You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 

107 lines
2.9 KiB

include import "./lang.ml"
include import "./lexer.ml"
open import "prelude.ml"
let parse = lex
let laid_out_block p = between obrace cbrace (sep_end_by_1 semi p)
let rec atom : forall 'm. monad 'm => parser_t 'm expr =
map Ref (try varid)
<|> map Ref (try conid)
<|> map Lit (try integer)
<+> between (try oparen) cparen expr
and fexp : forall 'm. monad 'm => parser_t 'm expr =
let! a = atom
let! ats = many atom
pure (foldl (curry App) a ats)
and expr : forall 'm. monad 'm => parser_t 'm expr =
let lam =
let! _ = back
let! vs = many (try varid)
let! _ = arrow
let! b = expr
pure (foldr ((Lam #) # curry id) b vs)
let case =
let! _ = keyword "case"
let! e = fexp
let! _ = keyword "of"
let! arms =
laid_out_block (
let! c = conid
let! vs = many (try varid)
let! _ = arrow
let! e = expr
pure (c, vs, e)
)
pure (Case (e, arms))
let hslet =
let binding =
let! c = varid
let! vs = many (try varid)
let! _ = equals
let! e = expr
pure (c, foldr ((Lam #) # curry id) e vs)
let! _ = keyword "let"
let! bs = laid_out_block binding
let! _ = keyword "in"
let! b = expr
pure (Let (bs, b))
try lam <|> try case <|> try hslet <+> fexp
let rec ty_atom : forall 'm. monad 'm => parser_t 'm hstype =
map Tyvar (try varid)
<|> map Tycon (try conid)
<+> between (try oparen) cparen ty_tup
and ty_fexp : forall 'm. monad 'm => parser_t 'm hstype =
let! a = ty_atom
let! ats = many ty_atom
pure (foldl (curry Tyapp) a ats)
and ty_exp : forall 'm. monad 'm => parser_t 'm hstype =
chainr1 ty_fexp (map (const (curry Tyarr)) arrow)
and ty_tup : forall 'm. monad 'm => parser_t 'm hstype =
let tytup = function
| [x] -> x
| x -> Tytup x
tytup <$> sep_by comma ty_exp
let datadec : forall 'm. monad 'm => parser_t 'm decl =
let! _ = try (keyword "data")
let datacon =
let! nm = conid
let! args = many ty_atom
pure (Constr (nm, args))
let! nm = conid
let! args = many (try varid)
let! cs = optionally (
let! _ = equals
sep_by_1 pipe (try datacon)
)
pure (Data (nm, args, match cs with | Some cs -> cs | None -> []))
let fdecl : forall 'm. monad 'm => parser_t 'm fdecl =
let! _ = try (keyword "import")
let! cc =
( (Lua <$ try (keyword "lua"))
<|> (Prim <$ try (keyword "prim"))
)
let! fent = string
let! var = varid
let! _ = dcolon
let! ftype = ty_exp
pure (Fimport { cc, fent, var, ftype })
let func : forall 'm. monad 'm => parser_t 'm decl =
let! nm = varid
let! args = many (try varid)
let! _ = equals
map (fun e -> Decl (nm, args, e)) expr
let dec : forall 'm. monad 'm => parser_t 'm decl =
let foreign =
let! _ = try (keyword "foreign")
map Foreign fdecl
try datadec <|> try foreign <|> func
let prog : forall 'm. monad 'm => parser_t 'm prog =
sep_end_by_1 semi dec <* eof