| File: | src/ti_bup.c |
| Warning: | line 507, column 4 Value stored to 'sl' is never read |
Press '?' to see keyboard shortcuts
Keyboard shortcuts:
| 1 | /**************************************************************************** |
| 2 | * |
| 3 | * ti_bup.c: Type inference -- bottom up pass. |
| 4 | * |
| 5 | * Copyright (c) 1990-2007 Aldor Software Organization Ltd (Aldor.org). |
| 6 | * |
| 7 | ***************************************************************************/ |
| 8 | #include "ablogic.h" |
| 9 | #include "abpretty.h" |
| 10 | #include "absub.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 "spesym.h" |
| 18 | #include "stab.h" |
| 19 | #include "store.h" |
| 20 | #include "strops.h" |
| 21 | #include "tfsat.h" |
| 22 | #include "table.h" |
| 23 | #include "ti_bup.h" |
| 24 | #include "ti_tdn.h" |
| 25 | #include "terror.h" |
| 26 | #include "tinfer.h" |
| 27 | #include "tposs.h" |
| 28 | #include "util.h" |
| 29 | |
| 30 | |
| 31 | |
| 32 | /***************************************************************************** |
| 33 | * |
| 34 | * :: Selective debug stuff |
| 35 | * |
| 36 | ****************************************************************************/ |
| 37 | |
| 38 | Bool tipBupDebug = false((int) 0); |
| 39 | #define tipBupDEBUGif (!tipBupDebug) { } else afprintf DEBUG_IF(tipBup)if (!tipBupDebug) { } else afprintf |
| 40 | |
| 41 | /***************************************************************************** |
| 42 | * |
| 43 | * :: Fluids to unify multiple exit points |
| 44 | * |
| 45 | ****************************************************************************/ |
| 46 | |
| 47 | /* |
| 48 | * One of the following four conditions will hold: |
| 49 | * |
| 50 | * tuniIsInappropriate => not in an appropriate context. |
| 51 | * tuniIsNoValue => in no-value context. |
| 52 | * tuniIsUnknown => in appropriate context, but no exit seen yet. |
| 53 | * otherwise => seen some possible types -- must intersect. |
| 54 | */ |
| 55 | |
| 56 | |
| 57 | static TPoss tuniYieldTPoss = 0; |
| 58 | static TPoss tuniReturnTPoss = 0; |
| 59 | static TPoss tuniExitTPoss = 0; |
| 60 | static TPoss tuniSelectTPoss = 0; |
| 61 | static TForm tuniYieldType = 0; |
| 62 | static TForm tuniExitType = 0; |
| 63 | static AbSyn tuniBupSelectObj = 0; |
| 64 | |
| 65 | /***************************************************************************** |
| 66 | * |
| 67 | * :: Other fluids and globals |
| 68 | * |
| 69 | ****************************************************************************/ |
| 70 | |
| 71 | static Bool tloopBreakCount = -1;/* Handle loop exits */ |
| 72 | static SymbolList terrorIdComplaints = 0; /* Id complaint list for scope. */ |
| 73 | |
| 74 | /***************************************************************************** |
| 75 | * |
| 76 | * :: Declarations for bottom up pass |
| 77 | * |
| 78 | ****************************************************************************/ |
| 79 | |
| 80 | localstatic Bool tibup0GiveMsg (AbSyn); |
| 81 | localstatic void tibup0Generic (Stab, AbSyn, TForm); |
| 82 | localstatic TForm tibup0Within (Stab, AbSyn, SymeList, Bool); |
| 83 | localstatic SymeList tibup0DefaultBody(Stab stab, AbSyn absyn, Bool); |
| 84 | localstatic void tibup0FarValue (Stab, AbSyn, TForm, AbSyn, TPoss *); |
| 85 | localstatic void tibup0NoValue (Stab, AbSyn, TForm, Msg); |
| 86 | |
| 87 | localstatic void tibup0ApplySymIfNeeded |
| 88 | (Stab, AbSyn, TForm, Symbol, |
| 89 | Length, AbSynGetter, AbSyn, TFormPredicate); |
| 90 | localstatic void tibup0ApplySym (Stab, AbSyn, TForm, Symbol, |
| 91 | Length, AbSynGetter, AbSyn); |
| 92 | localstatic void tibup0ApplyFType(Stab, AbSyn, TForm, AbSyn, |
| 93 | Length, AbSynGetter); |
| 94 | localstatic void tibup0ApplyJoin (Stab, AbSyn, TForm, AbSyn, |
| 95 | Length, AbSynGetter); |
| 96 | |
| 97 | localstatic void tibupSequence0 (Stab, AbSyn, TForm); |
| 98 | |
| 99 | localstatic void tibup0InferLhs (Stab, AbSyn, AbSyn, AbSyn, TPoss); |
| 100 | localstatic void tibup0InferLhsId (Stab, AbSyn, AbSyn, TForm, AbSyn); |
| 101 | localstatic void tibup0InferLhsApply (Stab, AbSyn, AbSyn, TForm); |
| 102 | |
| 103 | localstatic void tibupId (Stab, AbSyn, TForm); |
| 104 | localstatic void tibupIdSy (Stab, AbSyn, TForm); |
| 105 | localstatic void tibupBlank (Stab, AbSyn, TForm); |
| 106 | localstatic void tibupLitInteger (Stab, AbSyn, TForm); |
| 107 | localstatic void tibupLitFloat (Stab, AbSyn, TForm); |
| 108 | localstatic void tibupLitString (Stab, AbSyn, TForm); |
| 109 | localstatic void tibupAdd (Stab, AbSyn, TForm); |
| 110 | localstatic void tibupAnd (Stab, AbSyn, TForm); |
| 111 | localstatic void tibupApply (Stab, AbSyn, TForm); |
| 112 | localstatic void tibupAssert (Stab, AbSyn, TForm); |
| 113 | localstatic void tibupAssign (Stab, AbSyn, TForm); |
| 114 | localstatic void tibupBreak (Stab, AbSyn, TForm); |
| 115 | localstatic void tibupBuiltin (Stab, AbSyn, TForm); |
| 116 | localstatic void tibupCoerceTo (Stab, AbSyn, TForm); |
| 117 | localstatic void tibupCollect (Stab, AbSyn, TForm); |
| 118 | localstatic void tibupComma (Stab, AbSyn, TForm); |
| 119 | localstatic void tibupDeclare (Stab, AbSyn, TForm); |
| 120 | localstatic void tibupDefault (Stab, AbSyn, TForm); |
| 121 | localstatic void tibupDefine (Stab, AbSyn, TForm); |
| 122 | localstatic void tibupDelay (Stab, AbSyn, TForm); |
| 123 | localstatic void tibupDo (Stab, AbSyn, TForm); |
| 124 | localstatic void tibupExcept (Stab, AbSyn, TForm); |
| 125 | localstatic void tibupRaise (Stab, AbSyn, TForm); |
| 126 | localstatic void tibupExit (Stab, AbSyn, TForm); |
| 127 | localstatic void tibupExport (Stab, AbSyn, TForm); |
| 128 | localstatic void tibupExtend (Stab, AbSyn, TForm); |
| 129 | localstatic void tibupFix (Stab, AbSyn, TForm); |
| 130 | localstatic void tibupFluid (Stab, AbSyn, TForm); |
| 131 | localstatic void tibupFor (Stab, AbSyn, TForm); |
| 132 | localstatic void tibupForeignImport(Stab, AbSyn, TForm); |
| 133 | localstatic void tibupForeignExport(Stab, AbSyn, TForm); |
| 134 | localstatic void tibupFree (Stab, AbSyn, TForm); |
| 135 | localstatic void tibupGenerate (Stab, AbSyn, TForm); |
| 136 | localstatic void tibupReference (Stab, AbSyn, TForm); |
| 137 | localstatic void tibupRefArg (Stab, AbSyn, TForm); |
| 138 | localstatic void tibupGoto (Stab, AbSyn, TForm); |
| 139 | localstatic void tibupHas (Stab, AbSyn, TForm); |
| 140 | localstatic void tibupHide (Stab, AbSyn, TForm); |
| 141 | localstatic void tibupIf (Stab, AbSyn, TForm); |
| 142 | localstatic void tibupImport (Stab, AbSyn, TForm); |
| 143 | localstatic void tibupInline (Stab, AbSyn, TForm); |
| 144 | localstatic void tibupIterate (Stab, AbSyn, TForm); |
| 145 | localstatic void tibupLabel (Stab, AbSyn, TForm); |
| 146 | localstatic void tibupLambda (Stab, AbSyn, TForm); |
| 147 | localstatic void tibupLet (Stab, AbSyn, TForm); |
| 148 | localstatic void tibupLocal (Stab, AbSyn, TForm); |
| 149 | localstatic void tibupMacro (Stab, AbSyn, TForm); |
| 150 | localstatic void tibupMLambda (Stab, AbSyn, TForm); |
| 151 | localstatic void tibupNever (Stab, AbSyn, TForm); |
| 152 | localstatic void tibupNot (Stab, AbSyn, TForm); |
| 153 | localstatic void tibupNothing (Stab, AbSyn, TForm); |
| 154 | localstatic void tibupOr (Stab, AbSyn, TForm); |
| 155 | localstatic void tibupPretendTo (Stab, AbSyn, TForm); |
| 156 | localstatic void tibupQualify (Stab, AbSyn, TForm); |
| 157 | localstatic void tibupQuote (Stab, AbSyn, TForm); |
| 158 | localstatic void tibupRepeat (Stab, AbSyn, TForm); |
| 159 | localstatic void tibupRestrictTo (Stab, AbSyn, TForm); |
| 160 | localstatic void tibupReturn (Stab, AbSyn, TForm); |
| 161 | localstatic void tibupSelect (Stab, AbSyn, TForm); |
| 162 | localstatic void tibupSequence (Stab, AbSyn, TForm); |
| 163 | localstatic void tibupTest (Stab, AbSyn, TForm); |
| 164 | localstatic void tibupTry (Stab, AbSyn, TForm); |
| 165 | localstatic void tibupWhere (Stab, AbSyn, TForm); |
| 166 | localstatic void tibupWhile (Stab, AbSyn, TForm); |
| 167 | localstatic void tibupWith (Stab, AbSyn, TForm); |
| 168 | localstatic void tibupYield (Stab, AbSyn, TForm); |
| 169 | |
| 170 | localstatic void tibup0RefImps(Stab, AbSyn, TForm); |
| 171 | |
| 172 | /***************************************************************************** |
| 173 | * |
| 174 | * :: Bottom up pass |
| 175 | * |
| 176 | ****************************************************************************/ |
| 177 | |
| 178 | void |
| 179 | tiBottomUp(Stab stab, AbSyn absyn, TForm type) |
| 180 | { |
| 181 | Scope("tiBottomUp")String scopeName = ("tiBottomUp"); int fluidLevel0 = (scopeLevel ++, fluidLevel); |
| 182 | |
| 183 | TPoss fluid(tuniReturnTPoss)fluidSave_tuniReturnTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniReturnTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniReturnTPoss , fluidStack[fluidLevel].size = sizeof(tuniReturnTPoss), fluidLevel ++, (tuniReturnTPoss) ); |
| 184 | TPoss fluid(tuniYieldTPoss)fluidSave_tuniYieldTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniYieldTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniYieldTPoss , fluidStack[fluidLevel].size = sizeof(tuniYieldTPoss), fluidLevel ++, (tuniYieldTPoss) ); |
| 185 | TForm fluid(tuniYieldType)fluidSave_tuniYieldType = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniYieldType ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniYieldType , fluidStack[fluidLevel].size = sizeof(tuniYieldType), fluidLevel ++, (tuniYieldType) ); |
| 186 | TPoss fluid(tuniExitTPoss)fluidSave_tuniExitTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniExitTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniExitTPoss , fluidStack[fluidLevel].size = sizeof(tuniExitTPoss), fluidLevel ++, (tuniExitTPoss) ); |
| 187 | Bool fluid(tloopBreakCount)fluidSave_tloopBreakCount = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tloopBreakCount ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tloopBreakCount , fluidStack[fluidLevel].size = sizeof(tloopBreakCount), fluidLevel ++, (tloopBreakCount) ); |
| 188 | SymbolList fluid(terrorIdComplaints)fluidSave_terrorIdComplaints = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(terrorIdComplaints ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_terrorIdComplaints , fluidStack[fluidLevel].size = sizeof(terrorIdComplaints), fluidLevel ++, (terrorIdComplaints) ); |
| 189 | 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) ); |
| 190 | |
| 191 | tuniYieldTPoss = tuniInappropriateTPoss((TPoss) 12L); |
| 192 | tuniYieldType = tfUnknown; |
| 193 | tuniReturnTPoss = tuniInappropriateTPoss((TPoss) 12L); |
| 194 | tuniExitTPoss = tuniInappropriateTPoss((TPoss) 12L); |
| 195 | tuniExitType = tfUnknown; |
| 196 | tloopBreakCount = -1; |
| 197 | terrorIdComplaints = 0; |
| 198 | abCondKnown = abCondKnown ? ablogCopy(abCondKnown) : ablogTrue(); |
| 199 | |
| 200 | tibup(stab, absyn, type); |
| 201 | |
| 202 | listFree(Symbol)(Symbol_listPointer->Free)(terrorIdComplaints); |
| 203 | ablogFree(abCondKnown); |
| 204 | |
| 205 | ReturnNothing{ fluidUnwind(fluidLevel0, ((int) 0)); return;; }; |
| 206 | } |
| 207 | |
| 208 | |
| 209 | void |
| 210 | tibup(Stab stab, AbSyn absyn, TForm type) |
| 211 | { |
| 212 | static int serialNo = 0, depthNo = 0; |
| 213 | int serialThis; |
| 214 | |
| 215 | assert(absyn)do { if (!(absyn)) _do_assert(("absyn"),"ti_bup.c",215); } while (0); |
| 216 | |
| 217 | /* Check before processing the stab, if present. */ |
| 218 | if (abState(absyn)((absyn)->abHdr.state) >= AB_State_HasPoss) |
| 219 | return; |
| 220 | |
| 221 | if (!abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START) && abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab : 0)) { |
| 222 | stab = abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab : 0); |
| 223 | stabSeeOuterImports(stab); |
| 224 | stabGetSubstable(stab); |
| 225 | typeInferTForms(stab); |
| 226 | } |
| 227 | |
| 228 | /* Check that stab processing didn't already process absyn. */ |
| 229 | if (abState(absyn)((absyn)->abHdr.state) >= AB_State_HasPoss) |
| 230 | return; |
| 231 | |
| 232 | serialNo += 1; |
| 233 | depthNo += 1; |
| 234 | serialThis = serialNo; |
| 235 | if (DEBUG(tipBup)tipBupDebug) { |
| 236 | fprintf(dbOut,"->Bup: %*s %d= ", depthNo, "", serialThis); |
| 237 | abPrettyPrint(dbOut, absyn); |
| 238 | fnewline(dbOut); |
| 239 | } |
| 240 | |
| 241 | AB_SWITCH(absyn, tibup, (stab, absyn, type))switch (((absyn)->abHdr.tag)) { case AB_Id: tibupId (stab, absyn, type); break; case AB_IdSy: tibupIdSy (stab, absyn, type ); break; case AB_Blank: tibupBlank (stab, absyn, type); break ; case AB_LitInteger: tibupLitInteger (stab, absyn, type); break ; case AB_LitFloat: tibupLitFloat (stab, absyn, type); break; case AB_LitString: tibupLitString (stab, absyn, type); break ; case AB_Add: tibupAdd (stab, absyn, type); break; case AB_And : tibupAnd (stab, absyn, type); break; case AB_Apply: tibupApply (stab, absyn, type); break; case AB_Assert: tibupAssert (stab , absyn, type); break; case AB_Assign: tibupAssign (stab, absyn , type); break; case AB_Break: tibupBreak (stab, absyn, type) ; break; case AB_Builtin: tibupBuiltin (stab, absyn, type); break ; case AB_CoerceTo: tibupCoerceTo (stab, absyn, type); break; case AB_Collect: tibupCollect (stab, absyn, type); break; case AB_Comma: tibupComma (stab, absyn, type); break; case AB_Declare : tibupDeclare (stab, absyn, type); break; case AB_Default: tibupDefault (stab, absyn, type); break; case AB_Define: tibupDefine (stab , absyn, type); break; case AB_Delay: tibupDelay (stab, absyn , type); break; case AB_Do: tibupDo (stab, absyn, type); break ; case AB_Except: tibupExcept (stab, absyn, type); break; case AB_Raise: tibupRaise (stab, absyn, type); break; case AB_Exit : tibupExit (stab, absyn, type); break; case AB_Export: tibupExport (stab, absyn, type); break; case AB_Extend: tibupExtend (stab , absyn, type); break; case AB_Fix: tibupFix (stab, absyn, type ); break; case AB_Fluid: tibupFluid (stab, absyn, type); break ; case AB_For: tibupFor (stab, absyn, type); break; case AB_ForeignImport : tibupForeignImport (stab, absyn, type); break; case AB_ForeignExport : tibupForeignExport (stab, absyn, type); break; case AB_Free : tibupFree (stab, absyn, type); break; case AB_Generate: tibupGenerate (stab, absyn, type); break; case AB_Goto: tibupGoto (stab, absyn , type); break; case AB_Has: tibupHas (stab, absyn, type); break ; case AB_Hide: tibupHide (stab, absyn, type); break; case AB_If : tibupIf (stab, absyn, type); break; case AB_Import: tibupImport (stab, absyn, type); break; case AB_Inline: tibupInline (stab , absyn, type); break; case AB_Iterate: tibupIterate (stab, absyn , type); break; case AB_Label: tibupLabel (stab, absyn, type) ; break; case AB_Lambda: tibupLambda (stab, absyn, type); break ; case AB_Let: tibupLet (stab, absyn, type); break; case AB_Local : tibupLocal (stab, absyn, type); break; case AB_Macro: tibupMacro (stab, absyn, type); break; case AB_MLambda: tibupMLambda (stab , absyn, type); break; case AB_Never: tibupNever (stab, absyn , type); break; case AB_Not: tibupNot (stab, absyn, type); break ; case AB_Nothing: tibupNothing (stab, absyn, type); break; case AB_Or: tibupOr (stab, absyn, type); break; case AB_PLambda: tibupLambda (stab, absyn, type); break; case AB_PretendTo: tibupPretendTo (stab, absyn, type); break; case AB_Qualify: tibupQualify (stab , absyn, type); break; case AB_Quote: tibupQuote (stab, absyn , type); break; case AB_Reference: tibupReference (stab, absyn , type); break; case AB_Repeat: tibupRepeat (stab, absyn, type ); break; case AB_RestrictTo: tibupRestrictTo (stab, absyn, type ); break; case AB_Return: tibupReturn (stab, absyn, type); break ; case AB_Select: tibupSelect (stab, absyn, type); break; case AB_Sequence: tibupSequence (stab, absyn, type); break; case AB_Test : tibupTest (stab, absyn, type); break; case AB_Try: tibupTry (stab, absyn, type); break; case AB_Where: tibupWhere (stab, absyn, type); break; case AB_While: tibupWhile (stab, absyn, type); break; case AB_With: tibupWith (stab, absyn, type); break ; case AB_Yield: tibupYield (stab, absyn, type); break; default : bug("Bad case %d (line %d in file %s).", (int) ((absyn)-> abHdr.tag), 241, "ti_bup.c"); }; |
| 242 | |
| 243 | if (abState(absyn)((absyn)->abHdr.state) == AB_State_AbSyn) |
| 244 | abState(absyn)((absyn)->abHdr.state) = AB_State_HasPoss; |
| 245 | |
| 246 | #if 0 |
| 247 | /* |
| 248 | * !! Not yet, first we need to clean up the type arguments passed |
| 249 | * into tibup and change the type satisfier so _ can be a category. |
| 250 | * Some (all?) other calls to the type satisfier in this file can |
| 251 | * then be removed. |
| 252 | */ |
| 253 | { |
| 254 | TPoss abtposs; |
| 255 | abtposs = tpossSatisfiesType(abTPoss(absyn)((absyn)->abHdr.type.poss), type); |
| 256 | tpossFree(abTPoss(absyn)((absyn)->abHdr.type.poss)); |
| 257 | abTPoss(absyn)((absyn)->abHdr.type.poss) = abtposs; |
| 258 | } |
| 259 | #endif |
| 260 | |
| 261 | /* |
| 262 | * If all the parts of this node had meaning but this node |
| 263 | * itself has not meaning, then set the state to error. This |
| 264 | * is because it doesn't matter what types we assign to the |
| 265 | * leaves, this node will always be unsatified. |
| 266 | */ |
| 267 | if (tibup0GiveMsg(absyn)) { |
| 268 | tpossFree(abTPoss(absyn)((absyn)->abHdr.type.poss)); |
| 269 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 270 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossEmpty(); |
| 271 | } |
| 272 | |
| 273 | if (DEBUG(tipBup)tipBupDebug) { |
| 274 | TPoss abtposs = abReferTPoss(absyn); |
| 275 | fprintf(dbOut, "<-Bup: %*s %d= ", depthNo, "", serialThis); |
| 276 | abPrettyPrint(dbOut, absyn); |
| 277 | fprintf(dbOut, " has %d meanings: ", tpossCount(abtposs)); |
| 278 | tpossPrint(dbOut, abtposs); |
| 279 | fnewline(dbOut); |
| 280 | tpossFree(abtposs); |
| 281 | } |
| 282 | depthNo -= 1; |
| 283 | } |
| 284 | |
| 285 | localstatic Bool |
| 286 | tibup0GiveMsg(AbSyn absyn) |
| 287 | { |
| 288 | Bool result; |
| 289 | |
| 290 | /* Does this node have a possible set of types? */ |
| 291 | result = abState(absyn)((absyn)->abHdr.state) == AB_State_HasPoss && |
| 292 | tpossCount(abTPoss(absyn)((absyn)->abHdr.type.poss)) == 0; |
| 293 | |
| 294 | |
| 295 | /* If there are possible types then return now. */ |
| 296 | if (!result) return result; |
| 297 | |
| 298 | |
| 299 | /* Leaf nodes can be ignored for now */ |
| 300 | if (abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START)) |
| 301 | result = false((int) 0); |
| 302 | |
| 303 | /* So can add-bodies */ |
| 304 | else if (abTag(absyn)((absyn)->abHdr.tag) == AB_Add) |
| 305 | result = false((int) 0); |
| 306 | |
| 307 | else { |
| 308 | /* Check all parts have meaning */ |
| 309 | Length i; |
| 310 | for (i = 0; result && i < abArgc(absyn)((absyn)->abHdr.argc); i += 1) { |
| 311 | AbSyn argi = abArgv(absyn)((absyn)->abGen.data.argv)[i]; |
| 312 | switch (abState(argi)((argi)->abHdr.state)) { |
| 313 | case AB_State_HasPoss: |
| 314 | result = tpossCount(abTPoss(argi)((argi)->abHdr.type.poss)) > 0; |
| 315 | break; |
| 316 | case AB_State_Error: |
| 317 | result = false((int) 0); |
| 318 | break; |
| 319 | default: |
| 320 | break; |
| 321 | } |
| 322 | } |
| 323 | } |
| 324 | |
| 325 | /* Returns true iff all parts had meaning (and we don't) */ |
| 326 | return result; |
| 327 | } |
| 328 | |
| 329 | /**************************************************************************** |
| 330 | * |
| 331 | * :: Generic: abArgc(ab), abArgv(ab) |
| 332 | * |
| 333 | ***************************************************************************/ |
| 334 | |
| 335 | localstatic void |
| 336 | tibup0Generic(Stab stab, AbSyn absyn, TForm type) |
| 337 | { |
| 338 | Length i; |
| 339 | if (!abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START)) |
| 340 | for (i = 0; i < abArgc(absyn)((absyn)->abHdr.argc); i += 1) |
| 341 | tibup(stab, abArgv(absyn)((absyn)->abGen.data.argv)[i], tfUnknown); |
| 342 | |
| 343 | if (tfIsUnknown(type)(((type)->tag) == TF_Unknown)) type = tfNone()tfMulti(0); |
| 344 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(type); |
| 345 | } |
| 346 | |
| 347 | /**************************************************************************** |
| 348 | * |
| 349 | * :: Within: with bodies, 'with' conditional branches |
| 350 | * |
| 351 | ***************************************************************************/ |
| 352 | |
| 353 | localstatic TForm |
| 354 | tibup0Within(Stab stab, AbSyn absyn, SymeList bsymes, Bool doDefault) |
| 355 | { |
| 356 | SymeList xsymes, isymes, dsymes, ssymes, symes; |
| 357 | Length i, argc; |
| 358 | AbSyn *argv; |
| 359 | TForm tf; |
| 360 | Bool pending = false((int) 0); |
| 361 | |
| 362 | AB_SEQ_ITER(absyn, argc, argv){ switch (((absyn)->abHdr.tag)) { case AB_Nothing: argc = 0 ; argv = 0; break; case AB_Sequence: argc = ((absyn)->abHdr .argc); argv = ((absyn)->abGen.data.argv); break; default: argc = 1; argv = &absyn; break; }; }; |
| 363 | |
| 364 | xsymes = isymes = dsymes = ssymes = listNil(Syme)((SymeList) 0); |
| 365 | for (i = 0; i < argc; i += 1) { |
| 366 | AbSyn id = abDefineeIdOrElse(argv[i], NULL((void*)0)); |
| 367 | |
| 368 | /* Empty body. */ |
| 369 | if (abTag(argv[i])((argv[i])->abHdr.tag) == AB_Nothing) |
| 370 | typeInferAs(stab, argv[i], tfUnknown); |
| 371 | /* Default body. */ |
| 372 | else if (abTag(argv[i])((argv[i])->abHdr.tag) == AB_Default) { |
| 373 | typeInferAs(stab, argv[i], tfUnknown); |
| 374 | symes = abGetCatExports(argv[i]); |
| 375 | dsymes = listConcat(Syme)(Syme_listPointer->Concat)(symes, dsymes); |
| 376 | } |
| 377 | /* Explicit declaration/definition. */ |
| 378 | else if (id && abTag(argv[i])((argv[i])->abHdr.tag) != AB_Id) { |
| 379 | if (abTag(argv[i])((argv[i])->abHdr.tag) == AB_Define && !doDefault) { |
| 380 | AbSyn lhs = argv[i]->abDefine.lhs; |
| 381 | tiTfPushDefinee(lhs); |
| 382 | typeInferAs(stab, lhs, |
| 383 | tiDefineFilter(argv[i],tfUnknown)); |
| 384 | tiTfPopDefinee(lhs); |
| 385 | } |
| 386 | else /*if (doDefault)*/ |
| 387 | typeInferAs(stab, argv[i], tfUnknown); |
| 388 | if (abSyme(id)((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0) && symeIsExport(abSyme(id))(((((((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0 ))->kind == SYME_Trigger ? libGetAllSymes((((id)->abHdr .seman ? (id)->abHdr.seman->syme : 0))->lib) : ((void *)0)), (((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0)))->kind) == SYME_Export)) |
| 389 | xsymes = listCons(Syme)(Syme_listPointer->Cons)(abSyme(id)((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0), xsymes); |
| 390 | } |
| 391 | else if (abTag(argv[i])((argv[i])->abHdr.tag) == AB_Import |
| 392 | || abTag(argv[i])((argv[i])->abHdr.tag) == AB_Inline) { |
| 393 | typeInferAs(stab, argv[i], tfNone()tfMulti(0)); |
| 394 | } |
| 395 | /* Category expression. */ |
| 396 | else { |
| 397 | typeInferAs(stab, argv[i], tfCategory); |
| 398 | /*!! typeInferCheck(stab, argv[i], tfCategory); */ |
| 399 | symes = abGetCatExports(argv[i]); |
| 400 | isymes = symeListUnion(isymes, symes, symeEqual); |
| 401 | symes = abGetCatSelf(argv[i]); |
| 402 | ssymes = symeListUnion(ssymes, symes, symeEqual); |
| 403 | |
| 404 | if (abState(argv[i])((argv[i])->abHdr.state) != AB_State_HasUnique || |
| 405 | !tfIsMeaning(abTUnique(argv[i]))(((((argv[i])->abHdr.type.unique))->state)>=TF_State_Meaning )) |
| 406 | pending = true1; |
| 407 | } |
| 408 | } |
| 409 | |
| 410 | /* Mark the symes which have a default implementation. */ |
| 411 | dsymes = listNReverse(Syme)(Syme_listPointer->NReverse)(dsymes); |
| 412 | for (; dsymes; dsymes = listFreeCons(Syme)(Syme_listPointer->FreeCons)(dsymes)) { |
| 413 | Syme dsyme = car(dsymes)((dsymes)->first); |
| 414 | Syme xsyme = NULL((void*)0); |
| 415 | |
| 416 | /* If the default is one of our exports, just mark it. */ |
| 417 | for (symes = xsymes; !xsyme && symes; symes = cdr(symes)((symes)->rest)) |
| 418 | if (symeEqual(car(symes)((symes)->first), dsyme)) { |
| 419 | xsyme = car(symes)((symes)->first); |
| 420 | symeSetDefault(xsyme)(((((xsyme)->kind == SYME_Trigger ? libGetAllSymes((xsyme) ->lib) : ((void*)0)), (xsyme))->bits) |= (0x0080)); |
| 421 | symeSetSrcPos(xsyme, symeSrcPos(dsyme))(symeSetFieldVal = ((AInt) (((SrcPos) (SYFI_SrcPos < (8 * sizeof (int)) && !(((((dsyme)->kind == SYME_Trigger ? libGetAllSymes ((dsyme)->lib) : ((void*)0)), (dsyme))->hasmask) & ( 1 << (SYFI_SrcPos))) ? (symeFieldInfo[SYFI_SrcPos].def) : (((((dsyme)->kind == SYME_Trigger ? libGetAllSymes((dsyme )->lib) : ((void*)0)), (dsyme))->locmask) & (1 << (SYFI_SrcPos))) ? ((((((dsyme)->kind == SYME_Trigger ? libGetAllSymes ((dsyme)->lib) : ((void*)0)), (dsyme))->locmask) & ( 1 << (SYFI_SrcPos))) ? ((dsyme)->fieldv)[symeIndex(dsyme ,SYFI_SrcPos)] : (symeFieldInfo[SYFI_SrcPos].def)) : symeGetFieldFn (dsyme,SYFI_SrcPos))))), (((((xsyme)->kind == SYME_Trigger ? libGetAllSymes((xsyme)->lib) : ((void*)0)), (xsyme))-> locmask) & (1 << (SYFI_SrcPos))) ? (((xsyme)->fieldv )[symeIndex(xsyme,SYFI_SrcPos)] = (symeSetFieldVal)) : !((xsyme )->full) && symeSetFieldVal == (symeFieldInfo[SYFI_SrcPos ].def) ? symeSetFieldVal : symeSetFieldFn(xsyme,SYFI_SrcPos,symeSetFieldVal )); |
| 422 | } |
| 423 | |
| 424 | /* If the default is inherited, use the default syme. */ |
| 425 | if (xsyme == NULL((void*)0)) { |
| 426 | xsymes = listCons(Syme)(Syme_listPointer->Cons)(dsyme, xsymes); |
| 427 | symeSetDefault(dsyme)(((((dsyme)->kind == SYME_Trigger ? libGetAllSymes((dsyme) ->lib) : ((void*)0)), (dsyme))->bits) |= (0x0080)); |
| 428 | } |
| 429 | } |
| 430 | |
| 431 | xsymes = listNReverse(Syme)(Syme_listPointer->NReverse)(xsymes); |
| 432 | /* Order of args to ListUnion is important |
| 433 | * This way, we prefer local symes to imports */ |
| 434 | xsymes = symeListUnion(isymes, xsymes, symeEqual); |
| 435 | |
| 436 | if (abTag(absyn)((absyn)->abHdr.tag) == AB_Nothing || abTag(absyn)((absyn)->abHdr.tag) == AB_Sequence) { |
| 437 | abState(absyn)((absyn)->abHdr.state) = AB_State_HasUnique; |
| 438 | abTUnique(absyn)((absyn)->abHdr.type.unique) = tfThird(xsymes); |
| 439 | } |
| 440 | |
| 441 | tf = tfThird(xsymes); |
| 442 | tfAddSelf(tf, ssymes); |
| 443 | tfHasSelf(tf)((tf)->hasSelf) = !pending; |
| 444 | |
| 445 | return tf; |
| 446 | } |
| 447 | |
| 448 | localstatic SymeList |
| 449 | tibup0DefaultBody(Stab stab, AbSyn absyn, Bool doDef) |
| 450 | { |
| 451 | SymeList xsymes; |
| 452 | AbSyn *argv; |
| 453 | int argc, i; |
| 454 | |
| 455 | switch (abTag(absyn)((absyn)->abHdr.tag)) { |
| 456 | case AB_Sequence: |
| 457 | argc = abArgc(absyn)((absyn)->abHdr.argc); |
| 458 | argv = absyn->abSequence.argv; |
| 459 | break; |
| 460 | default: |
| 461 | argc = 1; |
| 462 | argv = &absyn; |
| 463 | break; |
| 464 | } |
| 465 | |
| 466 | xsymes = listNil(Syme)((SymeList) 0); |
| 467 | for (i=0; i<argc; i++) { |
| 468 | if (abTag(argv[i])((argv[i])->abHdr.tag) == AB_If) { |
| 469 | AbLogic saveCond; |
| 470 | SymeList sl1; |
| 471 | /* |
| 472 | * An unfixed compiler bug means that parts of Salli |
| 473 | * programs (and thus libAldor) are tinfered with |
| 474 | * (tfBoolean == tfUnknown). The correct fix is to |
| 475 | * ensure that tfBoolean has been imported into every |
| 476 | * scope that needs it before we get this far. |
| 477 | */ |
| 478 | if (tfBoolean == tfUnknown) |
| 479 | comsgFatal(absyn, ALDOR_F_BugNoBoolean367); |
| 480 | |
| 481 | /* !! need abExpandDefs() here */ |
| 482 | typeInferAs(stab, argv[i]->abIf.test, tfBoolean); |
| 483 | ablogAndPush(&abCondKnown, &saveCond, argv[i]->abIf.test, |
| 484 | true1); |
| 485 | sl1 = tibup0DefaultBody(stab, argv[i]->abIf.thenAlt, doDef); |
| 486 | ablogAndPop (&abCondKnown, &saveCond); |
| 487 | /* Should add the condition, but that leads to problems |
| 488 | * when merging |
| 489 | */ |
| 490 | /* !!else part!!*/ |
| 491 | xsymes = listNConcat(Syme)(Syme_listPointer->NConcat)(sl1, xsymes); |
| 492 | } |
| 493 | else if (abTag(argv[i])((argv[i])->abHdr.tag) == AB_Define) { |
| 494 | AbSyn id = abDefineeIdOrElse(argv[i], NULL((void*)0)); |
| 495 | AbSyn lhs = argv[i]->abDefine.lhs; |
| 496 | |
| 497 | tiTfPushDefinee(lhs); |
| 498 | typeInferAs(stab, lhs, |
| 499 | tiDefineFilter(argv[i],tfUnknown)); |
| 500 | tiTfPopDefinee(lhs); |
| 501 | |
| 502 | if (abSyme(id)((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0) && symeIsExport(abSyme(id))(((((((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0 ))->kind == SYME_Trigger ? libGetAllSymes((((id)->abHdr .seman ? (id)->abHdr.seman->syme : 0))->lib) : ((void *)0)), (((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0)))->kind) == SYME_Export)) |
| 503 | xsymes = listCons(Syme)(Syme_listPointer->Cons)(abSyme(id)((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0), xsymes); |
| 504 | } |
| 505 | else if (abTag(argv[i])((argv[i])->abHdr.tag) == AB_Sequence) { |
| 506 | SymeList sl; |
| 507 | sl = tibup0DefaultBody(stab, argv[i], doDef); |
Value stored to 'sl' is never read | |
| 508 | /* Why is `sl' not appended to `xsymes' ??? */ |
| 509 | } |
| 510 | |
| 511 | if (doDef) |
| 512 | typeInferAs(stab, argv[i], tfUnknown); |
| 513 | /* !! 'where' clauses */ |
| 514 | } |
| 515 | return xsymes; |
| 516 | } |
| 517 | |
| 518 | |
| 519 | /**************************************************************************** |
| 520 | * |
| 521 | * :: Implied call: apply, set!, test, generator, ... |
| 522 | * |
| 523 | ***************************************************************************/ |
| 524 | |
| 525 | localstatic Bool tibup0ApplyGiveMessage(AbSyn absyn, Length argc, AbSynGetter argf); |
| 526 | localstatic void tibup0ApplyFilter(Stab stab, AbSyn absyn, TForm type, TPoss opTypes, |
| 527 | AbSyn op, Length argc, AbSynGetter argf, |
| 528 | TPoss *nopTypes, TPoss *retTypes); |
| 529 | /* |
| 530 | * ab ==> m(i,...) -> tibup0Apply(stab, ab, 'apply, n+1, [m,i,...]) |
| 531 | * ab ==> m(i,...) := x -> tibup0Apply(stab, ab, 'set!, n+2, [m,i,...,x]) |
| 532 | * ab ==> if bb then ... -> tibup0Apply(stab, bb, 'test, 1, [bb.cond]); |
| 533 | * ab ==> for i in l -> tibup0Apply(stab, ab, 'iterator, 1, [l]) |
| 534 | * ab ==> x::T -> tibup0Apply(stab, ab, 'coerce, 1, [x]) |
| 535 | * |
| 536 | * Could also do... |
| 537 | * |
| 538 | * ab ==> 3 -> tibup0Apply(stab, ab, 'integer, 0, []) |
| 539 | * ab ==> "3.14" -> tibup0Apply(stab, ab, 'float, 0, []) |
| 540 | * ab ==> "hello" -> tibup0Apply(stab, ab, 'string, 0, []) |
| 541 | */ |
| 542 | |
| 543 | localstatic void |
| 544 | tibup0ApplySymIfNeeded(Stab stab, AbSyn absyn, TForm type, Symbol fsym, |
| 545 | Length argc, AbSynGetter argf, |
| 546 | AbSyn implicitPart, TFormPredicate pred) |
| 547 | { |
| 548 | AbSyn part; |
| 549 | TPoss tp; |
| 550 | |
| 551 | assert(argc == 1)do { if (!(argc == 1)) _do_assert(("argc == 1"),"ti_bup.c",551 ); } while (0); |
| 552 | |
| 553 | part = argf(absyn, int0((int) 0)); |
| 554 | tibup(stab, part, tfUnknown); |
| 555 | tp = abReferTPoss(part); |
| 556 | |
| 557 | if (tpossCount(tp) == 0) |
| 558 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossRefer(tp); |
| 559 | |
| 560 | else if (tpossIsHaving(tp, pred)) { |
| 561 | TPossIterator it; |
| 562 | TForm tf; |
| 563 | TPoss tpOk; |
| 564 | |
| 565 | tpOk = tpossEmpty(); |
| 566 | for (tpossITER(it, tp)((it).possl = (tp ? (tp)->possl : ((void*)0))); tpossMORE(it)((it).possl); tpossSTEP(it)((it).possl = (((it).possl)->rest))) { |
| 567 | tf = tpossELT(it)tpossELT_(&it); |
| 568 | if (pred(tf) && tfSatisfies(tf, type)) |
| 569 | tpossAdd1(tpOk, tf); |
| 570 | } |
| 571 | abResetTPoss(part, tpOk); |
| 572 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossRefer(tpOk); |
| 573 | } |
| 574 | else |
| 575 | tibup0ApplySym(stab,absyn,type, fsym,argc,argf,implicitPart); |
| 576 | |
| 577 | tpossFree(tp); |
| 578 | } |
| 579 | |
| 580 | localstatic void |
| 581 | tibup0ApplySym(Stab stab, AbSyn absyn, TForm type, |
| 582 | Symbol fsym, Length argc, AbSynGetter argf, |
| 583 | AbSyn implicitPart) |
| 584 | { |
| 585 | AbSyn imp = abNewId(abPos(absyn), fsym)abNew(AB_Id, (spstackFirst((absyn)->abHdr.pos)),1, fsym); |
| 586 | |
| 587 | if (!implicitPart) implicitPart = absyn; |
| 588 | |
| 589 | abSetImplicit(implicitPart, imp); |
| 590 | tibup(stab, imp, tfUnknown); |
| 591 | |
| 592 | tibup0ApplyFType(stab, absyn, type, imp, argc, argf); |
| 593 | } |
| 594 | |
| 595 | localstatic void |
| 596 | tibup0ApplyJoin(Stab stab, AbSyn absyn, TForm type, |
| 597 | AbSyn op, Length argc, AbSynGetter argf) |
| 598 | { |
| 599 | SymeList symes = listNil(Syme)((SymeList) 0), mods = listNil(Syme)((SymeList) 0); |
| 600 | TForm selftf; |
| 601 | Length i; |
| 602 | |
| 603 | /* Type check each argument as a category. */ |
| 604 | for (i = 0; i < argc; i += 1) { |
| 605 | AbSyn argi = argf(absyn, i); |
| 606 | |
| 607 | typeInferAs(stab, argi, tfCategory); |
| 608 | typeInferCheck(stab, argi, tfCategory); |
| 609 | } |
| 610 | |
| 611 | /* Collect the category exports for the result. */ |
| 612 | for (i = 0; i < argc; i += 1) { |
| 613 | AbSyn argi = argf(absyn, i); |
| 614 | SymeList symesi; |
| 615 | |
| 616 | if (abState(argi)((argi)->abHdr.state) == AB_State_HasUnique) { |
| 617 | symesi = tfGetThdExports(abTUnique(argf(absyn, i))((argf(absyn, i))->abHdr.type.unique)); |
| 618 | symes = tfJoinExportLists(mods, symes, symesi, NULL((void*)0)); |
| 619 | } |
| 620 | } |
| 621 | selftf = tfThird(symes); |
| 622 | |
| 623 | /* Collect the symbol meaning(s) for self for the result. */ |
| 624 | tfCopySelf(selftf, abTForm(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->tform : 0)); |
| 625 | for (i = 0; i < argc; i += 1) { |
| 626 | AbSyn argi = argf(absyn, i); |
| 627 | if (abState(argi)((argi)->abHdr.state) == AB_State_HasUnique) |
| 628 | tfAddSelf(selftf, tfGetThdSelf(abTUnique(argi)((argi)->abHdr.type.unique))); |
| 629 | } |
| 630 | |
| 631 | if (!tfSatisfies(selftf, type)) |
| 632 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 633 | |
| 634 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(selftf); |
| 635 | return; |
| 636 | } |
| 637 | |
| 638 | /* |
| 639 | * For each operator type, see whether some combination of args work. |
| 640 | * tibup is applied to the virtual arguments. |
| 641 | */ |
| 642 | |
| 643 | localstatic void |
| 644 | tibup0ApplyFType(Stab stab, AbSyn absyn, TForm type, |
| 645 | AbSyn op, Length argc, AbSynGetter argf) |
| 646 | { |
| 647 | Length i; |
| 648 | TPossIterator it; |
| 649 | TPoss opTypes = abReferTPoss(op); |
| 650 | TPoss nopTypes; |
| 651 | TPoss retTypes; |
| 652 | |
| 653 | if (abIsTheId(op, ssymJoin)(((op)->abHdr.tag == (AB_Id)) && ((op)->abId.sym )==(ssymJoin)) && tpossIsUnique(opTypes) && |
| 654 | tfSatisfies(tfMapRet(tpossUnique(opTypes))tfFollowArg(tpossUnique(opTypes), 1), tfCategory)) { |
| 655 | tibup0ApplyJoin(stab, absyn, type, op, argc, argf); |
| 656 | tpossFree(opTypes); |
| 657 | return; |
| 658 | } |
| 659 | |
| 660 | for (i = 0; i < argc; i += 1) |
| 661 | tibup(stab, argf(absyn, i), tfUnknown); |
| 662 | |
| 663 | tibup0ApplyFilter(stab, absyn, type, opTypes, op, argc, argf, &nopTypes, &retTypes); |
| 664 | |
| 665 | /* If the op and the parts had meaning, then give an error. */ |
| 666 | if (tpossCount(nopTypes) == 0) { |
| 667 | Bool giveMsg = tpossCount(opTypes) > 0 |
| 668 | || tibup0ApplyGiveMessage(absyn, argc, argf); |
| 669 | |
| 670 | if (giveMsg) { |
| 671 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 672 | abState(op)((op)->abHdr.state) = AB_State_Error; |
| 673 | } |
| 674 | else { |
| 675 | if (tpossCount( opTypes ) == 0) |
| 676 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 677 | |
| 678 | abResetTPoss(op, nopTypes); |
| 679 | } |
| 680 | } |
| 681 | else |
| 682 | abResetTPoss(op, nopTypes); |
| 683 | |
| 684 | abResetTPoss(absyn, retTypes); |
| 685 | tpossFree(opTypes); |
| 686 | } |
| 687 | |
| 688 | localstatic Bool |
| 689 | tibup0ApplyGiveMessage(AbSyn absyn, Length argc, AbSynGetter argf) |
| 690 | { |
| 691 | Bool giveMsg = true1; |
| 692 | int i; |
| 693 | |
| 694 | for (i = 0; giveMsg && i < argc; i += 1) { |
| 695 | AbSyn argi = argf(absyn, i); |
| 696 | if (abState(argi)((argi)->abHdr.state) == AB_State_Error || |
| 697 | (abState(argi)((argi)->abHdr.state) == AB_State_HasPoss && |
| 698 | tpossCount(abTPoss(argi)((argi)->abHdr.type.poss)) == 0)) |
| 699 | giveMsg = false((int) 0); |
| 700 | } |
| 701 | |
| 702 | return giveMsg; |
| 703 | } |
| 704 | |
| 705 | localstatic void |
| 706 | tibup0ApplyFilter(Stab stab, AbSyn absyn, TForm type, TPoss opTypes, |
| 707 | AbSyn op, Length argc, AbSynGetter argf, TPoss *pnopTypes, TPoss *pretTypes) |
| 708 | { |
| 709 | SatMask mask = tfSatBupMask(), result; |
| 710 | TPossIterator it; |
| 711 | TPoss nopTypes = tpossEmpty(); |
| 712 | TPoss retTypes = tpossEmpty(); |
| 713 | |
| 714 | /* Filter opTypes based on the argument and return types. */ |
| 715 | for (tpossITER(it, opTypes)((it).possl = (opTypes ? (opTypes)->possl : ((void*)0))); tpossMORE(it)((it).possl); tpossSTEP(it)((it).possl = (((it).possl)->rest))) { |
| 716 | TForm opType = tpossELT(it)tpossELT_(&it), retType; |
| 717 | AbSub sigma; |
| 718 | |
| 719 | opType = tfDefineeType(opType); |
| 720 | if (!tfIsAnyMap(opType)((((opType)->tag) == TF_Map) || (((opType)->tag) == TF_PackedMap ))) continue; |
| 721 | |
| 722 | retType = tfMapRet(opType)tfFollowArg(opType, 1); |
| 723 | sigma = absNew(stab); |
| 724 | |
| 725 | result = tfSatMapArgs(mask, sigma, opType, absyn, argc, argf); |
| 726 | |
| 727 | if (tfSatSucceed(result)) { |
| 728 | retType = tformSubst(sigma, retType); |
| 729 | result = tfSat(mask, retType, type); |
| 730 | if (tfSatSucceed(result)) { |
| 731 | nopTypes = tpossAdd1(nopTypes, opType); |
| 732 | retTypes = tpossAdd1(retTypes, retType); |
| 733 | } |
| 734 | } |
| 735 | |
| 736 | absFreeDeeply(sigma); |
| 737 | } |
| 738 | *pnopTypes = nopTypes; |
| 739 | *pretTypes = retTypes; |
| 740 | } |
| 741 | |
| 742 | /**************************************************************************** |
| 743 | * |
| 744 | * :: Far Values: return x, yield x, a => x |
| 745 | * |
| 746 | ***************************************************************************/ |
| 747 | |
| 748 | localstatic void |
| 749 | tibup0FarValue(Stab stab, AbSyn absyn, TForm type, |
| 750 | AbSyn farValue, TPoss *pFarTPoss) |
| 751 | { |
| 752 | tibup(stab, farValue, type); |
| 753 | |
| 754 | if (tuniIsInappropriate(*pFarTPoss)((*pFarTPoss) == ((TPoss) 12L))) { |
| 755 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 756 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tuniInappropriateTPoss((TPoss) 12L); |
| 757 | } |
| 758 | else if (tuniIsNoValue(*pFarTPoss)((*pFarTPoss) == ((TPoss) 4L))) { |
| 759 | if (abTag(farValue)((farValue)->abHdr.tag) != AB_Nothing && abTag(absyn)((absyn)->abHdr.tag) == AB_Return) |
| 760 | comsgWarning(absyn, ALDOR_W_TinNoValReturn231); |
| 761 | } |
| 762 | else { |
| 763 | TPoss tp0, tp1; |
| 764 | |
| 765 | tp1 = abReferTPoss(farValue); |
| 766 | |
| 767 | if (tuniIsUnknown(*pFarTPoss)((*pFarTPoss) == ((TPoss) 8L))) { |
| 768 | if (DEBUG(tipFar)tipFarDebug) { |
| 769 | fprintf(dbOut, "Setting "); |
| 770 | tpossPrint(dbOut, tp1); |
| 771 | fnewline(dbOut); |
| 772 | } |
| 773 | *pFarTPoss = tpossRefer(tp1); |
| 774 | } |
| 775 | else if (tpossCount(tp1) != 0) { |
| 776 | if (DEBUG(tipFar)tipFarDebug) { |
| 777 | fprintf(dbOut, " with "); |
| 778 | tpossPrint(dbOut, *pFarTPoss); |
| 779 | } |
| 780 | tp0 = tpossIntersect(tp1, *pFarTPoss); |
| 781 | |
| 782 | tpossFree(*pFarTPoss); |
| 783 | *pFarTPoss = tp0; |
| 784 | |
| 785 | if (DEBUG(tipFar)tipFarDebug) { |
| 786 | fprintf(dbOut, " to get "); |
| 787 | tpossPrint(dbOut, *pFarTPoss); |
| 788 | fnewline(dbOut); |
| 789 | } |
| 790 | } |
| 791 | tpossFree(tp1); |
| 792 | } |
| 793 | /* Calling program must set abTPoss(absyn). */ |
| 794 | } |
| 795 | |
| 796 | |
| 797 | /**************************************************************************** |
| 798 | * |
| 799 | * :: No Values: empty sequence, if w/o else, exit. |
| 800 | * |
| 801 | ***************************************************************************/ |
| 802 | |
| 803 | localstatic void |
| 804 | tibup0NoValue(Stab stab, AbSyn absyn, TForm type, Msg msg) |
| 805 | { |
| 806 | if (tfIsNoValueContext(type, absyn)) |
| 807 | { |
| 808 | /* No values are permitted ... */ |
| 809 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfNone()tfMulti(0)); |
| 810 | } |
| 811 | else |
| 812 | { |
| 813 | /* Oops - value required */ |
| 814 | comsgError(absyn, msg); |
| 815 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossEmpty(); |
| 816 | } |
| 817 | } |
| 818 | |
| 819 | |
| 820 | /**************************************************************************** |
| 821 | * |
| 822 | * :: Id: x, +, 1 |
| 823 | * X |
| 824 | ***************************************************************************/ |
| 825 | |
| 826 | localstatic void tibup0IdComplain (AbSyn); |
| 827 | |
| 828 | localstatic void |
| 829 | tibupId(Stab stab, AbSyn absyn, TForm type) |
| 830 | { |
| 831 | TPoss tp; |
| 832 | |
| 833 | if (abUse(absyn)((absyn)->abHdr.use) == AB_Use_Default) |
| 834 | tp = tpossSingleton(type); |
| 835 | else if (abSyme(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->syme : 0)) |
| 836 | tp = tpossSingleton(symeType(abSyme(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->syme : 0))); |
| 837 | else { |
| 838 | /* |
| 839 | * Get all possible types for this symbol which satisfy |
| 840 | * the current context. Unfortunately this includes types |
| 841 | * for export symes that may not be applicable. |
| 842 | */ |
| 843 | tp = stabGetTypes(stab, abCondKnown, absyn->abId.sym); |
| 844 | } |
| 845 | |
| 846 | /* |
| 847 | * Future work: if abUse(absyn) == AB_Use_Type and |
| 848 | * tpossCount(tp) == 1 then we really ought to enrich |
| 849 | * the type in tp with any information about it that |
| 850 | * we have in abCondKnown. This will remove the need |
| 851 | * for the pretend in the following code: |
| 852 | * |
| 853 | * MyDomain(S:Type):SomeCategory == |
| 854 | * { |
| 855 | * if (S has AnotherCategory) then |
| 856 | * AnotherDomain(S pretend AnotherCategory); |
| 857 | * else |
| 858 | * ... |
| 859 | * } |
| 860 | * AnotherDomain(S:AnotherCategory):XXX ... |
| 861 | * |
| 862 | * At the moment we only get tp = [<* Type *>] and |
| 863 | * so we need the pretend for this to go through. The |
| 864 | * only problem is that AbLogic is intended for testing |
| 865 | * with other AbLogic values rather than for extracting |
| 866 | * information from. |
| 867 | */ |
| 868 | |
| 869 | if (tpossCount(tp) == 1 && tfIsUnknown(tpossUnique(tp))(((tpossUnique(tp))->tag) == TF_Unknown)) |
| 870 | tp = tpossEmpty(); |
| 871 | if (tpossCount(tp) == 0) |
| 872 | tibup0IdComplain(absyn); |
| 873 | |
| 874 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tp; |
| 875 | } |
| 876 | |
| 877 | localstatic void |
| 878 | tibup0IdComplain(AbSyn absyn) |
| 879 | { |
| 880 | Symbol sym = absyn->abId.sym; |
| 881 | |
| 882 | if (listMemq(Symbol)(Symbol_listPointer->Memq)(terrorIdComplaints, sym)) return; |
| 883 | terrorIdComplaints = listCons(Symbol)(Symbol_listPointer->Cons)(sym, terrorIdComplaints); |
| 884 | |
| 885 | tpossFree(abTPoss(absyn)((absyn)->abHdr.type.poss)); |
| 886 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 887 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossEmpty(); |
| 888 | } |
| 889 | |
| 890 | /**************************************************************************** |
| 891 | * |
| 892 | * :: LitInteger: 32 |
| 893 | * :: LitFloat: 4.0 |
| 894 | * :: LitString: "hello" |
| 895 | * X |
| 896 | * !! This stuff could be made to go through ti...0Apply. |
| 897 | ***************************************************************************/ |
| 898 | |
| 899 | localstatic void tibup0Literal (Symbol, Stab, AbSyn, TForm); |
| 900 | |
| 901 | /* |
| 902 | * Bottom up entry points. |
| 903 | */ |
| 904 | |
| 905 | localstatic void |
| 906 | tibupLitInteger(Stab stab, AbSyn absyn, TForm type) |
| 907 | { |
| 908 | tibup0Literal(ssymTheInteger, stab, absyn, type); |
| 909 | } |
| 910 | |
| 911 | localstatic void |
| 912 | tibupLitFloat(Stab stab, AbSyn absyn, TForm type) |
| 913 | { |
| 914 | tibup0Literal(ssymTheFloat, stab, absyn, type); |
| 915 | } |
| 916 | |
| 917 | localstatic void |
| 918 | tibupLitString(Stab stab, AbSyn absyn, TForm type) |
| 919 | { |
| 920 | tibup0Literal(ssymTheString, stab, absyn, type); |
| 921 | } |
| 922 | |
| 923 | /* |
| 924 | * Functions which actually do the work. |
| 925 | */ |
| 926 | |
| 927 | localstatic void |
| 928 | tibup0Literal(Symbol sym, Stab stab, AbSyn absyn, TForm type) |
| 929 | { |
| 930 | SatMask mask = tfSatBupMask(); |
| 931 | Syme syme = abSyme(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->syme : 0); |
| 932 | |
| 933 | /* |
| 934 | * Consider the node to be the application of the given symbol |
| 935 | * to a string argument: String -> X |
| 936 | * If there is already a symbol meaning on the node, use it. |
| 937 | * Otherwise, consult the symbol table and filter by type. |
| 938 | */ |
| 939 | if (syme) { |
| 940 | TForm opType = symeType(syme); |
| 941 | TForm retType; |
| 942 | |
| 943 | if (!tfIsLitOpType(opType)) { |
| 944 | String msg = "inappropriate meaning on literal"; |
| 945 | comsgFatal(absyn, ALDOR_F_Bug365, msg); |
| 946 | /*bug("Inappropriate meaning on literal."); */ |
| 947 | } |
| 948 | |
| 949 | retType = tfMapRet(opType)tfFollowArg(opType, 1); |
| 950 | if (!tfSatSucceed(tfSat(mask, retType, type))) { |
| 951 | String msg = "inappropriate meaning on literal"; |
| 952 | comsgFatal(absyn, ALDOR_F_Bug365, msg); |
| 953 | /*bug("Inappropriate meaning on literal."); */ |
| 954 | } |
| 955 | |
| 956 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(retType); |
| 957 | } |
| 958 | else { |
| 959 | TPoss opTypes, litTypes; |
| 960 | TPossIterator tit; |
| 961 | |
| 962 | litTypes = tpossEmpty(); |
| 963 | opTypes = stabGetTypes(stab, abCondKnown, sym); |
| 964 | |
| 965 | if (DEBUG(tipLit)tipLitDebug) { |
| 966 | fprintf(dbOut, "tibup0Literal:\n"); |
| 967 | tpossPrint(dbOut, opTypes); |
| 968 | fnewline(dbOut); |
| 969 | } |
| 970 | |
| 971 | for (tpossITER(tit,opTypes)((tit).possl = (opTypes ? (opTypes)->possl : ((void*)0))) ; tpossMORE(tit)((tit).possl); tpossSTEP(tit)((tit).possl = (((tit).possl)->rest))) { |
| 972 | TForm opType = tpossELT(tit)tpossELT_(&tit); |
| 973 | TForm retType; |
| 974 | |
| 975 | tfFollow(opType)((opType) = tfFollowFn(opType)); |
| 976 | if (!tfIsLitOpType(opType)) continue; |
| 977 | |
| 978 | retType = tfMapRet(opType)tfFollowArg(opType, 1); |
| 979 | if (tfSatSucceed(tfSat(mask, retType, type))) |
| 980 | litTypes = tpossAdd1(litTypes, retType); |
| 981 | } |
| 982 | tpossFree(opTypes); |
| 983 | |
| 984 | abTPoss(absyn)((absyn)->abHdr.type.poss) = litTypes; |
| 985 | |
| 986 | if (tpossCount(litTypes) == 0) |
| 987 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 988 | } |
| 989 | } |
| 990 | |
| 991 | /*************************************************************************** |
| 992 | * |
| 993 | * :: Comma: (a, b) |
| 994 | * |
| 995 | ***************************************************************************/ |
| 996 | |
| 997 | localstatic TPoss |
| 998 | abGetArgTPoss(AbSyn *abv, Length i) |
| 999 | { |
| 1000 | return abReferTPoss(abv[i]); |
| 1001 | } |
| 1002 | |
| 1003 | localstatic Bool |
| 1004 | abSymeInducesDependency(AbSyn id, AbSyn absyn) |
| 1005 | { |
| 1006 | if (id == absyn) |
| 1007 | return false((int) 0); |
| 1008 | |
| 1009 | else if (abHasTag(absyn, AB_Id)((absyn)->abHdr.tag == (AB_Id)) && id->abId.sym == absyn->abId.sym) |
| 1010 | return true1; |
| 1011 | |
| 1012 | else if (!abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START)) { |
| 1013 | Length i; |
| 1014 | for (i = 0; i < abArgc(absyn)((absyn)->abHdr.argc); i += 1) |
| 1015 | if (abSymeInducesDependency(id, abArgv(absyn)((absyn)->abGen.data.argv)[i])) |
| 1016 | return true1; |
| 1017 | } |
| 1018 | |
| 1019 | return false((int) 0); |
| 1020 | } |
| 1021 | |
| 1022 | localstatic TPoss |
| 1023 | tpossDefine(Syme syme, TPoss tp, AbSyn ab) |
| 1024 | { |
| 1025 | TPoss ntp = tpossEmpty(); |
| 1026 | TPossIterator it; |
| 1027 | |
| 1028 | for (tpossITER(it, tp)((it).possl = (tp ? (tp)->possl : ((void*)0))); tpossMORE(it)((it).possl); tpossSTEP(it)((it).possl = (((it).possl)->rest))) { |
| 1029 | TForm tf = tpossELT(it)tpossELT_(&it); |
| 1030 | tf = tfDefine(tfDeclare(abFrSyme(syme), tf), ab); |
| 1031 | tpossAdd1(ntp, tf); |
| 1032 | } |
| 1033 | |
| 1034 | return ntp; |
| 1035 | } |
| 1036 | |
| 1037 | localstatic void |
| 1038 | tibupComma(Stab stab, AbSyn absyn, TForm type) |
| 1039 | { |
| 1040 | AbSyn * argv = abArgv(absyn)((absyn)->abGen.data.argv); |
| 1041 | Length i, argc = abArgc(absyn)((absyn)->abHdr.argc); |
| 1042 | Stab istab = NULL((void*)0); |
| 1043 | AbSub sigma = NULL((void*)0); |
| 1044 | TForm * trhsv = NULL((void*)0); |
| 1045 | Bool decl; |
| 1046 | TForm tf; |
| 1047 | TPoss tp; |
| 1048 | |
| 1049 | decl = abUse(absyn)((absyn)->abHdr.use) == AB_Use_Declaration || |
| 1050 | abUse(absyn)((absyn)->abHdr.use) == AB_Use_Default; |
| 1051 | |
| 1052 | tf = decl ? type : tfUnknown; |
| 1053 | |
| 1054 | for (i = 0; i < argc; i++) |
| 1055 | tibup(stab, argv[i], tf); |
| 1056 | |
| 1057 | if (abUse(absyn)((absyn)->abHdr.use) == AB_Use_Value || |
| 1058 | abUse(absyn)((absyn)->abHdr.use) == AB_Use_RetValue) { |
| 1059 | if (tfIsCross(type)(((type)->tag) == TF_Cross) && tfCrossArgc(type) == argc) |
| 1060 | trhsv = tfCrossArgv(type)((type)->argv); |
| 1061 | if (tfIsMulti(type)(((type)->tag) == TF_Multiple) && tfMultiArgc(type) == argc) |
| 1062 | trhsv = tfMultiArgv(type)((type)->argv); |
| 1063 | } |
| 1064 | |
| 1065 | for (i = 0; i < argc; i++) { |
| 1066 | AbSyn abi = argv[i]; |
| 1067 | TPoss ntp = NULL((void*)0); |
| 1068 | |
| 1069 | if (abState(abi)((abi)->abHdr.state) != AB_State_HasPoss) continue; |
| 1070 | tp = abTPoss(abi)((abi)->abHdr.type.poss); |
| 1071 | |
| 1072 | /* Add the syme to the type in declaration contexts. */ |
| 1073 | if (abTag(abi)((abi)->abHdr.tag) == AB_Declare) { |
| 1074 | AbSyn id = abi->abDeclare.id; |
| 1075 | if (abSymeInducesDependency(id, absyn)) |
| 1076 | ntp = tpossDeclare(abSyme(id)((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0), tp); |
| 1077 | } |
| 1078 | else if (abTag(abi)((abi)->abHdr.tag) == AB_Id) |
| 1079 | if (abUse(absyn)((absyn)->abHdr.use) == AB_Use_Define) |
| 1080 | ntp = tpossDeclare(abSyme(abi)((abi)->abHdr.seman ? (abi)->abHdr.seman->syme : 0), tp); |
| 1081 | |
| 1082 | /* Add the value to the type in value contexts. */ |
| 1083 | if (!ntp && trhsv) { |
| 1084 | /* Technique for shifting a type form to an |
| 1085 | * unrelated position in stab. |
| 1086 | */ |
| 1087 | Syme syme = (Syme)NULL((void*)0); |
| 1088 | TForm tfi = trhsv[i]; |
| 1089 | |
| 1090 | if (istab == NULL((void*)0) && tfIsDeclare(tfi)(((tfi)->tag) == TF_Declare)) { |
| 1091 | istab = stabPushLevel(stab, abPos(absyn)(spstackFirst((absyn)->abHdr.pos)),(ULong) 0); |
| 1092 | sigma = absNew(tfStab(type)((type)->stab)); |
| 1093 | } |
| 1094 | tfFollow(tfi)((tfi) = tfFollowFn(tfi)); |
| 1095 | |
| 1096 | #if AXL_EDIT_1_1_12p6_071 |
| 1097 | if (tfIsDeclare(tfi)(((tfi)->tag) == TF_Declare)) |
| 1098 | syme = tfDeclareSyme(tfi); |
| 1099 | |
| 1100 | /* |
| 1101 | * If this value is a dependent type and we |
| 1102 | * failed to obtain a unique meaning during |
| 1103 | * typeInferTForms then we may not have a |
| 1104 | * syme to associate with this definition. |
| 1105 | * (see bug 1238 for example). |
| 1106 | */ |
| 1107 | if (syme) { |
| 1108 | if (!stabHasMeaning(stab, syme)) { |
| 1109 | if (!istab) { |
| 1110 | istab = stabPushLevel(stab, abPos(absyn)(spstackFirst((absyn)->abHdr.pos)),(ULong) 0); |
| 1111 | sigma = absNew(tfStab(type)((type)->stab)); |
| 1112 | } |
| 1113 | syme = stabDefParam(istab, symeId(syme)((syme)->id), tformSubst(sigma, tfi)); |
| 1114 | } |
| 1115 | ntp = tpossDefine(syme, tp, abi); |
| 1116 | } |
| 1117 | #else |
| 1118 | if (tfIsDeclare(tfi)(((tfi)->tag) == TF_Declare)) { |
| 1119 | Syme syme = tfDeclareSyme(tfi); |
| 1120 | |
| 1121 | if (!stabHasMeaning(stab, syme)) { |
| 1122 | if (!istab) { |
| 1123 | istab = stabPushLevel(stab, abPos(absyn)(spstackFirst((absyn)->abHdr.pos)),(ULong) 0); |
| 1124 | sigma = absNew(tfStab(type)((type)->stab)); |
| 1125 | } |
| 1126 | syme = stabDefParam(istab, symeId(syme)((syme)->id), tformSubst(sigma, tfi)); |
| 1127 | } |
| 1128 | ntp = tpossDefine(syme, tp, abi); |
| 1129 | } |
| 1130 | #endif |
| 1131 | } |
| 1132 | |
| 1133 | if (ntp) abResetTPoss(abi, ntp); |
| 1134 | } |
| 1135 | |
| 1136 | if (decl) |
| 1137 | tp = tpossSingleton(tfNone()tfMulti(0)); |
| 1138 | else |
| 1139 | tp = tpossMulti(argc, argv, (TPossGetter) abGetArgTPoss); |
| 1140 | |
| 1141 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tp; |
| 1142 | } |
| 1143 | |
| 1144 | /**************************************************************************** |
| 1145 | * |
| 1146 | * :: Apply: f(a, b, ...) |
| 1147 | * |
| 1148 | ***************************************************************************/ |
| 1149 | |
| 1150 | localstatic void |
| 1151 | tibupApply(Stab stab, AbSyn absyn, TForm type) |
| 1152 | { |
| 1153 | AbSyn op = abApplyOp(absyn)((absyn)->abApply.op); |
| 1154 | AbSyn imp = NULL((void*)0); |
| 1155 | TPoss opTypes; |
| 1156 | TPoss nopTypes; |
| 1157 | TPoss retTypes; |
| 1158 | TPoss impOpTypes; |
| 1159 | TPoss impRetTypes; |
| 1160 | int i; |
| 1161 | |
| 1162 | tibup(stab, abApplyOp(absyn)((absyn)->abApply.op), tfUnknown); |
| 1163 | |
| 1164 | opTypes = abReferTPoss(op); |
| 1165 | |
| 1166 | if (abIsTheId(op, ssymJoin)(((op)->abHdr.tag == (AB_Id)) && ((op)->abId.sym )==(ssymJoin)) && tpossIsUnique(opTypes) && |
| 1167 | tfSatisfies(tfMapRet(tpossUnique(opTypes))tfFollowArg(tpossUnique(opTypes), 1), tfCategory)) { |
| 1168 | tibup0ApplyJoin(stab, absyn, type, op, abApplyArgc(absyn)(((absyn)->abHdr.argc)-1), abApplyArgf); |
| 1169 | tpossFree(opTypes); |
| 1170 | return; |
| 1171 | } |
| 1172 | |
| 1173 | for (i = 0; i < abApplyArgc(absyn)(((absyn)->abHdr.argc)-1); i += 1) |
| 1174 | tibup(stab, abApplyArg(absyn, i)((absyn)->abApply.argv[i]), tfUnknown); |
| 1175 | |
| 1176 | tibup0ApplyFilter(stab, absyn, type, opTypes, |
| 1177 | op, abApplyArgc(absyn)(((absyn)->abHdr.argc)-1), abApplyArgf, &nopTypes, &retTypes); |
| 1178 | |
| 1179 | if (tpossHasNonMapType(opTypes)) { |
| 1180 | imp = abNewId(abPos(absyn), ssymApply)abNew(AB_Id, (spstackFirst((absyn)->abHdr.pos)),1, ssymApply ); |
| 1181 | |
| 1182 | abSetImplicit(absyn, imp); |
| 1183 | tibup(stab, imp, tfUnknown); |
| 1184 | |
| 1185 | tibup0ApplyFilter(stab, absyn, type, abTPoss(imp)((imp)->abHdr.type.poss), |
| 1186 | imp, abArgc(absyn)((absyn)->abHdr.argc), abArgf, &impOpTypes, &impRetTypes); |
| 1187 | |
| 1188 | if (tpossCount(impOpTypes) > 0) { |
| 1189 | TPoss tmp2 = retTypes; |
| 1190 | retTypes = tpossUnion(retTypes, impRetTypes); |
| 1191 | tpossFree(tmp2); |
| 1192 | } |
| 1193 | else { |
| 1194 | abFree(imp); |
| 1195 | imp = NULL((void*)0); |
| 1196 | abSetImplicit(absyn, NULL((void*)0)); |
| 1197 | } |
| 1198 | } |
| 1199 | |
| 1200 | /* If the op and the parts had meaning, then give an error. */ |
| 1201 | if (tpossCount(retTypes) == 0) { |
| 1202 | Bool giveMsg = tpossCount(opTypes) > 0 |
| 1203 | && tibup0ApplyGiveMessage(absyn, abApplyArgc(absyn)(((absyn)->abHdr.argc)-1), abApplyArgf); |
| 1204 | |
| 1205 | if (giveMsg) { |
| 1206 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 1207 | abState(op)((op)->abHdr.state) = AB_State_Error; |
| 1208 | } |
| 1209 | else { |
| 1210 | if (tpossCount( opTypes ) == 0) |
| 1211 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 1212 | |
| 1213 | if (!imp) |
| 1214 | abResetTPoss(op, nopTypes); |
| 1215 | if (imp) |
| 1216 | abResetTPoss(imp, impOpTypes); |
| 1217 | } |
| 1218 | } |
| 1219 | else { |
| 1220 | if (!imp) |
| 1221 | abResetTPoss(op, nopTypes); |
| 1222 | if (imp) |
| 1223 | abResetTPoss(imp, impOpTypes); |
| 1224 | } |
| 1225 | |
| 1226 | abResetTPoss(absyn, retTypes); |
| 1227 | tpossFree(opTypes); |
| 1228 | } |
| 1229 | |
| 1230 | /**************************************************************************** |
| 1231 | * |
| 1232 | * :: Define: a == e |
| 1233 | * X |
| 1234 | ***************************************************************************/ |
| 1235 | |
| 1236 | /* Select the types from T which absyn satisfies. */ |
| 1237 | |
| 1238 | localstatic TPoss |
| 1239 | tpossFilterSatisfiers(AbSyn absyn, TPoss T) |
| 1240 | { |
| 1241 | TPoss tp, result; |
| 1242 | |
| 1243 | tp = abReferTPoss(absyn); |
| 1244 | result = tpossSatisfies(tp, T); |
| 1245 | tpossFree(tp); |
| 1246 | |
| 1247 | return result; |
| 1248 | } |
| 1249 | |
| 1250 | localstatic void |
| 1251 | tibupDefine(Stab stab, AbSyn absyn, TForm type) |
| 1252 | { |
| 1253 | AbSyn lhs = absyn->abDefine.lhs; |
| 1254 | AbSyn rhs = absyn->abDefine.rhs; |
| 1255 | Bool key = abTag(lhs)((lhs)->abHdr.tag) != AB_Declare && abUse(absyn)((absyn)->abHdr.use) == AB_Use_Value; |
| 1256 | |
| 1257 | tiTfPushDefinee(lhs); |
| 1258 | |
| 1259 | if (key) { |
| 1260 | /* !! We don't check the type of keyword arguments. */ |
| 1261 | tibup(stab, rhs, type); |
| 1262 | abState(lhs)((lhs)->abHdr.state) = AB_State_HasPoss; |
| 1263 | abTPoss(lhs)((lhs)->abHdr.type.poss) = abReferTPoss(rhs); |
| 1264 | } |
| 1265 | else if (abTag(lhs)((lhs)->abHdr.tag) == AB_Declare) { |
| 1266 | tibup(stab, lhs, type); |
| 1267 | type = abTForm(lhs->abDeclare.type)((lhs->abDeclare.type)->abHdr.seman ? (lhs->abDeclare .type)->abHdr.seman->tform : 0); |
| 1268 | tibup(stab, rhs, type); |
| 1269 | } |
| 1270 | else { |
| 1271 | TPoss tprhs, tpnew; |
| 1272 | TForm t; |
| 1273 | TPossIterator tit; |
| 1274 | |
| 1275 | |
| 1276 | /* Compute possible types for the RHS */ |
| 1277 | tibup(stab, rhs, type); |
| 1278 | tpnew = abReferTPoss(rhs); |
| 1279 | |
| 1280 | |
| 1281 | /* Filter out void types */ |
| 1282 | tprhs = tpossEmpty(); |
| 1283 | for (tpossITER(tit,tpnew)((tit).possl = (tpnew ? (tpnew)->possl : ((void*)0))); tpossMORE(tit)((tit).possl); tpossSTEP(tit)((tit).possl = (((tit).possl)->rest))) |
| 1284 | { |
| 1285 | /* Get the next type possibility */ |
| 1286 | t = tpossELT(tit)tpossELT_(&tit); |
| 1287 | |
| 1288 | |
| 1289 | /* Is it an empty multi? */ |
| 1290 | if (tfIsMulti(t)(((t)->tag) == TF_Multiple) && !tfArgc(t)((t)->argc)) continue; |
| 1291 | |
| 1292 | |
| 1293 | /* No - add it to the set of possible types */ |
| 1294 | tprhs = tpossAdd1(tprhs, t); |
| 1295 | } |
| 1296 | |
| 1297 | |
| 1298 | /* Update the tposs for the RHS */ |
| 1299 | /* abTPoss(rhs) = tpossRefer(tprhs); */ |
| 1300 | tpossFree(tpnew); |
| 1301 | |
| 1302 | |
| 1303 | /* Compute types for LHS based on RHS set */ |
| 1304 | tibup0InferLhs(stab, absyn, lhs, rhs, tprhs); |
| 1305 | tibup(stab, lhs, type); |
| 1306 | |
| 1307 | |
| 1308 | /* Check that we have at least one type for RHS */ |
| 1309 | if (!tpossCount(tprhs)) |
| 1310 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 1311 | } |
| 1312 | |
| 1313 | tiTfPopDefinee(lhs); |
| 1314 | |
| 1315 | if (abTag(lhs)((lhs)->abHdr.tag) == AB_Declare) |
| 1316 | { |
| 1317 | AbSyn idtype = lhs->abDeclare.type; |
| 1318 | abTPoss(absyn)((absyn)->abHdr.type.poss) = abReferTPoss(idtype); |
| 1319 | } |
| 1320 | else |
| 1321 | abTPoss(absyn)((absyn)->abHdr.type.poss) = abReferTPoss(rhs); |
| 1322 | |
| 1323 | |
| 1324 | if (DEBUG(tipDefine)tipDefineDebug) { |
| 1325 | TPoss abtposs = abReferTPoss(absyn); |
| 1326 | fprintf(dbOut,"Bup: Define of "); |
| 1327 | abPrint(dbOut, lhs); |
| 1328 | fprintf(dbOut," has %d types ", tpossCount(abtposs)); |
| 1329 | tpossPrint(dbOut, abtposs); |
| 1330 | fnewline(dbOut); |
| 1331 | tpossFree(abtposs); |
| 1332 | } |
| 1333 | } |
| 1334 | |
| 1335 | /**************************************************************************** |
| 1336 | * |
| 1337 | * :: Assign: a := e |
| 1338 | * X |
| 1339 | ***************************************************************************/ |
| 1340 | |
| 1341 | localstatic void |
| 1342 | tibup0InferLhs(Stab stab, AbSyn absyn, AbSyn lhs, AbSyn rhs, TPoss tprhs) |
| 1343 | { |
| 1344 | AbSyn * lhsv = abArgvAs(AB_Comma, lhs)(((lhs)->abHdr.tag == (AB_Comma)) ? ((lhs)->abGen.data. argv) : &(lhs)); |
| 1345 | Length i, lhsc = abArgcAs(AB_Comma, lhs)(((lhs)->abHdr.tag == (AB_Comma)) ? ((lhs)->abHdr.argc) : 1); |
| 1346 | TForm * trhsv = NULL((void*)0); |
| 1347 | TForm trhs; |
| 1348 | AbSub sigma; |
| 1349 | |
| 1350 | if (!tpossIsUnique(tprhs)) return; |
| 1351 | trhs = tpossUnique(tprhs); |
| 1352 | tfFollow(trhs)((trhs) = tfFollowFn(trhs)); |
| 1353 | if (tfIsUnknown(trhs)(((trhs)->tag) == TF_Unknown)) return; |
| 1354 | |
| 1355 | if (abTag(lhs)((lhs)->abHdr.tag) == AB_Id) { |
| 1356 | trhsv= &trhs; |
| 1357 | } |
| 1358 | else if (abTag(lhs)((lhs)->abHdr.tag) == AB_Comma) { |
| 1359 | trhs = tfDefineeBaseType(trhs); |
| 1360 | rhs = NULL((void*)0); |
| 1361 | if (tfIsCross(trhs)(((trhs)->tag) == TF_Cross) && tfCrossArgc(trhs) == lhsc) |
| 1362 | trhsv = tfCrossArgv(trhs)((trhs)->argv); |
| 1363 | if (tfIsMulti(trhs)(((trhs)->tag) == TF_Multiple) && tfMultiArgc(trhs) == lhsc) |
| 1364 | trhsv = tfMultiArgv(trhs)((trhs)->argv); |
| 1365 | } |
| 1366 | if (!trhsv) return; |
| 1367 | |
| 1368 | sigma = absNew(stab); |
| 1369 | for (i = 0; i < lhsc; i++) { |
| 1370 | AbSyn abi = lhsv[i]; |
| 1371 | TForm tfi = trhsv[i]; |
| 1372 | Syme syme = NULL((void*)0); |
| 1373 | |
| 1374 | tfi = tformSubst(sigma, tfi); |
| 1375 | tfFollow(tfi)((tfi) = tfFollowFn(tfi)); |
| 1376 | if (tfIsDeclare(tfi)(((tfi)->tag) == TF_Declare)) { |
| 1377 | syme = tfDeclareSyme(tfi); |
| 1378 | tfi = tfDeclareType(tfi)tfFollowArg(tfi, 0); |
| 1379 | } |
| 1380 | |
| 1381 | if (abTag(abi)((abi)->abHdr.tag) == AB_Id) |
| 1382 | tibup0InferLhsId(stab, lhs, abi, tfi, rhs); |
| 1383 | |
| 1384 | else if (abTag(abi)((abi)->abHdr.tag) == AB_Apply) { |
| 1385 | tibup0InferLhsApply(stab, lhs, abi, tfi); |
| 1386 | if (abState(abi)((abi)->abHdr.state) == AB_State_Error) |
| 1387 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 1388 | } |
| 1389 | |
| 1390 | /* Extend the sublist for dependent symes. */ |
| 1391 | if (abTag(abi)((abi)->abHdr.tag) == AB_Declare) |
| 1392 | abi = abi->abDeclare.id; |
| 1393 | |
| 1394 | if (abTag(abi)((abi)->abHdr.tag) == AB_Id && syme != NULL((void*)0)) { |
| 1395 | AbSyn ab = abCopy(abi); |
| 1396 | tiBottomUp(stab, ab, tfUnknown); |
| 1397 | tiTopDown (stab, ab, tfi); |
| 1398 | if (abState(ab)((ab)->abHdr.state) == AB_State_HasUnique) { |
| 1399 | if (absFVars(sigma)((sigma)->fv)) |
| 1400 | absSetFVars(sigma, NULL)((sigma)->fv = (((void*)0))); |
| 1401 | sigma = absExtend(syme, ab, sigma); |
| 1402 | } |
| 1403 | } |
| 1404 | } |
| 1405 | |
| 1406 | absFree(sigma); |
| 1407 | } |
| 1408 | |
| 1409 | localstatic void |
| 1410 | tibup0InferLhsId(Stab stab, AbSyn lhs, AbSyn ab, TForm tf, AbSyn rhs) |
| 1411 | { |
| 1412 | Symbol sym = abIdSym(ab)((ab)->abId.sym); |
| 1413 | |
| 1414 | if (stabIsUndeclaredId(stab, sym) && !tfIsUnknown(tf)(((tf)->tag) == TF_Unknown)) { |
| 1415 | if (tfIsMulti(tf)(((tf)->tag) == TF_Multiple) && rhs) { |
| 1416 | tf = tfCrossFrMulti(tf); |
| 1417 | abSetTContext(rhs, AB_Embed_MultiToCross(((AbEmbed) 1) << 5)); |
| 1418 | } |
| 1419 | if (comsgOkRemark(ALDOR_R_TinInferring235)) { |
| 1420 | String typestr = tfPretty(tf); |
| 1421 | comsgRemark(lhs, ALDOR_R_TinInferring235, |
| 1422 | symString(sym)((sym)->str), typestr); |
| 1423 | strFree(typestr); |
| 1424 | } |
| 1425 | stabDeclareId(stab, sym, tf); |
| 1426 | } |
| 1427 | } |
| 1428 | |
| 1429 | localstatic void |
| 1430 | tibup0InferLhsApply(Stab stab, AbSyn lhs, AbSyn ab, TForm tf) |
| 1431 | { |
| 1432 | AbSyn rhs = abNewNothing(abPos(lhs))abNew(AB_Nothing, (spstackFirst((lhs)->abHdr.pos)),0 ); |
| 1433 | AbSyn aba = abNewAssign(abPos(lhs), ab, rhs)abNew(AB_Assign, (spstackFirst((lhs)->abHdr.pos)),2, ab,rhs ); |
| 1434 | |
| 1435 | abTPoss(rhs)((rhs)->abHdr.type.poss) = tpossSingleton(tf); |
| 1436 | abState(rhs)((rhs)->abHdr.state) = AB_State_HasPoss; |
| 1437 | tibup0ApplySym(stab, aba, tfUnknown, ssymSetBang, |
| 1438 | abArgc(ab)((ab)->abHdr.argc) + 1, abSetArgf, ab); |
| 1439 | |
| 1440 | if (abState(aba)((aba)->abHdr.state) == AB_State_Error) { |
| 1441 | abState(ab)((ab)->abHdr.state) = AB_State_Error; |
| 1442 | tibup0IdComplain(ab); |
| 1443 | } |
| 1444 | /* This is because the tibup following tibup0LhsInfer |
| 1445 | * ignores the information we've just found, and puts |
| 1446 | * in implicit apply on this node. |
| 1447 | */ |
| 1448 | comsgError(ab, ALDOR_E_TinEmbeddedSet187); |
| 1449 | |
| 1450 | tpossFree(abTPoss(rhs)((rhs)->abHdr.type.poss)); |
| 1451 | tpossFree(abTPoss(aba)((aba)->abHdr.type.poss)); |
| 1452 | abFree(rhs); |
| 1453 | abFreeNode(aba); |
| 1454 | } |
| 1455 | |
| 1456 | localstatic void |
| 1457 | tibupAssign(Stab stab, AbSyn absyn, TForm type) |
| 1458 | { |
| 1459 | AbSyn lhs = absyn->abAssign.lhs; |
| 1460 | AbSyn rhs = absyn->abAssign.rhs; |
| 1461 | TPoss tplhs, tprhs, tpnew; |
| 1462 | TForm t; |
| 1463 | TPossIterator tit; |
| 1464 | |
| 1465 | if (abTag(lhs)((lhs)->abHdr.tag) == AB_Apply) { |
| 1466 | tibup0ApplySym(stab, absyn, type, |
| 1467 | ssymSetBang, abArgc(lhs)((lhs)->abHdr.argc) + 1, abSetArgf, lhs); |
| 1468 | if (abState(absyn)((absyn)->abHdr.state) != AB_State_HasUnique && |
| 1469 | tpossCount(abGoodTPoss(absyn)(((absyn)->abHdr.state) == AB_State_Error ? ((void*)0) :(( absyn)->abHdr.type.poss)))== 0) { |
| 1470 | abState(lhs)((lhs)->abHdr.state) = AB_State_HasPoss; |
| 1471 | abTPoss(lhs)((lhs)->abHdr.type.poss) = tpossEmpty(); |
| 1472 | } |
| 1473 | return; |
| 1474 | } |
| 1475 | |
| 1476 | |
| 1477 | /* Compute the set of possible types for the RHS */ |
| 1478 | tibup(stab, rhs, type); |
| 1479 | tpnew = abReferTPoss(rhs); |
| 1480 | |
| 1481 | |
| 1482 | /* Filter out void types */ |
| 1483 | tprhs = tpossEmpty(); |
| 1484 | for (tpossITER(tit,tpnew)((tit).possl = (tpnew ? (tpnew)->possl : ((void*)0))); tpossMORE(tit)((tit).possl); tpossSTEP(tit)((tit).possl = (((tit).possl)->rest))) |
| 1485 | { |
| 1486 | /* Get the next type possibility */ |
| 1487 | t = tpossELT(tit)tpossELT_(&tit); |
| 1488 | |
| 1489 | |
| 1490 | /* Is it an empty multi? */ |
| 1491 | if (tfIsEmptyMulti(t)((((t)->tag) == TF_Multiple) && tfMultiArgc(t) == 0 )) continue; |
| 1492 | |
| 1493 | |
| 1494 | /* No - add it to the set of possible types */ |
| 1495 | tprhs = tpossAdd1(tprhs, t); |
| 1496 | } |
| 1497 | tpossFree(tpnew); |
| 1498 | |
| 1499 | |
| 1500 | /* |
| 1501 | * Compute the possible types of the lhs restricted to |
| 1502 | * those in the set of possible types of the rhs. |
| 1503 | */ |
| 1504 | tibup0InferLhs(stab, absyn, lhs, rhs, tprhs); |
| 1505 | tibup(stab, lhs, type); |
| 1506 | |
| 1507 | if (abState(absyn)((absyn)->abHdr.state) == AB_State_Error) { |
| 1508 | tpossFree(tprhs); |
| 1509 | return; |
| 1510 | } |
| 1511 | if (abState(rhs)((rhs)->abHdr.state) == AB_State_Error && abTag(lhs)((lhs)->abHdr.tag) == AB_Id) { |
| 1512 | abState(lhs)((lhs)->abHdr.state) = AB_State_HasPoss; |
| 1513 | abTPoss(lhs)((lhs)->abHdr.type.poss) = tpossEmpty(); |
| 1514 | abState(absyn)((absyn)->abHdr.state) = AB_State_HasPoss; |
| 1515 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossEmpty(); |
| 1516 | return; |
| 1517 | } |
| 1518 | |
| 1519 | tplhs = abReferTPoss(lhs); |
| 1520 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossFilterSatisfiers(rhs, tplhs); |
| 1521 | |
| 1522 | if (tpossCount(tprhs) > 0 && tpossCount(abTPoss(absyn)((absyn)->abHdr.type.poss)) != 1) |
| 1523 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 1524 | |
| 1525 | tpossFree(tplhs); |
| 1526 | tpossFree(tprhs); |
| 1527 | |
| 1528 | if (DEBUG(tipAssign)tipAssignDebug) { |
| 1529 | TPoss tposs = abTPoss(absyn)((absyn)->abHdr.type.poss); |
| 1530 | fprintf(dbOut,"Bup: Assignment to "); |
| 1531 | abPrint(dbOut, lhs); |
| 1532 | fprintf(dbOut,"has %d types ", tpossCount(tposs)); |
| 1533 | tpossPrint(dbOut, tposs); |
| 1534 | fnewline(dbOut); |
| 1535 | } |
| 1536 | } |
| 1537 | |
| 1538 | |
| 1539 | /**************************************************************************** |
| 1540 | * |
| 1541 | * :: Declare: a: A |
| 1542 | * |
| 1543 | ***************************************************************************/ |
| 1544 | |
| 1545 | localstatic void |
| 1546 | tibupDeclare(Stab stab, AbSyn absyn, TForm type) |
| 1547 | { |
| 1548 | AbSyn id = absyn->abDeclare.id; |
| 1549 | AbSyn idtype = absyn->abDeclare.type; |
| 1550 | TPoss tp, ntp; |
| 1551 | Bool tupe = (abUse(absyn)((absyn)->abHdr.use) == AB_Use_Type); |
| 1552 | Bool defn = (abUse(absyn)((absyn)->abHdr.use) == AB_Use_Define) || |
| 1553 | (abUse(absyn)((absyn)->abHdr.use) == AB_Use_Assign); |
| 1554 | |
| 1555 | tiGetTForm(stab, idtype); |
| 1556 | |
| 1557 | tibup(stab, id, abTForm(idtype)((idtype)->abHdr.seman ? (idtype)->abHdr.seman->tform : 0)); |
| 1558 | |
| 1559 | if (abIsNothing(id)((id)->abHdr.tag == (AB_Nothing))) |
| 1560 | tp = tpossSingleton(abTForm(idtype)((idtype)->abHdr.seman ? (idtype)->abHdr.seman->tform : 0)); |
| 1561 | else if (defn) |
| 1562 | tp = abReferTPoss(id); |
| 1563 | else |
| 1564 | tp = abReferTPoss(idtype); |
| 1565 | |
| 1566 | if (!defn && !tupe) { |
| 1567 | ntp = tpossSatisfiesType(tp, type); |
| 1568 | tpossFree(tp); |
| 1569 | tp = ntp; |
| 1570 | } |
| 1571 | |
| 1572 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tp; |
| 1573 | |
| 1574 | if (DEBUG(tipDeclare)tipDeclareDebug) { |
| 1575 | TPoss tposs = abGoodTPoss(absyn)(((absyn)->abHdr.state) == AB_State_Error ? ((void*)0) :(( absyn)->abHdr.type.poss)); |
| 1576 | fprintf(dbOut,"Bup: Declare of "); |
| 1577 | abPrint(dbOut, id); |
| 1578 | fprintf(dbOut," has %d types ", tpossCount(tposs)); |
| 1579 | tpossPrint(dbOut, tposs); |
| 1580 | fnewline(dbOut); |
| 1581 | } |
| 1582 | } |
| 1583 | |
| 1584 | /**************************************************************************** |
| 1585 | * |
| 1586 | * :: Label: @@ x @@ [e] |
| 1587 | * |
| 1588 | ***************************************************************************/ |
| 1589 | |
| 1590 | localstatic void |
| 1591 | tibupLabel(Stab stab, AbSyn absyn, TForm type) |
| 1592 | { |
| 1593 | AbSyn expr = absyn->abLabel.expr; |
| 1594 | tibup(stab, expr, type); |
| 1595 | #if 0 |
| 1596 | if (abState(expr)((expr)->abHdr.state) == AB_State_Error) |
| 1597 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 1598 | #endif |
| 1599 | abTPoss(absyn)((absyn)->abHdr.type.poss) = abReferTPoss(expr); |
| 1600 | } |
| 1601 | |
| 1602 | /**************************************************************************** |
| 1603 | * |
| 1604 | * :: Goto: goto id |
| 1605 | * |
| 1606 | ***************************************************************************/ |
| 1607 | |
| 1608 | localstatic void |
| 1609 | tibupGoto(Stab stab, AbSyn absyn, TForm type) |
| 1610 | { |
| 1611 | AbSyn label, l0; |
| 1612 | AbSynList labelList; |
| 1613 | Syme syme; |
| 1614 | |
| 1615 | label = absyn->abGoto.label; |
| 1616 | labelList = stabGetLabels(stab, label->abId.sym); |
| 1617 | |
| 1618 | if (!labelList) { |
| 1619 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 1620 | } |
| 1621 | else { |
| 1622 | l0 = car(labelList)((labelList)->first); |
| 1623 | listFree(AbSyn)(AbSyn_listPointer->Free)(labelList); |
| 1624 | |
| 1625 | syme = abSyme(l0)((l0)->abHdr.seman ? (l0)->abHdr.seman->syme : 0); |
| 1626 | assert(syme)do { if (!(syme)) _do_assert(("syme"),"ti_bup.c",1626); } while (0); |
| 1627 | symeSetDVMark(syme, symeDVMark(syme) + 1)(symeSetFieldVal = ((AInt) (((UShort) (SYFI_DVMark < (8 * sizeof (int)) && !(((((syme)->kind == SYME_Trigger ? libGetAllSymes ((syme)->lib) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_DVMark))) ? (symeFieldInfo[SYFI_DVMark].def) : (((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)-> lib) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_DVMark ))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes(( syme)->lib) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_DVMark))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_DVMark )] : (symeFieldInfo[SYFI_DVMark].def)) : symeGetFieldFn(syme, SYFI_DVMark))) + 1)), (((((syme)->kind == SYME_Trigger ? libGetAllSymes ((syme)->lib) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_DVMark))) ? (((syme)->fieldv)[symeIndex(syme ,SYFI_DVMark)] = (symeSetFieldVal)) : !((syme)->full) && symeSetFieldVal == (symeFieldInfo[SYFI_DVMark].def) ? symeSetFieldVal : symeSetFieldFn(syme,SYFI_DVMark,symeSetFieldVal)); |
| 1628 | abSetSyme(label, syme); |
| 1629 | } |
| 1630 | |
| 1631 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfExit); |
| 1632 | } |
| 1633 | |
| 1634 | /**************************************************************************** |
| 1635 | * |
| 1636 | * :: Lambda: (a: A): B +-> b |
| 1637 | * :: PLambda: (a: A): B +->* b |
| 1638 | * |
| 1639 | ***************************************************************************/ |
| 1640 | |
| 1641 | localstatic void |
| 1642 | tibupLambda(Stab stab, AbSyn absyn, TForm type) |
| 1643 | { |
| 1644 | Scope("tibupLambda")String scopeName = ("tibupLambda"); int fluidLevel0 = (scopeLevel ++, fluidLevel); |
| 1645 | AbSyn param = absyn->abLambda.param; |
| 1646 | AbSyn ret = absyn->abLambda.rtype; |
| 1647 | AbSyn body = absyn->abLambda.body; |
| 1648 | TForm tf = tiGetTForm(stab, ret); |
| 1649 | Bool pack = abHasTag(absyn, AB_PLambda)((absyn)->abHdr.tag == (AB_PLambda)); |
| 1650 | |
| 1651 | TPoss fluid(tuniReturnTPoss)fluidSave_tuniReturnTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniReturnTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniReturnTPoss , fluidStack[fluidLevel].size = sizeof(tuniReturnTPoss), fluidLevel ++, (tuniReturnTPoss) ); |
| 1652 | TPoss fluid(tuniYieldTPoss)fluidSave_tuniYieldTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniYieldTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniYieldTPoss , fluidStack[fluidLevel].size = sizeof(tuniYieldTPoss), fluidLevel ++, (tuniYieldTPoss) ); |
| 1653 | TForm fluid(tuniYieldType)fluidSave_tuniYieldType = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniYieldType ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniYieldType , fluidStack[fluidLevel].size = sizeof(tuniYieldType), fluidLevel ++, (tuniYieldType) ); |
| 1654 | TPoss fluid(tuniExitTPoss)fluidSave_tuniExitTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniExitTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniExitTPoss , fluidStack[fluidLevel].size = sizeof(tuniExitTPoss), fluidLevel ++, (tuniExitTPoss) ); |
| 1655 | SymbolList fluid(terrorIdComplaints)fluidSave_terrorIdComplaints = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(terrorIdComplaints ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_terrorIdComplaints , fluidStack[fluidLevel].size = sizeof(terrorIdComplaints), fluidLevel ++, (terrorIdComplaints) ); |
| 1656 | |
| 1657 | tuniReturnTPoss = tuniInappropriateTPoss((TPoss) 12L); |
| 1658 | tuniYieldTPoss = tuniInappropriateTPoss((TPoss) 12L); |
| 1659 | tuniYieldType = tfUnknown; |
| 1660 | tuniExitTPoss = tuniInappropriateTPoss((TPoss) 12L); |
| 1661 | terrorIdComplaints = 0; |
| 1662 | |
| 1663 | tuniReturnTPoss = tpossSingleton(tf); |
| 1664 | typeInferAs(stab, param, tfUnknown); |
| 1665 | tibup(stab, body, tf); |
| 1666 | |
| 1667 | /* There can be only one type for this lambda ... */ |
| 1668 | tf = tfAnyMap(tfFullFrAbSyn(stab, param), tf, pack); |
| 1669 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tf); |
| 1670 | |
| 1671 | listFree(Symbol)(Symbol_listPointer->Free)(terrorIdComplaints); |
| 1672 | ReturnNothing{ fluidUnwind(fluidLevel0, ((int) 0)); return;; }; |
| 1673 | } |
| 1674 | |
| 1675 | /**************************************************************************** |
| 1676 | * |
| 1677 | * :: Sequence: (a; b; c) |
| 1678 | * |
| 1679 | ***************************************************************************/ |
| 1680 | |
| 1681 | localstatic void |
| 1682 | tibupSequence(Stab stab, AbSyn absyn, TForm type) |
| 1683 | { |
| 1684 | Scope("tibupSequence")String scopeName = ("tibupSequence"); int fluidLevel0 = (scopeLevel ++, fluidLevel); |
| 1685 | TPoss fluid(tuniExitTPoss)fluidSave_tuniExitTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniExitTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniExitTPoss , fluidStack[fluidLevel].size = sizeof(tuniExitTPoss), fluidLevel ++, (tuniExitTPoss) ); |
| 1686 | TForm fluid(tuniExitType)fluidSave_tuniExitType = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniExitType ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniExitType , fluidStack[fluidLevel].size = sizeof(tuniExitType), fluidLevel ++, (tuniExitType) ); |
| 1687 | TPoss fluid(tuniSelectTPoss)fluidSave_tuniSelectTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniSelectTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniSelectTPoss , fluidStack[fluidLevel].size = sizeof(tuniSelectTPoss), fluidLevel ++, (tuniSelectTPoss) ); |
| 1688 | AbSyn fluid(tuniBupSelectObj)fluidSave_tuniBupSelectObj = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniBupSelectObj ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniBupSelectObj , fluidStack[fluidLevel].size = sizeof(tuniBupSelectObj), fluidLevel ++, (tuniBupSelectObj) ); |
| 1689 | |
| 1690 | tuniSelectTPoss = NULL((void*)0); |
| 1691 | tuniBupSelectObj = NULL((void*)0); |
| 1692 | |
| 1693 | if (abUse(absyn)((absyn)->abHdr.use) == AB_Use_NoValue || tfIsNone(type)((((type)->tag) == TF_Multiple) && tfMultiArgc(type ) == 0)) |
| 1694 | tuniExitTPoss = tuniNoValueTPoss((TPoss) 4L); |
| 1695 | else |
| 1696 | tuniExitTPoss = tuniUnknownTPoss((TPoss) 8L); |
| 1697 | |
| 1698 | tuniExitType = type; |
| 1699 | |
| 1700 | tibupSequence0(stab, absyn, type); |
| 1701 | |
| 1702 | ReturnNothing{ fluidUnwind(fluidLevel0, ((int) 0)); return;; }; |
| 1703 | } |
| 1704 | |
| 1705 | localstatic void |
| 1706 | tibupSequence0(Stab stab, AbSyn absyn, TForm type) |
| 1707 | { |
| 1708 | Length i, n = abArgc(absyn)((absyn)->abHdr.argc); |
| 1709 | |
| 1710 | if (n == 0) |
| 1711 | tibup0NoValue(stab, absyn, type, ALDOR_E_TinContextSeq178); |
| 1712 | else { |
| 1713 | AbSyn arg; |
| 1714 | TPoss tp; |
| 1715 | |
| 1716 | for (i = 0; i < n-1; i++) |
| 1717 | tibup(stab, abArgv(absyn)((absyn)->abGen.data.argv)[i], tfUnknown); |
| 1718 | |
| 1719 | arg = abArgv(absyn)((absyn)->abGen.data.argv)[n-1]; |
| 1720 | tibup0FarValue(stab, absyn, type, arg, &tuniExitTPoss); |
| 1721 | |
| 1722 | if (tuniIsNoValue(tuniExitTPoss)((tuniExitTPoss) == ((TPoss) 4L))) |
| 1723 | tuniExitTPoss = tpossSingleton(tfNone()tfMulti(0)); |
| 1724 | else if (tuniIsUnknown(tuniExitTPoss)((tuniExitTPoss) == ((TPoss) 8L))) |
| 1725 | tuniExitTPoss = abReferTPoss(arg); |
| 1726 | |
| 1727 | tp = tpossSatisfiesType(tuniExitTPoss, type); |
| 1728 | |
| 1729 | /* |
| 1730 | * If this context is completely unconstrained |
| 1731 | * and we cannot find any meanings for this |
| 1732 | * sequence then there is an error. Otherwise |
| 1733 | * the caller must deal with checking that the |
| 1734 | * set of possible types is sensible. |
| 1735 | */ |
| 1736 | if (tpossCount(tp) == 0 && tfIsUnknown(type)(((type)->tag) == TF_Unknown)) { |
| 1737 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 1738 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossEmpty(); |
| 1739 | tpossFree(tp); |
| 1740 | } |
| 1741 | else { |
| 1742 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tp; |
| 1743 | tpossFree(tuniExitTPoss); |
| 1744 | } |
| 1745 | } |
| 1746 | |
| 1747 | return; |
| 1748 | } |
| 1749 | |
| 1750 | /**************************************************************************** |
| 1751 | * |
| 1752 | * :: Exit: (...; b => x ; ...) |
| 1753 | * |
| 1754 | ***************************************************************************/ |
| 1755 | |
| 1756 | localstatic void |
| 1757 | tibupExit(Stab stab, AbSyn absyn, TForm type) |
| 1758 | { |
| 1759 | AbSyn test = absyn->abExit.test; |
| 1760 | AbSyn value = absyn->abExit.value; |
| 1761 | AbLogic saveCond; |
| 1762 | |
| 1763 | tibup(stab, test, tfUnknown); |
| 1764 | |
| 1765 | if (!tuniBupSelectObj) { |
| 1766 | /* |
| 1767 | * Cases in a select don't affect abCondKnown at the |
| 1768 | * moment. We could do better though because we know |
| 1769 | * that `t case v' holds for the exit branch. |
| 1770 | */ |
| 1771 | AbSyn nTest = abExpandDefs(stab, test); |
| 1772 | ablogAndPush(&abCondKnown, &saveCond, nTest, true1); |
| 1773 | } |
| 1774 | |
| 1775 | tibup0FarValue(stab, absyn, tuniExitType, value, &tuniExitTPoss); |
| 1776 | |
| 1777 | if (!tuniBupSelectObj) |
| 1778 | ablogAndPop (&abCondKnown, &saveCond); |
| 1779 | |
| 1780 | if (abState(absyn)((absyn)->abHdr.state) != AB_State_Error) |
| 1781 | tibup0NoValue(stab, absyn, type, ALDOR_E_TinContextExit175); |
| 1782 | } |
| 1783 | |
| 1784 | /*************************************************************************** |
| 1785 | * |
| 1786 | * :: return: return x, return; |
| 1787 | * |
| 1788 | ***************************************************************************/ |
| 1789 | |
| 1790 | localstatic void |
| 1791 | tibupReturn(Stab stab, AbSyn absyn, TForm type) |
| 1792 | { |
| 1793 | tibup0FarValue(stab, absyn, tfUnknown, absyn->abReturn.value, |
| 1794 | &tuniReturnTPoss); |
| 1795 | if (abState(absyn)((absyn)->abHdr.state) != AB_State_Error) |
| 1796 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfExit); |
| 1797 | } |
| 1798 | |
| 1799 | /**************************************************************************** |
| 1800 | * |
| 1801 | * :: Generate: generate [N] of (... yield ...) |
| 1802 | * |
| 1803 | ***************************************************************************/ |
| 1804 | |
| 1805 | localstatic void |
| 1806 | tibupGenerate(Stab stab, AbSyn absyn, TForm type) |
| 1807 | { |
| 1808 | Scope("tibupGenerate")String scopeName = ("tibupGenerate"); int fluidLevel0 = (scopeLevel ++, fluidLevel); |
| 1809 | TPoss tpossIt; |
| 1810 | TPossIterator tit; |
| 1811 | TForm t, inner; |
| 1812 | |
| 1813 | TPoss fluid(tuniReturnTPoss)fluidSave_tuniReturnTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniReturnTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniReturnTPoss , fluidStack[fluidLevel].size = sizeof(tuniReturnTPoss), fluidLevel ++, (tuniReturnTPoss) ); |
| 1814 | TPoss fluid(tuniYieldTPoss)fluidSave_tuniYieldTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniYieldTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniYieldTPoss , fluidStack[fluidLevel].size = sizeof(tuniYieldTPoss), fluidLevel ++, (tuniYieldTPoss) ); |
| 1815 | TPoss fluid(tuniExitTPoss)fluidSave_tuniExitTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniExitTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniExitTPoss , fluidStack[fluidLevel].size = sizeof(tuniExitTPoss), fluidLevel ++, (tuniExitTPoss) ); |
| 1816 | TForm fluid(tuniYieldType)fluidSave_tuniYieldType = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniYieldType ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniYieldType , fluidStack[fluidLevel].size = sizeof(tuniYieldType), fluidLevel ++, (tuniYieldType) ); |
| 1817 | TfGenType tfGenType; |
| 1818 | |
| 1819 | tuniReturnTPoss = tuniInappropriateTPoss((TPoss) 12L); |
| 1820 | tuniYieldTPoss = tuniInappropriateTPoss((TPoss) 12L); |
| 1821 | tuniExitTPoss = tuniInappropriateTPoss((TPoss) 12L); |
| 1822 | |
| 1823 | tuniYieldTPoss = tuniUnknownTPoss((TPoss) 8L); |
| 1824 | |
| 1825 | tfGenType = abFlag_IsNewIter(absyn)(((absyn)->abHdr.flags) == AB_Flag_NewIter) ? TFG_XGenerator : TFG_Generator; |
| 1826 | |
| 1827 | if (tfIsGenerator(type)(((type)->tag) == TF_Generator)) { |
| 1828 | inner = tfGeneratorArg(type)tfFollowArg(type, 0); |
| 1829 | } |
| 1830 | else if (tfIsXGenerator(type)(((type)->tag) == TF_XGenerator)) { |
| 1831 | inner = tfXGeneratorArg(type)tfFollowArg(type, 0); |
| 1832 | } |
| 1833 | else { |
| 1834 | inner = tfUnknown; |
| 1835 | } |
| 1836 | |
| 1837 | tuniYieldType = inner; |
| 1838 | |
| 1839 | tibup(stab, absyn->abGenerate.count, tfUnknown); |
| 1840 | tibup(stab, absyn->abGenerate.body, tfUnknown); |
| 1841 | |
| 1842 | if (tuniIsUnknown(tuniYieldTPoss)((tuniYieldTPoss) == ((TPoss) 8L))) { |
| 1843 | if (tfIsUnknown(inner)(((inner)->tag) == TF_Unknown)) |
| 1844 | tuniYieldTPoss = tpossSingleton(tfNone()tfMulti(0)); |
| 1845 | else |
| 1846 | tuniYieldTPoss = tpossSingleton(inner); |
| 1847 | } |
| 1848 | |
| 1849 | tpossIt = tpossEmpty(); |
| 1850 | |
| 1851 | for (tpossITER(tit,tuniYieldTPoss)((tit).possl = (tuniYieldTPoss ? (tuniYieldTPoss)->possl : ((void*)0))); tpossMORE(tit)((tit).possl); tpossSTEP(tit)((tit).possl = (((tit).possl)->rest))) { |
| 1852 | t = tpossELT(tit)tpossELT_(&tit); |
| 1853 | if (tfSatisfies(t, inner)) { |
| 1854 | if (tfIsMulti(t)(((t)->tag) == TF_Multiple)) t = tfCrossFrMulti(t); |
| 1855 | tpossIt = tpossAdd1(tpossIt, tfAnyGenerator(tfGenType, t)); |
| 1856 | } |
| 1857 | } |
| 1858 | |
| 1859 | if (!tfIsUnknown(type)(((type)->tag) == TF_Unknown) && !tfIsAnyGenerator(type)) { |
| 1860 | tpossFree(tpossIt); |
| 1861 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 1862 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossEmpty(); |
| 1863 | } |
| 1864 | else if (!tfIsUnknown(type)(((type)->tag) == TF_Unknown) && tfAnyGeneratorType(type) != tfGenType) { |
| 1865 | tpossFree(tpossIt); |
| 1866 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 1867 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossEmpty(); |
| 1868 | } |
| 1869 | else if (tpossCount(tpossIt) == 0 && |
| 1870 | tpossCount(tuniYieldTPoss) != 0) { |
| 1871 | tpossFree(tpossIt); |
| 1872 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 1873 | tpossIt = tpossEmpty(); |
| 1874 | for (tpossITER(tit,tuniYieldTPoss)((tit).possl = (tuniYieldTPoss ? (tuniYieldTPoss)->possl : ((void*)0))); |
| 1875 | tpossMORE(tit)((tit).possl); |
| 1876 | tpossSTEP(tit)((tit).possl = (((tit).possl)->rest))) { |
| 1877 | t = tpossELT(tit)tpossELT_(&tit); |
| 1878 | if (tfIsMulti(t)(((t)->tag) == TF_Multiple)) t = tfCrossFrMulti(t); |
| 1879 | tpossIt = tpossAdd1(tpossIt, tfAnyGenerator(tfGenType, t)); |
| 1880 | } |
| 1881 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossIt; |
| 1882 | tpossFree(tuniYieldTPoss); |
| 1883 | } |
| 1884 | else { |
| 1885 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossIt; |
| 1886 | tpossFree(tuniYieldTPoss); |
| 1887 | } |
| 1888 | |
| 1889 | ReturnNothing{ fluidUnwind(fluidLevel0, ((int) 0)); return;; }; |
| 1890 | } |
| 1891 | |
| 1892 | /*************************************************************************** |
| 1893 | * |
| 1894 | * :: Yield: yield x |
| 1895 | * |
| 1896 | ***************************************************************************/ |
| 1897 | |
| 1898 | localstatic void |
| 1899 | tibupYield(Stab stab, AbSyn absyn, TForm type) |
| 1900 | { |
| 1901 | tibup0FarValue(stab, absyn, tuniYieldType, absyn->abYield.value, |
| 1902 | &tuniYieldTPoss); |
| 1903 | if (abState(absyn)((absyn)->abHdr.state) != AB_State_Error) |
| 1904 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfExit); |
| 1905 | } |
| 1906 | |
| 1907 | /*************************************************************************** |
| 1908 | * |
| 1909 | * :: Reference: ref id |
| 1910 | * |
| 1911 | ***************************************************************************/ |
| 1912 | |
| 1913 | localstatic void |
| 1914 | tibupReference(Stab stab, AbSyn absyn, TForm type) |
| 1915 | { |
| 1916 | AbSyn body = absyn -> abReference.body; |
| 1917 | TPoss tp, tpRef; |
| 1918 | TPossIterator iter; |
| 1919 | TForm tf, inner; |
| 1920 | |
| 1921 | |
| 1922 | /* Check the body */ |
| 1923 | tibupRefArg(stab, body, tfUnknown); |
| 1924 | |
| 1925 | /* Get the type of the Ref argument */ |
| 1926 | if (tfIsReference(type)(((type)->tag) == TF_Reference)) |
| 1927 | inner = tfReferenceArg(type)tfFollowArg(type, 0); |
| 1928 | else |
| 1929 | inner = tfUnknown; |
| 1930 | |
| 1931 | |
| 1932 | /* |
| 1933 | * Convert: e -> Ref(e) for all e in tp. In the process |
| 1934 | * we filter our any maps (functions) since we can't take |
| 1935 | * references of function applications. |
| 1936 | */ |
| 1937 | tp = abReferTPoss(body); |
| 1938 | tpRef = tpossEmpty(); |
| 1939 | for (tpossITER(iter, tp)((iter).possl = (tp ? (tp)->possl : ((void*)0))); tpossMORE(iter)((iter).possl); tpossSTEP(iter)((iter).possl = (((iter).possl)->rest))) |
| 1940 | { |
| 1941 | tf = tpossELT(iter)tpossELT_(&iter); |
| 1942 | if (tfSatisfies(tf, inner)) |
| 1943 | { |
| 1944 | /* Multi's are converted into Cross's */ |
| 1945 | if (tfIsMulti(tf)(((tf)->tag) == TF_Multiple)) |
| 1946 | tf = tfCrossFrMulti(tf); |
| 1947 | |
| 1948 | |
| 1949 | /* Convert e -> Ref(e) */ |
| 1950 | tpRef = tpossAdd1(tpRef, tfReference(tf)); |
| 1951 | } |
| 1952 | } |
| 1953 | |
| 1954 | |
| 1955 | /* Check the type context and the possible types */ |
| 1956 | if (!tfIsUnknown(type)(((type)->tag) == TF_Unknown) && !tfIsReference(type)(((type)->tag) == TF_Reference)) |
| 1957 | { |
| 1958 | /* This ought not to happen? */ |
| 1959 | tpossFree(tpRef); |
| 1960 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 1961 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossEmpty(); |
| 1962 | } |
| 1963 | else if ((tpossCount(tpRef) == 0) && (tpossCount(tp) == 0)) |
| 1964 | { |
| 1965 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 1966 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpRef; |
| 1967 | } |
| 1968 | else if ((tpossCount(tpRef) == 0) && (tpossCount(tp) != 0)) |
| 1969 | { |
| 1970 | /* |
| 1971 | * There were some possible types for the expression that |
| 1972 | * the user wants to make a reference of. However, none |
| 1973 | * were suitable for our needs, either because they were |
| 1974 | * mappings/functions or because they don't satisfy the |
| 1975 | * type context. |
| 1976 | * |
| 1977 | * Set the error flag and recompute the set of possible |
| 1978 | * types that we ignored since they weren't any good. The |
| 1979 | * error messaging system can use these types to tell the |
| 1980 | * user which ones were considered and discarded. |
| 1981 | * |
| 1982 | * Our error message is going to be somewhat confusing. |
| 1983 | * At the moment they will get something akin to the |
| 1984 | * classic S-algol error "int and int are not compatible". |
| 1985 | */ |
| 1986 | tpossFree(tpRef); |
| 1987 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 1988 | |
| 1989 | tpRef = tpossEmpty(); |
| 1990 | for (tpossITER(iter,tp)((iter).possl = (tp ? (tp)->possl : ((void*)0))); tpossMORE(iter)((iter).possl); tpossSTEP(iter)((iter).possl = (((iter).possl)->rest))) |
| 1991 | { |
| 1992 | tf = tpossELT(iter)tpossELT_(&iter); |
| 1993 | |
| 1994 | if (tfIsMulti(tf)(((tf)->tag) == TF_Multiple)) |
| 1995 | tf = tfCrossFrMulti(tf); |
| 1996 | |
| 1997 | tpRef = tpossAdd1(tpRef, tfReference(tf)); |
| 1998 | } |
| 1999 | |
| 2000 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpRef; |
| 2001 | } |
| 2002 | else |
| 2003 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpRef; |
| 2004 | } |
| 2005 | |
| 2006 | /* |
| 2007 | * Ensure that ref() arguments aren't |
| 2008 | * function applications or other |
| 2009 | * unsuitable items |
| 2010 | */ |
| 2011 | localstatic void |
| 2012 | tibupRefArg(Stab stab, AbSyn absyn, TForm type) |
| 2013 | { |
| 2014 | |
| 2015 | |
| 2016 | /* Type infer the whole expression first */ |
| 2017 | tibup(stab, absyn, type); |
| 2018 | |
| 2019 | |
| 2020 | /* If it isn't an application then we've finished */ |
| 2021 | if (!abIsApply(absyn)((absyn)->abHdr.tag == (AB_Apply))) |
| 2022 | return; |
| 2023 | |
| 2024 | |
| 2025 | /* |
| 2026 | * At the moment we only permit references of identifiers. In |
| 2027 | * future we would like to allow references of array/record |
| 2028 | * elements. This can be generalised to any domain which has |
| 2029 | * suitable apply/set! operators hinting that it is some form |
| 2030 | * of updatable aggregate. If the domain has these operators |
| 2031 | * and is a functional aggregate then the user ought not to |
| 2032 | * be taking references anyway ... |
| 2033 | */ |
| 2034 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 2035 | return; |
| 2036 | |
| 2037 | |
| 2038 | /* Get all possible meanings */ |
| 2039 | tibup0RefImps(stab, absyn, type); |
| 2040 | } |
| 2041 | |
| 2042 | |
| 2043 | localstatic void |
| 2044 | tibup0RefImps(Stab stab, AbSyn absyn, TForm type) |
| 2045 | { |
| 2046 | AbSyn op; |
| 2047 | TPossIterator iter; |
| 2048 | Length i; |
| 2049 | TPoss opTypes; |
| 2050 | TPoss nopTypes = tpossEmpty(); |
| 2051 | TPoss retTypes = tpossEmpty(); |
| 2052 | TPoss bangTypes = tpossEmpty(); |
| 2053 | SatMask mask = tfSatBupMask(); |
| 2054 | SatMask result; |
| 2055 | |
| 2056 | |
| 2057 | /* First identify all set! exports */ |
| 2058 | op = abNewId(abPos(absyn), ssymSetBang)abNew(AB_Id, (spstackFirst((absyn)->abHdr.pos)),1, ssymSetBang ); |
| 2059 | tibup(stab, op, tfUnknown); |
| 2060 | opTypes = abReferTPoss(op); |
| 2061 | |
| 2062 | |
| 2063 | /* Clean up the tposs */ |
| 2064 | for (tpossITER(iter,opTypes)((iter).possl = (opTypes ? (opTypes)->possl : ((void*)0))); tpossMORE(iter)((iter).possl); tpossSTEP(iter)((iter).possl = (((iter).possl)->rest))) |
| 2065 | { |
| 2066 | TForm opType = tpossELT(iter)tpossELT_(&iter); |
| 2067 | |
| 2068 | |
| 2069 | /* Extract the true type of this operator */ |
| 2070 | opType = tfDefineeType(opType); |
| 2071 | if (!tfIsAnyMap(opType)((((opType)->tag) == TF_Map) || (((opType)->tag) == TF_PackedMap ))) continue; |
| 2072 | |
| 2073 | |
| 2074 | /* Multi's are converted into Cross's */ |
| 2075 | if (tfIsMulti(opType)(((opType)->tag) == TF_Multiple)) |
| 2076 | opType = tfCrossFrMulti(opType); |
| 2077 | |
| 2078 | |
| 2079 | /* Add it to our set of possible types */ |
| 2080 | bangTypes = tpossAdd1(bangTypes, opType); |
| 2081 | } |
| 2082 | |
| 2083 | |
| 2084 | /* Free up opTypes */ |
| 2085 | tpossFree(opTypes); |
| 2086 | |
| 2087 | |
| 2088 | /* Only interested in implicit apply operations */ |
| 2089 | op = abNewId(abPos(absyn), ssymApply)abNew(AB_Id, (spstackFirst((absyn)->abHdr.pos)),1, ssymApply ); |
| 2090 | tibup(stab, op, tfUnknown); |
| 2091 | opTypes = abReferTPoss(op); |
| 2092 | |
| 2093 | |
| 2094 | /* |
| 2095 | * Filter out any application where the symbol being applied |
| 2096 | * comes from a domain which doesn't export both |
| 2097 | * apply : (%, SingleInteger) -> T |
| 2098 | * set! : (%, SingleInteger, T) -> T |
| 2099 | * This is too weak in general but will suffice for now |
| 2100 | * since detecting function applications is tricky. |
| 2101 | * |
| 2102 | * Note that we know there must be a suitable apply() operator |
| 2103 | * since this will have been picked up with the tibup() above. |
| 2104 | * We can use this to obtain the type T and check if there |
| 2105 | * is an equivalent set!() export. |
| 2106 | */ |
| 2107 | for (tpossITER(iter,opTypes)((iter).possl = (opTypes ? (opTypes)->possl : ((void*)0))); tpossMORE(iter)((iter).possl); tpossSTEP(iter)((iter).possl = (((iter).possl)->rest))) |
| 2108 | { |
| 2109 | TForm opType = tpossELT(iter)tpossELT_(&iter), retType; |
| 2110 | AbSub sigma; |
| 2111 | |
| 2112 | |
| 2113 | /* Extract the true type of this operator */ |
| 2114 | opType = tfDefineeType(opType); |
| 2115 | if (!tfIsAnyMap(opType)((((opType)->tag) == TF_Map) || (((opType)->tag) == TF_PackedMap ))) continue; |
| 2116 | |
| 2117 | |
| 2118 | /* Multi's are converted into Cross's */ |
| 2119 | if (tfIsMulti(opType)(((opType)->tag) == TF_Multiple)) |
| 2120 | opType = tfCrossFrMulti(opType); |
| 2121 | |
| 2122 | |
| 2123 | /* Determine the return type */ |
| 2124 | retType = tfMapRet(opType)tfFollowArg(opType, 1); |
| 2125 | |
| 2126 | |
| 2127 | /* Create a substitution map and check satisfaction */ |
| 2128 | sigma = absNew(stab); |
| 2129 | result = tfSatMapArgs(mask, sigma, opType, absyn, |
| 2130 | abArgc(absyn)((absyn)->abHdr.argc), abArgf); |
| 2131 | |
| 2132 | if (tfSatSucceed(result)) { |
| 2133 | retType = tformSubst(sigma, retType); |
| 2134 | result = tfSat(mask, retType, type); |
| 2135 | if (tfSatSucceed(result)) { |
| 2136 | nopTypes = tpossAdd1(nopTypes, opType); |
| 2137 | retTypes = tpossAdd1(retTypes, retType); |
| 2138 | } |
| 2139 | } |
| 2140 | |
| 2141 | absFreeDeeply(sigma); |
| 2142 | } |
| 2143 | |
| 2144 | |
| 2145 | /* |
| 2146 | * rettypes - these are the types for the whole expression |
| 2147 | * noptypes - these are the types of specific apply operators |
| 2148 | */ |
| 2149 | /* If the op and the parts had no meaning, then give an error. */ |
| 2150 | if (tpossCount(nopTypes) == 0) { |
| 2151 | Bool giveMsg = tpossCount(opTypes) > 0 |
| 2152 | || tibup0ApplyGiveMessage(absyn, abArgc(absyn)((absyn)->abHdr.argc), abApplyArgf); |
| 2153 | |
| 2154 | if (giveMsg) { |
| 2155 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 2156 | abState(op)((op)->abHdr.state) = AB_State_Error; |
| 2157 | } |
| 2158 | else { |
| 2159 | if (tpossCount( opTypes ) == 0) |
| 2160 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 2161 | |
| 2162 | abResetTPoss(op, nopTypes); |
| 2163 | } |
| 2164 | } |
| 2165 | else |
| 2166 | abResetTPoss(op, nopTypes); |
| 2167 | |
| 2168 | abResetTPoss(absyn, retTypes); |
| 2169 | tpossFree(opTypes); |
| 2170 | } |
| 2171 | |
| 2172 | |
| 2173 | /**************************************************************************** |
| 2174 | * |
| 2175 | * :: Add: [D] add (a: A == ...) |
| 2176 | * |
| 2177 | ***************************************************************************/ |
| 2178 | |
| 2179 | localstatic void |
| 2180 | tibupAdd(Stab stab, AbSyn absyn, TForm type) |
| 2181 | { |
| 2182 | Scope("tibupAdd")String scopeName = ("tibupAdd"); int fluidLevel0 = (scopeLevel ++, fluidLevel); |
| 2183 | SymbolList fluid(terrorIdComplaints)fluidSave_terrorIdComplaints = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(terrorIdComplaints ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_terrorIdComplaints , fluidStack[fluidLevel].size = sizeof(terrorIdComplaints), fluidLevel ++, (terrorIdComplaints) ); |
| 2184 | AbSyn base = absyn->abAdd.base; |
| 2185 | AbSyn capsule = absyn->abAdd.capsule; |
| 2186 | SymeList symes; |
| 2187 | TForm tfw; |
| 2188 | |
| 2189 | terrorIdComplaints = listNil(Symbol)((SymbolList) 0); |
| 2190 | |
| 2191 | tiGetTForm(stab, base); |
| 2192 | typeInferCheck(stab, base, tfDomain); |
| 2193 | symes = tiAddSymes(stab, capsule, abTForm(base)((base)->abHdr.seman ? (base)->abHdr.seman->tform : 0 ), type, (SymeList*)NULL((void*)0)); |
| 2194 | |
| 2195 | typeInferAs(stab, capsule, tfUnknown); |
| 2196 | |
| 2197 | if (symes) { |
| 2198 | if (tiIsSoftMissing()) { |
| 2199 | terrorNotEnoughExports(stab, absyn, |
| 2200 | tpossSingleton(tfWithFrSymes(symes)), true1); |
| 2201 | tfw = tfWithFrAbSyn(absyn); |
| 2202 | } |
| 2203 | else { |
| 2204 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 2205 | tfw = tfWithFrSymes(symes); |
| 2206 | tfSetSelf(tfw, tfGetCatSelf(type))((tfw)->self = (tfGetCatSelf(type))); |
| 2207 | } |
| 2208 | } |
| 2209 | else |
| 2210 | tfw = tfWithFrAbSyn(absyn); |
| 2211 | |
| 2212 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfw); |
| 2213 | if (!tfSatisfies(tfw, type)) |
| 2214 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 2215 | |
| 2216 | listFree(Symbol)(Symbol_listPointer->Free)(terrorIdComplaints); |
| 2217 | ReturnNothing{ fluidUnwind(fluidLevel0, ((int) 0)); return;; }; |
| 2218 | } |
| 2219 | |
| 2220 | /**************************************************************************** |
| 2221 | * |
| 2222 | * :: With: [C] with (a: A; ...) |
| 2223 | * |
| 2224 | ***************************************************************************/ |
| 2225 | |
| 2226 | localstatic void |
| 2227 | tibupWith(Stab stab, AbSyn absyn, TForm type) |
| 2228 | { |
| 2229 | Scope("tibupWith")String scopeName = ("tibupWith"); int fluidLevel0 = (scopeLevel ++, fluidLevel); |
| 2230 | AbSyn base = absyn->abWith.base; |
| 2231 | AbSyn within = absyn->abWith.within; |
| 2232 | SymeList bsymes, wsymes, symes = listNil(Syme)((SymeList) 0); |
| 2233 | SymeList mods = listNil(Syme)((SymeList) 0); |
| 2234 | TForm wtf, tf; |
| 2235 | |
| 2236 | SymbolList fluid(terrorIdComplaints)fluidSave_terrorIdComplaints = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(terrorIdComplaints ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_terrorIdComplaints , fluidStack[fluidLevel].size = sizeof(terrorIdComplaints), fluidLevel ++, (terrorIdComplaints) ); |
| 2237 | terrorIdComplaints = 0; |
| 2238 | |
| 2239 | typeInferAs(stab, base, tfCategory); |
| 2240 | typeInferCheck(stab, base, tfCategory); |
| 2241 | bsymes = abGetCatExports(base); |
| 2242 | |
| 2243 | wtf = tibup0Within(stab, within, bsymes, true1); |
| 2244 | wsymes = tfGetThdExports(wtf); |
| 2245 | |
| 2246 | symes = tfJoinExportLists(mods, symes, bsymes, NULL((void*)0)); |
| 2247 | symes = tfJoinExportLists(mods, symes, wsymes, NULL((void*)0)); |
| 2248 | |
| 2249 | tf = tfThird(symes); |
| 2250 | tfAddSelf(tf, abGetCatSelf(base)); |
| 2251 | tfAddSelf(tf, tfGetThdSelf(wtf)); |
| 2252 | |
| 2253 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tf); |
| 2254 | |
| 2255 | listFree(Symbol)(Symbol_listPointer->Free)(terrorIdComplaints); |
| 2256 | ReturnNothing{ fluidUnwind(fluidLevel0, ((int) 0)); return;; }; |
| 2257 | } |
| 2258 | |
| 2259 | /**************************************************************************** |
| 2260 | * |
| 2261 | * :: Where: e where d |
| 2262 | * |
| 2263 | ***************************************************************************/ |
| 2264 | |
| 2265 | localstatic void |
| 2266 | tibupWhere(Stab stab, AbSyn absyn, TForm type) |
| 2267 | { |
| 2268 | AbSyn context = absyn->abWhere.context; |
| 2269 | AbSyn expr = absyn->abWhere.expr; |
| 2270 | |
| 2271 | tibup(stab, context, tfUnknown); |
| 2272 | tibup(stab, expr, type); |
| 2273 | |
| 2274 | abTPoss(absyn)((absyn)->abHdr.type.poss) = abReferTPoss(expr); |
| 2275 | } |
| 2276 | |
| 2277 | /**************************************************************************** |
| 2278 | * |
| 2279 | * :: If: if b then t [else e] |
| 2280 | * |
| 2281 | ***************************************************************************/ |
| 2282 | |
| 2283 | localstatic void |
| 2284 | tibupIf(Stab stab, AbSyn absyn, TForm type) |
| 2285 | { |
| 2286 | AbSyn test = absyn->abIf.test; |
| 2287 | AbSyn thenAlt = absyn->abIf.thenAlt; |
| 2288 | AbSyn elseAlt = absyn->abIf.elseAlt; |
| 2289 | AbSyn nTest; |
| 2290 | AbLogic saveCond; |
| 2291 | |
| 2292 | /* |
| 2293 | * An unfixed compiler bug means that parts of Salli |
| 2294 | * programs (and thus libAldor) are tinfered with |
| 2295 | * (tfBoolean == tfUnknown). The correct fix is to |
| 2296 | * ensure that tfBoolean has been imported into every |
| 2297 | * scope that needs it before we get this far. |
| 2298 | */ |
| 2299 | if (tfBoolean == tfUnknown) comsgFatal(absyn, ALDOR_F_BugNoBoolean367); |
| 2300 | |
| 2301 | /* Completely analyze the test on the spot. */ |
| 2302 | typeInferAs(stab, test, tfBoolean); |
| 2303 | |
| 2304 | if (tfIsCategoryContext(type, absyn)) { |
| 2305 | SymeList tsymes, esymes, symes = listNil(Syme)((SymeList) 0); |
| 2306 | SymeList mods = listNil(Syme)((SymeList) 0); |
| 2307 | TForm ttf, etf, tf; |
| 2308 | Bool pending = false((int) 0); |
| 2309 | |
| 2310 | ablogAndPush(&abCondKnown, &saveCond, test, true1); |
| 2311 | ttf = tibup0Within(stab, thenAlt, listNil(Syme)((SymeList) 0), true1); |
| 2312 | ablogAndPop (&abCondKnown, &saveCond); |
| 2313 | |
| 2314 | if (!tfHasSelf(ttf)((ttf)->hasSelf)) pending = true1; |
| 2315 | tsymes = tfGetThdExports(ttf); |
| 2316 | |
| 2317 | ablogAndPush(&abCondKnown, &saveCond, test, false((int) 0)); |
| 2318 | etf = tibup0Within(stab, elseAlt, listNil(Syme)((SymeList) 0), true1); |
| 2319 | ablogAndPop (&abCondKnown, &saveCond); |
| 2320 | |
| 2321 | if (!tfHasSelf(etf)((etf)->hasSelf)) pending = true1; |
| 2322 | esymes = tfGetThdExports(etf); |
| 2323 | |
| 2324 | symes = tfJoinExportLists(mods, symes, tsymes, test); |
| 2325 | test = abNewNot(sposNone, test)abNew(AB_Not, sposNone,1, test); |
| 2326 | symes = tfJoinExportLists(mods, symes, esymes, test); |
| 2327 | |
| 2328 | tf = tfThird(symes); |
| 2329 | tfAddSelf(tf, tfGetThdSelf(ttf)); |
| 2330 | tfAddSelf(tf, tfGetThdSelf(etf)); |
| 2331 | |
| 2332 | if (pending) { |
| 2333 | tformFreeVars(tf); |
| 2334 | tfArgv(tf)((tf)->argv)[0] = tfFullFrAbSyn(stab, absyn); |
| 2335 | } |
| 2336 | |
| 2337 | abResetTPoss(absyn, tpossSingleton(tf)); |
| 2338 | |
| 2339 | return; |
| 2340 | } |
| 2341 | |
| 2342 | |
| 2343 | /* |
| 2344 | * Normalise the test condition for abCondKnown: this probably |
| 2345 | * ought to be done for categories as well - see titdnIf(). |
| 2346 | * |
| 2347 | * Note that we only use this for abCondKnown - we leave the |
| 2348 | * optimiser to do constant folding to optimise the test |
| 2349 | * during code generation. Thus even if abExpandDefs() is |
| 2350 | * broken we still generate the right code. |
| 2351 | */ |
| 2352 | nTest = abExpandDefs(stab, test); |
| 2353 | |
| 2354 | if (abIsSefo(nTest)(((nTest)->abHdr.state) == AB_State_HasUnique)) { |
| 2355 | ablogAndPush(&abCondKnown, &saveCond, nTest, true1); /* test, true); */ |
| 2356 | tibup(stab, thenAlt, type); |
| 2357 | ablogAndPop (&abCondKnown, &saveCond); |
| 2358 | |
| 2359 | ablogAndPush(&abCondKnown, &saveCond, nTest, false((int) 0)); /* test, false); */ |
| 2360 | tibup(stab, elseAlt, abIsNothing(elseAlt)((elseAlt)->abHdr.tag == (AB_Nothing)) ? tfUnknown : type); |
| 2361 | ablogAndPop (&abCondKnown, &saveCond); |
| 2362 | } |
| 2363 | else { |
| 2364 | tibup(stab, thenAlt, type); |
| 2365 | tibup(stab, elseAlt, abIsNothing(elseAlt)((elseAlt)->abHdr.tag == (AB_Nothing)) ? tfUnknown : type); |
| 2366 | } |
| 2367 | /* Analyze the branches in the presence of the condition. */ |
| 2368 | |
| 2369 | /* No value required. */ |
| 2370 | if (abUse(absyn)((absyn)->abHdr.use) == AB_Use_NoValue) |
| 2371 | abResetTPoss(absyn, tpossSingleton(tfNone()tfMulti(0))); |
| 2372 | |
| 2373 | /* Both branches present. */ |
| 2374 | else if (abIsNotNothing(elseAlt)!((elseAlt)->abHdr.tag == (AB_Nothing))) { |
| 2375 | TPoss thenPoss = abReferTPoss(thenAlt); |
| 2376 | TPoss elsePoss = abReferTPoss(elseAlt); |
| 2377 | |
| 2378 | abResetTPoss(absyn, tpossIntersect(thenPoss, elsePoss)); |
| 2379 | |
| 2380 | tpossFree(thenPoss); |
| 2381 | tpossFree(elsePoss); |
| 2382 | } |
| 2383 | |
| 2384 | /* One branch present. */ |
| 2385 | else { |
| 2386 | TPoss thenPoss = abReferTPoss(thenAlt); |
| 2387 | |
| 2388 | if (tpossHasSatisfier(thenPoss, tfCategory)) |
| 2389 | abResetTPoss(absyn, tpossRefer(thenPoss)); |
| 2390 | else |
| 2391 | tibup0NoValue(stab, absyn, type, ALDOR_E_TinContextIf176); |
| 2392 | |
| 2393 | tpossFree(thenPoss); |
| 2394 | } |
| 2395 | } |
| 2396 | |
| 2397 | /**************************************************************************** |
| 2398 | * |
| 2399 | * :: Test: implied test |
| 2400 | * |
| 2401 | ***************************************************************************/ |
| 2402 | |
| 2403 | AbSyn tibupSelectArgf(AbSyn ab, Length i) |
| 2404 | { |
| 2405 | if (i == 0) |
| 2406 | return tuniBupSelectObj; |
| 2407 | else |
| 2408 | return abArgv(ab)((ab)->abGen.data.argv)[i - 1]; |
| 2409 | } |
| 2410 | |
| 2411 | localstatic void |
| 2412 | tibupTest(Stab stab, AbSyn absyn, TForm type) |
| 2413 | { |
| 2414 | /* |
| 2415 | * An unfixed compiler bug means that parts of Salli |
| 2416 | * programs (and thus libAldor) are tinfered with |
| 2417 | * (tfBoolean == tfUnknown). The correct fix is to |
| 2418 | * ensure that tfBoolean has been imported into every |
| 2419 | * scope that needs it before we get this far. |
| 2420 | */ |
| 2421 | if (tfBoolean == tfUnknown) comsgFatal(absyn, ALDOR_F_BugNoBoolean367); |
| 2422 | |
| 2423 | if (tuniBupSelectObj != NULL((void*)0)) { |
| 2424 | tibup0ApplySym(stab, absyn, |
| 2425 | tfBoolean, |
| 2426 | ssymTheCase, |
| 2427 | 2, |
| 2428 | tibupSelectArgf, |
| 2429 | NULL((void*)0)); |
| 2430 | } |
| 2431 | else |
| 2432 | tibup0ApplySymIfNeeded(stab, absyn, tfBoolean, ssymTheTest, |
| 2433 | 1, abArgf, NULL((void*)0), tfIsBooleanFn); |
| 2434 | } |
| 2435 | |
| 2436 | /*************************************************************************** |
| 2437 | * |
| 2438 | * :: Collect: e <iter>* |
| 2439 | * |
| 2440 | ***************************************************************************/ |
| 2441 | |
| 2442 | localstatic TForm tibup0CollectGenerator(int iterType, TForm type); |
| 2443 | |
| 2444 | localstatic void |
| 2445 | tibupCollect(Stab stab, AbSyn absyn, TForm type) |
| 2446 | { |
| 2447 | Scope("tibupCollect")String scopeName = ("tibupCollect"); int fluidLevel0 = (scopeLevel ++, fluidLevel); |
| 2448 | AbSyn body = absyn->abCollect.body; |
| 2449 | AbSyn *iterv = absyn->abCollect.iterv; |
| 2450 | Length i, iterc = abCollectIterc(absyn)(((absyn)->abHdr.argc)-1); |
| 2451 | TPoss cposs, bposs; |
| 2452 | TPossIterator tit; |
| 2453 | |
| 2454 | TPoss fluid(tuniReturnTPoss)fluidSave_tuniReturnTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniReturnTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniReturnTPoss , fluidStack[fluidLevel].size = sizeof(tuniReturnTPoss), fluidLevel ++, (tuniReturnTPoss) ); |
| 2455 | TPoss fluid(tuniYieldTPoss)fluidSave_tuniYieldTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniYieldTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniYieldTPoss , fluidStack[fluidLevel].size = sizeof(tuniYieldTPoss), fluidLevel ++, (tuniYieldTPoss) ); |
| 2456 | TPoss fluid(tuniExitTPoss)fluidSave_tuniExitTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniExitTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniExitTPoss , fluidStack[fluidLevel].size = sizeof(tuniExitTPoss), fluidLevel ++, (tuniExitTPoss) ); |
| 2457 | Bool fluid(tloopBreakCount)fluidSave_tloopBreakCount = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tloopBreakCount ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tloopBreakCount , fluidStack[fluidLevel].size = sizeof(tloopBreakCount), fluidLevel ++, (tloopBreakCount) ); |
| 2458 | int iterType; |
| 2459 | |
| 2460 | tuniReturnTPoss = tuniInappropriateTPoss((TPoss) 12L); |
| 2461 | tuniYieldTPoss = tuniInappropriateTPoss((TPoss) 12L); |
| 2462 | tuniExitTPoss = tuniInappropriateTPoss((TPoss) 12L); |
| 2463 | tloopBreakCount = 0; |
| 2464 | |
| 2465 | for (i = 0; i < iterc; i++) |
| 2466 | tibup(stab, iterv[i], tfUnknown); |
| 2467 | |
| 2468 | iterType = 0; |
| 2469 | for (i = 0; i < iterc; i++) { |
| 2470 | iterType |= 1 << (abFlag_IsNewIter(iterv[i])(((iterv[i])->abHdr.flags) == AB_Flag_NewIter) ? 1 : 0); |
| 2471 | } |
| 2472 | |
| 2473 | tibup(stab, body, tfUnknown); |
| 2474 | |
| 2475 | bposs = abGoodTPoss(body)(((body)->abHdr.state) == AB_State_Error ? ((void*)0) :((body )->abHdr.type.poss)); |
| 2476 | cposs = tpossEmpty(); |
| 2477 | |
| 2478 | for (tpossITER(tit,bposs)((tit).possl = (bposs ? (bposs)->possl : ((void*)0))); tpossMORE(tit)((tit).possl); tpossSTEP(tit)((tit).possl = (((tit).possl)->rest))){ |
| 2479 | TForm t = tpossELT(tit)tpossELT_(&tit); |
| 2480 | TForm retType; |
| 2481 | SatMask result; |
| 2482 | tfFollow(t)((t) = tfFollowFn(t)); |
| 2483 | if (tfIsMulti(t)(((t)->tag) == TF_Multiple)) t = tfCrossFrMulti(t); |
| 2484 | retType = tibup0CollectGenerator(iterType, t); |
| 2485 | result = tfSat(tfSatBupMask(), retType, type); |
| 2486 | if (tfSatSucceed(result)) { |
| 2487 | cposs = tpossAdd1(cposs, retType); |
| 2488 | } |
| 2489 | } |
| 2490 | abTPoss(absyn)((absyn)->abHdr.type.poss) = cposs; |
| 2491 | |
| 2492 | ReturnNothing{ fluidUnwind(fluidLevel0, ((int) 0)); return;; }; |
| 2493 | } |
| 2494 | |
| 2495 | localstatic TForm |
| 2496 | tibup0CollectGenerator(int iterType, TForm type) |
| 2497 | { |
| 2498 | switch (iterType) { |
| 2499 | case 0: |
| 2500 | case 1: |
| 2501 | return tfGenerator(type); |
| 2502 | case 2: |
| 2503 | return tfXGenerator(type); |
| 2504 | default: |
| 2505 | bug("odd iterator"); |
| 2506 | } |
| 2507 | } |
| 2508 | |
| 2509 | |
| 2510 | /**************************************************************************** |
| 2511 | * |
| 2512 | * :: Repeat: <iter>* repeat e |
| 2513 | * |
| 2514 | ***************************************************************************/ |
| 2515 | |
| 2516 | localstatic void |
| 2517 | tibupRepeat(Stab stab, AbSyn absyn, TForm type) |
| 2518 | { |
| 2519 | Scope("tibupRepeat")String scopeName = ("tibupRepeat"); int fluidLevel0 = (scopeLevel ++, fluidLevel); |
| 2520 | |
| 2521 | Bool fluid(tloopBreakCount)fluidSave_tloopBreakCount = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tloopBreakCount ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tloopBreakCount , fluidStack[fluidLevel].size = sizeof(tloopBreakCount), fluidLevel ++, (tloopBreakCount) ); |
| 2522 | |
| 2523 | AbSyn body = absyn->abRepeat.body; |
| 2524 | AbSyn *iterv = absyn->abRepeat.iterv; |
| 2525 | Length i, iterc = abRepeatIterc(absyn)(((absyn)->abHdr.argc)-1); |
| 2526 | |
| 2527 | tloopBreakCount = 0; |
| 2528 | |
| 2529 | for (i = 0; i < iterc; i++) |
| 2530 | tibup(stab, iterv[i], tfUnknown); |
| 2531 | |
| 2532 | tibup(stab, body, tfUnknown); |
| 2533 | |
| 2534 | if (iterc == 0 && tloopBreakCount == 0) |
| 2535 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfExit); |
| 2536 | else |
| 2537 | tibup0NoValue(stab, absyn, type, ALDOR_E_TinContextRepeat177); |
| 2538 | |
| 2539 | ReturnNothing{ fluidUnwind(fluidLevel0, ((int) 0)); return;; }; |
| 2540 | } |
| 2541 | |
| 2542 | /*************************************************************************** |
| 2543 | * |
| 2544 | * :: Never |
| 2545 | * X |
| 2546 | ***************************************************************************/ |
| 2547 | |
| 2548 | localstatic void |
| 2549 | tibupNever(Stab stab, AbSyn absyn, TForm type) |
| 2550 | { |
| 2551 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfExit); |
| 2552 | } |
| 2553 | |
| 2554 | /*************************************************************************** |
| 2555 | * |
| 2556 | * :: Iterate |
| 2557 | * X |
| 2558 | ***************************************************************************/ |
| 2559 | |
| 2560 | localstatic void |
| 2561 | tibupIterate(Stab stab, AbSyn absyn, TForm type) |
| 2562 | { |
| 2563 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfExit); |
| 2564 | } |
| 2565 | |
| 2566 | /*************************************************************************** |
| 2567 | * |
| 2568 | * :: Break |
| 2569 | * X |
| 2570 | ***************************************************************************/ |
| 2571 | |
| 2572 | localstatic void |
| 2573 | tibupBreak(Stab stab, AbSyn absyn, TForm type) |
| 2574 | { |
| 2575 | if (tloopBreakCount == -1) { |
| 2576 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 2577 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossEmpty(); |
| 2578 | } |
| 2579 | else { |
| 2580 | tloopBreakCount++; |
| 2581 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfExit); |
| 2582 | } |
| 2583 | } |
| 2584 | |
| 2585 | /**************************************************************************** |
| 2586 | * |
| 2587 | * :: While: while c |
| 2588 | * |
| 2589 | ***************************************************************************/ |
| 2590 | |
| 2591 | localstatic void |
| 2592 | tibupWhile(Stab stab, AbSyn absyn, TForm type) |
| 2593 | { |
| 2594 | /* |
| 2595 | * An unfixed compiler bug means that parts of Salli |
| 2596 | * programs (and thus libAldor) are tinfered with |
| 2597 | * (tfBoolean == tfUnknown). The correct fix is to |
| 2598 | * ensure that tfBoolean has been imported into every |
| 2599 | * scope that needs it before we get this far. |
| 2600 | */ |
| 2601 | if (tfBoolean == tfUnknown) comsgFatal(absyn, ALDOR_F_BugNoBoolean367); |
| 2602 | tibup0Generic(stab, absyn, tfBoolean); |
| 2603 | } |
| 2604 | |
| 2605 | /*************************************************************************** |
| 2606 | * |
| 2607 | * :: For: for x in l | c |
| 2608 | * |
| 2609 | ***************************************************************************/ |
| 2610 | |
| 2611 | localstatic void |
| 2612 | tibupFor(Stab stab, AbSyn absyn, TForm type) |
| 2613 | { |
| 2614 | AbSyn lhs = absyn->abFor.lhs; |
| 2615 | AbSyn whole = absyn->abFor.whole; |
| 2616 | AbSyn test = absyn->abFor.test; |
| 2617 | TPoss tparg, tplhs, tp; |
| 2618 | Stab ostab = stab; |
| 2619 | |
| 2620 | /* |
| 2621 | * Subtle note: the generator in a for-iterator lies |
| 2622 | * outside the scope level of the repeat. This means |
| 2623 | * that we have to use cdr(stab) whenever we tinfer |
| 2624 | * absyn->abFor.whole or via abForIterArgf(). |
| 2625 | */ |
| 2626 | stab = cdr(stab)((stab)->rest); |
| 2627 | tibup(stab, whole, tfUnknown); |
| 2628 | if (!abFlag_IsNewIter(absyn)(((absyn)->abHdr.flags) == AB_Flag_NewIter)) { |
| 2629 | tibup0ApplySymIfNeeded(stab, absyn, tfUnknown, ssymTheGenerator, |
| 2630 | 1, abForIterArgf, NULL((void*)0), tfIsGeneratorFn); |
| 2631 | } |
| 2632 | else if (abFlag_IsNewIter(absyn)(((absyn)->abHdr.flags) == AB_Flag_NewIter)) { |
| 2633 | tibup0ApplySymIfNeeded(stab, absyn, tfUnknown, ssymTheXGenerator, |
| 2634 | 1, abForIterArgf, NULL((void*)0), tfIsXGeneratorFn); |
| 2635 | } |
| 2636 | else { |
| 2637 | bug("unknown iteration"); |
| 2638 | } |
| 2639 | stab = ostab; |
| 2640 | |
| 2641 | |
| 2642 | /* |
| 2643 | * The for-variable and test lie within the scope |
| 2644 | * of the repeat clause. |
| 2645 | */ |
| 2646 | tparg = tpossAnyGeneratorArg(abGoodTPoss(absyn)(((absyn)->abHdr.state) == AB_State_Error ? ((void*)0) :(( absyn)->abHdr.type.poss))); |
| 2647 | tibup0InferLhs(stab, absyn, lhs, test, tparg); /* !! test */ |
| 2648 | tibup(stab, lhs, tfUnknown); |
| 2649 | |
| 2650 | /* |
| 2651 | * An unfixed compiler bug means that parts of Salli |
| 2652 | * programs (and thus libAldor) are tinfered with |
| 2653 | * (tfBoolean == tfUnknown). The correct fix is to |
| 2654 | * ensure that tfBoolean has been imported into every |
| 2655 | * scope that needs it before we get this far. |
| 2656 | */ |
| 2657 | if (!abIsNothing(test)((test)->abHdr.tag == (AB_Nothing)) && tfBoolean == tfUnknown) |
| 2658 | comsgFatal(absyn, ALDOR_F_BugNoBoolean367); |
| 2659 | tibup(stab, test, abIsNothing(test)((test)->abHdr.tag == (AB_Nothing)) ? tfUnknown : tfBoolean); |
| 2660 | |
| 2661 | lhs = abTag(absyn->abFor.lhs)((absyn->abFor.lhs)->abHdr.tag) == AB_Comma ? lhs : abDefineeId(lhs); |
| 2662 | |
| 2663 | tplhs = abReferTPoss(lhs); |
| 2664 | tp = tpossSatisfies(tparg, tplhs); |
| 2665 | abResetTPoss(lhs, tp); |
| 2666 | tpossFree(tplhs); |
| 2667 | |
| 2668 | if (tpossCount(tparg) > 0 && tpossCount(tp) != 1) |
| 2669 | abState(absyn)((absyn)->abHdr.state) = AB_State_Error; |
| 2670 | |
| 2671 | if (abState(absyn)((absyn)->abHdr.state) == AB_State_Error) { |
| 2672 | tpossFree(tparg); |
| 2673 | return; |
| 2674 | } |
| 2675 | |
| 2676 | if (tpossIsUnique(tp) && !tpossIsUnique(abTPoss(absyn)((absyn)->abHdr.type.poss))) { |
| 2677 | TForm tf = tpossUnique(tp); |
| 2678 | tpossFree(abTPoss(absyn)((absyn)->abHdr.type.poss)); |
| 2679 | if (abFlag_IsNewIter(absyn)(((absyn)->abHdr.flags) == AB_Flag_NewIter)) |
| 2680 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfXGenerator(tf)); |
| 2681 | else |
| 2682 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfGenerator(tf)); |
| 2683 | } |
| 2684 | |
| 2685 | /* Avoid two error messages */ |
| 2686 | if (abState(whole)((whole)->abHdr.state) == AB_State_Error && |
| 2687 | abState(lhs)((lhs)->abHdr.state) == AB_State_Error) { |
| 2688 | abState(lhs)((lhs)->abHdr.state) = AB_State_HasPoss; |
| 2689 | abTPoss(lhs)((lhs)->abHdr.type.poss) = tpossEmpty(); |
| 2690 | } |
| 2691 | |
| 2692 | tpossFree(tparg); |
| 2693 | } |
| 2694 | |
| 2695 | /**************************************************************************** |
| 2696 | * |
| 2697 | * :: Foreign: import ... from Foreign(...) |
| 2698 | * |
| 2699 | ***************************************************************************/ |
| 2700 | |
| 2701 | localstatic void |
| 2702 | tibupForeignImport(Stab stab, AbSyn absyn, TForm type) |
| 2703 | { |
| 2704 | tibup(stab, absyn->abForeignImport.what, tfUnknown); |
| 2705 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfNone()tfMulti(0)); |
| 2706 | } |
| 2707 | |
| 2708 | /**************************************************************************** |
| 2709 | * |
| 2710 | * :: Foreign: import ... from Foreign(...) |
| 2711 | * |
| 2712 | ***************************************************************************/ |
| 2713 | |
| 2714 | localstatic void |
| 2715 | tibupForeignExport(Stab stab, AbSyn absyn, TForm type) |
| 2716 | { |
| 2717 | tibup(stab, absyn->abForeignExport.what, tfUnknown); |
| 2718 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfNone()tfMulti(0)); |
| 2719 | } |
| 2720 | |
| 2721 | /**************************************************************************** |
| 2722 | * |
| 2723 | * :: Import: import ... from D |
| 2724 | * |
| 2725 | ***************************************************************************/ |
| 2726 | |
| 2727 | localstatic void |
| 2728 | tibupImport(Stab stab, AbSyn absyn, TForm type) |
| 2729 | { |
| 2730 | AbSyn what = absyn->abImport.what; |
| 2731 | AbSyn from = absyn->abImport.origin; |
| 2732 | |
| 2733 | tiGetTForm(stab, from); |
| 2734 | typeInferCheck(stab, from, tfDomain); |
| 2735 | |
| 2736 | tibup0Within(stab, what, listNil(Syme)((SymeList) 0), true1); |
| 2737 | |
| 2738 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfNone()tfMulti(0)); |
| 2739 | } |
| 2740 | |
| 2741 | /**************************************************************************** |
| 2742 | * |
| 2743 | * :: Inline: inline .. from D |
| 2744 | * |
| 2745 | ***************************************************************************/ |
| 2746 | |
| 2747 | localstatic void |
| 2748 | tibupInline(Stab stab, AbSyn absyn, TForm type) |
| 2749 | { |
| 2750 | AbSyn what = absyn->abInline.what; |
| 2751 | AbSyn from = absyn->abInline.origin; |
| 2752 | |
| 2753 | tiGetTForm(stab, from); |
| 2754 | typeInferCheck(stab, from, tfDomain); |
| 2755 | |
| 2756 | tibup0Within(stab, what, listNil(Syme)((SymeList) 0), true1); |
| 2757 | |
| 2758 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfNone()tfMulti(0)); |
| 2759 | } |
| 2760 | |
| 2761 | /**************************************************************************** |
| 2762 | * |
| 2763 | * :: Qualify: A $ B |
| 2764 | * |
| 2765 | * ToDo: 3$Integer |
| 2766 | * |
| 2767 | ***************************************************************************/ |
| 2768 | |
| 2769 | localstatic void |
| 2770 | tibupQualify(Stab stab, AbSyn absyn, TForm type) |
| 2771 | { |
| 2772 | AbSyn origin = absyn->abQualify.origin; |
| 2773 | AbSyn what = absyn->abQualify.what; |
| 2774 | Symbol sym = what->abId.sym; |
| 2775 | |
| 2776 | Syme syme = 0; |
| 2777 | SymeList symes, msymes, fsymes; |
| 2778 | TPoss tposs = tpossEmpty(); |
| 2779 | TForm tforg; |
| 2780 | |
| 2781 | assert(abTag(what) == AB_Id)do { if (!(((what)->abHdr.tag) == AB_Id)) _do_assert(("abTag(what) == AB_Id" ),"ti_bup.c",2781); } while (0); |
| 2782 | tforg = tiGetTForm(stab, origin); |
| 2783 | typeInferCheck(stab, origin, tfDomain); |
| 2784 | |
| 2785 | 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))) { |
| 2786 | msymes = stabGetMeanings(stab, abCondKnown, what->abId.sym); |
| 2787 | symes = listNil(Syme)((SymeList) 0); |
| 2788 | for ( ; msymes; msymes = cdr(msymes)((msymes)->rest)) |
| 2789 | if (symeId(car(msymes))((((msymes)->first))->id) == sym |
| 2790 | && symeIsForeign(car(msymes))(((((((msymes)->first))->kind == SYME_Trigger ? libGetAllSymes ((((msymes)->first))->lib) : ((void*)0)), (((msymes)-> first)))->kind) == SYME_Foreign)) |
| 2791 | symes = listCons(Syme)(Syme_listPointer->Cons)(car(msymes)((msymes)->first), symes); |
| 2792 | fsymes = symes; |
| 2793 | } |
| 2794 | else if (tfIsSelf(tforg)(((((tforg)->tag) == TF_General) && ((((tforg)-> __absyn))->abHdr.tag) == AB_Id) && (((tforg)->__absyn )->abId.sym) == (ssymSelf))) { |
| 2795 | /*symes = tfGetDomImports(tforg);*/ |
| 2796 | symes = listNil(Syme)((SymeList) 0); |
| 2797 | fsymes = listNil(Syme)((SymeList) 0); |
| 2798 | |
| 2799 | if (symes == listNil(Syme)((SymeList) 0)) { |
| 2800 | msymes = stabGetMeanings(stab, abCondKnown, what->abId.sym); |
| 2801 | for ( ; msymes; msymes = cdr(msymes)((msymes)->rest)) |
| 2802 | 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)) |
| 2803 | symes = listCons(Syme)(Syme_listPointer->Cons)(car(msymes)((msymes)->first), |
| 2804 | symes); |
| 2805 | fsymes = symes; |
| 2806 | } |
| 2807 | } |
| 2808 | else { |
| 2809 | symes = listNil(Syme)((SymeList) 0); |
| 2810 | msymes = tfGetDomImportsByName(tforg, sym); |
| 2811 | for ( ; msymes; msymes = cdr(msymes)((msymes)->rest)) { |
| 2812 | Syme syme = car(msymes)((msymes)->first); |
| 2813 | if (sym != symeId(syme)((syme)->id)) |
| 2814 | continue; |
| 2815 | if (ablogIsListKnown(symeCondition(syme))) |
| 2816 | symes = listCons(Syme)(Syme_listPointer->Cons)(syme, symes); |
| 2817 | } |
| 2818 | fsymes = symes; |
| 2819 | } |
| 2820 | |
| 2821 | for (; symes; symes = cdr(symes)((symes)->rest)) { |
| 2822 | syme = car(symes)((symes)->first); |
| 2823 | if (tfSatReturn(symeType(syme), type)) |
| 2824 | tposs = tpossAdd1(tposs, symeType(syme)); |
| 2825 | } |
| 2826 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tposs; |
| 2827 | if (tpossCount(tposs) != 0) { |
| 2828 | abState(what)((what)->abHdr.state) = AB_State_HasPoss; |
| 2829 | abTPoss(what)((what)->abHdr.type.poss) = tpossRefer(tposs); |
| 2830 | } |
| 2831 | listFree(Syme)(Syme_listPointer->Free)(fsymes); |
| 2832 | } |
| 2833 | |
| 2834 | /*************************************************************************** |
| 2835 | * |
| 2836 | * :: CoerceTo: x :: T |
| 2837 | * |
| 2838 | ***************************************************************************/ |
| 2839 | |
| 2840 | localstatic void |
| 2841 | tibupCoerceTo(Stab stab, AbSyn absyn, TForm type) |
| 2842 | { |
| 2843 | TForm tf = tiGetTForm(stab, absyn->abCoerceTo.type); |
| 2844 | tibup0ApplySym(stab, absyn, tf, ssymCoerce, 1, abArgf, NULL((void*)0)); |
| 2845 | } |
| 2846 | |
| 2847 | /**************************************************************************** |
| 2848 | * |
| 2849 | * :: RestrictTo: A @ B |
| 2850 | * |
| 2851 | ***************************************************************************/ |
| 2852 | |
| 2853 | localstatic void |
| 2854 | tibupRestrictTo(Stab stab, AbSyn absyn, TForm type) |
| 2855 | { |
| 2856 | TForm tf = tiGetTForm(stab, absyn->abRestrictTo.type); |
| 2857 | |
| 2858 | tibup(stab, absyn->abRestrictTo.expr, tf); |
| 2859 | |
| 2860 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tf); |
| 2861 | } |
| 2862 | |
| 2863 | /**************************************************************************** |
| 2864 | * |
| 2865 | * :: PretendTo: A pretend B |
| 2866 | * |
| 2867 | ***************************************************************************/ |
| 2868 | |
| 2869 | localstatic void |
| 2870 | tibupPretendTo(Stab stab, AbSyn absyn, TForm type) |
| 2871 | { |
| 2872 | TForm tf = tiGetTForm(stab, absyn->abPretendTo.type); |
| 2873 | |
| 2874 | tibup(stab, absyn->abPretendTo.expr, tfUnknown); |
| 2875 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tf); |
| 2876 | } |
| 2877 | |
| 2878 | /*************************************************************************** |
| 2879 | * |
| 2880 | * :: Not: not a |
| 2881 | * |
| 2882 | ***************************************************************************/ |
| 2883 | |
| 2884 | localstatic void |
| 2885 | tibupNot(Stab stab, AbSyn absyn, TForm type) |
| 2886 | { |
| 2887 | /* |
| 2888 | * An unfixed compiler bug means that parts of Salli |
| 2889 | * programs (and thus libAldor) are tinfered with |
| 2890 | * (tfBoolean == tfUnknown). The correct fix is to |
| 2891 | * ensure that tfBoolean has been imported into every |
| 2892 | * scope that needs it before we get this far. |
| 2893 | */ |
| 2894 | if (tfBoolean == tfUnknown) comsgFatal(absyn, ALDOR_F_BugNoBoolean367); |
| 2895 | tibup(stab, absyn->abNot.expr, tfBoolean); |
| 2896 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfBoolean); |
| 2897 | } |
| 2898 | |
| 2899 | /*************************************************************************** |
| 2900 | * |
| 2901 | * :: And: a and b and c ... |
| 2902 | * |
| 2903 | ***************************************************************************/ |
| 2904 | |
| 2905 | localstatic void |
| 2906 | tibupAnd(Stab stab, AbSyn absyn, TForm type) |
| 2907 | { |
| 2908 | int i; |
| 2909 | int argc = abArgc(absyn)((absyn)->abHdr.argc); |
| 2910 | AbLogic *saveCond = (AbLogic*) stoAlloc(OB_Other0, sizeof(AbLogic) * argc); |
| 2911 | /* |
| 2912 | * An unfixed compiler bug means that parts of Salli |
| 2913 | * programs (and thus libAldor) are tinfered with |
| 2914 | * (tfBoolean == tfUnknown). The correct fix is to |
| 2915 | * ensure that tfBoolean has been imported into every |
| 2916 | * scope that needs it before we get this far. |
| 2917 | */ |
| 2918 | if (tfBoolean == tfUnknown) comsgFatal(absyn, ALDOR_F_BugNoBoolean367); |
| 2919 | |
| 2920 | for (i = 0; i < argc; i++) { |
| 2921 | tibup(stab, abArgv(absyn)((absyn)->abGen.data.argv)[i], tfBoolean); |
| 2922 | ablogAndPush(&abCondKnown, &saveCond[i], abArgv(absyn)((absyn)->abGen.data.argv)[i], true1); |
| 2923 | } |
| 2924 | for (i = 0; i < argc; i++) { |
| 2925 | ablogAndPop(&abCondKnown, &saveCond[argc-i-1]); |
| 2926 | } |
| 2927 | |
| 2928 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfBoolean); |
| 2929 | |
| 2930 | stoFree(saveCond); |
| 2931 | } |
| 2932 | |
| 2933 | /*************************************************************************** |
| 2934 | * |
| 2935 | * :: Or: a or b or c ... |
| 2936 | * |
| 2937 | ***************************************************************************/ |
| 2938 | |
| 2939 | localstatic void |
| 2940 | tibupOr(Stab stab, AbSyn absyn, TForm type) |
| 2941 | { |
| 2942 | int i; |
| 2943 | int argc = abArgc(absyn)((absyn)->abHdr.argc); |
| 2944 | |
| 2945 | /* |
| 2946 | * An unfixed compiler bug means that parts of Salli |
| 2947 | * programs (and thus libAldor) are tinfered with |
| 2948 | * (tfBoolean == tfUnknown). The correct fix is to |
| 2949 | * ensure that tfBoolean has been imported into every |
| 2950 | * scope that needs it before we get this far. |
| 2951 | */ |
| 2952 | if (tfBoolean == tfUnknown) comsgFatal(absyn, ALDOR_F_BugNoBoolean367); |
| 2953 | for (i = 0; i < argc; i++) |
| 2954 | tibup(stab, abArgv(absyn)((absyn)->abGen.data.argv)[i], tfBoolean); |
| 2955 | |
| 2956 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfBoolean); |
| 2957 | } |
| 2958 | |
| 2959 | /*************************************************************************** |
| 2960 | * |
| 2961 | * :: Assert: |
| 2962 | * |
| 2963 | ***************************************************************************/ |
| 2964 | |
| 2965 | localstatic void |
| 2966 | tibupAssert(Stab stab, AbSyn absyn, TForm type) |
| 2967 | { |
| 2968 | /* |
| 2969 | * An unfixed compiler bug means that parts of Salli |
| 2970 | * programs (and thus libAldor) are tinfered with |
| 2971 | * (tfBoolean == tfUnknown). The correct fix is to |
| 2972 | * ensure that tfBoolean has been imported into every |
| 2973 | * scope that needs it before we get this far. |
| 2974 | */ |
| 2975 | if (tfBoolean == tfUnknown) comsgFatal(absyn, ALDOR_F_BugNoBoolean367); |
| 2976 | tibup(stab, absyn->abAssert.test, tfBoolean); |
| 2977 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfNone()tfMulti(0)); |
| 2978 | } |
| 2979 | |
| 2980 | /*************************************************************************** |
| 2981 | * |
| 2982 | * :: Blank: |
| 2983 | * |
| 2984 | ***************************************************************************/ |
| 2985 | |
| 2986 | localstatic void |
| 2987 | tibupBlank(Stab stab, AbSyn absyn, TForm type) |
| 2988 | { |
| 2989 | tibup0Generic(stab, absyn, type); |
| 2990 | } |
| 2991 | |
| 2992 | /*************************************************************************** |
| 2993 | * |
| 2994 | * :: Builtin: |
| 2995 | * |
| 2996 | ***************************************************************************/ |
| 2997 | |
| 2998 | localstatic void |
| 2999 | tibupBuiltin(Stab stab, AbSyn absyn, TForm type) |
| 3000 | { |
| 3001 | tibup0Generic(stab, absyn, type); |
| 3002 | } |
| 3003 | |
| 3004 | /*************************************************************************** |
| 3005 | * |
| 3006 | * :: Default: |
| 3007 | * |
| 3008 | ***************************************************************************/ |
| 3009 | |
| 3010 | localstatic void |
| 3011 | tibupDefault(Stab stab, AbSyn absyn, TForm type) |
| 3012 | { |
| 3013 | SymeList sl; |
| 3014 | AbSyn body; |
| 3015 | TForm tf; |
| 3016 | |
| 3017 | body = absyn->abDefault.body; |
| 3018 | sl = tibup0DefaultBody(stab, body, tiTfDoDefault(absyn)); |
| 3019 | tf = tfThird(sl); |
| 3020 | tfHasSelf(tf)((tf)->hasSelf) = true1; |
| 3021 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tf); |
| 3022 | } |
| 3023 | |
| 3024 | /*************************************************************************** |
| 3025 | * |
| 3026 | * :: Delay: |
| 3027 | * |
| 3028 | ***************************************************************************/ |
| 3029 | |
| 3030 | localstatic void |
| 3031 | tibupDelay(Stab stab, AbSyn absyn, TForm type) |
| 3032 | { |
| 3033 | tibup0Generic(stab, absyn, type); |
| 3034 | } |
| 3035 | |
| 3036 | /*************************************************************************** |
| 3037 | * |
| 3038 | * :: Do: |
| 3039 | * |
| 3040 | ***************************************************************************/ |
| 3041 | |
| 3042 | localstatic void |
| 3043 | tibupDo(Stab stab, AbSyn absyn, TForm type) |
| 3044 | { |
| 3045 | tibup0Generic(stab, absyn, tfUnknown); |
| 3046 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfNone()tfMulti(0)); |
| 3047 | } |
| 3048 | |
| 3049 | /*************************************************************************** |
| 3050 | * |
| 3051 | * :: Except: |
| 3052 | * |
| 3053 | ***************************************************************************/ |
| 3054 | |
| 3055 | localstatic void |
| 3056 | tibupExcept(Stab stab, AbSyn absyn, TForm type) |
| 3057 | { |
| 3058 | tibup(stab, absyn->abExcept.except, tfTuple(tfCategory)); |
| 3059 | tibup(stab, absyn->abExcept.type, type); |
| 3060 | abTPoss(absyn)((absyn)->abHdr.type.poss) = abReferTPoss(absyn->abExcept.type); |
| 3061 | } |
| 3062 | |
| 3063 | /*************************************************************************** |
| 3064 | * |
| 3065 | * :: Raise: |
| 3066 | * |
| 3067 | ***************************************************************************/ |
| 3068 | |
| 3069 | localstatic void |
| 3070 | tibupRaise(Stab stab, AbSyn absyn, TForm type) |
| 3071 | { |
| 3072 | /* We can't check this, because we need a type form |
| 3073 | * on the RHS |
| 3074 | */ |
| 3075 | tibup(stab, absyn->abRaise.expr, tfDomain); |
| 3076 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfExit); |
| 3077 | } |
| 3078 | |
| 3079 | /*************************************************************************** |
| 3080 | * |
| 3081 | * :: Export: |
| 3082 | * |
| 3083 | ***************************************************************************/ |
| 3084 | |
| 3085 | localstatic void |
| 3086 | tibupExport(Stab stab, AbSyn absyn, TForm type) |
| 3087 | { |
| 3088 | AbSyn what = absyn->abExport.what; |
| 3089 | AbSyn from = absyn->abExport.origin; |
| 3090 | AbSyn dest = absyn->abExport.destination; |
| 3091 | |
| 3092 | if (!abIsNothing(dest)((dest)->abHdr.tag == (AB_Nothing))) |
| 3093 | tiGetTForm(stab, dest); |
| 3094 | |
| 3095 | if (!abIsNothing(from)((from)->abHdr.tag == (AB_Nothing))) { |
| 3096 | tiGetTForm(stab, from); |
| 3097 | typeInferCheck(stab, from, tfDomain); |
| 3098 | } |
| 3099 | |
| 3100 | if (abIsNothing(from)((from)->abHdr.tag == (AB_Nothing)) && abIsNothing(dest)((dest)->abHdr.tag == (AB_Nothing))) |
| 3101 | tibup(stab, what, tfUnknown); |
| 3102 | else |
| 3103 | tibup0Within(stab, what, listNil(Syme)((SymeList) 0), true1); |
| 3104 | |
| 3105 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tpossSingleton(tfNone()tfMulti(0)); |
| 3106 | } |
| 3107 | |
| 3108 | /*************************************************************************** |
| 3109 | * |
| 3110 | * :: Extend: |
| 3111 | * |
| 3112 | ***************************************************************************/ |
| 3113 | |
| 3114 | localstatic void |
| 3115 | tibupExtend(Stab stab, AbSyn absyn, TForm type) |
| 3116 | { |
| 3117 | tibup0Generic(stab, absyn, type); |
| 3118 | } |
| 3119 | |
| 3120 | /*************************************************************************** |
| 3121 | * |
| 3122 | * :: Fix: |
| 3123 | * |
| 3124 | ***************************************************************************/ |
| 3125 | |
| 3126 | localstatic void |
| 3127 | tibupFix(Stab stab, AbSyn absyn, TForm type) |
| 3128 | { |
| 3129 | tibup0Generic(stab, absyn, type); |
| 3130 | } |
| 3131 | |
| 3132 | /*************************************************************************** |
| 3133 | * |
| 3134 | * :: Fluid: |
| 3135 | * |
| 3136 | ***************************************************************************/ |
| 3137 | |
| 3138 | localstatic void |
| 3139 | tibupFluid(Stab stab, AbSyn absyn, TForm type) |
| 3140 | { |
| 3141 | tibup0Generic(stab, absyn, type); |
| 3142 | } |
| 3143 | |
| 3144 | /*************************************************************************** |
| 3145 | * |
| 3146 | * :: Free: |
| 3147 | * |
| 3148 | ***************************************************************************/ |
| 3149 | |
| 3150 | localstatic void |
| 3151 | tibupFree(Stab stab, AbSyn absyn, TForm type) |
| 3152 | { |
| 3153 | tibup0Generic(stab, absyn, type); |
| 3154 | } |
| 3155 | |
| 3156 | /*************************************************************************** |
| 3157 | * |
| 3158 | * :: Has: |
| 3159 | * |
| 3160 | ***************************************************************************/ |
| 3161 | |
| 3162 | localstatic void |
| 3163 | tibupHas(Stab stab, AbSyn absyn, TForm type) |
| 3164 | { |
| 3165 | AbSyn expr = absyn->abHas.expr; |
| 3166 | AbSyn prop = absyn->abHas.property; |
| 3167 | |
| 3168 | /* |
| 3169 | * An unfixed compiler bug means that parts of Salli |
| 3170 | * programs (and thus libAldor) are tinfered with |
| 3171 | * (tfBoolean == tfUnknown). The correct fix is to |
| 3172 | * ensure that tfBoolean has been imported into every |
| 3173 | * scope that needs it before we get this far. |
| 3174 | */ |
| 3175 | tiGetTFormContext(stab, abCondKnown, expr); |
| 3176 | tiGetTFormContext(stab, abCondKnown, prop); |
| 3177 | if (tfBoolean == tfUnknown) comsgFatal(absyn, ALDOR_F_BugNoBoolean367); |
| 3178 | tibup0Generic(stab, absyn, tfBoolean); |
| 3179 | |
| 3180 | typeInferCheck(stab, expr, tfDomain); |
| 3181 | typeInferCheck(stab, prop, tfCategory); |
| 3182 | } |
| 3183 | |
| 3184 | /*************************************************************************** |
| 3185 | * |
| 3186 | * :: Hide: |
| 3187 | * |
| 3188 | ***************************************************************************/ |
| 3189 | |
| 3190 | localstatic void |
| 3191 | tibupHide(Stab stab, AbSyn absyn, TForm type) |
| 3192 | { |
| 3193 | tibup0Generic(stab, absyn, type); |
| 3194 | } |
| 3195 | |
| 3196 | /*************************************************************************** |
| 3197 | * |
| 3198 | * :: IdSy: |
| 3199 | * |
| 3200 | ***************************************************************************/ |
| 3201 | |
| 3202 | localstatic void |
| 3203 | tibupIdSy(Stab stab, AbSyn absyn, TForm type) |
| 3204 | { |
| 3205 | tibup0Generic(stab, absyn, type); |
| 3206 | } |
| 3207 | |
| 3208 | /*************************************************************************** |
| 3209 | * |
| 3210 | * :: Let: |
| 3211 | * |
| 3212 | ***************************************************************************/ |
| 3213 | |
| 3214 | localstatic void |
| 3215 | tibupLet(Stab stab, AbSyn absyn, TForm type) |
| 3216 | { |
| 3217 | tibup0Generic(stab, absyn, type); |
| 3218 | } |
| 3219 | |
| 3220 | /*************************************************************************** |
| 3221 | * |
| 3222 | * :: Local: |
| 3223 | * |
| 3224 | ***************************************************************************/ |
| 3225 | |
| 3226 | localstatic void |
| 3227 | tibupLocal(Stab stab, AbSyn absyn, TForm type) |
| 3228 | { |
| 3229 | tibup0Generic(stab, absyn, type); |
| 3230 | } |
| 3231 | |
| 3232 | /*************************************************************************** |
| 3233 | * |
| 3234 | * :: Macro: |
| 3235 | * |
| 3236 | ***************************************************************************/ |
| 3237 | |
| 3238 | localstatic void |
| 3239 | tibupMacro(Stab stab, AbSyn absyn, TForm type) |
| 3240 | { |
| 3241 | tibup0Generic(stab, absyn, type); |
| 3242 | } |
| 3243 | |
| 3244 | /*************************************************************************** |
| 3245 | * |
| 3246 | * :: MLambda: |
| 3247 | * |
| 3248 | ***************************************************************************/ |
| 3249 | |
| 3250 | localstatic void |
| 3251 | tibupMLambda(Stab stab, AbSyn absyn, TForm type) |
| 3252 | { |
| 3253 | tibup0Generic(stab, absyn, type); |
| 3254 | } |
| 3255 | |
| 3256 | /*************************************************************************** |
| 3257 | * |
| 3258 | * :: Nothing: |
| 3259 | * |
| 3260 | ***************************************************************************/ |
| 3261 | |
| 3262 | localstatic void |
| 3263 | tibupNothing(Stab stab, AbSyn absyn, TForm type) |
| 3264 | { |
| 3265 | tibup0NoValue(stab, absyn, type, ALDOR_E_TinContextSeq178); |
| 3266 | } |
| 3267 | |
| 3268 | /*************************************************************************** |
| 3269 | * |
| 3270 | * :: Quote: |
| 3271 | * |
| 3272 | ***************************************************************************/ |
| 3273 | |
| 3274 | localstatic void |
| 3275 | tibupQuote(Stab stab, AbSyn absyn, TForm type) |
| 3276 | { |
| 3277 | tibup0Generic(stab, absyn, type); |
| 3278 | } |
| 3279 | |
| 3280 | /*************************************************************************** |
| 3281 | * |
| 3282 | * :: Select: |
| 3283 | * |
| 3284 | ***************************************************************************/ |
| 3285 | |
| 3286 | localstatic void |
| 3287 | tibupSelect(Stab stab, AbSyn absyn, TForm type) |
| 3288 | { |
| 3289 | Scope("tibupSelect")String scopeName = ("tibupSelect"); int fluidLevel0 = (scopeLevel ++, fluidLevel); |
| 3290 | TPoss fluid(tuniSelectTPoss)fluidSave_tuniSelectTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniSelectTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniSelectTPoss , fluidStack[fluidLevel].size = sizeof(tuniSelectTPoss), fluidLevel ++, (tuniSelectTPoss) ); |
| 3291 | AbSyn fluid(tuniBupSelectObj)fluidSave_tuniBupSelectObj = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniBupSelectObj ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniBupSelectObj , fluidStack[fluidLevel].size = sizeof(tuniBupSelectObj), fluidLevel ++, (tuniBupSelectObj) ); |
| 3292 | TPoss fluid(tuniExitTPoss)fluidSave_tuniExitTPoss = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniExitTPoss ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniExitTPoss , fluidStack[fluidLevel].size = sizeof(tuniExitTPoss), fluidLevel ++, (tuniExitTPoss) ); |
| 3293 | TForm fluid(tuniExitType)fluidSave_tuniExitType = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(tuniExitType ), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_tuniExitType , fluidStack[fluidLevel].size = sizeof(tuniExitType), fluidLevel ++, (tuniExitType) ); |
| 3294 | TPoss tp; |
| 3295 | AbSyn seq; |
| 3296 | tuniSelectTPoss = NULL((void*)0); |
| 3297 | tuniBupSelectObj = NULL((void*)0); |
| 3298 | |
| 3299 | tibup(stab, absyn->abSelect.testPart, tfUnknown); |
| 3300 | |
| 3301 | tuniSelectTPoss = abTPoss(absyn->abSelect.testPart)((absyn->abSelect.testPart)->abHdr.type.poss); |
| 3302 | tuniBupSelectObj = absyn->abSelect.testPart; |
| 3303 | |
| 3304 | if (abUse(absyn)((absyn)->abHdr.use) == AB_Use_NoValue || tfIsNone(type)((((type)->tag) == TF_Multiple) && tfMultiArgc(type ) == 0)) |
| 3305 | tuniExitTPoss = tuniNoValueTPoss((TPoss) 4L); |
| 3306 | else |
| 3307 | tuniExitTPoss = tuniUnknownTPoss((TPoss) 8L); |
| 3308 | |
| 3309 | tuniExitType = type; |
| 3310 | |
| 3311 | seq = absyn->abSelect.alternatives; |
| 3312 | tibupSequence0(stab, seq, type); |
| 3313 | |
| 3314 | |
| 3315 | if (abState(seq)((seq)->abHdr.state) == AB_State_Error) |
| 3316 | tp = tpossEmpty(); |
| 3317 | else { |
| 3318 | abState(seq)((seq)->abHdr.state) = AB_State_HasPoss; |
| 3319 | tp = abReferTPoss(seq); |
| 3320 | } |
| 3321 | |
| 3322 | /* |
| 3323 | * tp is under constrained, as the alternatives |
| 3324 | * may narrow the options. wtf. |
| 3325 | */ |
| 3326 | abTPoss(absyn)((absyn)->abHdr.type.poss) = tp; |
| 3327 | ReturnNothing{ fluidUnwind(fluidLevel0, ((int) 0)); return;; }; |
| 3328 | } |
| 3329 | |
| 3330 | /*************************************************************************** |
| 3331 | * |
| 3332 | * :: Try: |
| 3333 | * |
| 3334 | ***************************************************************************/ |
| 3335 | |
| 3336 | localstatic void |
| 3337 | tibupTry(Stab stab, AbSyn absyn, TForm type) |
| 3338 | { |
| 3339 | tibup(stab, absyn->abTry.id, tfUnknown); |
| 3340 | /* |
| 3341 | * Strictly, given |
| 3342 | * expr: Bar except (A, B, C) |
| 3343 | * and handler covers (X, Y, Z) |
| 3344 | * then we should: |
| 3345 | * check expr with: |
| 3346 | * Bar except (A, B, C, X, Y, Z) |
| 3347 | * check handler with: |
| 3348 | * Bar except (A, B, C) |
| 3349 | * The hard part is grabbing (X, Y, Z) |
| 3350 | */ |
| 3351 | tibup(stab, absyn->abTry.expr, tfIgnoreExceptions(type)); |
| 3352 | tibup(stab, absyn->abTry.always, tfNone()tfMulti(0)); |
| 3353 | |
| 3354 | if (!abIsNothing(absyn->abTry.except)((absyn->abTry.except)->abHdr.tag == (AB_Nothing))) |
| 3355 | tibup(stab, absyn->abTry.except, type); |
| 3356 | |
| 3357 | if (abUse(absyn)((absyn)->abHdr.use) == AB_Use_NoValue || tfIsNone(type)((((type)->tag) == TF_Multiple) && tfMultiArgc(type ) == 0)) |
| 3358 | abResetTPoss(absyn, tpossSingleton(tfNone()tfMulti(0))); |
| 3359 | else |
| 3360 | abTPoss(absyn)((absyn)->abHdr.type.poss) = abReferTPoss(absyn->abTry.expr); |
| 3361 | |
| 3362 | } |
| 3363 | |
| 3364 | /***************************************************************************** |
| 3365 | * |
| 3366 | * :: Cache for computed results (currently disabled) |
| 3367 | * |
| 3368 | ****************************************************************************/ |
| 3369 | |
| 3370 | typedef struct { |
| 3371 | Stab stab; |
| 3372 | AbSyn ab; |
| 3373 | TForm tf; |
| 3374 | AbLogic known; |
| 3375 | } *ArgSet, _ArgSet; |
| 3376 | |
| 3377 | localstatic Hash tibupCacheHash (ArgSet); |
| 3378 | localstatic Bool tibupCacheEq (ArgSet, ArgSet); |
| 3379 | #if 0 /* Seemingly unused */ |
| 3380 | localstatic void tibupCacheFreeElt(ArgSet set); |
| 3381 | #endif |
| 3382 | localstatic Table tuniCache; |
| 3383 | void |
| 3384 | tibupCacheAdd(Stab stab, AbSyn ab, TForm tf, AbLogic known, TPoss poss) |
| 3385 | { |
| 3386 | ArgSet set = (ArgSet) stoAlloc(OB_Other0, sizeof(*set)); |
| 3387 | |
| 3388 | set->stab = stab; |
| 3389 | set->ab = ab; |
| 3390 | set->tf = tf; |
| 3391 | set->known = ablogCopy(known); |
| 3392 | |
| 3393 | tpossRefer(poss); |
| 3394 | if (tuniCache == NULL((void*)0)) { |
| 3395 | tuniCache = tblNew((TblHashFun) tibupCacheHash, |
| 3396 | (TblEqFun) tibupCacheEq); |
| 3397 | } |
| 3398 | |
| 3399 | tblSetElt(tuniCache, (TblKey) set, (TblElt) poss); |
| 3400 | } |
| 3401 | |
| 3402 | TPoss |
| 3403 | tibupCacheLookup(Stab stab, AbSyn ab, TForm tf, AbLogic known) |
| 3404 | { |
| 3405 | _ArgSet myset; |
| 3406 | TPoss res; |
| 3407 | |
| 3408 | if (tuniCache == NULL((void*)0)) return NULL((void*)0); |
| 3409 | |
| 3410 | myset.stab = stab; |
| 3411 | myset.ab = ab; |
| 3412 | myset.tf = tf; |
| 3413 | myset.known = known; |
| 3414 | res = tblElt(tuniCache, (TblKey) &myset, NULL((void*)0)); |
| 3415 | |
| 3416 | if (res != NULL((void*)0)) { |
| 3417 | static int c; |
| 3418 | printf("Got %d\n", c++); |
| 3419 | tpossRefer(res); |
| 3420 | } |
| 3421 | return res; |
| 3422 | } |
| 3423 | |
| 3424 | /* |
| 3425 | * !! This function does not appear to be used anymore !! |
| 3426 | */ |
| 3427 | #if 0 |
| 3428 | localstatic void |
| 3429 | tibupCacheFlush(Stab stab) |
| 3430 | { |
| 3431 | /* Iterate over the cache destroying all instances of `stab' in the cache. */ |
| 3432 | /* |
| 3433 | * Not sure this is the best way, maybe using a `depth' index or something |
| 3434 | * would be best |
| 3435 | */ |
| 3436 | |
| 3437 | TableIterator it; |
| 3438 | if (tuniCache == NULL((void*)0)) return; |
| 3439 | |
| 3440 | for (tblITER(it, tuniCache)_tblITER(&(it), tuniCache); tblMORE(it)((it).curr <= (it).last); tblSTEP(it)((((it).link=(it).link->next))==0 ? _tblSTEP(&(it)) : 1 )) { |
| 3441 | ArgSet k = (ArgSet) tblKEY(it)((it).link->key); |
| 3442 | TPoss r = (TPoss) tblELT(it)((it).link->elt); |
| 3443 | tpossFree(r); |
| 3444 | tibupCacheFreeElt(k); |
| 3445 | } |
| 3446 | } |
| 3447 | #endif |
| 3448 | |
| 3449 | |
| 3450 | localstatic Bool |
| 3451 | tibupCacheEq(ArgSet a, ArgSet b) |
| 3452 | { |
| 3453 | if (a->stab != b->stab) return false((int) 0); |
| 3454 | if (a->tf != b->tf) return false((int) 0); |
| 3455 | if (abTContext(a->ab)((a->ab)->abHdr.seman ? (a->ab)->abHdr.seman-> embed : 0) != abTContext(b->ab)((b->ab)->abHdr.seman ? (b->ab)->abHdr.seman-> embed : 0)) return false((int) 0); |
| 3456 | if (!abEqual(a->ab, b->ab)) return false((int) 0); |
| 3457 | if (!ablogEqual(a->known, b->known)) return false((int) 0); |
| 3458 | return true1; |
| 3459 | } |
| 3460 | |
| 3461 | |
| 3462 | localstatic Hash |
| 3463 | tibupCacheHash(ArgSet set) |
| 3464 | { |
| 3465 | return abHash(set->ab) ^ tfHash(set->tf); |
| 3466 | } |
| 3467 | |
| 3468 | /* |
| 3469 | * !! This function does not appear to be used anymore !! |
| 3470 | */ |
| 3471 | #if 0 |
| 3472 | localstatic void |
| 3473 | tibupCacheFreeElt(ArgSet set) |
| 3474 | { |
| 3475 | ablogFree(set->known); |
| 3476 | stoFree(set); |
| 3477 | } |
| 3478 | #endif |
| 3479 |