Commit 2d1979cf authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Begin to handle environment for function parameters; fails in

	the transition between Compile and Eval
parent 8367c11b
......@@ -15,7 +15,7 @@ INEXTFILES = misc/custom.ml misc/encodings.ml misc/upool.ml misc/ns.ml\
types/externals.mli types/externals.ml typing/typer.ml\
runtime/run_dispatch.ml runtime/explain.ml schema/schema_pcre.ml\
schema/schema_xml.mli schema/schema_xml.ml schema/schema_common.mli\
schema/schema_common.ml runtime/eval.mli runtime/eval.ml compile/compile.mli\
schema/schema_common.ml runtime/eval.mli runtime/eval.ml\
compile/compile.ml types/compunit.mli types/compunit.ml types/var.ml\
types/boolVar.ml misc/imap.ml types/atoms.ml types/intervals.ml\
types/chars.mli types/chars.ml misc/bool.mli misc/bool.ml types/types.mli\
......
open Parse
open Typed
open Compile
open Camlp4.PreCast
let rec to_typed expr =
let env = Compile.empty_toplevel in match expr with
let env = empty_toplevel in match expr with
| Parse.Apply (loc, e1, e2) ->
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
env, { exp_loc=loc; exp_typ=Types.any;
exp_descr=Apply(snd (to_typed e1), snd (to_typed e2)) }
let env1, e1 = to_typed e1 in
let _, e2 = to_typed e2 in
env1, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Apply(e1, e2) }
| Abstr (loc, fun_name, params, return_type, body) ->
env, parse_abstr loc fun_name params return_type body
parse_abstr env loc fun_name params return_type body
| Match (loc, e, b) ->
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
let b = parse_branches b [] in
let brs = { br_typ=Types.any; br_accept=Types.any; br_branches=b } in
env, { exp_loc=loc; exp_typ=Types.any;
let brs = { br_typ=Types.empty; br_accept=Types.empty; br_branches=b } in
env, { exp_loc=loc; exp_typ=Types.empty;
exp_descr=Match(snd (to_typed e), brs) }
| Pair (loc, e1, e2) ->
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
env, { exp_loc=loc; exp_typ=Types.any;
env, { exp_loc=loc; exp_typ=Types.empty;
exp_descr=Pair(snd(to_typed e1), snd(to_typed e2)) }
| Var (loc, vname) ->
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
env, { exp_loc=loc; exp_typ=Types.any; exp_descr=Var(0, vname) }
env, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Var(0, vname) }
| Int (loc, i) ->
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
let i = Big_int.big_int_of_int i in
env, { exp_loc=loc; exp_typ=Types.any; exp_descr=Cst(Types.Integer i) }
env, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Cst(Types.Integer i) }
| String (loc, s) ->
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
let s = Types.String (0, (String.length s) - 1, s,
Types.Integer (Big_int.big_int_of_int 0)) in
env, { exp_loc=loc; exp_typ=Types.any; exp_descr=Cst s }
env, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Cst s }
and parse_abstr loc fun_name params return_type body =
and parse_abstr env loc fun_name params return_type body =
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
......@@ -57,16 +59,24 @@ and parse_abstr loc fun_name params return_type body =
let br = { br_loc=brloc; br_used=true; br_ghost=false;
br_vars_empty=[]; br_pat=node;
br_body=snd(to_typed body) } in
let brs = { br_typ=Types.any; br_accept=Types.any;
let brs = { br_typ=Types.empty; br_accept=Types.empty;
br_branches=[br] } in
let iface = parse_iface params [] in
{ exp_loc=loc; exp_typ=Types.any;
exp_descr=Abstraction({ fun_name=Some (0, fun_name); fun_iface=iface;
fun_body=brs; fun_typ=Types.any; fun_fv=[] }) }
let new_env = { cu=None; vars=Ident.Env.empty; stack_size=0;
max_stack=ref 1000; global_size=env.global_size } in
let iface, fv, new_env = parse_iface params [] [] new_env 0 in
let abstr = { fun_name=Some (0, fun_name); fun_iface=iface; fun_body=brs;
fun_typ=Types.empty; fun_fv=fv } in
new_env, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Abstraction(abstr) }
and parse_iface params res = match params with
| _ :: rest -> parse_iface rest (res @ [Types.any, Types.any])
| [] -> res
and parse_iface params iface fv env nb = match params with
| (_, pname, _) :: rest ->
let vars = Ident.Env.add (nb, pname) (Lambda.Local nb) env.vars in
let env = { cu=env.cu; vars=vars; stack_size=nb + 1;
max_stack=env.max_stack;
global_size=env.global_size + nb + 1 } in
parse_iface rest (iface @ [Types.empty, Types.empty]) (fv @ [nb, pname])
env (nb+1)
| [] -> iface, fv, env
and parse_branches brs res = match brs with
| (loc, p, e) :: rest ->
......
......@@ -45,4 +45,4 @@ with
let cend = Loc.stop_off loc - Loc.start_bol loc in
eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc) l
cbegin cend; raise exn
| e -> eprintf "Unknown error.\n"; raise e
| e -> eprintf "Runtime error.\n"; raise e
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment