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

Original author: cvscast
Date: 2003-06-25 23:20:40+00:00

parser/ast.ml

@@ -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;

parser/parser.ml

@@ -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

typing/typer.ml

@@ -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 =