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
44f030a7
Commit
44f030a7
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2005-06-13 12:08:21 by afrisch] Nested OCaml modules
Original author: afrisch Date: 2005-06-13 12:08:21+00:00
parent
38c16cdb
Changes
1
Hide whitespace changes
Inline
Side-by-side
typing/typer.ml
View file @
44f030a7
...
...
@@ -504,24 +504,8 @@ let rec expr env loc = function
let
(
fv1
,
e1
)
=
expr
env
loc
e1
and
(
fv2
,
e2
)
=
expr
env
loc
e2
in
let
n
=
if
env
.
keep_ns
then
Some
env
.
ns
else
None
in
exp
loc
(
Fv
.
cup
fv1
fv2
)
(
Typed
.
Xml
(
e1
,
e2
,
n
))
|
Dot
(
LocatedExpr
(
_
,
Var
cu
)
,
id
,
tyargs
)
when
not
(
has_value
cu
env
)
->
(
match
find_cu
loc
cu
env
with
|
ECDuce
cu
->
if
tyargs
!=
[]
then
error
loc
"CDuce externals cannot have type argument"
;
let
id
=
ident
env
loc
id
in
let
t
=
find_value_global
loc
cu
id
env
in
exp
loc
Fv
.
empty
(
Typed
.
ExtVar
(
cu
,
id
,
t
))
|
EOCaml
cu
->
extern
loc
env
(
cu
^
"."
^
U
.
get_str
id
)
tyargs
(* TODO: allow nested OCaml modules A.B.C.x *)
|
ESchema
_
->
error
loc
"Schema don't export values"
)
|
Dot
(
e
,
l
,
[]
)
->
let
(
fv
,
e
)
=
expr
env
loc
e
in
exp
loc
fv
(
Typed
.
Dot
(
e
,
parse_label
env
loc
l
))
|
Dot
(
_
,_,_::_
)
->
error
loc
"Field access cannot have type arguments"
|
Dot
_
as
e
->
dot
loc
env
e
|
RemoveField
(
e
,
l
)
->
let
(
fv
,
e
)
=
expr
env
loc
e
in
exp
loc
fv
(
Typed
.
RemoveField
(
e
,
parse_label
env
loc
l
))
...
...
@@ -588,6 +572,39 @@ and if_then_else loc cond yes no =
Typed
.
br_accept
=
Builtin_defs
.
bool
;
}
in
exp'
loc
(
Typed
.
Match
(
cond
,
b
))
and
dot
loc
env
e
=
let
dot_access
loc
(
fv
,
e
)
l
=
exp
loc
fv
(
Typed
.
Dot
(
e
,
parse_label
env
loc
l
))
in
let
rec
aux
loc
fields
args
=
function
|
Var
cu
when
not
(
has_value
cu
env
)
->
(
match
find_cu
loc
cu
env
with
|
ECDuce
cu
->
if
args
!=
[]
then
error
loc
"CDuce externals cannot have type argument"
;
let
id
,
fields
=
(
match
fields
with
(
hd
,_
)
::
tl
->
hd
,
tl
|
_
->
assert
false
)
in
let
id
=
ident
env
loc
id
in
let
t
=
find_value_global
loc
cu
id
env
in
let
e
=
exp
loc
Fv
.
empty
(
Typed
.
ExtVar
(
cu
,
id
,
t
))
in
List
.
fold_left
(
fun
e
(
x
,
loc
)
->
dot_access
loc
e
x
)
e
fields
|
EOCaml
cu
->
let
fields
=
List
.
map
fst
fields
in
let
s
=
String
.
concat
"."
(
cu
::
List
.
map
U
.
get_str
fields
)
in
extern
loc
env
s
args
|
ESchema
_
->
error
loc
"Schema don't export values"
)
|
LocatedExpr
(
loc
,
e
)
->
aux
loc
fields
args
e
|
Dot
(
e
,
id
,
a
)
->
aux
loc
((
id
,
loc
)
::
fields
)
(
a
@
args
)
e
|
e
->
if
args
!=
[]
then
error
loc
"Field access cannot have type arguments"
else
let
e
=
expr
env
loc
e
in
List
.
fold_left
(
fun
e
(
x
,
loc
)
->
dot_access
loc
e
x
)
e
fields
in
aux
loc
[]
[]
e
and
extern
loc
env
s
args
=
let
args
=
List
.
map
(
typ
env
)
args
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