1 : /*
2 : Copyright (C) 2007, Bruce Ediger
3 :
4 : This file is part of cl.
5 :
6 : cl is free software; you can redistribute it and/or modify
7 : it under the terms of the GNU General Public License as published by
8 : the Free Software Foundation; either version 2 of the License, or
9 : (at your option) any later version.
10 :
11 : cl is distributed in the hope that it will be useful,
12 : but WITHOUT ANY WARRANTY; without even the implied warranty of
13 : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 : GNU General Public License for more details.
15 :
16 : You should have received a copy of the GNU General Public License
17 : along with cl; if not, write to the Free Software
18 : Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19 :
20 : */
21 : #include <stdio.h>
22 : #include <stdlib.h> /* malloc() and free() */
23 : #include <assert.h>
24 : #include <setjmp.h> /* longjmp(), jmp_buf */
25 :
26 : #include <node.h>
27 : #include <graph.h>
28 : #include <spine_stack.h>
29 :
30 : int read_line(void);
31 :
32 : extern int trace_reduction;
33 : extern int debug_reduction;
34 : extern int elaborate_output;
35 : extern int single_step;
36 :
37 : extern int max_reduction_count;
38 :
39 : extern sigjmp_buf in_reduce_graph;
40 :
41 : #define D if(debug_reduction)
42 : #define T if(trace_reduction)
43 :
44 : /* can't do single_step && read_line() - compilers optimize it away */
45 : #define SS if (single_step) read_line()
46 :
47 : void print_graph(struct node *node, int sn_to_reduce, int current_sn)
48 631 : {
49 631 : print_tree(node, sn_to_reduce, current_sn);
50 631 : putc('\n', stdout);
51 631 : }
52 :
53 : /* Graph reduction function. Destructively modifies the graph passed in.
54 : */
55 : void
56 : reduce_graph(struct node *root)
57 346 : {
58 346 : struct spine_stack *stack = NULL;
59 346 : unsigned long reduction_counter = 0;
60 :
61 346 : push_spine_stack(&stack);
62 :
63 346 : PUSHNODE(stack, root);
64 :
65 : do {
66 :
67 78357204 : while (STACK_NOT_EMPTY(stack))
68 : {
69 78352943 : switch (TOPNODE(stack)->typ)
70 : {
71 : case APPLICATION:
72 52249076 : if (!LEFT_BRANCH_TRAVERSED(TOPNODE(stack)))
73 : {
74 52243353 : TOPNODE(stack)->updateable = &(TOPNODE(stack)->left);
75 52243353 : TOPNODE(stack)->branch_marker = LEFT;
76 52243353 : MARK_LEFT_BRANCH_TRAVERSED(TOPNODE(stack));
77 52243353 : PUSHNODE(stack, TOPNODE(stack)->left);
78 52243352 : D printf("push left branch on current stack\n");
79 5723 : } else if (!RIGHT_BRANCH_TRAVERSED(TOPNODE(stack))) {
80 1785 : struct node *tmp = TOPNODE(stack);
81 1785 : MARK_RIGHT_BRANCH_TRAVERSED(TOPNODE(stack));
82 1785 : D printf("push right branch on new stack\n");
83 1785 : TOPNODE(stack)->updateable = &(TOPNODE(stack)->right);
84 1785 : TOPNODE(stack)->branch_marker = RIGHT;
85 1785 : push_spine_stack(&stack);
86 1785 : PUSHNODE(stack, tmp); /* "dummy" node at top of stack */
87 1785 : PUSHNODE(stack, tmp->right);
88 : } else
89 3938 : POP(stack, 1); /* both sides of application node traversed */
90 52249075 : break;
91 : case COMBINATOR:
92 : /* node->typ indicates a combinator, which can comprise a built-in,
93 : * or it can comprise a mere variable. Let node->cn decide. */
94 26103867 : if (stack->top > stack->maxdepth) stack->maxdepth = stack->top;
95 26103867 : switch (TOPNODE(stack)->cn)
96 : {
97 : case COMB_I:
98 3453 : D {
99 2 : printf("I combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));
100 2 : printf("I combinator: "); print_graph(root, 0, TOPNODE(stack)->sn);
101 : }
102 3453 : if (STACK_SIZE(stack) > 2)
103 : {
104 3207 : D {printf("I reduction, before: "); print_graph(root, TOPNODE(stack)->sn, TOPNODE(stack)->sn);}
105 3207 : SS;
106 3207 : *(PARENTNODE(stack, 2)->updateable)
107 : = PARENTNODE(stack, 1)->right;
108 3207 : ++PARENTNODE(stack, 1)->right->refcnt;
109 3207 : PARENTNODE(stack, 2)->examined ^= PARENTNODE(stack, 2)->branch_marker;
110 3207 : PARENTNODE(stack, 1)->examined = 0;
111 3207 : free_node(PARENTNODE(stack, 1));
112 3207 : POP(stack, 2);
113 3207 : D{printf("I reduction, after (%d): ", STACK_SIZE(stack)); print_graph(root, 0, TOPNODE(stack)->sn);}
114 3207 : T print_graph(root, 0, 0);
115 3207 : SS;
116 : } else
117 246 : POP(stack, 1);
118 3453 : break;
119 : case COMB_K:
120 10843 : D printf("K combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));
121 10843 : if (STACK_SIZE(stack) > 3)
122 : {
123 10309 : D {printf("K reduction, before: "); print_graph(root, TOPNODE(stack)->sn, 0);}
124 10309 : SS;
125 10309 : *(PARENTNODE(stack, 3)->updateable) = PARENTNODE(stack, 1)->right;
126 10309 : ++PARENTNODE(stack, 1)->right->refcnt;
127 10309 : PARENTNODE(stack, 1)->examined ^= LEFT;
128 10309 : PARENTNODE(stack, 2)->examined ^= LEFT;
129 10309 : PARENTNODE(stack, 3)->examined ^= PARENTNODE(stack, 3)->branch_marker;
130 10309 : free_node(PARENTNODE(stack, 2));
131 10309 : ++reduction_counter;
132 10309 : POP(stack, 3);
133 10309 : D {printf("K reduction, after: "); print_graph(root, 0, TOPNODE(stack)->sn);}
134 10309 : T print_graph(root, 0, 0);
135 10309 : SS;
136 : } else
137 534 : POP(stack, 1);
138 10843 : break;
139 : case COMB_T:
140 : /* T x y -> y x */
141 10 : D printf("T combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));
142 10 : if (STACK_SIZE(stack) > 3)
143 : {
144 : struct node *n;
145 7 : struct node *tmp = *(PARENTNODE(stack, 3)->updateable);
146 7 : D {printf("T reduction, before: "); print_graph(root, TOPNODE(stack)->sn, 0);}
147 7 : SS;
148 7 : n = new_application(
149 : PARENTNODE(stack, 2)->right,
150 : PARENTNODE(stack, 1)->right
151 : );
152 7 : PARENTNODE(stack, 1)->examined ^= LEFT;
153 7 : PARENTNODE(stack, 2)->examined ^= LEFT;
154 7 : PARENTNODE(stack, 3)->examined ^= PARENTNODE(stack, 3)->branch_marker;
155 7 : *(PARENTNODE(stack, 3)->updateable) = n;
156 7 : ++n->refcnt;
157 7 : free_node(tmp);
158 7 : ++reduction_counter;
159 7 : POP(stack, 3);
160 7 : D {printf("T reduction, after: "); print_graph(root, 0, TOPNODE(stack)->sn);}
161 7 : T print_graph(root, 0, 0);
162 7 : SS;
163 : } else
164 3 : POP(stack, 1);
165 10 : break;
166 : case COMB_M:
167 : /* M x -> x x */
168 14 : D printf("M combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));
169 14 : if (STACK_SIZE(stack) > 2)
170 : {
171 : struct node *n;
172 9 : struct node *tmp = *(PARENTNODE(stack, 2)->updateable);
173 9 : D {printf("M reduction, before: "); print_graph(root, TOPNODE(stack)->sn, 0);}
174 9 : SS;
175 9 : n = new_application(
176 : PARENTNODE(stack, 1)->right,
177 : PARENTNODE(stack, 1)->right
178 : );
179 9 : PARENTNODE(stack, 1)->examined ^= LEFT;
180 9 : PARENTNODE(stack, 2)->examined ^= PARENTNODE(stack, 2)->branch_marker;
181 9 : *(PARENTNODE(stack, 2)->updateable) = n;
182 9 : ++n->refcnt;
183 9 : free_node(tmp);
184 9 : ++reduction_counter;
185 9 : POP(stack, 2);
186 9 : D {printf("M reduction, after: "); print_graph(root, 0, TOPNODE(stack)->sn);}
187 9 : SS;
188 : } else
189 5 : POP(stack, 1);
190 14 : break;
191 : case COMB_S:
192 15501 : D printf("S combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));
193 15501 : if (STACK_SIZE(stack) > 4)
194 : {
195 15205 : struct node *n3 = PARENTNODE(stack, 3);
196 15205 : struct node *ltmp = n3->left;
197 15205 : struct node *rtmp = n3->right;
198 15205 : D {printf("S reduction, before: "); print_graph(root, TOPNODE(stack)->sn, 0); }
199 15205 : SS;
200 15205 : n3->left = new_application(
201 : PARENTNODE(stack, 1)->right,
202 : n3->right
203 : );
204 15205 : ++n3->left->refcnt;
205 15205 : n3->right = new_application(
206 : PARENTNODE(stack, 2)->right,
207 : n3->right
208 : );
209 15205 : ++n3->right->refcnt;
210 15205 : PARENTNODE(stack, 1)->examined = 0;
211 15205 : PARENTNODE(stack, 2)->examined = 0;
212 15205 : free_node(ltmp);
213 15205 : free_node(rtmp);
214 15205 : n3->examined = 0;
215 15205 : ++reduction_counter;
216 15205 : POP(stack, 3);
217 15205 : D {printf("S reduction, after: "); print_graph(root, 0, TOPNODE(stack)->sn);}
218 15205 : T print_graph(root, 0, 0);
219 15205 : SS;
220 : } else
221 296 : POP(stack, 1);
222 15501 : break;
223 : case COMB_B:
224 10413 : D {printf("B combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));}
225 10413 : if (STACK_SIZE(stack) > 4)
226 : {
227 10372 : struct node *ltmp = PARENTNODE(stack, 3)->left;
228 10372 : struct node *rtmp = PARENTNODE(stack, 3)->right;
229 10372 : D {printf("B reduction, before: "); print_graph(root, TOPNODE(stack)->sn, 0);}
230 10372 : SS;
231 10372 : PARENTNODE(stack, 3)->left
232 : = PARENTNODE(stack, 1)->right;
233 10372 : ++PARENTNODE(stack, 3)->left->refcnt;
234 10372 : PARENTNODE(stack, 3)->right
235 : = new_application(
236 : PARENTNODE(stack, 2)->right,
237 : PARENTNODE(stack, 3)->right
238 : );
239 10372 : ++PARENTNODE(stack, 3)->right->refcnt;
240 :
241 10372 : free_node(ltmp);
242 10372 : free_node(rtmp);
243 :
244 10372 : PARENTNODE(stack, 1)->examined = 0;
245 10372 : PARENTNODE(stack, 2)->examined = 0;
246 10372 : PARENTNODE(stack, 3)->examined = 0;
247 :
248 10372 : ++reduction_counter;
249 10372 : POP(stack, 3);
250 10372 : D {printf("B reduction, after: "); print_graph(root, 0, TOPNODE(stack)->sn);}
251 10372 : T print_graph(root, 0, 0);
252 10372 : SS;
253 : } else
254 41 : POP(stack, 1);
255 10413 : break;
256 : case COMB_C:
257 1563 : D printf("C combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));
258 1563 : if (STACK_SIZE(stack) > 4)
259 : {
260 1551 : struct node *ltmp = PARENTNODE(stack, 3)->left;
261 1551 : struct node *rtmp = PARENTNODE(stack, 3)->right;
262 1551 : D {printf("C reduction, before: "); print_graph(root, TOPNODE(stack)->sn, 0);}
263 1551 : SS;
264 1551 : PARENTNODE(stack, 3)->left
265 : = new_application(
266 : PARENTNODE(stack, 1)->right,
267 : PARENTNODE(stack, 3)->right
268 : );
269 1551 : ++PARENTNODE(stack, 3)->left->refcnt;
270 1551 : PARENTNODE(stack, 3)->right
271 : = PARENTNODE(stack, 2)->right;
272 1551 : ++PARENTNODE(stack, 3)->right->refcnt;
273 :
274 1551 : free_node(ltmp);
275 1551 : free_node(rtmp);
276 :
277 1551 : PARENTNODE(stack, 1)->examined = 0;
278 1551 : PARENTNODE(stack, 2)->examined = 0;
279 1551 : PARENTNODE(stack, 3)->examined = 0;
280 1551 : ++reduction_counter;
281 1551 : POP(stack, 3);
282 1551 : D{printf("C reduction, after: "); print_graph(root, 0, TOPNODE(stack)->sn);}
283 1551 : T print_graph(root, 0, 0);
284 1551 : SS;
285 : } else
286 12 : POP(stack, 1);
287 1563 : break;
288 : case COMB_W:
289 26061360 : D printf("W combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));
290 26061360 : if (STACK_SIZE(stack) > 3)
291 : {
292 26061356 : struct node *ltmp = PARENTNODE(stack, 2)->left;
293 26061356 : D{printf("W reduction, before: "); print_graph(root, TOPNODE(stack)->sn, TOPNODE(stack)->sn);}
294 26061356 : SS;
295 26061356 : PARENTNODE(stack, 2)->left
296 : = new_application(
297 : PARENTNODE(stack, 1)->right,
298 : PARENTNODE(stack, 2)->right
299 : );
300 26061356 : ++PARENTNODE(stack, 2)->left->refcnt;
301 26061356 : PARENTNODE(stack, 1)->examined = 0;
302 26061356 : PARENTNODE(stack, 2)->examined = 0;
303 26061356 : free_node(ltmp);
304 26061356 : ++reduction_counter;
305 26061356 : POP(stack, 2);
306 26061356 : D{printf("W reduction, after: "); print_graph(root, 0, TOPNODE(stack)->sn);}
307 26061356 : T print_graph(root, 0, 0);
308 26061356 : SS;
309 : } else
310 4 : POP(stack, 1);
311 26061360 : break;
312 : case COMB_NONE: /* A combinator that's not a built-in */
313 710 : D{printf("%s, no reduction: ", TOPNODE(stack)->name); print_graph(root, 0, TOPNODE(stack)->sn);}
314 710 : POP(stack, 1);
315 710 : D{printf("after pop: "); print_graph(root, 0, TOPNODE(stack)->sn);}
316 : break;
317 : }
318 26103867 : break; /* end of case COMBINATOR, switch on node->cn */
319 : case UNTYPED:
320 0 : POP(stack, 1);
321 : break;
322 : }
323 :
324 78352942 : if (max_reduction_count > 0
325 : && reduction_counter > max_reduction_count)
326 : /* The 4 means "too many reductions" */
327 0 : siglongjmp(in_reduce_graph, 4);
328 : }
329 :
330 2130 : pop_spine_stack(&stack);
331 2130 : D printf("pop spine stack\n");
332 :
333 2130 : } while (stack);
334 345 : }
335 :
336 : /* Control can longjmp() back to reduce_tree()
337 : * in grammar.y for certain input(s). */
338 : int
339 : read_line(void)
340 0 : {
341 : char buf[64];
342 0 : *buf = 'A';
343 : do {
344 0 : printf("continue? ");
345 0 : fflush(stdout);
346 0 : fgets(buf, sizeof(buf), stdin);
347 0 : if (*buf == 'x' || *buf == 'e') exit(0);
348 0 : if (*buf == 'n' || *buf == 'q') siglongjmp(in_reduce_graph, 3);
349 0 : if (*buf == 'c') single_step = 0;
350 0 : if (*buf == '?')
351 : {
352 0 : fprintf(stderr,
353 : "e, x -> exit now\n"
354 : "n, q -> terminate current reduction, return to top level\n"
355 : "c -> continue current reduction without further stops\n"
356 : );
357 : }
358 0 : } while ('?' == *buf);
359 0 : return single_step;
360 : }
|
