Commit 7f09389f authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Add union types; fix on subtyping

parent 1eb86124
......@@ -30,7 +30,6 @@ branches = (* empty *)
id = [a-z_][A-Za-z0-9_]*
(* TODO: Add union types *)
type_id = [A-Z][A-Za-z0-9_]*
| "'"[A-Z][A-Za-z0-9_]*
| "[" complex_type_id "]"
......@@ -38,7 +37,10 @@ type_id = [A-Z][A-Za-z0-9_]*
complex_type_id = [A-Z][A-Za-z0-9_]*
| "'"[A-Z][A-Za-z0-9_]*
| complex_type_id * complex_type_id
| complex_type_id "*" complex_type_id
| complex_type_id "|" complex_type_id
| complex_type_id "&" complex_type_id
| "!" complex_type_id
| complex_type_id -> complex_type_id
| "[" complex_type_id "]"
| "(" complex_type_id ")"
......
......@@ -21,6 +21,9 @@ let rec type_of_ptype arg = match arg with
| Type(t) -> type_of_string t
| PType(t) -> any (* TODO: Check this solution *)
| TPair(t1, t2) -> times (cons (type_of_ptype t1)) (cons (type_of_ptype t2))
| TUnion(t1, t2) -> cup (type_of_ptype t1) (type_of_ptype t2)
| TInter(t1, t2) -> cap (type_of_ptype t1) (type_of_ptype t2)
| TNot(t) -> neg (type_of_ptype t)
| TArrow(t1, t2) -> arrow (cons (type_of_ptype t1)) (cons (type_of_ptype t2))
| TSeq(t) -> Sequence.star (type_of_ptype t)
......@@ -169,16 +172,16 @@ and parse_match_value env l list p toptype = match p with
let d1 = any, list, Patterns.Capture(lsize, mname) in
let t2 = type_of_ptype mtype in
let d2 = t2, [], Patterns.Constr(t2) in
t2, Patterns.Cap(d1, d2), list, l, Types.subtype (type_of_ptype toptype) t2
t2, Patterns.Cap(d1, d2), list, l, Types.subtype t2 (type_of_ptype toptype)
| MInt (_, i) ->
let t = constant (Integer(big_int_of_int i)) in
t, Patterns.Constr(t), list, l, Types.subtype (type_of_ptype toptype)
(type_of_string "Int")
t, Patterns.Constr(t), list, l, Types.subtype (type_of_string "Int")
(type_of_ptype toptype)
| MString (_, s) ->
let t = constant (String(0, String.length s - 1, s,
Integer(big_int_of_int 0))) in
t, Patterns.Constr(t), list, l, Types.subtype (type_of_ptype toptype)
(type_of_string "String")
t, Patterns.Constr(t), list, l, Types.subtype (type_of_string "String")
(type_of_ptype toptype)
let to_typed expr =
let env, l, expr = _to_typed empty_toplevel Locals.empty expr in
......
......@@ -118,6 +118,30 @@ let tests = "CDuce runtime tests" >:::
| el : [Int] -> el).[1; 2; 5; 4; 8; 7]");
);
"union" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.union.identity failed"
~printer:(fun x -> x) "Abstraction(([ Char* ] | Int, [ Char* ] | Int))"
(run_test "fun f x : (Int | String) : (Int | String) -> x");
assert_equal ~msg:"Test CDuce.runtime.union.match failed"
~printer:(fun x -> x) "Abstraction(([ Char* ] | Int, [ Char* ] | Int))"
(run_test "fun f x : (Int | String) : (Int | String) ->
match x : (Int | String) with
| x : Int -> 2
| x : String -> \"Piece of cake\"");
assert_equal ~msg:"Test CDuce.runtime.union.match_applied failed"
~printer:(fun x -> x) "2"
(run_test "(fun f x : (Int | String) : (Int | String) ->
match x : (Int | String) with
| x : Int -> 2
| x : String -> \"Piece of cake\").5");
assert_equal ~msg:"Test CDuce.runtime.union.match_applied2 failed"
~printer:(fun x -> x) "\"Piece of cake\""
(run_test "(fun f x : (Int | String) : (Int | String) ->
match x : (Int | String) with
| x : Int -> 2
| x : String -> \"Piece of cake\").\"test\"");
);
]
let _ = run_test_tt_main tests
......@@ -21,6 +21,9 @@ and ptype =
| Type of string
| PType of string
| TPair of ptype * ptype
| TUnion of ptype * ptype
| TInter of ptype * ptype
| TNot of ptype
| TArrow of ptype * ptype
| TSeq of ptype
......@@ -78,6 +81,9 @@ module ExprParser = struct
| [ "'"; t = UIDENT -> PType(t) ]
| [ t1 = SELF; "*"; t2 = SELF -> TPair(t1, t2)
| t1 = SELF; "->"; t2 = SELF -> TArrow(t1, t2) ]
| [ t1 = SELF; "|"; t2 = SELF -> TUnion(t1, t2)
| t1 = SELF; "&"; t2 = SELF -> TInter(t1, t2) ]
| [ "!"; t = SELF -> TNot(t) ]
| [ "["; t = complex_type_id; "]" -> TSeq(t) ]];
END;;
......
......@@ -20,6 +20,9 @@ and ptype =
| Type of string
| PType of string
| TPair of ptype * ptype
| TUnion of ptype * ptype
| TInter of ptype * ptype
| TNot of ptype
| TArrow of ptype * ptype
| TSeq of ptype
......
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