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
03bb9810
Commit
03bb9810
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2003-10-08 21:45:06 by cvscast] Toplevel and sep. comp.
Original author: cvscast Date: 2003-10-08 21:45:07+00:00
parent
194424db
Changes
5
Hide whitespace changes
Inline
Side-by-side
driver/cduce.ml
View file @
03bb9810
...
...
@@ -251,6 +251,9 @@ let rec phrases ppf phs = match phs with
typing_env
:=
Typer
.
enter_ns
pr
ns
!
typing_env
;
phrases
ppf
rest
|
{
descr
=
Ast
.
Using
(
x
,
cu
)
}
::
rest
->
Librarian
.
import
cu
;
Librarian
.
run
Value
.
nil
cu
;
typing_env
:=
Typer
.
enter_cu
x
cu
!
typing_env
;
phrases
ppf
rest
|
{
descr
=
Ast
.
EvalStatement
e
}
::
rest
->
...
...
driver/librarian.ml
View file @
03bb9810
...
...
@@ -159,19 +159,34 @@ and load_check id exp =
let
rec
run
argv
id
=
let
cu
=
find
id
in
List
.
iter
(
run
argv
)
cu
.
depends
;
Eval
.
L
.
push
argv
;
List
.
iter
Eval
.
L
.
eval
cu
.
code
;
cu
.
vals
<-
Some
(
Eval
.
L
.
comp_unit
()
)
match
cu
.
vals
with
|
None
->
List
.
iter
(
run
argv
)
cu
.
depends
;
Eval
.
L
.
push
argv
;
List
.
iter
Eval
.
L
.
eval
cu
.
code
;
cu
.
vals
<-
Some
(
Eval
.
L
.
comp_unit
()
)
|
Some
_
->
()
let
import
id
=
ignore
(
load
id
)
let
()
=
Typer
.
from_comp_unit
:=
(
fun
cu
->
(
load
cu
)
.
typing
);
Compile
.
from_comp_unit
:=
(
fun
cu
->
(
load
cu
)
.
compile
);
Eval
.
L
.
from_comp_unit
:=
(
fun
cu
i
->
match
(
load
cu
)
.
vals
with
|
None
->
assert
false
|
Some
a
->
a
.
(
i
))
Eval
.
L
.
from_comp_unit
:=
(
fun
cu
i
->
match
(
load
cu
)
.
vals
with
|
None
->
assert
false
|
Some
a
->
a
.
(
i
));
Eval
.
from_comp_unit
:=
(
fun
cu
id
->
let
c
=
load
cu
in
let
pos
=
match
Compile
.
find
id
c
.
compile
with
|
Lambda
.
Global
i
->
i
|
_
->
assert
false
in
run
Value
.
nil
cu
;
match
c
.
vals
with
|
None
->
assert
false
|
Some
a
->
a
.
(
pos
))
runtime/eval.ml
View file @
03bb9810
...
...
@@ -24,11 +24,14 @@ let map f v = let acc0 = make_accu () in set_cdr (f acc0 v) nil; get_accu acc0
(* Evaluation of expressions *)
let
from_comp_unit
=
ref
(
fun
cu
i
->
assert
false
)
let
eval_apply
=
ref
(
fun
f
x
->
assert
false
)
let
rec
eval
env
e0
=
match
e0
.
Typed
.
exp_descr
with
|
Typed
.
Forget
(
e
,_
)
->
eval
env
e
|
Typed
.
Var
s
->
(
match
Env
.
find
s
env
with
Value
.
Delayed
x
->
!
x
|
x
->
x
)
|
Typed
.
ExtVar
_
->
assert
false
|
Typed
.
Apply
(
f
,
arg
)
->
eval_apply
(
eval
env
f
)
(
eval
env
arg
)
|
Typed
.
ExtVar
(
cu
,
i
)
->
!
from_comp_unit
cu
i
|
Typed
.
Apply
(
f
,
arg
)
->
!
eval_apply
(
eval
env
f
)
(
eval
env
arg
)
|
Typed
.
Abstraction
a
->
eval_abstraction
env
a
|
Typed
.
RecordLitt
r
->
Record
(
LabelMap
.
map
(
eval
env
)
r
)
|
Typed
.
Pair
(
e1
,
e2
)
->
Pair
(
eval
env
e1
,
eval
env
e2
)
...
...
@@ -92,10 +95,11 @@ and eval_abstraction env a =
(
a
.
Typed
.
fun_iface
,
eval_branches
env
a
.
Typed
.
fun_body
)
in
self
:=
a
;
a
(*
and eval_apply f arg = match f with
| Abstraction (_,clos) -> clos arg
| _ -> assert false
*)
and
eval_branches
env
brs
arg
=
let
(
disp
,
rhs
)
=
Typed
.
dispatcher
brs
in
...
...
@@ -567,3 +571,5 @@ let eval = function
|
Let_funs
funs
->
eval_rec_funs
funs
end
let
()
=
eval_apply
:=
L
.
eval_apply
runtime/eval.mli
View file @
03bb9810
...
...
@@ -5,6 +5,7 @@ exception MultipleDeclaration of id
type
env
val
empty
:
env
val
from_comp_unit
:
(
Types
.
CompUnit
.
t
->
id
->
t
)
ref
val
enter_value
:
id
->
t
->
env
->
env
val
enter_values
:
(
id
*
t
)
list
->
env
->
env
...
...
typing/typer.ml
View file @
03bb9810
...
...
@@ -102,6 +102,10 @@ let iter_values env f =
let
enter_cu
x
cu
env
=
{
env
with
cu
=
Env
.
add
(
ident
x
)
cu
env
.
cu
}
let
find_cu
x
env
=
try
Env
.
find
x
env
.
cu
with
Not_found
->
failwith
(
"Unbound compunit prefix "
^
(
Ident
.
to_string
x
))
(* Namespaces *)
let
set_ns_table_for_printer
env
=
...
...
@@ -791,7 +795,7 @@ let rec expr env loc = function
|
""
,
id
->
let
id
=
ident
id
in
exp
loc
(
Fv
.
singleton
id
)
(
Typed
.
Var
id
)
|
cu
,
id
->
let
cu
=
Env
.
find
(
ident
(
U
.
mk
cu
))
env
.
cu
in
let
cu
=
find
_cu
(
ident
(
U
.
mk
cu
))
env
in
exp
loc
Fv
.
empty
(
Typed
.
ExtVar
(
cu
,
ident
id
)))
|
Apply
(
e1
,
e2
)
->
let
(
fv1
,
e1
)
=
expr
env
loc
e1
and
(
fv2
,
e2
)
=
expr
env
loc
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