Bug Summary

File:src/terror.c
Warning:line 1537, column 9
Value stored to 'fmt' during its initialization is never read

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 terror.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 terror.c
1/****************************************************************************
2 *
3 * terror.c: Type errors.
4 *
5 * Copyright (c) 1990-2007 Aldor Software Organization Ltd (Aldor.org).
6 *
7 ***************************************************************************/
8
9#include "ablogic.h"
10#include "abpretty.h"
11#include "absub.h"
12#include "comsg.h"
13#include "debug.h"
14#include "format.h"
15#include "freevar.h"
16#include "lib.h"
17#include "sefo.h"
18#include "spesym.h"
19#include "stab.h"
20#include "store.h"
21#include "strops.h"
22#include "table.h"
23#include "tconst.h"
24#include "tfsat.h"
25#include "terror.h"
26#include "tposs.h"
27#include "util.h"
28
29extern void tiBottomUp (Stab, AbSyn, TForm);
30extern void tiTopDown (Stab, AbSyn, TForm);
31
32/******************************************************************************
33 *
34 * :: Type form error rejection analysis structure.
35 *
36 *****************************************************************************/
37
38struct treject {
39 int why;
40 Syme syme;
41 TForm tf;
42 Length parN;
43 Length argN;
44};
45
46typedef struct treject * TReject;
47
48struct trejectInfo {
49 TReject * argv;
50 Length argc;
51 Length i;
52};
53
54typedef struct trejectInfo * TRejectInfo;
55
56#define trCurrent(trInfo)(trInfo->argv[trInfo->i]) (trInfo->argv[trInfo->i])
57#define trFirst(trInfo)(trInfo->argv[0]) (trInfo->argv[0])
58#define trInfoGet(trInfo,i)(trInfo->argv[i]) (trInfo->argv[i])
59#define trInfoArgc(trInfo)(trInfo->argc) (trInfo->argc)
60
61#define trWhy(tr)((tr)->why) ((tr)->why)
62#define trSyme(tr)((tr)->syme) ((tr)->syme)
63#define trType(tr)((tr)->tf) ((tr)->tf)
64#define trParN(tr)((tr)->parN) ((tr)->parN)
65#define trArgN(tr)((tr)->argN) ((tr)->argN)
66
67localstatic TReject trAlloc (Syme, TForm);
68localstatic void trFree (TReject);
69
70localstatic void trInfoFrStab (TRejectInfo, Stab, AbLogic, Symbol);
71localstatic void trInfoFrTPoss (TRejectInfo, TPoss);
72localstatic void trInfoFrTUnique (TRejectInfo, TForm);
73
74localstatic void bputCondition (Buffer buf, SefoList conds);
75localstatic void terrorPrintSymeList(Buffer obuf, String prefix, SymeList msymes);
76localstatic void terrorPutConditionallyDefinedExports(Buffer obuf, Stab stab, SymeList mods, AbSyn ab, SymeList symes);
77
78/**************************************************************************
79 * TReject / TRejectInfo utility
80 **************************************************************************/
81
82localstatic TReject
83trAlloc(Syme syme, TForm tf)
84{
85 TReject tr;
86
87 tfFollow(tf)((tf) = tfFollowFn(tf));
88 tr = (TReject) stoAlloc((unsigned) OB_Other0, sizeof(*tr));
89
90 tr->syme = syme;
91 tr->tf = tf;
92 tr->parN = 0;
93 tr->argN = 0;
94
95 return tr;
96}
97
98localstatic void
99trFree(TReject tr)
100{
101 stoFree((Pointer) tr);
102}
103
104localstatic void
105trInfoFrStab(TRejectInfo trInfo, Stab stab, AbLogic cond, Symbol sym)
106{
107 SymeList symes;
108 TReject * trArr;
109 Length nsymes;
110 Length i = 0;
111
112 symes = stabGetMeanings(stab, cond, sym);
113 nsymes = listLength(Syme)(Syme_listPointer->_Length)(symes);
114 trArr = (TReject *) stoAlloc((unsigned) OB_Other0,
115 sizeof(TReject) * nsymes);
116
117 for (; symes; symes = cdr(symes)((symes)->rest)) {
118 Syme syme = car(symes)((symes)->first);
119 TForm type = symeType(syme);
120
121 trArr[i++] = trAlloc(syme, type);
122 }
123 assert(i == nsymes)do { if (!(i == nsymes)) _do_assert(("i == nsymes"),"terror.c"
,123); } while (0)
;
124 trInfo->argv = trArr;
125 trInfo->argc = nsymes;
126}
127
128localstatic void
129trInfoFrTPoss(TRejectInfo trInfo, TPoss tp)
130{
131 TReject * trArr;
132 Length ntposs = tpossCount(tp);
133 Length i = 0;
134 TPossIterator it;
135
136 trArr = (TReject *) stoAlloc((unsigned) OB_Other0,
137 sizeof(TReject) * ntposs);
138
139 for (tpossITER(it, tp)((it).possl = (tp ? (tp)->possl : ((void*)0))); tpossMORE(it)((it).possl); tpossSTEP(it)((it).possl = (((it).possl)->rest))) {
140 TForm type = tpossELT(it)tpossELT_(&it);
141
142 trArr[i++] = trAlloc(NULL((void*)0), type);
143 }
144 assert(i == ntposs)do { if (!(i == ntposs)) _do_assert(("i == ntposs"),"terror.c"
,144); } while (0)
;
145 trInfo->argv = trArr;
146 trInfo->argc = ntposs;
147}
148
149localstatic void
150trInfoFrTUnique(TRejectInfo trInfo, TForm tf)
151{
152 TReject * trArr = (TReject *) stoAlloc((unsigned) OB_Other0,
153 sizeof(TReject));
154
155 *trArr = trAlloc(NULL((void*)0), tf);
156
157 trInfo->argv = trArr;
158 trInfo->argc = 1;
159}
160
161localstatic void
162trInfoFree(TRejectInfo trInfo)
163{
164 Length i;
165
166 for (i = 0; i < trInfo->argc; i++)
167 trFree(trInfo->argv[i]);
168
169 stoFree(trInfo->argv);
170}
171
172/***********************************************************************
173 * Sorting treject for generic apply
174 ***********************************************************************/
175
176localstatic int
177trejectCmpPtr(TReject *ptr1, TReject *ptr2)
178{
179 if (trWhy(*ptr1)((*ptr1)->why) < trWhy(*ptr2)((*ptr2)->why))
180 return -1;
181 else if (trWhy(*ptr1)((*ptr1)->why) > trWhy(*ptr2)((*ptr2)->why))
182 return 1;
183 else if (trWhy(*ptr1)((*ptr1)->why) == TR_BadArgType2) {
184 if (trArgN(*ptr1)((*ptr1)->argN) < trArgN(*ptr2)((*ptr2)->argN))
185 return -1;
186 else if (trArgN(*ptr1)((*ptr1)->argN) > trArgN(*ptr2)((*ptr2)->argN))
187 return 1;
188 else
189 return 0;
190 }
191 else
192 return 0;
193}
194
195/* Sort the treject vector accordind to following rules:
196 * - the order is BadArgType, ParMissing, EmbedFail, BadFnType
197 * - for BadArgType the order is ascendent on the argument number
198 */
199localstatic void
200sortTRejectInfo(TRejectInfo trInfo)
201{
202 lisort(trInfo->argv, trInfo->argc, sizeof(TReject),
203 (int (*)(ConstPointer, ConstPointer)) trejectCmpPtr);
204}
205
206/***********************************************************************
207 * Sorting treject for set!
208 ***********************************************************************/
209
210/* Gives an ordering for use in setbang.
211 * the order is:
212 * - BadFnType,BadArgType,ParMissing,EmbedFail
213 * - for BadArgType the order is discendent on the arg number
214 */
215localstatic int
216trejectSetBangCmpPtr(TReject *ptr1, TReject *ptr2)
217{
218 if (trWhy(*ptr1)((*ptr1)->why) < trWhy(*ptr2)((*ptr2)->why))
219 return -1;
220 else if (trWhy(*ptr1)((*ptr1)->why) > trWhy(*ptr2)((*ptr2)->why))
221 return 1;
222 else if (trWhy(*ptr1)((*ptr1)->why) == TR_BadArgType2) {
223 if (trArgN(*ptr1)((*ptr1)->argN) < trArgN(*ptr2)((*ptr2)->argN))
224 return 1;
225 else if (trArgN(*ptr1)((*ptr1)->argN) > trArgN(*ptr2)((*ptr2)->argN))
226 return -1;
227 else
228 return 0;
229 }
230 else
231 return 0;
232}
233
234localstatic void
235sortSetBangTRejectInfo(TRejectInfo trInfo)
236{
237 lisort(trInfo->argv, trInfo->argc, sizeof(TReject),
238 (int (*)(ConstPointer,ConstPointer)) trejectSetBangCmpPtr);
239}
240
241/******************************************************************************
242 *
243 * :: Local declarations.
244 *
245 *****************************************************************************/
246
247#define INDENT2 2
248#define CLIP65 65
249
250localstatic long terrorClip = CLIP65;
251localstatic void operatorErrMsg (AbSyn, AbSyn, Buffer);
252localstatic String fmtAbSyn (AbSyn);
253localstatic String fmtTForm (TForm);
254
255localstatic void bputMeanings (Buffer, TPoss);
256localstatic void bputSymes (Buffer, SymeList, String);
257localstatic void bputSyme (Buffer, Syme, TForm, String);
258localstatic void bputType (Buffer, TForm, String);
259localstatic void bputTForm (Buffer, TForm);
260localstatic void bputTPoss (Buffer, TPoss);
261localstatic void bputTPoss0(Buffer buf, int indent, TPoss tp);
262localstatic void bputAbTPoss (Buffer obuf, int indent, AbSyn ab, Msg, Msg);
263localstatic void bputContextType(Buffer obuf, TForm type);
264localstatic void bputTConst (Buffer, TConst);
265localstatic void bputTReject (Buffer, TReject, String);
266
267localstatic void bputAllValidMeanings(Buffer obuf, Stab stab, AbSyn ab, Length argc,
268 AbSynGetter argf, TForm tf, TForm type, Symbol idSym,
269 Bool * firstMean, String fmtOp);
270localstatic Bool bputMeaningsOutOfScope(Buffer obuf, Stab stab, AbSyn ab,AbSyn op,
271 Length argc,AbSynGetter argf, TForm type,
272 String fmtOp);
273localstatic void bputBadArgType(TRejectInfo trInfo, Buffer obuf, AbSyn ab,
274 Length argc, AbSynGetter argf, String fmtOp);
275localstatic void bputParMissing(TRejectInfo trInfo, Buffer obuf, String fmtOp);
276localstatic void bputEmbedFail(TRejectInfo trInfo, Buffer obuf, int argc,
277 String fmtOp);
278localstatic void bputBadFnType(TRejectInfo trInfo, Buffer obuf, TForm type, String fmtOp);
279localstatic void analyseRejectionCause(TReject tr, Stab stab, AbSyn ab, Length argc,
280 AbSynGetter argf, TForm type);
281localstatic void fillTRejectInfo(TRejectInfo trInfo, TForm type, AbSyn ab, Stab stab,
282 Length argc, AbSynGetter argf);
283localstatic void noMeaningsForOperator(Buffer obuf, TForm type, AbSyn ab, AbSyn op,
284 Stab stab, Length argc, AbSynGetter argf,
285 String fmtOp);
286
287localstatic void bputFirstExitTypes(AbSyn ab, String kind);
288localstatic void bputOtherExitTypes(AbSyn ab, String strKind);
289
290localstatic void terrorSequence (Stab, AbSyn, TForm);
291localstatic void terrorCoerceTo (Buffer, AbSyn , TForm);
292localstatic void terrorApply (Stab stab, AbSyn absyn, TForm type);
293localstatic void terrorImplicit (Stab stab, AbSyn absyn, TForm type);
294localstatic void terrorImplicitSetBang(Stab stab, AbSyn ab, Length argc, AbSynGetter argf, TForm type);
295localstatic Bool terrorAssignOrSetBang(Stab stab, AbSyn absyn, TForm type);
296localstatic void terrorNoMeaningForLit(AbSyn ab);
297localstatic Bool terrorIllegalDepAssign(int, AbSyn *, TForm *);
298
299extern AbSynList abExitsList;
300extern AbSynList abYieldsList;
301extern AbSynList abReturnsList;
302
303
304/****************************************************************************
305 *
306 * :: terror (main external entry point)
307 *
308 ****************************************************************************/
309/* Called on a node with abstate = State_Error
310 * Return false if the subtree needs NO more to be examined
311 */
312Bool
313terror (Stab stab, AbSyn absyn, TForm type)
314{
315 Bool result = true1;
316
317
318 /* Deal with the disaster scenario */
319 if (abState(absyn)((absyn)->abHdr.state) == AB_State_HasUnique) {
320 bugWarning("terror: absyn has unique type!");
321 abState(absyn)((absyn)->abHdr.state) = AB_State_HasPoss;
322 abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(abTUnique(absyn)((absyn)->abHdr.type.unique));
323 }
324
325 /* gives error msg */
326
327 switch (abTag(absyn)((absyn)->abHdr.tag)) {
328 case AB_Id: {
329 Symbol sym = absyn->abId.sym;
330 terrorNoMeaningForId(absyn,symString(sym)((sym)->str));
331 }
332 break;
333
334 case AB_LitInteger:
335 case AB_LitFloat:
336 case AB_LitString:
337 terrorNoMeaningForLit(absyn);
338 break;
339
340 case AB_Assign:
341 result = terrorAssignOrSetBang(stab, absyn, type);
342 break;
343
344 case AB_Add: /* NB: We may have an error other than
345 * "insufficient exports. see call to tfSatisfies
346 * in tiBupAdd
347 * Solution is to call tiAddSymes to see which error
348 * occurred.
349 */
350 assert(abState(absyn) != AB_State_HasUnique)do { if (!(((absyn)->abHdr.state) != AB_State_HasUnique)) _do_assert
(("abState(absyn) != AB_State_HasUnique"),"terror.c",350); } while
(0)
;
351 terrorNotEnoughExports(stab, absyn, abTPoss(absyn)((absyn)->abHdr.type.poss), false((int) 0));
352 tpossFree(abTPoss(absyn)((absyn)->abHdr.type.poss));
353 abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossEmpty();
354 break;
355
356 case AB_Apply:
357 terrorApply(stab, absyn, type);
358 break;
359
360 case AB_Sequence:
361 terrorSequence(stab, absyn, type);
362 break;
363
364 case AB_Generate:
365 case AB_Lambda:
366 case AB_PLambda:
367 break;
368
369 case AB_Return:
370 assert(abState(absyn) != AB_State_HasUnique)do { if (!(((absyn)->abHdr.state) != AB_State_HasUnique)) _do_assert
(("abState(absyn) != AB_State_HasUnique"),"terror.c",370); } while
(0)
;
371 if (tuniIsInappropriate(abTPoss(absyn))((((absyn)->abHdr.type.poss)) == ((TPoss) 12L))) {
372 comsgError(absyn, ALDOR_E_TinWildReturn170);
373 abTPoss(absyn)((absyn)->abHdr.type.poss) = NULL((void*)0);
374 }
375 else
376 abReturnsList = listCons(AbSyn)(AbSyn_listPointer->Cons)(absyn->abExit.value,abReturnsList);
377 result = false((int) 0);
378 break;
379
380 case AB_Yield:
381 assert(abState(absyn) != AB_State_HasUnique)do { if (!(((absyn)->abHdr.state) != AB_State_HasUnique)) _do_assert
(("abState(absyn) != AB_State_HasUnique"),"terror.c",381); } while
(0)
;
382 if (tuniIsInappropriate(abTPoss(absyn))((((absyn)->abHdr.type.poss)) == ((TPoss) 12L))) {
383 comsgError(absyn, ALDOR_E_TinWildYield171);
384 abTPoss(absyn)((absyn)->abHdr.type.poss) = NULL((void*)0);
385 }
386 else
387 abYieldsList = listCons(AbSyn)(AbSyn_listPointer->Cons)(absyn->abExit.value,abYieldsList);
388 result = false((int) 0);
389 break;
390
391 case AB_Exit:
392 assert(abState(absyn) != AB_State_HasUnique)do { if (!(((absyn)->abHdr.state) != AB_State_HasUnique)) _do_assert
(("abState(absyn) != AB_State_HasUnique"),"terror.c",392); } while
(0)
;
393 if (tuniIsInappropriate(abTPoss(absyn))((((absyn)->abHdr.type.poss)) == ((TPoss) 12L))) {
394 comsgError(absyn, ALDOR_E_TinWildExit169);
395 abTPoss(absyn)((absyn)->abHdr.type.poss) = NULL((void*)0);
396 }
397 else
398 abExitsList = listCons(AbSyn)(AbSyn_listPointer->Cons)(absyn->abExit.value,abExitsList);
399 result = false((int) 0);
400 break;
401
402 case AB_Goto:
403 abTPoss(absyn)((absyn)->abHdr.type.poss) = NULL((void*)0);
404 comsgError(absyn->abGoto.label, ALDOR_E_TinBadGoto166);
405 result = false((int) 0);
406 break;
407
408 default:
409 if (abImplicit(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->implicit
: 0)
)
410 terrorImplicit(stab, absyn, type);
411 else
412 terrorNotUniqueType(ALDOR_E_TinExprMeans164,absyn,type,
413 abTPoss(absyn)((absyn)->abHdr.type.poss));
414 }
415
416 if ((abState(absyn)((absyn)->abHdr.state) != AB_State_HasUnique) && abGoodTPoss(absyn)(((absyn)->abHdr.state) == AB_State_Error ? ((void*)0) :((
absyn)->abHdr.type.poss))
)
417 tpossFree(abTPoss(absyn)((absyn)->abHdr.type.poss));
418 abState(absyn)((absyn)->abHdr.state) = AB_State_HasPoss;
419 abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossEmpty();
420
421 return result;
422}
423
424/****************************************************************************
425 *
426 * :: terrorAssignOrSetBang
427 *
428 ****************************************************************************/
429
430
431localstatic Bool
432terrorAssignOrSetBang (Stab stab, AbSyn absyn, TForm type)
433{
434 Bool result = false((int) 0);
435 AbSyn lhs = absyn->abAssign.lhs;
436 AbSyn rhs = absyn->abAssign.rhs;
437
438 if (abTag(lhs)((lhs)->abHdr.tag) == AB_Apply) {
439 Length argc = abArgc(lhs)((lhs)->abHdr.argc)+1;
440 Length i;
441
442 terrorImplicitSetBang(stab, absyn, argc, abSetArgf, type);
443
444 for (i = 0 ; i < argc ; i++) {
445 AbSyn argi = abSetArgf(absyn,i);
446
447 /* Deal with the easy case */
448 if (abTag(argi)((argi)->abHdr.tag) == AB_Id) {
449 if (abState(argi)((argi)->abHdr.state) == AB_State_Error) {
450 abState(argi)((argi)->abHdr.state) = AB_State_HasPoss;
451 abTPoss(argi)((argi)->abHdr.type.poss) = tpossEmpty();
452 }
453 else /* Pass the buck onto the caller */
454 result = true1;
455 }
456 }
457 }
458 else if (abTag(lhs)((lhs)->abHdr.tag) == AB_Comma && tpossIsUnique(abGoodTPoss(rhs)(((rhs)->abHdr.state) == AB_State_Error ? ((void*)0) :((rhs
)->abHdr.type.poss))
)) {
459 AbSyn *lhsv = 0;
460 AbSyn *rhsv = 0;
461 TForm *trhsv = 0, trhs;
462 int lhsc = 0, i;
463
464 trhs = tpossUnique(abTPoss(rhs)((rhs)->abHdr.type.poss));
465 if (tfIsUnknown(trhs)(((trhs)->tag) == TF_Unknown)) {
466 String msg = "bad case 1 in terrorAssignOrSetBang";
467 comsgFatal(absyn, ALDOR_F_Bug365, msg);
468 /* bug("Bad case 1 in terrorAssignOrSetBang");*/
469 }
470
471 lhsc = abArgc(lhs)((lhs)->abHdr.argc);
472 lhsv = abArgv(lhs)((lhs)->abGen.data.argv);
473
474 if (tfIsCross(trhs)(((trhs)->tag) == TF_Cross) && tfCrossArgc(trhs) == lhsc) {
475 trhsv = tfArgv(trhs)((trhs)->argv);
476 rhsv = abArgv(rhs)((rhs)->abGen.data.argv);
477 }
478 else if (tfIsMulti(trhs)(((trhs)->tag) == TF_Multiple) && tfMultiArgc(trhs) == lhsc) {
479 trhsv = tfArgv(trhs)((trhs)->argv);
480 rhsv = abArgv(rhs)((rhs)->abGen.data.argv);
481 }
482 else {
483 comsgError(rhs, ALDOR_E_TinCantSplitRHS162);
484 return false((int) 0);
485 }
486 if (terrorIllegalDepAssign(lhsc, lhsv, trhsv))
487 return false((int) 0);
488
489 for (i = 0; i < lhsc; i++) {
490 if (!tpossSelectSatisfier(abTPoss(lhsv[i])((lhsv[i])->abHdr.type.poss),
491 trhsv[i])) {
492 AbSyn fake = abNewNothing(abPos(lhsv[i]))abNew(AB_Nothing, (spstackFirst((lhsv[i])->abHdr.pos)),0 );
493 AbSyn ab = abNewAssign(abPos(lhsv[i]),abNew(AB_Assign, (spstackFirst((lhsv[i])->abHdr.pos)),2, lhsv
[i],fake)
494 lhsv[i], fake)abNew(AB_Assign, (spstackFirst((lhsv[i])->abHdr.pos)),2, lhsv
[i],fake)
;
495 abTPoss(fake)((fake)->abHdr.type.poss) = tpossSingleton(trhsv[i]);
496 abState(fake)((fake)->abHdr.state) = AB_State_HasPoss;
497 terrorAssignOrSetBang(stab, ab, trhsv[i]);
498 tpossFree(abTPoss(fake)((fake)->abHdr.type.poss));
499 tpossFree(abTPoss(ab)((ab)->abHdr.type.poss));
500 abFree(fake);
501 abFreeNode(ab);
502 }
503 if (abState(lhsv[i])((lhsv[i])->abHdr.state) == AB_State_Error ||
504 abState(rhsv[i])((rhsv[i])->abHdr.state) == AB_State_Error) {
505 AbSyn fake = abNewNothing(abPos(lhs))abNew(AB_Nothing, (spstackFirst((lhs)->abHdr.pos)),0 );
506 AbSyn ab = abNewAssign(abPos(lhs), lhsv[i],abNew(AB_Assign, (spstackFirst((lhs)->abHdr.pos)),2, lhsv[
i],fake)
507 fake)abNew(AB_Assign, (spstackFirst((lhs)->abHdr.pos)),2, lhsv[
i],fake)
;
508 abTPoss(fake)((fake)->abHdr.type.poss) = tpossSingleton(trhsv[i]);
509 abState(fake)((fake)->abHdr.state) = AB_State_HasPoss;
510 /* ?? SetBang ?? */
511 terrorSetBang(stab, ab, abArgc(lhsv[i])((lhsv[i])->abHdr.argc)+1,
512 abSetArgf);
513
514 tpossFree(abTPoss(fake)((fake)->abHdr.type.poss));
515 tpossFree(abTPoss(ab)((ab)->abHdr.type.poss));
516 abFree(fake);
517 abFreeNode(ab);
518 }
519 }
520 }
521
522 else {
523 TPoss tp = abTPoss(absyn)((absyn)->abHdr.type.poss);
524 terrorAssign(absyn, type, tp);
525
526 /* Deal with the easy LHS case */
527 if (abTag(lhs)((lhs)->abHdr.tag) == AB_Id) {
528 if (abState(lhs)((lhs)->abHdr.state) == AB_State_Error) {
529 abState(lhs)((lhs)->abHdr.state) = AB_State_HasPoss;
530 abTPoss(lhs)((lhs)->abHdr.type.poss) = tpossEmpty();
531 }
532 else /* Pass the buck onto the caller */
533 result = true1;
534 }
535
536
537 /* Deal with the easy RHS case */
538 if (abTag(rhs)((rhs)->abHdr.tag) == AB_Id) {
539 if (abState(rhs)((rhs)->abHdr.state) == AB_State_Error) {
540 abState(rhs)((rhs)->abHdr.state) = AB_State_HasPoss;
541 abTPoss(rhs)((rhs)->abHdr.type.poss) = tpossEmpty();
542 }
543 else /* Pass the buck onto the caller */
544 result = true1;
545 }
546 }
547
548 return result;
549}
550
551localstatic Bool
552terrorIllegalDepAssign(int argc, AbSyn *lhsv, TForm *trhsv)
553{
554 SymeList blacklist = listNil(Syme)((SymeList) 0);
555 AIntList posns = listNil(AInt)((AIntList) 0);
556 SymeList symes;
557 AIntList pl;
558
559 Bool ret = false((int) 0);
560 int i;
561 for (i=0; i<argc; i++) {
562 Syme rsyme = tfDefineeSyme(trhsv[i]);
563 Syme lsyme = abSyme(lhsv[i])((lhsv[i])->abHdr.seman ? (lhsv[i])->abHdr.seman->syme
: 0)
;
564 TForm tf = tfDefineeType(trhsv[i]);
565
566 if (rsyme && symeIsLexVar(lsyme)(((((lsyme)->kind == SYME_Trigger ? libGetAllSymes((lsyme)
->lib) : ((void*)0)), (lsyme))->kind) == SYME_LexVar)
) {
567 blacklist = listCons(Syme)(Syme_listPointer->Cons)(rsyme, blacklist);
568 posns = listCons(AInt)(AInt_listPointer->Cons)(i, posns);
569 }
570 if (!tfFVars(tf)((tf)->fv))
571 continue;
572
573 symes = blacklist;
574 pl = posns;
575
576 while (symes) {
577 if (fvHasSyme(tfFVars(tf)((tf)->fv), car(symes)((symes)->first))) {
578 String name = symString(abIdSym(lhsv[car(pl)]))((((lhsv[((pl)->first)])->abId.sym))->str);
579 comsgError(lhsv[i],
580 ALDOR_E_TinAssignCreatesDepType163,
581 name);
582 ret = true1;
583 }
584 symes = cdr(symes)((symes)->rest);
585 pl = cdr(pl)((pl)->rest);
586 }
587 }
588 listFree(Syme)(Syme_listPointer->Free)(blacklist);
589 listFree(AInt)(AInt_listPointer->Free)(posns);
590 return ret;
591}
592
593/****************************************************************************
594 *
595 * :: terrorApply
596 *
597 ****************************************************************************/
598
599localstatic void
600terrorApply (Stab stab, AbSyn absyn, TForm type)
601{
602 AbSyn op;
603 TPoss opTypes;
604 Length argc;
605 AbSynGetter argf;
606
607 if (abImplicit(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->implicit
: 0)
) {
608 op = abImplicit(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->implicit
: 0)
;
609 argc = abArgc(absyn)((absyn)->abHdr.argc);
610 argf = abArgf;
611 }
612 else {
613 op = abApplyOp(absyn)((absyn)->abApply.op);
614 argc = abApplyArgc(absyn)(((absyn)->abHdr.argc)-1);
615 argf = abApplyArgf;
616 }
617
618
619 if (abState(op)((op)->abHdr.state) == AB_State_HasUnique) {
620 TForm opType = abTUnique(op)((op)->abHdr.type.unique);
621
622 if (abIsTheId(op, ssymJoin)(((op)->abHdr.tag == (AB_Id)) && ((op)->abId.sym
)==(ssymJoin))
&&
623 tfSatisfies(tfMapRet(opType)tfFollowArg(opType, 1), tfCategory)) {
624 terrorNotUniqueType(ALDOR_E_TinOpMeans168, absyn, type, abTPoss(op)((op)->abHdr.type.poss));
625 }
626 else
627 terrorApplyFType(absyn, type, NULL((void*)0), op, stab, argc, argf);
628 }
629 else {
630 abState(op)((op)->abHdr.state) = AB_State_HasPoss;
631 opTypes = abTPoss(op)((op)->abHdr.type.poss);
632
633 if (abIsTheId(op, ssymJoin)(((op)->abHdr.tag == (AB_Id)) && ((op)->abId.sym
)==(ssymJoin))
&& tpossIsUnique(opTypes) &&
634 tfSatisfies(tfMapRet(tpossUnique(opTypes))tfFollowArg(tpossUnique(opTypes), 1), tfCategory)) {
635 terrorNotUniqueType(ALDOR_E_TinOpMeans168, absyn, type, abTPoss(op)((op)->abHdr.type.poss));
636 }
637 else if (tpossCount(opTypes) == 0)
638 terrorMeaningsOutOfScope(stab, absyn, op, type,
639 abApplyArgc(absyn)(((absyn)->abHdr.argc)-1), abApplyArgf);
640 else
641 terrorApplyFType(absyn, type, NULL((void*)0), op, stab, argc, argf);
642 }
643}
644
645void
646terrorIdCondition(TForm tf, AbSyn id, AbLogic cont, AbLogic cond)
647{
648 /*
649 * This error routine drastically needs improving.
650 * terrorPutConditionalExports() would be good here
651 * terrorTypeConstFailed() looks interesting too
652 */
653 Buffer obuf = bufNew();
654 String fmtOp = fmtAbSyn(id);
655
656 bufPrintf(obuf, "There are no suitable meanings for `");
657 bufPrintf(obuf, fmtOp);
658 bufPrintf(obuf, "': it has the condition `");
659 bputAblog(obuf, cond);
660 bufPrintf(obuf, "' which is not satisfied by the context `");
661 bputAblog(obuf, cont);
662 bufPrintf(obuf, "'.");
663
664 comsgError(id, ALDOR_E_ExplicitMsg1, bufChars(obuf));
665 bufFree(obuf);
666}
667
668void
669terrorApplyCondition(AbSyn ab, TForm tf, AbSyn op, AbLogic cont, AbLogic cond)
670{
671 /*
672 * This error routine drastically needs improving.
673 * terrorPutConditionalExports() would be good here
674 * terrorTypeConstFailed() looks interesting too
675 */
676 Buffer obuf = bufNew();
677 String fmtOp = fmtAbSyn(op);
678
679 bufPrintf(obuf, "There are no suitable meanings for `");
680 bufPrintf(obuf, fmtOp);
681 bufPrintf(obuf, "': it has the condition `");
682 bputAblog(obuf, cond);
683 bufPrintf(obuf, "' which is not satisfied by the context `");
684 bputAblog(obuf, cont);
685 bufPrintf(obuf, "'.");
686
687 comsgError(ab, ALDOR_E_ExplicitMsg1, bufChars(obuf));
688 bufFree(obuf);
689}
690
691/****************************************************************************
692 *
693 * :: terrorImplicit
694 *
695 ****************************************************************************/
696
697localstatic void
698terrorImplicit (Stab stab, AbSyn absyn, TForm type)
699{
700 AbSyn op;
701 TPoss opTypes;
702 Length argc;
703 AbSynGetter argf;
704
705 op = abImplicit(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->implicit
: 0)
;
706 opTypes = abTPoss(op)((op)->abHdr.type.poss);
707
708 switch (abTag(absyn)((absyn)->abHdr.tag)) {
709 case AB_For:
710 argc = 1;
711 argf = abForIterArgf;
712 break;
713 case AB_CoerceTo:
714 case AB_Test:
715 argc = 1;
716 argf = abArgf;
717 break;
718 default:
719 bugBadCase(abTag(absyn))bug("Bad case %d (line %d in file %s).", (int) ((absyn)->abHdr
.tag), 719, "terror.c")
;
720 NotReached(return){(void)bug("Not supposed to reach line %d in file: %s\n",720,
"terror.c");}
;
721 }
722
723 if (tpossCount(opTypes) == 0)
724 terrorMeaningsOutOfScope(stab, absyn, op, type, argc, argf);
725 else
726 terrorApplyFType(absyn, type, abTPoss(absyn)((absyn)->abHdr.type.poss),
727 op, stab, argc, argf);
728}
729
730/****************************************************************************
731 *
732 * :: terrorNotUniqueType
733 *
734 ****************************************************************************/
735
736void
737terrorNoTypes(Msg msg, AbSyn ab, TForm type, TPoss tposs)
738{
739 Buffer obuf;
740 String fmt, s;
741
742
743 /*
744 * Labelled expressions are slightly odd since we never
745 * bother to tinfer the label properly. Instead we just
746 * tinfer the expression and hope that is sufficient.
747 */
748 while (abTag(ab)((ab)->abHdr.tag) == AB_Label)
749 ab = ab->abLabel.expr;
750
751
752 /* Use terrorNotUnique for other error reports */
753 if (abTag(ab)((ab)->abHdr.tag) != AB_Sequence) {
754 terrorNotUniqueType(msg, ab, type, tposs);
755 return;
756 }
757
758
759 /*
760 * We hope that empty sequences don't need to be
761 * handled here because we have made alternative
762 * arrangements (e.g. "a value is needed but an
763 * empty sequence does not produce one").
764 */
765 if (!abArgc(ab)((ab)->abHdr.argc))
766 return;
767
768
769 terrorClip = comsgOkAbbrev() ? CLIP65 : ABPP_UNCLIPPED(200000L);
770 assert(!tpossCount(tposs))do { if (!(!tpossCount(tposs))) _do_assert(("!tpossCount(tposs)"
),"terror.c",770); } while (0)
;
771
772 obuf = bufNew();
773 fmt = comsgString(msg);
774 bufPrintf(obuf, fmt, int0((int) 0)); /* 0 types */
775
776 if (!comsgOkDetails()) {
777 /* do nothing */
778 }
779 else {
780 /* Problem with the final statement */
781 AbSyn abi = abArgv(ab)((ab)->abGen.data.argv)[abArgc(ab)((ab)->abHdr.argc)-1];
782 TPoss tpi;
783
784 if (abState(abi)((abi)->abHdr.state) != AB_State_HasUnique) {
785 tpi = abTPoss(abi)((abi)->abHdr.type.poss);
786 fmt = comsgString(ALDOR_D_TinSubexprMeans192);
787 s = fmtAbSyn(abi);
788 bufPrintf(obuf, "\n ");
789 bufPrintf(obuf, fmt, s);
790 strFree(s);
791
792 bputMeanings(obuf, tpi);
793 }
794
795 bputContextType(obuf, type);
796 }
797
798 comsgError(ab, ALDOR_E_ExplicitMsg1, bufChars(obuf));
799 bufFree(obuf);
800}
801
802
803void
804terrorNotUniqueType(Msg msg, AbSyn ab, TForm type, TPoss tposs)
805{
806 Buffer obuf;
807 String fmt, s;
808 Length i, nposs;
809
810 terrorClip = comsgOkAbbrev() ? CLIP65 : ABPP_UNCLIPPED(200000L);
811
812 nposs = tpossCount(tposs);
813
814 obuf = bufNew();
815 fmt = comsgString(msg);
816 bufPrintf(obuf, fmt, nposs);
817
818 if (!comsgOkDetails()) {
819 /* do nothing */
820 }
821 else if (nposs > 0) {
822 bputMeanings(obuf, tposs);
823 bputContextType(obuf, type);
824 }
825 else if (abIsLeaf(ab)(((ab)->abHdr.tag) < AB_NODE_START)) {
826 if (abState(ab)((ab)->abHdr.state) == AB_State_HasPoss ||
827 abState(ab)((ab)->abHdr.state) == AB_State_Error) {
828 TPoss tp;
829
830 tp = abGoodTPoss(ab)(((ab)->abHdr.state) == AB_State_Error ? ((void*)0) :((ab)
->abHdr.type.poss))
;
831 fmt = comsgString(ALDOR_D_TinSubexprMeans192);
832 s = fmtAbSyn(ab);
833 bufPrintf(obuf, "\n ");
834 bufPrintf(obuf, fmt, s);
835 strFree(s);
836
837 bputMeanings(obuf, tp);
838 }
839 bputContextType(obuf, type);
840 }
841 else {
842 for (i = 0; i < abArgc(ab)((ab)->abHdr.argc); i++) {
843 AbSyn abi = abArgv(ab)((ab)->abGen.data.argv)[i];
844 TPoss tpi;
845
846 if (abIsNothing(abi)((abi)->abHdr.tag == (AB_Nothing))) continue;
847 if (abState(abi)((abi)->abHdr.state) != AB_State_HasPoss) continue;
848
849 tpi = abTPoss(abi)((abi)->abHdr.type.poss);
850 fmt = comsgString(ALDOR_D_TinSubexprMeans192);
851 s = fmtAbSyn(abi);
852 bufPrintf(obuf, "\n ");
853 bufPrintf(obuf, fmt, s);
854 strFree(s);
855
856 bputMeanings(obuf, tpi);
857 }
858 bputContextType(obuf, type);
859 }
860
861 comsgError(ab, ALDOR_E_ExplicitMsg1, bufChars(obuf));
862 bufFree(obuf);
863}
864
865/**************************************************************************
866 *
867 * Sequence: (a;..;b)
868 *
869 **************************************************************************/
870localstatic
871void terrorSequence(Stab stab, AbSyn absyn, TForm type)
872{
873 AbSynList abl;
874
875 abExitsList = listNReverse(AbSyn)(AbSyn_listPointer->NReverse)(abExitsList);
876
877 for (abl = abExitsList; abl; abl = cdr(abl)((abl)->rest)) {
878 if (abState(car(abl))((((abl)->first))->abHdr.state) == AB_State_HasPoss &&
879 tpossCount(abTPoss(car(abl))((((abl)->first))->abHdr.type.poss)) == 0)
880 return;
881 }
882
883 if (!abExitsList) {
884 comsgError(absyn, ALDOR_E_ExplicitMsg1,
885 "Unable to determine return type");
886 return;
887 }
888
889 bputFirstExitTypes(car(abExitsList)((abExitsList)->first), "exit");
890
891 if (!comsgOkDetails()) return;
892
893 for (abl = cdr(abExitsList)((abExitsList)->rest); abl; abl = cdr(abl)((abl)->rest))
894 bputOtherExitTypes(car(abl)((abl)->first), "exit");
895
896}
897
898localstatic void
899bputFirstExitTypes(AbSyn ab, String strKind)
900{
901 String fmt, s;
902 Buffer obuf = bufNew();
903
904
905 if (abState(ab)((ab)->abHdr.state) == AB_State_HasUnique) {
906 fmt = comsgString(ALDOR_E_TinFirstExitType182);
907 s = fmtTForm(abTUnique(ab)((ab)->abHdr.type.unique));
908 bufPrintf(obuf, fmt, strKind, s);
909 strFree(s);
910 }
911 else if (tpossCount(abTPoss(ab)((ab)->abHdr.type.poss)) == 1) {
912 fmt = comsgString(ALDOR_E_TinFirstExitType182);
913 s = fmtTForm(tpossUnique(abTPoss(ab)((ab)->abHdr.type.poss)));
914 bufPrintf(obuf, fmt, strKind, s);
915 strFree(s);
916 }
917 else {
918 fmt = comsgString(ALDOR_E_TinFirstExitTypes183);
919 bufPrintf(obuf, fmt, strKind);
920 bputTPoss(obuf, abTPoss(ab)((ab)->abHdr.type.poss));
921 }
922 if (comsgOkDetails()) {
923 bufPrintf(obuf, "\n");
924 fmt = comsgString(ALDOR_D_TinFirstExitCant228);
925 bufPrintf(obuf, fmt, strKind);
926 }
927
928 comsgNError(ab, ALDOR_E_ExplicitMsg1, bufChars(obuf));
929 bufFree(obuf);
930
931}
932
933localstatic void
934bputOtherExitTypes(AbSyn ab, String strKind)
935{
936 String fmt, s;
937 Buffer obuf = bufNew();
938
939 if (abState(ab)((ab)->abHdr.state) == AB_State_HasUnique) {
940 fmt = comsgString(ALDOR_N_TinOtherExitType229);
941 s = fmtTForm(abTUnique(ab)((ab)->abHdr.type.unique));
942 bufPrintf(obuf, fmt, strKind, s);
943 strFree(s);
944 }
945 else if (tpossCount(abTPoss(ab)((ab)->abHdr.type.poss)) == 1) {
946 fmt = comsgString(ALDOR_N_TinOtherExitType229);
947 s = fmtTForm(tpossUnique(abTPoss(ab)((ab)->abHdr.type.poss)));
948 bufPrintf(obuf, fmt, strKind, s);
949 strFree(s);
950 }
951 else {
952 fmt = comsgString(ALDOR_N_TinOtherExitTypes230);
953 bufPrintf(obuf, fmt, strKind);
954 bputTPoss(obuf, abTPoss(ab)((ab)->abHdr.type.poss));
955 bufPrintf(obuf, "\n");
956 }
957
958 comsgNote(ab, ALDOR_N_ExplicitMsg2, bufChars(obuf));
959 bufFree(obuf);
960}
961
962/**************************************************************************
963 *
964 * terrorCoerceTo
965 *
966 **************************************************************************/
967
968localstatic void
969terrorCoerceTo(Buffer obuf, AbSyn ab, TForm type)
970{
971 String fmt;
972
973 fmt = comsgString(ALDOR_E_TinNoGoodOp180);
974 bufPrintf(obuf, fmt, "coerce");
975
976 if (!comsgOkDetails()) goto done;
977 assert(abState(ab->abCoerceTo.expr) != AB_State_AbSyn)do { if (!(((ab->abCoerceTo.expr)->abHdr.state) != AB_State_AbSyn
)) _do_assert(("abState(ab->abCoerceTo.expr) != AB_State_AbSyn"
),"terror.c",977); } while (0)
;
978 bufPrintf(obuf, "\n ");
979 fmt = comsgString(ALDOR_D_TinPossTypesLhs193);
980 bufPrintf(obuf, fmt);
981 if (abState(ab->abCoerceTo.expr)((ab->abCoerceTo.expr)->abHdr.state) == AB_State_HasPoss ||
982 abState(ab->abCoerceTo.expr)((ab->abCoerceTo.expr)->abHdr.state) == AB_State_Error) {
983 TPoss tpFrom = abGoodTPoss(ab->abCoerceTo.expr)(((ab->abCoerceTo.expr)->abHdr.state) == AB_State_Error
? ((void*)0) :((ab->abCoerceTo.expr)->abHdr.type.poss)
)
;
984 bputTPoss(obuf, tpFrom);
985 }
986 else {
987 TForm tfFrom = abTUnique(ab->abCoerceTo.expr)((ab->abCoerceTo.expr)->abHdr.type.unique);
988 bputTForm(obuf, tfFrom);
989 }
990
991 /* To do: "the available coerce to `type' are:..." */
992done:
993 comsgError(ab->abCoerceTo.type, ALDOR_E_ExplicitMsg1, bufChars(obuf));
994}
995
996/**************************************************************************
997 *
998 * terrorSetBang
999 *
1000 **************************************************************************/
1001
1002void
1003terrorSetBang(Stab stab, AbSyn ab, Length argc, AbSynGetter argf)
1004{
1005 Buffer obuf;
1006 String fmt, s, s0;
1007 AbSyn rhs = ab->abAssign.rhs;
1008 AbSyn argi;
1009 Length i;
1010 AbSyn abp = ab;
1011
1012 terrorClip = comsgOkAbbrev() ? CLIP65 : ABPP_UNCLIPPED(200000L);
1013
1014 obuf = bufNew();
1015
1016 fmt = comsgString(ALDOR_E_TinNoGoodOp180);
1017 bufPrintf(obuf, fmt, "set!");
1018 if (!comsgOkDetails()) goto done;
1019
1020 bufPrintf(obuf, "\n");
1021
1022/* (1) */
1023
1024 for (i = 0 ; i < argc ; i++) {
1025 argi = argf(ab, i);
1026 if (tpossCount(abGoodTPoss((argi))((((argi))->abHdr.state) == AB_State_Error ? ((void*)0) :(
((argi))->abHdr.type.poss))
) == 0) {
1027 s = fmtAbSyn(argi);
1028 if (abTag(argi)((argi)->abHdr.tag) == AB_Id) {
1029 fmt = comsgString(ALDOR_D_TinNoMeaningForId191);
1030 bufPrintf(obuf, fmt, s);
1031 }
1032 else {
1033 fmt=comsgString(ALDOR_D_TinNoGoodInterp190);
1034 bufPrintf(obuf, fmt, s);
1035 }
1036
1037
1038 abp = argi;
1039 goto done;
1040 }
1041 }
1042
1043/* (2) */
1044
1045 for (i = 0 ; i < argc - 1 ; i++) {
1046 argi = argf(ab,i);
1047 s = fmtAbSyn(argi);
1048 if (abTag(argi)((argi)->abHdr.tag) == AB_Id) { /* vvv !!FIXME */
1049 SymeList symes= stabGetMeanings(stab,ablogFalse(),
1050 argi->abId.sym);
1051
1052 if (symes) {
1053 fmt = comsgString(ALDOR_D_TinPossInterps195);
1054 bufPrintf(obuf, fmt, s);
1055 bputSymes(obuf, symes, s);
1056 bufPrintf(obuf, "\n");
1057 }
1058 }
1059 else if (abState(argi)((argi)->abHdr.state) == AB_State_HasPoss &&
1060 tpossCount(abTPoss(argi)((argi)->abHdr.type.poss))) {
1061 fmt = comsgString(ALDOR_D_TinPossInterps195);
1062 bufPrintf(obuf, fmt, s);
1063 bputTPoss(obuf, abTPoss(argi)((argi)->abHdr.type.poss));
1064 bufPrintf(obuf, "\n");
1065 }
1066 else if (abState(argi)((argi)->abHdr.state) == AB_State_HasUnique) {
1067 fmt = comsgString(ALDOR_D_TinPossInterps195);
1068 bufPrintf(obuf, fmt, s);
1069 bputTForm(obuf, abTUnique(argi)((argi)->abHdr.type.unique));
1070 bufPrintf(obuf, "\n");
1071 }
1072 strFree(s);
1073 }
1074
1075 if (abState(rhs)((rhs)->abHdr.state) == AB_State_HasPoss &&
1076 tpossCount(abTPoss(rhs)((rhs)->abHdr.type.poss))) {
1077
1078 s0 = abIsNothing(rhs)((rhs)->abHdr.tag == (AB_Nothing)) ? strCopy("?") : fmtAbSyn(rhs);
1079 fmt = comsgString(ALDOR_D_TinPossTypesRhs196);
1080 bufPrintf(obuf, fmt, s0);
1081 bputTPoss(obuf, abTPoss(rhs)((rhs)->abHdr.type.poss));
1082 strFree(s0);
1083 }
1084
1085done: comsgError(abp, ALDOR_E_ExplicitMsg1, bufChars(obuf));
1086 bufFree(obuf);
1087
1088}
1089
1090localstatic void
1091bputOthersBadArgNumber(TRejectInfo trInfo, Buffer obuf)
1092{
1093 Length i;
1094 String fmt;
1095
1096 for ( i = 1; i < trInfo->argc ; i++)
1097 if (trWhy(trInfo->argv[i])((trInfo->argv[i])->why) == TR_EmbedFail4 ||
1098 trWhy(trInfo->argv[i])((trInfo->argv[i])->why) == TR_ArgMissing3) {
1099 bufPrintf(obuf, " ");
1100 fmt = comsgString(ALDOR_D_TinOtherDiffArgNum219);
1101 bufPrintf(obuf, fmt);
1102 bufPutc(obuf, '\n');
1103 break;
1104 }
1105}
1106
1107localstatic void
1108bputSetBangBadFnType(TRejectInfo trInfo, Buffer obuf, AbSyn ab, TForm type)
1109{
1110 TPoss retTypes = tpossEmpty();
1111 String fmt = comsgString(ALDOR_D_TinPossRetTypeSetBang221);
1112 int i;
1113
1114 bufPrintf(obuf, " ");
1115 bufPrintf(obuf, fmt);
1116 for (i = 0; i < trInfo->argc && trWhy(trInfo->argv[i])((trInfo->argv[i])->why) == TR_BadFnType1;
1117 i++) {
1118 TForm tfRet = tfMapRet(trType(trInfo->argv[i]))tfFollowArg(((trInfo->argv[i])->tf), 1);
1119 tfRet = tfDefineeType(tfRet);
1120 tpossAdd1(retTypes, tfRet);
1121 }
1122
1123 bputTPoss(obuf, retTypes);
1124 bputContextType(obuf, type);
1125 tpossFree(retTypes);
1126}
1127
1128localstatic void
1129bputSetBangBadArgType(TReject tr, Buffer obuf, AbSyn ab, Length argc,
1130 AbSynGetter argf)
1131{
1132 String fmt;
1133 Length argN = trArgN(tr)((tr)->argN);
1134 AbSyn argErr = argf(ab, argN);
1135 String fmtArgErr = fmtAbSyn(argErr);
1136
1137 if (argN == argc - 1) {
1138 TForm type;
1139 bputAbTPoss(obuf, 2, argErr,
1140 ALDOR_D_TinRejectedTypeForRhs209,
1141 ALDOR_D_TinRejectedTypesForRhs208);
1142 type = tfMapArgN(trType(tr)((tr)->tf), argN);
1143 type = tfDefineeType(type);
1144 bputContextType(obuf, type);
1145 }
1146 else if (argN > 0) {
1147 bufPrintf(obuf, " ");
1148 fmt = comsgString(ALDOR_D_TinPossSelectorTypes220);
1149 bufPrintf(obuf, fmt, fmtArgErr);
1150 bputTPoss0(obuf, 4, abTPoss(argErr)((argErr)->abHdr.type.poss));
1151 }
1152 else {
1153 bufPrintf(obuf, " ");
1154 fmt = comsgString(ALDOR_D_TinPossTypesForSetBang222);
1155 bufPrintf(obuf, fmt, fmtArgErr);
1156 bputTPoss0(obuf, 4, abTPoss(argErr)((argErr)->abHdr.type.poss));
1157 }
1158 strFree(fmtArgErr);
1159}
1160
1161localstatic void
1162bputSetBangArgNumber(Buffer obuf)
1163{
1164 String fmt = comsgString(ALDOR_D_TinSetBangBadArgNum223);
1165 bufPrintf(obuf, " ");
1166 bufPrintf(obuf, fmt);
1167}
1168
1169
1170
1171localstatic void
1172terrorImplicitSetBang(Stab stab, AbSyn ab, Length argc, AbSynGetter argf,
1173 TForm type)
1174{
1175 Buffer obuf;
1176 String fmt;
1177 AbSyn abp = ab;
1178 struct trejectInfo trInfoStruct;
1179 TReject tr = (TReject)NULL((void*)0);
1180
1181
1182 terrorClip = comsgOkAbbrev() ? CLIP65 : ABPP_UNCLIPPED(200000L);
1183
1184 obuf = bufNew();
1185 trInfoStruct.i = 0;
1186
1187 fmt = comsgString(ALDOR_E_TinNoGoodOp180);
1188 bufPrintf(obuf, fmt, "set!");
1189 if (!comsgOkDetails()) goto done;
1190
1191 bufPrintf(obuf, "\n");
1192
1193/* set! take state error only if all the children have abGoodTPoss not empty.
1194 * Here we assume this.
1195 * !!! FIXME (ablogFalse)
1196 */
1197 trInfoFrStab(&trInfoStruct, stab, ablogFalse(), ssymSetBang);
1198
1199 fillTRejectInfo(&trInfoStruct, type, ab, stab, argc, argf);
1200 sortSetBangTRejectInfo(&trInfoStruct);
1201
1202 if (trInfoStruct.argv) tr = trInfoStruct.argv[0];
1203
1204 if (tr && trWhy(tr)((tr)->why) == TR_BadFnType1) {
1205 bputSetBangBadFnType(&trInfoStruct, obuf, ab, type);
1206 bputOthersBadArgNumber(&trInfoStruct, obuf);
1207 }
1208 else if (tr && trWhy(tr)((tr)->why) == TR_BadArgType2) {
1209 abp = argf(ab, trArgN(tr)((tr)->argN));
1210 bputSetBangBadArgType(tr, obuf, ab, argc, argf);
1211 bputOthersBadArgNumber(&trInfoStruct, obuf);
1212 }
1213 else /* different parameter number */
1214 bputSetBangArgNumber(obuf);
1215
1216 trInfoFree(&trInfoStruct);
1217
1218done: comsgError(abp, ALDOR_E_ExplicitMsg1, bufChars(obuf));
1219 bufFree(obuf);
1220
1221}
1222
1223/**************************************************************************/
1224/* type const failure */
1225/**************************************************************************/
1226
1227void
1228terrorTypeConstFailed(TConst tc)
1229{
1230 AbSyn ab = tcPos(tc)((tc)->pos);
1231 Buffer obuf = bufNew();
1232
1233 terrorClip = comsgOkAbbrev() ? CLIP65 : ABPP_UNCLIPPED(200000L);
1234
1235 bufPrintf(obuf, comsgString(ALDOR_E_TinTypeConstIntro184));
1236 bputTForm(obuf, tcOwner(tc)((tc)->owner));
1237 bufPrintf(obuf, "\n");
1238 bufPrintf(obuf, comsgString(ALDOR_X_TinTypeConstFailed185));
1239 bputTConst(obuf, tc);
1240
1241 comsgError(ab, ALDOR_E_ExplicitMsg1, bufChars(obuf));
1242 bufFree(obuf);
1243}
1244
1245/**************************************************************************/
1246/* Output for all the meanings which could be suitable if imported */
1247/**************************************************************************/
1248
1249localstatic void
1250bputAllValidMeanings(Buffer obuf, Stab stab, AbSyn ab, Length argc,
1251 AbSynGetter argf, TForm tf, TForm type, Symbol idSym,
1252 Bool * firstMean, String fmtOp)
1253{
1254 String fmt = comsgString(ALDOR_D_TinAlternativeMeanings197);
1255 SatMask mask = tfSatTErrorMask(), result;
1256 SymeList symes;
1257
1258 for (symes = tfGetDomImportsByName(tf, idSym); symes; symes = cdr(symes)((symes)->rest)) {
1259 Syme syme = car(symes)((symes)->first);
1260 TForm opType;
1261
1262 if (symeId(syme)((syme)->id) != idSym)
1263 continue;
1264
1265 opType = tfDefineeType(symeType(syme));
1266 if (!tfIsAnyMap(opType)((((opType)->tag) == TF_Map) || (((opType)->tag) == TF_PackedMap
))
)
1267 continue;
1268
1269 result = tfSatMap(mask, stab, opType, type, ab, argc, argf);
1270 if (!tfSatSucceed(result))
1271 continue;
1272
1273 if (*firstMean) {
1274 bufPrintf(obuf,"\n");
1275 bufPrintf(obuf, fmt);
1276 *firstMean = false((int) 0);
1277 }
1278 bputSyme(obuf, syme, opType, fmtOp);
1279 }
1280}
1281
1282/*
1283 * Return false iif 0 meanings have been found out of current scope.
1284 */
1285localstatic Bool
1286bputMeaningsOutOfScope(Buffer obuf, Stab stab, AbSyn ab,AbSyn op, Length argc,
1287 AbSynGetter argf, TForm type, String fmtOp)
1288{
1289 TPoss tpArgn;
1290 TPoss tp = tpossEmpty();
1291 TPossIterator ti;
1292 TForm tf;
1293 Length i;
1294 Symbol idSym;
1295 Bool firstMean = true1;
1296
1297 if (abTag(op)((op)->abHdr.tag) != AB_Id) return false((int) 0);
1298
1299 idSym = op->abId.sym;
1300
1301 for (i = 0; i < argc ; i++) {
1302 AbSyn abArgn = argf(ab, i);
1303
1304 if (abState(abArgn)((abArgn)->abHdr.state) == AB_State_HasUnique)
1305 tpArgn = tpossSingleton(abTUnique(abArgn)((abArgn)->abHdr.type.unique));
1306 else
1307 tpArgn = abGoodTPoss(argf(ab, i))(((argf(ab, i))->abHdr.state) == AB_State_Error ? ((void*)
0) :((argf(ab, i))->abHdr.type.poss))
;
1308
1309 for (tpossITER(ti,tpArgn)((ti).possl = (tpArgn ? (tpArgn)->possl : ((void*)0))); tpossMORE(ti)((ti).possl); tpossSTEP(ti)((ti).possl = (((ti).possl)->rest))) {
1310 tf = tpossELT(ti)tpossELT_(&ti);
1311
1312 tf = tfDefineeType(tf);
1313
1314 if (!tfSatType(tf) && !tpossHas(tp ,tf)) {
1315 /*
1316 * NOTE that tpossAdd1 calls tpossHas again;
1317 * this redundat test could be skipped if
1318 * tpossCons wasn't a local function.
1319 */
1320 tpossAdd1(tp, tf);
1321 bputAllValidMeanings(obuf,stab,ab,argc,
1322 argf,tf,type,idSym,
1323 &firstMean,fmtOp);
1324
1325 }
1326 }
1327 if (abState(abArgn)((abArgn)->abHdr.state) == AB_State_HasUnique)
1328 tpossFree(tpArgn);
1329 }
1330 tpossFree(tp);
1331 return (!firstMean);
1332}
1333
1334void
1335terrorMeaningsOutOfScope(Stab stab,AbSyn ab,AbSyn op,TForm type,Length argc,
1336 AbSynGetter argf)
1337{
1338 Buffer obuf;
1339 String fmtOp;
1340 String fmt = comsgString(ALDOR_E_TinNoGoodOp180);
1341
1342 terrorClip = comsgOkAbbrev() ? CLIP65 : ABPP_UNCLIPPED(200000L);
1343
1344 fmtOp = fmtAbSyn(abApplyOp(ab)((ab)->abApply.op));
1345 obuf = bufNew();
1346
1347 bufPrintf(obuf, fmt, fmtOp);
1348
1349 if (comsgOkDetails())
1350 bputMeaningsOutOfScope(obuf,stab,ab,op,argc,argf,type,fmtOp);
1351
1352 operatorErrMsg(ab, op, obuf);
1353 strFree(fmtOp);
1354 bufFree(obuf);
1355}
1356
1357/**************************************************************************/
1358/* Procedures handling 0 meanings for an application */
1359/**************************************************************************/
1360
1361/* Prints all meanings rejected because some arg type doesn't match */
1362localstatic void
1363bputBadArgType(TRejectInfo trInfo, Buffer obuf, AbSyn ab, Length argc,
1364 AbSynGetter argf, String fmtOp)
1365{
1366 String fmt = comsgString(ALDOR_X_TinNoArgumentMatch203);
1367 String fmtParType;
1368 TForm tf, parType, opType;
1369 TReject tr;
1370 AbSyn abArgi;
1371
1372 for ( ; trInfo->i < trInfo->argc &&
1373 trWhy(trCurrent(trInfo))(((trInfo->argv[trInfo->i]))->why) == TR_BadArgType2;
1374 trInfo->i++) {
1375 Length iargc;
1376 tr = trCurrent(trInfo)(trInfo->argv[trInfo->i]);
1377 abArgi = argf(ab, trArgN(tr)((tr)->argN));
1378
1379 opType = trType(tr)((tr)->tf);
1380 tf = tfMapArg(opType)tfFollowArg(opType, 0);
1381
1382 bputTReject(obuf, tr, fmtOp);
1383
1384 iargc = tfMapHasDefaults(opType) ? tfMapArgc(opType) : argc;
1385 parType = tfAsMultiArgN(tf, iargc, trParN(tr)((tr)->parN));
1386 fmtParType = fmtTForm(parType);
1387
1388 /* "rejected because arg .. did not match ... */
1389 bufPrintf(obuf, "\n ");
1390 bufPrintf(obuf, fmt, trArgN(tr)((tr)->argN)+1, fmtParType);
1391
1392 strFree(fmtParType);
1393
1394 if ((!tfSatType(tfDefineeType(parType)))
1395 && (abTag(abArgi)((abArgi)->abHdr.tag) == AB_Define)
1396 && (abTag(abArgi->abDefine.lhs)((abArgi->abDefine.lhs)->abHdr.tag) == AB_Declare)) {
1397 String fmtId =
1398 fmtAbSyn((abArgi->abDefine.lhs)->abDeclare.id);
1399 String fmt1 = comsgString(ALDOR_D_TinShouldUseDoubleEq210);
1400 String fmtRhs = fmtAbSyn((abArgi->abDefine.rhs));
1401 String fmtArg = fmtAbSyn(abArgi);
1402 bufPrintf(obuf, "\n ");
1403 bufPrintf(obuf, fmt1, fmtId, fmtRhs, fmtArg);
1404
1405 strFree(fmtId);
1406 strFree(fmtRhs);
1407 strFree(fmtArg);
1408 }
1409
1410 /* output for: "the possible types for arg n are:" */
1411 if (trInfo->i + 1 == trInfo->argc ||
1412 trWhy(trInfo->argv[trInfo->i + 1])((trInfo->argv[trInfo->i + 1])->why) != TR_BadArgType2 ||
1413 trArgN(tr)((tr)->argN) != trArgN(trInfo->argv[trInfo->i + 1])((trInfo->argv[trInfo->i + 1])->argN)) {
1414
1415 String fmt1 = comsgString(ALDOR_D_TinAvailableTypesForArg211);
1416
1417 bufPrintf(obuf, "\n ");
1418 bufPrintf(obuf, fmt1, trArgN(tr)((tr)->argN)+1);
1419 if (abState(abArgi)((abArgi)->abHdr.state) == AB_State_HasPoss ||
1420 abState(abArgi)((abArgi)->abHdr.state) == AB_State_Error)
1421 bputTPoss(obuf, abGoodTPoss(abArgi)(((abArgi)->abHdr.state) == AB_State_Error ? ((void*)0) :(
(abArgi)->abHdr.type.poss))
);
1422 else
1423 bputTForm(obuf, abTUnique(abArgi)((abArgi)->abHdr.type.unique));
1424 }
1425 }
1426}
1427
1428/* Prints all meanings rejected due to some parameter missing */
1429localstatic void
1430bputParMissing(TRejectInfo trInfo, Buffer obuf, String fmtOp)
1431{
1432 String fmtParType, fmt;
1433 TForm tf, parType;
1434 Length argc;
1435
1436 for ( ; trInfo->i < trInfo->argc &&
1437 trWhy(trCurrent(trInfo))(((trInfo->argv[trInfo->i]))->why) == TR_ArgMissing3;
1438 trInfo->i++) {
1439
1440 TReject tr = trCurrent(trInfo)(trInfo->argv[trInfo->i]);
1441 TForm opType = trType(tr)((tr)->tf);
1442
1443 bputTReject(obuf, tr, fmtOp);
1444
1445 tf = tfMapArg(opType)tfFollowArg(opType, 0);
1446 argc = tfMapArgc(opType);
1447 parType = tfAsMultiArgN(tf, argc, trParN(tr)((tr)->parN));
1448 fmtParType = fmtTForm(parType);
1449
1450 /* "rejected because parameter ... is missing */
1451 bufPrintf(obuf, "\n ");
1452 fmt = comsgString(ALDOR_X_TinParameterMissing204);
1453 bufPrintf(obuf, fmt, trParN(tr)((tr)->parN)+1, fmtTForm(parType));
1454
1455 strFree(fmtParType);
1456 }
1457}
1458
1459/* Prints all meanings rejected due to different arity */
1460localstatic void
1461bputEmbedFail(TRejectInfo trInfo, Buffer obuf, int argc, String fmtOp)
1462{
1463 String fmt = comsgString(ALDOR_X_TinBadArgumentNumber205);
1464 Bool found = false((int) 0);
1465
1466 for ( ; trInfo->i < trInfo->argc &&
1467 trWhy(trCurrent(trInfo))(((trInfo->argv[trInfo->i]))->why) == TR_EmbedFail4;
1468 trInfo->i++) {
1469 TReject tr = trCurrent(trInfo)(trInfo->argv[trInfo->i]);
1470 bputTReject(obuf, tr, fmtOp);
1471 found = true1;
1472 }
1473 if (found) {
1474 bufPrintf(obuf, "\n ");
1475 bufPrintf(obuf, fmt, argc);
1476 }
1477}
1478
1479/* Prints all meanings rejected due to the unmatching return type */
1480localstatic void
1481bputBadFnType(TRejectInfo trInfo, Buffer obuf, TForm type, String fmtOp)
1482{
1483 String fmt, fmtType;
1484 Bool found = false((int) 0);
1485
1486 for ( ; trInfo->i < trInfo->argc &&
1487 trWhy(trCurrent(trInfo))(((trInfo->argv[trInfo->i]))->why) == TR_BadFnType1;
1488 trInfo->i++) {
1489 TReject tr = trCurrent(trInfo)(trInfo->argv[trInfo->i]);
1490
1491 bputTReject(obuf, tr, fmtOp);
1492 found = true1;
1493 }
1494
1495 if (found) {
1496 fmt = comsgString(ALDOR_X_TinBadFnType206);
1497 fmtType = fmtTForm(type);
1498 bufPrintf(obuf, "\n ");
1499 bufPrintf(obuf, fmt, fmtType);
1500
1501 strFree(fmtType);
1502 }
1503
1504}
1505
1506/**************************************************************************
1507 * Error output for the most likely meaning for an operator
1508 **************************************************************************/
1509localstatic void
1510bputBadFnType0(TRejectInfo trInfo, Buffer obuf, TForm type, String fmtOp)
1511{
1512 String fmt;
1513 TPoss retTypes = tpossEmpty();
1514 int i;
1515
1516 for ( i = 0; i < trInfo->argc &&
1517 trWhy(trInfo->argv[i])((trInfo->argv[i])->why) == TR_BadFnType1; i++) {
1518 TForm tfRet = tfMapRet(tfDefineeType(trType(trInfo->argv[i])))tfFollowArg(tfDefineeType(((trInfo->argv[i])->tf)), 1);
1519 tfRet = tfDefineeType(tfRet);
1520 tpossAdd1(retTypes, tfRet);
1521 }
1522
1523 bufPrintf(obuf, "\n ");
1524 fmt = comsgString(ALDOR_D_TinRejectedRetTypes218);
1525 bufPrintf(obuf, fmt);
1526
1527 bputTPoss(obuf, retTypes);
1528
1529 bputContextType(obuf, type);
1530 tpossFree(retTypes);
1531}
1532
1533localstatic Bool
1534bputBadArgType0(TRejectInfo trInfo, Stab stab, Buffer obuf, AbSyn ab, AbSyn op,
1535 Length argc, AbSynGetter argf, String fmtOp)
1536{
1537 String fmt = comsgString(ALDOR_X_TinNoArgumentMatch203);
Value stored to 'fmt' during its initialization is never read
1538 String fmtParType;
1539 TForm opType, argType, parType, defType;
1540 AbSyn abArgi;
1541 int i, j;
1542 TPoss parTypes = tpossEmpty();
1543 TReject tr;
1544 Bool result = false((int) 0);
1545 Length argN, argc0;
1546
1547 assert(trWhy(trFirst(trInfo)) == TR_BadArgType)do { if (!((((trInfo->argv[0]))->why) == 2)) _do_assert
(("trWhy(trFirst(trInfo)) == TR_BadArgType"),"terror.c",1547)
; } while (0)
;
1548
1549 for (i = 0 ; i < trInfoArgc(trInfo)(trInfo->argc) ; i += 1) {
1550 AbSub sigma;
1551
1552 tr = trInfoGet(trInfo,i)(trInfo->argv[i]);
1553
1554 if (trWhy(tr)((tr)->why) != TR_BadArgType2 ||
1555 trArgN(tr)((tr)->argN) != trArgN(trFirst(trInfo))(((trInfo->argv[0]))->argN))
1556 break;
1557
1558 opType = tfDefineeType(trType(tr)((tr)->tf));
1559 if (tfIsDeclare(opType)(((opType)->tag) == TF_Declare))
1560 opType = tfDeclareType(opType)tfFollowArg(opType, 0);
1561 argc0 = tfMapHasDefaults(opType) ? tfMapArgc(opType) : argc;
1562 argType = tfMapArg(opType)tfFollowArg(opType, 0);
1563
1564 /* We might be given a tfUnknown (bug 1210) */
1565 defType = tfDefineeType(argType);
1566 if (defType == tfUnknown) continue;
1567 sigma = absNew(stab);
1568 for (j = 0; j < trArgN(tr)((tr)->argN); j += 1) {
1569 Syme syme;
1570 TForm tfj;
1571 AbSyn abj;
1572 Bool def;
1573 Length ai;
1574
1575 tfj = tfAsMultiArgN(argType, argc0, j);
1576 syme = tfDefineeSyme(tfj);
1577 tfj = tfDefineeType(tfj);
1578 if (!syme) continue;
1579
1580 abj = tfAsMultiSelectArg(ab, argc, j, argf, tfj, &def, &ai);
1581 abj = sefoCopy(abj);
1582 tiBottomUp(stab, abj, tfUnknown);
1583 tiTopDown (stab, abj, tfj);
1584 if (abState(abj)((abj)->abHdr.state) == AB_State_HasUnique) {
1585 if (absFVars(sigma)((sigma)->fv)) absSetFVars(sigma, NULL)((sigma)->fv = (((void*)0)));
1586 sigma = absExtend(syme, abj, sigma);
1587 }
1588 }
1589
1590 parType = tfAsMultiArgN(argType, argc0, trParN(tr)((tr)->parN));
1591 parType = tfDefineeType(parType);
1592 parType = tformSubst(sigma, parType);
1593 tpossAdd1(parTypes, parType);
1594 absFree(sigma);
1595 }
1596
1597 i -= 1;
1598
1599 if (trArgN(trInfoGet(trInfo,i))(((trInfo->argv[i]))->argN) == trArgN(trFirst(trInfo))(((trInfo->argv[0]))->argN) &&
1600 ((i == trInfoArgc(trInfo)(trInfo->argc)-1) ||
1601 trWhy(trInfoGet(trInfo, i+1))(((trInfo->argv[i+1]))->why) != TR_ArgMissing3)) {
1602 result = true1;
1603 argN = trArgN(trFirst(trInfo))(((trInfo->argv[0]))->argN);
1604 fmt = comsgString(ALDOR_D_TinArgNoMatchParTypes212);
1605 if (abIsTheId(op, ssymApply)(((op)->abHdr.tag == (AB_Id)) && ((op)->abId.sym
)==(ssymApply))
) {
1606 if (argN > 0) {
1607 bufPrintf(obuf, fmt, argN+1, fmtOp);
1608 }
1609 else {
1610 fmt = comsgString(ALDOR_D_TinOperatorNoMatch213);
1611 bufPrintf(obuf, fmt, argN+1);
1612 }
1613 }
1614 else
1615 bufPrintf(obuf, fmt, argN+1, fmtOp);
1616 /*bufPrintf(obuf, "\n");*/
1617
1618 if (comsgOkDetails()) {
1619 abArgi = argf(ab, trArgN(trFirst(trInfo))(((trInfo->argv[0]))->argN));
1620 bputAbTPoss(obuf, 4, abArgi,
1621 ALDOR_D_TinRejectedType207,
1622 ALDOR_D_TinRejectedTypes202);
1623 if (tpossCount(parTypes) == 1) {
1624 fmt = comsgString(ALDOR_D_TinExpectedType216);
1625 fmtParType = fmtTForm(tpossUnique(parTypes));
1626 bufPrintf(obuf, "\n ");
1627 bufPrintf(obuf, fmt, fmtParType);
1628 strFree(fmtParType);
1629 }
1630 else {
1631 bufPrintf(obuf, "\n ");
1632 fmt = comsgString(ALDOR_D_TinExpectedTypes217);
1633 bufPrintf(obuf, fmt);
1634 bputTPoss0(obuf, 6, parTypes);
1635 }
1636 }
1637 }
1638 else
1639 result = false((int) 0);
1640
1641 tpossFree(parTypes);
1642 return result;
1643}
1644
1645/***************************************************************************
1646 * Try to determine which meaning(s) the user mean.
1647 *If is not possible, return false.
1648 ***************************************************************************/
1649localstatic Bool
1650guessOpMeanings(TRejectInfo trInfo, Stab stab, Buffer obuf, AbSyn ab, AbSyn op,
1651 Length argc, AbSynGetter argf, TForm type, String fmtOp)
1652{
1653 Bool result = false((int) 0);
1654 String fmt;
1655 AbSyn abErr = op;
1656 /* TO Do: if no -M guess option return */
1657
1658 if (trWhy(trFirst(trInfo))(((trInfo->argv[0]))->why) == TR_BadFnType1) {
1659 result = true1;
1660 fmt = comsgString(ALDOR_D_TinRetTypesCantContext215);
1661 bufPrintf(obuf, fmt);
1662 if (comsgOkDetails())
1663 bputBadFnType0(trInfo, obuf, type, fmtOp);
1664 }
1665 else if (trWhy(trFirst(trInfo))(((trInfo->argv[0]))->why) == TR_BadArgType2) {
1666 result = bputBadArgType0(trInfo,stab,obuf,ab,op,argc,argf,fmtOp);
1667 abErr = argf(ab, trArgN(trFirst(trInfo))(((trInfo->argv[0]))->argN));
1668 }
1669
1670 if (result) {
1671 bputMeaningsOutOfScope(obuf,stab, ab,op,argc,argf,type,fmtOp);
1672 operatorErrMsg(ab, abErr, obuf);
1673 }
1674 return result;
1675}
1676/***********************************************************
1677 * Analyse rejection cause and put the information in tr
1678 ***********************************************************/
1679localstatic void
1680analyseRejectionCause(TReject tr, Stab stab, AbSyn ab, Length argc,
1681 AbSynGetter argf, TForm type)
1682{
1683 SatMask mask = tfSatTErrorMask(), result;
1684 TForm opType = trType(tr)((tr)->tf);
1685
1686 opType = tfDefineeType(opType);
1687
1688 if (!tfIsAnyMap(opType)((((opType)->tag) == TF_Map) || (((opType)->tag) == TF_PackedMap
))
) return;
1689
1690 result = tfSatMap(mask, stab, opType, type, ab, argc, argf);
1691
1692 if (tfSatFailedBadArgType(result)) {
1693 trParN(tr)((tr)->parN) = tfSatParN(result);
1694 trArgN(tr)((tr)->argN) = tfSatArgN(ab, argc, argf, trParN(tr)((tr)->parN), opType);
1695 trWhy(tr)((tr)->why) = TR_BadArgType2;
1696 }
1697 else if (tfSatFailedArgMissing(result)) {
1698 trParN(tr)((tr)->parN) = tfSatParN(result);
1699 trWhy(tr)((tr)->why) = TR_ArgMissing3;
1700 }
1701 else if (tfSatFailedEmbedFail(result) |
1702 tfSatFailedDifferentArity(result))
1703 trWhy(tr)((tr)->why) = TR_EmbedFail4;
1704 else
1705 trWhy(tr)((tr)->why) = TR_BadFnType1;
1706}
1707
1708/**************************************************************************
1709 * Fills the trInfo structure calling analyseRejectionCause on each tr
1710 **************************************************************************/
1711localstatic void
1712fillTRejectInfo(TRejectInfo trInfo, TForm type, AbSyn ab, Stab stab,
1713 Length argc, AbSynGetter argf)
1714{
1715 Length i;
1716
1717 for (i = 0; i < trInfo->argc; i++)
1718 analyseRejectionCause(trInfo->argv[i], stab, ab, argc,
1719 argf, type);
1720}
1721
1722/**************************************************************************
1723 * If there are no suitable meanings for an operator, says why all the
1724 * meanings have been rejected.
1725 **************************************************************************/
1726localstatic void
1727noMeaningsForOperator(Buffer obuf, TForm type, AbSyn ab, AbSyn op, Stab stab,
1728 Length argc, AbSynGetter argf, String fmtOp)
1729{
1730 String fmt;
1731 struct trejectInfo trInfoStruct;
1732 Bool imp = (abImplicit(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->implicit : 0
)
!= NULL((void*)0));
1733
1734 if (abTag(ab)((ab)->abHdr.tag) == AB_CoerceTo) {
1735 terrorCoerceTo(obuf, ab, type);
1736 return;
1737 }
1738
1739 if (abTag(op)((op)->abHdr.tag) == AB_Id)
1740 trInfoFrStab(&trInfoStruct, /* vvv FIXME */
1741 stab, ablogFalse(), op->abId.sym);
1742 else if (abState(op)((op)->abHdr.state) == AB_State_HasPoss ||
1743 abState(op)((op)->abHdr.state) == AB_State_Error)
1744 trInfoFrTPoss(&trInfoStruct, abGoodTPoss(op)(((op)->abHdr.state) == AB_State_Error ? ((void*)0) :((op)
->abHdr.type.poss))
);
1745 else
1746 trInfoFrTUnique(&trInfoStruct, abTUnique(op)((op)->abHdr.type.unique));
1747
1748 fillTRejectInfo(&trInfoStruct, type, ab, stab, argc, argf);
1749
1750 if (imp)
1751 sortSetBangTRejectInfo(&trInfoStruct);
1752 else
1753 sortTRejectInfo(&trInfoStruct);
1754
1755 trInfoStruct.i = 0;
1756
1757 if ((!imp && abIsTheId(op, ssymApply)(((op)->abHdr.tag == (AB_Id)) && ((op)->abId.sym
)==(ssymApply))
) ||
1758 !guessOpMeanings(&trInfoStruct,stab,obuf,ab,op,argc, argf,
1759 type,fmtOp)) {
1760 fmt = comsgString(ALDOR_E_TinNoGoodOp180);
1761 bufPrintf(obuf, fmt, fmtOp);
1762 if (comsgOkDetails()) {
1763 bputBadFnType(&trInfoStruct, obuf, type, fmtOp);
1764 bputBadArgType(&trInfoStruct, obuf, ab, argc, argf,
1765 fmtOp);
1766 bputParMissing(&trInfoStruct, obuf, fmtOp);
1767 bputEmbedFail(&trInfoStruct, obuf, argc, fmtOp);
1768 bputMeaningsOutOfScope(obuf, stab, ab, op, argc, argf,
1769 type, fmtOp);
1770 }
1771
1772 operatorErrMsg(ab, op, obuf);
1773 }
1774
1775
1776 trInfoFree(&trInfoStruct);
1777}
1778
1779/**************************************************************************/
1780/* 0 or >1 meanings for an application */
1781/**************************************************************************/
1782
1783void
1784terrorApplyFType(AbSyn ab, TForm type, TPoss tposs, AbSyn op, Stab stab,
1785 Length argc, AbSynGetter argf)
1786{
1787 String fmt, fmtOp;
1788 Buffer obuf;
1789
1790 if (abTag(ab)((ab)->abHdr.tag) == AB_Assign)
1791 return;
1792
1793
1794 terrorClip = comsgOkAbbrev() ? CLIP65 : ABPP_UNCLIPPED(200000L);
1795
1796 obuf = bufNew();
1797 fmtOp = fmtAbSyn(op);
1798
1799 if (tpossCount(tposs) == 0) /* => 0 possible types */
1800 noMeaningsForOperator(obuf,type,ab,op,stab,argc,argf,
1801 fmtOp);
1802
1803 else { /* => >1 possible types */
1804 fmt = comsgString(ALDOR_D_TinMoreMeanings214);
1805 bufPrintf(obuf, fmt, tpossCount(tposs) , fmtOp);
1806 bputMeanings(obuf, tposs);
1807 operatorErrMsg(ab, op, obuf);
1808 }
1809
1810 strFree(fmtOp);
1811 bufFree(obuf);
1812
1813}
1814
1815
1816/*************************************************************************
1817 * Called from tibup0ApplyFType when a symbol has a meaning in which the
1818 * type cannot be completely analyzed.
1819 *************************************************************************/
1820void
1821terrorApplyNotAnalyzed(AbSyn ab, AbSyn op, TForm tf)
1822{
1823 String fmt = comsgString(ALDOR_E_TinCantBeAnalyzed186);
1824 Buffer obuf;
1825 obuf = bufNew();
1826
1827 bufPrintf(obuf, fmt);
1828 bufPrintf(obuf,"\n");
1829 operatorErrMsg(ab, op, obuf);
1830 bufFree(obuf);
1831}
1832
1833/**************************************************************************/
1834/* Assignment error */
1835/**************************************************************************/
1836void
1837terrorAssign(AbSyn ab, TForm type, TPoss tposs)
1838{
1839 String fmt, s;
1840 Buffer obuf;
1841 AbSyn rhs = ab->abAssign.rhs;
1842 AbSyn lhs = ab->abAssign.lhs;
1843 AbSyn abp;
1844
1845 terrorClip = comsgOkAbbrev() ? CLIP65 : ABPP_UNCLIPPED(200000L);
1846
1847 obuf = bufNew();
1848
1849 if (abState(lhs)((lhs)->abHdr.state) == AB_State_Error ||
1850 (abState(lhs)((lhs)->abHdr.state) == AB_State_HasPoss &&
1851 tpossCount(abTPoss(lhs)((lhs)->abHdr.type.poss)) == 0)) {
1852 fmt = comsgString(ALDOR_E_TinCantInferLhs179);
1853 bufPrintf(obuf, fmt);
1854 abp = abNewNothing(abPos(lhs))abNew(AB_Nothing, (spstackFirst((lhs)->abHdr.pos)),0 );
1855 }
1856 else {
1857 fmt = comsgString(ALDOR_E_TinNoGoodInterp181);
1858 s = fmtAbSyn(rhs);
1859 bufPrintf(obuf, fmt, s);
1860 strFree(s);
1861 abp = abNewNothing(abPos(rhs))abNew(AB_Nothing, (spstackFirst((rhs)->abHdr.pos)),0 );
1862
1863 /* Prevent error msg at the upper level */
1864 if (abState(lhs)((lhs)->abHdr.state) == AB_State_HasPoss) {
1865 TForm type = tpossUnique(abTPoss(lhs)((lhs)->abHdr.type.poss));
1866 assert(tpossCount(abTPoss(lhs)) == 1)do { if (!(tpossCount(((lhs)->abHdr.type.poss)) == 1)) _do_assert
(("tpossCount(abTPoss(lhs)) == 1"),"terror.c",1866); } while (
0)
;
1867
1868 bputContextType(obuf, type);
1869
1870 tpossFree(abGoodTPoss(lhs)(((lhs)->abHdr.state) == AB_State_Error ? ((void*)0) :((lhs
)->abHdr.type.poss))
);
1871 abTPoss(lhs)((lhs)->abHdr.type.poss) = tpossEmpty();
1872 }
1873 else {
1874 abState(lhs)((lhs)->abHdr.state) = AB_State_HasPoss;
1875 abTPoss(lhs)((lhs)->abHdr.type.poss) = tpossEmpty();
1876 }
1877 }
1878
1879 if (!comsgOkDetails()) goto done;
1880
1881 bufPrintf(obuf, "\n");
1882
1883 fmt = comsgString(ALDOR_D_TinPossTypesRhs196);
1884 s = fmtAbSyn(rhs);
1885 bufPrintf(obuf," ");
1886 bufPrintf(obuf, fmt, s);
1887 strFree(s);
1888 bputTPoss(obuf, abGoodTPoss(rhs)(((rhs)->abHdr.state) == AB_State_Error ? ((void*)0) :((rhs
)->abHdr.type.poss))
);
1889
1890 if (abState(lhs)((lhs)->abHdr.state) != AB_State_HasPoss &&
1891 tpossCount(abTPoss(lhs)((lhs)->abHdr.type.poss)) > 0) { /* 1 := >1 */
1892 assert(tpossIsUnique(abTPoss(lhs)))do { if (!(tpossIsUnique(((lhs)->abHdr.type.poss)))) _do_assert
(("tpossIsUnique(abTPoss(lhs))"),"terror.c",1892); } while (0
)
;
1893 bputContextType(obuf, type);
1894 }
1895
1896 done:
1897 comsgError(abp, ALDOR_E_ExplicitMsg1, bufChars(obuf));
1898 abFree(abp);
1899 bufFree(obuf);
1900
1901}
1902
1903/**************************************************************************/
1904/* The following exports were not provided:... */
1905/**************************************************************************/
1906
1907localstatic void
1908terrorPutConditionalExports(Stab stab, Buffer buf, SymeList csymes)
1909{
1910 SefoList conds;
1911 SymeList gsymes, symes, nsymes, hsyme;
1912 String fmt;
1913 /* Print sorted by condition */
1914 /* !!Should also try to not print meanings where the
1915 * meaning is also missing for a weaker condition
1916 */
1917 fmt = comsgString(ALDOR_D_TinMissingExport201);
1918 while (csymes != listNil(Syme)((SymeList) 0)) {
1919 String scond;
1920 conds = symeCondition(car(csymes)((csymes)->first));
1921 nsymes = listNil(Syme)((SymeList) 0);
1922 gsymes = listNil(Syme)((SymeList) 0);
1923 symes = csymes;
1924 while (symes != listNil(Syme)((SymeList) 0)) {
1925 Syme syme = car(symes)((symes)->first);
1926 hsyme = symes;
1927 symes = cdr(symes)((symes)->rest);
1928 if (sefoListEqual(symeCondition(syme), conds)) {
1929 cdr(hsyme)((hsyme)->rest) = gsymes;
1930 gsymes = hsyme;
1931 }
1932 else {
1933 cdr(hsyme)((hsyme)->rest) = nsymes;
1934 nsymes = hsyme;
1935 }
1936 }
1937 csymes = listNReverse(Syme)(Syme_listPointer->NReverse)(nsymes);
1938 gsymes = listNReverse(Syme)(Syme_listPointer->NReverse)(gsymes);
1939 scond = fmtAbSyn(car(conds)((conds)->first));
1940 bufPrintf(buf, "\n\tif %s", scond);
1941 conds = cdr(conds)((conds)->rest);
1942 while (conds != listNil(Sefo)((SefoList) 0)) {
1943 scond = fmtAbSyn(car(conds)((conds)->first));
1944 bufPrintf(buf, " and %s", scond);
1945 conds = cdr(conds)((conds)->rest);
1946 }
1947 bufPrintf(buf, " then", scond);
1948 while (gsymes != listNil(Syme)((SymeList) 0)) {
1949 String s;
1950 s = fmtTForm(symeType(car(gsymes)((gsymes)->first)));
1951 bufPrintf(buf , "\n\t\t");
1952
1953 bufPrintf(buf, fmt,
1954 symeString(car(gsymes))((((((gsymes)->first))->id))->str), s);
1955 strFree(s);
1956 gsymes = listFreeCons(Syme)(Syme_listPointer->FreeCons)(gsymes);
1957 }
1958 }
1959}
1960
1961void
1962terrorNotEnoughExports(Stab stab, AbSyn ab, TPoss tposs, Bool onlyWarning)
1963{
1964 TForm base;
1965 SymeList symes;
1966 SymeList csymes;
1967 SymeList isymes;
1968 SymeList msymes;
1969 SymeList mods;
1970 SymeList aself;
1971 Buffer obuf;
1972
1973 terrorClip = comsgOkAbbrev() ? CLIP65 : ABPP_UNCLIPPED(200000L);
1974
1975 obuf = bufNew();
1976
1977 if (!comsgOkDetails()) goto done;
1978
1979 base = abTForm(ab->abAdd.base)((ab->abAdd.base)->abHdr.seman ? (ab->abAdd.base)->
abHdr.seman->tform : 0)
;
1980 assert(tpossIsUnique(tposs))do { if (!(tpossIsUnique(tposs))) _do_assert(("tpossIsUnique(tposs)"
),"terror.c",1980); } while (0)
;
1981 symes = tfGetCatExports(tpossUnique(tposs));
1982
1983 aself = tfGetSelfFrStab(stab);
1984 mods = listCopy(Syme)(Syme_listPointer->Copy)(tfGetCatSelf(tpossUnique(tposs)));
1985 mods = listNConcat(Syme)(Syme_listPointer->NConcat)(listCopy(Syme)(Syme_listPointer->Copy)(tfGetDomSelf(base)), mods);
1986 mods = listNConcat(Syme)(Syme_listPointer->NConcat)(aself, mods);
1987
1988 csymes = listNil(Syme)((SymeList) 0);
1989 isymes = listNil(Syme)((SymeList) 0);
1990 msymes = listNil(Syme)((SymeList) 0);
1991 for (; symes; symes = cdr(symes)((symes)->rest)) {
1992 Syme syme = car(symes)((symes)->first);
1993 Syme isyme = stabGetDomainExportMod(stab, mods, symeId(syme)((syme)->id), symeType(syme));
1994 if (isyme != NULL((void*)0)) {
1995 isymes = listCons(Syme)(Syme_listPointer->Cons)(syme, isymes);
1996 }
1997 else if (symeCondition(car(symes)((symes)->first)))
1998 csymes = listCons(Syme)(Syme_listPointer->Cons)(syme, csymes);
1999 else {
2000 msymes = listCons(Syme)(Syme_listPointer->Cons)(syme, msymes);
2001 }
2002 }
2003
2004 if (msymes != listNil(Syme)((SymeList) 0)) {
2005 String fmt = comsgString(ALDOR_D_TinMissingExports200);
2006 bufPrintf(obuf, "%s", fmt);
2007 terrorPrintSymeList(obuf, "", msymes);
2008 }
2009
2010 if (csymes) {
2011 terrorPutConditionalExports(stab, obuf, csymes);
2012 }
2013 if (isymes) {
2014 terrorPutConditionallyDefinedExports(obuf, stab, mods, ab, isymes);
2015 }
2016done:
2017 if (onlyWarning)
2018 comsgWarning(ab, ALDOR_E_ExplicitMsg1, bufChars(obuf));
2019 else
2020 comsgError(ab, ALDOR_E_ExplicitMsg1, bufChars(obuf));
2021 bufFree(obuf);
2022
2023}
2024
2025localstatic void
2026terrorPrintSymeList(Buffer obuf, String prefix, SymeList msymes)
2027{
2028 String fmt = comsgString(ALDOR_D_TinMissingExport201);
2029
2030 for (; msymes != listNil(Syme)((SymeList) 0); msymes = listFreeCons(Syme)(Syme_listPointer->FreeCons)(msymes)) {
2031 Syme syme = car(msymes)((msymes)->first);
2032 String s = fmtTForm(symeType(syme));
2033 bufPrintf(obuf , "\n\t%s", prefix);
2034 bufPrintf(obuf, fmt, symeString(syme)((((syme)->id))->str), s);
2035 strFree(s);
2036 }
2037}
2038
2039localstatic void
2040terrorPutConditionallyDefinedExports(Buffer obuf, Stab stab, SymeList mods, AbSyn ab, SymeList symes)
2041{
2042 SymeList iter;
2043
2044 iter = listCopy(Syme)(Syme_listPointer->Copy)(symes);
2045 while (iter != listNil(Syme)((SymeList) 0)) {
2046 Syme syme = car(iter)((iter)->first);
2047 SymeList msymes, nsymes;
2048 SefoList condition = symeCondition(syme);
2049 Syme implSyme = stabGetDomainExportMod(stab, mods, symeId(syme)((syme)->id), symeType(syme));
2050 AbSynList defCondition = symeDefinitionConditions(implSyme)((AbSynList) (SYFI_DefinitionConditions < (8 * sizeof(int)
) && !(((((implSyme)->kind == SYME_Trigger ? libGetAllSymes
((implSyme)->lib) : ((void*)0)), (implSyme))->hasmask) &
(1 << (SYFI_DefinitionConditions))) ? (symeFieldInfo[SYFI_DefinitionConditions
].def) : (((((implSyme)->kind == SYME_Trigger ? libGetAllSymes
((implSyme)->lib) : ((void*)0)), (implSyme))->locmask) &
(1 << (SYFI_DefinitionConditions))) ? ((((((implSyme)->
kind == SYME_Trigger ? libGetAllSymes((implSyme)->lib) : (
(void*)0)), (implSyme))->locmask) & (1 << (SYFI_DefinitionConditions
))) ? ((implSyme)->fieldv)[symeIndex(implSyme,SYFI_DefinitionConditions
)] : (symeFieldInfo[SYFI_DefinitionConditions].def)) : symeGetFieldFn
(implSyme,SYFI_DefinitionConditions)))
;
2051
2052 nsymes = listNil(Syme)((SymeList) 0);
2053 msymes = listCons(Syme)(Syme_listPointer->Cons)(syme, listNil(Syme)((SymeList) 0));
2054 iter = listFreeCons(Syme)(Syme_listPointer->FreeCons)(iter);
2055 while (iter != listNil(Syme)((SymeList) 0)) {
2056 Syme iterSyme = car(iter)((iter)->first);
2057 Syme implSyme = stabGetDomainExportMod(stab, mods, symeId(iterSyme)((iterSyme)->id), symeType(iterSyme));
2058 if (sefoListEqual(condition, symeCondition(iterSyme))
2059 && sefoListEqual((SefoList) defCondition,
2060 (SefoList) symeDefinitionConditions(implSyme)((AbSynList) (SYFI_DefinitionConditions < (8 * sizeof(int)
) && !(((((implSyme)->kind == SYME_Trigger ? libGetAllSymes
((implSyme)->lib) : ((void*)0)), (implSyme))->hasmask) &
(1 << (SYFI_DefinitionConditions))) ? (symeFieldInfo[SYFI_DefinitionConditions
].def) : (((((implSyme)->kind == SYME_Trigger ? libGetAllSymes
((implSyme)->lib) : ((void*)0)), (implSyme))->locmask) &
(1 << (SYFI_DefinitionConditions))) ? ((((((implSyme)->
kind == SYME_Trigger ? libGetAllSymes((implSyme)->lib) : (
(void*)0)), (implSyme))->locmask) & (1 << (SYFI_DefinitionConditions
))) ? ((implSyme)->fieldv)[symeIndex(implSyme,SYFI_DefinitionConditions
)] : (symeFieldInfo[SYFI_DefinitionConditions].def)) : symeGetFieldFn
(implSyme,SYFI_DefinitionConditions)))
))
2061 msymes = listCons(Syme)(Syme_listPointer->Cons)(iterSyme, msymes);
2062 else
2063 nsymes = listCons(Syme)(Syme_listPointer->Cons)(iterSyme, nsymes);
2064 iter = listFreeCons(Syme)(Syme_listPointer->FreeCons)(iter);
2065 }
2066 iter = nsymes;
2067 bufPrintf(obuf, "\n");
2068 if (condition == listNil(Sefo)((SefoList) 0)) {
2069 AbSyn expr = abNewNot(sposNone, abNewOrAll(sposNone, defCondition))abNew(AB_Not, sposNone,1, abNewOrAll(sposNone, defCondition));
2070 bufPrintf(obuf, "\tMissing where %s", abPretty(expr));
2071 terrorPrintSymeList(obuf, "\t", msymes);
2072 }
2073 else {
2074 AbSyn expr = abNewNot(sposNone, abNewOrAll(sposNone, defCondition))abNew(AB_Not, sposNone,1, abNewOrAll(sposNone, defCondition));
2075 bufPrintf(obuf, "\tMissing where %s\n", abPretty(abNewAndAll(sposNone,
2076 (AbSynList) condition)));
2077 bufPrintf(obuf, "\t\t and %s", abPretty(expr));
2078 terrorPrintSymeList(obuf, "\t", msymes);
2079 }
2080 }
2081}
2082
2083/***************************************************************************/
2084/* Specific error msg for Identifier without meaning. */
2085/***************************************************************************/
2086void
2087terrorNoMeaningForId(AbSyn ab, String s)
2088{
2089 String fmt = comsgString(ALDOR_E_TinNoMeaningForId156);
2090 Buffer obuf;
2091 obuf = bufNew();
2092
2093 bufPrintf(obuf, fmt, s);
2094 comsgError(ab, ALDOR_E_ExplicitMsg1, bufChars(obuf));
2095 bufFree(obuf);
2096}
2097
2098/***************************************************************************/
2099/* Specific error msg for literal without meaning. */
2100/***************************************************************************/
2101localstatic void
2102terrorNoMeaningForLit(AbSyn ab)
2103{
2104 String fmt = comsgString(ALDOR_E_TinNoMeaningForLit157);
2105 String s = fmtAbSyn(ab);
2106 String s0;
2107 Buffer obuf = bufNew();
2108
2109 switch (abTag(ab)((ab)->abHdr.tag)) {
2110 case AB_LitInteger:
2111 s0 = "integer";
2112 break;
2113 case AB_LitString:
2114 s0 = "string";
2115 break;
2116 case AB_LitFloat:
2117 s0 = "float";
2118 break;
2119 default:
2120 bugBadCase(abTag(ab))bug("Bad case %d (line %d in file %s).", (int) ((ab)->abHdr
.tag), 2120, "terror.c")
;
2121 NotReached(return){(void)bug("Not supposed to reach line %d in file: %s\n",2121
, "terror.c");}
;
2122 }
2123
2124 bufPrintf(obuf, fmt, s0, s);
2125 strFree(s);
2126 comsgError(ab, ALDOR_E_ExplicitMsg1, bufChars(obuf));
2127 bufFree(obuf);
2128}
2129
2130/***************************************************************************/
2131
2132/*
2133 * <symes> is the list of symes satisfing the context type <type>.
2134 * <allSymes> is the list of all possible symes for ab.
2135 * If symes is an empty list, the produced message is: "No meanings for..."
2136 * otherwhise (more than 1 syme), allSymes are displayed.
2137 * Otherwise the message is "n meanings for ..." and symes are displayed.
2138 * NOTE: if the call is correct, the list should never contain 1 element.
2139 */
2140void
2141terrorNotUniqueMeaning(Msg msg, AbSyn ab, SymeList symes, SymeList allSymes,
2142 String s, TForm type)
2143{
2144 Buffer obuf;
2145 String fmt;
2146 Length nsymes;
2147
2148 terrorClip = comsgOkAbbrev() ? CLIP65 : ABPP_UNCLIPPED(200000L);
2149
2150 nsymes = listLength(Syme)(Syme_listPointer->_Length)(symes);
2151
2152 assert(nsymes != 1)do { if (!(nsymes != 1)) _do_assert(("nsymes != 1"),"terror.c"
,2152); } while (0)
;
2153
2154 fmt = comsgString(msg);
2155 obuf = bufNew();
2156 bufPrintf(obuf, fmt, nsymes, s);
2157
2158 if (!comsgOkDetails()) goto done;
2159
2160 if (!symes)
2161 symes = allSymes;
2162
2163 if (symes) {
2164 fmt = comsgString(ALDOR_D_TinPossTypes194);
2165 bufPrintf(obuf, "\n");
2166 bufPrintf(obuf, fmt);
2167 }
2168
2169 for (; symes; symes = cdr(symes)((symes)->rest)) {
2170 String opstr, stype, sfrom;
2171
2172 bufPrintf(obuf, "\n\t ");
2173
2174 opstr = symString(symeId(car(symes)))((((((symes)->first))->id))->str);
2175 stype = fmtTForm(symeType(car(symes)((symes)->first)));
2176 switch (symeKind(car(symes))((((((symes)->first))->kind == SYME_Trigger ? libGetAllSymes
((((symes)->first))->lib) : ((void*)0)), (((symes)->
first)))->kind)
) {
2177 case SYME_Import:
2178 sfrom = fmtTForm(symeExporter(car(symes)((symes)->first)));
2179 fmt = comsgString(ALDOR_D_TinOneImpMeaning224);
2180 bufPrintf(obuf, fmt, opstr, stype, sfrom);
2181 strFree(sfrom);
2182 break;
2183 case SYME_Library:
2184 fmt = comsgString(ALDOR_D_TinOneLibMeaning226);
2185 bufPrintf(obuf, fmt, opstr, stype);
2186 break;
2187 default:
2188 fmt = comsgString(ALDOR_D_TinOneLexMeaning225);
2189 bufPrintf(obuf, fmt, opstr, stype);
2190 break;
2191 }
2192 strFree(stype);
2193 }
2194
2195 bputContextType(obuf, type);
2196done:
2197 comsgError(ab, ALDOR_E_ExplicitMsg1, bufChars(obuf));
2198 bufFree(obuf);
2199}
2200
2201
2202
2203/*****************************************************************************
2204 *
2205 * :: Formatting utilities
2206 *
2207 *****************************************************************************/
2208
2209localstatic String
2210fmtAbSyn(AbSyn ab)
2211{
2212 return abPrettyClippedIn(ab, terrorClip, INDENT2);
2213}
2214
2215localstatic String
2216fmtTForm(TForm tf)
2217{
2218 return tfPrettyClippedIn(tf, terrorClip, INDENT2);
2219}
2220
2221localstatic void
2222bputMeanings(Buffer buf, TPoss tp)
2223{
2224 TPossIterator ti;
2225 int n;
2226 String fmt = comsgString(ALDOR_D_TinOneMeaning198);
2227
2228 for (n = 1, tpossITER(ti,tp)((ti).possl = (tp ? (tp)->possl : ((void*)0))); tpossMORE(ti)((ti).possl); n++, tpossSTEP(ti)((ti).possl = (((ti).possl)->rest))) {
2229 String s = fmtTForm(tpossELT(ti)tpossELT_(&ti));
2230 bufPrintf(buf, "\n\t");
2231 bufPrintf(buf, fmt, n, s);
2232 strFree(s);
2233 }
2234}
2235
2236localstatic void
2237bputSymes(Buffer buf, SymeList symes, String fmtOp)
2238{
2239 for (; symes; symes = cdr(symes)((symes)->rest))
2240 bputSyme(buf, car(symes)((symes)->first), symeType(car(symes)((symes)->first)), fmtOp);
2241}
2242
2243localstatic void
2244bputSyme(Buffer obuf, Syme syme, TForm type, String fmtOp)
2245{
2246 String stype, sfrom, fmt;
2247 SefoList cond;
2248 stype = fmtTForm(type);
2249 cond = symeCondition(syme);
2250 bufPrintf(obuf, "\n ");
2251
2252 switch (symeKind(syme)((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind)
) {
2253 case SYME_Import:
2254 sfrom = fmtTForm(symeExporter(syme));
2255 fmt = comsgString(ALDOR_D_TinOneImpMeaning224);
2256 bufPrintf(obuf, fmt, fmtOp, stype, sfrom);
2257 bputCondition(obuf, cond);
2258 strFree(sfrom);
2259 break;
2260 case SYME_Library:
2261 fmt = comsgString(ALDOR_D_TinOneLibMeaning226);
2262 bufPrintf(obuf, fmt, fmtOp, stype);
2263 break;
2264 default:
2265 fmt = comsgString(ALDOR_D_TinOneLexMeaning225);
2266 bufPrintf(obuf, fmt, fmtOp, stype);
2267 bputCondition(obuf, cond);
2268 break;
2269 }
2270 strFree(stype);
2271
2272}
2273
2274localstatic void
2275bputCondition(Buffer buf, SefoList conds)
2276{
2277 Sefo cond ;
2278 String scond, fmt;
2279 if (!conds) return;
2280
2281 cond = car(conds)((conds)->first);
2282 conds = cdr(conds)((conds)->rest);
2283 scond = fmtAbSyn(cond);
2284 fmt = ", if %s"; /* comsgString(ALDOR_D_TinCondSeparator) */
2285 bufPrintf(buf, fmt, scond);
2286
2287 while (conds) {
2288 scond = fmtAbSyn(car(conds)((conds)->first));
2289 conds = cdr(conds)((conds)->rest);
2290 bufPrintf(buf, ", %s", scond);
2291 }
2292}
2293
2294/* Prints the application type without the exporter */
2295localstatic void
2296bputType(Buffer obuf, TForm tf, String fmtOp)
2297{
2298 String stype = fmtTForm(tf);
2299 String fmt = comsgString(ALDOR_D_TinOneMeaning0227);
2300 bufPrintf(obuf, "\n ");
2301 bufPrintf(obuf, fmt, stype);
2302 strFree(stype);
2303}
2304
2305localstatic void
2306bputTForm0(Buffer buf, int indent, TForm tf)
2307{
2308 String s = fmtTForm(tf);
2309
2310 bufPutc(buf, '\n');
2311 bufPutcTimes(buf, ' ', indent);
2312 bufPrintf(buf, "-- %s", s);
2313 strFree(s);
2314}
2315
2316localstatic void
2317bputTPoss0(Buffer buf, int indent, TPoss tp)
2318{
2319 TPossIterator ti;
2320
2321 for (tpossITER(ti,tp)((ti).possl = (tp ? (tp)->possl : ((void*)0))); tpossMORE(ti)((ti).possl); tpossSTEP(ti)((ti).possl = (((ti).possl)->rest)))
2322 bputTForm0(buf, indent, tpossELT(ti)tpossELT_(&ti));
2323}
2324
2325localstatic void
2326bputTForm(Buffer buf, TForm tf)
2327{
2328 String s = fmtTForm(tf);
2329 bufPrintf(buf, "\n -- %s", s);
2330 strFree(s);
2331}
2332
2333localstatic void
2334bputTPoss(Buffer buf, TPoss tp)
2335{
2336 TPossIterator ti;
2337
2338 for (tpossITER(ti,tp)((ti).possl = (tp ? (tp)->possl : ((void*)0))); tpossMORE(ti)((ti).possl); tpossSTEP(ti)((ti).possl = (((ti).possl)->rest)))
2339 bputTForm(buf, tpossELT(ti)tpossELT_(&ti));
2340}
2341
2342
2343/* Dipending on the state of ab, puts in obuf:
2344 * <plurmsg> (types)
2345 * OR
2346 * <singmsg> (type).
2347 * OR
2348 * nothing
2349 *
2350 * Indent is the current indentation level which must be used.
2351 * <singmsg> should have a %s for the type and <plurmsg> should not.
2352 */
2353localstatic void
2354bputAbTPoss(Buffer obuf, int indent, AbSyn ab, Msg singmsg, Msg plurmsg)
2355{
2356 String fmt;
2357
2358 switch (abState(ab)((ab)->abHdr.state)) {
2359 case AB_State_HasPoss: {
2360 if (tpossCount(abTPoss(ab)((ab)->abHdr.type.poss)) == 0 ||
2361 (tpossCount(abTPoss(ab)((ab)->abHdr.type.poss)) == 1 &&
2362 tfIsUnknown(tpossUnique(abTPoss(ab)))(((tpossUnique(((ab)->abHdr.type.poss)))->tag) == TF_Unknown
)
))
2363 return;
2364
2365 if (tpossCount(abTPoss(ab)((ab)->abHdr.type.poss)) != 1) {
2366 fmt = comsgString(plurmsg);
2367 bufPutcTimes(obuf, ' ', indent);
2368 bufPrintf(obuf, fmt);
2369 bputTPoss0(obuf, indent+2, abTPoss(ab)((ab)->abHdr.type.poss));
2370
2371 }
2372 else {
2373 String s0 = fmtTForm(tpossUnique(abTPoss(ab)((ab)->abHdr.type.poss)));
2374 fmt = comsgString(singmsg);
2375 bufPutcTimes(obuf, ' ', indent);
2376 bufPrintf(obuf, fmt, s0);
2377 strFree(s0);
2378 }
2379 }
2380 break;
2381 case AB_State_HasUnique: {
2382 String s0 = fmtTForm(abTUnique(ab)((ab)->abHdr.type.unique));
2383 fmt = comsgString(singmsg);
2384 bufPutcTimes(obuf, ' ', indent);
2385 bufPrintf(obuf, fmt, s0);
2386 strFree(s0);
2387 break;
2388 }
2389 default:
2390 return;
2391 }
2392}
2393
2394localstatic void
2395bputContextType(Buffer obuf, TForm type)
2396{
2397 String s, fmt;
2398
2399 if (!tfIsUnknown(type)(((type)->tag) == TF_Unknown) && !tfIsNone(type)((((type)->tag) == TF_Multiple) && tfMultiArgc(type
) == 0)
) {
2400 s = fmtTForm(type);
2401 fmt = comsgString(ALDOR_D_TinContextType199);
2402 bufPrintf(obuf, "\n ");
2403 bufPrintf(obuf, fmt, s);
2404 strFree(s);
2405 }
2406}
2407
2408localstatic void
2409bputTConst(Buffer buf, TConst tc)
2410{
2411 String s0, s1;
2412
2413 switch(tcTag(tc)((tc)->tag)) {
2414 case TC_Satisfies:
2415 s0 = fmtTForm(tcArgv(tc)((tc)->argv)[0]);
2416 s1 = fmtTForm(tcArgv(tc)((tc)->argv)[1]);
2417 break;
2418 default:
2419 bugBadCase(tcTag(tc))bug("Bad case %d (line %d in file %s).", (int) ((tc)->tag)
, 2419, "terror.c")
;
2420 NotReached(s0 = s1 = NULL){(void)bug("Not supposed to reach line %d in file: %s\n",2420
, "terror.c");}
;
2421 }
2422
2423 bufPrintf(buf, "\n -- %s satisfies %s", s0, s1);
2424 strFree(s0);
2425 strFree(s1);
2426}
2427
2428localstatic void
2429bputTReject(Buffer obuf, TReject tr, String fmtOp)
2430{
2431 if (trSyme(tr)((tr)->syme))
2432 bputSyme(obuf, trSyme(tr)((tr)->syme), trType(tr)((tr)->tf), fmtOp);
2433 else
2434 bputType(obuf, trType(tr)((tr)->tf), fmtOp);
2435}
2436
2437/* cares that ^ catches the operator if infixed o 'coerce' */
2438localstatic void
2439operatorErrMsg(AbSyn ab, AbSyn op, Buffer obuf)
2440{
2441 AbSyn abp;
2442
2443 if (abTag(ab)((ab)->abHdr.tag) == AB_CoerceTo)
2444 abp = ab->abCoerceTo.type;
2445 else
2446 abp = op;
2447
2448 comsgError(abp, ALDOR_E_ExplicitMsg1, bufChars(obuf));
2449}
2450
2451
2452/*****************************************************************************
2453 *
2454 * :: Data structure audits
2455 *
2456 ****************************************************************************/
2457
2458static Bool reallyAudit = false((int) 0);
2459
2460localstatic Bool terrorAuditPoss0 (Bool, AbSyn, Table);
2461localstatic Bool terrorAuditPoss1 (Bool, AbSyn, Table);
2462
2463
2464Bool
2465terrorAuditPoss(Bool verbose, AbSyn absyn)
2466{
2467 Table counts;
2468 Bool ok;
2469
2470 if (!reallyAudit) return true1;
2471
2472 counts = tblNew((TblHashFun) 0, (TblEqFun) 0); /* "==" for ref counts */
2473 ok = true1;
2474
2475 ok &= terrorAuditPoss0(verbose, absyn, counts);
2476 ok &= terrorAuditPoss1(verbose, absyn, counts);
2477
2478 tblFree(counts);
2479 return ok;
2480}
2481
2482localstatic Bool
2483terrorAuditPoss0(Bool verbose, AbSyn absyn, Table counts)
2484{
2485 int i;
2486 Bool ok = true1;
2487
2488 if (absyn == 0) {
2489 fprintf(dbOut,"Failure Mode 0");
2490 fnewline(dbOut);
2491 return false((int) 0);
2492 }
2493 if (abState(absyn)((absyn)->abHdr.state) == AB_State_HasPoss) {
2494 TPoss tposs = abTPoss(absyn)((absyn)->abHdr.type.poss);
2495 long n;
2496 n = ptrToLong(tblElt(counts, tposs, ptrFrLong(long0)))((long) (tblElt(counts, tposs, ((Pointer)(((long) 0))))));
2497 tblSetElt (counts, tposs, ptrFrLong(n+1)((Pointer)(n+1)));
2498 }
2499 else {
2500 if (verbose) {
2501 String expr = abPretty(absyn);
2502 if (abTag(absyn)((absyn)->abHdr.tag) == AB_Nothing) {
2503 fprintf(dbOut,"'Twas nothing");
2504 fnewline(dbOut);
2505 }
2506 fprintf(dbOut,"State != AB_State_HasPoss in: %s", expr);
2507 fnewline(dbOut);
2508 strFree(expr);
2509 }
2510 ok = false((int) 0);
2511 }
2512 if (!abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START))
2513 for (i = 0; i < abArgc(absyn)((absyn)->abHdr.argc); i++)
2514 ok &= terrorAuditPoss0(verbose,abArgv(absyn)((absyn)->abGen.data.argv)[i],counts);
2515
2516 return ok;
2517}
2518
2519localstatic Bool
2520terrorAuditPoss1(Bool verbose, AbSyn absyn, Table counts)
2521{
2522 int i;
2523 Bool ok = true1;
2524
2525 if (abState(absyn)((absyn)->abHdr.state) == AB_State_HasPoss) {
2526 TPoss tposs = abTPoss(absyn)((absyn)->abHdr.type.poss);
2527 long n;
2528 n = ptrToLong(tblElt(counts, tposs, ptrFrLong(long0)))((long) (tblElt(counts, tposs, ((Pointer)(((long) 0))))));
2529 if (n != tposs->refc) {
2530 if (verbose) {
2531 String expr = abPretty(absyn);
2532 fprintf(dbOut,
2533 "Type possibilty set on expression %s ",
2534 expr);
2535 fprintf(dbOut,
2536 "is used %ld times but believes %d.",
2537 n, tposs->refc);
2538 fnewline(dbOut);
2539 }
2540 ok = false((int) 0);
2541
2542 /*
2543 * Stifle further messages.
2544 */
2545 tblSetElt(counts, tposs, ptrFrLong((long) tposs->refc)((Pointer)((long) tposs->refc)));
2546 }
2547 }
2548
2549 if (!abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START))
2550 for (i = 0; i < abArgc(absyn)((absyn)->abHdr.argc); i++)
2551 ok &= terrorAuditPoss1(verbose,abArgv(absyn)((absyn)->abGen.data.argv)[i],counts);
2552
2553 return ok;
2554}
2555
2556Bool
2557terrorAuditBottomUp(Bool verbose, AbSyn absyn)
2558{
2559 int i;
2560 Bool ok = true1;
2561
2562 assert(absyn)do { if (!(absyn)) _do_assert(("absyn"),"terror.c",2562); } while
(0)
;
2563 if ((abState(absyn)((absyn)->abHdr.state) != AB_State_HasPoss) && !abIsSefo(absyn)(((absyn)->abHdr.state) == AB_State_HasUnique)) {
2564 if (verbose) {
2565 String expr = abPretty(absyn);
2566 fprintf(dbOut, "No type possibilty set on node: %s", expr);
2567 fnewline(dbOut);
2568 strFree(expr);
2569 }
2570 ok = false((int) 0);
2571 }
2572 if (!abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START))
2573 for (i = 0; i < abArgc(absyn)((absyn)->abHdr.argc); i++)
2574 ok &= terrorAuditBottomUp(verbose, abArgv(absyn)((absyn)->abGen.data.argv)[i]);
2575 return ok;
2576}
2577
2578Bool
2579terrorAuditTopDown(Bool verbose, AbSyn absyn)
2580{
2581 int i;
2582 Bool ok = true1;
2583
2584 assert(absyn)do { if (!(absyn)) _do_assert(("absyn"),"terror.c",2584); } while
(0)
;
2585 if (!abIsSefo(absyn)(((absyn)->abHdr.state) == AB_State_HasUnique)) {
2586 if (verbose) {
2587 String expr = abPretty(absyn);
2588 fprintf(dbOut, "No unique type on node: %s", expr);
2589 fnewline(dbOut);
2590 strFree(expr);
2591 }
2592 ok = false((int) 0);
2593 } else if (abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START) && !abSyme(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->syme :
0)
) {
2594 if (verbose) {
2595 String expr = abPretty(absyn);
2596 fprintf(dbOut, "No symbol meaning for leaf: %s", expr);
2597 fnewline(dbOut);
2598 strFree(expr);
2599 }
2600 ok = false((int) 0);
2601 }
2602 if (!abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START))
2603 for (i = 0; i < abArgc(absyn)((absyn)->abHdr.argc); i++)
2604 ok &= terrorAuditTopDown(verbose, abArgv(absyn)((absyn)->abGen.data.argv)[i]);
2605 return ok;
2606}