Source file operator.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
open Fmlib
open Common

type assoc =
  | Left
  | Right
  | No



type t =
  int * assoc (* Invariant: The same precedence leads to the same assoc
                 i.e. the precedence is the key to the operator group which
                 are considered equivalent. *)


let colon             = (30,   Right)
let arrow             = (40,   Right)
let assign            = (41,   No)
let lambda            = (42,   No)
let push_arg          = (45,   Left)
let pull_arg          = (46,   Right)
let relation          = (50,   No)
let addition          = (60,   Left)
let multiplication    = (61,   Left)
let exponentiation    = (62,   Right)
let unknown           = (100,  Left)
let application       = (200,  Left)


let map: (int * assoc) String_map.t
  =
  let open String_map in
  empty
  |> add "->" arrow
  |> add "=>" arrow
  |> add ":=" assign
  |> add ":"  colon
  |> add "|>" push_arg
  |> add "<|" pull_arg
  |> add "="  relation
  |> add "/=" relation
  |> add "<"  relation
  |> add ">"  relation
  |> add "<=" relation
  |> add ">=" relation
  |> add "+"  addition
  |> add "-"  addition
  |> add "*"  multiplication
  |> add "/"  multiplication
  |> add "^"  exponentiation


let of_string (op:string): t =
  match
    String_map.maybe_find op map
  with
  | None ->
     unknown

  | Some d ->
     d



let compare ((prec1,_): t) ((prec2,_): t): int =
  Stdlib.compare prec1 prec2


let precedence = fst

let associativity = snd


let needs_parens
      (lower: t option)
      (is_left:bool)
      (upper: t)
    : bool
  =
  match lower with
  | None ->
     false

  | Some (low_prec, low_assoc) ->
     let prec, assoc = upper
     in
     assert (prec <> low_prec || low_assoc = assoc);

     prec > low_prec
     || (prec = low_prec  (* because of the invariant lower and upper have the
                             same associativity. *)
         && (match assoc with
             | No -> true

             | Left ->
                not is_left

             | Right ->
                is_left))