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
39d5d5a6
Commit
39d5d5a6
authored
May 26, 2014
by
Pietro Abate
Browse files
Use Builtin_defs types to create basic types in lambda tests
parent
96d3231d
Changes
1
Hide whitespace changes
Inline
Side-by-side
tests/lambda/src/compute.ml
View file @
39d5d5a6
...
...
@@ -8,12 +8,11 @@ module Locals = Map.Make(String)
exception
Error
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"
)))
|
"Any"
->
Types
.
any
|
"Int"
->
Builtin_defs
.
int
|
"String"
->
Builtin_defs
.
string
|
"Char"
->
Builtin_defs
.
char
|
"Bool"
->
Builtin_defs
.
bool
|
"Any"
->
Builtin_defs
.
any
|
_
->
Types
.
empty
let
rec
_to_typed
env
l
expr
=
...
...
@@ -48,7 +47,7 @@ let rec _to_typed env l expr =
|
Op
(
_
,
op
,
e1
,
e2
)
->
let
_
,
_
,
e1
=
_to_typed
env
l
e1
in
let
_
,
_
,
e2
=
_to_typed
env
l
e2
in
env
,
l
,
{
exp_loc
=
loc
;
exp_typ
=
type_of_string
"Int"
;
env
,
l
,
{
exp_loc
=
loc
;
exp_typ
=
Builtin_defs
.
int
;
exp_descr
=
Op
(
op
,
0
,
[
e1
;
e2
])
}
|
Var
(
origloc
,
vname
)
->
let
line
=
Loc
.
start_line
origloc
in
...
...
@@ -74,7 +73,7 @@ let rec _to_typed env l expr =
in
env
,
l
,
{
exp_loc
=
loc
;
exp_typ
=
vtype
;
exp_descr
=
v
}
|
Int
(
_
,
i
)
->
let
i
=
Big_int
.
big_int_of_int
i
in
env
,
l
,
{
exp_loc
=
loc
;
exp_typ
=
(
type_of_string
"Int"
)
;
env
,
l
,
{
exp_loc
=
loc
;
exp_typ
=
Builtin_defs
.
int
;
exp_descr
=
Cst
(
Types
.
Integer
i
)
}
|
String
(
_
,
s
)
->
let
i
=
Big_int
.
big_int_of_int
0
in
...
...
@@ -82,13 +81,13 @@ let rec _to_typed env l expr =
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
let
t
=
Builtin_defs
.
true_type
in
let
f
=
Builtin_defs
.
false_type
in
match
b
with
|
"true"
->
env
,
l
,
{
exp_loc
=
loc
;
exp_typ
=
t
;
exp_descr
=
Cst
(
Types
.
Atom
(
Atoms
.
V
.
mk_ascii
"true"
))
}
exp_descr
=
Cst
(
Types
.
Atom
(
Builtin_defs
.
true_atom
))
}
|
"false"
->
env
,
l
,
{
exp_loc
=
loc
;
exp_typ
=
f
;
exp_descr
=
Cst
(
Types
.
Atom
(
Atoms
.
V
.
mk_ascii
"false"
))
}
exp_descr
=
Cst
(
Types
.
Atom
(
Builtin_defs
.
true_atom
))
}
|
_
->
let
line
=
Loc
.
start_line
origloc
in
let
cbegin
=
Loc
.
start_off
origloc
-
Loc
.
start_bol
origloc
in
...
...
@@ -244,19 +243,19 @@ and parse_match_value env l list toptype = function
(
t2
,
Patterns
.
Cap
(
d1
,
d2
)
,
list
,
l
,
is_subtype
)
|
MInt
(
_
,
i
)
->
let
t
=
Types
.
constant
(
Types
.
Integer
(
Big_int
.
big_int_of_int
i
))
in
let
is_subtype
=
Types
.
subtype
(
type_of_string
"Int"
)
let
is_subtype
=
Types
.
subtype
Builtin_defs
.
int
(
type_of_ptype
toptype
)
in
(
t
,
Patterns
.
Constr
(
t
)
,
list
,
l
,
is_subtype
)
|
MString
(
_
,
s
)
->
let
zero
=
Types
.
Integer
(
Big_int
.
big_int_of_int
0
)
in
let
t
=
Types
.
constant
(
Types
.
String
(
0
,
String
.
length
s
-
1
,
s
,
zero
))
in
let
is_subtype
=
Types
.
subtype
(
type_of_string
"String"
)
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
=
match
b
with
|
"true"
->
Types
.
atom
(
Atoms
.
atom
(
Atoms
.
V
.
mk_ascii
"true"
))
|
"false"
->
Types
.
atom
(
Atoms
.
atom
(
Atoms
.
V
.
mk_ascii
"false"
))
|
"true"
->
Builtin_defs
.
true_type
|
"false"
->
Builtin_defs
.
false_type
|
_
->
let
line
=
Loc
.
start_line
origloc
in
let
cbegin
=
Loc
.
start_off
origloc
-
Loc
.
start_bol
origloc
in
...
...
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