Commit 3a0266a9 authored by Julien Lopez's avatar Julien Lopez
Browse files

Add function name to gamma in compile

[TESTS][LAMBDA] Fix booleans; add some tests
parent 4325e177
......@@ -118,10 +118,10 @@ and compile_aux env = function
NsTable (ns, compile_aux env e)
and compile_abstr env a =
let fun_env =
let fun_env, fun_name =
match a.Typed.fun_name with
| Some x -> Env.add x (Env 0) Env.empty
| None -> Env.empty in
| Some x -> Env.add x (Env 0) Env.empty, [x, Types.cons a.Typed.fun_typ]
| None -> Env.empty, [] in
let (slots,nb_slots,fun_env) =
List.fold_left
......@@ -141,7 +141,8 @@ and compile_abstr env a =
let slots = Array.of_list (List.rev slots) in
let env = { env with vars = fun_env; stack_size = 0; max_stack = ref 0 } in
let env = { env with vars = fun_env; gamma = (env.gamma @ fun_name);
stack_size = 0; max_stack = ref 0 } in
let body = compile_branches env a.Typed.fun_body in
let sigma = `Sel(a.Typed.fun_fv,a.Typed.fun_iface,env.sigma) in
let polyvars =
......
......@@ -77,9 +77,9 @@ let rec _to_typed env l expr =
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) }
exp_descr=Cst (Types.Atom (Atoms.V.mk_ascii "true")) }
| "false" -> env, l, { exp_loc=loc; exp_typ=f;
exp_descr=Cst (Types.Atom 0) }
exp_descr=Cst (Types.Atom (Atoms.V.mk_ascii "false")) }
| _ ->
let line = Loc.start_line origloc in
let cbegin = Loc.start_off origloc - Loc.start_bol origloc in
......
......@@ -104,9 +104,37 @@ Any \\ ([ Char* ] | Int)),{})"
| x : Int -> `true
| x : String -> `false
| x : (!(Int|String)) -> x");
assert_equal ~msg:"Test CDuce.runtime.misc.is_int_applied1 failed"
~printer:(fun x -> x)
"Atom(true)"
(run_test_eval "(fun ((Int -> Bool) & (String -> Bool) & ((!(Int|String)) -> (!(Int|String))))
| x : Int -> `true
| x : String -> `false
| x : (!(Int|String)) -> x).2");
assert_equal ~msg:"Test CDuce.runtime.misc.is_int_applied2 failed"
~printer:(fun x -> x)
"Atom(false)"
(run_test_eval "(fun ((Int -> Bool) & (String -> Bool) & ((!(Int|String)) -> (!(Int|String))))
| x : Int -> `true
| x : String -> `false
| x : (!(Int|String)) -> x).\"coucou\"");
assert_equal ~msg:"Test CDuce.runtime.misc.is_int_applied3 failed"
~printer:(fun x -> x)
"(2, 3, {})"
(run_test_eval "(fun ((Int -> Bool) & (String -> Bool) & ((!(Int|String)) -> (!(Int|String))))
| x : Int -> `true
| x : String -> `false
| x : (!(Int|String)) -> x).[2; 3]");
assert_equal ~msg:"Test CDuce.runtime.misc.map failed"
~printer:(fun x -> x)
"Abstraction(((Int,Int), X1 -> X1 where X1 = (Int,Int)),{})"
"Abstraction(((`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | Arrow) ->
(`$B & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any |
Arrow), [ (`$A & Int | Char | Atom | (Any,Any) |
<(Any) (Any)>Any | Arrow)* ] -> [ (`$B & Int |
Char | Atom |
(Any,Any) |
<(Any) (Any)>Any |
Arrow)* ]),{})"
(run_test_eval "fun map f : ('A{}->'B{}) x : ['A{}] : ['B{}] ->
match x : ['A{}] with
| (el : 'A{}) :: (rest : ['A{}]) -> [f.el; (map.f).rest]
......
......@@ -180,7 +180,7 @@ let rec pp_value ppf = function
| Xml(_,_,_,sigma) -> Format.fprintf ppf "Xml(%a)" pp_sigma sigma
| XmlNs(_,_,_,_,sigma) -> Format.fprintf ppf "XmlNs(%a)" pp_sigma sigma
| Record(_,sigma) -> Format.fprintf ppf "Record(%a)" pp_sigma sigma
| Atom(_) -> Format.fprintf ppf "Atom"
| Atom(a) -> Format.fprintf ppf "Atom(%a)" Atoms.V.print a
| Integer(i) -> Format.fprintf ppf "%d" (Big_int.int_of_big_int i)
| Char(i) -> Format.fprintf ppf "Char()"
| Abstraction(None, _, sigma) ->
......
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