Commit 3322367e authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][EVAL] Locations and some error messages added

	Abstractions are required to have at least one parameter now
	Add tests for evaluation
	Small fix in compilation of let expression (still not work though)
parent 25cf1919
......@@ -10,7 +10,7 @@ expr = id
| "let" id "=" expr "in" expr
| expr ";;" expr (* TODO *)
abstr = "fun" id params "->" expr
abstr = "fun" id id params "->" expr (* At least one parameter *)
match_value = id
| integer
......
<src>: include
<src/compile*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/parse*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/main*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
......
......@@ -2,9 +2,12 @@ open Printf
open Parse
open Lambda
open Auto_pat
open Camlp4.PreCast
let page_size = 1000
exception Error
type env =
{
parent: env option; (* None: toplevel *)
......@@ -26,9 +29,9 @@ let rec env_find env el =
let parse_to_lambda expr =
let rec _parse_to_lambda env expr =
match expr with
| Parse.Apply(e1, e2) ->
| Parse.Apply(_, e1, e2) ->
Apply(_parse_to_lambda env e1, _parse_to_lambda env e2)
| Abstract(fname, interface, body) ->
| Abstract(_, fname, interface, body) ->
let map = Hashtbl.create page_size in
Hashtbl.add map fname 0;
let params, nbrparams =
......@@ -44,23 +47,32 @@ let parse_to_lambda expr =
nbrparams (env.global_size + nbrparams) in
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))
| String(s) ->
| Var(loc, vname) ->
(try let index = env_find env vname in Var(Local(index))
with Not_found ->
let l = Loc.start_line loc in
let cbegin = Loc.start_off loc - Loc.start_bol loc in
let cend = Loc.stop_off loc - Loc.start_bol loc in
eprintf "File %s, line %d, characters %d-%d:\nUnbound identifier\n"
Sys.argv.(1) l cbegin cend; raise Error)
| Int(_, i) -> Const(Value.Integer(Intervals.V.from_int i))
| String(loc, 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(Value.Atom(nil_atom)))
| Pair(e1, e2) -> Pair(_parse_to_lambda env e1, _parse_to_lambda env e2)
| Match(e, branches) ->
| Pair(_, e1, e2) -> Pair(_parse_to_lambda env e1,
_parse_to_lambda env e2)
| Match(_, e, branches) ->
Match(_parse_to_lambda env e, compile_branches env branches)
| Let(x, e1, e2) -> (* TODO: Define the "_" *)
| Let(_, x, e1, e2) -> (* TODO: Define the "_" *)
let map = Hashtbl.create page_size in
Hashtbl.add map x 0;
Hashtbl.add map "_" 0;
Hashtbl.add map x 1;
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)),
2 (env.global_size + 2) in
let newloc = Camlp4.PreCast.Loc.ghost in
Apply(_parse_to_lambda new_env (Abstract(newloc, "_", [x], e2)),
_parse_to_lambda env e1)
(* TODO: Fix this function *)
......@@ -80,9 +92,9 @@ let parse_to_lambda expr =
(* match orig with | m & t -> e | ... *)
| (m, t, e) :: rest ->
let rec env_match_value map m nbr = match m with
| MVar(vname) -> Hashtbl.add map vname nbr; map, (nbr + 1)
| MVar(_, vname) -> Hashtbl.add map vname nbr; map, (nbr + 1)
| MInt(_) | MString(_) -> map, nbr
| MPair(m1, m2) ->
| MPair(_, m1, m2) ->
let map, nbr = env_match_value map m1 nbr in
env_match_value map m2 nbr in
let map, nbvars = env_match_value (Hashtbl.create page_size) m 0 in
......
exception Error
val parse_to_lambda : Parse.expr -> Lambda.expr
......@@ -28,13 +28,16 @@ let rec print_value v = match v with
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 *)"*) "let x = 2 in match x with | x -> x" in
let expr = ExprParser.of_string str in
let str, file =
if Array.length Sys.argv > 1 then load_file Sys.argv.(1), Sys.argv.(1)
else (eprintf "Fatal error: No input file\n"; exit 1)
in
let expr = ExprParser.of_string str file 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
print_value evalexpr; printf "\n"
try
let lambdaexpr = Compile.parse_to_lambda expr in
let evalexpr = Eval.expr lambdaexpr 100 in
print_value evalexpr; printf "\n"
with Compile.Error -> exit 3
open Printf
open Camlp4.PreCast
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 * (match_value * string option * expr) list
| Let of string * expr * expr
| Apply of Loc.t * expr * expr
| Abstract of Loc.t * string * string list * expr
| Var of Loc.t * string
| Int of Loc.t * int
| String of Loc.t * string
| Pair of Loc.t * expr * expr
| Match of Loc.t * expr * (match_value * string option * expr) list
| Let of Loc.t * string * expr * expr
and match_value =
| MVar of string
| MInt of int
| MString of string
| MPair of match_value * match_value
| MVar of Loc.t * string
| MInt of Loc.t * int
| MString of Loc.t * string
| MPair of Loc.t * match_value * match_value
module ExprParser = struct
open Camlp4.PreCast
let exp_eoi = Gram.Entry.mk "exp_eoi"
......@@ -30,75 +30,79 @@ module ExprParser = struct
[
"letexpr"
[ "let"; x = LIDENT; "="; e1 = expression; "in"; e2 = expression ->
Let(x, e1, e2)
Let(_loc, x, e1, e2)
| "let"; x = UIDENT; "="; e1 = expression; "in"; e2 = expression ->
Let(x, e1, e2) ]
Let(_loc, x, e1, e2) ]
| "abstr" RIGHTA
[ "fun"; x = LIDENT; p = LIST0 param; "->"; e = expression ->
Abstract(x, p, e)
| "fun"; x = UIDENT; p = LIST0 param; "->"; e = expression ->
Abstract(x, p, e)
| "match"; e1 = expression; "with"; b = LIST1 branch -> Match(e1, b) ]
[ "fun"; x = LIDENT; p = LIST1 param; "->"; e = expression ->
Abstract(_loc, x, p, e)
| "fun"; x = UIDENT; p = LIST1 param; "->"; e = expression ->
Abstract(_loc, x, p, e)
| "match"; e1 = expression; "with"; b = LIST1 branch ->
Match(_loc, e1, b) ]
| "pair" LEFTA
[ e1 = expression; ","; e2 = expression -> Pair(e1,e2)
| e1 = expression ; "."; e2 = expression -> Apply(e1,e2) ]
| "paren"
[ "("; e = expression; ")" -> e ]
[ e1 = expression; ","; e2 = expression -> Pair(_loc, e1, e2)
| e1 = expression ; "."; e2 = expression -> Apply(_loc, e1, e2) ]
| "paren" [ "("; e = expression; ")" -> e ]
| "var"
[ x = LIDENT -> Var(x)
| x = UIDENT -> Var(x) ]
[ x = LIDENT -> Var(_loc, x)
| x = UIDENT -> Var(_loc, x) ]
| "int"
[ x = INT -> Int(int_of_string x) ]
[ x = INT -> Int(_loc, int_of_string x) ]
| "string"
[ x = STRING -> String(x) ]
[ x = STRING -> String(_loc, x) ]
];
param:[[p = LIDENT -> p | p = UIDENT -> p]];
branch:
[
"branches" LEFTA
[ "|"; t = match_value; "->"; e = expression -> (t, None, e)
| "|"; t = match_value; "&"; x = LIDENT; "->"; e = expression ->
(t, Some x, e)
| "|"; t = match_value; "&"; x = UIDENT; "->"; e = expression ->
(t, Some x, e) ]
"branches" LEFTA
[ "|"; t = match_value; "->"; e = expression -> (t, None, e)
| "|"; t = match_value; "&"; x = LIDENT; "->"; e = expression ->
(t, Some x, e)
| "|"; t = match_value; "&"; x = UIDENT; "->"; e = expression ->
(t, Some x, e) ]
];
match_value:
[
"pair" LEFTA
[ e1 = match_value; ","; e2 = match_value -> MPair(e1,e2) ]
"pair" LEFTA
[ e1 = match_value; ","; e2 = match_value -> MPair(_loc, e1, e2) ]
| "paren"
[ "("; e = match_value; ")" -> e ]
| "var"
[ x = LIDENT -> MVar(x)
| x = UIDENT -> MVar(x) ]
[ x = LIDENT ->
MVar(_loc, x)
| x = UIDENT ->
MVar(_loc, x) ]
| "int"
[ x = INT -> MInt(int_of_string x) ]
[ x = INT ->
MInt(_loc, int_of_string x) ]
| "string"
[ x = STRING -> MString(x) ]
[ x = STRING ->
MString(_loc, x) ]
];
END;;
let of_string s = Gram.parse_string exp_eoi (Loc.mk "<string>") s
let of_string s file = Gram.parse_string exp_eoi (Loc.mk file) s
end
exception InvalidBranches;;
let rec print_expr expr = match expr with
| Apply(e1, e2) -> printf "Apply("; print_expr e1; printf ", ";
| Apply(_, e1, e2) -> printf "Apply("; print_expr e1; printf ", ";
print_expr e2; printf ")"
| Abstract(fname, params, e) -> printf "Abstract(%s" fname;
| Abstract(_, fname, params, e) -> printf "Abstract(%s" fname;
print_params params; printf ", "; print_expr e; printf ")"
| Var(vname) -> printf "Var(%s)" vname
| Int(i) -> printf "Int(%d)" i
| String(s) -> printf "String(%s)" s
| Pair(e1, e2) -> printf "Pair("; print_expr e1; printf ", "; print_expr e2;
printf ")"
| Match(e, b) -> printf "Match("; print_expr e; printf ", ";
| Var(_, vname) -> printf "Var(%s)" vname
| Int(_, i) -> printf "Int(%d)" i
| String(_, s) -> printf "String(%s)" s
| Pair(_, e1, e2) -> printf "Pair("; print_expr e1; printf ", ";
print_expr e2; printf ")"
| Match(_, e, b) -> printf "Match("; print_expr e; printf ", ";
print_branches b; printf ")"
| Let(x, e1, e2) -> printf "Let(%s, " x; print_expr e1; printf ", ";
| Let(_, x, e1, e2) -> printf "Let(%s, " x; print_expr e1; printf ", ";
print_expr e2; printf ")"
and print_params params = match params with
......@@ -113,24 +117,24 @@ and print_branches b = match b with
| [] -> ()
and print_mvalues mv = match mv with
| MVar(vname) -> printf "Var(%s)" vname
| MInt(i) -> printf "Int(%d)" i
| MString(s) -> printf "String(%s)" s
| MPair(e1, e2) -> printf "Pair("; print_mvalues e1; printf ", ";
| MVar(_, vname) -> printf "Var(%s)" vname
| MInt(_, i) -> printf "Int(%d)" i
| MString(_, s) -> printf "String(%s)" s
| MPair(_, e1, e2) -> printf "Pair("; print_mvalues e1; printf ", ";
print_mvalues e2; printf ")"
let rec expr_to_string expr = match expr with
| Apply(e1, e2) -> (expr_to_string e1) ^ " . " ^ (expr_to_string e2)
| Abstract(fname, params, e) -> "fun " ^ fname ^ (params_to_string params)
| Apply(_, e1, e2) -> (expr_to_string e1) ^ " . " ^ (expr_to_string e2)
| Abstract(_, fname, params, e) -> "fun " ^ fname ^ (params_to_string params)
^ " -> " ^ (expr_to_string e)
| Var(vname) -> vname
| Int(i) -> string_of_int i
| String(s) -> "\"" ^ s ^ "\""
| Pair(e1, e2) -> "(" ^ (expr_to_string e1) ^ ", " ^ (expr_to_string e2)
| Var(_, vname) -> vname
| Int(_, i) -> string_of_int i
| String(_, s) -> "\"" ^ s ^ "\""
| Pair(_, e1, e2) -> "(" ^ (expr_to_string e1) ^ ", " ^ (expr_to_string e2)
^ ")"
| Match(e, b) -> "match " ^ (expr_to_string e) ^ " with"
| Match(_, e, b) -> "match " ^ (expr_to_string e) ^ " with"
^ (branches_to_string b)
| Let(x, e1, e2) -> "let " ^ x ^ " = " ^ (expr_to_string e1) ^ " in "
| Let(_, x, e1, e2) -> "let " ^ x ^ " = " ^ (expr_to_string e1) ^ " in "
^ (expr_to_string e2)
and params_to_string params = match params with
......@@ -145,8 +149,8 @@ and branches_to_string b = match b with
| [] -> ""
and mvalues_to_string mv = match mv with
| MVar(vname) -> vname
| MInt(i) -> string_of_int i
| MString(s) -> "\"" ^ s ^ "\""
| MPair(e1, e2) -> "(" ^ (mvalues_to_string e1) ^ ", "
| MVar(_, vname) -> vname
| MInt(_, i) -> string_of_int i
| MString(_, s) -> "\"" ^ s ^ "\""
| MPair(_, e1, e2) -> "(" ^ (mvalues_to_string e1) ^ ", "
^ (mvalues_to_string e2) ^ ")"
open Camlp4.PreCast
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 * (match_value * string option * expr) list
| Let of string * expr * expr
| Apply of Loc.t * expr * expr
| Abstract of Loc.t * string * string list * expr
| Var of Loc.t * string
| Int of Loc.t * int
| String of Loc.t * string
| Pair of Loc.t * expr * expr
| Match of Loc.t * expr * (match_value * string option * expr) list
| Let of Loc.t * string * expr * expr
and match_value =
| MVar of string
| MInt of int
| MString of string
| MPair of match_value * match_value
| MVar of Loc.t * string
| MInt of Loc.t * int
| MString of Loc.t * string
| MPair of Loc.t * match_value * match_value
module ExprParser : sig
val of_string : string -> expr
val of_string : string -> string -> expr
end
val print_expr : expr -> unit
......
Original: fun f a->a
Expr: Abstract(f a, Var(a))
Result: fun f a -> a
Abstraction()
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