Commit 6b40d01d authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Fix printer; small fix in environment; code for pairs in match

	patterns; add a new test
parent a16f8fff
......@@ -65,15 +65,15 @@ let rec _to_typed env l expr =
exp_descr=Cst s }
and parse_abstr env l loc fun_name params rtype body =
let rec _parse_abstr env l fv loc fun_name params rtype body nb =
let rec _parse_abstr env l loc fun_name params rtype body nb =
let brloc = caml_loc_to_cduce (get_loc body) in
let empty, env, l, nfv, iface, rest =
let empty, env, l, fv, iface, rest =
parse_iface env l params [] nb [] rtype in
let node = make_node (fv @ nfv) nfv in
let body = if empty
then let _, _, body = _to_typed env l body in body
else let _, _, body = _parse_abstr env l (fv @ nfv) loc None rest
rtype body (nb + 1) in body
let node = make_node fv in
let env, l, body = if empty
then let _, _, body = _to_typed env l body in env, l, body
else let env, l, body = _parse_abstr env l loc None rest rtype body
(nb + 1) in env, l, body
in
let b = { br_loc=brloc; br_used=true; br_ghost=false; br_vars_empty=[];
br_pat=node; br_body=body } in
......@@ -84,10 +84,10 @@ and parse_abstr env l loc fun_name params rtype body =
(* TODO: Fix exp_typ *)
env, l, { exp_loc=loc; exp_typ=any; exp_descr=Abstraction(abstr) }
in
_parse_abstr env l [] loc fun_name params (type_of_string rtype) body 0
_parse_abstr env l loc fun_name params (type_of_string rtype) body 0
and make_node fv nfv =
let d = (match nfv with
and make_node fv =
let d = (match fv with
| el :: rest -> Patterns.Capture(el)
| [] -> Patterns.Dummy)
in
......@@ -133,8 +133,12 @@ and make_patterns t fv d = incr Patterns.counter;
Patterns.accept=(cons t); fv=fv }
and parse_match_value env l list p toptype = match p with
(* TODO: Allow pairs in types *)
| MPair (_) -> empty, Patterns.Dummy, list, l, false;
| MPair (_, m1, m2) ->
let t1, d1, list, l, b1 = parse_match_value env l list m1 toptype in
let t2, d2, list, l, b2 = parse_match_value env l list m2 toptype in
times (cons t1) (cons t2),
Patterns.Times (make_patterns t1 [] d1, make_patterns t2 [] d2),
list, l, b1 && b2;
| MVar (_, mname, mtype) ->
let lsize = Locals.cardinal l in
let l = Locals.add mname lsize l in
......
......@@ -43,8 +43,8 @@ and const cst = match cst with
and abst abstr = (match abstr.Typed.fun_name with
| Some (id, name) -> "name:(" ^ (string_of_int (Upool.int id)) ^ ", "
^ (Encodings.Utf8.to_string name)
| None -> "name:<none>") ^ "),\niface:[" ^ (iface abstr.Typed.fun_iface)
^ (Encodings.Utf8.to_string name) ^ ")"
| None -> "name:<none>") ^ ",\niface:[" ^ (iface abstr.Typed.fun_iface)
^ "],\nbody:[" ^ (branches abstr.Typed.fun_body) ^ "], "
^ "typ:" ^ (Types.Print.to_string abstr.Typed.fun_typ) ^ ", fv:["
^ (fv_to_string abstr.Typed.fun_fv) ^ "]"
......@@ -64,8 +64,9 @@ and branch brs = match brs with
| br :: [] -> "\n{used:" ^ (string_of_bool br.Typed.br_used) ^ "; ghost:"
^ (string_of_bool br.Typed.br_ghost) ^ "; br_vars_empty:["
^ (fv_to_string br.Typed.br_vars_empty) ^ "];\npat:{"
^ (node br.Typed.br_pat) ^ "};\nbody:"
^ (typed_to_string br.Typed.br_body) ^ "}"
^ (node br.Typed.br_pat) ^ "};\nbody:{typ:"
^ (Types.Print.to_string br.Typed.br_body.Typed.exp_typ) ^ ", descr:"
^ (typed_to_string br.Typed.br_body) ^ "}}"
| br :: rest -> "\n{used:" ^ (string_of_bool br.Typed.br_used) ^ "; ghost:"
^ (string_of_bool br.Typed.br_ghost) ^ "; br_vars_empty:["
^ (fv_to_string br.Typed.br_vars_empty) ^ "];\npat:{"
......@@ -148,7 +149,7 @@ in
try
let expr = ExprParser.of_string str file in
let env, texpr = Compute.to_typed expr in
(* eprintf "%s\n" (typed_to_string texpr);*)
eprintf "%s\n" (typed_to_string texpr); print_env env.Compile.vars;
let evalexpr = Compile.compile_eval_expr env texpr in
print_value evalexpr; printf "\n"
with
......
fun firsts x : (Int*Int) y : (Int*Int) : (Int*Int) -> match x,y : (Int*Int) with
| (a : Int,_ : Int),(b : Int,_ : Int) -> a,b
......@@ -22,7 +22,8 @@ for i in $MODULES; do
continue
fi
diff $OUT $i/refs/$PREFIX.ref > $DIFF 2>&1
echo "< received; > expected" > $DIFF
diff $OUT $i/refs/$PREFIX.ref >> $DIFF 2>&1
if test $? -ne 0; then
echo "Error in $i/$PREFIX: output is different (see $i/errors)"
test -d $i/errors || mkdir $i/errors
......
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