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
46d53fe1
Commit
46d53fe1
authored
Apr 23, 2014
by
Julien Lopez
Browse files
[TESTS][LAMBDA] Add booleans and some tests
parent
569be18c
Changes
5
Hide whitespace changes
Inline
Side-by-side
tests/lambda/GRAMMAR
View file @
46d53fe1
expr = id
| integer
| `true
| `false
| string
| abstr
| expr "." expr
...
...
tests/lambda/src/compute.ml
View file @
46d53fe1
...
...
@@ -11,6 +11,8 @@ let type_of_string s = match s with
|
"Int"
->
Types
.
interval
[
Intervals
.
Any
]
|
"String"
->
Sequence
.
string
|
"Char"
->
Types
.
char
Chars
.
any
|
"Bool"
->
Types
.
atom
(
Atoms
.
cup
(
Atoms
.
atom
(
Atoms
.
V
.
mk_ascii
"false"
))
(
Atoms
.
atom
(
Atoms
.
V
.
mk_ascii
"true"
)))
|
_
->
Types
.
empty
let
rec
_to_typed
env
l
expr
=
...
...
@@ -51,10 +53,10 @@ 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
let
index
,
vtype
=
try
Locals
.
find
vname
l
try
Locals
.
find
vname
l
with
Not_found
->
Printf
.
eprintf
"File %s, line %d, characters %d-%d:
\n
Unbound identifier %s
\n
"
(
Loc
.
file_name
origloc
)
line
cbegin
cend
vname
;
(
Loc
.
file_name
origloc
)
line
cbegin
cend
vname
;
raise
Error
in
let
v
=
if
Types
.
no_var
vtype
then
Var
(
index
,
vname
)
else
TVar
(
index
,
vname
)
...
...
@@ -68,6 +70,22 @@ let rec _to_typed env l expr =
let
s
=
Types
.
String
(
0
,
(
String
.
length
s
)
-
1
,
s
,
Types
.
Integer
i
)
in
env
,
l
,
{
exp_loc
=
loc
;
exp_typ
=
(
type_of_string
"String"
);
exp_descr
=
Cst
s
}
|
Bool
(
origloc
,
b
)
->
let
t
=
Types
.
atom
(
Atoms
.
atom
(
Atoms
.
V
.
mk_ascii
"true"
))
in
let
f
=
Types
.
atom
(
Atoms
.
atom
(
Atoms
.
V
.
mk_ascii
"false"
))
in
match
b
with
|
"true"
->
env
,
l
,
{
exp_loc
=
loc
;
exp_typ
=
t
;
exp_descr
=
Cst
(
Types
.
Atom
1
)
}
|
"false"
->
env
,
l
,
{
exp_loc
=
loc
;
exp_typ
=
f
;
exp_descr
=
Cst
(
Types
.
Atom
0
)
}
|
_
->
let
line
=
Loc
.
start_line
origloc
in
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:
\n
Unknown special term %s
\n
"
(
Loc
.
file_name
origloc
)
line
cbegin
cend
b
;
raise
Error
and
make_sigma
s
=
let
rec
aux
acc
=
function
...
...
tests/lambda/src/main.ml
View file @
46d53fe1
...
...
@@ -84,6 +84,20 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
);
"misc"
>::
(
fun
test_ctxt
->
assert_equal
~
msg
:
"Test CDuce.runtime.misc.is_int failed"
~
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
)
"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
)
"Abstraction(((Int,Int), X1 -> X1 where X1 = (Int,Int)),{})"
...
...
tests/lambda/src/parse.ml
View file @
46d53fe1
...
...
@@ -3,13 +3,14 @@ open Camlp4.PreCast
type
expr
=
|
Subst
of
Loc
.
t
*
expr
*
(
string
*
ptype
)
list
|
Apply
of
Loc
.
t
*
expr
*
expr
|
Apply
of
Loc
.
t
*
expr
*
expr
|
Abstr
of
Loc
.
t
*
fun_name
*
params
*
ptype
*
expr
|
Match
of
Loc
.
t
*
expr
*
ptype
*
branches
|
Pair
of
Loc
.
t
*
expr
*
expr
|
Pair
of
Loc
.
t
*
expr
*
expr
|
Var
of
Loc
.
t
*
string
|
Int
of
Loc
.
t
*
int
|
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
...
...
@@ -40,7 +41,7 @@ module ExprParser = struct
expression
:
[
"abstr"
RIGHTA
[
"fun"
;
x
=
LIDENT
;
p
=
LIST1
param
;
":"
;
t
=
type_id
;
"->"
;
e
=
SELF
->
[
"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
)
]
...
...
@@ -52,6 +53,7 @@ module ExprParser = struct
|
"var"
[
x
=
LIDENT
->
Var
(
_loc
,
x
)
]
|
"int"
[
x
=
INT
->
Int
(
_loc
,
int_of_string
x
)
]
|
"string"
[
x
=
STRING
->
String
(
_loc
,
x
)
]
|
"bool"
[
"`"
;
x
=
LIDENT
->
Bool
(
_loc
,
x
)
]
|
"subst"
NONA
[
e
=
SELF
;
"{"
;
s
=
LIST1
sigma
SEP
";"
;
"}"
->
Subst
(
_loc
,
e
,
s
)
]
];
...
...
@@ -63,7 +65,7 @@ module ExprParser = struct
param
:
[[
p
=
LIDENT
;
":"
;
t
=
type_id
->
_loc
,
p
,
t
]];
branch
:
[
"branch"
branch
:
[
"branch"
[
"|"
;
t
=
match_value
;
"->"
;
e
=
expression
->
_loc
,
t
,
e
]
];
...
...
@@ -77,14 +79,14 @@ module ExprParser = struct
|
"string"
[
x
=
STRING
->
MString
(
_loc
,
x
)
]
];
type_id
:
[
"atom_type"
type_id
:
[
"atom_type"
[
t
=
UIDENT
->
Type
(
t
)
]
|
[
"'"
;
t1
=
UIDENT
;
"{"
;
s
=
LIST0
sigma
SEP
";"
;
"}"
->
PType
(
t1
,
s
)
]
|
[
"("
;
t
=
complex_type_id
;
")"
->
t
]
|
[
"["
;
t
=
complex_type_id
;
"]"
->
TSeq
(
t
)
]
];
complex_type_id
:
[
"complex_type"
LEFTA
complex_type_id
:
[
"complex_type"
LEFTA
[
t
=
UIDENT
->
Type
(
t
)
|
"("
;
t
=
SELF
;
")"
->
t
]
|
[
"'"
;
t1
=
UIDENT
;
"{"
;
s
=
LIST0
sigma
SEP
";"
;
"}"
->
PType
(
t1
,
s
)
]
|
[
t1
=
SELF
;
"*"
;
t2
=
SELF
->
TPair
(
t1
,
t2
)
|
t1
=
SELF
;
"->"
;
t2
=
SELF
->
TArrow
(
t1
,
t2
)
]
...
...
@@ -108,6 +110,7 @@ let get_loc expr = match expr with
|
Var
(
loc
,
_
)
->
loc
|
Int
(
loc
,
_
)
->
loc
|
String
(
loc
,
_
)
->
loc
|
Bool
(
loc
,
_
)
->
loc
let
caml_loc_to_cduce
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
...
...
tests/lambda/src/parse.mli
View file @
46d53fe1
...
...
@@ -9,6 +9,7 @@ type expr =
|
Var
of
Loc
.
t
*
string
|
Int
of
Loc
.
t
*
int
|
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
...
...
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