camomile-commits Mailing List for camomile (Page 2)
Status: Beta
Brought to you by:
yori
Menu
▾
▴
camomile-commits — CVS commit messages
You can subscribe to this list here.
| 2002 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(16) |
Jun
(29) |
Jul
(1) |
Aug
(9) |
Sep
(10) |
Oct
|
Nov
|
Dec
(1) |
|---|
|
From: <yo...@us...> - 2002-06-27 00:08:42
|
Update of /cvsroot/camomile/camomile/tools
In directory usw-pr-cvs1:/tmp/cvs-serv15816/tools
Modified Files:
parse_allkeys.ml
Log Message:
New colltor design. Still not work.
Index: parse_allkeys.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/tools/parse_allkeys.ml,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** parse_allkeys.ml 10 May 2002 06:59:10 -0000 1.2
--- parse_allkeys.ml 27 Jun 2002 00:08:39 -0000 1.3
***************
*** 3,23 ****
open Unidata
!
! type direction = Forward | Backward
!
! type variable = Blanked | Non_ignorable | Shifted
!
! type element =
! {is_variable : bool; weight : int array}
!
! type collater =
! {rearrange : int list;
! choice : variable;
! directions : direction array;
! elements : (Uchar.t list * element list) list Tbl32.t}
let rearrange = ref []
- let choice = ref Shifted
- let directions = Array.make 4 Forward
let elements = Tbl32.create_rw []
--- 3,9 ----
open Unidata
! open Uca_collator
let rearrange = ref []
let elements = Tbl32.create_rw []
***************
*** 62,69 ****
let cs = List.map int_of_code (Str.split blank_pat s1) in
let n = List.hd cs in
- let us = List.map Uchar.chr_of_uint (List.tl cs) in
let es = List.map element_of (Str.split blank_pat s2) in
let entry = Tbl32.get_rw elements n in
! Tbl32.add elements n ((us, es) :: entry)
else
failwith ("Broken_line: " ^ line)
--- 48,54 ----
let cs = List.map int_of_code (Str.split blank_pat s1) in
let n = List.hd cs in
let es = List.map element_of (Str.split blank_pat s2) in
let entry = Tbl32.get_rw elements n in
! Tbl32.add elements n ((cs, es) :: entry)
else
failwith ("Broken_line: " ^ line)
***************
*** 75,82 ****
loaddata ();
let tbl =
! {rearrange = !rearrange;
! choice = !choice;
! directions = directions;
! elements = Tbl32.rw_to_ro elements}
in
let c = open_out_bin (Filename.concat !dir "allkeys.mar") in
--- 60,65 ----
loaddata ();
let tbl =
! {def_rearrange = !rearrange;
! def_element_tbl = Tbl32.rw_to_ro elements}
in
let c = open_out_bin (Filename.concat !dir "allkeys.mar") in
|
|
From: <yo...@us...> - 2002-06-27 00:08:41
|
Update of /cvsroot/camomile/camomile/internal
In directory usw-pr-cvs1:/tmp/cvs-serv15816/internal
Added Files:
uca_collator.ml
Log Message:
New colltor design. Still not work.
--- NEW FILE: uca_collator.ml ---
(* $Id: uca_collator.ml,v 1.1 2002/06/27 00:08:39 yori Exp $ *)
(* Copyright 2002 Yamagata Yoriyuki *)
open Helpers
let combined_class_tbl : Tbl32.bytes = Unidata.read_data "combined_class"
let combined_class u =
Tbl32.get_bytes combined_class_tbl (Uchar.uint_code u)
type weight = int array
type element =
{is_variable : bool; weight : weight}
type elements_tbl = (Uchar.t list * element list) list Tbl32.t
type default_table =
{def_rearrange : int list;
def_elements_tbl : elements_tbl}
let uca_default_table : default_table = Unidata.read_data "allkeys"
type delta = elements_tbl
type direction_type = Forward | Backward
type variable_type = Blanked | Non_ignorable | Shifted
type case_option_type = Lowercase_first | Uppercase_first
let rec match_init l1 l2 =
match l1, l2 with
[], _ -> true
| _, [] -> false
| (x1 :: r1), (x2 :: r2) ->
if x1 = x2 then match_init r1 r2 else false
let rec list_split i l =
if i = 0 then [], l else
let l1, l2 = list_split (i - 1) (List.tl l) in
((List.hd l) :: l1), l2
class output_to_list =
object
val mutable buf = []
method put (u : Uchar.t) = buf <- u :: buf
method close () = ()
method contents = List.rev buf
end
class swap rearrange (output : #Uchannel.output) =
object
val mutable prev = None
method put (u : Uchar.t) =
let n = Uchar.uint_code u in
match prev with
None ->
if List.exists (fun n' -> n = n') rearrange then
prev <- Some u
else
output#put u
| Some u' ->
output#put u;
output#put u';
prev <- None
method close () =
match prev with
None -> output#close ()
| Some u -> output#put u; output#close ()
end
(* for proposed update.
class remove_ignorable look_elem (output : #Uchannel.output) =
object
method put (u : Uchar.t) =
try
let es = look_elem u in
match es with
[([], [{is_variable = _; weight = [| 0; 0; 0|]}])] -> ()
| _ -> output#put u
with Not_found -> output#put u
method close () = output#close ()
end *)
(* For proposed update algorithm
let implicit_weight n =
let m = n land 0xffff in
if m = 0xffff || m = 0xfffe then
[{is_variable = false; weight = [|0; 0; 0|]}]
else if (n >= 0xd800 && n <= 0xdfff) || n < 0 || n > 0x10ffff then
[{is_variable = false; weight = [|0; 0; 0|]}]
else
let base =
if n >= 0x4e00 && n <= 0x9fff then 0xfb40 else (* cjk ideograph *)
if n >= 0x3400 && n <= 0xfdbf || (* cjk ideograph A *)
n >= 0x20000 && n <= 0x2a6df then 0xfb80 (* cjk ideograph B *)
else 0xfbc0
in
let a = base + (n lsr 15) in
let b = (n land 0x7fff) lor 0x8000 in
[ {is_variable = false; weight = [| a; 0x0020; 0x0002|]};
{is_variable = false; weight = [| b; 0; 0|]} ]
*)
let unassigned_weight n =
let n1 = n lsr 16 in
let n0 = n land 0xffff in
[{is_variable = false; weight = [| (0xffe0 + n1); 0x0020; 0x0002 |]};
{is_variable = false; weight = [| n0; 0x000; 0x000 |]}]
let implicit_weight u =
let n = Uchar.uint_code u in
let m = n land 0xffff in
if m = 0xffff || m = 0xfffe then
[{is_variable = false; weight = [|0; 0; 0|]}]
else if (n >= 0xd800 && n <= 0xdfff) || n < 0 || n > 0x10ffff then
[{is_variable = false; weight = [|0; 0; 0|]}]
else
match Ucategory.get u with
Ucategory.Cn -> unassigned_weight n
| Ucategory.Co -> unassigned_weight n
| _ ->
[ {is_variable = false; weight = [| n; 0x0020; 0x0002 |]} ]
let swap_casing_tbl =
{| 0x0; 0x1;
0x0008; 0x0009; 0x000A; 0x000B; 0x000C;
0x0007;
0x0002; 0x0003; 0x0004; 0x0005; 0x0006;
0x000D; 0x000E; 0x000F; 0x0010; 0x0011;
0x0012; 0x0013; 0x0014; 0x0015; 0x0016;
0x0017; 0x0018; 0x0019; 0x001A; 0x001B;
0x001D; 0x001C;
0x001E; 0x001F |}
let swap_casing element =
{is_variable = element.is_variable;
weight =
let w = Array.copy element.weight in
w.(2) <- swap_casing_tbl.( w.(2) );
w}
(* For porposed update
let gen_weights_blanked elems =
let rec loop1 elems a =
match elems with
[] -> a
| e :: rest ->
if e.is_variable then
loop2 rest ([| 0; 0; 0 |] :: a)
else
loop1 rest (e.weight :: a)
and loop2 elems a =
match elems with
[] -> a
| e :: rest ->
if e.weight.(0) = 0 then
loop2 rest ([| 0; 0; 0 |] :: a)
else
loop1 elems a
in
List.rev (loop1 elems [])
*)
let gen_weights_blanked elems =
let rec loop elems a =
match elems with
[] -> a
| e :: rest ->
if e.is_variable then
loop rest ([| 0; 0; 0 |] :: a)
else
loop rest (e.weight :: a)
in
List.rev (loop elems [])
let gen_weights_non_ignorable elems =
List.map (fun e -> e.weight) elems
(* For porposed update
let gen_weights_shifted elems =
let rec loop1 elems a =
match elems with
[] -> a
| e :: rest ->
if e.weight = [| 0; 0; 0 |] then
loop1 rest ([| 0; 0; 0; 0 |] :: a)
else if e.is_variable then
loop2 rest ([| 0; 0; 0; e.weight.(0)|] :: a)
else
let w = Array.make 4 0xffff in
Array.blit e.weight 0 w 0 3;
loop1 rest (w :: a)
and loop2 elems a =
match elems with
[] -> a
| e :: rest ->
if e.weight.(0) = 0 || e.weight.(1) = 0 then
loop2 rest ([| 0; 0; 0; 0 |] :: a)
else
loop1 elems a
in
List.rev (loop1 elems [])
*)
let gen_weights_shifted elems =
let rec loop elems a =
match elems with
[] -> a
| e :: rest ->
if e.weight = [| 0; 0; 0 |] then
loop rest ([| 0; 0; 0; 0 |] :: a)
else if e.is_variable then
loop rest ([| 0; 0; 0; e.weight.(0)|] :: a)
else
let w = Array.make 4 0xffff in
Array.blit e.weight 0 w 0 3;
loop rest (w :: a)
in
List.rev (loop elems [])
class ['s] uca
?(rearrange = uca_default_table.rearrange)
?(elements_tbl = uca_default_table.elements_tbl)
?(variable = Shifted)
?(directions = Array.make 4 Forward)
?(case_option = Lowercase_first)
()
=
object (self)
constraint 's = #Ustorage.cur #Ustorage.t
val rearrange = rearrange
val elements_tbl = elements_tbl
val directions = directions
val max_level = Array.length directions
val case_option = case_option
val variable = variable
method set_option
?(rearrange = uca_default_table.rearrange)
?(variable = Shifted)
?(directions = Array.make 4 Forward)
?(case_option = Lowercase_first)
() =
{< rearrange = rearrange;
directions = directions;
max_level = Array.length directions;
case_option = case_option;
variable = variable }>
method private look_elem_lower_first u =
Tbl32.get elements_tbl (Uchar.uint_code u)
method private look_elem_upper_first u =
let proc us, es = us, (List.map swap_casing es)
List.map proc (self#look_elem_lower_first u)
method private look_elem =
match case_option with
Lowercase_first -> look_elem_lower_first
| Uppercase_first -> look_elem_upper_first
method private gen_weights =
match variable with
Blanked -> gen_weights_blanked
| Non_ignorable -> gen_weights_non_ignorable
| Shifted -> gen_weights_shifted
method private gen_uchars (s : 's) =
let listbuf = new output_to_list in
let chan = new Unormalform.nfd_filter (new swap rearrange listbuf) in
Uchannel.output_string chan s;
chan#close ();
listbuf#contents
method private get_elems uchars =
let u = List.hd uchars in
let es = self#look_elem col_tbl u in
let remain = List.tl uchars in
let rec look_match i (us', _) =
if match_init us' remain then
let i' = List.length us' in
if i' > i then i' else i
else i
in
let i = List.fold_left look_match 0 es in
let us, remain = list_split i remain in
let rec loop2 us proced remain = (* proced is reverse-orderd. *)
match remain with
[] -> us, (List.rev proced)
| u :: rest ->
let x = combined_class u in
let us', p' =
let us' = us @ [u] in
if
(proced = []
|| combined_class (List.hd proced) <> x)
&& (List.mem_assoc us' es)
then
us', proced
else
us, (u :: proced)
in
if x = 0 then
us', (List.rev_append p' rest) (*rests are all blocked*)
else
loop2 us' p' rest
in
let us, remain = loop2 us [] remain in
try (List.assoc us es), remain with Not_found ->
match us with
[] -> (implicit_weight u), remain
| _ -> assert false
method private gen_elems uchars =
let rec loop uchars a =
if uchars = [] then a else
let elems, remain = self#get_elems uchars in
loop remain (List.rev_append elems a)
in
List.rev (loop uchars [])
method private gen_key level weights =
let buf = Array.make level [] in
let proc w =
for i = 0 to level - 1 do
if w.(i) <> 0 then
buf.(i) <- w.(i) :: buf.(i)
else
()
done
in
List.iter proc weights;
let ret = ref [] in
let proc i buf =
let subkey0 =
match dirs.(i) with
Forward -> List.rev buf
| Backward -> buf
in
let subkey = if i = 0 then subkey0 else 0 :: subkey0 in
ret := !ret @ subkey
in
Array.iteri proc buf;
!ret
method sort_key_fast ?(prec = 0) (s : 's) =
let uchars = self#gen_uchars s in
let elems = self#gen_elems uchars in
let weights = self#gen_weights elems in
let level =
if prec <= 0 || prec >= max_level then max_level else prec
in
self#gen_key level weights
end
|
|
From: <yo...@us...> - 2002-06-27 00:08:41
|
Update of /cvsroot/camomile/camomile/public
In directory usw-pr-cvs1:/tmp/cvs-serv15816/public
Modified Files:
ucomp.ml
Log Message:
New colltor design. Still not work.
Index: ucomp.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/public/ucomp.ml,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** ucomp.ml 18 Jun 2002 05:13:33 -0000 1.11
--- ucomp.ml 27 Jun 2002 00:08:39 -0000 1.12
***************
*** 9,24 ****
Tbl32.get_bytes combined_class_tbl (Uchar.uint_code u)
! type direction = Forward | Backward
! type variable = Blanked | Non_ignorable | Shifted
! type element =
! {is_variable : bool; weight : int array}
! type collater =
! {rearrange : int list;
! choice : variable;
! directions : direction array;
! elements : (Uchar.t list * element list) list Tbl32.t}
type key = int array
--- 9,33 ----
Tbl32.get_bytes combined_class_tbl (Uchar.uint_code u)
! type direction_type = Forward | Backward
! let trans_directions ds =
! Array.map (fun d -> match
! Forward -> Uca_collator.Forward
! | Backward -> Uca_collator.Backward) ds
! type variable_type = Blanked | Non_ignorable | Shifted
! let trans_variable v =
! match v with
! Blanked -> Uca_collator.Blanked
! | Non_ignorable -> Uca_collator.Non_ignorable
! | Shifted -> Uca_collator.Shifted
!
! type case_option_type = Lowercase_first | Uppercase_first
!
! let trans_case_option c =
! match c with
! Lowercase_first -> Uca_collator.Lowercase_first
! | Uppercase_first -> Uca_collator.Uppercase_first
type key = int array
***************
*** 29,347 ****
| keys -> pack keys
! let tbl : collater = Unidata.read_data "allkeys"
!
! let uca = tbl
!
! let set_options ?variable ?directions collater =
! {rearrange = collater.rearrange;
! choice = (match variable with
! None -> collater.choice
! | Some v -> v);
! directions = (match directions with
! None -> collater.directions
! | Some d -> d);
! elements = collater.elements}
!
! class output_to_list =
! object
! val mutable buf = []
! method put (u : Uchar.t) = buf <- u :: buf
! method close () = ()
! method contents = List.rev buf
! end
!
! class swap collater (output : #Uchannel.output) =
! object
! val mutable prev = None
! method put (u : Uchar.t) =
! let n = Uchar.uint_code u in
! match prev with
! None ->
! if List.exists (fun n' -> n = n') collater.rearrange then
! prev <- Some u
! else
! output#put u
! | Some u' ->
! output#put u;
! output#put u';
! prev <- None
! method close () =
! match prev with
! None -> output#close ()
! | Some u -> output#put u; output#close ()
! end
!
! class remove_ignorable collater (output : #Uchannel.output) =
! object
! method put (u : Uchar.t) =
! try
! let es = Tbl32.get collater.elements (Uchar.uint_code u) in
! match es with
! [([], [{is_variable = _; weight = [| 0; 0; 0|]}])] -> ()
! | _ -> output#put u
! with Not_found -> output#put u
! method close () = output#close ()
end
! (* For proposed update algorithm
! class prep collater output =
! object
! inherit Unormalform.nfd_filter
! (new swap collater (new remove_ignorable collater output))
! end *)
!
! class prep collater output =
object
! inherit Unormalform.nfd_filter
! (new swap collater output)
end
! let gen_uchars collater s =
! let listbuf = new output_to_list in
! let chan = new prep collater listbuf in
! Uchannel.output_string chan s;
! chan#close ();
! listbuf#contents
!
! (* For proposed update algorithm
! let implicit_weight n =
! let m = n land 0xffff in
! if m = 0xffff || m = 0xfffe then
! [{is_variable = false; weight = [|0; 0; 0|]}]
! else if (n >= 0xd800 && n <= 0xdfff) || n < 0 || n > 0x10ffff then
! [{is_variable = false; weight = [|0; 0; 0|]}]
! else
! let base =
! if n >= 0x4e00 && n <= 0x9fff then 0xfb40 else (* cjk ideograph *)
! if n >= 0x3400 && n <= 0xfdbf || (* cjk ideograph A *)
! n >= 0x20000 && n <= 0x2a6df then 0xfb80 (* cjk ideograph B *)
! else 0xfbc0
! in
! let a = base + (n lsr 15) in
! let b = (n land 0x7fff) lor 0x8000 in
! [ {is_variable = false; weight = [| a; 0x0020; 0x0002|]};
! {is_variable = false; weight = [| b; 0; 0|]} ]
! *)
!
! let unassigned_weight n =
! let n1 = n lsr 16 in
! let n0 = n land 0xffff in
! [{is_variable = false; weight = [| (0xffe0 + n1); 0x0020; 0x0002 |]};
! {is_variable = false; weight = [| n0; 0x000; 0x000 |]}]
!
! let implicit_weight u =
! let n = Uchar.uint_code u in
! let m = n land 0xffff in
! if m = 0xffff || m = 0xfffe then
! [{is_variable = false; weight = [|0; 0; 0|]}]
! else if (n >= 0xd800 && n <= 0xdfff) || n < 0 || n > 0x10ffff then
! [{is_variable = false; weight = [|0; 0; 0|]}]
! else
! match Ucategory.get u with
! Ucategory.Cn -> unassigned_weight n
! | Ucategory.Co -> unassigned_weight n
! | _ ->
! [ {is_variable = false; weight = [| n; 0x0020; 0x0002 |]} ]
!
! let rec match_init l1 l2 =
! match l1, l2 with
! [], _ -> true
! | _, [] -> false
! | (x1 :: r1), (x2 :: r2) ->
! if x1 = x2 then match_init r1 r2 else false
!
! let rec list_split i l =
! if i = 0 then [], l else
! let l1, l2 = list_split (i - 1) (List.tl l) in
! ((List.hd l) :: l1), l2
!
! let get_elems collater uchars =
! let u = List.hd uchars in
! let es = Tbl32.get collater.elements (Uchar.uint_code u) in
! let remain = List.tl uchars in
! let rec f i (us', e) =
! if match_init us' remain then
! let i' = List.length us' in
! if i' > i then i' else i
! else i
! in
! let i = List.fold_left f 0 es in
! let us, remain = list_split i remain in
! let rec loop2 us proced remain = (* proced is reverse-orderd. *)
! match remain with
! [] -> us, (List.rev proced)
! | u :: rest ->
! let x = combined_class u in
! let us', p' =
! let us' = us @ [u] in
! if
! (proced = []
! || combined_class (List.hd proced) <> x)
! && (List.mem_assoc us' es)
! then
! us', proced
! else
! us, (u :: proced)
! in
! if x = 0 then
! us', (List.rev_append p' rest) (*rests are all blocked*)
! else
! loop2 us' p' rest
! in
! let us, remain = loop2 us [] remain in
! try (List.assoc us es), remain with Not_found ->
! match us with
! [] -> (implicit_weight u), remain
! | _ -> assert false
!
! let gen_elems collater uchars =
! let rec loop uchars a =
! if uchars = [] then a else
! let elems, remain = get_elems collater uchars in
! loop remain (List.rev_append elems a)
! in
! List.rev (loop uchars [])
!
! (* For porposed update
! let gen_weights_blanked elems =
! let rec loop1 elems a =
! match elems with
! [] -> a
! | e :: rest ->
! if e.is_variable then
! loop2 rest ([| 0; 0; 0 |] :: a)
! else
! loop1 rest (e.weight :: a)
! and loop2 elems a =
! match elems with
! [] -> a
! | e :: rest ->
! if e.weight.(0) = 0 then
! loop2 rest ([| 0; 0; 0 |] :: a)
! else
! loop1 elems a
! in
! List.rev (loop1 elems [])
! *)
!
! let gen_weights_blanked elems =
! let rec loop elems a =
! match elems with
! [] -> a
! | e :: rest ->
! if e.is_variable then
! loop rest ([| 0; 0; 0 |] :: a)
! else
! loop rest (e.weight :: a)
! in
! List.rev (loop elems [])
!
! let gen_weights_non_ignorable elems =
! List.map (fun e -> e.weight) elems
!
! (* For porposed update
! let gen_weights_shifted elems =
! let rec loop1 elems a =
! match elems with
! [] -> a
! | e :: rest ->
! if e.weight = [| 0; 0; 0 |] then
! loop1 rest ([| 0; 0; 0; 0 |] :: a)
! else if e.is_variable then
! loop2 rest ([| 0; 0; 0; e.weight.(0)|] :: a)
! else
! let w = Array.make 4 0xffff in
! Array.blit e.weight 0 w 0 3;
! loop1 rest (w :: a)
! and loop2 elems a =
! match elems with
! [] -> a
! | e :: rest ->
! if e.weight.(0) = 0 || e.weight.(1) = 0 then
! loop2 rest ([| 0; 0; 0; 0 |] :: a)
! else
! loop1 elems a
! in
! List.rev (loop1 elems [])
! *)
!
! let gen_weights_shifted elems =
! let rec loop elems a =
! match elems with
! [] -> a
! | e :: rest ->
! if e.weight = [| 0; 0; 0 |] then
! loop rest ([| 0; 0; 0; 0 |] :: a)
! else if e.is_variable then
! loop rest ([| 0; 0; 0; e.weight.(0)|] :: a)
! else
! let w = Array.make 4 0xffff in
! Array.blit e.weight 0 w 0 3;
! loop rest (w :: a)
! in
! List.rev (loop elems [])
!
! let gen_weights collater elems =
! match collater.choice with
! Blanked -> gen_weights_blanked elems
! | Non_ignorable -> gen_weights_non_ignorable elems
! | Shifted -> gen_weights_shifted elems
!
! let gen_key collater level weights =
! let buf = Array.make level [] in
! let proc w =
! for i = 0 to level - 1 do
! if w.(i) <> 0 then
! buf.(i) <- w.(i) :: buf.(i)
! else
! ()
! done
! in
! List.iter proc weights;
! let ret = ref [] in
! let proc i buf =
! let subkey0 =
! match collater.directions.(i) with
! Forward -> List.rev buf
! | Backward -> buf
! in
! let subkey = if i = 0 then subkey0 else 0 :: subkey0 in
! ret := !ret @ subkey
! in
! Array.iteri proc buf;
! !ret
! let sort_key_aux ?(collater = tbl) ?(prec = 0) s =
! let uchars = gen_uchars collater s in
! let elems = gen_elems collater uchars in
! let weights = gen_weights collater elems in
! if weights = [] then [] else
! let max_level = Array.length (List.hd weights) in
! if prec > max_level then
! invalid_arg "Too high precision: Ucomp.sort_key"
! else
! let level = if prec <= 0 then max_level else prec in
! gen_key collater level weights
! let sort_key ?collater ?prec s = compact_key (sort_key_aux ?collater ?prec s)
let compare_key (k1 : key) (k2 : key) = Pervasives.compare k1 k2
! let compare ?collater ?prec s1 s2 =
! let k1 = sort_key_aux ?collater ?prec s1 in
! let k2 = sort_key_aux ?collater ?prec s2 in
! Pervasives.compare k1 k2
! let eq ?collater ?prec s1 s2 = (compare ?collater ?prec s1 s2 = 0)
! let not_eq ?collater ?prec s1 s2 = (compare ?collater ?prec s1 s2 <> 0)
! let less_than ?collater ?prec s1 s2 = (compare ?collater ?prec s1 s2 < 0)
! let greater_than ?collater ?prec s1 s2 = (compare ?collater ?prec s1 s2 > 0)
! let leq ?collater ?prec s1 s2 = (compare ?collater ?prec s1 s2 <= 0)
! let geq ?collater ?prec s1 s2 = (compare ?collater ?prec s1 s2 >= 0)
(* let print_key key =
--- 38,100 ----
| keys -> pack keys
! class virtual ['s1] ['s2] collator =
! object (self)
! constraint 's1 = #Ustorage.cur #Ustorage.t
! constraint 's2 = #Ustorage.cur #Ustorage.t
! method private virtual sort_key_fast : ?prec:int -> 's1 -> int list
! method virtual compare : ?prec:int -> 's1 -> 's2 -> int
! method sort_key ?prec (s : 's1) =
! compact_key (self#sort_key_fast ?prec s)
end
! class uca_collator
! ?(variable = Shifted)
! ?(directions = Array.make 4 Forward)
! ?(case_option = Lowercase_first)
! () =
object
! inherit collator
! inherit Uca_collator.uca
! ~variable:(trans_variable variable)
! ~direction:(trans_directions directions)
! ~case_option:(trans_case_option case_option) ()
! as super
! method compare ?prec (s1 : 's1) (s2 : 's2) =
! Pervasive (self#sort_key_fast ?prec s1) (self#sort_key_fast ?prec s2)
! method set_option
! ?(variable = Shifted)
! ?(directions = Array.make 4 Forward)
! ?(case_option = Lowercase_first)
! () =
! super#set_option
! ~variable:(trans_variable variable)
! ~direction:(trans_directions directions)
! ~case_option:(trans_case_option case_option) ()
end
! let (uca : 's1 's2 uca_colltor) = new uca_colltor ()
! let set_options ?variable ?directions ?case_option col =
! col#set_option ?variable ?directions ?case_option
! let sort_key ?(collator = 's 's uca) ?prec (s : 's) =
! collator#sort_key ?prec s
let compare_key (k1 : key) (k2 : key) = Pervasives.compare k1 k2
! let compare ?(collator = 's1 's2 uca) ?prec (s1 : 's1) (s2 : 's2) =
! colltor#compare ?prec s1 s2
! let eq ?collator ?prec s1 s2 = (compare ?collator ?prec s1 s2 = 0)
! let not_eq ?collator ?prec s1 s2 = (compare ?collator ?prec s1 s2 <> 0)
! let less_than ?collator ?prec s1 s2 = (compare ?collator ?prec s1 s2 < 0)
! let greater_than ?collator ?prec s1 s2 = (compare ?collator ?prec s1 s2 > 0)
! let leq ?collator ?prec s1 s2 = (compare ?collator ?prec s1 s2 <= 0)
! let geq ?collator ?prec s1 s2 = (compare ?collator ?prec s1 s2 >= 0)
(* let print_key key =
|
|
From: <yo...@us...> - 2002-06-27 00:06:02
|
Update of /cvsroot/camomile/camomile/internal In directory usw-pr-cvs1:/tmp/cvs-serv15250/internal Removed Files: res_bundle.ml Log Message: output_rb. --- res_bundle.ml DELETED --- |
|
From: <yo...@us...> - 2002-06-19 00:58:19
|
Update of /cvsroot/camomile/camomile/tools
In directory usw-pr-cvs1:/tmp/cvs-serv19127/tools
Modified Files:
camlrb.ml
Log Message:
output_rb.
Index: camlrb.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/tools/camlrb.ml,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** camlrb.ml 18 Jun 2002 05:14:31 -0000 1.2
--- camlrb.ml 19 Jun 2002 00:58:16 -0000 1.3
***************
*** 259,271 ****
let rec to_res_bundle data =
match data with
! Table tbl ->
! let proc k e a = (ucs4 k, to_res_bundle e) :: a in
! let a = Uhashtbl.fold proc tbl [] in
! Res_bundle.Table (pack a)
! | Array_data a -> Res_bundle.Array (Array.map to_res_bundle a)
! | String_data text -> Res_bundle.String (text#ucs4 ())
! | Binary b -> Res_bundle.Binary b
! | Int i -> Res_bundle.Integer i
! | Intvect a -> Res_bundle.Intvector a
| Tagged _ -> failwith "Broken entry."
--- 259,272 ----
let rec to_res_bundle data =
match data with
! Table tbl ->
! let tbl' = Uhashtbl.create 16 in
! let proc k e = Uhashtbl.add tbl' k (to_res_bundle e) in
! Uhashtbl.iter proc tbl;
! Locale.Table tbl'
! | Array_data a -> Locale.Array (Array.map to_res_bundle a)
! | String_data text -> Locale.String (text :> Ustorage.cur Ustorage.t)
! | Binary b -> Locale.Binary b
! | Int i -> Locale.Integer i
! | Intvect a -> Locale.Intvector a
| Tagged _ -> failwith "Broken entry."
***************
*** 403,407 ****
let c = open_out_bin file in
let bundle = to_res_bundle entry in
! output_value c bundle
in
(match data with
--- 404,408 ----
let c = open_out_bin file in
let bundle = to_res_bundle entry in
! Locale.output_rb c bundle
in
(match data with
|
|
From: <yo...@us...> - 2002-06-19 00:58:19
|
Update of /cvsroot/camomile/camomile/public
In directory usw-pr-cvs1:/tmp/cvs-serv19127/public
Modified Files:
locale.ml locale.mli
Log Message:
output_rb.
Index: locale.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/public/locale.ml,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** locale.ml 16 Jun 2002 04:26:36 -0000 1.3
--- locale.ml 19 Jun 2002 00:58:15 -0000 1.4
***************
*** 11,12 ****
--- 11,38 ----
| Integer of int
| Intvector of (int array)
+
+ type mar =
+ MTable of (string * mar) array
+ | MArray of mar array
+ | MString of string
+ | MBinary of string
+ | MInteger of int
+ | MIntvector of (int array)
+
+ let ucs4 = Char_encoding.encode Char_encoding.ucs4
+
+ let rec rb_mar data =
+ match data with
+ Table tbl ->
+ let proc k e a = (ucs4 k, rb_mar e) :: a in
+ let a = Uhashtbl.fold proc tbl [] in
+ MTable (pack a)
+ | Array a -> MArray (Array.map rb_mar a)
+ | String text -> MString (ucs4 text)
+ | Binary b -> MBinary b
+ | Integer i -> MInteger i
+ | Intvector a -> MIntvector a
+
+ let output_rb c rb =
+ output_value c (rb_mar rb)
+
Index: locale.mli
===================================================================
RCS file: /cvsroot/camomile/camomile/public/locale.mli,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** locale.mli 16 Jun 2002 04:26:36 -0000 1.3
--- locale.mli 19 Jun 2002 00:58:15 -0000 1.4
***************
*** 9,10 ****
--- 9,12 ----
| Integer of int
| Intvector of (int array)
+
+ val output_rb : out_channel -> resource_bundle -> unit
|
|
From: <yo...@us...> - 2002-06-18 05:14:34
|
Update of /cvsroot/camomile/camomile In directory usw-pr-cvs1:/tmp/cvs-serv22517 Modified Files: Makefile.in Log Message: Now camlrb works. Index: Makefile.in =================================================================== RCS file: /cvsroot/camomile/camomile/Makefile.in,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** Makefile.in 16 Jun 2002 04:20:49 -0000 1.10 --- Makefile.in 18 Jun 2002 05:14:31 -0000 1.11 *************** *** 122,133 **** ############################## ! CHARMAP_DATA := $(patsubst charmaps/%,charmaps.mar/%.mar, \ ! $(filter-out charmaps/CVS, $(wildcard charmaps/*))) ! charmap_data : charmaps.mar $(CHARMAP_DATA) ! charmaps.mar : ! mkdir charmaps.mar ! charmaps.mar/%.mar : tools/camlcharmap.$(OCAMLBEST) charmaps/$* ! tools/camlcharmap.$(OCAMLBEST) charmaps.mar < charmaps/$* tools/camlcharmap.byte : camomile.cma tools/camlcharmap.ml --- 122,131 ---- ############################## ! CHARMAP_DATA := $(patsubst charmaps/%,charmaps/%.mar, \ ! $(filter-out charmaps/CVS charmaps/%.mar, $(wildcard charmaps/*))) ! charmap_data : $(CHARMAP_DATA) ! charmaps/%.mar : tools/camlcharmap.$(OCAMLBEST) charmaps/$* ! tools/camlcharmap.$(OCAMLBEST) charmaps < charmaps/$* tools/camlcharmap.byte : camomile.cma tools/camlcharmap.ml *************** *** 140,147 **** ############################ tools/camlrb.byte : camomile.cma tools/camlrb.ml $(OCAMLC) $(CAMLP4O) $(BFLAGS) -o tools/camlrb.byte camomile.cma tools/camlrb.ml ! tools/camlrb.opt : camomiel.cmxa tools/camlrb.ml $(OCAMLOPT) $(CAMLP4O) $(OFLAGS) -o tools/camlrb.opt camomile.cmxa tools/camlrb.ml --- 138,153 ---- ############################ + LOCALE_DATA := $(patsubst locales/%.txt,locales/%.mar, \ + $(wildcard locales/*.txt)) + + locale_data : $(LOCALE_DATA) + + locales/%.mar : tools/camlrb.$(OCAMLBEST) $(@:.mar=.txt) + tools/camlrb.$(OCAMLBEST) --file $(@:.mar=.txt) locales + tools/camlrb.byte : camomile.cma tools/camlrb.ml $(OCAMLC) $(CAMLP4O) $(BFLAGS) -o tools/camlrb.byte camomile.cma tools/camlrb.ml ! tools/camlrb.opt : camomile.cmxa tools/camlrb.ml $(OCAMLOPT) $(CAMLP4O) $(OFLAGS) -o tools/camlrb.opt camomile.cmxa tools/camlrb.ml *************** *** 162,166 **** cp -f database/*.mar $(DATADIR)/camomile/database mkdir -p $(DATADIR)/camomile/charmaps ! cp -f charmaps.mar/*.mar $(DATADIR)/camomile/charmaps mkdir -p $(DATADIR)/camomile/mappings cp -f mappings/*.mar $(DATADIR)/camomile/mappings --- 168,172 ---- cp -f database/*.mar $(DATADIR)/camomile/database mkdir -p $(DATADIR)/camomile/charmaps ! cp -f charmaps/*.mar $(DATADIR)/camomile/charmaps mkdir -p $(DATADIR)/camomile/mappings cp -f mappings/*.mar $(DATADIR)/camomile/mappings *************** *** 313,317 **** rm -f *.cm[ioxa] *.cmxa *.o *.so *.a */*.cm[iox] */*.o pocaml\ */*.byte */*.opt ! rm -f charmaps.mar/*.mar rm -f mappings/*.mar --- 319,323 ---- rm -f *.cm[ioxa] *.cmxa *.o *.so *.a */*.cm[iox] */*.o pocaml\ */*.byte */*.opt ! rm -f charmaps/*.mar rm -f mappings/*.mar |
|
From: <yo...@us...> - 2002-06-18 05:14:34
|
Update of /cvsroot/camomile/camomile/tools
In directory usw-pr-cvs1:/tmp/cvs-serv22517/tools
Modified Files:
camlrb.ml
Log Message:
Now camlrb works.
Index: camlrb.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/tools/camlrb.ml,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** camlrb.ml 16 Jun 2002 04:20:49 -0000 1.1
--- camlrb.ml 18 Jun 2002 05:14:31 -0000 1.2
***************
*** 5,8 ****
--- 5,9 ----
open Ucategory
+ let ff = 0x000c (*form feed*)
let cr = Char.code '\r'
let lf = Char.code '\n'
***************
*** 11,14 ****
--- 12,17 ----
let backslash = Char.code '\\'
+ let sq = Char.code '\''
+ let dq = Char.code '"'
let bb = new Latin1.obj_of "\\\\"
***************
*** 24,31 ****
let code_9 = Char.code '9'
let code_a = Char.code 'a'
let code_f = Char.code 'f'
let code_A = Char.code 'A'
let code_F = Char.code 'F'
- let code_n = Char.code 'n'
class unescape out : Uchannel.output =
--- 27,35 ----
let code_9 = Char.code '9'
let code_a = Char.code 'a'
+ let code_n = Char.code 'n'
+ let code_r = Char.code 'r'
let code_f = Char.code 'f'
let code_A = Char.code 'A'
let code_F = Char.code 'F'
class unescape out : Uchannel.output =
***************
*** 44,58 ****
out#put u
| Escape ->
! if n = backslash then begin
! out#put (Uchar.chr_of_uint backslash);
! state <- Other end
! else if n = code_u then
! begin state <- U_literal; pos <- 0 end
! else if n = code_v then
! begin state <- V_literal; pos <- 0 end
! else if n = code_n then
! out#put (Uchar.chr_of_uint lf)
! else
! failwith "Broken escaped character";
| U_literal ->
if (n >= code_0 && n <= code_9) || (n >= code_a && n <= code_f)
--- 48,68 ----
out#put u
| Escape ->
! (match n with
! 34 | 39 | 92 ->
! out#put u; state <- Other
! | 102 ->
! out#put (Uchar.chr_of_uint ff); state <- Other
! | 110 ->
! out#put (Uchar.chr_of_uint lf); state <- Other
! | 114 ->
! out#put (Uchar.chr_of_uint cr); state <- Other
! | 116 ->
! out#put (Uchar.chr_of_uint tab); state <- Other
! | 117 ->
! state <- U_literal; pos <- 0
! | 118 ->
! state <- V_literal; pos <- 0
! | _ ->
! failwith "Broken escaped character";)
| U_literal ->
if (n >= code_0 && n <= code_9) || (n >= code_a && n <= code_f)
***************
*** 82,86 ****
let unescaped s = Uchannel.apply_filter (new unescape) s
-
let rec stream_to_list_aux a s = (parser
[< 'e; rest >] -> stream_to_list_aux (e :: a) rest
--- 92,95 ----
***************
*** 95,99 ****
| Colon
| Comma
! | EOF
let rec prep = parser
--- 104,115 ----
| Colon
| Comma
!
! let rec remove_bom = parser
! [< 'u; rest >] ->
! if Uchar.code u = 0xfeff then
! rest
! else
! [< 'u; rest >]
! | [< >] -> [< >]
let rec prep = parser
***************
*** 105,109 ****
let rec remove_comment = parser
! [< '( Some '/', _, _); '( Some '/', _, _); rest >] -> comment rest
| [< '( Some '"', _, _) as data; rest >] ->
[< 'data; in_quote rest >]
--- 121,130 ----
let rec remove_comment = parser
! [< '( Some '/', _, _) as data; rest >] ->
! (parser
! [< '(Some '/', _, _); rest >] -> comment rest
! | [< '(Some '*', _, _); rest >] -> comment2 rest
! | [< rest >] -> [< 'data; remove_comment rest >])
! rest
| [< '( Some '"', _, _) as data; rest >] ->
[< 'data; in_quote rest >]
***************
*** 112,121 ****
and comment = parser
[< '( Some ('\r' | '\n' | '\133'), _, _) | ( _, (Zl | Zp), _); rest >]
! ->
! remove_comment rest
! | [< 'data; rest >] -> [< 'data; comment rest >]
| [< >] -> [< >]
and in_quote = parser
! [< '( Some '"', _, _) as data; rest >] ->
[<' data; remove_comment rest >]
| [< 'data; rest >] -> [< 'data; in_quote rest >]
--- 133,149 ----
and comment = parser
[< '( Some ('\r' | '\n' | '\133'), _, _) | ( _, (Zl | Zp), _); rest >]
! -> remove_comment rest
! | [< 'data; rest >] -> comment rest
! | [< >] -> [< >]
! and comment2 = parser
! [< '( Some '*', _, _) as data; rest >] -> (parser
! [< '(Some '/', _, _); rest >] -> remove_comment rest
! | [< rest >] -> comment2 rest) rest
! | [< 'data; rest >] -> comment2 rest
| [< >] -> [< >]
and in_quote = parser
! [< '( Some '\\', _, _) as data1; 'data2; rest >] ->
! [< 'data1; 'data2; in_quote rest >]
! | [< '( Some '"', _, _) as data; rest >] ->
[<' data; remove_comment rest >]
| [< 'data; rest >] -> [< 'data; in_quote rest >]
***************
*** 138,150 ****
| [< '( Some ',', _, _); rest >] -> [< 'Comma; parse rest >]
| [< '( Some '"', _, _); rest >] -> quote rest
! | [< '( Some ('\r' | '\n' | '\133' | '\t'), _, _) |
! ( _, (Zs | Zl | Zp), _) ; rest >] ->
! parse rest
! | [< >] -> [< 'EOF >]
! | [< s >] -> text s
and quote s =
let buf = Ubuffer.create 16 in
let rec loop = parser
! [< '( Some '"', _, _); rest >] ->
let s = Ubuffer.contents_utext buf in
let s' = new Utext.t (unescaped s) in
--- 166,182 ----
| [< '( Some ',', _, _); rest >] -> [< 'Comma; parse rest >]
| [< '( Some '"', _, _); rest >] -> quote rest
! | [< '( Some ('\r' | '\n' | '\133' | '\t'), _, _)
! | ( _, (Zs | Zl | Zp), _) ; rest >] ->
! parse rest
! | [< 'e; rest >] -> text [< 'e; rest >]
! | [< >] -> [< >]
and quote s =
let buf = Ubuffer.create 16 in
let rec loop = parser
! [< '( Some '\\', _, u1); '(_, _, u2); rest >] ->
! Ubuffer.add_char buf u1;
! Ubuffer.add_char buf u2;
! loop rest
! | [< '( Some '"', _, _); rest >] ->
let s = Ubuffer.contents_utext buf in
let s' = new Utext.t (unescaped s) in
***************
*** 154,158 ****
loop rest
| [< >] -> failwith "A quote is not enclosed."
-
in
loop s
--- 186,189 ----
***************
*** 160,177 ****
let buf = Ubuffer.create 16 in
let rec loop = parser
! [< rest = parser
! [<'( Some ('\r' | '\n' | '\133' | '\t'), _, _) |
! ( _, (Zs | Zl | Zp), _) ; rest >] -> rest
! | [< >] -> [< >] >] ->
! let s = Ubuffer.contents_utext buf in
! let s' = new Utext.t (unescaped s) in
! [< 'Text s'; parse rest >]
| [< '( _, _, u); rest >] ->
Ubuffer.add_char buf u;
loop rest
in
loop s
in
! stream_to_list (merge_text (parse (remove_comment (prep s))))
let ascii = Utext.of_string
--- 191,219 ----
let buf = Ubuffer.create 16 in
let rec loop = parser
! [<'( Some ('\r' | '\n' | '\133' | '\t'), _, _) |
! ( _, (Zs | Zl | Zp), _) ; rest >] ->
! let s = Ubuffer.contents_utext buf in
! let s' = new Utext.t (unescaped s) in
! [< 'Text s'; parse rest >]
! | [< '( Some ('{' | '}' | ':' | ','| '"'), _, _) as e; rest >] ->
! let s = Ubuffer.contents_utext buf in
! let s' = new Utext.t (unescaped s) in
! [< 'Text s'; parse [< 'e; rest >] >]
| [< '( _, _, u); rest >] ->
Ubuffer.add_char buf u;
loop rest
+ | [< >] ->
+ let s = Ubuffer.contents_utext buf in
+ let s' = new Utext.t (unescaped s) in
+ [< 'Text s' >]
in
loop s
in
! let s' = remove_bom s in
! let p = prep s' in
! let p1 = remove_comment p in
! let tokens = parse p1 in
! let tokens1 = merge_text tokens in
! let l = stream_to_list tokens1 in l
let ascii = Utext.of_string
***************
*** 203,207 ****
Buffer.add_channel buf c 1
done; assert false end
! with Not_found ->
Buffer.contents buf
--- 245,249 ----
Buffer.add_channel buf c 1
done; assert false end
! with End_of_file ->
Buffer.contents buf
***************
*** 223,227 ****
| Array_data a -> Res_bundle.Array (Array.map to_res_bundle a)
| String_data text -> Res_bundle.String (text#ucs4 ())
! | _ -> failwith "Broken entry."
let rec parse_intvect l a =
--- 265,272 ----
| Array_data a -> Res_bundle.Array (Array.map to_res_bundle a)
| String_data text -> Res_bundle.String (text#ucs4 ())
! | Binary b -> Res_bundle.Binary b
! | Int i -> Res_bundle.Integer i
! | Intvect a -> Res_bundle.Intvector a
! | Tagged _ -> failwith "Broken entry."
let rec parse_intvect l a =
***************
*** 242,246 ****
match ent with
Tagged (name, data) ->
! Uhashtbl.add tbl name ent
| _ -> failwith "A broken table entry."
in
--- 287,291 ----
match ent with
Tagged (name, data) ->
! Uhashtbl.add tbl name data
| _ -> failwith "A broken table entry."
in
***************
*** 256,260 ****
parse_array rest (data :: a)
| Brace_r :: rest ->
! Array_data (pack (List.rev (data :: a))), rest
| _ -> failwith "A brace is not enclosed.")
| Text text :: Comma :: rest ->
--- 301,305 ----
parse_array rest (data :: a)
| Brace_r :: rest ->
! parse_array rest (data :: a)
| _ -> failwith "A brace is not enclosed.")
| Text text :: Comma :: rest ->
***************
*** 267,271 ****
and parse_unknown l =
match l with
! Text text :: Comma :: rest -> parse_array l []
| Text text :: rest -> parse_table l []
| _ -> parse_array l []
--- 312,318 ----
and parse_unknown l =
match l with
! Text text :: Brace_r :: rest ->
! String_data text, Brace_r :: rest
! | Text text :: Comma :: rest -> parse_array l []
| Text text :: rest -> parse_table l []
| _ -> parse_array l []
***************
*** 298,304 ****
else if Ucomp.eq tname (ascii "import") then
match rest with
! Text file :: Brace_r :: rest ->
! let filename = to_ascii file in
! Some (Tagged (name, Binary (load_file filename))), rest
| _ -> failwith "A broken import entry."
else if Ucomp.eq tname (ascii "int") then
--- 345,351 ----
else if Ucomp.eq tname (ascii "import") then
match rest with
! Text file :: Brace_r :: rest ->
! let filename = to_ascii file in
! Some (Tagged (name, Binary (load_file filename))), rest
| _ -> failwith "A broken import entry."
else if Ucomp.eq tname (ascii "int") then
***************
*** 315,322 ****
| _ -> failwith "A brace is not enclosed."
else failwith "Unknown data type."
! | Text name :: Brace_l :: rest ->
! let data, rest = parse_unknown rest in
! Some (Tagged (name, data)), rest
! | _ -> failwith "A broken entry."
--- 362,372 ----
| _ -> failwith "A brace is not enclosed."
else failwith "Unknown data type."
! | Text name :: Brace_l :: rest ->
! let data, rest = parse_unknown rest in
! (match rest with
! Brace_r :: rest ->
! Some (Tagged (name, data)), rest
! | _ -> failwith "A brace is not enclosed.")
! | _ -> None, l
***************
*** 348,354 ****
let data, rest = parse_table lexed [] in
match rest with
! [ EOF ] ->
let proc key entry =
! let file = Filename.concat !dir (to_ascii key) in
let c = open_out_bin file in
let bundle = to_res_bundle entry in
--- 398,404 ----
let data, rest = parse_table lexed [] in
match rest with
! [] ->
let proc key entry =
! let file = Filename.concat !dir ((to_ascii key) ^ ".mar") in
let c = open_out_bin file in
let bundle = to_res_bundle entry in
***************
*** 360,361 ****
--- 410,412 ----
| _ -> failwith "Strange trailing data."
+ let _ = main ()
|
|
From: <yo...@us...> - 2002-06-18 05:13:36
|
Update of /cvsroot/camomile/camomile/public
In directory usw-pr-cvs1:/tmp/cvs-serv22332/public
Modified Files:
ucasemap.ml ucomp.ml ustorage.ml
Log Message:
Allowing the null string.
Index: ucasemap.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/public/ucasemap.ml,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** ucasemap.ml 31 May 2002 11:01:01 -0000 1.4
--- ucasemap.ml 18 Jun 2002 05:13:33 -0000 1.5
***************
*** 181,184 ****
--- 181,185 ----
and output_with_upper s output =
let case1 u = output#put (to_upper1 u) in
+ if s#len = 0 then () else
let cur = s#first in
try while true do
***************
*** 200,203 ****
--- 201,205 ----
let lower1 u = output#put (to_lower1 u) in
let title1 u = output#put (to_title1 u) in
+ if s#len = 0 then () else
let cur = s#first in
try while true do
Index: ucomp.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/public/ucomp.ml,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** ucomp.ml 24 May 2002 11:42:54 -0000 1.10
--- ucomp.ml 18 Jun 2002 05:13:33 -0000 1.11
***************
*** 24,28 ****
type key = int array
! let compact_key keys = pack keys
let tbl : collater = Unidata.read_data "allkeys"
--- 24,31 ----
type key = int array
! let compact_key keys =
! match keys with
! [] -> Array.make 0 0
! | keys -> pack keys
let tbl : collater = Unidata.read_data "allkeys"
Index: ustorage.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/public/ustorage.ml,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** ustorage.ml 2 Jun 2002 08:35:27 -0000 1.3
--- ustorage.ml 18 Jun 2002 05:13:33 -0000 1.4
***************
*** 21,37 ****
let iter op s =
let cur = s#first in
! try while true do
! let u = cur#get in op u; cur#incr();
! done with Out_of_range -> ()
let eq s1 s2 =
let len = s1#len in
if len <> s2#len then false else
let cur1 = s1#first in
let cur2 = s2#first in
! let rec comp () =
! if (Uchar.uint_code cur1#get) <> (Uchar.uint_code cur2#get) then () else
! cur1#incr(); cur2#incr(); comp ()
! in
! try comp (); false with Out_of_range -> true
--- 21,45 ----
let iter op s =
+ let len = s#len in
+ if len = 0 then () else
let cur = s#first in
! let rec loop i =
! let u = cur#get in op u;
! if i < len then begin cur#incr (); loop (i + 1) end else ()
! in
! loop 1
let eq s1 s2 =
let len = s1#len in
if len <> s2#len then false else
+ if len = 0 then true else
let cur1 = s1#first in
let cur2 = s2#first in
! let rec comp i =
! if (Uchar.uint_code cur1#get) <> (Uchar.uint_code cur2#get) then
! false
! else if i < len then begin
! cur1#incr(); cur2#incr(); comp (i + 1) end
! else true
! in comp 1
!
|
|
From: <yo...@us...> - 2002-06-18 05:13:35
|
Update of /cvsroot/camomile/camomile/internal
In directory usw-pr-cvs1:/tmp/cvs-serv22332/internal
Modified Files:
ucs4.ml
Log Message:
Allowing the null string.
Index: ucs4.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/internal/ucs4.ml,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** ucs4.ml 2 Jun 2002 08:35:26 -0000 1.3
--- ucs4.ml 18 Jun 2002 05:13:33 -0000 1.4
***************
*** 24,27 ****
--- 24,28 ----
let build init =
let s = String.create (init#len lsl 2) in
+ if init#len = 0 then s else
let cur = init#first in
for i = 0 to init#len - 2 do
|
|
From: <yo...@us...> - 2002-06-18 05:13:00
|
Update of /cvsroot/camomile/camomile/public
In directory usw-pr-cvs1:/tmp/cvs-serv22216/public
Modified Files:
uchannel.mli
Log Message:
Raising its own exception in the end of the connetion.
Index: uchannel.mli
===================================================================
RCS file: /cvsroot/camomile/camomile/public/uchannel.mli,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** uchannel.mli 24 May 2002 00:53:59 -0000 1.2
--- uchannel.mli 18 Jun 2002 05:12:57 -0000 1.3
***************
*** 2,5 ****
--- 2,7 ----
(* Copyright 2002 Yamagata Yoriyuki. distributed with LGPL *)
+ exception Term
+
class type input =
object method get : unit -> Uchar.t end
|
|
From: <yo...@us...> - 2002-06-18 05:08:12
|
Update of /cvsroot/camomile/camomile/public
In directory usw-pr-cvs1:/tmp/cvs-serv21395/public
Modified Files:
char_encoding.ml
Log Message:
Fix bugs.
Index: char_encoding.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/public/char_encoding.ml,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** char_encoding.ml 16 Jun 2002 04:19:30 -0000 1.10
--- char_encoding.ml 18 Jun 2002 05:08:08 -0000 1.11
***************
*** 144,153 ****
class in_channel_aux enc input : Uchannel.input =
let q = Queue.create () in
- let m = enc.make_decoder (queueing q) in
object(self : 'a)
method get () =
try Queue.take q with Queue.Empty ->
(try let c = input#get () in m.read c with End_of_file ->
! m.term ());
self#get ()
end
--- 144,156 ----
class in_channel_aux enc input : Uchannel.input =
let q = Queue.create () in
object(self : 'a)
+ val m = enc.make_decoder (queueing q)
+ val q = q
+ val mutable term = false
method get () =
try Queue.take q with Queue.Empty ->
+ if term then raise Uchannel.Term else
(try let c = input#get () in m.read c with End_of_file ->
! m.term (); term <- true);
self#get ()
end
***************
*** 190,193 ****
--- 193,197 ----
make_encoder = make_encoder;}
in begin
+ install "US-ASCII" enc;
install "USASCII" enc;
install "ASCII" enc;
|
|
From: <yo...@us...> - 2002-06-16 04:26:38
|
Update of /cvsroot/camomile/camomile/public In directory usw-pr-cvs1:/tmp/cvs-serv27549/public Added Files: locale.ml locale.mli Log Message: Resource bundle definition. |
|
From: <yo...@us...> - 2002-06-16 04:26:38
|
Update of /cvsroot/camomile/camomile/internal
In directory usw-pr-cvs1:/tmp/cvs-serv27549/internal
Added Files:
res_bundle.ml
Log Message:
Resource bundle definition.
--- NEW FILE: res_bundle.ml ---
(* $Id: res_bundle.ml,v 1.1 2002/06/16 04:26:36 yori Exp $ *)
(* Copyright 2002 Yamagata Yoriyuki *)
(* representation of resource bundle for marshaling *)
type t =
Table of (string * t) array
| Array of t array
| String of string
| Binary of string
| Integer of int
| Intvector of (int array)
|
|
From: <yo...@us...> - 2002-06-16 04:20:52
|
Update of /cvsroot/camomile/camomile/internal In directory usw-pr-cvs1:/tmp/cvs-serv26433/internal Modified Files: Makefile Log Message: Resource bundle compiler. It still won't work. Index: Makefile =================================================================== RCS file: /cvsroot/camomile/camomile/internal/Makefile,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Makefile 8 Apr 2002 09:41:28 -0000 1.1 --- Makefile 16 Jun 2002 04:20:49 -0000 1.2 *************** *** 1,4 **** all : ! cd .. && make all clean : --- 1,4 ---- all : ! cd .. && make byte clean : |
|
From: <yo...@us...> - 2002-06-16 04:20:52
|
Update of /cvsroot/camomile/camomile In directory usw-pr-cvs1:/tmp/cvs-serv26433 Modified Files: Makefile.in Log Message: Resource bundle compiler. It still won't work. Index: Makefile.in =================================================================== RCS file: /cvsroot/camomile/camomile/Makefile.in,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** Makefile.in 2 Jun 2002 08:39:05 -0000 1.9 --- Makefile.in 16 Jun 2002 04:20:49 -0000 1.10 *************** *** 47,50 **** --- 47,52 ---- .PHONY : all byte opt tools test test.opt charmap_data unimaps database + CAMLP4O = -pp camlp4o + # Generic targets ################# *************** *** 62,69 **** INT =\ public/uchar.cmi public/ustorage.cmi public/uchannel.cmi\ ! public/ucategory.cmi public/unormalform.cmi public/ucasemap.cmi\ ! public/ucomp.cmi public/uhashtbl.cmi\ ! public/char_encoding.cmi\ ! public/ustring.cmi public/utext.cmi public/ubuffer.cmi\ public/udebug.cmi OBJECTS =\ --- 64,70 ---- INT =\ public/uchar.cmi public/ustorage.cmi public/uchannel.cmi\ ! public/char_encoding.cmi public/ucategory.cmi public/unormalform.cmi\ ! public/ucomp.cmi public/uhashtbl.cmi public/locale.cmi\ ! public/ucasemap.cmi public/ustring.cmi public/utext.cmi public/ubuffer.cmi\ public/udebug.cmi OBJECTS =\ *************** *** 71,79 **** internal/bytesvect.cmo internal/tbl32.cmo internal/byte_labeled_dag.cmo\ internal/unidata.cmo internal/charmap.cmo internal/unimap.cmo\ public/uchar.cmo public/ustorage.cmo\ internal/ucs4.cmo internal/latin1.cmo internal/singleton.cmo\ ! public/uchannel.cmo public/ucategory.cmo\ ! public/unormalform.cmo public/ucasemap.cmo public/ucomp.cmo\ ! public/uhashtbl.cmo public/char_encoding.cmo\ public/ustring.cmo public/utext.cmo public/ubuffer.cmo\ public/udebug.cmo --- 72,81 ---- internal/bytesvect.cmo internal/tbl32.cmo internal/byte_labeled_dag.cmo\ internal/unidata.cmo internal/charmap.cmo internal/unimap.cmo\ + internal/res_bundle.cmo\ public/uchar.cmo public/ustorage.cmo\ internal/ucs4.cmo internal/latin1.cmo internal/singleton.cmo\ ! public/uchannel.cmo public/char_encoding.cmo public/ucategory.cmo\ ! public/unormalform.cmo public/ucomp.cmo public/uhashtbl.cmo\ ! public/locale.cmo public/ucasemap.cmo\ public/ustring.cmo public/utext.cmo public/ubuffer.cmo\ public/udebug.cmo *************** *** 112,119 **** mappings/gen_mappings.byte : camomile.cma mappings/gen_mappings.ml ! $(OCAMLC) $(BFLAGS) -o mappings/gen_mappings.byte str.cma camomile.cma mappings/gen_mappings.ml mappings/gen_mappings.opt : camomile.cmxa mappings/gen_mappings.ml ! $(OCAMLOPT) $(OFLAGS) -o mappings/gen_mappings.opt str.cmxa camomile.cmxa mappings/gen_mappings.ml # Compilation of charmap files --- 114,121 ---- mappings/gen_mappings.byte : camomile.cma mappings/gen_mappings.ml ! $(OCAMLC) $(BFLAGS) -o mappings/gen_mappings.byte camomile.cma str.cma mappings/gen_mappings.ml mappings/gen_mappings.opt : camomile.cmxa mappings/gen_mappings.ml ! $(OCAMLOPT) $(OFLAGS) -o mappings/gen_mappings.opt camomile.cmxa str.cmxa mappings/gen_mappings.ml # Compilation of charmap files *************** *** 130,137 **** tools/camlcharmap.byte : camomile.cma tools/camlcharmap.ml ! $(OCAMLC) $(BFLAGS) -o tools/camlcharmap.byte str.cma camomile.cma tools/camlcharmap.ml tools/camlcharmap.opt : camomile.cmxa tools/camlcharmap.ml ! $(OCAMLOPT) $(OFLAGS) -o tools/camlcharmap.opt str.cmxa camomile.cmxa tools/camlcharmap.ml ################################################################### --- 132,148 ---- tools/camlcharmap.byte : camomile.cma tools/camlcharmap.ml ! $(OCAMLC) $(BFLAGS) -o tools/camlcharmap.byte camomile.cma str.cma tools/camlcharmap.ml tools/camlcharmap.opt : camomile.cmxa tools/camlcharmap.ml ! $(OCAMLOPT) $(OFLAGS) -o tools/camlcharmap.opt camomile.cmxa str.cmxa tools/camlcharmap.ml ! ! # Compilation of locale data ! ############################ ! ! tools/camlrb.byte : camomile.cma tools/camlrb.ml ! $(OCAMLC) $(CAMLP4O) $(BFLAGS) -o tools/camlrb.byte camomile.cma tools/camlrb.ml ! ! tools/camlrb.opt : camomiel.cmxa tools/camlrb.ml ! $(OCAMLOPT) $(CAMLP4O) $(OFLAGS) -o tools/camlrb.opt camomile.cmxa tools/camlrb.ml ################################################################### *************** *** 142,146 **** mkdir -p $(OCAMLLIB) cp -f $(INT) $(OCAMLLIB) ! cp -f public/*.cmx $(OCAMLLIB) test -f camomile.cma && cp -f camomile.cma $(OCAMLLIB) test -f camomile.cmxa && cp -f camomile.cmxa $(OCAMLLIB) --- 153,157 ---- mkdir -p $(OCAMLLIB) cp -f $(INT) $(OCAMLLIB) ! cp -f $(filter public/%.cmx, $(OPTOBJECTS)) $(OCAMLLIB) test -f camomile.cma && cp -f camomile.cma $(OCAMLLIB) test -f camomile.cmxa && cp -f camomile.cmxa $(OCAMLLIB) *************** *** 213,229 **** tools/parse_unidata.byte : camomile.cma tools/parse_unidata.ml ! $(OCAMLC) $(BFLAGS) -o tools/parse_unidata.byte str.cma camomile.cma tools/parse_unidata.ml tools/parse_specialcasing.byte : camomile.cma tools/parse_specialcasing.ml ! $(OCAMLC) $(BFLAGS) -o tools/parse_specialcasing.byte str.cma camomile.cma tools/parse_specialcasing.ml tools/parse_casefolding.byte : camomile.cma tools/parse_casefolding.ml ! $(OCAMLC) $(BFLAGS) -o tools/parse_casefolding.byte str.cma camomile.cma tools/parse_casefolding.ml tools/parse_uniset.byte : camomile.cma tools/parse_uniset.ml ! $(OCAMLC) $(BFLAGS) -o tools/parse_uniset.byte str.cma camomile.cma tools/parse_uniset.ml tools/parse_allkeys.byte : camomile.cma tools/parse_allkeys.ml ! $(OCAMLC) $(BFLAGS) -o tools/parse_allkeys.byte str.cma camomile.cma tools/parse_allkeys.ml ################################################################### --- 224,240 ---- tools/parse_unidata.byte : camomile.cma tools/parse_unidata.ml ! $(OCAMLC) $(BFLAGS) -o tools/parse_unidata.byte camomile.cma str.cma tools/parse_unidata.ml tools/parse_specialcasing.byte : camomile.cma tools/parse_specialcasing.ml ! $(OCAMLC) $(BFLAGS) -o tools/parse_specialcasing.byte camomile.cma str.cma tools/parse_specialcasing.ml tools/parse_casefolding.byte : camomile.cma tools/parse_casefolding.ml ! $(OCAMLC) $(BFLAGS) -o tools/parse_casefolding.byte camomile.cma str.cma tools/parse_casefolding.ml tools/parse_uniset.byte : camomile.cma tools/parse_uniset.ml ! $(OCAMLC) $(BFLAGS) -o tools/parse_uniset.byte camomile.cma str.cma tools/parse_uniset.ml tools/parse_allkeys.byte : camomile.cma tools/parse_allkeys.ml ! $(OCAMLC) $(BFLAGS) -o tools/parse_allkeys.byte camomile.cma str.cma tools/parse_allkeys.ml ################################################################### *************** *** 235,239 **** tools/parse_unidata.byte tools/parse_uniset.byte tools/camlcharmap.byte\ tools/parse_specialcasing.byte tools/parse_casefolding.byte\ ! tools/parse_allkeys.byte tools : $(TOOLS) --- 246,250 ---- tools/parse_unidata.byte tools/parse_uniset.byte tools/camlcharmap.byte\ tools/parse_specialcasing.byte tools/parse_casefolding.byte\ ! tools/parse_allkeys.byte tools/camlrb.byte tools : $(TOOLS) *************** *** 251,258 **** test/unitest.byte : camomile.cma test/unitest.ml ! $(OCAMLC) $(BFLAGS) -o test/unitest.byte str.cma netstring.cma unix.cma camomile.cma test/unitest.ml test/unitest.opt : camomile.cmxa test/unitest.ml ! $(OCAMLOPT) $(OFLAGS) -o test/unitest.opt str.cmxa netstring.cmxa unix.cmxa camomile.cmxa test/unitest.ml test/recode.byte : camomile.cma test/recode.ml --- 262,269 ---- test/unitest.byte : camomile.cma test/unitest.ml ! $(OCAMLC) $(BFLAGS) -o test/unitest.byte camomile.cma str.cma netstring.cma unix.cma test/unitest.ml test/unitest.opt : camomile.cmxa test/unitest.ml ! $(OCAMLOPT) $(OFLAGS) -o test/unitest.opt camomile.cmxa str.cmxa netstring.cmxa unix.cmxa test/unitest.ml test/recode.byte : camomile.cma test/recode.ml *************** *** 263,270 **** test/test_recode_netstring.byte : camomile.cma test/test_recode_netstring.ml ! $(OCAMLC) $(BFLAGS) -o test/test_recode_netstring.byte unix.cma str.cma netstring.cma camomile.cma -cclib -lpthread test/test_recode_netstring.ml test/recode.opt : camomile.cmxa test/recode.ml ! $(OCAMLOPT) $(OFLAGS) -o test/recode.opt str.cmxa netstring.cmxa camomile.cmxa test/recode.ml ################################################################### --- 274,281 ---- test/test_recode_netstring.byte : camomile.cma test/test_recode_netstring.ml ! $(OCAMLC) $(BFLAGS) -o test/test_recode_netstring.byte camomile.cma unix.cma str.cma netstring.cma -cclib -lpthread test/test_recode_netstring.ml test/recode.opt : camomile.cmxa test/recode.ml ! $(OCAMLOPT) $(OFLAGS) -o test/recode.opt camomile.cmxa test/recode.ml ################################################################### *************** *** 313,317 **** --- 324,331 ---- tools/parse_unidata.ml tools/parse_uniset.ml tools/camlcharmap.ml\ tools/parse_specialcasing.ml tools/parse_casefolding.ml\ + test/*.ml\ > .depend + $(OCAMLDEP) $(CAMLP4O) $(SUBDIR) \ + tools/camlrb.ml >> .depend include .depend |
|
From: <yo...@us...> - 2002-06-16 04:20:52
|
Update of /cvsroot/camomile/camomile/public In directory usw-pr-cvs1:/tmp/cvs-serv26433/public Modified Files: Makefile Log Message: Resource bundle compiler. It still won't work. Index: Makefile =================================================================== RCS file: /cvsroot/camomile/camomile/public/Makefile,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Makefile 8 Apr 2002 09:41:49 -0000 1.1 --- Makefile 16 Jun 2002 04:20:49 -0000 1.2 *************** *** 1,4 **** all : ! cd .. && make all clean : --- 1,4 ---- all : ! cd .. && make byte clean : |
|
From: <yo...@us...> - 2002-06-16 04:20:52
|
Update of /cvsroot/camomile/camomile/tools
In directory usw-pr-cvs1:/tmp/cvs-serv26433/tools
Modified Files:
Makefile
Added Files:
camlrb.ml
Log Message:
Resource bundle compiler. It still won't work.
--- NEW FILE: camlrb.ml ---
(* $Id: camlrb.ml,v 1.1 2002/06/16 04:20:49 yori Exp $ *)
(* Copyright 2002 Yamagata Yoriyuki *)
open Helpers
open Ucategory
let cr = Char.code '\r'
let lf = Char.code '\n'
let nel = 0x0085
let tab = Char.code '\t'
let backslash = Char.code '\\'
let bb = new Latin1.obj_of "\\\\"
let bdq = new Latin1.obj_of "\\\""
let bsq = new Latin1.obj_of "\\'"
type unescape_state = Escape | U_literal | V_literal | Other
let code_u = Char.code 'u'
let code_v = Char.code 'v'
let code_0 = Char.code '0'
let code_9 = Char.code '9'
let code_a = Char.code 'a'
let code_f = Char.code 'f'
let code_A = Char.code 'A'
let code_F = Char.code 'F'
let code_n = Char.code 'n'
class unescape out : Uchannel.output =
object
val mutable state = Other
val buf4 = String.create 4
val buf8 = String.create 8
val mutable pos = 0
method put u =
let n = Uchar.uint_code u in
match state with
Other ->
if n = backslash then
state <- Escape
else
out#put u
| Escape ->
if n = backslash then begin
out#put (Uchar.chr_of_uint backslash);
state <- Other end
else if n = code_u then
begin state <- U_literal; pos <- 0 end
else if n = code_v then
begin state <- V_literal; pos <- 0 end
else if n = code_n then
out#put (Uchar.chr_of_uint lf)
else
failwith "Broken escaped character";
| U_literal ->
if (n >= code_0 && n <= code_9) || (n >= code_a && n <= code_f)
|| (n >= code_A && n <= code_F) then
begin buf4.[pos] <- Char.chr n; pos <- pos + 1 end
else
failwith "Broken escaped character";
if pos = 4 then
let n' = int_of_string ("0x" ^ buf4) in
out#put (Uchar.chr_of_uint n');
state <- Other
else ();
| V_literal ->
if (n >= code_0 && n <= code_9) || (n >= code_a && n <= code_f)
|| (n >= code_A && n <= code_F) then
begin buf8.[pos] <- Char.chr n; pos <- pos + 1 end
else
failwith "Broken escaped character";
if pos = 8 then
let n' = int_of_string ("0x" ^ buf8) in
out#put (Uchar.chr_of_uint n');
state <- Other
else ();
method close () = out#close ()
end
let unescaped s = Uchannel.apply_filter (new unescape) s
let rec stream_to_list_aux a s = (parser
[< 'e; rest >] -> stream_to_list_aux (e :: a) rest
| [< >] -> List.rev a) s
let stream_to_list s = stream_to_list_aux [] s
type token =
Text of Utext.t
| Brace_r
| Brace_l
| Colon
| Comma
| EOF
let rec prep = parser
[< 'u; rest >] ->
let c = try Some (Uchar.char_of u) with Uchar.Out_of_range -> None in
let ct = Ucategory.get u in
[< '(c, ct, u); prep rest >]
| [< >] -> [< >]
let rec remove_comment = parser
[< '( Some '/', _, _); '( Some '/', _, _); rest >] -> comment rest
| [< '( Some '"', _, _) as data; rest >] ->
[< 'data; in_quote rest >]
| [< 'data; rest >] -> [< 'data; remove_comment rest >]
| [< >] -> [< >]
and comment = parser
[< '( Some ('\r' | '\n' | '\133'), _, _) | ( _, (Zl | Zp), _); rest >]
->
remove_comment rest
| [< 'data; rest >] -> [< 'data; comment rest >]
| [< >] -> [< >]
and in_quote = parser
[< '( Some '"', _, _) as data; rest >] ->
[<' data; remove_comment rest >]
| [< 'data; rest >] -> [< 'data; in_quote rest >]
| [< >] -> [< >]
let rec merge_text = parser
[< 'Text s; rest >] -> do_merge s rest
| [< 'e; rest >] -> [< 'e; merge_text rest >]
| [< >] -> [< >]
and do_merge s = parser
[< 'Text s'; rest >] -> do_merge (Utext.append s s') rest
| [< 'e; rest >] -> [< 'Text s; 'e; merge_text rest >]
| [< >] -> [< >]
let lexer s =
let rec parse = parser
[< '( Some '{', _, _); rest >] -> [< 'Brace_l; parse rest >]
| [< '( Some '}', _, _); rest >] -> [< 'Brace_r; parse rest >]
| [< '( Some ':', _, _); rest >] -> [< 'Colon; parse rest >]
| [< '( Some ',', _, _); rest >] -> [< 'Comma; parse rest >]
| [< '( Some '"', _, _); rest >] -> quote rest
| [< '( Some ('\r' | '\n' | '\133' | '\t'), _, _) |
( _, (Zs | Zl | Zp), _) ; rest >] ->
parse rest
| [< >] -> [< 'EOF >]
| [< s >] -> text s
and quote s =
let buf = Ubuffer.create 16 in
let rec loop = parser
[< '( Some '"', _, _); rest >] ->
let s = Ubuffer.contents_utext buf in
let s' = new Utext.t (unescaped s) in
[< 'Text s'; parse rest >]
| [< '( _, _, u); rest >] ->
Ubuffer.add_char buf u;
loop rest
| [< >] -> failwith "A quote is not enclosed."
in
loop s
and text s =
let buf = Ubuffer.create 16 in
let rec loop = parser
[< rest = parser
[<'( Some ('\r' | '\n' | '\133' | '\t'), _, _) |
( _, (Zs | Zl | Zp), _) ; rest >] -> rest
| [< >] -> [< >] >] ->
let s = Ubuffer.contents_utext buf in
let s' = new Utext.t (unescaped s) in
[< 'Text s'; parse rest >]
| [< '( _, _, u); rest >] ->
Ubuffer.add_char buf u;
loop rest
in
loop s
in
stream_to_list (merge_text (parse (remove_comment (prep s))))
let ascii = Utext.of_string
let to_ascii s = Char_encoding.encode Char_encoding.ascii s
let ucs4 s = Char_encoding.encode Char_encoding.ucs4 s
let int_of_ustring s = int_of_string (to_ascii s)
let string_to_binary s =
let n = (s#len) / 2 in
let a = to_ascii s in
let b = String.create n in
for i = 0 to n - 1 do
let d = int_of_string ("0x" ^ (String.sub a (i * 2) 2)) in
b.[i] <- Char.chr d
done;
b
let root = ref ""
let load_file filename =
let file =
if Filename.is_implicit filename then
Filename.concat !root filename else
filename
in
let c = open_in_bin file in
let buf = Buffer.create 16 in
try begin while true do
Buffer.add_channel buf c 1
done; assert false end
with Not_found ->
Buffer.contents buf
type data =
Table of data Uhashtbl.t
| Array_data of data array
| String_data of Utext.t
| Binary of string
| Int of int
| Intvect of int array
| Tagged of Utext.t * data
let rec to_res_bundle data =
match data with
Table tbl ->
let proc k e a = (ucs4 k, to_res_bundle e) :: a in
let a = Uhashtbl.fold proc tbl [] in
Res_bundle.Table (pack a)
| Array_data a -> Res_bundle.Array (Array.map to_res_bundle a)
| String_data text -> Res_bundle.String (text#ucs4 ())
| _ -> failwith "Broken entry."
let rec parse_intvect l a =
match l with
Text num :: Comma :: rest ->
parse_intvect rest ((int_of_ustring num) :: a)
| Text num :: rest ->
Intvect (pack (List.rev ((int_of_ustring num) :: a))), rest
| _ ->
Intvect (pack (List.rev a)), l
let rec parse_table l a =
match parse l with
Some d, rest -> parse_table rest (d :: a)
| None, rest ->
let tbl = Uhashtbl.create (List.length a) in
let proc ent =
match ent with
Tagged (name, data) ->
Uhashtbl.add tbl name ent
| _ -> failwith "A broken table entry."
in
List.iter proc a;
Table tbl, rest
and parse_array l a =
match l with
Brace_l :: rest ->
let data, rest = parse_unknown rest in
(match rest with
Brace_r :: Comma :: rest ->
parse_array rest (data :: a)
| Brace_r :: rest ->
Array_data (pack (List.rev (data :: a))), rest
| _ -> failwith "A brace is not enclosed.")
| Text text :: Comma :: rest ->
parse_array rest ((String_data text) :: a)
| Text text :: rest ->
Array_data (pack (List.rev ((String_data text) :: a))), rest
| _ ->
Array_data (pack (List.rev a)), l
and parse_unknown l =
match l with
Text text :: Comma :: rest -> parse_array l []
| Text text :: rest -> parse_table l []
| _ -> parse_array l []
and parse l = match l with
Text name :: Colon :: Text tname :: Brace_l :: rest ->
if Ucomp.eq tname (ascii "table") then
let data, rest = parse_table rest [] in
match rest with
Brace_r :: rest ->
Some (Tagged (name, data)), rest
| _ -> failwith "A brace is not enclosed."
else if Ucomp.eq tname (ascii "array") then
let data, rest = parse_array rest [] in
match rest with
Brace_r :: rest ->
Some (Tagged (name, data)), rest
| _ -> failwith "A brace is not enclosed."
else if Ucomp.eq tname (ascii "string") then
match rest with
Text data :: Brace_r :: rest ->
Some (Tagged (name, String_data data)), rest
| _ -> failwith "A broken string entry."
else if Ucomp.eq tname (ascii "bin") then
match rest with
Text data :: Brace_r :: rest ->
let b = string_to_binary data in
Some (Tagged (name, Binary b)), rest
| _ -> failwith "A broken binary entry."
else if Ucomp.eq tname (ascii "import") then
match rest with
Text file :: Brace_r :: rest ->
let filename = to_ascii file in
Some (Tagged (name, Binary (load_file filename))), rest
| _ -> failwith "A broken import entry."
else if Ucomp.eq tname (ascii "int") then
match rest with
Text num :: Brace_r :: rest ->
let n = int_of_ustring num in
Some (Tagged (name, Int n)), rest
| _ -> failwith "A broken integer entry."
else if Ucomp.eq tname (ascii "intvector") then
let data, rest = parse_intvect rest [] in
match rest with
Brace_r :: rest ->
Some (Tagged (name, data)), rest
| _ -> failwith "A brace is not enclosed."
else failwith "Unknown data type."
| Text name :: Brace_l :: rest ->
let data, rest = parse_unknown rest in
Some (Tagged (name, data)), rest
| _ -> failwith "A broken entry."
let main () =
let enc = ref Char_encoding.utf8 in
let set_enc encname = enc := Char_encoding.of_name encname in
let readfile = ref stdin in
let set_readfile filename =
let dir = Filename.dirname filename in
root := dir;
readfile := open_in_bin filename
in
let dir = ref Filename.current_dir_name in
let set_dir dirname = dir := dirname in
let _ = Arg.parse
["--enc", Arg.String set_enc, "Encoding name";
"--file", Arg.String set_readfile, "Reding file"]
set_dir
"camlrb -enc ENCNAME -file INPUTFILE DIRECTORY:\n\
Read the resouce bundle INPUTFILE using the encoding ENCNAME \
and put the compiled data into DIRECTORY. \
If ENCNAME is ommited, UTF-8 is used. \
If INPUTFILE is ommited, reading from stdin. \
If DIRECTORY is ommited, the current directory is used."
in
let uc = new Char_encoding.in_channel !enc !readfile in
let stream = Uchannel.stream_of uc in
let lexed = lexer stream in
let data, rest = parse_table lexed [] in
match rest with
[ EOF ] ->
let proc key entry =
let file = Filename.concat !dir (to_ascii key) in
let c = open_out_bin file in
let bundle = to_res_bundle entry in
output_value c bundle
in
(match data with
Table tbl -> Uhashtbl.iter proc tbl
| _ -> failwith "Broken data.")
| _ -> failwith "Strange trailing data."
Index: Makefile
===================================================================
RCS file: /cvsroot/camomile/camomile/tools/Makefile,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** Makefile 21 Dec 2001 11:34:22 -0000 1.1.1.1
--- Makefile 16 Jun 2002 04:20:49 -0000 1.2
***************
*** 1,2 ****
all :
! cd .. && make tools
\ No newline at end of file
--- 1,5 ----
all :
! cd .. && make tools
!
! clean :
! cd .. && make clean
\ No newline at end of file
|
|
From: <yo...@us...> - 2002-06-16 04:19:33
|
Update of /cvsroot/camomile/camomile/public In directory usw-pr-cvs1:/tmp/cvs-serv26121/public Modified Files: char_encoding.ml char_encoding.mli Log Message: Add shortcuts for several encodings. Index: char_encoding.ml =================================================================== RCS file: /cvsroot/camomile/camomile/public/char_encoding.ml,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** char_encoding.ml 2 Jun 2002 08:35:27 -0000 1.9 --- char_encoding.ml 16 Jun 2002 04:19:30 -0000 1.10 *************** *** 1426,1427 **** --- 1426,1440 ---- let _ = Iso2022cn.init () + + (* shortcuts *) + let ascii = of_name "US-ASCII" + let latin1 = of_name "Latin-1" + let utf8 = of_name "UTF-8" + let utf16 = of_name "UTF-16" + let utf16be = of_name "UTF-16BE" + let utf16le = of_name "UTF-16LE" + let utf32 = of_name "UTF-32" + let utf32be = of_name "UTF-32BE" + let utf32le = of_name "UTF-32LE" + let ucs4 = of_name "UCS-4" + Index: char_encoding.mli =================================================================== RCS file: /cvsroot/camomile/camomile/public/char_encoding.mli,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** char_encoding.mli 24 May 2002 00:54:55 -0000 1.6 --- char_encoding.mli 16 Jun 2002 04:19:30 -0000 1.7 *************** *** 36,39 **** --- 36,51 ---- val name_of : t -> string + (* Shortcuts *) + val ascii : t + val latin1 : t + val utf8 : t + val utf16 : t + val utf16be : t + val utf16le : t + val utf32 : t + val utf32be : t + val utf32le : t + val ucs4 : t + val decode : t -> string -> Ustorage.cur Ustorage.t |
|
From: <yo...@us...> - 2002-06-06 21:14:05
|
Update of /cvsroot/camomile/camomile
In directory usw-pr-cvs1:/tmp/cvs-serv21895
Modified Files:
Tag: rel-0-2-head
Changes
Log Message:
Fix a further typo in Changes.
Index: Changes
===================================================================
RCS file: /cvsroot/camomile/camomile/Attic/Changes,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -C2 -d -r1.1.2.2 -r1.1.2.3
*** Changes 6 Jun 2002 20:59:28 -0000 1.1.2.2
--- Changes 6 Jun 2002 21:14:02 -0000 1.1.2.3
***************
*** 8,12 ****
Installation
! - camomile.cmxa and public/*.cmx are now installed.
- Fix a bug in ocamldep arguments.
--- 8,12 ----
Installation
! - camomile.a and public/*.cmx are now installed.
- Fix a bug in ocamldep arguments.
|
|
From: <yo...@us...> - 2002-06-06 20:59:34
|
Update of /cvsroot/camomile/camomile
In directory usw-pr-cvs1:/tmp/cvs-serv16948
Modified Files:
Tag: rel-0-2-head
Changes
Log Message:
Fix a typo in Changes.
Index: Changes
===================================================================
RCS file: /cvsroot/camomile/camomile/Attic/Changes,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -C2 -d -r1.1.2.1 -r1.1.2.2
*** Changes 26 May 2002 05:05:37 -0000 1.1.2.1
--- Changes 6 Jun 2002 20:59:28 -0000 1.1.2.2
***************
*** 1,7 ****
Release 0.2.2
-------------
Installation
! - camomile.cma and public/*.cmx are now installed.
- Fix a bug in ocamldep arguments.
--- 1,12 ----
+ Release 0.2.3
+ -------------
+
+ Fix a typo in Changes
+
Release 0.2.2
-------------
Installation
! - camomile.cmxa and public/*.cmx are now installed.
- Fix a bug in ocamldep arguments.
|
|
From: <yo...@us...> - 2002-06-02 08:39:08
|
Update of /cvsroot/camomile/camomile/public
In directory usw-pr-cvs1:/tmp/cvs-serv25765/public
Modified Files:
udebug.ml ustring.ml ustring.mli utext.ml utext.mli
Removed Files:
umisc.ml umisc.mli
Log Message:
escaped and unescaped are withdrawn.
Index: udebug.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/public/udebug.ml,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** udebug.ml 31 May 2002 11:01:01 -0000 1.3
--- udebug.ml 2 Jun 2002 08:39:05 -0000 1.4
***************
*** 3,14 ****
open Helpers
! let ascii = Char_encoding.of_name "ASCII"
! let string_of s = Char_encoding.encode ascii (Umisc.escaped s)
let printer_ustorage f s =
! Format.fprintf f "\"%s\"" (string_of s)
let printer_uchar f u =
! Format.fprintf f "'%s'" (string_of (new Singleton.obj_of u))
--- 3,72 ----
open Helpers
+ open Ucategory
! let backslash = Char.code '\\'
! let sq = Char.code '\''
! let dq = Char.code '"'
! let lf = Char.code '\n'
! let cr = Char.code '\r'
! let tab = Char.code '\t'
! let backspace = Char.code '\b'
! let bb = new Latin1.obj_of "\\\\"
! let bdq = new Latin1.obj_of "\\\""
! let bsq = new Latin1.obj_of "\\'"
!
! let print_char n =
! let n2 = n land 0xffff in
! let n1 = n lsr 16 in
! if n1 = 0 then
! Printf.sprintf "\\u%04X" n2
! else
! Printf.sprintf "\\v%04X%04X" n1 n2
!
! let escaped s =
! let buf = Buffer.create (s#len) in
! let proc u =
! let n = Uchar.uint_code u in
! if n > 0x7f || n < 0 then
! Buffer.add_string buf (print_char n)
! else match (Char.chr n) with
! '\\' -> Buffer.add_string buf "\\\\"
! | '"' -> Buffer.add_string buf "\\\""
! | '\n' -> Buffer.add_string buf "\\n"
! | '\r' -> Buffer.add_string buf "\\r"
! | '\t' -> Buffer.add_string buf "\\t"
! | '\b' -> Buffer.add_string buf "\\b"
! | c ->
! if get u = Cc then
! Buffer.add_string buf (print_char n)
! else
! Buffer.add_char buf c
! in
! Ustorage.iter proc s;
! Buffer.contents buf
!
! let escaped_char u =
! let n = Uchar.uint_code u in
! if n > 0x7f || n < 0 then
! print_char n
! else
! match (Char.chr n) with
! '\\' -> "\\\\"
! | '\'' -> "\\'"
! | '\n' -> "\\n"
! | '\r' -> "\\r"
! | '\t' -> "\\t"
! | '\b' -> "\\b"
! | c ->
! if get u = Cc then
! print_char n
! else
! String.make 1 c
let printer_ustorage f s =
! Format.fprintf f "\"%s\"" (escaped s)
let printer_uchar f u =
! Format.fprintf f "'%s'" (escaped_char u)
!
Index: ustring.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/public/ustring.ml,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** ustring.ml 31 May 2002 11:01:01 -0000 1.4
--- ustring.ml 2 Jun 2002 08:39:05 -0000 1.5
***************
*** 49,56 ****
(List.map (fun s -> (s#unsafe_ucs4 ())) l))
- let escaped s = new t (Umisc.escaped s)
-
- let unescaped s = new t (Umisc.unescaped s)
-
let uppercase s =
new t (Ucasemap.uppercase s)
--- 49,52 ----
Index: ustring.mli
===================================================================
RCS file: /cvsroot/camomile/camomile/public/ustring.mli,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** ustring.mli 31 May 2002 11:01:01 -0000 1.4
--- ustring.mli 2 Jun 2002 08:39:05 -0000 1.5
***************
*** 59,73 ****
val concat : t -> t list -> t
- (* All control characters, non-ascii characters and backslash
- * are escaped as
- * \ -> \\
- * <16-bits unicode> -> \u<4-digits hexadecimal>
- * <21-bits unicode> -> \v<8-digits hexadecimal>
- *)
- val escaped : t -> t
-
- (* Reverse of escaped *)
- val unescaped : t -> t
-
(* Case mappings *)
val uppercase : t -> t
--- 59,62 ----
Index: utext.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/public/utext.ml,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** utext.ml 31 May 2002 11:01:01 -0000 1.5
--- utext.ml 2 Jun 2002 08:39:05 -0000 1.6
***************
*** 30,37 ****
(List.map (fun s -> (s#unsafe_ucs4 ())) l))
- let escaped s = new t (Umisc.escaped s)
-
- let unescaped s = new t (Umisc.unescaped s)
-
let uppercase s =
new t (Ucasemap.uppercase s)
--- 30,33 ----
Index: utext.mli
===================================================================
RCS file: /cvsroot/camomile/camomile/public/utext.mli,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** utext.mli 31 May 2002 11:01:01 -0000 1.5
--- utext.mli 2 Jun 2002 08:39:05 -0000 1.6
***************
*** 46,60 ****
val concat : t -> t list -> t
- (* All control characters, non-ascii characters and backslash
- * are escaped as
- * \ -> \\
- * <16-bits unicode> -> \u<4-digits hexadecimal>
- * <21-bits unicode> -> \v<8-digits hexadecimal>
- *)
- val escaped : t -> t
-
- (* Reverse of escaped *)
- val unescaped : t -> t
-
(* Case mappings *)
val uppercase : t -> t
--- 46,49 ----
--- umisc.ml DELETED ---
--- umisc.mli DELETED ---
|
|
From: <yo...@us...> - 2002-06-02 08:39:08
|
Update of /cvsroot/camomile/camomile In directory usw-pr-cvs1:/tmp/cvs-serv25765 Modified Files: Makefile.in Log Message: escaped and unescaped are withdrawn. Index: Makefile.in =================================================================== RCS file: /cvsroot/camomile/camomile/Makefile.in,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** Makefile.in 31 May 2002 11:01:00 -0000 1.8 --- Makefile.in 2 Jun 2002 08:39:05 -0000 1.9 *************** *** 64,68 **** public/ucategory.cmi public/unormalform.cmi public/ucasemap.cmi\ public/ucomp.cmi public/uhashtbl.cmi\ ! public/umisc.cmi public/char_encoding.cmi\ public/ustring.cmi public/utext.cmi public/ubuffer.cmi\ public/udebug.cmi --- 64,68 ---- public/ucategory.cmi public/unormalform.cmi public/ucasemap.cmi\ public/ucomp.cmi public/uhashtbl.cmi\ ! public/char_encoding.cmi\ public/ustring.cmi public/utext.cmi public/ubuffer.cmi\ public/udebug.cmi *************** *** 75,79 **** public/uchannel.cmo public/ucategory.cmo\ public/unormalform.cmo public/ucasemap.cmo public/ucomp.cmo\ ! public/uhashtbl.cmo public/char_encoding.cmo public/umisc.cmo\ public/ustring.cmo public/utext.cmo public/ubuffer.cmo\ public/udebug.cmo --- 75,79 ---- public/uchannel.cmo public/ucategory.cmo\ public/unormalform.cmo public/ucasemap.cmo public/ucomp.cmo\ ! public/uhashtbl.cmo public/char_encoding.cmo\ public/ustring.cmo public/utext.cmo public/ubuffer.cmo\ public/udebug.cmo |
|
From: <yo...@us...> - 2002-06-02 08:35:31
|
Update of /cvsroot/camomile/camomile/public
In directory usw-pr-cvs1:/tmp/cvs-serv25335/public
Modified Files:
char_encoding.ml uchannel.ml ustorage.ml ustorage.mli
Log Message:
Ustorage.iter s proc -> Ustorage.iter proc s
Index: char_encoding.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/public/char_encoding.ml,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** char_encoding.ml 24 May 2002 00:54:55 -0000 1.8
--- char_encoding.ml 2 Jun 2002 08:35:27 -0000 1.9
***************
*** 22,26 ****
let feed_ustorage encoder s =
! Ustorage.iter s (encoder.uread)
type t =
--- 22,26 ----
let feed_ustorage encoder s =
! Ustorage.iter encoder.uread s
type t =
Index: uchannel.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/public/uchannel.ml,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** uchannel.ml 24 May 2002 00:53:59 -0000 1.3
--- uchannel.ml 2 Jun 2002 08:35:27 -0000 1.4
***************
*** 21,25 ****
end
! let output_string outchan s = Ustorage.iter s (outchan#put)
let apply_filter f s =
--- 21,25 ----
end
! let output_string outchan s = Ustorage.iter outchan#put s
let apply_filter f s =
Index: ustorage.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/public/ustorage.ml,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** ustorage.ml 19 Apr 2002 04:45:55 -0000 1.2
--- ustorage.ml 2 Jun 2002 08:35:27 -0000 1.3
***************
*** 20,24 ****
end
! let iter s op =
let cur = s#first in
try while true do
--- 20,24 ----
end
! let iter op s =
let cur = s#first in
try while true do
Index: ustorage.mli
===================================================================
RCS file: /cvsroot/camomile/camomile/public/ustorage.mli,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** ustorage.mli 10 May 2002 10:57:07 -0000 1.3
--- ustorage.mli 2 Jun 2002 08:35:27 -0000 1.4
***************
*** 20,24 ****
end
! val iter : (#cur as 'a) #t -> (Uchar.t -> unit) -> unit
(* Equality by code point comparison.
--- 20,24 ----
end
! val iter : (Uchar.t -> unit) -> (#cur as 'a) #t -> unit
(* Equality by code point comparison.
|
|
From: <yo...@us...> - 2002-06-02 08:35:31
|
Update of /cvsroot/camomile/camomile/internal
In directory usw-pr-cvs1:/tmp/cvs-serv25335/internal
Modified Files:
ucs4.ml
Log Message:
Ustorage.iter s proc -> Ustorage.iter proc s
Index: ucs4.ml
===================================================================
RCS file: /cvsroot/camomile/camomile/internal/ucs4.ml,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** ucs4.ml 11 May 2002 23:06:25 -0000 1.2
--- ucs4.ml 2 Jun 2002 08:35:26 -0000 1.3
***************
*** 127,131 ****
let add_char b u = add_code b (Uchar.uint_code u); b.len <- b.len + 1
! let add_string b s = Ustorage.iter s (add_char b)
let add_buffer b b' =
--- 127,131 ----
let add_char b u = add_code b (Uchar.uint_code u); b.len <- b.len + 1
! let add_string b s = Ustorage.iter (add_char b) s
let add_buffer b b' =
|