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
2d1979cf
Commit
2d1979cf
authored
Apr 02, 2014
by
Julien Lopez
Browse files
[TESTS][LAMBDA] Begin to handle environment for function parameters; fails in
the transition between Compile and Eval
parent
8367c11b
Changes
3
Hide whitespace changes
Inline
Side-by-side
tests/lambda/Makefile
View file @
2d1979cf
...
...
@@ -15,7 +15,7 @@ INEXTFILES = misc/custom.ml misc/encodings.ml misc/upool.ml misc/ns.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.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
\
...
...
tests/lambda/src/compute.ml
View file @
2d1979cf
open
Parse
open
Typed
open
Compile
open
Camlp4
.
PreCast
let
rec
to_typed
expr
=
let
env
=
Compile
.
empty_toplevel
in
match
expr
with
let
env
=
empty_toplevel
in
match
expr
with
|
Parse
.
Apply
(
loc
,
e1
,
e2
)
->
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Apply
(
snd
(
to_typed
e1
)
,
snd
(
to_typed
e2
))
}
let
env1
,
e1
=
to_typed
e1
in
let
_
,
e2
=
to_typed
e2
in
env1
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
empty
;
exp_descr
=
Apply
(
e1
,
e2
)
}
|
Abstr
(
loc
,
fun_name
,
params
,
return_type
,
body
)
->
env
,
parse_abstr
loc
fun_name
params
return_type
body
parse_abstr
env
loc
fun_name
params
return_type
body
|
Match
(
loc
,
e
,
b
)
->
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
let
b
=
parse_branches
b
[]
in
let
brs
=
{
br_typ
=
Types
.
an
y
;
br_accept
=
Types
.
an
y
;
br_branches
=
b
}
in
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
an
y
;
let
brs
=
{
br_typ
=
Types
.
empt
y
;
br_accept
=
Types
.
empt
y
;
br_branches
=
b
}
in
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
empt
y
;
exp_descr
=
Match
(
snd
(
to_typed
e
)
,
brs
)
}
|
Pair
(
loc
,
e1
,
e2
)
->
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
an
y
;
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
empt
y
;
exp_descr
=
Pair
(
snd
(
to_typed
e1
)
,
snd
(
to_typed
e2
))
}
|
Var
(
loc
,
vname
)
->
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
an
y
;
exp_descr
=
Var
(
0
,
vname
)
}
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
empt
y
;
exp_descr
=
Var
(
0
,
vname
)
}
|
Int
(
loc
,
i
)
->
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
let
i
=
Big_int
.
big_int_of_int
i
in
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
an
y
;
exp_descr
=
Cst
(
Types
.
Integer
i
)
}
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
empt
y
;
exp_descr
=
Cst
(
Types
.
Integer
i
)
}
|
String
(
loc
,
s
)
->
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
let
s
=
Types
.
String
(
0
,
(
String
.
length
s
)
-
1
,
s
,
Types
.
Integer
(
Big_int
.
big_int_of_int
0
))
in
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
an
y
;
exp_descr
=
Cst
s
}
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
empt
y
;
exp_descr
=
Cst
s
}
and
parse_abstr
loc
fun_name
params
return_type
body
=
and
parse_abstr
env
loc
fun_name
params
return_type
body
=
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
...
...
@@ -57,16 +59,24 @@ and parse_abstr loc fun_name params return_type body =
let
br
=
{
br_loc
=
brloc
;
br_used
=
true
;
br_ghost
=
false
;
br_vars_empty
=
[]
;
br_pat
=
node
;
br_body
=
snd
(
to_typed
body
)
}
in
let
brs
=
{
br_typ
=
Types
.
an
y
;
br_accept
=
Types
.
an
y
;
let
brs
=
{
br_typ
=
Types
.
empt
y
;
br_accept
=
Types
.
empt
y
;
br_branches
=
[
br
]
}
in
let
iface
=
parse_iface
params
[]
in
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Abstraction
({
fun_name
=
Some
(
0
,
fun_name
);
fun_iface
=
iface
;
fun_body
=
brs
;
fun_typ
=
Types
.
any
;
fun_fv
=
[]
})
}
let
new_env
=
{
cu
=
None
;
vars
=
Ident
.
Env
.
empty
;
stack_size
=
0
;
max_stack
=
ref
1000
;
global_size
=
env
.
global_size
}
in
let
iface
,
fv
,
new_env
=
parse_iface
params
[]
[]
new_env
0
in
let
abstr
=
{
fun_name
=
Some
(
0
,
fun_name
);
fun_iface
=
iface
;
fun_body
=
brs
;
fun_typ
=
Types
.
empty
;
fun_fv
=
fv
}
in
new_env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
empty
;
exp_descr
=
Abstraction
(
abstr
)
}
and
parse_iface
params
res
=
match
params
with
|
_
::
rest
->
parse_iface
rest
(
res
@
[
Types
.
any
,
Types
.
any
])
|
[]
->
res
and
parse_iface
params
iface
fv
env
nb
=
match
params
with
|
(
_
,
pname
,
_
)
::
rest
->
let
vars
=
Ident
.
Env
.
add
(
nb
,
pname
)
(
Lambda
.
Local
nb
)
env
.
vars
in
let
env
=
{
cu
=
env
.
cu
;
vars
=
vars
;
stack_size
=
nb
+
1
;
max_stack
=
env
.
max_stack
;
global_size
=
env
.
global_size
+
nb
+
1
}
in
parse_iface
rest
(
iface
@
[
Types
.
empty
,
Types
.
empty
])
(
fv
@
[
nb
,
pname
])
env
(
nb
+
1
)
|
[]
->
iface
,
fv
,
env
and
parse_branches
brs
res
=
match
brs
with
|
(
loc
,
p
,
e
)
::
rest
->
...
...
tests/lambda/src/main.ml
View file @
2d1979cf
...
...
@@ -45,4 +45,4 @@ with
let
cend
=
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
eprintf
"File %s, line %d, characters %d-%d:
\n
"
(
Loc
.
file_name
loc
)
l
cbegin
cend
;
raise
exn
|
e
->
eprintf
"
Unknown
error.
\n
"
;
raise
e
|
e
->
eprintf
"
Runtime
error.
\n
"
;
raise
e
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