Stream.iter (fun {Node.value=v} -> print_char v) stream;
result,stream
-type token = Genlex.token Node.t
+type token = Token.t
type 'a lexer = char Node.t Stream.t -> 'a
-type lang = { string: token lexer;
- number: token lexer;
- keyword: token lexer;
- ident: token lexer;
+type lang = { string: Token.t lexer;
+ number: Token.t lexer;
+ keyword: Token.t lexer;
+ ident: Token.t lexer;
comment: unit lexer;
- bool: token lexer;
+ bool: Token.t lexer;
}
let lexer {string = string;
-type token = Genlex.token Node.t
type 'a lexer = char Node.t Stream.t -> 'a
type lang = {
- string : token lexer;
- number : token lexer;
- keyword : token lexer;
- ident : token lexer;
+ string : Token.t lexer;
+ number : Token.t lexer;
+ keyword : Token.t lexer;
+ ident : Token.t lexer;
comment : unit lexer;
- bool : token lexer;
+ bool : Token.t lexer;
}
val scheme : lang
-val lexer : lang -> char Node.t Stream.t -> token Stream.t
+val lexer : lang -> char Node.t Stream.t -> Token.t Stream.t
| List n ->
{n with Node.value = s}
-let parse stream =
+let parse xs =
let stream' =
- Stream.of_list @@ Sexp.of_stream stream in
- many (syntax_error (stmt <?> "malformed syntax") (loc "")) stream'
-
-
-let parse_string string =
- parse @@ Node.of_string string
-
+ Stream.of_list xs in
+ many (syntax_error (stmt <?> "malformed syntax") (loc "")) stream'
-val parse : char Node.t Stream.t -> Ast.program
-val parse_string : string -> Ast.program
+val parse : Sexp.t list -> Ast.program
+
open Base
let parse _ stream =
stream
+ +> Lexer.lexer Lexer.scheme
+ +> Sexp.of_stream
+> Lisp.parse
let parse_string _ string =
string
- +> Lisp.parse_string
+ +> Node.of_string
+ +> parse
let kwd s =
node (Genlex.Kwd s)
-let rec to_string =
- function
- 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
[<'{value = Genlex.String s} as node>] ->
List {node with value = c; end_pos = pos}
let of_stream stream =
- Parsec.many (Parsec.syntax_error read id) @@
- Lexer.lexer Lexer.scheme stream
-
-let of_string string =
- of_stream @@ Node.of_string string
+ Parsec.many (Parsec.syntax_error read id) stream
| 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
+val of_stream : Token.t Stream.t -> t list
+
--- /dev/null
+type t = Genlex.token Node.t
--- /dev/null
+type t = Genlex.token Node.t
OUNIT_SRC_DIR=$(SRC)/parser/
OUnitTest(lexer ,lexer parsec)
-OUnitTest(sexp ,sexp lexer parsec)
+OUnitTest(sexp ,sexp parsec)
OUnitTest(lisp ,lisp sexp parsec lexer)
Some (Node.ghost @@ Node.value @@ Stream.next stream)
with Stream.Failure ->
None) in
- Lisp.parse stream'
+ Lisp.parse @@ Sexp.of_stream @@ Lexer.lexer Lexer.scheme stream'
let ok ?msg x y =
OUnit.assert_equal ?msg
let pos_ok x y =
OUnit.assert_equal
- x @@ Lisp.parse_string y
+ x @@ Lisp.parse @@ Sexp.of_stream @@ Lexer.lexer Lexer.scheme @@ Node.of_string y
let sugar x y =
OUnit.assert_equal (parse_string x) (parse_string y)
"syntax error" >::
(fun () ->
syntax_error (fun () ->
- Lisp.parse_string "(if a)");
+ parse_string "(if a)");
syntax_error (fun () ->
- Lisp.parse_string "(if a b c d)"))
+ parse_string "(if a b c d)"))
]) +> run_test_tt
start_pos = a;
end_pos = b}
-let rec eq lhs rhs =
- match lhs,rhs with
- Int {value=x}, Int {value=y} ->
- x = y
- | String {value=x}, String {value=y} ->
- x = y
- | Float {value=x}, Float {value=y} ->
- x = y
- | Bool {value=x}, Bool {value=y} ->
- x = y
- | Symbol {value=x}, Symbol {value=y} ->
- x = y
- | List {value=x}, List {value=y} ->
- List.for_all2 eq x y
- | _ ->
- false
+let of_tokens tokens =
+ Sexp.of_stream @@ Stream.of_list tokens
-let ok sexp str =
+let ok sexp tokens =
let sexp' =
- of_string str in
+ of_tokens tokens in
OUnit.assert_equal
- ~cmp:(fun a b -> List.for_all2 eq a b)
- ~printer:(String.concat ";\n" $ List.map Sexp.to_string)
sexp
sexp'
+let node x =
+ pos x 1 2 3
+
let int n =
- Int (Node.ghost n)
+ Int (node n)
let string s =
- String (Node.ghost s)
+ String (node s)
let bool b =
- Bool (Node.ghost b)
+ Bool (node b)
let float f =
- Float (Node.ghost f)
+ Float (node f)
let symbol s =
- Symbol (Node.ghost s)
+ Symbol (node s)
let list l =
- List (Node.ghost l)
+ List (node l)
+
+let t_int n =
+ node (Genlex.Int n)
+
+let t_float n =
+ node (Genlex.Float n)
+
+let t_str str =
+ node (Genlex.String str)
+
+let t_char c =
+ node (Genlex.String c)
+
+let t_ident s =
+ node (Genlex.Ident s)
+
+let t_kwd s =
+ node (Genlex.Kwd s)
let _ =
- ("S expression module test" >::: [
+ ("sexp.ml" >::: [
"pos" >::
(fun () ->
assert_equal
- ~printer:(String.concat ";\n" $ List.map Sexp.to_string)
- [Int (pos 42 0 0 2);
- String (pos "str" 1 0 5);
- Float (pos 42.0 2 0 4);
- Bool (pos true 3 0 2);
- Bool (pos false 3 3 5);
- Symbol (pos "hoge" 4 0 4);
- List (pos [Symbol (pos "a" 5 1 2);
+ [List (pos [Symbol (pos "a" 5 1 2);
Symbol (pos "b" 5 3 4);
Symbol (pos "c" 5 5 6)] 5 0 7)] @@
- of_string "42
-\"str\"
-42.0
-#t #f
-hoge
-(a b c)");
+ of_tokens [
+ pos (Genlex.Kwd "(") 5 0 1;
+ pos (Genlex.Ident "a") 5 1 2;
+ pos (Genlex.Ident "b") 5 3 4;
+ pos (Genlex.Ident "c") 5 5 6;
+ pos (Genlex.Kwd ")") 5 6 7;
+ ]);
"empty" >::
(fun () ->
- ok [] "";
- ok [] "; foo bar");
+ ok [] []);
"int" >::
(fun () ->
- ok [int 42] "42";
- ok [int ~-42] "-42");
+ ok [int 42] [t_int 42];
+ ok [int ~-42] [t_int (~-42)]);
"bool" >::
(fun () ->
- ok [bool true] "#t";
- ok [bool false] "#f");
+ ok [bool true] [t_kwd "true"];
+ ok [bool false] [t_kwd "false"]);
"float" >::
(fun () ->
- ok [float 42.] "42.";
- ok [float 42.5] "42.5");
+ ok [float 42.1] [t_float (42.1)]);
"string" >::
(fun () ->
- ok [string ""] "\"\"";
- ok [string "foo"] "\"foo\"";
- ok [string "foo\"x"] "\"foo\\\"x\"";
- ok [string "foo\""] "\"foo\\\"\"");
+ ok [string ""] [t_str ""];
+ ok [string "foo"] [t_str "foo"];
+ ok [string "foo\"x"] [t_str "foo\"x"];
+ ok [string "foo\""] [t_str "foo\""]);
"symbol" >::
(fun () ->
- ok [string "foo"] "\"foo\"";
- ok [string "+"] "\"+\"";
- ok [symbol "."] ".");
- "+" >::
- (fun () ->
- ok [list [symbol "+"; int 1; int 2]]
- "(+ 1 2)");
+ ok [symbol "."] [t_ident "."]);
"call" >::
(fun () ->
+ ok [list [symbol "+"; int 1; int 2]]
+ [t_kwd "(";
+ t_ident "+"; t_int 1; t_int 2;
+ t_kwd ")"];
ok [list [symbol "print"; string "hello"]]
- "(print \"hello\")");
+ [t_kwd "(";
+ t_ident "print"; t_str "hello";
+ t_kwd ")"]);
"bracket" >::
(fun () ->
ok [list [symbol "print"; string "hello"]]
- "[print \"hello\"]");
+ [t_kwd "[";
+ t_ident "print"; t_str "hello";
+ t_kwd "]"]);
"quote" >::
(fun () ->
ok [list [symbol "quote"; symbol "hello"]]
- "(quote hello)";
+ [t_kwd "(";
+ t_ident "quote"; t_ident "hello";
+ t_kwd ")"];
ok [list [symbol "quote"; symbol "hello"]]
- "'hello")
+ [t_kwd "'"; t_ident "hello"])
]) +> run_test_tt
-
OSDN Git Service
