Source file `keyword.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
(******************************************************************************)
(*                                                                            *)
(*                                    Menhir                                  *)
(*                                                                            *)
(*   Copyright Inria. All rights reserved. This file is distributed under     *)
(*   the terms of the GNU Library General Public License version 2, with a    *)
(*   special exception on linking, as described in the file LICENSE.          *)
(*                                                                            *)
(******************************************************************************)

(* This module provides some type and function definitions
   that help deal with the keywords that we recognize within
   semantic actions. *)

(* ------------------------------------------------------------------------- *)
(* Types. *)

(* The user can request position information either at type
   [int] (a simple offset) or at type [Lexing.position]. *)

type flavor =
  | FlavorOffset
  | FlavorPosition
  | FlavorLocation

(* The user can request position information about the $start or $end
   of a symbol. Also, $symbolstart requests the computation of the
   start position of the first nonempty element in a production. *)

type where =
| WhereSymbolStart
| WhereStart
| WhereEnd

(* The user can request position information about a production's
   left-hand side or about one of the symbols in its right-hand
   side, which he can refer to by position or by name. *)

type subject =
  | Before
  | Left
  | RightNamed of string

(* Keywords inside semantic actions. They allow access to semantic
   values or to position information. *)

type keyword =
  | Position of subject * where * flavor

(* Constants. *)

let startpos =
  Position (Left, WhereStart, FlavorPosition) (* $startpos *)

let endpos =
  Position (Left, WhereEnd  , FlavorPosition) (* $endpos *)

(* ------------------------------------------------------------------------- *)
(* These auxiliary functions help map a [Position] keyword to the
   name of the variable that the keyword is replaced with. *)

let where = function
  | WhereSymbolStart ->
      "symbolstart"
  | WhereStart ->
      "start"
  | WhereEnd ->
      "end"

let subject = function
  | Before ->
      "__0_"
  | Left ->
      ""
  | RightNamed id ->
      Printf.sprintf "_%s_" id

let flavor = function
  | FlavorPosition ->
      "pos"
  | FlavorOffset ->
      "ofs"
  | FlavorLocation ->
      "loc"

let posvar s w f =
  match w, f with
  | _, (FlavorOffset | FlavorPosition) ->
      Printf.sprintf "_%s%s%s" (where w) (flavor f) (subject s)
  | WhereSymbolStart, FlavorLocation ->
      "_sloc"
  | WhereStart, FlavorLocation ->
      Printf.sprintf "_loc%s" (subject s)
  | _ ->
      assert false

let kposvar keyword =
  match keyword with
  | Position (s, w, f) ->
      posvar s w f

let print_subject = function
  | Before ->
      "($0)"
  | Left ->
      ""
  | RightNamed id ->
      Printf.sprintf "(%s)" id

let print keyword =
  match keyword with
  | Position (s, w, f) ->
      match w, f with
      | _, (FlavorOffset | FlavorPosition) ->
          Printf.sprintf "$%s%s%s" (where w) (flavor f) (print_subject s)
      | WhereSymbolStart, FlavorLocation ->
          "$sloc"
      | WhereStart, FlavorLocation ->
          Printf.sprintf "$loc%s" (print_subject s)
      | _ ->
          assert false

(* ------------------------------------------------------------------------- *)
(* Sets of keywords. *)

module KeywordSet = struct

  include Set.Make (struct
    type t = keyword
    let compare = compare
  end)

  let map f keywords =
    fold (fun keyword accu ->
      add (f keyword) accu
    ) keywords empty

end