Complete 1.04.p: add semantic actions to parser

[tiger.ml.git] / tiger / src / exe / tiger_tests.ml

diff --git a/tiger/src/exe/tiger_tests.ml b/tiger/src/exe/tiger_tests.ml
index 266797e..d9eb050 100644 (file)
--- a/tiger/src/exe/tiger_tests.ml
+++ b/tiger/src/exe/tiger_tests.ml
@@ -2,7 +2,7 @@ open Printf
 
 module List = ListLabels
 
-let test_01 =
+let test_case_from_book_01 =
   let name = "an array type and an array variable" in
   let code =
     " \
@@ -29,7 +29,7 @@ let test_01 =
   in
   (name, code, tokens)
 
-let test_02 =
+let test_case_from_book_02 =
   let name = "arr1 is valid since expression 0 is int = myint" in
   let code =
     " \
@@ -58,7 +58,7 @@ let test_02 =
   in
   (name, code, tokens)
 
-let test_03 =
+let test_case_from_book_03 =
   let name = "a record type and a record variable" in
   let code =
     " \
@@ -99,7 +99,7 @@ let test_03 =
   in
   (name, code, tokens)
 
-let test_04 =
+let test_case_from_book_04 =
   let name = "define a recursive function" in
   let code =
     " \
@@ -131,7 +131,7 @@ let test_04 =
   in
   (name, code, tokens)
 
-let test_09 =
+let test_case_from_book_09 =
   let name = "error : types of then - else differ" in
   let code =
     " \
@@ -147,36 +147,176 @@ let test_09 =
   (* TODO: Type error test case *)
   (name, code, tokens)
 
-let tokens_of_code code =
-  let lexbuf = Lexing.from_string code in
-  let rec tokens () =
-    let token = Tiger.Lexer.token lexbuf in
-    (* Avoiding fragile pattern-matching *)
-    if token = Tiger.Parser.EOF then [] else token :: tokens ()
+(*
+let test_case_from_book_queens =
+  let code =
+    "\
+    /* A program to solve the 8-queens problem */ \n\
+ \n\
+    let \n\
+      var N := 8 \n\
+ \n\
+      type intArray = array of int \n\
+ \n\
+      var row := intArray [ N ] of 0 \n\
+      var col := intArray [ N ] of 0 \n\
+      var diag1 := intArray [N+N-1] of 0 \n\
+      var diag2 := intArray [N+N-1] of 0 \n\
+ \n\
+      function printboard() = ( \n\
+        for i := 0 to N-1 do ( \n\
+          for j := 0 to N-1 do print(if col[i]=j then \" O\" else \" .\"); \n\
+          print(\"\n\") \n\
+        ); \n\
+        print(\"\n\") \n\
+      ) \n\
+ \n\
+      function try(c:int) = ( \n\
+        /*  for i:= 0 to c do print(\".\"); print(\"\n\"); flush();*/ \n\
+        if c=N \n\
+        then printboard() \n\
+        else \n\
+          for r := 0 to N-1 \n\
+          do \n\
+            if row[r]=0 & diag1[r+c]=0 & diag2[r+7-c]=0 \n\
+            then ( \n\
+              row[r]       := 1; \n\
+              diag1[r+c]   := 1; \n\
+              diag2[r+7-c] := 1; \n\
+              col[c]       := r; \n\
+              try(c+1); \n\
+              row[r]       := 0; \n\
+              diag1[r+c]   := 0; \n\
+              diag2[r+7-c] := 0 \n\
+            ) \n\
+      ) \n\
+    in \n\
+      try(0) \n\
+    end \n\
+    "
   in
-  tokens ()
+  (code, code, [])
+*)
 
-let parsetree_of_code code =
-  let lb = Lexing.from_string code in
-  (match Tiger.Parser.program Tiger.Lexer.token lb with
-  | exception Parsing.Parse_error ->
-      let module L = Lexing in
-      let L.({lex_curr_p = {pos_lnum=l; pos_bol=b; pos_cnum=c; _}; _}) = lb in
-      let msg = sprintf "Syntax error around line: %d, column: %d" l (c - b) in
-      Error msg
-  | parsetree ->
-      Ok parsetree
-  )
+let test_cases_from_book =
+  [ test_case_from_book_01
+  ; test_case_from_book_02
+  ; test_case_from_book_03
+  ; test_case_from_book_04
+  ; test_case_from_book_09
+  (*; test_case_from_book_queens*)
+  ]
 
-let tests =
-  [ test_01
-  ; test_02
-  ; test_03
-  ; test_04
-  ; test_09
+let tests_micro_cases =
+  let open Tiger.Parser in
+  [ (
+      let code =
+        "nil"
+      in
+      let tokens =
+        [NIL]
+      in
+      (code, code, tokens)
+    )
+  ; (
+      let code =
+        "5"
+      in
+      let tokens =
+        [INT 5]
+      in
+      (code, code, tokens)
+    )
+  ; (
+      let code =
+        "-5"
+      in
+      let tokens =
+        [MINUS; INT 5]
+      in
+      (code, code, tokens)
+    )
+  ; (
+      let code =
+        "f()"
+      in
+      let tokens =
+        [ID "f"; LPAREN; RPAREN]
+      in
+      (code, code, tokens)
+    )
+  ; (
+      let code =
+        "f(\"a\", 3, foo)"
+      in
+      let tokens =
+        [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN]
+      in
+      (code, code, tokens)
+    )
+  ; (
+      let code =
+        "abc.i"
+      in
+      let tokens =
+        [ID "abc"; DOT; ID "i"]
+      in
+      (code, code, tokens)
+    )
+  ; (
+      let code =
+        "abc [5] of nil"
+      in
+      let tokens =
+        [ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL]
+      in
+      (code, code, tokens)
+    )
+  ; (
+      let code =
+        "abc[0]"
+      in
+      let tokens =
+        [ID "abc"; LBRACK; INT 0; RBRACK]
+      in
+      (code, code, tokens)
+    )
+  ; (
+      let code =
+        "abc[0] := foo()"
+      in
+      let tokens =
+        [ID "abc"; LBRACK; INT 0; RBRACK; ASSIGN; ID "foo"; LPAREN; RPAREN]
+      in
+      (code, code, tokens)
+    )
   ]
 
+let tests =
+  test_cases_from_book @ tests_micro_cases
+
 let () =
+  let tokens_of_code code =
+    let lexbuf = Lexing.from_string code in
+    let rec tokens () =
+      let token = Tiger.Lexer.token lexbuf in
+      (* Avoiding fragile pattern-matching *)
+      if token = Tiger.Parser.EOF then [] else token :: tokens ()
+    in
+    tokens ()
+  in
+  let parsetree_of_code code =
+    let lb = Lexing.from_string code in
+    (match Tiger.Parser.program Tiger.Lexer.token lb with
+    | exception Parsing.Parse_error ->
+        let module L = Lexing in
+        let L.({lex_curr_p = {pos_lnum=l; pos_bol=b; pos_cnum=c; _}; _}) = lb in
+        let msg = sprintf "Syntax error around line: %d, column: %d" l (c - b) in
+        Error msg
+    | absyn ->
+        Ok (Tiger.Absyn.to_string absyn)
+    )
+  in
   let bar_sep = String.make 80 '-' in
   let bar_end = String.make 80 '=' in
   let indent n = String.make (2 * n) ' ' in