Stefan pushed to branch master at Stefan / Typer

Commits: 66730d6d by Stefan Monnier at 2016-12-19T11:30:12-05:00 * src/lparse.ml (lexp_expand_macro): Use `eval-call`.

The main purpose of this is to avoid converting the `sexp list` of args to a `lexp list` on its way to a `value_type list` since conversion from lexp to value_type doesn't always create a Vsexp.

* src/builtin.ml (o2l_list): Remove.

* src/lparse.ml (lexp_eval): New function, extracted from lexp_expand_macro. (lexp_expand_macro): Use it. Add `loc` argument. Use `eval_call`.

- - - - -

2 changed files:

- src/builtin.ml - src/lparse.ml

Changes:

===================================== src/builtin.ml ===================================== --- a/src/builtin.ml +++ b/src/builtin.ml @@ -113,17 +113,7 @@ let type_eq =

let o2l_bool ctx b = get_predef (if b then "true" else "false") ctx

-(* lexp Imm list *) -let o2l_list ctx lst = - let tcons = get_predef "cons" ctx in - let tnil = get_predef "nil" ctx in - - let rlst = List.rev lst in - List.fold_left (fun tail elem -> - mkCall(tcons, [(Aexplicit, (Imm (elem))); - (Aexplicit, tail)])) tnil rlst - -(* typer list as seen during runtime *) +(* Typer list as seen during runtime. *) let o2v_list lst = (* FIXME: We're not using predef here. This will break if we change * the definition of `List` in builtins.typer. *)

===================================== src/lparse.ml ===================================== --- a/src/lparse.ml +++ b/src/lparse.ml @@ -380,7 +380,7 @@ and get_implicit_arg ctx loc name t = * call a `default-arg-filler` function, implemented in Typer, * just like `expand_macro_` function. That one can then look * things up in a table and/or do anything else it wants. *) - let v = lexp_expand_macro attr [] ctx (Some t) in + let v = lexp_expand_macro loc attr [] ctx (Some t) in

(* get the sexp returned by the macro *) let lsarg = match v with @@ -706,7 +706,8 @@ and check_case rtype (loc, target, ppatterns) ctx = mkCase (loc, tlxp, rtype, lpattern, dflt)

and handle_macro_call ctx func args t = - let sxp = match lexp_expand_macro func args ctx (Some t) with + let sxp = match lexp_expand_macro (lexp_location func) + func args ctx (Some t) with | Vsexp (sxp) -> sxp | v -> value_fatal (lexp_location func) v "Macros should return a Sexp" in @@ -851,32 +852,37 @@ and track_fv meta_ctx rctx lctx e = | _ -> name in String.concat " " (List.map tfv nc)

-and lexp_expand_macro macro_funct sargs ctx ot: value_type = +and lexp_eval meta_ctx ectx e = + (* FIXME: Make erase_type take meta_ctx directly! *) + let e = L.clean meta_ctx e in + let ee = OL.erase_type e in + let rctx = EV.from_ectx meta_ctx ectx in + + if not (EV.closed_p rctx (OL.fv e)) then + lexp_error (lexp_location e) e + ("Expression `" ^ lexp_string e ^ "` is not closed: " + ^ track_fv meta_ctx rctx (ectx_to_lctx ectx) e); + + try EV.eval ee rctx + with exc -> EV.print_eval_trace None; raise exc + +and lexp_expand_macro loc macro_funct sargs ctx (ot : ltype option) + : value_type =

(* Build the function to be called *) + let meta_ctx, _ = !global_substitution in let macro_expand = BI.get_predef "expand_macro_" ctx in + (* FIXME: Rather than remember the lexp of "expand_macro" in predef, + * we should remember its value so we don't have to re-eval it everytime. *) + let macro_expand = lexp_eval meta_ctx ctx macro_expand in (* FIXME: provide `ot` (the optional expected type) for non-decl macros. *) - let args = [(Aexplicit, macro_funct); - (Aexplicit, (BI.o2l_list ctx sargs))] in + let macro = lexp_eval meta_ctx ctx macro_funct in + let args = [macro; BI.o2v_list sargs] in

(* FIXME: Don't `mkCall + eval` but use eval_call instead! *) - let macro = mkCall (macro_expand, args) in - let meta_ctx, _ = !global_substitution in - let macro = L.clean meta_ctx macro in - let emacro = OL.erase_type macro in - let rctx = EV.from_ectx meta_ctx ctx in - - if not (EV.closed_p rctx (OL.fv macro)) then - (lexp_error (lexp_location macro_funct) macro_funct - ("Macro function is not closed: " - ^ track_fv meta_ctx rctx (ectx_to_lctx ctx) macro)); - - (* eval macro *) - let vxp = try EV._eval emacro rctx ([], []) - with e -> EV.print_eval_trace None; raise e in - (* Return results *) - (* Vint/Vstring/Vfloat might need to be converted to sexp *) - vxp + (* FIXME: Make a proper `Var`. *) + EV.eval_call loc (EL.Var ((DB.dloc, "expand_macro"), 0)) ([], []) + macro_expand args

(* Print each generated decls *) and sexp_decls_macro_print sxp_decls = @@ -889,7 +895,7 @@ and lexp_decls_macro (loc, mname) sargs ctx: (pdecl list * elab_context) = try let lxp, ltp = infer (Pvar (loc, mname)) ctx in

(* FIXME: Check that (conv_p ltp Macro)! *) - let ret = lexp_expand_macro lxp sargs ctx None in + let ret = lexp_expand_macro loc lxp sargs ctx None in let decls = match ret with | Vsexp(sexp) -> sexp | _ -> fatal loc ("Macro `" ^ mname ^ "` should return a sexp") in

View it on GitLab: https://gitlab.com/monnier/typer/commit/66730d6dbf198522f461f5f80201937b632a...