Commits

Anonymous committed 3416b61

lexer and parser

Comments (0)

Files changed (5)

+  
+{
+(*  open Term        (* The type token is defined in parser.mli *)*)
+  type t = LAMBDA | DOT | Ident of string | OPEN | CLOSE
+| INT of int | EOL
+  exception Eof
+}
+
+let digit = ['0'-'9']
+let alpha = ['A'-'Z' 'a'-'z' '_']
+
+rule token = parse
+  [' ' '\t']     { token lexbuf }     (* skip blanks *)
+| ['\n' ]        { EOL }
+| "lambda"       { LAMBDA }
+| '\\'            { LAMBDA }
+| '.'            { DOT }
+| '('            { OPEN }
+| ')'            { CLOSE }
+| alpha (digit|alpha)*
+    { Ident (Lexing.lexeme lexbuf) }
+| ['0'-'9']+     { INT(int_of_string(Lexing.lexeme lexbuf)) }
+| eof            { raise Eof }
+
+(**
+  $ ocamllex lexer.mll
+  $ ocamlc lexer.ml main.ml
+**)
+
+open Lexer
+
+let stoken = function
+  | LAMBDA -> "LAMBDA"
+  | DOT -> "DOT"
+  | Ident s -> "var:" ^ s
+  | OPEN -> "OPEN"
+  | CLOSE -> "CLOSE"
+  | INT i -> "int:" ^ string_of_int i
+  | EOL -> "EOL"
+
+let _ =
+  try
+    let lexbuf = Lexing.from_channel stdin in
+    while true do
+      let t =  Lexer.token lexbuf in
+      prerr_endline (stoken t);
+      flush stderr;
+    done
+  with
+  | Lexer.Eof ->
+      prerr_endline "eof"; exit 0
+  | e -> prerr_endline ( "ERRR: " ^ Printexc.to_string e)
+(*
+type term =
+  | Var of var
+  | Abs of var * term
+  | App of term * term
+*)
+
+type token =
+  | Ident of string
+  | Lambda
+  | Dot
+  | Open
+  | Close
+
+(*open Lexer*)
+open ParserUtil
+open Term
+
+type 'a parser = ('a, token list) ParserUtil.parser
+
+let ident : var parser = function
+  | Ident s :: ts -> Inl (s, ts)
+  | _  -> Inr "ident"
+
+let token t : token parser = function
+  | t' :: ts when t = t' -> Inl (t, ts)
+  | _ -> Inr "token"
+
+let rec term1 () : term parser =
+    ident >>= fun s -> return (Var s)
+	<|> (token Lambda >> ident >>= fun s -> token Dot >> term1() >>= fun t -> return (Abs (s, t)))
+
+and term_app t1 : term parser =
+    term1() >>= fun t -> term_app (App (t1, t))
+type ('l, 'r) either = Inl of 'l | Inr of 'r
+type error_msg = string
+type ('a, 'ts) parser = 'ts -> ('a * 'ts, error_msg) either
+
+let (<|>) : ('a, 'ts) parser -> ('a, 'ts) parser -> ('a, 'ts) parser =
+    fun p1 p2 ->
+      fun code ->
+	match p1 code, p2 code with
+	| Inl (x1, ts), _ -> Inl (x1, ts)
+	| _, Inl (x2, ts) -> Inl (x2, ts)
+	| Inr (msg1), Inr (msg2) -> Inr (msg1 ^ " <|> " ^ msg2)
+	      
+let (>>=) : ('a, 'ts) parser -> ('a -> ('b, 'ts) parser) -> ('b, 'ts) parser = 
+    fun p f ->
+      fun code ->
+	match p code with
+	| Inl (x, ts) -> f x ts
+	| Inr msg -> Inr msg
+
+let (>>) : ('a, 'ts) parser -> ('b, 'ts) parser -> ('b, 'ts) parser =
+    fun p1 p2 ->
+      p1 >>= fun _ -> p2
+
+let return : 'a -> ('a, 'ts) parser =
+    fun x ->
+      fun code -> Inl (x, code)
+
+let many p =
+  let rec local store code = match p code with
+    | Inl (x, ts) -> local (x::store) ts
+    | Inr _ -> List.rev store, code
+  in
+  fun code -> Inl (local [] code)
+
+let opt p = fun code -> match p code with
+  | Inl (x, ts) -> Inl (Some x, ts)
+  | Inr _ ->  Inl (None, code)
+
+
+type var = string
+
+type term =
+  | Var of var
+  | Abs of var * term
+  | App of term * term