action.ml 5.39 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
open Keyword

type t = 
    {
      expr	: IL.expr;
      keywords  : Keyword.KeywordSet.t;
      filenames : string list;
      pkeywords : Keyword.keyword Positions.located list
    }

let from_stretch s = 
  { 
    expr      = IL.ETextual s;
    filenames = [ s.Stretch.stretch_filename ];
15
    keywords  = Keyword.KeywordSet.of_list (List.map Positions.value s.Stretch.stretch_keywords);
16
17
18
19
    pkeywords = s.Stretch.stretch_keywords;
  }

let compose x a1 a2 = 
20
21
22
23
  (* 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. *)
24
  {
25
    expr      = IL.ELet ([ IL.PVar x, a1.expr ], a2.expr);
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
    keywords  = Keyword.KeywordSet.union a1.keywords a2.keywords;
    filenames = a1.filenames @ a2.filenames;
    pkeywords = a1.pkeywords @ a2.pkeywords;
  }

let rename_inlined_psym (psym, first_prod, last_prod) phi l =
  List.fold_left
    (fun (l, phi, (used1, used2)) pk ->
       match pk.Positions.value with
	 | Position (subject, where, flavor) ->
	     let (subject', where'), (used1, used2) = 
	       match subject, where with
		 | RightNamed s, w  -> 
		     (* In the host rule, $startpos(x) is changed 
			to $startpos(first_prod) (same thing for $endpos). *)
		     if s = psym then
		       match w with
			 | WhereStart -> first_prod, (true, used2)
			 | WhereEnd -> last_prod, (used1, true)
		     else 
POTTIER Francois's avatar
Typo.    
POTTIER Francois committed
46
		       (* Otherwise, we just take the renaming into account. *)
47
48
49
50
51
		       let s' = try 
			 List.assoc s phi
		       with Not_found -> s 
		       in
			 (RightNamed s', w), (used1, used2)
52
		 | Left, _ -> (subject, where), (used1, used2)
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
	     in
	     let from_pos = Keyword.posvar subject where flavor
	     and to_pos = Keyword.posvar subject' where' flavor in
	       (Positions.with_pos pk.Positions.position 
		  (Position (subject', where', flavor)) :: l,
		(if from_pos <> to_pos && not (List.mem_assoc from_pos phi) then 
		   (from_pos, to_pos) :: phi else phi),
		(used1, used2))

	 | _ -> pk :: l, phi, (used1, used2)
    )
    ([], phi, (false, false)) l

(* 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.
   
*)
let rename_pkeywords (psym, first_prod, last_prod) phi l = 
  List.fold_left (fun (l, phi, (used1, used2)) pk -> match pk.Positions.value with
	    | Position (subject, where, flavor) ->
		let (subject', where'), (used1, used2) = 
		  match subject, where with
		      (* $startpos is changed to $startpos(first_prod) in the 
			 inlined rule. *)
		    | Left, WhereStart -> first_prod, (true, used2)
		      (* Similarly for $endpos. *)
		    | Left, WhereEnd   -> last_prod, (used1, true)
		      (* $i cannot be combined with inlining. *)
		    | RightNamed s, w  -> 
			(* In the host rule, $startpos(x) is changed to 
			   to $startpos(first_prod) (same thing for $endpos). *)
			if s = psym then
			  match w with
			    | WhereStart -> first_prod, (true, used2)
			    | WhereEnd -> last_prod, (used1, true)
			else 
			  (* Otherwise, we just that the renaming into account. *)
			  let s' = try List.assoc s phi with Not_found -> s in
			    (RightNamed s', w), (used1, used2)
		in
		let from_pos = Keyword.posvar subject where flavor
		and to_pos = Keyword.posvar subject' where' flavor in
		  (Positions.with_pos pk.Positions.position 
		     (Position (subject', where', flavor)) :: l,
		   (if from_pos <> to_pos && not (List.mem_assoc from_pos phi) then 
		      (from_pos, to_pos) :: phi else phi), 
		   (used1, used2))

109
	    | _ -> pk :: l, phi, (used1, used2))
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
139
140
141
142
143
144
145
146
147
148
149

    ([], phi, (false, false)) l
		
let rename renaming_fun renaming_env phi a = 
  let pkeywords, phi, used_fg = renaming_fun renaming_env phi a.pkeywords in
  { a with 
      (* We use the let construct to rename without modification of the semantic
	 action code. *)
      expr = 
      IL.ELet (List.map (fun (x, x') -> (IL.PVar x, IL.EVar x')) phi, 
	       a.expr);

      (* Keywords related to positions are updated too. *)
      keywords = 
      List.fold_left 
	(fun acu pk -> Keyword.KeywordSet.add pk.Positions.value acu) 
	Keyword.KeywordSet.empty
	pkeywords;

      pkeywords = pkeywords
  }, used_fg

let rename_inlined_psym =
  rename rename_inlined_psym

let rename =
  rename rename_pkeywords

let to_il_expr action = 
  action.expr

let filenames action = 
  action.filenames

let keywords action = 
  action.keywords

let pkeywords action = 
  action.pkeywords

150
let print f action = 
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
  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)