Bug Summary

File:src/absyn.c
Warning:line 1133, column 7
Dereference of null pointer

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple x86_64-unknown-linux-gnu -analyze -disable-free -clear-ast-before-backend -disable-llvm-verifier -discard-value-names -main-file-name absyn.c -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -mrelocation-model pic -pic-level 2 -pic-is-pie -mframe-pointer=all -fmath-errno -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -fdebug-compilation-dir=/home/kfp/aldor/aldor/aldor/src -fcoverage-compilation-dir=/home/kfp/aldor/aldor/aldor/src -resource-dir /usr/local/lib/clang/18 -D PACKAGE_NAME="aldor" -D PACKAGE_TARNAME="aldor" -D PACKAGE_VERSION="1.4.0" -D PACKAGE_STRING="aldor 1.4.0" -D PACKAGE_BUGREPORT="aldor@xinutec.org" -D PACKAGE_URL="" -D PACKAGE="aldor" -D VERSION="1.4.0" -D YYTEXT_POINTER=1 -D HAVE_STDIO_H=1 -D HAVE_STDLIB_H=1 -D HAVE_STRING_H=1 -D HAVE_INTTYPES_H=1 -D HAVE_STDINT_H=1 -D HAVE_STRINGS_H=1 -D HAVE_SYS_STAT_H=1 -D HAVE_SYS_TYPES_H=1 -D HAVE_UNISTD_H=1 -D STDC_HEADERS=1 -D HAVE_LIBREADLINE=1 -D HAVE_READLINE_READLINE_H=1 -D HAVE_READLINE_HISTORY=1 -D HAVE_READLINE_HISTORY_H=1 -D USE_GLOOP_SHELL=1 -D GENERATOR_COROUTINES=0 -D HAVE_DLFCN_H=1 -D LT_OBJDIR=".libs/" -I . -D VCSVERSION="2c53e759f1e00e345f8b172e7139debda72fda13" -internal-isystem /usr/local/lib/clang/18/include -internal-isystem /usr/local/include -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/14/../../../../x86_64-linux-gnu/include -internal-externc-isystem /usr/include/x86_64-linux-gnu -internal-externc-isystem /include -internal-externc-isystem /usr/include -O0 -Wno-empty-body -Wno-enum-compare -Wno-missing-field-initializers -Wno-unused -Wno-unused-parameter -Wno-error=format -Wno-error=type-limits -Wno-error=strict-aliasing -Wno-sign-compare -Wno-error=shift-negative-value -Wno-error=clobbered -std=c99 -ferror-limit 19 -fgnuc-version=4.2.1 -fskip-odr-check-in-gmf -analyzer-output=html -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /tmp/scan-build-2026-01-15-223856-845667-1 -x c absyn.c
1/*****************************************************************************
2 *
3 * absyn.c: Abstract syntax construction and manipulation.
4 *
5 * Copyright (c) 1990-2007 Aldor Software Organization Ltd (Aldor.org).
6 *
7 ****************************************************************************/
8
9#include "axlobs.h"
10#include "debug.h"
11#include "format.h"
12#include "opsys.h"
13#include "spesym.h"
14#include "store.h"
15#include "util.h"
16#include "syme.h"
17#include "tposs.h"
18#include "doc.h"
19#include "comsg.h"
20#include "sexpr.h"
21#include "symcoinfo.h"
22
23Bool abDebug = false((int) 0);
24#define abDEBUGif (!abDebug) { } else afprintf DEBUG_IF(ab)if (!abDebug) { } else afprintf
25
26localstatic int abFormatter (OStream stream, Pointer p);
27localstatic int abFormatterList (OStream ostream, Pointer p);
28localstatic int abTagFormatter (OStream ostream, int p);
29localstatic void abPosNodeSpan0 (AbSyn X, AbSyn *pA, AbSyn *pB);
30localstatic SrcPos abLeafEnd (AbSyn ab);
31
32localstatic void
33abBugPrelude(AbSyn ab)
34{
35 sposPrint(osStdout, abPos(ab)(spstackFirst((ab)->abHdr.pos)));
36 if (abTag(ab)((ab)->abHdr.tag) == AB_Id)
37 printf(" Identifier %s:\n", symString(ab->abId.sym)((ab->abId.sym)->str));
38}
39
40static Bool abIsInit = false((int) 0);
41
42#undef Complain
43
44void
45abInit(void)
46{
47 AbSynTag i;
48 Symbol sym;
49
50 sxiInit();
51 for (i = AB_START; i < AB_LIMIT; i++) {
52 sym = symInternConst(abInfo(i).str)symProbe(abInfoTable[(i) - AB_START].str, 1);
53#if 0
54 printf("Here1 sym->val=%s, sym->info=%x, %p\n", symString(sym)((sym)->str), symInfo(sym)((sym)->info), symCoInfo(sym));fflush(stdoutstdout);
55#endif
56
57 if (symCoInfo(sym) == NULL((void*)0)) {
58#if 0
59 printf("Here1.5\n"); fflush(stdoutstdout);
60#endif
61 symCoInfoInit(sym)(((sym)->info) = &(symCoInfoNew()->align));
62 }
63#if 0
64 printf("Here2\n"); fflush(stdoutstdout);
65#endif
66 symCoInfo(sym)->abTagVal = i;
67 abInfo(i)abInfoTable[(i) - AB_START].sxsym = sxiFrSymbol(sym);
68
69 abInfo(i)abInfoTable[(i) - AB_START].hash = strHash(abInfo(i)abInfoTable[(i) - AB_START].str);
70 }
71 abIsInit = true1;
72
73 fmtRegister("AbSyn", abFormatter);
74 fmtRegister("AbSynList", abFormatterList);
75 fmtRegister("Sefo", abFormatter);
76 fmtRegister("SefoList", abFormatterList);
77 fmtRegisterI("AbTag", abTagFormatter);
78}
79
80AbSyn
81abNewEmpty(AbSynTag abtag, Length argc)
82{
83 AbSyn ab;
84 Length i;
85
86 if (!abIsInit) abInit();
87
88 ab = (AbSyn) stoAlloc((int) OB_AbSyn(14 + 4),
89 fullsizeof(struct abGen, argc, AbSyn)(sizeof(struct abGen) + (argc) * sizeof(AbSyn) - 10 * sizeof(
AbSyn))
);
90
91 ab->abGen.hdr.tag = abtag;
92 ab->abGen.hdr.argc = argc;
93
94 ab->abGen.hdr.pos = spstackEmpty;
95 ab->abGen.hdr.state = AB_State_AbSyn;
96
97 ab->abGen.hdr.use = AB_Use_LIMIT;
98
99 ab->abGen.hdr.seman = 0;
100 ab->abGen.hdr.type.poss = 0;
101
102 for (i = 0; i < argc; i++) ab->abGen.data.argv[i] = 0;
103
104 return ab;
105}
106
107localstatic AbSyn vabNew(AbSynTag abtag, SrcPos pos, UByte flags, Length argc, va_list argp);
108
109AbSyn
110abNewMod(AbSynTag abtag, SrcPos pos, UByte mod, Length argc, ...)
111{
112 va_list argp;
113 va_start(argp, argc)__builtin_va_start(argp, argc);
114 AbSyn ab = vabNew(abtag, pos, mod, argc, argp);
115 va_end(argp)__builtin_va_end(argp);
116 return ab;
117}
118
119AbSyn
120abNew(AbSynTag abtag, SrcPos pos, Length argc, ...)
121{
122 va_list argp;
123 va_start(argp, argc)__builtin_va_start(argp, argc);
124 AbSyn ab = vabNew(abtag, pos, 0, argc, argp);
125 va_end(argp)__builtin_va_end(argp);
126 return ab;
127}
128
129localstatic AbSyn
130vabNew(AbSynTag abtag, SrcPos pos, UByte flags, Length argc, va_list argp)
131{
132 AbSyn ab;
133 Length i;
134
135 ab = abNewEmpty(abtag, argc);
136 ab->abHdr.flags = flags;
137 abSetPos(ab, pos)((ab)->abHdr.pos=spstackSetFirst ((ab)->abHdr.pos,(pos)
))
;
138
139 if (abIsSymTag(abtag)( (abtag) < AB_SYM_LIMIT))
140 abLeafSym(ab)((ab)->abGen.data.sym) = va_arg(argp, Symbol)__builtin_va_arg(argp, Symbol);
141 else if (abIsDocTag(abtag)( AB_DOC_START <= (abtag) && (abtag) < AB_DOC_LIMIT
)
)
142 abLeafDoc(ab)((ab)->abGen.data.doc) = va_arg(argp, Doc)__builtin_va_arg(argp, Doc);
143 else if (abIsStrTag(abtag)( AB_STR_START <= (abtag) && (abtag) < AB_STR_LIMIT
)
)
144 abLeafStr(ab)((ab)->abGen.data.str) = strCopy(va_arg(argp, String)__builtin_va_arg(argp, String));
145 else {
146 for (i = 0; i < argc; i++)
147 abArgv(ab)((ab)->abGen.data.argv)[i] = va_arg(argp, AbSyn)__builtin_va_arg(argp, AbSyn);
148 if (argc > 0) abSetEnd(ab, abEnd(abArgv(ab)((ab)->abGen.data.argv)[argc-1]));
149 }
150
151 return ab;
152}
153
154AbSyn
155abNewOfToken(AbSynTag abtag, Token tok)
156{
157 AbSyn ab;
158
159 ab = abNewEmpty(abtag, 1);
160
161 abSetPos(ab, tok->pos)((ab)->abHdr.pos=spstackSetFirst ((ab)->abHdr.pos,(tok->
pos)))
;
162
163 if (abIsSymTag(abtag)( (abtag) < AB_SYM_LIMIT)) {
164 if (tokHasString(tok)((tokInfoTable[((tok)->tag)-TK_START]).hasString))
165 abLeafSym(ab)((ab)->abGen.data.sym) = symIntern(tok->val.str)symProbe(tok->val.str, 1 | 2);
166 else
167 abLeafSym(ab)((ab)->abGen.data.sym) = tok->val.sym;
168 }
169 else if (abIsStrTag(abtag)( AB_STR_START <= (abtag) && (abtag) < AB_STR_LIMIT
)
) {
170 if (tokHasString(tok)((tokInfoTable[((tok)->tag)-TK_START]).hasString))
171 abLeafStr(ab)((ab)->abGen.data.str) = strCopy(tok->val.str);
172 else
173 abLeafStr(ab)((ab)->abGen.data.str) = strCopy(symString(tok->val.sym)((tok->val.sym)->str));
174 }
175 else {
176 AbSyn ab = abNewNothing(tok->pos)abNew(AB_Nothing, tok->pos,0 );
177 String msg = "cannot make this kind of absyn from a token.";
178 comsgFatal(ab, ALDOR_F_Bug365, msg);
179 /*bug("Cannot make this kind of abstract syntax from a token.");*/
180 }
181
182 if (!tokHasString(tok)((tokInfoTable[((tok)->tag)-TK_START]).hasString)) {
183 if ((sposChar(tok->pos) + strlen(symString(tok->val.sym)((tok->val.sym)->str))) < (sposChar(tok->end)))
184 abSetEnd(ab, tok->end-1);
185 }
186 else {
187 if ((sposChar(tok->pos) + strlen(tok->val.str)) < (sposChar(tok->end)))
188 abSetEnd(ab, tok->end-1);
189 }
190 return ab;
191}
192
193AbSyn
194abNewOfList(AbSynTag abtag, SrcPos pos, AbSynList args)
195{
196 AbSyn ab;
197 Length i, argc;
198
199 argc = listLength(AbSyn)(AbSyn_listPointer->_Length)(args);
200
201 ab = abNewEmpty(abtag, argc);
202 abSetPos(ab, pos)((ab)->abHdr.pos=spstackSetFirst ((ab)->abHdr.pos,(pos)
))
;
203
204 for (i = 0; i < argc; i++, args = cdr(args)((args)->rest))
205 abArgv(ab)((ab)->abGen.data.argv)[i] = car(args)((args)->first);
206 if (argc > 0) abSetEnd(ab, abEnd(abArgv(ab)((ab)->abGen.data.argv)[argc-1]));
207
208 return ab;
209}
210
211AbSyn
212abNewOfOpAndList(AbSynTag abtag, SrcPos pos, AbSyn op, AbSynList args)
213{
214 AbSyn ab;
215 Length i, argc;
216
217 argc = listLength(AbSyn)(AbSyn_listPointer->_Length)(args) + 1;
218
219 ab = abNewEmpty(abtag, argc);
220 abSetPos(ab, pos)((ab)->abHdr.pos=spstackSetFirst ((ab)->abHdr.pos,(pos)
))
;
221
222 abArgv(ab)((ab)->abGen.data.argv)[0] = op;
223
224 for (i = 1; i < argc; i++, args = cdr(args)((args)->rest))
225 abArgv(ab)((ab)->abGen.data.argv)[i] = car(args)((args)->first);
226 if (argc > 0) abSetEnd(ab, abEnd(abArgv(ab)((ab)->abGen.data.argv)[argc-1]));
227
228 return ab;
229}
230
231AbSyn
232abNewAndAll(SrcPos pos, AbSynList absyn)
233{
234 if (cdr(absyn)((absyn)->rest) == listNil(AbSyn)((AbSynList) 0))
235 return car(absyn)((absyn)->first);
236
237 return abNewAnd(pos, car(absyn), abNewAndAll(pos, cdr(absyn)))abNew(AB_And, pos,2, ((absyn)->first),abNewAndAll(pos, ((absyn
)->rest)))
;
238}
239AbSyn
240abNewOrAll(SrcPos pos, AbSynList absyn)
241{
242 if (cdr(absyn)((absyn)->rest) == listNil(AbSyn)((AbSynList) 0))
243 return car(absyn)((absyn)->first);
244 return abNewOr(pos, car(absyn), abNewOrAll(pos, cdr(absyn)))abNew(AB_Or, pos,2, ((absyn)->first),abNewOrAll(pos, ((absyn
)->rest)))
;
245}
246
247void
248abFree(AbSyn ab)
249{
250 int i;
251
252 if (!ab) return;
253
254 if (abIsSymTag(abTag(ab))( (((ab)->abHdr.tag)) < AB_SYM_LIMIT))
255 ; /* Nothing */
256 else if (abIsDocTag(abTag(ab))( AB_DOC_START <= (((ab)->abHdr.tag)) && (((ab)
->abHdr.tag)) < AB_DOC_LIMIT)
)
257 docFree(abLeafDoc(ab)((ab)->abGen.data.doc));
258 else if (abIsStrTag(abTag(ab))( AB_STR_START <= (((ab)->abHdr.tag)) && (((ab)
->abHdr.tag)) < AB_STR_LIMIT)
)
259 strFree(abLeafStr(ab)((ab)->abGen.data.str));
260 else
261 for (i = 0; i < abArgc(ab)((ab)->abHdr.argc); i++) abFree(abArgv(ab)((ab)->abGen.data.argv)[i]);
262
263 if (abTForm(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->tform : 0))
264 tfReleaseExpr(abTForm(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->tform : 0), ab);
265
266 if (ab->abHdr.seman)
267 stoFree((Pointer) ab->abHdr.seman);
268
269 stoFree((Pointer) ab);
270}
271
272void
273abFreeNode(AbSyn ab)
274{
275 if (!ab) return;
276
277 stoFree((Pointer) ab);
278}
279
280Bool
281abHasSymbol(AbSyn ab, Symbol sym)
282{
283 int i;
284
285 if (!ab) return false((int) 0);
286
287 if (abTag(ab)((ab)->abHdr.tag) == AB_Id) {
288 return ab->abId.sym == sym;
289 }
290 else if (abIsLeaf(ab)(((ab)->abHdr.tag) < AB_NODE_START)) {
291 return false((int) 0);
292 }
293 else {
294 for (i = 0; i < abArgc(ab)((ab)->abHdr.argc); i++)
295 if (abHasSymbol(abArgv(ab)((ab)->abGen.data.argv)[i], sym)) return true1;
296 return false((int) 0);
297 }
298}
299
300AbSyn
301abCopy(AbSyn ab)
302{
303 AbSyn abnew;
304 int i;
305
306 if (! ab)
307 return ab;
308
309 abnew = abNewEmpty(abTag(ab)((ab)->abHdr.tag), abArgc(ab)((ab)->abHdr.argc));
310
311 if (abIsSymTag(abTag(ab))( (((ab)->abHdr.tag)) < AB_SYM_LIMIT))
312 abLeafSym(abnew)((abnew)->abGen.data.sym) = abLeafSym(ab)((ab)->abGen.data.sym);
313 else if (abIsDocTag(abTag(ab))( AB_DOC_START <= (((ab)->abHdr.tag)) && (((ab)
->abHdr.tag)) < AB_DOC_LIMIT)
)
314 abLeafDoc(abnew)((abnew)->abGen.data.doc) = docCopy(abLeafDoc(ab)((ab)->abGen.data.doc));
315 else if (abIsStrTag(abTag(ab))( AB_STR_START <= (((ab)->abHdr.tag)) && (((ab)
->abHdr.tag)) < AB_STR_LIMIT)
)
316 abLeafStr(abnew)((abnew)->abGen.data.str) = strCopy(abLeafStr(ab)((ab)->abGen.data.str));
317 else
318 for (i = 0; i < abArgc(ab)((ab)->abHdr.argc); i++)
319 abArgv(abnew)((abnew)->abGen.data.argv)[i] = abCopy(abArgv(ab)((ab)->abGen.data.argv)[i]);
320
321 abnew->abHdr.pos = spstackCopy(ab->abHdr.pos);
322
323 if (abHasTag(ab, AB_Id)((ab)->abHdr.tag == (AB_Id)) && abComment(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->comment : 0))
324 abSetComment(abnew, docCopy(abComment(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->comment : 0)));
325
326 return abnew;
327}
328
329AbSyn
330abReposition(AbSyn ab, SrcPos pos, SrcPos end)
331{
332 if (ab) {
333 abSetPos(ab, pos)((ab)->abHdr.pos=spstackSetFirst ((ab)->abHdr.pos,(pos)
))
;
334 abSetEnd(ab, end);
335 if (! abIsLeaf(ab)(((ab)->abHdr.tag) < AB_NODE_START)) {
336 int i;
337 for (i = 0; i < abArgc(ab)((ab)->abHdr.argc); i++)
338 abReposition(abArgv(ab)((ab)->abGen.data.argv)[i], pos, end);
339 }
340 }
341 return ab;
342}
343
344AbSyn
345abMarkAsMacroExpanded(AbSyn ab)
346{
347 if (ab) {
348 abSetPos(ab, sposMacroExpanded(abPos(ab)))((ab)->abHdr.pos=spstackSetFirst ((ab)->abHdr.pos,(sposMacroExpanded
((spstackFirst((ab)->abHdr.pos))))))
;
349 abSetEnd(ab, sposMacroExpanded(abEnd(ab)));
350 if (!abIsLeaf(ab)(((ab)->abHdr.tag) < AB_NODE_START)) {
351 int i;
352 for (i = 0; i < abArgc(ab)((ab)->abHdr.argc); i++)
353 abMarkAsMacroExpanded(abArgv(ab)((ab)->abGen.data.argv)[i]);
354 }
355 }
356 return ab;
357}
358
359Length
360abTreeHeight(AbSyn ab)
361{
362 int i, n;
363 Length hi, hn;
364
365 if (!ab) return 0;
366 if (abIsLeaf(ab)(((ab)->abHdr.tag) < AB_NODE_START)) return 1;
367
368 n = abArgc(ab)((ab)->abHdr.argc);
369 hn = 0;
370
371 for (i = 0; i < n; i++) {
372 hi = abTreeHeight(abArgv(ab)((ab)->abGen.data.argv)[i]);
373 if (hi > hn) hn = hi;
374 }
375 return hn + 1;
376}
377
378Bool
379abContains(AbSyn ab, AbSyn target)
380{
381 if (abEqual(ab, target))
382 return true1;
383 else if (abIsLeaf(ab)(((ab)->abHdr.tag) < AB_NODE_START)) {
384 return false((int) 0);
385 }
386 else {
387 int i;
388 for (i=0; i<abArgc(ab)((ab)->abHdr.argc); i++) {
389 if (abContains(abArgv(ab)((ab)->abGen.data.argv)[i], target))
390 return true1;
391 }
392 return false((int) 0);
393 }
394}
395
396/*
397 * To find a node in a given tree: path = abPathToNode(r,n, eql, &len, 0);
398 * If the equality tester "eql" is 0, then "==" is used.
399 * If len >= 0, then the node was found.
400 */
401AIntList
402abPathToNode(AbSyn root, AbSyn node, Bool (*eql)(AbSyn, AbSyn),
403 int *plen, AIntList rpathsofar)
404{
405 struct AIntListCons succell;
406 int i;
407 AIntList path;
408
409 if ((!eql && node == root) || (eql && eql(node, root))) {
410 if (sposCmp(abPos(root)(spstackFirst((root)->abHdr.pos)), abPos(node)(spstackFirst((node)->abHdr.pos))) == 0) {
411 *plen = listLength(AInt)(AInt_listPointer->_Length)(rpathsofar);
412 return listReverse(AInt)(AInt_listPointer->Reverse)(rpathsofar);
413 }
414 }
415
416 if (!root || abIsLeaf(root)(((root)->abHdr.tag) < AB_NODE_START)) {
417 *plen = -1;
418 return 0;
419 }
420
421 setcdr(&succell, rpathsofar)((&succell)->rest = (rpathsofar));
422
423 for (i = 0; i < abArgc(root)((root)->abHdr.argc); i++) {
424 setcar(&succell, i)((&succell)->first = (i));
425 path = abPathToNode(abArgv(root)((root)->abGen.data.argv)[i],node,eql,plen,&succell);
426 if (*plen >= 0) return path;
427 }
428
429 *plen = -1;
430 return 0;
431}
432
433/*
434 * Find leftmost smallest subtree with positions spanning pos.
435 * The psubtree argument is updated with the smallest containing tree.
436 */
437#define AbContToLeft0 0
438#define AbContToRight1 1
439#define AbContInside2 2
440#define AbContCantTell3 3
441
442localstatic int
443abContainer0(AbSyn root, SrcPos pos, AbSyn *psubtree)
444{
445 if (abIsLeaf(root)(((root)->abHdr.tag) < AB_NODE_START)) {
446 SrcPos posS = abPos(root)(spstackFirst((root)->abHdr.pos));
447 SrcPos posE = abEnd(root);
448
449 if (psubtree) *psubtree = 0;
450
451 if (sposIsSpecial(posS)) return AbContCantTell3;
452
453 if (psubtree) *psubtree = root;
454
455 if (sposCmp(posE,pos) < 0) return AbContToRight1;
456 if (sposCmp(pos, posS) > 0) return AbContToLeft0;
457
458 return AbContInside2;
459 }
460 else {
461 int i, n, rc;
462 Bool anyToLeft, anyToRight;
463
464 n = abArgc(root)((root)->abHdr.argc);
465 assert(n > 0)do { if (!(n > 0)) _do_assert(("n > 0"),"absyn.c",465);
} while (0)
;
466
467 anyToLeft = false((int) 0);
468 anyToRight = false((int) 0);
469
470 for (i = 0; i < n; i++) {
471 rc = abContainer0(abArgv(root)((root)->abGen.data.argv)[i], pos, psubtree);
472 switch (rc) {
473 case AbContInside2: return AbContInside2;
474 case AbContToLeft0: anyToLeft = true1; break;
475 case AbContToRight1: anyToRight = true1; break;
476 }
477 }
478 if (anyToLeft && anyToRight) {
479 if (psubtree) *psubtree = root;
480 return AbContInside2;
481 }
482 if (anyToLeft) return AbContToLeft0;
483 if (anyToRight) return AbContToRight1;
484 return AbContCantTell3;
485 }
486}
487
488AbSyn
489abContainer(AbSyn root, SrcPos pos)
490{
491 AbSyn subtree;
492 abContainer0(root, pos, &subtree);
493 return subtree;
494}
495
496/*
497 * Find the leftmost smallest subtree containing both a and b.
498 * If eql is 0 then `==' is used as the comparison.
499 */
500
501AbSyn
502abSupremum(AbSyn root, AbSyn a, AbSyn b, Bool (*eql)(AbSyn, AbSyn))
503{
504 int la, lb;
505 AIntList pa, pb, ta, tb;
506
507 pa = abPathToNode(root, a, eql, &la, (AIntList) NULL((void*)0));
508 pb = abPathToNode(root, b, eql, &lb, (AIntList) NULL((void*)0));
509
510 if (la == -1 || lb == -1) return 0;
511
512 for (ta = pa, tb = pb; ta && tb; ta = cdr(ta)((ta)->rest), tb = cdr(tb)((tb)->rest)) {
513 if (car(ta)((ta)->first) != car(tb)((tb)->first)) break;
514 if (car(ta)((ta)->first)) root = abArgv(root)((root)->abGen.data.argv)[car(ta)((ta)->first)];
515 }
516 listFree(AInt)(AInt_listPointer->Free)(pa);
517 listFree(AInt)(AInt_listPointer->Free)(pb);
518
519 return root;
520}
521
522
523/*
524 * Print a piece of abstract syntax, limitting the number of nodes shown.
525 */
526
527localstatic int
528abPrintClipped0(FILE *fout, AbSyn ab, int *pMaxNodes)
529{
530 int cc;
531 Length i;
532
533 if (!ab) return 0;
534
535 if (*pMaxNodes == 0) return fprintf(fout, "...");
536
537 (*pMaxNodes)--;
538
539 switch (abTag(ab)((ab)->abHdr.tag)) {
540 case AB_Nothing:
541 cc = fprintf(fout, "_");
542 break;
543
544 case AB_Blank:
545 case AB_IdSy:
546 case AB_Id:
547 cc = fprintf(fout, "%s", symString(abLeafSym(ab))((((ab)->abGen.data.sym))->str));
548 break;
549 case AB_DocText:
550 findent += 2;
551 cc = fprintf(fout, "++%s", docString(ab->abDocText.doc)((ab->abDocText.doc)->corpus));
552 findent -= 2;
553 break;
554 case AB_LitInteger:
555 case AB_LitString:
556 case AB_LitFloat:
557 cc = fprintf(fout, "%.3s: %s",
558 abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].str,
559 abLeafStr(ab)((ab)->abGen.data.str));
560 break;
561 case AB_Sequence:
562 findent += 2;
563 cc = fprintf(fout, "[%.4s: ", abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].str);
564 cc += fnewline(fout);
565 for (i = 0; i < ab->abHdr.argc; i++) {
566 cc += abPrintClipped0(fout,
567 ab->abSequence.argv[i], pMaxNodes);
568 cc += fnewline(fout);
569 if (*pMaxNodes == 0) {
570 cc += fprintf(fout, "...");
571 break;
572 }
573 }
574 cc += fprintf(fout, "]");
575 cc += fnewline(fout);
576 findent -= 2;
577 break;
578 default:
579 cc = fprintf(fout, "[%s%.4s: ",
580 ((AB_Apply == abTag(ab)((ab)->abHdr.tag)) && abStab(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->stab : 0)) ? "*" : "",
581 abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].str);
582 for (i = 0; i < ab->abHdr.argc; i++) {
583 cc += abPrintClipped0(fout,
584 abArgv(ab)((ab)->abGen.data.argv)[i], pMaxNodes);
585 if (i < ab->abHdr.argc-1) cc += fprintf(fout, " ");
586 if (*pMaxNodes == 0) {
587 cc += fprintf(fout, "...");
588 break;
589 }
590 }
591 cc += fprintf(fout, "]");
592 }
593 return cc;
594}
595
596int
597abPrintClipped(FILE *fout, AbSyn ab, int maxNodes)
598{
599 return abPrintClipped0(fout, ab, &maxNodes);
600}
601
602int
603abPrintClippedDb(AbSyn ab, int maxNodes)
604{
605 int rc = abPrintClipped0(dbOut, ab, &maxNodes);
606 fnewline(dbOut);
607 return rc;
608}
609
610int
611abPrint(FILE *fout, AbSyn ab)
612{
613 return abPrintClipped(fout, ab, -1);
614}
615
616int
617abPrintDb(AbSyn ab)
618{
619 int rc = abPrintClipped(dbOut, ab, -1);
620 fnewline(dbOut);
621 return rc;
622}
623
624/*
625 * Syntactic comparison.
626 */
627
628Bool
629abEqual(AbSyn a, AbSyn b)
630{
631 Length i;
632
633 if (!a || !b) return a == b;
634
635 if (abTag(a)((a)->abHdr.tag) != abTag(b)((b)->abHdr.tag) || abArgc(a)((a)->abHdr.argc) != abArgc(b)((b)->abHdr.argc))
636 return false((int) 0);
637
638 if (abIsLeaf(a)(((a)->abHdr.tag) < AB_NODE_START)) {
639 switch (abTag(a)((a)->abHdr.tag)) {
640 case AB_Id:
641 case AB_IdSy:
642 case AB_Blank:
643 return abLeafSym(a)((a)->abGen.data.sym) == abLeafSym(b)((b)->abGen.data.sym);
644 case AB_LitInteger:
645 case AB_LitString:
646 case AB_LitFloat:
647 return strEqual(abLeafStr(a)((a)->abGen.data.str), abLeafStr(b)((b)->abGen.data.str));
648 default:
649 for (i = 0; i < abArgc(a)((a)->abHdr.argc); i++)
650 if (!strEqual((String) abArgv(a)((a)->abGen.data.argv)[i],
651 (String) abArgv(b)((b)->abGen.data.argv)[i]))
652 {
653 return false((int) 0);
654 }
655 }
656 }
657 else {
658 for (i = 0; i < abArgc(a)((a)->abHdr.argc); i++)
659 if (!abEqual(abArgv(a)((a)->abGen.data.argv)[i], abArgv(b)((b)->abGen.data.argv)[i]))
660 return false((int) 0);
661 }
662 return true1;
663}
664
665localstatic AbSyn
666abEqualDeclMods(AbSyn ab, Bool decls)
667{
668 Bool changed = (ab != NULL((void*)0));
669
670 while (changed)
671 switch (abTag(ab)((ab)->abHdr.tag)) {
672 case AB_Declare:
673 if (decls)
674 ab = ab->abDeclare.type;
675 else
676 changed = false((int) 0);
677 break;
678 case AB_Qualify:
679 ab = ab->abQualify.what;
680 break;
681 case AB_PretendTo:
682 ab = ab->abPretendTo.expr;
683 break;
684 default:
685 changed = false((int) 0);
686 break;
687 }
688
689 return ab;
690}
691
692localstatic Bool
693abEqualModDeclares0(AbSyn ab1, AbSyn ab2, Bool decls)
694{
695 if (ab1 == ab2)
696 return true1;
697
698 ab1 = abEqualDeclMods(ab1, decls);
699 ab2 = abEqualDeclMods(ab2, decls);
700
701 if (abTag(ab1)((ab1)->abHdr.tag) != abTag(ab2)((ab2)->abHdr.tag) || abArgc(ab1)((ab1)->abHdr.argc) != abArgc(ab2)((ab2)->abHdr.argc))
702 return false((int) 0);
703
704 else if (abIsLeaf(ab1)(((ab1)->abHdr.tag) < AB_NODE_START))
705 return abEqual(ab1, ab2);
706
707 else if (abHasTag(ab1, AB_Define)((ab1)->abHdr.tag == (AB_Define)))
708 return abEqualModDeclares0(ab1->abDefine.lhs,
709 ab2->abDefine.lhs, decls) &&
710 abEqualModDeclares0(ab1->abDefine.rhs,
711 ab2->abDefine.rhs, false((int) 0));
712
713 else {
714 Length i;
715 decls &= abHasTag(ab1, AB_Comma)((ab1)->abHdr.tag == (AB_Comma)) || abIsAnyMap(ab1)(((((ab1)->abHdr.tag == (AB_Apply)) && (((((ab1)->
abApply.op))->abHdr.tag == (AB_Id)) && ((((ab1)->
abApply.op))->abId.sym)==(ssymArrow))) && (((ab1)->
abHdr.argc)-1) == 2) || ((((ab1)->abHdr.tag == (AB_Apply))
&& (((((ab1)->abApply.op))->abHdr.tag == (AB_Id
)) && ((((ab1)->abApply.op))->abId.sym)==(ssymPackedArrow
))) && (((ab1)->abHdr.argc)-1) == 2))
;
716 for (i = 0; i < abArgc(ab1)((ab1)->abHdr.argc); i += 1)
717 if (!abEqualModDeclares0(abArgv(ab1)((ab1)->abGen.data.argv)[i],
718 abArgv(ab2)((ab2)->abGen.data.argv)[i], decls))
719 return false((int) 0);
720 return true1;
721 }
722}
723
724localstatic Bool
725abCompareModDeclares0(AbEqualFn eq, void *ctxt, AbSyn ab1, AbSyn ab2, Bool decls)
726{
727 if (ab1 == ab2)
728 return true1;
729
730 ab1 = abEqualDeclMods(ab1, decls);
731 ab2 = abEqualDeclMods(ab2, decls);
732
733 AbEqualValue val = eq(ctxt, ab1, ab2);
734 if (val != AbEqual_Struct) {
735 return val == AbEqual_True ? true1 : false((int) 0);
736 }
737 if (abTag(ab1)((ab1)->abHdr.tag) != abTag(ab2)((ab2)->abHdr.tag) || abArgc(ab1)((ab1)->abHdr.argc) != abArgc(ab2)((ab2)->abHdr.argc))
738 return false((int) 0);
739
740 else if (abIsLeaf(ab1)(((ab1)->abHdr.tag) < AB_NODE_START))
741 return abEqual(ab1, ab2);
742
743 else if (abHasTag(ab1, AB_Define)((ab1)->abHdr.tag == (AB_Define)))
744 return abCompareModDeclares0(eq, ctxt, ab1->abDefine.lhs,
745 ab2->abDefine.lhs, decls) &&
746 abCompareModDeclares0(eq, ctxt, ab1->abDefine.rhs,
747 ab2->abDefine.rhs, false((int) 0));
748
749 else {
750 Length i;
751 decls &= abHasTag(ab1, AB_Comma)((ab1)->abHdr.tag == (AB_Comma)) || abIsAnyMap(ab1)(((((ab1)->abHdr.tag == (AB_Apply)) && (((((ab1)->
abApply.op))->abHdr.tag == (AB_Id)) && ((((ab1)->
abApply.op))->abId.sym)==(ssymArrow))) && (((ab1)->
abHdr.argc)-1) == 2) || ((((ab1)->abHdr.tag == (AB_Apply))
&& (((((ab1)->abApply.op))->abHdr.tag == (AB_Id
)) && ((((ab1)->abApply.op))->abId.sym)==(ssymPackedArrow
))) && (((ab1)->abHdr.argc)-1) == 2))
;
752 for (i = 0; i < abArgc(ab1)((ab1)->abHdr.argc); i += 1)
753 if (!abCompareModDeclares0(eq, ctxt, abArgv(ab1)((ab1)->abGen.data.argv)[i],
754 abArgv(ab2)((ab2)->abGen.data.argv)[i], decls))
755 return false((int) 0);
756 return true1;
757 }
758}
759
760Bool
761abEqualModDeclares(AbSyn ab1, AbSyn ab2)
762{
763 return abEqualModDeclares0(ab1, ab2, true1);
764}
765
766Bool
767abCompareModDeclares(AbEqualFn eq, void *ctxt, AbSyn ab1, AbSyn ab2)
768{
769 return abCompareModDeclares0(eq, ctxt, ab1, ab2, true1);
770}
771
772/*
773 * Hash code.
774 */
775
776#define abHashArg(h, hi){ h ^= (h << 8); h += (hi) + 200041; h &= 0x3FFFFFFF
; }
{ \
777 h ^= (h << 8); \
778 h += (hi) + 200041; \
779 h &= 0x3FFFFFFF; \
780}
781
782Hash
783abHashSefo(AbSyn ab)
784{
785 Hash h = 0;
786 Length i;
787
788 if (abHasTag(ab, AB_Declare)((ab)->abHdr.tag == (AB_Declare)))
789 return abHashSefo(ab->abDeclare.type);
790 if (abHasTag(ab, AB_Qualify)((ab)->abHdr.tag == (AB_Qualify)))
791 return abHashSefo(ab->abQualify.what);
792 if (abHasTag(ab, AB_PretendTo)((ab)->abHdr.tag == (AB_PretendTo)))
793 return abHashSefo(ab->abPretendTo.expr);
794 if (abHasTag(ab, AB_RestrictTo)((ab)->abHdr.tag == (AB_RestrictTo)))
795 return abHashSefo(ab->abRestrictTo.expr);
796 if (abHasTag(ab, AB_Test)((ab)->abHdr.tag == (AB_Test)))
797 return abHashSefo(ab->abTest.cond);
798
799 if (abIsSymTag(abTag(ab))( (((ab)->abHdr.tag)) < AB_SYM_LIMIT))
800 h = strHash(symString(abLeafSym(ab))((((ab)->abGen.data.sym))->str));
801 else if (abIsDocTag(abTag(ab))( AB_DOC_START <= (((ab)->abHdr.tag)) && (((ab)
->abHdr.tag)) < AB_DOC_LIMIT)
)
802 h = strHash(docString(abLeafDoc(ab))((((ab)->abGen.data.doc))->corpus));
803 else if (abIsStrTag(abTag(ab))( AB_STR_START <= (((ab)->abHdr.tag)) && (((ab)
->abHdr.tag)) < AB_STR_LIMIT)
)
804 h = strHash(abLeafStr(ab)((ab)->abGen.data.str));
805 else if (abHasTag(ab, AB_Define)((ab)->abHdr.tag == (AB_Define))) {
806 abHashArg(h, abHashSefo(ab->abDefine.lhs)){ h ^= (h << 8); h += (abHashSefo(ab->abDefine.lhs))
+ 200041; h &= 0x3FFFFFFF; }
;
807 abHashArg(h, abHashSefo(ab->abDefine.rhs)){ h ^= (h << 8); h += (abHashSefo(ab->abDefine.rhs))
+ 200041; h &= 0x3FFFFFFF; }
;
808 }
809 else if (abTag(ab)((ab)->abHdr.tag) == AB_Lambda) {
810 abHashArg(h, abHashSefo(ab->abLambda.param)){ h ^= (h << 8); h += (abHashSefo(ab->abLambda.param
)) + 200041; h &= 0x3FFFFFFF; }
;
811 abHashArg(h, abHashSefo(ab->abLambda.rtype)){ h ^= (h << 8); h += (abHashSefo(ab->abLambda.rtype
)) + 200041; h &= 0x3FFFFFFF; }
;
812 }
813 else
814 for (i = 0; i < abArgc(ab)((ab)->abHdr.argc); i++)
815 abHashArg(h, abHashSefo(abArgv(ab)[i])){ h ^= (h << 8); h += (abHashSefo(((ab)->abGen.data.
argv)[i])) + 200041; h &= 0x3FFFFFFF; }
;
816
817 h += abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].hash;
818 h &= 0x3FFFFFFF;
819 return h;
820}
821
822Hash
823abHash(AbSyn ab)
824{
825 Hash h = 0;
826 Length i;
827
828 if (abIsSymTag(abTag(ab))( (((ab)->abHdr.tag)) < AB_SYM_LIMIT))
829 h = strHash(symString(abLeafSym(ab))((((ab)->abGen.data.sym))->str));
830 else if (abIsDocTag(abTag(ab))( AB_DOC_START <= (((ab)->abHdr.tag)) && (((ab)
->abHdr.tag)) < AB_DOC_LIMIT)
)
831 h = strHash(docString(abLeafDoc(ab))((((ab)->abGen.data.doc))->corpus));
832 else if (abIsStrTag(abTag(ab))( AB_STR_START <= (((ab)->abHdr.tag)) && (((ab)
->abHdr.tag)) < AB_STR_LIMIT)
)
833 h = strHash(abLeafStr(ab)((ab)->abGen.data.str));
834 else if (abTag(ab)((ab)->abHdr.tag) == AB_Lambda) {
835 abHashArg(h, abHash(ab->abLambda.param)){ h ^= (h << 8); h += (abHash(ab->abLambda.param)) +
200041; h &= 0x3FFFFFFF; }
;
836 abHashArg(h, abHash(ab->abLambda.rtype)){ h ^= (h << 8); h += (abHash(ab->abLambda.rtype)) +
200041; h &= 0x3FFFFFFF; }
;
837 }
838 else
839 for (i = 0; i < abArgc(ab)((ab)->abHdr.argc); i++)
840 abHashArg(h, abHash(abArgv(ab)[i])){ h ^= (h << 8); h += (abHash(((ab)->abGen.data.argv
)[i])) + 200041; h &= 0x3FFFFFFF; }
;
841
842 h += abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].hash;
843 h &= 0x3FFFFFFF;
844 return h;
845}
846
847Hash
848abHashList(AbSynList abl)
849{
850 AbSyn ab = car(abl)((abl)->first);
851 Hash h = 0;
852
853 if (!abHasTag(ab, AB_Apply)((ab)->abHdr.tag == (AB_Apply))) abl = cdr(abl)((abl)->rest);
854
855 for (; abl; abl = cdr(abl)((abl)->rest))
856 abHashArg(h, abHash(car(abl))){ h ^= (h << 8); h += (abHash(((abl)->first))) + 200041
; h &= 0x3FFFFFFF; }
;
857
858 h += abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].hash;
859 h &= 0x3FFFFFFF;
860 return h;
861}
862
863Hash
864abHashModDeclares(AbSyn ab)
865{
866 Hash h = 0;
867 Length i;
868
869 if (abHasTag(ab, AB_Declare)((ab)->abHdr.tag == (AB_Declare)))
870 return abHashModDeclares(ab->abDeclare.type);
871 if (abHasTag(ab, AB_Qualify)((ab)->abHdr.tag == (AB_Qualify)))
872 return abHashModDeclares(ab->abQualify.what);
873
874 if (abIsSymTag(abTag(ab))( (((ab)->abHdr.tag)) < AB_SYM_LIMIT))
875 h = strHash(symString(abLeafSym(ab))((((ab)->abGen.data.sym))->str));
876 else if (abIsDocTag(abTag(ab))( AB_DOC_START <= (((ab)->abHdr.tag)) && (((ab)
->abHdr.tag)) < AB_DOC_LIMIT)
)
877 h = strHash(docString(abLeafDoc(ab))((((ab)->abGen.data.doc))->corpus));
878 else if (abIsStrTag(abTag(ab))( AB_STR_START <= (((ab)->abHdr.tag)) && (((ab)
->abHdr.tag)) < AB_STR_LIMIT)
)
879 h = strHash(abLeafStr(ab)((ab)->abGen.data.str));
880 else if (abHasTag(ab, AB_Define)((ab)->abHdr.tag == (AB_Define))) {
881 abHashArg(h, abHashModDeclares(ab->abDefine.lhs)){ h ^= (h << 8); h += (abHashModDeclares(ab->abDefine
.lhs)) + 200041; h &= 0x3FFFFFFF; }
;
882 abHashArg(h, abHash(ab->abDefine.rhs)){ h ^= (h << 8); h += (abHash(ab->abDefine.rhs)) + 200041
; h &= 0x3FFFFFFF; }
;
883 }
884 else if (abHasTag(ab, AB_Comma)((ab)->abHdr.tag == (AB_Comma))) {
885 for (i = 0; i < abArgc(ab)((ab)->abHdr.argc); i++)
886 abHashArg(h, abHashModDeclares(abArgv(ab)[i])){ h ^= (h << 8); h += (abHashModDeclares(((ab)->abGen
.data.argv)[i])) + 200041; h &= 0x3FFFFFFF; }
;
887 }
888 else
889 for (i = 0; i < abArgc(ab)((ab)->abHdr.argc); i++)
890 abHashArg(h, abHash(abArgv(ab)[i])){ h ^= (h << 8); h += (abHash(((ab)->abGen.data.argv
)[i])) + 200041; h &= 0x3FFFFFFF; }
;
891
892 h += abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].hash;
893 h &= 0x3FFFFFFF;
894 return h;
895}
896
897/*
898 * Destructively replace oldSym by newSym in all abIds in ab
899 */
900
901void
902abSubSymbol(AbSyn ab, Symbol oldSym, Symbol newSym)
903{
904 if (! ab)
905 ;
906 else if (abHasTag(ab, AB_Id)((ab)->abHdr.tag == (AB_Id))) {
907 if (ab->abId.sym == oldSym)
908 ab->abId.sym = newSym;
909 }
910 else if (! abIsLeaf(ab)(((ab)->abHdr.tag) < AB_NODE_START)) {
911 int i;
912 for (i = 0; i < abArgc(ab)((ab)->abHdr.argc); i++)
913 abSubSymbol(abArgv(ab)((ab)->abGen.data.argv)[i], oldSym, newSym);
914 }
915}
916
917/*
918 * Construct a new identifier from a symbol meaning.
919 */
920AbSyn
921abFrSyme(Syme syme)
922{
923 AbSyn ab = abNewId(sposNone, symeId(syme))abNew(AB_Id, sposNone,1, ((syme)->id));
924
925 abSetSyme(ab, syme);
926 abState(ab)((ab)->abHdr.state) = AB_State_HasUnique;
927 abTUnique(ab)((ab)->abHdr.type.unique) = symeType(syme);
928
929 return ab;
930}
931
932/*
933 * abNew{No,In,Pre,Post,Match}fix form [Apply f, a, b, c]
934 */
935
936AbSyn
937abNewNofix(SrcPos pos, AbSyn op)
938{
939 return abNew(AB_Apply, pos, 1, op);
940}
941
942AbSyn
943abNewInfix(SrcPos pos, AbSyn op, AbSyn a, AbSyn b)
944{
945 return abNew(AB_Apply, pos, 3, op, a, b);
946}
947
948AbSyn
949abNewPrefix(SrcPos pos, AbSyn op, AbSyn a)
950{
951 AbSyn ab;
952 int i;
953
954 if (abTag(a)((a)->abHdr.tag) != AB_Comma) return abNew(AB_Apply, pos, 2, op, a);
955
956 ab = abNewEmpty(AB_Apply, 1 + abArgc(a)((a)->abHdr.argc));
957 abArgv(ab)((ab)->abGen.data.argv)[0] = op;
958 for (i = 0; i < abArgc(a)((a)->abHdr.argc); i++) abArgv(ab)((ab)->abGen.data.argv)[i+1] = abArgv(a)((a)->abGen.data.argv)[i];
959 abFreeNode(a);
960
961 abSetPos(ab, pos)((ab)->abHdr.pos=spstackSetFirst ((ab)->abHdr.pos,(pos)
))
;
962 return ab;
963}
964
965AbSyn
966abNewPostfix(SrcPos pos, AbSyn op, AbSyn a)
967{
968 return abNewPrefix(pos, op, a); /* All the same processing */
969}
970
971AbSyn
972abNewMatchfix(SrcPos pos, AbSyn op, AbSyn a)
973{
974 return a ? abNewPrefix(pos, op, a) : abNewNofix(pos, op);
975}
976
977/*
978 * Used as a functional argument.
979 */
980AbSyn
981abArgf(AbSyn ab, Length i)
982{
983 return abArgv(ab)((ab)->abGen.data.argv)[i];
984}
985
986/*
987 * Used as a functional argument.
988 */
989AbSyn
990abThisArgf(AbSyn ab, Length i)
991{
992 assert(i == 0)do { if (!(i == 0)) _do_assert(("i == 0"),"absyn.c",992); } while
(0)
;
993 return ab;
994}
995
996/*
997 * Used as a functional argument.
998 */
999AbSyn
1000abApplyArgf(AbSyn ab, Length i)
1001{
1002 return abApplyArg(ab, i)((ab)->abApply.argv[i]);
1003}
1004
1005/*
1006 * Used as a functional argument.
1007 */
1008AbSyn
1009abForIterArgf(AbSyn ab, Length i)
1010{
1011 assert(i == 0)do { if (!(i == 0)) _do_assert(("i == 0"),"absyn.c",1011); } while
(0)
;
1012 return ab->abFor.whole;
1013}
1014
1015/*
1016 * Used as a functional argument.
1017 */
1018AbSyn
1019abSetArgf(AbSyn ab, Length i)
1020{
1021 AbSyn lhs, rhs;
1022 Length n;
1023
1024 assert(abTag(ab) == AB_Assign)do { if (!(((ab)->abHdr.tag) == AB_Assign)) _do_assert(("abTag(ab) == AB_Assign"
),"absyn.c",1024); } while (0)
;
1025
1026 lhs = ab->abAssign.lhs;
1027 rhs = ab->abAssign.rhs;
1028
1029 assert(abTag(lhs) == AB_Apply)do { if (!(((lhs)->abHdr.tag) == AB_Apply)) _do_assert(("abTag(lhs) == AB_Apply"
),"absyn.c",1029); } while (0)
;
1030 n = abApplyArgc(lhs)(((lhs)->abHdr.argc)-1);
1031
1032 /* 0 is the lhs operator */
1033 if (i == 0) return abApplyOp(lhs)((lhs)->abApply.op);
1034
1035 /* 1..n are the lhs arg[0]...arg[n-1] */
1036 if (i-1 < n) return abApplyArg(lhs, i-1)((lhs)->abApply.argv[i-1]);
1037
1038 /* n+1 is the rhs */
1039 if (i == n+1) return rhs;
1040
1041 bugBadCase(i)bug("Bad case %d (line %d in file %s).", (int) i, 1041, "absyn.c"
)
;
1042 NotReached(return 0){(void)bug("Not supposed to reach line %d in file: %s\n",1042
, "absyn.c");}
;
1043}
1044
1045/*
1046 * Allocate a new application for the arguments of the comma.
1047 */
1048AbSyn
1049abNewApplyOfComma(AbSyn op, AbSyn arg)
1050{
1051 Length i, argc;
1052 AbSyn *argv;
1053 AbSyn ab;
1054
1055 switch (abTag(arg)((arg)->abHdr.tag)) {
1056 case AB_Nothing:
1057 argc = 0;
1058 argv = 0;
1059 break;
1060 case AB_Comma:
1061 argc = abArgc(arg)((arg)->abHdr.argc);
1062 argv = abArgv(arg)((arg)->abGen.data.argv);
1063 break;
1064 default:
1065 argc = 1;
1066 argv = &arg;
1067 break;
1068 }
1069
1070 ab = abNewEmpty(AB_Apply, argc + 1);
1071
1072 if (argc > 0) {
1073 abSetPos(ab, abPos(argv[0]))((ab)->abHdr.pos=spstackSetFirst ((ab)->abHdr.pos,((spstackFirst
((argv[0])->abHdr.pos)))))
;
1074 abSetEnd(ab, abEnd(argv[argc-1]));
1075 }
1076
1077 abApplyOp(ab)((ab)->abApply.op) = op;
1078 for (i = 0; i < argc; i += 1)
1079 abApplyArg(ab, i)((ab)->abApply.argv[i]) = abDefineeId(argv[i]);
1080
1081 return ab;
1082}
1083
1084/*
1085 * Allocate a new comma for the original arguments of an application.
1086 */
1087AbSyn
1088abNewApplyArg(AbSyn app)
1089{
1090 AbSyn a, *v;
1091 int i, n;
1092
1093 assert(app && abTag(app) == AB_Apply)do { if (!(app && ((app)->abHdr.tag) == AB_Apply))
_do_assert(("app && abTag(app) == AB_Apply"),"absyn.c"
,1093); } while (0)
;
1094
1095 n = abApplyArgc(app)(((app)->abHdr.argc)-1);
1096 v = abApplyArgv(app)((app)->abApply.argv);
1097
1098 if (n == 1 && v[0] && abTag(v[0])((v[0])->abHdr.tag) == AB_Comma) {
1099 n = abArgc(v[0])((v[0])->abHdr.argc);
1100 v = abArgv(v[0])((v[0])->abGen.data.argv);
1101 }
1102
1103 a = abNewEmpty(AB_Comma, n);
1104 abSetPos(a, ((n == 0) ? abPos(app) : abPos(v[0])))((a)->abHdr.pos=spstackSetFirst ((a)->abHdr.pos,(((n ==
0) ? (spstackFirst((app)->abHdr.pos)) : (spstackFirst((v[
0])->abHdr.pos))))))
;
1105
1106 for (i = 0; i < n; i++) abArgv(a)((a)->abGen.data.argv)[i] = v[i];
1107 abSetEnd(a, ((n == 0) ? abEnd(app) : abEnd(v[n-1])));
1108
1109 return a;
1110}
1111
1112/*
1113 * Allocate a new comma for the original arguments of an application.
1114 * Args that are ids have declarations created.
1115 */
1116AbSyn
1117abNewApplyDeclaredArg(AbSyn app)
1118{
1119 AbSyn a, *v;
1120 int i, n;
1121
1122 assert(app && abTag(app) == AB_Apply)do { if (!(app && ((app)->abHdr.tag) == AB_Apply))
_do_assert(("app && abTag(app) == AB_Apply"),"absyn.c"
,1122); } while (0)
;
1
Assuming 'app' is non-null
2
Assuming field 'tag' is equal to AB_Apply
3
Taking false branch
4
Loop condition is false. Exiting loop
1123
1124 n = abApplyArgc(app)(((app)->abHdr.argc)-1);
1125 v = abApplyArgv(app)((app)->abApply.argv);
1126
1127 if (n == 1 && v[0] && abTag(v[0])((v[0])->abHdr.tag) == AB_Comma) {
5
Assuming 'n' is equal to 1
6
Assuming the condition is false
7
Assuming pointer value is null
1128 n = abArgc(v[0])((v[0])->abHdr.argc);
1129 v = abArgv(v[0])((v[0])->abGen.data.argv);
1130 }
1131
1132 a = abNewEmpty(AB_Comma, n);
1133 abSetPos(a, ((n == 0) ? abPos(app) : abPos(v[0])))((a)->abHdr.pos=spstackSetFirst ((a)->abHdr.pos,(((n ==
0) ? (spstackFirst((app)->abHdr.pos)) : (spstackFirst((v[
0])->abHdr.pos))))))
;
8
'?' condition is false
9
Dereference of null pointer
1134
1135 for (i = 0; i < n; i++)
1136 abArgv(a)((a)->abGen.data.argv)[i] = abHasTag(v[i], AB_Id)((v[i])->abHdr.tag == (AB_Id))
1137 ? abNewDeclare(abPos(v[i]),v[i], abNewNothing(abPos(v[i])))abNew(AB_Declare, (spstackFirst((v[i])->abHdr.pos)),2, v[i
],abNew(AB_Nothing, (spstackFirst((v[i])->abHdr.pos)),0 ))
1138 : v[i];
1139 abSetEnd(a, ((n == 0) ? abEnd(app) : abEnd(v[n-1])));
1140
1141 return a;
1142}
1143
1144/*
1145 * Allocate a new comma for copied arguments of an application.
1146 */
1147AbSyn
1148abCopyApplyArg(AbSyn ab)
1149{
1150 int i, n;
1151 ab = abNewApplyArg(ab);
1152 n = abApplyArgc(ab)(((ab)->abHdr.argc)-1);
1153 for (i = 0; i < n; i++) abArgv(ab)((ab)->abGen.data.argv)[i] = abCopy(abArgv(ab)((ab)->abGen.data.argv)[i]);
1154 return ab;
1155}
1156
1157AbSyn
1158abNewDefineLhs(Symbol sym, AbSynList params)
1159{
1160 AbSynList pl, revParams;
1161 AbSyn abd;
1162
1163 abd = abNewId(sposNone, sym)abNew(AB_Id, sposNone,1, sym);
1164 revParams = listReverse(AbSyn)(AbSyn_listPointer->Reverse)(params);
1165 for (pl = revParams; pl; pl = cdr(pl)((pl)->rest))
1166 abd = abNewApplyOfComma(abd, car(pl)((pl)->first));
1167 listFree(AbSyn)(AbSyn_listPointer->Free)(revParams);
1168
1169 return abd;
1170}
1171
1172
1173/*
1174 * Return a singleton, otherwise alloc node and fill.
1175 */
1176AbSyn
1177abOneOrNewOfList(AbSynTag tag, AbSynList l)
1178{
1179 AbSyn ab;
1180 Length n, n0;
1181
1182 if (l && !cdr(l)((l)->rest)) return car(l)((l)->first);
1183
1184 n0 = n = listLength(AbSyn)(AbSyn_listPointer->_Length)(l);
1185 ab = abNewEmpty(tag, n);
1186
1187 for ( ; l; l = cdr(l)((l)->rest) )
1188 abArgv(ab)((ab)->abGen.data.argv)[--n] = car(l)((l)->first);
1189 if (n0 > 0) {
1190 abSetPos(ab, abPos(abArgv(ab)[0]))((ab)->abHdr.pos=spstackSetFirst ((ab)->abHdr.pos,((spstackFirst
((((ab)->abGen.data.argv)[0])->abHdr.pos)))))
;
1191 abSetEnd(ab, abEnd(abArgv(ab)((ab)->abGen.data.argv)[n0-1]));
1192 }
1193
1194 return ab;
1195}
1196
1197/*
1198 * Allocate a new abDocText node from a list of doc tokens.
1199 */
1200AbSyn
1201abNewDocTextOfList(TokenList tl)
1202{
1203 return (tl ? abNewDocText(car(tl)->pos, docNewFrList(tl))abNew(AB_DocText, ((tl)->first)->pos,1, docNewFrList(tl
))
: 0);
1204}
1205
1206/*
1207 * Find the nodes with the minimum and maximum positions.
1208 * In case of ties, the node closer to the frontier is selected
1209 */
1210localstatic void
1211abPosNodeSpan0(AbSyn X, AbSyn *pA, AbSyn *pB)
1212{
1213 Length i, n;
1214 SrcPos sposA, sposB, sposX, sposE;
1215
1216 sposX = abPos(X)(spstackFirst((X)->abHdr.pos));
1217 sposE = abEnd(X);
1218 sposA = abPos(*pA)(spstackFirst((*pA)->abHdr.pos));
1219 sposB = abEnd(*pB);
1220
1221 if (!sposIsSpecial(sposX))
1222 if (sposIsSpecial(sposA) || sposCmp(sposX,sposA)<=0) *pA = X;
1223 if (!sposIsSpecial(sposE))
1224 if (sposIsSpecial(sposB) || sposCmp(sposE,sposB)>=0) *pB = X;
1225
1226 if (!abIsLeaf(X)(((X)->abHdr.tag) < AB_NODE_START)) {
1227 n = abArgc(X)((X)->abHdr.argc);
1228 for (i = 0; i < n; i++) abPosNodeSpan0(abArgv(X)((X)->abGen.data.argv)[i], pA, pB);
1229 }
1230}
1231
1232SrcPos
1233abEnd(AbSyn ab)
1234{
1235 SrcPos sp;
1236
1237 if (abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].tokenTag < TK_GEN_LIMIT)
1238 sp = abLeafEnd(ab);
1239 else
1240 sp = spstackFirst(spstackRest(ab->abHdr.pos));
1241 return sp;
1242}
1243
1244void
1245abSetEnd(AbSyn ab, SrcPos sp)
1246{
1247 ab->abHdr.pos = spstackSetSecond(ab->abHdr.pos, sp);
1248}
1249
1250/*
1251 * Find the end position of a leaf node.
1252 *!! This is approximate, assuming no escapes.
1253 */
1254localstatic SrcPos
1255abLeafEnd(AbSyn ab)
1256{
1257 int off;
1258
1259 if (sposChar(spstackFirst(spstackRest(ab->abHdr.pos))) > 0)
1260 return spstackFirst(spstackRest(ab->abHdr.pos));
1261
1262 switch (abTag(ab)((ab)->abHdr.tag)) {
1263 case AB_Blank:
1264 off = strlen(symString(ab->abBlank.sym)((ab->abBlank.sym)->str)); break;
1265 case AB_Id:
1266 off = strlen(symString(ab->abId.sym)((ab->abId.sym)->str)); break;
1267 case AB_IdSy:
1268 off = strlen(symString(ab->abIdSy.sym)((ab->abIdSy.sym)->str)); break;
1269 case AB_DocText:
1270 /*!! Assuming single line ++ */
1271 off = docLength(ab->abDocText.doc)((ab->abDocText.doc)->cc); break;
1272 case AB_LitInteger:
1273 off = strlen(ab->abLitInteger.str); break;
1274 case AB_LitFloat:
1275 off = strlen(ab->abLitFloat.str); break;
1276 case AB_LitString:
1277 /* Add 2 for quotes. */
1278 off = strlen(ab->abLitString.str) + 2; break;
1279 default:
1280 off = 0;
1281 }
1282 return sposOffset(abPos(ab)(spstackFirst((ab)->abHdr.pos)), off-1);
1283}
1284
1285void
1286abPosNodeSpan(AbSyn ab, AbSyn *pMinNode, AbSyn *pMaxNode)
1287{
1288 AbSyn A, B;
1289
1290 A = ab;
1291 B = ab;
1292
1293 abPosNodeSpan0(ab, &A, &B);
1294
1295 if (pMinNode) *pMinNode = A;
1296 if (pMaxNode) *pMaxNode = B;
1297}
1298
1299void
1300abPosSpan(AbSyn ab, SrcPos *pmin, SrcPos *pmax)
1301{
1302 AbSyn A, B;
1303
1304 if (!ab) return;
1305
1306 A = ab;
1307 B = ab;
1308
1309 abPosNodeSpan0(ab, &A, &B);
1310
1311 if (pmin) *pmin = abPos(A)(spstackFirst((A)->abHdr.pos));
1312 if (pmax) *pmax = abEnd(B);
1313}
1314
1315/******************************************************************************
1316 *
1317 * :: AbSyn/SExpr conversion
1318 *
1319 *****************************************************************************/
1320static Bool abElideInnerExpressions;
1321
1322SExpr
1323abToSExprElided(AbSyn ab)
1324{
1325 SExpr sx;
1326 abElideInnerExpressions = true1;
1327 sx = abToSExpr(ab);
1328 abElideInnerExpressions = false((int) 0);
1329 return sx;
1330}
1331
1332SExpr
1333abToSExpr(AbSyn ab)
1334{
1335 Length ai;
1336 SExpr sx;
1337
1338 if (!abIsInit) abInit();
1339
1340 if (!ab) return sxNil;
1341
1342 switch (abTag(ab)((ab)->abHdr.tag)) {
1343 case AB_Nothing:
1344 sx = sxNil;
1345 break;
1346 case AB_Blank:
1347 case AB_IdSy:
1348 sx = sxiList(2,
1349 abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].sxsym,
1350 sxiFrSymbol(ab->abId.sym));
1351 break;
1352 case AB_Id:
1353 sx = sxiFrSymbol(ab->abId.sym);
1354 break;
1355 case AB_DocText:
1356 sx = sxiList(2,
1357 abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].sxsym,
1358 sxiFrString(docString(ab->abDocText.doc)((ab->abDocText.doc)->corpus))
1359 );
1360 break;
1361 case AB_LitInteger:
1362 case AB_LitString:
1363 case AB_LitFloat:
1364 sx = sxiList(2,
1365 abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].sxsym,
1366 sxiFrString(ab->abLitString.str)
1367 );
1368 break;
1369 case AB_Declare: {
1370 Syme syme = abSyme(ab->abDeclare.id)((ab->abDeclare.id)->abHdr.seman ? (ab->abDeclare.id
)->abHdr.seman->syme : 0)
;
1371
1372 sx = sxCons(abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].sxsym, sxNil);
1373 for (ai = 0; ai < abArgc(ab)((ab)->abHdr.argc); ai++)
1374 sx = sxCons(abToSExpr(abArgv(ab)((ab)->abGen.data.argv)[ai]), sx);
1375 if (syme)
1376 sx = sxCons(symeSExprAList(syme), sx);
1377
1378 sx = sxNReverse(sx);
1379 break;
1380 }
1381 case AB_Add:
1382 case AB_With: {
1383 if (abElideInnerExpressions) {
1384 sx = sxCons(abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].sxsym, sxNil);
1385 }
1386 else {
1387 sx = sxCons(abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].sxsym, sxNil);
1388 for (ai = 0; ai < abArgc(ab)((ab)->abHdr.argc); ai++)
1389 sx = sxCons(abToSExpr(abArgv(ab)((ab)->abGen.data.argv)[ai]), sx);
1390 sx = sxNReverse(sx);
1391 }
1392 break;
1393 }
1394
1395 default:
1396 sx = sxCons(abInfo(abTag(ab))abInfoTable[(((ab)->abHdr.tag)) - AB_START].sxsym, sxNil);
1397 for (ai = 0; ai < abArgc(ab)((ab)->abHdr.argc); ai++)
1398 sx = sxCons(abToSExpr(abArgv(ab)((ab)->abGen.data.argv)[ai]), sx);
1399 sx = sxNReverse(sx);
1400 }
1401
1402 sx = sxiRepos(abPos(ab)(spstackFirst((ab)->abHdr.pos)), sx);
1403 return sx;
1404}
1405
1406#define croak(sx,msg)comsgFatal(abNew(AB_Nothing, ((sx)->sxHdr.pos),0 ), msg) comsgFatal(abNewNothing(sxiPos(sx))abNew(AB_Nothing, ((sx)->sxHdr.pos),0 ), msg)
1407
1408AbSyn
1409abFrSExpr(SExpr sx)
1410{
1411 AbSyn ab;
1412 Symbol op;
1413 int tag;
1414 Length argc, ai;
1415 SExpr ss;
1416
1417 if (!abIsInit) abInit();
1418
1419 /*
1420 * Special cases
1421 */
1422 if (sxiNull(sx)(((sx)->sxHdr.tag) == SX_Nil)) {
1423 ab = abNewNothing(sxiPos(sx))abNew(AB_Nothing, ((sx)->sxHdr.pos),0 );
1424 return ab;
1425 }
1426 if (sxiSymbolP(sx)(((sx)->sxHdr.tag) == SX_Symbol)) {
1427 ab = abNewId(sxiPos(sx), sxiToSymbol(sx))abNew(AB_Id, ((sx)->sxHdr.pos),1, ((sx)->sxSymbol.sym));
1428 return ab;
1429 }
1430
1431 /*
1432 * General case
1433 */
1434 if (!sxiConsP(sx)(((sx)->sxHdr.tag) == SX_Cons))
1435 croak(sx, ALDOR_F_LoadNotList)comsgFatal(abNew(AB_Nothing, ((sx)->sxHdr.pos),0 ), 74);
1436 if (!sxiSymbolP(ss = sxCar(sx))(((ss = ((sx)->sxCons.sxCarField))->sxHdr.tag) == SX_Symbol
)
|| !symCoInfo(sxiToSymbol(ss)((ss)->sxSymbol.sym)))
1437 croak(ss, ALDOR_F_LoadNotAbSyn)comsgFatal(abNew(AB_Nothing, ((ss)->sxHdr.pos),0 ), 72);
1438
1439 op = sxiToSymbol(ss)((ss)->sxSymbol.sym);
1440 argc = sxiLength(sx) - 1; /* -1 for tag */
1441 tag = symCoInfo(op)->abTagVal;
1442
1443 switch (tag) {
1444 case AB_Blank:
1445 case AB_IdSy:
1446 if (argc != 1) croak(sx, ALDOR_F_LoadNotUnary)comsgFatal(abNew(AB_Nothing, ((sx)->sxHdr.pos),0 ), 75);
1447 if (!sxiSymbolP(ss = sxSecond(sx))(((ss = ((((sx)->sxCons.sxCdrField))->sxCons.sxCarField
))->sxHdr.tag) == SX_Symbol)
) croak(ss, ALDOR_F_LoadNotSymbol)comsgFatal(abNew(AB_Nothing, ((ss)->sxHdr.pos),0 ), 77);
1448 ab = abNew(tag, sposNone, 1, sxiToSymbol(ss)((ss)->sxSymbol.sym));
1449 break;
1450 case AB_DocText:
1451 ab = abNewDocText(sposNone,abNew(AB_DocText, sposNone,1, docNewFrString(strCopy(((((((sx
)->sxCons.sxCdrField))->sxCons.sxCarField))->sxString
.val))))
1452 docNewFrString(sxiToString(sxSecond(sx))))abNew(AB_DocText, sposNone,1, docNewFrString(strCopy(((((((sx
)->sxCons.sxCdrField))->sxCons.sxCarField))->sxString
.val))))
;
1453 break;
1454 case AB_LitInteger:
1455 case AB_LitString:
1456 case AB_LitFloat:
1457 if (argc != 1) croak(sx, ALDOR_F_LoadNotUnary)comsgFatal(abNew(AB_Nothing, ((sx)->sxHdr.pos),0 ), 75);
1458 if (!sxiStringP(ss = sxSecond(sx))(((ss = ((((sx)->sxCons.sxCdrField))->sxCons.sxCarField
))->sxHdr.tag) == SX_String)
) croak(ss, ALDOR_F_LoadNotString)comsgFatal(abNew(AB_Nothing, ((ss)->sxHdr.pos),0 ), 76);
1459 ab = abNew(tag, sposNone, 1, sxiToString(ss)strCopy(((ss)->sxString.val)));
1460 break;
1461 default:
1462 ab = abNewEmpty(tag, argc);
1463 for (ai = 0, sx = sxCdr(sx)((sx)->sxCons.sxCdrField); ai < argc; ai++, sx = sxCdr(sx)((sx)->sxCons.sxCdrField))
1464 abArgv(ab)((ab)->abGen.data.argv)[ai] = abFrSExpr(sxCar(sx)((sx)->sxCons.sxCarField));
1465 break;
1466 }
1467
1468 abSetPos(ab, sxiPos(sx))((ab)->abHdr.pos=spstackSetFirst ((ab)->abHdr.pos,(((sx
)->sxHdr.pos))))
;
1469 return ab;
1470}
1471
1472
1473int
1474abWrSExpr(FILE *file, AbSyn ab, ULong sxioMode)
1475{
1476 SExpr sx;
1477 int cc;
1478
1479 sx = abToSExpr(ab);
1480 cc = sxiWrite(file, sx, SXRW_MixedCase(1L<<0) | sxioMode);
1481 sxiFree(sx);
1482
1483 return cc;
1484}
1485
1486AbSyn
1487abRdSExpr(FILE *file, FileName *pfn, int *plno)
1488{
1489 SExpr sx;
1490 AbSyn ab;
1491
1492 sx = sxiRead(file, pfn, plno, sxNil, SXRW_MixedCase(1L<<0) | SXRW_SrcPos(1L<<2));
1493 ab = abFrSExpr(sx);
1494 sxiFree(sx);
1495
1496 return ab;
1497}
1498
1499int
1500abOStreamPrint(OStream ostream, AbSyn absyn)
1501{
1502 /* Ideally, we'd avoid going through the buffer, but sxiWrite is
1503 * written vs a buffer, and there's no point changing it for debug functionality
1504 */
1505 SExpr sx = abToSExpr(absyn);
1506 Buffer b = bufNew();
1507 int c;
1508
1509 sxiToBufferFormatted(b, sx, SXRW_MixedCase(1L<<0));
1510 c = ostreamWrite(ostream, bufLiberate(b), -1);
1511 sxiFree(sx);
1512
1513 return c;
1514
1515}
1516
1517
1518/*****************************************************************************
1519 *
1520 * :: Writing uninterpreted forms
1521 *
1522 ****************************************************************************/
1523
1524int
1525abToBuffer(Buffer buf, AbSyn ab)
1526{
1527 Length start = bufPosition(buf);
1528 AbSynTag tag = abTag(ab)((ab)->abHdr.tag);
1529 UShort i, argc;
1530
1531 bufPutByte(buf, tag);
1532
1533 switch (tag) {
1534 case AB_Nothing:
1535 case AB_Blank:
1536 break;
1537
1538 case AB_IdSy:
1539 case AB_Id:
1540 bufWrString(buf, symString(abIdSym(ab))((((ab)->abId.sym))->str));
1541 break;
1542
1543 case AB_LitInteger:
1544 case AB_LitString:
1545 case AB_LitFloat:
1546 bufWrString(buf, abLeafStr(ab)((ab)->abGen.data.str));
1547 break;
1548
1549 default:
1550 argc = abArgc(ab)((ab)->abHdr.argc);
1551 bufPutHInt(buf, argc);
1552 for (i = 0; i < argc; i += 1)
1553 abToBuffer(buf, abArgv(ab)((ab)->abGen.data.argv)[i]);
1554 }
1555
1556 return bufPosition(buf) - start;
1557}
1558
1559AbSyn
1560abFrBuffer(Buffer buf)
1561{
1562 AbSyn ab;
1563 AbSynTag tag;
1564 int i, argc;
1565 tag = bufGetByte(buf);
1566 switch (tag) {
1567 case AB_Nothing:
1568 ab = abNewNothing(sposNone)abNew(AB_Nothing, sposNone,0 );
1569 break;
1570 case AB_Blank:
1571 ab = abNewBlank(sposNone, ssymVariable)abNew(AB_Blank, sposNone,1, ssymVariable);
1572 break;
1573 case AB_IdSy:
1574 case AB_Id:
1575 ab = abNewId(sposNone, symIntern(bufRdString(buf)))abNew(AB_Id, sposNone,1, symProbe(bufRdString(buf), 1 | 2));
1576 break;
1577 case AB_LitInteger:
1578 ab = abNewLitInteger(sposNone, bufRdString(buf))abNew(AB_LitInteger, sposNone,1, bufRdString(buf));
1579 break;
1580 case AB_LitString:
1581 ab = abNewLitString(sposNone, bufRdString(buf))abNew(AB_LitString, sposNone,1, bufRdString(buf));
1582 break;
1583 case AB_LitFloat:
1584 ab = abNewLitFloat(sposNone, bufRdString(buf))abNew(AB_LitFloat, sposNone,1, bufRdString(buf));
1585 break;
1586 default:
1587 argc = bufGetHInt(buf);
1588 ab = abNewEmpty(tag, argc);
1589 for (i = 0; i < argc; i += 1)
1590 abArgv(ab)((ab)->abGen.data.argv)[i] = abFrBuffer(buf);
1591 break;
1592 }
1593 return ab;
1594}
1595
1596/*****************************************************************************
1597 *
1598 * :: Information associated with each abstract syntax tag
1599 *
1600 ****************************************************************************/
1601
1602/*
1603 * These must have the same order as the elements of the enumeration.
1604 */
1605
1606struct ab_info abInfoTable[] = {
1607 {AB_Id, 0, 0, "Id", TK_Id },
1608 {AB_IdSy, 0, 0, "IdSy", TK_Id },
1609 {AB_Blank, 0, 0, "Blank", TK_LIMIT },
1610 {AB_DocText, 0, 0, "DocText", TK_PostDoc },
1611 {AB_LitInteger, 0, 0, "LitInteger", TK_Int },
1612 {AB_LitFloat, 0, 0, "LitFloat", TK_Float },
1613 {AB_LitString, 0, 0, "LitString", TK_String },
1614 {AB_Add, 0, 0, "Add", KW_Add },
1615 {AB_And, 0, 0, "And", KW_And },
1616 {AB_Apply, 0, 0, "Apply", KW_Juxtapose},
1617 {AB_Assert, 0, 0, "Assert", KW_Assert },
1618 {AB_Assign, 0, 0, "Assign", KW_Assign },
1619 {AB_Break, 0, 0, "Break", KW_Break },
1620 {AB_Builtin, 0, 0, "Builtin", TK_LIMIT },
1621 {AB_CoerceTo, 0, 0, "CoerceTo", KW_2Colon },
1622 {AB_Collect, 0, 0, "Collect", TK_LIMIT },
1623 {AB_Comma, 0, 0, "Comma", TK_LIMIT },
1624 {AB_Declare, 0, 0, "Declare", KW_Colon },
1625 {AB_Default, 0, 0, "Default", KW_Default },
1626 {AB_Define, 0, 0, "Define", KW_2EQ },
1627 {AB_DDefine, 0, 0, "DDefine", KW_Define },
1628 {AB_Delay, 0, 0, "Delay", KW_Delay },
1629 {AB_Do, 0, 0, "Do", KW_Do },
1630 {AB_Documented, 0, 0, "Documented", TK_LIMIT },
1631 {AB_Except, 0, 0, "Except", KW_Throw },
1632 {AB_Exit, 0, 0, "Exit", KW_Implies },
1633 {AB_Export, 0, 0, "Export", KW_Export },
1634 {AB_Extend, 0, 0, "Extend", KW_Extend },
1635 {AB_Fix, 0, 0, "Fix", KW_Fix },
1636 {AB_Fluid, 0, 0, "Fluid", KW_Fluid },
1637 {AB_For, 0, 0, "For", KW_For },
1638 {AB_ForeignImport,0, 0, "ForeignImport",TK_LIMIT },
1639 {AB_ForeignExport,0, 0, "ForeignExport",TK_LIMIT },
1640 {AB_Free, 0, 0, "Free", KW_Free },
1641 {AB_Generate, 0, 0, "Generate", KW_Generate },
1642 {AB_Goto, 0, 0, "Goto", KW_Goto },
1643 {AB_Has, 0, 0, "Has", KW_Has },
1644 {AB_Hide, 0, 0, "Hide", KW_ColonStar},
1645 {AB_If, 0, 0, "If", KW_If },
1646 {AB_Import, 0, 0, "Import", KW_Import },
1647 {AB_Inline, 0, 0, "Inline", KW_Inline },
1648 {AB_Iterate, 0, 0, "Iterate", KW_Iterate },
1649 {AB_Label, 0, 0, "Label", KW_At },
1650 {AB_Lambda, 0, 0, "Lambda", TK_LIMIT },
1651 {AB_Let, 0, 0, "Let", KW_Let },
1652 {AB_Local, 0, 0, "Local", KW_Local },
1653 {AB_Macro, 0, 0, "Macro", KW_Macro },
1654 {AB_MDefine, 0, 0, "MDefine", KW_MArrow },
1655 {AB_MLambda, 0, 0, "MLambda", KW_Macro },
1656 {AB_Never, 0, 0, "Never", KW_Never },
1657 {AB_Not, 0, 0, "Not", KW_Not },
1658 {AB_Nothing, 0, 0, "Nothing", TK_LIMIT },
1659 {AB_Or, 0, 0, "Or", KW_Or },
1660 {AB_Paren, 0, 0, "Paren", KW_OParen },
1661 {AB_PLambda, 0, 0, "PLambda", TK_LIMIT },
1662 {AB_PretendTo, 0, 0, "PretendTo", KW_Pretend },
1663 {AB_Qualify, 0, 0, "Qualify", KW_Dollar },
1664 {AB_Quote, 0, 0, "Quote", KW_Quote },
1665 {AB_Raise, 0, 0, "Raise", KW_Throw },
1666 {AB_Reference, 0, 0, "Reference", KW_Reference },
1667 {AB_Repeat, 0, 0, "Repeat", KW_Repeat },
1668 {AB_RestrictTo, 0, 0, "RestrictTo", KW_At },
1669 {AB_Return, 0, 0, "Return", KW_Return },
1670 {AB_Select, 0, 0, "Select", KW_Select },
1671 {AB_Sequence, 0, 0, "Sequence", TK_LIMIT },
1672 {AB_Test, 0, 0, "Test", TK_LIMIT },
1673 {AB_Try, 0, 0, "Try", KW_Try },
1674 {AB_Unit, 0, 0, "Unit", TK_LIMIT },
1675 {AB_Where, 0, 0, "Where", KW_Where },
1676 {AB_While, 0, 0, "While", KW_While },
1677 {AB_With, 0, 0, "With", KW_With },
1678 {AB_Yield, 0, 0, "Yield", KW_Yield },
1679
1680 {AB_LIMIT, 0, 0, "LIMIT", TK_LIMIT }
1681};
1682
1683localstatic int
1684abTagFormatter(OStream ostream, int p)
1685{
1686 int tag = (int) p;
1687 if (tag < 0 || tag >= AB_LIMIT) {
1688 return ostreamPrintf(ostream, "AbTag[%d]", tag);
1689 }
1690 else {
1691 return ostreamPrintf(ostream, "AbTag[%s]", abInfo(tag)abInfoTable[(tag) - AB_START].str);
1692 }
1693}
1694
1695
1696/*
1697 * Equality preserving functions for abTransferSemantics.
1698 */
1699
1700localstatic Sefo
1701abEqualMods(Sefo sefo)
1702{
1703 Bool changed = (sefo != NULL((void*)0));
1704
1705 while (changed)
1706 switch (abTag(sefo)((sefo)->abHdr.tag)) {
1707 case AB_Hide:
1708 sefo = sefo->abHide.type;
1709 break;
1710 case AB_Define:
1711 sefo = sefo->abDefine.lhs;
1712 break;
1713 case AB_PretendTo:
1714 sefo = sefo->abPretendTo.expr;
1715 break;
1716 case AB_RestrictTo:
1717 sefo = sefo->abRestrictTo.expr;
1718 break;
1719 case AB_Qualify:
1720 sefo = sefo->abQualify.what;
1721 break;
1722 case AB_Declare:
1723 if (abIsNothing(sefo->abDeclare.id)((sefo->abDeclare.id)->abHdr.tag == (AB_Nothing))
1724 || abTag(sefo->abDeclare.id)((sefo->abDeclare.id)->abHdr.tag) == AB_Label)
1725 sefo = sefo->abDeclare.type;
1726 else
1727 changed = false((int) 0);
1728 break;
1729 case AB_Comma:
1730 if (abArgc(sefo)((sefo)->abHdr.argc) == 1)
1731 sefo = abArgv(sefo)((sefo)->abGen.data.argv)[0];
1732 else
1733 changed = false((int) 0);
1734 break;
1735 case AB_Label:
1736 sefo = sefo->abLabel.expr;
1737 break;
1738 default:
1739 changed = false((int) 0);
1740 break;
1741 }
1742
1743 return sefo;
1744}
1745
1746/*
1747 * from and to should be two absyns that have exactly the same
1748 * structure. We transfer the sematics information from 'from'
1749 * to 'to'.
1750 */
1751void
1752abTransferSemantics(AbSyn from, AbSyn to)
1753{
1754 if (abState(to)((to)->abHdr.state) > abState(from)((from)->abHdr.state))
1755 return;
1756
1757 if (from == to)
1758 return;
1759
1760 if (abHasTag(to, AB_Blank)((to)->abHdr.tag == (AB_Blank)))
1761 return;
1762
1763 if (abTag(from)((from)->abHdr.tag) != abTag(to)((to)->abHdr.tag)) {
1764 from = abEqualMods(from);
1765 to = abEqualMods(to);
1766 }
1767
1768 if (DEBUG(ab)abDebug) {
1769 if (abTag(from)((from)->abHdr.tag) != abTag(to)((to)->abHdr.tag)) {
1770 fprintf(dbOut,"'from' absyn = ");
1771 abPrint(dbOut, from);
1772 fnewline(dbOut);
1773 fprintf(dbOut,"'to' absyn = ");
1774 abPrint(dbOut, to);
1775 fnewline(dbOut);
1776 }
1777 }
1778
1779 abUse(to)((to)->abHdr.use) = abUse(from)((from)->abHdr.use);
1780
1781 if (from->abHdr.seman) {
1782 abSetComment(to, abComment(from)((from)->abHdr.seman ? (from)->abHdr.seman->comment :
0)
);
1783 abSetStab(to, abStab(from)((from)->abHdr.seman ? (from)->abHdr.seman->stab : 0
)
);
1784 abSetSyme(to, abSyme(from)((from)->abHdr.seman ? (from)->abHdr.seman->syme : 0
)
);
1785 abSetTForm(to, abTForm(from)((from)->abHdr.seman ? (from)->abHdr.seman->tform : 0
)
);
1786 abSetImplicit(to, abImplicit(from)((from)->abHdr.seman ? (from)->abHdr.seman->implicit
: 0)
);
1787 abSetTContext(to, abTContext(from)((from)->abHdr.seman ? (from)->abHdr.seman->embed : 0
)
);
1788 abSetDefineIdx(to, abDefineIdx(from)((from)->abHdr.seman ? (from)->abHdr.seman->defnIdx :
-1)
);
1789 abSetSelf(to, abSelf(from)((from)->abHdr.seman ? (from)->abHdr.seman->self : 0
)
);
1790 }
1791
1792 switch (abState(from)((from)->abHdr.state)) {
1793 case AB_State_HasPoss:
1794 abState(to)((to)->abHdr.state) = abState(from)((from)->abHdr.state);
1795 abTPoss(to)((to)->abHdr.type.poss) = tpossRefer(abTPoss(from)((from)->abHdr.type.poss));
1796 break;
1797 case AB_State_HasUnique:
1798 abState(to)((to)->abHdr.state) = abState(from)((from)->abHdr.state);
1799 abTUnique(to)((to)->abHdr.type.unique) = abTUnique(from)((from)->abHdr.type.unique);
1800 break;
1801 case AB_State_Error:
1802 abState(to)((to)->abHdr.state) = abState(from)((from)->abHdr.state);
1803 abTPoss(to)((to)->abHdr.type.poss) = tpossRefer(abTPoss(from)((from)->abHdr.type.poss));
1804 break;
1805 default:
1806 break;
1807 }
1808
1809 if (abIsNothing(from)((from)->abHdr.tag == (AB_Nothing)) || abIsNothing(to)((to)->abHdr.tag == (AB_Nothing)))
1810 return;
1811
1812 assert(abTag(from) == abTag(to))do { if (!(((from)->abHdr.tag) == ((to)->abHdr.tag))) _do_assert
(("abTag(from) == abTag(to)"),"absyn.c",1812); } while (0)
;
1813
1814 if (!abIsLeaf(from)(((from)->abHdr.tag) < AB_NODE_START)) {
1815 int i, n = abArgc(from)((from)->abHdr.argc);
1816 assert(n == abArgc(to))do { if (!(n == ((to)->abHdr.argc))) _do_assert(("n == abArgc(to)"
),"absyn.c",1816); } while (0)
;
1817
1818 for (i = 0; i < n; i += 1)
1819 abTransferSemantics(abArgv(from)((from)->abGen.data.argv)[i], abArgv(to)((to)->abGen.data.argv)[i]);
1820 }
1821}
1822
1823AbSeman
1824abNewSemantics(void)
1825{
1826 AbSeman as;
1827 as = (AbSeman) stoAlloc((int) OB_Other0, sizeof(*as));
1828 as->comment = 0;
1829 as->stab = 0;
1830 as->syme = 0;
1831 as->tform = 0;
1832 as->implicit = 0;
1833 as->embed = 0;
1834 as->defnIdx = -1;
1835 as->impl = NULL((void*)0);
1836 as->self = listNil(Syme)((SymeList) 0);
1837
1838 return as;
1839}
1840
1841Doc
1842abSetComment(AbSyn ab, Doc comment)
1843{
1844 Doc new = NULL((void*)0);
1845 assert(ab)do { if (!(ab)) _do_assert(("ab"),"absyn.c",1845); } while (0
)
;
1846 if (! ab->abHdr.seman)
1847 ab->abHdr.seman = abNewSemantics();
1848 if (comment) {
1849 new = comment;
1850 }
1851 ab->abHdr.seman->comment = new;
1852 return new;
1853}
1854
1855Stab
1856abSetStab(AbSyn ab, Stab stab)
1857{
1858 assert(ab)do { if (!(ab)) _do_assert(("ab"),"absyn.c",1858); } while (0
)
;
1859 if (! ab->abHdr.seman)
1860 ab->abHdr.seman = abNewSemantics();
1861 ab->abHdr.seman->stab = stab;
1862 return stab;
1863}
1864
1865Syme
1866abSetSyme(AbSyn ab, Syme syme)
1867{
1868 /* scobind may hand this a 0 ab */
1869 if (ab) {
1870 if (! ab->abHdr.seman)
1871 ab->abHdr.seman = abNewSemantics();
1872 ab->abHdr.seman->syme = syme;
1873 }
1874 return syme;
1875}
1876
1877void
1878abSetSelf(AbSyn ab, SymeList symes)
1879{
1880 /* scobind may hand this a 0 ab */
1881 if (ab) {
1882 if (! ab->abHdr.seman)
1883 ab->abHdr.seman = abNewSemantics();
1884 ab->abHdr.seman->self = symes;
1885 }
1886}
1887
1888void
1889abSetDefineIdx(AbSyn ab, int idx)
1890{
1891 /* scobind may hand this a 0 ab */
1892 if (ab) {
1893 if (! ab->abHdr.seman)
1894 ab->abHdr.seman = abNewSemantics();
1895 ab->abHdr.seman->defnIdx = idx;
1896 }
1897}
1898void
1899abSetImpl(AbSyn ab, SImpl impl)
1900{
1901 if (impl == NULL((void*)0) && !ab->abHdr.seman)
1902 return;
1903
1904 if (! ab->abHdr.seman)
1905 ab->abHdr.seman = abNewSemantics();
1906
1907 ab->abHdr.seman->impl = impl;
1908}
1909
1910AbSyn
1911abSetImplicit(AbSyn ab, AbSyn imp)
1912{
1913 assert(ab)do { if (!(ab)) _do_assert(("ab"),"absyn.c",1913); } while (0
)
;
1914 if (! ab->abHdr.seman)
1915 ab->abHdr.seman = abNewSemantics();
1916 ab->abHdr.seman->implicit = imp;
1917 return imp;
1918}
1919
1920TForm
1921abSetTForm(AbSyn ab, TForm tform)
1922{
1923 if (ab) {
1924 if (! ab->abHdr.seman)
1925 ab->abHdr.seman = abNewSemantics();
1926 ab->abHdr.seman->tform = tform;
1927 }
1928 return tform;
1929}
1930
1931AbEmbed
1932abSetTContext(AbSyn ab, AbEmbed tag)
1933{
1934 if (ab) {
1935 if (! ab->abHdr.seman)
1936 ab->abHdr.seman = abNewSemantics();
1937 ab->abHdr.seman->embed = tag;
1938 }
1939 return tag;
1940}
1941
1942AbEmbed
1943abAddTContext(AbSyn ab, AbEmbed tag)
1944{
1945 if (ab) {
1946 if (! ab->abHdr.seman)
1947 ab->abHdr.seman = abNewSemantics();
1948 ab->abHdr.seman->embed |= tag;
1949 }
1950 return tag;
1951}
1952
1953TPoss
1954abResetTPoss(AbSyn ab, TPoss tp)
1955{
1956 switch (abState(ab)((ab)->abHdr.state)) {
1957 case AB_State_HasPoss:
1958 tpossFree(abTPoss(ab)((ab)->abHdr.type.poss));
1959 break;
1960 case AB_State_HasUnique:
1961 abState(ab)((ab)->abHdr.state) = AB_State_HasPoss;
1962 break;
1963 default:
1964 break;
1965 }
1966
1967 abTPoss(ab)((ab)->abHdr.type.poss) = tp;
1968 return tp;
1969}
1970
1971/*
1972 * Important: this function may increase the reference count
1973 * on the returned tposs. If you want to use this function for
1974 * debugging purposes you must call tpossFree when you have
1975 * finished with it otherwise it will hang around forever.
1976 */
1977TPoss
1978abReferTPoss(AbSyn ab)
1979{
1980 TPoss result;
1981
1982 switch (abState(ab)((ab)->abHdr.state)) {
1983 case AB_State_HasPoss:
1984 result = tpossRefer(abTPoss(ab)((ab)->abHdr.type.poss));
1985 break;
1986 case AB_State_HasUnique:
1987 result = tpossSingleton(abTUnique(ab)((ab)->abHdr.type.unique));
1988 break;
1989 default:
1990 result = tpossEmpty();
1991 break;
1992 }
1993
1994 return result;
1995}
1996
1997/*
1998 * Find the identifier in a Declare/Define/Assign. Should not be
1999 * invoked with a multi ...
2000 */
2001
2002AbSyn
2003abDefineeId(AbSyn ab)
2004{
2005 AbSyn r;
2006
2007 r = abDefineeIdOrElse(ab, NULL((void*)0));
2008 if (!r) {
2009 abBugPrelude(ab);
2010 bugBadCase(abTag(ab))bug("Bad case %d (line %d in file %s).", (int) ((ab)->abHdr
.tag), 2010, "absyn.c")
;
2011 }
2012 return r;
2013}
2014
2015
2016AbSyn
2017abDefineeIdOrElse(AbSyn ab, AbSyn failed)
2018{
2019 if (DEBUG(ab)abDebug) {
2020 fprintf(dbOut, "abDefineeIdOrElse: ");
2021 abPrint(dbOut, ab);
2022 fnewline(dbOut);
2023 }
2024 while (abTag(ab)((ab)->abHdr.tag) != AB_Id)
2025 switch (abTag(ab)((ab)->abHdr.tag)) {
2026 case AB_Assign:
2027 ab = ab->abAssign.lhs;
2028 break;
2029 case AB_Define:
2030 ab = ab->abDefine.lhs;
2031 break;
2032 case AB_Documented:
2033 ab = ab->abDocumented.expr;
2034 break;
2035 case AB_Declare:
2036 ab = ab->abDeclare.id;
2037 break;
2038 case AB_For:
2039 ab = ab->abFor.lhs;
2040 break;
2041 case AB_Local:
2042 case AB_Free:
2043 case AB_Sequence:
2044 case AB_Comma:
2045 if (abArgc(ab)((ab)->abHdr.argc) < 1)
2046 return failed;
2047 if (abArgc(ab)((ab)->abHdr.argc) > 1) {
2048 afprintf(dbOut, "%pAbSyn\n", ab);
2049 bugWarning("abDefineeId comma bug");
2050 }
2051 ab = abArgv(ab)((ab)->abGen.data.argv)[0];
2052 break;
2053 case AB_Id:
2054 break;
2055 default:
2056 return failed;
2057 }
2058
2059 return ab;
2060}
2061
2062/*
2063 * Find the type in a Declare/Define/Assign.
2064 */
2065
2066AbSyn
2067abDefineeType(AbSyn ab)
2068{
2069 AbSyn r;
2070
2071 r = abDefineeTypeOrElse(ab, NULL((void*)0));
2072 if (!r) {
2073 abBugPrelude(ab);
2074 bugBadCase(abTag(ab))bug("Bad case %d (line %d in file %s).", (int) ((ab)->abHdr
.tag), 2074, "absyn.c")
;
2075 }
2076 return r;
2077}
2078
2079AbSyn
2080abDefineeTypeOrElse(AbSyn ab, AbSyn failed)
2081{
2082 if (DEBUG(ab)abDebug) {
2083 fprintf(dbOut, "abDefineeTypeOrElse: ");
2084 abPrint(dbOut, ab);
2085 fnewline(dbOut);
2086 }
2087 while (abTag(ab)((ab)->abHdr.tag) != AB_Declare)
2088 switch (abTag(ab)((ab)->abHdr.tag)) {
2089 case AB_Assign:
2090 ab = ab->abAssign.lhs;
2091 break;
2092 case AB_Define:
2093 ab = ab->abDefine.lhs;
2094 break;
2095 case AB_Documented:
2096 ab = ab->abDocumented.expr;
2097 break;
2098 default:
2099 return failed;
2100 }
2101
2102 return ab->abDeclare.type;
2103}
2104
2105/*****************************************************************************
2106 *
2107 * :: Debugging facilities
2108 *
2109 ****************************************************************************/
2110
2111void
2112abDumpPosition(AbSyn ab)
2113{
2114 /* Display the source code where `ab' came from */
2115 if (ab)
2116 {
2117 spstackPrintDb(ab->abHdr.pos);
2118 fnewline(dbOut);
2119 }
2120}
2121
2122localstatic int
2123abFormatter(OStream ostream, Pointer p)
2124{
2125 AbSyn absyn = (AbSyn) p;
2126 return abOStreamPrint(ostream, absyn);
2127}
2128
2129localstatic int
2130abFormatterList(OStream ostream, Pointer p)
2131{
2132 AbSynList list = (AbSynList) p;
2133 return listFormat(AbSyn)(AbSyn_listPointer->Format)(ostream, "AbSyn", list);
2134}