Commit 71ddc3a0 authored by Kim Nguyễn's avatar Kim Nguyễn

Remove all the unneeded and untested cruft.

parent 3a94a2d7
#directory "_build";;
#use "topfind";;
#require "num";;
#load "cduce_boolvar.cma";;
#camlp4o;;
#require "camlp4.extend";;
#require "ulex";;
#require "pcre";;
#require "netstring";;
#load "typesOUnit.cma";;
open TypesOUnit;;
open Types;;
let parse_typ s =
let st = Stream.of_string s in
let astpat = Parser.pat st in
let nodepat = Typer.typ Builtin.env astpat in
Types.descr nodepat
;;
type pp = P of vv * string | N of string * vv
and vv = V of string
let mk_pp = function
|P(V alpha,t) -> Tallying.CS.singleton (Tallying.Pos (Var.mk alpha,parse_typ t))
|N(t,V alpha) -> Tallying.CS.singleton (Tallying.Neg (parse_typ t,Var.mk alpha))
let mk_prod l =
List.fold_left (fun acc2 c ->
Tallying.CS.prod Var.Set.empty (mk_pp c) acc2
) Tallying.CS.sat l
let mk_union l1 l2 =
Tallying.CS.union (mk_prod l1) (mk_prod l2)
let mk_s ll =
List.fold_left (fun acc1 l ->
Tallying.CS.union (mk_prod l) acc1
) Tallying.CS.S.empty ll
module BIN = struct
open Builtin_defs
(* Types *)
let stringn = Types.cons string
let namespaces =
Sequence.star (Types.times stringn stringn)
let types =
[
"Empty", Types.empty;
"Any", any;
"Int", int;
"Char", Types.char Chars.any;
"Byte", char_latin1;
"Atom", atom;
"Pair", Types.Product.any;
"Arrow", Types.Arrow.any;
"Record", Types.Record.any;
"String", string;
"Latin1", string_latin1;
"Bool", bool;
"Float", float;
"AnyXml", any_xml;
"Namespaces", namespaces;
"Caml_int", caml_int;
]
let env =
List.fold_left
(fun accu (n,t) ->
let n = (Ns.empty, Ident.U.mk n) in
Types.Print.register_global "" n t;
Typer.enter_type (Ident.ident n) t accu
)
Typer.empty_env
types
end
let parse_expr s =
let astexpr = Parser.expr (Stream.of_string s) in
let texpr = fst (Typer.type_expr BIN.env astexpr) in
texpr
;;
......@@ -49,26 +49,7 @@ package: clean
git archive --prefix=$(PACKAGE)/ -o $(PACKAGE).tar.gz HEAD
OCAML_STDLIBDIR := $(shell ocamlc -where)
.PHONY: .ocamlinit
.ocamlinit:
echo '(* AUTOMATICALLY GENERATED by Makefile: DO NOT EDIT! *)' > $@
echo '#load "$(OCAML_STDLIBDIR)/pcre/pcre.cma";;' >> $@
echo '#load "$(OCAML_STDLIBDIR)/unix.cma";;' >> $@
echo '#load "$(OCAML_STDLIBDIR)/netstring/netstring.cma";;' >> $@
# echo '#load "$(OCAML_STDLIBDIR)/netstring/netstring_top.cmo";;' >> $@
echo '#load "$(OCAML_STDLIBDIR)/pxp-engine/pxp_engine.cma";;' >> $@
# echo '#load "$(OCAML_STDLIBDIR)/pxp-engine/pxp_top.cmo";;' *)' >> $@
echo '#load "$(OCAML_STDLIBDIR)/pxp-lex-iso88591/pxp_lex_iso88591.cma";;' >> $@
echo '#load "$(OCAML_STDLIBDIR)/pxp-lex-iso88591/pxp_lex_link_iso88591.cmo";;' >> $@
echo '#load "$(OCAML_STDLIBDIR)/ulex/ulexing.cma";;' >> $@
echo '#load "$(OCAML_STDLIBDIR)/nums.cma";;' >> $@
# echo '#load "$(OCAML_STDLIBDIR)/num_top.cma";;' >> $@
echo '#load "$(OCAML_STDLIBDIR)/cgi/cgi.cma";;' >> $@
for o in $(VALIDATE_OBJECTS); do echo "prerr_endline \"Loading $$o ...\";;" >> $@; echo "#load \"$$o\";;" >> $@; done
for d in $(DIRS); do echo "#directory \"$$d\";;" >> $@; done
for p in pcre netstring pxp-engine ulex cgi; do echo "#directory \"`$(OCAMLFIND) query $$p`\";;" >> $@; done
echo "prerr_endline \"All done!\"" >> $@
echo '(* vim: set ft=ocaml: *)' >> $@
.PHONY:
CVS_DISTRIB = web CHANGES LICENSE README AUTHORS cduce dtd2cduce
CVS_DOC = doc/cdo2ml.1 doc/cduce.1 doc/cduce_mktop.1 doc/cduce_validate.1 doc/dtd2cduce.1 doc/fomanual/tutorial.pdf doc/fomanual/manual.pdf
......@@ -119,7 +100,3 @@ evaluator: $(EVALUATOR:.cmo=.$(EXTENSION))
# (to compile it on a machine which is not the web server)
# Seems to be some problems with statically linking curl
# EXTRA_OPTS_WEBIFACE += -ccopt -static
typestop:
ocamlbuild typesOUnit.cma
ocaml -init tests/toplevel/typesOUnit.ocamlinit
DIRS= cduce/misc cduce/types cduce/compile cduce/runtime
ML_SRC= \
cduce/misc/serialize.ml \
cduce/misc/custom.ml \
cduce/misc/encodings.ml \
cduce/misc/imap.ml \
cduce/misc/state.ml \
cduce/misc/pool.ml \
cduce/misc/ns.ml \
cduce/types/sortedList.ml \
cduce/types/atoms.ml \
cduce/misc/bool.ml \
cduce/types/chars.ml \
cduce/types/var.ml \
cduce/types/boolVar.ml \
cduce/types/ident.ml \
cduce/types/intervals.ml \
cduce/misc/inttbl.ml \
cduce/types/normal.ml \
cduce/misc/pretty.ml \
cduce/misc/stats.ml \
cduce/types/types.ml \
cduce/types/sequence.ml \
cduce/types/sample.ml \
cduce/types/patterns.ml \
cduce/compile/lambda.ml \
cduce/runtime/value.ml \
cduce/runtime/run_dispatch.ml \
cduce/runtime/explain.ml \
cduce/runtime/serial.ml
CMO_OBJECTS=$(ML_SRC:.ml=.cmo)
CMX_OBJECTS=$(ML_SRC:.ml=.cmx)
$(CMO_OBJECTS) $(CMX_OBJECTS): $(COMPILER)
$(CMX_OBJECTS): $(OPTCOMPILER)
cduce_types.cmo: $(CMO_OBJECTS)
$(CAMLC) $(COMPFLAGS) -pack -o cduce_types.cmo $(CDUCE_INCLUDES) $(CMO_OBJECTS)
cduce_types.cmx: $(CMX_OBJECTS)
$(CAMLOPT) $(OPTCOMPFLAGS) -pack -o cduce_types.cmx $(CDUCE_INCLUDES) $(CMX_OBJECTS)
cduce_types.p.cmx: cduce_types.cmx
cp cduce_types.cmx cduce_types.p.cmx
cp cduce_types.o cduce_types.p.o
CDUCE_INCLUDES = $(DIRS:%=-I %)
.SUFFIXES: .ml .mli .cmo .cmi .cmx
.ml.cmo:
$(CAMLC) $(COMPFLAGS) -c $(CDUCE_INCLUDES) $<
.ml.cmx:
$(CAMLOPT) $(OPTCOMPFLAGS) -c $(CDUCE_INCLUDES) $<
.mli.cmi:
$(CAMLC) $(COMPFLAGS) -c $(CDUCE_INCLUDES) $<
.PHONY: compute_depend
compute_depend:
ocamldep $(CDUCE_INCLUDES) $(SRC) $(SRC:.ml=.mli) > cduce/types_depend
include cduce/types_depend
clean:
for i in $(DIRS); do \
(cd $$i; rm -f *.cmi *.cmo *.cma *.cmx *.o *.a *.cmxa *~); \
done
true: -traverse
<{misc,types}/**>: traverse
<misc>: include
<types>: include
<parser>: include
<typing>: include
<compile>: include
<schema>: include
<runtime>: include
<{misc,types,typing,schema,compile,runtime,parser}/*.cmx>: for-pack(TypesOUnit)
<{misc,types}/*.cmx>: for-pack(BoolVarOUnit)
<parser/**>: package(ulex), package(netstring), package(camlp4.extend), syntax(camlp4o)
<schema/**>: package(pcre), package(netstring)
<runtime/**>: package(pcre), package(netstring)
<tests/libtest/*Test.*>: package(netstring), package(pcre), package(oUnit), package(ulex), package(num), package(camlp4.lib)
Upool
Serialize
Custom
Encodings
Imap
State
Pool
Ns
SortedList
Var
Atoms
Bool
Chars
Ident
Intervals
Inttbl
Normal
Pretty
Stats
BoolVar
open Ocamlbuild_plugin;;
Options.use_ocamlfind := true ;;
open Command ;;
(*
let _ = dispatch begin function
| After_rules ->
ocaml_lib ~extern:true ~dir:"_build" "typesOUnit"
| _ -> ()
end;;
*)
#!/bin/sh
# Do not change these variables directly. Use options to modify the behavior of
# the script (see usage).
VERBOSE="false"
WITHOCAML="false"
OCAMLFOLDER="ocaml"
PACKAGES="pcre-ocaml ocamlnet pxp ocurl ocaml-expat ocamlsdl ounit"
usage ()
{
echo "Usage: $0 [OPTION]... [MLVERSION]"
echo "Configures opam for the compilation of CDuce."
echo "Switches the OCaml version of opam if MLVERSION is provided."
echo "Example: $0 --verbose --mliface=ocaml 4.01.0"
echo "Valid options are:"
echo -e "\t-v, --verbose\tactivate verbose mode"
echo -e "\t--mliface=DIR\tcheckout the OCaml sources in DIR to MLVERSION"
echo -e "\t-h, --help\tdisplay this help and exit"
}
# Parse options
while test $# -ge 1; do
if test $1 = "-v" || test $1 = "--verbose"; then VERBOSE="true";
elif echo $1 | grep -qse "--mliface=.*"; then
WITHOCAML="true"; OCAMLFOLDER=`echo $1 | cut -d '=' -f 2`;
elif test $1 = "-h" || test $1 = "--help"; then usage; exit 0;
elif echo $1 | grep -qse "-.*"; then usage; exit 1;
else break; fi;
shift;
done
# Switching opam's version of OCaml
if test $# -ge 1; then
echo -n "Switching to version $1 of OCaml..."
opam switch $1 > /dev/null 2>&1
if test $? -ne 0; then
echo "failed. This version doesn't seem to exist."; exit 2;
fi
echo "done."
echo "# To complete the configuration of OPAM, you need to run:"
echo "eval \`opam config env\`"
fi
# Installing packages
echo "Installing mandatory packages to compile CDuce."
for i in $PACKAGES; do opam install $i; done
# Checkout git repository of OCaml sources to appropriate version.
if test $WITHOCAML = "true" && test $# -ge 1; then
if test -d $OCAMLFOLDER; then
cd $OCAMLFOLDER; git checkout $1 > /dev/null 2>&1
echo "OCaml sources updated to version $1."
else
echo "Couldn't find $OCAMLFOLDER. The interface will not be built."
fi
fi
COMPILER ?= ocamlbuild
ROOTDIR ?= ../..
SRCDIR ?= src
EXTDIR ?= $(SRCDIR)/externals
LIBFLAGS ?= -libs nums,pcre,netstring -lflags -I,`ocamlfind query pcre`\
-lflags -I,`ocamlfind query netstring`
DEBUGFLAGS ?= -cflags -g -lflags -g
INEXTFILES = misc/custom.ml misc/encodings.ml types/ident.ml\
compile/lambda.ml misc/ns.ml misc/ns.mli misc/upool.ml misc/upool.mli\
types/sortedList.ml types/sortedList.mli types/compunit.ml types/compunit.mli\
types/types.mli types/types.ml runtime/eval.mli runtime/eval.ml\
types/boolVar.ml types/var.ml types/atoms.ml misc/imap.ml types/intervals.ml\
types/chars.ml misc/bool.ml compile/auto_pat.ml runtime/value.ml\
types/sequence.ml schema/schema_validator.ml schema/schema_pcre.ml\
schema/schema_common.ml schema/schema_common.mli schema/schema_types.ml\
schema/schema_xml.ml schema/schema_xml.mli schema/schema_builtin.ml\
types/builtin_defs.ml runtime/run_dispatch.ml runtime/explain.ml\
misc/stats.mli misc/stats.ml types/normal.mli types/normal.ml misc/pretty.ml\
misc/pretty.mli
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
<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)
<src/externals>: include
<src/externals/schema_*>: package(pcre, netcgi2, unix, netsys, str)
COMPILER ?= ocamlbuild
ROOTDIR ?= ../..
SRCDIR ?= src
EXTDIR ?= $(SRCDIR)/externals
INEXTFILES = misc/utils.ml 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 parser/parser.ml parser/ulexer.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 types/sample.ml\
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 ?= valueTests.native lambdaTests.native typedTests.native astprinter.native
OUTDEBUG ?= valueTests.byte lambdaTests.byte typedTests.byte astprinter.byte
.PHONY: clean _import tests
all: $(OUT)
debug: $(OUTDEBUG)
%.native: _import
$(COMPILER) -use-ocamlfind $@
%.byte: _import
$(COMPILER) -use-ocamlfind -tag debug $@
# Shortcuts
ast: astprinter.native
lambda: lambdaTests.native
typed: typedTests.native
value: valueTests.native
tests:
make -C tests
_import:
@echo -n "Copying external files..."
@test -d $(EXTDIR) || mkdir $(EXTDIR)
@cp $(EXTFILES) $(EXTDIR)
@echo "done"
clean:
make -C tests clean
$(COMPILER) -clean
test $(EXTDIR) = "src" || test $(EXTDIR) = "." || $(RM) -r $(EXTDIR)
true: debug
<src>: include
<src/parse*>: pp(camlp4orf.opt), package(camlp4.lib)
<src/testlib*>: pp(camlp4orf.opt), package(camlp4.lib)
<src/compute*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/*Tests*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str, oUnit, pcre, ulex, num, netstring)
<src/astprinter*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str, oUnit, pcre, ulex, num, netstring)
<src/externals>: include
<src/externals/schema_*>: package(pcre, netcgi2)
<src/externals/cduce_loc*>: package(ulex), syntax(camlp4o)
<src/externals/{ulexer,parser}.*>: syntax(camlp4o), package(ulex)
open OUnit2
open Camlp4.PreCast
(* Typed -> Lambda *)
let run_test_compile msg expected totest =
let aux str =
try
let expr = Parse.ExprParser.of_string_no_file str in
let env, texpr = Compute.to_typed expr in
Format.printf "Computed Typed -> %a%!@." Typed.Print.pp_typed texpr;
let lambdaexpr = Compile.compile env texpr in
Lambda.Print.string_of_lambda lambdaexpr
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
| e -> Printf.eprintf "Runtime error.\n"; raise e
in
fun _ -> assert_equal ~msg:msg ~printer:(fun x -> x) expected (aux totest)
let tests_poly_abstr = [
"Test CDuce.lambda.const_abstr failed",
"Abstraction(Dummy,,,,Sel(,[(Int -> Int)],{}))",
"fun f x : Int : Int -> 2";
"Test CDuce.lambda.poly.identity failed",
"Abstraction(Dummy,,,,Sel(,[([ Char* ] | Int -> [ Char* ] | Int)],Comp({},{{ 'A =
Int },{ 'A = [ Char* ]
}})))",
"(fun f x : 'A : 'A -> x) [{A/Int},{A/String}]";
"Test CDuce.runtime.poly.tail failed",
"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", "Abstraction(Dummy,,,,Sel(,[(('A & Int | Char | Atom | (Any,Any) |
<(Any) (Any)>Any | Arrow,'B & Int | Char |
Atom | (Any,Any) | <(Any) (Any)>Any | Arrow) ->
'A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | Arrow)],{}))",
"fun pair x : ('A * 'B) : 'A -> match x : ('A * 'B) with | (z : 'A, y : 'B) -> z";
"Test CDuce.runtime.poly.match_abstr failed", "Apply(Match(Abstraction(Dummy,,,,Sel(,[('A & Int | Char | Atom | (Any,Any) |
<(Any) (Any)>Any | Arrow -> 'A & Int |
Char |
Atom |
(Any,Any) |
<(Any) (Any)>Any |
Arrow)],{})), {accept_chars=false; brs_disp=<disp>; brs_rhs=[| (2, TVar(Local(0),Comp({},{ { 'A =
Int
} }))) |]; brs_stack_pos=0}),Const(3))",
"(match (fun f x : 'A : 'A -> x) : ('A -> 'A) with | y : ('A -> 'A) -> y[{A/Int}]).3";
]
let tests_poly_abstr = [
(*
"Test CDuce.lambda.const_abstr failed",
"Abstraction(Dummy,,,,Sel((Int -> Int),{}))",
"fun f x : 'A : 'A -> 2";
*)
"Test CDuce.lambda.identity_applied failed",
"Apply(PolyAbstraction([Dummy,Dummy],,{accept_chars=true; brs_disp=<disp>; brs_rhs=[| (1, Var(Local(0))) |]; brs_stack_pos=0},,Sel(Env(1),[(
'A -> 'A)],{{'A = Int
}})),Const(2))",
"(fun f x : 'A : 'A -> x)[{A/Int}].2";
];;
let tests_compile = "CDuce compile tests (Typed -> Lambda )" >:::
List.map (fun (m,e,f) -> f >:: run_test_compile m e f) tests_poly_abstr
(* Typed -> Lambda -> Value *)
let run_test_eval str =
try
let expr = Parse.ExprParser.of_string_no_file str in
let env, texpr = Compute.to_typed expr in
let lambdaexpr,lsize = Compile.compile_expr env texpr in
Format.printf "Input : %s\n" str;
Format.printf "Lambda : %s\n" (Lambda.Print.string_of_lambda lambdaexpr);
let evalexpr = Eval.expr lambdaexpr lsize in
Format.printf "Eval : %a\n\n" Value.Print.pp_value evalexpr;
Value.Print.string_of_value evalexpr
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
| 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.let_simple failed"
~printer:(fun x -> x) "3"
(run_test_eval "let x : Int = 3 in x : Int");
assert_equal ~msg:"Test CDuce.runtime.abstr.let_sum failed"
~printer:(fun x -> x) "5"
(run_test_eval "let x : Int = 2 in (let y : Int = 3 in (x + y) : Int) : Int");
assert_equal ~msg:"Test CDuce.runtime.abstr.let_medium failed"
~printer:(fun x -> x) "2"
(run_test_eval "let f : (Int -> Int) = (fun (Int -> Int) | x : Int -> x)
in (f.f.2) : Int");
assert_equal ~msg:"Test CDuce.runtime.abstr.let_nested_simple failed"
~printer:(fun x -> x) "3"
(run_test_eval "let f : (Int -> Int) = (fun (Int -> Int) | x : Int -> x + 1)
in (let x : Int = f.2
in x : Int) : Int");
assert_equal ~msg:"Test CDuce.runtime.abstr.let_nested_medium failed"
~printer:(fun x -> x) "4"
(run_test_eval "let f : (Int -> Int) = (fun (Int -> Int) | x : Int -> x + 1)
in (let x : Int = f.2
in f.x : Int) : Int");
assert_equal ~msg:"Test CDuce.runtime.abstr.simple failed"
~printer:(fun x -> x) "Abstraction([(Int,Int)],Mono)"
(run_test_eval "fun f x : Int : Int -> 2");
assert_equal ~msg:"Test CDuce.runtime.abstr.medium failed"
~printer:(fun x -> x)
"Abstraction([(Int,[ Char* ] -> [ Int Char* ])],Mono)"
(run_test_eval "fun f x : Int y : String : (Int*String) -> x,y");
assert_equal ~msg:"Test CDuce.runtime.abstr.hard failed"
~printer:(fun x -> x)
"Abstraction([((Int -> Int) -> Int,(Int -> Int) -> Int)],Mono)"
(run_test_eval "fun (((Int -> Int) -> Int) -> (Int -> Int) -> Int) | x : ((Int -> Int) -> Int) -> (fun ((Int -> Int) -> Int) | y : (Int -> Int) -> x.y)");
);
"apply" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.apply.simple failed"
~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,Mono)"
(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,Mono)"
(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.even failed"
~printer:(fun x -> x)
"Abstraction([(Int,Bool),(Any \\ Int,Any \\ Int)],Mono)"
(run_test_eval "fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x");
assert_equal ~msg:"Test CDuce.runtime.misc.even_applied1 failed"
~printer:(fun x -> x)
"Atom(false)"
(run_test_eval "(fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x).5");
assert_equal ~msg:"Test CDuce.runtime.misc.even_applied2 failed"
~printer:(fun x -> x)
"Atom(true)"
(run_test_eval "(fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x).8");
assert_equal ~msg:"Test CDuce.runtime.misc.even_applied3 failed"
~printer:(fun x -> x)
"(2,(3,Atom(nil),Mono),Mono)"
(run_test_eval "(fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x).[2; 3]");
assert_equal ~msg:"Test CDuce.runtime.misc.is_int failed"
~printer:(fun x -> x)
"Abstraction([(Int,Bool),(Bool,Bool),(Any \\ (Int | Bool),Any \\ (Int | Bool))],Mono)"
(run_test_eval "fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
| x : Int -> `true
| x : Bool -> `false
| x : (!(Int|Bool)) -> x");
assert_equal ~msg:"Test CDuce.runtime.misc.is_int_applied1 failed"
~printer:(fun x -> x)
"Atom(true)"
(run_test_eval "(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
| x : Int -> `true
| x : Bool -> `false
| x : (!(Int|Bool)) -> x).2");
assert_equal ~msg:"Test CDuce.runtime.misc.is_int_applied2 failed"
~printer:(fun x -> x)
"Atom(false)"
(run_test_eval "(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
| x : Int -> `true
| x : Bool -> `false
| x : (!(Int|Bool)) -> x).`true");
assert_equal ~msg:"Test CDuce.runtime.misc.is_int_applied3 failed"
~printer:(fun x -> x)
"(2,(3,Atom(nil),Mono),Mono)"
(run_test_eval "(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
| x : Int -> `true
| x : Bool -> `false
| x : (!(Int|Bool)) -> x).[2; 3]");
assert_equal ~msg:"Test CDuce.runtime.misc.map failed"
~printer:(fun x -> x)
"Abstraction([('A -> 'B,[ 'A* ] -> [ 'B* ])],Id)"
(run_test_eval "fun map f : ('A -> 'B) x : ['A] : ['B] ->
match x : ['A] with
| (el : 'A) :: [] -> f.el
| (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))");
assert_equal ~msg:"Test CDuce.runtime.misc.map_even failed"
~printer:(fun x -> x)
"Abstraction([([ 'A* ],[ 'B* ])],Id)"
(run_test_eval "(fun map f : ('A->'B) x : ['A] : ['B] ->
match x : ['A] with
| (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))
| [] -> []).(fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x)");
assert_equal ~msg:"Test CDuce.runtime.misc.map_even_simple failed"
~printer:(fun x -> x)
"(\"hey\",(Atom(false),Atom(nil),Mono),Mono)"
(run_test_eval "(fun map f : ('A->'B) x : ['A] : ['B] ->
match x : ['A] with
| (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))
| [] -> [])[{A/Int},{A/Bool}].(fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x).[\"hey\"; 3]");
assert_equal ~msg:"Test CDuce.runtime.misc.map_even_medium failed"
~printer:(fun x -> x)
"(Atom(true),(\"hey\",(Atom(false),(Atom(true),Atom(nil),Mono),Mono),Mono),Mono)"
(run_test_eval "(fun map f : ('A->'B) x : ['A] : ['B] ->
match x : ['A] with
| (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))
| [] -> [])[{A/Int},{A/Bool}].(fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x).[4; \"hey\"; 3; 2]");
assert_equal ~msg:"Test CDuce.runtime.misc.map_even_hard failed"
~printer:(fun x -> x)
"(Atom(true),(\"hey\",((3,(5,Atom(nil),Mono),Mono),(Atom(true),(Abstraction([(
'C,'C)],Id),(Atom(false),Atom(nil),Mono),Mono),Mono),Mono),Mono),Mono)"
(run_test_eval "(fun map f : ('A->'B) x : ['A] : ['B] ->
match x : ['A] with
| (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))
| [] -> [])[{A/Int},{A/Bool}].(fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x).[4; \"hey\"; [3; 5]; 2; (fun ('C -> 'C) | x : 'C -> x); 3+4]");
assert_equal ~msg:"Test CDuce.runtime.misc.map_is_int_simple failed"
~printer:(fun x -> x)
"(Atom(false),(Atom(true),Atom(nil),Mono),Mono)"
(run_test_eval "(fun map f : ('A->'B) x : ['A] : ['B] ->
match x : ['A] with
| (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))
| [] -> [])[{A/Int},{A/Bool}].(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
| x : Int -> `true
| x : Bool -> `false
| x : (!(Int|Bool)) -> x).[`true; 3]");
assert_equal ~msg:"Test CDuce.runtime.misc.map_is_int_medium failed"
~printer:(fun x -> x)
"(Atom(false),(Atom(true),(Atom(false),Atom(nil),Mono),Mono),Mono)"
(run_test_eval "(fun map f : ('A->'B) x : ['A] : ['B] ->
match x : ['A] with
| (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))
| [] -> [])[{A/Int},{A/Bool}].(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
| x : Int -> `true
| x : Bool -> `false
| x : (!(Int|Bool)) -> x).[`true; 3; `true]");
assert_equal ~msg:"Test CDuce.runtime.misc.firsts failed"
~printer:(fun x -> x)
"Abstraction([((Int,Int),(Int,Int) -> (Int,Int))],Mono)"
(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,Mono)"