1 | // $Source$ |
---|
2 | // $Revision: 759 $ |
---|
3 | // $Date: 2003-05-26 15:01:45 +0000 (Mon, 26 May 2003) $ |
---|
4 | |
---|
5 | $use "rfpc"; |
---|
6 | $use "rfp_compile"; |
---|
7 | $use "rfp_format"; |
---|
8 | $use "rfp_list"; |
---|
9 | $use "rfp_helper"; |
---|
10 | $use "rfp_vars"; |
---|
11 | |
---|
12 | $use Arithm Class StdIO Table; |
---|
13 | |
---|
14 | // transform only e.targets and leave all the rest as it is |
---|
15 | $func Transform (e.targets) e.Items = e.Items; |
---|
16 | |
---|
17 | // transform { A; } : { B; } into { A; } :: aux, aux : { B; } |
---|
18 | $func Unstick-Blocks e.Sentence = e.Sentence (e.Fe); |
---|
19 | |
---|
20 | $func Generate-In-Out-Vars (e.in) (e.out) e.branch = (e.in) (e.out) e.branch; |
---|
21 | |
---|
22 | // rename variables local for the {}-blocks |
---|
23 | //$func Rename-Vars s.num (e.upper-vars) (e.res-vars) e.Snt = e.new-Snt; |
---|
24 | $func Rename-Vars e = e; |
---|
25 | |
---|
26 | // is variable with e.QualifiedName in the e.vars list? |
---|
27 | //$func? Old-Var? e.vars (s t (e.QualifiedName)) = ; |
---|
28 | $func? Old-Var? e = e; |
---|
29 | |
---|
30 | //$func Rename s.num (s.tag t.p (e.QualifiedName)) = |
---|
31 | // (s.tag t.p ("ren" e.QualifiedName s.num)); |
---|
32 | $func Rename e = e; |
---|
33 | |
---|
34 | // build substitution for all occurrences of each e.var in e.Snt |
---|
35 | $func Build-Subst (e.vars) (e.substs) e.Snt = (e.patterns) (e.replacements); |
---|
36 | |
---|
37 | // build substitution for all occurrences of variable with the name t.n in e.Snt |
---|
38 | $func Var-Subst t.n t.s e.Snt = (e.patterns) (e.replacements); |
---|
39 | |
---|
40 | |
---|
41 | RFP-As2As-Transform e.Items = |
---|
42 | { <Lookup &RFP-Options ITEMS>;; } :: e.targets, |
---|
43 | <Transform (e.targets) e.Items>; |
---|
44 | |
---|
45 | Transform (e.targets) e.Items, { |
---|
46 | e.Items : t.item e.rest, { |
---|
47 | { |
---|
48 | e.targets : v = |
---|
49 | e.targets : e t.name e, |
---|
50 | t.item : (t t t t.name e);; |
---|
51 | }, |
---|
52 | t.item : (s.link s.tag t.pragma t.name (e.in) (e.out) (BRANCH t.p e.branch)) = |
---|
53 | <Unstick-Blocks e.branch> :: e.branch t, |
---|
54 | { |
---|
55 | <Format-Exp e.in> : e.in, <Format-Exp e.out> : e.out = |
---|
56 | <Generate-In-Out-Vars (e.in) (e.out) e.branch>; |
---|
57 | (e.in) (e.out) e.branch; |
---|
58 | } :: (e.in) (e.out) e.branch, |
---|
59 | <Rename-Vars 0 (<Vars e.in>) () e.branch> :: e.branch, |
---|
60 | (s.link s.tag t.pragma t.name (e.in) (e.out) (BRANCH t.p e.branch)); |
---|
61 | t.item; |
---|
62 | } :: t.item = |
---|
63 | t.item <Transform (e.targets) e.rest>;; |
---|
64 | }; |
---|
65 | |
---|
66 | /* |
---|
67 | * Next function gets use of the following proposition: |
---|
68 | * one can add (RESULT) term to the end of any sentence that isn't end in |
---|
69 | * (RESULT e.anything) and it won't change the result of program execution. |
---|
70 | * No, no, the proposition is WRONG!!! Such doings change the semantics of "=". |
---|
71 | * |
---|
72 | * The function returns the sentence with all { A; } : { B; } constructions |
---|
73 | * turned into { A; } :: aux, aux : { B; } ones and format of the last Re of |
---|
74 | * the sentence. |
---|
75 | */ |
---|
76 | Unstick-Blocks e.Sentence, e.Sentence : eL e.Snt, e.Snt : \{ |
---|
77 | (s.block t.Pragma e.branches) eR, s.block : \{ BLOCK; BLOCK?; } = |
---|
78 | e.branches () () $iter { |
---|
79 | e.branches : (BRANCH t.p e.branch) e.rest, |
---|
80 | <Unstick-Blocks e.branch> :: e.new-branch (e.Fe), |
---|
81 | { e.Fe : FAIL; (e.Fe); } :: e.Fe, |
---|
82 | e.rest (e.br (BRANCH t.p e.new-branch)) (e.Fes e.Fe); |
---|
83 | } :: e.branches (e.br) (e.Fes), |
---|
84 | e.branches : /*empty*/ = |
---|
85 | { |
---|
86 | eR : \{ |
---|
87 | (BLOCK t (BRANCH t (LEFT e) e) e) e; |
---|
88 | (BLOCK t (BRANCH t (RIGHT e) e) e) e; |
---|
89 | (BLOCK? t (BRANCH t (LEFT e) e) e) e; |
---|
90 | (BLOCK? t (BRANCH t (RIGHT e) e) e) e; |
---|
91 | } = |
---|
92 | <Gener-Var-Indices 1 (<MSG e.Fes>) "aux" "block"> :: e.aux s, |
---|
93 | eL (s.block t.Pragma e.br) (FORMAT e.aux) |
---|
94 | (RESULT e.aux) <Unstick-Blocks eR>; |
---|
95 | eR : /*empty*/ = |
---|
96 | eL (s.block t.Pragma e.br) (<MSG e.Fes>); |
---|
97 | eL (s.block t.Pragma e.br) <Unstick-Blocks eR>; |
---|
98 | }; |
---|
99 | (RESULT t.Pragma e.Re) = |
---|
100 | eL (RESULT t.Pragma e.Re) (<Format-Exp e.Re>); |
---|
101 | (ITER (BRANCH t.p1 e.body) t.IterVars (BRANCH t.p2 e.condition)) = |
---|
102 | <Unstick-Blocks e.body> :: e.body t, |
---|
103 | <Unstick-Blocks e.condition> :: e.condition (e.Format), |
---|
104 | eL (ITER (BRANCH t.p1 e.body) t.IterVars (BRANCH t.p2 e.condition)) (e.Format); |
---|
105 | (TRY (BRANCH t.p1 e.TrySnt) e.NOFAIL t.CatchBlock) = |
---|
106 | <Unstick-Blocks e.TrySnt> :: e.TrySnt t.Try-Fe, |
---|
107 | <Unstick-Blocks t.CatchBlock> :: e.CatchBlock t.Catch-Fe, |
---|
108 | eL (TRY (BRANCH t.p1 e.TrySnt) e.NOFAIL e.CatchBlock) (<MSG t.Try-Fe t.Catch-Fe>); |
---|
109 | (FAIL e) = e.Sentence (FAIL); |
---|
110 | (ERROR t.Pragma) eR = |
---|
111 | <Unstick-Blocks eR> :: eR t, |
---|
112 | eL (ERROR t.Pragma) eR (FAIL); |
---|
113 | }; |
---|
114 | |
---|
115 | /* |
---|
116 | * Generate variable names for input and output function parameters. Change |
---|
117 | * e.Sentence so that it doesn't begin with pattern. |
---|
118 | */ |
---|
119 | Generate-In-Out-Vars (e.in) (e.out) e.Sentence, { |
---|
120 | /* |
---|
121 | * If input PAlt of a function is a sentence (not a block), format of |
---|
122 | * input pattern coincides t.InputFormat, and all variables in input |
---|
123 | * pattern have different indexes then we can drop the pattern and define |
---|
124 | * function as |
---|
125 | * func (Fname (pattern_vars) (res_..., res_..., ...)) |
---|
126 | * where pattern_vars means variables used in the pattern. |
---|
127 | */ |
---|
128 | e.Sentence : \{ |
---|
129 | (LEFT t e.Pe) e.Snt = (e.Pe) e.Snt; |
---|
130 | (RIGHT t e.Pe) e.Snt = (e.Pe) e.Snt; |
---|
131 | } :: (e.Pe) e.Snt = |
---|
132 | { |
---|
133 | <Format-Exp e.Pe> : e.in, // FIXME: here should be checked format equality |
---|
134 | <Vars e.Pe> :: e.args, |
---|
135 | # \{ e.args : e (e t1) e (e t1) e; } = |
---|
136 | (e.Pe) e.Snt; |
---|
137 | <Gener-Var-Indices 1 (e.in) "arg"> :: e.in-expr s = |
---|
138 | (e.in-expr) (RESULT (PRAGMA) e.in-expr) e.Sentence; |
---|
139 | }; |
---|
140 | /* |
---|
141 | * Else if we have real PAlt then we can do that transformation with each |
---|
142 | * branch. Input parameters for the function will be arg_1...arg_N. If |
---|
143 | * first pattern in the branch satisfies the conditions then drop it out |
---|
144 | * and rename variables in the branch to arg_1...arg_N instead of pattern |
---|
145 | * variables. |
---|
146 | */ |
---|
147 | e.Sentence : (s.block t.Pragma e.branches) e.Snt = |
---|
148 | <Gener-Var-Indices 1 (e.in) "arg"> :: e.in-expr s, |
---|
149 | <Vars e.in-expr> :: e.in-vars, |
---|
150 | (/*e.br*/) e.branches $iter { |
---|
151 | e.branches : (BRANCH t.p (s.dir t.pp e.Pe) e.br-snt) e.rest, { |
---|
152 | <Format-Exp e.Pe> : e.in, // FIXME: here should be checked format equality |
---|
153 | <Vars e.Pe> :: e.vars, |
---|
154 | # \{ e.vars : e (e t1) e (e t1) e; } = |
---|
155 | <Build-Subst (e.vars) (e.in-vars) e.br-snt> :: (e.pats) (e.repls), |
---|
156 | (e.br (BRANCH t.p <Subst (e.pats) (e.repls) e.br-snt>)) e.rest; |
---|
157 | (e.br (BRANCH t.p (RESULT (PRAGMA) e.in-expr) (s.dir t.pp e.Pe) e.br-snt)) |
---|
158 | e.rest; |
---|
159 | }; |
---|
160 | } :: (e.br) e.branches, |
---|
161 | e.branches : /*empty*/ = |
---|
162 | (e.in-expr) (s.block t.Pragma e.br) e.Snt; |
---|
163 | /* |
---|
164 | * Else sentence already hasn't begun with pattern, so left it as it is. |
---|
165 | * It can be only if e.in and e.out are both empty. |
---|
166 | */ |
---|
167 | //! (e.in) e.Sentence; |
---|
168 | } :: (e.in) e.Sentence = |
---|
169 | // <Gener-Var-Indices 1 (e.out) "res"> :: e.out s, |
---|
170 | (e.in) (e.out) e.Sentence; |
---|
171 | |
---|
172 | /* |
---|
173 | * Each {}-block is seen as inlined function. e.upper-vars and e.res-vars are |
---|
174 | * correspondingly input and output parameters for that function. e.Snt is its |
---|
175 | * body. |
---|
176 | * Rename all variables local for inlined function, for those to be |
---|
177 | * distinguishable from the outer world when the function is inlined in |
---|
178 | * imperative language. |
---|
179 | */ |
---|
180 | Rename-Vars s.num (e.upper-vars) (e.res-vars) e.Snt = |
---|
181 | (e.upper-vars) (/*e.new-Snt*/) e.Snt $iter { |
---|
182 | e.Snt : t.Statement e.rest, { |
---|
183 | /* |
---|
184 | * If we meet a pattern then add each unknown variable from it to |
---|
185 | * the list and rename local variables which intersect with out |
---|
186 | * parameters of the block. |
---|
187 | */ |
---|
188 | t.Statement : \{ |
---|
189 | (LEFT t e.Pe) = e.Pe; |
---|
190 | (RIGHT t e.Pe) = e.Pe; |
---|
191 | } :: e.Pe = |
---|
192 | <Split &Old-Var? e.res-vars (<Vars e.Pe>)> :: (e.old-vars) (e.new-vars), |
---|
193 | <Map &Rename s.num (e.old-vars)> :: e.renames, |
---|
194 | <Build-Subst (e.old-vars) (e.renames) e.Snt> :: (e.pats) (e.repls), |
---|
195 | <Subst (e.pats) (e.repls) e.Snt> : (s.tag t.p e.Pe1) e.rest-Snt, |
---|
196 | (<Or (e.vars) <Vars e.Pe1>>) (e.new-Snt (s.tag t.p e.Pe1)) e.rest-Snt; |
---|
197 | /* |
---|
198 | * If we meet format expression then for each already used |
---|
199 | * variable in it select new name by adding prefix "ren". |
---|
200 | */ |
---|
201 | t.Statement : (FORMAT t e.He) = |
---|
202 | <Split &Old-Var? e.upper-vars e.res-vars (<Vars e.He>)> |
---|
203 | :: (e.old-vars) (e.new-vars), |
---|
204 | <Map &Rename s.num (e.old-vars)> :: e.renames, |
---|
205 | <Build-Subst (e.old-vars) (e.renames) e.Snt> :: (e.pats) (e.repls), |
---|
206 | <Subst (e.pats) (e.repls) e.Snt> : (FORMAT t.p e.He1) e.rest-Snt, |
---|
207 | (<Or (e.vars) <Vars e.He1>>) (e.new-Snt (FORMAT t.p e.He1)) e.rest-Snt; |
---|
208 | /* |
---|
209 | * We shouldn't rename variable if its duplicate is appeared on |
---|
210 | * a parallel branch of the block. So process all branches |
---|
211 | * iteratively with the same list of variables (known before |
---|
212 | * block). |
---|
213 | */ |
---|
214 | t.Statement : (s.block t.Pragma e.branches), s.block : \{ BLOCK; BLOCK?; } = |
---|
215 | e.rest : { |
---|
216 | (LEFT t e.Pe) e = <Vars e.Pe>; |
---|
217 | (RIGHT t e.Pe) e = <Vars e.Pe>; |
---|
218 | // (FORMAT t e.He) e = <Vars e.He>; |
---|
219 | /*empty*/ = e.res-vars; |
---|
220 | e = /*empty*/; |
---|
221 | } :: e.bl-res-vars, |
---|
222 | /* |
---|
223 | * Left as res-vars only variables which were unknown before |
---|
224 | * block. Those are local if meet in pattern and need |
---|
225 | * renaming. |
---|
226 | */ |
---|
227 | (/*e.brv*/) e.bl-res-vars $iter { |
---|
228 | e.bl-res-vars : e1 (e t.name) e2, e.vars : e (e t.name) e = |
---|
229 | (e.brv e1) e2; |
---|
230 | (e.brv e.bl-res-vars); |
---|
231 | } :: (e.brv) e.bl-res-vars, |
---|
232 | e.bl-res-vars : /*empty*/ = |
---|
233 | <Map &Rename-Vars <"+" s.num 1> (e.vars) (e.brv) (e.branches)> |
---|
234 | :: e.branches, |
---|
235 | (e.vars) (e.new-Snt (s.block t.Pragma e.branches)) e.rest; |
---|
236 | t.Statement : (BRANCH t.Pragma e.Sentence) = |
---|
237 | () (e.new-Snt (BRANCH t.Pragma |
---|
238 | <Rename-Vars s.num (e.upper-vars) (e.res-vars) e.Sentence>)); |
---|
239 | t.Statement : (ITER t.IterBody t.IterVars t.IterCondition) = |
---|
240 | <Rename-Vars s.num (e.upper-vars) () t.IterVars t.IterBody> : t t.NewBody, |
---|
241 | <Rename-Vars s.num (e.upper-vars) (e.res-vars) t.IterVars t.IterCondition> |
---|
242 | :: e.IterCondition, |
---|
243 | () (e.new-Snt (ITER t.NewBody e.IterCondition)); |
---|
244 | t.Statement : (TRY t.TryBranch e.NOFAIL t.Catch) = |
---|
245 | <Rename-Vars s.num (e.upper-vars) (e.res-vars) t.TryBranch> :: e.TryBranch, |
---|
246 | <Rename-Vars s.num (e.upper-vars) (e.res-vars) t.Catch> :: e.Catch, |
---|
247 | () (e.new-Snt (TRY e.TryBranch e.NOFAIL e.Catch)); |
---|
248 | /* |
---|
249 | * Else proceed with the rest. |
---|
250 | */ |
---|
251 | (e.vars) (e.new-Snt t.Statement) e.rest; |
---|
252 | }; |
---|
253 | } :: (e.vars) (e.new-Snt) e.Snt, |
---|
254 | e.Snt : /*empty*/ = |
---|
255 | e.new-Snt; |
---|
256 | |
---|
257 | Old-Var? e.vars (s t (e.QualifiedName)) = e.vars : e (s t (e.QualifiedName)) e; |
---|
258 | |
---|
259 | Rename s.num (s.tag t.p (e.QualifiedName s.last)), { |
---|
260 | <Int? s.last> = (s.tag t.p ("renew" e.QualifiedName s.last s.num)); |
---|
261 | (s.tag t.p ("ren" e.QualifiedName s.last s.num)); |
---|
262 | }; |
---|
263 | |
---|
264 | /* |
---|
265 | * Build substitution for all occurrences of each e.var in e.Snt. |
---|
266 | */ |
---|
267 | Build-Subst { |
---|
268 | ((s t t.name) e.vars) ((s t t.s) e.substs) e.Snt = |
---|
269 | <Var-Subst t.name t.s e.Snt> :: (e.var-pats) (e.var-repls), |
---|
270 | <Build-Subst (e.vars) (e.substs) e.Snt> :: (e.pats) (e.repls), |
---|
271 | (e.var-pats e.pats) (e.var-repls e.repls); |
---|
272 | () () e = () (); |
---|
273 | }; |
---|
274 | |
---|
275 | /* |
---|
276 | * Build substitution for all occurrences of variable with the name t.n in e.Snt. |
---|
277 | */ |
---|
278 | Var-Subst t.n t.s e.Snt, { |
---|
279 | e.Snt : t.Statement e.rest, { |
---|
280 | t.Statement : \{ |
---|
281 | (SVAR t.p t.name) = SVAR t.p t.name; |
---|
282 | (TVAR t.p t.name) = TVAR t.p t.name; |
---|
283 | (VVAR t.p t.name) = VVAR t.p t.name; |
---|
284 | (EVAR t.p t.name) = EVAR t.p t.name; |
---|
285 | } :: s.tag t.p t.name, |
---|
286 | { |
---|
287 | t.name : t.n = ((s.tag t.p t.name)) (((s.tag t.p t.s))); |
---|
288 | () (); |
---|
289 | }; |
---|
290 | t.Statement : (expr) = <Var-Subst t.n t.s expr>; |
---|
291 | () (); |
---|
292 | } :: (e.st-pats) (e.st-repls), |
---|
293 | <Var-Subst t.n t.s e.rest> :: (e.pats) (e.repls), |
---|
294 | (e.st-pats e.pats) (e.st-repls e.repls); |
---|
295 | () (); |
---|
296 | }; |
---|
297 | |
---|
298 | |
---|
299 | /////////////////////////// Varibles Using Analysis ///////////////////////// |
---|
300 | // |
---|
301 | //$func Post-Comp (e.used-vars) e.comp-func = (e.used-vars) e.result-func; |
---|
302 | // |
---|
303 | //Post-Comp (e.used-vars) e.comp-func, e.comp-func : { |
---|
304 | // /* |
---|
305 | // * As well as "Used" shouldn't be "Declare" statements added? |
---|
306 | // */ |
---|
307 | // e.something (Used e.vars) = |
---|
308 | // <Post-Comp (<Or (e.used-vars) e.vars>) e.something>; |
---|
309 | // e.something (If-used (e.vars) e.statements), { |
---|
310 | // <Split &Elem? e.vars (e.used-vars)> : (v.true-used) (e.yet-not-used) = |
---|
311 | // <Post-Comp (v.true-used) e.statements> :: (e.expr-vars) e.expr, |
---|
312 | // <Post-Comp (<Or (e.yet-not-used) e.expr-vars>) e.something> e.expr; |
---|
313 | // <Post-Comp (e.used-vars) e.something>; |
---|
314 | // }; |
---|
315 | // e.something (e.expr) = |
---|
316 | // <Post-Comp (e.used-vars) e.expr> :: (e.expr-vars) e.expr, |
---|
317 | // <Post-Comp (e.expr-vars) e.something> (e.expr); |
---|
318 | // e.something s.symbol = |
---|
319 | // <Post-Comp (e.used-vars) e.something> s.symbol; |
---|
320 | // /*empty*/ = (e.used-vars); |
---|
321 | //}; |
---|
322 | |
---|
323 | |
---|
324 | /////////////////////////// Static Clash Analysis /////////////////////////// |
---|
325 | // |
---|
326 | //$func? Split-Clashes (e.clashes) e.Snt = |
---|
327 | // (e.greater) (e.less) (e.hards) (e.clashes) e.Snt; |
---|
328 | // |
---|
329 | //$func? Improve-Clash (e.Re) (s.dir e.Pe) (e1) (e2) e.Snt = e.clashes (e.Snt); |
---|
330 | // |
---|
331 | //$func? Self-Occur (e.Re) e.Pe = e; |
---|
332 | // |
---|
333 | //$func Cyclic e.expr = e.cyclic-vars; |
---|
334 | // |
---|
335 | //$func Hard e.expr = e.hard-part; |
---|
336 | // |
---|
337 | //$func Exchange (e.var-holder) (e.new-expr) e.clashes (e.Snt) = |
---|
338 | // e.clashes (e.Snt); |
---|
339 | // |
---|
340 | //$func Exchange-Exp (e.change) (e1) (e2) e.Snt = (e1) (e2) e.Snt; |
---|
341 | // |
---|
342 | //$func Minimize (e.expr) (e.clashes) e.Snt = (e.clashes) (e.less) e.Snt; |
---|
343 | // |
---|
344 | //$func? Intersect s.k (e.l) s.m (e.n) = s.x (e.y); |
---|
345 | // |
---|
346 | //$func Min-Length e.expr = s.min-length; |
---|
347 | // |
---|
348 | //$func Max-Length e.expr = e.max-length; |
---|
349 | // |
---|
350 | //$func? Add-Less-Ineq (e.vars s.len) (e.clashes1) (e.clashes2) e.Snt = |
---|
351 | // (e.clashes1) (e.clashes2) e.Snt; |
---|
352 | // |
---|
353 | //$func? Add-Greater-Ineq (e.vars s.len) (e.clashes1) (e.clashes2) e.Snt = |
---|
354 | // (e.clashes1) (e.clashes2) e.Snt; |
---|
355 | // |
---|
356 | //$func Get-Min e.vars = s.min; |
---|
357 | // |
---|
358 | //$func Get-Max e.vars = e.max; |
---|
359 | // |
---|
360 | //$func Mults e.vars = e.mults; |
---|
361 | // |
---|
362 | //$func Mark-Unw-Hard (e.vars) e.clashes = e.clashes; |
---|
363 | // |
---|
364 | //$func Ceil s1 s2 = s; |
---|
365 | // |
---|
366 | //$func? Match-Exp (e.Re) e.Pe = s.left s.right; |
---|
367 | // |
---|
368 | //$func? Match e.clash = ; |
---|
369 | // |
---|
370 | //$func? Match-Term t.Rt t.Pt e.clashes = e.clashes; |
---|
371 | // |
---|
372 | //$func? Match-Cyclic (e.Re) (e.Pe) e.clashes = e.clashes; |
---|
373 | // |
---|
374 | //$func Granulate e.expr = e.expr; |
---|
375 | // |
---|
376 | //$func? Left-Exp s.left s.len e.expr = (e.expr) e.change; |
---|
377 | // |
---|
378 | //$func? Right-Exp s.right s.len e.expr = (e.expr) e.change; |
---|
379 | // |
---|
380 | //$func? Middle-Exp s.left s.right e.expr = (e.expr) e.change; |
---|
381 | // |
---|
382 | *$func Comp-Pattern t.Pattern e.Snt = e.asail-Snt; |
---|
383 | * |
---|
384 | *Comp-Pattern (s.dir e.PatternExp) e.Sentence = |
---|
385 | * <Norm-Vars (<Vars e.PatternExp>) (s.dir e.PatternExp) e.Sentence> |
---|
386 | * : t t.Pattern e.Snt, |
---|
387 | *// (Unwatched (<? &Last-Re>) t.Pattern) e.Snt $iter { |
---|
388 | * /* |
---|
389 | * * Uncomment previous line and delete next one to activate Split-Clashes |
---|
390 | * * function |
---|
391 | * */ |
---|
392 | * ((<? &Last-Re>) t.Pattern) e.Snt $iter { |
---|
393 | * e.Snt : (RESULT e.Re) (s.d e.Pe) e = |
---|
394 | *// <WriteLN Matching (RESULT e.Re) (s.d e.Pe)>, |
---|
395 | * <Norm-Vars (<Vars e.Pe>) e.Snt> : t t.R t.P e.rest, |
---|
396 | *// (e.clashes Unwatched (e.Re) t.P) e.rest; |
---|
397 | * /* |
---|
398 | * * Uncomment previous line and delete next one to activate |
---|
399 | * * Split-Clashes function |
---|
400 | * */ |
---|
401 | * (e.clashes (e.Re) t.P) e.rest; |
---|
402 | * } :: (e.clashes) e.Snt, |
---|
403 | * # \{ |
---|
404 | * e.Snt : \{ |
---|
405 | * (RESULT e.Re) (LEFT e) e = e.Re; |
---|
406 | * (RESULT e.Re) (RIGHT e) e = e.Re; |
---|
407 | * } :: e.Re, |
---|
408 | * <Without-Calls? e.Re>; |
---|
409 | * } = |
---|
410 | * e.Snt : e.Current-Snt (Comp Sentence) e.Other-Snts = |
---|
411 | * <Comp-Sentence () e.Other-Snts> :: e.asail-Others, |
---|
412 | * { |
---|
413 | *// <Split-Clashes (e.clashes) e.Current-Snt> |
---|
414 | *// :: (e.greater) (e.less) (e.hards) (e.clashes) e.Current-Snt = |
---|
415 | *// <WriteLN "Hards: " e.hards>, |
---|
416 | *// <WriteLN "Less: " e.less>, |
---|
417 | *// <WriteLN "Greater: " e.greater>, |
---|
418 | *// <WriteLN "Current-Snt: " e.Current-Snt>, |
---|
419 | *//! <Comp-Clashes (e.clashes) |
---|
420 | *//! (e.Current-Snt (Comp Sentence)) e.Other-Snts> :: e.asail-Clashes, |
---|
421 | *// e.asail-Clashes (e.greater) $iter { |
---|
422 | *// e.greater : (e.vars s.num) e.rest, |
---|
423 | *// <Old-Vars e.vars> :: e.vars, // temporary step |
---|
424 | *// (IF ((INFIX ">=" ((LENGTH e.vars)) (s.num))) |
---|
425 | *// e.asail-Clashes |
---|
426 | *// ) (e.rest); |
---|
427 | *// } :: e.asail-Clashes (e.greater), |
---|
428 | *// e.greater : /*empty*/ = |
---|
429 | *// e.asail-Clashes (e.less) $iter { |
---|
430 | *// e.less : (e.vars s.num) e.rest, |
---|
431 | *// <Old-Vars e.vars> :: e.vars, // temporary step |
---|
432 | *// (IF ((INFIX "<=" ((LENGTH e.vars)) (s.num))) |
---|
433 | *// e.asail-Clashes |
---|
434 | *// ) (e.rest); |
---|
435 | *// } :: e.asail-Clashes (e.less), |
---|
436 | *// e.less : /*empty*/ = |
---|
437 | *// e.asail-Clashes (e.hards) $iter { |
---|
438 | *// e.hards : (e.Re) (e.Pe) e.rest, |
---|
439 | *// <Old-Vars e.Re> :: e.Re, // temporary step |
---|
440 | *// <Old-Vars e.Pe> :: e.Pe, // temporary step |
---|
441 | *// (IF ((INFIX "==" (e.Re) (e.Pe))) e.asail-Clashes) (e.rest); |
---|
442 | *// } :: e.asail-Clashes (e.hards), |
---|
443 | *// e.hards : /*empty*/ = |
---|
444 | *//! e.asail-Clashes e.asail-Others; |
---|
445 | * e.asail-Others; |
---|
446 | *// <Comp-Sentence () e.Other-Snts>; |
---|
447 | * }; |
---|
448 | // |
---|
449 | //Split-Clashes (e.clashes) e.Snt = |
---|
450 | // e.clashes (e.Snt) () () () $iter e.clashes : { |
---|
451 | // e1 Unwatched (e.Re) (s.dir e.Pe) e2, { \? |
---|
452 | // \{ |
---|
453 | // \{ |
---|
454 | // <Self-Occur (e.Re) e.Pe> : { |
---|
455 | // Occur e.vars = |
---|
456 | // <Minimize (e.vars) (e1 e2) e.Snt> |
---|
457 | // :: (e.clashes) (e.new-less) e.Snt, |
---|
458 | // e.clashes (e.Snt) |
---|
459 | // (e.greater) (e.less e.new-less) (e.hards); |
---|
460 | // /*empty*/ \! $fail; |
---|
461 | // }; |
---|
462 | // <Self-Occur (e.Pe) e.Re> : { |
---|
463 | // Occur e.vars = |
---|
464 | // <Minimize (e.vars) (e1 e2) e.Snt> |
---|
465 | // :: (e.clashes) (e.new-less) e.Snt, |
---|
466 | // e.clashes (e.Snt) |
---|
467 | // (e.greater) (e.less e.new-less) (e.hards); |
---|
468 | // /*empty*/ \! $fail; |
---|
469 | // }; |
---|
470 | // }; |
---|
471 | // <Vars e.Re> : /*empty*/, \{ // e.Re is ground expression |
---|
472 | // <Vars e.Pe> : /*empty*/ \! // e.Pe is ground expression |
---|
473 | // $fail; |
---|
474 | // e.Pe : \{ |
---|
475 | // /* |
---|
476 | // * If e.Pe is symbol then e.Re should be a symbol and if |
---|
477 | // * e.Pe is "old" variable then we should remember clash |
---|
478 | // * "e.Re : e.Pe" as hard. |
---|
479 | // */ |
---|
480 | // (SVAR 1 (1) e.name) \! |
---|
481 | // e.Re : s, |
---|
482 | // { |
---|
483 | // <Known-Vars? (SVAR e.name)> = (e.Re) (e.Pe); |
---|
484 | // /*empty*/; |
---|
485 | // } :: e.new-hard, |
---|
486 | // <Exchange (e.Pe) (e.Re) e1 e2 (e.Snt)> |
---|
487 | // (e.greater) (e.less) (e.hards e.new-hard); |
---|
488 | // /* |
---|
489 | // * If e.Pe is parenthesized expression then e.Re should be |
---|
490 | // * parenthesized expression too and we can take parentheses |
---|
491 | // * off. |
---|
492 | // */ |
---|
493 | // (PAREN e.pat-expr) \! |
---|
494 | // e.Re : (PAREN e.re-expr), |
---|
495 | // e1 Unwatched (e.re-expr) (s.dir e.pat-expr) e2 |
---|
496 | // (e.Snt) (e.greater) (e.less) (e.hards); |
---|
497 | // /* |
---|
498 | // * If e.Pe is any other variable then length of e.Re (which |
---|
499 | // * can be zero) should belong to its range. If e.Pe is |
---|
500 | // * "old" variable and e.Re is empty expression then we |
---|
501 | // * should remember that length of e.Pe is less or equal to |
---|
502 | // * 0 and if e.Re isn't empty then we should remember clash |
---|
503 | // * "e.Re : e.Pe" as hard. |
---|
504 | // */ |
---|
505 | // (s.var-tag s.m (e.n) e.name) \! |
---|
506 | // <Intersect s.m (e.n) <Length e.Re> (<Length e.Re>)> : e, |
---|
507 | // { |
---|
508 | // <Known-Vars? (s.var-tag e.name)>, |
---|
509 | // { |
---|
510 | // e.Re : /*empty*/ = (e.Pe 0) (); |
---|
511 | // /*empty*/ ((e.Re) (e.Pe)); |
---|
512 | // }; |
---|
513 | // /*empty*/ (); |
---|
514 | // } :: e.new-less (e.new-hard), |
---|
515 | // <Exchange (e.Pe) (e.Re) e1 e2 (e.Snt)> |
---|
516 | // (e.greater) (e.less e.new-less) (e.hards e.new-hard); |
---|
517 | // }; |
---|
518 | // }; |
---|
519 | // <Vars e.Pe> : /*empty*/, e.Re : \{ |
---|
520 | // (SVAR 1 (1) e.name) \! |
---|
521 | // e.Pe : s, |
---|
522 | // { |
---|
523 | // <Known-Vars? (SVAR e.name)> = (e.Re) (e.Pe); |
---|
524 | // /*empty*/; |
---|
525 | // } :: e.new-hard, |
---|
526 | // <Exchange (e.Re) (e.Pe) e1 e2 (e.Snt)> |
---|
527 | // (e.greater) (e.less) (e.hards e.new-hard); |
---|
528 | // (PAREN e.re-expr) \! |
---|
529 | // e.Pe : (PAREN e.pe-expr), |
---|
530 | // e1 Unwatched (e.re-expr) (s.dir e.pe-expr) e2 |
---|
531 | // (e.Snt) (e.greater) (e.less) (e.hards); |
---|
532 | // (s.var-tag s.m (e.n) e.name) \! |
---|
533 | // <Intersect s.m (e.n) <Length e.Pe> (<Length e.Pe>)> : e, |
---|
534 | // { |
---|
535 | // <Known-Vars? (s.var-tag e.name)>, |
---|
536 | // { |
---|
537 | // e.Pe : /*empty*/ = (e.Re 0) (); |
---|
538 | // /*empty*/ ((e.Re) (e.Pe)); |
---|
539 | // }; |
---|
540 | // /*empty*/ (); |
---|
541 | // } :: e.new-less (e.new-hard), |
---|
542 | // <Exchange (e.Re) (e.Pe) e1 e2 (e.Snt)> |
---|
543 | // (e.greater) (e.less e.new-less) (e.hards e.new-hard); |
---|
544 | // }; |
---|
545 | // e.Re : \{ |
---|
546 | // (PAREN e.re-expr), e.Pe : \{ |
---|
547 | // (PAREN e.pe-expr) = |
---|
548 | // e1 Unwatched (e.re-expr) (s.dir e.pe-expr) e2 |
---|
549 | // (e.Snt) (e.greater) (e.less) (e.hards); |
---|
550 | // (SVAR e) \! |
---|
551 | // $fail; |
---|
552 | // (s.tag s.m (e.n) e.var-id) \! |
---|
553 | // e.var-id : e.NEW (e.QualifiedName), |
---|
554 | // <Intersect 1 (1) s.m (e.n)> :: e, |
---|
555 | // (s.tag 0 () NEW ("paren" e.QualifiedName)) :: t.new-var, |
---|
556 | // { |
---|
557 | // <Known-Vars? (s.tag e.var-id)> = |
---|
558 | // Watched (e.Pe) (s.dir (PAREN t.new-var)); |
---|
559 | // /*empty*/; |
---|
560 | // } :: e.new-clash, |
---|
561 | // <Exchange (e.Pe) ((PAREN t.new-var)) e1 ()> :: e1 t, |
---|
562 | // e.new-clash e1 Unwatched (e.re-expr) (s.dir t.new-var) |
---|
563 | // <Exchange (e.Pe) ((PAREN t.new-var)) e2 (e.Snt)> |
---|
564 | // (e.greater) (e.less) (e.hards); |
---|
565 | // }; |
---|
566 | // (SVAR 1 (1) e.name), e.Pe : \{ |
---|
567 | // s.ObjectSymbol = |
---|
568 | // { |
---|
569 | // <Known-Vars? (SVAR e.name)> = (e.Re) (e.Pe); |
---|
570 | // /*empty*/; |
---|
571 | // } :: e.new-hard, |
---|
572 | // <Exchange (e.Re) (e.Pe) e1 e2 (e.Snt)> |
---|
573 | // (e.greater) (e.less) (e.hards e.new-hard); |
---|
574 | // (PAREN e) \! |
---|
575 | // $fail; |
---|
576 | // (s.tag s.m (e.n) e.var-id) \! |
---|
577 | // <Intersect 1 (1) s.m (e.n)> :: e, |
---|
578 | // { |
---|
579 | // <Known-Vars? (s.tag e.var-id)>, { |
---|
580 | // <Known-Vars? (SVAR e.name)> = |
---|
581 | // ((e.Re) (e.Pe)) (); |
---|
582 | // () (Watched (e.Pe) (s.dir e.Re)); |
---|
583 | // }; |
---|
584 | // () (); |
---|
585 | // } :: (e.new-hard) (e.new-clash), |
---|
586 | // e.new-clash <Exchange (e.Pe) (e.Re) e1 e2 (e.Snt)> |
---|
587 | // (e.greater) (e.less) (e.hards e.new-hard); |
---|
588 | // }; |
---|
589 | // (s.tag s.m (e.n) e.var-id), TVAR VVAR EVAR : e s.tag e, \{ |
---|
590 | // e.Pe : (s.tag1 s.k (e.l) e.var-id1), |
---|
591 | // TVAR VVAR EVAR : e s.tag1 e \! |
---|
592 | // <Intersect s.m (e.n) s.k (e.l)> :: s.x (e.y), |
---|
593 | // { |
---|
594 | // <Known-Vars? (s.tag e.var-id)>, { |
---|
595 | // <Known-Vars? (s.tag1 e.var-id1)> = |
---|
596 | // (s.tag s.x (e.y) e.var-id) (e.Re) (e.Pe); |
---|
597 | // (s.tag s.x (e.y) e.var-id) /*empty*/; |
---|
598 | // }; |
---|
599 | // (s.tag1 s.x (e.y) e.var-id1) /*empty*/; |
---|
600 | // } :: t.new-var e.new-hards, |
---|
601 | // <Exchange (e.Re) (t.new-var) e1 e2 (e.Snt)> |
---|
602 | // :: e.clashes (e.Snt), |
---|
603 | // <Exchange (e.Pe) (t.new-var) e.clashes (e.Snt)> |
---|
604 | // (e.greater) (e.less) (e.hards e.new-hards); |
---|
605 | // }; |
---|
606 | // }; |
---|
607 | // e.Pe : \{ |
---|
608 | // (PAREN e.pe-expr), e.Re : \{ |
---|
609 | // (s.tag s.m (e.n) e.var-id) \! |
---|
610 | // e.var-id : e.NEW (e.QualifiedName), |
---|
611 | // <Intersect 1 (1) s.m (e.n)> :: e, |
---|
612 | // (s.tag 0 () NEW ("paren" e.QualifiedName)) :: t.new-var, |
---|
613 | // { |
---|
614 | // <Known-Vars? (s.tag e.var-id)> = |
---|
615 | // Watched (e.Re) (s.dir (PAREN t.new-var)); |
---|
616 | // /*empty*/; |
---|
617 | // } :: e.new-clash, |
---|
618 | // <Exchange (e.Re) ((PAREN t.new-var)) e1 ()> :: e1 t, |
---|
619 | // e.new-clash e1 Unwatched (t.new-var) (s.dir e.pe-expr) |
---|
620 | // <Exchange (e.Re) ((PAREN t.new-var)) e2 (e.Snt)> |
---|
621 | // (e.greater) (e.less) (e.hards); |
---|
622 | // }; |
---|
623 | // (SVAR 1 (1) e.name), e.Re : \{ |
---|
624 | // (s.tag s.m (e.n) e.var-id) \! |
---|
625 | // <Intersect 1 (1) s.m (e.n)> :: e, |
---|
626 | // { |
---|
627 | // <Known-Vars? (s.tag e.var-id)>, { |
---|
628 | // <Known-Vars? (SVAR e.name)> = |
---|
629 | // ((e.Re) (e.Pe)) (); |
---|
630 | // () (Watched (e.Re) (s.dir e.Pe)); |
---|
631 | // }; |
---|
632 | // () (); |
---|
633 | // } :: (e.new-hard) (e.new-clash), |
---|
634 | // e.new-clash <Exchange (e.Re) (e.Pe) e1 e2 (e.Snt)> |
---|
635 | // (e.greater) (e.less) (e.hards e.new-hard); |
---|
636 | // }; |
---|
637 | // }; |
---|
638 | // e.Re : t.Rt e.Re1, e.Pe : t.Pt e.Pe1, |
---|
639 | // <Min-Length t.Rt> :: s.rt-min, <Min-Length t.Pt> :: s.pt-min, |
---|
640 | // # \{ s.rt-min : 0; s.pt-min : 0; } = |
---|
641 | // { |
---|
642 | // <Left-Exp 0 s.rt-min t.Pt> (<Left-Exp 0 s.rt-min t.Rt>); |
---|
643 | // <Left-Exp 0 s.pt-min t.Rt> (<Left-Exp 0 s.pt-min t.Pt>); |
---|
644 | // } :: t e.change1 (t e.change2), |
---|
645 | // e1 Unwatched (e.Re) (e.Pe) :: e1, |
---|
646 | // <Exchange-Exp (e.change1) |
---|
647 | // <Exchange-Exp (e.change2) (e1) (e2) e.Snt>> |
---|
648 | // :: (e1) (e2) e.Snt, |
---|
649 | // { |
---|
650 | // e.change1 : (s.tag t.m t.n e.var-id) t.new-1 t.new-2, |
---|
651 | // <Known-Vars? (s.tag e.var-id)> = |
---|
652 | // Watched |
---|
653 | // ((s.tag t.m t.n e.var-id)) (s.dir t.new-1 t.new-2); |
---|
654 | // /*empty*/; |
---|
655 | // } :: e.new-clash1, |
---|
656 | // { |
---|
657 | // e.change2 : (s.tag t.m t.n e.var-id) t.new-1 t.new-2, |
---|
658 | // <Known-Vars? (s.tag e.var-id)> = |
---|
659 | // Watched |
---|
660 | // ((s.tag t.m t.n e.var-id)) (s.dir t.new-1 t.new-2); |
---|
661 | // /*empty*/; |
---|
662 | // } :: e.new-clash2, |
---|
663 | // e1 : e11 (t.Rt1 e.Re2) (t.Pt1 e.Pe2), |
---|
664 | // e.new-clash1 e.new-clash2 e11 (t.Rt1) (s.dir t.Pt1) |
---|
665 | // Unwatched (e.Re2) (s.dir e.Pe2) e2 |
---|
666 | // (e.Snt) (e.greater) (e.less) (e.hards); |
---|
667 | // e.Re : e.Re1 t.Rt, e.Pe : e.Pe1 t.Pt, |
---|
668 | // <Min-Length t.Rt> :: s.rt-min, <Min-Length t.Pt> :: s.pt-min, |
---|
669 | // # \{ s.rt-min : 0; s.pt-min : 0; } = |
---|
670 | // { |
---|
671 | // <Right-Exp 0 s.rt-min t.Pt> (<Right-Exp 0 s.rt-min t.Rt>); |
---|
672 | // <Right-Exp 0 s.pt-min t.Rt> (<Right-Exp 0 s.pt-min t.Pt>); |
---|
673 | // } :: t e.change1 (t e.change2), |
---|
674 | // e1 Unwatched (e.Re) (e.Pe) :: e1, |
---|
675 | // <Exchange-Exp (e.change1) |
---|
676 | // <Exchange-Exp (e.change2) (e1) (e2) e.Snt>> |
---|
677 | // :: (e1) (e2) e.Snt, |
---|
678 | // { |
---|
679 | // e.change1 : (s.tag t.m t.n e.var-id) t.new-1 t.new-2, |
---|
680 | // <Known-Vars? (s.tag e.var-id)> = |
---|
681 | // Watched |
---|
682 | // ((s.tag t.m t.n e.var-id)) (s.dir t.new-1 t.new-2); |
---|
683 | // /*empty*/; |
---|
684 | // } :: e.new-clash1, |
---|
685 | // { |
---|
686 | // e.change2 : (s.tag t.m t.n e.var-id) t.new-1 t.new-2, |
---|
687 | // <Known-Vars? (s.tag e.var-id)> = |
---|
688 | // Watched |
---|
689 | // ((s.tag t.m t.n e.var-id)) (s.dir t.new-1 t.new-2); |
---|
690 | // /*empty*/; |
---|
691 | // } :: e.new-clash2, |
---|
692 | // e1 : e11 (e.Re2 t.Rt1) (e.Pe2 t.Pt1), |
---|
693 | // e.new-clash1 e.new-clash2 e11 (e.Re2) (s.dir e.Pe2) |
---|
694 | // Unwatched (t.Rt1) (s.dir t.Pt1) e2 |
---|
695 | // (e.Snt) (e.greater) (e.less) (e.hards); |
---|
696 | // <Max-Length e.Re> : /*empty*/, <Max-Length e.Pe> : /*empty*/ \! |
---|
697 | // <Min-Length e.Re> :: s.re-min, |
---|
698 | // <Min-Length e.Pe> :: s.pe-min, |
---|
699 | // e1 Unwatched Hard (e.Re) (s.dir e.Pe) :: e1, |
---|
700 | // { |
---|
701 | // <"<" (s.re-min) (s.pe-min)> = |
---|
702 | // <Add-Greater-Ineq (<Cyclic e.Re> s.pe-min) |
---|
703 | // (e1) (e2) e.Snt>; |
---|
704 | // <">" (s.re-min) (s.pe-min)> = |
---|
705 | // <Add-Greater-Ineq (<Cyclic e.Pe> s.re-min) |
---|
706 | // (e1) (e2) e.Snt>; |
---|
707 | // (e1) (e2) e.Snt; |
---|
708 | // } :: (e1) (e2) e.Snt, |
---|
709 | // e1 e2 (e.Snt) (e.greater) (e.less) (e.hards); |
---|
710 | // { |
---|
711 | // <Max-Length e.Re> : s.re-max, { |
---|
712 | // <Max-Length e.Pe> : s.pe-max, { |
---|
713 | // <"<" (s.re-max) (s.pe-max)> = e.Pe s.re-max; |
---|
714 | // e.Re s.pe-max; |
---|
715 | // }; |
---|
716 | // e.Pe s.re-max; |
---|
717 | // }; |
---|
718 | // e.Re <Max-Length e.Pe>; |
---|
719 | // } : e.ineq s.max \! |
---|
720 | // <"-" s.max <Min-Length <Hard e.ineq>>> :: s.max, |
---|
721 | // <Cyclic e.ineq> :: e.cyclic, |
---|
722 | // <Add-Less-Ineq (e.cyclic s.max) |
---|
723 | // (e1 Unwatched Hard (e.Re) (s.dir e.Pe)) (e2) e.Snt> |
---|
724 | // :: (e1) (e2) e.Snt \? |
---|
725 | // { |
---|
726 | // e1 : e Unwatched Hard t t \! |
---|
727 | // <Min-Length e.Re> :: s.re-min, |
---|
728 | // <Min-Length e.Pe> :: s.pe-min, |
---|
729 | // { |
---|
730 | // <"<" (s.re-min) (s.pe-min)> = e.Re s.pe-min; |
---|
731 | // e.Pe s.re-min; |
---|
732 | // } :: e.ineq s.min, |
---|
733 | // <"-" s.min <Min-Length <Hard e.ineq>>> :: s.min, |
---|
734 | // <Cyclic e.ineq> :: e.cyclic, |
---|
735 | // <Add-Greater-Ineq (e.cyclic s.min) (e1) (e2) e.Snt> |
---|
736 | // :: (e1) (e2) e.Snt, |
---|
737 | // e1 e2 (e.Snt) (e.greater) (e.less) (e.hards); |
---|
738 | // e1 e2 (e.Snt) (e.greater) (e.less) (e.hards); |
---|
739 | // }; |
---|
740 | // }; |
---|
741 | // = <Print-Error Warning! Pattern (e.Re ' : ' e.Pe)>, $fail; |
---|
742 | // }; |
---|
743 | // e1 Unwatched Hard (e.Re) (s.dir e.Pe) e2, { |
---|
744 | // <Cyclic e.Re> : /*empty*/, { // e.Re is hard expression |
---|
745 | // <Improve-Clash (e.Re) (s.dir e.Pe) (e1) (e2) e.Snt> |
---|
746 | // (e.greater) (e.less) (e.hards); |
---|
747 | // <Print-Error Warning! Pattern (e.Re ' : ' e.Pe)> |
---|
748 | // = $fail; |
---|
749 | // }; |
---|
750 | //// <Cyclic e.Pe> : /*empty*/ = // e.Pe is hard expression |
---|
751 | //// <Improve-Clash (e.Pe) (e.Re) (e1) (e2) e.Snt> |
---|
752 | //// (e.greater) (e.less) (e.hards); |
---|
753 | // e1 (e.Re) (s.dir e.Pe) e2 (e.Snt) (e.greater) (e.less) (e.hards); |
---|
754 | // }; |
---|
755 | // e1 Watched t.Re t.Pe e2 = |
---|
756 | // e1 t.Re t.Pe e2 (e.Snt) (e.greater) (e.less) (e.hards); |
---|
757 | // } :: e.clashes (e.Snt) (e.greater) (e.less) (e.hards), |
---|
758 | //// <WriteLN Sp-Clashes e.clashes>, |
---|
759 | //// <WriteLN G <? &Greater-Ineqs>>, |
---|
760 | //// <WriteLN L <? &Less-Ineqs>>, |
---|
761 | // # \{ e.clashes : e s e; } = |
---|
762 | // (e.greater) (e.less) (e.hards) (e.clashes) e.Snt; |
---|
763 | // |
---|
764 | //Improve-Clash (e.Re) (s.dir e.Pe) (e1) (e2) e.Snt = |
---|
765 | //// <WriteLN Improve-Clash (e.Re) (s.dir e.Pe)>, |
---|
766 | // /* |
---|
767 | // * Find all non-empty hard parts in e.Pe and remember them in |
---|
768 | // * e.hard-parts. |
---|
769 | // */ |
---|
770 | // e.Pe : t.l e.right, |
---|
771 | // () (t.l) (e.right) <Cyclic e.right> $iter { |
---|
772 | // e.cyclic : t.var e.rest, |
---|
773 | // e.right : e.new-hard t.var e.new-right, { |
---|
774 | // e.new-hard : v = |
---|
775 | // (e.hard-parts |
---|
776 | // ((e.left) e.new-hard (t.var e.new-right)) |
---|
777 | // ) (e.left e.new-hard t.var) (e.new-right) e.rest; |
---|
778 | // (e.hard-parts) (e.left t.var) (e.new-right) e.rest; |
---|
779 | // }; |
---|
780 | // } :: (e.hard-parts) (e.left) (e.right) e.cyclic, |
---|
781 | // e.cyclic : /*empty*/ = |
---|
782 | //// <WriteLN Hard-parts e.hard-parts>, |
---|
783 | // /* |
---|
784 | // * For each hard part (or until some variables ranges are |
---|
785 | // * changed or some inequalitys are added) try to match it with |
---|
786 | // * corresponding part of e.Re. |
---|
787 | // */ |
---|
788 | // (e.hard-parts) |
---|
789 | // (e1 (e.Re) (s.dir e.Pe)) (e2) e.Snt $iter { |
---|
790 | // e.hard-parts : ((e.left-i) e.hard-i (e.right-i)) e.rest, |
---|
791 | // <Cyclic e.left-i> :: e.cyc-left, |
---|
792 | // <Hard e.left-i> :: e.hard-left, |
---|
793 | // <Reverse <Cyclic e.right-i>> :: e.cyc-right, |
---|
794 | // <Hard e.right-i> :: e.hard-right, |
---|
795 | // <Min-Length e.hard-left> :: s.left-len, |
---|
796 | // <Min-Length e.hard-right> :: s.right-len, |
---|
797 | // <"+" <Get-Min e.cyc-left> s.left-len> :: s.left-min, |
---|
798 | // <Get-Max e.cyc-left> : s.left-max, |
---|
799 | // <"+" s.left-max s.left-len> :: s.left-max, |
---|
800 | // <"+" <Get-Min e.cyc-right> s.right-len> :: s.right-min, |
---|
801 | // <Get-Max e.cyc-right> : s.right-max, |
---|
802 | // <"+" s.right-max s.right-len> :: s.right-max, |
---|
803 | // <Min-Length e.hard-i> :: s.hard-len, |
---|
804 | // <Min-Length e.Re> :: s.len, |
---|
805 | // <"-" s.len <"+" s.right-max s.hard-len>> :: s.left, |
---|
806 | // <"-" s.len <"+" s.left-max s.hard-len>> :: s.right, |
---|
807 | // <WriteLN Hard e.hard-i>, |
---|
808 | // <WriteLN Hard-len s.hard-len>, |
---|
809 | // <WriteLN Left-len s.left-len>, |
---|
810 | // <WriteLN Right-len s.right-len>, |
---|
811 | // <WriteLN Len s.len>, |
---|
812 | // <WriteLN Left s.left>, |
---|
813 | // <WriteLN Left-min s.left-min>, |
---|
814 | // <WriteLN Left-max s.left-max>, |
---|
815 | // <WriteLN Right s.right>, |
---|
816 | // <WriteLN Right-min s.right-min>, |
---|
817 | // <WriteLN Right-max s.right-max>, |
---|
818 | // { |
---|
819 | // s.left-min : s.left, s.right-min : s.right = |
---|
820 | // <Middle-Exp s.left s.right e.Re> :: (e.middle) e.change, |
---|
821 | // <WriteLN Middle-Exp e.middle>, |
---|
822 | // <Exchange-Exp (e.change) (e1) (e2) e.Snt> :: (e1) (e2) e.Snt, |
---|
823 | // <Match-Exp (e.middle) e.hard-i> :: s.new-left s.new-right, |
---|
824 | // <WriteLN Match-Exp s.new-left s.new-right>, |
---|
825 | // { |
---|
826 | // s.new-left : 0, s.new-right : 0 = |
---|
827 | // (e.rest) (e1) (e2) e.Snt; |
---|
828 | // /* |
---|
829 | // * If founded matchings are coinsided then split our |
---|
830 | // * clash into three new ones. |
---|
831 | // */ |
---|
832 | // <"+" s.hard-len <"+" s.new-left s.new-right>> |
---|
833 | // : s.len = |
---|
834 | // <"+" s.left s.new-left> :: s.left, |
---|
835 | // <"+" s.right s.new-right> :: s.right, |
---|
836 | // <Left-Exp s.left s.hard-len e.Re> :: (e.left-Re) e.change, |
---|
837 | // <Exchange-Exp (e.change) (e1) (e2) e.Snt> :: (e1) (e2) e.Snt, |
---|
838 | // Unwatched (e.left-Re) (s.dir e.hard-i) :: e.new-hard, |
---|
839 | // <Left-Exp 0 s.left e.Re> :: (e.left-Re) e.change, |
---|
840 | // <Exchange-Exp (e.change) (e1) (e2) e.Snt> :: (e1) (e2) e.Snt, |
---|
841 | // Unwatched (e.left-Re) (s.dir e.left-i) :: e.new-left, |
---|
842 | // <Right-Exp 0 s.right e.Re> :: (e.right-Re) e.change, |
---|
843 | // <Exchange-Exp (e.change) (e1) (e2) e.Snt> :: (e1) (e2) e.Snt, |
---|
844 | // Unwatched (e.right-Re) (s.dir e.right-i) :: e.new-right, |
---|
845 | // s.dir : { |
---|
846 | // LEFT = |
---|
847 | // e.new-hard e.new-left e.new-right; |
---|
848 | // RIGHT = |
---|
849 | // e.new-hard e.new-right e.new-left; |
---|
850 | // } :: e.new-clashes, |
---|
851 | // e1 : e1-new t t, |
---|
852 | // () (e1-new e.new-clashes) (e2) e.Snt; |
---|
853 | // /* |
---|
854 | // * Else we've got some new inequalites... |
---|
855 | // */ |
---|
856 | // = |
---|
857 | // <"+" s.left <"-" s.new-left s.left-len>> :: s.num, |
---|
858 | // <WriteLN NUM s.num>, |
---|
859 | // <Add-Greater-Ineq (e.cyc-left s.num) (e1) (e2) e.Snt> |
---|
860 | // :: (e1) (e2) e.Snt, |
---|
861 | // <"+" s.right <"-" s.new-right s.right-len>> :: s.num, |
---|
862 | // <WriteLN NUM s.num>, |
---|
863 | // <Add-Greater-Ineq (e.cyc-right s.num) (e1) (e2) e.Snt> |
---|
864 | // :: (e1) (e2) e.Snt, |
---|
865 | // <"-" s.len <"+" s.right <"+" s.new-right |
---|
866 | // <"+" s.hard-len s.left-len>>>> :: s.num, |
---|
867 | // <WriteLN NUM s.num>, |
---|
868 | // <Add-Less-Ineq (e.cyc-left s.num) (e1) (e2) e.Snt> |
---|
869 | // :: (e1) (e2) e.Snt, |
---|
870 | // <"-" s.len <"+" s.left <"+" s.new-left |
---|
871 | // <"+" s.hard-len s.right-len>>>> :: s.num, |
---|
872 | // <WriteLN NUM s.num>, |
---|
873 | // <Add-Less-Ineq (e.cyc-right s.num) (e1) (e2) e.Snt> |
---|
874 | // :: (e1) (e2) e.Snt, |
---|
875 | // (e.rest) (e1) (e2) e.Snt; |
---|
876 | // }; |
---|
877 | // /* |
---|
878 | // * At least one inequlity shurely will be added, so we'll go |
---|
879 | // * out of the $iter. |
---|
880 | // */ |
---|
881 | // = { |
---|
882 | // <"<" (s.left-min) (s.left)> = |
---|
883 | // <Add-Greater-Ineq (e.cyc-left s.left) (e1) (e2) e.Snt>; |
---|
884 | // (e1) (e2) e.Snt; |
---|
885 | // } :: (e1) (e2) e.Snt, { |
---|
886 | // <">" (s.left-min) (s.left)> = |
---|
887 | // <"-" s.len <"+" s.left-min <"+" s.hard-len s.right-len>>> |
---|
888 | // :: s.left, |
---|
889 | // <Add-Less-Ineq (e.cyc-right s.left) (e1) (e2) e.Snt>; |
---|
890 | // (e1) (e2) e.Snt; |
---|
891 | // } :: (e1) (e2) e.Snt, { |
---|
892 | // <"<" (s.right-min) (s.right)> = |
---|
893 | // <Add-Greater-Ineq (e.cyc-right s.right) (e1) (e2) e.Snt>; |
---|
894 | // (e1) (e2) e.Snt; |
---|
895 | // } :: (e1) (e2) e.Snt, { |
---|
896 | // <">" (s.right-min) (s.right)> = |
---|
897 | // <"-" s.len <"+" s.right-min <"+" s.hard-len s.left-len>>> |
---|
898 | // :: s.right, |
---|
899 | // <Add-Less-Ineq (e.cyc-left s.right) (e1) (e2) e.Snt>; |
---|
900 | // (e1) (e2) e.Snt; |
---|
901 | // } :: (e1) (e2) e.Snt, |
---|
902 | // () (e1) (e2) e.Snt; |
---|
903 | // }; |
---|
904 | // } :: (e.hard-parts) (e1) (e2) e.Snt, |
---|
905 | // \{ |
---|
906 | // e1 : \{ e Unwatched (e) (e); e Unwatched Hard (e) (e); }; |
---|
907 | // e.hard-parts : /*empty*/; |
---|
908 | // } = |
---|
909 | // e1 e2 (e.Snt); |
---|
910 | // |
---|
911 | ///* |
---|
912 | // * If occurrence of e.Pe is found in e.Re and it can be there then return |
---|
913 | // * variables which should be minimized. |
---|
914 | // * If found occurence of e.Re isn't legal then return empty expression. |
---|
915 | // * And return $fail if there are no occurences of e.Re in e.Pe. |
---|
916 | // */ |
---|
917 | //Self-Occur (e.Re) e.Pe, <WriteLN Occur (e.Re) e.Pe>, { |
---|
918 | // e.Re : e1 e.Pe e2 , { |
---|
919 | // <Min-Length e1 e2> : 0 = Occur e1 e2; |
---|
920 | // /*empty*/; |
---|
921 | // }; |
---|
922 | // e.Pe Not-Found $iter { |
---|
923 | // e.Pe : e (PAREN v.pe-expr) e, { |
---|
924 | // e.Re : e v.pe-expr e = Found; |
---|
925 | // v.pe-expr Not-Found; |
---|
926 | // }; |
---|
927 | // } :: e.Pe s.found?, |
---|
928 | // \{ |
---|
929 | // s.found? : Found = /*empty*/; |
---|
930 | // # \{ e.Pe : e (PAREN v) e; } = $fail; |
---|
931 | // }; |
---|
932 | //}; |
---|
933 | // |
---|
934 | //Cyclic e.expr = |
---|
935 | // () e.expr $iter { |
---|
936 | // e.expr : t1 e2, t1 : { |
---|
937 | // s.ObjectSymbol = /*empty*/; |
---|
938 | //// (REF t.name) = ??? |
---|
939 | // (PAREN e) = /*empty*/; |
---|
940 | // (s.var-tag s.m (e.n) e.var-id), # \{ s.m : e.n; } = t1; |
---|
941 | // t = /*empty*/; |
---|
942 | // } :: e.new-cyclic, |
---|
943 | // (e.cyclic e.new-cyclic) e2; |
---|
944 | // } :: (e.cyclic) e.expr, |
---|
945 | // e.expr : /*empty*/ = |
---|
946 | // e.cyclic; |
---|
947 | // |
---|
948 | //Hard e.expr = |
---|
949 | // () e.expr $iter { |
---|
950 | // e.expr : t1 e2, t1 : { |
---|
951 | // s.ObjectSymbol = t1; |
---|
952 | //// (REF t.name) = ??? |
---|
953 | // (PAREN e) = t1; |
---|
954 | // (s.var-tag s.m (e.n) e.var-id), # \{ s.m : e.n; } = /*empty*/; |
---|
955 | // t = t1; |
---|
956 | // } :: e.new-hard, |
---|
957 | // (e.hard e.new-hard) e2; |
---|
958 | // } :: (e.hard) e.expr, |
---|
959 | // e.expr : /*empty*/ = |
---|
960 | // e.hard; |
---|
961 | // |
---|
962 | ////Hard-Exp? e.expr = |
---|
963 | //// e.expr () $iter \{ |
---|
964 | //// <Cyclic e.expr> () $iter { |
---|
965 | //// e.cyclic : (s.tag t t e.var-id) e.rest, { |
---|
966 | //// <Known-Vars? (s.tag e.var-id)> = e.rest (e.num); |
---|
967 | //// e.rest (e.num I); |
---|
968 | //// }; |
---|
969 | //// } :: e.cyclic (e.num), |
---|
970 | //// <WriteLN Hard-Exp e.cyclic (e.num)>, |
---|
971 | //// \{ |
---|
972 | //// e.num : I I = $fail; |
---|
973 | //// e.cyclic : /*empty*/, { |
---|
974 | //// e.expr : e1 (PAREN e.paren) e2 = e.paren (e.watched e2); |
---|
975 | //// e.watched : e1 (PAREN e.paren) e2 = e.paren (e2); |
---|
976 | //// /*empty*/ (); |
---|
977 | //// }; |
---|
978 | //// }; |
---|
979 | //// } :: e.expr (e.watched), |
---|
980 | //// e.expr : /*empty*/; |
---|
981 | // |
---|
982 | //Exchange (e.var-holder) (e.new-expr) e.clashes (e.Snt) = |
---|
983 | // e.var-holder : t.var, |
---|
984 | // /* |
---|
985 | // * Mark containing t.var clashes as "Unwatched" and change t.var to |
---|
986 | // * t.new-var in them. |
---|
987 | // */ |
---|
988 | // () e.clashes $iter { |
---|
989 | // e.clashes : e.tag (e.Re) (e.Pe) e.rest, |
---|
990 | // { |
---|
991 | // e.tag : Watched = Watched; |
---|
992 | // Unwatched; |
---|
993 | // } :: s.watched?, |
---|
994 | // { |
---|
995 | // <Vars e.Re> <Vars e.Pe> : e t.var e = |
---|
996 | // (e.new-clashes |
---|
997 | // s.watched? <Subst (t.var) ((e.new-expr)) (e.Re) (e.Pe)> |
---|
998 | // ) e.rest; |
---|
999 | // (e.new-clashes e.tag (e.Re) (e.Pe)) e.rest; |
---|
1000 | // }; |
---|
1001 | // } :: (e.new-clashes) e.clashes, |
---|
1002 | // e.clashes : /*empty*/ = |
---|
1003 | // /* |
---|
1004 | // * Remove all inequalitys wich contain t.var. |
---|
1005 | // */ |
---|
1006 | // () <? &Greater-Ineqs> $iter { |
---|
1007 | // e.ineqs : t.ineq e.rest, |
---|
1008 | // { |
---|
1009 | // t.ineq : (e t.var e) = /*empty*/; |
---|
1010 | // t.ineq; |
---|
1011 | // } :: e.ineq, |
---|
1012 | // (e.new-ineqs e.ineq) e.rest; |
---|
1013 | // } :: (e.new-ineqs) e.ineqs, |
---|
1014 | // e.ineqs : /*empty*/ = |
---|
1015 | // <Store &Greater-Ineqs e.new-ineqs>, |
---|
1016 | // () <? &Less-Ineqs> $iter { |
---|
1017 | // e.ineqs : t.ineq e.rest, |
---|
1018 | // { |
---|
1019 | // t.ineq : (e t.var e) = /*empty*/; |
---|
1020 | // t.ineq; |
---|
1021 | // } :: e.ineq, |
---|
1022 | // (e.new-ineqs e.ineq) e.rest; |
---|
1023 | // } :: (e.new-ineqs) e.ineqs, |
---|
1024 | // e.ineqs : /*empty*/ = |
---|
1025 | // <Store &Less-Ineqs e.new-ineqs>, |
---|
1026 | // /* |
---|
1027 | // * Rename t.var in the rest of current sentence. |
---|
1028 | // */ |
---|
1029 | // t.var : (s.tag t t e.var-id), // temporary step |
---|
1030 | //// <Old-Vars e.new-expr> :: e.new-expr, // temporary step |
---|
1031 | // e.new-clashes (<Subst ((s.tag e.var-id)) ((e.new-expr)) e.Snt>); |
---|
1032 | // |
---|
1033 | //Exchange-Exp (e.change) (e1) (e2) e.Snt = |
---|
1034 | //{ |
---|
1035 | // e.change : t.old-1 t.new-1 t.new-2 e.change1 = |
---|
1036 | // <Exchange (t.old-1) (t.new-1 t.new-2) e1 ()> :: e1 t, |
---|
1037 | // <Exchange (t.old-1) (t.new-1 t.new-2) e2 (e.Snt)> :: e2 (e.Snt), |
---|
1038 | // { |
---|
1039 | // e.change1 : t.old-2 e.new-3 = |
---|
1040 | // <Exchange (t.old-2) (e.new-3) e1 ()> :: e1 t, |
---|
1041 | // <Exchange (t.old-2) (e.new-3) e2 (e.Snt)> :: e2 (e.Snt), |
---|
1042 | // (e1) (e2) e.Snt; |
---|
1043 | // (e1) (e2) e.Snt; |
---|
1044 | // }; |
---|
1045 | // (e1) (e2) e.Snt; |
---|
1046 | //}; |
---|
1047 | // |
---|
1048 | //Minimize (e.expr) (e.clashes) e.Snt = |
---|
1049 | // (e.expr) () e.clashes (e.Snt) $iter { |
---|
1050 | // e.expr : t.var e.rest, |
---|
1051 | // t.var : (s.tag t t e.var-id), |
---|
1052 | // { |
---|
1053 | // <Known-Vars? (s.tag e.var-id)> = (t.var 0); |
---|
1054 | // /*empty*/; |
---|
1055 | // } :: e.new-less, |
---|
1056 | // (e.rest) (e.less e.new-less) <Exchange (t.var) () e.clashes (e.Snt)>; |
---|
1057 | // } :: (e.expr) (e.less) e.clashes (e.Snt), |
---|
1058 | // e.expr : /*empty*/ = |
---|
1059 | // (e.clashes) (e.less) e.Snt; |
---|
1060 | // |
---|
1061 | //Intersect s.k (e.l) s.m (e.n) = |
---|
1062 | // { |
---|
1063 | // <"<" (s.k) (s.m)> = s.m; |
---|
1064 | // s.k; |
---|
1065 | // } :: s.x, |
---|
1066 | // { |
---|
1067 | // e.l e.n : /*empty*/ = /*empty*/; |
---|
1068 | // e.l : /*empty*/ = e.n; |
---|
1069 | // e.n : /*empty*/ = e.l; |
---|
1070 | // <"<" (e.n) (e.l)> = e.n; |
---|
1071 | // e.l; |
---|
1072 | // } :: e.y, |
---|
1073 | // \{ |
---|
1074 | // e.y : /*empty*/ = s.x (); |
---|
1075 | // <"<=" (s.x) (e.y)> = s.x (e.y); |
---|
1076 | // }; |
---|
1077 | // |
---|
1078 | //Min-Length e.expr = |
---|
1079 | // 0 e.expr $iter { |
---|
1080 | // e.expr : t1 e2, t1 : { |
---|
1081 | // s.ObjectSymbol = <"+" s.len 1>; |
---|
1082 | //// (REF t.name) = ??? |
---|
1083 | // (PAREN e) = <"+" s.len 1>; |
---|
1084 | // (s.var-tag s.m (e.n) e.var-id) = <"+" s.len s.m>; |
---|
1085 | // } :: s.len, |
---|
1086 | // s.len e2; |
---|
1087 | // } :: s.len e.expr, |
---|
1088 | // e.expr : /*empty*/ = |
---|
1089 | // s.len; |
---|
1090 | // |
---|
1091 | //Max-Length e.expr = |
---|
1092 | // 0 e.expr $iter { |
---|
1093 | // e.expr : t1 e2, t1 : { |
---|
1094 | // s.ObjectSymbol = <"+" s.len 1>; |
---|
1095 | //// (REF t.name) = ??? |
---|
1096 | // (PAREN e) = <"+" s.len 1>; |
---|
1097 | // (s.var-tag s.m (s.n) e.var-id) = <"+" s.len s.n>; |
---|
1098 | // (s.var-tag s.m () e.var-id) = Empty; |
---|
1099 | // } :: s.len, |
---|
1100 | // s.len e2; |
---|
1101 | // } :: s.len e.expr, |
---|
1102 | // \{ |
---|
1103 | // s.len : Empty = /*empty*/; |
---|
1104 | // e.expr : /*empty*/ = s.len; |
---|
1105 | // }; |
---|
1106 | // |
---|
1107 | //Add-Less-Ineq (e.vars s.len) (e.clashes1) (e.clashes2) e.Snt = |
---|
1108 | // <Get-Min e.vars> :: s.min, { |
---|
1109 | // <">" (s.min) (s.len)> = $fail; |
---|
1110 | // <Mults e.vars> :: e.mults, |
---|
1111 | // <Min-Length e.vars> :: s.min-len, |
---|
1112 | // /* |
---|
1113 | // * For each variable form new inequality recompute its maximum: |
---|
1114 | // * new_max = (s.len - s.min-len + s.mult * min) / s.mult |
---|
1115 | // */ |
---|
1116 | // () e.vars $iter { |
---|
1117 | // e.tmp-vars : (s.tag s.m (e.n) e.var-id) e.rest, |
---|
1118 | // e.mults : e (s.tag s.m (e.n) e.var-id) s.mult e, |
---|
1119 | // <Div <"+" <"-" s.len s.min-len> <"*" s.mult s.m>> s.mult> |
---|
1120 | // :: s.max, |
---|
1121 | // { |
---|
1122 | // e.n : /*empty*/ = s.max; |
---|
1123 | // <"<" (e.n) (s.max)> = e.n; |
---|
1124 | // s.max; |
---|
1125 | // } :: e.max, |
---|
1126 | // (e.new-vars (s.tag s.m (e.max) e.var-id)) e.rest; |
---|
1127 | // } :: (e.new-vars) e.tmp-vars, |
---|
1128 | // e.tmp-vars : /*empty*/ = |
---|
1129 | // <Max-Length e.new-vars> : s.max-len, { |
---|
1130 | // /* |
---|
1131 | // * Check that maximums weren't decreased too much. |
---|
1132 | // */ |
---|
1133 | // <">" (s.min) (s.max-len)> = $fail; |
---|
1134 | // /* |
---|
1135 | // * If max-len == <<minimal valid value>> then change all |
---|
1136 | // * e*[min,max] to e*[max,max]. If max == 0 then change variable |
---|
1137 | // * to empty expression. |
---|
1138 | // */ |
---|
1139 | // s.min : s.max-len = |
---|
1140 | // e.vars (e.new-vars) (e.clashes1) (e.clashes2) (e.Snt) $iter { |
---|
1141 | // e.vars : t.var e.rest, |
---|
1142 | // e.new-vars : (s.tag s.m (s.n) e.var-id) e.new-rest, { |
---|
1143 | // s.n : 0 = |
---|
1144 | //// <Exchange (t.var) () e.clashes1 ()> |
---|
1145 | //// :: e.clashes1 t, |
---|
1146 | //// <Exchange (t.var) () e.clashes2 (e.Snt)> |
---|
1147 | //// :: e.clashes2 (e.Snt), |
---|
1148 | // e.rest (e.new-rest) |
---|
1149 | // (e.clashes1 Unwatched (t.var) (LEFT)) |
---|
1150 | // (e.clashes2) (e.Snt); |
---|
1151 | // <Exchange (t.var) ((s.tag s.n (s.n) e.var-id)) |
---|
1152 | // e.clashes1 ()> :: e.clashes1 t, |
---|
1153 | // <Exchange (t.var) ((s.tag s.n (s.n) e.var-id)) |
---|
1154 | // e.clashes2 (e.Snt)> :: e.clashes2 (e.Snt), |
---|
1155 | // e.rest (e.new-rest) (e.clashes1) |
---|
1156 | // (e.clashes2) (e.Snt); |
---|
1157 | // }; |
---|
1158 | // } :: e.vars (e.new-vars) (e.clashes1) (e.clashes2) (e.Snt), |
---|
1159 | // e.vars : /*empty*/ = |
---|
1160 | // (e.clashes1) (e.clashes2) e.Snt; |
---|
1161 | // /* |
---|
1162 | // * If no maximums were changed then see whether we should add |
---|
1163 | // * new inequality to storage and if so then mark clashes |
---|
1164 | // * containing e.vars in the begining or reversed e.vars in the |
---|
1165 | // * end as "Unwatched Hard". |
---|
1166 | // */ |
---|
1167 | // e.vars : e.new-vars, { |
---|
1168 | // <">" (<Get-Max e.vars>) (s.len)>, |
---|
1169 | // () <? &Less-Ineqs> $iter e.tmp-ineqs : { |
---|
1170 | // e1 (e.vars e.ineq s.in-len) e2, |
---|
1171 | // <Max-Length e.ineq> : s.ineq-max, |
---|
1172 | // <"<=" (<"+" s.len s.ineq-max>) (s.in-len)>, |
---|
1173 | // (e.ineqs e1) e2; |
---|
1174 | // e1 = (e.ineqs e1); |
---|
1175 | // } :: (e.ineqs) e.tmp-ineqs, |
---|
1176 | // e.tmp-ineqs : /*empty*/ = |
---|
1177 | // { |
---|
1178 | // e.ineqs : e1 (e.vars e.ineq) e2 = |
---|
1179 | // e1 (e.vars s.len) (e.vars e.ineq) e2; |
---|
1180 | // e.ineqs (e.vars s.len); |
---|
1181 | // } :: e.ineqs, |
---|
1182 | // <Store &Less-Ineqs e.ineqs>, |
---|
1183 | // (<Mark-Unw-Hard (e.vars) e.clashes1>) |
---|
1184 | // (<Mark-Unw-Hard (e.vars) e.clashes2>) |
---|
1185 | // e.Snt; |
---|
1186 | // (e.clashes1) (e.clashes2) e.Snt; |
---|
1187 | // }; |
---|
1188 | // /* |
---|
1189 | // * Else, if some maximums were changed, then change them in all |
---|
1190 | // * clashes and in Snt. For each variable maximum can't be less |
---|
1191 | // * then minimum because it would mean that s.len < s.min. |
---|
1192 | // * If max == 0 then change variable to empty expression. |
---|
1193 | // */ |
---|
1194 | // e.vars (e.new-vars) (e.clashes1) (e.clashes2) (e.Snt) $iter { |
---|
1195 | // e.vars : t.var e.rest, |
---|
1196 | // e.new-vars : (s.tag s.m (s.n) e.var-id) e.new-rest, { |
---|
1197 | // t.var : (s.tag s.m (s.n) e.var-id) = |
---|
1198 | // e.rest (e.new-rest) (e.clashes1) (e.clashes2) (e.Snt); |
---|
1199 | // s.n : 0 = |
---|
1200 | //// <Exchange (t.var) () e.clashes1 ()> |
---|
1201 | //// :: e.clashes1 t, |
---|
1202 | //// <Exchange (t.var) () e.clashes2 (e.Snt)> |
---|
1203 | //// :: e.clashes2 (e.Snt), |
---|
1204 | // e.rest (e.new-rest) |
---|
1205 | // (e.clashes1 Unwatched (t.var) (LEFT)) (e.clashes2) |
---|
1206 | // (e.Snt); |
---|
1207 | // <Exchange (t.var) ((s.tag s.m (s.n) e.var-id)) |
---|
1208 | // e.clashes1 ()> :: e.clashes1 t, |
---|
1209 | // <Exchange (t.var) ((s.tag s.m (s.n) e.var-id)) |
---|
1210 | // e.clashes2 (e.Snt)> :: e.clashes2 (e.Snt), |
---|
1211 | // e.rest (e.new-rest) (e.clashes1) (e.clashes2) (e.Snt); |
---|
1212 | // }; |
---|
1213 | // } :: e.vars (e.new-vars) (e.clashes1) (e.clashes2) (e.Snt), |
---|
1214 | // e.vars : /*empty*/ = |
---|
1215 | // (e.clashes1) (e.clashes2) e.Snt; |
---|
1216 | // }; |
---|
1217 | // }; |
---|
1218 | // |
---|
1219 | //Add-Greater-Ineq (e.vars s.len) (e.clashes1) (e.clashes2) e.Snt, { |
---|
1220 | // <Get-Max e.vars> : s.max, { |
---|
1221 | // <"<" (s.max) (s.len)> = $fail; |
---|
1222 | // <Mults e.vars> :: e.mults, |
---|
1223 | // <Max-Length e.vars> : s.max-len, |
---|
1224 | // /* |
---|
1225 | // * For each variable from new inequality recompute its minimum: |
---|
1226 | // * new_min = ceil ((s.len - s.max-len + s.mult * max) / s.mult) |
---|
1227 | // */ |
---|
1228 | // () e.vars $iter { |
---|
1229 | // e.tmp-vars : (s.tag s.m (s.n) e.var-id) e.rest, |
---|
1230 | // e.mults : e (s.tag s.m (s.n) e.var-id) s.mult e, |
---|
1231 | // <Ceil <"+" <"-" s.len s.max-len> <"*" s.mult s.n>> s.mult> |
---|
1232 | // :: s.min, |
---|
1233 | // { |
---|
1234 | // <"<" (s.min) (0)> = 0; |
---|
1235 | // <">" (s.m) (s.min)> = s.m; |
---|
1236 | // s.min; |
---|
1237 | // } :: s.min, |
---|
1238 | // (e.new-vars (s.tag s.min (s.n) e.var-id)) e.rest; |
---|
1239 | // } :: (e.new-vars) e.tmp-vars, |
---|
1240 | // e.tmp-vars : /*empty*/ = |
---|
1241 | // <Min-Length e.new-vars> :: s.min-len, { |
---|
1242 | // /* |
---|
1243 | // * Check that minimums weren't increased too much. |
---|
1244 | // */ |
---|
1245 | // <"<" (s.max) (s.min-len)> = $fail; |
---|
1246 | // /* |
---|
1247 | // * If min-len == <<maximum valid value>> then change all |
---|
1248 | // * e*[min,max] to e*[min,min]. |
---|
1249 | // */ |
---|
1250 | // s.max : s.min-len = |
---|
1251 | // e.vars (e.new-vars) (e.clashes1) (e.clashes2) (e.Snt) $iter { |
---|
1252 | // e.vars : t.var e.rest, |
---|
1253 | // e.new-vars : (s.tag s.m (s.n) e.var-id) e.new-rest, |
---|
1254 | // <Exchange (t.var) ((s.tag s.m (s.m) e.var-id)) |
---|
1255 | // e.clashes1 ()> :: e.clashes1 t, |
---|
1256 | // <Exchange (t.var) ((s.tag s.m (s.m) e.var-id)) |
---|
1257 | // e.clashes2 (e.Snt)> :: e.clashes2 (e.Snt), |
---|
1258 | // e.rest (e.new-rest) (e.clashes1) (e.clashes2) (e.Snt); |
---|
1259 | // } :: e.vars (e.new-vars) (e.clashes1) (e.clashes2) (e.Snt), |
---|
1260 | // e.vars : /*empty*/ = |
---|
1261 | // (e.clashes1) (e.clashes2) e.Snt; |
---|
1262 | // /* |
---|
1263 | // * If no minimums were changed then see whether we should add |
---|
1264 | // * new inequality to storage and if so then mark clashes |
---|
1265 | // * containing e.vars in the begining or reversed e.vars in the |
---|
1266 | // * end as "Unwatched Hard". |
---|
1267 | // */ |
---|
1268 | // e.vars : e.new-vars, { |
---|
1269 | // <"<" (<Get-Min e.vars>) (s.len)>, |
---|
1270 | // () <? &Greater-Ineqs> $iter e.tmp-ineqs : { |
---|
1271 | // e1 (e.vars e.ineq s.in-len) e2, |
---|
1272 | // <">=" (<"+" s.len <Min-Length e.ineq>>) (s.in-len)>, |
---|
1273 | // (e.ineqs e1) e2; |
---|
1274 | // e1 = (e.ineqs e1); |
---|
1275 | // } :: (e.ineqs) e.tmp-ineqs, |
---|
1276 | // e.tmp-ineqs : /*empty*/ = |
---|
1277 | // { |
---|
1278 | // e.ineqs : e1 (e.vars e.ineq) e2 = |
---|
1279 | // e1 (e.vars s.len) (e.vars e.ineq) e2; |
---|
1280 | // e.ineqs (e.vars s.len); |
---|
1281 | // } :: e.ineqs, |
---|
1282 | // <Store &Greater-Ineqs e.ineqs>, |
---|
1283 | // (<Mark-Unw-Hard (e.vars) e.clashes1>) |
---|
1284 | // (<Mark-Unw-Hard (e.vars) e.clashes2>) |
---|
1285 | // e.Snt; |
---|
1286 | // (e.clashes1) (e.clashes2) e.Snt; |
---|
1287 | // }; |
---|
1288 | // /* |
---|
1289 | // * Else, if some minimums were changed, then change them in all |
---|
1290 | // * clashes and in Snt. For each variable minimum can't be greater |
---|
1291 | // * then maximum because it would mean that s.len > s.max. |
---|
1292 | // */ |
---|
1293 | // e.vars (e.new-vars) (e.clashes1) (e.clashes2) (e.Snt) $iter { |
---|
1294 | // e.vars : t.var e.rest, |
---|
1295 | // e.new-vars : t.new-var e.new-rest, { |
---|
1296 | // t.var : t.new-var = |
---|
1297 | // e.rest (e.new-rest) (e.clashes1) (e.clashes2) (e.Snt); |
---|
1298 | // <Exchange (t.var) (t.new-var) e.clashes1 ()> |
---|
1299 | // :: e.clashes1 t, |
---|
1300 | // <Exchange (t.var) (t.new-var) e.clashes2 (e.Snt)> |
---|
1301 | // :: e.clashes2 (e.Snt), |
---|
1302 | // e.rest (e.new-rest) (e.clashes1) (e.clashes2) (e.Snt); |
---|
1303 | // }; |
---|
1304 | // } :: e.vars (e.new-vars) (e.clashes1) (e.clashes2) (e.Snt), |
---|
1305 | // e.vars : /*empty*/ = |
---|
1306 | // (e.clashes1) (e.clashes2) e.Snt; |
---|
1307 | // }; |
---|
1308 | // }; |
---|
1309 | // e.vars : (s.tag s.n () e.var-id), { |
---|
1310 | // <">" (s.len) (s.n)> = |
---|
1311 | // <Exchange ((s.tag s.n () e.var-id)) ((s.tag s.len () e.var-id)) |
---|
1312 | // e.clashes1 ()> :: e.clashes1 t, |
---|
1313 | // <Exchange ((s.tag s.n () e.var-id)) ((s.tag s.len () e.var-id)) |
---|
1314 | // e.clashes2 (e.Snt)> :: e.clashes2 (e.Snt), |
---|
1315 | // (e.clashes1) (e.clashes2) e.Snt; |
---|
1316 | // (e.clashes1) (e.clashes2) e.Snt; |
---|
1317 | // }; |
---|
1318 | // (e.clashes1) (e.clashes2) e.Snt; // STUB!!! Add inequality to the storage? |
---|
1319 | //}; |
---|
1320 | // |
---|
1321 | //Get-Min e.vars, { |
---|
1322 | // <? &Greater-Ineqs> : $r e (e.ineq s.len) e, |
---|
1323 | // e.vars : e.ineq e.other, |
---|
1324 | // <"+" s.len <Min-Length e.other>>; |
---|
1325 | // <Min-Length e.vars>; |
---|
1326 | //}; |
---|
1327 | // |
---|
1328 | //Get-Max e.vars, { |
---|
1329 | // <? &Less-Ineqs> : $r e (e.ineq s.len) e, |
---|
1330 | // e.vars : e.ineq e.other, |
---|
1331 | // <Max-Length e.other> : s.other-len, |
---|
1332 | // <"+" s.len s.other-len>; |
---|
1333 | // <Max-Length e.vars>; |
---|
1334 | //}; |
---|
1335 | // |
---|
1336 | ///* |
---|
1337 | // * Computes variables multiplicitys and returns them in the form: |
---|
1338 | // * e.mults ::= t.var s.mult e.mults | [] |
---|
1339 | // */ |
---|
1340 | //Mults e.vars = |
---|
1341 | // () e.vars $iter { |
---|
1342 | // e.vars : t.var e.rest, |
---|
1343 | // 1 e.rest $iter { |
---|
1344 | // e.rest : e1 t.var e2, |
---|
1345 | // <"+" s.mult 1> e1 e2; |
---|
1346 | // } :: s.mult e.rest, |
---|
1347 | // # \{ e.rest : e t.var e; } = |
---|
1348 | // (e.mults t.var s.mult) e.rest; |
---|
1349 | // } :: (e.mults) e.vars, |
---|
1350 | // e.vars : /*empty*/ = |
---|
1351 | // e.mults; |
---|
1352 | // |
---|
1353 | //Mark-Unw-Hard (e.vars) e.clashes = |
---|
1354 | // <Reverse e.vars> :: e.rev-vars, |
---|
1355 | // () e.clashes $iter e.clashes : { |
---|
1356 | // (e.Re) (e.Pe) e.rest, |
---|
1357 | // <Cyclic e.Re> :: e.cyc-Re, |
---|
1358 | // <Cyclic e.Pe> :: e.cyc-Pe, |
---|
1359 | // { |
---|
1360 | // \{ |
---|
1361 | // e.cyc-Re : e.vars e; |
---|
1362 | // e.cyc-Re : e e.rev-vars; |
---|
1363 | // e.cyc-Pe : e.vars e; |
---|
1364 | // e.cyc-Pe : e e.rev-vars; |
---|
1365 | // }, |
---|
1366 | // (e.new-clashes Unwatched Hard (e.Re) (e.Pe)) e.rest; |
---|
1367 | // (e.new-clashes (e.Re) (e.Pe)) e.rest; |
---|
1368 | // }; |
---|
1369 | // e.tag (e.Re) (e.Pe) e.rest = |
---|
1370 | // (e.new-clashes e.tag (e.Re) (e.Pe)) e.rest; |
---|
1371 | // } :: (e.new-clashes) e.clashes, |
---|
1372 | // e.clashes : /*empty*/ = |
---|
1373 | // e.new-clashes; |
---|
1374 | // |
---|
1375 | //Ceil s1 s2, { |
---|
1376 | // <Rem s1 s2> : 0 = <Div s1 s2>; |
---|
1377 | // <"+" <Div s1 s2> 1>; |
---|
1378 | //}; |
---|
1379 | // |
---|
1380 | //Match-Exp (e.Re) e.Pe = |
---|
1381 | // <Granulate e.Re> :: e.Re, |
---|
1382 | // <Granulate e.Pe> :: e.Pe, |
---|
1383 | // <Length e.Pe> :: s.len, |
---|
1384 | // e.Re : e1 e2, |
---|
1385 | // <Match (<Left 0 s.len e2>) (e.Pe)>, |
---|
1386 | // e2 : $r e3 e4, |
---|
1387 | // <Match (<Right 0 s.len e3>) (e.Pe)>, |
---|
1388 | // <Length e1> <Length e4>; |
---|
1389 | // |
---|
1390 | //Match e.clash = |
---|
1391 | // e.clash $iter e.clashes : \{ |
---|
1392 | // e1 (e.expr) (e.expr) e2 = e1 e2; |
---|
1393 | // e1 (t.Rt e.Re) (t.Pt e.Pe) e2, |
---|
1394 | // # \{ t.Rt : (EVAR e); t.Pt : (EVAR e); } = |
---|
1395 | // <Match-Term t.Rt t.Pt e1 (e.Re) (e.Pe) e2>; |
---|
1396 | // e1 (e.Re t.Rt) (e.Pe t.Pt) e2, |
---|
1397 | // # \{ t.Rt : (EVAR e); t.Pt : (EVAR e); } = |
---|
1398 | // <Match-Term t.Rt t.Pt e1 (e.Re) (e.Pe) e2>; |
---|
1399 | // e1 (e.Re) (e.Pe) e2, \{ |
---|
1400 | // e.Re : (EVAR e) e (EVAR e) = <Match-Cyclic (e.Re) (e.Pe) e1 e2>; |
---|
1401 | // e.Pe : (EVAR e) e (EVAR e) = <Match-Cyclic (e.Pe) (e.Re) e1 e2>; |
---|
1402 | // \{ |
---|
1403 | // e.Re : (EVAR e) e, e.Pe : e (EVAR e); |
---|
1404 | // e.Re : (EVAR e) e, e.Pe : e (EVAR e); |
---|
1405 | // } = |
---|
1406 | // <Intersect <Min-Length e.Re> (<Max-Length e.Re>) |
---|
1407 | // <Min-Length e.Pe> (<Max-Length e.Pe>)>; // This is STUB!!! |
---|
1408 | // }; |
---|
1409 | // } :: e.clashes, |
---|
1410 | // <WriteLN Match e.clashes>, |
---|
1411 | // e.clashes : /*empty*/; |
---|
1412 | // |
---|
1413 | //Match-Term { |
---|
1414 | // term term e.clashes = e.clashes; |
---|
1415 | // t.Rt t.Pt e.clashes, t.Rt : { |
---|
1416 | // s.ObjectSymbol = |
---|
1417 | // t.Pt : (s.tag e), |
---|
1418 | // SVAR TVAR : e s.tag e, // check that s.tag isn't PAREN |
---|
1419 | // <Subst (t.Pt) ((t.Rt)) e.clashes>; |
---|
1420 | // (SVAR e), t.Pt : { |
---|
1421 | // s.ObjectSymbol = <Subst (t.Rt) ((t.Pt)) e.clashes>; |
---|
1422 | // (s.tag e) = |
---|
1423 | // SVAR TVAR : e s.tag e, // check that s.tag isn't PAREN |
---|
1424 | // <Subst (t.Pt) ((t.Rt)) e.clashes>; |
---|
1425 | // }; |
---|
1426 | // (TVAR e) = |
---|
1427 | // <Subst (t.Rt) ((t.Pt)) e.clashes>; |
---|
1428 | // (PAREN e.Re) = t.Pt : \{ |
---|
1429 | // (TVAR e) = <Subst (t.Pt) ((t.Rt)) e.clashes>; |
---|
1430 | // (PAREN e.Pe) = (e.Re) (e.Pe) e.clashes; |
---|
1431 | // }; |
---|
1432 | // }; |
---|
1433 | //}; |
---|
1434 | // |
---|
1435 | //Match-Cyclic (e.Re) (e.Pe) e.clashes = ; // This is STUB!!! |
---|
1436 | // |
---|
1437 | //Granulate e.expr = |
---|
1438 | // (e.expr) <Vars e.expr> $iter { |
---|
1439 | // e.vars : t.var e.rest, |
---|
1440 | // t.var : { |
---|
1441 | // (s.tag 1 (1) e.var-id), { |
---|
1442 | // SVAR TVAR : e s.tag e = e.expr; |
---|
1443 | // <Subst (t.var) (((TVAR 1 (1)) e.var-id)) e.expr>; |
---|
1444 | // }; |
---|
1445 | // (s.tag s.n (s.n) e.NEW (e.QualifiedName)) = |
---|
1446 | // s.n /*empty*/ $iter |
---|
1447 | // <"-" s.n 1> |
---|
1448 | // (TVAR 1 (1) NEW ("gran" e.QualifiedName s.n)) e.new-vars |
---|
1449 | // :: s.n e.new-vars, |
---|
1450 | // s.n : 0 = |
---|
1451 | // <Subst (t.var) ((e.new-vars)) e.expr>; |
---|
1452 | // (s.tag e.something), { // cyclic variable |
---|
1453 | // s.tag : EVAR = e.expr; |
---|
1454 | // <Subst (t.var) (((EVAR e.something))) e.expr>; |
---|
1455 | // }; |
---|
1456 | // } :: e.expr, |
---|
1457 | // (e.expr) e.rest; |
---|
1458 | // } :: (e.expr) e.vars, |
---|
1459 | // e.vars : /*empty*/ = |
---|
1460 | // e.expr; |
---|
1461 | // |
---|
1462 | //Left-Exp s.left s.len e.expr, \{ |
---|
1463 | // <"<" (<Min-Length e.expr>) (<"+" s.left s.len>)> |
---|
1464 | // = $fail; |
---|
1465 | // s.len : 0 = (); |
---|
1466 | // s.left : 0 = |
---|
1467 | // 0 () e.expr $iter \{ |
---|
1468 | // e.expr : t1 e2, t1 : { |
---|
1469 | // s.ObjectSymbol = <"+" s.num 1>; |
---|
1470 | //// (REF t.name) = ??? |
---|
1471 | // (PAREN e) = <"+" s.num 1> ; |
---|
1472 | // (s.var-tag s.n (s.n) e.var-id) = <"+" s.num s.n>; |
---|
1473 | // (s.var-tag s.m (e.n) e.var-id) = |
---|
1474 | // <"+" s.num s.m> :: s.num, |
---|
1475 | // <"<=" (s.len) (s.num)>, |
---|
1476 | // s.num; |
---|
1477 | // } :: s.num, |
---|
1478 | // s.num (e.left t1) e2; |
---|
1479 | // } :: s.num (e.left) e.expr, |
---|
1480 | // <"<=" (s.len) (s.num)> = |
---|
1481 | // <"-" s.num s.len> :: s.r-min, |
---|
1482 | // e.left : e.first t.var, |
---|
1483 | // t.var : { |
---|
1484 | // s.ObjectSymbol = (e.left); |
---|
1485 | // (PAREN e) = (e.left); |
---|
1486 | // (s.tag s.m (e.n) e.NEW (e.QualifiedName)) = |
---|
1487 | // <"-" s.m s.r-min> :: s.l-len, |
---|
1488 | // e.n : { |
---|
1489 | // /*empty*/ = /*empty*/; |
---|
1490 | // s.x = <"-" <"+" s.x <Min-Length e.first>> s.l-len>; |
---|
1491 | // } : { |
---|
1492 | // 0 = (e.left); |
---|
1493 | // e.r-max, |
---|
1494 | // (s.tag s.l-len (s.l-len) NEW ("l-split" e.QualifiedName)) |
---|
1495 | // :: t.l-var, |
---|
1496 | // (s.tag s.r-min (e.r-max) NEW ("r-split" e.QualifiedName)) |
---|
1497 | // :: t.r-var, |
---|
1498 | // <Subst (t.var) ((t.l-var t.r-var)) e.first> :: e.expr, |
---|
1499 | // (e.expr t.l-var) t.var t.l-var t.r-var; |
---|
1500 | // }; |
---|
1501 | // }; |
---|
1502 | // <Left-Exp 0 s.left e.expr> :: (e.left) e.change, |
---|
1503 | // { |
---|
1504 | // e.change : t.old-var t.new-1 t.new-2 = |
---|
1505 | // <Subst (t.old-var) ((t.new-1 t.new-2)) e.expr>; |
---|
1506 | // e.expr; |
---|
1507 | // } : e.left e.right, |
---|
1508 | // <Left-Exp 0 s.len e.right> e.change; |
---|
1509 | //}; |
---|
1510 | // |
---|
1511 | //Right-Exp s.right s.len e.expr, \{ |
---|
1512 | // <"<" (<Min-Length e.expr>) (<"+" s.right s.len>)> |
---|
1513 | // = $fail; |
---|
1514 | // s.len : 0 = (); |
---|
1515 | // s.right : 0 = |
---|
1516 | // 0 () e.expr $iter \{ |
---|
1517 | // e.expr : e2 t1, t1 : { |
---|
1518 | // s.ObjectSymbol = <"+" s.num 1>; |
---|
1519 | //// (REF t.name) = ??? |
---|
1520 | // (PAREN e) = <"+" s.num 1> ; |
---|
1521 | // (s.var-tag s.n (s.n) e.var-id) = <"+" s.num s.n>; |
---|
1522 | // (s.var-tag s.m (e.n) e.var-id) = |
---|
1523 | // <"+" s.num s.m> :: s.num, |
---|
1524 | // <"<=" (s.len) (s.num)>, |
---|
1525 | // s.num; |
---|
1526 | // } :: s.num, |
---|
1527 | // s.num (t1 e.right) e2; |
---|
1528 | // } :: s.num (e.right) e.expr, |
---|
1529 | // <"<=" (s.len) (s.num)> = |
---|
1530 | // <"-" s.num s.len> :: s.l-min, |
---|
1531 | // e.right : t.var e.last, |
---|
1532 | // t.var : { |
---|
1533 | // s.ObjectSymbol = (e.right); |
---|
1534 | // (PAREN e) = (e.right); |
---|
1535 | // (s.tag s.m (e.n) e.NEW (e.QualifiedName)) = |
---|
1536 | // <"-" s.m s.l-min> :: s.r-len, |
---|
1537 | // e.n : { |
---|
1538 | // /*empty*/ = /*empty*/; |
---|
1539 | // s.x = <"-" <"+" s.x <Min-Length e.last>> s.r-len>; |
---|
1540 | // } : { |
---|
1541 | // 0 = (e.right); |
---|
1542 | // e.l-max, |
---|
1543 | // (s.tag s.r-len (s.r-len) NEW ("r-split" e.QualifiedName)) |
---|
1544 | // :: t.r-var, |
---|
1545 | // (s.tag s.l-min (e.l-max) NEW ("l-split" e.QualifiedName)) |
---|
1546 | // :: t.l-var, |
---|
1547 | // <Subst (t.var) ((t.l-var t.r-var)) e.last> :: e.expr, |
---|
1548 | // (e.expr t.r-var) t.var t.l-var t.r-var; |
---|
1549 | // }; |
---|
1550 | // }; |
---|
1551 | // <Right-Exp 0 s.right e.expr> :: (e.right) e.change, |
---|
1552 | // { |
---|
1553 | // e.change : t.old-var t.new-1 t.new-2 = |
---|
1554 | // <Subst (t.old-var) ((t.new-1 t.new-2)) e.expr>; |
---|
1555 | // e.expr; |
---|
1556 | // } : e.left e.right, |
---|
1557 | // <Right-Exp 0 s.len e.left> e.change; |
---|
1558 | //}; |
---|
1559 | // |
---|
1560 | //// Right-Exp s.right s.len e.expr = |
---|
1561 | //// <Min-Length e.expr> :: s.expr-len, |
---|
1562 | //// <"+" s.right s.len> :: s.sum, |
---|
1563 | //// \{ |
---|
1564 | //// <"<" (s.expr-len) (s.sum)> = $fail; |
---|
1565 | //// <Left-Exp <"-" s.expr-len s.sum> s.len e.expr>; |
---|
1566 | //// }; |
---|
1567 | // |
---|
1568 | //Middle-Exp s.left s.right e.expr, \{ |
---|
1569 | // <"<" (<Min-Length e.expr>) (<"+" s.left s.right>)> |
---|
1570 | // = $fail; |
---|
1571 | // <Left-Exp 0 s.left e.expr> :: (e.left) e.l-change, |
---|
1572 | // <Right-Exp 0 s.right e.expr> :: (e.right) e.r-change, |
---|
1573 | // e.expr : e.left e.sought e.right, |
---|
1574 | // (e.sought) e.l-change e.r-change; |
---|
1575 | //}; |
---|
1576 | |
---|