action.ml 5.51 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
(******************************************************************************)
(*                                                                            *)
(*                                   Menhir                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
(*                                                                            *)
(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
(*  terms of the GNU General Public License version 2, as described in the    *)
(*  file LICENSE.                                                             *)
(*                                                                            *)
(******************************************************************************)

14 15
open Keyword

16
type t = {
17

18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
  (* The code for this semantic action. *)
  expr: IL.expr;

  (* The files where this semantic action originates. Via inlining,
     several semantic actions can be combined into one, so there can
     be several files. *)
  filenames: string list;

  (* The set of keywords that appear in this semantic action. They can be thought
     of as free variables that refer to positions. They must be renamed during
     inlining. *)
  keywords  : KeywordSet.t;

}

(* Creation. *)
34

35
let from_stretch s = {
36 37 38 39
  expr      = IL.ETextual s;
  filenames = [ s.Stretch.stretch_filename ];
  keywords  = KeywordSet.of_list s.Stretch.stretch_keywords
}
40

POTTIER Francois's avatar
POTTIER Francois committed
41 42 43 44 45 46
let from_il_expr e = {
  expr      = e;
  filenames = [];
  keywords  = KeywordSet.empty;
}

47 48 49 50 51 52 53 54 55
(* Defining a keyword in terms of other keywords. *)

let define keyword keywords f action =
  assert (KeywordSet.mem keyword action.keywords);
  { action with
    expr     = f action.expr;
    keywords = KeywordSet.union keywords (KeywordSet.remove keyword action.keywords)
  }

56 57
(* Composition, used during inlining. *)

58
let compose x a1 a2 =
59 60 61 62
  (* 2015/07/20: there used to be a call to [parenthesize_stretch] here,
     which would insert parentheses around every stretch in [a1]. This is
     not necessary, as far as I can see, since every stretch that represents
     a semantic action is already parenthesized by the lexer. *)
63
  {
64
    expr      = CodeBits.blet ([ IL.PVar x, a1.expr ], a2.expr);
65
    keywords  = KeywordSet.union a1.keywords a2.keywords;
66 67 68
    filenames = a1.filenames @ a2.filenames;
  }

POTTIER Francois's avatar
POTTIER Francois committed
69 70 71 72 73 74 75 76 77
(* Binding an OCaml pattern to an OCaml variable in a semantic action. *)

let bind p x a =
  {
    expr      = CodeBits.blet ([ p, IL.EVar x ], a.expr);
    keywords  = a.keywords;
    filenames = a.filenames;
  }

78 79
(* Substitutions, represented as association lists.
   In principle, no name appears twice in the domain. *)
80

81 82
type subst =
  (string * string) list
83

84
let apply (phi : subst) (s : string) : string =
85
  try
86 87
    List.assoc s phi
  with Not_found ->
88
    s
89

90 91
let apply_subject (phi : subst) (subject : subject) : subject =
  match subject with
92
  | Before
93
  | Left ->
94
      subject
95 96 97
  | RightNamed s ->
      RightNamed (apply phi s)

98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114
let extend x y (phi : subst ref) =
  assert (not (List.mem_assoc x !phi));
  if x <> y then
    phi := (x, y) :: !phi

(* Renaming of keywords, used during inlining. *)

type sw =
  Keyword.subject * Keyword.where

(* [rename_keyword f phi keyword] applies the function [f] to possibly change
   the keyword [keyword]. If [f] decides to change this keyword (by returning
   [Some _]) then this decision is obeyed. Otherwise, the keyword is renamed
   by the substitution [phi]. In either case, [phi] is extended with a
   renaming decision. *)

let rename_keyword (f : sw -> sw option) (phi : subst ref) keyword : keyword =
115
  match keyword with
116 117
  | SyntaxError ->
      SyntaxError
118
  | Position (subject, where, flavor) ->
119
      let subject', where' =
120 121 122 123 124 125 126 127 128 129 130 131
        match f (subject, where) with
        | Some (subject', where') ->
            subject', where'
        | None ->
            apply_subject !phi subject, where
      in
      extend
        (Keyword.posvar subject where flavor)
        (Keyword.posvar subject' where' flavor)
        phi;
      Position (subject', where', flavor)

132 133 134 135 136
(* [rename f phi a] applies to the semantic action [a] the renaming [phi] as
   well as the transformations decided by the function [f]. The function [f] is
   applied to each (not-yet-renamed) keyword and may decide to transform it, by
   returning [Some _], or to not transform it, by returning [None]. (In the
   latter case, [phi] still applies to the keyword.) *)
137

138
let rename f phi a =
139 140

  (* Rename all keywords, growing [phi] as we go. *)
141
  let keywords = a.keywords in
142
  let phi = ref phi in
143
  let keywords = KeywordSet.map (rename_keyword f phi) keywords in
144 145
  let phi = !phi in

146
  (* Construct a new semantic action, where [phi] is translated into
147 148 149
     a set of *simultaneous* [let] bindings. (We cannot use a series
     of nested [let] bindings, as that would cause a capture if the
     domain and codomain of [phi] have a nonempty intersection.) *)
150
  let phi = List.map (fun (x, y) -> IL.PVar x, IL.EVar y) phi in
151
  let expr = CodeBits.eletand (phi, a.expr) in
152

153
  {
154 155 156
    expr      = expr;
    filenames = a.filenames;
    keywords  = keywords;
157
  }
158

159
let to_il_expr action =
160 161
  action.expr

162
let filenames action =
163 164
  action.filenames

165
let keywords action =
166 167 168 169 170
  action.keywords

let has_syntaxerror action =
  KeywordSet.mem SyntaxError (keywords action)

171
let has_beforeend action =
172
  KeywordSet.mem (Position (Before, WhereEnd, FlavorPosition)) action.keywords