inferno-experimental/client/MLParser.mly

228 lines
5.6 KiB
OCaml

%{
open ML
%}
%token <string> LIDENT
%token <string> UIDENT
%token <string> QIDENT
%token FUN
%token ARROW "->"
%token LET IN
%token EQ "="
%token LPAR "("
%token RPAR ")"
%token TYPE
%token OF
%token LBRACE "{"
%token RBRACE "}"
%token STAR "*"
%token DOTS "..."
%token LBRACKET "["
%token RBRACKET "]"
%token COMMA
%token WILDCARD
%token PIPE
%token MATCH WITH END
%token COLON ":"
%token PERIOD "."
%token SOME
%token FOR
%token USE "#use"
%token <string> FILENAME
%token EOF
%type<(string list * ML.datatype_env * (string * ML.term) list)> prog
%type<ML.term> self_contained_term
%type<ML.datatype_env> self_contained_type_decls
%start prog self_contained_term self_contained_type_decls
%%
let prog :=
| filenames = use_directives ;
datatype_env = type_decls ;
xts = nonempty_list (toplevel_term_decl) ; EOF ;
{ (filenames, datatype_env, xts) }
let self_contained_term :=
| ~ = term ; EOF ; <>
let self_contained_type_decls :=
| ~ = type_decls ; EOF ; <>
(***************** TERMS ***************)
let toplevel_term_decl :=
| LET ; x = tevar_ ; "=" ; t = term ; { (x, t) }
let term :=
| ~ = term_abs ; <>
let term_abs :=
| FUN ; xs = list (tevar_) ; "->" ; t = term_abs ;
{
List.fold_right (fun x t -> Abs ($loc, x, t)) xs t
}
| (x, t1, t2) = letin(tevar) ; { Let ($loc, x, t1, t2) }
| (xs, t1, t2) = letin(tuple(tevar)) ; { LetProd ($loc, xs, t1, t2) }
| ~ = term_app ; <>
let term_app :=
| t1 = term_app ; t2 = term_atom ;
{
match t1 with
| Variant ((start_pos, _), l, None) ->
Variant ((start_pos, $endpos), l, Some t2)
| _ ->
App ($loc, t1, t2)
}
| ~ = term_atom ; <>
let term_atom :=
| x = tevar ; { Var ($loc, x) }
| l = UIDENT ; { Variant ($loc, Datatype.Label l, None) }
| ts = tuple (term) ; { Tuple ($loc, ts) }
| MATCH ; t = term ; WITH ;
brs = branches ;
END ; { Match ($loc, t, brs) }
| "..."; "["; ts = item_sequence(term, COMMA); "]";
{ Hole ($loc, ts) }
| "(" ; t = term ; ":" ; tyannot = type_annotation ; ")" ;
{ Annot ($loc, t, tyannot) }
| "(" ; ~ = term ; ")" ; <>
let branches :=
| ~ = pipe_separated_list (branch) ; <>
let branch :=
| pat = pattern ; "->" ; t = term ; { (pat, t) }
let pattern :=
| l = UIDENT ; pat = pattern_atom ; { PVariant ($loc, Datatype.Label l, Some pat) }
| ~ = pattern_atom ; <>
let pattern_atom :=
| x = tevar ; { PVar ($loc, x) }
| l = UIDENT; { PVariant ($loc, Datatype.Label l, None) }
| WILDCARD ; { PWildcard $loc }
| ps = tuple (pattern) ; { PTuple ($loc, ps) }
| "(" ; p = pattern ; ":" ; tyannot = type_annotation ; ")" ;
{ PAnnot ($loc, p, tyannot) }
let tevar :=
| ~ = LIDENT ; <>
let tevar_ :=
| ~ = LIDENT ; <>
| WILDCARD ; { "_" }
(*************** TYPES ***************)
let typ :=
| ~ = type_arrow ; <>
let type_arrow :=
| ty1 = type_tyconstr ; "->" ; ty2 = type_arrow ;
{ TyArrow ($loc, ty1, ty2) }
| ~ = type_tyconstr ; <>
let type_tyconstr :=
| ~ = tyname ; typarams = list (type_atom) ;
{ TyConstr ($loc, tyname, typarams)}
| ~ = type_atom ; <>
let type_atom :=
| x = tyvar ; { TyVar ($loc, x) }
| "{" ; tys = separated_list ("*", typ) ; "}" ;
{ TyProduct ($loc, tys) }
| "(" ; ~ = typ ; ")" ; <>
let type_annotation :=
| ty = typ; { (Flexible, [], ty) }
| SOME ; xs = list(tyvar) ; "." ; ty = typ ;
{ (Flexible, xs, ty) }
| FOR ; xs = list(tyvar) ; "." ; ty = typ ;
{ (Rigid, xs, ty) }
let tyconstr_decl :=
| l = UIDENT ; arg_type = option (OF ; ~ = typ ; <>) ;
{ (Datatype.Label l, arg_type) }
let type_decls :=
| decls = list (type_decl) ;
{ List.fold_left Datatype.Env.add_decl Datatype.Env.empty decls }
let type_decl :=
| TYPE ; ~ = tyname ; type_params = list (tyvar) ; "=" ;
arg_types = pipe_separated_list (tyconstr_decl) ;
{
let name = tyname in
let data_kind = Datatype.Variant in
let labels_descr = List.map (fun (label_name, arg_type) ->
Datatype.{ label_name ; type_name = name ; arg_type } )
arg_types
in
Datatype.{ name ; type_params ; data_kind ; labels_descr }
}
let use_directives :=
| ~ = list (use_directive) ; <>
let use_directive :=
| "#use" ; filename = FILENAME ; { filename }
let tyname :=
| lid = LIDENT ; { Datatype.Type lid }
let tyvar :=
| ~ = QIDENT ; <>
let tuple (X) :=
| "(" ; ")" ; { [] }
(* note: the rule below enforces that one-element lists always
end with a trailing comma *)
| "(" ; x = X ; COMMA ; xs = item_sequence(X, COMMA) ; ")"; { x :: xs }
(* item sequence with optional trailing separator *)
let item_sequence(X, Sep) :=
| { [] }
| x = X ; { [x] }
| x = X ; () = Sep ; xs = item_sequence(X, Sep); { x :: xs }
let letin (X) :=
| LET ; x = X ; EQ ;
t1 = term ; IN ;
t2 = term_abs ; { (x, t1, t2) }
let pipe_separated_list (X) :=
| option (PIPE) ; ~ = separated_list (PIPE, X) ; <>