Skip to content

GitLab

Commit 6d582266 authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Add functions with union types; still some runtime errors

parent e7a14bb5
Hide whitespace changes
Inline Side-by-side
tests/lambda/GRAMMAR
View file @ 6d582266
......@@ -18,8 +18,9 @@ listexpr = (* empty *)
| expr
| listexpr ";" listexpr
(* TODO: Add the "_" special keyword *)
abstr = "fun" id id ":" type_id params ":" type_id "->" expr
| "fun" "_" id ":" type_id params ":" type_id "->" expr
| "fun" type_id "|" match_value "->" expr branches
match_value = id ":" type_id
| integer
......
tests/lambda/src/compute.ml
View file @ 6d582266
......@@ -13,6 +13,7 @@ let type_of_string s = match s with
| "Char" -> Types.char Chars.any
| "Bool" -> Types.atom (Atoms.cup (Atoms.atom (Atoms.V.mk_ascii "false"))
(Atoms.atom (Atoms.V.mk_ascii "true")))
| "Any" -> Types.any
| _ -> Types.empty
let rec _to_typed env l expr =
......@@ -30,8 +31,9 @@ let rec _to_typed env l expr =
env, l, { exp_loc=loc;
exp_typ=(Types.Arrow.apply (Types.Arrow.get e1.exp_typ) e2.exp_typ);
exp_descr=Apply(e1, e2) }
| Abstr (_, fun_name, params, rtype, body) ->
parse_abstr env l [] loc (Some(0, fun_name)) params rtype body
| Abstr (origloc, fun_name, iface, body) ->
let fname = match fun_name with | "_" -> None | _ -> Some(0, fun_name) in
parse_abstr env l origloc fname iface body
| Match (_, e, t, b) ->
let b, btype = parse_branches env l t [] Types.empty b in
let t = type_of_ptype t in
......@@ -55,7 +57,7 @@ let rec _to_typed env l expr =
let index, vtype =
try Locals.find vname l
with Not_found -> Printf.eprintf
"File %s, line %d, characters %d-%d:\nUnbound identifier %s\n"
"File %s, line %d, characters %d-%d:\nError: Unbound identifier %s\n"
(Loc.file_name origloc) line cbegin cend vname;
raise Error
in
......@@ -83,7 +85,7 @@ let rec _to_typed env l expr =
let cbegin = Loc.start_off origloc - Loc.start_bol origloc in
let cend = Loc.stop_off origloc - Loc.start_bol origloc in
Printf.eprintf
"File %s, line %d, characters %d-%d:\nUnknown special term %s\n"
"File %s, line %d, characters %d-%d:\nError: Unknown special term %s\n"
(Loc.file_name origloc) line cbegin cend b;
raise Error
......@@ -116,68 +118,48 @@ and type_of_ptype =
| TArrow(t1, t2) -> arrow (cons (type_of_ptype t1)) (cons (type_of_ptype t2))
| TSeq(t) -> Sequence.star (type_of_ptype t)
and type_of_iface iface rtype =
let open Types in
let rec _type_of_iface iface rtype res =
match iface with
| (_, pname, ptype) :: rest -> _type_of_iface rest rtype
(arrow (cons res) (cons (type_of_ptype ptype)))
| [] -> arrow (cons res) (cons rtype)
and first_param loc iface =
let rec _first_param loc accu = function
| TArrow(t1, t2) -> t1, accu @ [type_of_ptype t1, type_of_ptype t2]
| TUnion(t1, t2) ->
let t1, acc1 = first_param loc t1 in
let t2, acc2 = first_param loc t2 in
TInter(t1, t2), acc1 @ acc2
| TInter(t1, t2) ->
let t1, acc1 = first_param loc t1 in
let t2, acc2 = first_param loc t2 in
TUnion(t1, t2), acc1 @ acc2
| _ ->
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 fname = Loc.file_name loc in
Printf.eprintf
"File %s, line %d, characters %d-%d:\nError: This type should be an arrow type\n"
fname line cbegin cend; raise Error
in
match iface with
| (_, pname, ptype) :: [] -> arrow (cons (type_of_ptype ptype)) (cons rtype)
| (_, pname, ptype) :: (_, pname2, ptype2) :: rest ->
let res = type_of_ptype ptype2 in
arrow (cons (type_of_ptype ptype)) (cons (_type_of_iface rest rtype res))
| [] -> assert false
_first_param loc [] iface
and parse_abstr env l loc fun_name iface body =
let fun_typ = type_of_ptype iface in
let ptype, iface = first_param loc iface in
let l = (match fun_name with
| None -> l
| Some (id, name) -> Locals.add name (id,fun_typ) l) in
let b, btype = parse_branches env l ptype [] Types.empty body in
let brs = { Typed.br_typ=btype; br_accept=Types.any; br_branches=b } in
let abstr = { Typed.fun_name=fun_name; fun_iface=iface; fun_body=brs;
fun_typ=fun_typ; fun_fv=[] } in
env, l, { Typed.exp_loc=caml_loc_to_cduce loc; exp_typ=fun_typ;
exp_descr=Typed.Abstraction(abstr) }
and parse_abstr env l fv loc fun_name params rtype body =
let rec _parse_abstr env l oldfv loc fun_name params rtype body nb =
let brloc = caml_loc_to_cduce (get_loc body) in
let empty, env, l, fv, iface, rest =
parse_iface env l params [] nb [] rtype in
let fun_typ = type_of_iface params rtype in
let node = make_node fv in
let l = (match fun_name with
| None -> l
| Some (id, name) -> Locals.add name (id,fun_typ) l) in
let env, l, body = if empty
then let _, _, body = _to_typed env l body in env, l, body
else let env, l, body = _parse_abstr env l (oldfv @ fv) loc None rest
rtype body (nb + 1) in env, l, body
in
let b = { Typed.br_loc=brloc; br_used=true; br_ghost=false;
br_vars_empty=[]; br_pat=node; br_body=body } in
let brs = { Typed.br_typ=rtype; br_accept=Types.any; br_branches=[b] } in
let abstr = { Typed.fun_name=fun_name; fun_iface=iface; fun_body=brs;
fun_typ=fun_typ; fun_fv=oldfv } in
env, l, { Typed.exp_loc=loc; exp_typ=fun_typ;
exp_descr=Typed.Abstraction(abstr) }
in
_parse_abstr env l fv loc fun_name params (type_of_ptype rtype) body 0
and make_node fv =
let d = (match fv with
| el :: rest -> Patterns.Capture(el)
| [] -> Patterns.Dummy)
in
make_patterns Types.any fv d
and parse_iface env l params fv nb iface rtype = match params with
| (_, pname, ptype) :: [] ->
let ptype = type_of_ptype ptype in
true, env, (Locals.add pname (nb,ptype) l), (fv @ [nb, pname]),
(iface @ [ptype, rtype]), []
| (_, pname, ptype) :: rest ->
let ptype = type_of_ptype ptype in
false, env, (Locals.add pname (nb,ptype) l), (fv @ [nb, pname]),
(iface @ [ptype, type_of_iface rest rtype]), rest
| [] -> true, env, l, fv, iface, []
and itype acc =
let open Types in function
| (_, _, t) :: rest -> itype (arrow (cons acc) (cons (type_of_ptype t))) rest
| [] -> acc
and make_patterns t fv d =
incr Patterns.counter;
{ Patterns.id=(!Patterns.counter);
descr=(t, fv, d);
accept=(Types.cons t);
fv=fv
}
and parse_branches env l toptype acc btype = function
| (loc, p, e) :: rest ->
......@@ -208,13 +190,15 @@ and parse_branches env l toptype acc btype = function
(Types.cup btype br_body.Typed.exp_typ) rest
| [] -> acc, btype
and make_patterns t fv d =
incr Patterns.counter;
{ Patterns.id=(!Patterns.counter);
descr=(t, fv, d);
accept=(Types.cons t);
fv=fv
}
and get_fv brs =
let rec _fv_of_patt = function
| MPair (_, m1, m2) -> (_fv_of_patt m1) @ (_fv_of_patt m2)
| MVar (_, mname, _) -> [0, mname]
| _ -> [] in
let rec _get_fv accu = function
| (_, p, _) :: rest -> _get_fv (accu @ (_fv_of_patt p)) rest
| [] -> accu in
_get_fv [] brs
and parse_match_value env l list toptype = function
| MPair (_, m1, m2) ->
......
tests/lambda/src/main.ml
View file @ 6d582266
......@@ -12,11 +12,11 @@ let run_test_compile msg expected totest =
with
| Compute.Error -> exit 3
| Loc.Exc_located (loc, exn) ->
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
Printf.eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc) l
cbegin cend; raise exn
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
Printf.eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc) l
cbegin cend; raise exn
| e -> Printf.eprintf "Runtime error.\n"; raise e
in
fun _ -> assert_equal ~msg:msg ~printer:(fun x -> x) expected (aux totest)
......@@ -32,16 +32,20 @@ let tests_poly_abstr = [
"(fun f x : 'A{A/Int;A/String} : 'A{A/Int;A/String} -> x) {A/Int;A/String}";
"Test CDuce.runtime.poly.tail failed",
"Abstraction(([ (`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any \
| Arrow)* ], [ (`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | \
Arrow)* ]),{})",
"fun tail x : ['A{}] : ['A{}] -> match x : ['A{}] with | (el : 'A{}) :: (rest : ['A{}]) -> rest";
"Abstraction(Dummy,,,,Sel(,([ (`$A & Int | Char | Atom | (Any,Any) |
<(Any) (Any)>Any | Arrow)* ] -> [ (`$A & Int |
Char |
Atom |
(Any,Any) |
<(Any) (Any)>Any |
Arrow)* ]),{}))",
"fun tail x : ['A{}] : ['A{}] -> match x : ['A{}] with | (el : 'A{}) :: (rest : ['A{}]) -> rest";
"Test CDuce.runtime.poly.pair failed", "",
"fun pair x : ('A * 'B) -> match x : ('A * 'B) with | (x,y) : ('A * 'B) -> x";
"fun pair x : ('A{} * 'B{}) : 'A{} -> match x : ('A{} * 'B{}) with | (x : 'A{}, y : 'B{}) -> x";
"Test CDuce.runtime.poly.pair failed", "",
"(match ( fun f x : 'A{} : 'A{} ) with y : ('A{} -> 'A{}) -> y{A/Int}).3";
"Test CDuce.runtime.poly.match_abstr failed", "",
"(match (fun f x : 'A{} : 'A{} -> x) : ('A{} -> 'A{}) with | y : ('A{} -> 'A{}) -> y{A/Int}).3";
......@@ -63,95 +67,95 @@ let run_test_eval str =
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
Printf.eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc) l
cbegin cend; raise exn
Printf.eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc)
l cbegin cend; raise exn
| e -> Printf.eprintf "Runtime error.\n"; raise e
let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
[
"abstr" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.abstr.simple failed"
~printer:(fun x -> x) "Abstraction((Int, Int),{})"
~printer:(fun x -> x) "Abstraction((Int, Int),{})"
(run_test_eval "fun f x : Int : Int -> 2");
assert_equal ~msg:"Test CDuce.runtime.abstr.medium failed"
~printer:(fun x -> x)
~printer:(fun x -> x)
"Abstraction((Int, [ Char* ] -> [ Int Char* ]),{})"
(run_test_eval "fun f x : Int y : String : (Int*String) -> x,y");
);
"apply" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.apply.simple failed"
~printer:(fun x -> x) "2"
~printer:(fun x -> x) "2"
(run_test_eval "(fun f x : Int : Int -> x).2");
assert_equal ~msg:"Test CDuce.runtime.apply.simple_pair failed"
~printer:(fun x -> x) "(3, 2, {})"
~printer:(fun x -> x) "(3, 2, {})"
(run_test_eval "(fun f x : (Int*Int) : (Int*Int) -> x).(3,2)");
assert_equal ~msg:"Test CDuce.runtime.apply.medium failed"
~printer:(fun x -> x) "(2, 3, {})"
~printer:(fun x -> x) "(2, 3, {})"
(run_test_eval "((fun f x : Int y : Int : (Int*Int) -> x,y).2).3");
);
"misc" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.misc.is_int failed"
~printer:(fun x -> x)
~printer:(fun x -> x)
"Abstraction(([ Char* ] | Int, Bool),{})"
(run_test_eval "fun is_int x : (Int | String) : Bool ->
match x : (Int | String) with
| x : Int -> `true
| x : String -> `false");
assert_equal ~msg:"Test CDuce.runtime.misc.map failed"
~printer:(fun x -> x)
~printer:(fun x -> x)
"Abstraction(((Int,Int), X1 -> X1 where X1 = (Int,Int)),{})"
(run_test_eval "fun map f : ('A{}->'B{}) x : ['A{}] : ['B{}] ->
match x : ['A{}] with
| (el : 'A{}) :: (rest : ['A{}]) -> [f.el; (map.f).rest]
| el : ['A{}] -> f.el");
assert_equal ~msg:"Test CDuce.runtime.misc.firsts failed"
~printer:(fun x -> x)
~printer:(fun x -> x)
"Abstraction(((Int,Int), X1 -> X1 where X1 = (Int,Int)),{})"
(run_test_eval "fun firsts x : (Int*Int) y : (Int*Int) : (Int*Int) ->
match x,y : ((Int*Int)*(Int*Int)) with
| (a : Int,_ : Int),(b : Int,_ : Int) -> a,b");
assert_equal ~msg:"Test CDuce.runtime.misc.firsts_applied failed"
~printer:(fun x -> x) "(5, 1, {})"
~printer:(fun x -> x) "(5, 1, {})"
(run_test_eval "((fun firsts x : (Int*Int) y : (Int*Int) : (Int*Int) ->
match x,y : ((Int*Int)*(Int*Int)) with
| (a : Int,_ : Int),(b : Int,_ : Int) -> a,b)
.(5, 3)).(1, 4)");
assert_equal ~msg:"Test CDuce.runtime.misc.applier failed"
~printer:(fun x -> x) "Abstraction((Int, Int -> Int -> Int),{})"
~printer:(fun x -> x) "Abstraction((Int, Int -> Int -> Int),{})"
(run_test_eval "fun applier x : Int f : (Int->Int) : Int -> f.x");
assert_equal ~msg:"Test CDuce.runtime.misc.applier_applied failed"
~printer:(fun x -> x) "2"
~printer:(fun x -> x) "2"
(run_test_eval "((fun applier x : Int f : (Int->Int) : Int ->
f.x).2).(fun g x : Int : Int -> x)");
);
"match" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.match.simple failed"
~printer:(fun x -> x) "1"
~printer:(fun x -> x) "1"
(run_test_eval "match 1 : Int with | 1 -> 1 | \"true\" -> \"true\"");
assert_equal ~msg:"Test CDuce.runtime.match.unused_branches failed"
~printer:(fun x -> x) "1"
~printer:(fun x -> x) "1"
(run_test_eval "match 1 : Int with
| s : String -> s | b : Bool -> b | i : Int -> i");
assert_equal ~msg:"Test CDuce.runtime.match.simple_var failed"
~printer:(fun x -> x) "2"
~printer:(fun x -> x) "2"
(run_test_eval "(fun f x : Int : Int ->
match x : Int with | y : Int -> x).2");
assert_equal ~msg:"Test CDuce.runtime.match.medium failed"
~printer:(fun x -> x) "2"
~printer:(fun x -> x) "2"
(run_test_eval "(fun f x : Int : Int ->
match x : Int with | 1 -> 3 | x : Int -> x).2");
assert_equal ~msg:"Test CDuce.runtime.match.rec failed"
~printer:(fun x -> x) "3"
~printer:(fun x -> x) "3"
(run_test_eval "(fun f x : Int : Int ->
match x : Int with | 1 -> 3 | x : Int -> f.1).2");
);
"string" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.string.simple failed"
~printer:(fun x -> x) "\"The cake is a lie\""
~printer:(fun x -> x) "\"The cake is a lie\""
(run_test_eval "\"The cake is a lie\"");
);
......@@ -167,11 +171,11 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
| (el : Int) :: (rest : [Int]) -> el
| x : Int -> 3");
assert_equal ~msg:"Test CDuce.runtime.list.tail failed"
~printer:(fun x -> x) "Abstraction(([ Int* ], [ Int* ]),{})"
~printer:(fun x -> x) "Abstraction(([ Int* ], [ Int* ]),{})"
(run_test_eval "fun tail x : [Int] : [Int] -> match x : [Int] with
| (el : Int) :: (rest : [Int]) -> rest");
assert_equal ~msg:"Test CDuce.runtime.list.tail.eval failed"
~printer:(fun x -> x) "(2, 5, {})"
~printer:(fun x -> x) "(2, 5, {})"
(run_test_eval "(fun tail x : [Int] : [Int] -> match x : [Int] with
| (el : Int) :: (rest : [Int]) -> rest).[1; 2; 5]");
(* TODO: Fix this test, we need to define [] aka `nil *)
......@@ -184,15 +188,13 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
"union" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.union.identity_precise failed"
~printer:(fun x -> x) "Abstraction((Int -> Int & X1 -> X1 where X1 = [ Char* ], Int -> Int &
X1 -> X1 where
X1 = [ Char* ]),{})"
(run_test_eval "fun _f f : ((Int -> Int) & (String -> String)) : ((Int -> Int) & (String -> String)) -> f");
~printer:(fun x -> x) "Abstraction((Int, Int) ,([ Char* ], [ Char* ]),{})"
(run_test_eval "fun ((Int -> Int) & (String -> String)) | x : (Int | String) -> x");
assert_equal ~msg:"Test CDuce.runtime.union.identity failed"
~printer:(fun x -> x) "Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
~printer:(fun x -> x) "Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
(run_test_eval "fun f x : (Int | String) : (Int | String) -> x");
assert_equal ~msg:"Test CDuce.runtime.union.match failed"
~printer:(fun x -> x) "Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
~printer:(fun x -> x) "Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
(run_test_eval "fun f x : (Int | String) : (Int | String) ->
match x : (Int | String) with
| x : Int -> 2
......@@ -214,12 +216,12 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
"poly" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.poly.identity_pure failed"
~printer:(fun x -> x)
"Abstraction((`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | \
Arrow, `$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | Arrow),{})"
"Abstraction((`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | Arrow,
`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | Arrow),{})"
(run_test_eval "fun f x : 'A{} : 'A{} -> x");
assert_equal ~msg:"Test CDuce.runtime.poly.identity failed"
~printer:(fun x -> x)
"Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
"Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
(run_test_eval "(fun f x : 'A{A/Int;A/String} : 'A{A/Int;A/String} -> x)
{A/Int;A/String}");
assert_equal ~msg:"Test CDuce.runtime.poly.identity_applied failed"
......@@ -231,13 +233,13 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
(run_test_eval "((fun f x : 'A{A/String} : 'A{A/String} -> x){A/String}).2");
assert_equal ~msg:"Test CDuce.runtime.poly.tail failed"
~printer:(fun x -> x)
"Abstraction(([ (`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any \
| Arrow)* ], [ (`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | \
Arrow)* ]),{})"
"Abstraction(([ (`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any |
Arrow)* ], [ (`$A & Int | Char | Atom | (Any,Any) |
<(Any) (Any)>Any | Arrow)* ]),{})"
(run_test_eval "fun tail x : ['A{}] : ['A{}] -> match x : ['A{}] with
| (el : 'A{}) :: (rest : ['A{}]) -> rest");
assert_equal ~msg:"Test CDuce.runtime.poly.tail_applied failed"
~printer:(fun x -> x) "(7, (8, 5, {}), {})"
~printer:(fun x -> x) "(7, (8, 5, {}), {})"
(run_test_eval "(fun tail x : ['A{}] : ['A{}] -> match x : ['A{}] with
| (el : 'A{}) :: (rest : ['A{}]) -> rest).[3; 7; 8; 5]");
......
tests/lambda/src/parse.ml
View file @ 6d582266
......@@ -4,7 +4,7 @@ open Camlp4.PreCast
type expr =
| Subst of Loc.t * expr * (string * ptype) list
| Apply of Loc.t * expr * expr
| Abstr of Loc.t * fun_name * params * ptype * expr
| Abstr of Loc.t * fun_name * ptype * branches
| Match of Loc.t * expr * ptype * branches
| Pair of Loc.t * expr * expr
| Var of Loc.t * string
......@@ -12,7 +12,6 @@ type expr =
| String of Loc.t * string
| Bool 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
......@@ -42,12 +41,23 @@ module ExprParser = struct
[
"abstr" RIGHTA
[ "fun"; x = LIDENT; p = LIST1 param; ":"; t = type_id; "->"; e = SELF ->
Abstr(_loc, x, p, t, e)
| "match"; e = SELF; ":"; t = type_id; "with"; b = LIST1 branch ->
Match(_loc, e, t, b) ]
let rec aux acc t = function
| (loc, pname, ptype) :: [] ->
let t = TArrow(ptype, t) in
Abstr(_loc, x, t, [_loc, MVar(loc, pname, ptype), acc])
| (loc, pname, ptype) :: rest ->
let t = TArrow(ptype, t) in
aux (Abstr(_loc, "_", t, [_loc, MVar(loc, pname, ptype), acc]))
t rest
| [] -> acc
in
aux e t p
| "fun"; t = type_id; b = LIST1 branch -> Abstr(_loc, "_", t, b)
| "match"; e = SELF; ":"; t = type_id; "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) ]
[ e1 = SELF; ","; e2 = SELF -> Pair(_loc, e1, e2)
| e1 = SELF ; "."; e2 = SELF -> Apply(_loc, e1, e2) ]
| "list" LEFTA [ "["; le = listexpr; "]" -> le ]
| "paren" [ "("; e = SELF; ")" -> e ]
| "var" [ x = LIDENT -> Var(_loc, x) ]
......@@ -104,7 +114,7 @@ end
let get_loc expr = match expr with
| Subst (loc, _, _) -> loc
| Apply (loc, _, _) -> loc
| Abstr (loc, _, _, _, _) -> loc
| Abstr (loc, _, _, _) -> loc
| Match (loc, _, _, _) -> loc
| Pair (loc, _, _) -> loc
| Var (loc, _) -> loc
......
tests/lambda/src/parse.mli
View file @ 6d582266
......@@ -3,7 +3,7 @@ open Camlp4.PreCast
type expr =
| Subst of Loc.t * expr * (string * ptype) list
| Apply of Loc.t * expr * expr
| Abstr of Loc.t * fun_name * params * ptype * expr
| Abstr of Loc.t * fun_name * ptype * branches
| Match of Loc.t * expr * ptype * branches
| Pair of Loc.t * expr * expr
| Var of Loc.t * string
......@@ -11,7 +11,6 @@ type expr =
| String of Loc.t * string
| Bool 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
......
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