action.ml 5.3 KB
Newer Older
1
2
open Keyword

3
type t = {
POTTIER Francois's avatar
POTTIER Francois committed
4

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
  (* 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;

  (* A list of keywords that appear in this semantic action, with their
     positions. This list is maintained only up to the well-formedness check in
     [PartialGrammar.check_keywords]. Thereafter, it is no longer used. So, the
     keyword-renaming functions do not bother to update it. *)
  pkeywords : keyword Positions.located 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. *)
27

POTTIER Francois's avatar
POTTIER Francois committed
28
29
30
let pkeywords_to_keywords pkeywords =
  KeywordSet.of_list (List.map Positions.value pkeywords)

31
let from_stretch s = 
POTTIER Francois's avatar
POTTIER Francois committed
32
  let pkeywords = s.Stretch.stretch_keywords in
33
34
35
  { 
    expr      = IL.ETextual s;
    filenames = [ s.Stretch.stretch_filename ];
POTTIER Francois's avatar
POTTIER Francois committed
36
    pkeywords = pkeywords;
37
    keywords  = pkeywords_to_keywords pkeywords;
38
39
  }

40
41
(* Composition, used during inlining. *)

42
let compose x a1 a2 = 
43
44
45
46
  (* 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. *)
47
  {
48
    expr      = IL.ELet ([ IL.PVar x, a1.expr ], a2.expr);
POTTIER Francois's avatar
POTTIER Francois committed
49
    keywords  = KeywordSet.union a1.keywords a2.keywords;
50
    filenames = a1.filenames @ a2.filenames;
51
    pkeywords = [] (* don't bother; already checked *)
52
53
  }

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

POTTIER Francois's avatar
POTTIER Francois committed
56
57
58
type sw =
  Keyword.subject * Keyword.where

59
type keyword_renaming =
POTTIER Francois's avatar
POTTIER Francois committed
60
61
  string * sw * sw

POTTIER Francois's avatar
POTTIER Francois committed
62
let rename_position_keyword_outer
63
64
65
66
67
68
69
70
71
72
    ((psym, first_prod, last_prod) : keyword_renaming)
    (subject, where) : sw =
  match subject, where with
  | Left, _ -> (subject, where)
  | RightNamed s, w ->
      assert (s = psym);
      match w with
      | WhereStart -> first_prod
      | WhereEnd   -> last_prod

POTTIER Francois's avatar
POTTIER Francois committed
73
let rename_position_keyword_inner
74
75
76
77
78
79
80
81
82
83
84
85
86
    ((psym, first_prod, last_prod) : keyword_renaming)
    (subject, where) : sw =
  match subject, where with
  (* $startpos is changed to $startpos(first_prod) in the 
       inlined rule. Similarly for $endpos. *)
  | Left, WhereStart -> first_prod
  | Left, WhereEnd   -> last_prod
  | RightNamed s, w ->
      assert (s = psym);
      match w with
      | WhereStart -> first_prod
      | WhereEnd   -> last_prod

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
let rename_keyword
    (f : keyword_renaming -> sw -> sw)
    ((psym, _, _) as renaming : keyword_renaming)
    phi
    keyword : keyword =
  match keyword with
  | SyntaxError -> SyntaxError
  | Position (subject, where, flavor) ->
    let (subject', where') = 
      match subject with
      | Left ->
          f renaming (subject, where)
      | RightNamed s ->
          if s = psym then
            f renaming (subject, where)
          else
          (* Otherwise, we just take the renaming into account. *)
	  let s' = try 
	    List.assoc s !phi
	  with Not_found ->
            s 
	  in
	  (RightNamed s', where)
    in
    let from_pos = Keyword.posvar subject where flavor
    and to_pos = Keyword.posvar subject' where' flavor in
    if from_pos <> to_pos && not (List.mem_assoc from_pos !phi) then
      phi := (from_pos, to_pos) :: !phi;
    Position (subject', where', flavor)

117
118
119
120
121
122
123
124
125
126
127
128
(* Rename the keywords related to position to handle the composition
   of semantic actions during non terminal inlining. 

   The first argument describes the context: 
   - [first_prod] is the first producer that starts the action's rule.
   - [last_prod] is the last one.
   For instance, if %inline rule r is A -> B C and rule r' is D -> E A F,
   then [first_prod] is B and [last_prod] is C. 
   If r is A -> and r' is unchanged. [first_prod] is E and [last_prod] is F.
   - [psym] is the producer that is being inlined.
   
*)
129
130
131
132

let rename f renaming phi a = 

  let keywords = a.keywords in
133
134
  let phi = ref phi in
  let keywords =
135
    KeywordSet.map (rename_keyword f renaming phi) keywords
136
  in
137
138
  let phi = !phi in

139
140
141
142
  { a with 
      (* We use the let construct to rename without modification of the semantic
	 action code. *)
      expr = 
143
      IL.ELet (List.map (fun (x, x') -> (IL.PVar x, IL.EVar x')) phi,
144
145
146
	       a.expr);

      (* Keywords related to positions are updated too. *)
147
148
149
      pkeywords = []; (* don't bother *)
      keywords  = keywords;
  }
150

POTTIER Francois's avatar
POTTIER Francois committed
151
152
let rename_outer =
  rename rename_position_keyword_outer
153

POTTIER Francois's avatar
POTTIER Francois committed
154
155
let rename_inner =
  rename rename_position_keyword_inner
156
157
158
159
160
161
162
163
164
165
166
167
168

let to_il_expr action = 
  action.expr

let filenames action = 
  action.filenames

let keywords action = 
  action.keywords

let pkeywords action = 
  action.pkeywords

169
let print f action = 
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
  let module P = Printer.Make (struct let f = f 
				      let locate_stretches = None 
			       end) 
  in
    P.expr action.expr

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

let has_leftstart action =
  KeywordSet.exists (function
    | Position (Left, WhereStart, _) ->
	true
    | _ ->
	false
  ) (keywords action)

let has_leftend action =
  KeywordSet.exists (function
    | Position (Left, WhereEnd, _) ->
	true
    | _ ->
	false
  ) (keywords action)