Commit 4b0f4d79 authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Add operator "@" with a test (List.concat)

parent 0e06d80e
......@@ -249,17 +249,33 @@ and parse_match_value env l list toptype = function
(type_of_ptype toptype) in
(t, Patterns.Constr(t), list, l, is_subtype)
let rec arith_op f = function
let arith_op f = function
| Value.Integer(x) :: Value.Integer(y) :: [] ->
Value.Integer(Big_int.big_int_of_int (f (Big_int.int_of_big_int x)
(Big_int.int_of_big_int y)))
| _ -> raise Error
let concat =
let rec add_to_tail y = function
| Value.Pair(x, nil, s) ->
if nil = Value.Atom(Atoms.V.mk_ascii "nil")
then Value.Pair(x, y, s) else Value.Pair(x, add_to_tail y nil, s)
| _ -> raise Error in
function
| (Value.Pair(_, _, _) as x) :: (Value.Pair(_) as y) :: [] ->
add_to_tail y x
| x :: y :: [] ->
if x = Value.Atom(Atoms.V.mk_ascii "nil") then y
else if y = Value.Atom(Atoms.V.mk_ascii "nil") then x
else raise Error
| _ -> raise Error
let to_typed expr =
Eval.register_op "+" (arith_op ( + ));
Eval.register_op "-" (arith_op ( - ));
Eval.register_op "*" (arith_op ( * ));
Eval.register_op "/" (arith_op ( / ));
Eval.register_op "%" (arith_op ( mod ));
Eval.register_op "@" concat;
let env, _, expr = _to_typed Compile.empty_toplevel Locals.empty expr in
env, expr
......@@ -332,6 +332,11 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
(run_test_eval "(fun f x : [Int] : [Int] -> match x : [Int] with
| (el : Int) :: [] -> el+1
| (el : Int) :: (rest : [Int]) -> ((el+1), (f.rest))).[1; 2; 5; 4; 8; 7]");
assert_equal ~msg:"Test CDuce.runtime.list.concat failed"
~printer:(fun x -> x) "(1, (2, (5, (4, (8, (7, (2, (3, (4, Atom(nil), {}), {}), {}), {}), {}), {}), {}), {}), {})"
(run_test_eval "(fun concat x : [[Int]] : [Int] -> match x : [[Int]] with
| (el : [Int]) :: [] -> el
| (el : [Int]) :: (rest : [[Int]]) -> (el@(concat.rest))).[[1; 2; 5; 4; 8; 7]; [2; 3; 4]]");
);
"union" >:: ( fun test_ctxt ->
......@@ -422,4 +427,3 @@ let _ =
]
)
;;
......@@ -70,6 +70,7 @@ module ExprParser = struct
[ e1 = SELF; "*"; e2 = SELF -> Op(_loc, "*", e1, e2)
| e1 = SELF; "/"; e2 = SELF -> Op(_loc, "/", e1, e2)
| e1 = SELF; "%"; e2 = SELF -> Op(_loc, "%", e1, e2) ]
| "concat" LEFTA [ 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) ]
......
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