Bug Summary

File:src/ti_tdn.c
Warning:line 2366, column 2
Value stored to 'ok' 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 ti_tdn.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 ti_tdn.c
1/****************************************************************************
2 *
3 * ti_tdn.c: Type inference -- top down pass.
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 "comsg.h"
12#include "debug.h"
13#include "fluid.h"
14#include "format.h"
15#include "lib.h"
16#include "sefo.h"
17#include "simpl.h"
18#include "spesym.h"
19#include "store.h"
20#include "stab.h"
21#include "terror.h"
22#include "tfsat.h"
23#include "ti_tdn.h"
24#include "tinfer.h"
25#include "tposs.h"
26#include "util.h"
27
28
29/*
30 * To do:
31 * -- titdnApply: Should mark op as erroneous, if necessary.
32 */
33
34/*****************************************************************************
35 *
36 * :: Selective debug stuff
37 *
38 ****************************************************************************/
39
40Bool condApplyDebug = false((int) 0);
41Bool tipTdnDebug = false((int) 0);
42#define condApplyDEBUGif (!condApplyDebug) { } else afprintf DEBUG_IF(condApply)if (!condApplyDebug) { } else afprintf
43#define tipTdnDEBUGif (!tipTdnDebug) { } else afprintf DEBUG_IF(tipTdn)if (!tipTdnDebug) { } else afprintf
44
45/*****************************************************************************
46 *
47 * :: Fluids to unify multiple exit points
48 *
49 ****************************************************************************/
50
51TForm tuniYieldTForm = 0;
52TForm tuniReturnTForm = 0;
53TForm tuniExitTForm = 0;
54static AbSyn tuniTdnSelectObj = 0;
55
56/*****************************************************************************
57 *
58 * :: Fluids to keep trace of multiple exit points
59 *
60 ****************************************************************************/
61
62AbSynList abExitsList = 0;
63AbSynList abReturnsList = 0;
64AbSynList abYieldsList = 0;
65
66/*****************************************************************************
67 *
68 * :: Declarations for top down pass
69 *
70 ****************************************************************************/
71
72localstatic Bool titdn0Generic (Stab, AbSyn, TForm);
73localstatic Bool titdn0FarValue (Stab, AbSyn, TForm, AbSyn,TForm *,
74 AbSynList *);
75localstatic Bool titdn0NoValue (Stab, AbSyn, TForm, Msg);
76
77localstatic Bool titdn0ApplySymIfNeeded
78 (Stab, AbSyn, TForm, Symbol,
79 Length, AbSynGetter, AbSyn, TFormPredicate);
80localstatic Bool titdn0ApplySym (Stab, AbSyn, TForm, Symbol,
81 Length, AbSynGetter, AbSyn);
82localstatic Bool titdn0ApplyFType(Stab, AbSyn, TForm, AbSyn,
83 Length, AbSynGetter);
84localstatic Bool titdn0ApplyJoin (Stab, AbSyn, TForm, AbSyn,
85 Length, AbSynGetter);
86
87localstatic Bool titdn0PLambdaArgs (Stab, AbSyn);
88localstatic Bool titdn0PLambdaRets (Stab, AbSynList);
89
90localstatic Bool titdnId (Stab, AbSyn, TForm);
91localstatic Bool titdn0IdCondition(AbSyn, Syme);
92localstatic Bool titdnIdSy (Stab, AbSyn, TForm);
93localstatic Bool titdnBlank (Stab, AbSyn, TForm);
94localstatic Bool titdnLitInteger (Stab, AbSyn, TForm);
95localstatic Bool titdnLitFloat (Stab, AbSyn, TForm);
96localstatic Bool titdnLitString (Stab, AbSyn, TForm);
97localstatic Bool titdnAdd (Stab, AbSyn, TForm);
98localstatic Bool titdnAnd (Stab, AbSyn, TForm);
99localstatic Bool titdnApply (Stab, AbSyn, TForm);
100localstatic Bool titdnAssert (Stab, AbSyn, TForm);
101localstatic Bool titdnAssign (Stab, AbSyn, TForm);
102localstatic Bool titdnBreak (Stab, AbSyn, TForm);
103localstatic Bool titdnBuiltin (Stab, AbSyn, TForm);
104localstatic Bool titdnCoerceTo (Stab, AbSyn, TForm);
105localstatic Bool titdnCollect (Stab, AbSyn, TForm);
106localstatic Bool titdnComma (Stab, AbSyn, TForm);
107localstatic Bool titdnDeclare (Stab, AbSyn, TForm);
108localstatic Bool titdnDefault (Stab, AbSyn, TForm);
109localstatic Bool titdnDefine (Stab, AbSyn, TForm);
110localstatic Bool titdnDelay (Stab, AbSyn, TForm);
111localstatic Bool titdnDo (Stab, AbSyn, TForm);
112localstatic Bool titdnExcept (Stab, AbSyn, TForm);
113localstatic Bool titdnRaise (Stab, AbSyn, TForm);
114localstatic Bool titdnExit (Stab, AbSyn, TForm);
115localstatic Bool titdnExport (Stab, AbSyn, TForm);
116localstatic Bool titdnExtend (Stab, AbSyn, TForm);
117localstatic Bool titdnFix (Stab, AbSyn, TForm);
118localstatic Bool titdnFluid (Stab, AbSyn, TForm);
119localstatic Bool titdnFor (Stab, AbSyn, TForm);
120localstatic Bool titdnForeignImport(Stab, AbSyn, TForm);
121localstatic Bool titdnForeignExport(Stab, AbSyn, TForm);
122localstatic Bool titdnFree (Stab, AbSyn, TForm);
123localstatic Bool titdnGenerate (Stab, AbSyn, TForm);
124localstatic Bool titdnGoto (Stab, AbSyn, TForm);
125localstatic Bool titdnHas (Stab, AbSyn, TForm);
126localstatic Bool titdnHide (Stab, AbSyn, TForm);
127localstatic Bool titdnIf (Stab, AbSyn, TForm);
128localstatic Bool titdnImport (Stab, AbSyn, TForm);
129localstatic Bool titdnInline (Stab, AbSyn, TForm);
130localstatic Bool titdnIterate (Stab, AbSyn, TForm);
131localstatic Bool titdnLabel (Stab, AbSyn, TForm);
132localstatic Bool titdnLambda (Stab, AbSyn, TForm);
133localstatic Bool titdnLet (Stab, AbSyn, TForm);
134localstatic Bool titdnLocal (Stab, AbSyn, TForm);
135localstatic Bool titdnMacro (Stab, AbSyn, TForm);
136localstatic Bool titdnMLambda (Stab, AbSyn, TForm);
137localstatic Bool titdnNever (Stab, AbSyn, TForm);
138localstatic Bool titdnNot (Stab, AbSyn, TForm);
139localstatic Bool titdnNothing (Stab, AbSyn, TForm);
140localstatic Bool titdnOr (Stab, AbSyn, TForm);
141localstatic Bool titdnPretendTo (Stab, AbSyn, TForm);
142localstatic Bool titdnQualify (Stab, AbSyn, TForm);
143localstatic Bool titdnQuote (Stab, AbSyn, TForm);
144localstatic Bool titdnReference (Stab, AbSyn, TForm);
145localstatic Bool titdnRepeat (Stab, AbSyn, TForm);
146localstatic Bool titdnRestrictTo (Stab, AbSyn, TForm);
147localstatic Bool titdnReturn (Stab, AbSyn, TForm);
148localstatic Bool titdnSelect (Stab, AbSyn, TForm);
149localstatic Bool titdnSequence (Stab, AbSyn, TForm);
150localstatic Bool titdnSelect (Stab, AbSyn, TForm);
151localstatic Bool titdnTest (Stab, AbSyn, TForm);
152localstatic Bool titdnTry (Stab, AbSyn, TForm);
153localstatic Bool titdnWhere (Stab, AbSyn, TForm);
154localstatic Bool titdnWhile (Stab, AbSyn, TForm);
155localstatic Bool titdnWith (Stab, AbSyn, TForm);
156localstatic Bool titdnYield (Stab, AbSyn, TForm);
157
158localstatic void titdnError(Stab stab, AbSyn absyn, TForm type);
159localstatic void titdn0Error(Stab stab, AbSyn absyn, TForm type);
160
161localstatic Bool titdnSequence0 (Stab, AbSyn, TForm);
162
163/*****************************************************************************
164 *
165 * :: Top down pass
166 *
167 ****************************************************************************/
168
169void
170tiTopDown(Stab stab, AbSyn absyn, TForm type)
171{
172 Scope("tiTopDown")String scopeName = ("tiTopDown"); int fluidLevel0 = (scopeLevel
++, fluidLevel)
;
173
174 TForm fluid(tuniReturnTForm)fluidSave_tuniReturnTForm = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniReturnTForm
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniReturnTForm
, fluidStack[fluidLevel].size = sizeof(tuniReturnTForm), fluidLevel
++, (tuniReturnTForm) )
;
175 TForm fluid(tuniYieldTForm)fluidSave_tuniYieldTForm = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniYieldTForm
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniYieldTForm
, fluidStack[fluidLevel].size = sizeof(tuniYieldTForm), fluidLevel
++, (tuniYieldTForm) )
;
176 TForm fluid(tuniExitTForm)fluidSave_tuniExitTForm = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniExitTForm
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniExitTForm
, fluidStack[fluidLevel].size = sizeof(tuniExitTForm), fluidLevel
++, (tuniExitTForm) )
;
177 AbLogic fluid(abCondKnown)fluidSave_abCondKnown = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(abCondKnown
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_abCondKnown
, fluidStack[fluidLevel].size = sizeof(abCondKnown), fluidLevel
++, (abCondKnown) )
;
178
179 tuniReturnTForm = tfNone()tfMulti(0);
180 tuniYieldTForm = tfNone()tfMulti(0);
181 tuniExitTForm = tfNone()tfMulti(0);
182 abCondKnown = abCondKnown ? ablogCopy(abCondKnown) : ablogTrue();
183
184 titdn(stab, absyn, type);
185
186 ablogFree(abCondKnown);
187
188 ReturnNothing{ fluidUnwind(fluidLevel0, ((int) 0)); return;; }; /* (result); */
189}
190
191Bool
192titdn(Stab stab, AbSyn absyn, TForm type)
193{
194 TPoss abtposs;
195 static int serialNo = 0, depthNo = 0;
196 int serialThis;
197 Bool s = false((int) 0);
198 TForm stype;
199
200 if (abState(absyn)((absyn)->abHdr.state) == AB_State_HasUnique)
201 return true1;
202
203 if (abState(absyn)((absyn)->abHdr.state) == AB_State_Error) {
204 titdnError(stab, absyn, type);
205 return false((int) 0);
206 }
207
208 assert(abState(absyn) == AB_State_HasPoss)do { if (!(((absyn)->abHdr.state) == AB_State_HasPoss)) _do_assert
(("abState(absyn) == AB_State_HasPoss"),"ti_tdn.c",208); } while
(0)
;
209 /* MUST use tpossRefer() or abReferTPoss() */
210 abtposs = tpossRefer(abTPoss(absyn)((absyn)->abHdr.type.poss));
211
212 if (tpossCount(abtposs) == 0) {
213 titdnError(stab, absyn, type);
214 return false((int) 0);
215 }
216
217 stype = tfFollowSubst(type);
218
219 if (tfIsUnknown(stype)(((stype)->tag) == TF_Unknown) || tfIsNone(stype)((((stype)->tag) == TF_Multiple) && tfMultiArgc(stype
) == 0)
) {
220 if (tpossCount(abtposs) > 1) {
221 terrorNotUniqueType(ALDOR_E_TinExprMeans164,
222 absyn,type,abtposs);
223 return false((int) 0);
224 }
225 if (tpossCount(abtposs) == 1)
226 type = tpossUnique(abtposs);
227 }
228
229 if (!abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START) && abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
)
230 stab = abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
;
231
232 serialNo += 1;
233 depthNo += 1;
234 serialThis = serialNo;
235 if (DEBUG(tipTdn)tipTdnDebug) {
236 fprintf(dbOut,"->Tdn: %*s%d= ", depthNo, "", serialThis);
237 abPrettyPrint(dbOut, absyn);
238 fprintf(dbOut," @ ");
239 tfPrint(dbOut, type);
240 fnewline(dbOut);
241 }
242
243 AB_SWITCH(absyn, s = titdn, (stab, absyn, type))switch (((absyn)->abHdr.tag)) { case AB_Id: s = titdnId (stab
, absyn, type); break; case AB_IdSy: s = titdnIdSy (stab, absyn
, type); break; case AB_Blank: s = titdnBlank (stab, absyn, type
); break; case AB_LitInteger: s = titdnLitInteger (stab, absyn
, type); break; case AB_LitFloat: s = titdnLitFloat (stab, absyn
, type); break; case AB_LitString: s = titdnLitString (stab, absyn
, type); break; case AB_Add: s = titdnAdd (stab, absyn, type)
; break; case AB_And: s = titdnAnd (stab, absyn, type); break
; case AB_Apply: s = titdnApply (stab, absyn, type); break; case
AB_Assert: s = titdnAssert (stab, absyn, type); break; case AB_Assign
: s = titdnAssign (stab, absyn, type); break; case AB_Break: s
= titdnBreak (stab, absyn, type); break; case AB_Builtin: s =
titdnBuiltin (stab, absyn, type); break; case AB_CoerceTo: s
= titdnCoerceTo (stab, absyn, type); break; case AB_Collect:
s = titdnCollect (stab, absyn, type); break; case AB_Comma: s
= titdnComma (stab, absyn, type); break; case AB_Declare: s =
titdnDeclare (stab, absyn, type); break; case AB_Default: s =
titdnDefault (stab, absyn, type); break; case AB_Define: s =
titdnDefine (stab, absyn, type); break; case AB_Delay: s = titdnDelay
(stab, absyn, type); break; case AB_Do: s = titdnDo (stab, absyn
, type); break; case AB_Except: s = titdnExcept (stab, absyn,
type); break; case AB_Raise: s = titdnRaise (stab, absyn, type
); break; case AB_Exit: s = titdnExit (stab, absyn, type); break
; case AB_Export: s = titdnExport (stab, absyn, type); break;
case AB_Extend: s = titdnExtend (stab, absyn, type); break; case
AB_Fix: s = titdnFix (stab, absyn, type); break; case AB_Fluid
: s = titdnFluid (stab, absyn, type); break; case AB_For: s =
titdnFor (stab, absyn, type); break; case AB_ForeignImport: s
= titdnForeignImport (stab, absyn, type); break; case AB_ForeignExport
: s = titdnForeignExport (stab, absyn, type); break; case AB_Free
: s = titdnFree (stab, absyn, type); break; case AB_Generate:
s = titdnGenerate (stab, absyn, type); break; case AB_Goto: s
= titdnGoto (stab, absyn, type); break; case AB_Has: s = titdnHas
(stab, absyn, type); break; case AB_Hide: s = titdnHide (stab
, absyn, type); break; case AB_If: s = titdnIf (stab, absyn, type
); break; case AB_Import: s = titdnImport (stab, absyn, type)
; break; case AB_Inline: s = titdnInline (stab, absyn, type);
break; case AB_Iterate: s = titdnIterate (stab, absyn, type)
; break; case AB_Label: s = titdnLabel (stab, absyn, type); break
; case AB_Lambda: s = titdnLambda (stab, absyn, type); break;
case AB_Let: s = titdnLet (stab, absyn, type); break; case AB_Local
: s = titdnLocal (stab, absyn, type); break; case AB_Macro: s
= titdnMacro (stab, absyn, type); break; case AB_MLambda: s =
titdnMLambda (stab, absyn, type); break; case AB_Never: s = titdnNever
(stab, absyn, type); break; case AB_Not: s = titdnNot (stab,
absyn, type); break; case AB_Nothing: s = titdnNothing (stab
, absyn, type); break; case AB_Or: s = titdnOr (stab, absyn, type
); break; case AB_PLambda: s = titdnLambda (stab, absyn, type
); break; case AB_PretendTo: s = titdnPretendTo (stab, absyn,
type); break; case AB_Qualify: s = titdnQualify (stab, absyn
, type); break; case AB_Quote: s = titdnQuote (stab, absyn, type
); break; case AB_Reference: s = titdnReference (stab, absyn,
type); break; case AB_Repeat: s = titdnRepeat (stab, absyn, type
); break; case AB_RestrictTo: s = titdnRestrictTo (stab, absyn
, type); break; case AB_Return: s = titdnReturn (stab, absyn,
type); break; case AB_Select: s = titdnSelect (stab, absyn, type
); break; case AB_Sequence: s = titdnSequence (stab, absyn, type
); break; case AB_Test: s = titdnTest (stab, absyn, type); break
; case AB_Try: s = titdnTry (stab, absyn, type); break; case AB_Where
: s = titdnWhere (stab, absyn, type); break; case AB_While: s
= titdnWhile (stab, absyn, type); break; case AB_With: s = titdnWith
(stab, absyn, type); break; case AB_Yield: s = titdnYield (stab
, absyn, type); break; default: bug("Bad case %d (line %d in file %s)."
, (int) ((absyn)->abHdr.tag), 243, "ti_tdn.c"); }
;
244
245 if (s) {
246 /* The callee should have set abTUnique(absyn). */
247 assert(abTPoss(absyn) != abtposs)do { if (!(((absyn)->abHdr.type.poss) != abtposs)) _do_assert
(("abTPoss(absyn) != abtposs"),"ti_tdn.c",247); } while (0)
;
248
249 /* All identifiers should have symes. */
250 assert(abTag(absyn) != AB_Id || abSyme(absyn))do { if (!(((absyn)->abHdr.tag) != AB_Id || ((absyn)->abHdr
.seman ? (absyn)->abHdr.seman->syme : 0))) _do_assert((
"abTag(absyn) != AB_Id || abSyme(absyn)"),"ti_tdn.c",250); } while
(0)
;
251
252 abState(absyn)((absyn)->abHdr.state) = AB_State_HasUnique;
253 tpossFree(abtposs);
254 }
255 else {
256 /* The callee should not have changed the abState. */
257 assert(abState(absyn) == AB_State_HasPoss)do { if (!(((absyn)->abHdr.state) == AB_State_HasPoss)) _do_assert
(("abState(absyn) == AB_State_HasPoss"),"ti_tdn.c",257); } while
(0)
;
258
259 /* The caller should not have set abTUnique(absyn). */
260 assert(abTPoss(absyn) == abtposs)do { if (!(((absyn)->abHdr.type.poss) == abtposs)) _do_assert
(("abTPoss(absyn) == abtposs"),"ti_tdn.c",260); } while (0)
;
261 }
262
263 if (DEBUG(tipTdn)tipTdnDebug) {
264 fprintf(dbOut, "<-Tdn: %*s%d= ", depthNo, "", serialThis);
265 abPrettyPrint(dbOut, absyn);
266 fprintf(dbOut, " @ ");
267 if (abState(absyn)((absyn)->abHdr.state) == AB_State_HasUnique)
268 tfPrint(dbOut, abTUnique(absyn)((absyn)->abHdr.type.unique));
269 else
270 tfPrint(dbOut, type);
271 fnewline(dbOut);
272 }
273 depthNo -= 1;
274 return s;
275}
276
277/****************************************************************************
278 *
279 * :: Generic: abArgc(ab), abArgv(ab)
280 *
281 ***************************************************************************/
282
283localstatic Bool
284titdn0Generic(Stab stab, AbSyn absyn, TForm type)
285{
286 Length i;
287 if (!abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START))
288 for (i = 0; i < abArgc(absyn)((absyn)->abHdr.argc); i += 1)
289 titdn(stab, abArgv(absyn)((absyn)->abGen.data.argv)[i], tfUnknown);
290 tfFollow(type)((type) = tfFollowFn(type));
291 abTUnique(absyn)((absyn)->abHdr.type.unique) = type;
292 return true1;
293}
294
295/****************************************************************************
296 *
297 * :: Implied call: apply, set!, test, generator, ...
298 *
299 ***************************************************************************/
300
301/*
302 * ab ==> m(i,...) -> tibup0Apply(stab, ab, 'apply, n+1, [m,i,...])
303 * ab ==> m(i,...) := x -> tibup0Apply(stab, ab, 'set!, n+2, [m,i,...,x])
304 * ab ==> if bb then ... -> tibup0Apply(stab, bb, 'test, 1, [bb.cond]);
305 * ab ==> for i in l -> tibup0Apply(stab, ab, 'iterator, 1, [l])
306 * ab ==> x::T -> tibup0Apply(stab, ab, 'coerce, 1, [x])
307 *
308 * Could also do...
309 *
310 * ab ==> 3 -> tibup0Apply(stab, ab, 'integer, 0, [])
311 * ab ==> "3.14" -> tibup0Apply(stab, ab, 'float, 0, [])
312 * ab ==> "hello" -> tibup0Apply(stab, ab, 'string, 0, [])
313 */
314
315localstatic Bool
316titdn0ApplySymIfNeeded(Stab stab, AbSyn absyn, TForm type, Symbol fsym,
317 Length argc, AbSynGetter argf,
318 AbSyn implicitPart, TFormPredicate pred)
319{
320 AbSyn part;
321 TPoss tp;
322
323 assert(argc == 1)do { if (!(argc == 1)) _do_assert(("argc == 1"),"ti_tdn.c",323
); } while (0)
;
324
325 part = argf(absyn, int0((int) 0));
326 tp = abReferTPoss(part);
327
328 if (tpossIsHaving(tp, pred) || tpossCount(tp) == 0)
329 titdn(stab, part, type);
330 else
331 return titdn0ApplySym(stab, absyn, type, fsym, argc, argf,
332 implicitPart);
333
334 tpossFree(tp);
335 return true1;
336}
337
338localstatic Bool
339titdn0ApplySym(Stab stab, AbSyn absyn, TForm type,
340 Symbol fsym, Length argc, AbSynGetter argf,
341 AbSyn implicitPart)
342{
343 AbSyn implicitOp;
344
345 if (!implicitPart) implicitPart = absyn;
346
347 /* Get the implicit operation */
348 implicitOp = abImplicit(implicitPart)((implicitPart)->abHdr.seman ? (implicitPart)->abHdr.seman
->implicit : 0)
;
349 assert(implicitOp)do { if (!(implicitOp)) _do_assert(("implicitOp"),"ti_tdn.c",
349); } while (0)
;
350
351 return titdn0ApplyFType(stab, absyn, type, implicitOp, argc, argf);
352}
353
354localstatic Bool
355titdn0ApplyJoin(Stab stab, AbSyn absyn, TForm type,
356 AbSyn op, Length argc, AbSynGetter argf)
357{
358 TPoss abtposs = abTPoss(absyn)((absyn)->abHdr.type.poss);
359 TForm opType, retType;
360
361 opType = tpossUnique(abTPoss(op)((op)->abHdr.type.poss));
362 titdn(stab, op, opType);
363 assert(abState(op) == AB_State_HasUnique)do { if (!(((op)->abHdr.state) == AB_State_HasUnique)) _do_assert
(("abState(op) == AB_State_HasUnique"),"ti_tdn.c",363); } while
(0)
;
364 abAddTContext(op, tfMapMultiArgEmbed(opType, argc));
365
366 if (!tpossIsUnique(abtposs))
367 return false((int) 0);
368
369 retType = tpossUnique(abtposs);
370 if (!tfSatValues(retType, type))
371 return false((int) 0);
372
373 abTUnique(absyn)((absyn)->abHdr.type.unique) = retType;
374 return true1;
375}
376
377/*
378 * Filter the operations based on arg and ret types.
379 * titdn is applied to the virtual arguments.
380 */
381
382localstatic Bool
383titdn0ApplyFType(Stab stab, AbSyn absyn, TForm type, AbSyn op,
384 Length argc, AbSynGetter argf)
385{
386 SatMask mask = tfSatBupMask();
387 Length nopc, popc, parmc;
388 TForm nopt, popt, opType;
389 TPoss opTypes, nopTypes;
390 TPossIterator it;
391 Bool result;
392
393 opTypes = abTPoss(op)((op)->abHdr.type.poss);
394 if (abIsTheId(op, ssymJoin)(((op)->abHdr.tag == (AB_Id)) && ((op)->abId.sym
)==(ssymJoin))
&& tpossIsUnique(opTypes) &&
395 tfSatisfies(tfMapRet(tpossUnique(opTypes))tfFollowArg(tpossUnique(opTypes), 1), tfCategory))
396 return titdn0ApplyJoin(stab, absyn, type, op, argc, argf);
397
398 opTypes = abReferTPoss(op); /* Original list of possible types */
399 nopTypes = tpossEmpty(); /* Possible (non-pending) types */
400 nopc = 0; /* Number of non-pending matches */
401 popc = 0; /* Number of all possible matches */
402 nopt = tfUnknown; /* Non-pending op type */
403 popt = tfUnknown; /* Any possible op type */
404 opType = NULL((void*)0);
405
406 /* Filter opTypes based on the argument and return types. */
407 for (tpossITER(it, opTypes)((it).possl = (opTypes ? (opTypes)->possl : ((void*)0))); tpossMORE(it)((it).possl); tpossSTEP(it)((it).possl = (((it).possl)->rest))) {
408 TForm opType = tpossELT(it)tpossELT_(&it);
409 SatMask result;
410
411 opType = tfDefineeType(opType);
412 assert(tfIsAnyMap(opType))do { if (!(((((opType)->tag) == TF_Map) || (((opType)->
tag) == TF_PackedMap)))) _do_assert(("tfIsAnyMap(opType)"),"ti_tdn.c"
,412); } while (0)
;
413
414 result = tfSatMap(mask, stab, opType, type, absyn, argc, argf);
415 if (tfSatSucceed(result)) {
416 if (!tfSatPending(result)) {
417 nopc += 1;
418 nopt = opType;
419 nopTypes = tpossAdd1(nopTypes, opType);
420 }
421 popc += 1;
422 popt = opType;
423 }
424 }
425
426 if (popc == 1) {
427 opType = popt;
428 result = true1;
429 }
430 else if (nopc == 1) {
431 opType = nopt;
432 result = true1;
433 }
434 else if (nopc == 0 && popc > 0) {
435 terrorApplyNotAnalyzed(absyn, op, popt);
436 result = false((int) 0);
437 }
438 else {
439 terrorApplyFType(absyn, type, nopTypes, op, stab, argc, argf);
440 result = false((int) 0);
441 }
442
443 tpossFree(opTypes);
444 tpossFree(nopTypes);
445
446 if (!result) return false((int) 0);
447
448 titdn(stab, op, opType);
449
450 parmc = tfMapHasDefaults(opType) ? tfMapArgc(opType) : argc;
451 abAddTContext(op, tfMapMultiArgEmbed(opType, parmc));
452
453 mask = tfSatTdnMask();
454 result = tfSatMap(mask, stab, opType, type, absyn, argc, argf);
455
456 /* We return false rarely (eg titdn0FarValue failure). */
457 return tfSatSucceed(result);
458}
459
460/****************************************************************************
461 *
462 * :: Far Values: return x, yield x, a => x
463 *
464 ***************************************************************************/
465
466localstatic Bool
467titdn0FarValue(Stab stab,AbSyn absyn,TForm type,AbSyn farValue,TForm *pFarType,
468 AbSynList *pFarAbSynList)
469{
470 AbEmbed embed;
471 if (DEBUG(tipFar)tipFarDebug) {
472 fprintf(dbOut, "Computing far value as a ");
473 tfPrint(dbOut, *pFarType);
474 fnewline(dbOut);
475 }
476 titdn(stab, farValue, *pFarType);
477
478 if (abState(farValue)((farValue)->abHdr.state) != AB_State_HasUnique)
479 return false((int) 0);
480
481 /*
482 * Check for `return value' in contexts where no
483 * value is expected and for `return' in contexts
484 * where a value _is_ expected.
485 */
486 if (abTag(absyn)((absyn)->abHdr.tag) == AB_Return)
487 {
488 Bool abnone = (abTag(farValue)((farValue)->abHdr.tag) == AB_Nothing);
489 Bool tfnone = tfIsNone(*pFarType)((((*pFarType)->tag) == TF_Multiple) && tfMultiArgc
(*pFarType) == 0)
;
490
491 if (abnone && !tfnone)
492 comsgError(absyn, ALDOR_E_TinReturnNoVal232);
493 else if (!abnone && tfnone)
494 comsgWarning(absyn, ALDOR_W_TinNoValReturn231);
495 }
496
497 *pFarAbSynList = listCons(AbSyn)(AbSyn_listPointer->Cons)(farValue, *pFarAbSynList);
498 if (tfIsUnknown(*pFarType)(((*pFarType)->tag) == TF_Unknown)) {
499 *pFarType = abTUnique(farValue)((farValue)->abHdr.type.unique);
500 if (DEBUG(tipFar)tipFarDebug) {
501 fprintf(dbOut, "Converting far value to a ");
502 tfPrint(dbOut, *pFarType);
503 fnewline(dbOut);
504 }
505 }
506
507 if (abTUnique(farValue)((farValue)->abHdr.type.unique)) {
508 embed = tfSatEmbedType(abTUnique(farValue)((farValue)->abHdr.type.unique), *pFarType);
509 if (!tfIsNone(*pFarType)((((*pFarType)->tag) == TF_Multiple) && tfMultiArgc
(*pFarType) == 0)
&& embed != AB_Embed_Identity(((AbEmbed) 1) << 0))
510 abAddTContext(farValue, embed);
511 }
512 /* Calling program must set abTUnique(absyn). */
513 return true1;
514}
515
516/****************************************************************************
517 *
518 * :: No Values: empty sequence, if w/o else, exit.
519 *
520 ***************************************************************************/
521
522/*
523 * This function tells the caller whether or not the void type
524 * () satisfies the type provided. As a side-effect, the absyn
525 * is given the void type if the type is satisfied otherwise the
526 * specified error message is generated.
527 */
528localstatic Bool
529titdn0NoValue(Stab stab, AbSyn absyn, TForm type, Msg msg)
530{
531 /*
532 * If the context requires a value of type () then
533 * this statement is type correct and has type ().
534 *
535 * We used to use tfSatValues(tfNone(), type) but
536 * this is useless because () satisfies any tuple
537 * type (it represents the empty tuple).
538 */
539 if (tfIsEmptyMulti(type)((((type)->tag) == TF_Multiple) && tfMultiArgc(type
) == 0)
)
540 {
541 /* Phew! The types match */
542 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfNone()tfMulti(0);
543 return true1;
544 }
545 else
546 {
547 /* Generate the required error message */
548 comsgError(absyn, msg);
549 return false((int) 0);
550 }
551}
552
553
554/****************************************************************************
555 *
556 * :: Id: x, +, 1
557 * X
558 ***************************************************************************/
559
560localstatic Bool
561titdnId(Stab stab, AbSyn absyn, TForm type)
562{
563 Syme syme = abSyme(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->syme :
0)
;
564
565 tipIdDEBUGif (!tipIdDebug) { } else afprintf(dbOut,"Entering titdnId\n");
566
567
568 /* If no meaning yet, find one */
569 if (syme == NULL((void*)0)) {
570 /*
571 * Use the default type if requested. This may be a
572 * source of bugs because we don't check conditions.
573 */
574 if (abUse(absyn)((absyn)->abHdr.use) == AB_Use_Default) {
575 TForm tf = tpossUnique(abTPoss(absyn)((absyn)->abHdr.type.poss));
576 syme = symeNewLexVar(absyn->abId.sym, tf, car(stab)((stab)->first));
577 }
578 else
579 syme = tiGetMeaning(stab, absyn, type);
580
581
582 /*
583 * Unfortunately we can't tell if tiGetMeaning() failed
584 * because there are no symbols of the correct type or
585 * whether there were some but the conditions were wrong.
586 */
587 if (syme == NULL((void*)0)) return false((int) 0);
588 }
589
590
591 /* Check lazy conditions */
592 if (!symeUseIdentifier(absyn, syme))
593 comsgError(absyn, ALDOR_E_TinNoMeaningForId156, symeString(syme)((((syme)->id))->str));
594
595
596 /* Check conditions imposed on local exports/constants */
597 if (symeIsExport(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Export)
|| symeIsLexConst(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_LexConst)
) {
598 Bool important = false((int) 0);
599
600
601 /*
602 * Some usages must be ignored: we don't want to
603 * complain that the redefinition of a conditional
604 * export (under a different condition) fails to
605 * satisfy the original condition!
606 */
607 switch (abUse(absyn)((absyn)->abHdr.use)) {
608 /* Ignore the following usages */
609 case AB_Use_Assign: /* Fall through */
610 case AB_Use_Declaration: /* Fall through */
611 case AB_Use_Define: /* Fall through */
612 case AB_Use_Elided: /* Fall through */
613 break;
614
615 /*
616 * All other usages are important:
617 * AB_Use_Type: conditional types are evil
618 * AB_Use_Value: normal usage
619 * AB_Use_RetValue: normal usage
620 * AB_Use_NoValue: don't really care
621 * AB_Use_Label: don't really care
622 * AB_Use_Default: rarely seen here
623 * AB_Use_Iterator: never seen here
624 * AB_Use_Except: not sure
625 * (unspecified): normal usage
626 */
627 default: important = true1; break;
628 }
629
630
631 /* If important, ensure that the condition is satisfied */
632 if (important) titdn0IdCondition(absyn, syme);
633 }
634
635
636 /* Give this leaf some meaning */
637 stabSetSyme(stab, absyn, syme, abCondKnown);
638 abTUnique(absyn)((absyn)->abHdr.type.unique) = symeType(syme);
639
640
641 /* We return success even if an error was raised */
642 return true1;
643}
644
645localstatic Bool
646titdn0IdCondition(AbSyn id, Syme syme)
647{
648 SImpl impl;
649 AbLogic cond;
650
651
652 /* If it has a default implementation let it go */
653 if (symeHasDefault(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) & (0x0080))
) return true1;
654
655
656 /* Check to see if there are any implementation details. */
657 impl = symeImpl(syme)((SImpl) (SYFI_SImpl < (8 * sizeof(int)) && !(((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_SImpl
))) ? (symeFieldInfo[SYFI_SImpl].def) : (((((syme)->kind ==
SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0)),
(syme))->locmask) & (1 << (SYFI_SImpl))) ? ((((
((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_SImpl
))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_SImpl)] : (symeFieldInfo
[SYFI_SImpl].def)) : symeGetFieldFn(syme,SYFI_SImpl)))
;
658
659
660 /* If there aren't any then there are no conditions. */
661 if (!impl) return true1;
662
663
664 /* At the moment we can only cope with simple conditions */
665 if (implTag(impl)((impl)->implGen.hdr.tag) != SIMPL_Cond) return true1;
666
667
668 /* Check the implementation condition */
669 cond = impl->implCond.cond;
670 if (ablogImplies(abCondKnown, cond)) return true1;
671
672
673 /* Report the error */
674 terrorIdCondition(symeType(syme), id, abCondKnown, cond);
675 return false((int) 0);
676}
677
678
679/****************************************************************************
680 *
681 * :: LitInteger: 32
682 * :: LitFloat: 4.0
683 * :: LitString: "hello"
684 * X
685 * !! This stuff could be made to go through ti...0Apply.
686 ***************************************************************************/
687
688localstatic Bool titdn0Literal (Symbol, Stab, AbSyn, TForm);
689
690/*
691 * Top down entry points.
692 */
693
694localstatic Bool
695titdnLitInteger(Stab stab, AbSyn absyn, TForm tform)
696{
697 return titdn0Literal(ssymTheInteger, stab, absyn, tform);
698}
699
700localstatic Bool
701titdnLitFloat(Stab stab, AbSyn absyn, TForm tform)
702{
703 return titdn0Literal(ssymTheFloat, stab, absyn, tform);
704}
705
706localstatic Bool
707titdnLitString(Stab stab, AbSyn absyn, TForm tform)
708{
709 return titdn0Literal(ssymTheString, stab, absyn, tform);
710}
711
712/*
713 * Functions which actually do the work.
714 */
715
716localstatic Bool
717titdn0Literal(Symbol sym, Stab stab, AbSyn absyn, TForm type)
718{
719 SatMask mask = tfSatBupMask(), result;
720 Syme syme = abSyme(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->syme :
0)
;
721 TForm retType = tfUnknown;
722
723 if (syme) {
724 assert(tfIsLitOpType(symeType(syme)))do { if (!(tfIsLitOpType(symeType(syme)))) _do_assert(("tfIsLitOpType(symeType(syme))"
),"ti_tdn.c",724); } while (0)
;
725 retType = tfMapRet(symeType(syme))tfFollowArg(symeType(syme), 1);
726 }
727 else {
728 SymeList ml0, ml, okSymes = listNil(Syme)((SymeList) 0);
729 int n;
730
731 ml0 = stabGetMeanings(stab, abCondKnown, sym);
732
733 for (n = 0, ml = ml0; ml; ml = cdr(ml)((ml)->rest)) {
734 TForm tf = symeType(car(ml)((ml)->first));
735
736 tfFollow(tf)((tf) = tfFollowFn(tf));
737 if (!tfIsLitOpType(tf)) continue;
738
739 result = tfSat(mask, tfMapRet(tf)tfFollowArg(tf, 1), type);
740 if (tfSatPending(result) && cdr(ml0)((ml0)->rest)) {
741 terrorApplyNotAnalyzed(absyn, absyn, tf);
742 return false((int) 0);
743 }
744 if (tfSatSucceed(result)) {
745 if (n)
746 okSymes= listCons(Syme)(Syme_listPointer->Cons)(syme, okSymes);
747
748 syme = car(ml)((ml)->first);
749 retType = tfMapRet(tf)tfFollowArg(tf, 1);
750 if (!symeUseIdentifier(absyn, syme))
751 comsgError(absyn,
752 ALDOR_E_TinNoMeaningForLit157,
753 symString(sym)((sym)->str),
754 absyn->abLitString.str);
755 n++;
756 }
757 }
758 if (n != 1) {
759 if (n) okSymes = listCons(Syme)(Syme_listPointer->Cons)(syme, okSymes);
760 terrorNotUniqueMeaning(ALDOR_E_TinNMeanings165,
761 absyn, okSymes, ml0,
762 abLeafStr(absyn)((absyn)->abGen.data.str), type);
763 listFree(Syme)(Syme_listPointer->Free)(okSymes);
764 return false((int) 0);
765 }
766 }
767
768 mask = tfSatTdnMask();
769 tfSat(mask, retType, type);
770
771 abTUnique(absyn)((absyn)->abHdr.type.unique) = retType;
772 stabSetSyme(stab, absyn, syme, abCondKnown);
773
774 return true1;
775}
776
777/***************************************************************************
778 *
779 * :: Comma: (a, b)
780 *
781 ***************************************************************************/
782
783localstatic Bool
784titdnComma(Stab stab, AbSyn absyn, TForm type)
785{
786 AbSyn *argv = abArgv(absyn)((absyn)->abGen.data.argv);
787 Length i, argc = abArgc(absyn)((absyn)->abHdr.argc);
788 Length n = 0;
789 TPoss tp = abTPoss(absyn)((absyn)->abHdr.type.poss);
790 TPossIterator it;
791 TForm rtype = NULL((void*)0);
792 AbEmbed embed;
793
794 if (abUse(absyn)((absyn)->abHdr.use) == AB_Use_Declaration ||
795 abUse(absyn)((absyn)->abHdr.use) == AB_Use_Default) {
796 for (i = 0; i < argc; i++)
797 titdn(stab, argv[i], tfUnknown);
798 rtype = type;
799 }
800 else {
801 for (tpossITER(it,tp)((it).possl = (tp ? (tp)->possl : ((void*)0))); tpossMORE(it)((it).possl); tpossSTEP(it)((it).possl = (((it).possl)->rest))) {
802 TForm tt = tpossELT(it)tpossELT_(&it);
803 if (tfSatReturn(tt, type)) {
804 n++;
805 rtype = tt;
806 }
807 }
808 if (n != 1) {
809 /* Note we haven't done titdn on descendents. */
810 terrorNotUniqueType(ALDOR_E_TinExprMeans164, absyn, type, tp);
811 return false((int) 0);
812 }
813 for (i = 0; i < argc; i++) {
814 TForm rti = tfMultiArgN(rtype,i)tfFollowArg(rtype, i);
815 if (tfIsTypeTuple(type)) rti = tfType;
816 titdn(stab, argv[i], rti);
817 }
818 embed = tfSatEmbedType(rtype, type);
819 if (!tfIsNone(type)((((type)->tag) == TF_Multiple) && tfMultiArgc(type
) == 0)
&& embed != AB_Embed_Identity(((AbEmbed) 1) << 0))
820 abAddTContext(absyn, embed);
821 }
822
823 abTUnique(absyn)((absyn)->abHdr.type.unique) = rtype;
824 return true1;
825}
826
827/****************************************************************************
828 *
829 * :: Apply: f(a, b, ...)
830 *
831 ***************************************************************************/
832
833localstatic Bool
834titdnApply(Stab stab, AbSyn absyn, TForm type)
835{
836 SatMask mask = tfSatBupMask();
837 AbSyn op = abApplyOp(absyn)((absyn)->abApply.op);
838 TPoss opTypes, nopTypes;
839 TPossIterator it;
840 Bool isImplicit = false((int) 0);
841 Length nopc, popc, parmc;
842 TForm nopt, popt, opType;
843 Bool result;
844 if (abState(op)((op)->abHdr.state) == AB_State_Error)
845 return false((int) 0);
846
847 nopc = 0; /* Number of non-pending matches */
848 popc = 0; /* Number of all possible matches */
849 nopt = tfUnknown; /* Non-pending op type */
850 popt = tfUnknown; /* Any possible op type */
851 opType = NULL((void*)0);
852
853 opTypes = abReferTPoss(op);
854 nopTypes = tpossEmpty();
855 if (abIsTheId(op, ssymJoin)(((op)->abHdr.tag == (AB_Id)) && ((op)->abId.sym
)==(ssymJoin))
&& tpossIsUnique(opTypes) &&
856 tfSatisfies(tfMapRet(tpossUnique(opTypes))tfFollowArg(tpossUnique(opTypes), 1), tfCategory))
857 return titdn0ApplyJoin(stab, absyn, type, op, abArgc(absyn)((absyn)->abHdr.argc), abApplyArgf);
858
859 /* At this point, the mapping is either in the implicit part,
860 * or in the operator position. Let's look at the operator
861 * first.
862 */
863 for (tpossITER(it, opTypes)((it).possl = (opTypes ? (opTypes)->possl : ((void*)0))); tpossMORE(it)((it).possl); tpossSTEP(it)((it).possl = (((it).possl)->rest))) {
864 TForm opType = tpossELT(it)tpossELT_(&it);
865 SatMask result;
866
867 opType = tfDefineeType(opType);
868 if (!tfIsAnyMap(opType)((((opType)->tag) == TF_Map) || (((opType)->tag) == TF_PackedMap
))
)
869 continue;
870
871 result = tfSatMap(mask, stab, opType, type, absyn, abApplyArgc(absyn)(((absyn)->abHdr.argc)-1), abApplyArgf);
872 if (tfSatSucceed(result)) {
873 if (!tfSatPending(result)) {
874 nopc += 1;
875 nopt = opType;
876 nopTypes = tpossAdd1(nopTypes, opType);
877 }
878 popc += 1;
879 popt = opType;
880 }
881 }
882 /* And now the implicit part */
883 if (abImplicit(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->implicit
: 0)
!= NULL((void*)0)) {
884 AbSyn implicitApply = abImplicit(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->implicit
: 0)
;
885 TPoss implicitOpTypes = abTPoss(implicitApply)((implicitApply)->abHdr.type.poss);
886 isImplicit = true1;
887 for (tpossITER(it, implicitOpTypes)((it).possl = (implicitOpTypes ? (implicitOpTypes)->possl :
((void*)0)))
; tpossMORE(it)((it).possl); tpossSTEP(it)((it).possl = (((it).possl)->rest))) {
888 TForm opType = tpossELT(it)tpossELT_(&it);
889 SatMask result;
890
891 opType = tfDefineeType(opType);
892 assert(tfIsAnyMap(opType))do { if (!(((((opType)->tag) == TF_Map) || (((opType)->
tag) == TF_PackedMap)))) _do_assert(("tfIsAnyMap(opType)"),"ti_tdn.c"
,892); } while (0)
;
893
894 result = tfSatMap(mask, stab, opType, type, absyn, abArgc(absyn)((absyn)->abHdr.argc), abArgf);
895 if (tfSatSucceed(result)) {
896 if (!tfSatPending(result)) {
897 nopc += 1;
898 nopt = opType;
899 nopTypes = tpossAdd1(nopTypes, opType);
900 }
901 popc += 1;
902 popt = opType;
903 }
904 }
905 }
906
907 if (popc == 1) {
908 /* We found one thing.. must be this one */
909 opType = popt;
910 result = true1;
911 }
912 else if (nopc == 1) {
913 /* We found one non-pending one, and possibly some others. Let's use it */
914 opType = nopt;
915 result = true1;
916 }
917 else if (nopc == 0 && popc > 0) {
918 /* All pending, and more than one of them. Error - not analyzed */
919 terrorApplyNotAnalyzed(absyn, op, popt);
920 result = false((int) 0);
921 }
922 else {
923 /* Anything else - error */
924 terrorApplyFType(absyn, type, nopTypes, op, stab, abApplyArgc(absyn)(((absyn)->abHdr.argc)-1), abApplyArgf);
925 result = false((int) 0);
926 }
927
928 tpossFree(opTypes);
929 tpossFree(nopTypes);
930
931 if (!result) return false((int) 0);
932
933 if (isImplicit) {
934 AbSyn imp = abImplicit(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->implicit
: 0)
;
935 int parmc;
936 titdn(stab, imp, opType);
937
938 parmc = tfMapHasDefaults(opType) ? tfMapArgc(opType) : abArgc(absyn)((absyn)->abHdr.argc);
939 abAddTContext(imp, tfMapMultiArgEmbed(opType, parmc));
940
941 mask = tfSatTdnMask();
942 result = tfSatMap(mask, stab, opType, type, absyn, abArgc(absyn)((absyn)->abHdr.argc), abArgf);
943 }
944 else {
945 int parmc;
946 abFree(abImplicit(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->implicit
: 0)
);
947 abSetImplicit(absyn, NULL((void*)0));
948 titdn(stab, op, opType);
949
950 parmc = tfMapHasDefaults(opType) ? tfMapArgc(opType) : abApplyArgc(absyn)(((absyn)->abHdr.argc)-1);
951 abAddTContext(op, tfMapMultiArgEmbed(opType, parmc));
952
953 mask = tfSatTdnMask();
954 result = tfSatMap(mask, stab, opType, type, absyn, abApplyArgc(absyn)(((absyn)->abHdr.argc)-1), abApplyArgf);
955 }
956 /* We return false rarely (eg titdn0FarValue failure). */
957 return tfSatSucceed(result);
958}
959
960
961
962/****************************************************************************
963 *
964 * :: Define: a == e
965 * X
966 ***************************************************************************/
967
968localstatic Bool
969titdnDefine(Stab stab, AbSyn absyn, TForm type)
970{
971 AbSyn lhs = absyn->abDefine.lhs;
972 AbSyn rhs = absyn->abDefine.rhs;
973 TForm rtype, ltype, idtype;
974 TPoss idtposs;
975
976 if (tfIsNone(type)((((type)->tag) == TF_Multiple) && tfMultiArgc(type
) == 0)
) type = tfUnknown;
977
978 idtype = tiDefineFilter(absyn, type);
979 idtposs = tiDefineTPoss(absyn);
980
981 rtype = tpossSelectSatisfier(idtposs, idtype);
982 if (!rtype) {
983 terrorNotUniqueType(ALDOR_E_TinDefnMeans161, absyn, idtype, idtposs);
984 return false((int) 0);
985 }
986
987 /* If the r.h. type satisfies the constraint, relax on the l.h. */
988 if (abState(lhs)((lhs)->abHdr.state) == AB_State_HasUnique &&
989 tfSatValues(abTUnique(lhs)((lhs)->abHdr.type.unique), rtype))
990 ltype = abTUnique(lhs)((lhs)->abHdr.type.unique);
991 else {
992 assert(abState(lhs) == AB_State_HasPoss)do { if (!(((lhs)->abHdr.state) == AB_State_HasPoss)) _do_assert
(("abState(lhs) == AB_State_HasPoss"),"ti_tdn.c",992); } while
(0)
;
993 if (tpossIsUnique(abTPoss(lhs)((lhs)->abHdr.type.poss)) &&
994 tfSatValues(tpossUnique(abTPoss(lhs)((lhs)->abHdr.type.poss)), rtype))
995 ltype = tpossUnique(abTPoss(lhs)((lhs)->abHdr.type.poss));
996 else
997 ltype = rtype;
998 }
999
1000 if (DEBUG(tipDefine)tipDefineDebug) {
1001 fprintf(dbOut, "************** Defining: ");
1002 abPrettyPrint(dbOut, lhs);
1003 fnewline(dbOut);
1004 }
1005
1006 titdn(stab, lhs, ltype);
1007 titdn(stab, rhs, rtype);
1008
1009 if (abTag(lhs)((lhs)->abHdr.tag) == AB_Declare) {
1010 rtype = tpossSelectSatisfier(abTPoss(absyn)((absyn)->abHdr.type.poss), type);
1011 if (!rtype) {
1012 terrorNotUniqueType(ALDOR_E_TinDefnMeans161, absyn,
1013 type, abTPoss(absyn)((absyn)->abHdr.type.poss));
1014 return false((int) 0);
1015 }
1016 }
1017
1018
1019 abTUnique(absyn)((absyn)->abHdr.type.unique) = rtype;
1020
1021 if (DEBUG(tipDefine)tipDefineDebug) {
1022 fprintf(dbOut,"Tdn: Define of ");
1023 abPrint(dbOut, lhs);
1024 fprintf(dbOut," has type ");
1025 tfPrint(dbOut, rtype);
1026 fnewline(dbOut);
1027 }
1028 return true1;
1029}
1030
1031/****************************************************************************
1032 *
1033 * :: Assign: a := e
1034 * X
1035 ***************************************************************************/
1036
1037/*!! To do: (v.i,v.j) := (v.j, v.i) */
1038
1039localstatic Bool
1040titdnAssign(Stab stab, AbSyn absyn, TForm type)
1041{
1042 AbSyn rhs = absyn->abAssign.rhs;
1043 AbSyn lhs = absyn->abAssign.lhs;
1044 TPoss abtposs = abTPoss(absyn)((absyn)->abHdr.type.poss);
1045 TForm rtype;
1046 AbEmbed embed;
1047
1048 if (tfIsNone(type)((((type)->tag) == TF_Multiple) && tfMultiArgc(type
) == 0)
) type = tfUnknown;
1049 rtype = tpossSelectSatisfier(abtposs, type);
1050 if (!rtype) {
1051 terrorNotUniqueType(ALDOR_E_TinAssMeans160, absyn, type, abtposs);
1052 return false((int) 0);
1053 }
1054
1055 if (abTag(lhs)((lhs)->abHdr.tag) == AB_Apply)
1056 return titdn0ApplySym(stab, absyn, rtype, ssymSetBang,
1057 abArgc(lhs)((lhs)->abHdr.argc) + 1, abSetArgf, lhs);
1058
1059 titdn(stab, rhs, rtype);
1060 titdn(stab, lhs, rtype);
1061 abTUnique(absyn)((absyn)->abHdr.type.unique) = rtype;
1062
1063 embed = tfSatEmbedType(abTUnique(rhs)((rhs)->abHdr.type.unique), rtype);
1064 if (!tfIsNone(rtype)((((rtype)->tag) == TF_Multiple) && tfMultiArgc(rtype
) == 0)
&& embed != AB_Embed_Identity(((AbEmbed) 1) << 0))
1065 abAddTContext(rhs, embed);
1066
1067
1068 if (DEBUG(tipAssign)tipAssignDebug) {
1069 fprintf(dbOut,"Tdn: Assignment to ");
1070 abPrint(dbOut, lhs);
1071 fprintf(dbOut," has type ");
1072 tfPrint(dbOut, rtype);
1073 fnewline(dbOut);
1074 }
1075 return true1;
1076}
1077
1078/****************************************************************************
1079 *
1080 * :: Declare: a: A
1081 *
1082 ***************************************************************************/
1083
1084localstatic Bool
1085titdnDeclare(Stab stab, AbSyn absyn, TForm type)
1086{
1087 AbSyn id = absyn->abDeclare.id;
1088 AbSyn idtype = absyn->abDeclare.type;
1089 TForm tf, rtype;
1090 Syme syme;
1091
1092 if (DEBUG(tipDeclare)tipDeclareDebug) {
1093 fprintf(dbOut, "In the declaration ");
1094 abPrettyPrint(dbOut, absyn);
1095 fprintf(dbOut, ", the semantics field is ");
1096 if (abTForm(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->tform :
0)
)
1097 tfPrint(dbOut, abTForm(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->tform :
0)
);
1098 else
1099 fprintf(dbOut, "_");
1100 fnewline(dbOut);
1101 }
1102
1103 if (abUse(absyn)((absyn)->abHdr.use) == AB_Use_Define || abUse(absyn)((absyn)->abHdr.use) == AB_Use_Assign)
1104 tf = (tfIsUnknown(type)(((type)->tag) == TF_Unknown) ? tiGetTForm(stab, idtype) : type);
1105 else
1106 tf = tiGetTForm(stab, idtype);
1107
1108 /* Prevent stabUseMeaning during titdn(stab, id, tf) */
1109 if (abUse(absyn)((absyn)->abHdr.use) != AB_Use_Assign) stabUseMeaningShadow(id);
1110
1111 syme = abSyme(id)((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0);
1112 if (syme && tfIsMulti(type)(((type)->tag) == TF_Multiple)) {
1113 comsgError(absyn, ALDOR_E_TinBadDeclare158);
1114 return false((int) 0);
1115 }
1116
1117 titdn(stab, id, tf);
1118 stabUseMeaningUnshadow();
1119
1120 /* idtype has been handled already. */
1121
1122 rtype = tpossSelectSatisfier(abTPoss(absyn)((absyn)->abHdr.type.poss), type);
1123 if (!rtype) rtype = tfUnknown;
1124 abTUnique(absyn)((absyn)->abHdr.type.unique) = rtype;
1125
1126 if (DEBUG(tipDeclare)tipDeclareDebug) {
1127 fprintf(dbOut,"Tdn: Declare of ");
1128 abPrint(dbOut, id);
1129 fprintf(dbOut," has type ");
1130 tfPrint(dbOut, rtype);
1131 fnewline(dbOut);
1132 }
1133 return true1;
1134}
1135
1136/****************************************************************************
1137 *
1138 * :: Label: @@ x @@ [e]
1139 *
1140 ***************************************************************************/
1141
1142localstatic Bool
1143titdnLabel(Stab stab, AbSyn absyn, TForm type)
1144{
1145 AbSyn expr = absyn->abLabel.expr;
1146
1147 if (titdn(stab, expr, type))
1148 abTUnique(absyn)((absyn)->abHdr.type.unique) = abTUnique(expr)((expr)->abHdr.type.unique);
1149 else
1150 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfUnknown;
1151
1152 return true1;
1153}
1154
1155/****************************************************************************
1156 *
1157 * :: Goto: goto id
1158 *
1159 ***************************************************************************/
1160
1161localstatic Bool
1162titdnGoto(Stab stab, AbSyn absyn, TForm type)
1163{
1164 AbSyn label = absyn->abGoto.label;
1165
1166 if (stabLabelExistsInThisStab(stab, abIdSym(label)((label)->abId.sym))) {
1167 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfExit;
1168 return true1;
1169 }
1170 else {
1171 AbSynList abl = stabGetLabels(stab, abIdSym(label)((label)->abId.sym));
1172 while (abl) {
1173 AbSyn label = car(abl)((abl)->first);
1174 Syme syme = label->abHdr.seman->syme;
1175 ULong labelLamLev = symeDefLambdaLevelNo(syme)(symeDefLevel(syme)->lambdaLevel);
1176 ULong labelLexLev = symeDefLevelNo(syme)(symeDefLevel(syme)->lexicalLevel);
1177 ULong gotoLamLev = stabLambdaLevelNo(stab)(((stab)->first)->lambdaLevel);
1178 ULong gotoLexLev = stabLevelNo(stab)(((stab)->first)->lexicalLevel);
1179
1180 if (labelLamLev == gotoLamLev && labelLexLev <= gotoLexLev) {
1181 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfExit;
1182 return true1;
1183 }
1184 abl = cdr(abl)((abl)->rest);
1185 }
1186
1187 comsgError(absyn->abGoto.label, ALDOR_E_TinFarGoto167);
1188 return false((int) 0);
1189 }
1190}
1191
1192/****************************************************************************
1193 *
1194 * :: Lambda: (a: A): B +-> b
1195 * :: PLambda: (a: A): B +->* b
1196 *
1197 ***************************************************************************/
1198
1199localstatic Bool
1200titdnLambda(Stab stab, AbSyn absyn, TForm type)
1201{
1202 Scope("titdnLambda")String scopeName = ("titdnLambda"); int fluidLevel0 = (scopeLevel
++, fluidLevel)
;
1203 AbSyn param = absyn->abLambda.param;
1204 AbSyn body = absyn->abLambda.body;
1205 AbSyn ret = absyn->abLambda.rtype;
1206 TPoss abtposs;
1207 TForm rtype;
1208 Bool result = true1;
1209
1210 TForm fluid(tuniReturnTForm)fluidSave_tuniReturnTForm = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniReturnTForm
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniReturnTForm
, fluidStack[fluidLevel].size = sizeof(tuniReturnTForm), fluidLevel
++, (tuniReturnTForm) )
;
1211 TForm fluid(tuniYieldTForm)fluidSave_tuniYieldTForm = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniYieldTForm
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniYieldTForm
, fluidStack[fluidLevel].size = sizeof(tuniYieldTForm), fluidLevel
++, (tuniYieldTForm) )
;
1212 TForm fluid(tuniExitTForm)fluidSave_tuniExitTForm = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniExitTForm
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniExitTForm
, fluidStack[fluidLevel].size = sizeof(tuniExitTForm), fluidLevel
++, (tuniExitTForm) )
;
1213 AbSynList fluid(abReturnsList)fluidSave_abReturnsList = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(abReturnsList
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_abReturnsList
, fluidStack[fluidLevel].size = sizeof(abReturnsList), fluidLevel
++, (abReturnsList) )
;
1214
1215 tuniReturnTForm = tfNone()tfMulti(0);
1216 tuniYieldTForm = tfNone()tfMulti(0);
1217 tuniExitTForm = tfNone()tfMulti(0);
1218 abReturnsList = listNil(AbSyn)((AbSynList) 0);
1219
1220 tuniReturnTForm = tfFullFrAbSyn(stab, ret);
1221
1222 titdn(stab, param, tfUnknown);
1223 titdn(stab, body, tuniReturnTForm);
1224
1225 abtposs = abTPoss(absyn)((absyn)->abHdr.type.poss);
1226 if (tiCheckLambdaType(type) || !tfIsAnyMap(type)((((type)->tag) == TF_Map) || (((type)->tag) == TF_PackedMap
))
)
1227 rtype = tpossSelectSatisfier(abtposs, type);
1228 else
1229 rtype = type;
1230
1231 if (!rtype) {
1232 terrorNotUniqueType(ALDOR_E_TinExprMeans164, absyn, type, abtposs);
1233 result = false((int) 0);
1234 }
1235
1236 else if (abHasTag(absyn, AB_PLambda)((absyn)->abHdr.tag == (AB_PLambda))) {
1237 Bool tres;
1238
1239 while (abTag(body)((body)->abHdr.tag) == AB_Label)
1240 body = body->abLabel.expr;
1241 abReturnsList = listCons(AbSyn)(AbSyn_listPointer->Cons)(body, abReturnsList);
1242 tres = titdn0PLambdaArgs(stab, param) &&
1243 titdn0PLambdaRets(stab, abReturnsList);
1244
1245 /* Return false if either result or tres are false */
1246 result = result ? tres : result;
1247 }
1248
1249 /* Only allowed to set abTUnique if successful */
1250 if (result) abTUnique(absyn)((absyn)->abHdr.type.unique) = rtype;
1251
1252 listFree(AbSyn)(AbSyn_listPointer->Free)(abReturnsList);
1253 Return(result){ fluidUnwind(fluidLevel0, ((int) 0)); return result;; };
1254}
1255
1256localstatic Bool
1257titdn0PLambdaArgs(Stab stab, AbSyn param)
1258{
1259 AbSyn *argv;
1260 Length i, argc;
1261 Bool result = true1;
1262
1263 switch (abTag(param)((param)->abHdr.tag)) {
1264 case AB_Nothing:
1265 argc = 0;
1266 argv = 0;
1267 break;
1268 case AB_Comma:
1269 argc = abArgc(param)((param)->abHdr.argc);
1270 argv = abArgv(param)((param)->abGen.data.argv);
1271 break;
1272 default:
1273 argc = 1;
1274 argv = &param;
1275 break;
1276 }
1277
1278 for (i = 0; result && i < argc; i += 1) {
1279 AbSyn argi = abDefineeId(argv[i]);
1280 assert(abState(argi) == AB_State_HasUnique)do { if (!(((argi)->abHdr.state) == AB_State_HasUnique)) _do_assert
(("abState(argi) == AB_State_HasUnique"),"ti_tdn.c",1280); } while
(0)
;
1281 result = tiRawToUnary(stab, argi, abTUnique(argi)((argi)->abHdr.type.unique));
1282 }
1283
1284 return result;
1285}
1286
1287localstatic Bool
1288titdn0PLambdaRets(Stab stab, AbSynList vals)
1289{
1290 Bool result = true1;
1291
1292 for (; result && vals; vals = cdr(vals)((vals)->rest)) {
1293 AbSyn val = car(vals)((vals)->first);
1294 assert(abState(val) == AB_State_HasUnique)do { if (!(((val)->abHdr.state) == AB_State_HasUnique)) _do_assert
(("abState(val) == AB_State_HasUnique"),"ti_tdn.c",1294); } while
(0)
;
1295 result = tiUnaryToRaw(stab, val, tfUnknown);
1296 }
1297
1298 return result;
1299}
1300
1301/****************************************************************************
1302 *
1303 * :: Sequence: (a; b; c)
1304 *
1305 ***************************************************************************/
1306
1307localstatic Bool
1308titdnSequence(Stab stab, AbSyn absyn, TForm type)
1309{
1310 Scope("titdnSequence")String scopeName = ("titdnSequence"); int fluidLevel0 = (scopeLevel
++, fluidLevel)
;
1311 TForm fluid(tuniExitTForm)fluidSave_tuniExitTForm = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniExitTForm
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniExitTForm
, fluidStack[fluidLevel].size = sizeof(tuniExitTForm), fluidLevel
++, (tuniExitTForm) )
;
1312 AbSynList fluid(abExitsList)fluidSave_abExitsList = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(abExitsList
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_abExitsList
, fluidStack[fluidLevel].size = sizeof(abExitsList), fluidLevel
++, (abExitsList) )
;
1313 AbSyn fluid(tuniTdnSelectObj)fluidSave_tuniTdnSelectObj = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniTdnSelectObj
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniTdnSelectObj
, fluidStack[fluidLevel].size = sizeof(tuniTdnSelectObj), fluidLevel
++, (tuniTdnSelectObj) )
;
1314 Bool result;
1315
1316 tuniExitTForm = type;
1317 abExitsList = listNil(AbSyn)((AbSynList) 0);
1318 tuniTdnSelectObj = NULL((void*)0);
1319
1320 result = titdnSequence0(stab, absyn, type);
1321
1322 Return(result){ fluidUnwind(fluidLevel0, ((int) 0)); return result;; };
1323}
1324
1325localstatic Bool
1326titdnSequence0(Stab stab, AbSyn absyn, TForm type)
1327{
1328 int i, n = abArgc(absyn)((absyn)->abHdr.argc);
1329 Bool result;
1330
1331 if (abState(absyn)((absyn)->abHdr.state) == AB_State_Error)
1332 abState(absyn)((absyn)->abHdr.state) = AB_State_HasPoss;
1333
1334 if (n == 0)
1335 result = titdn0NoValue(stab, absyn, type, ALDOR_E_TinContextSeq178);
1336 else
1337 {
1338 TForm none = tfNone()tfMulti(0);
1339
1340 for (i = 0; i < n-1; i++)
1341 titdn(stab, abArgv(absyn)((absyn)->abGen.data.argv)[i], none);
1342
1343 titdn0FarValue(stab,absyn, type, abArgv(absyn)((absyn)->abGen.data.argv)[n-1],
1344 &tuniExitTForm, &abExitsList);
1345
1346 if (abState(absyn)((absyn)->abHdr.state) == AB_State_Error) {
1347 terror(stab, absyn, type);
1348 result = false((int) 0);
1349 }
1350 else {
1351 abTUnique(absyn)((absyn)->abHdr.type.unique) = tuniExitTForm;
1352 result = true1;
1353 }
1354 }
1355 listFree(AbSyn)(AbSyn_listPointer->Free)(abExitsList);
1356
1357 return result;
1358}
1359
1360/****************************************************************************
1361 *
1362 * :: Exit: (...; b => x ; ...)
1363 *
1364 ***************************************************************************/
1365
1366localstatic Bool
1367titdnExit(Stab stab, AbSyn absyn, TForm type)
1368{
1369 AbSyn test = absyn->abExit.test;
1370 AbSyn value = absyn->abExit.value;
1371 AbLogic saveCond;
1372 Bool pushCond;
1373 titdn(stab, test, tfUnknown);
1374
1375 pushCond = !tuniTdnSelectObj && abIsSefo(test)(((test)->abHdr.state) == AB_State_HasUnique);
1376 if (pushCond) {
1377 /* See tibupExit for comments */
1378 AbSyn nTest = abExpandDefs(stab, test);
1379 ablogAndPush(&abCondKnown, &saveCond, nTest, true1);
1380 }
1381
1382 titdn0FarValue(stab, absyn, type, value, &tuniExitTForm, &abExitsList);
1383
1384 if (pushCond)
1385 ablogAndPop (&abCondKnown, &saveCond);
1386
1387 return titdn0NoValue(stab, absyn, type, ALDOR_E_TinContextExit175);
1388}
1389
1390/***************************************************************************
1391 *
1392 * :: return: return x, return;
1393 *
1394 ***************************************************************************/
1395
1396localstatic Bool
1397titdnReturn(Stab stab, AbSyn absyn, TForm type)
1398{
1399 titdn0FarValue(stab,absyn,type,absyn->abReturn.value,
1400 &tuniReturnTForm, &abReturnsList);
1401 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfExit;
1402 return true1;
1403}
1404
1405/****************************************************************************
1406 *
1407 * :: Generate: generate [N] of (... yield ...)
1408 *
1409 ***************************************************************************/
1410
1411localstatic Bool
1412titdnGenerate(Stab stab, AbSyn absyn, TForm type)
1413{
1414 Scope("titdnGenerate")String scopeName = ("titdnGenerate"); int fluidLevel0 = (scopeLevel
++, fluidLevel)
;
1415
1416 TForm fluid(tuniReturnTForm)fluidSave_tuniReturnTForm = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniReturnTForm
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniReturnTForm
, fluidStack[fluidLevel].size = sizeof(tuniReturnTForm), fluidLevel
++, (tuniReturnTForm) )
;
1417 TForm fluid(tuniYieldTForm)fluidSave_tuniYieldTForm = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniYieldTForm
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniYieldTForm
, fluidStack[fluidLevel].size = sizeof(tuniYieldTForm), fluidLevel
++, (tuniYieldTForm) )
;
1418 TForm fluid(tuniExitTForm)fluidSave_tuniExitTForm = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniExitTForm
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniExitTForm
, fluidStack[fluidLevel].size = sizeof(tuniExitTForm), fluidLevel
++, (tuniExitTForm) )
;
1419 AbSynList fluid(abYieldsList)fluidSave_abYieldsList = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(abYieldsList
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_abYieldsList
, fluidStack[fluidLevel].size = sizeof(abYieldsList), fluidLevel
++, (abYieldsList) )
;
1420 AbSyn body = absyn->abGenerate.body;
1421 AbSyn count = absyn->abGenerate.count;
1422 Bool result;
1423 TfGenType tfGenType;
1424
1425 tuniReturnTForm = tfNone()tfMulti(0);
1426 tuniYieldTForm = tfNone()tfMulti(0);
1427 tuniExitTForm = tfNone()tfMulti(0);
1428 abYieldsList = listNil(AbSyn)((AbSynList) 0);
1429
1430 tfGenType = abFlag_IsNewIter(absyn)(((absyn)->abHdr.flags) == AB_Flag_NewIter) ? TFG_XGenerator : TFG_Generator;
1431
1432 if (tfIsAnyGenerator(type))
1433 tuniYieldTForm = tfAnyGeneratorArg(type);
1434 else
1435 tuniYieldTForm = tfUnknown;
1436
1437 if (abTag(count)((count)->abHdr.tag) != KW_From) {
1438 titdn(stab, count, tfUnknown);
1439 }
1440 titdn(stab, body, tfNone()tfMulti(0));
1441
1442 if (abState(absyn)((absyn)->abHdr.state) == AB_State_Error) {
1443 /*
1444 * The problem must be in the body. We hope that
1445 * errors in the count expression will be handled
1446 * by someone else. The trouble is that this kind
1447 * of thinking caused bugs like #1144 which we are
1448 * trying to fix here ...
1449 *
1450 * Anyway, since we have fully analysed the body of
1451 * the generator, it probably has a unique type now.
1452 * If so we turn it into a tposs for terror().
1453 */
1454 if (abState(body)((body)->abHdr.state) == AB_State_HasUnique) {
1455 abState(body)((body)->abHdr.state) = AB_State_HasPoss;
1456 abTPoss(body)((body)->abHdr.type.poss) = tpossSingleton(abTUnique(body)((body)->abHdr.type.unique));
1457 }
1458
1459
1460 /*
1461 * If errors were detected then they will have been
1462 * reported by titdn and the unique type associated
1463 * with the body will satisfy the context of the
1464 * generator. This means that we won't repeat these
1465 * error messages when we call terror().
1466 *
1467 * If we didn't detect any errors when we dealt with
1468 * the body then this node must be bad because its
1469 * inferred type does not satisfy the context type.
1470 * Hopefully terror() will report the problem for us.
1471 */
1472 terror(stab, body, type);
1473 }
1474
1475 /* Were we successful? */
1476 result = (abState(absyn)((absyn)->abHdr.state) != AB_State_Error) ? true1 : false((int) 0);
1477
1478 /* Only allowed to set abTUnique if returning true */
1479 if (result) abTUnique(absyn)((absyn)->abHdr.type.unique) = tfAnyGenerator(tfGenType, tuniYieldTForm);
1480
1481 listFree(AbSyn)(AbSyn_listPointer->Free)(abYieldsList);
1482 Return(result){ fluidUnwind(fluidLevel0, ((int) 0)); return result;; };
1483}
1484
1485/***************************************************************************
1486 *
1487 * :: Yield: yield x
1488 *
1489 ***************************************************************************/
1490
1491localstatic Bool
1492titdnYield(Stab stab, AbSyn absyn, TForm type)
1493{
1494 titdn0FarValue(stab, absyn, type,
1495 absyn->abYield.value,
1496 &tuniYieldTForm,
1497 &abYieldsList);
1498 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfExit;
1499 return true1;
1500}
1501
1502/****************************************************************************
1503 *
1504 * :: Add: [D] add (a: A == ...)
1505 *
1506 ***************************************************************************/
1507
1508localstatic Bool
1509titdnAdd(Stab stab, AbSyn absyn, TForm type)
1510{
1511 AbSyn base = absyn->abAdd.base;
1512 AbSyn capsule = absyn->abAdd.capsule;
1513
1514 titdn(stab, base, tfUnknown); /* !! cd push Type */
1515 titdn(stab, capsule, tfUnknown);
1516
1517 /* !! Should infer type of body. */
1518 abTUnique(absyn)((absyn)->abHdr.type.unique) = type;
1519 return true1;
1520}
1521
1522/****************************************************************************
1523 *
1524 * :: With: [C] with (a: A; ...)
1525 *
1526 ***************************************************************************/
1527
1528localstatic Bool
1529titdnWith(Stab stab, AbSyn absyn, TForm type)
1530{
1531 TPoss abtposs = abTPoss(absyn)((absyn)->abHdr.type.poss);
1532 TForm rtype;
1533
1534 rtype = tpossSelectSatisfier(abtposs, type);
1535 if (!rtype) return false((int) 0);
1536
1537 abTUnique(absyn)((absyn)->abHdr.type.unique) = rtype;
1538 return true1;
1539}
1540
1541/****************************************************************************
1542 *
1543 * :: Where: e where d
1544 *
1545 ***************************************************************************/
1546
1547localstatic Bool
1548titdnWhere(Stab stab, AbSyn absyn, TForm type)
1549{
1550 TPoss abtposs = abTPoss(absyn)((absyn)->abHdr.type.poss);
1551 AbSyn context = absyn->abWhere.context;
1552 AbSyn expr = absyn->abWhere.expr;
1553
1554 titdn(stab, context, tfNone()tfMulti(0));
1555 titdn(stab, expr, type);
1556
1557 type = tpossSelectSatisfier(abtposs, type);
1558 if (!type) return false((int) 0);
1559
1560 abTUnique(absyn)((absyn)->abHdr.type.unique) = type;
1561 return true1;
1562}
1563
1564/****************************************************************************
1565 *
1566 * :: If: if b then t [else e]
1567 *
1568 ***************************************************************************/
1569
1570localstatic Bool
1571titdnIf(Stab stab, AbSyn absyn, TForm type)
1572{
1573 AbSyn test = absyn->abIf.test;
1574 AbSyn thenAlt = absyn->abIf.thenAlt;
1575 AbSyn elseAlt = absyn->abIf.elseAlt;
1576 AbSyn nTest = test;
1577 AbLogic saveCond;
1578
1579 TPoss abtposs = abTPoss(absyn)((absyn)->abHdr.type.poss);
1580 abtposs = tpossSatisfiesType(abtposs, type);
1581
1582 if (tpossCount(abtposs) > 1) {
1583 terrorNotUniqueType(ALDOR_E_TinIfMeans159, absyn, type, abtposs);
1584 return false((int) 0);
1585 }
1586
1587 /*
1588 * An unfixed compiler bug means that parts of Salli programs
1589 * tinfered with (tfBoolean == tfUnknown). We want to catch
1590 * this problem as soon as possible.
1591 */
1592 assert(tfBoolean != tfUnknown)do { if (!(tfBoolean != tfUnknown)) _do_assert(("tfBoolean != tfUnknown"
),"ti_tdn.c",1592); } while (0)
;
1593
1594
1595 /* This ought to do nothing since we tinfered test during tibup */
1596 titdn(stab, test, tfBoolean);
1597
1598
1599 if (tfIsCategoryContext(type, absyn))
1600 type = tpossUnique(abtposs);
1601 else /* Normalise the test for other contexts */
1602 nTest = abExpandDefs(stab, test);
1603
1604 if (abIsSefo(nTest)(((nTest)->abHdr.state) == AB_State_HasUnique)) {
1605 ablogAndPush(&abCondKnown, &saveCond, nTest, true1); /* test, true); */
1606 titdn(stab, thenAlt, type);
1607 ablogAndPop (&abCondKnown, &saveCond);
1608
1609 ablogAndPush(&abCondKnown, &saveCond, nTest, false((int) 0)); /* test, false); */
1610 titdn(stab, elseAlt, type);
1611 ablogAndPop (&abCondKnown, &saveCond);
1612 }
1613 else {
1614 titdn(stab, thenAlt, type);
1615 titdn(stab, elseAlt, type);
1616 }
1617
1618 /*
1619 * We can't use tpossUnique(abtposs) here because otherwise we
1620 * will end up performing embeddings on ourself in addition to
1621 * the same embeddings that we performed on the branches.
1622 */
1623 abTUnique(absyn)((absyn)->abHdr.type.unique) = type;
1624 return true1;
1625}
1626
1627/****************************************************************************
1628 *
1629 * :: Test: implied test
1630 *
1631 ***************************************************************************/
1632
1633AbSyn
1634titdnSelectArgf(AbSyn ab, Length i)
1635{
1636 if (i == 0)
1637 return tuniTdnSelectObj;
1638 else
1639 return abArgv(ab)((ab)->abGen.data.argv)[i - 1];
1640}
1641
1642localstatic Bool
1643titdnTest(Stab stab, AbSyn absyn, TForm type)
1644{
1645 /*
1646 * An unfixed compiler bug means that parts of Salli programs
1647 * tinfered with (tfBoolean == tfUnknown). We want to catch
1648 * this problem as soon as possible.
1649 */
1650 assert(tfBoolean != tfUnknown)do { if (!(tfBoolean != tfUnknown)) _do_assert(("tfBoolean != tfUnknown"
),"ti_tdn.c",1650); } while (0)
;
1651
1652 if (tuniTdnSelectObj != NULL((void*)0)) {
1653 titdn0ApplySym(stab, absyn,
1654 tfBoolean,
1655 ssymTheCase, 2,
1656 titdnSelectArgf, NULL((void*)0));
1657 }
1658 else {
1659 titdn0ApplySymIfNeeded(stab, absyn, tfBoolean,
1660 ssymTheTest, 1, abArgf, NULL((void*)0),
1661 tfIsBooleanFn);
1662 }
1663 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfBoolean;
1664 return true1;
1665}
1666
1667/***************************************************************************
1668 *
1669 * :: Collect: e <iter>*
1670 *
1671 ***************************************************************************/
1672
1673localstatic Bool
1674titdnCollect(Stab stab, AbSyn absyn, TForm type)
1675{
1676 Scope("titdnCollect")String scopeName = ("titdnCollect"); int fluidLevel0 = (scopeLevel
++, fluidLevel)
;
1677 AbSyn body = absyn->abCollect.body;
1678 AbSyn *iterv = absyn->abCollect.iterv;
1679 Length i, iterc = abCollectIterc(absyn)(((absyn)->abHdr.argc)-1);
1680 TForm rtype;
1681
1682 TForm fluid(tuniReturnTForm)fluidSave_tuniReturnTForm = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniReturnTForm
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniReturnTForm
, fluidStack[fluidLevel].size = sizeof(tuniReturnTForm), fluidLevel
++, (tuniReturnTForm) )
;
1683 TForm fluid(tuniYieldTForm)fluidSave_tuniYieldTForm = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniYieldTForm
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniYieldTForm
, fluidStack[fluidLevel].size = sizeof(tuniYieldTForm), fluidLevel
++, (tuniYieldTForm) )
;
1684 TForm fluid(tuniExitTForm)fluidSave_tuniExitTForm = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniExitTForm
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniExitTForm
, fluidStack[fluidLevel].size = sizeof(tuniExitTForm), fluidLevel
++, (tuniExitTForm) )
;
1685
1686 tuniReturnTForm = tfNone()tfMulti(0);
1687 tuniYieldTForm = tfNone()tfMulti(0);
1688 tuniExitTForm = tfNone()tfMulti(0);
1689
1690 for (i = 0; i < iterc; i++)
1691 titdn(stab, iterv[i], tfUnknown);
1692
1693 if (tfIsAnyGenerator(type))
1694 rtype = tfAnyGeneratorArg(type);
1695 else
1696 rtype = tfUnknown;
1697
1698 titdn(stab, body, rtype);
1699 abTUnique(absyn)((absyn)->abHdr.type.unique) = type;
1700
1701 {
1702 AbEmbed embed = tfSatEmbedType(abTUnique(body)((body)->abHdr.type.unique), rtype);
1703 if (!tfIsNone(rtype)((((rtype)->tag) == TF_Multiple) && tfMultiArgc(rtype
) == 0)
&& embed != AB_Embed_Identity(((AbEmbed) 1) << 0))
1704 abAddTContext(body, embed);
1705 }
1706
1707 Return(true){ fluidUnwind(fluidLevel0, ((int) 0)); return 1;; };
1708}
1709
1710/****************************************************************************
1711 *
1712 * :: Repeat: <iter>* repeat e
1713 *
1714 ***************************************************************************/
1715
1716localstatic Bool
1717titdnRepeat(Stab stab, AbSyn absyn, TForm type)
1718{
1719 AbSyn body = absyn->abRepeat.body;
1720 AbSyn *iterv = absyn->abRepeat.iterv;
1721 Length i, iterc = abRepeatIterc(absyn)(((absyn)->abHdr.argc)-1);
1722 Bool result;
1723
1724 for (i = 0; i < iterc; i++)
1725 titdn(stab, iterv[i], tfUnknown);
1726
1727 titdn(stab, body, tfNone()tfMulti(0));
1728 if (tfIsNone(tpossUnique(abTPoss(absyn)))((((tpossUnique(((absyn)->abHdr.type.poss)))->tag) == TF_Multiple
) && tfMultiArgc(tpossUnique(((absyn)->abHdr.type.
poss))) == 0)
)
1729 {
1730 result = titdn0NoValue(stab,absyn,type,ALDOR_E_TinContextRepeat177);
1731 }
1732 else
1733 {
1734 abTUnique(absyn)((absyn)->abHdr.type.unique) = type;
1735 result = true1;
1736 }
1737
1738 return result;
1739}
1740
1741/***************************************************************************
1742 *
1743 * :: Never
1744 * X
1745 ***************************************************************************/
1746
1747localstatic Bool
1748titdnNever(Stab stab, AbSyn absyn, TForm type)
1749{
1750 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfExit;
1751 return true1;
1752}
1753
1754/***************************************************************************
1755 *
1756 * :: Iterate
1757 * X
1758 ***************************************************************************/
1759
1760localstatic Bool
1761titdnIterate(Stab stab, AbSyn absyn, TForm type)
1762{
1763 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfExit;
1764 return true1;
1765}
1766
1767/***************************************************************************
1768 *
1769 * :: Break
1770 * X
1771 ***************************************************************************/
1772
1773localstatic Bool
1774titdnBreak(Stab stab, AbSyn absyn, TForm type)
1775{
1776 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfExit;
1777 return true1;
1778}
1779
1780/****************************************************************************
1781 *
1782 * :: While: while c
1783 *
1784 ***************************************************************************/
1785
1786localstatic Bool
1787titdnWhile(Stab stab, AbSyn absyn, TForm type)
1788{
1789 /*
1790 * An unfixed compiler bug means that parts of Salli programs
1791 * tinfered with (tfBoolean == tfUnknown). We want to catch
1792 * this problem as soon as possible.
1793 */
1794 assert(tfBoolean != tfUnknown)do { if (!(tfBoolean != tfUnknown)) _do_assert(("tfBoolean != tfUnknown"
),"ti_tdn.c",1794); } while (0)
;
1795
1796 return titdn0Generic(stab, absyn, tfBoolean);
1797}
1798
1799/***************************************************************************
1800 *
1801 * :: For: for x in l | c
1802 *
1803 ***************************************************************************/
1804
1805localstatic Bool
1806titdnFor(Stab stab, AbSyn absyn, TForm type)
1807{
1808 AbSyn lhs = absyn->abFor.lhs;
1809 AbSyn test = absyn->abFor.test;
1810 TForm twhole;
1811 Bool unique;
1812 unique = tfIsUnknown(type)(((type)->tag) == TF_Unknown) && tpossIsUnique(abTPoss(lhs)((lhs)->abHdr.type.poss));
1813 if (unique && abFlag_IsNewIter(absyn)(((absyn)->abHdr.flags) == AB_Flag_NewIter))
1814 twhole = tfXGenerator(tpossUnique(abTPoss(lhs)((lhs)->abHdr.type.poss)));
1815 else if (unique)
1816 twhole = tfGenerator(tpossUnique(abTPoss(lhs)((lhs)->abHdr.type.poss)));
1817 else
1818 twhole = type;
1819
1820 /*
1821 * Subtle note: the generator in a for-iterator lies
1822 * outside the scope level of the repeat. This means
1823 * that we have to use cdr(stab) whenever we tinfer
1824 * absyn->abFor.whole or via abForIterArgf().
1825 */
1826
1827 if (!abFlag_IsNewIter(absyn)(((absyn)->abHdr.flags) == AB_Flag_NewIter)) {
1828 titdn0ApplySymIfNeeded(cdr(stab)((stab)->rest), absyn, twhole,
1829 ssymTheGenerator, 1, abForIterArgf,
1830 NULL((void*)0), tfIsGeneratorFn);
1831 }
1832 else if (abFlag_IsNewIter(absyn)(((absyn)->abHdr.flags) == AB_Flag_NewIter)) {
1833 titdn0ApplySymIfNeeded(cdr(stab)((stab)->rest), absyn, twhole,
1834 ssymTheXGenerator, 1, abForIterArgf,
1835 NULL((void*)0), tfIsXGeneratorFn);
1836 }
1837
1838 /*
1839 * The for-variable and test lie within the scope
1840 * of the repeat clause.
1841 */
1842 titdn(stab, lhs, tfUnknown);
1843 titdn(stab, test, tfUnknown);
1844
1845 abTUnique(absyn)((absyn)->abHdr.type.unique) = twhole;
1846 return true1;
1847}
1848
1849/****************************************************************************
1850 *
1851 * :: Foreign: import ... from Foreign(...)
1852 *
1853 ***************************************************************************/
1854
1855localstatic Bool titdnForeignJava(Stab stab, AbSyn absyn);
1856localstatic Bool titdnForeignJavaDeclare(Stab stab, AbSyn decl);
1857
1858localstatic Bool
1859titdnForeignImport(Stab stab, AbSyn absyn, TForm type)
1860{
1861 ForeignOrigin forg = forgFrAbSyn(absyn->abForeignImport.origin);
1862 Bool ok;
1863 titdn(stab, absyn->abForeignImport.what, tfUnknown);
1864
1865 switch (forg->protocol) {
1866 case FOAM_Proto_Java:
1867 ok = titdnForeignJava(stab, absyn->abForeignImport.what);
1868 break;
1869 default:
1870 ok = true1;
1871 break;
1872 }
1873 if (!ok) {
1874 return false((int) 0);
1875 }
1876
1877 abTUnique(absyn)((absyn)->abHdr.type.unique) = type;
1878 return true1;
1879}
1880
1881localstatic Bool
1882titdnForeignJava(Stab stab, AbSyn what)
1883{
1884 AbSyn inner;
1885 int i;
1886 Bool ok;
1887
1888 switch (abTag(what)((what)->abHdr.tag)) {
1889 case AB_Sequence:
1890 ok = true1;
1891 for (i=0; i<abArgc(what)((what)->abHdr.argc); i++) {
1892 ok = ok && titdnForeignJava(stab, what->abSequence.argv[i]);
1893 }
1894 return ok;
1895 case AB_Declare:
1896 return titdnForeignJavaDeclare(stab, what);
1897 case AB_Id:
1898 return false((int) 0);
1899 default:
1900 return false((int) 0);
1901 }
1902 return true1;
1903}
1904
1905localstatic Bool
1906titdnForeignJavaDeclare(Stab stab, AbSyn decl)
1907{
1908 TForm tf;
1909 Syme syme;
1910 SymeList l;
1911 assert(abTag(decl) == AB_Declare)do { if (!(((decl)->abHdr.tag) == AB_Declare)) _do_assert(
("abTag(decl) == AB_Declare"),"ti_tdn.c",1911); } while (0)
;
1912
1913 syme = abSyme(decl->abDeclare.id)((decl->abDeclare.id)->abHdr.seman ? (decl->abDeclare
.id)->abHdr.seman->syme : 0)
;
1914 if (syme == NULL((void*)0))
1915 return true1; /* Error is elsewhere - not here */
1916 tf = symeType(syme);
1917
1918 l = tfGetCatExports(tf);
1919
1920 while (l != listNil(Syme)((SymeList) 0)) {
1921 ErrorSet errors;
1922 Syme syme = car(l)((l)->first);
1923 Bool bad;
1924 l = cdr(l)((l)->rest);
1925 errors = symeIsJavaExport(syme);
1926
1927 if (errorSetHasErrors(errors)) {
1928 /* This isn't the most efficient, but if the list has more than
1929 * a few elements something is badly wrong anyway */
1930 StringList tmp = errorSetErrors(errors);
1931 String s = strPrintf("%s: %s cannot be used as a java function:\n",
1932 symeString(syme)((((syme)->id))->str),
1933 abPretty(tfExpr(symeType(syme))tfToAbSyn(symeType(syme))));
1934 while (tmp != listNil(String)((StringList) 0)) {
1935 s = strNConcat(s, "\t");
1936 s = strNConcat(s, car(tmp)((tmp)->first));
1937 s = strNConcat(s, "\n");
1938 tmp = cdr(tmp)((tmp)->rest);
1939 }
1940 errorSetFree(errors);
1941 comsgError(decl, ALDOR_E_ExplicitMsg1, s);
1942
1943 abState(decl)((decl)->abHdr.state) = AB_State_Error;
1944 return false((int) 0);
1945 }
1946 errorSetFree(errors);
1947
1948 }
1949 return true1;
1950}
1951
1952/****************************************************************************
1953 *
1954 * :: export: export ... to D
1955 *
1956 ***************************************************************************/
1957
1958localstatic Bool
1959titdnForeignExport(Stab stab, AbSyn absyn, TForm type)
1960{
1961 AbSyn what = absyn->abForeignExport.what;
1962 AbSyn dest = absyn->abForeignExport.dest;
1963 ForeignOrigin forg = forgFrAbSyn(dest->abApply.argv[0]);
1964
1965 Bool success = titdn(stab, absyn->abForeignExport.what, tfUnknown);
1966 if (success && forg->protocol == FOAM_Proto_Java) {
1967 stabAddForeignExport(stab, tiGetTForm(stab, what), forg);
1968 }
1969 abTUnique(absyn)((absyn)->abHdr.type.unique) = type;
1970 return true1;
1971}
1972
1973/****************************************************************************
1974 *
1975 * :: Import: import ... from D
1976 *
1977 ***************************************************************************/
1978
1979
1980localstatic Bool
1981titdnImport(Stab stab, AbSyn absyn, TForm type)
1982{
1983 if (!tfSatReturn(tfNone()tfMulti(0), type)) {
1984 terrorNotUniqueType(ALDOR_E_TinExprMeans164,
1985 absyn, type, abTPoss(absyn)((absyn)->abHdr.type.poss));
1986 return false((int) 0);
1987 }
1988 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfNone()tfMulti(0);
1989 return true1;
1990}
1991
1992/****************************************************************************
1993 *
1994 * :: Inline: inline .. from D
1995 *
1996 ***************************************************************************/
1997
1998localstatic Bool
1999titdnInline(Stab stab, AbSyn absyn, TForm type)
2000{
2001 if (!tfSatReturn(tfNone()tfMulti(0), type)) {
2002 terrorNotUniqueType(ALDOR_E_TinExprMeans164,
2003 absyn, type, abTPoss(absyn)((absyn)->abHdr.type.poss));
2004 return false((int) 0);
2005 }
2006 abTUnique(absyn)((absyn)->abHdr.type.unique) = type;
2007 return true1;
2008}
2009
2010/****************************************************************************
2011 *
2012 * :: Qualify: A $ B
2013 *
2014 * ToDo: 3$Integer
2015 *
2016 ***************************************************************************/
2017
2018localstatic Bool
2019titdnQualify(Stab stab, AbSyn absyn, TForm type)
2020{
2021 AbSyn origin = absyn->abQualify.origin;
2022 AbSyn what = absyn->abQualify.what;
2023 Symbol sym = what->abId.sym;
2024
2025 TForm tforg;
2026 SymeList symes, msymes, fsymes, allSymes, okSymes;
2027 Syme syme, osyme;
2028
2029 tforg = tiGetTForm(stab, origin);
2030
2031 if (tfIsForeign(tforg)((((((tforg)->tag) == TF_General) && ((((tforg)->
__absyn))->abHdr.tag) == AB_Id) && (((tforg)->__absyn
)->abId.sym) == (ssymForeign)) || (((((tforg)->tag) == TF_General
) && ((((tforg)->__absyn))->abHdr.tag) == AB_Apply
) && (((tforg)->__absyn)->abApply.op)->abId.
sym == ssymForeign))
) {
2032 msymes = stabGetMeanings(stab, abCondKnown, what->abId.sym);
2033 symes = listNil(Syme)((SymeList) 0);
2034
2035 for ( ; msymes; msymes = cdr(msymes)((msymes)->rest))
2036 if (symeId(car(msymes))((((msymes)->first))->id) == sym && symeIsForeign(car(msymes))(((((((msymes)->first))->kind == SYME_Trigger ? libGetAllSymes
((((msymes)->first))->lib) : ((void*)0)), (((msymes)->
first)))->kind) == SYME_Foreign)
)
2037 symes = listCons(Syme)(Syme_listPointer->Cons)(car(msymes)((msymes)->first), symes);
2038 fsymes = symes;
2039 }
2040 else if (tfIsSelf(tforg)(((((tforg)->tag) == TF_General) && ((((tforg)->
__absyn))->abHdr.tag) == AB_Id) && (((tforg)->__absyn
)->abId.sym) == (ssymSelf))
) {
2041 /*symes = tfGetDomImports(tforg);*/
2042 symes = listNil(Syme)((SymeList) 0);
2043 fsymes = listNil(Syme)((SymeList) 0);
2044
2045 if (symes == listNil(Syme)((SymeList) 0)) {
2046 msymes = stabGetMeanings(stab, abCondKnown, what->abId.sym);
2047 for ( ; msymes; msymes = cdr(msymes)((msymes)->rest))
2048 if (symeId(car(msymes))((((msymes)->first))->id) == sym && symeIsExport(car(msymes))(((((((msymes)->first))->kind == SYME_Trigger ? libGetAllSymes
((((msymes)->first))->lib) : ((void*)0)), (((msymes)->
first)))->kind) == SYME_Export)
)
2049 symes = listCons(Syme)(Syme_listPointer->Cons)(car(msymes)((msymes)->first),
2050 symes);
2051 fsymes = symes;
2052 }
2053 }
2054 else {
2055 symes = listNil(Syme)((SymeList) 0);
2056 msymes = tfGetDomImportsByName(tforg, sym);
2057 for ( ; msymes; msymes = cdr(msymes)((msymes)->rest)) {
2058 assert(symeId(car(msymes)) == sym)do { if (!(((((msymes)->first))->id) == sym)) _do_assert
(("symeId(car(msymes)) == sym"),"ti_tdn.c",2058); } while (0)
;
2059 if (ablogIsListKnown(symeCondition(car(msymes)((msymes)->first))))
2060 symes = listCons(Syme)(Syme_listPointer->Cons)(car(msymes)((msymes)->first), symes);
2061 }
2062 fsymes = symes;
2063 }
2064
2065 allSymes = symes;
2066 okSymes = listNil(Syme)((SymeList) 0);
2067 syme = NULL((void*)0);
2068
2069 for (symes = allSymes; symes; symes = cdr(symes)((symes)->rest)) {
2070 syme = car(symes)((symes)->first);
2071
2072 if (symeId(syme)((syme)->id) == sym
2073 && tfSatReturn(symeType(syme), type)) {
2074 osyme = symeListHasExtendee(okSymes, syme);
2075 if (osyme) {
2076 symeSetExtension(osyme, syme)symeXSetExtension(osyme, (AInt) syme);
2077 okSymes = symeListExtend(okSymes, syme);
2078 continue;
2079 }
2080
2081 osyme = symeListHasExtension(okSymes, syme);
2082 if (osyme) continue;
2083 if (tiMergeSyme(syme, okSymes))
2084 okSymes = listCons(Syme)(Syme_listPointer->Cons)(syme, okSymes);
2085 }
2086 }
2087
2088 if (okSymes == NULL((void*)0) || cdr(okSymes)((okSymes)->rest) != NULL((void*)0)) {
2089 terrorNotUniqueMeaning(ALDOR_E_TinNMeanings165, absyn, okSymes,
2090 allSymes, symString(sym)((sym)->str), type);
2091 listFree(Syme)(Syme_listPointer->Free)(okSymes);
2092 listFree(Syme)(Syme_listPointer->Free)(fsymes);
2093 return false((int) 0);
2094 }
2095
2096 syme = car(okSymes)((okSymes)->first);
2097 listFree(Syme)(Syme_listPointer->Free)(okSymes);
2098 listFree(Syme)(Syme_listPointer->Free)(fsymes);
2099
2100 if (abState(what)((what)->abHdr.state) == AB_State_HasPoss)
2101 tpossFree(abTPoss(what)((what)->abHdr.type.poss));
2102
2103 stabSetSyme(stab, what, syme, abCondKnown);
2104 stabSetSyme(stab, absyn, syme, abCondKnown);
2105 abTUnique(what)((what)->abHdr.type.unique) = symeType(syme);
2106 abTUnique(absyn)((absyn)->abHdr.type.unique) = symeType(syme);
2107 abState(what)((what)->abHdr.state) = AB_State_HasUnique;
2108 return true1;
2109}
2110
2111/***************************************************************************
2112 *
2113 * :: CoerceTo: x :: T
2114 *
2115 ***************************************************************************/
2116
2117localstatic Bool
2118titdnCoerceTo(Stab stab, AbSyn absyn, TForm type)
2119{
2120 TForm tf = tiGetTForm(stab, absyn->abCoerceTo.type);
2121
2122 if (!tfSatReturn(tf, type)) {
2123 terrorNotUniqueType(ALDOR_E_TinExprMeans164,
2124 absyn, type, abTPoss(absyn)((absyn)->abHdr.type.poss));
2125 return false((int) 0);
2126 }
2127 titdn0ApplySym(stab, absyn, tf, ssymCoerce, 1, abArgf, NULL((void*)0));
2128 abTUnique(absyn)((absyn)->abHdr.type.unique) = tf;
2129 return true1;
2130}
2131
2132/****************************************************************************
2133 *
2134 * :: RestrictTo: A @ B
2135 *
2136 ***************************************************************************/
2137
2138
2139localstatic Bool
2140titdnRestrictTo(Stab stab, AbSyn absyn, TForm type)
2141{
2142 TForm tf = tiGetTForm(stab, absyn->abRestrictTo.type);
2143
2144 if (!tfSatReturn(tf, type)) {
2145 terrorNotUniqueType(ALDOR_E_TinExprMeans164,
2146 absyn, type, abTPoss(absyn)((absyn)->abHdr.type.poss));
2147 return false((int) 0);
2148 }
2149 titdn(stab, absyn->abRestrictTo.expr, tf);
2150 abTUnique(absyn)((absyn)->abHdr.type.unique) = tf;
2151 return true1;
2152}
2153
2154
2155/****************************************************************************
2156 *
2157 * :: PretendTo: A pretend B
2158 *
2159 ***************************************************************************/
2160
2161localstatic Bool
2162titdnPretendTo(Stab stab, AbSyn absyn, TForm type)
2163{
2164 TForm tf = tiGetTForm(stab, absyn->abPretendTo.type);
2165
2166 if (!tfSatReturn(tf, type)) {
2167 terrorNotUniqueType(ALDOR_E_TinExprMeans164,
2168 absyn, type, abTPoss(absyn)((absyn)->abHdr.type.poss));
2169 return false((int) 0);
2170 }
2171 titdn(stab, absyn->abPretendTo.expr, tfUnknown);
2172 if (!tfIsMulti(type)(((type)->tag) == TF_Multiple) && tfIsMulti(abTUnique(absyn->abPretendTo.expr))(((((absyn->abPretendTo.expr)->abHdr.type.unique))->
tag) == TF_Multiple)
) {
2173 abSetTContext(absyn->abPretendTo.expr, AB_Embed_MultiToCross(((AbEmbed) 1) << 5));
2174 }
2175
2176 abTUnique(absyn)((absyn)->abHdr.type.unique) = tf;
2177 return true1;
2178}
2179
2180/***************************************************************************
2181 *
2182 * :: Not: not a
2183 *
2184 ***************************************************************************/
2185
2186localstatic Bool
2187titdnNot(Stab stab, AbSyn absyn, TForm type)
2188{
2189 /*
2190 * An unfixed compiler bug means that parts of Salli programs
2191 * tinfered with (tfBoolean == tfUnknown). We want to catch
2192 * this problem as soon as possible.
2193 */
2194 assert(tfBoolean != tfUnknown)do { if (!(tfBoolean != tfUnknown)) _do_assert(("tfBoolean != tfUnknown"
),"ti_tdn.c",2194); } while (0)
;
2195
2196 if (!tfSatReturn(tfBoolean, type)) {
2197 terrorNotUniqueType(ALDOR_E_TinExprMeans164,
2198 absyn, type, abTPoss(absyn)((absyn)->abHdr.type.poss));
2199 return false((int) 0);
2200 }
2201 titdn(stab, absyn->abNot.expr, tfBoolean);
2202 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfBoolean;
2203 return true1;
2204}
2205
2206/***************************************************************************
2207 *
2208 * :: And: a and b and c ...
2209 *
2210 ***************************************************************************/
2211
2212localstatic Bool
2213titdnAnd(Stab stab, AbSyn absyn, TForm type)
2214{
2215 int i;
2216 int argc = abArgc(absyn)((absyn)->abHdr.argc);
2217 AbLogic *saveCond = (AbLogic*) stoAlloc(OB_Other0, sizeof(AbLogic) * argc);
2218
2219 /*
2220 * An unfixed compiler bug means that parts of Salli programs
2221 * tinfered with (tfBoolean == tfUnknown). We want to catch
2222 * this problem as soon as possible.
2223 */
2224 assert(tfBoolean != tfUnknown)do { if (!(tfBoolean != tfUnknown)) _do_assert(("tfBoolean != tfUnknown"
),"ti_tdn.c",2224); } while (0)
;
2225
2226 if (!tfSatReturn(tfBoolean, type)) {
2227 terrorNotUniqueType(ALDOR_E_TinExprMeans164,
2228 absyn, type, abTPoss(absyn)((absyn)->abHdr.type.poss));
2229 return false((int) 0);
2230 }
2231
2232 for (i = 0; i < argc; i++) {
2233 titdn(stab, abArgv(absyn)((absyn)->abGen.data.argv)[i], tfBoolean);
2234 ablogAndPush(&abCondKnown, &saveCond[i], abArgv(absyn)((absyn)->abGen.data.argv)[i], true1);
2235 }
2236 for (i = 0; i < argc; i++) {
2237 ablogAndPop(&abCondKnown, &saveCond[argc-i-1]);
2238 }
2239 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfBoolean;
2240 stoFree(saveCond);
2241 return true1;
2242}
2243
2244/***************************************************************************
2245 *
2246 * :: Or: a or b or c ...
2247 *
2248 ***************************************************************************/
2249
2250
2251localstatic Bool
2252titdnOr(Stab stab, AbSyn absyn, TForm type)
2253{
2254 int i;
2255
2256 /*
2257 * An unfixed compiler bug means that parts of Salli programs
2258 * tinfered with (tfBoolean == tfUnknown). We want to catch
2259 * this problem as soon as possible.
2260 */
2261 assert(tfBoolean != tfUnknown)do { if (!(tfBoolean != tfUnknown)) _do_assert(("tfBoolean != tfUnknown"
),"ti_tdn.c",2261); } while (0)
;
2262
2263 if (!tfSatReturn(tfBoolean, type)) {
2264 terrorNotUniqueType(ALDOR_E_TinExprMeans164,
2265 absyn, type, abTPoss(absyn)((absyn)->abHdr.type.poss));
2266 return false((int) 0);
2267 }
2268 for (i = 0; i < abArgc(absyn)((absyn)->abHdr.argc); i++)
2269 titdn(stab, abArgv(absyn)((absyn)->abGen.data.argv)[i], tfBoolean);
2270 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfBoolean;
2271 return true1;
2272}
2273
2274/***************************************************************************
2275 *
2276 * :: Assert:
2277 *
2278 ***************************************************************************/
2279
2280localstatic Bool
2281titdnAssert(Stab stab, AbSyn absyn, TForm type)
2282{
2283 Bool ok;
2284
2285 /* Ensure that the context requires no value */
2286 ok = titdn0NoValue(stab, absyn, type, ALDOR_E_TinContextAssert173);
2287
2288 /*
2289 * An unfixed compiler bug means that parts of Salli programs
2290 * tinfered with (tfBoolean == tfUnknown). We want to catch
2291 * this problem as soon as possible.
2292 */
2293 assert(!ok || (tfBoolean != tfUnknown))do { if (!(!ok || (tfBoolean != tfUnknown))) _do_assert(("!ok || (tfBoolean != tfUnknown)"
),"ti_tdn.c",2293); } while (0)
;
2294
2295 if (ok) titdn(stab, absyn->abAssert.test, tfBoolean);
2296 return ok;
2297}
2298
2299/***************************************************************************
2300 *
2301 * :: Blank:
2302 *
2303 ***************************************************************************/
2304
2305localstatic Bool
2306titdnBlank(Stab stab, AbSyn absyn, TForm type)
2307{
2308 return titdn0Generic(stab, absyn, type);
2309}
2310
2311/***************************************************************************
2312 *
2313 * :: Builtin:
2314 *
2315 ***************************************************************************/
2316
2317localstatic Bool
2318titdnBuiltin(Stab stab, AbSyn absyn, TForm type)
2319{
2320 return titdn0Generic(stab, absyn, type);
2321}
2322
2323/***************************************************************************
2324 *
2325 * :: Default:
2326 *
2327 ***************************************************************************/
2328
2329localstatic Bool
2330titdnDefault(Stab stab, AbSyn absyn, TForm type)
2331{
2332 TPoss abtposs = abTPoss(absyn)((absyn)->abHdr.type.poss);
2333 TForm rtype;
2334
2335 rtype = tpossSelectSatisfier(abtposs, type);
2336 if (!rtype) return false((int) 0);
2337
2338 abTUnique(absyn)((absyn)->abHdr.type.unique) = rtype;
2339 return true1;
2340}
2341
2342/***************************************************************************
2343 *
2344 * :: Delay:
2345 *
2346 ***************************************************************************/
2347
2348localstatic Bool
2349titdnDelay(Stab stab, AbSyn absyn, TForm type)
2350{
2351 return titdn0Generic(stab, absyn, type);
2352}
2353
2354/***************************************************************************
2355 *
2356 * :: Do:
2357 *
2358 ***************************************************************************/
2359
2360localstatic Bool
2361titdnDo(Stab stab, AbSyn absyn, TForm type)
2362{
2363 Bool ok;
2364
2365 /* Ensure that the context requires no value */
2366 ok = titdn0NoValue(stab, absyn, type, ALDOR_E_TinContextDo174);
Value stored to 'ok' is never read
2367 return titdn0Generic(stab, absyn, tfNone()tfMulti(0));
2368}
2369
2370/***************************************************************************
2371 *
2372 * :: Except:
2373 *
2374 ***************************************************************************/
2375
2376localstatic Bool
2377titdnExcept(Stab stab, AbSyn absyn, TForm type)
2378{
2379 titdn(stab, absyn->abExcept.except, tfTuple(tfCategory));
2380 if (!titdn(stab, absyn->abExcept.type, type))
2381 return false((int) 0);
2382 if (abState(absyn->abExcept.type)((absyn->abExcept.type)->abHdr.state) != AB_State_HasUnique)
2383 return false((int) 0);
2384 abTUnique(absyn)((absyn)->abHdr.type.unique) = abTUnique(absyn->abExcept.type)((absyn->abExcept.type)->abHdr.type.unique);
2385 return true1;
2386}
2387
2388/***************************************************************************
2389 *
2390 * :: Raise:
2391 *
2392 ***************************************************************************/
2393
2394localstatic Bool
2395titdnRaise(Stab stab, AbSyn absyn, TForm type)
2396{
2397 TForm tf;
2398 Sefo sef;
2399 titdn(stab, absyn->abRaise.expr, tfDomain);
2400 tf = tiGetTForm(stab, absyn->abRaise.expr);
2401 sef = tfGetExpr(tf)((tf)->__absyn);
2402 assert(sef)do { if (!(sef)) _do_assert(("sef"),"ti_tdn.c",2402); } while
(0)
;
2403 tf = tfExcept(tfExit, abGetCategory(sef));
2404 if (!tfSatReturn(tf, type)) {
2405 /* !!This is the _wrong_ routine to call */
2406 terrorNotUniqueType(ALDOR_E_TinExprMeans164, absyn, type,
2407 tpossSingleton(tf));
2408 return false((int) 0);
2409 }
2410 abTUnique(absyn)((absyn)->abHdr.type.unique) = tf;
2411 return true1;
2412}
2413
2414/***************************************************************************
2415 *
2416 * :: Export:
2417 *
2418 ***************************************************************************/
2419
2420localstatic Bool
2421titdnExport(Stab stab, AbSyn absyn, TForm type)
2422{
2423 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfNone()tfMulti(0);
2424 return true1;
2425}
2426
2427/***************************************************************************
2428 *
2429 * :: Extend:
2430 *
2431 ***************************************************************************/
2432
2433localstatic Bool
2434titdnExtend(Stab stab, AbSyn absyn, TForm type)
2435{
2436 return titdn0Generic(stab, absyn, type);
2437}
2438
2439/***************************************************************************
2440 *
2441 * :: Fix:
2442 *
2443 ***************************************************************************/
2444
2445localstatic Bool
2446titdnFix(Stab stab, AbSyn absyn, TForm type)
2447{
2448 return titdn0Generic(stab, absyn, type);
2449}
2450
2451/***************************************************************************
2452 *
2453 * :: Fluid:
2454 *
2455 ***************************************************************************/
2456
2457localstatic Bool
2458titdnFluid(Stab stab, AbSyn absyn, TForm type)
2459{
2460 return titdn0Generic(stab, absyn, type);
2461}
2462
2463/***************************************************************************
2464 *
2465 * :: Free:
2466 *
2467 ***************************************************************************/
2468
2469localstatic Bool
2470titdnFree(Stab stab, AbSyn absyn, TForm type)
2471{
2472 return titdn0Generic(stab, absyn, type);
2473}
2474
2475/***************************************************************************
2476 *
2477 * :: Has:
2478 *
2479 ***************************************************************************/
2480
2481localstatic Bool
2482titdnHas(Stab stab, AbSyn absyn, TForm type)
2483{
2484 return titdn0Generic(stab, absyn, type);
2485}
2486
2487/***************************************************************************
2488 *
2489 * :: Hide:
2490 *
2491 ***************************************************************************/
2492
2493localstatic Bool
2494titdnHide(Stab stab, AbSyn absyn, TForm type)
2495{
2496 return titdn0Generic(stab, absyn, type);
2497}
2498
2499/***************************************************************************
2500 *
2501 * :: IdSy:
2502 *
2503 ***************************************************************************/
2504
2505localstatic Bool
2506titdnIdSy(Stab stab, AbSyn absyn, TForm type)
2507{
2508 return titdn0Generic(stab, absyn, type);
2509}
2510
2511/***************************************************************************
2512 *
2513 * :: Local:
2514 *
2515 ***************************************************************************/
2516
2517localstatic Bool
2518titdnLocal(Stab stab, AbSyn absyn, TForm type)
2519{
2520 return titdn0Generic(stab, absyn, type);
2521}
2522
2523/***************************************************************************
2524 *
2525 * :: Macro:
2526 *
2527 ***************************************************************************/
2528
2529localstatic Bool
2530titdnMacro(Stab stab, AbSyn absyn, TForm type)
2531{
2532 return titdn0Generic(stab, absyn, type);
2533}
2534
2535/***************************************************************************
2536 *
2537 * :: MLambda:
2538 *
2539 ***************************************************************************/
2540
2541localstatic Bool
2542titdnMLambda(Stab stab, AbSyn absyn, TForm type)
2543{
2544 return titdn0Generic(stab, absyn, type);
2545}
2546
2547/***************************************************************************
2548 *
2549 * :: Nothing:
2550 *
2551 ***************************************************************************/
2552
2553localstatic Bool
2554titdnNothing(Stab stab, AbSyn absyn, TForm type)
2555{
2556 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfNone()tfMulti(0);
2557 return true1;
2558}
2559
2560/***************************************************************************
2561 *
2562 * :: Quote:
2563 *
2564 ***************************************************************************/
2565
2566localstatic Bool
2567titdnQuote(Stab stab, AbSyn absyn, TForm type)
2568{
2569 return titdn0Generic(stab, absyn, type);
2570}
2571
2572/***************************************************************************
2573 *
2574 * :: Reference: ref id
2575 *
2576 ***************************************************************************/
2577
2578localstatic Bool
2579titdnReference(Stab stab, AbSyn absyn, TForm type)
2580{
2581 AbSyn body = absyn -> abReference.body;
2582 TForm inner;
2583
2584
2585 /* What is the argument to the reference? */
2586 if (tfIsReference(type)(((type)->tag) == TF_Reference))
2587 inner = tfReferenceArg(type)tfFollowArg(type, 0);
2588 else
2589 inner = tfUnknown;
2590
2591
2592 /* Continue type inference to the leaves */
2593 titdn(stab, body, tfUnknown);
2594
2595
2596 /* Return now if an error has occurred */
2597 if (abState(absyn)((absyn)->abHdr.state) == AB_State_Error) return false((int) 0);
2598
2599
2600 /* Fix our type */
2601 abTUnique(absyn)((absyn)->abHdr.type.unique) = tfReference(inner);
2602 return true1;
2603}
2604
2605/***************************************************************************
2606 *
2607 * :: Select:
2608 *
2609 ***************************************************************************/
2610
2611localstatic Bool
2612titdnSelect(Stab stab, AbSyn absyn, TForm type)
2613{
2614 Scope("titdnSelect")String scopeName = ("titdnSelect"); int fluidLevel0 = (scopeLevel
++, fluidLevel)
;
2615 TForm fluid(tuniExitTForm)fluidSave_tuniExitTForm = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniExitTForm
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniExitTForm
, fluidStack[fluidLevel].size = sizeof(tuniExitTForm), fluidLevel
++, (tuniExitTForm) )
;
2616 AbSynList fluid(abExitsList)fluidSave_abExitsList = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(abExitsList
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_abExitsList
, fluidStack[fluidLevel].size = sizeof(abExitsList), fluidLevel
++, (abExitsList) )
;
2617 AbSyn fluid(tuniTdnSelectObj)fluidSave_tuniTdnSelectObj = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(tuniTdnSelectObj
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniTdnSelectObj
, fluidStack[fluidLevel].size = sizeof(tuniTdnSelectObj), fluidLevel
++, (tuniTdnSelectObj) )
;
2618 AbSyn seq;
2619 Bool result;
2620
2621 tuniExitTForm = type;
2622 abExitsList = listNil(AbSyn)((AbSynList) 0);
2623 tuniTdnSelectObj = absyn->abSelect.testPart;
2624
2625 titdn(stab, absyn->abSelect.testPart, tfUnknown);
2626
2627 seq = absyn->abSelect.alternatives;
2628
2629 result = titdnSequence0(stab, absyn->abSelect.alternatives, type);
2630
2631 if (result)
2632 abTUnique(absyn)((absyn)->abHdr.type.unique) = abTUnique(absyn->abSelect.alternatives)((absyn->abSelect.alternatives)->abHdr.type.unique);
2633 Return(result){ fluidUnwind(fluidLevel0, ((int) 0)); return result;; };
2634}
2635
2636/***************************************************************************
2637 *
2638 * :: Try:
2639 *
2640 ***************************************************************************/
2641
2642localstatic Bool
2643titdnTry(Stab stab, AbSyn absyn, TForm type)
2644{
2645 AInt i, argc;
2646 TForm inner;
2647 AbEmbed embed;
2648 AbSyn expr, seq, nuttin, *argv;
2649
2650 extern void tibup(Stab, AbSyn, TForm);
2651
2652
2653 /* Try-blocks with no value are tricky */
2654 if (tfIsNone(type)((((type)->tag) == TF_Multiple) && tfMultiArgc(type
) == 0)
) {
2655 /* (void)fprintf(dbOut, "*** Ick: empty multi.\n"); */
2656 expr = absyn->abTry.expr;
2657
2658
2659 /* We want to force a void return value */
2660 if(abHasTag(expr, AB_Sequence)((expr)->abHdr.tag == (AB_Sequence))) {
2661 argc = abArgc(expr)((expr)->abHdr.argc);
2662 argv = abArgv(expr)((expr)->abGen.data.argv);
2663 }
2664 else {
2665 argc = 1;
2666 argv = &expr;
2667 }
2668
2669
2670 /* Create a new sequence */
2671 seq = abNewEmpty(AB_Sequence, argc + 1);
2672
2673
2674 /* Copy across the old members */
2675 for (i = 0;i < argc; i++)
2676 abArgv(seq)((seq)->abGen.data.argv)[i] = argv[i];
2677
2678
2679 /* Create a void value and type infer */
2680 nuttin = abNewNothing(abPos(expr))abNew(AB_Nothing, (spstackFirst((expr)->abHdr.pos)),0 );
2681 tibup(stab, nuttin, tfNone()tfMulti(0));
2682
2683
2684 /* Append the void to the sequence */
2685 abArgv(seq)((seq)->abGen.data.argv)[argc] = nuttin;
2686
2687
2688 /* We require the type to be () */
2689 abUse(seq)((seq)->abHdr.use) = abUse(expr)((expr)->abHdr.use);
2690 abState(seq)((seq)->abHdr.state) = AB_State_HasPoss;
2691 abTPoss(seq)((seq)->abHdr.type.poss) = tpossSingleton(tfNone()tfMulti(0));
2692
2693
2694 /* Update the try-expression */
2695 absyn->abTry.expr = seq;
2696 }
2697 else if (tfIsMulti(type)(((type)->tag) == TF_Multiple)) {
2698 /* (void)fprintf(dbOut, "*** Yum: hot-cross multi!\n"); */
2699 type = tfCrossFrMulti(type);
2700 }
2701
2702
2703 /* Finish the type inference on this node */
2704 titdn(stab, absyn->abTry.id, tfUnknown);
2705 titdn(stab, absyn->abTry.expr, tfIgnoreExceptions(type));
2706 titdn(stab, absyn->abTry.always, tfNone()tfMulti(0));
2707 if (!abIsNothing(absyn->abTry.except)((absyn->abTry.except)->abHdr.tag == (AB_Nothing)))
2708 titdn(stab, absyn->abTry.except, type);
2709
2710
2711 /* Embed multi-valued try-blocks in a Cross */
2712 if (abState(absyn->abTry.expr)((absyn->abTry.expr)->abHdr.state) == AB_State_HasUnique) {
2713 inner = abTUnique(absyn->abTry.expr)((absyn->abTry.expr)->abHdr.type.unique);
2714
2715 if (tfAsMultiArgc(inner) > 1) {
2716 embed = tfSatEmbedType(inner, type);
2717 if (!tfIsNone(type)((((type)->tag) == TF_Multiple) && tfMultiArgc(type
) == 0)
&& (embed != AB_Embed_Identity(((AbEmbed) 1) << 0)))
2718 abAddTContext(absyn->abTry.expr, embed);
2719 }
2720 }
2721
2722 abTUnique(absyn)((absyn)->abHdr.type.unique) = type;
2723 return true1;
2724}
2725
2726/***************************************************************************
2727 *
2728 * :: Let:
2729 *
2730 ***************************************************************************/
2731
2732localstatic Bool
2733titdnLet(Stab stab, AbSyn absyn, TForm type)
2734{
2735 return titdn0Generic(stab, absyn, type);
2736}
2737
2738
2739/**************************************************************************
2740 * titdnError: permforms a recursive discendent visit of parse tree
2741 * looking for nodes with state == AB_State_Error and giving error
2742 * message.
2743 * Note: every error find in bup process should be handled here.
2744 **************************************************************************/
2745
2746localstatic void titdn0ErrorSequence(Stab stab, AbSyn ab, TForm type);
2747
2748/* Call titdnError on each subtree using .type. as constraint type */
2749localstatic void
2750titdn0Error(Stab stab, AbSyn absyn, TForm type)
2751{
2752 int i;
2753 int argc = abArgc(absyn)((absyn)->abHdr.argc);
2754
2755 for (i = 0; i < argc; i++) {
2756 AbSyn argi = abArgv(absyn)((absyn)->abGen.data.argv)[i];
2757 titdnError(stab, argi, type);
2758 }
2759}
2760
2761localstatic void
2762titdnError(Stab stab, AbSyn absyn, TForm type)
2763{
2764 tfFollow(type)((type) = tfFollowFn(type));
2765
2766 if (!abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START) && abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
)
2767 stab = abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
;
2768
2769 if (abState(absyn)((absyn)->abHdr.state) == AB_State_Error) {
2770 Bool exit = true1;
2771 Bool result = false((int) 0);
2772
2773 if (abTag(absyn)((absyn)->abHdr.tag) == AB_Sequence)
2774 result = titdnSequence(stab, absyn, type);
2775 else if (abIsAnyLambda(absyn)(((absyn)->abHdr.tag == (AB_Lambda)) || ((absyn)->abHdr
.tag == (AB_PLambda)))
)
2776 result = titdnLambda(stab, absyn, type);
2777 else if (abTag(absyn)((absyn)->abHdr.tag) == AB_Generate)
2778 result = titdnGenerate(stab, absyn, type);
2779 else
2780 exit = !terror(stab, absyn, type);
2781
2782 /*assert(!result);*/
2783 if (result) abState(absyn)((absyn)->abHdr.state) = AB_State_HasUnique;
2784
2785 if (exit) return;
2786 }
2787
2788 if (!abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START)) {
2789
2790 /* Determine the constraint types */
2791 switch(abTag(absyn)((absyn)->abHdr.tag)) {
2792 case AB_Declare:
2793 {
2794 TForm tf = abTForm(absyn->abDeclare.type)((absyn->abDeclare.type)->abHdr.seman ? (absyn->abDeclare
.type)->abHdr.seman->tform : 0)
;
2795 titdnError(stab, absyn->abDeclare.id, tf);
2796 }
2797 break;
2798 case AB_Lambda:
2799 case AB_PLambda: {
2800 TForm tf = tiGetTForm(stab,absyn->abLambda.rtype);
2801 titdnError(stab, absyn->abLambda.param, tfUnknown);
2802 titdnError(stab, absyn->abLambda.body, tf);
2803 }
2804 break;
2805 case AB_With:
2806 titdnError(stab,absyn->abWith.base, tfCategory);
2807 titdnError(stab,absyn->abWith.within, tfUnknown);
2808 break;
2809 case AB_Where:
2810 titdnError(stab,absyn->abWhere.context, tfUnknown);
2811 titdnError(stab,absyn->abWhere.expr, type);
2812 break;
2813 case AB_If:
2814 assert(tfBoolean != tfUnknown)do { if (!(tfBoolean != tfUnknown)) _do_assert(("tfBoolean != tfUnknown"
),"ti_tdn.c",2814); } while (0)
;
2815 titdnError(stab, absyn->abIf.test, tfBoolean);
2816 titdnError(stab, absyn->abIf.thenAlt, type);
2817 titdnError(stab, absyn->abIf.elseAlt, type);
2818 break;
2819 case AB_RestrictTo: {
2820 TForm tf = tiGetTForm(stab, absyn->abRestrictTo.type);
2821 titdnError(stab, absyn->abRestrictTo.expr, tf);
2822 }
2823 break;
2824 case AB_For:
2825 titdnError(stab, absyn->abFor.whole, tfUnknown);
2826 assert(tfBoolean != tfUnknown)do { if (!(tfBoolean != tfUnknown)) _do_assert(("tfBoolean != tfUnknown"
),"ti_tdn.c",2826); } while (0)
;
2827 titdnError(stab, absyn->abFor.test, tfBoolean);
2828 titdnError(stab, absyn->abFor.lhs, tfUnknown);
2829 break;
2830 case AB_ForeignImport:
2831 titdnError(stab, absyn->abForeignImport.what, tfUnknown);
2832 break;
2833 case AB_ForeignExport:
2834 titdnError(stab, absyn->abForeignExport.what, tfUnknown);
2835 break;
2836 case AB_Import:
2837 titdnError(stab, absyn->abImport.what, tfUnknown);
2838 break;
2839 case AB_Inline:
2840 titdnError(stab, absyn->abInline.what, tfUnknown);
2841 break;
2842 case AB_Sequence:
2843 titdn0ErrorSequence(stab, absyn, type);
2844 break;
2845 case AB_PretendTo:
2846 case AB_Do:
2847 case AB_Repeat:
2848 case AB_Collect:
2849 case AB_Generate:
2850 case AB_Return:
2851 case AB_Exit:
2852 case AB_Comma:
2853 case AB_Apply:
2854 titdn0Error(stab, absyn, tfUnknown);
2855 break;
2856 case AB_Not:
2857 case AB_And:
2858 case AB_Or:
2859 case AB_Has:
2860 case AB_While:
2861 assert(tfBoolean != tfUnknown)do { if (!(tfBoolean != tfUnknown)) _do_assert(("tfBoolean != tfUnknown"
),"ti_tdn.c",2861); } while (0)
;
2862 titdn0Error(stab, absyn, tfBoolean);
2863 break;
2864 default:
2865 titdn0Error(stab, absyn, type);
2866 break;
2867 }
2868 }
2869 return;
2870}
2871
2872
2873/* NB: We should also handle 'exit' cases, and similar with
2874 * generate and return (probably)
2875 */
2876localstatic void
2877titdn0ErrorSequence(Stab stab, AbSyn absyn, TForm type)
2878{
2879 TForm none = tfNone()tfMulti(0);
2880 int i;
2881 int argc = abArgc(absyn)((absyn)->abHdr.argc);
2882
2883 if (argc == 0)
2884 return;
2885
2886 for (i = 0; i < argc-1; i++) {
2887 AbSyn argi = absyn->abSequence.argv[i];
2888 titdnError(stab, argi, none);
2889 }
2890 titdnError(stab, absyn->abSequence.argv[i], type);
2891}