Commit 3932c71c authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Fix on types in abstraction interface

parent 5a5e2d91
......@@ -47,8 +47,3 @@ _import:
clean:
$(COMPILER) -clean
test $(EXTDIR) = "src" || test $(EXTDIR) = "." || $(RM) -r $(EXTDIR)
check: test
test: all
tests/test.sh
......@@ -28,10 +28,19 @@ let rec type_of_ptype arg = match arg with
| TPair(t1, t2) -> times (cons (type_of_ptype t1)) (cons (type_of_ptype t2))
| TArrow(t1, t2) -> arrow (cons (type_of_ptype t1)) (cons (type_of_ptype t2))
let rec type_of_iface iface res = match iface with
| (ptype, rtype) :: rest -> type_of_iface rest
(cup (arrow (cons ptype) (cons rtype)) res)
| [] -> res
let rec type_of_iface iface rtype =
let rec _type_of_iface iface rtype res =
match iface with
| (_, pname, ptype) :: rest -> _type_of_iface rest rtype
(arrow (cons res) (cons (type_of_ptype ptype)))
| [] -> arrow (cons res) (cons rtype)
in
match iface with
| (_, pname, ptype) :: [] -> arrow (cons (type_of_ptype ptype)) (cons rtype)
| (_, pname, ptype) :: (_, pname2, ptype2) :: rest ->
let res = type_of_ptype ptype2 in
arrow (cons (type_of_ptype ptype)) (cons (_type_of_iface rest rtype res))
| [] -> assert false
let rec _to_typed env l expr =
(* From Camlp4 locations to CDuce locations *)
......@@ -78,7 +87,7 @@ and parse_abstr env l fv loc fun_name params rtype body =
let brloc = caml_loc_to_cduce (get_loc body) in
let empty, env, l, fv, iface, rest =
parse_iface env l params [] nb [] rtype in
let fun_typ = type_of_iface iface Types.empty in
let fun_typ = type_of_iface params rtype in
let node = make_node fv in
let env, l, body = if empty
then let _, _, body = _to_typed env l body in env, l, body
......@@ -106,8 +115,8 @@ and parse_iface env l params fv nb iface rtype = match params with
| (_, pname, ptype) :: [] -> true, env, (Locals.add pname nb l),
(fv @ [nb, pname]), (iface @ [type_of_ptype ptype, rtype]), []
| (_, pname, ptype) :: rest -> false, env, (Locals.add pname nb l),
(fv @ [nb, pname]), (iface @ [itype rest (type_of_ptype ptype), rtype]),
rest
(fv @ [nb, pname]),
(iface @ [type_of_ptype ptype, type_of_iface rest rtype]), rest
| [] -> true, env, l, fv, iface, []
and itype iface res = match iface with
......
......@@ -41,7 +41,7 @@ let tests = "CDuce runtime tests" >:::
"misc" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.misc.firsts failed"
~printer:(fun x -> x) "Abstraction((Int,Int), X1 -> X1 where X1 = (Int,Int))"
~printer:(fun x -> x) "Abstraction(((Int,Int), (Int,Int) -> (Int,Int)))"
(run_test "fun firsts x : (Int*Int) y : (Int*Int) : (Int*Int) ->
match x,y : ((Int*Int)*(Int*Int)) with
| (a : Int,_ : Int),(b : Int,_ : Int) -> a,b");
......
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