head	1.6;
access;
symbols;
locks; strict;
comment	@# @;


1.6
date	95.03.03.22.39.28;	author ids;	state Exp;
branches;
next	1.5;

1.5
date	95.03.01.20.13.59;	author ids;	state Exp;
branches;
next	1.4;

1.4
date	95.03.01.19.35.53;	author ids;	state Exp;
branches;
next	1.3;

1.3
date	95.03.01.19.29.18;	author ids;	state Exp;
branches;
next	1.2;

1.2
date	95.03.01.19.21.47;	author ids;	state Exp;
branches;
next	1.1;

1.1
date	95.03.01.18.28.05;	author ids;	state Exp;
branches;
next	;


desc
@@


1.6
log
@improved Abort, Assert:
 * added use of standard error (though it doesn't work for now!)
 * now exits with "quit <", allowing a less baroque error message
   (without the banner!)
 * Assert has Abort in-lined, so that "quit <" works nicely.
@
text
@%
%	BIO.t: simple BIO-like Turing I/O.
%	I have not wrapped this up into a proper module; you just include it!
%
%	If you use this, you must not mix it with direct calls to Turing's own
%	*input* statements, as this would confuse the input buffering.
%	You can mix it with Turing's own *output* statements if you want.
%



%
%	Assert and Abort (used by some of the BIO-type procedures)
%
const STDERR := 0	% this is subject to change, says the green book!



procedure Abort (message : string)
	%
	%	Prints the message on standard error and aborts.
	%	WARNING: standard error doesn't seem to work for now:
	%		 it just goes on to the standard output!
	%
	put :STDERR, ""		% in case we're part-way along a line already
	put :STDERR, message
	quit <			% gives line number of call to Abort
end Abort



procedure Assert (b : boolean, message : string)
	%
	%	Asserts that b is true.
	%	If b turns out to be false, prints the message on
	%	standard error and aborts.
	%	WARNING: standard error doesn't seem to work for now:
	%		 it just goes on to the standard output!
	%
	if not b then
		%
		%	code of Abort(message):
		%	inlined so that "quit <" gives a sensible line number.
		%
		put :STDERR, ""	% in case we're part-way along a line already
		put :STDERR, message
		quit <		% gives line number of call to Assert
	end if
end Assert



%
%	the buffer, and a flag saying whether it's currently in use
%
var BIO_BUFFER        : char
var BIO_BUFFER_IN_USE : boolean := false



%
%	now the actual BIO-type procedures!
%
procedure GetChar (var ch : char)
	%
	%	Gets one character from the logical input stream.
	%	If the logical input stream is exhausted, aborts with an
	%	error message.
	%
	if BIO_BUFFER_IN_USE then
		ch := BIO_BUFFER
		BIO_BUFFER_IN_USE := false
	else
		Assert(not eof, "GetChar: premature EOF reached")
		get ch
	end if
end GetChar



procedure PushBackChar (ch : char)
	%
	%	Pushes back one character into the logical input stream.
	%	You cannot push back more than one character.
	%
	%	Note that InspectChar() below ends with a PushBackChar, so you
	%	can't follow it with PushBackChar.
	%
	Assert(not BIO_BUFFER_IN_USE,
		"PushBackChar: cannot push back more than one char")
	BIO_BUFFER_IN_USE := true
	BIO_BUFFER        := ch
end PushBackChar



function IsMore() : boolean
	%
	%	Returns true iff there is at least one character left
	%	on the logical input stream. Side-effect-free.
	%
	if BIO_BUFFER_IN_USE then
		result true
	else
		result not eof
	end if
end IsMore



function InspectChar() : char
	%
	%	Returns the next character on the logical input stream.
	%	Unlike GetChar, the character is not actually read,
	%	merely inspected.
	%	If the logical input stream is exhausted, aborts with an
	%	error message.
	%
	var ch : char

	Assert(IsMore(), "InspectChar: premature EOF reached")
	GetChar(ch)
	PushBackChar(ch)
	result ch
end InspectChar



function IsDigit (ch : char) : boolean
	%
	%	Returns true iff the character is a digit.
	%
	result ch>='0' and ch<='9'
end IsDigit



function IsWhitespace (ch : char) : boolean
	%
	%	Returns true iff the character is whitespace
	%	(space, tab, or newline).
	%
	result ch=' ' or ch='	' or ch='\n'
end IsWhitespace



procedure SkipWhitespace()
	%
	%	Skips as much contiguous whitespace as possible
	%	(zero or more characters) from the current point onwards
	%	in the logical input stream.
	%
	var dummych : char

	loop
		exit when not IsMore() or not IsWhitespace(InspectChar())
		GetChar(dummych)
	end loop
end SkipWhitespace



function IsMoreAfterWhitespace() : boolean
	%
	%	Returns true iff there is at least one character left
	%	on the logical input stream even after skipping whitespace.
	%
	SkipWhitespace()
	result IsMore()
end IsMoreAfterWhitespace



procedure GetInteger (var i : int)
	%
	%	Gets one integer from the logical input stream.
	%	Any whitespace *before* the integer is skipped;
	%	any whitespace *after* the integer is left alone.
	%	If the logical input stream is exhausted or there is not a
	%	valid integer on the logical input stream, aborts with an
	%	error message.
	%
	%	Syntax of an integer: optional minus sign followed by
	%	compulsory block of one or more digit characters.
	%
	%	Currently no range checking is performed.
	%
	var multiplier  : int
	var ch, dummych : char

	SkipWhitespace()
	Assert(IsMore(), "GetInteger: premature EOF reached")

	%
	%	get minus sign, if present
	%
	if InspectChar()='-' then
		GetChar(dummych)
		Assert(IsMore(), "GetInteger: premature EOF reached")
		multiplier := -1
	else
		multiplier := 1
	end if

	Assert(IsMore() and IsDigit(InspectChar()),
		"GetInteger: invalid integer input")

	%
	%	get block of digit characters
	%
	i := 0
	loop
		exit when not IsMore() or not IsDigit(InspectChar())
		GetChar(ch)
		i := 10*i + multiplier*strint(ch)
	end loop
end GetInteger



procedure GetLine()
	%
	%	Skips up to and including the next newline character on the
	%	logical input stream.
	%	If the logical input stream is exhausted before a newline is
	%	found, aborts with an error message.
	%
	var dummych : char

	loop
		exit when not IsMore() or InspectChar()='\n'
		GetChar(dummych)
	end loop

	Assert(IsMore(), "GetLine: premature EOF reached")
	GetChar(dummych)
end GetLine



procedure PutChar (ch : char)
	%
	%	Puts one character on to the output stream.
	%	Note that the output stream is just the normal Turing
	%	output stream; this procedure is provided for symmetry only.
	%
	put ch ..
end PutChar



procedure PutInteger (i : int)
	%
	%	Puts one integer on to the output stream.
	%	Note that the output stream is just the normal Turing
	%	output stream; this procedure is provided for symmetry only.
	%
	put i ..
end PutInteger



procedure PutLine()
	%
	%	Puts one newline character on to the output stream.
	%	Note that the output stream is just the normal Turing
	%	output stream; this procedure is provided for symmetry only.
	%
	put ""
end PutLine
@


1.5
log
@better comments
better declaration order.
@
text
@d15 4
d21 3
a23 3
	%	Aborts with the message.
	%	At the moment there is some extra clutter too, but it is
	%	flagged as such.
d25 3
a27 8
	put ""		% in case we're part-way along a line already
	put ""
	put "****************ABORTING: MESSAGE AS FOLLOWS:****************"
	put "******", message
	put "********************END OF ABORT MESSAGE.********************"
	put ""
	put "[On the other hand, ignore *this* error message below...]"
	put 1/0		% there seems to be no "proper" way to abort!
d35 4
a38 1
	%	If b turns out to be false, aborts with the message.
d41 7
a47 1
		Abort(message)
@


1.4
log
@better commenting and layout in Abort.
@
text
@d3 1
a3 2
%	If you use this you must not mix it with "direct" built-in I/O
%	statements of Turing, as this would confuse the buffering!
d5 3
a7 5



%
%	the buffer, and a flag saying whether it's currently in use
a8 2
var BIO_BUFFER        : char
var BIO_BUFFER_IN_USE : boolean := false
d46 8
d77 3
@


1.3
log
@added function IsMoreAfterWhitespace().
@
text
@d26 1
a26 1
	put ""
d32 1
a32 1
	put "[On the other hand, ignore *this* error message below...] "
@


1.2
log
@added lots of detailed comments
improved format of message in Abort
added GetLine, PutLine; removed newline from output of PutChar, PutInteger
better variable names
layout tidyups.
@
text
@d150 11
@


1.1
log
@Initial revision
@
text
@a5 2
var BIO_buffer        : char
var BIO_buffer_in_use : boolean := false
d8 12
d21 5
d27 7
a33 3
	put "******ABORTING******"
	put message
	put "(On the other hand, ignore *this* error message:) ", 1/0
d37 1
d39 4
d49 13
a61 4
procedure GetChar(var ch : char)
	if BIO_buffer_in_use then
		ch := BIO_buffer
		BIO_buffer_in_use := false
d69 10
a78 4
procedure PushBackChar(ch : char)
	Assert(not BIO_buffer_in_use, "PushBackChar: cannot push back more than one char")
	BIO_buffer_in_use := true
	BIO_buffer        := ch
d82 1
d84 5
a88 1
	if BIO_buffer_in_use then
d96 1
d98 7
d114 1
d116 3
d123 1
d125 4
d133 1
d135 6
a140 1
	var ch : char
d144 1
a144 1
		GetChar(ch)
d149 15
a163 1
procedure GetInteger(var i : int)
d170 3
d181 2
a182 1
	Assert(IsMore() and IsDigit(InspectChar()), "GetInteger: invalid integer input")
d184 3
d196 21
d218 6
a223 1
	put ch
d227 1
d229 6
a234 1
	put i
d236 11
@