Commit 04247512 authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][EVAL] Environment management done; remains only to define branches

parent 8fbfb47b
......@@ -2,7 +2,6 @@ open Printf
open Parse
open Lambda
open Auto_pat
open Value
let page_size = 1000
......@@ -10,71 +9,65 @@ 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 }
a_size g_size =
{ parent=p; map=m; max_size=s; actual_size=a_size; global_size=g_size }
let parse_to_lambda expr = (* TODO: Replace dummy_branches *)
let rec env_find env el =
try Hashtbl.find env.map el with Not_found -> match env.parent with
| 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 =
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 map = Hashtbl.create page_size in
Hashtbl.add map fname 0;
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 *)
| el :: rest -> Hashtbl.add map el nbr;
let curr = [|Local(nbr)|] in
fill_params rest (Array.append res curr) (nbr + 1)
| [] -> res, nbr
in
fill_params interface [||] 0
fill_params interface [||] 1
in
Abstraction(params, [], dummy_branches, nbrparams, true, List([[]]))
| Var(vname) -> Var(Local(0)) (* TODO: Not supposed to be 0 *)
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 [[]])
| 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))
| 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)))
Const(Value.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)
Match(_parse_to_lambda env e, compile_branches env 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;
let new_env = mk_env ~parent:(Some env) ~max_size:env.max_size ~map:map
1 (env.global_size + 1) in
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"
val parse_to_lambda : Parse.expr -> Lambda.expr
open Printf
open Parse
open Value
let load_file f =
let ic = open_in f in
......@@ -9,13 +10,31 @@ 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 *)
| _ -> x . z (* That doesn't make any sense *)"*) "\"The cake is a lie\"" in
| _ -> x . z (* That doesn't make any sense *)"*) "let x = 2 in x" in
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 (Compile.parse_to_lambda expr) 100 in
Compile.print_value evalexpr; printf "\n"
print_value evalexpr; printf "\n"
......@@ -8,7 +8,7 @@ type expr =
| String of string
| Pair of expr * expr
| Match of expr * (expr * string option * expr) list
| Let of string * expr * expr;;
| Let of string * expr * expr
module ExprParser = struct
open Camlp4.PreCast
......@@ -55,9 +55,7 @@ module ExprParser = struct
END;;
let of_string s = Gram.parse_string exp_eoi (Loc.mk "<string>") s
let os = of_string
end;;
end
exception InvalidBranches;;
......
type expr =
| Apply of expr * expr
| Abstract of string * string list * expr
| Var of string
| Int of int
| String of string
| Pair of expr * expr
| Match of expr * (expr * string option * expr) list
| Let of string * expr * expr
module ExprParser : sig
val of_string : string -> expr
end
val print_expr : expr -> unit
val expr_to_string : expr -> 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