Source file arithmetic.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
let invalid_arg fmt = Format.kasprintf invalid_arg fmt

type 'a t =
  | Invert of 'a t
  | Add of 'a
  | Sub of 'a
  | Mul of 'a
  | Div of 'a
  | Mod of 'a
  | Bitwise_and of 'a
  | Bitwise_xor of 'a
  | Bitwise_or of 'a

let rec serialize pp ppf = function
  | Invert t ->
      Format.fprintf ppf "Conan.Arithmetic.Invert@ @[%a@]"
        (Serialize.parens (serialize pp))
        t
  | Add v -> Format.fprintf ppf "Conan.Arithmetic.Add@ @[%a@]" pp v
  | Sub v -> Format.fprintf ppf "Conan.Arithmetic.Sub@ @[%a@]" pp v
  | Mul v -> Format.fprintf ppf "Conan.Arithmetic.Mul@ @[%a@]" pp v
  | Div v -> Format.fprintf ppf "Conan.Arithmetic.Div@ @[%a@]" pp v
  | Mod v -> Format.fprintf ppf "Conan.Arithmetic.Mod@ @[%a@]" pp v
  | Bitwise_and v ->
      Format.fprintf ppf "Conan.Arithmetic.Bitwise_and@ @[%a@]" pp v
  | Bitwise_xor v ->
      Format.fprintf ppf "Conan.Arithmetic.Bitwise_xor@ @[%a@]" pp v
  | Bitwise_or v ->
      Format.fprintf ppf "Conan.Arithmetic.Bitwise_or@ @[%a@]" pp v

let pf = Format.fprintf

let rec pp pp_val ppf = function
  | Invert v -> pf ppf "~%a" (pp pp_val) v
  | Add v -> pf ppf "+%a" pp_val v
  | Sub v -> pf ppf "-%a" pp_val v
  | Mul v -> pf ppf "*%a" pp_val v
  | Div v -> pf ppf "/%a" pp_val v
  | Mod v -> pf ppf "%%%a" pp_val v
  | Bitwise_and v -> pf ppf "&%a" pp_val v
  | Bitwise_xor v -> pf ppf "^%a" pp_val v
  | Bitwise_or v -> pf ppf "|%a" pp_val v

let rec map ~f = function
  | Invert c -> Invert (map ~f c)
  | Add v -> Add (f v)
  | Sub v -> Sub (f v)
  | Mul v -> Mul (f v)
  | Div v -> Div (f v)
  | Mod v -> Mod (f v)
  | Bitwise_and v -> Bitwise_and (f v)
  | Bitwise_xor v -> Bitwise_xor (f v)
  | Bitwise_or v -> Bitwise_or (f v)

let rec value = function
  | Invert c -> value c
  | Add v -> v
  | Sub v -> v
  | Mul v -> v
  | Div v -> v
  | Mod v -> v
  | Bitwise_and v -> v
  | Bitwise_xor v -> v
  | Bitwise_or v -> v

let of_string ~with_val = function
  | "+" -> Add with_val
  | "-" -> Sub with_val
  | "*" -> Mul with_val
  | "/" -> Div with_val
  | "%" -> Mod with_val
  | "&" -> Bitwise_and with_val
  | "^" -> Bitwise_xor with_val
  | "|" -> Bitwise_or with_val
  | v -> invalid_arg "Invalid arithmetic operator: %S" v

let is = function
  | '+' | '-' | '*' | '/' | '%' | '&' | '|' | '^' -> true
  | _ -> false

let add v = Add v

let sub v = Sub v

let mul v = Mul v

let div v = Div v

let rem v = Mod v

let logand v = Bitwise_and v

let logxor v = Bitwise_xor v

let invert v = Invert v

let logor v = Bitwise_or v

let rec process : type a. ?unsigned:bool -> a Integer.t -> a -> a t -> a =
 fun ?(unsigned = false) w a -> function
  | Add b -> Integer.add w a b
  | Sub b -> Integer.sub w a b
  | Mul b -> Integer.mul w a b
  | Div b -> Integer.div ~unsigned w a b
  | Mod b -> Integer.rem ~unsigned w a b
  | Bitwise_and b -> Integer.bitwise_and w a b
  | Bitwise_xor b -> Integer.bitwise_xor w a b
  | Bitwise_or b -> Integer.bitwise_or w a b
  | Invert c -> Integer.invert w (process w a c)

let process_float a = function
  | Add b -> Float.add a b
  | Sub b -> Float.sub a b
  | Mul b -> Float.mul a b
  | Div b -> Float.div a b
  | Mod b -> Float.rem a b
  | Bitwise_and _ | Bitwise_xor _ | Bitwise_or _ | Invert _ ->
      invalid_arg "Invalid bitwise operation on float"

let rec process_ptime a = function
  | Add b -> Ptime.Span.add a b
  | Sub b -> Ptime.Span.sub a b
  | Invert c -> Ptime.Span.neg (process_ptime a c)
  | Mul _ | Div _ | Mod _ | Bitwise_and _ | Bitwise_xor _ | Bitwise_or _ ->
      invalid_arg "Invalid operation on date"