[r2004-10-18 09:17:05 by afrisch] Trying to fix Schema...

Original author: afrisch
Date: 2004-10-18 09:17:05+00:00

schema/schema_parser.ml

-
 open Printf
 open Pxp_document
 
@@ -543,9 +542,6 @@ class lazy_resolver =
         (fun (p, ns) ->
           namespace_manager#add_namespace (Utf8.get_str p) (Utf8.get_str ns))
         Schema_xml.schema_ns_prefixes;
-(*
-
-  Need to do something about that...
 
       List.iter
         (fun n ->
@@ -555,8 +551,8 @@ class lazy_resolver =
             Hashtbl.add orig_ns_prefixes prefix uri;
             ignore (namespace_manager#lookup_or_add_namespace prefix uri)
           end)
-        root#namespace_info#declaration;
-*)
+        root#namespaces_as_nodes;
+
       if _has_attribute "targetNamespace" root then begin
         let ns = _attribute "targetNamespace" root in
         targetNamespace <- Some ns;
@@ -820,8 +816,7 @@ let schema_of_node root =
   }
 
 let parse_schema source =
-(*
-  let config =
+(*  let config =
     { new_xsd_config () with Pxp_types.enable_namespace_info = true }
   in
 *)

tests/overloading.cd

@@ -18,6 +18,12 @@ let fun sort (MPerson -> Man ; FPerson -> Woman)
        let d = map fc with x -> sort x in	
            <(tag) name=n>[ <sons>s  <daughters>d ] 
 
+let fun sort2 (MPerson -> Man ; FPerson -> Woman)
+   <person gender=(("F" & (tag := `woman)) | (tag := `man))>[ <name>n <children>[(mc::MPerson | fc::FPerson)*]; _] ->
+       let s = map mc with x -> sort x in
+       let d = map fc with x -> sort x in	
+           <(tag) name=n>[ <sons>s  <daughters>d ] 
+
 
 let base : Person = 
 <person gender="M">[ 
@@ -38,7 +44,7 @@ let base : Person =
 
 
 
-sort base;;
+print (print_xml (sort2 base));;
 
 
 (*

typing/typer.ml

@@ -1437,8 +1437,8 @@ module Schema_converter =
       let min_regexp = repeat_regexp base min in
       match max with
       | Some max ->
-          assert (max >= min);
-          let rec aux acc = function
+	  (*  assert (max >= min);   Need to use Bigint comparison ! -- AF *)
+	  let rec aux acc = function
             | z when Intervals.V.is_zero z -> acc
             | n ->
                 aux (PAlt (PEpsilon, (PSeq (base, acc)))) (Intervals.V.pred n)
@@ -1634,6 +1634,7 @@ module Schema_converter =
 
 let get_schema_names env = UEnv.fold (fun n _ acc -> n :: acc) env.schemas []
 
+
 let get_schema uri =
   try Hashtbl.find !schemas uri
   with Not_found ->
@@ -1655,8 +1656,8 @@ let get_schema uri =
     Hashtbl.add !schemas uri schema;
     List.iter (* Schema types -> CDuce types *)
       (fun type_def ->
-        let cd_type = Schema_converter.cd_type_of_type_def ~schema type_def in
         let name = Schema_common.name_of_type_definition type_def in
+        let cd_type = Schema_converter.cd_type_of_type_def ~schema type_def in
         log_schema_component "type" uri name cd_type;
         Hashtbl.add !schema_types (uri, name) cd_type)
       schema.Schema_types.types;