GraphCalcML/arithmetic.ml at main · bkhalil3/GraphCalcML · GitHub

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
open Ast

module type Arithmetic_Funcs = sig
  val add : value list -> value
  val subtract : value list -> value
  val multiply : value list -> value
  val divide : value list -> value
  val exponentiation : value list -> value
  val modulus : value list -> value
  val logarithm : value list -> value
  val equal_to : value list -> value
end

module type CFU_sig = sig
  val operation_list : (string * ( value list -> value )) list
end

module Arithmetic_Functions : Arithmetic_Funcs = struct

  (** [unwrap v] is the float extracted from value [v]
      requires: [v] has type VFloat *)
  let unwrap v =
    match v with
    | VFloat x -> x
    | _ -> failwith "This cannot occur - arithmetic.ml"

  let add (s : value list) =
    match s with
    | hd1::hd2::tl ->
      let (hd1', hd2') = (unwrap hd1, unwrap hd2) in
      VFloat (Float.add hd1' hd2')
    | _ -> failwith "InvalidInput"

  let subtract (s : value list) =
    match s with
    | hd1::hd2::tl ->
      let (hd1', hd2') = (unwrap hd1, unwrap hd2) in
      VFloat (Float.sub hd1' hd2')
    | _ -> failwith "InvalidInput"

  let multiply (s : value list) =
    match s with
    | hd1::hd2::tl ->
      let (hd1', hd2') = (unwrap hd1, unwrap hd2) in
      VFloat (Float.mul hd1' hd2')
    | _ -> failwith "InvalidInput"

  let divide (s : value list) =
    match s with
    | hd1::hd2::tl ->
      let (hd1', hd2') = (unwrap hd1, unwrap hd2) in
      VFloat (Float.div hd1' hd2')
    | _ -> failwith "InvalidInput"

  let exponentiation (s : value list) =
    match s with
    | hd1::hd2::tl ->
      let (hd1', hd2') = (unwrap hd1, unwrap hd2) in
      VFloat (hd1' ** hd2')
    | _ -> failwith "InvalidInput"

  let modulus (s : value list) =
    match s with
    | hd1::hd2::tl ->
      let (hd1', hd2') = (unwrap hd1, unwrap hd2) in
      VFloat (Stdlib.mod_float hd1' hd2')
    | _ -> failwith "InvalidInput"

  (** [log a b] computes the logarithm of [a] with base [b] *)
  let rec log (a : float) (b : float) =
    if a > 1. then 1.0 +. log (Float.div a b) b else 0.

  let logarithm (s : value list) =
    match s with
    | hd1::hd2::tl ->
      let (hd1', hd2') = (unwrap hd1, unwrap hd2) in
      VFloat (log hd1' hd2')
    | _ -> failwith "InvalidInput"

  let equal_to (s : value list) =
    match s with
    | hd1::hd2::tl ->
      let (hd1', hd2') = (unwrap hd1, unwrap hd2) in
      VFloat (if (hd1' = hd2') then 1.0 else 0.0)
    | _ -> failwith "InvalidInput"
end

module Arithmetic_CFU : CFU_sig = struct

  let operation_list = [
    ("+", Arithmetic_Functions.add);
    ("-", Arithmetic_Functions.subtract);
    ("*", Arithmetic_Functions.multiply);
    ("/", Arithmetic_Functions.divide);
    ("^", Arithmetic_Functions.exponentiation);
    ("%", Arithmetic_Functions.modulus);
    ("log", Arithmetic_Functions.logarithm);
    ("==", Arithmetic_Functions.equal_to)
  ]

end