Source

olfend / parsing / parser.ml

open Spotlib.Spot
open Planck

module Stream = Stoken.Make(Token)(Position.Region)(Pfile.Parser)

let token_stream : Pfile.Stream.t -> Stream.t = Stream.create 
  Planck.Pfile.Parser.(perform
    (v, pos) <-- Lex.ocaml_token;
    match v with
    | Token.EOF -> return (None, pos)
    | _ -> return (Some v, pos))

module Parser = struct
  include Ptoken.Make(Stream)
  let with_region x = with_region Position.Region.merge x
end

open Olf
open Olf.Expr

open Token
open Parser

let constant = 
  token_option (function 
    | INT n -> Some (Const (Const.Int n))
    | STRING s -> Some (Const (Const.String s))
    | _ -> None)

(* CR jfuruse: it is silly to create a function for each ... *)
let uident : string t = token_option (function UIDENT s -> Some s | _ -> None)
let lident : string t = token_option (function LIDENT s -> Some s | _ -> None) 
let in_parens : 'a t -> 'a t = fun x -> surrounded (token LPAREN) (token RPAREN) x

let patt : pattern t = lident >>= fun s -> return & PVar s

let path : Rawname.Path.t t = fun x -> begin 
  let open Rawname in 
  perform
    uids <-- ?** (perform uid <-- uident; token DOT; return uid);
    lid <-- lident;
    let rec make_path = function
      | [] -> assert false
      | [x] -> Path.Ident x
      | x::xs -> Path.Dot (make_path xs, x)
    in
    return (make_path (lid :: List.rev uids))
end x

let op = 
  let open Rawname in
  tokenp (function 
    | INFIXOP0 s
    | INFIXOP1 s
    | INFIXOP2 s
    | INFIXOP3 s
    | INFIXOP4 s
    | PREFIXOP s -> Some (Path.Ident s)
    | _ -> None)

let rec simple_expr x = begin

  constant 

  <|> (path >>= fun p -> return & Var p)

  <|> (in_parens expr)

end x

and application x = begin perform
    es <-- ?++ ( (op >>= return & `Op p) <|> (simple_expr >>= return & `Ex e) );
    return & App es
end x

and fun_ x = begin perform
  token FUN;
  ps <-- ?++ patt;
  token MINUSGREATER;
  e <-- expr;
  return & Abs (ps, e)
end x

and expr x = begin

  fun_
  <|> application
  <!> simple_expr

end x
  
let top_let = perform
  token LET;
  p <-- patt;
  token EQUAL;
  e <-- expr;
  return & Top.Let (p,e)

let top = top_let

let file = ?** top