[UPDATE]sexp support Node.t

diff --git a/src/lexer.ml b/src/lexer.ml
index 4aea7a5..68bf4f7 100644 (file)
--- a/src/lexer.ml
+++ b/src/lexer.ml
@@ -115,8 +115,9 @@ let in_string stream =
 
 let p_string delim =
   parser
-      [<_ = node delim; xs = many in_string; _ = node delim>] -> 
-       string @@ implode xs
+      [<n = node delim; xs = many in_string; _ = node delim>] -> 
+       {n with
+          Node.value = Genlex.String (ExtString.String.implode @@ List.map Node.value xs)}
     | [<>] ->
        fail ()
 

diff --git a/src/lexer.mli b/src/lexer.mli
index b2d1d90..f14ebd5 100644 (file)
--- a/src/lexer.mli
+++ b/src/lexer.mli
@@ -24,4 +24,4 @@ type laungage = { string_:  t lex;
                }
 val scheme' : laungage
 
-val lexer : laungage -> char Node.t Stream.t -> token Node.t Stream.t
+val lexer : laungage -> char Node.t Stream.t -> t Stream.t

diff --git a/src/node.ml b/src/node.ml
index d745c44..e0e140a 100644 (file)
--- a/src/node.ml
+++ b/src/node.ml
@@ -57,7 +57,6 @@ let lift f ({value=x} as node) =
   {node with
      value = f x}
 
-
 let concat f =
   function
       (x::_) as xs ->
@@ -66,3 +65,6 @@ let concat f =
     | [] ->
        empty (f [])
 
+let to_string show {value=value;filename=filename; lineno=lineno} =
+  Printf.sprintf "{value=%s; filename=%s; lineno=%d}\n"
+    (show value) filename lineno

diff --git a/src/node.mli b/src/node.mli
index 5658665..5e6ccb1 100644 (file)
--- a/src/node.mli
+++ b/src/node.mli
@@ -13,3 +13,5 @@ val value : 'a t -> 'a
 
 val lift : ('a -> 'b) -> 'a t -> 'b t
 val concat : ('a list -> 'b) -> 'a t list -> 'b t
+val to_string : ('a -> string) -> 'a t -> string
+

diff --git a/src/sexp.ml b/src/sexp.ml
index 668ec25..b252e7a 100644 (file)
--- a/src/sexp.ml
+++ b/src/sexp.ml
@@ -1,29 +1,39 @@
 (* lisp parser *)
 open Base
 type lisp = 
-    Int    of int 
-  | String of string 
+    Int    of int
+  | String of string
   | Float  of float 
   | Bool   of bool 
   | Symbol of string 
   | List   of lisp list
 
+type t =
+    Int_    of int Node.t
+  | String_ of string Node.t
+  | Float_  of float Node.t
+  | Bool_   of bool Node.t
+  | Symbol_ of string Node.t
+  | List_   of t list Node.t
+    
+
 let rec to_string =
   function
-      Int    n ->
-       string_of_int n
-    | String s ->
-       Printf.sprintf "\"%s\"" s
-    | Float  d ->
-       string_of_float d
-    | Symbol s ->
-       s
-    | Bool   b ->
-       if b then "#t" else "#f"
-    | List   xs ->
-       let s =
-         String.concat " " @@ List.map to_string xs in
-         Printf.sprintf "(%s)" s
+      Int_   node ->
+       Node.to_string string_of_int node
+    | String_ node ->
+       Node.to_string (Printf.sprintf "\"%s\"") node
+    | Float_  node ->
+       Node.to_string string_of_float node
+    | Symbol_ node ->
+       Node.to_string id node
+    | Bool_   node ->
+       Node.to_string (fun b -> if b then "#t" else "#f") node
+    | List_   node ->
+       let f xs = 
+         let s = String.concat " " @@ List.map to_string xs in
+           Printf.sprintf "(%s)" s in
+         Node.to_string f node
 
 let rec read =
   parser
@@ -45,3 +55,38 @@ let parse stream =
 
 let parse_string string =
   parse @@ Stream.of_string string
+
+let rec read_node =
+  parser
+      [<'{Node.value = Genlex.String s} as node>] -> 
+       String_ {node with Node.value = s}
+    | [<'{Node.value = Genlex.Ident name} as node>] ->
+       Symbol_ {node with Node.value = name}
+    | [<'{Node.value = Genlex.Int n} as node >] -> 
+       Int_    {node with Node.value = n}
+    | [<'{Node.value = Genlex.Float x} as node>] -> 
+       Float_  {node with Node.value = x}
+    | [<'{Node.value = Genlex.Kwd "true"} as node>] -> 
+       Bool_   {node with Node.value = true}
+    | [<'{Node.value=Genlex.Kwd "false"} as node >] -> 
+       Bool_   {node with Node.value = false}
+    | [<'{Node.value=Genlex.Kwd "("} as node; 
+       c = Parsec.many read_node;
+       '{Node.value = Genlex.Kwd ")"} >] -> 
+       List_   {node with Node.value = c}
+    | [<'{Node.value=Genlex.Kwd "["} as node;
+       c = Parsec.many read_node;
+       '{Node.value=Genlex.Kwd "]"} >] -> 
+       List_   {node with Node.value = c}
+    | [<'{Node.value=Genlex.Kwd "'"} as node; c = Parsec.many read_node >] -> 
+       let quote =
+         Symbol_ {node with Node.value= "quote"} in
+         List_ {node with Node.value = quote::c}
+
+let of_stream stream =
+  let lexer =
+    Lexer.lexer Lexer.scheme' in
+    Parsec.many read_node @@ lexer stream
+
+let of_string string =
+  of_stream @@ Node.of_string string

diff --git a/src/sexp.mli b/src/sexp.mli
index 31587a6..e88b116 100644 (file)
--- a/src/sexp.mli
+++ b/src/sexp.mli
@@ -2,6 +2,18 @@
 
 type lisp = Int of int | String of string | Float of float | Bool of bool | Symbol of string | List of lisp list
 
-val to_string : lisp -> string
+
 val parse : char Stream.t -> lisp list
 val parse_string : string -> lisp list
+
+type t =
+    Int_    of int Node.t
+  | String_ of string Node.t
+  | Float_  of float Node.t
+  | Bool_   of bool Node.t
+  | Symbol_ of string Node.t
+  | List_   of t list Node.t
+
+val of_stream : char Node.t Stream.t -> t list
+val of_string : string -> t list
+val to_string : t -> string

diff --git a/test/test_lexer.ml b/test/test_lexer.ml
index 9614ee3..b904c9d 100644 (file)
--- a/test/test_lexer.ml
+++ b/test/test_lexer.ml
@@ -16,6 +16,12 @@ let node value =
 
 let _ =
   ("lex module test" >::: [
+     "multiline" >::
+       (fun () ->
+         let s =
+           lexer "x\ny" in
+           ok (node (Ident "x")) @@ Stream.next s;
+           ok {(node (Ident "y")) with Node.lineno=1} @@ Stream.next s);
      "symbol" >::
        (fun () ->
          ok (node (Ident "+"))  @@ Stream.next (lexer "+");
@@ -26,6 +32,10 @@ let _ =
      "dot" >::
        (fun () ->
          ok (node (Ident ".")) @@ Stream.next (lexer "."));
+     "string" >::
+       (fun () ->
+         ok (node (String "")) @@ Stream.next (lexer "\"\"");
+         ok (node (String "xyz")) @@ Stream.next (lexer "\"xyz\""));
      "bool" >::
        (fun () ->
          ok (node (Kwd "true"))  @@ Stream.next (lexer "#t");

diff --git a/test/test_sexp.ml b/test/test_sexp.ml
index 3726205..17510ed 100644 (file)
--- a/test/test_sexp.ml
+++ b/test/test_sexp.ml
@@ -4,53 +4,66 @@ open OUnit
 
 let ok sexp str =
   let sexp' =
-    parse_string str in
+    of_string str in
     OUnit.assert_equal
       ~printer:(String.concat ";\n" $ List.map Sexp.to_string) 
       sexp 
       sexp'
 
+let node x =
+  {Node.value = x; filename = "<string>"; lineno = 0}
+
 let _ =
   ("S expression module test" >::: [
+     "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 42)] "42";
-         ok [(Int ~-42)] "-42");
+         ok [Int_ (node 42)] "42";
+         ok [Int_ (node ~-42)] "-42");
      "bool" >::
        (fun () ->
-         ok [(Bool true)]  "#t";
-         ok [(Bool false)] "#f");
+         ok [Bool_ (node true)]  "#t";
+         ok [Bool_ (node false)] "#f");
      "float" >::
        (fun () ->
-         ok [(Float 42.)] "42.";
-         ok [(Float 42.5)] "42.5");
+         ok [Float_ (node 42.)] "42.";
+         ok [Float_ (node 42.5)] "42.5");
      "string" >::
        (fun () ->
-         ok [(String "")]        "\"\"";
-         ok [(String "foo")]     "\"foo\"";
-         ok [(String "foo\"x")]  "\"foo\\\"x\"";
-         ok [(String "foo\"")]   "\"foo\\\"\"");
+         ok [String_ (node "")]        "\"\"";
+         ok [String_ (node "foo")]     "\"foo\"";
+         ok [String_ (node "foo\"x")]  "\"foo\\\"x\"";
+         ok [String_ (node "foo\"")]   "\"foo\\\"\"");
      "symbol" >::
        (fun () ->
-         ok [(String "foo")]  "\"foo\"";
-         ok [(String "+")]    "\"+\"";
-         ok [(Symbol ".")]    ".");
+         ok [String_ (node "foo")]  "\"foo\"";
+         ok [String_ (node "+")]    "\"+\"";
+         ok [Symbol_ (node ".")]    ".");
      "+" >::
        (fun () ->
-         ok [List [Symbol "+";Int 1; Int 2]] "(+ 1 2)");
+         ok [List_ (node [Symbol_ (node "+");
+                          Int_ (node 1);
+                          Int_ (node 2)])] "(+ 1 2)");
      "call" >::
        (fun () ->
-         ok [List [Symbol "print";String "hello"]] "(print \"hello\")");
+         ok [List_ (node [Symbol_ (node "print");
+                          String_ (node "hello")])] "(print \"hello\")");
      "bracket" >::
        (fun () ->
-         ok [List [Symbol "print";String "hello"]] "[print \"hello\"]");
+         ok [List_ (node [Symbol_ (node "print");
+                          String_ (node "hello")])] "[print \"hello\"]");
      "quote" >::
        (fun () ->
-         ok [List [Symbol "quote";Symbol "hello"]] "(quote hello)";
-         ok [List [Symbol "quote";Symbol "hello"]] "'hello")
+         ok [List_ (node [Symbol_ (node "quote");
+                          Symbol_ (node "hello")])] "(quote hello)";
+         ok [List_ (node [Symbol_ (node "quote");
+                          Symbol_ (node "hello")])] "'hello")
    ]) +> run_test_tt