Skip to content

GitLab

Commit dcbf304d authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Add lambda tests for CDuce compilation; dummy parser complete

parent c541564d
Hide whitespace changes
Inline Side-by-side
tests/lambda/GRAMMAR 0 → 100644
View file @ dcbf304d
expr = id
| integer
| string
| abstr
| expr "." expr
| expr "," expr
| "(" expr ")"
| "match" expr "with" "|" match_value "->" expr branches
abstr = "fun" id id ":" type_id params ":" type_id "->" expr
match_value = id ":" type_id
| integer
| string
| match_value "," match_value
| "(" match_value ")"
params = (* empty *)
| id ":" type_id params
branches = (* empty *)
| "|" match_value "->" expr branches
id = [a-z_][A-Za-z0-9_]*
type_id = [A-Z][A-Za-z0-9_]*
integer = [0-9]+
tests/lambda/Makefile 0 → 100644
View file @ dcbf304d
COMPILER ?= ocamlbuild
ROOTDIR ?= ../..
SRCDIR ?= src
EXTDIR ?= $(SRCDIR)/externals
LIBFLAGS ?= -libs nums,netstring,pcre,ulexing\
-lflags -I,`ocamlfind query netstring` -lflags -I,`ocamlfind query pcre`\
-lflags -I,`ocamlfind query ulex`
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\
types/builtin_defs.ml parser/ast.ml typing/typepat.mli typing/typepat.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
EXTFILES = $(INEXTFILES:%=$(ROOTDIR)/%)
RM ?= rm -f
OUT ?= main.native
OUTDEBUG ?= main.byte
.PHONY: clean check test _import
all: _import
$(COMPILER) -use-ocamlfind $(LIBFLAGS) $(OUT)
debug: _import
$(COMPILER) -use-ocamlfind $(DEBUGFLAGS) $(LIBFLAGS) $(OUTDEBUG)
_import:
@echo -n "Copying external files..."
@test -d $(EXTDIR) || mkdir $(EXTDIR)
@cp $(EXTFILES) $(EXTDIR)
@echo "done"
clean:
$(COMPILER) -clean
test $(EXTDIR) = "src" || test $(EXTDIR) = "." || $(RM) -r $(EXTDIR)
check: test
test: all
tests/test.sh
tests/lambda/_tags 0 → 100644
View file @ dcbf304d
<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/externals>: include
<src/externals/schema_*>: package(pcre, netcgi2, unix, netsys, str)
<src/externals/cduce_loc*>: package(ulex), syntax(camlp4o)
tests/lambda/src/main.ml 0 → 100644
View file @ dcbf304d
open Printf
open Parse
open Compile
open Value
open Camlp4.PreCast
let load_file f =
let ic = open_in f in
let n = in_channel_length ic in
let s = String.create n in
really_input ic s 0 n;
close_in ic;
s
let rec print_value v = match v with
| Value.Pair(v1, v2) -> printf "("; print_value v1; printf ", ";
print_value v2; printf ")"
| Xml(_,_,_) -> printf "Xml"
| XmlNs(_,_,_,_) -> printf "XmlNs"
| Record(_) -> printf "Record"
| Atom(_) -> printf "Atom"
| Integer(i) -> printf "%d" (Big_int.int_of_big_int i)
| Char(i) -> printf "Char()"
| Abstraction(_, _) -> printf "Abstraction()"
| Abstract((name, _)) -> printf "Abstract(%s)" name
| String_latin1(i1, i2, s, v) -> printf "String_latin1(%d, %d, %s)" i1 i2 s;
print_value v
| String_utf8(_,_,s,_) -> printf "String(%s)" s
| Concat(v1, v2) -> printf "Concat("; print_value v1; printf ", ";
print_value v2; printf ")"
| Absent -> printf "Absent"
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
try
let expr = ExprParser.of_string str file in
let lambdaexpr = compile (mk None) expr in
let evalexpr = Eval.expr lambdaexpr 100 in
print_value evalexpr; printf "\n"
with
| 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
eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc) l
cbegin cend; raise exn
| e -> eprintf "Unknown error.\n"; raise e
tests/lambda/src/parse.ml 0 → 100644
View file @ dcbf304d
open Printf
open Typed
open Patterns
open Camlp4.PreCast
module ExprParser = struct
let exp_eoi = Gram.Entry.mk "exp_eoi"
EXTEND Gram
GLOBAL: exp_eoi;
exp_eoi:[[e = expression; `EOI -> e]];
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) } ]
| "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) } ]
| "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 } ]
];
param:[[p = LIDENT; ":"; t = UIDENT -> Types.any, Types.any]];
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 } ]
];
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) } ]
| "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 } ]
];
END;;
let of_string s file = Gram.parse_string exp_eoi (Loc.mk file) s
end
tests/lambda/src/parse.mli 0 → 100644
View file @ dcbf304d
open Camlp4.PreCast
module ExprParser : sig
val of_string : string -> string -> Typed.texpr
end
tests/lambda/tests/eval/refs/match_error_simple.ref 0 → 100644
View file @ dcbf304d
File ./tests/eval/tests/match_error_simple.test, line 1, characters 6-7:
Unbound identifier x
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