Commit 07458a8d authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Ignore unused branches; code cleanup

parent 4d4237a4
......@@ -5,8 +5,9 @@ expr = id
| expr "." expr
| expr "," expr
| "(" expr ")"
| "match" expr "with" "|" match_value "->" expr branches
| "match" expr ":" type_id "with" "|" match_value "->" expr branches
(* TODO: Add the "_" special keyword *)
abstr = "fun" id id ":" type_id params ":" type_id "->" expr
match_value = id ":" type_id
......@@ -23,6 +24,7 @@ branches = (* empty *)
id = [a-z_][A-Za-z0-9_]*
(* TODO: Add union and polymorphic types *)
type_id = [A-Z][A-Za-z0-9_]*
integer = [0-9]+
......@@ -3,70 +3,56 @@ open Typed
open Compile
open Camlp4.PreCast
(* Gives a unique id for a name *)
module Locals = Map.Make(String)
(* To throw in case of an unbound name *)
exception Error
(* TODO: We will need a much better representation of types and a much better
function when we'll add union types and polymorphism. *)
let is_subtype t1 t2 = if String.compare t1 t2 = 0 then true else false
let rec _to_typed env l expr =
(* From Camlp4 locations to CDuce locations *)
let loc = caml_loc_to_cduce (get_loc expr) 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
| Parse.Apply (_, e1, e2) ->
let _, _, e1 = _to_typed env l e1 in
let _, _, e2 = _to_typed env l e2 in
env, l, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Apply(e1, e2) }
| Abstr (loc, fun_name, params, return_type, body) ->
| Abstr (_, fun_name, params, return_type, body) ->
parse_abstr env l 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 env l b [] in
| Match (_, e, t, b) ->
let b = parse_branches env l t b [] in
let brs = { br_typ=Types.empty; br_accept=Types.empty; br_branches=b } in
let _, _, exp_descr = _to_typed env l e in
env, l, { exp_loc=loc; exp_typ=Types.empty;
exp_descr=Match(exp_descr, 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
| Pair (_, e1, e2) ->
let _, _, exp_descr1 = _to_typed env l e1 in
let _, _, exp_descr2 = _to_typed env l e2 in
env, l, { exp_loc=loc; exp_typ=Types.empty;
exp_descr=Pair(exp_descr1, exp_descr2) }
| Var (loc, vname) ->
let line = 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
| Var (origloc, vname) ->
let line = Loc.start_line origloc in
let cbegin = Loc.start_off origloc - Loc.start_bol origloc in
let cend = Loc.stop_off origloc - Loc.start_bol origloc in
let index = (try Locals.find vname l with Not_found ->
Printf.eprintf "File %s, line %d, characters %d-%d:\nUnbound identifier %s\n"
(Loc.file_name loc) line cbegin cend vname; raise Error) in
let loc = `File(Loc.file_name loc), cbegin, cend in
(Loc.file_name origloc) line cbegin cend vname; raise Error) in
env, l, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Var(index, 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
| Int (_, i) ->
let i = Big_int.big_int_of_int i in
env, l, { exp_loc=loc; exp_typ=Types.empty;
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
| String (_, s) ->
let s = Types.String (0, (String.length s) - 1, s,
Types.Integer (Big_int.big_int_of_int 0)) in
env, l, { exp_loc=loc; exp_typ=Types.empty; exp_descr=Cst s }
and parse_abstr env l 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 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 brloc = caml_loc_to_cduce (get_loc body) in
let env, l, fv, iface = parse_iface env l params [] 0 [] in
let node = Patterns.make fv in
let _, _, br_body = _to_typed env l body in
......@@ -84,18 +70,31 @@ and parse_iface env l params fv nb iface = match params with
(iface @ [Types.empty, Types.empty])
| [] -> env, l, fv, iface
and parse_branches env l brs res = match brs with
and parse_branches env l toptype 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 brloc = caml_loc_to_cduce loc in
let br_locals, br_used = parse_match_value env l p toptype in
let line = 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
let node = Patterns.make [] in
let _, _, br_body = _to_typed env l e in
let b = { br_loc=loc; br_used=true; br_ghost=false; br_vars_empty=[];
let _, _, br_body = _to_typed env br_locals e in
let b = { br_loc=brloc; br_used=br_used; br_ghost=false; br_vars_empty=[];
br_pat=node; br_body=br_body} in
parse_branches env l rest (res @ [b])
let fname = Loc.file_name loc in
if not br_used then Printf.eprintf
"File %s, line %d, characters %d-%d:\nWarning: This branch is not used\n"
fname line cbegin cend;
parse_branches env l toptype rest (res @ [b])
| [] -> res
and parse_match_value env l p toptype = match p with
| MPair (_) -> l, false; (* TODO: Allow pairs in types *)
| MVar (_, mname, mtype) -> Locals.add mname (Locals.cardinal l) l,
is_subtype toptype mtype
| MInt (_) -> l, is_subtype toptype "Int"
| MString (_) -> l, is_subtype toptype "String"
let to_typed expr =
let env, _, expr = _to_typed empty_toplevel Locals.empty expr in
env, expr
......@@ -4,7 +4,7 @@ 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
| Match of Loc.t * expr * ptype * branches
| Pair of Loc.t * expr * expr
| Var of Loc.t * string
| Int of Loc.t * int
......@@ -33,7 +33,8 @@ module ExprParser = struct
"abstr" RIGHTA
[ "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) ]
| "match"; e = SELF; ":"; t = UIDENT; "with"; b = LIST1 branch ->
Match(_loc, e, t, b) ]
| "pair" LEFTA
[ e1 = SELF; ","; e2 = SELF -> Pair(_loc, e1, e2)
| e1 = SELF ; "."; e2 = SELF -> Apply(_loc, e1, e2) ]
......@@ -64,8 +65,12 @@ end
let get_loc expr = match expr with
| Apply (loc, _, _) -> loc
| Abstr (loc, _, _, _, _) -> loc
| Match (loc, _, _) -> loc
| Match (loc, _, _, _) -> loc
| Pair (loc, _, _) -> loc
| Var (loc, _) -> loc
| Int (loc, _) -> loc
| String (loc, _) -> loc
let caml_loc_to_cduce loc =
`File(Loc.file_name loc), Loc.start_off loc - Loc.start_bol loc,
Loc.stop_off loc - Loc.start_bol loc
......@@ -3,7 +3,7 @@ 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
| Match of Loc.t * expr * ptype * branches
| Pair of Loc.t * expr * expr
| Var of Loc.t * string
| Int of Loc.t * int
......@@ -23,3 +23,4 @@ module ExprParser : sig
end
val get_loc : expr -> Loc.t
val caml_loc_to_cduce : Loc.t -> Cduce_loc.loc
File ./tests/eval/tests/match_error_simple.test, line 1, characters 37-38:
File ./tests/eval/tests/match_error_simple.test, line 1, characters 50-51:
Unbound identifier a
match x with | (a : Int, b : Int) -> a
match x : Pairofints with | (a : Int, b : Int) -> a
match 1 with | 2 -> 2 | a : Int -> 3
match 1 : Int with | 1 -> 1 | 2 -> 2
(fun f x -> match x with | y : Int -> x+y).2
match 1 : Int with | s : String -> s | b : Bool -> b | i : Int -> i
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