Artifact c68baf406e24bdae3cc734dde60820e1dff1dc42d4ce775d5ada490e5d33a230:

• File psl-1983/kernel/read.red — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 4632) [annotate] [blame] [check-ins using] [more...]

%
% READ.RED - S-expression parser
% 
% Author:      Eric Benson
%	       Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        28 August 1981
% Copyright (c) 1981 University of Utah
%

%  <PSL.KERNEL>READ.RED.6, 20-Oct-82 11:07:28, Edit by BENSON
%  Extra right paren in file only prints warning, not error
%  <PSL.KERNEL>READ.RED.5,  6-Oct-82 11:37:33, Edit by BENSON
%  Took away CATCH in READ, EOF error binds *InsideStructureRead to NIL
%  <PSL.KERNEL>READ.RED.2, 20-Sep-82 11:24:32, Edit by BENSON
%  Right parens at top level cause an error in a file
%  <PSL.INTERP>READ.RED.6,  2-Sep-82 14:07:37, Edit by BENSON
%  Right parens are ignored at the top level

fluid '(CurrentReadMacroIndicator!*	% Get to find read macro function
	CurrentScanTable!*		% vector of character types
	!*InsideStructureRead);		% indicates within compound read

global '(TokType!*			% Set by token scanner, type of token
	 LispScanTable!*		% CurrentScanTable!* when READing
	 IN!*				% Current input channel
	 !$EOF!$);			% has value returned when EOF is read
	
CurrentReadMacroIndicator!* := 'LispReadMacro;

CompileTime flag('(DotContextError), 'InternalFunction);

lisp procedure ChannelReadTokenWithHooks Channel;  % Scan token w/read macros
%
% This is ReadToken with hooks for read macros
%
begin scalar Tkn, Fn;
    Tkn := ChannelReadToken Channel;
    if TokType!* eq 3 and (Fn := get(Tkn, CurrentReadMacroIndicator!*)) then
	return IDApply2(Channel, Tkn, Fn);
    return Tkn;
end;

lisp procedure ChannelRead Channel;	%. Parse S-expression from channel
begin scalar CurrentScanTable!*, CurrentReadMacroIndicator!*;
    CurrentScanTable!* := LispScanTable!*;
    CurrentReadMacroIndicator!* := 'LispReadMacro;
    return ChannelReadTokenWithHooks Channel;
end;

lisp procedure Read();			%. Parse S-expr from current input
<<  MakeInputAvailable();
    ChannelRead IN!* >>;

lisp procedure ChannelReadEof(Channel, Ef);	% Handle end-of-file in Read
    if !*InsideStructureRead then return
    begin scalar !*InsideStructureRead;
	return 
	StdError BldMsg("Unexpected EOF while reading on channel %r",
								Channel);
    end else !$EOF!$;

lisp procedure ChannelReadQuotedExpression(Channel, Qt);	% read macro '
    MkQuote ChannelReadTokenWithHooks Channel;

lisp procedure ChannelReadListOrDottedPair(Channel, Pa);	% read macro (
%
% Read list or dotted pair.  Collect items until closing right paren.
% Check for dot context errors.
%
begin scalar Elem, StartPointer, EndPointer, !*InsideStructureRead;
    !*InsideStructureRead := T;
    Elem := ChannelReadTokenWithHooks Channel;
    if TokType!* eq 3 then
	if Elem eq '!. then return DotContextError()
	else if Elem eq '!) then return NIL;
    StartPointer := EndPointer := list Elem;
LoopBegin:
    Elem := ChannelReadTokenWithHooks Channel;
    if TokType!* eq 3 then
	if Elem eq '!) then return StartPointer
	else if Elem eq '!. then
	<<  Elem := ChannelReadTokenWithHooks Channel;
	    if TokType!* eq 3 and (Elem eq '!) or Elem eq '!.) then
		return DotContextError()
	    else
	    <<  RplacD(EndPointer, Elem);
		Elem := ChannelReadTokenWithHooks Channel;
		if TokType!* eq 3 and Elem eq '!) then return StartPointer
		else return DotContextError() >> >>;
% If we had splice macros, I think they would be checked here
    RplacD(EndPointer, list Elem);
    EndPointer := cdr EndPointer;
    goto LoopBegin;
end;

lisp procedure ChannelReadRightParen(Channel, Tok);
% Ignore right parens at the top
    if !*InsideStructureRead then Tok
    else
    <<  if not (Channel eq StdIN!*) then % if not reading from the terminal
	    ErrorPrintF "*** Unmatched right parenthesis";
	ChannelReadTokenWithHooks Channel >>;

lisp procedure DotContextError();	% Parsing error
    IOError "Dot context error";

% List2Vector is found in TYPE-CONVERSIONS.RED

lisp procedure ChannelReadVector Channel;	% read macro [
begin scalar Elem, StartPointer, EndPointer, !*InsideStructureRead;
    !*InsideStructureRead := T;
    StartPointer := EndPointer := (NIL . NIL);
    while << Elem := ChannelReadTokenWithHooks Channel;
	     TokType!* neq 3 or Elem neq '!] >> do
    <<  RplacD(EndPointer, list Elem);
	EndPointer := cdr EndPointer >>;
    return List2Vector cdr StartPointer;
end;

StartupTime <<
    put('!', 'LispReadMacro, function ChannelReadQuotedExpression);
    put('!( , 'LispReadMacro, function ChannelReadListOrDottedPair);
    put('!) , 'LispReadMacro, function ChannelReadRightParen);
    put('![, 'LispReadMacro, function ChannelReadVector);
    put(MkID char EOF, 'LispReadMacro, function ChannelReadEOF);
>>;

END;