Commit 8fbfb47b authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][EVAL] Split compile from main; begin to code environments

parent 52f533a0
open Printf
open Parse
open Lambda
open Auto_pat
open Value
let page_size = 1000
type env =
{
parent: env option; (* None: toplevel *)
map: (string, int) Hashtbl.t;
locals: var_loc array;
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)
?locals:(l=Array.make s Dummy) actual_size global_size =
{ parent=p; map=m; locals=l; max_size=s; actual_size=actual_size;
global_size=global_size }
let parse_to_lambda expr = (* TODO: Replace dummy_branches *)
let rec _parse_to_lambda env expr =
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
match expr with
| Parse.Apply(e1, e2) ->
Apply(_parse_to_lambda env e1, _parse_to_lambda env e2)
| Abstract(fname, interface, body) ->
let params, nbrparams =
let rec fill_params params res nbr = match params with
| el :: rest ->
let curr = [|Local(0)|] in (* TODO: Not supposed to be 0 *)
fill_params rest (Array.append res curr) (nbr + 1)
| [] -> res, nbr
in
fill_params interface [||] 0
in
Abstraction(params, [], dummy_branches, nbrparams, true, List([[]]))
| Var(vname) -> Var(Local(0)) (* TODO: Not supposed to be 0 *)
| Int(i) -> Const(Value.Integer(Intervals.V.from_int i))
| String(s) ->
let s = Ident.U.mk s in
let nil_atom = Atoms.V.mk_ascii "nil" in
String(Ident.U.start_index s, Ident.U.end_index s, s,
Const(Atom(nil_atom)))
| Pair(e1, e2) -> Pair(_parse_to_lambda env e1, _parse_to_lambda env e2)
| Match(e, branches) ->
Match(_parse_to_lambda env e, dummy_branches)
| Let(x, e1, e2) -> (* TODO: Define the "_" *)
let map = Hashtbl.create page_size in
let new_env = mk_env ~parent:(Some env) ~max_size:env.max_size ~map:map
~locals:[|Local(env.global_size)|] 1 (env.global_size + 1) in
Hashtbl.add map x 0;
Apply(_parse_to_lambda new_env (Abstract("_", [x], e2)),
_parse_to_lambda env e1)
in
_parse_to_lambda (mk_env 0 0) expr
let rec print_value v = match v with
| Value.Pair(v1, v2) -> printf "("; print_value v1; printf ", ";
print_value v2; printf ")"
| Xml(_,_,_) -> printf "Xml"
| XmlNs(_,_,_,_) -> printf "XmlNs"
| Record(_) -> printf "Record"
| Atom(_) -> printf "Atom"
| Integer(i) -> printf "%d" (Big_int.int_of_big_int i)
| Char(i) -> printf "Char(%d)" i
| Abstraction(_, _) -> printf "Abstraction()"
| Abstract((name, _)) -> printf "Abstract(%s)" name
| String_latin1(i1, i2, s, v) -> printf "String_latin1(%d, %d, %s)" i1 i2 s;
print_value v
| String_utf8(_,_,s,_) -> printf "String(%s)" s
| Concat(v1, v2) -> printf "Concat("; print_value v1; printf ", ";
print_value v2; printf ")"
| Absent -> printf "Absent"
open Printf
open Parse
open Lambda
open Auto_pat
open Value
let rec parse_to_lambda expr = (* 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
match expr with
| Parse.Apply(e1, e2) -> Apply(parse_to_lambda e1, parse_to_lambda e2)
| Abstract(fname, interface, body) ->
let params, nbrparams =
let rec fill_params params res nbr = match params with
| el :: rest ->
let curr = [|Local(0)|] in (* TODO: Not supposed to be 0 *)
fill_params rest (Array.append res curr) (nbr + 1)
| [] -> res, nbr
in
fill_params interface [||] 0
in
Abstraction(params, [], dummy_branches, nbrparams, true, List([[]]))
| Var(vname) -> Var(Local(0)) (* TODO: Not supposed to be 0 *)
| Int(i) -> Const(Value.Integer(Intervals.V.from_int i))
| String(s) ->
let s = Ident.U.mk s in
let nil_atom = Atoms.V.mk_ascii "nil" in
String(Ident.U.start_index s, Ident.U.end_index s, s,
Const(Atom(nil_atom)))
| Pair(e1, e2) -> Pair(parse_to_lambda e1, parse_to_lambda e2)
| Match(e, branches) ->
Match(parse_to_lambda e, dummy_branches)
| Let(x, e1, e2) -> (* TODO: Define the "_" *)
Apply(parse_to_lambda (Abstract("_", [x], e2)), parse_to_lambda e1)
let load_file f =
let ic = open_in f in
......@@ -43,24 +9,6 @@ let load_file f =
close_in ic;
s
let rec print_value v = match v with
| Value.Pair(v1, v2) -> printf "("; print_value v1; printf ", ";
print_value v2; printf ")"
| Xml(_,_,_) -> printf "Xml"
| XmlNs(_,_,_,_) -> printf "XmlNs"
| Record(_) -> printf "Record"
| Atom(_) -> printf "Atom"
| Integer(i) -> printf "%d" (Big_int.int_of_big_int i)
| Char(i) -> printf "Char(%d)" i
| Abstraction(_, _) -> printf "Abstraction()"
| Abstract((name, _)) -> printf "Abstract(%s)" name
| String_latin1(i1, i2, s, v) -> printf "String_latin1(%d, %d, %s)" i1 i2 s;
print_value v
| String_utf8(_,_,s,_) -> printf "String(%s)" s
| Concat(v1, v2) -> printf "Concat("; print_value v1; printf ", ";
print_value v2; printf ")"
| Absent -> printf "Absent"
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 *)
......@@ -69,5 +17,5 @@ let expr = ExprParser.of_string str in
(*printf "Original: %s\nExpr: " str;
print_expr expr;
printf "\nResult: %s\n" (expr_to_string expr);*)
let evalexpr = Eval.expr (parse_to_lambda expr) 100 in
print_value evalexpr; printf "\n"
let evalexpr = Eval.expr (Compile.parse_to_lambda expr) 100 in
Compile.print_value evalexpr; printf "\n"
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