suuport 'hoge

diff --git a/src/sexp.ml b/src/sexp.ml
new file mode 100644 (file)
index 0000000..668ec25
--- /dev/null
+++ b/src/sexp.ml
@@ -0,0 +1,47 @@
+(* lisp parser *)
+open Base
+type lisp = 
+    Int    of int 
+  | String of string 
+  | Float  of float 
+  | Bool   of bool 
+  | Symbol of string 
+  | List   of lisp list
+
+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
+
+let rec read =
+  parser
+      [<'Genlex.String s >] -> String s
+    | [<'Genlex.Ident name >] -> Symbol name
+    | [<'Genlex.Int n >] -> Int n
+    | [<'Genlex.Float x>] -> Float x
+    | [<'Genlex.Kwd "true" >] -> Bool true
+    | [<'Genlex.Kwd "false" >] -> Bool false
+    | [<'Genlex.Kwd "("; c = Parsec.many read; 'Genlex.Kwd ")" >] -> List c
+    | [<'Genlex.Kwd "["; c = Parsec.many read; 'Genlex.Kwd "]" >] -> List c
+    | [<'Genlex.Kwd "'"; c = Parsec.many read >] -> List (Symbol "quote"::c)
+
+let lexer =
+  Lexer.make_lexer Lexer.scheme
+
+let parse stream =
+  Parsec.many read @@ lexer stream
+
+let parse_string string =
+  parse @@ Stream.of_string string

diff --git a/src/sexp.mli b/src/sexp.mli
new file mode 100644 (file)
index 0000000..31587a6
--- /dev/null
+++ b/src/sexp.mli
@@ -0,0 +1,7 @@
+(** S-expression parsing. *)
+
+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

diff --git a/test/test_sexp.ml b/test/test_sexp.ml
new file mode 100644 (file)
index 0000000..d85bc71
--- /dev/null
+++ b/test/test_sexp.ml
@@ -0,0 +1,49 @@
+open Base
+open Sexp
+
+let assert_equal sexp str =
+  let sexp' =
+    parse_string str in
+    OUnit.assert_equal 
+      ~printer:(String.concat ";\n" $ List.map Sexp.to_string) 
+      sexp 
+      sexp'
+  
+test empty =
+    assert_equal [] "";
+    assert_equal [] "; foo bar"
+
+test int =
+    assert_equal [(Int 42)] "42";
+    assert_equal [(Int ~-42)] "-42"
+
+test bool =
+    assert_equal [(Bool true)]  "#t";
+    assert_equal [(Bool false)] "#f"
+
+test float =
+    assert_equal [(Float 42.)] "42."
+
+test string =
+    assert_equal [(String "")]        "\"\"";
+    assert_equal [(String "foo")]     "\"foo\"";
+    assert_equal [(String "foo\"x")]  "\"foo\\\"x\"";
+    assert_equal [(String "foo\"")]   "\"foo\\\"\"";
+
+test symbol =
+    assert_equal [(String "foo")]  "\"foo\"";
+    assert_equal [(String "+")]    "\"+\""
+
+test add =
+    assert_equal [List [Symbol "+";Int 1; Int 2]] "(+ 1 2)"
+
+test list =
+    assert_equal [List [Symbol "print";String "hello"]] "(print \"hello\")"
+
+test bracket_list =
+    assert_equal [List [Symbol "print";String "hello"]] "[print \"hello\"]"
+
+test quote =
+    assert_equal [List [Symbol "quote";Symbol "hello"]] "(quote hello)";
+    assert_equal [List [Symbol "quote";Symbol "hello"]] "'hello";
+