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
8535f6b3
Commit
8535f6b3
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2004-05-05 21:14:46 by afrisch] New semantics for 'using'
Original author: afrisch Date: 2004-05-05 21:14:47+00:00
parent
ea45944e
Changes
7
Hide whitespace changes
Inline
Side-by-side
compile/compile.ml
View file @
8535f6b3
...
...
@@ -194,6 +194,9 @@ let namespace (tenv,cenv,codes) pr ns =
let
tenv
=
Typer
.
enter_ns
pr
ns
tenv
in
(
tenv
,
cenv
,
codes
)
let
find_cu
(
tenv
,_,_
)
cu
=
Typer
.
find_cu
cu
tenv
let
using
(
tenv
,
cenv
,
codes
)
x
cu
=
let
tenv
=
Typer
.
enter_cu
x
cu
tenv
in
(
tenv
,
cenv
,
codes
)
...
...
@@ -222,6 +225,7 @@ let rec phrases ~run ~show ~loading ~directive =
|
{
descr
=
Ast
.
Namespace
(
pr
,
ns
)
}
::
rest
->
loop
(
namespace
accu
pr
ns
)
rest
|
{
descr
=
Ast
.
Using
(
x
,
cu
)
}
::
rest
->
let
cu
=
find_cu
accu
cu
in
loading
cu
;
loop
(
using
accu
x
cu
)
rest
|
{
descr
=
Ast
.
EvalStatement
e
}
::
rest
->
...
...
driver/cduce.ml
View file @
8535f6b3
...
...
@@ -121,6 +121,10 @@ let rec print_exn ppf = function
|
Typer
.
UnboundId
(
x
,
tn
)
->
Format
.
fprintf
ppf
"Unbound identifier %a%s@."
U
.
print
(
Id
.
value
x
)
(
if
tn
then
" (it is a type name)"
else
""
)
|
Typer
.
UnboundExtId
(
cu
,
x
)
->
Format
.
fprintf
ppf
"Unbound external identifier %a:%a@."
U
.
print
(
Types
.
CompUnit
.
value
cu
)
U
.
print
(
Id
.
value
x
)
|
Ulexer
.
Error
(
i
,
j
,
s
)
->
let
loc
=
Location
.
loc_of_pos
(
i
,
j
)
,
`Full
in
Format
.
fprintf
ppf
"Error %a:@."
Location
.
print_loc
loc
;
...
...
parser/ast.ml
View file @
8535f6b3
(* Abstract syntax as produced by the parse
d
*)
(* Abstract syntax as produced by the parse
r
*)
open
Location
open
Ident
...
...
@@ -12,7 +12,7 @@ and pmodule_item' =
|
LetDecl
of
ppat
*
pexpr
|
FunDecl
of
pexpr
|
Namespace
of
U
.
t
*
Ns
.
t
|
Using
of
U
.
t
*
Types
.
CompUnit
.
t
|
Using
of
U
.
t
*
U
.
t
|
EvalStatement
of
pexpr
|
Directive
of
toplevel_directive
and
debug_directive
=
...
...
parser/parser.ml
View file @
8535f6b3
...
...
@@ -108,8 +108,8 @@ EXTEND
|
(
_
,
p
,
e1
)
=
let_binding
;
"in"
;
e2
=
expr
LEVEL
"top"
->
[
mk
loc
(
EvalStatement
(
exp
loc
(
Match
(
e1
,
[
p
,
e2
]))))
]
|
"type"
;
x
=
IDENT
;
"="
;
t
=
pat
->
[
mk
loc
(
TypeDecl
(
ident
x
,
t
))
]
|
"using"
;
name
=
IDENT
;
"="
;
cu
=
STRING2
->
[
mk
loc
(
Using
(
U
.
mk
name
,
Types
.
CompUnit
.
mk
(
U
.
mk
cu
))
)
]
|
"using"
;
name
=
IDENT
;
"="
;
cu
=
[
IDENT
|
STRING2
]
->
[
mk
loc
(
Using
(
U
.
mk
name
,
U
.
mk
cu
))
]
|
"schema"
;
name
=
IDENT
;
"="
;
uri
=
STRING2
->
protect_op
"schema"
;
let
schema
=
match
Url
.
process
uri
with
...
...
@@ -192,7 +192,7 @@ EXTEND
|
"if"
|
"then"
|
"else"
|
"transform"
|
"fun"
|
"in"
|
"let"
|
"type"
|
"debug"
|
"include"
|
"and"
|
"validate"
|
"schema"
|
"namespace"
|
"ref"
|
"
using
"
|
"and"
|
"validate"
|
"schema"
|
"namespace"
|
"ref"
|
"
alias
"
|
"not"
|
"as"
]
->
a
...
...
typing/typer.ml
View file @
8535f6b3
...
...
@@ -20,10 +20,12 @@ type item =
|
Type
of
Types
.
t
|
Val
of
Types
.
t
module
UEnv
=
Map
.
Make
(
U
)
type
t
=
{
ids
:
item
Env
.
t
;
ns
:
Ns
.
table
;
cu
:
Types
.
CompUnit
.
t
Env
.
t
;
cu
:
Types
.
CompUnit
.
t
U
Env
.
t
;
}
let
hash
_
=
failwith
"Typer.hash"
...
...
@@ -50,25 +52,23 @@ let deserialize s =
let
ids
=
Serialize
.
Get
.
env
Id
.
deserialize
deserialize_item
Env
.
add
Env
.
empty
s
in
let
ns
=
Ns
.
deserialize_table
s
in
{
ids
=
ids
;
ns
=
ns
;
cu
=
Env
.
empty
}
{
ids
=
ids
;
ns
=
ns
;
cu
=
U
Env
.
empty
}
let
empty_env
=
{
ids
=
Env
.
empty
;
ns
=
Ns
.
empty_table
;
cu
=
Env
.
empty
;
cu
=
U
Env
.
empty
;
}
let
from_comp_unit
=
ref
(
fun
cu
->
assert
false
)
let
enter_cu
x
cu
env
=
{
env
with
cu
=
Env
.
add
(
ident
x
)
cu
env
.
cu
}
{
env
with
cu
=
U
Env
.
add
x
cu
env
.
cu
}
let
find_cu
loc
x
env
=
try
Env
.
find
x
env
.
cu
with
Not_found
->
raise_loc_generic
loc
(
"Unbound compunit prefix "
^
(
Ident
.
to_string
x
))
let
find_cu
x
env
=
try
UEnv
.
find
x
env
.
cu
with
Not_found
->
Types
.
CompUnit
.
mk
x
let
enter_type
id
t
env
=
...
...
@@ -82,7 +82,7 @@ let find_type id env =
|
Val
_
->
raise
Not_found
let
find_type_global
loc
cu
id
env
=
let
cu
=
find_cu
loc
cu
env
in
let
cu
=
find_cu
cu
env
in
let
env
=
!
from_comp_unit
cu
in
find_type
id
env
...
...
@@ -173,6 +173,7 @@ exception ShouldHave of Types.descr * string
exception
ShouldHave2
of
Types
.
descr
*
string
*
Types
.
descr
exception
WrongLabel
of
Types
.
descr
*
label
exception
UnboundId
of
id
*
bool
exception
UnboundExtId
of
Types
.
CompUnit
.
t
*
id
exception
Error
of
string
let
raise_loc
loc
exn
=
raise
(
Location
(
loc
,
`Full
,
exn
))
...
...
@@ -493,7 +494,7 @@ let rec derecurs env p = match p.descr with
with
Not_found
->
PCapture
v
)
|
cu
,
v
->
try
let
cu
=
ident
(
U
.
mk
cu
)
in
let
cu
=
U
.
mk
cu
in
PType
(
find_type_global
p
.
loc
cu
(
ident
v
)
env
.
penv_tenv
)
with
Not_found
->
raise_loc_generic
p
.
loc
...
...
@@ -842,7 +843,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
=
find_cu
loc
(
ident
(
U
.
mk
cu
)
)
env
in
let
cu
=
find_cu
(
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
...
...
@@ -1101,7 +1102,7 @@ and type_check' loc env e constr precise = match e with
let
t
=
try
find_value_global
cu
s
env
with
Not_found
->
raise_loc
loc
(
UnboundId
(
s
,
false
)
)
in
raise_loc
loc
(
Unbound
Ext
Id
(
cu
,
s
)
)
in
verify
loc
t
constr
|
Cst
c
->
verify
loc
(
Types
.
constant
c
)
constr
...
...
typing/typer.mli
View file @
8535f6b3
...
...
@@ -6,6 +6,7 @@ exception Constraint of Types.descr * Types.descr
exception
ShouldHave
of
Types
.
descr
*
string
exception
WrongLabel
of
Types
.
descr
*
label
exception
UnboundId
of
id
*
bool
exception
UnboundExtId
of
Types
.
CompUnit
.
t
*
id
exception
ShouldHave2
of
Types
.
descr
*
string
*
Types
.
descr
exception
Error
of
string
val
warning
:
loc
->
string
->
unit
...
...
@@ -22,6 +23,7 @@ val register_types : Types.CompUnit.t -> t -> unit
val
enter_ns
:
U
.
t
->
Ns
.
t
->
t
->
t
val
enter_cu
:
U
.
t
->
Types
.
CompUnit
.
t
->
t
->
t
val
find_cu
:
U
.
t
->
t
->
Types
.
CompUnit
.
t
val
enter_value
:
id
->
Types
.
t
->
t
->
t
val
enter_values
:
(
id
*
Types
.
t
)
list
->
t
->
t
...
...
web/manual/interpreter.xml
View file @
8535f6b3
...
...
@@ -144,9 +144,13 @@ and global namespace default <code>namespace "%%...%%"</code>
<li>
Schema declaration
<code>
schema %%name%% = "%%...%%"
</code>
(see
<local
href=
"manual_schema"
>
XML Schema
</local>
).
</li>
<li>
Import external unit
<code>
using %%name%% = "%%unit%%"
</code>
:
import a pre-compiled
<code>
%%unit%%.cdo
</code>
CDuce unit. Values
and types from this unit can be referred to as
<code>
%%name%%:%%ident%%
</code>
<li>
Import external unit
<code>
using %%name%% = "%%unit%%"
</code>
or
<code>
using %%name%% = %%unit%%
</code>
:
imports a pre-compiled
<code>
%%unit%%.cdo
</code>
CDuce unit. Values
and types from this unit can be referred to as
<code>
%%name%%:%%ident%%
</code>
instead of
<code>
%%unit%%:%%ident%%
</code>
.
</li>
</ul>
...
...
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