Commit 9b1bb431 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-06-25 23:20:40 by cvscast] Local namespace bindings -- Alain

Original author: cvscast
Date: 2003-06-25 23:20:40+00:00
parent 193b887b
......@@ -64,6 +64,9 @@ and pexpr =
(* Exceptions *)
| Try of pexpr * branches
(* Other *)
| NamespaceIn of U.t * Atoms.Ns.t * pexpr
and abstr = {
fun_name : id option;
fun_iface : (ppat * ppat) list;
......
......@@ -120,14 +120,12 @@ EXTEND
let schema_doc = Schema_xml.pxp_tree_of uri in
let schema = Schema_parser.parse_schema schema_doc in
[ mk loc (SchemaDecl (name, schema))]
| "namespace";
name = [ name = [ UIDENT | LIDENT | keyword ]; "=" ->
parse_ident name
| -> U.mk "" ];
uri = STRING2 ->
let ns = Atoms.Ns.mk (parse_ident uri) in
Atoms.Ns.register_prefix name ns;
[ mk loc (Namespace (name, ns)) ]
| (name,ns) = namespace_binding ->
Atoms.Ns.register_prefix name ns;
[ mk loc (Namespace (name, ns)) ]
| (name,ns) = namespace_binding; "in"; e2 = expr LEVEL "top" ->
let e = exp loc (NamespaceIn (name, ns, e2)) in
[ mk loc (EvalStatement (exp loc e)) ]
| "debug"; d = debug_directive -> [ mk loc (Debug d) ]
| DIRECTIVE "#quit" -> [ mk loc (Directive `Quit) ]
| DIRECTIVE "#env" -> [ mk loc (Directive `Env) ]
......@@ -205,6 +203,8 @@ EXTEND
exp loc (Abstraction { fun_name = f; fun_iface = a; fun_body = b })
| (_,p,e1) = let_binding; "in"; e2 = expr LEVEL "top"->
exp loc (Match (e1,[p,e2]))
| (name,ns) = namespace_binding; "in"; e2 = expr LEVEL "top" ->
exp loc (NamespaceIn (name, ns, e2))
| e = expr; ":"; p = pat ->
exp loc (Forget (e,p))
]
......@@ -313,7 +313,19 @@ EXTEND
| "!"; e = expr LEVEL "no_appl" -> `Explode e
]
];
namespace_binding: [
[ "namespace";
name = [ name = [ UIDENT | LIDENT | keyword ]; "=" ->
parse_ident name
| -> U.mk "" ];
uri = STRING2 ->
let ns = Atoms.Ns.mk (parse_ident uri) in
(name,ns)
]
];
let_binding: [
[ "let"; is_fun_decl; OPT "fun"; (f,a,b) = fun_decl ->
let f = match f with Some x -> x | None -> assert false in
......
......@@ -711,6 +711,9 @@ let rec expr glb loc = function
let (fv1,e) = expr glb loc e
and (fv2,b) = branches glb b in
exp loc (Fv.cup fv1 fv2) (Typed.Try (e, b))
| NamespaceIn (pr,ns,e) ->
let glb = register_ns_prefix glb pr ns in
expr glb loc e
and branches glb b =
......
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