Commit 6b25df64 authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Add if statements (has sugar of match);

	add operator "=" for integers;
	add constant values "`true" and "`false" as possible patterns
parent e70c61c0
......@@ -5,8 +5,11 @@ expr = id
| STRING
| abstr
| "let" LIDENT ":" type_id "=" expr "in" expr ":" type_id
| "if" expr "then" expr
| "if" expr "then" expr "else" expr
| expr "." expr
| expr "," expr
| expr "=" expr
| expr "+" expr
| expr "-" expr
| expr "*" expr
......
......@@ -252,6 +252,20 @@ and parse_match_value env l list toptype = function
let is_subtype = Types.subtype (type_of_string "String")
(type_of_ptype toptype) in
(t, Patterns.Constr(t), list, l, is_subtype)
| MBool (origloc, b) ->
let t = match b with
| "true" -> Types.atom (Atoms.atom (Atoms.V.mk_ascii "true"))
| "false" -> Types.atom (Atoms.atom (Atoms.V.mk_ascii "false"))
| _ ->
let line = Loc.start_line origloc in
let cbegin = Loc.start_off origloc - Loc.start_bol origloc in
let cend = Loc.stop_off origloc - Loc.start_bol origloc in
Printf.eprintf
"File %s, line %d, characters %d-%d:\nError: Unknown special term %s\n"
(Loc.file_name origloc) line cbegin cend b;
raise Error in
let is_subtype = Types.subtype t (type_of_ptype toptype) in
(t, Patterns.Constr(t), list, l, is_subtype)
let arith_op f = function
| Value.Integer(x) :: Value.Integer(y) :: [] ->
......@@ -259,6 +273,12 @@ let arith_op f = function
(Big_int.int_of_big_int y)))
| _ -> raise Error
let equal = function
| Value.Integer(x) :: Value.Integer(y) :: [] ->
let b = if Big_int.int_of_big_int x = Big_int.int_of_big_int y then "true"
else "false" in Value.Atom(Atoms.V.mk_ascii b)
| _ -> raise Error
let concat =
let rec add_to_tail y = function
| Value.Pair(x, nil, s) ->
......@@ -280,6 +300,7 @@ let to_typed expr =
Eval.register_op "*" (arith_op ( * ));
Eval.register_op "/" (arith_op ( / ));
Eval.register_op "%" (arith_op ( mod ));
Eval.register_op "=" equal;
Eval.register_op "@" concat;
let env, _, expr = _to_typed Compile.empty_toplevel Locals.empty expr in
env, expr
......@@ -295,6 +295,10 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
~printer:(fun x -> x) "3"
(run_test_eval "(fun f x : Int : Int ->
match x : Int with | 1 -> 3 | _ : Int -> f.1).2");
assert_equal ~msg:"Test CDuce.runtime.match.desugar_if failed"
~printer:(fun x -> x) "0"
(run_test_eval "((fun f x : Int y : Int : Int ->
match (x = y) : Bool with | `true -> 0 | `false -> 1).2).2");
);
"string" >:: ( fun test_ctxt ->
......@@ -356,7 +360,7 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
match l : ['A[{A/(Int|Bool)}]] with
| (el : 'A[{A/(Int|Bool)}]) :: [] -> el
| (el : 'A[{A/(Int|Bool)}]) :: (rest : ['A[{A/(Int|Bool)}]]) ->
(match n : Int with | 0 -> el | _ : Int -> (nth.rest).(n-1))).[1; 2; 5; `true; 2].2");
(if n = 0 then el else nth.rest.(n-1))).[1; 2; 5; `true; 2].2");
);
"union" >:: ( fun test_ctxt ->
......
......@@ -20,6 +20,7 @@ and match_value =
| MVar of Loc.t * string * ptype
| MInt of Loc.t * int
| MString of Loc.t * string
| MBool of Loc.t * string
and ptype =
| Type of string
| PType of string * (string * ptype) list list
......@@ -61,8 +62,18 @@ module ExprParser = struct
| "fun"; t = type_id; b = LIST1 branch -> Abstr(_loc, "_", t, [], b)
| "let"; x = LIDENT; ":"; t = type_id; "="; v = SELF; "in"; e = SELF;
":"; te = type_id -> Match(_loc, v, t, [_loc, MVar(_loc, x, t), e])
| "if"; e1 = SELF; "then"; e2 = SELF ->
let b = [(_loc, MBool(_loc, "true"), e2);
(_loc, MBool(_loc, "false"), Var(_loc, "`nil"))] in
Match(_loc, e1, Type("Bool"), b)
| "if"; e1 = SELF; "then"; e2 = SELF; "else"; e3 = SELF ->
let b = [(_loc, MBool(_loc, "true"), e2);
(_loc, MBool(_loc, "false"), e3)] in
Match(_loc, e1, Type("Bool"), b)
| "match"; e = SELF; ":"; t = type_id; "with"; b = LIST1 branch ->
Match(_loc, e, t, b) ]
| "egal" LEFTA
[ e1 = SELF; "="; e2 = SELF -> Op(_loc, "=", e1, e2) ]
| "add" LEFTA
[ e1 = SELF; "+"; e2 = SELF -> Op(_loc, "+", e1, e2)
| e1 = SELF; "-"; e2 = SELF -> Op(_loc, "-", e1, e2) ]
......@@ -107,6 +118,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) ]
| "bool" [ "`"; x = LIDENT -> MBool(_loc, x) ]
| "empty" [ "["; "]" -> MVar(_loc, "`nil", Type("Any")) ]
];
......
......@@ -19,6 +19,7 @@ and match_value =
| MVar of Loc.t * string * ptype
| MInt of Loc.t * int
| MString of Loc.t * string
| MBool of Loc.t * string
and ptype =
| Type of string
| PType of string * (string * ptype) list list
......
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