Commit d7a762df authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Work on sequence representation (not working yet); fix on test

	generator
parent 697eb9b6
......@@ -141,7 +141,7 @@ and compile_abstr env a =
let slots = Array.of_list (List.rev slots) in
let env = { env with vars = fun_env; gamma = (env.gamma @ fun_name);
let env = { env with vars = fun_env; gamma = IdMap.merge (fun _ v2 -> v2) env.gamma fun_name;
stack_size = 0; max_stack = ref 0 } in
let body = compile_branches env a.Typed.fun_body in
let sigma = `Sel(a.Typed.fun_fv,a.Typed.fun_iface,env.sigma) in
......
......@@ -217,14 +217,19 @@ and parse_match_value env l list toptype = function
Patterns.Times (make_patterns t1 list1 d1, make_patterns t2 list2 d2),
(list1 @ list2), l, b1 && b2;
| MVar (_, mname, mtype) ->
let lsize = Locals.cardinal l in
let l = Locals.add mname (lsize, type_of_ptype mtype) l in
let list = list @ [lsize, mname] in
let d1 = Types.any, list, Patterns.Capture(lsize, mname) in
let t2 = type_of_ptype mtype in
let d2 = t2, [], Patterns.Constr(t2) in
let is_subtype = Types.subtype t2 (type_of_ptype toptype) in
(t2, Patterns.Cap(d1, d2), list, l, is_subtype)
if mname = "`nil" then
let nil_atom = Atoms.V.mk_ascii "nil" in
let t = Types.atom (Atoms.atom nil_atom) in
(t, Patterns.Constr(t), list, l, true)
else
let lsize = Locals.cardinal l in
let l = Locals.add mname (lsize, type_of_ptype mtype) l in
let list = list @ [lsize, mname] in
let d1 = Types.any, list, Patterns.Capture(lsize, mname) in
let t2 = type_of_ptype mtype in
let d2 = t2, [], Patterns.Constr(t2) in
let is_subtype = Types.subtype t2 (type_of_ptype toptype) in
(t2, Patterns.Cap(d1, d2), list, l, is_subtype)
| MInt (_, i) ->
let t = Types.constant (Types.Integer(Big_int.big_int_of_int i)) in
let is_subtype = Types.subtype (type_of_string "Int")
......
......@@ -139,7 +139,7 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
| x : (!Int) -> x).8");
assert_equal ~msg:"Test CDuce.runtime.misc.even_applied3 failed"
~printer:(fun x -> x)
"(2, 3, {})"
"(2, (3, Atom(nil), {}), {})"
(run_test_eval "(fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
......@@ -168,7 +168,7 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
| x : (!(Int|Bool)) -> x).`true");
assert_equal ~msg:"Test CDuce.runtime.misc.is_int_applied3 failed"
~printer:(fun x -> x)
"(2, 3, {})"
"(2, (3, Atom(nil), {}), {})"
(run_test_eval "(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
| x : Int -> `true
| x : Bool -> `false
......@@ -185,15 +185,15 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
Arrow)* ]),{})"
(run_test_eval "fun map f : ('A{}->'B{}) x : ['A{}] : ['B{}] ->
match x : ['A{}] with
| (el : 'A{}) :: (rest : ['A{}]) -> [f.el; (map.f).rest]
| el : ['A{}] -> f.el");
| (el : 'A{}) :: [] -> f.el
| (el : 'A{}) :: (rest : ['A{}]) -> ((f.el), ((map.f).rest))");
assert_equal ~msg:"Test CDuce.runtime.misc.map_even_simple failed"
~printer:(fun x -> x)
"(\"hey\", Atom(false), {})"
(run_test_eval "(fun map f : ('A{A/Int;A/Bool}->'B{A/Int;A/Bool}) x : ['A{A/Int;A/Bool}] : ['B{A/Int;A/Bool}] ->
match x : ['A{A/Int;A/Bool}] with
| (el : 'A{A/Int;A/Bool}) :: (rest : ['A{A/Int;A/Bool}]) -> [f.el; (map.f).rest]
| el : ['A{A/Int;A/Bool}] -> f.el).(fun ((Int -> Bool) & ((!Int) -> (!Int)))
(run_test_eval "(fun map f : ('A{}->'B{}) x : ['A{}] : ['B{}] ->
match x : ['A{}] with
| (el : 'A{}) :: [] -> f.el
| (el : 'A{}) :: (rest : ['A{}]) -> ((f.el), ((map.f).rest))).(fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
......@@ -201,10 +201,10 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
assert_equal ~msg:"Test CDuce.runtime.misc.map_even_medium failed"
~printer:(fun x -> x)
"(\"hey\", Atom(false), Atom(true), {})"
(run_test_eval "(fun map f : ('A{A/Int;A/Bool}->'B{A/Int;A/Bool}) x : ['A{A/Int;A/Bool}] : ['B{A/Int;A/Bool}] ->
match x : ['A{A/Int;A/Bool}] with
| (el : 'A{A/Int;A/Bool}) :: (rest : ['A{A/Int;A/Bool}]) -> [f.el; (map.f).rest]
| el : ['A{A/Int;A/Bool}] -> f.el).(fun ((Int -> Bool) & ((!Int) -> (!Int)))
(run_test_eval "(fun map f : ('A{}->'B{}) x : ['A{}] : ['B{}] ->
match x : ['A{}] with
| (el : 'A{}) :: [] -> f.el
| (el : 'A{}) :: (rest : ['A{}]) -> ((f.el), ((map.f).rest))).(fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
......@@ -212,20 +212,20 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
assert_equal ~msg:"Test CDuce.runtime.misc.map_is_int_simple failed"
~printer:(fun x -> x)
"(Atom(false), Atom(true), {})"
(run_test_eval "(fun map f : ('A{A/Int;A/Bool}->'B{A/Int;A/Bool}) x : ['A{A/Int;A/Bool}] : ['B{A/Int;A/Bool}] ->
match x : ['A{A/Int;A/Bool}] with
| (el : 'A{A/Int;A/Bool}) :: (rest : ['A{A/Int;A/Bool}]) -> [f.el; (map.f).rest]
| el : ['A{A/Int;A/Bool}] -> f.el).(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
(run_test_eval "(fun map f : ('A{}->'B{}) x : ['A{}] : ['B{}] ->
match x : ['A{}] with
| (el : 'A{}) :: [] -> f.el
| (el : 'A{}) :: (rest : ['A{}]) -> ((f.el), ((map.f).rest))).(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
| x : Int -> `true
| x : Bool -> `false
| x : (!(Int|Bool)) -> x).[`true; 3]");
assert_equal ~msg:"Test CDuce.runtime.misc.map_is_int_medium failed"
~printer:(fun x -> x)
"(Atom(false), Atom(true), Atom(false), {})"
(run_test_eval "(fun map f : ('A{A/Int;A/Bool}->'B{A/Int;A/Bool}) x : ['A{A/Int;A/Bool}] : ['B{A/Int;A/Bool}] ->
match x : ['A{A/Int;A/Bool}] with
| (el : 'A{A/Int;A/Bool}) :: (rest : ['A{A/Int;A/Bool}]) -> [f.el; (map.f).rest]
| el : ['A{A/Int;A/Bool}] -> f.el).(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
(run_test_eval "(fun map f : ('A{}->'B{}) x : ['A{}] : ['B{}] ->
match x : ['A{}] with
| (el : 'A{}) :: [] -> f.el
| (el : 'A{}) :: (rest : ['A{}]) -> ((f.el), ((map.f).rest))).(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
| x : Int -> `true
| x : Bool -> `false
| x : (!(Int|Bool)) -> x).[`true; 3; `true]");
......@@ -303,19 +303,19 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
(run_test_eval "fun tail x : [Int] : [Int] -> match x : [Int] with
| (el : Int) :: (rest : [Int]) -> rest");
assert_equal ~msg:"Test CDuce.runtime.list.tail.eval failed"
~printer:(fun x -> x) "(2, 5, {})"
~printer:(fun x -> x) "(2, (5, Atom(nil), {}), {})"
(run_test_eval "(fun tail x : [Int] : [Int] -> match x : [Int] with
| (el : Int) :: (rest : [Int]) -> rest).[1; 2; 5]");
assert_equal ~msg:"Test CDuce.runtime.list.last failed"
~printer:(fun x -> x) "7"
(run_test_eval "(fun f x : [Int] : [Int] -> match x : [Int] with
| (el : Int) :: (rest : [Int]) -> f.rest
| el : [Int] -> el).[1; 2; 5; 4; 8; 7]");
| (el : Int) :: [] -> el
| (el : Int) :: (rest : [Int]) -> f.rest).[1; 2; 5; 4; 8; 7]");
assert_equal ~msg:"Test CDuce.runtime.list.plusone failed"
~printer:(fun x -> x) "(2, (3, (6, (5, (9, 8, {}), {}), {}), {}), {})"
(run_test_eval "(fun f x : [Int] : [Int] -> match x : [Int] with
| (el : Int) :: (rest : [Int]) -> [el+1; f.rest]
| el : [Int] -> el+1).[1; 2; 5; 4; 8; 7]");
| (el : Int) :: [] -> el+1
| (el : Int) :: (rest : [Int]) -> ((el+1), (f.rest))).[1; 2; 5; 4; 8; 7]");
);
"union" >:: ( fun test_ctxt ->
......@@ -390,7 +390,7 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
(run_test_eval "fun tail x : ['A{}] : ['A{}] -> match x : ['A{}] with
| (el : 'A{}) :: (rest : ['A{}]) -> rest");
assert_equal ~msg:"Test CDuce.runtime.poly.tail_applied failed"
~printer:(fun x -> x) "(7, (8, 5, {}), {})"
~printer:(fun x -> x) "(7, (8, (5, Atom(nil), {}), {}), {})"
(run_test_eval "(fun tail x : ['A{}] : ['A{}] -> match x : ['A{}] with
| (el : 'A{}) :: (rest : ['A{}]) -> rest).[3; 7; 8; 5]");
......
......@@ -73,7 +73,13 @@ module ExprParser = struct
| "pair" LEFTA
[ e1 = SELF; ","; e2 = SELF -> Pair(_loc, e1, e2)
| e1 = SELF ; "."; e2 = SELF -> Apply(_loc, e1, e2) ]
| "list" LEFTA [ "["; le = listexpr; "]" -> le ]
| "list" LEFTA
[ "["; le = LIST0 SELF SEP ";"; "]" ->
let rec make_seq res = function
| e :: rest -> make_seq (Pair(_loc, e, res)) rest
| [] -> res in
make_seq (Var(_loc, "`nil")) (List.rev le)
]
| "paren" [ "("; e = SELF; ")" -> e ]
| "var" [ x = LIDENT -> Var(_loc, x) ]
| "int" [ x = INT -> Int(_loc, int_of_string x) ]
......@@ -85,9 +91,6 @@ module ExprParser = struct
sigma: [[ x = UIDENT; "/"; t = type_id -> x, t ]];
listexpr:[ "rec" RIGHTA [ l1=SELF; ";"; l2=SELF -> Pair(_loc, l1, l2) ]
| [ e=expression -> e]];
param:[[p = LIDENT; ":"; t = type_id -> _loc, p, t]];
branch:[ "branch"
......@@ -102,6 +105,7 @@ module ExprParser = struct
| "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) ]
| "empty" [ "["; "]" -> MVar(_loc, "`nil", Type("Any")) ]
];
type_id: [ "atom_type"
......
......@@ -13,8 +13,14 @@ let rec init l = match l with
arules := Array.append !arules [| name |]; init rest
| [] -> ()
let rec is_terminal state = match state with
| RefRule(_) :: rest -> false
| _ :: rest -> is_terminal rest
| [] -> true
let rec get_state nb = function
| state :: rest -> if nb != 0 then get_state (nb - 1) rest else state
| state :: rest -> if (nb < 0 && not (is_terminal state)) || nb > 0
then get_state (nb - 1) rest else state
| _ -> assert false
let rec g_ident nb res =
......@@ -45,8 +51,9 @@ let g_uident nb res =
let res = res ^ (String.make 1 (char_of_int (int_of_char 'A' + rand))) in
g_ident (nb - 1) res
let rec g_token = function
let rec g_token n = function
| RefRule(loc, name) ->
Printf.eprintf "Refrule(%s)\n" name;
let states =
try Rules.find name !rules
with Not_found ->
......@@ -55,9 +62,9 @@ let rec g_token = function
let cend = Loc.stop_off loc - Loc.start_bol loc in
Printf.eprintf "File %s, line %d, characters %d-%d:Unknown rule %s\n"
(Loc.file_name loc) l cbegin cend name; raise Error
in g_states "" states
| String(_, s) -> s
| Special(loc, spe) -> match spe with
in g_states "" (max (n-1) 0) states
| String(_, s) -> Printf.eprintf "String(%s)\n" s;s
| Special(loc, spe) -> Printf.eprintf "Special(%s)\n" spe; match spe with
| "LIDENT" -> g_lident 3 ""
| "UIDENT" -> g_uident 3 ""
| "STRING" -> g_ident 3 ""
......@@ -69,20 +76,21 @@ let rec g_token = function
Printf.eprintf "File %s, line %d, characters %d-%d:Unknown special keyword %s\n"
(Loc.file_name loc) l cbegin cend spe; raise Error
and g_tokens res = function
| token :: rest -> g_tokens (res ^ (g_token token)) rest
and g_tokens res n = function
| token :: rest -> g_tokens (res ^ (g_token n token)) n rest
| [] -> res
and g_states res states =
and g_states res n states =
let max_rand = List.length states in
let rand = Random.int max_rand in
g_tokens res (get_state rand states)
let rand = if n != 0 then rand else -1 in
g_tokens res n (get_state rand states)
let g_rule res =
let g_init res n =
Random.self_init();
let max_rand = Rules.cardinal !rules in
let rand = Random.int (max_rand + 1) in
if rand != max_rand then g_states res (Rules.find !arules.(rand) !rules)
if rand != max_rand then g_states res n (Rules.find !arules.(rand) !rules)
else res
let get_test () = g_rule ""
let get_test () = g_init "" 2
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