Add the tiger source code bundle from the book site

Signed-off-by: jmug <u.g.a.mariano@gmail.com>

tiger/chap4/absyn.sml

@@ -0,0 +1,52 @@
+structure Absyn = 
+struct
+
+type pos = int   and   symbol = Symbol.symbol
+
+datatype var = SimpleVar of symbol * pos
+            | FieldVar of var * symbol * pos
+            | SubscriptVar of var * exp * pos
+
+and exp = VarExp of var
+        | NilExp
+        | IntExp of int
+        | StringExp of string * pos
+        | CallExp of {func: symbol, args: exp list, pos: pos}
+        | OpExp of {left: exp, oper: oper, right: exp, pos: pos}
+        | RecordExp of {fields: (symbol * exp * pos) list,
+			typ: symbol, pos: pos}
+        | SeqExp of (exp * pos) list
+        | AssignExp of {var: var, exp: exp, pos: pos}
+        | IfExp of {test: exp, then': exp, else': exp option, pos: pos}
+        | WhileExp of {test: exp, body: exp, pos: pos}
+	| ForExp of {var: symbol, escape: bool ref,
+		     lo: exp, hi: exp, body: exp, pos: pos}
+        | BreakExp of pos
+        | LetExp of {decs: dec list, body: exp, pos: pos}
+        | ArrayExp of {typ: symbol, size: exp, init: exp, pos: pos}
+
+and dec = FunctionDec of fundec list
+        | VarDec of {name: symbol,
+		     escape: bool ref,
+		     typ: (symbol * pos) option,
+		     init: exp,
+		     pos: pos}
+        | TypeDec of {name: symbol, ty: ty, pos: pos} list
+
+and ty = NameTy of symbol * pos
+       | RecordTy of field list
+       | ArrayTy of symbol * pos
+
+and oper = PlusOp | MinusOp | TimesOp | DivideOp
+         | EqOp | NeqOp | LtOp | LeOp | GtOp | GeOp
+
+withtype field = {name: symbol, escape: bool ref, 
+		  typ: symbol, pos: pos}
+   and   fundec = {name: symbol,
+		   params: field list,
+		   result: (symbol * pos) option,
+		   body: exp,
+		   pos: pos}
+     
+end
+        

tiger/chap4/errormsg.sml

@@ -0,0 +1,53 @@
+signature ERRORMSG =
+sig
+    val anyErrors : bool ref
+    val fileName : string ref
+    val lineNum : int ref
+    val linePos : int list ref
+    val sourceStream : TextIO.instream ref
+    val error : int -> string -> unit
+    exception Error
+    val impossible : string -> 'a   (* raises Error *)
+    val reset : unit -> unit
+end
+
+structure ErrorMsg : ERRORMSG =
+struct
+
+  val anyErrors = ref false
+  val fileName = ref ""
+  val lineNum = ref 1
+  val linePos = ref [1]
+  val sourceStream = ref TextIO.stdIn
+
+  fun reset() = (anyErrors:=false;
+		 fileName:="";
+		 lineNum:=1;
+		 linePos:=[1];
+		 sourceStream:=TextIO.stdIn)
+
+  exception Error
+
+  fun error pos (msg:string) =
+      let fun look(a::rest,n) =
+		if a<pos then app print [":",
+				       Int.toString n,
+				       ".",
+				       Int.toString (pos-a)]
+		       else look(rest,n-1)
+	    | look _ = print "0.0"
+       in anyErrors := true;
+	  print (!fileName);
+	  look(!linePos,!lineNum);
+	  print ":";
+	  print msg;
+	  print "\n"
+      end
+
+  fun impossible msg =
+      (app print ["Error: Compiler bug: ",msg,"\n"];
+       TextIO.flushOut TextIO.stdOut;
+       raise Error)
+
+end  (* structure ErrorMsg *)
+  

tiger/chap4/parse.sml

@@ -0,0 +1,22 @@
+structure Parse : sig val parse : string -> Absyn.exp  end =
+struct 
+  structure TigerLrVals = TigerLrValsFun(structure Token = LrParser.Token)
+  structure Lex = TigerLexFun(structure Tokens = TigerLrVals.Tokens)
+  structure TigerP = Join(structure ParserData = TigerLrVals.ParserData
+			structure Lex=Lex
+			structure LrParser = LrParser)
+  fun parse filename =
+      let val _ = (ErrorMsg.reset(); ErrorMsg.fileName := filename)
+	  val file = TextIO.openIn filename
+	  fun get _ = TextIO.input file
+	  fun parseerror(s,p1,p2) = ErrorMsg.error p1 s
+	  val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
+	  val (absyn, _) = TigerP.parse(30,lexer,parseerror,())
+       in TextIO.closeIn file;
+	   absyn
+      end handle LrParser.ParseError => raise ErrorMsg.Error
+
+end
+
+
+

tiger/chap4/prabsyn.sml

@@ -0,0 +1,128 @@
+structure PrintAbsyn : 
+     sig val print : TextIO.outstream * Absyn.exp -> unit end =
+struct
+
+  structure A = Absyn
+
+fun print (outstream, e0) =
+ let fun say s =  TextIO.output(outstream,s)
+  fun sayln s= (say s; say "\n") 
+
+  fun indent 0 = ()
+    | indent i = (say " "; indent(i-1))
+
+  fun opname A.PlusOp = "PlusOp"
+    | opname A.MinusOp = "MinusOp"
+    | opname A.TimesOp = "TimesOp"
+    | opname A.DivideOp = "DivideOp"
+    | opname A.EqOp = "EqOp"
+    | opname A.NeqOp = "NeqOp"
+    | opname A.LtOp = "LtOp"
+    | opname A.LeOp = "LeOp"
+    | opname A.GtOp = "GtOp"
+    | opname A.GeOp = "GeOp"
+
+  fun dolist d f [a] = (sayln ""; f(a,d+1))
+    | dolist d f (a::r) = (sayln ""; f(a,d+1); say ","; dolist d f r)
+    | dolist d f nil = ()
+
+
+  fun var(A.SimpleVar(s,p),d) = (indent d; say "SimpleVar("; 
+			         say(Symbol.name s); say ")")
+    | var(A.FieldVar(v,s,p),d) = (indent d; sayln "FieldVar(";
+				  var(v,d+1); sayln ",";
+				  indent(d+1); say(Symbol.name s); say ")")
+    | var(A.SubscriptVar(v,e,p),d) = (indent d; sayln "SubscriptVar(";
+				      var(v,d+1); sayln ",";
+				      exp(e,d+1); say ")")
+  and exp(A.VarExp v, d) = (indent d; sayln "VarExp("; var(v,d+1); say ")")
+    | exp(A.NilExp, d) = (indent d; say "NilExp")
+    | exp(A.IntExp i, d) = (indent d; say "IntExp("; say(Int.toString i);
+			    say ")")
+    | exp(A.StringExp(s,p),d) = (indent d; say "StringExp(\"";
+				 say s; say "\")")
+    | exp(A.CallExp{func,args,pos},d) =
+		        (indent d; say "CallExp("; say(Symbol.name func);
+			 say ",["; dolist d exp args; say "])")
+    | exp(A.OpExp{left,oper,right,pos},d) =
+		(indent d; say "OpExp("; say(opname oper); sayln ",";
+		 exp(left,d+1); sayln ","; exp(right,d+1); say ")")
+    | exp(A.RecordExp{fields,typ,pos},d) =
+	    let fun f((name,e,pos),d) = 
+			(indent d; say "("; say(Symbol.name name);
+			 sayln ","; exp(e,d+1);
+			 say ")")
+	     in indent d; say "RecordExp("; say(Symbol.name typ); 
+	        sayln ",["; dolist d f fields; say "])" 
+	    end
+    | exp(A.SeqExp l, d) = (indent d; say "SeqExp["; dolist d exp (map #1 l); 
+			    say "]")
+    | exp(A.AssignExp{var=v,exp=e,pos},d) = 
+		(indent d; sayln "AssignExp("; var(v,d+1); sayln ",";
+		 exp(e,d+1); say ")")
+    | exp(A.IfExp{test,then',else',pos},d) =
+		(indent d; sayln "IfExp("; exp(test,d+1); sayln ",";
+		 exp(then',d+1);
+		 case else' of NONE => ()
+			| SOME e => (sayln ","; exp(e,d+1));
+		 say ")")
+    | exp(A.WhileExp{test,body,pos},d) =
+		(indent d; sayln "WhileExp("; exp(test,d+1); sayln ",";
+		 exp(body,d+1); say ")")
+    | exp(A.ForExp{var=v,escape=b,lo,hi,body,pos},d) =
+		(indent d; sayln "ForExp(";
+		 say(Symbol.name v); say ","; say(Bool.toString (!b)); sayln ",";
+		 exp(lo,d+1); sayln ","; exp(hi,d+1); sayln ",";
+		 exp(body,d+1); say ")")
+    | exp(A.BreakExp p, d) = (indent d; say "BreakExp")
+    | exp(A.LetExp{decs,body,pos},d) =
+		(indent d; say "LetExp([";
+		 dolist d dec decs; sayln "],"; exp(body,d+1); say")")
+    | exp(A.ArrayExp{typ,size,init,pos},d) =
+	        (indent d; say "ArrayExp("; say(Symbol.name typ); sayln ",";
+		 exp(size,d+1); sayln ","; exp(init,d+1); say ")")
+
+
+  and dec(A.FunctionDec l, d) = 
+	    let fun field({name,escape,typ,pos},d) = 
+			(indent d; say "("; say(Symbol.name name);
+			 say ","; say(Bool.toString(!escape)); 
+			 say ","; say(Symbol.name typ); say ")")
+		fun f({name,params,result,body,pos},d) =
+		   (indent d; say "("; say (Symbol.name name); say ",[";
+		    dolist d field params; sayln "],";
+		    case result of NONE => say "NONE"
+			 | SOME(s,_) => (say "SOME("; say(Symbol.name s); say ")");
+		    sayln ","; exp(body,d+1); say ")")
+	     in indent d; say "FunctionDec["; dolist d f l; say "]"
+	    end
+    | dec(A.VarDec{name,escape,typ,init,pos},d) =
+	   (indent d; say "VarDec("; say(Symbol.name name); say ",";
+	    say(Bool.toString (!escape)); say ",";
+	    case typ of NONE => say "NONE" 
+		      | SOME(s,p)=> (say "SOME("; say(Symbol.name s); say ")");
+            sayln ","; exp(init,d+1); say ")")
+    | dec(A.TypeDec l, d) = 
+	 let fun tdec({name,ty=t,pos},d) = (indent d; say"("; 
+				  	    say(Symbol.name name); sayln ",";
+					    ty(t,d+1); say ")")
+	  in indent d; say "TypeDec["; dolist d tdec l; say "]"
+         end
+   
+  and ty(A.NameTy(s,p), d) = (indent d; say "NameTy("; say(Symbol.name s);
+			      say ")")
+    | ty(A.RecordTy l, d) =  
+		let fun f({name,escape,typ,pos},d) =
+			(indent d; say "("; say (Symbol.name name);
+		         say ","; say (Bool.toString (!escape)); say ",";
+			 say (Symbol.name typ); say ")")
+	         in indent d; say "RecordTy["; dolist d f l; say "]"
+		end
+    | ty(A.ArrayTy(s,p),d) = (indent d; say "ArrayTy("; say(Symbol.name s);
+			      say ")")
+
+ in  exp(e0,0); sayln ""; TextIO.flushOut outstream
+end
+
+end
+

tiger/chap4/sources.cm

@@ -0,0 +1,13 @@
+Group is 
+
+absyn.sml
+errormsg.sml
+table.sig
+table.sml
+symbol.sml
+parse.sml
+tiger.lex
+tiger.grm
+smlnj-lib.cm
+ml-yacc-lib.cm
+

tiger/chap4/symbol.sml

@@ -0,0 +1,43 @@
+signature SYMBOL =
+sig
+  eqtype symbol
+  val symbol : string -> symbol
+  val name : symbol -> string
+  type 'a table
+  val empty : 'a table
+  val enter : 'a table * symbol * 'a -> 'a table
+  val look  : 'a table * symbol -> 'a option
+end
+
+structure Symbol :> SYMBOL =
+struct
+
+  type symbol = string * int
+
+  structure H = HashTable
+
+  exception Symbol
+  val nextsym = ref 0
+  val sizeHint = 128
+  val hashtable : (string,int) H.hash_table = 
+		H.mkTable(HashString.hashString, op = ) (sizeHint,Symbol)
+  
+  fun symbol name =
+      case H.find hashtable name
+       of SOME i => (name,i)
+        | NONE => let val i = !nextsym
+	           in nextsym := i+1;
+		      H.insert hashtable (name,i);
+		      (name,i)
+		  end
+
+  fun name(s,n) = s
+
+  structure Table = IntMapTable(type key = symbol
+				fun getInt(s,n) = n)
+
+  type 'a table= 'a Table.table
+  val empty = Table.empty
+  val enter = Table.enter
+  val look = Table.look
+end

tiger/chap4/table.sig

@@ -0,0 +1,9 @@
+signature TABLE = 
+sig
+   type key
+   type 'a table
+   val empty : 'a table
+   val enter : 'a table * key * 'a -> 'a table
+   val look  : 'a table * key -> 'a option
+end
+

tiger/chap4/table.sml

@@ -0,0 +1,9 @@
+functor IntMapTable (type key
+		     val getInt: key -> int) : TABLE =
+struct
+  type key=key
+  type 'a table = 'a IntBinaryMap.map
+  val empty = IntBinaryMap.empty
+  fun enter(t,k,a) = IntBinaryMap.insert(t,getInt k,a)
+  fun look(t,k) = IntBinaryMap.find(t,getInt k)
+end

tiger/chap4/tiger.grm

@@ -0,0 +1,40 @@
+structure A = Absyn
+
+%%
+%term
+    EOF 
+  | ID of string
+  | INT of int | STRING of string 
+  | COMMA | COLON | SEMICOLON | LPAREN | RPAREN | LBRACK | RBRACK 
+  | LBRACE | RBRACE | DOT 
+  | PLUS | MINUS | TIMES | DIVIDE | EQ | NEQ | LT | LE | GT | GE
+  | AND | OR | ASSIGN
+  | ARRAY | IF | THEN | ELSE | WHILE | FOR | TO | DO | LET | IN | END | OF 
+  | BREAK | NIL
+  | FUNCTION | VAR | TYPE 
+
+%nonterm  exp | program of A.exp
+
+%pos int
+%verbose
+%start program
+%eop EOF
+%noshift EOF
+
+%name Tiger
+
+%keyword WHILE FOR TO BREAK LET IN END FUNCTION VAR TYPE ARRAY IF THEN ELSE 
+	DO OF NIL
+
+%prefer THEN ELSE LPAREN
+
+%value ID ("bogus")
+%value INT (1)
+%value STRING ("")
+
+%%
+
+program	: exp				(exp)
+
+	
+exp: NIL		(A.NilExp)