Commit 8367c11b authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Split compute and parse (needed to create the environment)

parent dcbf304d
......@@ -15,14 +15,15 @@ INEXTFILES = misc/custom.ml misc/encodings.ml misc/upool.ml misc/ns.ml\
types/externals.mli types/externals.ml typing/typer.ml\
runtime/run_dispatch.ml runtime/explain.ml schema/schema_pcre.ml\
schema/schema_xml.mli schema/schema_xml.ml schema/schema_common.mli\
schema/schema_common.ml runtime/eval.mli runtime/eval.ml compile/compile.ml\
types/compunit.mli types/compunit.ml types/var.ml types/boolVar.ml\
misc/imap.ml types/atoms.ml types/intervals.ml types/chars.mli types/chars.ml\
misc/bool.mli misc/bool.ml types/types.mli misc/stats.mli misc/stats.ml\
types/normal.mli types/normal.ml misc/pretty.mli misc/pretty.ml\
types/types.ml compile/auto_pat.mli runtime/value.mli runtime/value.ml\
schema/schema_types.mli schema/schema_validator.mli schema/schema_builtin.mli\
schema/schema_builtin.ml schema/schema_validator.ml compile/lambda.ml
schema/schema_common.ml runtime/eval.mli runtime/eval.ml compile/compile.mli\
compile/compile.ml types/compunit.mli types/compunit.ml types/var.ml\
types/boolVar.ml misc/imap.ml types/atoms.ml types/intervals.ml\
types/chars.mli types/chars.ml misc/bool.mli misc/bool.ml types/types.mli\
misc/stats.mli misc/stats.ml types/normal.mli types/normal.ml misc/pretty.mli\
misc/pretty.ml types/types.ml compile/auto_pat.mli runtime/value.mli\
runtime/value.ml schema/schema_types.mli schema/schema_validator.mli\
schema/schema_builtin.mli schema/schema_builtin.ml schema/schema_validator.ml\
compile/lambda.ml
EXTFILES = $(INEXTFILES:%=$(ROOTDIR)/%)
RM ?= rm -f
......
<src>: include
<src/parse*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/main*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/parse*>: pp(camlp4orf.opt), package(camlp4.lib)
<src/compute*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/main*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/externals>: include
<src/externals/schema_*>: package(pcre, netcgi2, unix, netsys, str)
<src/externals/schema_*>: package(pcre, netcgi2)
<src/externals/cduce_loc*>: package(ulex), syntax(camlp4o)
open Parse
open Typed
open Camlp4.PreCast
let rec to_typed expr =
let env = Compile.empty_toplevel in match expr with
| Parse.Apply (loc, e1, e2) ->
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
env, { exp_loc=loc; exp_typ=Types.any;
exp_descr=Apply(snd (to_typed e1), snd (to_typed e2)) }
| Abstr (loc, fun_name, params, return_type, body) ->
env, parse_abstr loc fun_name params return_type body
| Match (loc, e, b) ->
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
let b = parse_branches b [] in
let brs = { br_typ=Types.any; br_accept=Types.any; br_branches=b } in
env, { exp_loc=loc; exp_typ=Types.any;
exp_descr=Match(snd (to_typed e), brs) }
| Pair (loc, e1, e2) ->
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
env, { exp_loc=loc; exp_typ=Types.any;
exp_descr=Pair(snd(to_typed e1), snd(to_typed e2)) }
| Var (loc, vname) ->
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
env, { exp_loc=loc; exp_typ=Types.any; exp_descr=Var(0, vname) }
| Int (loc, i) ->
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
let i = Big_int.big_int_of_int i in
env, { exp_loc=loc; exp_typ=Types.any; exp_descr=Cst(Types.Integer i) }
| String (loc, s) ->
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
let s = Types.String (0, (String.length s) - 1, s,
Types.Integer (Big_int.big_int_of_int 0)) in
env, { exp_loc=loc; exp_typ=Types.any; exp_descr=Cst s }
and parse_abstr loc fun_name params return_type body =
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
let node = Patterns.make [] in
let brloc = get_loc body in
let brloc = `File(Loc.file_name brloc),
Loc.start_off brloc - Loc.start_bol brloc,
Loc.stop_off brloc - Loc.start_bol brloc in
let br = { br_loc=brloc; br_used=true; br_ghost=false;
br_vars_empty=[]; br_pat=node;
br_body=snd(to_typed body) } in
let brs = { br_typ=Types.any; br_accept=Types.any;
br_branches=[br] } in
let iface = parse_iface params [] in
{ exp_loc=loc; exp_typ=Types.any;
exp_descr=Abstraction({ fun_name=Some (0, fun_name); fun_iface=iface;
fun_body=brs; fun_typ=Types.any; fun_fv=[] }) }
and parse_iface params res = match params with
| _ :: rest -> parse_iface rest (res @ [Types.any, Types.any])
| [] -> res
and parse_branches brs res = match brs with
| (loc, p, e) :: rest ->
let loc = `File(Loc.file_name loc),
Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc in
let node = Patterns.make [] in
let b = { br_loc=loc; br_used=true; br_ghost=false; br_vars_empty=[];
br_pat=node; br_body=snd(to_typed e)} in
parse_branches rest (res @ [b])
| [] -> res
val to_typed : Parse.expr -> Compile.env * Typed.texpr
open Printf
open Parse
open Compile
open Value
open Camlp4.PreCast
......@@ -36,8 +35,8 @@ let str, file =
in
try
let expr = ExprParser.of_string str file in
let lambdaexpr = compile (mk None) expr in
let evalexpr = Eval.expr lambdaexpr 100 in
let env, texpr = Compute.to_typed expr in
let evalexpr = Compile.compile_eval_expr env texpr in
print_value evalexpr; printf "\n"
with
| Loc.Exc_located (loc, exn) ->
......
open Printf
open Typed
open Patterns
open Camlp4.PreCast
type expr =
| Apply of Loc.t * expr * expr
| Abstr of Loc.t * fun_name * params * ptype * expr
| Match of Loc.t * expr * branches
| Pair of Loc.t * expr * expr
| Var of Loc.t * string
| Int of Loc.t * int
| String of Loc.t * string
and fun_name = string
and params = (Loc.t * string * ptype) list
and branches = (Loc.t * match_value * expr) list
and match_value =
| MPair of Loc.t * match_value * match_value
| MVar of Loc.t * string * ptype
| MInt of Loc.t * int
| MString of Loc.t * string
and ptype = string
module ExprParser = struct
let exp_eoi = Gram.Entry.mk "exp_eoi"
......@@ -15,101 +31,41 @@ module ExprParser = struct
expression:
[
"abstr" RIGHTA
[ "fun"; x = LIDENT; p = LIST1 param; ":"; t = UIDENT; "->"; e = SELF ->
let loc = `File(Loc.file_name _loc),
Loc.start_off _loc - Loc.start_bol _loc,
Loc.stop_off _loc - Loc.start_bol _loc in
let node = Patterns.make [] in
let br = { br_loc=e.exp_loc; br_used=true; br_ghost=false;
br_vars_empty=[]; br_pat=node; br_body=e } in
let brs = { br_typ=Types.any; br_accept=Types.any;
br_branches=[br] } in
{ exp_loc=loc; exp_typ=Types.any;
exp_descr=Abstraction({ fun_name=Some (0, x); fun_iface=p;
fun_body=brs; fun_typ=Types.any; fun_fv=[] }) }
| "match"; e1 = SELF; "with"; b = LIST1 branch ->
let loc = `File(Loc.file_name _loc),
Loc.start_off _loc - Loc.start_bol _loc,
Loc.stop_off _loc - Loc.start_bol _loc in
let brs = { br_typ=Types.any; br_accept=Types.any; br_branches=b } in
{ exp_loc=loc; exp_typ=Types.any; exp_descr=Match(e1, brs) } ]
[ "fun"; x = LIDENT; p = LIST1 param; ":"; t = UIDENT; "->";
e = SELF -> Abstr(_loc, x, p, t, e)
| "match"; e = SELF; "with"; b = LIST1 branch -> Match(_loc, e, b) ]
| "pair" LEFTA
[ e1 = SELF; ","; e2 = SELF ->
let loc = `File(Loc.file_name _loc),
Loc.start_off _loc - Loc.start_bol _loc,
Loc.stop_off _loc - Loc.start_bol _loc in
{ exp_loc=loc; exp_typ=Types.any; exp_descr=Pair(e1, e2) }
| e1 = SELF ; "."; e2 = SELF ->
let loc = `File(Loc.file_name _loc),
Loc.start_off _loc - Loc.start_bol _loc,
Loc.stop_off _loc - Loc.start_bol _loc in
{ exp_loc=loc; exp_typ=Types.any; exp_descr=Apply(e1, e2) } ]
[ e1 = SELF; ","; e2 = SELF -> Pair(_loc, e1, e2)
| e1 = SELF ; "."; e2 = SELF -> Apply(_loc, e1, e2) ]
| "paren" [ "("; e = SELF; ")" -> e ]
| "var"
[ x = LIDENT ->
let loc = `File(Loc.file_name _loc),
Loc.start_off _loc - Loc.start_bol _loc,
Loc.stop_off _loc - Loc.start_bol _loc in
{ exp_loc=loc; exp_typ=Types.any; exp_descr=Var(0, x) } ]
| "int"
[ x = INT ->
let loc = `File(Loc.file_name _loc),
Loc.start_off _loc - Loc.start_bol _loc,
Loc.stop_off _loc - Loc.start_bol _loc in
let x = Big_int.big_int_of_int (int_of_string x) in
{ exp_loc=loc; exp_typ=Types.any; exp_descr=Cst(Types.Integer x) } ]
| "string"
[ x = STRING ->
let loc = `File(Loc.file_name _loc),
Loc.start_off _loc - Loc.start_bol _loc,
Loc.stop_off _loc - Loc.start_bol _loc in
let x = Types.String (0, (String.length x) - 1, x,
Types.Integer (Big_int.big_int_of_int 0)) in
{ exp_loc=loc; exp_typ=Types.any; exp_descr=Cst x } ]
| "var" [ x = LIDENT -> Var(_loc, x) ]
| "int" [ x = INT -> Int(_loc, int_of_string x) ]
| "string" [ x = STRING -> String(_loc, x) ]
];
param:[[p = LIDENT; ":"; t = UIDENT -> Types.any, Types.any]];
param:[[p = LIDENT; ":"; t = UIDENT -> _loc, p, t]];
branch:
[
"branch" LEFTA
[ "|"; t = match_value; "->"; e = expression ->
let loc = `File(Loc.file_name _loc),
Loc.start_off _loc - Loc.start_bol _loc,
Loc.stop_off _loc - Loc.start_bol _loc in
let node = Patterns.make [] in
{ br_loc=loc; br_used=true; br_ghost=false; br_vars_empty=[];
br_pat=node; br_body=e } ]
];
branch:[ "branch" [ "|"; t = match_value; "->"; e = expression ->
_loc, t, e ]];
match_value:
[
"pair" LEFTA [ e1 = SELF; ","; e2 = SELF ->
let loc = `File(Loc.file_name _loc),
Loc.start_off _loc - Loc.start_bol _loc,
Loc.stop_off _loc - Loc.start_bol _loc in
{ exp_loc=loc; exp_typ=Types.any; exp_descr=Pair(e1, e2) } ]
"pair" LEFTA [ e1 = SELF; ","; e2 = SELF -> MPair(_loc, e1, e2) ]
| "paren" [ "("; e = SELF; ")" -> e ]
| "var" [ x = LIDENT; ":"; t = UIDENT ->
let loc = `File(Loc.file_name _loc),
Loc.start_off _loc - Loc.start_bol _loc,
Loc.stop_off _loc - Loc.start_bol _loc in
{ exp_loc=loc; exp_typ=Types.any; exp_descr=Var(0, x) } ]
| "int" [ x = INT ->
let loc = `File(Loc.file_name _loc),
Loc.start_off _loc - Loc.start_bol _loc,
Loc.stop_off _loc - Loc.start_bol _loc in
let x = Big_int.big_int_of_int (int_of_string x) in
{ exp_loc=loc; exp_typ=Types.any; exp_descr=Cst(Types.Integer x) } ]
| "string" [ x = STRING ->
let loc = `File(Loc.file_name _loc),
Loc.start_off _loc - Loc.start_bol _loc,
Loc.stop_off _loc - Loc.start_bol _loc in
let x = Types.String (0, (String.length x) - 1, x,
Types.Integer (Big_int.big_int_of_int 0)) in
{ exp_loc=loc; exp_typ=Types.any; exp_descr=Cst x } ]
| "var" [ x = LIDENT; ":"; t = UIDENT -> MVar(_loc, x, t) ]
| "int" [ x = INT -> MInt(_loc, int_of_string x) ]
| "string" [ x = STRING -> MString(_loc, x) ]
];
END;;
let of_string s file = Gram.parse_string exp_eoi (Loc.mk file) s
end
let get_loc expr = match expr with
| Apply (loc, _, _) -> loc
| Abstr (loc, _, _, _, _) -> loc
| Match (loc, _, _) -> loc
| Pair (loc, _, _) -> loc
| Var (loc, _) -> loc
| Int (loc, _) -> loc
| String (loc, _) -> loc
open Camlp4.PreCast
type expr =
| Apply of Loc.t * expr * expr
| Abstr of Loc.t * fun_name * params * ptype * expr
| Match of Loc.t * expr * branches
| Pair of Loc.t * expr * expr
| Var of Loc.t * string
| Int of Loc.t * int
| String of Loc.t * string
and fun_name = string
and params = (Loc.t * string * ptype) list
and branches = (Loc.t * match_value * expr) list
and match_value =
| MPair of Loc.t * match_value * match_value
| MVar of Loc.t * string * ptype
| MInt of Loc.t * int
| MString of Loc.t * string
and ptype = string
module ExprParser : sig
val of_string : string -> string -> Typed.texpr
val of_string : string -> string -> expr
end
val get_loc : expr -> Loc.t
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