Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 129 lines (117 sloc) 6.829 kB
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
6fac5ce @Aqua-Ye [cleanup] ocamllib: typo on Opa
Aqua-Ye authored
4 This file is part of Opa.
fccc685 Initial open-source release
MLstate authored
5
6fac5ce @Aqua-Ye [cleanup] ocamllib: typo on Opa
Aqua-Ye authored
6 Opa is free software: you can redistribute it and/or modify it under the
fccc685 Initial open-source release
MLstate authored
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
6fac5ce @Aqua-Ye [cleanup] ocamllib: typo on Opa
Aqua-Ye authored
10 Opa is distributed in the hope that it will be useful, but WITHOUT ANY
fccc685 Initial open-source release
MLstate authored
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
6fac5ce @Aqua-Ye [cleanup] ocamllib: typo on Opa
Aqua-Ye authored
16 along with Opa. If not, see <http://www.gnu.org/licenses/>.
fccc685 Initial open-source release
MLstate authored
17 *)
18 (** Charf:
19 Equivalent of Char.is_xyz except implemented as lookup tables.
20 *)
21 module List = Base.List
22 module String = Base.String
23 module Char = Base.Char
24
25 (*
26 (* Code to generate chtab. *)
27 let is_lu ch = Char.is_lower ch || Char.is_upper ch
28 let is_hex c = (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F')
29 let is_sptab c = c = ' ' || c = '\t'
30 let is_name = function | 'a'..'z' -> true | 'A'..'Z' -> true | '0'..'9' -> true | '_' | '-' -> true | _ -> false
31 let is_url = function
32 | 'a'..'z' -> true | 'A'..'Z' -> true | '0'..'9' -> true
33 | '_' | '-' | '$' | '.' | '+' | '!' | '*' | '\'' | '(' | ')' | ',' -> true
34 | _ -> false
35 (* is_url but excluding , / ? : @ & = + $ # *) (* and now: ! ' *)
36 let is_urlx = function
37 | 'a'..'z' -> true | 'A'..'Z' -> true | '0'..'9' -> true
38 | '_' | '-' | '.' | '*' | '(' | ')' -> true
39 | _ -> false
40 (*A-Z, a-z, 0-9, hyphen ( - ), underscore ( _ ), period ( . ), and tilde ( ~ )*)
41 let is_aws = function
42 | 'a'..'z' -> true | 'A'..'Z' -> true | '0'..'9' -> true
43 | '-' | '_' | '.' | '~' -> true
44 | _ -> false
45 let is_char = function | ' ' | '\t' | '\r' | '\n' | '%' | '&' | '?' | '=' | '+' -> true | _ -> false
46 let is_sep = function
47 | ' ' | '\n' | '\t' | '\r' | ',' | '?' | ';' | '.' | ':' | '/' | '!' | '*' | '+' | '(' | ')' | '[' | ']' -> true
48 | _ -> false
49 let is_htmlchar = function
50 | 'a'..'z' -> true | 'A'..'Z' -> true | '0'..'9' -> true | '\'' | '"' | '_' | '-' | '@' -> true | _ -> false
51 let chtab = Array.create 256 0
52 let setcodes (bit,is_fn) =
53 List.iter (fun ch -> if is_fn ch then let idx = Char.code ch in chtab.(idx) <- chtab.(idx) lor bit else ())
54 (List.init 256 (fun i -> Char.chr i))
55 let codes = [(0x0001,Char.is_digit); (0x0002,is_hex); (0x0004,Char.is_lower); (0x0008,Char.is_upper);
56 (0x0010,Char.is_alpha); (0x0020,Char.is_space); (0x0040,is_lu); (0x0080,is_sptab);
57 (0x0100,is_name); (0x0200,is_char); (0x0400,is_url); (0x0800,is_sep);
58 (0x1000,is_htmlchar); (0x2000,is_urlx); (0x4000,is_aws); ]
59 let _ = List.iter setcodes codes
60 *)
61 let chtab = [|0; 0; 0; 0; 0; 0; 0; 0; 0; 2720; 2592; 0; 0; 2592; 0; 0; 0; 0; 0; 0; 0; 0;
62 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 2720; 3072; 4096; 0; 1024; 512; 512; 5120;
63 11264; 11264; 11264; 3584; 3072; 29952; 27648; 2048; 29971; 29971; 29971;
64 29971; 29971; 29971; 29971; 29971; 29971; 29971; 2048; 2048; 0; 512; 0;
65 2560; 4096; 30042; 30042; 30042; 30042; 30042; 30042; 30040; 30040; 30040;
66 30040; 30040; 30040; 30040; 30040; 30040; 30040; 30040; 30040; 30040;
67 30040; 30040; 30040; 30040; 30040; 30040; 30040; 2048; 0; 2048; 0; 29952;
68 0; 30038; 30038; 30038; 30038; 30038; 30038; 30036; 30036; 30036; 30036;
69 30036; 30036; 30036; 30036; 30036; 30036; 30036; 30036; 30036; 30036;
70 30036; 30036; 30036; 30036; 30036; 30036; 0; 0; 0; 16384; 0; 0; 0; 0; 0; 0;
71 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
72 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
73 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
74 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
75 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0|]
76
77 (* These are faster than the Char ones:
78 * for digit, lower, upper and alpha about 10% faster,
79 * for hex, space about 2x as fast.
80 *)
81 let is_digitf ch = (chtab.(Char.code ch) land 0x0001) <> 0
82 let is_hexf ch = (chtab.(Char.code ch) land 0x0002) <> 0
83 let is_lowerf ch = (chtab.(Char.code ch) land 0x0004) <> 0
84 let is_upperf ch = (chtab.(Char.code ch) land 0x0008) <> 0
85 let is_alphaf ch = (chtab.(Char.code ch) land 0x0010) <> 0
86 let is_spacef ch = (chtab.(Char.code ch) land 0x0020) <> 0
87 let is_luf ch = (chtab.(Char.code ch) land 0x0040) <> 0
88 let is_sptabf ch = (chtab.(Char.code ch) land 0x0080) <> 0
89 let is_namef ch = (chtab.(Char.code ch) land 0x0100) <> 0
90 let is_charf ch = (chtab.(Char.code ch) land 0x0200) <> 0
91 let is_urlf ch = (chtab.(Char.code ch) land 0x0400) <> 0
92 let is_sepf ch = (chtab.(Char.code ch) land 0x0800) <> 0
93 let is_htmlcharf ch = (chtab.(Char.code ch) land 0x1000) <> 0
94 let is_urlxf ch = (chtab.(Char.code ch) land 0x2000) <> 0
95 let is_awsf ch = (chtab.(Char.code ch) land 0x4000) <> 0
96
97 (* Code to generate hxtab.
98 let hcode ch =
99 match ch with
100 | '0'..'9' -> (Char.code ch)-48
101 | 'a'..'f' -> (Char.code ch)-87
102 | 'A'..'F' -> (Char.code ch)-55
103 | _ -> 0
104 let hxtab = Array.create 256 0
105 let _ = List.iter (fun ch -> hxtab.(Char.code ch) <- hcode ch) (List.init 256 (fun i -> Char.chr i))
106 *)
107 let hxtab = [|0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
108 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 1;
109 2; 3; 4; 5; 6; 7; 8; 9; 0; 0; 0; 0; 0; 0; 0; 10; 11; 12; 13; 14; 15; 0; 0;
110 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 10;
111 11; 12; 13; 14; 15; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
112 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
113 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
114 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
115 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
116 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
117 0; 0; 0; 0; 0; 0; 0; 0; 0; 0|]
118 let hcodef ch = hxtab.(Char.code ch)
119
120 let c3i c1 c2 c3 = ((Char.code c1)-48)*100+((Char.code c2)-48)*10+((Char.code c3)-48)
121 let c2h c1 c2 = (hcodef (c1))*16+(hcodef c2)
122
123 (* SML names... *)
124 let implode cl = let s = String.create (List.length cl) in List.iteri (fun c i -> s.[i] <- c) cl; s
125
126 let c4u c1 c2 c3 c4 = implode (Uchar.chars_of_uchar (4096 * (hcodef c1) + 256 * (hcodef c2) + 16 * (hcodef c3) + (hcodef c4)))
127
128 (* End of file charf.ml *)
Something went wrong with that request. Please try again.