[REFACTOR] I refactored tokenizer.

- split common-parts to function

diff --git a/src/lisp.ml b/src/lisp.ml
index 0db62d4..a836ecf 100644 (file)
--- a/src/lisp.ml
+++ b/src/lisp.ml
@@ -32,7 +32,7 @@ let symbol stream =
     | _ ->
        Parsec.fail ()
 
-let keyword kwd stream =
+let kwd kwd stream =
   match Stream.peek stream with
       Some (Symbol {Node.value = v}) when kwd = v->
        Stream.next stream;
@@ -44,7 +44,9 @@ let one_list hd tl =
       [< x = hd; y = Parsec.many tl>] ->
        (x,y)
 
-
+let pair car cdr =
+  parser [< x = car; y = cdr >] ->
+    (x,y)
 
 let rec expr = 
   parser
@@ -70,15 +72,15 @@ and block =
        `Block e
 and cond_clause =
   parser
-      [< _ = keyword "else"; body = block>] ->
+      [< _ = kwd "else"; body = block>] ->
        `Else body
     | [< cond = expr; body = block>] ->
        `Cond (cond,body)
 and p_list =
   parser
-      [< _ = keyword "if"; t = expr; c = expr; a = expr >] ->
+      [< _ = kwd "if"; t = expr; c = expr; a = expr >] ->
        `If (t,c,a)
-    | [< _ =keyword "cond"; body = Parsec.many @@ list cond_clause >] ->
+    | [< _ =kwd "cond"; body = Parsec.many @@ list cond_clause >] ->
        List.fold_right 
          (fun clause sub ->
             match clause with
@@ -87,23 +89,23 @@ and p_list =
               | `Cond (cond,body) ->
                   `If (cond,body,sub))
          body (`Block [])
-    | [< _ = keyword "let"; vars = list @@ Parsec.many @@ list vars; 
+    | [< _ = kwd "let"; vars = list @@ Parsec.many @@ list vars; 
         body = Parsec.many expr>] ->
        `Let (vars,`Block body)
-    | [< _ = keyword "letrec"; vars = list @@ Parsec.many @@ list vars; 
+    | [< _ = kwd "letrec"; vars = list @@ Parsec.many @@ list vars; 
         body = block>] ->
        `LetRec (vars,body)
-    | [< _ = keyword "begin"; body = block >] ->
+    | [< _ = kwd "begin"; body = block >] ->
        body
-    | [< _ = keyword "lambda"; args = list @@ Parsec.many symbol; body = block >] ->
+    | [< _ = kwd "lambda"; args = list @@ Parsec.many symbol; body = block >] ->
        `Lambda (args,body)
-    | [< _ = keyword "new"; name = symbol; args = Parsec.many expr >] ->
+    | [< _ = kwd "new"; name = symbol; args = Parsec.many expr >] ->
        `New (qname name,args)
-    | [< _ = keyword "."; obj = expr; (name,args) = list @@ one_list symbol expr >] ->
+    | [< _ = kwd "."; obj = expr; (name,args) = list @@ one_list symbol expr >] ->
        `Invoke (obj,name,args)
-    | [< _ = keyword "slot-ref"; obj = expr; name = symbol >] ->
+    | [< _ = kwd "slot-ref"; obj = expr; name = symbol >] ->
        `SlotRef (obj,name)
-    | [< _ = keyword "slot-set!";obj = expr; 
+    | [< _ = kwd "slot-set!";obj = expr; 
         name = symbol; value = expr>] ->
        `SlotSet (obj,name,value)
     | [< xs = Parsec.many expr >]  ->
@@ -111,12 +113,12 @@ and p_list =
 
 let define_value =
   parser
-      [< _ = keyword "define"; name = symbol; body = Parsec.many expr >] ->
+      [< _ = kwd "define"; name = symbol; body = Parsec.many expr >] ->
        `Define (name,`Block body)
 
 let define_func =
   parser
-      [< _ = keyword "define"; (name,args) = list @@ one_list symbol symbol; body = block >] ->
+      [< _ = kwd "define"; (name,args) = list @@ one_list symbol symbol; body = block >] ->
        let f = 
          `Lambda (args,body) in
          `Define (name,f)
@@ -124,20 +126,16 @@ let define_func =
 let define =
   (try_ define_value) <|> define_func
 
-let pair car cdr =
-  parser [< x = car; y = cdr >] ->
-    (x,y)
-
 let p_stmt =
   parser
       [< def = define >] ->
        def
-    | [< _ = keyword "define-class"; 
+    | [< _ = kwd "define-class"; 
         name = symbol;
         (super,_)= list @@ one_list symbol symbol; 
         attr = list @@ many symbol >] ->
        `DefineClass (name,qname super,attr)
-    | [< _ = keyword "define-method";
+    | [< _ = kwd "define-method";
         f = symbol;
         ((self,klass),args) = list @@ one_list (list @@ pair symbol symbol) symbol;
         body = block >] ->

diff --git a/src/sexp.ml b/src/sexp.ml
index 0b55018..ad06175 100644 (file)
--- a/src/sexp.ml
+++ b/src/sexp.ml
@@ -11,6 +11,9 @@ type t =
   | Symbol of string Node.t
   | List   of t list Node.t
 
+let kwd s =
+  node (Genlex.Kwd s)
+
 let rec to_string =
   function
       Int   node ->
@@ -39,25 +42,25 @@ let rec read =
        Int    {node with value = n}
     | [<'{value = Genlex.Float x} as node>] -> 
        Float  {node with value = x}
-    | [<'{value = Genlex.Kwd "true"} as node>] -> 
+    | [< node = kwd "true" >] ->
        Bool   {node with value = true}
-    | [<'{value=Genlex.Kwd "false"} as node >] -> 
+    | [< node = kwd "false" >] ->
        Bool   {node with value = false}
     | [< e = parse_list <?> "unbalanced list" >] ->
        e
-    | [<'{value=Genlex.Kwd "'"} as node; c = read >] -> 
+    | [< node = kwd "'"; c = read >] -> 
        let quote =
          Symbol {node with value= "quote"} in
          List {node with value = [quote;c]}
 and parse_list =
   parser
-      [<'{value=Genlex.Kwd "("} as node; 
-       c = Parsec.many read;
-       '{value = Genlex.Kwd ")"; end_pos = pos} >] -> 
+      [< node = kwd "("; 
+        c = Parsec.many read; 
+        {end_pos = pos} = kwd ")" >] ->
        List   {node with value = c; end_pos = pos}
-    | [<'{value=Genlex.Kwd "["} as node;
+    | [< node = kwd "[";
        c = Parsec.many read;
-       '{value=Genlex.Kwd "]"; end_pos = pos} >] -> 
+       {end_pos = pos} = kwd "]" >] ->
        List   {node with value = c; end_pos = pos}
 
 let of_stream stream =

diff --git a/test/test_lexer.ml b/test/test_lexer.ml
index 49c4f60..55ca741 100644 (file)
--- a/test/test_lexer.ml
+++ b/test/test_lexer.ml
@@ -7,7 +7,7 @@ open Node
 let lexer str = 
   Lexer.lexer scheme (Node.of_string str)
 
-let node value line a b =
+let pos value line a b =
   {(Node.empty value) with 
      Node.filename =  "<string>";
      lineno        = line;
@@ -17,6 +17,9 @@ let node value line a b =
 let ok a {Node.value = b} =
   Util.ok a b
 
+let token str =
+  Stream.next @@ lexer str
+
 let _ =
   ("lex module test" >::: [
      "multiline" >::
@@ -34,42 +37,42 @@ foo
 42
 42.0
 #t #f" in
-           Util.ok (node (Kwd "(")      0 0 1) @@ Stream.next s;
-           Util.ok (node (Ident "foo")  1 0 3) @@ Stream.next s;
-           Util.ok (node (String "abc") 2 0 5) @@ Stream.next s;
-           Util.ok (node (Int 42)       3 0 2) @@ Stream.next s;
-           Util.ok (node (Float 42.0)   4 0 4) @@ Stream.next s;
-           Util.ok (node (Kwd "true")   5 0 2) @@ Stream.next s;
-           Util.ok (node (Kwd "false")  5 3 5) @@ Stream.next s);
+           Util.ok (pos (Kwd "(")      0 0 1) @@ Stream.next s;
+           Util.ok (pos (Ident "foo")  1 0 3) @@ Stream.next s;
+           Util.ok (pos (String "abc") 2 0 5) @@ Stream.next s;
+           Util.ok (pos (Int 42)       3 0 2) @@ Stream.next s;
+           Util.ok (pos (Float 42.0)   4 0 4) @@ Stream.next s;
+           Util.ok (pos (Kwd "true")   5 0 2) @@ Stream.next s;
+           Util.ok (pos (Kwd "false")  5 3 5) @@ Stream.next s);
      "symbol" >::
        (fun () ->
-         ok (Ident "+")  @@ Stream.next (lexer "+");
-         ok (Ident "+.") @@ Stream.next (lexer "+.");
-         ok (Ident "+.") @@ Stream.next (lexer "+.");
-         ok (Ident "/")  @@ Stream.next (lexer "/");
-         ok (Ident "foo.bar") @@ Stream.next (lexer "foo.bar"));
+         ok (Ident "+")  @@ token "+";
+         ok (Ident "+.") @@ token "+.";
+         ok (Ident "+.") @@ token "+.";
+         ok (Ident "/")  @@ token "/";
+         ok (Ident "foo.bar") @@ token "foo.bar");
      "dot" >::
        (fun () ->
-         ok (Ident ".") @@ Stream.next (lexer "."));
+         ok (Ident ".") @@ token ".");
      "string" >::
        (fun () ->
-         ok (String "") @@ Stream.next (lexer "\"\"");
-         ok (String "xyz") @@ Stream.next (lexer "\"xyz\""));
+         ok (String "") @@ token "\"\"";
+         ok (String "xyz") @@ token "\"xyz\"");
      "bool" >::
        (fun () ->
-         ok (Kwd "true")  @@ Stream.next (lexer "#t");
-         ok (Kwd "false") @@ Stream.next (lexer "#f"));
+         ok (Kwd "true")  @@ token "#t";
+         ok (Kwd "false") @@ token "#f");
      "int" >::
        (fun () ->
-         ok (Int 42) @@ Stream.next (lexer "42"));
+         ok (Int 42) @@ token "42");
      "float" >::
        (fun () ->
-         ok (Float 42.) @@ Stream.next (lexer "42.");
-         ok (Float 42.) @@ Stream.next (lexer "42.0");
-         ok (Float 42.1) @@ Stream.next (lexer "+42.1");
-         ok (Float (-42.1)) @@ Stream.next (lexer "-42.1"));
+         ok (Float 42.) @@ token "42.";
+         ok (Float 42.) @@ token "42.0";
+         ok (Float 42.1) @@ token "+42.1";
+         ok (Float (-42.1)) @@ token "-42.1");
      "quote" >::
        (fun () ->
-         ok (Kwd "'") @@ Stream.next (lexer "'");
-         ok (Kwd "'") @@ Stream.next (lexer "'hoge"))
+         ok (Kwd "'") @@ token "'";
+         ok (Kwd "'") @@ token "'hoge")
    ]) +> run_test_tt

diff --git a/test/test_lisp.ml b/test/test_lisp.ml
index ee4d9ee..c1469d7 100644 (file)
--- a/test/test_lisp.ml
+++ b/test/test_lisp.ml
@@ -15,12 +15,12 @@ let ok x y =
   OUnit.assert_equal 
     ~cmp:(fun a b -> List.for_all2 AstUtil.eq_clos a b)
     ~printer:(string_of_list $ List.map ClosTrans.to_string)
-    x y
+    x @@ Lisp.compile_string y
 
 let check x y =
   OUnit.assert_equal 
     ~printer:(string_of_list $ List.map ClosTrans.to_string)
-    x y
+    x @@ Lisp.compile_string y
 
 let syntax_error f =
   try
@@ -61,189 +61,184 @@ let _ =
   ("lisp module test" >::: [
      "pos" >::
        (fun () ->
-         check (expr (`Int (pos 42 0 0 2))) @@
-           Lisp.compile_string "42";
-         check (expr (`String (pos "hoge" 0 0 6))) @@
-           Lisp.compile_string "\"hoge\"";
-         check (expr (`Bool   (pos true 0 0 2))) @@
-           Lisp.compile_string "#t";
-         check (expr (`Var    (pos "foo" 0 0 3))) @@
-           Lisp.compile_string "foo";
-         check (expr (`Lambda ([pos "abc" 0 9 12],`Block []))) @@
-           Lisp.compile_string "(lambda (abc))";
+         check (expr (`Int (pos 42 0 0 2))) 
+           "42";
+         check (expr (`String (pos "hoge" 0 0 6))) 
+           "\"hoge\"";
+         check (expr (`Bool   (pos true 0 0 2))) 
+           "#t";
+         check (expr (`Var    (pos "foo" 0 0 3))) 
+           "foo";
+         check (expr (`Lambda ([pos "abc" 0 9 12],`Block []))) 
+           "(lambda (abc))";
          check (expr (`Let ([pos "foo" 0 7 10,`Int (pos 42 0 11 13)],
                             `Block []))) @@ 
-           Lisp.compile_string "(let [(foo 42)] )";
+           "(let [(foo 42)] )";
          check (expr (`LetRec ([pos "foo" 0 10 13,`Int (pos 42 0 14 16)],
                                `Block []))) @@ 
-           Lisp.compile_string "(letrec [(foo 42)] )";
+           "(letrec [(foo 42)] )";
          check (expr (`New (pos ("","Foo") 0 5 8 ,[]))) @@
-           Lisp.compile_string "(new Foo)";
+           "(new Foo)";
          check (expr (`Invoke (`Var (pos "foo" 0 3 6), pos "baz" 0 8 11,[]))) @@
-           Lisp.compile_string "(. foo (baz))";
+           "(. foo (baz))";
          check (expr (`SlotRef (`Var (pos "obj" 0 10 13),pos "name" 0 14 18))) @@
-           Lisp.compile_string "(slot-ref obj name)";
+           "(slot-ref obj name)";
          check (expr (`SlotSet (`Var (pos "obj" 0 11 14),
                                pos "name" 0 15 19,
                                 `Int (pos  42 0 20 22)))) @@
-           Lisp.compile_string "(slot-set! obj name 42)";
+           "(slot-set! obj name 42)";
          check [`Define (pos "x" 0 8 9,`Block [`Int (pos 42 0 10 12)])] @@
-           Lisp.compile_string "(define x 42)";
+           "(define x 42)";
          check [`Define (pos "f" 0 9 10,`Lambda ([pos "x" 0 11 12],`Block []))] @@
-           Lisp.compile_string "(define (f x))";
+           "(define (f x))";
          check [`DefineClass (pos "Foo" 0 14 17,
                              pos ("","Object") 0 19 25,
                              [pos "arg" 0 28 31])] @@
-           Lisp.compile_string "(define-class Foo (Object) (arg))";
+           "(define-class Foo (Object) (arg))";
          check [`DefineMethod (pos "fun" 0 15 18,
                               (pos "self" 0 21 25,pos "Object" 0 26 32),
                               [pos "xyz" 0 34 37],
                                `Block [])] @@
-           Lisp.compile_string "(define-method fun ((self Object) xyz))");
+           "(define-method fun ((self Object) xyz))");
      "empty" >::
        (fun () ->
-         OUnit.assert_equal [] @@ Lisp.compile_string "");
+         ok [] "");
      "comment" >::
        (fun () ->
-         OUnit.assert_equal [] @@ 
-           Lisp.compile_string "; foo bar");
+         ok [] "; foo bar");
      "string" >::
        (fun () ->
-         ok (expr (string "hello")) @@ 
-           Lisp.compile_string "\"hello\"");
+         ok (expr (string "hello")) 
+           "\"hello\"");
      "int" >::
        (fun () ->
-         ok (expr (int 42)) @@ 
-           Lisp.compile_string "42");
+         ok (expr (int 42)) 
+           "42");
      "float" >::
        (fun () ->
-         ok (expr (float 42.)) @@ 
-           Lisp.compile_string "42.";
-         ok (expr (float 42.5)) @@ 
-           Lisp.compile_string "42.5");
+         ok (expr (float 42.)) 
+           "42.";
+         ok (expr (float 42.5))  
+           "42.5");
      "bool" >::
        (fun () ->
-         ok (expr (bool true)) @@ 
-           Lisp.compile_string "#t";
-         ok (expr (bool false)) @@ 
-           Lisp.compile_string "#f");
+         ok (expr (bool true))  
+           "#t";
+         ok (expr (bool false))  
+           "#f");
      "call" >::
        (fun () ->
-         ok (expr (`Call [var "print"])) @@ 
-           Lisp.compile_string "(print)";
-         ok (expr (`Call [var "print";string "hello"])) @@ 
-           Lisp.compile_string "(print \"hello\")";
-         ok (expr (`Call [var "print";string "hello";string "world"])) @@ 
-           Lisp.compile_string "(print \"hello\" \"world\")");
+         ok (expr (`Call [var "print"]))  
+           "(print)";
+         ok (expr (`Call [var "print";string "hello"]))  
+           "(print \"hello\")";
+         ok (expr (`Call [var "print";string "hello";string "world"]))  
+           "(print \"hello\" \"world\")");
      "+" >::
        (fun () ->
-         ok (expr (`Call [var "+";int 1;int 2])) @@ 
-           Lisp.compile_string "(+ 1 2)";
-         ok (expr (`Call [var "-";int 1;int 2])) @@ 
-           Lisp.compile_string "(- 1 2)";
-         ok (expr (`Call [var "*";int 1;int 2])) @@ 
-           Lisp.compile_string "(* 1 2)";
-         ok (expr (`Call [var "/";int 1;int 2])) @@ 
-           Lisp.compile_string "(/ 1 2)");
+         ok (expr (`Call [var "+";int 1;int 2]))  
+           "(+ 1 2)";
+         ok (expr (`Call [var "-";int 1;int 2]))  
+           "(- 1 2)";
+         ok (expr (`Call [var "*";int 1;int 2]))  
+           "(* 1 2)";
+         ok (expr (`Call [var "/";int 1;int 2]))  
+           "(/ 1 2)");
      "<" >::
        (fun () ->
-         ok (expr (`Call [var "=";int 1;int 2])) @@ 
-           Lisp.compile_string "(= 1 2)";
-         ok (expr (`Call [var "<";int 1;int 2])) @@ 
-           Lisp.compile_string "(< 1 2)";
-         ok (expr (`Call [var "<=";int 1;int 2])) @@ 
-           Lisp.compile_string "(<= 1 2)";
-         ok (expr (`Call [var ">";int 1;int 2])) @@ 
-           Lisp.compile_string "(> 1 2)";
-         ok (expr (`Call [var ">=";int 1;int 2])) @@ 
-           Lisp.compile_string "(>= 1 2)");
+         ok (expr (`Call [var "=";int 1;int 2]))  
+           "(= 1 2)";
+         ok (expr (`Call [var "<";int 1;int 2]))  
+           "(< 1 2)";
+         ok (expr (`Call [var "<=";int 1;int 2]))  
+           "(<= 1 2)";
+         ok (expr (`Call [var ">";int 1;int 2]))  
+           "(> 1 2)";
+         ok (expr (`Call [var ">=";int 1;int 2]))  
+           "(>= 1 2)");
      "if" >::
        (fun () ->
-         ok (expr (`If (int 1,int 2,int 3))) @@ 
-           Lisp.compile_string "(if 1 2 3)");
+         ok (expr (`If (int 1,int 2,int 3)))  
+           "(if 1 2 3)");
      "cond" >::
        (fun () ->
          ok (expr (`If (int 1,
                         `Block [int 2],
                         `If (int 3,
                              `Block [int 4],
-                             `Block [int 5])))) @@
-           Lisp.compile_string "(cond (1 2) (3 4) (else 5))");
+                             `Block [int 5])))) 
+           "(cond (1 2) (3 4) (else 5))");
      "cond without else" >::
        (fun () ->
          ok (expr (`If (int 1,
                        `Block [int 2],
                        `If (int 3,
                             `Block [int 4],
-                            `Block [])))) @@
-           Lisp.compile_string "(cond (1 2) (3 4))");
+                            `Block [])))) 
+           "(cond (1 2) (3 4))");
      "let" >::
        (fun () ->
          ok (expr (`Let ([node "x",int 1;node "y",int 2],
-                         `Block [var "x";var "y"]))) @@ 
-           Lisp.compile_string "(let ((x 1) (y 2)) x y)");
+                         `Block [var "x";var "y"])))  
+           "(let ((x 1) (y 2)) x y)");
      "letrec" >::
        (fun () ->
          ok (expr (`LetRec ([node "x",int 1;node "y",int 2],
-                            `Block [var "x";var "y"]))) @@ 
-           Lisp.compile_string "(letrec ((x 1) (y 2)) x y)");
+                            `Block [var "x";var "y"])))  
+           "(letrec ((x 1) (y 2)) x y)");
      "begin" >::
        (fun () ->
-         ok (expr (`Block [int 1;int 2])) @@
-           Lisp.compile_string "(begin 1 2)");
+         ok (expr (`Block [int 1;int 2])) 
+           "(begin 1 2)");
      "lambda" >::
        (fun () ->
-         ok (expr (`Lambda ([],`Block [int 42]))) @@
-           Lisp.compile_string "(lambda () 42)");
-     "lambda args" >::
-       (fun () ->
+         ok (expr (`Lambda ([],`Block [int 42]))) 
+           "(lambda () 42)";
          ok (expr (`Lambda ([node "a";node "b";node "c"],
-                            `Block [int 42]))) @@
-           Lisp.compile_string "(lambda (a b c) 42)");
+                            `Block [int 42]))) 
+           "(lambda (a b c) 42)");
      "new" >::
        (fun () ->
-         ok (expr (`New (node ("","Foo"),[]))) @@
-           Lisp.compile_string "(new Foo)");
-     "new args" >::
-       (fun () ->
-         ok (expr (`New (node ("","Foo"),[int 1;int 2]))) @@
-           Lisp.compile_string "(new Foo 1 2)");
+         ok (expr (`New (node ("","Foo"),[]))) 
+           "(new Foo)";
+         ok (expr (`New (node ("","Foo"),[int 1;int 2]))) 
+           "(new Foo 1 2)");
      "invoke" >::
        (fun () ->
-         ok (expr (`Invoke (var "foo",node "baz",[int 1;int 2]))) @@
-           Lisp.compile_string "(. foo (baz 1 2))");
+         ok (expr (`Invoke (var "foo",node "baz",[int 1;int 2]))) 
+           "(. foo (baz 1 2))");
      "define" >::
        (fun () ->
-         ok [`Define (node "x",`Block [int 42])] @@
-           Lisp.compile_string "(define x 42)";
+         ok [`Define (node "x",`Block [int 42])] 
+           "(define x 42)";
          ok [`Define (node "f",`Lambda ([node "x"],
-                                               `Block [int 42]))] @@
-           Lisp.compile_string "(define (f x) 42)");
+                                        `Block [int 42]))] 
+           "(define (f x) 42)");
      "bug()" >::
        (fun () ->
          ok [`Expr (int 10);
-             `Define (node "x",`Block [int 42])] @@
-           Lisp.compile_string "10 (define x 42)");
+             `Define (node "x",`Block [int 42])] 
+           "10 (define x 42)");
      "class" >::
        (fun () ->
-         ok [define_class "Foo" ("","Object") ["x";"y"]] @@
-           Lisp.compile_string "(define-class Foo (Object) (x y))";
-         ok [define_class "Foo" ("flash.text","Object") ["x";"y"]] @@
-           Lisp.compile_string "(define-class Foo (flash.text.Object) (x y))";
-         ok [define_class "Foo" ("flash.text","Object") []] @@
-           Lisp.compile_string "(define-class Foo (flash.text.Object) ())");
+         ok [define_class "Foo" ("","Object") ["x";"y"]] 
+            "(define-class Foo (Object) (x y))";
+         ok [define_class "Foo" ("flash.text","Object") ["x";"y"]] 
+            "(define-class Foo (flash.text.Object) (x y))";
+         ok [define_class "Foo" ("flash.text","Object") []] 
+            "(define-class Foo (flash.text.Object) ())");
      "method" >::
        (fun () ->
-         ok [define_method  "f" "self" "Object" ["x";"y"] (`Block [int 42])] @@
-           Lisp.compile_string "(define-method f ((self Object) x y) 42)");
+         ok [define_method  "f" "self" "Object" ["x";"y"] (`Block [int 42])] 
+           "(define-method f ((self Object) x y) 42)");
      "slot-ref" >::
        (fun () ->
-         ok (expr (`SlotRef (var "obj",node "name"))) @@
-           Lisp.compile_string "(slot-ref obj name)");
+         ok (expr (`SlotRef (var "obj",node "name"))) 
+           "(slot-ref obj name)");
      "slot-set!" >::
        (fun () ->
-         ok (expr (`SlotSet (var "obj",node "name",int 42))) @@
-           Lisp.compile_string "(slot-set! obj name 42)");
+         ok (expr (`SlotSet (var "obj",node "name",int 42))) 
+           "(slot-set! obj name 42)");
      "syntax error" >::
        (fun () ->
          syntax_error (fun () ->

diff --git a/test/test_sexp.ml b/test/test_sexp.ml
index 2b23c28..fc0b944 100644 (file)
--- a/test/test_sexp.ml
+++ b/test/test_sexp.ml
@@ -39,6 +39,19 @@ let pos x n a b =
      start_pos     = a;
      end_pos       = b}
 
+let int n =
+  Int (node n)
+let string s =
+  String (node s)
+let bool b =
+  Bool (node b)
+let float f =
+  Float (node f)
+let symbol s =
+  Symbol (node s)
+let list l =
+  List (node l)
+
 let _ =
   ("S expression module test" >::: [
      "pos" >::
@@ -60,55 +73,50 @@ let _ =
 #t #f
 hoge
 (a b c)");
-     "multi line" >::
-       (fun () ->
-         ok [Int (node 42);
-             Int {(node 10) with Node.lineno=1}] "42\n10");
      "empty" >::
        (fun () ->
          ok [] "";
          ok [] "; foo bar");
      "int" >::
        (fun () ->
-         ok [Int (node 42)] "42";
-         ok [Int (node ~-42)] "-42");
+         ok [int 42]   "42";
+         ok [int ~-42] "-42");
      "bool" >::
        (fun () ->
-         ok [Bool (node true)]  "#t";
-         ok [Bool (node false)] "#f");
+         ok [bool true]  "#t";
+         ok [bool false] "#f");
      "float" >::
        (fun () ->
-         ok [Float (node 42.)] "42.";
-         ok [Float (node 42.5)] "42.5");
+         ok [float 42.]  "42.";
+         ok [float 42.5] "42.5");
      "string" >::
        (fun () ->
-         ok [String (node "")]        "\"\"";
-         ok [String (node "foo")]     "\"foo\"";
-         ok [String (node "foo\"x")]  "\"foo\\\"x\"";
-         ok [String (node "foo\"")]   "\"foo\\\"\"");
+         ok [string ""]       "\"\"";
+         ok [string "foo"]    "\"foo\"";
+         ok [string "foo\"x"] "\"foo\\\"x\"";
+         ok [string "foo\""]  "\"foo\\\"\"");
      "symbol" >::
        (fun () ->
-         ok [String (node "foo")]  "\"foo\"";
-         ok [String (node "+")]    "\"+\"";
-         ok [Symbol (node ".")]    ".");
+         ok [string "foo"] "\"foo\"";
+         ok [string "+"]   "\"+\"";
+         ok [symbol "."]   ".");
      "+" >::
        (fun () ->
-         ok [List (node [Symbol (node "+");
-                          Int (node 1);
-                          Int (node 2)])] "(+ 1 2)");
+         ok [list [symbol "+"; int 1; int 2]]
+           "(+ 1 2)");
      "call" >::
        (fun () ->
-         ok [List (node [Symbol (node "print");
-                          String (node "hello")])] "(print \"hello\")");
+         ok [list [symbol "print"; string "hello"]]
+           "(print \"hello\")");
      "bracket" >::
        (fun () ->
-         ok [List (node [Symbol (node "print");
-                          String (node "hello")])] "[print \"hello\"]");
+         ok [list [symbol "print"; string "hello"]] 
+           "[print \"hello\"]");
      "quote" >::
        (fun () ->
-         ok [List (node [Symbol (node "quote");
-                          Symbol (node "hello")])] "(quote hello)";
-         ok [List (node [Symbol (node "quote");
-                         Symbol (node "hello")])] "'hello")
+         ok [list [symbol "quote"; symbol "hello"]] 
+           "(quote hello)";
+         ok [list [symbol "quote"; symbol "hello"]] 
+           "'hello")
    ]) +> run_test_tt