00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037 # include "lclintMacros.nf"
00038 # include "llbasic.h"
00039 # include "lslparse.h"
00040 # include "llgrammar.h"
00041 # include "lclscan.h"
00042 # include "lh.h"
00043 # include "imports.h"
00044
00045 static lsymbol lsymbol_Bool;
00046 static lsymbol lsymbol_bool;
00047 static lsymbol lsymbol_TRUE;
00048 static lsymbol lsymbol_FALSE;
00049
00050 static void lclPredicateNode_free ( lclPredicateNode p_x) ;
00051 static void exposedNode_free ( exposedNode p_x) ;
00052 static void CTypesNode_free ( CTypesNode p_x);
00053 static CTypesNode CTypesNode_copy ( CTypesNode p_x) ;
00054 static void
00055 constDeclarationNode_free ( constDeclarationNode p_x);
00056 static void claimNode_free ( claimNode p_x);
00057 static void iterNode_free ( iterNode p_x);
00058 static void abstBodyNode_free ( abstBodyNode p_n);
00059 static void abstractNode_free ( abstractNode p_x);
00060 static void taggedUnionNode_free ( taggedUnionNode p_x);
00061 static void typeNode_free ( typeNode p_t);
00062 static strOrUnionNode
00063 strOrUnionNode_copy ( strOrUnionNode p_n) ;
00064 static void strOrUnionNode_free ( strOrUnionNode p_n)
00065 ;
00066
00067 static void enumSpecNode_free ( enumSpecNode p_x);
00068 static enumSpecNode
00069 enumSpecNode_copy ( enumSpecNode p_x) ;
00070 static lclTypeSpecNode
00071 lclTypeSpecNode_copySafe (lclTypeSpecNode p_n) ;
00072 static void lclTypeSpecNode_free ( lclTypeSpecNode p_n);
00073 static void typeNamePack_free ( typeNamePack p_x);
00074 static void opFormNode_free ( opFormNode p_op);
00075 static quantifiedTermNode quantifiedTermNode_copy (quantifiedTermNode p_q) ;
00076 static void nameAndReplaceNode_free ( nameAndReplaceNode p_x);
00077 static void renamingNode_free ( renamingNode p_x);
00078 static void exportNode_free ( exportNode p_x);
00079 static void privateNode_free ( privateNode p_x);
00080 static termNode termNode_copy ( termNode p_t) ;
00081 static void
00082 stmtNode_free ( stmtNode p_x) ;
00083 static typeExpr typeExpr_copy ( typeExpr p_x) ;
00084
00085 static lsymbol ConditionalSymbol;
00086 static lsymbol equalSymbol;
00087 static lsymbol eqSymbol;
00088 static lclTypeSpecNode exposedType;
00089
00090 static cstring abstDeclaratorNode_unparse (abstDeclaratorNode p_x);
00091 static pairNodeList extractParams ( typeExpr p_te);
00092 static sort extractReturnSort (lclTypeSpecNode p_t, declaratorNode p_d);
00093 static void checkAssociativity (termNode p_x, ltoken p_op);
00094 static void LCLBootstrap (void);
00095 static cstring printMiddle (int p_j);
00096 static void paramNode_checkQualifiers (lclTypeSpecNode p_t, typeExpr p_d);
00097
00098 void
00099 resetImports (cstring current)
00100 {
00101 lsymbolSet_free (g_currentImports);
00102
00103 g_currentImports = lsymbolSet_new ();
00104 (void) lsymbolSet_insert (g_currentImports,
00105 lsymbol_fromChars (cstring_toCharsSafe (current)));
00106 }
00107
00108 void
00109 abstract_init ()
00110 {
00111 typeInfo ti = (typeInfo) dmalloc (sizeof (*ti));
00112 nameNode nn;
00113 ltoken dom, range;
00114 sigNode sign;
00115 opFormNode opform;
00116 ltokenList domain = ltokenList_new ();
00117 ltokenList domain2;
00118
00119 equalSymbol = lsymbol_fromChars ("=");
00120 eqSymbol = lsymbol_fromChars ("\\eq");
00121
00122
00123
00124
00125
00126
00127 lsymbol_bool = lsymbol_fromChars ("bool");
00128 lsymbol_Bool = lsymbol_fromChars ("Bool");
00129
00130 lsymbol_TRUE = lsymbol_fromChars ("TRUE");
00131 lsymbol_FALSE = lsymbol_fromChars ("FALSE");
00132
00133 ConditionalSymbol = lsymbol_fromChars ("if__then__else__");
00134
00135
00136
00137
00138
00139 range = ltoken_create (simpleId, lsymbol_bool);
00140 dom = ltoken_create (simpleId, lsymbol_bool);
00141
00142 ltokenList_addh (domain, ltoken_copy (dom));
00143
00144 domain2 = ltokenList_copy (domain);
00145
00146 sign = makesigNode (ltoken_undefined, domain, ltoken_copy (range));
00147
00148 opform = makeOpFormNode (ltoken_undefined, OPF_ANYOPM,
00149 opFormUnion_createAnyOp (ltoken_not),
00150 ltoken_undefined);
00151 nn = makeNameNodeForm (opform);
00152 symtable_enterOp (g_symtab, nn, sign);
00153
00154 ltokenList_addh (domain2, dom);
00155
00156 sign = makesigNode (ltoken_undefined, domain2, range);
00157
00158 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM,
00159 opFormUnion_createAnyOp (ltoken_and),
00160 ltoken_undefined);
00161
00162 nn = makeNameNodeForm (opform);
00163 symtable_enterOp (g_symtab, nn, sigNode_copy (sign));
00164
00165 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM,
00166 opFormUnion_createAnyOp (ltoken_or),
00167 ltoken_undefined);
00168
00169 nn = makeNameNodeForm (opform);
00170 symtable_enterOp (g_symtab, nn, sigNode_copy (sign));
00171
00172 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM,
00173 opFormUnion_createAnyOp (ltoken_implies),
00174 ltoken_undefined);
00175 nn = makeNameNodeForm (opform);
00176 symtable_enterOp (g_symtab, nn, sign);
00177
00178
00179
00180
00181
00182
00183
00184 ti->id = ltoken_createType (LLT_TYPEDEF_NAME, SID_TYPE, lsymbol_fromChars ("float"));
00185
00186 ti->modifiable = FALSE;
00187 ti->abstract = FALSE;
00188 ti->export = FALSE;
00189 ti->basedOn = sort_float;
00190 symtable_enterType (g_symtab, ti);
00191 }
00192
00193 void
00194 declareForwardType (declaratorNode declare)
00195 {
00196 typeInfo ti = (typeInfo) dmalloc (sizeof (*ti));
00197 sort tsort, handle;
00198 lsymbol typedefname;
00199
00200 typedefname = ltoken_getText (declare->id);
00201 ti->id = ltoken_copy (declare->id);
00202
00203 ltoken_setCode (ti->id, LLT_TYPEDEF_NAME);
00204 ltoken_setIdType (ti->id, SID_TYPE);
00205
00206 ti->modifiable = FALSE;
00207 ti->abstract = FALSE;
00208 tsort = lclTypeSpecNode2sort (exposedType);
00209 handle = typeExpr2ptrSort (tsort, declare->type);
00210 ti->basedOn = sort_makeSyn (declare->id, handle, typedefname);
00211 ti->export = FALSE;
00212
00213 symtable_enterType (g_symtab, ti);
00214 }
00215
00216 void LCLBuiltins (void)
00217 {
00218 typeInfo ti = (typeInfo) dmalloc (sizeof (*ti));
00219 varInfo vi = (varInfo) dmalloc (sizeof (*vi));
00220
00221
00222
00223
00224
00225
00226
00227 LCLBootstrap ();
00228
00229
00230
00231
00232 ti->id = ltoken_copy (ltoken_bool);
00233
00234 ltoken_setCode (ti->id, LLT_TYPEDEF_NAME);
00235 ltoken_setIdType (ti->id, SID_TYPE);
00236
00237 ti->modifiable = FALSE;
00238 ti->abstract = TRUE;
00239 ti->basedOn = sort_bool;
00240 ti->export = FALSE;
00241 symtable_enterType (g_symtab, ti);
00242
00243
00244 vi->id = ltoken_createType (simpleId, SID_VAR, lsymbol_fromChars ("FALSE"));
00245
00246 vi->kind = VRK_CONST;
00247 vi->sort = sort_bool;
00248 vi->export = TRUE;
00249
00250 (void) symtable_enterVar (g_symtab, vi);
00251
00252
00253
00254 ltoken_setText (vi->id, lsymbol_fromChars ("TRUE"));
00255 (void) symtable_enterVar (g_symtab, vi);
00256
00257 varInfo_free (vi);
00258
00259 importCTrait ();
00260 }
00261
00262 static void
00263 LCLBootstrap (void)
00264 {
00265 nameNode nn1, nn2;
00266 ltoken range;
00267 sigNode sign;
00268 sort s;
00269
00270
00271
00272
00273
00274
00275
00276
00277 s = sort_makeImmutable (ltoken_undefined, lsymbol_bool);
00278 range = ltoken_create (simpleId, lsymbol_bool);
00279 sign = makesigNode (ltoken_undefined, ltokenList_new (), range);
00280
00281 nn1 = (nameNode) dmalloc (sizeof (*nn1));
00282 nn1->isOpId = TRUE;
00283
00284 nn1->content.opid = ltoken_create (simpleId, lsymbol_fromChars ("true"));
00285
00286 symtable_enterOp (g_symtab, nn1, sign);
00287
00288 nn2 = (nameNode) dmalloc (sizeof (*nn2));
00289 nn2->isOpId = TRUE;
00290 nn2->content.opid = ltoken_create (simpleId, lsymbol_fromChars ("false"));
00291
00292 symtable_enterOp (g_symtab, nn2, sigNode_copy (sign));
00293 }
00294
00295 interfaceNodeList
00296 consInterfaceNode ( interfaceNode n, interfaceNodeList ns)
00297 {
00298
00299 interfaceNodeList_addl (ns, n);
00300 return (ns);
00301 }
00302
00303 interfaceNode
00304 makeInterfaceNodeImports ( importNodeList x)
00305 {
00306 interfaceNode i = (interfaceNode) dmalloc (sizeof (*i));
00307 lsymbol importSymbol;
00308
00309 i->kind = INF_IMPORTS;
00310 i->content.imports = x;
00311
00312 importNodeList_elements (x, imp)
00313 {
00314 importSymbol = ltoken_getRawText (imp->val);
00315
00316 if (lsymbolSet_member (g_currentImports, importSymbol))
00317 {
00318 lclerror (imp->val,
00319 message ("Circular imports: %s",
00320 cstring_fromChars (lsymbol_toChars (importSymbol))));
00321 }
00322 else
00323 {
00324 processImport (importSymbol, imp->val, imp->kind);
00325 }
00326 } end_importNodeList_elements;
00327
00328 lhOutLine (cstring_undefined);
00329 return (i);
00330 }
00331
00332 interfaceNode
00333 makeInterfaceNodeUses ( traitRefNodeList x)
00334 {
00335 interfaceNode i = (interfaceNode) dmalloc (sizeof (*i));
00336
00337 i->kind = INF_USES;
00338 i->content.uses = x;
00339
00340
00341 return (i);
00342 }
00343
00344 interfaceNode
00345 interfaceNode_makeConst ( constDeclarationNode x)
00346 {
00347 interfaceNode i = (interfaceNode) dmalloc (sizeof (*i));
00348 exportNode e = (exportNode) dmalloc (sizeof (*e));
00349
00350 e->kind = XPK_CONST;
00351 e->content.constdeclaration = x;
00352 i->kind = INF_EXPORT;
00353 i->content.export = e;
00354
00355 return (i);
00356 }
00357
00358 interfaceNode
00359 interfaceNode_makeVar ( varDeclarationNode x)
00360 {
00361 interfaceNode i = (interfaceNode) dmalloc (sizeof (*i));
00362 exportNode e = (exportNode) dmalloc (sizeof (*e));
00363
00364 e->kind = XPK_VAR;
00365 e->content.vardeclaration = x;
00366 i->kind = INF_EXPORT;
00367 i->content.export = e;
00368
00369 if (context_msgLh ())
00370 {
00371 lhOutLine (lhVarDecl (x->type, x->decls, x->qualifier));
00372 }
00373
00374 return (i);
00375 }
00376
00377 interfaceNode
00378 interfaceNode_makeType ( typeNode x)
00379 {
00380 interfaceNode i = (interfaceNode) dmalloc (sizeof (*i));
00381 exportNode e = (exportNode) dmalloc (sizeof (*e));
00382 e->kind = XPK_TYPE;
00383 e->content.type = x;
00384 i->kind = INF_EXPORT;
00385 i->content.export = e;
00386
00387 if (context_msgLh ())
00388 {
00389
00390 lhOutLine (lhType (x));
00391 }
00392
00393 return (i);
00394 }
00395
00396 interfaceNode
00397 interfaceNode_makeFcn ( fcnNode x)
00398 {
00399 interfaceNode i = (interfaceNode) dmalloc (sizeof (*i));
00400 exportNode e = (exportNode) dmalloc (sizeof (*e));
00401
00402 e->kind = XPK_FCN;
00403 e->content.fcn = x;
00404 i->kind = INF_EXPORT;
00405 i->content.export = e;
00406
00407 if (context_msgLh ())
00408 {
00409 llassert (x->typespec != NULL);
00410 llassert (x->declarator != NULL);
00411
00412 lhOutLine (lhFunction (x->typespec, x->declarator));
00413 }
00414
00415 return (i);
00416 }
00417
00418 interfaceNode
00419 interfaceNode_makeClaim ( claimNode x)
00420 {
00421 interfaceNode i = (interfaceNode) dmalloc (sizeof (*i));
00422 exportNode e = (exportNode) dmalloc (sizeof (*e));
00423
00424 e->kind = XPK_CLAIM;
00425 e->content.claim = x;
00426 i->kind = INF_EXPORT;
00427 i->content.export = e;
00428 return (i);
00429 }
00430
00431 interfaceNode
00432 interfaceNode_makeIter ( iterNode x)
00433 {
00434 interfaceNode i = (interfaceNode) dmalloc (sizeof (*i));
00435 exportNode e = (exportNode) dmalloc (sizeof (*e));
00436
00437 e->kind = XPK_ITER;
00438 e->content.iter = x;
00439 i->kind = INF_EXPORT;
00440 i->content.export = e;
00441 return (i);
00442 }
00443
00444 interfaceNode
00445 interfaceNode_makePrivConst ( constDeclarationNode x)
00446 {
00447 interfaceNode i = (interfaceNode) dmalloc (sizeof (*i));
00448 privateNode e = (privateNode) dmalloc (sizeof (*e));
00449
00450 e->kind = PRIV_CONST;
00451 e->content.constdeclaration = x;
00452 i->kind = INF_PRIVATE;
00453 i->content.private = e;
00454 return (i);
00455 }
00456
00457 interfaceNode
00458 interfaceNode_makePrivVar ( varDeclarationNode x)
00459 {
00460 interfaceNode i = (interfaceNode) dmalloc (sizeof (*i));
00461 privateNode e = (privateNode) dmalloc (sizeof (*e));
00462
00463 e->kind = PRIV_VAR;
00464 e->content.vardeclaration = x;
00465 i->kind = INF_PRIVATE;
00466 i->content.private = e;
00467 return (i);
00468 }
00469
00470 interfaceNode
00471 interfaceNode_makePrivType ( typeNode x)
00472 {
00473 interfaceNode i = (interfaceNode) dmalloc (sizeof (*i));
00474 privateNode e = (privateNode) dmalloc (sizeof (*e));
00475
00476 e->kind = PRIV_TYPE;
00477 e->content.type = x;
00478 i->kind = INF_PRIVATE;
00479 i->content.private = e;
00480 return (i);
00481 }
00482
00483 interfaceNode
00484 interfaceNode_makePrivFcn ( fcnNode x)
00485 {
00486 interfaceNode i = (interfaceNode) dmalloc (sizeof (*i));
00487 privateNode e = (privateNode) dmalloc (sizeof (*e));
00488
00489
00490
00491
00492
00493
00494 e->kind = PRIV_FUNCTION;
00495 e->content.fcn = x;
00496 i->kind = INF_PRIVATE;
00497 i->content.private = e;
00498 return (i);
00499 }
00500
00501 cstring
00502 exportNode_unparse (exportNode n)
00503 {
00504 if (n != (exportNode) 0)
00505 {
00506 switch (n->kind)
00507 {
00508 case XPK_CONST:
00509 return (message
00510 ("%q\n",
00511 constDeclarationNode_unparse (n->content.constdeclaration)));
00512 case XPK_VAR:
00513 return (message
00514 ("%q\n",
00515 varDeclarationNode_unparse (n->content.vardeclaration)));
00516 case XPK_TYPE:
00517 return (message ("%q\n", typeNode_unparse (n->content.type)));
00518 case XPK_FCN:
00519 return (fcnNode_unparse (n->content.fcn));
00520 case XPK_CLAIM:
00521 return (claimNode_unparse (n->content.claim));
00522 case XPK_ITER:
00523 return (iterNode_unparse (n->content.iter));
00524 default:
00525 llfatalbug (message ("exportNode_unparse: unknown kind: %d", (int) n->kind));
00526 }
00527 }
00528 return cstring_undefined;
00529 }
00530
00531 cstring
00532 privateNode_unparse (privateNode n)
00533 {
00534 if (n != (privateNode) 0)
00535 {
00536 switch (n->kind)
00537 {
00538 case PRIV_CONST:
00539 return (constDeclarationNode_unparse (n->content.constdeclaration));
00540 case PRIV_VAR:
00541 return (varDeclarationNode_unparse (n->content.vardeclaration));
00542 case PRIV_TYPE:
00543 return (typeNode_unparse (n->content.type));
00544 case PRIV_FUNCTION:
00545 return (fcnNode_unparse (n->content.fcn));
00546 default:
00547 llfatalbug (message ("privateNode_unparse: unknown kind: %d",
00548 (int) n->kind));
00549 }
00550 }
00551 return cstring_undefined;
00552 }
00553
00554 void lclPredicateNode_free ( lclPredicateNode x)
00555 {
00556 if (x != NULL)
00557 {
00558 termNode_free (x->predicate);
00559 ltoken_free (x->tok);
00560 sfree (x);
00561 }
00562 }
00563
00564 static cstring
00565 lclPredicateNode_unparse ( lclPredicateNode p)
00566 {
00567 if (p != (lclPredicateNode) 0)
00568 {
00569 cstring st = cstring_undefined;
00570
00571 switch (p->kind)
00572 {
00573 case LPD_REQUIRES:
00574 st = cstring_makeLiteral (" requires ");
00575 break;
00576 case LPD_CHECKS:
00577 st = cstring_makeLiteral (" checks ");
00578 break;
00579 case LPD_ENSURES:
00580 st = cstring_makeLiteral (" ensures ");
00581 break;
00582 case LPD_INTRACLAIM:
00583 st = cstring_makeLiteral (" claims ");
00584 break;
00585 case LPD_CONSTRAINT:
00586 st = cstring_makeLiteral ("constraint ");
00587 break;
00588 case LPD_INITIALLY:
00589 st = cstring_makeLiteral ("initially ");
00590 break;
00591 case LPD_PLAIN:
00592 break;
00593 default:
00594 llfatalbug (message ("lclPredicateNode_unparse: unknown kind: %d",
00595 (int) p->kind));
00596 }
00597 return (message ("%q%q;\n", st, termNode_unparse (p->predicate)));
00598 }
00599 return cstring_undefined;
00600 }
00601
00602 bool
00603 ltoken_similar (ltoken t1, ltoken t2)
00604 {
00605 lsymbol sym1 = ltoken_getText (t1);
00606 lsymbol sym2 = ltoken_getText (t2);
00607
00608 if (sym1 == sym2)
00609 {
00610 return TRUE;
00611 }
00612
00613 if ((sym1 == eqSymbol && sym2 == equalSymbol) ||
00614 (sym2 == eqSymbol && sym1 == equalSymbol))
00615 {
00616 return TRUE;
00617 }
00618
00619 if ((sym1 == lsymbol_bool && sym2 == lsymbol_Bool) ||
00620 (sym2 == lsymbol_bool && sym1 == lsymbol_Bool))
00621 {
00622 return TRUE;
00623 }
00624
00625 return FALSE;
00626 }
00627
00628 cstring
00629 iterNode_unparse ( iterNode i)
00630 {
00631 if (i != (iterNode) 0)
00632 {
00633 return (message ("iter %s %q", ltoken_unparse (i->name),
00634 paramNodeList_unparse (i->params)));
00635 }
00636 return cstring_undefined;
00637 }
00638
00639
00640 cstring
00641 fcnNode_unparse ( fcnNode f)
00642 {
00643 if (f != (fcnNode) 0)
00644 {
00645 return (message ("%q %q%q{\n%q%q%q%q%q%q}\n",
00646 lclTypeSpecNode_unparse (f->typespec),
00647 declaratorNode_unparse (f->declarator),
00648 varDeclarationNodeList_unparse (f->globals),
00649 varDeclarationNodeList_unparse (f->inits),
00650 letDeclNodeList_unparse (f->lets),
00651 lclPredicateNode_unparse (f->require),
00652 modifyNode_unparse (f->modify),
00653 lclPredicateNode_unparse (f->ensures),
00654 lclPredicateNode_unparse (f->claim)));
00655 }
00656 return cstring_undefined;
00657 }
00658
00659 cstring
00660 varDeclarationNode_unparse ( varDeclarationNode x)
00661 {
00662 if (x != (varDeclarationNode) 0)
00663 {
00664 cstring st;
00665
00666 if (x->isSpecial)
00667 {
00668 return (sRef_unparse (x->sref));
00669 }
00670 else
00671 {
00672 switch (x->qualifier)
00673 {
00674 case QLF_NONE:
00675 st = cstring_undefined;
00676 break;
00677 case QLF_CONST:
00678 st = cstring_makeLiteral ("const ");
00679 break;
00680 case QLF_VOLATILE:
00681 st = cstring_makeLiteral ("volatile ");
00682 break;
00683 BADDEFAULT;
00684 }
00685
00686 st = message ("%q%q %q", st, lclTypeSpecNode_unparse (x->type),
00687 initDeclNodeList_unparse (x->decls));
00688 return (st);
00689 }
00690 }
00691
00692 return cstring_undefined;
00693 }
00694
00695 cstring
00696 typeNode_unparse ( typeNode t)
00697 {
00698 if (t != (typeNode) 0)
00699 {
00700 switch (t->kind)
00701 {
00702 case TK_ABSTRACT:
00703 return (abstractNode_unparse (t->content.abstract));
00704 case TK_EXPOSED:
00705 return (exposedNode_unparse (t->content.exposed));
00706 case TK_UNION:
00707 return (taggedUnionNode_unparse (t->content.taggedunion));
00708 default:
00709 llfatalbug (message ("typeNode_unparse: unknown kind: %d", (int)t->kind));
00710 }
00711 }
00712 return cstring_undefined;
00713 }
00714
00715 cstring
00716 constDeclarationNode_unparse ( constDeclarationNode x)
00717 {
00718 if (x != (constDeclarationNode) 0)
00719 {
00720 return (message ("constant %q %q", lclTypeSpecNode_unparse (x->type),
00721 initDeclNodeList_unparse (x->decls)));
00722 }
00723
00724 return cstring_undefined;
00725 }
00726
00727 storeRefNode
00728 makeStoreRefNodeTerm ( termNode t)
00729 {
00730 storeRefNode x = (storeRefNode) dmalloc (sizeof (*x));
00731
00732 x->kind = SRN_TERM;
00733 x->content.term = t;
00734 return (x);
00735 }
00736
00737 storeRefNode
00738 makeStoreRefNodeType ( lclTypeSpecNode t, bool isObj)
00739 {
00740 storeRefNode x = (storeRefNode) dmalloc (sizeof (*x));
00741
00742 x->kind = isObj ? SRN_OBJ : SRN_TYPE;
00743 x->content.type = t;
00744 return (x);
00745 }
00746
00747 storeRefNode
00748 makeStoreRefNodeInternal (void)
00749 {
00750 storeRefNode x = (storeRefNode) dmalloc (sizeof (*x));
00751
00752 x->kind = SRN_SPECIAL;
00753 x->content.ref = sRef_makeInternalState ();
00754 return (x);
00755 }
00756
00757 storeRefNode
00758 makeStoreRefNodeSystem (void)
00759 {
00760 storeRefNode x = (storeRefNode) dmalloc (sizeof (*x));
00761
00762 x->kind = SRN_SPECIAL;
00763 x->content.ref = sRef_makeSystemState ();
00764 return (x);
00765 }
00766
00767 modifyNode
00768 makeModifyNodeSpecial ( ltoken t, bool modifiesNothing)
00769 {
00770 modifyNode x = (modifyNode) dmalloc (sizeof (*x));
00771
00772 x->tok = t;
00773 x->modifiesNothing = modifiesNothing;
00774 x->hasStoreRefList = FALSE;
00775 return (x);
00776 }
00777
00778 modifyNode
00779 makeModifyNodeRef ( ltoken t, storeRefNodeList y)
00780 {
00781 modifyNode x = (modifyNode) dmalloc (sizeof (*x));
00782 sort sort;
00783
00784 x->tok = t;
00785 x->hasStoreRefList = TRUE;
00786 x->modifiesNothing = FALSE;
00787 x->list = y;
00788
00789
00790 storeRefNodeList_elements (y, sr)
00791 {
00792 if (storeRefNode_isTerm (sr))
00793 {
00794 sort = sr->content.term->sort;
00795
00796 if (!sort_mutable (sort) && sort_isValidSort (sort))
00797 {
00798 ltoken errtok = termNode_errorToken (sr->content.term);
00799 lclerror (errtok,
00800 message ("Term denoting immutable object used in modifies list: %q",
00801 termNode_unparse (sr->content.term)));
00802 }
00803 }
00804 else
00805 {
00806 if (!storeRefNode_isSpecial (sr))
00807 {
00808 sort = lclTypeSpecNode2sort (sr->content.type);
00809
00810 if (storeRefNode_isObj (sr))
00811 {
00812 sort = sort_makeObj (sort);
00813 }
00814
00815 if (!sort_mutable (sort))
00816 {
00817 ltoken errtok = lclTypeSpecNode_errorToken (sr->content.type);
00818 lclerror (errtok,
00819 message ("Immutable type used in modifies list: %q",
00820 sort_unparse (sort)));
00821 }
00822 }
00823 }
00824 } end_storeRefNodeList_elements;
00825 return (x);
00826 }
00827
00828 ltoken
00829 termNode_errorToken ( termNode n)
00830 {
00831 if (n != (termNode) 0)
00832 {
00833 switch (n->kind)
00834 {
00835 case TRM_LITERAL:
00836 case TRM_UNCHANGEDALL:
00837 case TRM_UNCHANGEDOTHERS:
00838 case TRM_SIZEOF:
00839 case TRM_CONST:
00840 case TRM_VAR:
00841 case TRM_ZEROARY:
00842 return n->literal;
00843 case TRM_QUANTIFIER:
00844 return n->quantified->open;
00845 case TRM_APPLICATION:
00846 if (n->name != NULL)
00847 {
00848 if (n->name->isOpId)
00849 {
00850 return n->name->content.opid;
00851 }
00852 else
00853 {
00854 llassert (n->name->content.opform != NULL);
00855 return n->name->content.opform->tok;
00856 }
00857 }
00858 else
00859 {
00860 return ltoken_undefined;
00861 }
00862 }
00863 }
00864 return ltoken_undefined;
00865 }
00866
00867 ltoken
00868 nameNode_errorToken ( nameNode nn)
00869 {
00870 if (nn != (nameNode) 0)
00871 {
00872 if (nn->isOpId)
00873 {
00874 return nn->content.opid;
00875 }
00876 else
00877 {
00878 if (nn->content.opform != NULL)
00879 {
00880 return nn->content.opform->tok;
00881 }
00882 }
00883 }
00884
00885 return ltoken_undefined;
00886 }
00887
00888 ltoken
00889 lclTypeSpecNode_errorToken ( lclTypeSpecNode t)
00890 {
00891 if (t != (lclTypeSpecNode) 0)
00892 {
00893 switch (t->kind)
00894 {
00895 case LTS_TYPE:
00896 {
00897 llassert (t->content.type != NULL);
00898
00899 if (ltokenList_empty (t->content.type->ctypes))
00900 break;
00901 else
00902 return (ltokenList_head (t->content.type->ctypes));
00903 }
00904 case LTS_STRUCTUNION:
00905 llassert (t->content.structorunion != NULL);
00906 return t->content.structorunion->tok;
00907 case LTS_ENUM:
00908 llassert (t->content.enumspec != NULL);
00909 return t->content.enumspec->tok;
00910 case LTS_CONJ:
00911 return (lclTypeSpecNode_errorToken (t->content.conj->a));
00912 }
00913 }
00914
00915 return ltoken_undefined;
00916 }
00917
00918 static bool
00919 sort_member_modulo_cstring (sort s, termNode t)
00920 {
00921
00922 if (t != (termNode) 0)
00923 {
00924 if (t->kind == TRM_LITERAL)
00925 {
00926 sortNode sn;
00927
00928 sortSet_elements (t->possibleSorts, el)
00929 {
00930 if (sort_compatible_modulo_cstring (s, el))
00931 {
00932 return TRUE;
00933 }
00934 } end_sortSet_elements;
00935
00936 sn = sort_lookup (s);
00937
00938 if (sn.kind == SRT_PTR)
00939 {
00940 char *lit = lsymbol_toChars (ltoken_getText (t->literal));
00941
00942 if (lit != NULL)
00943 {
00944 long val = 0;
00945
00946 if (sscanf (lit, "%ld", &val) == 1)
00947 {
00948 if (val == 0) return TRUE;
00949 }
00950 }
00951 }
00952
00953 return FALSE;
00954 }
00955 else
00956 {
00957 return sort_compatible_modulo_cstring (s, t->sort);
00958 }
00959 }
00960 return FALSE;
00961 }
00962
00963 letDeclNode
00964 makeLetDeclNode (ltoken varid, lclTypeSpecNode t,
00965 termNode term)
00966 {
00967 letDeclNode x = (letDeclNode) dmalloc (sizeof (*x));
00968 varInfo vi = (varInfo) dmalloc (sizeof (*vi));
00969 ltoken errtok;
00970 sort s, termsort;
00971
00972 if (t != (lclTypeSpecNode) 0)
00973 {
00974
00975 s = lclTypeSpecNode2sort (t);
00976 termsort = term->sort;
00977
00978 if (!sort_member_modulo_cstring (s, term) &&
00979 !term->error_reported)
00980 {
00981 errtok = termNode_errorToken (term);
00982
00983
00984
00985
00986
00987 lclerror (errtok,
00988 message ("Let declaration expects type %q", sort_unparse (s)));
00989
00990 }
00991 }
00992 else
00993 {
00994 s = term->sort;
00995 }
00996
00997 vi->id = ltoken_copy (varid);
00998 vi->kind = VRK_LET;
00999 vi->sort = s;
01000 vi->export = TRUE;
01001
01002 (void) symtable_enterVar (g_symtab, vi);
01003 varInfo_free (vi);
01004
01005 x->varid = varid;
01006 x->sortspec = t;
01007 x->term = term;
01008 x->sort = sort_makeNoSort ();
01009
01010 return (x);
01011 }
01012
01013 programNode
01014 makeProgramNodeAction ( programNodeList x, actionKind k)
01015 {
01016 programNode n = (programNode) dmalloc (sizeof (*n));
01017 n->wrapped = 0;
01018 n->kind = k;
01019 n->content.args = x;
01020 return (n);
01021 }
01022
01023 programNode
01024 makeProgramNode ( stmtNode x)
01025 {
01026 programNode n = (programNode) dmalloc (sizeof (*n));
01027
01028 n->wrapped = 0;
01029 n->kind = ACT_SELF;
01030 n->content.self = x;
01031 return (n);
01032 }
01033
01034 typeNode
01035 makeAbstractTypeNode ( abstractNode x)
01036 {
01037 typeNode n = (typeNode) dmalloc (sizeof (*n));
01038
01039 n->kind = TK_ABSTRACT;
01040 n->content.abstract = x;
01041
01042 return (n);
01043 }
01044
01045 typeNode
01046 makeExposedTypeNode ( exposedNode x)
01047 {
01048 typeNode n = (typeNode) dmalloc (sizeof (*n));
01049
01050 n->kind = TK_EXPOSED;
01051 n->content.exposed = x;
01052 return (n);
01053 }
01054
01055
01056
01057
01058
01059 importNode
01060 importNode_makePlain ( ltoken t)
01061 {
01062 importNode imp = (importNode) dmalloc (sizeof (*imp));
01063
01064 imp->kind = IMPPLAIN;
01065 imp->val = t;
01066 return (imp);
01067 }
01068
01069 importNode
01070 importNode_makeBracketed ( ltoken t)
01071 {
01072 importNode imp = (importNode) dmalloc (sizeof (*imp));
01073
01074 imp->kind = IMPBRACKET;
01075 imp->val = t;
01076 return (imp);
01077 }
01078
01079 static cstring extractQuote ( cstring s)
01080 {
01081 int len = cstring_length (s);
01082 char *sc = cstring_toCharsSafe (s);
01083 cstring t;
01084
01085 llassert (len > 1);
01086 *(sc + len - 1) = '\0';
01087 t = cstring_fromChars (mstring_copy (sc + 1));
01088 cstring_free (s);
01089 return (t);
01090 }
01091
01092 importNode
01093 importNode_makeQuoted ( ltoken t)
01094 {
01095 importNode imp = (importNode) dmalloc (sizeof (*imp));
01096 cstring q = extractQuote (cstring_copy (ltoken_getRawString (t)));
01097
01098 imp->kind = IMPQUOTE;
01099
01100 ltoken_setRawText (t, lsymbol_fromChars (cstring_toCharsSafe (q)));
01101
01102 imp->val = t;
01103
01104 cstring_free (q);
01105 return (imp);
01106 }
01107
01108
01109
01110
01111
01112
01113 static void cylerror ( char *s)
01114 {
01115 ylerror(s);
01116 sfree (s);
01117 }
01118
01119 void
01120 checkBrackets (ltoken lb, ltoken rb)
01121 {
01122
01123 cstring tname;
01124
01125 tname = ltoken_getRawString (lb);
01126
01127 if (!cstring_equalLit (tname, "<"))
01128 {
01129 cylerror (cstring_toCharsSafeO (message ("Invalid import token: %s", tname)));
01130 }
01131
01132 tname = ltoken_getRawString (rb);
01133
01134 if (!cstring_equalLit (tname, ">"))
01135 {
01136 cylerror (cstring_toCharsSafeO (message ("Invalid import token: %s", tname)));
01137 }
01138 }
01139
01140 traitRefNode
01141 makeTraitRefNode ( ltokenList fl, renamingNode r)
01142 {
01143 traitRefNode n = (traitRefNode) dmalloc (sizeof (*n));
01144
01145 n->traitid = fl;
01146 n->rename = r;
01147 return (n);
01148 }
01149
01150
01151
01152
01153
01154 static cstring
01155 printLeaves (ltokenList f)
01156 {
01157 bool firstone = TRUE;
01158 cstring s = cstring_undefined;
01159
01160 ltokenList_elements (f, i)
01161 {
01162 if (firstone)
01163 {
01164 s = cstring_copy (ltoken_unparse (i));
01165 firstone = FALSE;
01166 }
01167 else
01168 {
01169 s = message ("%q %s", s, ltoken_unparse (i));
01170 }
01171 } end_ltokenList_elements;
01172
01173 return s;
01174 }
01175
01176
01177 cstring
01178 printLeaves2 (ltokenList f)
01179 {
01180 return (ltokenList_unparse (f));
01181 }
01182
01183 cstring
01184 printRawLeaves2 (ltokenList f)
01185 {
01186 bool first = TRUE;
01187 cstring s = cstring_undefined;
01188
01189 ltokenList_elements (f, i)
01190 {
01191 if (first)
01192 {
01193 s = message ("%s", ltoken_getRawString (i));
01194 first = FALSE;
01195 }
01196 else
01197 s = message ("%q, %s", s, ltoken_getRawString (i));
01198 } end_ltokenList_elements;
01199
01200 return s;
01201 }
01202
01203 renamingNode
01204 makeRenamingNode ( typeNameNodeList n, replaceNodeList r)
01205 {
01206 renamingNode ren = (renamingNode) dmalloc (sizeof (*ren));
01207
01208 if (typeNameNodeList_empty (n))
01209 {
01210 ren->is_replace = TRUE;
01211 ren->content.replace = r;
01212 typeNameNodeList_free (n);
01213 }
01214 else
01215 {
01216 nameAndReplaceNode nr = (nameAndReplaceNode) dmalloc (sizeof (*nr));
01217 nr->replacelist = r;
01218 nr->namelist = n;
01219 ren->is_replace = FALSE;
01220 ren->content.name = nr;
01221 }
01222
01223 return (ren);
01224 }
01225
01226 cstring
01227 renamingNode_unparse ( renamingNode x)
01228 {
01229 if (x != (renamingNode) 0)
01230 {
01231 if (x->is_replace)
01232 {
01233 return (replaceNodeList_unparse (x->content.replace));
01234 }
01235 else
01236 {
01237 return (message ("%q%q", typeNameNodeList_unparse (x->content.name->namelist),
01238 replaceNodeList_unparse (x->content.name->replacelist)));
01239 }
01240 }
01241 return cstring_undefined;
01242 }
01243
01244 replaceNode
01245 makeReplaceNameNode (ltoken t, typeNameNode tn, nameNode nn)
01246 {
01247 replaceNode r = (replaceNode) dmalloc (sizeof (*r));
01248
01249 r->tok = t;
01250 r->isCType = FALSE;
01251 r->typename = tn;
01252 r->content.renamesortname.name = nn;
01253 r->content.renamesortname.signature = (sigNode)NULL;
01254
01255 return (r);
01256 }
01257
01258 replaceNode
01259 makeReplaceNode (ltoken t, typeNameNode tn,
01260 bool is_ctype, ltoken ct,
01261 nameNode nn, sigNode sn)
01262 {
01263 replaceNode r = (replaceNode) dmalloc (sizeof (*r));
01264
01265 r->tok = t;
01266 r->isCType = is_ctype;
01267 r->typename = tn;
01268
01269 if (is_ctype)
01270 {
01271 r->content.ctype = ct;
01272 sigNode_free (sn);
01273 nameNode_free (nn);
01274 }
01275 else
01276 {
01277 r->content.renamesortname.name = nn;
01278 r->content.renamesortname.signature = sn;
01279 ltoken_free (ct);
01280 }
01281
01282 return (r);
01283 }
01284
01285 cstring
01286 replaceNode_unparse ( replaceNode x)
01287 {
01288 if (x != (replaceNode) 0)
01289 {
01290 cstring st;
01291
01292 st = message ("%q for ", typeNameNode_unparse (x->typename));
01293
01294 if (x->isCType)
01295 {
01296 st = message ("%q%s", st, ltoken_getRawString (x->content.ctype));
01297 }
01298 else
01299 {
01300 st = message ("%q%q%q", st, nameNode_unparse (x->content.renamesortname.name),
01301 sigNode_unparse (x->content.renamesortname.signature));
01302 }
01303 return st;
01304 }
01305 return cstring_undefined;
01306 }
01307
01308 nameNode
01309 makeNameNodeForm ( opFormNode opform)
01310 {
01311 nameNode nn = (nameNode) dmalloc (sizeof (*nn));
01312
01313 nn->isOpId = FALSE;
01314 nn->content.opform = opform;
01315
01316 return (nn);
01317 }
01318
01319 nameNode
01320 makeNameNodeId ( ltoken opid)
01321 {
01322 nameNode nn = (nameNode) dmalloc (sizeof (*nn));
01323
01324
01325
01326
01327
01328
01329 if (ltoken_getText (opid) == ConditionalSymbol)
01330 {
01331 opFormNode opform = makeOpFormNode (ltoken_undefined, OPF_IF,
01332 opFormUnion_createMiddle (0),
01333 ltoken_undefined);
01334 nn->isOpId = FALSE;
01335 nn->content.opform = opform;
01336 ltoken_free (opid);
01337 }
01338 else
01339 {
01340 nn->isOpId = TRUE;
01341 nn->content.opid = opid;
01342 }
01343
01344 return (nn);
01345 }
01346
01347 cstring
01348 nameNode_unparse ( nameNode n)
01349 {
01350 if (n != (nameNode) 0)
01351 {
01352 if (n->isOpId)
01353 {
01354 return (cstring_copy (ltoken_getRawString (n->content.opid)));
01355 }
01356 else
01357 {
01358 return (opFormNode_unparse (n->content.opform));
01359 }
01360 }
01361 return cstring_undefined;
01362 }
01363
01364 sigNode
01365 makesigNode (ltoken t, ltokenList domain, ltoken range)
01366 {
01367 sigNode s = (sigNode) dmalloc (sizeof (*s));
01368 unsigned int key;
01369
01370
01371
01372
01373
01374 s->tok = t;
01375 s->domain = domain;
01376 s->range = range;
01377 key = MASH (0, ltoken_getText (range));
01378
01379 ltokenList_elements (domain, id)
01380 {
01381 lsymbol sym = ltoken_getText (id);
01382 key = MASH (key, sym);
01383 } end_ltokenList_elements;
01384
01385 s->key = key;
01386 return (s);
01387 }
01388
01389 cstring sigNode_unparse ( sigNode n)
01390 {
01391 if (n != (sigNode) 0)
01392 {
01393 return (message (":%q -> %s", printLeaves2 (n->domain),
01394 ltoken_unparse (n->range)));
01395 }
01396
01397 return cstring_undefined;
01398 }
01399
01400 void sigNode_markOwned (sigNode n)
01401 {
01402 sfreeEventually (n);
01403 }
01404
01405 cstring
01406 sigNode_unparseText ( sigNode n)
01407 {
01408 if (n != (sigNode) 0)
01409 {
01410 return (message ("%q -> %s", printLeaves2 (n->domain),
01411 ltoken_unparse (n->range)));
01412 }
01413 return cstring_undefined;
01414 }
01415
01416 static unsigned int
01417 opFormNode2key (opFormNode op, opFormKind k)
01418 {
01419 unsigned int key;
01420
01421 switch (k)
01422 {
01423 case OPF_IF:
01424
01425
01426
01427 key = MASH (k, k + 1);
01428
01429
01430 break;
01431 case OPF_ANYOP:
01432 case OPF_MANYOP:
01433 case OPF_ANYOPM:
01434 case OPF_MANYOPM:
01435 {
01436 lsymbol sym = ltoken_getText (op->content.anyop);
01437
01438 if (sym == equalSymbol)
01439 {
01440 key = MASH (k, eqSymbol);
01441 }
01442 else
01443 {
01444 key = MASH (k, ltoken_getText (op->content.anyop));
01445 }
01446 break;
01447 }
01448 case OPF_MIDDLE:
01449 case OPF_MMIDDLE:
01450 case OPF_MIDDLEM:
01451 case OPF_MMIDDLEM:
01452 case OPF_BMIDDLE:
01453 case OPF_BMMIDDLE:
01454 case OPF_BMIDDLEM:
01455 case OPF_BMMIDDLEM:
01456 key = MASH (k, op->content.middle);
01457 key = MASH (key, ltoken_getRawText (op->tok));
01458 break;
01459 case OPF_SELECT:
01460 case OPF_MAP:
01461 case OPF_MSELECT:
01462 case OPF_MMAP:
01463 key = MASH (k, ltoken_getRawText (op->content.id));
01464 break;
01465 default:
01466 key = 0;
01467 }
01468
01469 return key;
01470 }
01471
01472 opFormNode
01473 makeOpFormNode (ltoken t, opFormKind k, opFormUnion u,
01474 ltoken close)
01475 {
01476 opFormNode n = (opFormNode) dmalloc (sizeof (*n));
01477 unsigned int key = 0;
01478
01479
01480
01481
01482
01483 n->tok = t;
01484 n->close = close;
01485 n->kind = k;
01486
01487
01488 switch (k)
01489 {
01490 case OPF_IF:
01491 n->content.middle = 0;
01492
01493 key = MASH (k, k + 1) ;
01494 break;
01495 case OPF_ANYOP:
01496 case OPF_MANYOP:
01497 case OPF_ANYOPM:
01498 case OPF_MANYOPM:
01499 {
01500 lsymbol sym = ltoken_getText (u.anyop);
01501
01502 if (sym == equalSymbol)
01503 {
01504 key = MASH (k, eqSymbol);
01505 }
01506 else
01507 {
01508 key = MASH (k, ltoken_getText (u.anyop));
01509 }
01510
01511 n->content = u;
01512 break;
01513 }
01514 case OPF_MIDDLE:
01515 case OPF_MMIDDLE:
01516 case OPF_MIDDLEM:
01517 case OPF_MMIDDLEM:
01518 case OPF_BMIDDLE:
01519 case OPF_BMMIDDLE:
01520 case OPF_BMIDDLEM:
01521 case OPF_BMMIDDLEM:
01522 n->content = u;
01523 key = MASH (k, u.middle);
01524 key = MASH (key, ltoken_getRawText (t));
01525 break;
01526 case OPF_SELECT:
01527 case OPF_MAP:
01528 case OPF_MSELECT:
01529 case OPF_MMAP:
01530 key = MASH (k, ltoken_getRawText (u.id));
01531 n->content = u;
01532 break;
01533 default:
01534 {
01535 llbug (message ("makeOpFormNode: unknown opFormKind: %d", (int) k));
01536 }
01537 }
01538 n->key = key;
01539 return (n);
01540 }
01541
01542 static cstring printMiddle (int j)
01543 {
01544 int i;
01545 char *s = mstring_createEmpty ();
01546
01547 for (i = j; i >= 1; i--)
01548 {
01549 s = mstring_concatFree1 (s, "__");
01550
01551 if (i != 1)
01552 {
01553 s = mstring_concatFree1 (s, ", ");
01554 }
01555 }
01556
01557 return cstring_fromCharsO (s);
01558 }
01559
01560 cstring
01561 opFormNode_unparse ( opFormNode n)
01562 {
01563 if (n != (opFormNode) 0)
01564 {
01565 switch (n->kind)
01566 {
01567 case OPF_IF:
01568 return (cstring_makeLiteral ("if __ then __ else __ "));
01569 case OPF_ANYOP:
01570 return (cstring_copy (ltoken_getRawString (n->content.anyop)));
01571 case OPF_MANYOP:
01572 return (message ("__ %s", ltoken_getRawString (n->content.anyop)));
01573 case OPF_ANYOPM:
01574 return (message ("%s __ ", ltoken_getRawString (n->content.anyop)));
01575 case OPF_MANYOPM:
01576 return (message ("__ %s __ ", ltoken_getRawString (n->content.anyop)));
01577 case OPF_MIDDLE:
01578 return (message ("%s %q %s",
01579 ltoken_getRawString (n->tok),
01580 printMiddle (n->content.middle),
01581 ltoken_getRawString (n->close)));
01582 case OPF_MMIDDLE:
01583 return (message ("__ %s %q %s",
01584 ltoken_getRawString (n->tok),
01585 printMiddle (n->content.middle),
01586 ltoken_getRawString (n->close)));
01587 case OPF_MIDDLEM:
01588 return (message ("%s %q %s __",
01589 ltoken_getRawString (n->tok),
01590 printMiddle (n->content.middle),
01591 ltoken_getRawString (n->close)));
01592 case OPF_MMIDDLEM:
01593 return (message ("__ %s%q %s __",
01594 ltoken_getRawString (n->tok),
01595 printMiddle (n->content.middle),
01596 ltoken_getRawString (n->close)));
01597 case OPF_BMIDDLE:
01598 return (message ("[%q]", printMiddle (n->content.middle)));
01599 case OPF_BMMIDDLE:
01600 return (message ("__ [%q]", printMiddle (n->content.middle)));
01601 case OPF_BMIDDLEM:
01602 return (message ("[%q] __", printMiddle (n->content.middle)));
01603 case OPF_BMMIDDLEM:
01604 return (message ("__ [%q] __", printMiddle (n->content.middle)));
01605 case OPF_SELECT:
01606 return (message (" \\select %s", ltoken_getRawString (n->content.id)));
01607 case OPF_MAP:
01608 return (message (" \\field_arrow%s", ltoken_getRawString (n->content.id)));
01609 case OPF_MSELECT:
01610 return (message ("__ \\select %s", ltoken_getRawString (n->content.id)));
01611 case OPF_MMAP:
01612 return (message ("__ \\field_arrow %s", ltoken_getRawString (n->content.id)));
01613 default:
01614 llfatalbug (message ("opFormNodeUnparse: unknown kind: %d",
01615 (int) n->kind));
01616 }
01617 }
01618 return cstring_undefined;
01619 }
01620
01621 typeNameNode
01622 makeTypeNameNode (bool isObj, lclTypeSpecNode t, abstDeclaratorNode n)
01623 {
01624 typeNameNode tn = (typeNameNode) dmalloc (sizeof (*tn));
01625 typeNamePack p = (typeNamePack) dmalloc (sizeof (*p));
01626
01627 tn->isTypeName = TRUE;
01628 p->isObj = isObj;
01629 p->type = t;
01630 p->abst = n;
01631 tn->opform = (opFormNode) 0;
01632 tn->typename = p;
01633 return (tn);
01634 }
01635
01636 typeNameNode
01637 makeTypeNameNodeOp (opFormNode n)
01638 {
01639 typeNameNode t = (typeNameNode) dmalloc (sizeof (*t));
01640 t->typename = (typeNamePack) 0;
01641 t->opform = n;
01642 t->isTypeName = FALSE;
01643 return (t);
01644 }
01645
01646 cstring
01647 typeNameNode_unparse ( typeNameNode n)
01648 {
01649 if (n != (typeNameNode) 0)
01650 {
01651 if (n->isTypeName)
01652 {
01653 cstring st = cstring_undefined;
01654 typeNamePack p = n->typename;
01655
01656 llassert (p != NULL);
01657
01658 if (p->isObj)
01659 st = cstring_makeLiteral ("obj ");
01660
01661 return (message ("%q%q%q", st, lclTypeSpecNode_unparse (p->type),
01662 abstDeclaratorNode_unparse (p->abst)));
01663
01664 }
01665 else
01666 return (opFormNode_unparse (n->opform));
01667 }
01668 return cstring_undefined;
01669 }
01670
01671 lclTypeSpecNode
01672 makeLclTypeSpecNodeConj ( lclTypeSpecNode a, lclTypeSpecNode b)
01673 {
01674 lclTypeSpecNode n = (lclTypeSpecNode) dmalloc (sizeof (*n));
01675
01676 n->kind = LTS_CONJ;
01677 n->pointers = 0;
01678 n->quals = qualList_new ();
01679 n->content.conj = (lclconj) dmalloc (sizeof (*n->content.conj));
01680 n->content.conj->a = a;
01681 n->content.conj->b = b;
01682
01683 return (n);
01684 }
01685
01686 lclTypeSpecNode
01687 makeLclTypeSpecNodeType ( CTypesNode x)
01688 {
01689 lclTypeSpecNode n = (lclTypeSpecNode) dmalloc (sizeof (*n));
01690
01691 n->kind = LTS_TYPE;
01692 n->pointers = 0;
01693 n->content.type = x;
01694 n->quals = qualList_new ();
01695 return (n);
01696 }
01697
01698 lclTypeSpecNode
01699 makeLclTypeSpecNodeSU ( strOrUnionNode x)
01700 {
01701 lclTypeSpecNode n = (lclTypeSpecNode) dmalloc (sizeof (*n));
01702
01703 n->kind = LTS_STRUCTUNION;
01704 n->pointers = 0;
01705 n->content.structorunion = x;
01706 n->quals = qualList_new ();
01707 return (n);
01708 }
01709
01710 lclTypeSpecNode
01711 makeLclTypeSpecNodeEnum ( enumSpecNode x)
01712 {
01713 lclTypeSpecNode n = (lclTypeSpecNode) dmalloc (sizeof (*n));
01714
01715 n->quals = qualList_new ();
01716 n->kind = LTS_ENUM;
01717 n->pointers = 0;
01718 n->content.enumspec = x;
01719 return (n);
01720 }
01721
01722 lclTypeSpecNode
01723 lclTypeSpecNode_addQual (lclTypeSpecNode n, qual q)
01724 {
01725 llassert (lclTypeSpecNode_isDefined (n));
01726 n->quals = qualList_add (n->quals, q);
01727 return n;
01728 }
01729
01730 cstring
01731 lclTypeSpecNode_unparse ( lclTypeSpecNode n)
01732 {
01733 if (n != (lclTypeSpecNode) 0)
01734 {
01735 switch (n->kind)
01736 {
01737 case LTS_TYPE:
01738 llassert (n->content.type != NULL);
01739 return (printLeaves (n->content.type->ctypes));
01740 case LTS_STRUCTUNION:
01741 return (strOrUnionNode_unparse (n->content.structorunion));
01742 case LTS_ENUM:
01743 return (enumSpecNode_unparse (n->content.enumspec));
01744 case LTS_CONJ:
01745 return (lclTypeSpecNode_unparse (n->content.conj->a));
01746 default:
01747 llfatalbug (message ("lclTypeSpecNode_unparse: unknown lclTypeSpec kind: %d",
01748 (int) n->kind));
01749 }
01750 }
01751 return cstring_undefined;
01752 }
01753
01754 enumSpecNode
01755 makeEnumSpecNode (ltoken t, ltoken optTagId,
01756 ltokenList enums)
01757 {
01758 enumSpecNode n = (enumSpecNode) dmalloc (sizeof (*n));
01759 tagInfo ti;
01760 smemberInfo *top = smemberInfo_undefined;
01761
01762 n->tok = t;
01763 n->opttagid = ltoken_copy (optTagId);
01764 n->enums = enums;
01765
01766
01767 n->sort = sort_makeEnum (optTagId);
01768
01769 if (!ltoken_isUndefined (optTagId))
01770 {
01771
01772 ti = symtable_tagInfo (g_symtab, ltoken_getText (optTagId));
01773
01774 if (tagInfo_exists (ti))
01775 {
01776 if (ti->kind == TAG_ENUM)
01777 {
01778
01779
01780 ti->content.enums = enums;
01781 ti->sort = n->sort;
01782 ti->imported = context_inImport ();
01783 }
01784 else
01785 {
01786 lclerror (optTagId,
01787 message ("Tag %s previously defined as %q, redefined as enum",
01788 ltoken_getRawString (optTagId),
01789 tagKind_unparse (ti->kind)));
01790
01791
01792 }
01793
01794 ltoken_free (optTagId);
01795 }
01796 else
01797 {
01798 ti = (tagInfo) dmalloc (sizeof (*ti));
01799
01800 ti->kind = TAG_ENUM;
01801 ti->id = optTagId;
01802 ti->content.enums = enums;
01803 ti->sort = n->sort;
01804 ti->imported = context_inImport ();
01805
01806 (void) symtable_enterTag (g_symtab, ti);
01807 }
01808 }
01809
01810
01811
01812 ltokenList_reset (enums);
01813
01814 while (!ltokenList_isFinished (enums))
01815 {
01816 ltoken c = ltokenList_current (enums);
01817 smemberInfo *ei = (smemberInfo *) dmalloc (sizeof (*ei));
01818
01819 ei->name = ltoken_getText (c);
01820 ei->next = top;
01821 ei->sort = n->sort;
01822 top = ei;
01823
01824 if (!varInfo_exists (symtable_varInfo (g_symtab, ltoken_getText (c))))
01825 {
01826 varInfo vi = (varInfo) dmalloc (sizeof (*vi));
01827
01828 vi->id = ltoken_copy (c);
01829 vi->kind = VRK_ENUM;
01830 vi->sort = n->sort;
01831 vi->export = TRUE;
01832
01833 (void) symtable_enterVar (g_symtab, vi);
01834 varInfo_free (vi);
01835 }
01836 else
01837 {
01838 lclerror (c, message ("Enumerated value redeclared: %s",
01839 ltoken_getRawString (c)));
01840 ltokenList_removeCurrent (enums);
01841 }
01842 ltokenList_advance (enums);
01843
01844 }
01845
01846
01847 (void) sort_updateEnum (n->sort, top);
01848 return (n);
01849 }
01850
01851 enumSpecNode
01852 makeEnumSpecNode2 (ltoken t, ltoken tagid)
01853 {
01854
01855 enumSpecNode n = (enumSpecNode) dmalloc (sizeof (*n));
01856 tagInfo ti = symtable_tagInfo (g_symtab, ltoken_getText (tagid));
01857
01858 n->tok = t;
01859 n->opttagid = tagid;
01860 n->enums = ltokenList_new ();
01861
01862 if (tagInfo_exists (ti))
01863 {
01864 if (ti->kind == TAG_ENUM)
01865 {
01866 n->sort = ti->sort;
01867 }
01868 else
01869 {
01870 n->sort = sort_makeNoSort ();
01871 lclerror (tagid, message ("Tag %s defined as %q, used as enum",
01872 ltoken_getRawString (tagid),
01873 tagKind_unparse (ti->kind)));
01874 }
01875 }
01876 else
01877 {
01878 n->sort = sort_makeNoSort ();
01879 lclerror (t, message ("Undefined type: enum %s",
01880 ltoken_getRawString (tagid)));
01881 }
01882
01883 return (n);
01884 }
01885
01886 cstring
01887 enumSpecNode_unparse ( enumSpecNode n)
01888 {
01889 if (n != (enumSpecNode) 0)
01890 {
01891 cstring s = cstring_makeLiteral ("enum ");
01892
01893 if (!ltoken_isUndefined (n->opttagid))
01894 {
01895 s = message ("%q%s ", s, ltoken_getRawString (n->opttagid));
01896 }
01897
01898 s = message ("%q{%q}", s, printLeaves2 (n->enums));
01899 return s;
01900 }
01901 return cstring_undefined;
01902 }
01903
01904 strOrUnionNode
01905 makestrOrUnionNode (ltoken str, suKind k, ltoken opttagid,
01906 stDeclNodeList x)
01907 {
01908 strOrUnionNode n = (strOrUnionNode) dmalloc (sizeof (*n));
01909 lsymbolSet set = lsymbolSet_new ();
01910 declaratorNodeList declarators;
01911 sort fieldsort, tsort1, tsort2;
01912 smemberInfo *mi, *top = smemberInfo_undefined;
01913 bool doTag = FALSE;
01914 bool isStruct = (k == SU_STRUCT);
01915 tagInfo t;
01916
01917
01918 n->kind = k;
01919 n->tok = str;
01920 n->opttagid = ltoken_copy (opttagid);
01921 n->structdecls = x;
01922 n->sort = isStruct ? sort_makeStr (opttagid) : sort_makeUnion (opttagid);
01923
01924 if (!ltoken_isUndefined (opttagid))
01925 {
01926
01927 t = symtable_tagInfo (g_symtab, ltoken_getText (opttagid));
01928
01929 if (tagInfo_exists (t))
01930 {
01931 if ((t->kind == TAG_FWDUNION && k == SU_UNION) ||
01932 (t->kind == TAG_FWDSTRUCT && k == SU_STRUCT))
01933 {
01934
01935 t->content.decls = stDeclNodeList_copy (x);
01936 t->sort = n->sort;
01937 }
01938 else
01939 {
01940 lclerror (opttagid,
01941 message ("Tag %s previously defined as %q, used as %q",
01942 ltoken_getRawString (opttagid),
01943 tagKind_unparse (t->kind),
01944 cstring_makeLiteral (isStruct ? "struct" : "union")));
01945 }
01946 }
01947 else
01948 {
01949 doTag = TRUE;
01950 }
01951 }
01952 else
01953 {
01954 doTag = TRUE;
01955 }
01956
01957 if (doTag && !ltoken_isUndefined (opttagid))
01958 {
01959 t = (tagInfo) dmalloc (sizeof (*t));
01960
01961
01962
01963
01964 t->kind = (k == SU_STRUCT) ? TAG_STRUCT : TAG_UNION;
01965 t->id = opttagid;
01966 t->content.decls = stDeclNodeList_copy (x);
01967 t->sort = n->sort;
01968 t->imported = FALSE;
01969
01970
01971 (void) symtable_enterTagForce (g_symtab, t);
01972 }
01973
01974
01975
01976 stDeclNodeList_elements (x, i)
01977 {
01978 fieldsort = lclTypeSpecNode2sort (i->lcltypespec);
01979
01980
01981
01982
01983
01984
01985 declarators = i->declarators;
01986
01987 declaratorNodeList_elements (declarators, decl)
01988 {
01989 lsymbol fieldname;
01990 mi = (smemberInfo *) dmalloc (sizeof (*mi));
01991
01992 fieldname = ltoken_getText (decl->id);
01993
01994
01995 tsort1 = typeExpr2ptrSort (fieldsort, decl->type);
01996 tsort2 = sort_makeGlobal (tsort1);
01997
01998 mi->name = fieldname;
01999 mi->sort = tsort2;
02000 mi->next = top;
02001 top = mi;
02002
02003 if (lsymbolSet_member (set, fieldname))
02004 {
02005 lclerror (decl->id,
02006 message ("Field name reused: %s",
02007 ltoken_getRawString (decl->id)));
02008 }
02009 else
02010 {
02011 (void) lsymbolSet_insert (set, fieldname);
02012 }
02013
02014 } end_declaratorNodeList_elements;
02015
02016 } end_stDeclNodeList_elements;
02017
02018 if (k == SU_STRUCT)
02019 {
02020 (void) sort_updateStr (n->sort, top);
02021 }
02022 else
02023 {
02024 (void) sort_updateUnion (n->sort, top);
02025 }
02026
02027
02028
02029
02030 lsymbolSet_free (set);
02031
02032 return (n);
02033 }
02034
02035 strOrUnionNode
02036 makeForwardstrOrUnionNode (ltoken str, suKind k,
02037 ltoken tagid)
02038 {
02039 strOrUnionNode n = (strOrUnionNode) dmalloc (sizeof (*n));
02040 sort sort = sort_makeNoSort ();
02041 tagInfo t;
02042
02043
02044
02045 n->kind = k;
02046 n->tok = str;
02047 n->opttagid = tagid;
02048 n->structdecls = stDeclNodeList_new ();
02049
02050
02051 t = symtable_tagInfo (g_symtab, ltoken_getText (tagid));
02052
02053 if (tagInfo_exists (t))
02054 {
02055 sort = t->sort;
02056
02057 if (!(((t->kind == TAG_STRUCT || t->kind == TAG_FWDSTRUCT) && k == SU_STRUCT)
02058 || ((t->kind == TAG_UNION || t->kind == TAG_FWDUNION) && k == SU_UNION)))
02059 {
02060 lclerror (tagid,
02061 message ("Tag %s previously defined as %q, used as %q",
02062 ltoken_getRawString (tagid),
02063 tagKind_unparse (t->kind),
02064 cstring_makeLiteral ((k == SU_STRUCT) ? "struct" : "union")));
02065 }
02066 }
02067 else
02068 {
02069
02070
02071
02072
02073
02074
02075
02076
02077
02078 if (k == SU_STRUCT)
02079 {
02080 (void) checkAndEnterTag (TAG_FWDSTRUCT, ltoken_copy (tagid));
02081 lhForwardStruct (tagid);
02082 sort = sort_makeStr (tagid);
02083 }
02084 else
02085 {
02086 (void) checkAndEnterTag (TAG_FWDUNION, ltoken_copy (tagid));
02087 lhForwardUnion (tagid);
02088 sort = sort_makeUnion (tagid);
02089 }
02090 }
02091
02092 n->sort = sort;
02093 return (n);
02094 }
02095
02096 cstring
02097 strOrUnionNode_unparse ( strOrUnionNode n)
02098 {
02099 if (n != (strOrUnionNode) 0)
02100 {
02101 cstring s;
02102 switch (n->kind)
02103 {
02104 case SU_STRUCT:
02105 s = cstring_makeLiteral ("struct ");
02106 break;
02107 case SU_UNION:
02108 s = cstring_makeLiteral ("union ");
02109 break;
02110 BADDEFAULT
02111 }
02112
02113 if (!ltoken_isUndefined (n->opttagid))
02114 {
02115 s = message ("%q%s ", s, ltoken_getRawString (n->opttagid));
02116 }
02117 s = message ("%q{%q}", s, stDeclNodeList_unparse (n->structdecls));
02118 return s;
02119 }
02120 return cstring_undefined;
02121 }
02122
02123 stDeclNode
02124 makestDeclNode (lclTypeSpecNode s,
02125 declaratorNodeList x)
02126 {
02127 stDeclNode n = (stDeclNode) dmalloc (sizeof (*n));
02128
02129 n->lcltypespec = s;
02130 n->declarators = x;
02131 return n;
02132 }
02133
02134 typeExpr
02135 makeFunctionNode (typeExpr x, paramNodeList p)
02136 {
02137 typeExpr y = (typeExpr) dmalloc (sizeof (*y));
02138
02139 y->wrapped = 0;
02140 y->kind = TEXPR_FCN;
02141 y->content.function.returntype = x;
02142 y->content.function.args = p;
02143 y->sort = sort_makeNoSort ();
02144
02145 return (y);
02146 }
02147
02148 static ltoken
02149 extractDeclarator ( typeExpr t)
02150 {
02151 if (t != (typeExpr) 0)
02152 {
02153 switch (t->kind)
02154 {
02155 case TEXPR_BASE:
02156 return t->content.base;
02157 case TEXPR_PTR:
02158 return (extractDeclarator (t->content.pointer));
02159 case TEXPR_ARRAY:
02160 return (extractDeclarator (t->content.array.elementtype));
02161 case TEXPR_FCN:
02162 return (extractDeclarator (t->content.function.returntype));
02163 }
02164 }
02165
02166 return ltoken_undefined;
02167 }
02168
02169 typeExpr
02170 makeTypeExpr (ltoken t)
02171 {
02172 typeExpr x = (typeExpr) dmalloc (sizeof (*x));
02173
02174
02175 x->wrapped = 0;
02176 x->kind = TEXPR_BASE;
02177 x->content.base = t;
02178 x->sort = sort_makeNoSort ();
02179
02180 return (x);
02181 }
02182
02183
02184 declaratorNode
02185 makeDeclaratorNode (typeExpr t)
02186 {
02187 declaratorNode x = (declaratorNode) dmalloc (sizeof (*x));
02188
02189 x->id = ltoken_copy (extractDeclarator (t));
02190 x->type = t;
02191 x->isRedecl = FALSE;
02192
02193 return (x);
02194 }
02195
02196 static declaratorNode
02197 makeUnknownDeclaratorNode ( ltoken t)
02198 {
02199 declaratorNode x = (declaratorNode) dmalloc (sizeof (*x));
02200
02201 x->id = t;
02202 x->type = (typeExpr) 0;
02203 x->isRedecl = FALSE;
02204
02205 return (x);
02206 }
02207
02208 static cstring
02209 printTypeExpr2 ( typeExpr x)
02210 {
02211 paramNodeList params;
02212
02213 if (x != (typeExpr) 0)
02214 {
02215 cstring s;
02216
02217 switch (x->kind)
02218 {
02219 case TEXPR_BASE:
02220 return (message ("%s ", ltoken_getRawString (x->content.base)));
02221 case TEXPR_PTR:
02222 return (message ("%qptr to ", printTypeExpr2 (x->content.pointer)));
02223 case TEXPR_ARRAY:
02224 return (message ("array[%q] of %q",
02225 termNode_unparse (x->content.array.size),
02226 printTypeExpr2 (x->content.array.elementtype)));
02227 case TEXPR_FCN:
02228 s = printTypeExpr2 (x->content.function.returntype);
02229 params = x->content.function.args;
02230 if (!paramNodeList_empty (params))
02231 {
02232 s = message ("%qfcn with args: (%q)", s,
02233 paramNodeList_unparse (x->content.function.args));
02234 }
02235 else
02236 s = message ("%qfcn with no args", s);
02237 return s;
02238 default:
02239 llfatalbug (message ("printTypeExpr2: unknown typeExprKind: %d", (int) x->kind));
02240 }
02241 }
02242 return cstring_undefined;
02243 }
02244
02245 cstring
02246 declaratorNode_unparse (declaratorNode x)
02247 {
02248 return (typeExpr_unparse (x->type));
02249 }
02250
02251 declaratorNode
02252 declaratorNode_copy (declaratorNode x)
02253 {
02254 declaratorNode ret = (declaratorNode) dmalloc (sizeof (*ret));
02255
02256 ret->type = typeExpr_copy (x->type);
02257 ret->id = ltoken_copy (x->id);
02258 ret->isRedecl = x->isRedecl;
02259
02260 return (ret);
02261 }
02262
02263 static typeExpr typeExpr_copy ( typeExpr x)
02264 {
02265 if (x == NULL)
02266 {
02267 return NULL;
02268 }
02269 else
02270 {
02271 typeExpr ret = (typeExpr) dmalloc (sizeof (*ret));
02272
02273 ret->wrapped = x->wrapped;
02274 ret->kind = x->kind;
02275
02276 switch (ret->kind)
02277 {
02278 case TEXPR_BASE:
02279 ret->content.base = ltoken_copy (x->content.base);
02280 break;
02281 case TEXPR_PTR:
02282 ret->content.pointer = typeExpr_copy (x->content.pointer);
02283 break;
02284 case TEXPR_ARRAY:
02285 ret->content.array.elementtype = typeExpr_copy (x->content.array.elementtype);
02286 ret->content.array.size = termNode_copy (x->content.array.size);
02287 break;
02288 case TEXPR_FCN:
02289 ret->content.function.returntype = typeExpr_copy (x->content.function.returntype);
02290 ret->content.function.args = paramNodeList_copy (x->content.function.args);
02291 break;
02292 }
02293
02294 ret->sort = x->sort;
02295 return ret;
02296 }
02297 }
02298
02299 static cstring
02300 typeExpr_unparseCode ( typeExpr x)
02301 {
02302
02303 cstring s = cstring_undefined;
02304
02305 if (x != (typeExpr) 0)
02306 {
02307 switch (x->kind)
02308 {
02309 case TEXPR_BASE:
02310 return (cstring_copy (ltoken_getRawString (x->content.base)));
02311 case TEXPR_PTR:
02312 return (typeExpr_unparseCode (x->content.pointer));
02313 case TEXPR_ARRAY:
02314 return (typeExpr_unparseCode (x->content.array.elementtype));
02315 case TEXPR_FCN:
02316 return (typeExpr_unparseCode (x->content.function.returntype));
02317 }
02318 }
02319 return s;
02320 }
02321
02322 void typeExpr_free ( typeExpr x)
02323 {
02324 if (x != (typeExpr) 0)
02325 {
02326 switch (x->kind)
02327 {
02328 case TEXPR_BASE:
02329 break;
02330 case TEXPR_PTR:
02331 typeExpr_free (x->content.pointer);
02332 break;
02333 case TEXPR_ARRAY:
02334 typeExpr_free (x->content.array.elementtype);
02335 termNode_free (x->content.array.size);
02336 break;
02337 case TEXPR_FCN:
02338 typeExpr_free (x->content.function.returntype);
02339 paramNodeList_free (x->content.function.args);
02340 break;
02341
02342 }
02343
02344
02345 sfree (x);
02346 }
02347 }
02348
02349
02350 cstring
02351 declaratorNode_unparseCode (declaratorNode x)
02352 {
02353 return (typeExpr_unparseCode (x->type));
02354 }
02355
02356 cstring
02357 typeExpr_unparse ( typeExpr x)
02358 {
02359 cstring s = cstring_undefined;
02360 paramNodeList params;
02361 int i;
02362
02363 if (x != (typeExpr) 0)
02364 {
02365 cstring front = cstring_undefined;
02366 cstring back = cstring_undefined;
02367
02368 llassert (x->wrapped < 100);
02369
02370 for (i = x->wrapped; i >= 1; i--)
02371 {
02372 front = cstring_appendChar (front, '(');
02373 back = cstring_appendChar (back, ')');
02374 }
02375
02376 switch (x->kind)
02377 {
02378 case TEXPR_BASE:
02379 s = message ("%q%s", s, ltoken_getRawString (x->content.base));
02380 break;
02381 case TEXPR_PTR:
02382 s = message ("%q*%q", s, typeExpr_unparse (x->content.pointer));
02383 break;
02384 case TEXPR_ARRAY:
02385 s = message ("%q%q[%q]", s,
02386 typeExpr_unparse (x->content.array.elementtype),
02387 termNode_unparse (x->content.array.size));
02388 break;
02389 case TEXPR_FCN:
02390 s = message ("%q%q (", s,
02391 typeExpr_unparse (x->content.function.returntype));
02392 params = x->content.function.args;
02393
02394 if (!paramNodeList_empty (params))
02395 {
02396 s = message ("%q%q", s,
02397 paramNodeList_unparse (x->content.function.args));
02398 }
02399
02400 s = message ("%q)", s);
02401 break;
02402 }
02403 s = message ("%q%q%q", front, s, back);
02404 }
02405 else
02406 {
02407 s = cstring_makeLiteral ("?");
02408 }
02409
02410 return s;
02411 }
02412
02413 cstring
02414 typeExpr_unparseNoBase ( typeExpr x)
02415 {
02416 cstring s = cstring_undefined;
02417 paramNodeList params;
02418 int i;
02419
02420 if (x != (typeExpr) 0)
02421 {
02422 cstring front = cstring_undefined;
02423 cstring back = cstring_undefined;
02424
02425 llassert (x->wrapped < 100);
02426
02427 for (i = x->wrapped; i >= 1; i--)
02428 {
02429 front = cstring_appendChar (front, '(');
02430 back = cstring_appendChar (back, ')');
02431 }
02432
02433 switch (x->kind)
02434 {
02435 case TEXPR_BASE:
02436 s = message ("%q /* %s */", s, ltoken_getRawString (x->content.base));
02437 break;
02438 case TEXPR_PTR:
02439 s = message ("%q*%q", s, typeExpr_unparseNoBase (x->content.pointer));
02440 break;
02441 case TEXPR_ARRAY:
02442 s = message ("%q%q[%q]", s,
02443 typeExpr_unparseNoBase (x->content.array.elementtype),
02444 termNode_unparse (x->content.array.size));
02445 break;
02446 case TEXPR_FCN:
02447 s = message ("%q%q (", s,
02448 typeExpr_unparseNoBase (x->content.function.returntype));
02449 params = x->content.function.args;
02450
02451 if (!paramNodeList_empty (params))
02452 {
02453 s = message ("%q%q", s,
02454 paramNodeList_unparse (x->content.function.args));
02455 }
02456
02457 s = message ("%q)", s);
02458 break;
02459 }
02460 s = message ("%q%q%q", front, s, back);
02461 }
02462 else
02463 {
02464 s = cstring_makeLiteral ("?");
02465 }
02466
02467 return s;
02468 }
02469
02470 cstring
02471 typeExpr_name ( typeExpr x)
02472 {
02473 if (x != (typeExpr) 0)
02474 {
02475 switch (x->kind)
02476 {
02477 case TEXPR_BASE:
02478 return (cstring_copy (ltoken_getRawString (x->content.base)));
02479 case TEXPR_PTR:
02480 return (typeExpr_name (x->content.pointer));
02481 case TEXPR_ARRAY:
02482 return (typeExpr_name (x->content.array.elementtype));
02483 case TEXPR_FCN:
02484 return (typeExpr_name (x->content.function.returntype));
02485 }
02486 }
02487
02488
02489
02490
02491
02492
02493 return cstring_undefined;
02494 }
02495
02496 typeExpr
02497 makePointerNode (ltoken star, typeExpr x)
02498 {
02499 if (x != (typeExpr)0 && (x->kind == TEXPR_FCN && (x->wrapped == 0)))
02500 {
02501 x->content.function.returntype = makePointerNode (star, x->content.function.returntype);
02502 return x;
02503 }
02504 else
02505 {
02506 typeExpr y = (typeExpr) dmalloc (sizeof (*y));
02507
02508 y->wrapped = 0;
02509 y->kind = TEXPR_PTR;
02510 y->content.pointer = x;
02511 y->sort = sort_makeNoSort ();
02512 ltoken_free (star);
02513
02514 return y;
02515 }
02516 }
02517
02518 typeExpr makeArrayNode ( typeExpr x,
02519 arrayQualNode a)
02520 {
02521 if (x != (typeExpr)0 && (x->kind == TEXPR_FCN && (x->wrapped == 0)))
02522 {
02523
02524
02525
02526
02527
02528 x->content.function.returntype = makeArrayNode (x, a);
02529 return x;
02530 }
02531 else
02532 {
02533 typeExpr y = (typeExpr) dmalloc (sizeof (*y));
02534 y->wrapped = 0;
02535 y->kind = TEXPR_ARRAY;
02536
02537 if (a == (arrayQualNode) 0)
02538 {
02539 y->content.array.size = (termNode) 0;
02540 }
02541 else
02542 {
02543 y->content.array.size = a->term;
02544 ltoken_free (a->tok);
02545 sfree (a);
02546 }
02547
02548 y->content.array.elementtype = x;
02549 y->sort = sort_makeNoSort ();
02550
02551 return (y);
02552 }
02553 }
02554
02555 constDeclarationNode
02556 makeConstDeclarationNode (lclTypeSpecNode t, initDeclNodeList decls)
02557 {
02558 constDeclarationNode n = (constDeclarationNode) dmalloc (sizeof (*n));
02559 sort s, s2, initValueSort;
02560 ltoken varid, errtok;
02561 termNode initValue;
02562
02563 s = lclTypeSpecNode2sort (t);
02564
02565 initDeclNodeList_elements (decls, init)
02566 {
02567 declaratorNode vdnode = init->declarator;
02568 varInfo vi = (varInfo) dmalloc (sizeof (*vi));
02569
02570 varid = ltoken_copy (vdnode->id);
02571 s2 = typeExpr2ptrSort (s, vdnode->type);
02572 initValue = init->value;
02573
02574 if (termNode_isDefined (initValue) && !initValue->error_reported)
02575 {
02576 initValueSort = initValue->sort;
02577
02578
02579 if (!sort_member_modulo_cstring (s2, initValue)
02580 && !initValue->error_reported)
02581 {
02582 errtok = termNode_errorToken (initValue);
02583
02584 lclerror
02585 (errtok,
02586 message ("Constant %s declared type %q, initialized to %q: %q",
02587 ltoken_unparse (varid),
02588 sort_unparse (s2),
02589 sort_unparse (initValueSort),
02590 termNode_unparse (initValue)));
02591 }
02592 }
02593
02594 vi->id = varid;
02595 vi->kind = VRK_CONST;
02596 vi->sort = s2;
02597 vi->export = TRUE;
02598
02599 (void) symtable_enterVar (g_symtab, vi);
02600 varInfo_free (vi);
02601
02602 } end_initDeclNodeList_elements;
02603
02604 n->type = t;
02605 n->decls = decls;
02606
02607 return n;
02608 }
02609
02610 varDeclarationNode makeInternalStateNode (void)
02611 {
02612 varDeclarationNode n = (varDeclarationNode) dmalloc (sizeof (*n));
02613
02614 n->isSpecial = TRUE;
02615 n->sref = sRef_makeInternalState ();
02616
02617 return n;
02618 }
02619
02620 varDeclarationNode makeFileSystemNode (void)
02621 {
02622 varDeclarationNode n = (varDeclarationNode) dmalloc (sizeof (*n));
02623
02624 n->isSpecial = TRUE;
02625 n->sref = sRef_makeSystemState ();
02626
02627 return n;
02628 }
02629
02630 varDeclarationNode
02631 makeVarDeclarationNode (lclTypeSpecNode t, initDeclNodeList x,
02632 bool isGlobal, bool isPrivate)
02633 {
02634 varDeclarationNode n = (varDeclarationNode) dmalloc (sizeof (*n));
02635 sort s, s2, initValueSort;
02636 ltoken varid, errtok;
02637 termNode initValue;
02638 declaratorNode vdnode;
02639
02640 n->isSpecial = FALSE;
02641 n->qualifier = QLF_NONE;
02642 n->isGlobal = isGlobal;
02643 n->isPrivate = isPrivate;
02644 n->decls = x;
02645
02646 s = lclTypeSpecNode2sort (t);
02647
02648
02649
02650 initDeclNodeList_elements (x, init)
02651 {
02652 vdnode = init->declarator;
02653 varid = vdnode->id;
02654 s2 = typeExpr2ptrSort (s, vdnode->type);
02655 initValue = init->value;
02656
02657 if (termNode_isDefined (initValue) && !initValue->error_reported)
02658 {
02659 initValueSort = initValue->sort;
02660
02661 if (!sort_member_modulo_cstring (s2, initValue)
02662 && !initValue->error_reported)
02663 {
02664 errtok = termNode_errorToken (initValue);
02665
02666 lclerror (errtok,
02667 message ("Variable %s declared type %q, initialized to %q",
02668 ltoken_unparse (varid),
02669 sort_unparse (s2),
02670 sort_unparse (initValueSort)));
02671 }
02672 }
02673
02674
02675
02676
02677
02678
02679 if (isGlobal)
02680 {
02681 varInfo vi = symtable_varInfo (g_symtab, ltoken_getText (varid));
02682
02683 if (!varInfo_exists (vi))
02684 {
02685 lclerror (varid,
02686 message ("Undeclared global variable: %s",
02687 ltoken_getRawString (varid)));
02688 }
02689 else
02690 {
02691 if (vi->kind == VRK_CONST)
02692 {
02693 lclerror (varid,
02694 message ("Constant used in global list: %s",
02695 ltoken_getRawString (varid)));
02696 }
02697 }
02698 }
02699 else
02700 {
02701 varInfo vi = (varInfo) dmalloc (sizeof (*vi));
02702
02703 vi->id = ltoken_copy (varid);
02704 if (isPrivate)
02705 {
02706 vi->kind = VRK_PRIVATE;
02707
02708 if (initValue == (termNode) 0)
02709 {
02710 lclerror (varid,
02711 message ("Private variable must have initialization: %s",
02712 ltoken_getRawString (varid)));
02713 }
02714 }
02715 else
02716 {
02717 vi->kind = VRK_VAR;
02718 }
02719
02720 vi->sort = sort_makeGlobal (s2);
02721 vi->export = TRUE;
02722
02723 vdnode->isRedecl = symtable_enterVar (g_symtab, vi);
02724 varInfo_free (vi);
02725 }
02726 } end_initDeclNodeList_elements;
02727
02728 n->type = t;
02729
02730 return n;
02731 }
02732
02733 initDeclNode
02734 makeInitDeclNode (declaratorNode d, termNode x)
02735 {
02736 initDeclNode n = (initDeclNode) dmalloc (sizeof (*n));
02737
02738 n->declarator = d;
02739 n->value = x;
02740 return n;
02741 }
02742
02743 abstractNode
02744 makeAbstractNode (ltoken t, ltoken name,
02745 bool isMutable, bool isRefCounted, abstBodyNode a)
02746 {
02747 abstractNode n = (abstractNode) dmalloc (sizeof (*n));
02748 sort handle;
02749 typeInfo ti = (typeInfo) dmalloc (sizeof (*ti));
02750
02751 n->tok = t;
02752 n->isMutable = isMutable;
02753 n->name = name;
02754 n->body = a;
02755 n->isRefCounted = isRefCounted;
02756
02757 if (isMutable)
02758 handle = sort_makeMutable (name, ltoken_getText (name));
02759 else
02760 handle = sort_makeImmutable (name, ltoken_getText (name));
02761 n->sort = handle;
02762
02763 ti->id = ltoken_createType (ltoken_getCode (ltoken_typename), SID_TYPE,
02764 ltoken_getText (name));
02765 ti->modifiable = isMutable;
02766 ti->abstract = TRUE;
02767 ti->basedOn = handle;
02768 ti->export = TRUE;
02769
02770 symtable_enterType (g_symtab, ti);
02771
02772
02773 return n;
02774 }
02775
02776 cstring
02777 abstractNode_unparse (abstractNode n)
02778 {
02779 if (n != (abstractNode) 0)
02780 {
02781 cstring s;
02782
02783 if (n->isMutable)
02784 s = cstring_makeLiteral ("mutable");
02785 else
02786 s = cstring_makeLiteral ("immutable");
02787
02788 return (message ("%q type %s%q;", s, ltoken_getRawString (n->name),
02789 abstBodyNode_unparse (n->body)));
02790 }
02791 return cstring_undefined;
02792 }
02793
02794 void
02795 setExposedType (lclTypeSpecNode s)
02796 {
02797 exposedType = s;
02798 }
02799
02800 exposedNode
02801 makeExposedNode (ltoken t, lclTypeSpecNode s,
02802 declaratorInvNodeList d)
02803 {
02804 exposedNode n = (exposedNode) dmalloc (sizeof (*n));
02805
02806 n->tok = t;
02807 n->type = s;
02808 n->decls = d;
02809
02810 return n;
02811 }
02812
02813 cstring
02814 exposedNode_unparse (exposedNode n)
02815 {
02816 if (n != (exposedNode) 0)
02817 {
02818 return (message ("typedef %q %q;",
02819 lclTypeSpecNode_unparse (n->type),
02820 declaratorInvNodeList_unparse (n->decls)));
02821 }
02822 return cstring_undefined;
02823 }
02824
02825 declaratorInvNode
02826 makeDeclaratorInvNode (declaratorNode d, abstBodyNode b)
02827 {
02828 declaratorInvNode n = (declaratorInvNode) dmalloc (sizeof (*n));
02829 n->declarator = d;
02830 n->body = b;
02831
02832 return (n);
02833 }
02834
02835 cstring
02836 declaratorInvNode_unparse (declaratorInvNode d)
02837 {
02838 return (message ("%q%q", declaratorNode_unparse (d->declarator),
02839 abstBodyNode_unparseExposed (d->body)));
02840 }
02841
02842 cstring
02843 abstBodyNode_unparse (abstBodyNode n)
02844 {
02845 if (n != (abstBodyNode) 0)
02846 {
02847 return (lclPredicateNode_unparse (n->typeinv));
02848 }
02849 return cstring_undefined;
02850 }
02851
02852 cstring
02853 abstBodyNode_unparseExposed (abstBodyNode n)
02854 {
02855 if (n != (abstBodyNode) 0)
02856 {
02857 return (message ("%q", lclPredicateNode_unparse (n->typeinv)));
02858 }
02859 return cstring_undefined;
02860 }
02861
02862 cstring
02863 taggedUnionNode_unparse (taggedUnionNode n)
02864 {
02865 if (n != (taggedUnionNode) 0)
02866 {
02867 return (message ("tagged union {%q}%q;\n",
02868 stDeclNodeList_unparse (n->structdecls),
02869 declaratorNode_unparse (n->declarator)));
02870 }
02871 return cstring_undefined;
02872 }
02873
02874 static paramNodeList
02875 typeExpr_toParamNodeList ( typeExpr te)
02876 {
02877 if (te != (typeExpr) 0)
02878 {
02879 switch (te->kind)
02880 {
02881 case TEXPR_FCN:
02882 return te->content.function.args;
02883 case TEXPR_PTR:
02884 return typeExpr_toParamNodeList (te->content.pointer);
02885 case TEXPR_ARRAY:
02886
02887 case TEXPR_BASE:
02888 return paramNodeList_undefined;
02889 }
02890 }
02891 return paramNodeList_undefined;
02892 }
02893
02894 fcnNode
02895 fcnNode_fromDeclarator ( lclTypeSpecNode t,
02896 declaratorNode d)
02897 {
02898 return (makeFcnNode (QU_UNKNOWN, t, d,
02899 varDeclarationNodeList_new (),
02900 varDeclarationNodeList_new (),
02901 letDeclNodeList_new (),
02902 (lclPredicateNode) 0,
02903 (lclPredicateNode) 0,
02904 (modifyNode) 0,
02905 (lclPredicateNode) 0,
02906 (lclPredicateNode) 0));
02907 }
02908
02909 iterNode
02910 makeIterNode (ltoken id, paramNodeList p)
02911 {
02912 iterNode x = (iterNode) dmalloc (sizeof (*x));
02913 bool hasYield = FALSE;
02914
02915 x->name = id;
02916 x->params = p;
02917
02918
02919
02920 paramNodeList_elements (p, pe)
02921 {
02922 if (paramNode_isYield (pe))
02923 {
02924 hasYield = TRUE;
02925 break;
02926 }
02927 } end_paramNodeList_elements
02928
02929 if (!hasYield)
02930 {
02931 lclerror (id, message ("Iterator has no yield parameters: %s",
02932 ltoken_getRawString (id)));
02933 }
02934
02935 return (x);
02936 }
02937
02938 fcnNode
02939 makeFcnNode (qual specQual,
02940 lclTypeSpecNode t,
02941 declaratorNode d,
02942 globalList g,
02943 varDeclarationNodeList privateinits,
02944 letDeclNodeList lets,
02945 lclPredicateNode checks,
02946 lclPredicateNode requires,
02947 modifyNode m,
02948 lclPredicateNode ensures,
02949 lclPredicateNode claims)
02950 {
02951 fcnNode x = (fcnNode) dmalloc (sizeof (*x));
02952
02953 if (d->type != (typeExpr)0 && (d->type)->kind != TEXPR_FCN)
02954 {
02955 lclerror (d->id, cstring_makeLiteral
02956 ("Attempt to specify function without parameter list"));
02957 d->type = makeFunctionNode (d->type, paramNodeList_new ());
02958 }
02959
02960
02961 x->special = specQual;
02962 x->typespec = t;
02963 x->declarator = d;
02964 x->globals = g;
02965 x->inits = privateinits;
02966 x->lets = lets;
02967 x->checks = checks;
02968 x->require = requires;
02969 x->modify = m;
02970 x->ensures = ensures;
02971 x->claim = claims;
02972
02973
02974 x->name = ltoken_copy (d->id);
02975
02976 return (x);
02977 }
02978
02979 claimNode
02980 makeClaimNode (ltoken id, paramNodeList p,
02981 globalList g, letDeclNodeList lets, lclPredicateNode requires,
02982 programNode b, lclPredicateNode ensures)
02983 {
02984 claimNode x = (claimNode) dmalloc (sizeof (*x));
02985
02986
02987 x->name = id;
02988 x->params = p;
02989 x->globals = g;
02990 x->lets = lets;
02991 x->require = requires;
02992 x->body = b;
02993 x->ensures = ensures;
02994 return (x);
02995 }
02996
02997 lclPredicateNode
02998 makeIntraClaimNode (ltoken t, lclPredicateNode n)
02999 {
03000 ltoken_free (n->tok);
03001 n->tok = t;
03002 n->kind = LPD_INTRACLAIM;
03003 return (n);
03004 }
03005
03006 lclPredicateNode
03007 makeRequiresNode (ltoken t, lclPredicateNode n)
03008 {
03009 ltoken_free (n->tok);
03010 n->tok = t;
03011 n->kind = LPD_REQUIRES;
03012 return (n);
03013 }
03014
03015 lclPredicateNode
03016 makeChecksNode (ltoken t, lclPredicateNode n)
03017 {
03018 ltoken_free (n->tok);
03019 n->tok = t;
03020 n->kind = LPD_CHECKS;
03021 return (n);
03022 }
03023
03024 lclPredicateNode
03025 makeEnsuresNode (ltoken t, lclPredicateNode n)
03026 {
03027 ltoken_free (n->tok);
03028 n->tok = t;
03029 n->kind = LPD_ENSURES;
03030 return (n);
03031 }
03032
03033 lclPredicateNode
03034 makeLclPredicateNode (ltoken t, termNode n,
03035 lclPredicateKind k)
03036 {
03037 lclPredicateNode x = (lclPredicateNode) dmalloc (sizeof (*x));
03038
03039 x->tok = t;
03040 x->predicate = n;
03041 x->kind = k;
03042 return (x);
03043 }
03044
03045 quantifierNode
03046 makeQuantifierNode (varNodeList v, ltoken quant)
03047 {
03048 quantifierNode x = (quantifierNode) dmalloc (sizeof (*x));
03049
03050 x->quant = quant;
03051 x->vars = v;
03052 x->isForall = cstring_equalLit (ltoken_unparse (quant), "\forall");
03053
03054 return (x);
03055 }
03056
03057 arrayQualNode
03058 makeArrayQualNode (ltoken t, termNode term)
03059 {
03060 arrayQualNode x = (arrayQualNode) dmalloc (sizeof (*x));
03061
03062 x->tok = t;
03063 x->term = term;
03064 return (x);
03065 }
03066
03067 varNode
03068 makeVarNode ( ltoken varid, bool isObj, lclTypeSpecNode t)
03069 {
03070 varNode x = (varNode) dmalloc (sizeof (*x));
03071 varInfo vi = (varInfo) dmalloc (sizeof (*vi));
03072 sort sort;
03073
03074 vi->id = ltoken_copy (varid);
03075 sort = lclTypeSpecNode2sort (t);
03076
03077
03078
03079
03080
03081
03082
03083
03084 sort = sort_makeVal (sort);
03085
03086 if (isObj)
03087 {
03088 sort = sort_makeObj (sort);
03089 }
03090
03091
03092 vi->sort = sort;
03093 vi->kind = VRK_QUANT;
03094 vi->export = TRUE;
03095
03096 (void) symtable_enterVar (g_symtab, vi);
03097 varInfo_free (vi);
03098
03099 x->varid = varid;
03100 x->isObj = isObj;
03101 x->type = t;
03102 x->sort = sort_makeNoSort ();
03103
03104 return (x);
03105 }
03106
03107 abstBodyNode
03108 makeAbstBodyNode (ltoken t, fcnNodeList f)
03109 {
03110 abstBodyNode x = (abstBodyNode) dmalloc (sizeof (*x));
03111
03112 x->tok = t;
03113 x->typeinv = (lclPredicateNode)0;
03114 x->fcns = f;
03115 return (x);
03116 }
03117
03118 abstBodyNode
03119 makeExposedBodyNode (ltoken t, lclPredicateNode inv)
03120 {
03121 abstBodyNode x = (abstBodyNode) dmalloc (sizeof (*x));
03122
03123 x->tok = t;
03124 x->typeinv = inv;
03125 x->fcns = fcnNodeList_undefined;
03126 return (x);
03127 }
03128
03129 abstBodyNode
03130 makeAbstBodyNode2 (ltoken t, ltokenList ops)
03131 {
03132 abstBodyNode x = (abstBodyNode) dmalloc (sizeof (*x));
03133
03134 x->tok = t;
03135 x->typeinv = (lclPredicateNode) 0;
03136
03137 x->fcns = fcnNodeList_new ();
03138
03139 ltokenList_elements (ops, op)
03140 {
03141 x->fcns = fcnNodeList_add
03142 (x->fcns,
03143 fcnNode_fromDeclarator (lclTypeSpecNode_undefined,
03144 makeUnknownDeclaratorNode (ltoken_copy (op))));
03145 } end_ltokenList_elements;
03146
03147 ltokenList_free (ops);
03148
03149 return (x);
03150 }
03151
03152 stmtNode
03153 makeStmtNode (ltoken varId, ltoken fcnId, termNodeList v)
03154 {
03155 stmtNode n = (stmtNode) dmalloc (sizeof (*n));
03156
03157 n->lhs = varId;
03158 n->operator = fcnId;
03159 n->args = v;
03160 return (n);
03161 }
03162
03163
03164
03165 static cstring abstDeclaratorNode_unparse (abstDeclaratorNode x)
03166 {
03167 return (typeExpr_unparse ((typeExpr) x));
03168 }
03169
03170 paramNode
03171 makeParamNode (lclTypeSpecNode t, typeExpr d)
03172 {
03173 paramNode x = (paramNode) dmalloc (sizeof (*x));
03174
03175 paramNode_checkQualifiers (t, d);
03176
03177 x->type = t;
03178 x->paramdecl = d;
03179 x->kind = PNORMAL;
03180
03181 return (x);
03182 }
03183
03184 paramNode
03185 paramNode_elipsis (void)
03186 {
03187 paramNode x = (paramNode) dmalloc (sizeof (*x));
03188
03189 x->type = (lclTypeSpecNode) 0;
03190 x->paramdecl = (typeExpr) 0;
03191 x->kind = PELIPSIS;
03192
03193 return (x);
03194 }
03195
03196 static ltoken typeExpr_getTok (typeExpr d)
03197 {
03198 while (d != (typeExpr)0)
03199 {
03200 if (d->kind == TEXPR_BASE)
03201 {
03202 return (d->content.base);
03203 }
03204 else
03205 {
03206 if (d->kind == TEXPR_PTR)
03207 {
03208 d = d->content.pointer;
03209 }
03210 else if (d->kind == TEXPR_ARRAY)
03211 {
03212 d = d->content.array.elementtype;
03213 }
03214 else if (d->kind == TEXPR_FCN)
03215 {
03216 d = d->content.function.returntype;
03217 }
03218 else
03219 {
03220 BADBRANCH;
03221 }
03222 }
03223 }
03224
03225 llfatalerror (cstring_makeLiteral ("typeExpr_getTok: unreachable code"));
03226 BADEXIT;
03227 }
03228
03229 void
03230 paramNode_checkQualifiers (lclTypeSpecNode t, typeExpr d)
03231 {
03232 bool isPointer = FALSE;
03233 bool isUser = FALSE;
03234 bool hasAlloc = FALSE;
03235 bool hasAlias = FALSE;
03236
03237 llassert (lclTypeSpecNode_isDefined (t));
03238
03239 if (t->pointers == 0
03240 && (d != (typeExpr)0 && d->kind != TEXPR_PTR) && d->kind != TEXPR_ARRAY)
03241 {
03242 if (t->kind == LTS_TYPE)
03243 {
03244 sortNode sn;
03245
03246 llassert (t->content.type != NULL);
03247
03248 sn = sort_quietLookup (sort_getUnderlying ((t->content.type)->sort));
03249
03250 if (sn.kind == SRT_PTR || sn.kind == SRT_ARRAY
03251 || sn.kind == SRT_HOF || sn.kind == SRT_NONE)
03252 {
03253 isPointer = TRUE;
03254 }
03255 }
03256 }
03257 else
03258 {
03259 isPointer = TRUE;
03260 }
03261
03262 if (d != (typeExpr)0 && d->kind != TEXPR_BASE)
03263 {
03264 if (t->kind == LTS_TYPE)
03265 {
03266 sortNode sn;
03267
03268 llassert (t->content.type != NULL);
03269 sn = sort_quietLookup (sort_getUnderlying ((t->content.type)->sort));
03270
03271 if (sn.kind == SRT_PTR || sn.kind == SRT_ARRAY
03272 || sn.kind == SRT_HOF || sn.kind == SRT_NONE)
03273 {
03274 isUser = TRUE;
03275 }
03276 }
03277 }
03278 else
03279 {
03280 isPointer = TRUE;
03281 }
03282
03283 if (d != (typeExpr)NULL)
03284 {
03285 qualList_elements (t->quals, q)
03286 {
03287 if (qual_isAllocQual (q))
03288 {
03289 if (hasAlloc)
03290 {
03291 ltoken tok = typeExpr_getTok (d);
03292 lclerror (tok, message ("Parameter declared with multiple allocation "
03293 "qualifiers: %q", typeExpr_unparse (d)));
03294 }
03295 hasAlloc = TRUE;
03296
03297 if (!isPointer)
03298 {
03299 ltoken tok = typeExpr_getTok (d);
03300 lclerror (tok, message ("Non-pointer declared as %s parameter: %q",
03301 qual_unparse (q),
03302 typeExpr_unparse (d)));
03303 }
03304 }
03305 if (qual_isAliasQual (q))
03306 {
03307 if (hasAlias)
03308 {
03309 ltoken tok = typeExpr_getTok (d);
03310 lclerror (tok, message ("Parameter declared with multiple alias qualifiers: %q",
03311 typeExpr_unparse (d)));
03312 }
03313 hasAlias = TRUE;
03314
03315 if (!(isPointer || isUser))
03316 {
03317 ltoken tok = typeExpr_getTok (d);
03318 lclerror (tok, message ("Unsharable type declared as %s parameter: %q",
03319 qual_unparse (q),
03320 typeExpr_unparse (d)));
03321 }
03322 }
03323 } end_qualList_elements;
03324 }
03325 }
03326
03327 cstring
03328 paramNode_unparse (paramNode x)
03329 {
03330 if (x != (paramNode) 0)
03331 {
03332 if (x->kind == PELIPSIS)
03333 {
03334 return (cstring_makeLiteral ("..."));
03335 }
03336
03337 if (x->paramdecl != (typeExpr) 0)
03338 {
03339 return (message ("%q %q", lclTypeSpecNode_unparse (x->type),
03340 typeExpr_unparse (x->paramdecl)));
03341 }
03342 else
03343 {
03344 return (lclTypeSpecNode_unparse (x->type));
03345 }
03346 }
03347 return cstring_undefined;
03348 }
03349
03350 static cstring
03351 lclTypeSpecNode_unparseAltComments ( lclTypeSpecNode typespec)
03352 {
03353 if (typespec != (lclTypeSpecNode) 0)
03354 {
03355 cstring s = qualList_toCComments (typespec->quals);
03356
03357 switch (typespec->kind)
03358 {
03359 case LTS_TYPE:
03360 {
03361 llassert (typespec->content.type != NULL);
03362
03363 return (cstring_concatFree
03364 (s, printLeaves (typespec->content.type->ctypes)));
03365 }
03366 case LTS_ENUM:
03367 {
03368 bool first = TRUE;
03369 enumSpecNode n = typespec->content.enumspec;
03370
03371 s = cstring_concatFree (s, cstring_makeLiteral ("enum"));
03372 llassert (n != NULL);
03373
03374 if (!ltoken_isUndefined (n->opttagid))
03375 {
03376 s = message ("%q %s", s, ltoken_unparse (n->opttagid));
03377 }
03378 s = message ("%q {", s);
03379
03380 ltokenList_elements (n->enums, e)
03381 {
03382 if (first)
03383 {
03384 first = FALSE;
03385 s = message ("%q%s", s, ltoken_getRawString (e));
03386 }
03387 else
03388 s = message ("%q, %s", s, ltoken_getRawString (e));
03389 } end_ltokenList_elements;
03390
03391 return (message ("%q}", s));
03392 }
03393 case LTS_STRUCTUNION:
03394 {
03395 strOrUnionNode n = typespec->content.structorunion;
03396 stDeclNodeList decls;
03397
03398 llassert (n != NULL);
03399
03400 switch (n->kind)
03401 {
03402 case SU_STRUCT:
03403 s = cstring_concatFree (s, cstring_makeLiteral ("struct "));
03404 break;
03405 case SU_UNION:
03406 s = cstring_concatFree (s, cstring_makeLiteral ("union "));
03407 break;
03408 }
03409
03410 if (!ltoken_isUndefined (n->opttagid))
03411 {
03412 if (stDeclNodeList_size (n->structdecls) == 0)
03413 {
03414 return (message ("%q%s", s, ltoken_unparse (n->opttagid)));
03415 }
03416
03417 s = message ("%q%s {\n\2\1", s, ltoken_unparse (n->opttagid));
03418 }
03419 else
03420 {
03421 s = message ("%q{\n\2\1", s);
03422 }
03423
03424 decls = n->structdecls;
03425
03426 stDeclNodeList_elements (decls, f)
03427 {
03428 s = message ("%q%q\1%q;\n\1", s,
03429 lclTypeSpecNode_unparseAltComments (f->lcltypespec),
03430 declaratorNodeList_unparse (f->declarators));
03431 } end_stDeclNodeList_elements;
03432
03433 return (message ("%q\3}", s));
03434 }
03435 case LTS_CONJ:
03436 {
03437 cstring_free (s);
03438
03439 return
03440 (message
03441 ("%q, %q",
03442 lclTypeSpecNode_unparseAltComments (typespec->content.conj->a),
03443 lclTypeSpecNode_unparseAltComments (typespec->content.conj->b)));
03444 }
03445 BADDEFAULT;
03446 }
03447 }
03448 else
03449 {
03450 llcontbuglit ("lclTypeSpecNode_unparseComments: null typespec");
03451
03452 return cstring_undefined;
03453 }
03454
03455 BADEXIT;
03456 }
03457
03458 cstring lclTypeSpecNode_unparseComments ( lclTypeSpecNode typespec)
03459 {
03460 if (typespec != (lclTypeSpecNode) 0)
03461 {
03462 cstring s = qualList_toCComments (typespec->quals);
03463
03464 switch (typespec->kind)
03465 {
03466 case LTS_TYPE:
03467 {
03468 llassert (typespec->content.type != NULL);
03469
03470 return (cstring_concatFree
03471 (s, printLeaves (typespec->content.type->ctypes)));
03472 }
03473 case LTS_ENUM:
03474 {
03475 bool first = TRUE;
03476 enumSpecNode n = typespec->content.enumspec;
03477
03478 s = cstring_concatFree (s, cstring_makeLiteral ("enum"));
03479 llassert (n != NULL);
03480
03481 if (!ltoken_isUndefined (n->opttagid))
03482 {
03483 s = message ("%q %s", s, ltoken_unparse (n->opttagid));
03484 }
03485 s = message ("%q {", s);
03486
03487 ltokenList_elements (n->enums, e)
03488 {
03489 if (first)
03490 {
03491 first = FALSE;
03492 s = message ("%q%s", s, ltoken_getRawString (e));
03493 }
03494 else
03495 s = message ("%q, %s", s, ltoken_getRawString (e));
03496 } end_ltokenList_elements;
03497
03498 return (message ("%q}", s));
03499 }
03500 case LTS_STRUCTUNION:
03501 {
03502 strOrUnionNode n = typespec->content.structorunion;
03503 stDeclNodeList decls;
03504
03505 llassert (n != NULL);
03506
03507 switch (n->kind)
03508 {
03509 case SU_STRUCT:
03510 s = cstring_concatFree (s, cstring_makeLiteral ("struct "));
03511 break;
03512 case SU_UNION:
03513 s = cstring_concatFree (s, cstring_makeLiteral ("union "));
03514 break;
03515 }
03516
03517 if (!ltoken_isUndefined (n->opttagid))
03518 {
03519 if (stDeclNodeList_size (n->structdecls) == 0)
03520 {
03521 return (message ("%q%s", s, ltoken_unparse (n->opttagid)));
03522 }
03523
03524 s = message ("%q%s {\n\2\1", s, ltoken_unparse (n->opttagid));
03525 }
03526 else
03527 {
03528 s = message ("%q{\n\2\1", s);
03529 }
03530
03531 decls = n->structdecls;
03532
03533 stDeclNodeList_elements (decls, f)
03534 {
03535 s = message ("%q%q\1%q;\n\1", s,
03536 lclTypeSpecNode_unparseComments (f->lcltypespec),
03537 declaratorNodeList_unparse (f->declarators));
03538 } end_stDeclNodeList_elements;
03539
03540 return (message ("%q\3}", s));
03541 }
03542 case LTS_CONJ:
03543 {
03544 cstring_free (s);
03545
03546 return
03547 (message
03548 ("%q /*@alt %q@*/",
03549 lclTypeSpecNode_unparseComments (typespec->content.conj->a),
03550 lclTypeSpecNode_unparseAltComments (typespec->content.conj->b)));
03551 }
03552 BADDEFAULT;
03553 }
03554 }
03555 else
03556 {
03557 llcontbuglit ("lclTypeSpecNode_unparseComments: null typespec");
03558
03559 return cstring_undefined;
03560 }
03561
03562 BADEXIT;
03563 }
03564
03565 cstring
03566 paramNode_unparseComments (paramNode x)
03567 {
03568 if (x != (paramNode) 0)
03569 {
03570 if (x->kind == PELIPSIS)
03571 {
03572 return (cstring_makeLiteral ("..."));
03573 }
03574
03575 if (x->paramdecl != (typeExpr) 0)
03576 {
03577 return (message ("%q %q",
03578 lclTypeSpecNode_unparseComments (x->type),
03579 typeExpr_unparseNoBase (x->paramdecl)));
03580 }
03581 else
03582 {
03583 return (lclTypeSpecNode_unparseComments (x->type));
03584 }
03585 }
03586 return cstring_undefined;
03587 }
03588
03589 termNode
03590 makeIfTermNode (ltoken ift, termNode ifn, ltoken thent,
03591 termNode thenn, ltoken elset,
03592 termNode elsen)
03593 {
03594 termNode t = (termNode) dmalloc (sizeof (*t));
03595 opFormNode opform = makeOpFormNode (ift, OPF_IF, opFormUnion_createMiddle (0),
03596 ltoken_undefined);
03597 nameNode nn = makeNameNodeForm (opform);
03598 termNodeList args = termNodeList_new ();
03599
03600 t->error_reported = FALSE;
03601 t->wrapped = 0;
03602 termNodeList_addh (args, ifn);
03603 termNodeList_addh (args, thenn);
03604 termNodeList_addh (args, elsen);
03605 t->name = nn;
03606 t->args = args;
03607 t->kind = TRM_APPLICATION;
03608 t->sort = sort_makeNoSort ();
03609 t->given = t->sort;
03610 t->possibleSorts = sortSet_new ();
03611 t->possibleOps = lslOpSet_new ();
03612
03613 ltoken_free (thent);
03614 ltoken_free (elset);
03615
03616 return (t);
03617 }
03618
03619 static ltoken
03620 nameNode2anyOp (nameNode n)
03621 {
03622 if (n != (nameNode) 0)
03623 {
03624 opFormNode opnode = n->content.opform;
03625 opFormKind kind;
03626
03627 llassert (opnode != NULL);
03628
03629 kind = opnode->kind;
03630
03631 if (kind == OPF_MANYOPM || kind == OPF_ANYOP ||
03632 kind == OPF_MANYOP || kind == OPF_ANYOPM)
03633 {
03634 opFormUnion u;
03635
03636 u = opnode->content;
03637 return u.anyop;
03638 }
03639 }
03640 return ltoken_undefined;
03641 }
03642
03643 termNode
03644 makeInfixTermNode (termNode x, ltoken op, termNode y)
03645 {
03646 termNode t = (termNode) dmalloc (sizeof (*t));
03647 opFormNode opform;
03648 nameNode nn;
03649 termNodeList args = termNodeList_new ();
03650
03651 checkAssociativity (x, op);
03652
03653 opform = makeOpFormNode (op, OPF_MANYOPM,
03654 opFormUnion_createAnyOp (op),
03655 ltoken_undefined);
03656
03657 nn = makeNameNodeForm (opform);
03658
03659 t->error_reported = FALSE;
03660 t->wrapped = 0;
03661 termNodeList_addh (args, x);
03662 termNodeList_addh (args, y);
03663 t->name = nn;
03664 t->args = args;
03665 t->kind = TRM_APPLICATION;
03666 t->sort = sort_makeNoSort ();
03667 t->given = t->sort;
03668 t->possibleSorts = sortSet_new ();
03669 t->possibleOps = lslOpSet_new ();
03670 return (t);
03671 }
03672
03673 quantifiedTermNode
03674 quantifiedTermNode_copy (quantifiedTermNode q)
03675 {
03676 quantifiedTermNode ret = (quantifiedTermNode) dmalloc (sizeof (*ret));
03677
03678 ret->quantifiers = quantifierNodeList_copy (q->quantifiers);
03679 ret->open = ltoken_copy (q->open);
03680 ret->close = ltoken_copy (q->close);
03681 ret->body = termNode_copySafe (q->body);
03682
03683 return (ret);
03684 }
03685
03686 termNode
03687 makeQuantifiedTermNode (quantifierNodeList qn, ltoken open,
03688 termNode t, ltoken close)
03689 {
03690 sort sort;
03691 termNode n = (termNode) dmalloc (sizeof (*n));
03692 quantifiedTermNode q = (quantifiedTermNode) dmalloc (sizeof (*q));
03693
03694 n->name = NULL;
03695 n->error_reported = FALSE;
03696 n->wrapped = 0;
03697 n->error_reported = FALSE;
03698 n->kind = TRM_QUANTIFIER;
03699 n->possibleSorts = sortSet_new ();
03700 n->possibleOps = lslOpSet_new ();
03701 n->kind = TRM_UNCHANGEDALL;
03702 n->args = termNodeList_new ();
03703
03704 termNodeList_free (t->args);
03705 t->args = termNodeList_new ();
03706
03707 sort = sort_bool;
03708 n->sort = sort;
03709 (void) sortSet_insert (n->possibleSorts, sort);
03710
03711 q->quantifiers = qn;
03712 q->open = open;
03713 q->close = close;
03714 q->body = t;
03715
03716 n->quantified = q;
03717 return (n);
03718 }
03719
03720 termNode
03721 makePostfixTermNode ( termNode secondary, ltokenList postfixops)
03722 {
03723 termNode top = secondary;
03724
03725 ltokenList_elements (postfixops, op)
03726 {
03727 top = makePostfixTermNode2 (top, ltoken_copy (op));
03728 } end_ltokenList_elements;
03729
03730 ltokenList_free (postfixops);
03731
03732 return (top);
03733 }
03734
03735
03736
03737
03738
03739 termNode
03740 makePostfixTermNode2 ( termNode secondary,
03741 ltoken postfixop)
03742 {
03743 termNode t = (termNode) dmalloc (sizeof (*t));
03744
03745 opFormNode opform = makeOpFormNode (postfixop,
03746 OPF_MANYOP, opFormUnion_createAnyOp (postfixop),
03747 ltoken_undefined);
03748 nameNode nn = makeNameNodeForm (opform);
03749 termNodeList args = termNodeList_new ();
03750
03751 t->error_reported = FALSE;
03752 t->wrapped = 0;
03753 termNodeList_addh (args, secondary);
03754 t->name = nn;
03755 t->args = args;
03756 t->kind = TRM_APPLICATION;
03757 t->sort = sort_makeNoSort ();
03758 t->given = t->sort;
03759 t->possibleSorts = sortSet_new ();
03760 t->possibleOps = lslOpSet_new ();
03761 return t;
03762 }
03763
03764 termNode
03765 makePrefixTermNode (ltoken op, termNode arg)
03766 {
03767 termNode t = (termNode) dmalloc (sizeof (*t));
03768 termNodeList args = termNodeList_new ();
03769 opFormNode opform = makeOpFormNode (op, OPF_ANYOPM, opFormUnion_createAnyOp (op),
03770 ltoken_undefined);
03771 nameNode nn = makeNameNodeForm (opform);
03772
03773 t->error_reported = FALSE;
03774 t->wrapped = 0;
03775 t->name = nn;
03776 termNodeList_addh (args, arg);
03777 t->args = args;
03778 t->kind = TRM_APPLICATION;
03779 t->sort = sort_makeNoSort ();
03780 t->given = t->sort;
03781 t->possibleSorts = sortSet_new ();
03782 t->possibleOps = lslOpSet_new ();
03783 return t;
03784 }
03785
03786 termNode
03787 makeOpCallTermNode (ltoken op, ltoken open,
03788 termNodeList args, ltoken close)
03789 {
03790
03791 termNode t = (termNode) dmalloc (sizeof (*t));
03792 nameNode nn = makeNameNodeId (op);
03793
03794 t->error_reported = FALSE;
03795 t->wrapped = 0;
03796 t->name = nn;
03797 t->args = args;
03798 t->kind = TRM_APPLICATION;
03799 t->sort = sort_makeNoSort ();
03800 t->given = t->sort;
03801 t->possibleSorts = sortSet_new ();
03802 t->possibleOps = lslOpSet_new ();
03803
03804 ltoken_free (open);
03805 ltoken_free (close);
03806
03807 return t;
03808 }
03809
03810 termNode
03811 CollapseInfixTermNode ( termNode secondary, termNodeList infix)
03812 {
03813 termNode left = secondary;
03814
03815 termNodeList_elements (infix, node)
03816 {
03817 termNodeList_addl (node->args, termNode_copySafe (left));
03818 left = node;
03819
03820 } end_termNodeList_elements;
03821
03822 return (left);
03823 }
03824
03825 static void
03826 checkAssociativity (termNode x, ltoken op)
03827 {
03828 ltoken lastOpToken;
03829
03830 if (x->wrapped == 0 &&
03831 x->kind == TRM_APPLICATION && x->name != (nameNode) 0 &&
03832 (!x->name->isOpId))
03833 {
03834 lastOpToken = nameNode2anyOp (x->name);
03835
03836 if ((ltoken_getCode (lastOpToken) == logicalOp &&
03837 ltoken_getCode (op) == logicalOp) ||
03838 ((ltoken_getCode (lastOpToken) == simpleOp ||
03839 ltoken_getCode (lastOpToken) == LLT_MULOP) &&
03840 (ltoken_getCode (op) == simpleOp ||
03841 ltoken_getCode (op) == LLT_MULOP)))
03842 if (ltoken_getText (lastOpToken) != ltoken_getText (op))
03843 {
03844 lclerror (op,
03845 message
03846 ("Parentheses needed to specify associativity of %s and %s",
03847 cstring_fromChars (lsymbol_toChars (ltoken_getText (lastOpToken))),
03848 cstring_fromChars (lsymbol_toChars (ltoken_getText (op)))));
03849 }
03850 }
03851 }
03852
03853 termNodeList
03854 pushInfixOpPartNode ( termNodeList x, ltoken op,
03855 termNode secondary)
03856 {
03857 termNode lastLeftTerm;
03858 termNodeList args = termNodeList_new ();
03859 termNode t = (termNode) dmalloc (sizeof (*t));
03860 opFormNode opform;
03861 nameNode nn;
03862
03863 termNodeList_addh (args, secondary);
03864
03865 if (!termNodeList_empty (x))
03866 {
03867 termNodeList_reset (x);
03868 lastLeftTerm = termNodeList_current (x);
03869 checkAssociativity (lastLeftTerm, op);
03870 }
03871
03872 opform = makeOpFormNode (op, OPF_MANYOPM,
03873 opFormUnion_createAnyOp (op), ltoken_undefined);
03874
03875 nn = makeNameNodeForm (opform);
03876
03877 t->error_reported = FALSE;
03878 t->wrapped = 0;
03879 t->name = nn;
03880 t->kind = TRM_APPLICATION;
03881 t->args = args;
03882 t->sort = sort_makeNoSort ();
03883 t->given = t->sort;
03884 t->possibleSorts = sortSet_new ();
03885 t->possibleOps = lslOpSet_new ();
03886 termNodeList_addh (x, t);
03887
03888 return (x);
03889 }
03890
03891 termNode
03892 updateMatchedNode ( termNode left, termNode t,
03893 termNode right)
03894 {
03895 opFormNode op;
03896
03897 if ((t == (termNode) 0) || (t->name == NULL) || t->name->isOpId)
03898 {
03899 llbugexitlit ("updateMatchedNode: expect opForm in nameNode");
03900 }
03901
03902 op = t->name->content.opform;
03903 llassert (op != NULL);
03904
03905 if (left == (termNode) 0)
03906 {
03907 if (right == (termNode) 0)
03908 {
03909
03910 termNode_free (right);
03911 }
03912 else
03913 {
03914 op->kind = OPF_MIDDLEM;
03915 op->key = opFormNode2key (op, OPF_MIDDLEM);
03916 termNodeList_addh (t->args, right);
03917 }
03918 }
03919 else
03920 {
03921 termNodeList_addl (t->args, left);
03922 if (right == (termNode) 0)
03923 {
03924 op->kind = OPF_MMIDDLE;
03925 op->key = opFormNode2key (op, OPF_MMIDDLE);
03926 }
03927 else
03928 {
03929 op->kind = OPF_MMIDDLEM;
03930 op->key = opFormNode2key (op, OPF_MMIDDLEM);
03931 termNodeList_addh (t->args, right);
03932 }
03933 }
03934 return t;
03935 }
03936
03937 termNode
03938 updateSqBracketedNode ( termNode left,
03939 termNode t,
03940 termNode right)
03941 {
03942 opFormNode op;
03943
03944 if ((t == (termNode) 0) || (t->name == NULL) || (t->name->isOpId))
03945 {
03946 llbugexitlit ("updateSqBracketededNode: expect opForm in nameNode");
03947 }
03948
03949 op = t->name->content.opform;
03950 llassert (op != NULL);
03951
03952 if (left == (termNode) 0)
03953 {
03954 if (right == (termNode) 0)
03955 {
03956
03957 }
03958 else
03959 {
03960 op->kind = OPF_BMIDDLEM;
03961 op->key = opFormNode2key (op, OPF_BMIDDLEM);
03962 termNodeList_addh (t->args, right);
03963 }
03964 }
03965 else
03966 {
03967 termNodeList_addl (t->args, left);
03968
03969 if (right == (termNode) 0)
03970 {
03971 op->kind = OPF_BMMIDDLE;
03972 op->key = opFormNode2key (op, OPF_BMMIDDLE);
03973 }
03974 else
03975 {
03976 op->kind = OPF_BMMIDDLEM;
03977 op->key = opFormNode2key (op, OPF_BMMIDDLEM);
03978 termNodeList_addh (t->args, right);
03979 }
03980 }
03981 return t;
03982 }
03983
03984 termNode
03985 makeSqBracketedNode (ltoken lbracket,
03986 termNodeList args, ltoken rbracket)
03987 {
03988 termNode t = (termNode) dmalloc (sizeof (*t));
03989 int size;
03990 opFormNode opform;
03991 nameNode nn;
03992
03993 t->error_reported = FALSE;
03994 t->wrapped = 0;
03995
03996 size = termNodeList_size (args);
03997 opform = makeOpFormNode (lbracket, OPF_BMIDDLE, opFormUnion_createMiddle (size),
03998 rbracket);
03999 nn = makeNameNodeForm (opform);
04000 t->name = nn;
04001 t->kind = TRM_APPLICATION;
04002 t->args = args;
04003 t->sort = sort_makeNoSort ();
04004 t->given = t->sort;
04005 t->possibleSorts = sortSet_new ();
04006 t->possibleOps = lslOpSet_new ();
04007
04008 return (t);
04009 }
04010
04011 termNode
04012 makeMatchedNode (ltoken open, termNodeList args, ltoken close)
04013 {
04014
04015 termNode t = (termNode) dmalloc (sizeof (*t));
04016 int size;
04017 opFormNode opform;
04018 nameNode nn;
04019
04020 t->error_reported = FALSE;
04021 t->wrapped = 0;
04022
04023 size = termNodeList_size (args);
04024 opform = makeOpFormNode (open, OPF_MIDDLE, opFormUnion_createMiddle (size), close);
04025 nn = makeNameNodeForm (opform);
04026 t->name = nn;
04027 t->kind = TRM_APPLICATION;
04028 t->args = args;
04029 t->sort = sort_makeNoSort ();
04030 t->given = t->sort;
04031 t->possibleSorts = sortSet_new ();
04032 t->possibleOps = lslOpSet_new ();
04033
04034 return (t);
04035 }
04036
04037 termNode
04038 makeSimpleTermNode (ltoken varid)
04039 {
04040 sort theSort = sort_makeNoSort ();
04041 lsymbol sym;
04042 opInfo oi;
04043 varInfo vi;
04044 termNode n = (termNode) dmalloc (sizeof (*n));
04045
04046 n->error_reported = FALSE;
04047 n->wrapped = 0;
04048 n->name = (nameNode) 0;
04049 n->given = theSort;
04050 n->args = termNodeList_new ();
04051 n->possibleSorts = sortSet_new ();
04052 n->possibleOps = lslOpSet_new ();
04053
04054 sym = ltoken_getText (varid);
04055
04056
04057 vi = symtable_varInfoInScope (g_symtab, sym);
04058
04059 if (varInfo_exists (vi))
04060 {
04061 theSort = vi->sort;
04062 n->kind = TRM_VAR;
04063 n->sort = theSort;
04064 n->literal = varid;
04065 (void) sortSet_insert (n->possibleSorts, theSort);
04066 }
04067 else
04068 {
04069 vi = symtable_varInfo (g_symtab, sym);
04070
04071 if (varInfo_exists (vi) && vi->kind == VRK_CONST)
04072 {
04073 theSort = vi->sort;
04074 n->kind = TRM_CONST;
04075 n->sort = theSort;
04076 n->literal = varid;
04077 (void) sortSet_insert (n->possibleSorts, theSort);
04078 }
04079 else
04080 {
04081 nameNode nn = makeNameNodeId (ltoken_copy (varid));
04082 oi = symtable_opInfo (g_symtab, nn);
04083
04084 if (opInfo_exists (oi) && (oi->name->isOpId) &&
04085 !sigNodeSet_isEmpty (oi->signatures))
04086 {
04087 sigNodeSet_elements (oi->signatures, x)
04088 {
04089 if (ltokenList_empty (x->domain))
04090
04091 {
04092 lslOp op = (lslOp) dmalloc (sizeof (*op));
04093
04094 op->name = nameNode_copy (nn);
04095 op->signature = x;
04096 (void) sortSet_insert (n->possibleSorts, sigNode_rangeSort (x));
04097 (void) lslOpSet_insert (n->possibleOps, op);
04098 }
04099 } end_sigNodeSet_elements;
04100 }
04101
04102 nameNode_free (nn);
04103
04104 if (sortSet_size (n->possibleSorts) == 0)
04105 {
04106 lclerror
04107 (varid,
04108 message ("Unrecognized identifier (constant, variable or operator): %s",
04109 ltoken_getRawString (varid)));
04110
04111 }
04112
04113 n->sort = sort_makeNoSort ();
04114 n->literal = varid;
04115 n->kind = TRM_ZEROARY;
04116 }
04117 }
04118
04119 return (n);
04120 }
04121
04122 termNode
04123 makeSelectTermNode (termNode pri, ltoken select, ltoken id)
04124 {
04125 termNode t = (termNode) dmalloc (sizeof (*t));
04126 opFormNode opform = makeOpFormNode (select,
04127 OPF_MSELECT, opFormUnion_createAnyOp (id),
04128 ltoken_undefined);
04129 nameNode nn = makeNameNodeForm (opform);
04130 termNodeList args = termNodeList_new ();
04131
04132 t->error_reported = FALSE;
04133 t->wrapped = 0;
04134 t->name = nn;
04135 t->kind = TRM_APPLICATION;
04136 termNodeList_addh (args, pri);
04137 t->args = args;
04138 t->kind = TRM_APPLICATION;
04139 t->sort = sort_makeNoSort ();
04140 t->given = t->sort;
04141 t->possibleSorts = sortSet_new ();
04142 t->possibleOps = lslOpSet_new ();
04143
04144 return t;
04145 }
04146
04147 termNode
04148 makeMapTermNode (termNode pri, ltoken map, ltoken id)
04149 {
04150 termNode t = (termNode) dmalloc (sizeof (*t));
04151 opFormNode opform = makeOpFormNode (map, OPF_MMAP, opFormUnion_createAnyOp (id),
04152 ltoken_undefined);
04153 nameNode nn = makeNameNodeForm (opform);
04154 termNodeList args = termNodeList_new ();
04155
04156 t->error_reported = FALSE;
04157 t->wrapped = 0;
04158 t->kind = TRM_APPLICATION;
04159 t->name = nn;
04160 termNodeList_addh (args, pri);
04161 t->args = args;
04162 t->kind = TRM_APPLICATION;
04163 t->sort = sort_makeNoSort ();
04164 t->given = t->sort;
04165 t->possibleSorts = sortSet_new ();
04166 t->possibleOps = lslOpSet_new ();
04167 return t;
04168 }
04169
04170 termNode
04171 makeLiteralTermNode (ltoken tok, sort s)
04172 {
04173 nameNode nn = makeNameNodeId (ltoken_copy (tok));
04174 opInfo oi = symtable_opInfo (g_symtab, nn);
04175 lslOp op = (lslOp) dmalloc (sizeof (*op));
04176 termNode n = (termNode) dmalloc (sizeof (*n));
04177 sigNode sign;
04178 ltoken range;
04179
04180 n->name = nn;
04181 n->error_reported = FALSE;
04182 n->wrapped = 0;
04183 n->kind = TRM_LITERAL;
04184 n->literal = tok;
04185 n->given = sort_makeNoSort ();
04186 n->sort = n->given;
04187 n->args = termNodeList_new ();
04188 n->possibleSorts = sortSet_new ();
04189 n->possibleOps = lslOpSet_new ();
04190
04191
04192
04193 range = ltoken_create (simpleId, sort_getLsymbol (s));
04194 sign = makesigNode (ltoken_undefined, ltokenList_new (),
04195 ltoken_copy (range));
04196
04197 if (opInfo_exists (oi) && (oi->name->isOpId)
04198 && (sigNodeSet_size (oi->signatures) > 0))
04199 {
04200 sigNodeSet_elements (oi->signatures, x)
04201 {
04202 if (ltokenList_empty (x->domain))
04203 {
04204 lslOp opn = (lslOp) dmalloc (sizeof (*opn));
04205 sort sort;
04206
04207 opn->name = nameNode_copy (nn);
04208 opn->signature = x;
04209 sort = sigNode_rangeSort (x);
04210 (void) sortSet_insert (n->possibleSorts, sort);
04211 (void) lslOpSet_insert (n->possibleOps, opn);
04212 }
04213 } end_sigNodeSet_elements;
04214 }
04215
04216
04217 (void) sortSet_insert (n->possibleSorts, s);
04218
04219 op->name = nameNode_copy (nn);
04220 op->signature = sign;
04221 (void) lslOpSet_insert (n->possibleOps, op);
04222
04223
04224
04225
04226
04227
04228
04229 if (s == sort_int)
04230 {
04231 sigNode osign;
04232 lslOp opn = (lslOp) dmalloc (sizeof (*opn));
04233
04234
04235
04236
04237 (void) sortSet_insert (n->possibleSorts, sort_double);
04238
04239 ltoken_setText (range, lsymbol_fromChars ("double"));
04240 osign = makesigNode (ltoken_undefined, ltokenList_new (), range);
04241 opn->name = nameNode_copy (nn);
04242 opn->signature = osign;
04243 (void) lslOpSet_insert (n->possibleOps, opn);
04244
04245 symtable_enterOp (g_symtab, nameNode_copySafe (nn), sigNode_copy (osign));
04246 }
04247 else
04248 {
04249 ltoken_free (range);
04250 }
04251
04252
04253
04254
04255
04256 return n;
04257 }
04258
04259 termNode
04260 makeUnchangedTermNode1 (ltoken op, ltoken all)
04261 {
04262 termNode t = (termNode) dmalloc (sizeof (*t));
04263
04264 t->error_reported = FALSE;
04265 t->wrapped = 0;
04266 t->kind = TRM_UNCHANGEDALL;
04267 t->sort = sort_bool;
04268 t->literal = op;
04269 t->given = sort_makeNoSort ();
04270 t->name = NULL;
04271 t->args = termNodeList_new ();
04272 t->possibleSorts = sortSet_new ();
04273 t->possibleOps = lslOpSet_new ();
04274 (void) sortSet_insert (t->possibleSorts, t->sort);
04275
04276 ltoken_free (all);
04277
04278 return t;
04279 }
04280
04281 termNode
04282 makeUnchangedTermNode2 (ltoken op, storeRefNodeList x)
04283 {
04284 termNode t = (termNode) dmalloc (sizeof (*t));
04285 ltoken errtok;
04286 sort sort;
04287
04288 t->name = NULL;
04289 t->error_reported = FALSE;
04290 t->wrapped = 0;
04291 t->kind = TRM_UNCHANGEDOTHERS;
04292 t->sort = sort_bool;
04293 t->literal = op;
04294 t->unchanged = x;
04295 t->given = sort_makeNoSort ();
04296 t->possibleSorts = sortSet_new ();
04297 t->possibleOps = lslOpSet_new ();
04298 t->args = termNodeList_new ();
04299
04300 (void) sortSet_insert (t->possibleSorts, t->sort);
04301
04302
04303 storeRefNodeList_elements (x, sto)
04304 {
04305 if (storeRefNode_isTerm (sto))
04306 {
04307 sort = sto->content.term->sort;
04308 if (!sort_mutable (sort))
04309 {
04310 errtok = termNode_errorToken (sto->content.term);
04311 lclerror (errtok,
04312 message ("Term denoting immutable object used in unchanged list: %q",
04313 termNode_unparse (sto->content.term)));
04314 }
04315 }
04316 else
04317 {
04318 if (storeRefNode_isType (sto))
04319 {
04320 lclTypeSpecNode type = sto->content.type;
04321 sort = lclTypeSpecNode2sort (type);
04322 if (!sort_mutable (sort))
04323 {
04324 errtok = lclTypeSpecNode_errorToken (type);
04325 lclerror (errtok, message ("Immutable type used in unchanged list: %q",
04326 sort_unparse (sort)));
04327 }
04328 }
04329 }
04330 } end_storeRefNodeList_elements;
04331
04332 return t;
04333 }
04334
04335 termNode
04336 makeSizeofTermNode (ltoken op, lclTypeSpecNode type)
04337 {
04338 termNode t = (termNode) dmalloc (sizeof (*t));
04339
04340 t->name = NULL;
04341 t->error_reported = FALSE;
04342 t->wrapped = 0;
04343 t->kind = TRM_SIZEOF;
04344 t->sort = sort_int;
04345 t->literal = op;
04346 t->sizeofField = type;
04347 t->given = sort_makeNoSort ();
04348 t->possibleSorts = sortSet_new ();
04349 t->possibleOps = lslOpSet_new ();
04350 t->args = termNodeList_new ();
04351
04352 (void) sortSet_insert (t->possibleSorts, t->sort);
04353
04354 return (t);
04355 }
04356
04357 cstring
04358 claimNode_unparse (claimNode c)
04359 {
04360 if (c != (claimNode) 0)
04361 {
04362 cstring s = message ("claims (%q)%q{\n%q",
04363 paramNodeList_unparse (c->params),
04364 varDeclarationNodeList_unparse (c->globals),
04365 lclPredicateNode_unparse (c->require));
04366
04367 if (c->body != NULL)
04368 {
04369 s = message ("%qbody {%q}\n", s, programNode_unparse (c->body));
04370 }
04371 s = message ("%q%q}\n", s, lclPredicateNode_unparse (c->ensures));
04372 return s;
04373 }
04374 return cstring_undefined;
04375 }
04376
04377 static void
04378 WrongArity (ltoken tok, int expect, int size)
04379 {
04380 lclerror (tok, message ("Expecting %d arguments but given %d", expect, size));
04381 }
04382
04383 static cstring
04384 printTermNode2 ( opFormNode op, termNodeList args, sort sort)
04385 {
04386 if (op != (opFormNode) 0)
04387 {
04388 cstring s = cstring_undefined;
04389 cstring sortText;
04390 cstring sortSpace;
04391
04392 if (sort != sort_makeNoSort ())
04393 {
04394 sortText = message (": %s", cstring_fromChars (lsymbol_toChars (sort_getLsymbol (sort))));
04395 sortSpace = cstring_makeLiteral (" ");
04396 }
04397 else
04398 {
04399 sortText = cstring_undefined;
04400 sortSpace = cstring_undefined;
04401 }
04402
04403 switch (op->kind)
04404 {
04405 case OPF_IF:
04406 {
04407 int size = termNodeList_size (args);
04408
04409 if (size == 3)
04410 {
04411 s = message ("if %q then %q else %q\n",
04412 termNode_unparse (termNodeList_getN (args, 0)),
04413 termNode_unparse (termNodeList_getN (args, 1)),
04414 termNode_unparse (termNodeList_getN (args, 2)));
04415 }
04416 else
04417 {
04418 WrongArity (op->tok, 3, size);
04419 s = cstring_makeLiteral ("if __ then __ else __");
04420 }
04421 s = message ("%q%s", s, sortText);
04422 break;
04423 }
04424 case OPF_ANYOP:
04425 {
04426 s = message ("%s %s",
04427 ltoken_getRawString (op->content.anyop),
04428 sortText);
04429 break;
04430 }
04431 case OPF_MANYOP:
04432 {
04433 int size = termNodeList_size (args);
04434
04435 if (size == 1)
04436 {
04437 s = message ("%q ", termNode_unparse (termNodeList_head (args)));
04438 }
04439 else
04440 {
04441 WrongArity (op->content.anyop, 1, size);
04442 s = cstring_makeLiteral ("__ ");
04443 }
04444 s = message ("%q%s%s", s, ltoken_getRawString (op->content.anyop),
04445 sortText);
04446 break;
04447 }
04448 case OPF_ANYOPM:
04449 {
04450 int size = termNodeList_size (args);
04451
04452 s = message ("%s ", ltoken_getRawString (op->content.anyop));
04453
04454 if (size == 1)
04455 {
04456 s = message ("%q%q", s, termNode_unparse (termNodeList_head (args)));
04457 }
04458 else
04459 {
04460 WrongArity (op->content.anyop, 1, size);
04461 s = message ("%q__", s);
04462 }
04463 s = message ("%q%s", s, sortText);
04464 break;
04465 }
04466 case OPF_MANYOPM:
04467 {
04468 int size = termNodeList_size (args);
04469
04470 if (size == 2)
04471 {
04472 s = message ("%q %s %q",
04473 termNode_unparse (termNodeList_getN (args, 0)),
04474 ltoken_getRawString (op->content.anyop),
04475 termNode_unparse (termNodeList_getN (args, 1)));
04476 }
04477 else
04478 {
04479 WrongArity (op->content.anyop, 2, size);
04480 s = message ("__ %s __", ltoken_getRawString (op->content.anyop));
04481 }
04482 s = message ("%q%s", s, sortText);
04483 break;
04484 }
04485 case OPF_MIDDLE:
04486 {
04487 int size = termNodeList_size (args);
04488 int expect = op->content.middle;
04489
04490
04491
04492 if (size == expect)
04493 {
04494 s = message ("{%q}", termNodeList_unparse (args));
04495 }
04496 else
04497 {
04498 WrongArity (op->tok, expect, size);
04499 s = cstring_makeLiteral ("{ * }");
04500 }
04501
04502 s = message ("%q%s", s, sortText);
04503 break;
04504 }
04505 case OPF_MMIDDLE:
04506 {
04507 int size = termNodeList_size (args);
04508 int expect = op->content.middle + 1;
04509
04510 if (size == expect)
04511 {
04512 s = message ("%q{%q}",
04513 termNode_unparse (termNodeList_head (args)),
04514 termNodeList_unparseTail (args));
04515 }
04516 else
04517 {
04518 WrongArity (op->tok, expect, size);
04519 s = cstring_makeLiteral ("__ { * }");
04520 }
04521
04522 s = message ("%q%s", s, sortText);
04523 break;
04524 }
04525 case OPF_MIDDLEM:
04526 {
04527 int size = termNodeList_size (args);
04528 int expect = op->content.middle + 1;
04529
04530 if (size == expect)
04531 {
04532 termNodeList_finish (args);
04533
04534 s = message ("{%q}%s%s%q",
04535 termNodeList_unparseToCurrent (args),
04536 sortText, sortSpace,
04537 termNode_unparse (termNodeList_current (args)));
04538 }
04539 else
04540 {
04541 WrongArity (op->tok, expect, size);
04542
04543 s = message ("{ * }%s __", sortText);
04544
04545
04546 }
04547 break;
04548 }
04549 case OPF_MMIDDLEM:
04550 {
04551 int size = termNodeList_size (args);
04552 int expect = op->content.middle + 2;
04553
04554 if (size == expect)
04555 {
04556 termNodeList_finish (args);
04557
04558 s = message ("%q {%q} %s%s%q",
04559 termNode_unparse (termNodeList_head (args)),
04560 termNodeList_unparseSecondToCurrent (args),
04561 sortText, sortSpace,
04562 termNode_unparse (termNodeList_current (args)));
04563 }
04564 else
04565 {
04566 WrongArity (op->tok, expect, size);
04567 s = message ("__ { * } %s __", sortText);
04568
04569
04570 }
04571 break;
04572 }
04573 case OPF_BMIDDLE:
04574 {
04575 int size = termNodeList_size (args);
04576 int expect = op->content.middle;
04577
04578 if (size == expect)
04579 {
04580 s = message ("[%q]", termNodeList_unparse (args));
04581 }
04582 else
04583 {
04584 WrongArity (op->tok, expect, size);
04585 s = cstring_makeLiteral ("[ * ]");
04586 }
04587 s = message ("%q%s", s, sortText);
04588 break;
04589 }
04590 case OPF_BMMIDDLE:
04591 {
04592 int size = termNodeList_size (args);
04593 int expect = op->content.middle + 1;
04594
04595 if (size == expect)
04596 {
04597 s = message ("%q[%q]",
04598 termNode_unparse (termNodeList_head (args)),
04599 termNodeList_unparseTail (args));
04600 }
04601 else
04602 {
04603 WrongArity (op->tok, expect, size);
04604 s = cstring_makeLiteral ("__ [ * ]");
04605 }
04606
04607 s = message ("%q%s", s, sortText);
04608 break;
04609 }
04610 case OPF_BMMIDDLEM:
04611 {
04612 int size = termNodeList_size (args);
04613 int expect = op->content.middle + 1;
04614
04615 if (size == expect)
04616 {
04617 s = message ("%q[%q] __",
04618 termNode_unparse (termNodeList_head (args)),
04619 termNodeList_unparseTail (args));
04620 }
04621 else
04622 {
04623 WrongArity (op->tok, expect, size);
04624 s = cstring_makeLiteral ("__ [ * ] __");
04625 }
04626 s = message ("%q%s", s, sortText);
04627 break;
04628 }
04629 case OPF_BMIDDLEM:
04630 {
04631 int size = termNodeList_size (args);
04632 int expect = op->content.middle + 1;
04633
04634 if (size == expect)
04635 {
04636 termNodeList_finish (args);
04637
04638 s = message ("[%q]%s%s%q",
04639 termNodeList_unparseToCurrent (args),
04640 sortText, sortSpace,
04641 termNode_unparse (termNodeList_current (args)));
04642 }
04643 else
04644 {
04645 WrongArity (op->tok, expect, size);
04646 s = cstring_makeLiteral ("[ * ] __");
04647 }
04648
04649 break;
04650 }
04651 case OPF_SELECT:
04652 {
04653 s = cstring_prependChar ('.', ltoken_getRawString (op->content.id));
04654 break;
04655 }
04656 case OPF_MAP:
04657 s = cstring_concat (cstring_makeLiteralTemp ("->"),
04658 ltoken_getRawString (op->content.id));
04659 break;
04660 case OPF_MSELECT:
04661 {
04662 int size = termNodeList_size (args);
04663
04664 if (size == 1)
04665 {
04666 s = message ("%q.%s", termNode_unparse (termNodeList_head (args)),
04667 ltoken_getRawString (op->content.id));
04668 }
04669 else
04670 {
04671 WrongArity (op->content.id, 1, size);
04672 s = cstring_concat (cstring_makeLiteralTemp ("__."),
04673 ltoken_getRawString (op->content.id));
04674 }
04675 break;
04676 }
04677 case OPF_MMAP:
04678 {
04679 int size = termNodeList_size (args);
04680
04681 if (size == 1)
04682 {
04683 s = message ("%q->%s", termNode_unparse (termNodeList_head (args)),
04684 ltoken_getRawString (op->content.id));
04685 }
04686 else
04687 {
04688 WrongArity (op->content.id, 1, size);
04689 s = cstring_concat (cstring_makeLiteralTemp ("__->"),
04690 ltoken_getRawString (op->content.id));
04691 }
04692 break;
04693 }
04694 }
04695
04696 cstring_free (sortSpace);
04697 cstring_free (sortText);
04698 return s;
04699 }
04700 return cstring_undefined;
04701 }
04702
04703 cstring
04704 termNode_unparse ( termNode n)
04705 {
04706 cstring s = cstring_undefined;
04707 cstring back = cstring_undefined;
04708 cstring front = cstring_undefined;
04709 int count;
04710
04711 if (n != (termNode) 0)
04712 {
04713 for (count = n->wrapped; count > 0; count--)
04714 {
04715 front = cstring_appendChar (front, '(');
04716 back = cstring_appendChar (back, ')');
04717 }
04718
04719 switch (n->kind)
04720 {
04721 case TRM_LITERAL:
04722 case TRM_CONST:
04723 case TRM_VAR:
04724 case TRM_ZEROARY:
04725 s = cstring_copy (ltoken_getRawString (n->literal));
04726 break;
04727 case TRM_APPLICATION:
04728 {
04729 nameNode nn = n->name;
04730 if (nn != (nameNode) 0)
04731 {
04732 if (nn->isOpId)
04733 {
04734 s = message ("%s (%q) ",
04735 ltoken_getRawString (nn->content.opid),
04736 termNodeList_unparse (n->args));
04737
04738 }
04739 else
04740 {
04741 s = message ("%q ", printTermNode2 (nn->content.opform, n->args, n->given));
04742 }
04743 }
04744 else
04745 {
04746 llfatalbug
04747 (message ("termNode_unparse: expect non-empty nameNode: TRM_APPLICATION: %q",
04748 nameNode_unparse (nn)));
04749 }
04750 break;
04751 }
04752 case TRM_UNCHANGEDALL:
04753 s = cstring_makeLiteral ("unchanged (all)");
04754 break;
04755 case TRM_UNCHANGEDOTHERS:
04756 s = message ("unchanged (%q)", storeRefNodeList_unparse (n->unchanged));
04757 break;
04758 case TRM_SIZEOF:
04759 s = message ("sizeof (%q)", lclTypeSpecNode_unparse (n->sizeofField));
04760 break;
04761 case TRM_QUANTIFIER:
04762 {
04763 quantifiedTermNode x = n->quantified;
04764 s = message ("%q%s%q%s",
04765 quantifierNodeList_unparse (x->quantifiers),
04766 ltoken_getRawString (x->open),
04767 termNode_unparse (x->body),
04768 ltoken_getRawString (x->close));
04769 break;
04770 }
04771 }
04772 }
04773 return (message ("%q%q%q", front, s, back));
04774 }
04775
04776 static void modifyNode_free ( modifyNode m)
04777 {
04778 if (m != (modifyNode) 0)
04779 {
04780
04781 if (m->hasStoreRefList)
04782 {
04783 storeRefNodeList_free (m->list);
04784
04785 }
04786
04787
04788 ltoken_free (m->tok);
04789 sfree (m);
04790 }
04791 }
04792
04793 cstring
04794 modifyNode_unparse ( modifyNode m)
04795 {
04796 if (m != (modifyNode) 0)
04797 {
04798 if (m->hasStoreRefList)
04799 {
04800 return (message (" modifies %q; \n", storeRefNodeList_unparse (m->list)));
04801 }
04802 else
04803 {
04804 if (m->modifiesNothing)
04805 {
04806 return (cstring_makeLiteral ("modifies nothing; \n"));
04807 }
04808 else
04809 {
04810 return (cstring_makeLiteral ("modifies anything; \n"));
04811 }
04812 }
04813 }
04814 return cstring_undefined;
04815 }
04816
04817 cstring
04818 programNode_unparse (programNode p)
04819 {
04820 if (p != (programNode) 0)
04821 {
04822 cstring s = cstring_undefined;
04823 int count;
04824
04825 switch (p->kind)
04826 {
04827 case ACT_SELF:
04828 {
04829 cstring back = cstring_undefined;
04830
04831 for (count = p->wrapped; count > 0; count--)
04832 {
04833 s = cstring_appendChar (s, '(');
04834 back = cstring_appendChar (back, ')');
04835 }
04836 s = message ("%q%q%q", s, stmtNode_unparse (p->content.self), back);
04837 break;
04838 }
04839 case ACT_ITER:
04840 s = message ("*(%q)", programNodeList_unparse (p->content.args));
04841 break;
04842 case ACT_ALTERNATE:
04843 s = message ("|(%q)", programNodeList_unparse (p->content.args));
04844 break;
04845 case ACT_SEQUENCE:
04846 s = programNodeList_unparse (p->content.args);
04847 break;
04848 }
04849
04850 return s;
04851 }
04852 return cstring_undefined;
04853 }
04854
04855 cstring
04856 stmtNode_unparse (stmtNode x)
04857 {
04858 cstring s = cstring_undefined;
04859
04860 if (x != (stmtNode) 0)
04861 {
04862 if (ltoken_isValid (x->lhs))
04863 {
04864 s = cstring_concat (ltoken_getRawString (x->lhs),
04865 cstring_makeLiteralTemp (" = "));
04866 }
04867
04868 s = message ("%q%s (%q)", s,
04869 ltoken_getRawString (x->operator),
04870 termNodeList_unparse (x->args));
04871 }
04872
04873 return s;
04874 }
04875
04876 lslOp
04877 makelslOpNode ( nameNode name,
04878 sigNode s)
04879 {
04880 lslOp x = (lslOp) dmalloc (sizeof (*x));
04881
04882 x->name = name;
04883 x->signature = s;
04884
04885
04886
04887
04888 if (g_lslParsingTraits)
04889 {
04890 if (name != NULL)
04891 {
04892 symtable_enterOp (g_symtab, nameNode_copySafe (name), sigNode_copy (s));
04893 }
04894 }
04895 else
04896 {
04897
04898 }
04899
04900 return x;
04901 }
04902
04903 cstring
04904 lslOp_unparse (lslOp x)
04905 {
04906 char *s = mstring_createEmpty ();
04907
04908 if (x != (lslOp) 0)
04909 {
04910 s = mstring_concatFree (s, cstring_toCharsSafe (nameNode_unparse (x->name)));
04911
04912 if (x->signature != (sigNode) 0)
04913 {
04914 s = mstring_concatFree (s, cstring_toCharsSafe (sigNode_unparse (x->signature)));
04915 }
04916 }
04917
04918 return cstring_fromCharsO (s);
04919 }
04920
04921 static bool
04922 sameOpFormNode ( opFormNode n1, opFormNode n2)
04923 {
04924 if (n1 == n2)
04925 return TRUE;
04926
04927 if (n1 == 0)
04928 return FALSE;
04929
04930 if (n2 == 0)
04931 return FALSE;
04932
04933 if (n1->kind == n2->kind)
04934 {
04935 switch (n1->kind)
04936 {
04937 case OPF_IF:
04938 return TRUE;
04939 case OPF_ANYOP:
04940 case OPF_MANYOP:
04941 case OPF_ANYOPM:
04942 return (ltoken_similar (n1->content.anyop, n2->content.anyop));
04943 case OPF_MANYOPM:
04944 {
04945
04946 return ltoken_similar (n1->content.anyop, n2->content.anyop);
04947 }
04948 case OPF_MIDDLE:
04949 case OPF_MMIDDLE:
04950 case OPF_MIDDLEM:
04951 case OPF_MMIDDLEM:
04952
04953 if ((int) n1->content.middle == (int) n2->content.middle)
04954 {
04955 if (lsymbol_equal (ltoken_getRawText (n1->tok),
04956 ltoken_getRawText (n2->tok)) &&
04957 lsymbol_equal (ltoken_getRawText (n1->close),
04958 ltoken_getRawText (n2->close)))
04959 return TRUE;
04960 }
04961 return FALSE;
04962 case OPF_BMIDDLE:
04963 case OPF_BMMIDDLE:
04964 case OPF_BMIDDLEM:
04965 case OPF_BMMIDDLEM:
04966 return ((int) n1->content.middle == (int) n2->content.middle);
04967 case OPF_SELECT:
04968 case OPF_MAP:
04969 case OPF_MSELECT:
04970 case OPF_MMAP:
04971 return (ltoken_similar (n1->content.id, n2->content.id));
04972 }
04973 }
04974 return FALSE;
04975 }
04976
04977 bool
04978 sameNameNode ( nameNode n1, nameNode n2)
04979 {
04980 if (n1 == n2)
04981 return TRUE;
04982 if (n1 != (nameNode) 0 && n2 != (nameNode) 0)
04983 {
04984 if (bool_equal (n1->isOpId, n2->isOpId))
04985 {
04986 if (n1->isOpId)
04987 return (ltoken_similar (n1->content.opid, n2->content.opid));
04988 else
04989 return sameOpFormNode (n1->content.opform,
04990 n2->content.opform);
04991 }
04992 }
04993 return FALSE;
04994 }
04995
04996 void CTypesNode_free ( CTypesNode x)
04997 {
04998 if (x != NULL)
04999 {
05000 ltokenList_free (x->ctypes);
05001 sfree (x);
05002 }
05003 }
05004
05005 CTypesNode CTypesNode_copy ( CTypesNode x)
05006 {
05007 if (x != NULL)
05008 {
05009 CTypesNode newnode = (CTypesNode) dmalloc (sizeof (*newnode));
05010 newnode->intfield = x->intfield;
05011 newnode->ctypes = ltokenList_copy (x->ctypes);
05012 newnode->sort = x->sort;
05013
05014 return newnode;
05015 }
05016 else
05017 {
05018 return NULL;
05019 }
05020 }
05021
05022 CTypesNode
05023 makeCTypesNode ( CTypesNode ctypes, ltoken ct)
05024 {
05025 CTypesNode newnode;
05026 lsymbol sortname;
05027 bits sortbits;
05028
05029 if (ctypes == (CTypesNode) NULL)
05030 {
05031 newnode = (CTypesNode) dmalloc (sizeof (*newnode));
05032 newnode->intfield = 0;
05033 newnode->ctypes = ltokenList_new ();
05034 newnode->sort = sort_makeNoSort ();
05035 }
05036 else
05037 {
05038 newnode = ctypes;
05039 }
05040
05041 if ((ltoken_getIntField (ct) & newnode->intfield) != 0)
05042 {
05043 lclerror (ct,
05044 message
05045 ("Duplicate type specifier ignored: %s",
05046 cstring_fromChars
05047 (lsymbol_toChars
05048 (lclctype_toSortDebug (ltoken_getIntField (ct))))));
05049
05050
05051
05052
05053 ltoken_free (ct);
05054 return newnode;
05055 }
05056
05057 sortbits = newnode->intfield | ltoken_getIntField (ct);
05058 sortname = lclctype_toSort (sortbits);
05059
05060 if (sortname == lsymbol_fromChars ("error"))
05061 {
05062 lclerror (ct, cstring_makeLiteral ("Invalid combination of type specifiers"));
05063 }
05064 else
05065 {
05066 newnode->intfield = sortbits;
05067 }
05068
05069 ltokenList_addh (newnode->ctypes, ct);
05070
05071
05072
05073
05074
05075
05076 return newnode;
05077 }
05078
05079 CTypesNode
05080 makeTypeSpecifier (ltoken typedefname)
05081 {
05082 CTypesNode newnode = (CTypesNode) dmalloc (sizeof (*newnode));
05083 typeInfo ti = symtable_typeInfo (g_symtab, ltoken_getText (typedefname));
05084
05085 newnode->intfield = 0;
05086 newnode->ctypes = ltokenList_singleton (ltoken_copy (typedefname));
05087
05088
05089
05090 if (ltoken_getText (typedefname) == lsymbol_bool)
05091 {
05092 lhIncludeBool ();
05093 }
05094
05095 if (typeInfo_exists (ti))
05096 {
05097
05098
05099
05100
05101 newnode->sort = sort_getUnderlying (ti->basedOn);
05102 }
05103 else
05104 {
05105 lclerror (typedefname, message ("Unrecognized type: %s",
05106 ltoken_getRawString (typedefname)));
05107
05108
05109 newnode->sort = sort_makeNoSort ();
05110 }
05111
05112 ltoken_free (typedefname);
05113 return newnode;
05114 }
05115
05116 bool sigNode_equal (sigNode n1, sigNode n2)
05117 {
05118
05119
05120 return ((n1 == n2) ||
05121 (n1->key == n2->key &&
05122 ltoken_similar (n1->range, n2->range) &&
05123 ltokenList_equal (n1->domain, n2->domain)));
05124 }
05125
05126 sort
05127 typeExpr2ptrSort (sort base, typeExpr t)
05128 {
05129 if (t != (typeExpr) 0)
05130 {
05131 switch (t->kind)
05132 {
05133 case TEXPR_BASE:
05134 return base;
05135 case TEXPR_PTR:
05136 return typeExpr2ptrSort (sort_makePtr (ltoken_undefined, base),
05137 t->content.pointer);
05138 case TEXPR_ARRAY:
05139 return typeExpr2ptrSort (sort_makeArr (ltoken_undefined, base),
05140 t->content.array.elementtype);
05141 case TEXPR_FCN:
05142
05143 return sort_makeHOFSort (base);
05144 }
05145 }
05146 return base;
05147 }
05148
05149 static sort
05150 typeExpr2returnSort (sort base, typeExpr t)
05151 {
05152 if (t != (typeExpr) 0)
05153 {
05154 switch (t->kind)
05155 {
05156 case TEXPR_BASE:
05157 return base;
05158 case TEXPR_PTR:
05159 return typeExpr2returnSort (sort_makePtr (ltoken_undefined, base),
05160 t->content.pointer);
05161 case TEXPR_ARRAY:
05162 return typeExpr2returnSort (sort_makeArr (ltoken_undefined, base),
05163 t->content.array.elementtype);
05164 case TEXPR_FCN:
05165 return typeExpr2returnSort (base, t->content.function.returntype);
05166 }
05167 }
05168 return base;
05169 }
05170
05171 sort
05172 lclTypeSpecNode2sort (lclTypeSpecNode type)
05173 {
05174 if (type != (lclTypeSpecNode) 0)
05175 {
05176 switch (type->kind)
05177 {
05178 case LTS_TYPE:
05179 llassert (type->content.type != NULL);
05180 return sort_makePtrN (type->content.type->sort, type->pointers);
05181 case LTS_STRUCTUNION:
05182 llassert (type->content.structorunion != NULL);
05183 return sort_makePtrN (type->content.structorunion->sort,
05184 type->pointers);
05185 case LTS_ENUM:
05186 llassert (type->content.enumspec != NULL);
05187 return sort_makePtrN (type->content.enumspec->sort,
05188 type->pointers);
05189 case LTS_CONJ:
05190 return (lclTypeSpecNode2sort (type->content.conj->a));
05191 }
05192 }
05193 return (sort_makeNoSort ());
05194 }
05195
05196 lsymbol
05197 checkAndEnterTag (tagKind k, ltoken opttagid)
05198 {
05199
05200 tagInfo t;
05201 sort sort = sort_makeNoSort ();
05202
05203 if (!ltoken_isUndefined (opttagid))
05204 {
05205 switch (k)
05206 {
05207 case TAG_FWDSTRUCT:
05208 case TAG_STRUCT:
05209 sort = sort_makeStr (opttagid);
05210 break;
05211 case TAG_FWDUNION:
05212 case TAG_UNION:
05213 sort = sort_makeUnion (opttagid);
05214 break;
05215 case TAG_ENUM:
05216 sort = sort_makeEnum (opttagid);
05217 break;
05218 }
05219
05220
05221 t = symtable_tagInfo (g_symtab, ltoken_getText (opttagid));
05222
05223 if (tagInfo_exists (t))
05224 {
05225 if (t->kind == TAG_FWDUNION || t->kind == TAG_FWDSTRUCT)
05226 {
05227
05228 }
05229 else
05230 {
05231 cstring s;
05232
05233 switch (k)
05234 {
05235 case TAG_ENUM:
05236 s = cstring_makeLiteral ("Enum");
05237 break;
05238 case TAG_STRUCT:
05239 case TAG_FWDSTRUCT:
05240 s = cstring_makeLiteral ("Struct");
05241 break;
05242 case TAG_UNION:
05243 case TAG_FWDUNION:
05244 s = cstring_makeLiteral ("Union");
05245 break;
05246 }
05247
05248 t->sort = sort;
05249 t->kind = k;
05250 lclerror (opttagid,
05251 message ("Tag redefined: %q %s", s,
05252 ltoken_getRawString (opttagid)));
05253
05254 }
05255
05256 ltoken_free (opttagid);
05257 }
05258 else
05259 {
05260 tagInfo newnode = (tagInfo) dmalloc (sizeof (*newnode));
05261
05262 newnode->sort = sort;
05263 newnode->kind = k;
05264 newnode->id = opttagid;
05265 newnode->imported = FALSE;
05266 newnode->content.decls = stDeclNodeList_new ();
05267
05268 (void) symtable_enterTag (g_symtab, newnode);
05269 }
05270 }
05271
05272 return sort_getLsymbol (sort);
05273 }
05274
05275 static sort
05276 extractReturnSort (lclTypeSpecNode t, declaratorNode d)
05277 {
05278 sort sort;
05279 sort = lclTypeSpecNode2sort (t);
05280 sort = typeExpr2returnSort (sort, d->type);
05281 return sort;
05282 }
05283
05284 void
05285 signNode_free ( signNode sn)
05286 {
05287 sortList_free (sn->domain);
05288 ltoken_free (sn->tok);
05289 sfree (sn);
05290 }
05291
05292 cstring
05293 signNode_unparse (signNode sn)
05294 {
05295 cstring s = cstring_undefined;
05296
05297 if (sn != (signNode) 0)
05298 {
05299 s = message (": %q -> %s", sortList_unparse (sn->domain),
05300 sort_unparseName (sn->range));
05301 }
05302 return s;
05303 }
05304
05305 static pairNodeList
05306 globalList_toPairNodeList (globalList g)
05307 {
05308
05309 pairNodeList result = pairNodeList_new ();
05310 pairNode p;
05311 declaratorNode vdnode;
05312 lclTypeSpecNode type;
05313 sort sort;
05314 lsymbol sym;
05315 initDeclNodeList decls;
05316
05317 varDeclarationNodeList_elements (g, x)
05318 {
05319 if (x->isSpecial)
05320 {
05321 ;
05322 }
05323 else
05324 {
05325 if (x->isGlobal && !x->isPrivate)
05326 {
05327 type = x->type;
05328 decls = x->decls;
05329
05330 initDeclNodeList_elements (decls, init)
05331 {
05332 p = (pairNode) dmalloc (sizeof (*p));
05333
05334 vdnode = init->declarator;
05335 sym = ltoken_getText (vdnode->id);
05336
05337
05338 sort = extractReturnSort (type, vdnode);
05339 p->sort = sort_makeGlobal (sort);
05340
05341
05342
05343 p->tok = ltoken_copy (vdnode->id);
05344 pairNodeList_addh (result, p);
05345 } end_initDeclNodeList_elements;
05346 }
05347 }
05348 } end_varDeclarationNodeList_elements;
05349 return result;
05350 }
05351
05352 void
05353 enteringFcnScope (lclTypeSpecNode t, declaratorNode d, globalList g)
05354 {
05355 scopeInfo si = (scopeInfo) dmalloc (sizeof (*si));
05356 varInfo vi = (varInfo) dmalloc (sizeof (*vi));
05357 sort returnSort;
05358 ltoken result = ltoken_copy (ltoken_id);
05359 pairNodeList paramPairs, globals;
05360 fctInfo fi = (fctInfo) dmalloc (sizeof (*fi));
05361 signNode sign = (signNode) dmalloc (sizeof (*sign));
05362 sortList domain = sortList_new ();
05363 unsigned int key;
05364
05365 paramPairs = extractParams (d->type);
05366 returnSort = extractReturnSort (t, d);
05367 globals = globalList_toPairNodeList (g);
05368
05369 sign->tok = ltoken_undefined;
05370 sign->range = returnSort;
05371
05372 key = MASH (0, sort_getLsymbol (returnSort));
05373
05374 pairNodeList_elements (paramPairs, p)
05375 {
05376 sortList_addh (domain, p->sort);
05377 key = MASH (key, sort_getLsymbol (p->sort));
05378 } end_pairNodeList_elements;
05379
05380 sign->domain = domain;
05381 sign->key = key;
05382
05383
05384 fi->id = ltoken_copy (d->id);
05385 fi->export = TRUE;
05386 fi->signature = sign;
05387 fi->globals = globals;
05388
05389 (void) symtable_enterFct (g_symtab, fi);
05390
05391
05392 si->kind = SPE_FCN;
05393 symtable_enterScope (g_symtab, si);
05394
05395
05396 ltoken_setText (result, lsymbol_fromChars ("result"));
05397
05398 vi->id = result;
05399 vi->sort = sort_makeFormal (returnSort);
05400 vi->kind = VRK_PARAM;
05401 vi->export = TRUE;
05402
05403 (void) symtable_enterVar (g_symtab, vi);
05404
05405
05406
05407
05408
05409
05410
05411
05412
05413 pairNodeList_elements (globals, gl)
05414 {
05415 ltoken_free (vi->id);
05416 vi->id = ltoken_copy (gl->tok);
05417 vi->kind = VRK_GLOBAL;
05418 vi->sort = gl->sort;
05419 (void) symtable_enterVar (g_symtab, vi);
05420 } end_pairNodeList_elements;
05421
05422
05423
05424
05425
05426
05427
05428
05429
05430
05431
05432 pairNodeList_elements (paramPairs, pair)
05433 {
05434 ltoken_free (vi->id);
05435 vi->id = ltoken_copy (pair->tok);
05436 vi->sort = pair->sort;
05437 vi->kind = VRK_PARAM;
05438 (void) symtable_enterVar (g_symtab, vi);
05439 } end_pairNodeList_elements;
05440
05441 pairNodeList_free (paramPairs);
05442 varInfo_free (vi);
05443 }
05444
05445 void
05446 enteringClaimScope (paramNodeList params, globalList g)
05447 {
05448 scopeInfo si = (scopeInfo) dmalloc (sizeof (*si));
05449 pairNodeList globals;
05450 lclTypeSpecNode paramtype;
05451 typeExpr paramdecl;
05452 sort sort;
05453
05454 globals = globalList_toPairNodeList (g);
05455
05456 si->kind = SPE_CLAIM;
05457
05458 symtable_enterScope (g_symtab, si);
05459
05460
05461
05462
05463 paramNodeList_elements (params, param)
05464 {
05465 paramdecl = param->paramdecl;
05466 paramtype = param->type;
05467 if (paramdecl != (typeExpr) 0 && paramtype != (lclTypeSpecNode) 0)
05468 {
05469 varInfo vi = (varInfo) dmalloc (sizeof (*vi));
05470
05471 sort = lclTypeSpecNode2sort (paramtype);
05472 sort = sort_makeFormal (sort);
05473 vi->sort = typeExpr2ptrSort (sort, paramdecl);
05474 vi->id = ltoken_copy (extractDeclarator (paramdecl));
05475 vi->kind = VRK_PARAM;
05476 vi->export = TRUE;
05477
05478 (void) symtable_enterVar (g_symtab, vi);
05479 varInfo_free (vi);
05480 }
05481 } end_paramNodeList_elements;
05482
05483
05484
05485
05486 pairNodeList_elements (globals, g2)
05487 {
05488 varInfo vi = (varInfo) dmalloc (sizeof (*vi));
05489
05490 vi->id = ltoken_copy (g2->tok);
05491 vi->kind = VRK_GLOBAL;
05492 vi->sort = g2->sort;
05493 vi->export = TRUE;
05494
05495
05496 (void) symtable_enterVar (g_symtab, vi);
05497 varInfo_free (vi);
05498 } end_pairNodeList_elements;
05499
05500 pairNodeList_free (globals);
05501
05502 }
05503
05504 static pairNodeList
05505 extractParams ( typeExpr te)
05506 {
05507
05508 sort sort;
05509 typeExpr paramdecl;
05510 paramNodeList params;
05511 lclTypeSpecNode paramtype;
05512 pairNodeList head = pairNodeList_new ();
05513 pairNode pair;
05514
05515 if (te != (typeExpr) 0)
05516 {
05517 params = typeExpr_toParamNodeList (te);
05518 if (paramNodeList_isDefined (params))
05519 {
05520 paramNodeList_elements (params, param)
05521 {
05522 paramdecl = param->paramdecl;
05523 paramtype = param->type;
05524 if (paramdecl != (typeExpr) 0 && paramtype != (lclTypeSpecNode) 0)
05525 {
05526 pair = (pairNode) dmalloc (sizeof (*pair));
05527 sort = lclTypeSpecNode2sort (paramtype);
05528
05529 sort = sort_makeFormal (sort);
05530 pair->sort = typeExpr2ptrSort (sort, paramdecl);
05531
05532 pair->tok = ltoken_copy (extractDeclarator (paramdecl));
05533 pairNodeList_addh (head, pair);
05534 }
05535 } end_paramNodeList_elements;
05536 }
05537 }
05538 return head;
05539 }
05540
05541 sort
05542 sigNode_rangeSort (sigNode sig)
05543 {
05544 if (sig == (sigNode) 0)
05545 {
05546 return sort_makeNoSort ();
05547 }
05548 else
05549 {
05550 return sort_fromLsymbol (ltoken_getText (sig->range));
05551 }
05552 }
05553
05554 sortList
05555 sigNode_domain (sigNode sig)
05556 {
05557 sortList domain = sortList_new ();
05558
05559 if (sig == (sigNode) 0)
05560 {
05561 ;
05562 }
05563 else
05564 {
05565 ltokenList dom = sig->domain;
05566
05567 ltokenList_elements (dom, tok)
05568 {
05569 sortList_addh (domain, sort_fromLsymbol (ltoken_getText (tok)));
05570 } end_ltokenList_elements;
05571 }
05572
05573 return domain;
05574 }
05575
05576 opFormUnion
05577 opFormUnion_createAnyOp ( ltoken t)
05578 {
05579 opFormUnion u;
05580
05581
05582 u.anyop = t;
05583 return u;
05584 }
05585
05586 opFormUnion
05587 opFormUnion_createMiddle (int middle)
05588 {
05589 opFormUnion u;
05590
05591 u.middle = middle;
05592 return u;
05593 }
05594
05595 paramNode
05596 markYieldParamNode (paramNode p)
05597 {
05598 p->kind = PYIELD;
05599
05600 llassert (p->type != NULL);
05601 p->type->quals = qualList_add (p->type->quals, qual_createYield ());
05602
05603 return (p);
05604 }
05605
05606 lclTypeSpecNode
05607 lclTypeSpecNode_copySafe (lclTypeSpecNode n)
05608 {
05609 lclTypeSpecNode ret = lclTypeSpecNode_copy (n);
05610
05611 llassert (ret != NULL);
05612 return ret;
05613 }
05614
05615 lclTypeSpecNode
05616 lclTypeSpecNode_copy ( lclTypeSpecNode n)
05617 {
05618 if (n != NULL)
05619 {
05620 switch (n->kind)
05621 {
05622 case LTS_CONJ:
05623 return (makeLclTypeSpecNodeConj (lclTypeSpecNode_copy (n->content.conj->a),
05624 lclTypeSpecNode_copy (n->content.conj->b)));
05625 case LTS_TYPE:
05626 return (makeLclTypeSpecNodeType (CTypesNode_copy (n->content.type)));
05627 case LTS_STRUCTUNION:
05628 return (makeLclTypeSpecNodeSU (strOrUnionNode_copy (n->content.structorunion)));
05629 case LTS_ENUM:
05630 return (makeLclTypeSpecNodeEnum (enumSpecNode_copy (n->content.enumspec)));
05631 }
05632 }
05633
05634 return NULL;
05635 }
05636
05637 void lclTypeSpecNode_free ( lclTypeSpecNode n)
05638 {
05639 if (n != NULL)
05640 {
05641 switch (n->kind)
05642 {
05643 case LTS_CONJ:
05644 lclTypeSpecNode_free (n->content.conj->a);
05645 lclTypeSpecNode_free (n->content.conj->b);
05646 break;
05647 case LTS_TYPE:
05648 CTypesNode_free (n->content.type);
05649 break;
05650 case LTS_STRUCTUNION:
05651 strOrUnionNode_free (n->content.structorunion);
05652 break;
05653 case LTS_ENUM:
05654 enumSpecNode_free (n->content.enumspec);
05655 break;
05656 }
05657
05658 qualList_free (n->quals);
05659 sfree (n);
05660 }
05661 }
05662
05663 static opFormNode opFormNode_copy ( opFormNode op)
05664 {
05665 if (op != NULL)
05666 {
05667 opFormNode ret = (opFormNode) dmalloc (sizeof (*ret));
05668
05669 ret->tok = ltoken_copy (op->tok);
05670 ret->kind = op->kind;
05671 ret->content = op->content;
05672 ret->key = op->key;
05673 ret->close = ltoken_copy (op->close);
05674
05675 return ret;
05676 }
05677 else
05678 {
05679 return NULL;
05680 }
05681 }
05682
05683 void opFormNode_free ( opFormNode op)
05684 {
05685 sfree (op);
05686 }
05687
05688 void nameNode_free (nameNode n)
05689 {
05690
05691 if (n != NULL)
05692 {
05693 if (!n->isOpId)
05694 {
05695 opFormNode_free (n->content.opform);
05696 }
05697
05698 sfree (n);
05699 }
05700 }
05701
05702 bool
05703 lslOp_equal (lslOp x, lslOp y)
05704 {
05705 return ((x == y) ||
05706 ((x != 0) && (y != 0) &&
05707 sameNameNode (x->name, y->name) &&
05708 sigNode_equal (x->signature, y->signature)));
05709 }
05710
05711 void lslOp_free (lslOp x)
05712 {
05713 nameNode_free (x->name);
05714 sfree (x);
05715 }
05716
05717 void sigNode_free (sigNode x)
05718 {
05719 if (x != NULL)
05720 {
05721 ltokenList_free (x->domain);
05722 ltoken_free (x->tok);
05723 ltoken_free (x->range);
05724 sfree (x);
05725 }
05726 }
05727
05728 void declaratorNode_free ( declaratorNode x)
05729 {
05730 if (x != NULL)
05731 {
05732 typeExpr_free (x->type);
05733 ltoken_free (x->id);
05734 sfree (x);
05735 }
05736 }
05737
05738 void abstBodyNode_free ( abstBodyNode n)
05739 {
05740 if (n != NULL)
05741 {
05742 lclPredicateNode_free (n->typeinv);
05743 fcnNodeList_free (n->fcns);
05744 ltoken_free (n->tok);
05745 sfree (n);
05746 }
05747 }
05748
05749 void fcnNode_free ( fcnNode f)
05750 {
05751 if (f != NULL)
05752 {
05753 lclTypeSpecNode_free (f->typespec);
05754 declaratorNode_free (f->declarator);
05755 globalList_free (f->globals);
05756 varDeclarationNodeList_free (f->inits);
05757 letDeclNodeList_free (f->lets);
05758 lclPredicateNode_free (f->checks);
05759 lclPredicateNode_free (f->require);
05760 lclPredicateNode_free (f->claim);
05761 lclPredicateNode_free (f->ensures);
05762 modifyNode_free (f->modify);
05763 ltoken_free (f->name);
05764 sfree (f);
05765 }
05766 }
05767
05768 void declaratorInvNode_free ( declaratorInvNode x)
05769 {
05770 if (x != NULL)
05771 {
05772 declaratorNode_free (x->declarator);
05773 abstBodyNode_free (x->body);
05774 sfree (x);
05775 }
05776 }
05777
05778 lslOp lslOp_copy (lslOp x)
05779 {
05780 return (makelslOpNode (nameNode_copy (x->name), x->signature));
05781 }
05782
05783 sigNode sigNode_copy (sigNode s)
05784 {
05785 llassert (s != NULL);
05786 return (makesigNode (ltoken_copy (s->tok),
05787 ltokenList_copy (s->domain),
05788 ltoken_copy (s->range)));
05789 }
05790
05791 nameNode nameNode_copy ( nameNode n)
05792 {
05793 if (n == NULL) return NULL;
05794 return nameNode_copySafe (n);
05795 }
05796
05797 nameNode nameNode_copySafe (nameNode n)
05798 {
05799 if (n->isOpId)
05800 {
05801 return (makeNameNodeId (ltoken_copy (n->content.opid)));
05802 }
05803 else
05804 {
05805
05806 return (makeNameNodeForm (opFormNode_copy (n->content.opform)));
05807 }
05808 }
05809
05810 bool initDeclNode_isRedeclaration (initDeclNode d)
05811 {
05812 return (d->declarator->isRedecl);
05813 }
05814
05815 void termNode_free ( termNode t)
05816 {
05817 sfree (t);
05818 }
05819
05820 termNode termNode_copySafe (termNode t)
05821 {
05822 termNode ret = termNode_copy (t);
05823
05824 llassert (ret != NULL);
05825 return ret;
05826 }
05827
05828 termNode termNode_copy ( termNode t)
05829 {
05830 if (t != NULL)
05831 {
05832 termNode ret = (termNode) dmalloc (sizeof (*ret));
05833
05834 ret->wrapped = t->wrapped;
05835 ret->kind = t->kind;
05836 ret->sort = t->sort;
05837 ret->given = t->given;
05838 ret->possibleSorts = sortSet_copy (t->possibleSorts);
05839 ret->error_reported = t->error_reported;
05840 ret->possibleOps = lslOpSet_copy (t->possibleOps);
05841 ret->name = nameNode_copy (t->name);
05842 ret->args = termNodeList_copy (t->args);
05843
05844 if (t->kind == TRM_LITERAL
05845 || t->kind == TRM_SIZEOF
05846 || t->kind == TRM_VAR
05847 || t->kind == TRM_CONST
05848 || t->kind == TRM_ZEROARY)
05849 {
05850 ret->literal = ltoken_copy (t->literal);
05851 }
05852
05853 if (t->kind == TRM_UNCHANGEDOTHERS)
05854 {
05855 ret->unchanged = storeRefNodeList_copy (t->unchanged);
05856 }
05857
05858 if (t->kind == TRM_QUANTIFIER)
05859 {
05860 ret->quantified = quantifiedTermNode_copy (t->quantified);
05861 }
05862
05863 if (t->kind == TRM_SIZEOF)
05864 {
05865 ret->sizeofField = lclTypeSpecNode_copySafe (t->sizeofField);
05866 }
05867
05868 return ret;
05869 }
05870 else
05871 {
05872
05873 return NULL;
05874 }
05875 }
05876
05877 void importNode_free ( importNode x)
05878 {
05879 sfree (x);
05880 }
05881
05882 void initDeclNode_free ( initDeclNode x)
05883 {
05884 if (x != NULL)
05885 {
05886 declaratorNode_free (x->declarator);
05887 termNode_free (x->value);
05888 sfree (x);
05889 }
05890 }
05891
05892 void letDeclNode_free ( letDeclNode x)
05893 {
05894 if (x != NULL)
05895 {
05896 lclTypeSpecNode_free (x->sortspec);
05897 termNode_free (x->term);
05898 ltoken_free (x->varid);
05899 sfree (x);
05900 }
05901 }
05902
05903 void pairNode_free ( pairNode x)
05904 {
05905 sfree (x);
05906 }
05907
05908 paramNode paramNode_copy ( paramNode p)
05909 {
05910 if (p != NULL)
05911 {
05912 paramNode ret = (paramNode) dmalloc (sizeof (*ret));
05913
05914 ret->type = lclTypeSpecNode_copy (p->type);
05915 ret->paramdecl = typeExpr_copy (p->paramdecl);
05916 ret->kind = p->kind;
05917 return ret;
05918 }
05919
05920 return NULL;
05921 }
05922
05923 void paramNode_free ( paramNode x)
05924 {
05925 if (x != NULL)
05926 {
05927 lclTypeSpecNode_free (x->type);
05928 typeExpr_free (x->paramdecl);
05929 sfree (x);
05930 }
05931 }
05932
05933 void programNode_free ( programNode x)
05934 {
05935 if (x != NULL)
05936 {
05937 switch (x->kind)
05938 {
05939 case ACT_SELF: stmtNode_free (x->content.self); break;
05940 case ACT_ITER:
05941 case ACT_ALTERNATE:
05942 case ACT_SEQUENCE: programNodeList_free (x->content.args); break;
05943 BADDEFAULT;
05944 }
05945 sfree (x);
05946 }
05947 }
05948
05949 quantifierNode quantifierNode_copy (quantifierNode x)
05950 {
05951 quantifierNode ret = (quantifierNode) dmalloc (sizeof (*ret));
05952
05953 ret->quant = ltoken_copy (x->quant);
05954 ret->vars = varNodeList_copy (x->vars);
05955 ret->isForall = x->isForall;
05956
05957 return ret;
05958 }
05959
05960 void quantifierNode_free ( quantifierNode x)
05961 {
05962 if (x != NULL)
05963 {
05964 varNodeList_free (x->vars);
05965 ltoken_free (x->quant);
05966 sfree (x);
05967 }
05968 }
05969
05970 void replaceNode_free ( replaceNode x)
05971 {
05972 if (x != NULL)
05973 {
05974 if (x->isCType)
05975 {
05976 ;
05977 }
05978 else
05979 {
05980 nameNode_free (x->content.renamesortname.name);
05981 sigNode_free (x->content.renamesortname.signature);
05982 }
05983
05984 typeNameNode_free (x->typename);
05985 ltoken_free (x->tok);
05986 sfree (x);
05987 }
05988 }
05989
05990 storeRefNode storeRefNode_copy (storeRefNode x)
05991 {
05992 storeRefNode ret = (storeRefNode) dmalloc (sizeof (*ret));
05993
05994 ret->kind = x->kind;
05995
05996 switch (x->kind)
05997 {
05998 case SRN_TERM:
05999 ret->content.term = termNode_copySafe (x->content.term);
06000 break;
06001 case SRN_OBJ: case SRN_TYPE:
06002 ret->content.type = lclTypeSpecNode_copy (x->content.type);
06003 break;
06004 case SRN_SPECIAL:
06005 ret->content.ref = sRef_copy (x->content.ref);
06006 break;
06007 }
06008
06009 return ret;
06010 }
06011
06012 void storeRefNode_free ( storeRefNode x)
06013 {
06014 if (x != NULL)
06015 {
06016 if (storeRefNode_isTerm (x))
06017 {
06018 termNode_free (x->content.term);
06019 }
06020 else if (storeRefNode_isType (x) || storeRefNode_isObj (x))
06021 {
06022 lclTypeSpecNode_free (x->content.type);
06023 }
06024 else
06025 {
06026
06027 }
06028
06029 sfree (x);
06030 }
06031 }
06032
06033 stDeclNode stDeclNode_copy (stDeclNode x)
06034 {
06035 stDeclNode ret = (stDeclNode) dmalloc (sizeof (*ret));
06036
06037 ret->lcltypespec = lclTypeSpecNode_copySafe (x->lcltypespec);
06038 ret->declarators = declaratorNodeList_copy (x->declarators);
06039
06040 return ret;
06041 }
06042
06043 void stDeclNode_free ( stDeclNode x)
06044 {
06045 if (x != NULL)
06046 {
06047 lclTypeSpecNode_free (x->lcltypespec);
06048 declaratorNodeList_free (x->declarators);
06049 sfree (x);
06050 }
06051 }
06052
06053 void traitRefNode_free ( traitRefNode x)
06054 {
06055 if (x != NULL)
06056 {
06057 ltokenList_free (x->traitid);
06058 renamingNode_free (x->rename);
06059 sfree (x);
06060 }
06061 }
06062
06063 void typeNameNode_free ( typeNameNode n)
06064 {
06065 if (n != NULL)
06066 {
06067 typeNamePack_free (n->typename);
06068 opFormNode_free (n->opform);
06069 sfree (n);
06070 }
06071 }
06072
06073 void varDeclarationNode_free ( varDeclarationNode x)
06074 {
06075 if (x != NULL)
06076 {
06077 if (x->isSpecial)
06078 {
06079 ;
06080 }
06081 else
06082 {
06083 lclTypeSpecNode_free (x->type);
06084 initDeclNodeList_free (x->decls);
06085 sfree (x);
06086 }
06087 }
06088 }
06089
06090 varNode varNode_copy (varNode x)
06091 {
06092 varNode ret = (varNode) dmalloc (sizeof (*ret));
06093
06094 ret->varid = ltoken_copy (x->varid);
06095 ret->isObj = x->isObj;
06096 ret->type = lclTypeSpecNode_copySafe (x->type);
06097 ret->sort = x->sort;
06098
06099 return ret;
06100 }
06101
06102 void varNode_free ( varNode x)
06103 {
06104 if (x != NULL)
06105 {
06106 lclTypeSpecNode_free (x->type);
06107 ltoken_free (x->varid);
06108 sfree (x);
06109 }
06110 }
06111
06112 void stmtNode_free ( stmtNode x)
06113 {
06114 if (x != NULL)
06115 {
06116 ltoken_free (x->lhs);
06117 termNodeList_free (x->args);
06118 ltoken_free (x->operator);
06119 sfree (x);
06120 }
06121 }
06122
06123 void renamingNode_free ( renamingNode x)
06124 {
06125 if (x != NULL)
06126 {
06127 if (x->is_replace)
06128 {
06129 replaceNodeList_free (x->content.replace);
06130 }
06131 else
06132 {
06133 nameAndReplaceNode_free (x->content.name);
06134 }
06135
06136 sfree (x);
06137 }
06138 }
06139
06140 void nameAndReplaceNode_free ( nameAndReplaceNode x)
06141 {
06142 if (x != NULL)
06143 {
06144 typeNameNodeList_free (x->namelist);
06145 replaceNodeList_free (x->replacelist);
06146 sfree (x);
06147 }
06148 }
06149
06150 void typeNamePack_free ( typeNamePack x)
06151 {
06152 if (x != NULL)
06153 {
06154 lclTypeSpecNode_free (x->type);
06155 abstDeclaratorNode_free (x->abst);
06156 sfree (x);
06157 }
06158 }
06159
06160 cstring interfaceNode_unparse (interfaceNode x)
06161 {
06162 if (x != NULL)
06163 {
06164 switch (x->kind)
06165 {
06166 case INF_IMPORTS:
06167 return (message ("[imports] %q", importNodeList_unparse (x->content.imports)));
06168 case INF_USES:
06169 return (message ("[uses] %q", traitRefNodeList_unparse (x->content.uses)));
06170 case INF_EXPORT:
06171 return (message ("[export] %q", exportNode_unparse (x->content.export)));
06172 case INF_PRIVATE:
06173 return (message ("[private] %q", privateNode_unparse (x->content.private)));
06174 }
06175
06176 BADBRANCH;
06177 }
06178 else
06179 {
06180 return (cstring_makeLiteral ("<interface node undefined>"));
06181 }
06182 }
06183
06184 void interfaceNode_free ( interfaceNode x)
06185 {
06186 if (x != NULL)
06187 {
06188
06189 switch (x->kind)
06190 {
06191 case INF_IMPORTS: importNodeList_free (x->content.imports); break;
06192 case INF_USES: traitRefNodeList_free (x->content.uses); break;
06193 case INF_EXPORT: exportNode_free (x->content.export); break;
06194 case INF_PRIVATE: privateNode_free (x->content.private); break;
06195 }
06196 sfree (x);
06197 }
06198 }
06199
06200 void exportNode_free ( exportNode x)
06201 {
06202 if (x != NULL)
06203 {
06204 switch (x->kind)
06205 {
06206 case XPK_CONST: constDeclarationNode_free (x->content.constdeclaration); break;
06207 case XPK_VAR: varDeclarationNode_free (x->content.vardeclaration); break;
06208 case XPK_TYPE: typeNode_free (x->content.type); break;
06209 case XPK_FCN: fcnNode_free (x->content.fcn); break;
06210 case XPK_CLAIM: claimNode_free (x->content.claim); break;
06211 case XPK_ITER: iterNode_free (x->content.iter); break;
06212 }
06213
06214 sfree (x);
06215 }
06216 }
06217
06218 void privateNode_free ( privateNode x)
06219 {
06220 if (x != NULL)
06221 {
06222 switch (x->kind)
06223 {
06224 case PRIV_CONST:
06225 constDeclarationNode_free (x->content.constdeclaration); break;
06226 case PRIV_VAR:
06227 varDeclarationNode_free (x->content.vardeclaration); break;
06228 case PRIV_TYPE:
06229 typeNode_free (x->content.type); break;
06230 case PRIV_FUNCTION:
06231 fcnNode_free (x->content.fcn); break;
06232 }
06233
06234 sfree (x);
06235 }
06236 }
06237
06238 void constDeclarationNode_free ( constDeclarationNode x)
06239 {
06240 if (x != NULL)
06241 {
06242 lclTypeSpecNode_free (x->type);
06243 initDeclNodeList_free (x->decls);
06244 sfree (x);
06245 }
06246 }
06247
06248 void typeNode_free ( typeNode t)
06249 {
06250 if (t != NULL)
06251 {
06252 switch (t->kind)
06253 {
06254 case TK_ABSTRACT: abstractNode_free (t->content.abstract); break;
06255 case TK_EXPOSED: exposedNode_free (t->content.exposed); break;
06256 case TK_UNION: taggedUnionNode_free (t->content.taggedunion); break;
06257 }
06258
06259 sfree (t);
06260 }
06261 }
06262
06263 void claimNode_free ( claimNode x)
06264 {
06265 if (x != NULL)
06266 {
06267 paramNodeList_free (x->params);
06268 globalList_free (x->globals);
06269 letDeclNodeList_free (x->lets);
06270 lclPredicateNode_free (x->require);
06271 programNode_free (x->body);
06272 lclPredicateNode_free (x->ensures);
06273 ltoken_free (x->name);
06274 sfree (x);
06275 }
06276 }
06277
06278 void iterNode_free ( iterNode x)
06279 {
06280 if (x != NULL)
06281 {
06282 paramNodeList_free (x->params);
06283 ltoken_free (x->name);
06284 sfree (x);
06285 }
06286 }
06287
06288 void abstractNode_free ( abstractNode x)
06289 {
06290 if (x != NULL)
06291 {
06292 abstBodyNode_free (x->body);
06293 ltoken_free (x->tok);
06294 ltoken_free (x->name);
06295 sfree (x);
06296 }
06297 }
06298
06299 void exposedNode_free ( exposedNode x)
06300 {
06301 if (x != NULL)
06302 {
06303 lclTypeSpecNode_free (x->type);
06304 declaratorInvNodeList_free (x->decls);
06305 ltoken_free (x->tok);
06306 sfree (x);
06307 }
06308 }
06309
06310 void taggedUnionNode_free ( taggedUnionNode x)
06311 {
06312 if (x != NULL)
06313 {
06314 stDeclNodeList_free (x->structdecls);
06315 declaratorNode_free (x->declarator);
06316 sfree (x);
06317 }
06318 }
06319
06320 strOrUnionNode
06321 strOrUnionNode_copy ( strOrUnionNode n)
06322 {
06323 if (n != NULL)
06324 {
06325 strOrUnionNode ret = (strOrUnionNode) dmalloc (sizeof (*ret));
06326
06327 ret->kind = n->kind;
06328 ret->tok = ltoken_copy (n->tok);
06329 ret->opttagid = ltoken_copy (n->opttagid);
06330 ret->sort = n->sort;
06331 ret->structdecls = stDeclNodeList_copy (n->structdecls);
06332
06333 return ret;
06334 }
06335 else
06336 {
06337 return NULL;
06338 }
06339 }
06340
06341 void strOrUnionNode_free ( strOrUnionNode n)
06342 {
06343 if (n != NULL)
06344 {
06345 stDeclNodeList_free (n->structdecls);
06346 ltoken_free (n->tok);
06347 ltoken_free (n->opttagid);
06348 sfree (n);
06349 }
06350 }
06351
06352 void enumSpecNode_free ( enumSpecNode x)
06353 {
06354 if (x != NULL)
06355 {
06356 ltokenList_free (x->enums);
06357 ltoken_free (x->tok);
06358 ltoken_free (x->opttagid);
06359 sfree (x);
06360 }
06361 }
06362
06363 enumSpecNode enumSpecNode_copy ( enumSpecNode x)
06364 {
06365 if (x != NULL)
06366 {
06367 enumSpecNode ret = (enumSpecNode) dmalloc (sizeof (*ret));
06368
06369 ret->tok = ltoken_copy (x->tok);
06370 ret->opttagid = ltoken_copy (x->opttagid);
06371 ret->enums = ltokenList_copy (x->enums);
06372 ret->sort = x->sort;
06373
06374 return ret;
06375 }
06376 else
06377 {
06378 return NULL;
06379 }
06380 }
06381
06382 void lsymbol_setbool (lsymbol s)
06383 {
06384 lsymbol_bool = s;
06385 }
06386
06387 lsymbol lsymbol_getbool ()
06388 {
06389 return lsymbol_bool;
06390 }
06391
06392 lsymbol lsymbol_getBool ()
06393 {
06394 return lsymbol_Bool;
06395 }
06396
06397 lsymbol lsymbol_getFALSE ()
06398 {
06399 return lsymbol_FALSE;
06400 }
06401
06402 lsymbol lsymbol_getTRUE ()
06403 {
06404 return lsymbol_TRUE;
06405 }
06406
06407