Commit 4d4237a4 authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Environment done for functions and stand alone variables; same

	error as eval occurs: currification fails
parent 46637b09
......@@ -3,51 +3,63 @@ open Typed
open Compile
open Camlp4.PreCast
let rec to_typed expr =
let env = empty_toplevel in match expr with
module Locals = Map.Make(String)
exception Error
let rec _to_typed env l expr =
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
let _, e1 = to_typed e1 in
let _, e2 = to_typed e2 in
env, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Apply(e1, e2) }
let _, _, e1 = _to_typed env l e1 in
let _, _, e2 = _to_typed env l e2 in
env, l, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Apply(e1, e2) }
| Abstr (loc, fun_name, params, return_type, body) ->
parse_abstr env loc fun_name params return_type body
parse_abstr env l 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 b = parse_branches env l b [] in
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) }
let _, _, exp_descr = _to_typed env l e in
env, l, { exp_loc=loc; exp_typ=Types.empty;
exp_descr=Match(exp_descr, 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.empty;
exp_descr=Pair(snd(to_typed e1), snd(to_typed e2)) }
let _, _, exp_descr1 = _to_typed env l e1 in
let _, _, exp_descr2 = _to_typed env l e2 in
env, l, { exp_loc=loc; exp_typ=Types.empty;
exp_descr=Pair(exp_descr1, exp_descr2) }
| 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.empty; exp_descr=Var(0, vname) }
let line = Loc.start_line loc in
let cbegin = Loc.start_off loc - Loc.start_bol loc in
let cend = Loc.stop_off loc - Loc.start_bol loc in
let index = (try Locals.find vname l with Not_found ->
Printf.eprintf "File %s, line %d, characters %d-%d:\nUnbound identifier %s\n"
(Loc.file_name loc) line cbegin cend vname; raise Error) in
let loc = `File(Loc.file_name loc), cbegin, cend in
env, l, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Var(index, 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.empty; exp_descr=Cst(Types.Integer i) }
env, l, { 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.empty; exp_descr=Cst s }
env, l, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Cst s }
and parse_abstr env loc fun_name params return_type body =
and parse_abstr env l 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
......@@ -55,30 +67,35 @@ and parse_abstr env loc fun_name params return_type body =
let brloc = `File(Loc.file_name brloc),
Loc.start_off brloc - Loc.start_bol brloc,
Loc.stop_off brloc - Loc.start_bol brloc in
let fv, iface = parse_iface params [] 0 [] env in
let env, l, fv, iface = parse_iface env l params [] 0 [] in
let node = Patterns.make fv in
let _, _, br_body = _to_typed env l body in
let br = { br_loc=brloc; br_used=true; br_ghost=false;
br_vars_empty=[]; br_pat=node;
br_body=snd(to_typed body) } in
br_vars_empty=[]; br_pat=node; br_body=br_body } in
let brs = { br_typ=Types.empty; br_accept=Types.empty;
br_branches=[br] } in
let abstr = { fun_name=Some (0, fun_name); fun_iface=iface; fun_body=brs;
fun_typ=Types.empty; fun_fv=[] } in
env, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Abstraction(abstr) }
env, l, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Abstraction(abstr) }
and parse_iface params fv nb iface env = match params with
and parse_iface env l params fv nb iface = match params with
| (_, pname, _) :: rest ->
parse_iface rest (fv @ [nb, pname]) (nb + 1)
(iface @ [Types.empty, Types.empty]) env
| [] -> fv, iface
parse_iface env (Locals.add pname nb l) rest (fv @ [nb, pname]) (nb + 1)
(iface @ [Types.empty, Types.empty])
| [] -> env, l, fv, iface
and parse_branches brs res = match brs with
and parse_branches env l brs res = match brs with
| (loc, p, e) :: rest ->
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 node = Patterns.make [] in
let _, _, br_body = _to_typed env l e in
let b = { br_loc=loc; br_used=true; br_ghost=false; br_vars_empty=[];
br_pat=node; br_body=snd(to_typed e)} in
parse_branches rest (res @ [b])
br_pat=node; br_body=br_body} in
parse_branches env l rest (res @ [b])
| [] -> res
let to_typed expr =
let env, _, expr = _to_typed empty_toplevel Locals.empty expr in
env, expr
exception Error
val to_typed : Parse.expr -> Compile.env * Typed.texpr
......@@ -39,6 +39,7 @@ try
let evalexpr = Compile.compile_eval_expr env texpr in
print_value evalexpr; printf "\n"
with
| Compute.Error -> exit 3
| Loc.Exc_located (loc, exn) ->
let l = Loc.start_line loc in
let cbegin = Loc.start_off loc - Loc.start_bol loc in
......
Runtime error.
Fatal error: exception Failure("Compile: cannot find a")
File ./tests/eval/tests/match_error_simple.test, line 1, characters 37-38:
Unbound identifier a
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