Source file test_calculator.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
module CP =
    Character.Make
        (Unit)                  (* No state needed. *)
        (Int)                   (* The parser returns a number. *)
        (String)                (* The possible semantic error. *)
open CP

let whitespace: int t =
    skip_zero_or_more (char ' ')

type addop = Plus  | Minus
type mulop = Times | Divide


let operator (c: char) (op: 'a): 'a t =
    map (fun _ -> op) (char c)


let addop: addop t =
    (* Parse an addition operator. *)
    let* op =
        operator '+' Plus </> operator '-' Minus
    in
    let* _ = whitespace in      (* strip whitespace *)
    return op


let mulop: mulop t =
    (* Parse a multiplication operator. *)
    let* op =
        operator '*' Times </> operator '/' Divide
    in
    let* _ = whitespace in      (* strip whitespace *)
    return op


let number: int t =
    (* Parse one number. *)
    let* v =
        one_or_more_fold_left
            (fun d -> return d)
            (fun v d -> 10 * v + d |> return)
            digit
    in
    let* _ = whitespace in      (* strip whitespace *)
    return v


let parenthesized (p: unit -> 'a t): 'a t =
    let* _ = char '(' in
    let* _ = whitespace in
    let* x = p () in
    let* _ = char ')' in
    let* _ = whitespace in
    return x


let rec expr (): int t =
    (* Parse a sum [a + b - c ...]. *)
    one_or_more_separated
        return
        (fun s op x ->
             match op with
             | Plus ->
                 s + x |> return
             | Minus ->
                 s - x |> return)
        (product ())
        addop

and atomic (): int t =
    number
    </>
    parenthesized expr


and factors (opnd1: int): int t =
    (* Parse the factors of a product. *)
    (
        let* op    = mulop in
        let* opnd2 = atomic ()
        in
        match op with
        | Times ->
            factors (opnd1 * opnd2)
        | Divide ->
            if opnd2 = 0 then
                fail "division by zero"
            else
                factors (opnd1 / opnd2)
    )
    </>
    return opnd1


and product (): int t =
    (* Parse a product [f1 * f2 / f3 ...]. *)
    let* n = atomic () in
    factors n



let calculator: Parser.t =
    make () (expr ())


let%test _ =
    let p = Parser.run_on_string "(1 + 2) * 6 / 2 -1" calculator in
    Parser.has_succeeded p
    &&
    Parser.final p = 8


let%test _ =
    let p = Parser.run_on_string "1 / 0" calculator in
    Parser.has_failed_semantic p