[r2005-03-04 01:16:24 by afrisch] More uniform treatment of cduce,ocaml,schema units

Original author: afrisch
Date: 2005-03-04 01:16:26+00:00

compile/compile.ml

@@ -78,7 +78,7 @@ and compile_aux env tail = function
   | Typed.Transform (e,brs) -> Transform 
       (compile env false e, compile_branches env false brs)
   | Typed.Xtrans (e,brs) -> Xtrans (compile env false e, compile_branches env false brs)
-  | Typed.Validate (e,k,sch,t) -> Validate (compile env tail e, k, sch, t)
+  | Typed.Validate (e,sch,t) -> Validate (compile env tail e, sch, t)
   | Typed.RemoveField (e,l) -> RemoveField (compile env tail e,l)
   | Typed.Dot (e,l) -> Dot (compile env tail e, l)
   | Typed.Try (e,brs) -> Try (compile env false e, compile_branches env tail brs)

compile/lambda.ml

@@ -56,7 +56,7 @@ type expr =
   | Transform of expr * branches
   | Xtrans of expr * branches
   | Try of expr * branches
-  | Validate of expr * schema_component_kind * string * Ns.qname
+  | Validate of expr * string * Ns.qname
   | RemoveField of expr * label
   | Dot of expr * label
   | Ref of expr * Types.Node.t
@@ -186,10 +186,9 @@ module Put = struct
 	bits nbits s 12;
 	expr s e;
 	branches s brs
-    | Validate (e,k,sch,t) ->
+    | Validate (e,sch,t) ->
 	bits nbits s 13;
 	expr s e;
-	serialize_schema_component_kind s k;
 	string s sch;
 	Ns.QName.serialize s t
 (*	assert false (* TODO:Need to store a pointer to the schema ... *) *)
@@ -313,10 +312,9 @@ module Get = struct
 	  Try (e,brs)
       | 13 -> 
 	  let e = expr s in
-	  let k = deserialize_schema_component_kind s in
 	  let sch = string s in
 	  let t = Ns.QName.deserialize s in
-	  Validate (e,k,sch,t)
+	  Validate (e,sch,t)
       | 14 ->
 	  let e = expr s in
 	  let l = LabelPool.deserialize s in

compile/lambda.mli

@@ -29,7 +29,7 @@ type expr =
   | Transform of expr * branches
   | Xtrans of expr * branches
   | Try of expr * branches
-  | Validate of expr * schema_component_kind * string * Ns.qname
+  | Validate of expr * string * Ns.qname
   | RemoveField of expr * label
   | Dot of expr * label
   | Ref of expr * Types.Node.t

driver/cduce.ml

@@ -251,11 +251,6 @@ let directive ppf tenv cenv = function
       (if !toplevel then raise End_of_file)
   | `Env ->
       dump_env ppf tenv cenv
-  | `Print_schema schema ->
-      let uri = Typer.find_schema schema tenv in
-      let sch = Typer.get_schema uri in
-      Schema_common.print_schema ppf sch;
-      flush_ppf ppf
   | `Print_type t ->
       let t = Typer.typ tenv t in
       Format.fprintf ppf "%a@." Types.Print.print_noname (Types.descr t)

driver/librarian.ml

@@ -81,6 +81,10 @@ let deserialize_dep =
 *)
 
 
+let has_obj n =
+  let base = Encodings.Utf8.to_string n ^ ".cdo" in
+  List.exists (fun p -> Sys.file_exists (Filename.concat p base)) !obj_path
+
 let find_obj id = 
   let base = Encodings.Utf8.to_string (C.value id) ^ ".cdo" in
   let p = 
@@ -278,6 +282,7 @@ let import_from_string id str dig dep = ignore (load_from_string id str dig dep)
 
 let () =
   Typer.from_comp_unit := (fun cu -> (load cu).typing);
+  Typer.has_comp_unit := has_obj;
   Compile.from_comp_unit := (fun cu -> (load cu).compile);
   Eval.get_global := (fun cu i -> import_and_run cu; (load cu).vals.(i));
   Eval.set_global := (fun cu i v -> import cu; (load cu).vals.(i) <- v);

ocamliface/mlstub.ml

@@ -516,6 +516,8 @@ let stub name ty_env c_env values =
 
 
 let register () =
+  Typer.has_ocaml_unit :=
+    (fun cu -> Mltypes.has_cmi (U.get_str cu));
   Librarian.stub_ml := 
   (fun cu ty_env c_env ->
      try

ocamliface/mltypes.ml

@@ -183,6 +183,11 @@ let unfold ty =
 let unsupported s =
   raise (Error (Printf.sprintf "Unsupport feature (%s) found in .cmi" s))
 
+let has_cmi name =
+  Config.load_path := Config.standard_library :: !Librarian.obj_path;
+  try ignore (Misc.find_in_path_uncap !Config.load_path (name ^ ".cmi")); true
+  with Not_found -> false
+
 let read_cmi name =
   Config.load_path := Config.standard_library :: !Librarian.obj_path;
   let filename = Misc.find_in_path_uncap !Config.load_path (name ^ ".cmi") in

ocamliface/mltypes.mli

@@ -24,3 +24,5 @@ val print_ocaml : Format.formatter -> Types.type_expr -> unit
 
 
 val find_value: string -> t * int
+
+val has_cmi: string -> bool

parser/ast.ml

@@ -31,7 +31,6 @@ and toplevel_directive =
   | `Reinit_ns
   | `Help
   | `Dump of pexpr
-  | `Print_schema of U.t
   | `Print_type of ppat
   | `Debug of debug_directive
   | `Verbose
@@ -62,8 +61,7 @@ and pexpr =
   | Map of pexpr * branches
   | Transform of pexpr * branches
   | Xtrans of pexpr * branches
-  | Validate of pexpr * Schema_types.component_kind * U.t * U.t
-      (* exp, schema component kind, schema name, element name *)
+  | Validate of pexpr * U.t * U.t (* exp, schema name, element name *)
   | Dot of pexpr * label
   | RemoveField of pexpr * label
 
@@ -94,8 +92,10 @@ and branches = (ppat * pexpr) list
 and ppat = ppat' located
 and ppat' =
   | PatVar of (U.t option) * U.t  (* optional compilation unit *)
+(*
   | SchemaVar of  (* type/pattern schema variable *)
       Schema_types.component_kind * U.t * U.t (* kind, schema, name *)
+*)
   | Cst of pexpr
   | NsT of U.t
   | Recurs of ppat * (Location.loc * U.t * ppat) list

parser/parser.ml

@@ -159,8 +159,6 @@ EXTEND
     | "#"; IDENT "ascii" -> Ulexer.enc := Ulexing.Ascii; [ ]
     | "#"; IDENT "quit" -> [ mk loc (Directive `Quit) ]
     | "#"; IDENT "env" -> [ mk loc (Directive `Env) ]
-    | "#"; IDENT "print_schema"; name = IDENT ->
-        [ mk loc (Directive (`Print_schema (U.mk name))) ]
     | "#"; IDENT "print_type"; t = pat ->
         [ mk loc (Directive (`Print_type t)) ]
     | "#"; IDENT "dump_value"; e = expr -> [ mk loc (Directive (`Dump e)) ]
@@ -238,8 +236,8 @@ EXTEND
 	exp loc (if_then_else e e1 e2)
     | "transform"; e = SELF; "with"; b = branches -> 
 	exp loc (Transform (e,b))
-    | "validate"; e = SELF; "with"; (kind, schema, typ) = schema_ref ->
-        exp loc (Validate (e, kind, schema, typ))
+    | "validate"; e = SELF; "with"; (schema, typ) = schema_ref ->
+        exp loc (Validate (e, schema, typ))
     | "fun"; (f,a,b) = fun_decl ->
 	exp loc (Abstraction { fun_name = f; fun_iface = a; fun_body = b })
     | "external"; s = STRING2 ->
@@ -512,19 +510,8 @@ EXTEND
     ]
   ];
 
-  schema_kind : [
-    [ IDENT "element" -> `Element
-    | "type" -> `Type
-    | IDENT "attribute" -> `Attribute
-    | IDENT "attribute_group" -> `Attribute_group
-    | IDENT "model_group" -> `Model_group
-    ]
-  ];
-
   schema_ref: [
-    [ schema = IDENT; "#"; typ = [ IDENT | keyword ];
-      kind = OPT [ "as"; k = schema_kind -> k] ->
-        (kind, U.mk schema, U.mk typ)
+    [ schema = IDENT; "."; typ = [ IDENT | keyword ] -> (U.mk schema, U.mk typ)
     ]
   ];
 
@@ -551,13 +538,8 @@ EXTEND
       | IDENT "_" -> mk loc (Internal Types.any)
       | "("; a = IDENT; ":="; c = expr; ")" -> 
 	  mk loc (Constant (ident a,c))
-      | schema = IDENT; "#"; typ = [ IDENT | keyword ];
-        kind = OPT [ "as"; k = schema_kind -> k] ->
-          mk loc (SchemaVar (kind, U.mk schema, U.mk typ))
       | "!"; a = IDENT ->
 	  mk loc (Internal (Types.abstract (Types.Abstract.atom a)))
-(*      | a = IDENT -> 
-	  mk loc (PatVar (None, U.mk a)) *)
       | cu = OPT [ cu = IDENT; "." -> U.mk cu ]; a = IDENT ->
 	  mk loc (PatVar (cu, U.mk a))
       | i = INT ; "--"; j = INT -> 

runtime/eval.ml

@@ -141,7 +141,7 @@ let rec eval env = function
   | Transform (arg,brs) -> eval_transform env brs (eval env arg) 
   | Dot (e, l) -> eval_dot l (eval env e)
   | RemoveField (e, l) -> eval_remove_field l (eval env e)
-  | Validate (e, kind, schema, name) -> eval_validate env e kind schema name
+  | Validate (e, schema, name) -> eval_validate env e schema name
   | Ref (e,t) -> eval_ref env e t
   | Op (op,args) as e -> 
       let eval_fun = eval_op op in
@@ -229,22 +229,10 @@ and eval_branches_new env brs arg =
 and eval_ref env e t=
   Value.mk_ref (Types.descr t) (eval env e)
 
-and eval_validate env e kind uri name = 
-  let schema = Typer.get_schema uri in
-  try
-    let validate =
-      match Schema_common.get_component kind name schema with
-      | Schema_types.Type x -> Schema_validator.validate_type x schema
-      | Schema_types.Element x -> Schema_validator.validate_element x schema
-      | Schema_types.Attribute x ->
-          assert false  (* TODO see schema/schema_validator.mli *)
-(*           Schema_validator.validate_attribute x schema *)
-      | Schema_types.Attribute_group x ->
-          Schema_validator.validate_attribute_group x schema
-      | Schema_types.Model_group x ->
-          Schema_validator.validate_model_group x schema
-    in
-    validate (eval env e)
+and eval_validate env e uri name = 
+(* TODO: compute the validator when loading the lambda code *)
+  let validate = Typer.get_schema_validator uri name in
+  try validate (eval env e)
   with Schema_common.XSI_validation_error msg ->
     failwith' ("Schema validation failure: " ^ msg)
 

schema/schema_builtin.ml

@@ -712,7 +712,8 @@ let string_of_time_type fields =
 
   (** {2 API} *)
 
-let is = QTable.mem builtins
+let xsd_any = (xsd,Utf8.mk "anyType")
+let is s = QTable.mem builtins s || (Ns.QName.equal s xsd_any)
 let iter f = QTable.iter f builtins
 
 let get name = QTable.find builtins name

schema/schema_validator.ml

@@ -33,8 +33,6 @@ let foo_qname = Ns.empty, Utf8.mk ""
 
 type context = {
   ctx_stream: event Stream.t;
-  ctx_schema: schema;
-
   mutable ctx_mixed: bool;
   mutable ctx_current: Value.t;
 }
@@ -523,14 +521,13 @@ and validate_model_group ctx model_group =
   | Sequence particles -> List.iter (validate_particle ctx) particles
 
 
-let ctx stream schema =
+let ctx stream =
   { ctx_stream = stream;
-    ctx_schema = schema;
     ctx_mixed = false;
     ctx_current = Value.Absent }
 
-let validate_element decl schema value =
-  let ctx = ctx (stream_of_value value) schema in
+let validate_element decl value =
+  let ctx = ctx (stream_of_value value) in
   validate_element ctx decl
 
 let get_str v = 
@@ -539,12 +536,12 @@ let get_str v =
       "Only string values could be validate against simple types";
   fst (get_string_utf8 v)
 
-let validate_type def schema value =
+let validate_type def value =
   match def with
   | AnyType -> value  (* shortcut *)
   | Simple st_def -> validate_simple_type st_def (get_str value)
   | Complex ct_def ->
-      let ctx = ctx (stream_of_value value) schema in
+      let ctx = ctx (stream_of_value value) in
       let start_tag = expect_any_start_tag ctx in
       let attrs = get_attributes ctx in
       let (attrs, content) = validate_complex_type ctx attrs ct_def in
@@ -552,7 +549,7 @@ let validate_type def schema value =
       Value.Xml (Value.Atom (Atoms.V.of_qname start_tag), attrs, content)
 
 (*
-let validate_attribute decl schema value =
+let validate_attribute decl value =
   assert false; (* TODO see the .mli *)
   (match value with
   | Record _ -> ()
@@ -586,7 +583,7 @@ let validate_attribute decl schema value =
   Value.vrecord fields
 *)
 
-let validate_attribute_group { ag_def = attr_uses } schema value =
+let validate_attribute_group { ag_def = attr_uses } value =
   let stream =
     match value with
     | Record _ ->
@@ -600,18 +597,18 @@ let validate_attribute_group { ag_def = attr_uses } schema value =
         error
           "Only record values could be validated against attribute groups"
   in
-  let ctx = ctx stream schema in
+  let ctx = ctx stream in
   let attrs = get_attributes ctx in
   validate_attribute_uses attrs attr_uses
 
 
-let validate_model_group { mg_def = mg } schema value =
+let validate_model_group { mg_def = mg } value =
   if not (Value.is_seq value) then
     error
       "Only sequence values could be validated against model groups";
   let stream = stream_of_value (Value.Xml (foo_atom, empty_record, value)) in
   Stream.junk stream;
-  let ctx = ctx stream schema in
+  let ctx = ctx stream in
   validate_model_group ctx mg;
   get ctx
 

schema/schema_validator.mli

@@ -12,7 +12,7 @@ open Schema_types
    * that a given XML value has the given type ignoring tag name (CDuce domain:
    * XML values)
    *)
-val validate_type : type_definition -> schema -> Value.t -> Value.t
+val validate_type : type_definition -> Value.t -> Value.t
 
   (** CDuce domain: records
    *
@@ -29,15 +29,15 @@ val validate_type : type_definition -> schema -> Value.t -> Value.t
 *)
 
   (** CDuce domain: XML values *)
-val validate_element : element_declaration -> schema -> Value.t -> Value.t
+val validate_element : element_declaration -> Value.t -> Value.t
 
   (** CDuce domain: records *)
 val validate_attribute_group :
-  attribute_group_definition -> schema -> Value.t -> Value.t
+  attribute_group_definition -> Value.t -> Value.t
 
   (** CDuce domain: sequences of XML values *)
 val validate_model_group :
-  model_group_definition -> schema -> Value.t -> Value.t
+  model_group_definition -> Value.t -> Value.t
 
 
 (** {2 derived validators} *)

tests/schema/test.pl

@@ -31,13 +31,13 @@ foreach my $s (@ARGV) {
 EOF
     if ($root) {
       print CD <<EOF;
-	#print_type X # $root;;
+	#print_type X . $root;;
 EOF
     }
     if (-f "$1.xml") {
       print CD <<EOF;
 	let x = load_xml "$1.xml";;
-	let y = validate x with X # $root;;
+	let y = validate x with X . $root;;
 	print_xml y;;
 EOF
     }

types/externals.mli

 val nb: unit -> int
 
 val register: ref (int -> string -> Types.Node.t list -> Types.t)
-
 val resolve: string -> Types.Node.t list -> (int * Types.t)

typing/typed.ml

@@ -42,8 +42,7 @@ and  texpr' =
   | Map of texpr * branches
   | Transform of texpr * branches
   | Xtrans of texpr * branches
-  | Validate of texpr * Schema_types.component_kind * string * Ns.qname
-      (* exp, schema component kind, schema uri, element name *)
+  | Validate of texpr * string * Ns.qname (* exp, schema uri, element name *)
   | RemoveField of texpr * label
   | Dot of texpr * label
       

typing/typer.ml

@@ -43,13 +43,17 @@ type item =
   | Type of Types.t
   | Val of Types.t
 
+type ext =
+  | ECDuce of Types.CompUnit.t   (* CDuce unit *)
+  | EOCaml of string             (* OCaml module *)
+  | ESchema of string            (* XML Schema *)
+
 module UEnv = Map.Make(U)
 
 type t = {
   ids : item Env.t;
   ns: Ns.table;
-  cu: Types.CompUnit.t UEnv.t;
-  schemas: string UEnv.t
+  cu: ext UEnv.t;
 }
 
 let hash _ = failwith "Typer.hash"
@@ -62,18 +66,13 @@ let check _ = failwith "Typer.check"
 let load_schema_fwd = ref (fun x uri -> assert false)
 
 let enter_schema ?prefix x uri env =
-  let sch,reg = !load_schema_fwd x uri in
-(* Set the namespace prefix before registration for better pretty
-   printing *)
-  let env = 
-    { env with 
-	schemas = UEnv.add x uri env.schemas;
-	ns = (match prefix with 
-		| Some p -> 
-		    Ns.add_prefix p sch.Schema_types.targetNamespace env.ns
-		| None -> env.ns) } in
-  reg ();
-  env
+  let sch = !load_schema_fwd x uri in
+  { env with 
+      cu = UEnv.add x (ESchema uri) env.cu;
+      ns = (match prefix with 
+	      | Some p -> 
+		  Ns.add_prefix p sch.Schema_types.targetNamespace env.ns
+	      | None -> env.ns) }
 
 
 (* TODO: filter out builtin defs ? *)
@@ -86,7 +85,9 @@ let serialize s env =
   Ns.serialize_table s env.ns;
 
   let schs =
-    UEnv.fold (fun name uri accu -> (name,uri)::accu) env.schemas [] in
+    UEnv.fold (fun name cu accu -> 
+		 match cu with ESchema uri -> (name,uri)::accu | _ -> accu) 
+      env.cu [] in
   Serialize.Put.list (Serialize.Put.pair U.serialize Serialize.Put.string) s schs
 
 let deserialize_item s = match Serialize.Get.bits 1 s with
@@ -101,7 +102,7 @@ let deserialize s =
     Serialize.Get.list 
       (Serialize.Get.pair U.deserialize Serialize.Get.string) s in
   let env = 
-    { ids = ids; ns = ns; cu = UEnv.empty; schemas = UEnv.empty } in
+    { ids = ids; ns = ns; cu = UEnv.empty } in
   List.fold_left (fun env (name,uri) -> enter_schema name uri env) env schs
 
 
@@ -109,22 +110,30 @@ let empty_env = {
   ids = Env.empty;
   ns = Ns.empty_table;
   cu = UEnv.empty;
-  schemas = UEnv.empty
 }
 
-let from_comp_unit = ref (fun cu -> assert false)
+let from_comp_unit = ref (fun (cu : Types.CompUnit.t) -> assert false)
+let has_comp_unit = ref (fun cu -> assert false)
+let has_ocaml_unit = ref (fun cu -> false)
 
 let enter_cu x cu env =
-  { env with cu = UEnv.add x cu env.cu }
+  { env with cu = UEnv.add x (ECDuce cu) env.cu }
 
-let find_cu x env =
+let find_cu loc x env =
   try UEnv.find x env.cu
-  with Not_found -> Types.CompUnit.mk x
+  with Not_found ->
+    if !has_comp_unit x then (ECDuce (Types.CompUnit.mk x))
+    else if !has_ocaml_unit x then (EOCaml (U.get_str x))
+    else error loc ("Cannot find external unit " ^ (U.to_string x))
 
 
 let find_schema x env =
-  try UEnv.find x env.schemas
-  with Not_found -> raise (Error (Printf.sprintf "%s: no such schema" (U.get_str x)))
+  try 
+    (match UEnv.find x env.cu with
+      | ESchema s -> s 
+      | _ -> raise Not_found)
+  with Not_found -> 
+    raise (Error (Printf.sprintf "%s: no such schema" (U.to_string x)))
 
 let enter_type id t env =
   { env with ids = Env.add id (Type t) env.ids }
@@ -136,10 +145,6 @@ let find_type id env =
     | Type t -> t
     | Val _ -> raise Not_found
 
-let find_type_global loc cu id env =
-  let cu = find_cu cu env in
-  let env = !from_comp_unit cu in
-  find_type id env
 
 let enter_value id t env = 
   { env with ids = Env.add id (Val t) env.ids }
@@ -153,12 +158,9 @@ let find_value id env =
   match Env.find id env.ids with
     | Val t -> t
     | _ -> raise Not_found
-let find_value_global cu id env =
-  let env = !from_comp_unit cu in
-  find_value id env
-let is_cu id env =
-  try ignore (!from_comp_unit (find_cu id env)); true
-  with _ -> false
+let find_value_global loc cu id env =
+  try find_value id (!from_comp_unit cu)
+  with Not_found -> raise_loc loc (UnboundExtId (cu,id))
 	
 let value_name_ok id env =
   try match Env.find id env.ids with
@@ -239,55 +241,24 @@ let rec const env loc = function
 
 (* Schema *)
 
-let is_registered_schema env s = UEnv.mem s env.schemas
-
 (* uri -> schema binding *)
-let schemas = State.ref "Typer.schemas" (Hashtbl.create 3)
-
-let schema_types = State.ref "Typer.schema_types" (Hashtbl.create 51)
-let schema_elements = State.ref "Typer.schema_elements" (Hashtbl.create 51)
-let schema_attributes = State.ref "Typer.schema_attributes" (Hashtbl.create 51)
-let schema_attribute_groups =
-  State.ref "Typer.schema_attribute_groups" (Hashtbl.create 51)
-let schema_model_groups =
-  State.ref "Typer.schema_model_groups" (Hashtbl.create 51)
+let schemas = Hashtbl.create 3
 
-
-(*
-let get_schema uri =
-  try Hashtbl.find !schemas uri
-  with Not_found -> assert false
-*)
-
-let find_schema_descr_uri kind uri (name : Ns.qname) =
+let find_schema_descr uri (name : Ns.qname) =
   try
-    let elt () = Hashtbl.find !schema_elements (uri, name) in
-    let typ () = Hashtbl.find !schema_types (uri, name) in
-    let att () = Hashtbl.find !schema_attributes (uri, name) in
-    let att_group () = Hashtbl.find !schema_attribute_groups (uri, name) in
-    let mod_group () = Hashtbl.find !schema_model_groups (uri, name) in
-    let rec do_try n = function
-      | [] -> raise Not_found
-      | f :: rem -> (try f () with Not_found -> do_try n rem)
-    in
-    match kind with
-      | Some `Element -> do_try "element" [ elt ]
-      | Some `Type -> do_try "type" [ typ ]
-      | Some `Attribute -> do_try "atttribute" [ att ]
-      | Some `Attribute_group -> do_try "attribute group" [ att_group ]
-      | Some `Model_group -> do_try "model group" [ mod_group ]
-      | None ->
-          (* policy for unqualified schema component resolution. This order should
-           * be consistent with Schema_component.get_component *)
-          do_try "component" [ elt; typ; att; att_group; mod_group ]
-    with Not_found ->    
-      raise (Error (Printf.sprintf "No %s named '%s' found in schema '%s'"
-		      (Schema_common.string_of_component_kind kind) (Ns.QName.to_string name) uri))
+    let sch = snd (Hashtbl.find schemas uri) in
+    fst (Env.find (Ident.ident name) sch)
+  with Not_found ->    
+    raise (Error (Printf.sprintf "No component named '%s' found in schema '%s'"
+		    (Ns.QName.to_string name) uri))
 
-let find_schema_descr env kind schema name =
-  let uri = find_schema schema env in
-  find_schema_descr_uri kind uri name
 
+let find_type_global loc cu id env =
+  match find_cu loc cu env with
+    | ECDuce cu -> find_type id (!from_comp_unit cu)
+    | EOCaml _ -> error loc "OCaml units don't export types" (* TODO *)
+    | ESchema s -> find_schema_descr s (Ident.value id)
+	
 
 module IType = struct
   type node = {
@@ -796,10 +767,12 @@ module IType = struct
     
   let rec derecurs env p = match p.descr with
     | PatVar (cu,v) -> derecurs_var env p.loc cu v
+(*
     | SchemaVar (kind, schema_name, component_name) ->
 
 	let name = qname env.penv_tenv  p.loc component_name in
 	itype (find_schema_descr env.penv_tenv kind schema_name name)
+*)
 
     | Recurs (p,b) -> derecurs (derecurs_def env b) p
     | Internal t -> itype t
@@ -1040,17 +1013,16 @@ let rec expr env loc = function
       let (fv1,e1) = expr env loc e1 and (fv2,e2) = expr env loc e2 in
       exp loc (Fv.cup fv1 fv2) (Typed.Xml (e1,e2))
   | Dot (LocatedExpr (_,Var cu), id) when not (has_value cu env) ->
-      if is_cu cu env then (
-	let cu = find_cu cu env in
-	let id = ident env loc id in
-	let t =
-	  try find_value_global cu id env
-	  with Not_found ->