Commit 46d53fe1 authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Add booleans and some tests

parent 569be18c
expr = id
| integer
| `true
| `false
| string
| abstr
| expr "." expr
......
......@@ -11,6 +11,8 @@ let type_of_string s = match s with
| "Int" -> Types.interval [Intervals.Any]
| "String" -> Sequence.string
| "Char" -> Types.char Chars.any
| "Bool" -> Types.atom (Atoms.cup (Atoms.atom (Atoms.V.mk_ascii "false"))
(Atoms.atom (Atoms.V.mk_ascii "true")))
| _ -> Types.empty
let rec _to_typed env l expr =
......@@ -51,10 +53,10 @@ let rec _to_typed env l expr =
let cbegin = Loc.start_off origloc - Loc.start_bol origloc in
let cend = Loc.stop_off origloc - Loc.start_bol origloc in
let index, vtype =
try Locals.find vname l
try Locals.find vname l
with Not_found -> Printf.eprintf
"File %s, line %d, characters %d-%d:\nUnbound identifier %s\n"
(Loc.file_name origloc) line cbegin cend vname;
(Loc.file_name origloc) line cbegin cend vname;
raise Error
in
let v = if Types.no_var vtype then Var(index, vname) else TVar(index, vname)
......@@ -68,6 +70,22 @@ let rec _to_typed env l expr =
let s = Types.String (0, (String.length s) - 1, s, Types.Integer i) in
env, l, { exp_loc=loc; exp_typ=(type_of_string "String");
exp_descr=Cst s }
| Bool (origloc, b) ->
let t = Types.atom (Atoms.atom (Atoms.V.mk_ascii "true")) in
let f = Types.atom (Atoms.atom (Atoms.V.mk_ascii "false")) in
match b with
| "true" -> env, l, { exp_loc=loc; exp_typ=t;
exp_descr=Cst (Types.Atom 1) }
| "false" -> env, l, { exp_loc=loc; exp_typ=f;
exp_descr=Cst (Types.Atom 0) }
| _ ->
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:\nUnknown special term %s\n"
(Loc.file_name origloc) line cbegin cend b;
raise Error
and make_sigma s =
let rec aux acc = function
......
......@@ -84,6 +84,20 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
);
"misc" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.misc.is_int failed"
~printer:(fun x -> x)
"Abstraction(([ Char* ] | Int, Bool),{})"
(run_test_eval "fun is_int x : (Int | String) : Bool ->
match x : (Int | String) with
| x : Int -> `true
| x : String -> `false");
assert_equal ~msg:"Test CDuce.runtime.misc.map failed"
~printer:(fun x -> x)
"Abstraction(((Int,Int), X1 -> X1 where X1 = (Int,Int)),{})"
(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");
assert_equal ~msg:"Test CDuce.runtime.misc.firsts failed"
~printer:(fun x -> x)
"Abstraction(((Int,Int), X1 -> X1 where X1 = (Int,Int)),{})"
......
......@@ -3,13 +3,14 @@ open Camlp4.PreCast
type expr =
| Subst of Loc.t * expr * (string * ptype) list
| Apply of Loc.t * expr * expr
| Apply of Loc.t * expr * expr
| Abstr of Loc.t * fun_name * params * ptype * expr
| Match of Loc.t * expr * ptype * branches
| Pair of Loc.t * expr * expr
| Pair of Loc.t * expr * expr
| Var of Loc.t * string
| Int of Loc.t * int
| String of Loc.t * string
| Bool of Loc.t * string
and fun_name = string
and params = (Loc.t * string * ptype) list
and branches = (Loc.t * match_value * expr) list
......@@ -40,7 +41,7 @@ module ExprParser = struct
expression:
[
"abstr" RIGHTA
[ "fun"; x = LIDENT; p = LIST1 param; ":"; t = type_id; "->"; e = SELF ->
[ "fun"; x = LIDENT; p = LIST1 param; ":"; t = type_id; "->"; e = SELF ->
Abstr(_loc, x, p, t, e)
| "match"; e = SELF; ":"; t = type_id; "with"; b = LIST1 branch ->
Match(_loc, e, t, b) ]
......@@ -52,6 +53,7 @@ module ExprParser = struct
| "var" [ x = LIDENT -> Var(_loc, x) ]
| "int" [ x = INT -> Int(_loc, int_of_string x) ]
| "string" [ x = STRING -> String(_loc, x) ]
| "bool" [ "`"; x = LIDENT -> Bool(_loc, x) ]
| "subst" NONA
[ e = SELF; "{"; s = LIST1 sigma SEP ";"; "}" -> Subst(_loc, e, s) ]
];
......@@ -63,7 +65,7 @@ module ExprParser = struct
param:[[p = LIDENT; ":"; t = type_id -> _loc, p, t]];
branch:[ "branch"
branch:[ "branch"
[ "|"; t = match_value; "->"; e = expression -> _loc, t, e ]
];
......@@ -77,14 +79,14 @@ module ExprParser = struct
| "string" [ x = STRING -> MString(_loc, x) ]
];
type_id: [ "atom_type"
type_id: [ "atom_type"
[ t = UIDENT -> Type(t) ]
| [ "'"; t1 = UIDENT; "{"; s = LIST0 sigma SEP ";"; "}" -> PType(t1, s) ]
| [ "("; t = complex_type_id; ")" -> t ]
| [ "["; t = complex_type_id; "]" -> TSeq(t) ]
];
complex_type_id: [ "complex_type" LEFTA
complex_type_id: [ "complex_type" LEFTA
[ t = UIDENT -> Type(t) | "("; t = SELF; ")" -> t ]
| [ "'"; t1 = UIDENT; "{"; s = LIST0 sigma SEP ";"; "}" -> PType(t1, s) ]
| [ t1 = SELF; "*"; t2 = SELF -> TPair(t1, t2) | t1 = SELF; "->"; t2 = SELF -> TArrow(t1, t2) ]
......@@ -108,6 +110,7 @@ let get_loc expr = match expr with
| Var (loc, _) -> loc
| Int (loc, _) -> loc
| String (loc, _) -> loc
| Bool (loc, _) -> loc
let caml_loc_to_cduce loc =
`File(Loc.file_name loc), Loc.start_off loc - Loc.start_bol loc,
......
......@@ -9,6 +9,7 @@ type expr =
| Var of Loc.t * string
| Int of Loc.t * int
| String of Loc.t * string
| Bool of Loc.t * string
and fun_name = string
and params = (Loc.t * string * ptype) list
and branches = (Loc.t * match_value * expr) 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