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
ebf672ce
Commit
ebf672ce
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2004-03-15 14:29:18 by afrisch] Opt
Original author: afrisch Date: 2004-03-15 14:29:18+00:00
parent
931ac14f
Changes
3
Hide whitespace changes
Inline
Side-by-side
compile/compile.ml
View file @
ebf672ce
...
...
@@ -38,7 +38,7 @@ let from_comp_unit = ref (fun cu -> assert false)
let
find_ext
cu
x
=
let
env
=
!
from_comp_unit
cu
in
match
find
x
env
with
|
Global
i
->
Ext
Var
(
cu
,
i
)
|
Ext
(
_
,_
)
as
v
->
Var
v
|
_
->
assert
false
let
rec
compile
env
tail
e
=
compile_aux
env
tail
e
.
Typed
.
exp_descr
...
...
@@ -82,7 +82,7 @@ and compile_abstr env a =
p
::
slots
,
succ
nb_slots
,
Env
.
add
x
(
Env
nb_slots
)
fun_env
;
|
Global
_
as
p
->
|
Global
_
|
Ext
_
as
p
->
slots
,
nb_slots
,
Env
.
add
x
p
fun_env
...
...
compile/lambda.ml
View file @
ebf672ce
...
...
@@ -4,12 +4,14 @@ type var_loc =
|
Stack
of
int
|
Env
of
int
|
Global
of
int
|
Ext
of
Types
.
CompUnit
.
t
*
int
(* If pos < 0, the first arg is the value *)
|
Dummy
let
print_var_loc
ppf
=
function
|
Stack
i
->
Format
.
fprintf
ppf
"Stack %i"
i
|
Env
i
->
Format
.
fprintf
ppf
"Env %i"
i
|
Global
i
->
Format
.
fprintf
ppf
"Global %i"
i
|
Ext
(
cu
,
i
)
->
Format
.
fprintf
ppf
"Ext (_,%i)"
i
|
Dummy
->
Format
.
fprintf
ppf
"Dummy"
type
schema_component_kind
=
...
...
@@ -17,7 +19,6 @@ type schema_component_kind =
type
expr
=
|
Var
of
var_loc
|
ExtVar
of
Types
.
CompUnit
.
t
*
int
|
Apply
of
bool
*
expr
*
expr
|
Abstraction
of
var_loc
array
*
(
Types
.
t
*
Types
.
t
)
list
*
branches
...
...
@@ -50,7 +51,6 @@ and branches = {
let
rec
dump_expr
ppf
=
function
|
Var
v
->
print_var_loc
ppf
v
|
ExtVar
(
cu
,
i
)
->
Format
.
fprintf
ppf
"Extvar (_,%i)"
i
|
Apply
(
tr
,
f
,
x
)
->
Format
.
fprintf
ppf
"Apply (%b,%a,%a)"
tr
dump_expr
f
dump_expr
x
|
Abstraction
(
env
,
iface
,
brs
)
->
Format
.
fprintf
ppf
"Abstraction (["
;
...
...
@@ -94,7 +94,13 @@ module Put = struct
bits
2
s
0
;
int
s
i
|
Global
i
->
assert
false
;
bits
2
s
1
;
Types
.
CompUnit
.
serialize
s
!
current_cu
;
int
s
i
|
Ext
(
cu
,
i
)
->
bits
2
s
1
;
Types
.
CompUnit
.
serialize
s
cu
;
int
s
i
|
Env
i
->
bits
2
s
2
;
int
s
i
...
...
@@ -102,14 +108,6 @@ module Put = struct
bits
2
s
3
let
rec
expr
s
=
function
|
ExtVar
(
cu
,
pos
)
->
bits
nbits
s
19
;
Types
.
CompUnit
.
serialize
s
cu
;
int
s
pos
|
Var
(
Global
pos
)
->
bits
nbits
s
19
;
Types
.
CompUnit
.
serialize
s
!
current_cu
;
int
s
pos
|
Var
v
->
bits
nbits
s
0
;
var_loc
s
v
...
...
@@ -214,6 +212,10 @@ module Get = struct
let
var_loc
s
=
match
bits
2
s
with
|
0
->
Stack
(
int
s
)
|
1
->
let
cu
=
Types
.
CompUnit
.
deserialize
s
in
let
pos
=
int
s
in
Ext
(
cu
,
pos
)
|
2
->
Env
(
int
s
)
|
3
->
Dummy
|
_
->
assert
false
...
...
@@ -288,10 +290,6 @@ module Get = struct
let
e
=
expr
s
in
let
t
=
Types
.
Node
.
deserialize
s
in
Ref
(
e
,
t
)
|
19
->
let
cu
=
Types
.
CompUnit
.
deserialize
s
in
let
pos
=
int
s
in
ExtVar
(
cu
,
pos
)
|
_
->
assert
false
and
branches
s
=
...
...
runtime/eval.ml
View file @
ebf672ce
...
...
@@ -64,10 +64,16 @@ let eval_var env = function
|
Global
i
->
!
stack
.
(
i
)
|
Stack
i
->
!
stack
.
(
!
frame
+
i
)
|
Dummy
->
Value
.
Absent
|
Ext
(
cu
,
pos
)
as
x
->
if
pos
<
0
then
(
Obj
.
magic
cu
:
Value
.
t
)
else
let
v
=
!
from_comp_unit
cu
pos
in
let
x
=
Obj
.
repr
x
in
Obj
.
set_field
x
0
(
Obj
.
repr
v
);
Obj
.
set_field
x
1
(
Obj
.
repr
(
-
1
));
v
let
rec
eval
env
=
function
|
Var
x
->
eval_var
env
x
|
ExtVar
(
cu
,
pos
)
->
!
from_comp_unit
cu
pos
|
Apply
(
false
,
e1
,
e2
)
->
let
v1
=
eval
env
e1
in
let
v2
=
eval
env
e2
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