Commit 07c734d6 authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Add sequences

parent b7893873
......@@ -5,8 +5,13 @@ expr = id
| expr "." expr
| expr "," expr
| "(" expr ")"
| "[" listexpr "]"
| "match" expr ":" type_id "with" "|" match_value "->" expr branches
listexpr = (* empty *)
| expr
| listexpr ";" listexpr
(* TODO: Add the "_" special keyword *)
abstr = "fun" id id ":" type_id params ":" type_id "->" expr
......@@ -14,6 +19,7 @@ match_value = id ":" type_id
| integer
| string
| match_value "," match_value
| match_value "::" match_value
| "(" match_value ")"
params = (* empty *)
......@@ -24,14 +30,17 @@ branches = (* empty *)
id = [a-z_][A-Za-z0-9_]*
(* TODO: Add union and polymorphic types *)
(* TODO: Add union types *)
type_id = [A-Z][A-Za-z0-9_]*
| (complex_type_id)
| "'"[A-Z][A-Za-z0-9_]*
| "[" complex_type_id "]"
| "(" complex_type_id ")"
complex_type_id = [A-Z][A-Za-z0-9_]*
| "'"[A-Z][A-Za-z0-9_]*
| complex_type_id * complex_type_id
| complex_type_id -> complex_type_id
| "[" complex_type_id "]"
| "(" complex_type_id ")"
integer = [0-9]+
......@@ -3,8 +3,6 @@ ROOTDIR ?= ../..
SRCDIR ?= src
EXTDIR ?= $(SRCDIR)/externals
DEBUGFLAGS ?= -cflags -g -lflags -g
INEXTFILES = misc/custom.ml misc/encodings.ml misc/upool.ml misc/ns.ml\
types/sortedList.ml types/ident.ml misc/html.ml types/sequence.ml\
types/patterns.ml parser/cduce_loc.mli parser/cduce_loc.ml typing/typed.ml\
......@@ -33,7 +31,7 @@ all: _import
$(COMPILER) -use-ocamlfind $(OUT)
debug: _import
$(COMPILER) -use-ocamlfind $(DEBUGFLAGS) $(OUTDEBUG)
$(COMPILER) -use-ocamlfind -tag debug $(OUTDEBUG)
_import:
@echo -n "Copying external files..."
......
......@@ -22,6 +22,7 @@ let rec type_of_ptype arg = match arg with
| PType(t) -> any (* TODO: Check this solution *)
| TPair(t1, t2) -> times (cons (type_of_ptype t1)) (cons (type_of_ptype t2))
| TArrow(t1, t2) -> arrow (cons (type_of_ptype t1)) (cons (type_of_ptype t2))
| TSeq(t) -> Sequence.star (type_of_ptype t)
let rec type_of_iface iface rtype =
let rec _type_of_iface iface rtype res =
......@@ -146,17 +147,10 @@ and make_patterns t fv d = incr Patterns.counter;
Patterns.accept=(cons t); fv=fv }
and parse_match_value env l list p toptype = match p with
| MPair (loc, m1, m2) ->
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
| MPair (_, m1, m2) ->
let top1, top2 =
(match toptype with | TPair(t1, t2) -> t1, t2 | _ ->
Printf.eprintf "File %s, line %d, characters %d-%d:\nError:" fname
line cbegin cend;
Printf.eprintf " type %s is not a pair\n"
(Types.Print.to_string (type_of_ptype toptype)); raise Error) in
(match toptype with | TPair(t1, t2) -> t1, t2 | TSeq(t) -> t, TSeq(t)
| _ -> Type("Empty"), Type("Empty")) in
let t1, d1, list1, l, b1 = parse_match_value env l list m1 top1 in
let t2, d2, list2, l, b2 = parse_match_value env l list m2 top2 in
times (cons t1) (cons t2),
......
......@@ -88,6 +88,23 @@ let tests = "CDuce runtime tests" >:::
(run_test "\"The cake is a lie\"");
);
"list" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.list.simple failed"
~printer:(fun x -> x) "1"
(run_test "match [1; 2] : [Int] with
| (el : Int) :: (rest : [Int]) -> el
| x : Int -> 3");
assert_equal ~msg:"Test CDuce.runtime.list.simple2 failed"
~printer:(fun x -> x) "3"
(run_test "match 2 : Int with
| (el : Int) :: (rest : [Int]) -> el
| x : Int -> 3");
assert_equal ~msg:"Test CDuce.runtime.list.tail failed"
~printer:(fun x -> x) "(2, 5)"
(run_test "(fun f x : [Int] : [Int] -> match x : [Int] with
| (el : Int) :: (rest : [Int]) -> rest).[1; 2; 5]");
);
]
let _ = run_test_tt_main tests
......@@ -22,6 +22,7 @@ and ptype =
| PType of string
| TPair of ptype * ptype
| TArrow of ptype * ptype
| TSeq of ptype
module ExprParser = struct
......@@ -42,12 +43,16 @@ module ExprParser = struct
| "pair" LEFTA
[ 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) ]
| "int" [ x = INT -> Int(_loc, int_of_string x) ]
| "string" [ x = STRING -> String(_loc, x) ]
];
listexpr:[ "rec" RIGHTA [ l1=SELF; ";"; l2=SELF -> Pair(_loc, l1, l2) ]
| [ e=expression -> e]];
param:[[p = LIDENT; ":"; t = type_id -> _loc, p, t]];
branch:[ "branch" [ "|"; t = match_value; "->"; e = expression ->
......@@ -56,6 +61,7 @@ module ExprParser = struct
match_value:
[
"pair" LEFTA [ e1 = SELF; ","; e2 = SELF -> MPair(_loc, e1, e2) ]
| "headlist" [ e1 = SELF; "::"; e2 = SELF -> MPair(_loc, e1, e2) ]
| "paren" [ "("; e = SELF; ")" -> e ]
| "var" [ x = LIDENT; ":"; t = type_id -> MVar(_loc, x, t) ]
| "int" [ x = INT -> MInt(_loc, int_of_string x) ]
......@@ -63,13 +69,16 @@ module ExprParser = struct
];
type_id: [ "atom_type" [ t = UIDENT -> Type(t) ]
| [ "'"; t = UIDENT -> PType(t) ]
| [ "("; t = complex_type_id; ")" -> t ]
| [ "'"; t = UIDENT -> PType(t) ] ];
| [ "["; t = complex_type_id; "]" -> TSeq(t) ]];
complex_type_id: [ "complex_type" LEFTA [ t = UIDENT -> Type(t)
| "("; t = SELF; ")" -> t ]
| [ "'"; t = UIDENT -> PType(t) ]
| [ t1 = SELF; "*"; t2 = SELF -> TPair(t1, t2)
| t1 = SELF; "->"; t2 = SELF -> TArrow(t1, t2) ]];
| t1 = SELF; "->"; t2 = SELF -> TArrow(t1, t2) ]
| [ "["; t = complex_type_id; "]" -> TSeq(t) ]];
END;;
......
......@@ -21,6 +21,7 @@ and ptype =
| PType of string
| TPair of ptype * ptype
| TArrow of ptype * ptype
| TSeq of ptype
module ExprParser : sig
val of_string : string -> string -> expr
......
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