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

	doesn't work with applications

tests/lambda/GRAMMAR

@@ -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]+

tests/lambda/src/compute.ml

@@ -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 ->

tests/lambda/src/parse.ml

@@ -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

tests/lambda/tests/eval/refs/apply_medium.ref

-2,3
+(2, 3)

tests/lambda/tests/eval/refs/match_error_simple.ref

-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

tests/lambda/tests/eval/tests/apply_medium.test

-((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

tests/lambda/tests/eval/tests/apply_simple_pair.test

-(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)

tests/lambda/tests/eval/tests/match_error_simple.test

-match x : Pairofints with | (a : Int, b : Int) -> a
+match x : (Int*Int) with | (a : Int, b : Int) -> a