Stefan pushed to branch master at Stefan / Typer

Commits: 61f036c4 by Stefan Monnier at 2016-03-15T18:16:46-04:00 * src/lparse.ml (lexp_parse): Don't return a context

(lexp_parse_constructors, lexp_call): Same.

- - - - -

3 changed files:

- src/lexp.ml - src/lparse.ml - src/main.ml

Changes:

===================================== src/lexp.ml ===================================== --- a/src/lexp.ml +++ b/src/lexp.ml @@ -584,7 +584,6 @@ and lexp_unparse e : pexp = (* (internal_error "Can't print a Susp") *)

let lexp_print e = sexp_print (pexp_unparse (lexp_unparse e)) -<<<<<<< HEAD

(* let rec lexp_type (env: (lexp option * lexp) VMap.t) e : lexp = * let rec follow e =

===================================== src/lparse.ml ===================================== --- a/src/lparse.ml +++ b/src/lparse.ml @@ -20,11 +20,11 @@ * FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * - * You should have received a copy of the GNU General Public License along - * with this program. If not, see http://www.gnu.org/licenses/. + * You should have received a copy of the GNU General Public License along + * with this program. If not, see http://www.gnu.org/licenses/. * * --------------------------------------------------------------------------- - * + * * Description: * parse pexp expression into lexp * @@ -42,7 +42,7 @@ open Lexer open Prelexer

(* Shortcut => Create a Var *) -let make_var name index loc = +let make_var name index loc = Var(((loc, name), index)) ;;

@@ -56,7 +56,7 @@ let dloc = dummy_location

let lexp_warning = msg_warning "LEXP" let lexp_error = msg_error "LEXP" -let lexp_fatal loc msg = +let lexp_fatal loc msg = msg_error "LEXP" loc msg; raise (internal_error msg) ;; @@ -72,12 +72,12 @@ let pvar_to_vdef p = p;;

(* * The main job of lexp (currently) is to determine variable name (index) - * and to regroup type specification with their variable + * and to regroup type specification with their variable * * lexp_context is composed of two environment: senv and env. * the senv environment is used to find the correct debruijn index * while the env environment is used to save variable information. - * the env environment look a lot like the runtime environment that will be + * the env environment look a lot like the runtime environment that will be * used in the eval section. * * While most of the time senv and env will be synchronised it is @@ -88,131 +88,129 @@ let pvar_to_vdef p = p;; * let a = 3; b = 5 in a + b; * *) -

-let rec lexp_parse (p: pexp) (ctx: lexp_context): (lexp * lexp_context) = + +let rec lexp_parse (p: pexp) (ctx: lexp_context): lexp = (* So I don't have to extract it *) let tloc = pexp_location p in match p with (* Block/String/Integer/Float *) - | Pimm value -> Imm(value), ctx - + | Pimm value -> Imm(value) + (* Symbol i.e identifier *) - | Pvar (loc, name) -> begin - try + | Pvar (loc, name) -> + (try (* Send Variable loc *) let idx = senv_lookup name ctx in - (make_var name idx loc), ctx; - + make_var name idx loc; + with Not_found -> (lexp_error loc ("The Variable: " ^ name ^ " was not declared"); (* Error recovery. The -1 index will raise an error later on *) - (make_var name (-1) loc), ctx) end - + make_var name (-1) loc)) + (* Let, Variable declaration + local scope *) - | Plet(loc, decls, body) -> + | Plet(loc, decls, body) -> let decl, nctx = lexp_decls decls ctx in (* Body cannot modify context *) - let bdy, _ = lexp_parse body nctx in + let bdy = lexp_parse body nctx in (* Send back old context as we exit the inner scope *) - Let(tloc, decl, bdy), ctx - + Let(tloc, decl, bdy) + (* ->/=> *) | Parrow (kind, Some var, tp, loc, expr) -> let nvar = pvar_to_vdef var in (* /!\ HERE *) - let ltyp, ctx = lexp_parse tp ctx in - let lxp, ctx = lexp_parse expr ctx in - Arrow(kind, Some nvar, ltyp, tloc, lxp), ctx - + let ltyp = lexp_parse tp ctx in + let lxp = lexp_parse expr ctx in (* FIXME: add nvar to ctx! *) + Arrow(kind, Some nvar, ltyp, tloc, lxp) + | Parrow (kind, None, tp, loc, expr) -> - let ltyp, ctx = lexp_parse tp ctx in - let lxp, ctx = lexp_parse expr ctx in - Arrow(kind, None, ltyp, tloc, lxp), ctx - + let ltyp = lexp_parse tp ctx in + let lxp = lexp_parse expr ctx in + Arrow(kind, None, ltyp, tloc, lxp) + (* *) | Plambda (kind, var, Some ptype, body) -> (* Add argument to context *) let (loc, vname) = var in - let ltp, nctx = lexp_parse ptype ctx in (* Get Type *) - + let ltp = lexp_parse ptype ctx in (* Get Type *) + let nctx = senv_add_var vname loc ctx in let nctx = env_add_var_info (0, (loc, vname), dlxp, ltp) nctx in

- let lbody, _ = lexp_parse body nctx in - + let lbody = lexp_parse body nctx in + (* Return old context as we exit lambda scope*) - Lambda(kind, var, ltp, lbody), ctx - + Lambda(kind, var, ltp, lbody) + | Plambda (kind, var, None, body) -> let (loc, vname) = var in - + let nctx = senv_add_var vname loc ctx in let nctx = env_add_var_info (0, (loc, vname), dlxp, dltype) nctx in - - let lbody, _ = lexp_parse body nctx in - Lambda(kind, var, UnknownType(tloc), lbody), ctx - - | Pcall (fname, _args) -> - let r, c = lexp_call fname _args ctx in - r, ctx + + let lbody = lexp_parse body nctx in + Lambda(kind, var, UnknownType(tloc), lbody) + + | Pcall (fname, args) -> lexp_call fname args ctx

(* Pinductive *) | Pinductive (label, [], ctors) -> - let map_ctor, nctx = lexp_parse_constructors ctors ctx in - Inductive(tloc, label, [], map_ctor), nctx - + let map_ctor = lexp_parse_constructors ctors ctx in + Inductive(tloc, label, [], map_ctor) + (* Pcons *) | Pcons(vr, sym) -> ( let (loc, type_name) = vr in let (_, ctor_name) = sym in - + (* An inductive type named type_name must be in the environment *) try let idx = senv_lookup type_name ctx in (* Check if the constructor exists *) (* TODO *) - Cons((vr, idx), sym), ctx + Cons((vr, idx), sym) with Not_found -> - lexp_error loc + lexp_error loc ("The inductive type: " ^ type_name ^ " was not declared"); - Cons((vr, -1), sym), ctx) - + Cons((vr, -1), sym)) + (* Pcase *) | Pcase (loc, target, patterns) -> - + (* I need type info HERE *) - let lxp, nctx = lexp_parse target ctx in + let lxp = lexp_parse target ctx in let ltp = UnknownType(loc) in

(* Read patterns one by one *) let rec loop ptrns merged dflt = match ptrns with | [] -> merged, dflt - | hd::tl -> + | hd::tl -> let (pat, exp) = hd in (* Create pattern context *) - let (name, iloc, arg), nctx2 = - lexp_read_pattern pat exp lxp nctx in + let (name, iloc, arg), nctx2 = + lexp_read_pattern pat exp lxp ctx in (* parse using pattern context *) - let exp, _ = lexp_parse exp nctx2 in - + let exp = lexp_parse exp nctx2 in + if name = "_" then loop tl merged (Some exp) else let merged = SMap.add name (iloc, arg, exp) merged in loop tl merged dflt in - + let (lpattern, dflt) = loop patterns SMap.empty None in (* Exit case, send back old context *) - Case(loc, lxp, ltp, lpattern, dflt), ctx - - | _ - -> UnknownType(tloc), ctx - + Case(loc, lxp, ltp, lpattern, dflt) + + | _ + -> UnknownType(tloc) + (* Identify Call Type and return processed call *) and lexp_call (fname: pexp) (_args: sexp list) ctx = (* Process Arguments *) let pargs = List.map pexp_parse _args in - + (* Call to named function which must have been defined earlier * * i.e they must be in the context *) begin try begin @@ -221,52 +219,52 @@ and lexp_call (fname: pexp) (_args: sexp list) ctx = | Pvar(loc, nm) -> nm, loc | Pcons (_, (loc, nm)) -> nm, loc | _ -> raise Not_found in - - let largs, fctx = lexp_parse_all pargs ctx in + + let largs, fctx = lexp_parse_all pargs ctx in let new_args = List.map (fun g -> (Aexplicit, g)) largs in - + try (* Check if the function was defined *) let idx = senv_lookup name ctx in let vf = (make_var name idx loc) in - - Call(vf, new_args), ctx - + + Call(vf, new_args) + with Not_found -> (* Don't stop even if an error was found *) - lexp_error loc ("The function "" ^ name ^ + lexp_error loc ("The function "" ^ name ^ "" was not defined"); let vf = (make_var name (-1) loc) in - Call(vf, new_args), ctx end - + Call(vf, new_args) end + (* Call to a nameless function *) with Not_found -> - let largs, fctx = lexp_parse_all pargs ctx in + let largs, fctx = lexp_parse_all pargs ctx in let new_args = List.map (fun g -> (Aexplicit, g)) largs in (* I think this should not modify context. * if so, funny things might happen when evaluating *) - let fname, ctx = lexp_parse fname ctx in - Call(fname, new_args), ctx end + let fname = lexp_parse fname ctx in + Call(fname, new_args) end

-(* Read a pattern and create the equivalent representation *) -and lexp_read_pattern pattern exp target ctx: +(* Read a pattern and create the equivalent representation *) +and lexp_read_pattern pattern exp target ctx: ((string * location * (arg_kind * vdef) option list) * lexp_context) = - + match pattern with | Ppatany (loc) -> (* Catch all expression nothing to do *) - ("_", loc, []), ctx - + ("_", loc, []), ctx + | Ppatvar (loc, name) ->( (* FIXME better check *) try - let idx = senv_lookup name ctx in + let idx = senv_lookup name ctx in (* constructor with no args *) (name, loc, []), ctx - + (* would it not make a default match too? *) with Not_found -> (* Create a variable containing target *) - let nctx = senv_add_var name loc ctx in + let nctx = senv_add_var name loc ctx in let nctx = env_add_var_info (0, (loc, name), target, dltype) nctx in ("_", loc, []), nctx)

@@ -276,7 +274,7 @@ and lexp_read_pattern pattern exp target ctx: (* read pattern args *) let args, nctx = lexp_read_pattern_args args ctx in (name, loc, args), nctx - + (* Read patterns inside a constructor *) and lexp_read_pattern_args args ctx: (((arg_kind * vdef) option list) * lexp_context)= @@ -289,7 +287,7 @@ and lexp_read_pattern_args args ctx: match pat with (* Nothing to do *) | Ppatany (loc) -> loop tl (None::acc) ctx - | Ppatvar (loc, name) -> + | Ppatvar (loc, name) -> (* Add var *) let nctx = senv_add_var name loc ctx in let nctx = env_add_var_info (0, (loc, name), dlxp, dltype) nctx in @@ -299,12 +297,12 @@ and lexp_read_pattern_args args ctx: loop tl (None::acc) ctx)

in loop args [] ctx - + (* Parse inductive constructor *) and lexp_parse_constructors ctors ctx = - + let make_args (args:(arg_kind * pvar option * pexp) list): - (arg_kind * ltype) list * lexp_context = + (arg_kind * ltype) list * lexp_context = let rec loop args acc ctx = match args with | [] -> (List.rev acc), ctx @@ -312,38 +310,38 @@ and lexp_parse_constructors ctors ctx = match hd with (* What does the optional Pvar do ? that expression does not exist in LEXP*) - | (kind, _, exp) -> - let lxp, nctx = lexp_parse exp ctx in - loop tl ((kind, lxp)::acc) nctx end in + | (kind, _, exp) -> + let lxp = lexp_parse exp ctx in + loop tl ((kind, lxp)::acc) ctx end in loop args [] ctx in - + let rec loop ctors merged ctx = match ctors with - | [] -> merged, ctx - | hd::tl -> begin - match hd with + | [] -> merged + | hd::tl -> begin + match hd with | ((loc, name), args) -> let largs, nctx = make_args args in let nmerged = SMap.add name largs merged in - (loop tl nmerged ctx) - end in - + loop tl nmerged ctx + end in + loop ctors SMap.empty ctx - + (* Parse let declaration *) and lexp_decls decls ctx: (((vdef * lexp * ltype) list) * lexp_context) =

(* Merge Type info and declaration together *) (* We use a list because order matters and Maps reorder elements *) - (* + (* let rec is_equal target (p:(vdef * pexp option * pexp option)): bool = let ((_, name), _, _) = p in if name == target then true else false in *) - + (* merge with a map to guarantee uniqueness. *) - let rec merge_decls (decls: (pvar * pexp * bool) list) merged acc: + let rec merge_decls (decls: (pvar * pexp * bool) list) merged acc: ((location * pexp option * pexp option) SMap.t * string list) = - + (* we cant evaluate here because variable are not in the environment *) match decls with | [] -> merged, (List.rev acc) @@ -352,7 +350,7 @@ and lexp_decls decls ctx: (((vdef * lexp * ltype) list) * lexp_context) = (* Type Info: Var:Type *) | ((loc, name), type_info, true) -> begin try - (* If found its means the instruction was declared + (* If found its means the instruction was declared * before the type info. Should we allow this? *) let (l, inst, _) = SMap.find name merged in let new_decl = (l, inst, Some type_info) in @@ -362,7 +360,7 @@ and lexp_decls decls ctx: (((vdef * lexp * ltype) list) * lexp_context) = let new_decl = (loc, None, Some type_info) in let nmerged = SMap.add name new_decl merged in (merge_decls tl nmerged (name::acc)) end - + (* Instruction: Var = expr *) | ((loc, name), inst, false) -> begin try @@ -370,29 +368,29 @@ and lexp_decls decls ctx: (((vdef * lexp * ltype) list) * lexp_context) = let new_decl = (l, Some inst, tp) in let nmerged = SMap.add name new_decl merged in (merge_decls tl nmerged acc) - + with Not_found -> let new_decl = (loc, Some inst, None) in let nmerged = SMap.add name new_decl merged in (merge_decls tl nmerged (name::acc)) end in - + let mdecls, ord = merge_decls decls SMap.empty [] in - + (* cast map to list*) let decls = List.map (fun name -> let (l, inst, tp) = SMap.find name mdecls in ((l, name), inst, tp) ) ord in - + (* Add Each Variable to the environment *) let nctx = List.fold_left (fun ctx hd -> - match hd with + match hd with | (_, None, _) -> ctx (* Unused variable: No Instruction *) - | ((loc, name), _, _) -> senv_add_var name loc ctx) + | ((loc, name), _, _) -> senv_add_var name loc ctx) ctx decls in - + let n_decls = List.length decls in - + (* Add Variable info *) let rec process_var_info dcl_lst _ctx acc i = match dcl_lst with @@ -404,30 +402,30 @@ and lexp_decls decls ctx: (((vdef * lexp * ltype) list) * lexp_context) = let nacc = ((loc, name), lxp, ltp)::acc in let ctx2 = env_add_var_info (n_decls - i, (loc, name), lxp, ltp) _ctx in process_var_info tl ctx2 nacc (i + 1)) - + | ((loc, name), Some pinst, Some ptype) ->( - let linst, ctx1 = lexp_parse pinst _ctx in - let ltyp, ctx2 = lexp_parse ptype ctx1 in + let linst = lexp_parse pinst _ctx in + let ltyp = lexp_parse ptype _ctx in let nacc = ((loc, name), linst, ltyp)::acc in - let ctx3 = env_add_var_info (n_decls - i, (loc, name), linst, ltyp) ctx2 in + let ctx3 = env_add_var_info (n_decls - i, (loc, name), linst, ltyp) _ctx in process_var_info tl ctx3 nacc (i + 1))

(* Skip the variable *) - | ((loc, name), None, _) -> (lexp_warning loc ("Unused Variable: " ^ name); + | ((loc, name), None, _) -> (lexp_warning loc ("Unused Variable: " ^ name); process_var_info tl _ctx acc i) in - + let acc, ctx = process_var_info decls nctx [] 0 in acc, ctx

-and lexp_parse_all (p: pexp list) (ctx: lexp_context): +and lexp_parse_all (p: pexp list) (ctx: lexp_context): (lexp list * lexp_context) = - let rec loop (plst: pexp list) ctx (acc: lexp list) = + let rec loop (plst: pexp list) ctx (acc: lexp list) = match plst with | [] -> ((List.rev acc), ctx) - | _ -> let lxp, new_ctx = lexp_parse (List.hd plst) ctx in - (loop (List.tl plst) new_ctx (lxp::acc)) in + | _ -> let lxp = lexp_parse (List.hd plst) ctx in + (loop (List.tl plst) ctx (lxp::acc)) in (loop p ctx []) - + (* * Type Inference * --------------------- *) @@ -447,9 +445,9 @@ and lexp_parse_all (p: pexp list) (ctx: lexp_context): * - use lexp_p_infer for destructors, and use lexp_p_check for constructors. * - use lexp_p_check whenever you can. *) - + and lexp_p_infer (p : pexp) (env : lexp_context) : lexp * ltype = - let lxp, nctx = lexp_parse p env in + let lxp = lexp_parse p env in lxp, UnknownType(dummy_location)

and lexp_p_check (p : pexp) (t : ltype) (env : lexp_context): lexp = @@ -461,7 +459,7 @@ and lexp_p_check (p : pexp) (t : ltype) (env : lexp_context): lexp = (* * Printing * --------------------- *) - + (* Print back in CET (Close Enough Typer) easier to read *) (* So print can be called while parsing *) and lexp_print_adv opt exp = @@ -469,44 +467,44 @@ and lexp_print_adv opt exp = let (pty, indent, prtp) = opt in match exp with | Imm(value) -> sexp_print value - | Var ((loc, name), idx) -> - print_string name; + | Var ((loc, name), idx) -> + print_string name; print_string "["; print_int idx; print_string "]" - + | Let (_, decls, body) -> - print_string "let"; lexp_print_decls (pty, indent + 1, prtp) decls; + print_string "let"; lexp_print_decls (pty, indent + 1, prtp) decls; if pty then print_string (make_line ' ' (indent * 4 + 4)); print_string " in "; lexp_print_adv (pty, indent + 2, prtp) body - + | Arrow(kind, Some (_, name), tp, loc, expr) -> slexp_print tp; print_string ": "; print_string name; print_string " -> "; slexp_print expr; - + | Arrow(kind, None, tp, loc, expr) -> slexp_print tp; print_string " -> "; slexp_print expr; - + | Lambda(kind, (loc, name), ltype, lbody) -> - print_string "lambda ("; print_string (name ^ ": "); + print_string "lambda ("; print_string (name ^ ": "); slexp_print ltype; print_string ") -> "; slexp_print lbody; - + | Cons(vf, symbol) -> let (loc, name) = symbol in let ((loc, vname), idx) = vf in print_string (name ^ "("); print_string vname; print_string "["; print_int idx; print_string "])" - + | Call(fname, args) -> begin (* /!\ Partial Print *) (* get function name *) let str, idx = match fname with | Var((_, name), idx) -> name, idx | _ -> "unkwn", -1 in - - let print_arg arg = match arg with | (kind, lxp) -> + + let print_arg arg = match arg with | (kind, lxp) -> lexp_print_adv (pty, 0, prtp) lxp in - - let print_binop op lhs rhs = + + let print_binop op lhs rhs = print_arg lhs; print_string op; print_arg rhs in - + match (str, args) with (* Special Operator *) | ("_=_", [lhs; rhs]) -> print_binop " = " lhs rhs @@ -515,7 +513,7 @@ and lexp_print_adv opt exp = | ("_/_", [lhs; rhs]) -> print_binop " / " lhs rhs | ("_*_", [lhs; rhs]) -> print_binop " * " lhs rhs (* not an operator *) - | _ -> + | _ -> print_string ("(" ^ str ^ "["); print_int idx; print_string "]"; List.iter (fun arg -> print_string " "; print_arg arg) args; print_string ")" end @@ -523,43 +521,43 @@ and lexp_print_adv opt exp = | Inductive (_, (_, name), _, ctors) -> print_string ("inductive_ " ^ name ^ " "); lexp_print_ctors opt ctors; - + | Case (_, target, tpe, map, dflt) -> begin print_string "case "; slexp_print target; - print_string ": "; slexp_print tpe; - + print_string ": "; slexp_print tpe; + if pty then print_string "\n"; - + let print_arg arg = - List.iter (fun v -> + List.iter (fun v -> match v with | None -> print_string " _" | Some (kind, (l, n)) -> print_string (" " ^ n)) arg in - + SMap.iter (fun key (loc, arg, exp) -> print_string (make_line ' ' (indent * 4)); - print_string ("| " ^ key); print_arg arg; + print_string ("| " ^ key); print_arg arg; print_string " -> "; slexp_print exp; print_string "; "; if pty then print_string "\n";) map; - + match dflt with | None -> () - | Some df -> + | Some df -> print_string (make_line ' ' (indent * 4)); print_string "| _ -> "; slexp_print df; print_string ";"; if pty then print_string "\n"; end - + (* debug catch all *) | UnknownType (loc) -> print_string "unkwn"; | _ -> print_string "Printint Not Implemented" - - + + and lexp_print_ctors opt ctors = SMap.iter (fun key value -> print_string ("(" ^ key ^ ": "); - List.iter (fun (kind, arg) -> + List.iter (fun (kind, arg) -> lexp_print_adv opt arg; print_string " ") value; print_string ")") ctors @@ -567,14 +565,14 @@ and lexp_print_ctors opt ctors = and lexp_print_decls opt decls = let (pty, indent, prtp) = opt in let print_type nm tp = - print_string (" " ^ nm ^ ": "); lexp_print_adv opt tp; + print_string (" " ^ nm ^ ": "); lexp_print_adv opt tp; print_string ";"; in

List.iteri (fun idx g -> match g with | ((loc, name), expr, ltyp) -> if pty && idx > 0 then print_string (make_line ' ' (indent * 4)); if prtp then print_type name ltyp; print_string " "; - print_string (name ^ " = "); + print_string (name ^ " = "); lexp_print_adv opt expr; print_string ";"; if pty then print_string "\n") decls @@ -582,17 +580,17 @@ and lexp_print_decls opt decls = (* Print context *) and lexp_context_print ctx = let ((n, map), env) = ctx in - + print_string (make_title " LEXP CONTEXT "); - + make_rheader [ (Some ('r', 10), "NAME"); (Some ('r', 7), "INDEX"); (Some ('r', 10), "NAME"); (Some ('r', 20), "VALUE:TYPE")]; - + print_string (make_sep '-'); - + StringMap.iter (fun key idx -> (* Print senv info *) print_string " | "; @@ -600,9 +598,9 @@ and lexp_context_print ctx = print_string " | "; ralign_print_int (n - idx - 1) 7; print_string " | "; - + (* Print env Info *) - try let (_, (_, name), exp, tp) = env_lookup_by_index (n - idx - 1) ctx in + try let (_, (_, name), exp, tp) = env_lookup_by_index (n - idx - 1) ctx in ralign_print_string name 10; (* name must match *) print_string " | "; lexp_print_adv (false, 0, true) exp; @@ -613,14 +611,14 @@ and lexp_context_print ctx = Not_found -> print_string "Not_found \n")

map; - + print_string (make_sep '=');

(* Only print var info *) and lexp_print_var_info ctx = let ((_, _), env) = ctx in let n = Myers.length env in - + for i = 0 to n - 1 do ( let (_, (_, name), exp, tp) = Myers.nth i env in print_string name; (* name must match *) @@ -632,11 +630,11 @@ and lexp_print_var_info ctx = done; ;;

-let lexp_print e = lexp_print_adv (false, 0, true) e;; - +let lexp_print e = lexp_print_adv (false, 0, true) e;; +

(* add dummy definition helper *) -let add_def name ctx = +let add_def name ctx = let ctx = senv_add_var name dloc ctx in env_add_var_info (0, (dloc, name), dlxp, dlxp) ctx ;; @@ -646,7 +644,7 @@ let add_def name ctx = * ------------------------ *)

(* Lexp helper *) -let _lexp_expr_str (str: string) (tenv: bool array) +let _lexp_expr_str (str: string) (tenv: bool array) (grm: grammar) (limit: string option) (ctx: lexp_context) = let pretoks = prelex_string str in let toks = lex tenv pretoks in @@ -656,7 +654,7 @@ let _lexp_expr_str (str: string) (tenv: bool array) ;;

(* specialized version *) -let lexp_expr_str str lctx = +let lexp_expr_str str lctx = _lexp_expr_str str default_stt default_grammar (Some ";") lctx ;;

@@ -670,7 +668,6 @@ let _lexp_decl_str (str: string) tenv grm limit ctx = ;;

(* specialized version *) -let lexp_decl_str str lctx = +let lexp_decl_str str lctx = _lexp_decl_str str default_stt default_grammar (Some ";") lctx ;; -

===================================== src/main.ml ===================================== --- a/src/main.ml +++ b/src/main.ml @@ -88,16 +88,15 @@ let default_stt = stt.(Char.code ')') <- true; stt

-(* +(* default_grammar is auto-generated from typer-smie-grammar via: + (dolist (x typer-smie-grammar) (when (stringp (car x)) (insert "("" (car x) "", " (if (numberp (nth 1 x)) (format "Some %d" (nth 1 x)) "None") ", " (if (numberp (nth 2 x)) (format "Some %d" (nth 2 x)) "None") ");\n"))) - *) - let default_grammar : grammar = List.fold_left (fun g (n, ll, rl) -> SMap.add n (ll, rl) g) SMap.empty

View it on GitLab: https://gitlab.com/monnier/typer/commit/61f036c49dc0c1b31f1df56ae6a7de14ec8a...