Setepenre pushed to branch master at Stefan / Typer

Commits: 723db68b by Pierre Delaunay at 2016-05-26T16:24:59-04:00 All tests pass

Changes to be committed: - src/eval.ml - src/lparse.ml - fix builtin parsing as (lctx -> rctx) is not as straight forward as it was

- - - - -

2 changed files:

- src/eval.ml - src/lparse.ml

Changes:

===================================== src/eval.ml ===================================== --- a/src/eval.ml +++ b/src/eval.ml @@ -315,19 +315,43 @@ let eval_all lxps rctx silent = (* build a rctx from a lctx *) let from_lctx (ctx: lexp_context): runtime_env = let ((n, _), env, _) = ctx in + let n = n - 1 in + let rctx = ref make_runtime_ctx in + + for i = 0 to n do + let name, exp = match (Myers.nth (n - i) env) with + | (_, Some (_, name), LetDef exp, _) -> Some name, Some exp + | _ -> None, None in + + let vxp = match exp with + | Some lxp -> + let octx = add_rte_variable name Vdummy (!rctx) in + let lxp = (erase_type lxp) in + (try (eval lxp octx) + with e -> elexp_print lxp; + print_string "\n"; raise e) + + | None -> Vdummy in + + rctx := add_rte_variable name vxp (!rctx) + done; + + !rctx + + (* let ((n, _), env, _) = ctx in let rctx = ref make_runtime_ctx in

let bsize = 0 in let csize = n - 1 in

- (* add all variables *) + (* add all variables * ) for i = bsize to csize do let name = match (Myers.nth (csize - i) env) with | (_, Some (_, name), _, _) -> Some name | _ -> None in

rctx := add_rte_variable name Vdummy (!rctx) - done; + done; *)

let diff = csize - bsize in

@@ -347,11 +371,11 @@ let from_lctx (ctx: lexp_context): runtime_env = print_string "\n"; raise e)

| None -> Vdummy in - rctx := set_rte_variable j name vxp (!rctx) + rctx := add_rte_variable name vxp (!rctx)

with Not_found -> print_int n; print_string " "; print_int (csize - i); print_string "\n "; raise Not_found done; - !rctx + !rctx *)

===================================== src/lparse.ml ===================================== --- a/src/lparse.ml +++ b/src/lparse.ml @@ -701,8 +701,9 @@ and _lexp_decls decls ctx i: (((vdef * lexp * ltype) list list) * lexp_context) | Some lxp -> lxp | None -> dltype in

+ (* let ltp = unsusp_all ltp in - let lxp = unsusp_all lxp in + let lxp = unsusp_all lxp in *) ((l, s), lxp, ltp)::acc) [] names in

let decls = List.map (fun names -> @@ -893,9 +894,15 @@ let default_lctx = let pxps = pexp_decls_all nods in

_parsing_internals := true; - let _, lctx = lexp_p_decls pxps lctx in + let d, lctx = lexp_p_decls pxps lctx in _parsing_internals := false;

+ (* dump grouped decls * ) + List.iter (fun decls -> + print_string "["; + List.iter (fun ((_, s), _, _) -> + print_string (s ^ ", ")) decls; print_string "] \n") d; *) + (* Once default builtin are set we can populate the predef table *) try List.iter (fun name -> @@ -911,11 +918,29 @@ let default_lctx =

(* Make runtime context with built-in types *) let default_rctx = + (* Empty context *) + let lctx = make_lexp_context in + let lxp = Builtin((dloc, "Built-in"), type0) in + let lctx = env_extend lctx (dloc, "Built-in") (LetDef lxp) type0 in + + (* Read BTL files *) + let pres = prelex_file (!btl_folder ^ "types.typer") in + let sxps = lex default_stt pres in + let nods = sexp_parse_all_to_list default_grammar sxps (Some ";") in + let pxps = pexp_decls_all nods in + + _parsing_internals := true; + let d, lctx = lexp_p_decls pxps lctx in + _parsing_internals := false; + + let rctx = make_runtime_ctx in + eval_decls_toplevel (EL.clean_toplevel d) rctx + (* try (from_lctx (default_lctx)) with e ->( print_eval_trace (); lexp_error dloc "Could not convert lexp context into rte context"; - raise e) + raise e) *)

(* String Parsing

View it on GitLab: https://gitlab.com/monnier/typer/commit/723db68b317662ee4f962c847659bfc59f4a...