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
64dcac8c
Commit
64dcac8c
authored
May 29, 2014
by
Julien Lopez
Browse files
[TESTS][LAMBDA] Change wrong Bool name to Atom, better nil atom
parent
8c96ed41
Changes
3
Hide whitespace changes
Inline
Side-by-side
tests/lambda/src/compute.ml
View file @
64dcac8c
...
...
@@ -56,11 +56,7 @@ let rec _to_typed env l expr =
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
if
vname
=
"`nil"
then
let
nil_atom
=
Atoms
.
V
.
mk_ascii
"nil"
in
env
,
l
,
{
exp_loc
=
loc
;
exp_typ
=
(
Types
.
atom
(
Atoms
.
atom
nil_atom
));
exp_descr
=
(
Cst
(
Types
.
Atom
nil_atom
))
}
else
if
vname
=
"_"
then
if
vname
=
"_"
then
(
Printf
.
eprintf
"File %s, line %d, characters %d-%d:
\n
Error: Invalid reference to special variable %s
\n
"
(
Loc
.
file_name
origloc
)
line
cbegin
cend
vname
;
raise
Error
)
...
...
@@ -82,7 +78,7 @@ let rec _to_typed env l expr =
let
i
=
Big_int
.
big_int_of_int
0
in
let
s
=
Types
.
String
(
0
,
(
String
.
length
s
)
-
1
,
s
,
Types
.
Integer
i
)
in
env
,
l
,
{
exp_loc
=
loc
;
exp_typ
=
Builtin_defs
.
string
;
exp_descr
=
Cst
s
}
|
Bool
(
origloc
,
b
)
->
|
Atom
(
origloc
,
b
)
->
let
t
=
Builtin_defs
.
true_type
in
let
f
=
Builtin_defs
.
false_type
in
match
b
with
...
...
@@ -90,6 +86,10 @@ let rec _to_typed env l expr =
exp_descr
=
Cst
(
Types
.
Atom
(
Builtin_defs
.
true_atom
))
}
|
"false"
->
env
,
l
,
{
exp_loc
=
loc
;
exp_typ
=
f
;
exp_descr
=
Cst
(
Types
.
Atom
(
Builtin_defs
.
false_atom
))
}
|
"nil"
->
let
nil_atom
=
Atoms
.
V
.
mk_ascii
"nil"
in
env
,
l
,
{
exp_loc
=
loc
;
exp_typ
=
(
Types
.
atom
(
Atoms
.
atom
nil_atom
));
exp_descr
=
(
Cst
(
Types
.
Atom
nil_atom
))
}
|
_
->
let
line
=
Loc
.
start_line
origloc
in
let
cbegin
=
Loc
.
start_off
origloc
-
Loc
.
start_bol
origloc
in
...
...
@@ -219,11 +219,7 @@ and parse_match_value env l list toptype = function
Patterns
.
Times
(
make_patterns
t1
list1
d1
,
make_patterns
t2
list2
d2
)
,
(
list1
@
list2
)
,
l
,
b1
&&
b2
;
|
MVar
(
_
,
mname
,
mtype
)
->
if
mname
=
"`nil"
then
let
nil_atom
=
Atoms
.
V
.
mk_ascii
"nil"
in
let
t
=
Types
.
atom
(
Atoms
.
atom
nil_atom
)
in
(
t
,
Patterns
.
Constr
(
t
)
,
list
,
l
,
true
)
else
if
mname
=
"_"
then
if
mname
=
"_"
then
let
t
=
type_of_ptype
mtype
in
(
t
,
Patterns
.
Constr
(
t
)
,
list
,
l
,
true
)
else
...
...
@@ -246,8 +242,19 @@ and parse_match_value env l list toptype = function
let
is_subtype
=
Types
.
subtype
Builtin_defs
.
string
(
type_of_ptype
toptype
)
in
(
t
,
Patterns
.
Constr
(
t
)
,
list
,
l
,
is_subtype
)
|
MBool
(
origloc
,
b
)
->
let
t
=
if
b
then
Builtin_defs
.
true_type
else
Builtin_defs
.
false_type
in
|
MAtom
(
origloc
,
b
)
->
let
t
=
match
b
with
|
"true"
->
Builtin_defs
.
true_type
|
"false"
->
Builtin_defs
.
false_type
|
"nil"
->
Types
.
atom
(
Atoms
.
atom
(
Atoms
.
V
.
mk_ascii
"nil"
))
|
_
->
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
Error: Unknown special term %s
\n
"
(
Loc
.
file_name
origloc
)
line
cbegin
cend
b
;
raise
Error
in
let
is_subtype
=
Types
.
subtype
t
(
type_of_ptype
toptype
)
in
(
t
,
Patterns
.
Constr
(
t
)
,
list
,
l
,
is_subtype
)
...
...
tests/lambda/src/parse.ml
View file @
64dcac8c
...
...
@@ -11,7 +11,7 @@ type expr =
|
Var
of
Loc
.
t
*
string
|
Int
of
Loc
.
t
*
int
|
String
of
Loc
.
t
*
string
|
Bool
of
Loc
.
t
*
string
|
Atom
of
Loc
.
t
*
string
and
fun_name
=
string
and
fv
=
(
int
*
string
)
list
and
branches
=
(
Loc
.
t
*
match_value
*
expr
)
list
...
...
@@ -20,7 +20,7 @@ and match_value =
|
MVar
of
Loc
.
t
*
string
*
ptype
|
MInt
of
Loc
.
t
*
int
|
MString
of
Loc
.
t
*
string
|
M
Bool
of
Loc
.
t
*
bool
|
M
Atom
of
Loc
.
t
*
string
and
ptype
=
|
Type
of
string
|
PType
of
string
...
...
@@ -46,7 +46,7 @@ module ExprParser = struct
[
"fun"
;
x
=
LIDENT
;
p
=
LIST1
param
;
":"
;
t
=
type_id
;
"->"
;
e
=
SELF
->
let
rec
make_fv
accu
nb
=
function
|
_
::
[]
|
[]
->
accu
|
(
_
,
name
,
_
)
::
rest
->
make_fv
(
accu
@
[
nb
,
name
])
(
nb
+
1
)
rest
|
(
_
,
name
,
_
)
::
rest
->
make_fv
(
accu
@
[
nb
,
name
])
(
nb
+
1
)
rest
in
let
rec
aux
acc
t
fv
=
function
|
(
loc
,
pname
,
ptype
)
::
[]
->
...
...
@@ -67,20 +67,20 @@ module ExprParser = struct
|
"if"
;
e1
=
SELF
;
"then"
;
e2
=
SELF
->
let
b
=
[
(
_loc
,
M
Bool
(
_loc
,
true
)
,
e2
);
(
_loc
,
M
Bool
(
_loc
,
false
)
,
Var
(
_loc
,
"
`
nil"
))]
(
_loc
,
M
Atom
(
_loc
,
"
true
"
)
,
e2
);
(
_loc
,
M
Atom
(
_loc
,
"
false
"
)
,
Atom
(
_loc
,
"nil"
))]
in
Match
(
_loc
,
e1
,
Type
(
"Bool"
)
,
b
)
|
"if"
;
e1
=
SELF
;
"then"
;
e2
=
SELF
;
"else"
;
e3
=
SELF
->
let
b
=
[
(
_loc
,
M
Bool
(
_loc
,
true
)
,
e2
);
(
_loc
,
M
Bool
(
_loc
,
false
)
,
e3
)]
(
_loc
,
M
Atom
(
_loc
,
"
true
"
)
,
e2
);
(
_loc
,
M
Atom
(
_loc
,
"
false
"
)
,
e3
)]
in
Match
(
_loc
,
e1
,
Type
(
"Bool"
)
,
b
)
|
"match"
;
e
=
SELF
;
":"
;
t
=
type_id
;
"with"
;
b
=
LIST1
branch
->
Match
(
_loc
,
e
,
t
,
b
)
Match
(
_loc
,
e
,
t
,
b
)
]
|
"egal"
LEFTA
[
e1
=
SELF
;
"="
;
e2
=
SELF
->
Op
(
_loc
,
"="
,
e1
,
e2
)
]
...
...
@@ -99,13 +99,13 @@ module ExprParser = struct
let
rec
make_seq
res
=
function
|
e
::
rest
->
make_seq
(
Pair
(
_loc
,
e
,
res
))
rest
|
[]
->
res
in
make_seq
(
Var
(
_loc
,
"
`
nil"
))
(
List
.
rev
le
)
make_seq
(
Atom
(
_loc
,
"nil"
))
(
List
.
rev
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
)
]
|
"
bool
"
[
"`"
;
x
=
LIDENT
->
Bool
(
_loc
,
x
)
]
|
"
atom
"
[
"`"
;
x
=
LIDENT
->
Atom
(
_loc
,
x
)
]
|
"subst"
NONA
[
e
=
SELF
;
"["
;
s
=
LIST0
sigma
SEP
","
;
"]"
->
Subst
(
_loc
,
e
,
s
)
]
];
...
...
@@ -128,24 +128,11 @@ module ExprParser = struct
|
"var"
[
x
=
LIDENT
;
":"
;
t
=
type_id
->
MVar
(
_loc
,
x
,
t
)
]
|
"int"
[
x
=
INT
->
MInt
(
_loc
,
int_of_string
x
)
]
|
"string"
[
x
=
STRING
->
MString
(
_loc
,
x
)
]
|
"bool"
[
"`"
;
x
=
LIDENT
->
try
MBool
(
_loc
,
bool_of_string
x
)
with
Invalid_argument
"bool_of_string"
->
begin
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
err
=
Printf
.
sprintf
"File %s, line %d, characters %d-%d:
\n
Error: Unknown special term %s
\n
"
(
Loc
.
file_name
_loc
)
line
cbegin
cend
x
in
raise
(
Stream
.
Error
err
)
end
]
|
"empty"
[
"["
;
"]"
->
MVar
(
_loc
,
"`nil"
,
Type
(
"Any"
))
]
|
"atom"
[
"`"
;
x
=
LIDENT
->
MAtom
(
_loc
,
x
)
]
|
"empty"
[
"["
;
"]"
->
MAtom
(
_loc
,
"nil"
)
]
];
type_id
:
[
type_id
:
[
"atom_type"
[
t
=
UIDENT
->
Type
(
t
)
]
|
[
"'"
;
t
=
UIDENT
->
PType
(
t
)
]
|
[
"("
;
t
=
complex_type_id
;
")"
->
t
]
...
...
@@ -180,7 +167,7 @@ let get_loc expr = match expr with
|
Var
(
loc
,
_
)
->
loc
|
Int
(
loc
,
_
)
->
loc
|
String
(
loc
,
_
)
->
loc
|
Bool
(
loc
,
_
)
->
loc
|
Atom
(
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 @
64dcac8c
...
...
@@ -10,7 +10,7 @@ type expr =
|
Var
of
Loc
.
t
*
string
|
Int
of
Loc
.
t
*
int
|
String
of
Loc
.
t
*
string
|
Bool
of
Loc
.
t
*
string
|
Atom
of
Loc
.
t
*
string
and
fun_name
=
string
and
fv
=
(
int
*
string
)
list
and
branches
=
(
Loc
.
t
*
match_value
*
expr
)
list
...
...
@@ -19,7 +19,7 @@ and match_value =
|
MVar
of
Loc
.
t
*
string
*
ptype
|
MInt
of
Loc
.
t
*
int
|
MString
of
Loc
.
t
*
string
|
M
Bool
of
Loc
.
t
*
bool
|
M
Atom
of
Loc
.
t
*
string
and
ptype
=
|
Type
of
string
|
PType
of
string
...
...
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