[r2005-02-24 09:07:07 by afrisch] Bug

Original author: afrisch
Date: 2005-02-24 09:07:07+00:00

schema/schema_validator.ml

@@ -253,7 +253,7 @@ let rec validate_simple_type def s =
   | Primitive _ -> assert false
   | Derived (_, Atomic primitive, facets, base) ->
       let literal = normalize_white_space (fst facets.whiteSpace) s in
-      let value = validate_simple_type_ref base(*primitive*)(*???*) 
+      let value = validate_simple_type_ref (*base*)primitive(*???*) 
 	literal in
       Schema_facets.facets_valid facets value;
       value

typing/typer.ml

@@ -473,6 +473,7 @@ module IType = struct
 	  | None, d -> iter aux d
       )
     in
+    assert(!to_clear == []);
     match n.fv with
       | Some x -> x
       | None -> aux n; clear (); n.fv <- Some !fv; !fv
@@ -480,11 +481,9 @@ module IType = struct
 (* optimized version to check closedness *)
 
   let no_fv = Some IdSet.empty
-  let check_no_fv loc n =
-    let err x = 
-      raise_loc_generic loc 
-	("Capture variable not allowed: " ^ (Ident.to_string x))
-    in
+  exception FoundFv of id
+  let peek_fv n =
+    let err x = raise (FoundFv x) in
     let rec aux n =
       let n = repr n in
       if (n.sid = 0) then (
@@ -496,6 +495,7 @@ module IType = struct
 	  | None, d -> iter aux d
       )
     in
+    assert(!to_clear == []);
     try
       match n.fv with
 	| Some x -> (match IdSet.pick x with Some x -> err x | None -> ())
@@ -504,6 +504,17 @@ module IType = struct
 	    to_clear := []
     with exn -> clear (); raise exn
 
+  let check_no_fv loc n =
+    try peek_fv n 
+    with FoundFv x ->
+      raise_loc_generic loc 
+	("Capture variable not allowed: " ^ (Ident.to_string x))
+
+  let has_no_fv n =
+    try peek_fv n; true
+    with FoundFv _ -> false
+
+
 (* From the intermediate representation to the internal one *)
 
 
@@ -652,10 +663,24 @@ module IType = struct
       | l -> PAlt l
 
   let rec merge_alt = function
-    | PElem p::PElem q::l -> merge_alt (PElem (ior p q) :: l)
+    | PElem p::PElem q::l when (has_no_fv p) && (has_no_fv q) -> 
+	merge_alt (PElem (ior p q) :: l)
+	  (* Need the guard because of
+	       [ (x&Int|_) R' ] which is produced from [ (x::Int|_) R ]
+	     Might weaken it to (fv p = fv q)
+	  *)
     | r::l -> r::(merge_alt l)
     | [] -> []
 	
+  let rec print_regexp ppf = function
+    | PElem _ -> Format.fprintf ppf "Elem"
+    | PGuard _ -> Format.fprintf ppf "Guard"
+    | PSeq l -> Format.fprintf ppf "Seq(%a)" print_regexp_list l
+    | PAlt l -> Format.fprintf ppf "Alt(%a)" print_regexp_list l
+    | PStar r -> Format.fprintf ppf "Star(%a)" print_regexp r
+    | PWeakStar r -> Format.fprintf ppf "WStar(%a)" print_regexp r
+  and print_regexp_list ppf l =
+    List.iter (fun x -> Format.fprintf ppf "%a;" print_regexp x) l
 
   let rec remove_regexp r q = match r with
     | PElem p ->
@@ -665,7 +690,7 @@ module IType = struct
     | PSeq l ->
 	List.fold_right (fun r a -> remove_regexp r a) l q
     | PAlt rl ->
-	let rl = merge_alt rl in
+ 	let rl = merge_alt rl in
 	List.fold_left (fun a r -> ior a (remove_regexp r q)) iempty rl
     | PStar r ->
 	let x = mk_delayed () in