+++ /dev/null
-(* $Id$
- * ----------------------------------------------------------------------
- *
- *)
-
-open Printf;;
-
-let comment_re = Str.regexp "#.*$";;
-let space_re = Str.regexp "[ \t\r\n]+";;
-
-let read_unimap_format_a fname f =
- (* Reads a Unicode mapping in format A from a "local" code to Unicode.
- * Returns a list of pairs (localcode, unicode).
- *)
-
- let read_unimap_line() =
- let s = input_line f in (* may raise End_of_file *)
- let s' = Str.global_replace comment_re "" s in
- let words = Str.split space_re s' in
- match words with
- [] -> raise Not_found
- | [ localcode; unicode ] ->
- int_of_string localcode, int_of_string unicode
- | _ ->
- failwith ("File " ^ fname ^ ": Do not know what to do with:\n" ^ s')
- in
-
- let rec read_following_lines() =
- try
- let localcode, unicode = read_unimap_line() in
- (* may raise End_of_file, Not_found *)
- (localcode, unicode) :: read_following_lines()
- with
- Not_found -> read_following_lines()
- | End_of_file -> []
- in
-
- read_following_lines()
-;;
-
-
-type from_uni_list =
- U_nil
- | U_single of (int * int)
- | U_list of (int * int) list
-
-type from_unicode =
- from_uni_list array;;
- (* A hashtable with fixed size (256). A pair (unicode, localcode) is
- * stored at the position unicode mod 256 in the array.
- *)
-
-
-let make_bijection unimap =
- (* unimap: a list of pairs (localcode, unicode)
- * returns a pair of arrays (m_to_unicode, m_from_unicode) with:
- * - m_to_unicode.(localcode) = Some unicode,
- * if the pair (localcode, unicode) exists
- * m_to_unicode.(x) = None otherwise
- * - m_from_unicode.(unicode lsr 8) = [ ...; (unicode,localcode); ... ]
- *)
-
- let m_to_unicode = Array.create 256 None in
- let m_from_unicode = Array.create 256 [] in
-
- List.iter
- (fun (localcode, unicode) ->
- assert(localcode < 256);
-
- (* Update m_to_unicode: *)
- if m_to_unicode.(localcode) <> None then
- failwith ("Local code point " ^ string_of_int localcode ^
- " mapped twice");
- m_to_unicode.(localcode) <- Some unicode;
-
- (* Update m_from_unicode: *)
- let unilow = unicode land 255 in
- if List.mem_assoc unicode (m_from_unicode.(unilow)) then
- failwith ("Unicode code point " ^ string_of_int unicode ^
- " mapped twice");
- m_from_unicode.(unilow) <-
- m_from_unicode.(unilow) @ [unicode,localcode];
- )
- unimap;
-
- m_to_unicode, m_from_unicode
-;;
-
-
-let to_unimap_as_string to_unimap =
- let make_repr x =
- match x with
- None -> -1
- | Some u -> u
- in
- Marshal.to_string (Array.map make_repr to_unimap) [ Marshal.No_sharing ]
-;;
-
-
-let from_unimap_as_string from_unimap =
- let make_repr l =
- match l with
- [] -> U_nil
- | [u,l] -> U_single(u,l)
- | _ -> U_list l
- in
- let m = Array.map make_repr from_unimap in
- Marshal.to_string m [ Marshal.No_sharing ]
-;;
-
-
-let print_bijection f name m_to_unicode m_from_unicode =
- (* Prints on file f this O'Caml code:
- * let <name>_to_unicode = ...
- * let <name>_from_unicode = ...
- *)
- fprintf f "let %s_to_unicode = lazy (Marshal.from_string \"%s\" 0 : int array);;\n"
- name
- (String.escaped (to_unimap_as_string m_to_unicode));
-
- fprintf f "let %s_from_unicode = lazy (Marshal.from_string \"%s\" 0 : Netmappings.from_uni_list array);;\n "
- name
- (String.escaped (from_unimap_as_string m_from_unicode));
-;;
-
-
-let main() =
- let files = ref [] in
- let outch = ref (lazy stdout) in
- Arg.parse
- [ "-o", Arg.String (fun s -> outch := lazy (open_out s)),
- " <file> Write result to this file"]
- (fun s -> files := !files @ [s])
- "usage: unimap_to_ocaml file.unimap ...";
-
- (* First read in all unimaps: *)
- let unimaps =
- List.map
- (fun filename ->
- let mapname = Str.replace_first (Str.regexp "\.unimap$") ""
- (Filename.basename filename) in
- let f = open_in filename in
- prerr_endline ("Reading " ^ filename);
- let unimap = read_unimap_format_a filename f in
- close_in f;
- mapname, unimap
- )
- !files
- in
-
- (* Second compute all bijections: *)
- let bijections =
- List.map
- (fun (mapname, unimap) ->
- prerr_endline ("Processing " ^ mapname);
- let to_unicode, from_unicode = make_bijection unimap in
- mapname, to_unicode, from_unicode
- )
- unimaps
- in
-
- let out = Lazy.force !outch in
- (* Third output all results: *)
- output_string out "(* WARNING! This is a generated file! *)\n";
-
- List.iter
- (fun (mapname, to_unicode, from_unicode) ->
- print_bijection out mapname to_unicode from_unicode)
- bijections;
- List.iter
- (fun (mapname, _, _) ->
- fprintf out "Hashtbl.add Netmappings.to_unicode `Enc_%s %s_to_unicode;\n"
- mapname mapname;
- fprintf out "Hashtbl.add Netmappings.from_unicode `Enc_%s %s_from_unicode;\n"
- mapname mapname;
- )
- (List.rev bijections);
- fprintf out "();;\n";
-
- close_out out
-;;
-
-
-main();;
-
-(* ======================================================================
- * History:
- *
- * $Log$
- * Revision 1.1 2000/11/17 09:57:29 lpadovan
- * Initial revision
- *
- * Revision 1.3 2000/08/29 00:48:52 gerd
- * Conversion tables are now stored in marshalled form.
- * New type for the conversion table Unicode to 8bit.
- *
- * Revision 1.2 2000/08/12 23:54:56 gerd
- * Initial revision.
- *
- *
- *)
projects / helm.git / blobdiff