Add the tiger source code bundle from the book site

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

tiger/testcases/merge.tig

@@ -0,0 +1,56 @@
+let 
+
+ type any = {any : int}
+ var buffer := getchar()
+
+function readint(any: any) : int =
+ let var i := 0
+     function isdigit(s : string) : int = 
+		  ord(buffer)>=ord("0") & ord(buffer)<=ord("9")
+     function skipto() =
+       while buffer=" " | buffer="\n"
+         do buffer := getchar()
+  in skipto();
+     any.any := isdigit(buffer);
+     while isdigit(buffer)
+       do (i := i*10+ord(buffer)-ord("0"); buffer := getchar());
+     i
+ end
+
+ type list = {first: int, rest: list}
+
+ function readlist() : list =
+    let var any := any{any=0}
+        var i := readint(any)
+     in if any.any
+         then list{first=i,rest=readlist()}
+         else nil
+    end
+
+ function merge(a: list, b: list) : list =
+   if a=nil then b
+   else if b=nil then a
+   else if a.first < b.first 
+      then list{first=a.first,rest=merge(a.rest,b)}
+      else list{first=b.first,rest=merge(a,b.rest)}
+
+ function printint(i: int) =
+  let function f(i:int) = if i>0 
+	     then (f(i/10); print(chr(i-i/10*10+ord("0"))))
+   in if i<0 then (print("-"); f(-i))
+      else if i>0 then f(i)
+      else print("0")
+  end
+
+ function printlist(l: list) =
+   if l=nil then print("\n")
+   else (printint(l.first); print(" "); printlist(l.rest))
+
+   var list1 := readlist()
+   var list2 := (buffer:=getchar(); readlist())
+
+
+  /* BODY OF MAIN PROGRAM */
+ in printlist(merge(list1,list2))
+end
+

tiger/testcases/queens.tig

@@ -0,0 +1,34 @@
+/* A program to solve the 8-queens problem */
+
+let
+    var N := 8
+
+    type intArray = array of int
+
+    var row := intArray [ N ] of 0
+    var col := intArray [ N ] of 0
+    var diag1 := intArray [N+N-1] of 0
+    var diag2 := intArray [N+N-1] of 0
+
+    function printboard() =
+       (for i := 0 to N-1
+	 do (for j := 0 to N-1 
+	      do print(if col[i]=j then " O" else " .");
+	     print("\n"));
+         print("\n"))
+
+    function try(c:int) = 
+( /*  for i:= 0 to c do print("."); print("\n"); flush();*/
+     if c=N
+     then printboard()
+     else for r := 0 to N-1
+	   do if row[r]=0 & diag1[r+c]=0 & diag2[r+7-c]=0
+	           then (row[r]:=1; diag1[r+c]:=1; diag2[r+7-c]:=1;
+		         col[c]:=r;
+	                 try(c+1);
+			 row[r]:=0; diag1[r+c]:=0; diag2[r+7-c]:=0)
+
+)
+ in try(0)
+end
+	

tiger/testcases/test1.tig

@@ -0,0 +1,7 @@
+/* an array type and an array variable */
+let
+	type  arrtype = array of int
+	var arr1:arrtype := arrtype [10] of 0
+in
+	arr1
+end

tiger/testcases/test10.tig

@@ -0,0 +1,2 @@
+/* error : body of while not unit */
+while(10 > 5) do 5+6

tiger/testcases/test11.tig

@@ -0,0 +1,3 @@
+/* error hi expr is not int, and index variable erroneously assigned to.  */
+for i:=10 to " " do 
+	i := i - 1

tiger/testcases/test12.tig

@@ -0,0 +1,7 @@
+/* valid for and let */
+
+let
+	var a:= 0
+in 
+	for i:=0 to 100 do (a:=a+1;())
+end

tiger/testcases/test13.tig

@@ -0,0 +1,3 @@
+/* error: comparison of incompatible types */
+
+3 > "df"

tiger/testcases/test14.tig

@@ -0,0 +1,13 @@
+/* error : compare rec with array */
+
+let
+
+	type arrtype = array of int
+	type rectype = {name:string, id: int}
+
+	var rec := rectype {name="aname", id=0}
+	var arr := arrtype [3] of 0
+
+in
+	if rec <> arr then 3 else 4
+end

tiger/testcases/test15.tig

@@ -0,0 +1,3 @@
+/* error : if-then returns non unit */
+
+if 20 then 3

tiger/testcases/test16.tig

@@ -0,0 +1,11 @@
+/* error: mutually recursive types thet do not pass through record or array */
+let 
+
+type a=c
+type b=a
+type c=d
+type d=a
+
+in
+ ""
+end

tiger/testcases/test17.tig

@@ -0,0 +1,10 @@
+/* error: definition of recursive types is interrupted */
+let
+/* define a tree */
+type tree ={key: int, children: treelist}
+var d:int :=0
+type treelist = {hd: tree, tl: treelist}
+
+in
+	d
+end

tiger/testcases/test18.tig

@@ -0,0 +1,15 @@
+/* error : definition of recursive functions is interrupted */
+let
+
+function do_nothing1(a: int, b: string):int=
+		(do_nothing2(a+1);0)
+
+var d:=0
+
+function do_nothing2(d: int):string =
+		(do_nothing1(d, "str");" ")
+
+in
+	do_nothing1(0, "str2")
+end
+

tiger/testcases/test19.tig

@@ -0,0 +1,13 @@
+/* error : second function uses variables local to the first one, undeclared variable */
+let
+
+function do_nothing1(a: int, b: string):int=
+		(do_nothing2(a+1);0)
+
+function do_nothing2(d: int):string =
+		(do_nothing1(a, "str");" ")
+
+in
+	do_nothing1(0, "str2")
+end
+

tiger/testcases/test2.tig

@@ -0,0 +1,9 @@
+/* arr1 is valid since expression 0 is int = myint */
+let
+	type myint = int
+	type  arrtype = array of myint
+
+	var arr1:arrtype := arrtype [10] of 0
+in
+	arr1
+end

tiger/testcases/test20.tig

@@ -0,0 +1,3 @@
+/* error: undeclared variable i */
+
+while 10 > 5 do (i+1;())

tiger/testcases/test21.tig

@@ -0,0 +1,13 @@
+/* error : procedure returns value  and procedure is used in arexpr */
+let
+
+/* calculate n! */
+function nfactor(n: int) =
+		if  n = 0 
+			then 1
+			else n * nfactor(n-1)
+
+in
+	nfactor(10)
+end
+

tiger/testcases/test22.tig

@@ -0,0 +1,8 @@
+/* error : field not in record type */
+
+let 
+	type rectype = {name:string , id:int}
+	var rec1 := rectype {name="Name", id=0}
+in
+	rec1.nam := "asd"
+end

tiger/testcases/test23.tig

@@ -0,0 +1,9 @@
+/* error : type mismatch */
+
+let 
+	type rectype = {name:string , id:int}
+	var rec1 := rectype {name="aname", id=0}
+in
+	rec1.name := 3;
+	rec1.id := "" 
+end

tiger/testcases/test24.tig

@@ -0,0 +1,7 @@
+/* error : variable not array */
+let 
+	var d:=0
+in
+	d[3]
+end
+

tiger/testcases/test25.tig

@@ -0,0 +1,7 @@
+/* error : variable not record */
+let 
+	var d:=0
+in
+	d.f 
+end
+

tiger/testcases/test26.tig

@@ -0,0 +1,3 @@
+/* error : integer required */
+
+3 + "var"

tiger/testcases/test27.tig

@@ -0,0 +1,8 @@
+/* locals hide globals */
+let
+	var a:=0
+
+	function g(a:int):int = a 
+in
+ g(2)
+end

tiger/testcases/test28.tig

@@ -0,0 +1,10 @@
+/* error : different record types */
+
+let
+	type rectype1 = {name:string , id:int}
+	type rectype2 = {name:string , id:int}
+
+	var rec1: rectype1 := rectype2 {name="Name", id=0}
+in
+	rec1
+end

tiger/testcases/test29.tig

@@ -0,0 +1,10 @@
+/* error : different array types */
+
+let
+	type arrtype1 = array of int
+	type arrtype2 = array of int
+
+	var arr1: arrtype1 := arrtype2 [10] of 0
+in
+	arr1
+end

tiger/testcases/test3.tig

@@ -0,0 +1,8 @@
+/* a record type and a record variable */
+let
+	type  rectype = {name:string, age:int}
+	var rec1:rectype := rectype {name="Nobody", age=1000}
+in
+	rec1.name := "Somebody";
+	rec1
+end

tiger/testcases/test30.tig

@@ -0,0 +1,10 @@
+/* synonyms are fine */
+
+let 
+		type a = array of int
+		type b = a
+
+		var arr1:a := b [10] of 0
+in
+		arr1[2]
+end

tiger/testcases/test31.tig

@@ -0,0 +1,6 @@
+/* error : type constraint and init value differ */
+let 
+	var a:int := " "
+in
+	a
+end

tiger/testcases/test32.tig

@@ -0,0 +1,9 @@
+/* error : initializing exp and array type differ */
+
+let
+	type arrayty = array of int
+
+	var a := arrayty [10] of " "
+in
+	0
+end

tiger/testcases/test33.tig

@@ -0,0 +1,6 @@
+/* error : unknown type */
+let
+	var a:= rectype {}
+in
+	0
+end

tiger/testcases/test34.tig

@@ -0,0 +1,6 @@
+/* error : formals and actuals have different types */
+let
+	function g (a:int , b:string):int = a
+in
+	g("one", "two")
+end

tiger/testcases/test35.tig

@@ -0,0 +1,6 @@
+/* error : formals are more then actuals */
+let
+	function g (a:int , b:string):int = a
+in
+	g("one")
+end

tiger/testcases/test36.tig

@@ -0,0 +1,6 @@
+/* error : formals are fewer then actuals */
+let
+	function g (a:int , b:string):int = a
+in
+	g(3,"one",5)
+end

tiger/testcases/test37.tig

@@ -0,0 +1,8 @@
+/* redeclaration of variable; this is legal, there are two different
+   variables with the same name.  The second one hides the first.  */
+let
+	var a := 0
+	var a := " "
+in
+	0
+end

tiger/testcases/test38.tig

@@ -0,0 +1,9 @@
+/* This is illegal, since there are two types with the same name
+    in the same (consecutive) batch of mutually recursive types. 
+    See also test47  */
+let
+	type a = int
+	type a = string
+in
+	0
+end

tiger/testcases/test39.tig

@@ -0,0 +1,9 @@
+/* This is illegal, since there are two functions with the same name
+    in the same (consecutive) batch of mutually recursive functions.
+   See also test48 */
+let
+	function g(a:int):int = a
+	function g(a:int):int = a
+in
+	0
+end

tiger/testcases/test4.tig

@@ -0,0 +1,13 @@
+/* define a recursive function */
+let
+
+/* calculate n! */
+function nfactor(n: int): int =
+		if  n = 0 
+			then 1
+			else n * nfactor(n-1)
+
+in
+	nfactor(10)
+end
+

tiger/testcases/test40.tig

@@ -0,0 +1,7 @@
+/* error : procedure returns value */
+let
+	function g(a:int) = a
+in 
+	g(2)
+end
+

tiger/testcases/test41.tig

@@ -0,0 +1,10 @@
+/* local types hide global */
+let
+	type a = int
+in
+	let
+		type a = string
+	in
+		0
+	end
+end

tiger/testcases/test42.tig

@@ -0,0 +1,30 @@
+/* correct declarations */
+let 
+
+type arrtype1 = array of int
+type rectype1 = {name:string, address:string, id: int , age: int}
+type arrtype2 = array of rectype1
+type rectype2 = {name : string, dates: arrtype1}
+
+type arrtype3 = array of string
+
+var arr1 := arrtype1 [10] of 0
+var arr2  := arrtype2 [5] of rectype1 {name="aname", address="somewhere", id=0, age=0}
+var arr3:arrtype3 := arrtype3 [100] of ""
+
+var rec1 := rectype1 {name="Kapoios", address="Kapou", id=02432, age=44}
+var rec2 := rectype2 {name="Allos", dates= arrtype1 [3] of 1900}
+
+in
+
+arr1[0] := 1; 
+arr1[9] := 3;
+arr2[3].name := "kati";
+arr2[1].age := 23;
+arr3[34] := "sfd";
+
+rec1.name := "sdf";
+rec2.dates[0] := 2323;
+rec2.dates[2] := 2323
+
+end

tiger/testcases/test43.tig

@@ -0,0 +1,7 @@
+/* initialize with unit and causing type mismatch in addition */
+
+let 
+	var a := ()
+in
+	a + 3
+end

tiger/testcases/test44.tig

@@ -0,0 +1,11 @@
+/* valid nil initialization and assignment */
+let 
+
+	type rectype = {name:string, id:int}
+	var b:rectype := nil
+
+in
+
+	b := nil
+
+end

tiger/testcases/test45.tig

@@ -0,0 +1,8 @@
+/* error: initializing nil expressions not constrained by record type */
+let 
+	type rectype = {name:string, id:int}
+
+	var a:= nil
+in
+	a
+end

tiger/testcases/test46.tig

@@ -0,0 +1,8 @@
+/* valid rec comparisons */
+let 
+	type rectype = {name:string, id:int}
+	var b:rectype := nil
+in
+	b = nil;
+	b <> nil
+end

tiger/testcases/test47.tig

@@ -0,0 +1,11 @@
+/* This is legal.  The second type "a" simply hides the first one.
+   Because of the intervening variable declaration, the two "a" types
+   are not in the same  batch of mutually recursive types.
+   See also test38 */
+let
+	type a = int
+	var b := 4
+	type a = string
+in
+	0
+end

tiger/testcases/test48.tig

@@ -0,0 +1,11 @@
+/* This is legal.  The second function "g" simply hides the first one.
+   Because of the intervening variable declaration, the two "g" functions
+   are not in the same  batch of mutually recursive functions. 
+   See also test39 */
+let
+	function g(a:int):int = a
+	type t = int
+	function g(a:int):int = a
+in
+	0
+end

tiger/testcases/test49.tig

@@ -0,0 +1,8 @@
+/* error: syntax error, nil should not be preceded by type-id.  */
+let 
+	type rectype = {name:string, id:int}
+
+	var a:= rectype nil
+in
+	a
+end

tiger/testcases/test5.tig

@@ -0,0 +1,14 @@
+/* define valid recursive types */
+let
+/* define a list */
+type intlist = {hd: int, tl: intlist} 
+
+/* define a tree */
+type tree ={key: int, children: treelist}
+type treelist = {hd: tree, tl: treelist}
+
+var lis:intlist := intlist { hd=0, tl= nil } 
+
+in
+	lis
+end

tiger/testcases/test6.tig

@@ -0,0 +1,13 @@
+/* define valid mutually recursive procedures */
+let
+
+function do_nothing1(a: int, b: string)=
+		do_nothing2(a+1)
+
+function do_nothing2(d: int) =
+		do_nothing1(d, "str")
+
+in
+	do_nothing1(0, "str2")
+end
+

tiger/testcases/test7.tig

@@ -0,0 +1,13 @@
+/* define valid mutually recursive functions */
+let
+
+function do_nothing1(a: int, b: string):int=
+		(do_nothing2(a+1);0)
+
+function do_nothing2(d: int):string =
+		(do_nothing1(d, "str");" ")
+
+in
+	do_nothing1(0, "str2")
+end
+

tiger/testcases/test8.tig

@@ -0,0 +1,2 @@
+/* correct if */
+if (10 > 20) then 30 else 40	

tiger/testcases/test9.tig

@@ -0,0 +1,3 @@
+/* error : types of then - else differ */
+
+if (5>4) then 13 else  " "