Commit 96a91969 authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Add complex_type in parser; first version of currification that

	doesn't work with applications
parent bc3850d6
......@@ -26,5 +26,10 @@ id = [a-z_][A-Za-z0-9_]*
(* TODO: Add union and polymorphic types *)
type_id = [A-Z][A-Za-z0-9_]*
| (complex_type_id)
complex_type_id = [A-Z][A-Za-z0-9_]*
| complex_type_id * complex_type_id
| complex_type_id -> complex_type_id
integer = [0-9]+
......@@ -52,23 +52,31 @@ let rec _to_typed env l expr =
env, l, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Cst s }
and parse_abstr env l loc fun_name params return_type body =
let brloc = caml_loc_to_cduce (get_loc body) 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=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, l, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Abstraction(abstr) }
let rec _parse_abstr env l fv loc fun_name params return_type body nb =
let brloc = caml_loc_to_cduce (get_loc body) in
let empty, env, l, nfv, iface, rest = parse_iface env l params [] nb [] in
let node = Patterns.make (fv @ 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 fun_name rest
return_type body (nb + 1) in body
in
let br = { br_loc=brloc; br_used=true; br_ghost=false;
br_vars_empty=[]; br_pat=node; br_body=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, l, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Abstraction(abstr) }
in
_parse_abstr env l [] loc fun_name params return_type body 0
and parse_iface env l params fv nb iface = match params with
| (_, pname, _) :: rest ->
parse_iface env (Locals.add pname nb l) rest (fv @ [nb, pname]) (nb + 1)
(iface @ [Types.empty, Types.empty])
| [] -> env, l, fv, iface
| (_, pname, _) :: [] -> true, env, (Locals.add pname nb l),
(fv @ [nb, pname]), (iface @ [Types.empty, Types.empty]), []
| (_, pname, _) :: rest -> false, env, (Locals.add pname nb l),
(fv @ [nb, pname]), (iface @ [Types.empty, Types.empty]), rest
| [] -> true, env, l, fv, iface, []
and parse_branches env l toptype brs res = match brs with
| (loc, p, e) :: rest ->
......
......@@ -31,9 +31,9 @@ module ExprParser = struct
expression:
[
"abstr" RIGHTA
[ "fun"; x = LIDENT; p = LIST1 param; ":"; t = UIDENT; "->";
[ "fun"; x = LIDENT; p = LIST1 param; ":"; t = type_id; "->";
e = SELF -> Abstr(_loc, x, p, t, e)
| "match"; e = SELF; ":"; t = UIDENT; "with"; b = LIST1 branch ->
| "match"; e = SELF; ":"; t = type_id; "with"; b = LIST1 branch ->
Match(_loc, e, t, b) ]
| "pair" LEFTA
[ e1 = SELF; ","; e2 = SELF -> Pair(_loc, e1, e2)
......@@ -44,7 +44,7 @@ module ExprParser = struct
| "string" [ x = STRING -> String(_loc, x) ]
];
param:[[p = LIDENT; ":"; t = UIDENT -> _loc, p, t]];
param:[[p = LIDENT; ":"; t = type_id -> _loc, p, t]];
branch:[ "branch" [ "|"; t = match_value; "->"; e = expression ->
_loc, t, e ]];
......@@ -53,10 +53,18 @@ module ExprParser = struct
[
"pair" LEFTA [ e1 = SELF; ","; e2 = SELF -> MPair(_loc, e1, e2) ]
| "paren" [ "("; e = SELF; ")" -> e ]
| "var" [ x = LIDENT; ":"; t = UIDENT -> MVar(_loc, x, t) ]
| "var" [ x = LIDENT; ":"; t = type_id -> MVar(_loc, x, t) ]
| "int" [ x = INT -> MInt(_loc, int_of_string x) ]
| "string" [ x = STRING -> MString(_loc, x) ]
];
type_id: [ "atom_type" [ t = UIDENT -> t ]
| [ "("; t = complex_type_id; ")" -> t ]];
complex_type_id: [ "complex_type" LEFTA [ t = UIDENT -> t ]
| [ t1 = SELF; "*"; t2 = SELF -> t1 ^ "*" ^ t2
| t1 = SELF; "->"; t2 = SELF -> t1 ^ "->" ^ t2 ]];
END;;
let of_string s file = Gram.parse_string exp_eoi (Loc.mk file) s
......
File ./tests/eval/tests/match_error_simple.test, line 1, characters 50-51:
File ./tests/eval/tests/match_error_simple.test, line 1, characters 49-50:
Unbound identifier a
((fun f x : Int y : Int : Int (* To fix: Int*Int *) -> x,y).2).3
((fun f x : Int y : Int : (Int*Int) -> x,y).2).3
(fun f x : Int (* To fix: Int*Int *) : Int (* To fix: Int*Int *) -> x).(3,2)
(fun f x : (Int*Int) : (Int*Int) -> x).(3,2)
match x : Pairofints with | (a : Int, b : Int) -> a
match x : (Int*Int) with | (a : Int, b : Int) -> 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