Commit 29949bdc authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][EVAL] First results on abstractions; but branches still not complete

parent 04247512
......@@ -6,13 +6,13 @@ open Auto_pat
let page_size = 1000
type env =
{
parent: env option; (* None: toplevel *)
map: (string, int) Hashtbl.t;
max_size: int;
actual_size: int;
global_size: int
}
{
parent: env option; (* None: toplevel *)
map: (string, int) Hashtbl.t;
max_size: int;
actual_size: int;
global_size: int
}
let mk_env ?parent:(p=None) ?max_size:(s=page_size) ?map:(m=Hashtbl.create s)
a_size g_size =
......@@ -23,13 +23,6 @@ let rec env_find env el =
| Some p -> env_find p el
| None -> raise Not_found
let compile_branches env body = (* TODO: Replace dummy_branches *)
let dummy_state = { uid=0; arity=[||]; actions=AIgnore(0,[||],0);
fail_code=0; expected_type="" } in
let dummy_branches = { brs_accept_chars=true; brs_disp=dummy_state;
brs_rhs=[||]; brs_stack_pos=0 } in
dummy_branches
let parse_to_lambda expr =
let rec _parse_to_lambda env expr =
match expr with
......@@ -41,7 +34,7 @@ let parse_to_lambda expr =
let params, nbrparams =
let rec fill_params params res nbr = match params with
| el :: rest -> Hashtbl.add map el nbr;
let curr = [|Local(nbr)|] in
let curr = [|Local(env.global_size + nbr)|] in
fill_params rest (Array.append res curr) (nbr + 1)
| [] -> res, nbr
in
......@@ -49,8 +42,8 @@ let parse_to_lambda expr =
in
let new_env = mk_env ~parent:(Some env) ~max_size:env.max_size ~map:map
nbrparams (env.global_size + nbrparams + 1) in
Abstraction(params, [], compile_branches new_env body, nbrparams, true,
List [[]])
let brs = compile_func_body new_env body in
Abstraction(params, [], brs, nbrparams, true, List [[]])
| Var(vname) -> (try let index = env_find env vname in Var(Local(index))
with Not_found -> raise Not_found)
| Int(i) -> Const(Value.Integer(Intervals.V.from_int i))
......@@ -69,5 +62,29 @@ let parse_to_lambda expr =
1 (env.global_size + 1) in
Apply(_parse_to_lambda new_env (Abstract("_", [x], e2)),
_parse_to_lambda env e1)
(* TODO: Fix this function *)
and compile_func_body env body =
let dummy_state = { uid=0; arity=[||]; actions=AIgnore(0,[||],0);
fail_code=0; expected_type="" } in
let body = _parse_to_lambda env body in
{ brs_accept_chars=true; brs_disp=dummy_state;
brs_rhs=[|Auto_pat.Match (0, body)|]; brs_stack_pos=env.global_size }
(* TODO: Fix this function *)
and compile_branches env brs =
let dummy_state = { uid=0; arity=[||]; actions=AIgnore(0,[||],0);
fail_code=0; expected_type="" } in
let rec aux env brs rhs uid =
match brs with
(* match ? with | m & t -> e | ... *)
| (m, t, e) :: rest ->
let e = _parse_to_lambda env e in
aux env rest (Array.append rhs [|Auto_pat.Match (uid, e)|]) (uid + 1)
| [] -> dummy_state, rhs
in
let (state, rhs) = aux env brs [||] 0 in
{ brs_accept_chars=true; brs_disp=state; brs_rhs=rhs;
brs_stack_pos=env.global_size }
in
_parse_to_lambda (mk_env 0 0) expr
......@@ -31,7 +31,7 @@ let rec print_value v = match v with
let str = if Array.length Sys.argv > 1 then load_file Sys.argv.(1)
else (*"let z = 3 in fun firsts x y -> match x,y with
| (a,_),(b,_) -> a,b (* This (* is (* a nested *) *) comment *)
| _ -> x . z (* That doesn't make any sense *)"*) "let x = 2 in x" in
| _ -> x . z (* That doesn't make any sense *)"*) "(fun f x y -> x, y), (fun f x -> x)" in
let expr = ExprParser.of_string str in
(*printf "Original: %s\nExpr: " str;
print_expr expr;
......
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