Commit 2da34588 authored by Pietro Abate's avatar Pietro Abate

[r2003-09-16 21:30:42 by cvscast] Cleaning in progress... + no more...

[r2003-09-16 21:30:42 by cvscast] Cleaning in progress... + no more uppercase/lowercase distinction for
identifiers

Original author: cvscast
Date: 2003-09-16 21:30:45+00:00
parent 767d0c34
......@@ -8,24 +8,24 @@ misc/pool.cmo: misc/q_symbol.cmo misc/custom.cmo misc/state.cmi misc/pool.cmi
misc/pool.cmx: misc/q_symbol.cmo misc/custom.cmx misc/state.cmx misc/pool.cmi
misc/encodings.cmo: misc/q_symbol.cmo misc/encodings.cmi
misc/encodings.cmx: misc/q_symbol.cmo misc/encodings.cmi
misc/bool.cmo: misc/q_symbol.cmo misc/custom.cmo misc/bool.cmi
misc/bool.cmx: misc/q_symbol.cmo misc/custom.cmx misc/bool.cmi
misc/bool.cmo: misc/q_symbol.cmo misc/custom.cmo misc/serialize.cmi misc/bool.cmi
misc/bool.cmx: misc/q_symbol.cmo misc/custom.cmx misc/serialize.cmx misc/bool.cmi
misc/pretty.cmo: misc/q_symbol.cmo misc/pretty.cmi
misc/pretty.cmx: misc/q_symbol.cmo misc/pretty.cmi
misc/ns.cmo: misc/q_symbol.cmo misc/encodings.cmi misc/pool.cmi misc/state.cmi misc/ns.cmi
misc/ns.cmx: misc/q_symbol.cmo misc/encodings.cmx misc/pool.cmx misc/state.cmx misc/ns.cmi
types/sortedList.cmo: misc/q_symbol.cmo misc/custom.cmo types/sortedList.cmi
types/sortedList.cmx: misc/q_symbol.cmo misc/custom.cmx types/sortedList.cmi
types/sortedList.cmo: misc/q_symbol.cmo misc/custom.cmo misc/serialize.cmi types/sortedList.cmi
types/sortedList.cmx: misc/q_symbol.cmo misc/custom.cmx misc/serialize.cmx types/sortedList.cmi
types/boolean.cmo: misc/q_symbol.cmo misc/custom.cmo types/sortedList.cmi types/boolean.cmi
types/boolean.cmx: misc/q_symbol.cmo misc/custom.cmx types/sortedList.cmx types/boolean.cmi
types/ident.cmo: misc/q_symbol.cmo misc/encodings.cmi misc/ns.cmi misc/pool.cmi \
types/sortedList.cmi
types/ident.cmx: misc/q_symbol.cmo misc/encodings.cmx misc/ns.cmx misc/pool.cmx \
types/sortedList.cmx
types/intervals.cmo: misc/q_symbol.cmo types/intervals.cmi
types/intervals.cmx: misc/q_symbol.cmo types/intervals.cmi
types/chars.cmo: misc/q_symbol.cmo types/chars.cmi
types/chars.cmx: misc/q_symbol.cmo types/chars.cmi
types/intervals.cmo: misc/q_symbol.cmo misc/custom.cmo misc/serialize.cmi types/intervals.cmi
types/intervals.cmx: misc/q_symbol.cmo misc/custom.cmx misc/serialize.cmx types/intervals.cmi
types/chars.cmo: misc/q_symbol.cmo misc/custom.cmo types/chars.cmi
types/chars.cmx: misc/q_symbol.cmo misc/custom.cmx types/chars.cmi
types/atoms.cmo: misc/q_symbol.cmo misc/encodings.cmi misc/ns.cmi misc/pool.cmi \
types/sortedList.cmi types/atoms.cmi
types/atoms.cmx: misc/q_symbol.cmo misc/encodings.cmx misc/ns.cmx misc/pool.cmx \
......@@ -111,13 +111,13 @@ typing/typed.cmx: misc/q_symbol.cmo types/ident.cmx parser/location.cmx types/pa
typing/typer.cmo: misc/q_symbol.cmo parser/ast.cmo types/atoms.cmi types/builtin_defs.cmi \
types/chars.cmi types/ident.cmo parser/location.cmi misc/ns.cmi \
types/patterns.cmi schema/schema_builtin.cmi schema/schema_types.cmi \
schema/schema_validator.cmi types/sequence.cmi misc/state.cmi \
typing/typed.cmo types/types.cmi typing/typer.cmi
schema/schema_validator.cmi types/sequence.cmi misc/serialize.cmi \
misc/state.cmi typing/typed.cmo types/types.cmi typing/typer.cmi
typing/typer.cmx: misc/q_symbol.cmo parser/ast.cmx types/atoms.cmx types/builtin_defs.cmx \
types/chars.cmx types/ident.cmx parser/location.cmx misc/ns.cmx \
types/patterns.cmx schema/schema_builtin.cmx schema/schema_types.cmx \
schema/schema_validator.cmx types/sequence.cmx misc/state.cmx \
typing/typed.cmx types/types.cmx typing/typer.cmi
schema/schema_validator.cmx types/sequence.cmx misc/serialize.cmx \
misc/state.cmx typing/typed.cmx types/types.cmx typing/typer.cmi
runtime/load_xml.cmo: misc/q_symbol.cmo types/atoms.cmi misc/encodings.cmi types/ident.cmo \
parser/location.cmi misc/ns.cmi runtime/value.cmi runtime/load_xml.cmi
runtime/load_xml.cmx: misc/q_symbol.cmo types/atoms.cmx misc/encodings.cmx types/ident.cmx \
......@@ -173,6 +173,8 @@ misc/bool.cmi: misc/q_symbol.cmo misc/custom.cmo
misc/ns.cmi: misc/q_symbol.cmo misc/custom.cmo misc/encodings.cmi
types/sortedList.cmi: misc/q_symbol.cmo misc/custom.cmo
types/boolean.cmi: misc/q_symbol.cmo misc/custom.cmo
types/intervals.cmi: misc/q_symbol.cmo misc/custom.cmo
types/chars.cmi: misc/q_symbol.cmo misc/custom.cmo
types/atoms.cmi: misc/q_symbol.cmo misc/encodings.cmi misc/ns.cmi
types/types.cmi: misc/q_symbol.cmo types/atoms.cmi types/chars.cmi misc/custom.cmo \
types/ident.cmo types/intervals.cmi
......
......@@ -84,8 +84,9 @@ let rec print_exn ppf = function
Format.fprintf ppf "Residual type:@.%a@."
print_norm t;
Format.fprintf ppf "Sample:@.%a@." print_sample (Sample.get t)
| Typer.UnboundId x ->
Format.fprintf ppf "Unbound identifier %a@." U.print (Id.value x)
| Typer.UnboundId (x,tn) ->
Format.fprintf ppf "Unbound identifier %a%s@." U.print (Id.value x)
(if tn then " (it is a type name)" else "")
| Wlexer.Illegal_character c ->
Format.fprintf ppf "Illegal character (%a)@." print_protect (Char.escaped c)
| Wlexer.Unterminated_comment ->
......
......@@ -31,6 +31,7 @@ struct
| True
| False
| Split of int * elem * t * t * t
include Custom.Dummy
let rec equal a b =
......@@ -69,17 +70,28 @@ struct
let compute_hash x p i n =
(X.hash x) + 17 * (hash p) + 257 * (hash i) + 16637 * (hash n)
let rec check = function
| True | False -> ()
| Split (h,x,p,i,n) ->
assert (h = compute_hash x p i n);
(match p with Split (_,y,_,_,_) -> assert (X.compare x y < 0) | _ -> ());
(match i with Split (_,y,_,_,_) -> assert (X.compare x y < 0) | _ -> ());
(match n with Split (_,y,_,_,_) -> assert (X.compare x y < 0) | _ -> ());
check p; check i; check n
let atom x =
let h = X.hash x + 17 in (* partial evaluation of compute_hash... *)
Split (h, x,True,False,False)
let neg_atom x =
let h = X.hash x + 16637 in (* partial evaluation of compute_hash... *)
Split (h, x,False,False,True)
let rec iter f = function
| Split (_, x, p,i,n) -> f x; iter f p; iter f i; iter f n
| _ -> ()
(* TODO: precompute hash value for Split node to have fast equality... *)
let rec dump ppf = function
| True -> Format.fprintf ppf "+"
| False -> Format.fprintf ppf "-"
......@@ -142,6 +154,10 @@ struct
let split x pos ign neg =
Split (compute_hash x pos ign neg, x, pos, ign, neg)
let empty = False
let full = True
......@@ -329,6 +345,41 @@ struct
let cap = ( ** )
let diff = ( // )
let rec serialize t = function
| (True | False) as b ->
Serialize.Put.bool t true; Serialize.Put.bool t (b = True)
| Split (_,x,p,i,n) ->
Serialize.Put.bool t false;
X.serialize t x;
serialize t p;
serialize t i;
serialize t n
let rec cap_atom x pos a = (* Assume that x does not appear in a *)
match a with
| False -> False
| True -> if pos then atom x else neg_atom x
| Split (_,y,p,i,n) ->
let c = X.compare x y in
assert (c <> 0);
if x < y then
if pos then split x a False False
else split x False False a
else split y (cap_atom x pos p) (cap_atom x pos i) (cap_atom x pos n)
let rec deserialize t =
if Serialize.Get.bool t then
if Serialize.Get.bool t then True else False
else
let x = X.deserialize t in
let p = deserialize t in
let i = deserialize t in
let n = deserialize t in
(cap_atom x true p) ++ i ++ (cap_atom x false n)
(* split x p i n is not ok, because order of keys might have changed! *)
(*
let diff x y =
let d = diff x y in
......
......@@ -16,13 +16,13 @@ module type T = sig
end
module Dummy = struct
let dump ppf _ = assert false
let check _ = assert false
let equal t1 t2 = assert false
let hash t = assert false
let compare t1 t2 = assert false
let serialize t = assert false
let deserialize t = assert false
let dump ppf _ = failwith "dump not implemented"
let check _ = failwith "check not implemented"
let equal t1 t2 = failwith "equal not implemented"
let hash t = failwith "hash not implemented"
let compare t1 t2 = failwith "compare not implemented"
let serialize t = failwith "serialize not implemented"
let deserialize t = failwith "deserialize not implemented"
end
let dump_list ?(sep="; ") f ppf l =
......@@ -96,8 +96,8 @@ module List(X : T) = struct
| [],_ -> -1
| _ -> 1
let serialize = Serialize.Put.list X.serialize
let deserialize = Serialize.Get.list X.deserialize
let serialize t x = Serialize.Put.list X.serialize t x
let deserialize t = Serialize.Get.list X.deserialize t
end
......@@ -114,6 +114,6 @@ module Pair(X : T)(Y : T) = struct
let equal (x1,y1) (x2,y2) = (X.equal x1 x2) && (Y.equal y1 y2)
let hash (x,y) = X.hash x + 17 * Y.hash y
let serialize = Serialize.Put.pair X.serialize Y.serialize
let deserialize = Serialize.Get.pair X.deserialize Y.deserialize
let serialize t x = Serialize.Put.pair X.serialize Y.serialize t x
let deserialize t = Serialize.Get.pair X.deserialize Y.deserialize t
end
......@@ -6,9 +6,23 @@ module Put = struct
}
type 'a f = t -> 'a -> unit
type 'b property = (t * 'b) list ref
let properties = ref []
let get_property prop t = List.assq t !prop
let mk_property init =
let prop = ref [] in
properties :=
((fun t -> prop := (t, init t) :: !prop),
(fun t -> prop := List.remove_assq t !prop)) :: !properties;
prop
let run f x =
let t = { buf = Buffer.create 1024; cur_byte = 0; cur_bits = 0 } in
List.iter (fun (f,_) -> f t) !properties;
f t x;
List.iter (fun (_,f) -> f t) !properties;
if t.cur_bits > 0 then Buffer.add_char t.buf (Char.chr t.cur_byte);
Buffer.contents t.buf
......@@ -21,11 +35,11 @@ module Put = struct
) else
t.cur_bits <- succ t.cur_bits
let rec bits t i nb = (* TODO: opt *)
if (nb > 0) then (bool t ((i land 1) <> 0); bits t (i lsr 1) (pred nb))
let rec bits nb t i = (* TODO: opt *)
if (nb > 0) then (bool t ((i land 1) <> 0); bits (pred nb) t (i lsr 1))
let rec int t i =
bits t i 4;
bits 4 t i;
let i = i lsr 4 in
if i <> 0 then (bool t true; int t i) else (bool t false)
......@@ -33,7 +47,7 @@ module Put = struct
let l = String.length s in
int t l;
for i = 0 to l - 1 do
bits t (Char.code (s.[i])) 8
bits 8 t (Char.code (s.[i]))
done
let rec list f t = function
......@@ -41,6 +55,7 @@ module Put = struct
| hd::tl -> bool t true; f t hd; list f t tl
let pair f1 f2 t (x,y) = f1 t x; f2 t y
end
......@@ -57,14 +72,14 @@ module Get = struct
else t.idx_bits <- succ t.idx_bits;
b
let rec bits t nb =
let rec bits nb t =
if nb = 0 then 0
else if bool t
then succ (bits t (pred nb) lsl 1)
else bits t (pred nb) lsl 1
then succ (bits (pred nb) t lsl 1)
else bits (pred nb) t lsl 1
let rec int t =
let i = bits t 4 in
let i = bits 4 t in
if bool t then i + (int t) lsl 4
else i
......@@ -72,7 +87,7 @@ module Get = struct
let l = int t in
let s = String.create l in
for i = 0 to l - 1 do
s.[i] <- Char.chr (bits t 8)
s.[i] <- Char.chr (bits 8 t)
done;
s
......
......@@ -3,12 +3,17 @@ module Put : sig
type 'a f = t -> 'a -> unit
val run: 'a f -> 'a -> string
val bits: int -> int f
val int: int f
val string: string f
val bool: bool f
val list: 'a f -> 'a list f
val pair: 'a f -> 'b f -> ('a * 'b) f
type 'b property
val mk_property: (t -> 'b) -> 'b property
val get_property: 'b property -> t -> 'b
end
module Get : sig
......@@ -16,6 +21,7 @@ module Get : sig
type 'a f = t -> 'a
val run : 'a f -> string -> 'a
val bits: int -> int f
val int : int f
val string: string f
val bool: bool f
......
......@@ -99,7 +99,6 @@ and ppat' =
| Arrow of ppat * ppat
| Optional of ppat
| Record of bool * (label * ppat) list
| Capture of id
| Constant of id * pconst
| Regexp of regexp * ppat
(* regular expression, continuation: [ re ; cont ], e.g: [ re ; nil ] *)
......
This diff is collapsed.
......@@ -217,43 +217,41 @@ let rec token engine lexbuf =
# 80 "parser/wlexer.mll"
(
let s = Lexing.lexeme lexbuf in
if (s.[0] >= 'A') && (s.[0] <= 'Z')
then "UIDENT",s
else if Hashtbl.mem keywords s then "",s else "LIDENT",s
if Hashtbl.mem keywords s then "",s else "IDENT",s
)
# 225 "parser/wlexer.ml"
# 223 "parser/wlexer.ml"
| 2 ->
# 87 "parser/wlexer.mll"
# 85 "parser/wlexer.mll"
(
let s = Lexing.lexeme lexbuf in
let s = String.sub s 0 (String.length s - 2) in
"ANY_IN_NS", s
)
# 234 "parser/wlexer.ml"
# 232 "parser/wlexer.ml"
| 3 ->
# 92 "parser/wlexer.mll"
# 90 "parser/wlexer.mll"
( "ANY_IN_NS", "" )
# 239 "parser/wlexer.ml"
# 237 "parser/wlexer.ml"
| 4 ->
# 94 "parser/wlexer.mll"
# 92 "parser/wlexer.mll"
( "INT",Lexing.lexeme lexbuf )
# 244 "parser/wlexer.ml"
# 242 "parser/wlexer.ml"
| 5 ->
# 99 "parser/wlexer.mll"
# 97 "parser/wlexer.mll"
( "",Lexing.lexeme lexbuf )
# 249 "parser/wlexer.ml"
# 247 "parser/wlexer.ml"
| 6 ->
# 100 "parser/wlexer.mll"
# 98 "parser/wlexer.mll"
( "DIRECTIVE",Lexing.lexeme lexbuf )
# 254 "parser/wlexer.ml"
# 252 "parser/wlexer.ml"
| 7 ->
# 102 "parser/wlexer.mll"
# 100 "parser/wlexer.mll"
( let string_start = Lexing.lexeme_start lexbuf in
string_start_pos := string_start;
let double_quote = Lexing.lexeme_char lexbuf 0 = '"' in
......@@ -262,49 +260,49 @@ let rec token engine lexbuf =
string_start - lexbuf.Lexing.lex_abs_pos;
(if double_quote then "STRING2" else "STRING1"),
(get_stored_string()) )
# 266 "parser/wlexer.ml"
# 264 "parser/wlexer.ml"
| 8 ->
# 112 "parser/wlexer.mll"
# 110 "parser/wlexer.mll"
( comment_start_pos := [Lexing.lexeme_start lexbuf];
in_comment := true;
comment engine lexbuf;
in_comment := false;
token engine lexbuf )
# 275 "parser/wlexer.ml"
# 273 "parser/wlexer.ml"
| 9 ->
# 119 "parser/wlexer.mll"
# 117 "parser/wlexer.mll"
( "EOI","" )
# 280 "parser/wlexer.ml"
# 278 "parser/wlexer.ml"
| 10 ->
# 121 "parser/wlexer.mll"
# 119 "parser/wlexer.mll"
( error
(Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf)
(Illegal_character ((Lexing.lexeme lexbuf).[0])) )
# 287 "parser/wlexer.ml"
# 285 "parser/wlexer.ml"
| _ -> failwith "lexing: empty token [token]"
and comment engine lexbuf =
match engine __ocaml_lex_tables 27 lexbuf with
| 0 ->
# 127 "parser/wlexer.mll"
# 125 "parser/wlexer.mll"
( comment_start_pos := Lexing.lexeme_start lexbuf :: !comment_start_pos;
comment engine lexbuf;
)
# 298 "parser/wlexer.ml"
# 296 "parser/wlexer.ml"
| 1 ->
# 131 "parser/wlexer.mll"
# 129 "parser/wlexer.mll"
( comment_start_pos := List.tl !comment_start_pos;
if !comment_start_pos <> [] then comment engine lexbuf;
)
# 305 "parser/wlexer.ml"
# 303 "parser/wlexer.ml"
| 2 ->
# 135 "parser/wlexer.mll"
# 133 "parser/wlexer.mll"
( string_start_pos := Lexing.lexeme_start lexbuf;
Buffer.clear string_buff;
let ender = Lexing.lexeme lexbuf in
......@@ -314,93 +312,93 @@ and comment engine lexbuf =
error st (st+2) Unterminated_string_in_comment);
Buffer.clear string_buff;
comment engine lexbuf )
# 318 "parser/wlexer.ml"
# 316 "parser/wlexer.ml"
| 3 ->
# 145 "parser/wlexer.mll"
# 143 "parser/wlexer.mll"
( let st = List.hd !comment_start_pos in
error st (st+2) Unterminated_comment
)
# 325 "parser/wlexer.ml"
# 323 "parser/wlexer.ml"
| 4 ->
# 149 "parser/wlexer.mll"
# 147 "parser/wlexer.mll"
( comment engine lexbuf )
# 330 "parser/wlexer.ml"
# 328 "parser/wlexer.ml"
| _ -> failwith "lexing: empty token [comment]"
and string ender engine lexbuf =
match engine __ocaml_lex_tables 33 lexbuf with
| 0 ->
# 153 "parser/wlexer.mll"
# 151 "parser/wlexer.mll"
( let c = Lexing.lexeme lexbuf in
if c = ender then ()
else (store_char (Lexing.lexeme lexbuf);
string ender engine lexbuf) )
# 342 "parser/wlexer.ml"
# 340 "parser/wlexer.ml"
| 1 ->
# 158 "parser/wlexer.mll"
# 156 "parser/wlexer.mll"
( store_ascii (Lexing.lexeme_char lexbuf 1);
string ender engine lexbuf )
# 348 "parser/wlexer.ml"
# 346 "parser/wlexer.ml"
| 2 ->
# 161 "parser/wlexer.mll"
# 159 "parser/wlexer.mll"
( let c = Lexing.lexeme_char lexbuf 1 in
if c = 'x'
then parse_hexa_char engine lexbuf
else store_special c;
string ender engine lexbuf )
# 357 "parser/wlexer.ml"
# 355 "parser/wlexer.ml"
| 3 ->
# 167 "parser/wlexer.mll"
# 165 "parser/wlexer.mll"
( store_code (decimal_char (Lexing.lexeme lexbuf));
string ender engine lexbuf )
# 363 "parser/wlexer.ml"
# 361 "parser/wlexer.ml"
| 4 ->
# 170 "parser/wlexer.mll"
# 168 "parser/wlexer.mll"
( error
(Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf)
(Illegal_character '\\') )
# 370 "parser/wlexer.ml"
# 368 "parser/wlexer.ml"
| 5 ->
# 174 "parser/wlexer.mll"
# 172 "parser/wlexer.mll"
( error !string_start_pos (!string_start_pos+1) Unterminated_string )
# 375 "parser/wlexer.ml"
# 373 "parser/wlexer.ml"
| 6 ->
# 176 "parser/wlexer.mll"
# 174 "parser/wlexer.mll"
( store_code (Char.code (Lexing.lexeme_char lexbuf 0));
(* Adapt when source is UTF8 *)
string ender engine lexbuf )
# 382 "parser/wlexer.ml"
# 380 "parser/wlexer.ml"
| _ -> failwith "lexing: empty token [string]"
and parse_hexa_char engine lexbuf =
match engine __ocaml_lex_tables 37 lexbuf with
| 0 ->
# 182 "parser/wlexer.mll"
# 180 "parser/wlexer.mll"
( store_code (hexa_char (Lexing.lexeme lexbuf)) )
# 391 "parser/wlexer.ml"
# 389 "parser/wlexer.ml"
| 1 ->
# 184 "parser/wlexer.mll"
# 182 "parser/wlexer.mll"
( error
(Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf)
(Illegal_character '\\') )
# 398 "parser/wlexer.ml"
# 396 "parser/wlexer.ml"
| _ -> failwith "lexing: empty token [parse_hexa_char]"
;;
# 190 "parser/wlexer.mll"
# 188 "parser/wlexer.mll"
let delta_loc = ref 0
......@@ -590,4 +588,4 @@ and parse_hexa_char engine lexbuf =
let latin1_engine = Lex_engines.engine_tiny_8bit table
# 594 "parser/wlexer.ml"
# 592 "parser/wlexer.ml"
......@@ -79,9 +79,7 @@ rule token = parse
| qname
{
let s = Lexing.lexeme lexbuf in
if (s.[0] >= 'A') && (s.[0] <= 'Z')
then "UIDENT",s
else if Hashtbl.mem keywords s then "",s else "LIDENT",s
if Hashtbl.mem keywords s then "",s else "IDENT",s
}
| ncname ":*"
{
......
......@@ -53,7 +53,7 @@ let attrib att =
LabelMap.from_list (fun _ _ -> failwith "Invalid XML document: uniqueness of attributes") att
let elem (tag_ns,tag) att child =
Xml (Atom (Atoms.mk tag_ns tag), Record (attrib att), child)
Xml (Atom (Atoms.V.mk tag_ns tag), Record (attrib att), child)
(*
class warner = object method warn w = print_endline ("PXP WARNING: " ^ w) end
......
......@@ -7,7 +7,7 @@ open Ident
module U = Encodings.Utf8
let exn_print_xml = CDuceExn (Pair (
Atom (Atoms.mk_ascii "Invalid_argument"),
Atom (Atoms.V.mk_ascii "Invalid_argument"),
string_latin1 "print_xml"))
let string_of_xml ~utf8 ns_table v =
......@@ -62,7 +62,7 @@ let string_of_xml ~utf8 ns_table v =
List.iter
(fun (n,_) -> Ns.Printer.register_attr printer (LabelPool.value n))
(LabelMap.get attrs);
Ns.Printer.register_tag printer (Atoms.value tag);
Ns.Printer.register_tag printer (Atoms.V.value tag);
register_content content
| _ -> ()
and register_content = function
......@@ -75,7 +75,7 @@ let string_of_xml ~utf8 ns_table v =
let rec print_elt xmlns = function
| Xml (Atom tag, Record attrs, content) ->
let tag = Atoms.value tag in
let tag = Atoms.V.value tag in
let attrs = LabelMap.mapi_to_list
(fun n v ->
if not (is_str v) then raise exn_print_xml;
......
......@@ -101,10 +101,10 @@ let make_result_string_latin1 i j s q r1 r2 (code,r) =
let x = match Array.unsafe_get r a with
| Catch -> String_latin1 (i,j,s,q)
| Const c -> const c
| Left n -> if (n < 0) then Char (Chars.mk_char s.[i]) else buf.(r1 + n)
| Left n -> if (n < 0) then Char (Chars.V.mk_char s.[i]) else buf.(r1 + n)
| Right m -> if (m < 0) then tail_string_latin1 i j s q else buf.(r2 + m)
| Recompose (n,m) ->
Pair ((if (n < 0) then Char (Chars.mk_char s.[i]) else buf.(r1 + n)),
Pair ((if (n < 0) then Char (Chars.V.mk_char s.[i]) else buf.(r1 + n)),
(if (m < 0) then tail_string_latin1 i j s q else buf.(r2 + m)))
in
buf.(!cursor + a) <- x
......@@ -126,10 +126,10 @@ let make_result_string_utf8 i j s q r1 r2 (code,r) =
let x = match Array.unsafe_get r a with
| Catch -> String_utf8 (i,j,s,q)
| Const c -> const c
| Left n -> if (n < 0) then Char (Chars.mk_int (Utf8.get s i)) else buf.(r1 + n)
| Left n -> if (n < 0) then Char (Chars.V.mk_int (Utf8.get s i)) else buf.(r1 + n)
| Right m -> if (m < 0) then tail_string_utf8 i j s q else buf.(r2 + m)
| Recompose (n,m) ->
Pair ((if (n < 0) then Char (Chars.mk_int (Utf8.get s i)) else buf.(r1 + n)),
Pair ((if (n < 0) then Char (Chars.V.mk_int (Utf8.get s i)) else buf.(r1 + n)),
(if (m < 0) then tail_string_utf8 i j s q else buf.(r2 + m)))
in
buf.(!cursor + a) <- x
......@@ -235,11 +235,11 @@ and run_disp_string_latin1 i j s q actions =
if i == j then run_disp_kind actions q
else match actions.prod with
| Impossible -> assert false
| TailCall d1 -> run_disp_string_latin1_char d1 (Chars.mk_char s.[i])
| TailCall d1 -> run_disp_string_latin1_char d1 (Chars.V.mk_char s.[i])
| Ignore d2 -> run_disp_string_latin1_2 !cursor i j s q d2
| Dispatch (d1,b1) ->
let r1 = !cursor in
let code1 = run_disp_string_latin1_char d1 (Chars.mk_char s.[i]) in
let code1 = run_disp_string_latin1_char d1 (Chars.V.mk_char s.[i]) in
run_disp_string_latin1_2 r1 i j s q b1.(code1)
and run_disp_string_latin1_char d ch =
match actions d with
......@@ -263,11 +263,11 @@ and run_disp_string_utf8 i j s q actions =
if Utf8.equal_index i j then run_disp_kind actions q
else match actions.prod with
| Impossible -> assert false
| TailCall d1 -> run_disp_string_utf8_char d1 (Chars.mk_int (Utf8.get s i))
| TailCall d1 -> run_disp_string_utf8_char d1 (Chars.V.mk_int (Utf8.get s i))
| Ignore d2 -> run_disp_string_utf8_2 !cursor i j s q d2
| Dispatch (d1,b1) ->
let r1 = !cursor in
let code1 = run_disp_string_utf8_char d1 (Chars.mk_int (Utf8.get s i)) in
let code1 = run_disp_string_utf8_char d1 (Chars.V.mk_int (Utf8.get s i)) in
run_disp_string_utf8_2 r1 i j s q b1.(code1)
and run_disp_string_utf8_char d ch =
match actions d with
......
......@@ -5,9 +5,9 @@ type t =
| Pair of t * t
| Xml of t * t * t
| Record of t label_map
| Atom of Atoms.v
| Integer of Intervals.v
| Char of Chars.v
| Atom of Atoms.V.t
| Integer of Intervals.V.t
| Char of Chars.V.t
| Abstraction of (Types.descr * Types.descr) list * (t -> t)
| String_latin1 of int * int * string * t
| String_utf8 of Utf8.uindex * Utf8.uindex * Utf8.t * t
......@@ -21,8 +21,8 @@ exception CDuceExn of t
let nil = Atom Sequence.nil_atom
let string_latin1 s = String_latin1 (0,String.length s, s, nil)
let string_utf8 s = String_utf8 (Utf8.start_index s,Utf8.end_index s, s, nil)
let vtrue = Atom (Atoms.mk_ascii "true")
let vfalse = Atom (Atoms.mk_ascii "false")
let vtrue = Atom (Atoms.V.mk_ascii "true")
let vfalse = Atom (Atoms.V.mk_ascii "false")
let vbool x = if x then vtrue else vfalse
(* TODO: namespaces for the two following functions *)
......@@ -73,7 +73,7 @@ let rec add_buf_latin1_to_utf8 src i j =
let get_string_latin1 e =
let rec aux = function
| Pair (Char x,y) -> Buffer.add_char buf (Chars.to_char x); aux y
| Pair (Char x,y) -> Buffer.add_char buf (Chars.V.to_char x); aux y
| String_latin1 (i,j,src,y) -> Buffer.add_substring buf src i (j - i); aux y
| String_utf8 (i,j,src,y) -> add_buf_utf8_to_latin1 src i j; aux y
| _ -> () in
......@@ -84,7 +84,7 @@ let get_string_latin1 e =
let get_string_utf8 e =
let rec aux = function
| Pair (Char x,y) -> Utf8.store buf (Chars.to_int x); aux y
| Pair (Char x,y) -> Utf8.store buf (Chars.V.to_int x); aux y
| String_latin1 (i,j,src,y) -> add_buf_latin1_to_utf8 src i j; aux y
| String_utf8 (i,j,src,y) -> Utf8.copy buf src i j; aux y
| q -> q in
......@@ -94,7 +94,7 @@ let get_string_utf8 e =
(Utf8.mk s, q)
let get_int = function
| Integer i when Intervals.is_int i -> Intervals.get_int i
| Integer i when Intervals.V.is_int i -> Intervals.V.ge