Commit 39503fcb authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Add simple arithmetic; add tests for arithmetic; add printer

	for Typed.Op; add map_even tests
parent e59ae0d1
......@@ -6,6 +6,11 @@ expr = id
| abstr
| expr "." expr
| expr "," expr
| expr "+" expr
| expr "-" expr
| expr "*" expr
| expr "/" expr
| expr "%" expr
| expr "{" id "/" type_id sigma "}"
| "(" expr ")"
| "[" listexpr "]"
......
......@@ -45,6 +45,11 @@ let rec _to_typed env l expr =
let _, _, e2 = _to_typed env l e2 in
let t = Types.times (Types.cons e1.exp_typ) (Types.cons e2.exp_typ) in
env, l, { exp_loc=loc; exp_typ=t; exp_descr=Pair(e1, e2) }
| Op (_, op, e1, e2) ->
let _, _, e1 = _to_typed env l e1 in
let _, _, e2 = _to_typed env l e2 in
env, l, { exp_loc=loc; exp_typ=type_of_string "Int";
exp_descr=Op(op, 0, [e1; e2]) }
| Var (origloc, vname) ->
if vname = "`nil" then
let nil_atom = Atoms.V.mk_ascii "nil" in
......@@ -232,6 +237,41 @@ and parse_match_value env l list toptype = function
(type_of_ptype toptype) in
(t, Patterns.Constr(t), list, l, is_subtype)
let plus = fun l -> match l with
| Value.Integer(x) :: Value.Integer(y) :: [] ->
Value.Integer(Big_int.big_int_of_int ((Big_int.int_of_big_int x) +
(Big_int.int_of_big_int y)))
| _ -> raise Error
let minus = fun l -> match l with
| Value.Integer(x) :: Value.Integer(y) :: [] ->
Value.Integer(Big_int.big_int_of_int ((Big_int.int_of_big_int x) -
(Big_int.int_of_big_int y)))
| _ -> raise Error
let mult = fun l -> match l with
| Value.Integer(x) :: Value.Integer(y) :: [] ->
Value.Integer(Big_int.big_int_of_int ((Big_int.int_of_big_int x) *
(Big_int.int_of_big_int y)))
| _ -> raise Error
let div = fun l -> match l with
| Value.Integer(x) :: Value.Integer(y) :: [] ->
Value.Integer(Big_int.big_int_of_int ((Big_int.int_of_big_int x) /
(Big_int.int_of_big_int y)))
| _ -> raise Error
let modulo = fun l -> match l with
| Value.Integer(x) :: Value.Integer(y) :: [] ->
Value.Integer(Big_int.big_int_of_int ((Big_int.int_of_big_int x) mod
(Big_int.int_of_big_int y)))
| _ -> raise Error
let to_typed expr =
Eval.register_op "+" plus;
Eval.register_op "-" minus;
Eval.register_op "*" mult;
Eval.register_op "/" div;
Eval.register_op "%" modulo;
let env, _, expr = _to_typed Compile.empty_toplevel Locals.empty expr in
env, expr
......@@ -96,6 +96,38 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
);
"misc" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.misc.even failed"
~printer:(fun x -> x)
"Abstraction((Int, Bool) ,(Any \\ (Int), Any \\ (Int)),{})"
(run_test_eval "fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x");
assert_equal ~msg:"Test CDuce.runtime.misc.even_applied1 failed"
~printer:(fun x -> x)
"Atom(false)"
(run_test_eval "(fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x).5");
assert_equal ~msg:"Test CDuce.runtime.misc.even_applied2 failed"
~printer:(fun x -> x)
"Atom(true)"
(run_test_eval "(fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x).8");
assert_equal ~msg:"Test CDuce.runtime.misc.even_applied3 failed"
~printer:(fun x -> x)
"(2, 3, {})"
(run_test_eval "(fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x).[2; 3]");
assert_equal ~msg:"Test CDuce.runtime.misc.is_int failed"
~printer:(fun x -> x)
"Abstraction((Int, Bool) ,(Bool, Bool) ,(Any \\ (Int | Bool), Any \\ (Int | Bool)),{})"
......@@ -138,6 +170,28 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
match x : ['A{}] with
| (el : 'A{}) :: (rest : ['A{}]) -> [f.el; (map.f).rest]
| el : ['A{}] -> f.el");
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)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x).[\"hey\"; 3]");
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)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x).[\"hey\"; 3; 2]");
assert_equal ~msg:"Test CDuce.runtime.misc.map_is_int_simple failed"
~printer:(fun x -> x)
"(Atom(false), Atom(true), {})"
......@@ -179,6 +233,15 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
f.x).2).(fun g x : Int : Int -> x)");
);
"arith" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.arith.simple failed"
~printer:(fun x -> x) "5"
(run_test_eval "2+3");
assert_equal ~msg:"Test CDuce.runtime.arith.complete failed"
~printer:(fun x -> x) "1"
(run_test_eval "2+5*7%2-8/4");
);
"match" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.match.simple failed"
~printer:(fun x -> x) "1"
......
......@@ -7,6 +7,7 @@ type expr =
| Abstr of Loc.t * fun_name * ptype * fv * branches
| Match of Loc.t * expr * ptype * branches
| Pair of Loc.t * expr * expr
| Op of Loc.t * string * expr * expr
| Var of Loc.t * string
| Int of Loc.t * int
| String of Loc.t * string
......@@ -60,6 +61,13 @@ module ExprParser = struct
| "fun"; t = type_id; b = LIST1 branch -> Abstr(_loc, "_", t, [], b)
| "match"; e = SELF; ":"; t = type_id; "with"; b = LIST1 branch ->
Match(_loc, e, t, b) ]
| "add" LEFTA
[ e1 = SELF; "+"; e2 = SELF -> Op(_loc, "+", e1, e2)
| e1 = SELF; "-"; e2 = SELF -> Op(_loc, "-", e1, e2) ]
| "mult" LEFTA
[ e1 = SELF; "*"; e2 = SELF -> Op(_loc, "*", e1, e2)
| e1 = SELF; "/"; e2 = SELF -> Op(_loc, "/", e1, e2)
| e1 = SELF; "%"; e2 = SELF -> Op(_loc, "%", e1, e2) ]
| "pair" LEFTA
[ e1 = SELF; ","; e2 = SELF -> Pair(_loc, e1, e2)
| e1 = SELF ; "."; e2 = SELF -> Apply(_loc, e1, e2) ]
......@@ -122,6 +130,7 @@ let get_loc expr = match expr with
| Abstr (loc, _, _, _, _) -> loc
| Match (loc, _, _, _) -> loc
| Pair (loc, _, _) -> loc
| Op (loc, _, _, _) -> loc
| Var (loc, _) -> loc
| Int (loc, _) -> loc
| String (loc, _) -> loc
......
......@@ -6,6 +6,7 @@ type expr =
| Abstr of Loc.t * fun_name * ptype * fv * branches
| Match of Loc.t * expr * ptype * branches
| Pair of Loc.t * expr * expr
| Op of Loc.t * string * expr * expr
| Var of Loc.t * string
| Int of Loc.t * int
| String of Loc.t * string
......
......@@ -62,6 +62,7 @@ and pp_typed_aux ppf e =
Format.fprintf ppf "Match(%a,%a)" pp_typed e pp_branches b
| Typed.Subst(e, s) ->
Format.fprintf ppf "Subst(%a,[%a])" pp_typed e pp_typedsigma s
| Typed.Op(s, i, l) -> Format.fprintf ppf "(%s, %d, " s i; (print_lst pp_typed ppf l); Format.fprintf ppf ")"
| _ -> assert false
and pp_abst ppf abstr =
......
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