Commit c1733997 authored by Pietro Abate's avatar 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
......@@ -49,7 +49,7 @@ and pexpr =
| Cst of pconst
| Pair of pexpr * pexpr
| Xml of pexpr * pexpr
| RecordLitt of pexpr label_map
| RecordLitt of (label * pexpr) list
| 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 label_map
| Record of bool * (label * ppat) list
| Capture of id
| Constant of id * pconst
| Regexp of regexp * ppat
......
......@@ -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
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment