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 703 : {
49 703 : print_tree(node, sn_to_reduce, current_sn);
50 703 : putc('\n', stdout);
51 703 : }
52 :
53 : /* Graph reduction function. Destructively modifies the graph passed in.
54 : */
55 : void
56 : reduce_graph(struct node *root)
57 385 : {
58 385 : struct spine_stack *stack = NULL;
59 385 : unsigned long reduction_counter = 0;
60 :
61 385 : push_spine_stack(&stack);
62 :
63 385 : PUSHNODE(stack, root);
64 :
65 : do {
66 :
67 225182870 : while (STACK_NOT_EMPTY(stack))
68 : {
69 225178354 : switch (TOPNODE(stack)->typ)
70 : {
71 : case APPLICATION:
72 150132808 : if (!LEFT_BRANCH_TRAVERSED(TOPNODE(stack)))
73 : {
74 150126778 : TOPNODE(stack)->updateable = &(TOPNODE(stack)->left);
75 150126778 : TOPNODE(stack)->branch_marker = LEFT;
76 150126778 : MARK_LEFT_BRANCH_TRAVERSED(TOPNODE(stack));
77 150126778 : PUSHNODE(stack, TOPNODE(stack)->left);
78 150126773 : D printf("push left branch on current stack\n");
79 6030 : } else if (!RIGHT_BRANCH_TRAVERSED(TOPNODE(stack))) {
80 1879 : struct node *tmp = TOPNODE(stack);
81 1879 : MARK_RIGHT_BRANCH_TRAVERSED(TOPNODE(stack));
82 1879 : D printf("push right branch on new stack\n");
83 1879 : TOPNODE(stack)->updateable = &(TOPNODE(stack)->right);
84 1879 : TOPNODE(stack)->branch_marker = RIGHT;
85 1879 : push_spine_stack(&stack);
86 1879 : PUSHNODE(stack, tmp); /* "dummy" node at top of stack */
87 1879 : PUSHNODE(stack, tmp->right);
88 : } else
89 4151 : POP(stack, 1); /* both sides of application node traversed */
90 150132803 : 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 75045545 : if (stack->top > stack->maxdepth) stack->maxdepth = stack->top;
95 75045545 : switch (TOPNODE(stack)->cn)
96 : {
97 : case COMB_I:
98 3516 : 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 3516 : if (STACK_SIZE(stack) > 2)
103 : {
104 3266 : D {printf("I reduction, before: "); print_graph(root, TOPNODE(stack)->sn, TOPNODE(stack)->sn);}
105 3266 : SS;
106 3266 : *(PARENTNODE(stack, 2)->updateable)
107 : = PARENTNODE(stack, 1)->right;
108 3266 : ++PARENTNODE(stack, 1)->right->refcnt;
109 3266 : PARENTNODE(stack, 2)->examined ^= PARENTNODE(stack, 2)->branch_marker;
110 3266 : PARENTNODE(stack, 1)->examined = 0;
111 3266 : free_node(PARENTNODE(stack, 1));
112 3266 : POP(stack, 2);
113 3266 : D{printf("I reduction, after (%d): ", STACK_SIZE(stack)); print_graph(root, 0, TOPNODE(stack)->sn);}
114 3266 : T print_graph(root, 0, 0);
115 3266 : SS;
116 : } else
117 250 : POP(stack, 1);
118 3516 : break;
119 : case COMB_K:
120 10889 : D printf("K combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));
121 10889 : if (STACK_SIZE(stack) > 3)
122 : {
123 10352 : D {printf("K reduction, before: "); print_graph(root, TOPNODE(stack)->sn, 0);}
124 10352 : SS;
125 10352 : *(PARENTNODE(stack, 3)->updateable) = PARENTNODE(stack, 1)->right;
126 10352 : ++PARENTNODE(stack, 1)->right->refcnt;
127 10352 : PARENTNODE(stack, 1)->examined ^= LEFT;
128 10352 : PARENTNODE(stack, 2)->examined ^= LEFT;
129 10352 : PARENTNODE(stack, 3)->examined ^= PARENTNODE(stack, 3)->branch_marker;
130 10352 : free_node(PARENTNODE(stack, 2));
131 10352 : ++reduction_counter;
132 10352 : POP(stack, 3);
133 10352 : D {printf("K reduction, after: "); print_graph(root, 0, TOPNODE(stack)->sn);}
134 10352 : T print_graph(root, 0, 0);
135 10352 : SS;
136 : } else
137 537 : POP(stack, 1);
138 10889 : break;
139 : case COMB_T:
140 : /* T x y -> y x */
141 19 : D printf("T combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));
142 19 : if (STACK_SIZE(stack) > 3)
143 : {
144 : struct node *n;
145 9 : struct node *tmp = *(PARENTNODE(stack, 3)->updateable);
146 9 : D {printf("T reduction, before: "); print_graph(root, TOPNODE(stack)->sn, 0);}
147 9 : SS;
148 9 : n = new_application(
149 : PARENTNODE(stack, 2)->right,
150 : PARENTNODE(stack, 1)->right
151 : );
152 9 : PARENTNODE(stack, 1)->examined ^= LEFT;
153 9 : PARENTNODE(stack, 2)->examined ^= LEFT;
154 9 : PARENTNODE(stack, 3)->examined ^= PARENTNODE(stack, 3)->branch_marker;
155 9 : *(PARENTNODE(stack, 3)->updateable) = n;
156 9 : ++n->refcnt;
157 9 : free_node(tmp);
158 9 : ++reduction_counter;
159 9 : POP(stack, 3);
160 9 : D {printf("T reduction, after: "); print_graph(root, 0, TOPNODE(stack)->sn);}
161 9 : T print_graph(root, 0, 0);
162 9 : SS;
163 : } else
164 10 : POP(stack, 1);
165 19 : break;
166 : case COMB_M:
167 : /* M x -> x x */
168 52120117 : D printf("M combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));
169 52120117 : if (STACK_SIZE(stack) > 2)
170 : {
171 : struct node *n;
172 52120110 : struct node *tmp = *(PARENTNODE(stack, 2)->updateable);
173 52120110 : D {printf("M reduction, before: "); print_graph(root, TOPNODE(stack)->sn, 0);}
174 52120110 : SS;
175 52120109 : n = new_application(
176 : PARENTNODE(stack, 1)->right,
177 : PARENTNODE(stack, 1)->right
178 : );
179 52120109 : PARENTNODE(stack, 1)->examined ^= LEFT;
180 52120109 : PARENTNODE(stack, 2)->examined ^= PARENTNODE(stack, 2)->branch_marker;
181 52120109 : *(PARENTNODE(stack, 2)->updateable) = n;
182 52120109 : ++n->refcnt;
183 52120109 : free_node(tmp);
184 52120109 : ++reduction_counter;
185 52120109 : POP(stack, 2);
186 52120109 : D {printf("M reduction, after: "); print_graph(root, 0, TOPNODE(stack)->sn);}
187 52120109 : SS;
188 : } else
189 7 : POP(stack, 1);
190 52120115 : break;
191 : case COMB_S:
192 15563 : D printf("S combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));
193 15563 : if (STACK_SIZE(stack) > 4)
194 : {
195 15266 : struct node *n3 = PARENTNODE(stack, 3);
196 15266 : struct node *ltmp = n3->left;
197 15266 : struct node *rtmp = n3->right;
198 15266 : D {printf("S reduction, before: "); print_graph(root, TOPNODE(stack)->sn, 0); }
199 15266 : SS;
200 15266 : n3->left = new_application(
201 : PARENTNODE(stack, 1)->right,
202 : n3->right
203 : );
204 15266 : ++n3->left->refcnt;
205 15266 : n3->right = new_application(
206 : PARENTNODE(stack, 2)->right,
207 : n3->right
208 : );
209 15266 : ++n3->right->refcnt;
210 15266 : PARENTNODE(stack, 1)->examined = 0;
211 15266 : PARENTNODE(stack, 2)->examined = 0;
212 15266 : free_node(ltmp);
213 15266 : free_node(rtmp);
214 15266 : n3->examined = 0;
215 15266 : ++reduction_counter;
216 15266 : POP(stack, 3);
217 15266 : D {printf("S reduction, after: "); print_graph(root, 0, TOPNODE(stack)->sn);}
218 15266 : T print_graph(root, 0, 0);
219 15266 : SS;
220 : } else
221 297 : POP(stack, 1);
222 15563 : break;
223 : case COMB_B:
224 10498 : D {printf("B combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));}
225 10498 : if (STACK_SIZE(stack) > 4)
226 : {
227 10439 : struct node *ltmp = PARENTNODE(stack, 3)->left;
228 10439 : struct node *rtmp = PARENTNODE(stack, 3)->right;
229 10439 : D {printf("B reduction, before: "); print_graph(root, TOPNODE(stack)->sn, 0);}
230 10439 : SS;
231 10439 : PARENTNODE(stack, 3)->left
232 : = PARENTNODE(stack, 1)->right;
233 10439 : ++PARENTNODE(stack, 3)->left->refcnt;
234 10439 : PARENTNODE(stack, 3)->right
235 : = new_application(
236 : PARENTNODE(stack, 2)->right,
237 : PARENTNODE(stack, 3)->right
238 : );
239 10439 : ++PARENTNODE(stack, 3)->right->refcnt;
240 :
241 10439 : free_node(ltmp);
242 10439 : free_node(rtmp);
243 :
244 10439 : PARENTNODE(stack, 1)->examined = 0;
245 10439 : PARENTNODE(stack, 2)->examined = 0;
246 10439 : PARENTNODE(stack, 3)->examined = 0;
247 :
248 10439 : ++reduction_counter;
249 10439 : POP(stack, 3);
250 10439 : D {printf("B reduction, after: "); print_graph(root, 0, TOPNODE(stack)->sn);}
251 10439 : T print_graph(root, 0, 0);
252 10439 : SS;
253 : } else
254 59 : POP(stack, 1);
255 10498 : break;
256 : case COMB_C:
257 1575 : D printf("C combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));
258 1575 : if (STACK_SIZE(stack) > 4)
259 : {
260 1563 : struct node *ltmp = PARENTNODE(stack, 3)->left;
261 1563 : struct node *rtmp = PARENTNODE(stack, 3)->right;
262 1563 : D {printf("C reduction, before: "); print_graph(root, TOPNODE(stack)->sn, 0);}
263 1563 : SS;
264 1563 : PARENTNODE(stack, 3)->left
265 : = new_application(
266 : PARENTNODE(stack, 1)->right,
267 : PARENTNODE(stack, 3)->right
268 : );
269 1563 : ++PARENTNODE(stack, 3)->left->refcnt;
270 1563 : PARENTNODE(stack, 3)->right
271 : = PARENTNODE(stack, 2)->right;
272 1563 : ++PARENTNODE(stack, 3)->right->refcnt;
273 :
274 1563 : free_node(ltmp);
275 1563 : free_node(rtmp);
276 :
277 1563 : PARENTNODE(stack, 1)->examined = 0;
278 1563 : PARENTNODE(stack, 2)->examined = 0;
279 1563 : PARENTNODE(stack, 3)->examined = 0;
280 1563 : ++reduction_counter;
281 1563 : POP(stack, 3);
282 1563 : D{printf("C reduction, after: "); print_graph(root, 0, TOPNODE(stack)->sn);}
283 1563 : T print_graph(root, 0, 0);
284 1563 : SS;
285 : } else
286 12 : POP(stack, 1);
287 1575 : break;
288 : case COMB_W:
289 22882575 : D printf("W combinator %d, stack depth %d\n", TOPNODE(stack)->sn, STACK_SIZE(stack));
290 22882575 : if (STACK_SIZE(stack) > 3)
291 : {
292 22882569 : struct node *ltmp = PARENTNODE(stack, 2)->left;
293 22882569 : D{printf("W reduction, before: "); print_graph(root, TOPNODE(stack)->sn, TOPNODE(stack)->sn);}
294 22882569 : SS;
295 22882569 : PARENTNODE(stack, 2)->left
296 : = new_application(
297 : PARENTNODE(stack, 1)->right,
298 : PARENTNODE(stack, 2)->right
299 : );
300 22882569 : ++PARENTNODE(stack, 2)->left->refcnt;
301 22882569 : PARENTNODE(stack, 1)->examined = 0;
302 22882569 : PARENTNODE(stack, 2)->examined = 0;
303 22882569 : free_node(ltmp);
304 22882569 : ++reduction_counter;
305 22882569 : POP(stack, 2);
306 22882569 : D{printf("W reduction, after: "); print_graph(root, 0, TOPNODE(stack)->sn);}
307 22882569 : T print_graph(root, 0, 0);
308 22882569 : SS;
309 : } else
310 6 : POP(stack, 1);
311 22882575 : break;
312 : case COMB_NONE: /* A combinator that's not a built-in */
313 792 : D{printf("%s, no reduction: ", TOPNODE(stack)->name); print_graph(root, 0, TOPNODE(stack)->sn);}
314 791 : POP(stack, 1);
315 791 : D{printf("after pop: "); print_graph(root, 0, TOPNODE(stack)->sn);}
316 : break;
317 : }
318 75045542 : break; /* end of case COMBINATOR, switch on node->cn */
319 : case UNTYPED:
320 0 : POP(stack, 1);
321 : break;
322 : }
323 :
324 225178346 : if (max_reduction_count > 0
325 : && reduction_counter > max_reduction_count)
326 : /* The 4 means "too many reductions" */
327 2 : siglongjmp(in_reduce_graph, 4);
328 : }
329 :
330 2253 : pop_spine_stack(&stack);
331 2253 : D printf("pop spine stack\n");
332 :
333 2253 : } while (stack);
334 374 : }
335 :
336 : /* Control can longjmp() back to reduce_tree()
337 : * in grammar.y for certain input(s). */
338 : int
339 : read_line(void)
340 7 : {
341 : char buf[64];
342 7 : *buf = 'A';
343 : do {
344 7 : printf("continue? ");
345 7 : fflush(stdout);
346 7 : fgets(buf, sizeof(buf), stdin);
347 7 : if (*buf == 'x' || *buf == 'e') exit(0);
348 6 : if (*buf == 'n' || *buf == 'q') siglongjmp(in_reduce_graph, 3);
349 5 : if (*buf == 'c') single_step = 0;
350 5 : 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 5 : } while ('?' == *buf);
359 5 : return single_step;
360 : }
|
