Skip to content

GitLab

Commit 64dcac8c authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Change wrong Bool name to Atom, better nil atom

parent 8c96ed41
Hide whitespace changes
Inline Side-by-side
tests/lambda/src/compute.ml
View file @ 64dcac8c
......@@ -56,11 +56,7 @@ let rec _to_typed env l expr =
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
if vname = "`nil" then
let nil_atom = Atoms.V.mk_ascii "nil" in
env, l, { exp_loc=loc; exp_typ=(Types.atom (Atoms.atom nil_atom));
exp_descr=(Cst (Types.Atom nil_atom)) }
else if vname = "_" then
if vname = "_" then
(Printf.eprintf
"File %s, line %d, characters %d-%d:\nError: Invalid reference to special variable %s\n"
(Loc.file_name origloc) line cbegin cend vname; raise Error)
......@@ -82,7 +78,7 @@ let rec _to_typed env l expr =
let i = Big_int.big_int_of_int 0 in
let s = Types.String (0, (String.length s) - 1, s, Types.Integer i) in
env, l, { exp_loc=loc; exp_typ=Builtin_defs.string; exp_descr=Cst s }
| Bool (origloc, b) ->
| Atom (origloc, b) ->
let t = Builtin_defs.true_type in
let f = Builtin_defs.false_type in
match b with
......@@ -90,6 +86,10 @@ let rec _to_typed env l expr =
exp_descr=Cst (Types.Atom (Builtin_defs.true_atom)) }
| "false" -> env, l, { exp_loc=loc; exp_typ=f;
exp_descr=Cst (Types.Atom (Builtin_defs.false_atom)) }
| "nil" ->
let nil_atom = Atoms.V.mk_ascii "nil" in
env, l, { exp_loc=loc; exp_typ=(Types.atom (Atoms.atom nil_atom));
exp_descr=(Cst (Types.Atom nil_atom)) }
| _ ->
let line = Loc.start_line origloc in
let cbegin = Loc.start_off origloc - Loc.start_bol origloc in
......@@ -219,11 +219,7 @@ 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) ->
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 if mname = "_" then
if mname = "_" then
let t = type_of_ptype mtype in
(t, Patterns.Constr(t), list, l, true)
else
......@@ -246,8 +242,19 @@ and parse_match_value env l list toptype = function
let is_subtype = Types.subtype Builtin_defs.string
(type_of_ptype toptype) in
(t, Patterns.Constr(t), list, l, is_subtype)
| MBool (origloc, b) ->
let t = if b then Builtin_defs.true_type else Builtin_defs.false_type in
| MAtom (origloc, b) ->
let t = match b with
| "true" -> Builtin_defs.true_type
| "false" -> Builtin_defs.false_type
| "nil" -> Types.atom (Atoms.atom (Atoms.V.mk_ascii "nil"))
| _ ->
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)
......
tests/lambda/src/parse.ml
View file @ 64dcac8c
......@@ -11,7 +11,7 @@ type expr =
| Var of Loc.t * string
| Int of Loc.t * int
| String of Loc.t * string
| Bool of Loc.t * string
| Atom of Loc.t * string
and fun_name = string
and fv = (int * string) list
and branches = (Loc.t * match_value * expr) list
......@@ -20,7 +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 * bool
| MAtom of Loc.t * string
and ptype =
| Type of string
| PType of string
......@@ -46,7 +46,7 @@ module ExprParser = struct
[ "fun"; x = LIDENT; p = LIST1 param; ":"; t = type_id; "->"; e = SELF ->
let rec make_fv accu nb = function
| _ :: [] | [] -> accu
| (_, name, _) :: rest -> make_fv (accu @ [nb, name]) (nb+1) rest
| (_, name, _) :: rest -> make_fv (accu @ [nb, name]) (nb+1) rest
in
let rec aux acc t fv = function
| (loc, pname, ptype) :: [] ->
......@@ -67,20 +67,20 @@ module ExprParser = struct
| "if"; e1 = SELF; "then"; e2 = SELF ->
let b = [
(_loc, MBool(_loc, true), e2);
(_loc, MBool(_loc, false), Var(_loc, "`nil"))]
(_loc, MAtom(_loc, "true"), e2);
(_loc, MAtom(_loc, "false"), Atom(_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)]
(_loc, MAtom(_loc, "true"), e2);
(_loc, MAtom(_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)
Match(_loc, e, t, b)
]
| "egal" LEFTA
[ e1 = SELF; "="; e2 = SELF -> Op(_loc, "=", e1, e2) ]
......@@ -99,13 +99,13 @@ module ExprParser = struct
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)
make_seq (Atom(_loc, "nil")) (List.rev le)
]
| "paren" [ "("; e = SELF; ")" -> e ]
| "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) ]
| "atom" [ "`"; x = LIDENT -> Atom(_loc, x) ]
| "subst" NONA [
e = SELF; "["; s = LIST0 sigma SEP ","; "]" -> Subst(_loc, e, s) ]
];
......@@ -128,24 +128,11 @@ 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 ->
try MBool(_loc, bool_of_string x)
with Invalid_argument "bool_of_string" -> begin
let line = Loc.start_line _loc in
let cbegin = Loc.start_off _loc - Loc.start_bol _loc in
let cend = Loc.stop_off _loc - Loc.start_bol _loc in
let err =
Printf.sprintf
"File %s, line %d, characters %d-%d:\nError: Unknown special term %s\n"
(Loc.file_name _loc) line cbegin cend x
in
raise (Stream.Error err)
end
]
| "empty" [ "["; "]" -> MVar(_loc, "`nil", Type("Any")) ]
| "atom" [ "`"; x = LIDENT -> MAtom(_loc, x) ]
| "empty" [ "["; "]" -> MAtom(_loc, "nil") ]
];
type_id: [
type_id: [
"atom_type" [ t = UIDENT -> Type(t) ]
| [ "'"; t = UIDENT -> PType(t) ]
| [ "("; t = complex_type_id; ")" -> t ]
......@@ -180,7 +167,7 @@ let get_loc expr = match expr with
| Var (loc, _) -> loc
| Int (loc, _) -> loc
| String (loc, _) -> loc
| Bool (loc, _) -> loc
| Atom (loc, _) -> loc
let caml_loc_to_cduce loc =
`File(Loc.file_name loc), Loc.start_off loc - Loc.start_bol loc,
......
tests/lambda/src/parse.mli
View file @ 64dcac8c
......@@ -10,7 +10,7 @@ type expr =
| Var of Loc.t * string
| Int of Loc.t * int
| String of Loc.t * string
| Bool of Loc.t * string
| Atom of Loc.t * string
and fun_name = string
and fv = (int * string) list
and branches = (Loc.t * match_value * expr) list
......@@ -19,7 +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 * bool
| MAtom of Loc.t * string
and ptype =
| Type of string
| PType of string
......
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