[WORKING]adding node-support to lexer

diff --git a/src/lexer.ml b/src/lexer.ml
index 4efa1aa..e46c7f4 100644 (file)
--- a/src/lexer.ml
+++ b/src/lexer.ml
@@ -1,19 +1,38 @@
 open Base
 open Parsec
 
+let kwd =
+  Node.lift (fun x -> Genlex.Kwd x)
+
+let ident =
+  Node.lift (fun x -> Genlex.Ident x)
+
 let parse_keyword keywords stream = 
   let parse = 
     HList.fold_left1 (<|>) @@ List.map string keywords in
     Genlex.Kwd (ExtString.String.implode @@ parse stream)
 
+let keyword keywords stream = 
+  let parse = 
+    HList.fold_left1 (<|>) @@ List.map NodeS.string keywords in
+    kwd (Node.lift ExtString.String.implode @@ parse stream)
+
 let parse_comment start stream =
   ignore @@ string start stream;
   ignore @@ until '\n' stream;
   Stream.junk stream
 
+let comment start stream =
+  ignore @@ NodeS.string start stream;
+  ignore @@ untilBy (fun {Node.value=c} -> c = '\n') stream;
+  Stream.junk stream
+
 let parse_space =
   ignore $ one_of " \t\n\r"
 
+let space =
+  ignore $ NodeS.one_of " \t\n\r"
+
 let parse_ident head tail =
   let head = 
     alpha <|> one_of head in
@@ -23,6 +42,30 @@ let parse_ident head tail =
        [< x = head; xs = many tail>] ->
          Genlex.Ident (ExtString.String.implode @@ x::xs)
 
+let p_ident head tail =
+  let head = 
+    NodeS.alpha <|> NodeS.one_of head in
+  let tail = 
+    head <|> NodeS.digit <|> NodeS.one_of tail in
+    parser 
+       [< x = head; xs = many tail>] ->
+         ident @@ Node.concat ExtString.String.implode @@ x::xs
+
+let p_char = 
+  let escaped = 
+    List.map (fun c -> ((Char.escaped c).[1],c)) ['\n'; '\t'] in
+  parser [<'c; stream >] ->
+    if c.Node.value = '\\' then
+      let {Node.value = x} as node = 
+       Stream.next stream in
+       try
+         {node with
+            Node.value = List.assoc x escaped}
+       with Not_found ->
+         node
+    else
+      c
+
 let parse_char = 
   let escaped = 
     List.map (fun c -> ((Char.escaped c).[1],c)) ['\n'; '\t'] in
@@ -37,6 +80,7 @@ let parse_char =
     else
       c
 
+
 let string_content stream = 
   match Stream.peek stream with
       Some '"' ->
@@ -114,11 +158,11 @@ let scheme = {
 
 let test f s =
   let stream =
-    Stream.of_string s in
+    Node.of_string s in
   let result =
     try
       Some (f stream) 
     with _ ->
       None in
-    Stream.dump (print_char) stream;
+    Stream.iter (fun {Node.value=v} -> print_char v) stream;
     result

diff --git a/src/node.ml b/src/node.ml
index 6d2f848..aa2b5b7 100644 (file)
--- a/src/node.ml
+++ b/src/node.ml
@@ -53,4 +53,16 @@ let value {value=v} =
 let empty a =
   {value=a; filename="<empty>"; lineno=(-1)}
 
+let lift f ({value=x} as node) =
+  {node with
+     value = f x}
+
+
+let concat f =
+  function
+      (x::_) as xs ->
+       {x with
+          value = f @@ List.map value xs}
+    | [] ->
+       invalid_arg "Node.concat"
 

diff --git a/src/node.mli b/src/node.mli
index 24135b8..5658665 100644 (file)
--- a/src/node.mli
+++ b/src/node.mli
@@ -11,4 +11,5 @@ val of_channel : string -> in_channel -> char t Stream.t
 val empty : 'a -> 'a t
 val value : 'a t -> 'a
 
-
+val lift : ('a -> 'b) -> 'a t -> 'b t
+val concat : ('a list -> 'b) -> 'a t list -> 'b t

diff --git a/src/parsec.ml b/src/parsec.ml
index 492ffb3..a8b7a8e 100644 (file)
--- a/src/parsec.ml
+++ b/src/parsec.ml
@@ -29,6 +29,14 @@ let rec until c stream =
     | _ ->
        []
 
+let rec untilBy f stream =
+  match Stream.peek stream with
+      Some x when not (f x) ->
+       Stream.junk stream;
+       x::(untilBy f stream)
+    | _ ->
+       []
+
 let option f stream =
   try
     Some (f stream)
@@ -122,7 +130,7 @@ module Parser(S : STREAM) = struct
          fail ()
 end
 
-module Char = Parser(
+module CharS = Parser(
   struct
     type t = char
     type s = char list
@@ -133,17 +141,16 @@ module Char = Parser(
     let shrink = id
   end)
 
-module N = Node
-module Node = Parser(
+module NodeS = Parser(
   struct
-    type t = char N.t
-    type s = char list N.t
+    type t = char Node.t
+    type s = char list Node.t
        
     let npeek n stream = 
-      List.map N.value @@ Stream.npeek n stream
+      List.map Node.value @@ Stream.npeek n stream
 
     let peek  stream = 
-      sure N.value @@ Stream.peek stream
+      sure Node.value @@ Stream.peek stream
     let junk  = 
       Stream.junk
     let next  = 
@@ -152,23 +159,23 @@ module Node = Parser(
     let shrink =
       function
          (x::_) as xs ->
-           {x with N.value = List.map N.value xs}
+           {x with Node.value = List.map Node.value xs}
        | [] ->
            fail ()
   end)
 
 (* obsolute *)
 let string =
-  Char.string 
+  CharS.string 
 
 let one_of =
-  Char.one_of
+  CharS.one_of
 
 let alpha =
-  Char.alpha
+  CharS.alpha
 
 let digit =
-  Char.digit
+  CharS.digit
 
 
 

diff --git a/src/parsec.mli b/src/parsec.mli
index 8411e6c..417945a 100644 (file)
--- a/src/parsec.mli
+++ b/src/parsec.mli
@@ -8,6 +8,7 @@ val option : ('a -> 'b) -> 'a -> 'b option
 val many : ('a Stream.t -> 'b) -> 'a Stream.t -> 'b list
 val many1 : ('a Stream.t -> 'b) -> 'a Stream.t -> 'b list
 val until : 'a -> 'a Stream.t -> 'a list
+val untilBy : ('a -> bool) -> 'a Stream.t -> 'a list
 val char : 'a -> 'a Stream.t -> 'a
 
 val string : string -> char Stream.t -> char list
@@ -15,3 +16,18 @@ val one_of : string -> char Stream.t -> char
 val alpha : char Stream.t -> char
 val digit : char Stream.t -> char
 
+module CharS :
+  sig
+    val string : string -> char Stream.t -> char list
+    val one_of : string -> char Stream.t -> char
+    val alpha : char Stream.t -> char
+    val digit : char Stream.t -> char
+  end
+
+module NodeS :
+  sig
+    val string : string -> char Node.t Stream.t -> char list Node.t
+    val one_of : string -> char Node.t Stream.t -> char Node.t
+    val alpha : char Node.t Stream.t -> char Node.t
+    val digit : char Node.t Stream.t -> char Node.t
+  end