Source file `char.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
open! Import
module Array = Array0
module String = String0
include Char0

module T = struct
  type t = char [@@deriving_inline compare, hash, globalize, sexp, sexp_grammar]

  let compare = (compare_char : t -> t -> int)

  let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) =
    hash_fold_char

  and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) =
    let func = hash_char in
    fun x -> func x
  ;;

  let (globalize : (t[@ocaml.local]) -> t) = (globalize_char : (t[@ocaml.local]) -> t)
  let t_of_sexp = (char_of_sexp : Sexplib0.Sexp.t -> t)
  let sexp_of_t = (sexp_of_char : t -> Sexplib0.Sexp.t)
  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = char_sexp_grammar

  [@@@end]

  let to_string t = String.make 1 t

  let of_string s =
    match String.length s with
    | 1 -> s.[0]
    | _ -> failwithf "Char.of_string: %S" s ()
  ;;
end

include T

include Identifiable.Make (struct
    include T

    let module_name = "Base.Char"
  end)

let pp fmt c = Stdlib.Format.fprintf fmt "%C" c

(* Open replace_polymorphic_compare after including functor instantiations so they do not
   shadow its definitions. This is here so that efficient versions of the comparison
   functions are available within this module. *)
open! Char_replace_polymorphic_compare

let invariant (_ : t) = ()
let all = Array.init 256 ~f:unsafe_of_int |> Array.to_list

let is_lowercase = function
  | 'a' .. 'z' -> true
  | _ -> false
;;

let is_uppercase = function
  | 'A' .. 'Z' -> true
  | _ -> false
;;

let is_print = function
  | ' ' .. '~' -> true
  | _ -> false
;;

let is_whitespace = function
  | '\t' | '\n' | '\011' (* vertical tab *) | '\012' (* form feed *) | '\r' | ' ' -> true
  | _ -> false
;;

let is_digit = function
  | '0' .. '9' -> true
  | _ -> false
;;

let is_alpha = function
  | 'a' .. 'z' | 'A' .. 'Z' -> true
  | _ -> false
;;

(* Writing these out, instead of calling [is_alpha] and [is_digit], reduces
   runtime by approx. 30% *)
let is_alphanum = function
  | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' -> true
  | _ -> false
;;

let get_digit_unsafe t = to_int t - to_int '0'

let get_digit_exn t =
  if is_digit t
  then get_digit_unsafe t
  else failwithf "Char.get_digit_exn %C: not a digit" t ()
;;

let get_digit t = if is_digit t then Some (get_digit_unsafe t) else None

let is_hex_digit = function
  | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true
  | _ -> false
;;

let is_hex_digit_lower = function
  | '0' .. '9' | 'a' .. 'f' -> true
  | _ -> false
;;

let is_hex_digit_upper = function
  | '0' .. '9' | 'A' .. 'F' -> true
  | _ -> false
;;

let get_hex_digit_exn = function
  | '0' .. '9' as t -> to_int t - to_int '0'
  | 'a' .. 'f' as t -> to_int t - to_int 'a' + 10
  | 'A' .. 'F' as t -> to_int t - to_int 'A' + 10
  | t ->
    Error.raise_s
      (Sexp.message
         "Char.get_hex_digit_exn: not a hexadecimal digit"
         [ "char", sexp_of_t t ])
;;

let get_hex_digit t = if is_hex_digit t then Some (get_hex_digit_exn t) else None

module O = struct
  let ( >= ) = ( >= )
  let ( <= ) = ( <= )
  let ( = ) = ( = )
  let ( > ) = ( > )
  let ( < ) = ( < )
  let ( <> ) = ( <> )
end

module Caseless = struct
  module T = struct
    type t = char [@@deriving_inline sexp, sexp_grammar]

    let t_of_sexp = (char_of_sexp : Sexplib0.Sexp.t -> t)
    let sexp_of_t = (sexp_of_char : t -> Sexplib0.Sexp.t)
    let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = char_sexp_grammar

    [@@@end]

    let compare c1 c2 = compare (lowercase c1) (lowercase c2)
    let hash_fold_t state t = hash_fold_char state (lowercase t)
    let hash t = Hash.run hash_fold_t t
  end

  include T
  include Comparable.Make (T)
end

(* Include type-specific [Replace_polymorphic_compare] at the end, after
   including functor application that could shadow its definitions. This is
   here so that efficient versions of the comparison functions are exported by
   this module. *)
include Char_replace_polymorphic_compare