Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
42341383
Commit
42341383
authored
Jun 10, 2014
by
Pietro Abate
Browse files
Add a new small testing tool to print various ASTs
parent
9c97ce5a
Changes
6
Hide whitespace changes
Inline
Side-by-side
tests/lambda/Makefile
View file @
42341383
...
...
@@ -22,8 +22,8 @@ INEXTFILES = misc/custom.ml misc/encodings.ml misc/upool.ml misc/ns.ml\
EXTFILES
=
$
(
INEXTFILES:%
=
$(ROOTDIR)
/%
)
RM
?=
rm
-f
OUT
?=
valueTests.native lambdaTests.native typedTests.native
OUTDEBUG
?=
valueTests.native lambdaTests.byte typedTests.byte
OUT
?=
valueTests.native lambdaTests.native typedTests.native
tests.native
OUTDEBUG
?=
valueTests.native lambdaTests.byte typedTests.byte
tests.byte
.PHONY
:
clean _import tests
...
...
tests/lambda/_tags
View file @
42341383
<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/tests*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str, oUnit, pcre, ulex, num, netstring)
<src/externals>: include
<src/externals/schema_*>: package(pcre, netcgi2)
...
...
tests/lambda/src/testlib.ml
0 → 100644
View file @
42341383
open
Camlp4
.
PreCast
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
wrap
f
s
=
try
f
s
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
(* Cduce program -> Typed *)
let
parse_cduce
?
(
verbose
=
false
)
s
=
let
astexpr
=
Parser
.
expr
(
Stream
.
of_string
s
)
in
let
texpr
=
fst
(
Typer
.
type_expr
BIN
.
env
astexpr
)
in
if
verbose
then
Format
.
printf
"Cduce Typed %s ====>
\n
%s
\n
%!@."
s
(
Typed
.
Print
.
typed_to_string
texpr
);
texpr
(* Typed AST -> Typed *)
let
parse_texpr
?
(
verbose
=
false
)
s
=
let
expr
=
Parse
.
ExprParser
.
of_string_no_file
s
in
let
env
,
texpr
=
Compute
.
to_typed
expr
in
if
verbose
then
Format
.
printf
"Computed Typed %s ====>
\n
%s
\n
%!@."
s
(
Typed
.
Print
.
typed_to_string
texpr
);
texpr
(* --> Lambda *)
let
parse_lexpr
?
(
verbose
=
false
)
texpr
=
let
lambdaexpr
,
lsize
=
Compile
.
compile_expr
Compile
.
empty_toplevel
texpr
in
if
verbose
then
Format
.
printf
"Lambda : %s
\n
"
(
Lambda
.
Print
.
lambda_to_string
lambdaexpr
);
lambdaexpr
,
lsize
(* --> Value *)
let
parse_vexpr
?
(
verbose
=
false
)
(
lambdaexpr
,
lsize
)
=
let
evalexpr
=
Eval
.
expr
lambdaexpr
lsize
in
if
verbose
then
Format
.
printf
"Value : %s
\n
"
(
Value
.
value_to_string
evalexpr
);
evalexpr
(* Cduce program -> Lambda *)
let
parse_cduce_lexpr
?
(
verbose
=
false
)
s
=
let
texpr
=
wrap
(
parse_cduce
~
verbose
)
s
in
parse_lexpr
~
verbose
:
true
texpr
(* Cduce program -> Value *)
let
parse_cduce_vexpr
?
(
verbose
=
false
)
s
=
let
texpr
=
wrap
(
parse_cduce
~
verbose
)
s
in
let
lambdaexpr
,
lsize
=
parse_lexpr
~
verbose
texpr
in
parse_vexpr
~
verbose
:
true
(
lambdaexpr
,
lsize
)
(* Typed AST -> Lambda *)
let
parse_texpr_lexpr
?
(
verbose
=
false
)
s
=
let
texpr
=
wrap
(
parse_texpr
~
verbose
)
s
in
parse_lexpr
~
verbose
:
true
texpr
(* Typed AST -> Value *)
let
parse_texpr_vexpr
?
(
verbose
=
false
)
s
=
let
texpr
=
wrap
(
parse_texpr
~
verbose
)
s
in
let
lambdaexpr
,
lsize
=
parse_lexpr
~
verbose
texpr
in
parse_vexpr
~
verbose
:
true
(
lambdaexpr
,
lsize
)
tests/lambda/src/tests.ml
0 → 100644
View file @
42341383
let
verbose
=
ref
false
let
typed
=
ref
false
let
lambda
=
ref
false
let
value
=
ref
false
let
program
=
ref
""
let
main
()
=
let
speclist
=
[
(
"-v"
,
Arg
.
Set
verbose
,
"Enables verbose mode (print all itermediate ASTs)"
);
(
"--lambda"
,
Arg
.
Set
lambda
,
"Print Lambda AST"
);
(
"--value"
,
Arg
.
Set
value
,
"Print Value AST"
);
]
in
let
usage_msg
=
"Print various cduce ASTs fragments (default typed)"
in
Arg
.
parse
speclist
(
fun
s
->
program
:=
s
)
usage_msg
;
let
verbose
=
!
verbose
in
if
not
(
!
lambda
||
!
value
)
then
ignore
(
Testlib
.
parse_cduce
~
verbose
:
true
!
program
);
if
!
lambda
then
ignore
(
Testlib
.
parse_cduce_lexpr
~
verbose
!
program
);
if
!
value
then
ignore
(
Testlib
.
parse_cduce_vexpr
~
verbose
!
program
)
;;
main
()
;;
tests/lambda/src/typedTests.ml
View file @
42341383
open
OUnit2
open
Camlp4
.
PreCast
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
wrap
f
s
=
try
f
s
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
parse_cduce
s
=
let
astexpr
=
Parser
.
expr
(
Stream
.
of_string
s
)
in
let
texpr
=
fst
(
Typer
.
type_expr
BIN
.
env
astexpr
)
in
Format
.
printf
"Cduce Typed %s ====>
\n
%s
\n
%!@."
s
(
Typed
.
Print
.
typed_to_string
texpr
);
texpr
let
parse_texpr
s
=
let
expr
=
Parse
.
ExprParser
.
of_string_no_file
s
in
let
env
,
texpr
=
Compute
.
to_typed
expr
in
Format
.
printf
"Computed Typed %s ====>
\n
%s
\n
%!@."
s
(
Typed
.
Print
.
typed_to_string
texpr
);
texpr
let
parse_lexpr
f
s
=
let
texpr
=
wrap
f
s
in
let
lambdaexpr
,
lsize
=
Compile
.
compile_expr
Compile
.
empty_toplevel
texpr
in
Format
.
printf
"Lambda : %s
\n
"
(
Lambda
.
Print
.
lambda_to_string
lambdaexpr
);
lambdaexpr
,
lsize
let
parse_vexpr
f
s
=
let
lambdaexpr
,
lsize
=
parse_lexpr
f
s
in
let
evalexpr
=
Eval
.
expr
lambdaexpr
lsize
in
Format
.
printf
"Value : %s
\n
"
(
Value
.
value_to_string
evalexpr
);
evalexpr
open
Testlib
let
run_test_typer
msg
expected
totest
_
=
let
expected
=
wrap
parse_texpr
expected
in
...
...
@@ -83,8 +7,8 @@ let run_test_typer msg expected totest _ =
assert_equal
~
msg
:
msg
~
printer
:
(
fun
x
->
Typed
.
Print
.
typed_to_string
x
)
expected
totest
let
run_test_compile
msg
expected
totest
_
=
let
expected
,_
=
parse_
l
expr
parse_t
expr
expected
in
let
totest
,_
=
parse_
lexpr
parse_cduce
totest
in
let
expected
,_
=
parse_
t
expr
_l
expr
expected
in
let
totest
,_
=
parse_
cduce_lexpr
totest
in
assert_equal
~
msg
:
msg
~
printer
:
(
fun
x
->
Lambda
.
Print
.
lambda_to_string
x
)
expected
totest
(* (message, typed expr - expected, cduce expr) *)
...
...
@@ -109,10 +33,15 @@ let tests_typer_list = [
"Test CDuce.typed.fun.partial 1",
"fun f x : 'A : 'A -> 2",
"fun f ( `$A -> `$A -> `$A) x -> fun g -> g x";
*)
"Test CDuce.typed.fun.partial 2",
"fun f x : 'A : 'A -> 2",
"fun f ( g : `$A -> `$B ) ( x : `$A) : `$B = g x";
*)
"Test CDuce.typed.fun.partial 2"
,
"fun f x : 'A : 'A -> 2"
,
"let id ( y : `$A ) : `$B = y in id"
;
]
...
...
@@ -133,7 +62,7 @@ let _ =
test_list
[
tests_typer
;
tests_compile
;
(*
tests_compile;
*)
]
)
;;
...
...
tests/lambda/src/valueTests.ml
View file @
42341383
open
OUnit2
open
Camlp4
.
PreCast
open
Testlib
(* 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 %s -> %s%!@."
str
(
Typed
.
Print
.
typed_to_string
texpr
);
let
lambdaexpr
=
Compile
.
compile
env
texpr
in
Lambda
.
Print
.
lambda_to_string
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
run_test_compile
msg
expected
totest
_
=
let
expected
,_
=
parse_texpr_lexpr
expected
in
let
totest
,_
=
parse_cduce_lexpr
totest
in
assert_equal
~
msg
:
msg
~
printer
:
(
fun
x
->
Lambda
.
Print
.
lambda_to_string
x
)
expected
totest
let
tests_poly_abstr
=
[
"Test CDuce.lambda.const_abstr failed"
,
""
,
"fun f x : 'A : 'A -> 2"
;
(*
"Test CDuce.lambda.let",
"",
"let x : Int = 3 in x : Int";
...
...
@@ -39,7 +26,6 @@ let tests_poly_abstr = [
"",
"fun applier x : 'A f : ('A -> 'A) : 'A -> f.x";
(*
"Test CDuce.lambda.apply",
"",
"(fun f x : Int : Int -> x).2";
...
...
@@ -62,27 +48,10 @@ 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
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 %s -> %s%!@."
str
(
Typed
.
Print
.
typed_to_string
texpr
);
let
lambdaexpr
,
lsize
=
Compile
.
compile_expr
env
texpr
in
Format
.
printf
"Lambda : %s
\n
"
(
Lambda
.
Print
.
lambda_to_string
lambdaexpr
);
let
evalexpr
=
Eval
.
expr
lambdaexpr
lsize
in
Value
.
value_to_string
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
in
fun
_
->
assert_equal
~
msg
:
msg
~
printer
:
(
fun
x
->
x
)
expected
(
aux
totest
)
let
run_test_eval
msg
expected
totest
_
=
let
expected
=
parse_texpr_vexpr
expected
in
let
totest
=
parse_cduce_vexpr
totest
in
assert_equal
~
msg
:
msg
~
printer
:
(
fun
x
->
Value
.
value_to_string
x
)
expected
totest
let
tests_eval
=
"CDuce evaluation tests (Typed -> Lambda -> Value )"
>:::
List
.
map
(
fun
(
m
,
e
,
f
)
->
f
>::
run_test_eval
m
e
f
)
tests_poly_abstr
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment