--filename: expr-io.adb 4:54PM  9/11/95

with text_io, int_io;
package body expr.io is

-- this only recognizes spaces (and returns and tabs) as delimiters. It isn't
-- pretty, but it does allow one to read in expressions without having to
-- provide a complete scanner for more robust input. Thus ALL tokens, 
-- including parentheses, must be separated by spaces.
procedure Get(N: out Symbol) is
     C:Character;
     I: Integer := 1;

  use standard.ascii;
  function IsDelimiter(C:Character) return Boolean is
  begin
    case C is
	when ' '|ht|lf|cr => return true;
	when others => return false;
    end case;
  end IsDelimiter;     

begin
  N:= "        ";
  text_io.get(C);
  while IsDelimiter(C) 
	loop 
	  text_io.get(C); 
	end loop; -- get first non-blank
  while not IsDelimiter(C) 
           loop
	       if I=9 then raise constraint_error; end if;
               N(I):= C;
	       if text_io.end_of_line then exit; end if;
               text_io.get(C);
               I:= I+1;
            end loop;
exception
	when constraint_error => 
			while not IsDelimiter(C) 
				loop text_io.get(C); end loop; 
			text_io.put_line("too many characters in symbol");
			text_io.put_line("symbol truncated to: ");
			for I in 1..8 loop text_io.put(N(I)); end loop;
			text_io.new_line;
end get;

procedure GetExpList(EL:in out ExpList) is
     E: Exp;
     C: character;
     Eptr: ExpList;
begin
  get(E);
  if E.etype /= endparen
    then EL := cons(E, Empty); 
         Get(E);
         Eptr := EL;
         while E.etype /= endparen
          loop
	      SetRest(Eptr, cons(E, Empty));
	      Eptr := Rest(Eptr);
              Get(E);
          end loop;
    else EL:= Empty;
  end if;
end GetExpList;

procedure Get(EL:  out ExpList) is
begin
  GetExpList(EL);
end Get;

procedure GetNameList(NL: in out SymbolList) is
     N:Symbol;
     NPtr:SymbolList;
begin
  Get(N);
  if N /= ")       "       
    then NL:= cons(N, Empty); 
         Get(N);
         Nptr := NL;
         while N /= ")       "
          loop
	    SetRest(Nptr, cons(N, Empty));
	    Nptr := Rest(Nptr);
            Get(N);
          end loop;
     else NL:=Empty;
  end if;
end GetNamelist;

procedure Get(NL : out SymbolList) is
begin
  GetNameList(NL);
end Get;

procedure Get(E: out Exp) is
     C : Character;
     I : Integer;
     N : SYmbol;
     Ex, OpExp : Exp;
     SubE : Exp;
     NL : SymbolList;
     exL : ExpList;
     App : Boolean := False;
     unknown_expression_type:exception;
begin
     if  text_io.end_of_file then E:= MkDummy("done    "); 
	end if;
     get(N);
     case N(1) is
          when '0'..'9' => E := MkConst(Integer'value(String(N)));
	  when '(' => get(N);
		      case N(1) is
			when 'd' => 
				if N ="define  " 
				then get(N);
				     get(Ex);
				     E := MkDef(N, Ex);
				     get(N); -- swallow close paren
				     if N(1) /= ')'
	then text_io.put_line("missing right paren on define");
					end if;
				else App := true;
				end if;
			when 's' => 
				if N = "set     " 
				then get(N);
				     get(Ex);
				     E := MkSet(N, Ex);
				     get(N); -- swallow close paren
				     if N(1) /= ')'
	then text_io.put_line("missing right paren on set");
				     end if;
				elsif N = "seq     " 
				then  getExpList( exL);
			              E:= MkSeq(exL);
				     -- getExpList should swallow close paren
				else App := true;
			        end if;
			when 'f' => 
				if N = "function" 
				then get(N); -- swallow left paren
				     if N(1) /= '('
	then text_io.put_line("missing left paren at start of param list");
				     end if;
				     getNameList(NL); -- swallows right paren
				     get(Ex);
				     E := MkFcn(compound, "function", NL, Ex);
				     get(N); -- swallow close paren
				     if N(1) /= ')'
	then text_io.put_line("missing right paren on function");
				     end if;
				else App := true;
				end if;
			when others 	=> getExpList(exL);
					   OpExp := MkVar(N);
					   E := MkApp(OpExp, exL);
-- note that the assumption implemented here is that applications must have 
-- names of functions in the operator position, i.e., we've not allowed 
-- anonymous functions to appear here, or the possibility of functions 
-- as results of applications.
		      end case;
	-- now we must handle the applications that didn't fit the case
	-- because the function name started with "s" or "f"
		      if App then getExpList(exL);
				  OpExp := MkVar(N);
				  E := MkApp(OpExp, exL);
		      end if;
	  when others => if N = "exit    " or N = "done    " or N ="quit    " 
			   then E := MkDummy(N);
			   elsif N(1) = ')'
			   then E := MkEndparen("endparen");
			   else E := MkVar(N);
			 end if;
	  end case;
end Get;

procedure put(N: in Symbol) is
  I : Integer := 1;
begin
  while I<9 and then N(I) /= ' '
    loop
      text_io.put(N(I));
      I := I+1;
    end loop;
end put;

procedure put(NL:in SymbolList) is
     Nptr: SymbolList := NL;
begin
  while Nptr /= Empty
    loop
     put(First(Nptr));
     text_io.put(' ');
     Nptr := Rest(Nptr);
    end loop;
end put;

procedure put(EL:in ExpList) is
     Lptr: ExpList := EL;
begin
  while Lptr /= Empty
    loop
     put(First(Lptr));
     text_io.put(' ');
     Lptr := Rest(Lptr);
    end loop;
end put;

procedure Put(E: in Exp) is
begin
  case E.etype is
     when const => int_io.put(E.value);
     when var => put(E.vname);
     when def => text_io.put("define "); 
                 put(E.name);
                 text_io.put(" to be ");
                 put(E.expr);
     when set => text_io.put("set the value of ");
                 put(E.name);
                 text_io.put(" to ");
                 put(E.expr);
     when fcn => case E.funtype is
                    when primitive => text_io.put("function ");
                                      put(E.fname);
           when compound => text_io.put(" function with parameters: ");
                            put(E.params); text_io.new_line;
                            text_io.put(" and body: ");
                            put(E.fnbody);
                 end case;
     when seq => text_io.put(" (seq ");
                 put(E.list);
                 text_io.put(')');
     when app => put(E.op);
		 text_io.put_line(" applied to ");
                 text_io.put('(');
                 put(E.arglist);
                 text_io.put(')');
     when done => text_io.put("done expression");
     when endparen => text_io.put("shouldn't have gotten this endparen");
  end case;
  text_io.new_line;
end put;

end expr.io;