Skip to content
GitLab
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
c1733997
Commit
c1733997
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2003-06-30 14:11:14 by cvscast] Namespaces in record fields
Original author: cvscast Date: 2003-06-30 14:11:14+00:00
parent
7a36ebe0
Changes
3
Hide whitespace changes
Inline
Side-by-side
parser/ast.ml
View file @
c1733997
...
...
@@ -49,7 +49,7 @@ and pexpr =
|
Cst
of
pconst
|
Pair
of
pexpr
*
pexpr
|
Xml
of
pexpr
*
pexpr
|
RecordLitt
of
pexpr
l
abel_map
|
RecordLitt
of
(
label
*
pexpr
)
l
ist
|
String
of
U
.
uindex
*
U
.
uindex
*
U
.
t
*
pexpr
(* Data destructors *)
...
...
@@ -67,6 +67,8 @@ and pexpr =
(* Other *)
|
NamespaceIn
of
U
.
t
*
Ns
.
t
*
pexpr
and
label
=
U
.
t
and
abstr
=
{
fun_name
:
id
option
;
fun_iface
:
(
ppat
*
ppat
)
list
;
...
...
@@ -93,7 +95,7 @@ and ppat' =
|
XmlT
of
ppat
*
ppat
|
Arrow
of
ppat
*
ppat
|
Optional
of
ppat
|
Record
of
bool
*
ppat
l
abel_map
|
Record
of
bool
*
(
label
*
ppat
)
l
ist
|
Capture
of
id
|
Constant
of
id
*
pconst
|
Regexp
of
regexp
*
ppat
...
...
parser/parser.ml
View file @
c1733997
...
...
@@ -21,19 +21,8 @@ let parse_ident = U.mk_latin1
let
id_dummy
=
ident
(
U
.
mk
"$$$"
)
(*
let split_qname s =
try
let i = String.index s ':' in
let ns = String.sub s 0 i in
let s = String.sub s (i + 1) (String.length s - i - 1) in
(parse_ident ns, parse_ident s)
with Not_found ->
(U.mk "", parse_ident s)
*)
(* TODO: NS *)
let
label
s
=
LabelPool
.
mk
(
Ns
.
empty
,
parse_ident
s
)
let
label
=
parse_ident
let
ident
s
=
ident
(
parse_ident
s
)
let
prog
=
Grammar
.
Entry
.
create
gram
"prog"
...
...
@@ -72,8 +61,6 @@ let seq_of_string s =
in
aux
(
Encodings
.
Utf8
.
start_index
s
)
(
Encodings
.
Utf8
.
end_index
s
)
let
make_record
loc
r
=
LabelMap
.
from_list
(
fun
_
_
->
error
loc
"Duplicated record field"
)
r
let
parse_char
loc
s
=
match
seq_of_string
s
with
...
...
@@ -286,7 +273,7 @@ EXTEND
a
=
expr_attrib_spec
;
">"
;
c
=
expr
->
(* let t = Pair (cst_nil, t) in *)
exp
loc
(
Xml
(
t
,
Pair
(
a
,
c
)))
|
"{"
;
r
=
[
expr_record_spec
|
->
exp
loc
(
RecordLitt
LabelMap
.
empty
)
];
"}"
->
r
|
"{"
;
r
=
[
expr_record_spec
|
->
exp
loc
(
RecordLitt
[]
)
];
"}"
->
r
|
s
=
STRING2
->
let
s
=
U
.
mk
s
in
exp
loc
(
String
(
U
.
start_index
s
,
U
.
end_index
s
,
s
,
cst_nil
))
...
...
@@ -500,7 +487,7 @@ EXTEND
let
x
=
if
o
then
mk
loc
(
Optional
x
)
else
x
in
(
label
l
,
x
)
]
SEP
";"
->
make_record
loc
r
r
]
];
char
:
...
...
@@ -529,13 +516,13 @@ EXTEND
[
l
=
[
LIDENT
|
UIDENT
|
keyword
];
"="
;
x
=
expr
->
(
label
l
,
x
)
]
SEP
";"
->
exp
loc
(
RecordLitt
(
make_record
loc
r
)
)
exp
loc
(
RecordLitt
r
)
]
];
expr_attrib_spec
:
[
[
r
=
expr_record_spec
->
r
]
|
[
e
=
expr
LEVEL
"no_appl"
->
e
|
->
exp
loc
(
RecordLitt
(
LabelMap
.
empty
)
)
|
->
exp
loc
(
RecordLitt
[]
)
]
];
END
...
...
typing/typer.ml
View file @
c1733997
...
...
@@ -190,33 +190,32 @@ let mk_slot loc =
incr
counter
;
{
ploop
=
false
;
ploc
=
loc
;
pid
=
!
counter
;
pdescr
=
None
}
(*
let ns_from_prefix env loc ns =
try TypeEnv.find ns env.tenv_nspref
with Not_found ->
raise_loc_generic loc
("Undefined namespace prefix " ^ (U.to_string ns))
*)
let
parse_atom
env
loc
t
=
try
let
(
ns
,
l
)
=
Ns
.
map_tag
env
.
tenv_nspref
t
in
Atoms
.
mk
ns
l
let
protect_error_ns
loc
f
x
=
try
f
x
with
Ns
.
UnknownPrefix
ns
->
raise_loc_generic
loc
(
"Undefined namespace prefix "
^
(
U
.
to_string
ns
))
let
parse_ns
env
loc
ns
=
try
Ns
.
map_prefix
env
.
tenv_nspref
ns
with
Ns
.
UnknownPrefix
ns
->
raise_loc_generic
loc
(
"Undefined namespace prefix "
^
(
U
.
to_string
ns
))
let
parse_atom
env
loc
t
=
let
(
ns
,
l
)
=
protect_error_ns
loc
(
Ns
.
map_tag
env
.
tenv_nspref
)
t
in
Atoms
.
mk
ns
l
let
parse_ns
env
loc
ns
=
protect_error_ns
loc
(
Ns
.
map_prefix
env
.
tenv_nspref
)
ns
let
const
env
loc
=
function
|
Const_internal
c
->
c
|
Const_atom
t
->
Types
.
Atom
(
parse_atom
env
loc
t
)
let
parse_label
env
loc
t
=
let
(
ns
,
l
)
=
protect_error_ns
loc
(
Ns
.
map_attr
env
.
tenv_nspref
)
t
in
LabelPool
.
mk
(
ns
,
l
)
let
parse_record
env
loc
f
r
=
let
r
=
List
.
map
(
fun
(
l
,
x
)
->
(
parse_label
env
loc
l
,
f
x
))
r
in
LabelMap
.
from_list
(
fun
_
_
->
raise_loc_generic
loc
"Duplicated record field"
)
r
let
rec
derecurs
env
p
=
match
p
.
descr
with
|
PatVar
v
->
(
try
PAlias
(
TypeEnv
.
find
v
env
.
tenv_names
)
...
...
@@ -263,7 +262,7 @@ let rec derecurs env p = match p.descr with
|
XmlT
(
p1
,
p2
)
->
PXml
(
derecurs
env
p1
,
derecurs
env
p2
)
|
Arrow
(
p1
,
p2
)
->
PArrow
(
derecurs
env
p1
,
derecurs
env
p2
)
|
Optional
p
->
POptional
(
derecurs
env
p
)
|
Record
(
o
,
r
)
->
PRecord
(
o
,
LabelMap
.
map
(
derecurs
env
)
r
)
|
Record
(
o
,
r
)
->
PRecord
(
o
,
parse_record
env
p
.
loc
(
derecurs
env
)
r
)
|
Capture
x
->
PCapture
x
|
Constant
(
x
,
c
)
->
PConstant
(
x
,
const
env
p
.
loc
c
)
|
Regexp
(
r
,
q
)
->
...
...
@@ -687,13 +686,13 @@ let rec expr glb loc = function
exp
loc
(
Fv
.
cup
fv1
fv2
)
(
Typed
.
Xml
(
e1
,
e2
))
|
Dot
(
e
,
l
)
->
let
(
fv
,
e
)
=
expr
glb
loc
e
in
exp
loc
fv
(
Typed
.
Dot
(
e
,
l
))
exp
loc
fv
(
Typed
.
Dot
(
e
,
parse_label
glb
loc
l
))
|
RemoveField
(
e
,
l
)
->
let
(
fv
,
e
)
=
expr
glb
loc
e
in
exp
loc
fv
(
Typed
.
RemoveField
(
e
,
l
))
exp
loc
fv
(
Typed
.
RemoveField
(
e
,
parse_label
glb
loc
l
))
|
RecordLitt
r
->
let
fv
=
ref
Fv
.
empty
in
let
r
=
LabelMap
.
map
let
r
=
parse_record
glb
loc
(
fun
e
->
let
(
fv2
,
e
)
=
expr
glb
loc
e
in
fv
:=
Fv
.
cup
!
fv
fv2
;
e
)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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