12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745 |
- #include "limbo.h"
- #include "mp.h"
- #include "libsec.h"
- char *kindname[Tend] =
- {
- /* Tnone */ "no type",
- /* Tadt */ "adt",
- /* Tadtpick */ "adt",
- /* Tarray */ "array",
- /* Tbig */ "big",
- /* Tbyte */ "byte",
- /* Tchan */ "chan",
- /* Treal */ "real",
- /* Tfn */ "fn",
- /* Tint */ "int",
- /* Tlist */ "list",
- /* Tmodule */ "module",
- /* Tref */ "ref",
- /* Tstring */ "string",
- /* Ttuple */ "tuple",
- /* Texception */ "exception",
- /* Tfix */ "fixed point",
- /* Tpoly */ "polymorphic",
- /* Tainit */ "array initializers",
- /* Talt */ "alt channels",
- /* Tany */ "polymorphic type",
- /* Tarrow */ "->",
- /* Tcase */ "case int labels",
- /* Tcasel */ "case big labels",
- /* Tcasec */ "case string labels",
- /* Tdot */ ".",
- /* Terror */ "type error",
- /* Tgoto */ "goto labels",
- /* Tid */ "id",
- /* Tiface */ "module interface",
- /* Texcept */ "exception handler table",
- /* Tinst */ "instantiated type",
- };
- Tattr tattr[Tend] =
- {
- /* isptr refable conable big vis */
- /* Tnone */ { 0, 0, 0, 0, 0, },
- /* Tadt */ { 0, 1, 1, 1, 1, },
- /* Tadtpick */ { 0, 1, 0, 1, 1, },
- /* Tarray */ { 1, 0, 0, 0, 1, },
- /* Tbig */ { 0, 0, 1, 1, 1, },
- /* Tbyte */ { 0, 0, 1, 0, 1, },
- /* Tchan */ { 1, 0, 0, 0, 1, },
- /* Treal */ { 0, 0, 1, 1, 1, },
- /* Tfn */ { 0, 1, 0, 0, 1, },
- /* Tint */ { 0, 0, 1, 0, 1, },
- /* Tlist */ { 1, 0, 0, 0, 1, },
- /* Tmodule */ { 1, 0, 0, 0, 1, },
- /* Tref */ { 1, 0, 0, 0, 1, },
- /* Tstring */ { 1, 0, 1, 0, 1, },
- /* Ttuple */ { 0, 1, 1, 1, 1, },
- /* Texception */ { 0, 0, 0, 1, 1, },
- /* Tfix */ { 0, 0, 1, 0, 1, },
- /* Tpoly */ { 1, 0, 0, 0, 1, },
- /* Tainit */ { 0, 0, 0, 1, 0, },
- /* Talt */ { 0, 0, 0, 1, 0, },
- /* Tany */ { 1, 0, 0, 0, 0, },
- /* Tarrow */ { 0, 0, 0, 0, 1, },
- /* Tcase */ { 0, 0, 0, 1, 0, },
- /* Tcasel */ { 0, 0, 0, 1, 0, },
- /* Tcasec */ { 0, 0, 0, 1, 0, },
- /* Tdot */ { 0, 0, 0, 0, 1, },
- /* Terror */ { 0, 1, 1, 0, 0, },
- /* Tgoto */ { 0, 0, 0, 1, 0, },
- /* Tid */ { 0, 0, 0, 0, 1, },
- /* Tiface */ { 0, 0, 0, 1, 0, },
- /* Texcept */ { 0, 0, 0, 1, 0, },
- /* Tinst */ { 0, 1, 1, 1, 1, },
- };
- static Teq *eqclass[Tend];
- static Type ztype;
- static int eqrec;
- static int eqset;
- static int tcomset;
- static int idcompat(Decl*, Decl*, int, int);
- static int rtcompat(Type *t1, Type *t2, int any, int);
- static int assumeteq(Type *t1, Type *t2);
- static int assumetcom(Type *t1, Type *t2);
- static int cleartcomrec(Type *t);
- static int rtequal(Type*, Type*);
- static int cleareqrec(Type*);
- static int idequal(Decl*, Decl*, int, int*);
- static int pyequal(Type*, Type*);
- static int rtsign(Type*, uchar*, int, int);
- static int clearrec(Type*);
- static int idsign(Decl*, int, uchar*, int, int);
- static int idsign1(Decl*, int, uchar*, int, int);
- static int raisessign(Node *n, uchar *sig, int lensig, int spos);
- static void ckfix(Type*, double);
- static int fnunify(Type*, Type*, Tpair**, int);
- static int rtunify(Type*, Type*, Tpair**, int);
- static int idunify(Decl*, Decl*, Tpair**, int);
- static int toccurs(Type*, Tpair**);
- static int fncleareqrec(Type*, Type*);
- static Type* comtype(Src*, Type*, Decl*);
- static Type* duptype(Type*);
- static int tpolys(Type*);
- static void
- addtmap(Type *t1, Type *t2, Tpair **tpp)
- {
- Tpair *tp;
- tp = allocmem(sizeof *tp);
- tp->t1 = t1;
- tp->t2 = t2;
- tp->nxt = *tpp;
- *tpp = tp;
- }
- Type*
- valtmap(Type *t, Tpair *tp)
- {
- for( ; tp != nil; tp = tp->nxt)
- if(tp->t1 == t)
- return tp->t2;
- return t;
- }
- Typelist*
- addtype(Type *t, Typelist *hd)
- {
- Typelist *tl, *p;
- tl = allocmem(sizeof(*tl));
- tl->t = t;
- tl->nxt = nil;
- if(hd == nil)
- return tl;
- for(p = hd; p->nxt != nil; p = p->nxt)
- ;
- p->nxt = tl;
- return hd;
- }
- void
- typeinit(void)
- {
- Decl *id;
- anontupsym = enter(".tuple", 0);
- ztype.sbl = -1;
- ztype.ok = 0;
- ztype.rec = 0;
- tbig = mktype(&noline, &noline, Tbig, nil, nil);
- tbig->size = IBY2LG;
- tbig->align = IBY2LG;
- tbig->ok = OKmask;
- tbyte = mktype(&noline, &noline, Tbyte, nil, nil);
- tbyte->size = 1;
- tbyte->align = 1;
- tbyte->ok = OKmask;
- tint = mktype(&noline, &noline, Tint, nil, nil);
- tint->size = IBY2WD;
- tint->align = IBY2WD;
- tint->ok = OKmask;
- treal = mktype(&noline, &noline, Treal, nil, nil);
- treal->size = IBY2FT;
- treal->align = IBY2FT;
- treal->ok = OKmask;
- tstring = mktype(&noline, &noline, Tstring, nil, nil);
- tstring->size = IBY2WD;
- tstring->align = IBY2WD;
- tstring->ok = OKmask;
- texception = mktype(&noline, &noline, Texception, nil, nil);
- texception->size = IBY2WD;
- texception->align = IBY2WD;
- texception->ok = OKmask;
- tany = mktype(&noline, &noline, Tany, nil, nil);
- tany->size = IBY2WD;
- tany->align = IBY2WD;
- tany->ok = OKmask;
- tnone = mktype(&noline, &noline, Tnone, nil, nil);
- tnone->size = 0;
- tnone->align = 1;
- tnone->ok = OKmask;
- terror = mktype(&noline, &noline, Terror, nil, nil);
- terror->size = 0;
- terror->align = 1;
- terror->ok = OKmask;
- tunknown = mktype(&noline, &noline, Terror, nil, nil);
- tunknown->size = 0;
- tunknown->align = 1;
- tunknown->ok = OKmask;
- tfnptr = mktype(&noline, &noline, Ttuple, nil, nil);
- id = tfnptr->ids = mkids(&nosrc, nil, tany, nil);
- id->store = Dfield;
- id->offset = 0;
- id->sym = enter("t0", 0);
- id->src = nosrc;
- id = tfnptr->ids->next = mkids(&nosrc, nil, tint, nil);
- id->store = Dfield;
- id->offset = IBY2WD;
- id->sym = enter("t1", 0);
- id->src = nosrc;
- rtexception = mktype(&noline, &noline, Tref, texception, nil);
- rtexception->size = IBY2WD;
- rtexception->align = IBY2WD;
- rtexception->ok = OKmask;
- }
- void
- typestart(void)
- {
- descriptors = nil;
- nfns = 0;
- nadts = 0;
- selfdecl = nil;
- if(tfnptr->decl != nil)
- tfnptr->decl->desc = nil;
- memset(eqclass, 0, sizeof eqclass);
- typebuiltin(mkids(&nosrc, enter("int", 0), nil, nil), tint);
- typebuiltin(mkids(&nosrc, enter("big", 0), nil, nil), tbig);
- typebuiltin(mkids(&nosrc, enter("byte", 0), nil, nil), tbyte);
- typebuiltin(mkids(&nosrc, enter("string", 0), nil, nil), tstring);
- typebuiltin(mkids(&nosrc, enter("real", 0), nil, nil), treal);
- }
- Teq*
- modclass(void)
- {
- return eqclass[Tmodule];
- }
- Type*
- mktype(Line *start, Line *stop, int kind, Type *tof, Decl *args)
- {
- Type *t;
- t = allocmem(sizeof *t);
- *t = ztype;
- t->src.start = *start;
- t->src.stop = *stop;
- t->kind = kind;
- t->tof = tof;
- t->ids = args;
- return t;
- }
- Type*
- mktalt(Case *c)
- {
- Type *t;
- char buf[32];
- static int nalt;
- t = mktype(&noline, &noline, Talt, nil, nil);
- t->decl = mkdecl(&nosrc, Dtype, t);
- seprint(buf, buf+sizeof(buf), ".a%d", nalt++);
- t->decl->sym = enter(buf, 0);
- t->cse = c;
- return usetype(t);
- }
- /*
- * copy t and the top level of ids
- */
- Type*
- copytypeids(Type *t)
- {
- Type *nt;
- Decl *id, *new, *last;
- nt = allocmem(sizeof *nt);
- *nt = *t;
- last = nil;
- for(id = t->ids; id != nil; id = id->next){
- new = allocmem(sizeof *id);
- *new = *id;
- if(last == nil)
- nt->ids = new;
- else
- last->next = new;
- last = new;
- }
- return nt;
- }
- /*
- * make each of the ids have type t
- */
- Decl*
- typeids(Decl *ids, Type *t)
- {
- Decl *id;
- if(ids == nil)
- return nil;
- ids->ty = t;
- for(id = ids->next; id != nil; id = id->next){
- id->ty = t;
- }
- return ids;
- }
- void
- typebuiltin(Decl *d, Type *t)
- {
- d->ty = t;
- t->decl = d;
- installids(Dtype, d);
- }
- Node *
- fielddecl(int store, Decl *ids)
- {
- Node *n;
- n = mkn(Ofielddecl, nil, nil);
- n->decl = ids;
- for(; ids != nil; ids = ids->next)
- ids->store = store;
- return n;
- }
- Node *
- typedecl(Decl *ids, Type *t)
- {
- Node *n;
- if(t->decl == nil)
- t->decl = ids;
- n = mkn(Otypedecl, nil, nil);
- n->decl = ids;
- n->ty = t;
- for(; ids != nil; ids = ids->next)
- ids->ty = t;
- return n;
- }
- void
- typedecled(Node *n)
- {
- installids(Dtype, n->decl);
- }
- Node *
- adtdecl(Decl *ids, Node *fields)
- {
- Node *n;
- Type *t;
- n = mkn(Oadtdecl, nil, nil);
- t = mktype(&ids->src.start, &ids->src.stop, Tadt, nil, nil);
- n->decl = ids;
- n->left = fields;
- n->ty = t;
- t->decl = ids;
- for(; ids != nil; ids = ids->next)
- ids->ty = t;
- return n;
- }
- void
- adtdecled(Node *n)
- {
- Decl *d, *ids;
- d = n->ty->decl;
- installids(Dtype, d);
- if(n->ty->polys != nil){
- pushscope(nil, Sother);
- installids(Dtype, n->ty->polys);
- }
- pushscope(nil, Sother);
- fielddecled(n->left);
- n->ty->ids = popscope();
- if(n->ty->polys != nil)
- n->ty->polys = popscope();
- for(ids = n->ty->ids; ids != nil; ids = ids->next)
- ids->dot = d;
- }
- void
- fielddecled(Node *n)
- {
- for(; n != nil; n = n->right){
- switch(n->op){
- case Oseq:
- fielddecled(n->left);
- break;
- case Oadtdecl:
- adtdecled(n);
- return;
- case Otypedecl:
- typedecled(n);
- return;
- case Ofielddecl:
- installids(Dfield, n->decl);
- return;
- case Ocondecl:
- condecled(n);
- gdasdecl(n->right);
- return;
- case Oexdecl:
- exdecled(n);
- return;
- case Opickdecl:
- pickdecled(n);
- return;
- default:
- fatal("can't deal with %O in fielddecled", n->op);
- }
- }
- }
- int
- pickdecled(Node *n)
- {
- Decl *d;
- int tag;
- if(n == nil)
- return 0;
- tag = pickdecled(n->left);
- pushscope(nil, Sother);
- fielddecled(n->right->right);
- d = n->right->left->decl;
- d->ty->ids = popscope();
- installids(Dtag, d);
- for(; d != nil; d = d->next)
- d->tag = tag++;
- return tag;
- }
- /*
- * make the tuple type used to initialize adt t
- */
- Type*
- mkadtcon(Type *t)
- {
- Decl *id, *new, *last;
- Type *nt;
- nt = allocmem(sizeof *nt);
- *nt = *t;
- last = nil;
- nt->ids = nil;
- nt->kind = Ttuple;
- for(id = t->ids; id != nil; id = id->next){
- if(id->store != Dfield)
- continue;
- new = allocmem(sizeof *id);
- *new = *id;
- new->cyc = 0;
- if(last == nil)
- nt->ids = new;
- else
- last->next = new;
- last = new;
- }
- last->next = nil;
- return nt;
- }
- /*
- * make the tuple type used to initialize t,
- * an adt with pick fields tagged by tg
- */
- Type*
- mkadtpickcon(Type *t, Type *tgt)
- {
- Decl *id, *new, *last;
- Type *nt;
- last = mkids(&tgt->decl->src, nil, tint, nil);
- last->store = Dfield;
- nt = mktype(&t->src.start, &t->src.stop, Ttuple, nil, last);
- for(id = t->ids; id != nil; id = id->next){
- if(id->store != Dfield)
- continue;
- new = allocmem(sizeof *id);
- *new = *id;
- new->cyc = 0;
- last->next = new;
- last = new;
- }
- for(id = tgt->ids; id != nil; id = id->next){
- if(id->store != Dfield)
- continue;
- new = allocmem(sizeof *id);
- *new = *id;
- new->cyc = 0;
- last->next = new;
- last = new;
- }
- last->next = nil;
- return nt;
- }
- /*
- * make an identifier type
- */
- Type*
- mkidtype(Src *src, Sym *s)
- {
- Type *t;
- t = mktype(&src->start, &src->stop, Tid, nil, nil);
- if(s->unbound == nil){
- s->unbound = mkdecl(src, Dunbound, nil);
- s->unbound->sym = s;
- }
- t->decl = s->unbound;
- return t;
- }
- /*
- * make a qualified type for t->s
- */
- Type*
- mkarrowtype(Line *start, Line *stop, Type *t, Sym *s)
- {
- Src src;
- src.start = *start;
- src.stop = *stop;
- t = mktype(start, stop, Tarrow, t, nil);
- if(s->unbound == nil){
- s->unbound = mkdecl(&src, Dunbound, nil);
- s->unbound->sym = s;
- }
- t->decl = s->unbound;
- return t;
- }
- /*
- * make a qualified type for t.s
- */
- Type*
- mkdottype(Line *start, Line *stop, Type *t, Sym *s)
- {
- Src src;
- src.start = *start;
- src.stop = *stop;
- t = mktype(start, stop, Tdot, t, nil);
- if(s->unbound == nil){
- s->unbound = mkdecl(&src, Dunbound, nil);
- s->unbound->sym = s;
- }
- t->decl = s->unbound;
- return t;
- }
- Type*
- mkinsttype(Src* src, Type *tt, Typelist *tl)
- {
- Type *t;
- t = mktype(&src->start, &src->stop, Tinst, tt, nil);
- t->u.tlist = tl;
- return t;
- }
- /*
- * look up the name f in the fields of a module, adt, or tuple
- */
- Decl*
- namedot(Decl *ids, Sym *s)
- {
- for(; ids != nil; ids = ids->next)
- if(ids->sym == s)
- return ids;
- return nil;
- }
- /*
- * complete the declaration of an adt
- * methods frames get sized in module definition or during function definition
- * place the methods at the end of the field list
- */
- void
- adtdefd(Type *t)
- {
- Decl *d, *id, *next, *aux, *store, *auxhd, *tagnext;
- int seentags;
- if(debug['x'])
- print("adt %T defd\n", t);
- d = t->decl;
- tagnext = nil;
- store = nil;
- for(id = t->polys; id != nil; id = id->next){
- id->store = Dtype;
- id->ty = verifytypes(id->ty, d, nil);
- }
- for(id = t->ids; id != nil; id = next){
- if(id->store == Dtag){
- if(t->tags != nil)
- error(id->src.start, "only one set of pick fields allowed");
- tagnext = pickdefd(t, id);
- next = tagnext;
- if(store != nil)
- store->next = next;
- else
- t->ids = next;
- continue;
- }else{
- id->dot = d;
- next = id->next;
- store = id;
- }
- }
- aux = nil;
- store = nil;
- auxhd = nil;
- seentags = 0;
- for(id = t->ids; id != nil; id = next){
- if(id == tagnext)
- seentags = 1;
- next = id->next;
- id->dot = d;
- id->ty = topvartype(verifytypes(id->ty, d, nil), id, 1, 1);
- if(id->store == Dfield && id->ty->kind == Tfn)
- id->store = Dfn;
- if(id->store == Dfn || id->store == Dconst){
- if(store != nil)
- store->next = next;
- else
- t->ids = next;
- if(aux != nil)
- aux->next = id;
- else
- auxhd = id;
- aux = id;
- }else{
- if(seentags)
- error(id->src.start, "pick fields must be the last data fields in an adt");
- store = id;
- }
- }
- if(aux != nil)
- aux->next = nil;
- if(store != nil)
- store->next = auxhd;
- else
- t->ids = auxhd;
- for(id = t->tags; id != nil; id = id->next){
- id->ty = verifytypes(id->ty, d, nil);
- if(id->ty->tof == nil)
- id->ty->tof = mkadtpickcon(t, id->ty);
- }
- }
- /*
- * assemble the data structure for an adt with a pick clause.
- * since the scoping rules for adt pick fields are strange,
- * we have a customized check for overlapping definitions.
- */
- Decl*
- pickdefd(Type *t, Decl *tg)
- {
- Decl *id, *xid, *lasttg, *d;
- Type *tt;
- int tag;
- lasttg = nil;
- d = t->decl;
- t->tags = tg;
- tag = 0;
- while(tg != nil){
- tt = tg->ty;
- if(tt->kind != Tadtpick || tg->tag != tag)
- break;
- tt->decl = tg;
- lasttg = tg;
- for(; tg != nil; tg = tg->next){
- if(tg->ty != tt)
- break;
- tag++;
- lasttg = tg;
- tg->dot = d;
- }
- for(id = tt->ids; id != nil; id = id->next){
- xid = namedot(t->ids, id->sym);
- if(xid != nil)
- error(id->src.start, "redeclaration of %K, previously declared as %k on line %L",
- id, xid, xid->src.start);
- id->dot = d;
- }
- }
- if(lasttg == nil){
- error(t->src.start, "empty pick field declaration in %T", t);
- t->tags = nil;
- }else
- lasttg->next = nil;
- d->tag = tag;
- return tg;
- }
- Node*
- moddecl(Decl *ids, Node *fields)
- {
- Node *n;
- Type *t;
- n = mkn(Omoddecl, mkn(Oseq, nil, nil), nil);
- t = mktype(&ids->src.start, &ids->src.stop, Tmodule, nil, nil);
- n->decl = ids;
- n->left = fields;
- n->ty = t;
- return n;
- }
- void
- moddecled(Node *n)
- {
- Decl *d, *ids, *im, *dot;
- Type *t;
- Sym *s;
- char buf[StrSize];
- int isimp;
- Dlist *dm, *dl;
- d = n->decl;
- installids(Dtype, d);
- isimp = 0;
- for(ids = d; ids != nil; ids = ids->next){
- for(im = impmods; im != nil; im = im->next){
- if(ids->sym == im->sym){
- isimp = 1;
- d = ids;
- dm = malloc(sizeof(Dlist));
- dm->d = ids;
- dm->next = nil;
- if(impdecls == nil)
- impdecls = dm;
- else{
- for(dl = impdecls; dl->next != nil; dl = dl->next)
- ;
- dl->next = dm;
- }
- }
- }
- ids->ty = n->ty;
- }
- pushscope(nil, Sother);
- fielddecled(n->left);
- d->ty->ids = popscope();
- /*
- * make the current module the -> parent of all contained decls->
- */
- for(ids = d->ty->ids; ids != nil; ids = ids->next)
- ids->dot = d;
- t = d->ty;
- t->decl = d;
- if(debug['m'])
- print("declare module %s\n", d->sym->name);
- /*
- * add the iface declaration in case it's needed later
- */
- seprint(buf, buf+sizeof(buf), ".m.%s", d->sym->name);
- installids(Dglobal, mkids(&d->src, enter(buf, 0), tnone, nil));
- if(isimp){
- for(ids = d->ty->ids; ids != nil; ids = ids->next){
- s = ids->sym;
- if(s->decl != nil && s->decl->scope >= scope){
- dot = s->decl->dot;
- if(s->decl->store != Dwundef && dot != nil && dot != d && isimpmod(dot->sym) && dequal(ids, s->decl, 0))
- continue;
- redecl(ids);
- ids->old = s->decl->old;
- }else
- ids->old = s->decl;
- s->decl = ids;
- ids->scope = scope;
- }
- }
- }
- /*
- * for each module in id,
- * link by field ext all of the decls for
- * functions needed in external linkage table
- * collect globals and make a tuple for all of them
- */
- Type*
- mkiface(Decl *m)
- {
- Decl *iface, *last, *globals, *glast, *id, *d;
- Type *t;
- char buf[StrSize];
- iface = last = allocmem(sizeof(Decl));
- globals = glast = mkdecl(&m->src, Dglobal, mktype(&m->src.start, &m->src.stop, Tadt, nil, nil));
- for(id = m->ty->ids; id != nil; id = id->next){
- switch(id->store){
- case Dglobal:
- glast = glast->next = dupdecl(id);
- id->iface = globals;
- glast->iface = id;
- break;
- case Dfn:
- id->iface = last = last->next = dupdecl(id);
- last->iface = id;
- break;
- case Dtype:
- if(id->ty->kind != Tadt)
- break;
- for(d = id->ty->ids; d != nil; d = d->next){
- if(d->store == Dfn){
- d->iface = last = last->next = dupdecl(d);
- last->iface = d;
- }
- }
- break;
- }
- }
- last->next = nil;
- iface = namesort(iface->next);
- if(globals->next != nil){
- glast->next = nil;
- globals->ty->ids = namesort(globals->next);
- globals->ty->decl = globals;
- globals->sym = enter(".mp", 0);
- globals->dot = m;
- globals->next = iface;
- iface = globals;
- }
- /*
- * make the interface type and install an identifier for it
- * the iface has a ref count if it is loaded
- */
- t = mktype(&m->src.start, &m->src.stop, Tiface, nil, iface);
- seprint(buf, buf+sizeof(buf), ".m.%s", m->sym->name);
- id = enter(buf, 0)->decl;
- t->decl = id;
- id->ty = t;
- /*
- * dummy node so the interface is initialized
- */
- id->init = mkn(Onothing, nil, nil);
- id->init->ty = t;
- id->init->decl = id;
- return t;
- }
- void
- joiniface(Type *mt, Type *t)
- {
- Decl *id, *d, *iface, *globals;
- iface = t->ids;
- globals = iface;
- if(iface != nil && iface->store == Dglobal)
- iface = iface->next;
- for(id = mt->tof->ids; id != nil; id = id->next){
- switch(id->store){
- case Dglobal:
- for(d = id->ty->ids; d != nil; d = d->next)
- d->iface->iface = globals;
- break;
- case Dfn:
- id->iface->iface = iface;
- iface = iface->next;
- break;
- default:
- fatal("unknown store %k in joiniface", id);
- break;
- }
- }
- if(iface != nil)
- fatal("join iface not matched");
- mt->tof = t;
- }
- void
- addiface(Decl *m, Decl *d)
- {
- Type *t;
- Decl *id, *last, *dd, *lastorig;
- Dlist *dl;
- if(d == nil || !local(d))
- return;
- modrefable(d->ty);
- if(m == nil){
- if(impdecls->next != nil)
- for(dl = impdecls; dl != nil; dl = dl->next)
- if(dl->d->ty->tof != impdecl->ty->tof) /* impdecl last */
- addiface(dl->d, d);
- addiface(impdecl, d);
- return;
- }
- t = m->ty->tof;
- last = nil;
- lastorig = nil;
- for(id = t->ids; id != nil; id = id->next){
- if(d == id || d == id->iface)
- return;
- last = id;
- if(id->tag == 0)
- lastorig = id;
- }
- dd = dupdecl(d);
- if(d->dot == nil)
- d->dot = dd->dot = m;
- d->iface = dd;
- dd->iface = d;
- if(debug['v']) print("addiface %p %p\n", d, dd);
- if(last == nil)
- t->ids = dd;
- else
- last->next = dd;
- dd->tag = 1; /* mark so not signed */
- if(lastorig == nil)
- t->ids = namesort(t->ids);
- else
- lastorig->next = namesort(lastorig->next);
- }
- /*
- * eliminate unused declarations from interfaces
- * label offset within interface
- */
- void
- narrowmods(void)
- {
- Teq *eq;
- Decl *id, *last;
- Type *t;
- long offset;
- for(eq = modclass(); eq != nil; eq = eq->eq){
- t = eq->ty->tof;
- if(t->linkall == 0){
- last = nil;
- for(id = t->ids; id != nil; id = id->next){
- if(id->refs == 0){
- if(last == nil)
- t->ids = id->next;
- else
- last->next = id->next;
- }else
- last = id;
- }
- /*
- * need to resize smaller interfaces
- */
- resizetype(t);
- }
- offset = 0;
- for(id = t->ids; id != nil; id = id->next)
- id->offset = offset++;
- /*
- * rathole to stuff number of entries in interface
- */
- t->decl->init->val = offset;
- }
- }
- /*
- * check to see if any data field of module m if referenced.
- * if so, mark all data in m
- */
- void
- moddataref(void)
- {
- Teq *eq;
- Decl *id;
- for(eq = modclass(); eq != nil; eq = eq->eq){
- id = eq->ty->tof->ids;
- if(id != nil && id->store == Dglobal && id->refs)
- for(id = eq->ty->ids; id != nil; id = id->next)
- if(id->store == Dglobal)
- modrefable(id->ty);
- }
- }
- /*
- * move the global declarations in interface to the front
- */
- Decl*
- modglobals(Decl *mod, Decl *globals)
- {
- Decl *id, *head, *last;
- /*
- * make a copy of all the global declarations
- * used for making a type descriptor for globals ONLY
- * note we now have two declarations for the same variables,
- * which is apt to cause problems if code changes
- *
- * here we fix up the offsets for the real declarations
- */
- idoffsets(mod->ty->ids, 0, 1);
- last = head = allocmem(sizeof(Decl));
- for(id = mod->ty->ids; id != nil; id = id->next)
- if(id->store == Dglobal)
- last = last->next = dupdecl(id);
- last->next = globals;
- return head->next;
- }
- /*
- * snap all id type names to the actual type
- * check that all types are completely defined
- * verify that the types look ok
- */
- Type*
- validtype(Type *t, Decl *inadt)
- {
- if(t == nil)
- return t;
- bindtypes(t);
- t = verifytypes(t, inadt, nil);
- cycsizetype(t);
- teqclass(t);
- return t;
- }
- Type*
- usetype(Type *t)
- {
- if(t == nil)
- return t;
- t = validtype(t, nil);
- reftype(t);
- return t;
- }
- Type*
- internaltype(Type *t)
- {
- bindtypes(t);
- t->ok = OKverify;
- sizetype(t);
- t->ok = OKmask;
- return t;
- }
- /*
- * checks that t is a valid top-level type
- */
- Type*
- topvartype(Type *t, Decl *id, int tyok, int polyok)
- {
- if(t->kind == Tadt && t->tags != nil || t->kind == Tadtpick)
- error(id->src.start, "cannot declare %s with type %T", id->sym->name, t);
- if(!tyok && t->kind == Tfn)
- error(id->src.start, "cannot declare %s to be a function", id->sym->name);
- if(!polyok && (t->kind == Tadt || t->kind == Tadtpick) && ispolyadt(t))
- error(id->src.start, "cannot declare %s of a polymorphic type", id->sym->name);
- return t;
- }
- Type*
- toptype(Src *src, Type *t)
- {
- if(t->kind == Tadt && t->tags != nil || t->kind == Tadtpick)
- error(src->start, "%T, an adt with pick fields, must be used with ref", t);
- if(t->kind == Tfn)
- error(src->start, "data cannot have a fn type like %T", t);
- return t;
- }
- static Type*
- comtype(Src *src, Type *t, Decl* adtd)
- {
- if(adtd == nil && (t->kind == Tadt || t->kind == Tadtpick) && ispolyadt(t))
- error(src->start, "polymorphic type %T illegal here", t);
- return t;
- }
- void
- usedty(Type *t)
- {
- if(t != nil && (t->ok | OKmodref) != OKmask)
- fatal("used ty %t %2.2ux", t, t->ok);
- }
- void
- bindtypes(Type *t)
- {
- Decl *id;
- Typelist *tl;
- if(t == nil)
- return;
- if((t->ok & OKbind) == OKbind)
- return;
- t->ok |= OKbind;
- switch(t->kind){
- case Tadt:
- if(t->polys != nil){
- pushscope(nil, Sother);
- installids(Dtype, t->polys);
- }
- if(t->val != nil)
- mergepolydecs(t);
- if(t->polys != nil){
- popscope();
- for(id = t->polys; id != nil; id = id->next)
- bindtypes(id->ty);
- }
- break;
- case Tadtpick:
- case Tmodule:
- case Terror:
- case Tint:
- case Tbig:
- case Tstring:
- case Treal:
- case Tbyte:
- case Tnone:
- case Tany:
- case Tiface:
- case Tainit:
- case Talt:
- case Tcase:
- case Tcasel:
- case Tcasec:
- case Tgoto:
- case Texcept:
- case Tfix:
- case Tpoly:
- break;
- case Tarray:
- case Tarrow:
- case Tchan:
- case Tdot:
- case Tlist:
- case Tref:
- bindtypes(t->tof);
- break;
- case Tid:
- id = t->decl->sym->decl;
- if(id == nil)
- id = undefed(&t->src, t->decl->sym);
- /* save a little space */
- id->sym->unbound = nil;
- t->decl = id;
- break;
- case Ttuple:
- case Texception:
- for(id = t->ids; id != nil; id = id->next)
- bindtypes(id->ty);
- break;
- case Tfn:
- if(t->polys != nil){
- pushscope(nil, Sother);
- installids(Dtype, t->polys);
- }
- for(id = t->ids; id != nil; id = id->next)
- bindtypes(id->ty);
- bindtypes(t->tof);
- if(t->val != nil)
- mergepolydecs(t);
- if(t->polys != nil){
- popscope();
- for(id = t->polys; id != nil; id = id->next)
- bindtypes(id->ty);
- }
- break;
- case Tinst:
- bindtypes(t->tof);
- for(tl = t->u.tlist; tl != nil; tl = tl->nxt)
- bindtypes(tl->t);
- break;
- default:
- fatal("bindtypes: unknown type kind %d", t->kind);
- }
- }
- /*
- * walk the type checking for validity
- */
- Type*
- verifytypes(Type *t, Decl *adtt, Decl *poly)
- {
- Node *n;
- Decl *id, *id1, *last;
- char buf[32];
- int i, cyc;
- Ok ok, ok1;
- double max;
- Typelist *tl;
- if(t == nil)
- return nil;
- if((t->ok & OKverify) == OKverify)
- return t;
- t->ok |= OKverify;
- if((t->ok & (OKverify|OKbind)) != (OKverify|OKbind))
- fatal("verifytypes bogus ok for %t", t);
- cyc = t->flags&CYCLIC;
- switch(t->kind){
- case Terror:
- case Tint:
- case Tbig:
- case Tstring:
- case Treal:
- case Tbyte:
- case Tnone:
- case Tany:
- case Tiface:
- case Tainit:
- case Talt:
- case Tcase:
- case Tcasel:
- case Tcasec:
- case Tgoto:
- case Texcept:
- break;
- case Tfix:
- n = t->val;
- max = 0.0;
- if(n->op == Oseq){
- ok = echeck(n->left, 0, 0, n);
- ok1 = echeck(n->right, 0, 0, n);
- if(!ok.ok || !ok1.ok)
- return terror;
- if(n->left->ty != treal || n->right->ty != treal){
- error(t->src.start, "fixed point scale/maximum not real");
- return terror;
- }
- n->right = fold(n->right);
- if(n->right->op != Oconst){
- error(t->src.start, "fixed point maximum not constant");
- return terror;
- }
- if((max = n->right->rval) <= 0){
- error(t->src.start, "non-positive fixed point maximum");
- return terror;
- }
- n = n->left;
- }
- else{
- ok = echeck(n, 0, 0, nil);
- if(!ok.ok)
- return terror;
- if(n->ty != treal){
- error(t->src.start, "fixed point scale not real");
- return terror;
- }
- }
- n = t->val = fold(n);
- if(n->op != Oconst){
- error(t->src.start, "fixed point scale not constant");
- return terror;
- }
- if(n->rval <= 0){
- error(t->src.start, "non-positive fixed point scale");
- return terror;
- }
- ckfix(t, max);
- break;
- case Tref:
- t->tof = comtype(&t->src, verifytypes(t->tof, adtt, nil), adtt);
- if(t->tof != nil && !tattr[t->tof->kind].refable){
- error(t->src.start, "cannot have a ref %T", t->tof);
- return terror;
- }
- if(0 && t->tof->kind == Tfn && t->tof->ids != nil && t->tof->ids->implicit)
- error(t->src.start, "function references cannot have a self argument");
- if(0 && t->tof->kind == Tfn && t->polys != nil)
- error(t->src.start, "function references cannot be polymorphic");
- break;
- case Tchan:
- case Tarray:
- case Tlist:
- t->tof = comtype(&t->src, toptype(&t->src, verifytypes(t->tof, adtt, nil)), adtt);
- break;
- case Tid:
- t->ok &= ~OKverify;
- t = verifytypes(idtype(t), adtt, nil);
- break;
- case Tarrow:
- t->ok &= ~OKverify;
- t = verifytypes(arrowtype(t, adtt), adtt, nil);
- break;
- case Tdot:
- /*
- * verify the parent adt & lookup the tag fields
- */
- t->ok &= ~OKverify;
- t = verifytypes(dottype(t, adtt), adtt, nil);
- break;
- case Tadt:
- /*
- * this is where Tadt may get tag fields added
- */
- adtdefd(t);
- break;
- case Tadtpick:
- for(id = t->ids; id != nil; id = id->next){
- id->ty = topvartype(verifytypes(id->ty, id->dot, nil), id, 0, 1);
- if(id->store == Dconst)
- error(t->src.start, "pick fields cannot be a con like %s", id->sym->name);
- }
- verifytypes(t->decl->dot->ty, nil, nil);
- break;
- case Tmodule:
- for(id = t->ids; id != nil; id = id->next){
- id->ty = verifytypes(id->ty, nil, nil);
- if(id->store == Dglobal && id->ty->kind == Tfn)
- id->store = Dfn;
- if(id->store != Dtype && id->store != Dfn)
- topvartype(id->ty, id, 0, 0);
- }
- break;
- case Ttuple:
- case Texception:
- if(t->decl == nil){
- t->decl = mkdecl(&t->src, Dtype, t);
- t->decl->sym = enter(".tuple", 0);
- }
- i = 0;
- for(id = t->ids; id != nil; id = id->next){
- id->store = Dfield;
- if(id->sym == nil){
- seprint(buf, buf+sizeof(buf), "t%d", i);
- id->sym = enter(buf, 0);
- }
- i++;
- id->ty = toptype(&id->src, verifytypes(id->ty, adtt, nil));
- /* id->ty = comtype(&id->src, toptype(&id->src, verifytypes(id->ty, adtt, nil)), adtt); */
- }
- break;
- case Tfn:
- last = nil;
- for(id = t->ids; id != nil; id = id->next){
- id->store = Darg;
- id->ty = topvartype(verifytypes(id->ty, adtt, nil), id, 0, 1);
- if(id->implicit){
- Decl *selfd;
- selfd = poly ? poly : adtt;
- if(selfd == nil)
- error(t->src.start, "function is not a member of an adt, so can't use self");
- else if(id != t->ids)
- error(id->src.start, "only the first argument can use self");
- else if(id->ty != selfd->ty && (id->ty->kind != Tref || id->ty->tof != selfd->ty))
- error(id->src.start, "self argument's type must be %s or ref %s",
- selfd->sym->name, selfd->sym->name);
- }
- last = id;
- }
- for(id = t->polys; id != nil; id = id->next){
- if(adtt != nil){
- for(id1 = adtt->ty->polys; id1 != nil; id1 = id1->next){
- if(id1->sym == id->sym)
- id->ty = id1->ty;
- }
- }
- id->store = Dtype;
- id->ty = verifytypes(id->ty, adtt, nil);
- }
- t->tof = comtype(&t->src, toptype(&t->src, verifytypes(t->tof, adtt, nil)), adtt);
- if(t->varargs && (last == nil || last->ty != tstring))
- error(t->src.start, "variable arguments must be preceded by a string");
- if(t->varargs && t->polys != nil)
- error(t->src.start, "polymorphic functions must not have variable arguments");
- break;
- case Tpoly:
- for(id = t->ids; id != nil; id = id->next){
- id->store = Dfn;
- id->ty = verifytypes(id->ty, adtt, t->decl);
- }
- break;
- case Tinst:
- t->ok &= ~OKverify;
- t->tof = verifytypes(t->tof, adtt, nil);
- for(tl = t->u.tlist; tl != nil; tl = tl->nxt)
- tl->t = verifytypes(tl->t, adtt, nil);
- t = verifytypes(insttype(t, adtt, nil), adtt, nil);
- break;
- default:
- fatal("verifytypes: unknown type kind %d", t->kind);
- }
- if(cyc)
- t->flags |= CYCLIC;
- return t;
- }
- /*
- * resolve an id type
- */
- Type*
- idtype(Type *t)
- {
- Decl *id;
- Type *tt;
- id = t->decl;
- if(id->store == Dunbound)
- fatal("idtype: unbound decl");
- tt = id->ty;
- if(id->store != Dtype && id->store != Dtag){
- if(id->store == Dundef){
- id->store = Dwundef;
- error(t->src.start, "%s is not declared", id->sym->name);
- }else if(id->store == Dimport){
- id->store = Dwundef;
- error(t->src.start, "%s's type cannot be determined", id->sym->name);
- }else if(id->store != Dwundef)
- error(t->src.start, "%s is not a type", id->sym->name);
- return terror;
- }
- if(tt == nil){
- error(t->src.start, "%t not fully defined", t);
- return terror;
- }
- return tt;
- }
- /*
- * resolve a -> qualified type
- */
- Type*
- arrowtype(Type *t, Decl *adtt)
- {
- Type *tt;
- Decl *id;
- id = t->decl;
- if(id->ty != nil){
- if(id->store == Dunbound)
- fatal("arrowtype: unbound decl has a type");
- return id->ty;
- }
- /*
- * special hack to allow module variables to derive other types
- */
- tt = t->tof;
- if(tt->kind == Tid){
- id = tt->decl;
- if(id->store == Dunbound)
- fatal("arrowtype: Tid's decl unbound");
- if(id->store == Dimport){
- id->store = Dwundef;
- error(t->src.start, "%s's type cannot be determined", id->sym->name);
- return terror;
- }
- /*
- * forward references to module variables can't be resolved
- */
- if(id->store != Dtype && !(id->ty->ok & OKbind)){
- error(t->src.start, "%s's type cannot be determined", id->sym->name);
- return terror;
- }
- if(id->store == Dwundef)
- return terror;
- tt = id->ty = verifytypes(id->ty, adtt, nil);
- if(tt == nil){
- error(t->tof->src.start, "%T is not a module", t->tof);
- return terror;
- }
- }else
- tt = verifytypes(t->tof, adtt, nil);
- t->tof = tt;
- if(tt == terror)
- return terror;
- if(tt->kind != Tmodule){
- error(t->src.start, "%T is not a module", tt);
- return terror;
- }
- id = namedot(tt->ids, t->decl->sym);
- if(id == nil){
- error(t->src.start, "%s is not a member of %T", t->decl->sym->name, tt);
- return terror;
- }
- if(id->store == Dtype && id->ty != nil){
- t->decl = id;
- return id->ty;
- }
- error(t->src.start, "%T is not a type", t);
- return terror;
- }
- /*
- * resolve a . qualified type
- */
- Type*
- dottype(Type *t, Decl *adtt)
- {
- Type *tt;
- Decl *id;
- if(t->decl->ty != nil){
- if(t->decl->store == Dunbound)
- fatal("dottype: unbound decl has a type");
- return t->decl->ty;
- }
- t->tof = tt = verifytypes(t->tof, adtt, nil);
- if(tt == terror)
- return terror;
- if(tt->kind != Tadt){
- error(t->src.start, "%T is not an adt", tt);
- return terror;
- }
- id = namedot(tt->tags, t->decl->sym);
- if(id != nil && id->ty != nil){
- t->decl = id;
- return id->ty;
- }
- error(t->src.start, "%s is not a pick tag of %T", t->decl->sym->name, tt);
- return terror;
- }
- Type*
- insttype(Type *t, Decl *adtt, Tpair **tp)
- {
- Type *tt;
- Typelist *tl;
- Decl *ids;
- Tpair *tp1, *tp2;
- Src src;
- src = t->src;
- if(tp == nil){
- tp2 = nil;
- tp = &tp2;
- }
- if(t->tof->kind != Tadt && t->tof->kind != Tadtpick){
- error(src.start, "%T is not an adt", t->tof);
- return terror;
- }
- if(t->tof->kind == Tadt)
- ids = t->tof->polys;
- else
- ids = t->tof->decl->dot->ty->polys;
- if(ids == nil){
- error(src.start, "%T is not a polymorphic adt", t->tof);
- return terror;
- }
- for(tl = t->u.tlist; tl != nil && ids != nil; tl = tl->nxt, ids = ids->next){
- tt = tl->t;
- if(!tattr[tt->kind].isptr){
- error(src.start, "%T is not a pointer type", tt);
- return terror;
- }
- unifysrc = src;
- if(!tunify(ids->ty, tt, &tp1)){
- error(src.start, "type %T does not match %T", tt, ids->ty);
- return terror;
- }
- /* usetype(tt); */
- tt = verifytypes(tt, adtt, nil);
- addtmap(ids->ty, tt, tp);
- }
- if(tl != nil){
- error(src.start, "too many actual types in instantiation");
- return terror;
- }
- if(ids != nil){
- error(src.start, "too few actual types in instantiation");
- return terror;
- }
- tp1 = *tp;
- tt = t->tof;
- t = expandtype(tt, t, adtt, tp);
- if(t == tt && adtt == nil)
- t = duptype(t);
- if(t != tt){
- t->u.tmap = tp1;
- if(debug['w']){
- print("tmap for %T: ", t);
- for( ; tp1!=nil; tp1=tp1->nxt)
- print("%T -> %T ", tp1->t1, tp1->t2);
- print("\n");
- }
- }
- t->src = src;
- return t;
- }
- /*
- * walk a type, putting all adts, modules, and tuples into equivalence classes
- */
- void
- teqclass(Type *t)
- {
- Decl *id, *tg;
- Teq *teq;
- if(t == nil || (t->ok & OKclass) == OKclass)
- return;
- t->ok |= OKclass;
- switch(t->kind){
- case Terror:
- case Tint:
- case Tbig:
- case Tstring:
- case Treal:
- case Tbyte:
- case Tnone:
- case Tany:
- case Tiface:
- case Tainit:
- case Talt:
- case Tcase:
- case Tcasel:
- case Tcasec:
- case Tgoto:
- case Texcept:
- case Tfix:
- case Tpoly:
- return;
- case Tref:
- teqclass(t->tof);
- return;
- case Tchan:
- case Tarray:
- case Tlist:
- teqclass(t->tof);
- if(!debug['Z'])
- return;
- break;
- case Tadt:
- case Tadtpick:
- case Ttuple:
- case Texception:
- for(id = t->ids; id != nil; id = id->next)
- teqclass(id->ty);
- for(tg = t->tags; tg != nil; tg = tg->next)
- teqclass(tg->ty);
- for(id = t->polys; id != nil; id = id->next)
- teqclass(id->ty);
- break;
- case Tmodule:
- t->tof = mkiface(t->decl);
- for(id = t->ids; id != nil; id = id->next)
- teqclass(id->ty);
- break;
- case Tfn:
- for(id = t->ids; id != nil; id = id->next)
- teqclass(id->ty);
- for(id = t->polys; id != nil; id = id->next)
- teqclass(id->ty);
- teqclass(t->tof);
- return;
- default:
- fatal("teqclass: unknown type kind %d", t->kind);
- return;
- }
- /*
- * find an equivalent type
- * stupid linear lookup could be made faster
- */
- if((t->ok & OKsized) != OKsized)
- fatal("eqclass type not sized: %t", t);
- for(teq = eqclass[t->kind]; teq != nil; teq = teq->eq){
- if(t->size == teq->ty->size && tequal(t, teq->ty)){
- t->eq = teq;
- if(t->kind == Tmodule)
- joiniface(t, t->eq->ty->tof);
- return;
- }
- }
- /*
- * if no equiv type, make one
- */
- t->eq = allocmem(sizeof(Teq));
- t->eq->id = 0;
- t->eq->ty = t;
- t->eq->eq = eqclass[t->kind];
- eqclass[t->kind] = t->eq;
- }
- /*
- * record that we've used the type
- * using a type uses all types reachable from that type
- */
- void
- reftype(Type *t)
- {
- Decl *id, *tg;
- if(t == nil || (t->ok & OKref) == OKref)
- return;
- t->ok |= OKref;
- if(t->decl != nil && t->decl->refs == 0)
- t->decl->refs++;
- switch(t->kind){
- case Terror:
- case Tint:
- case Tbig:
- case Tstring:
- case Treal:
- case Tbyte:
- case Tnone:
- case Tany:
- case Tiface:
- case Tainit:
- case Talt:
- case Tcase:
- case Tcasel:
- case Tcasec:
- case Tgoto:
- case Texcept:
- case Tfix:
- case Tpoly:
- break;
- case Tref:
- case Tchan:
- case Tarray:
- case Tlist:
- if(t->decl != nil){
- if(nadts >= lenadts){
- lenadts = nadts + 32;
- adts = reallocmem(adts, lenadts * sizeof *adts);
- }
- adts[nadts++] = t->decl;
- }
- reftype(t->tof);
- break;
- case Tadt:
- case Tadtpick:
- case Ttuple:
- case Texception:
- if(t->kind == Tadt || t->kind == Ttuple && t->decl->sym != anontupsym){
- if(nadts >= lenadts){
- lenadts = nadts + 32;
- adts = reallocmem(adts, lenadts * sizeof *adts);
- }
- adts[nadts++] = t->decl;
- }
- for(id = t->ids; id != nil; id = id->next)
- if(id->store != Dfn)
- reftype(id->ty);
- for(tg = t->tags; tg != nil; tg = tg->next)
- reftype(tg->ty);
- for(id = t->polys; id != nil; id = id->next)
- reftype(id->ty);
- if(t->kind == Tadtpick)
- reftype(t->decl->dot->ty);
- break;
- case Tmodule:
- /*
- * a module's elements should get used individually
- * but do the globals for any sbl file
- */
- if(bsym != nil)
- for(id = t->ids; id != nil; id = id->next)
- if(id->store == Dglobal)
- reftype(id->ty);
- break;
- case Tfn:
- for(id = t->ids; id != nil; id = id->next)
- reftype(id->ty);
- for(id = t->polys; id != nil; id = id->next)
- reftype(id->ty);
- reftype(t->tof);
- break;
- default:
- fatal("reftype: unknown type kind %d", t->kind);
- break;
- }
- }
- /*
- * check all reachable types for cycles and illegal forward references
- * find the size of all the types
- */
- void
- cycsizetype(Type *t)
- {
- Decl *id, *tg;
- if(t == nil || (t->ok & (OKcycsize|OKcyc|OKsized)) == (OKcycsize|OKcyc|OKsized))
- return;
- t->ok |= OKcycsize;
- switch(t->kind){
- case Terror:
- case Tint:
- case Tbig:
- case Tstring:
- case Treal:
- case Tbyte:
- case Tnone:
- case Tany:
- case Tiface:
- case Tainit:
- case Talt:
- case Tcase:
- case Tcasel:
- case Tcasec:
- case Tgoto:
- case Texcept:
- case Tfix:
- case Tpoly:
- t->ok |= OKcyc;
- sizetype(t);
- break;
- case Tref:
- case Tchan:
- case Tarray:
- case Tlist:
- cyctype(t);
- sizetype(t);
- cycsizetype(t->tof);
- break;
- case Tadt:
- case Ttuple:
- case Texception:
- cyctype(t);
- sizetype(t);
- for(id = t->ids; id != nil; id = id->next)
- cycsizetype(id->ty);
- for(tg = t->tags; tg != nil; tg = tg->next){
- if((tg->ty->ok & (OKcycsize|OKcyc|OKsized)) == (OKcycsize|OKcyc|OKsized))
- continue;
- tg->ty->ok |= (OKcycsize|OKcyc|OKsized);
- for(id = tg->ty->ids; id != nil; id = id->next)
- cycsizetype(id->ty);
- }
- for(id = t->polys; id != nil; id = id->next)
- cycsizetype(id->ty);
- break;
- case Tadtpick:
- t->ok &= ~OKcycsize;
- cycsizetype(t->decl->dot->ty);
- break;
- case Tmodule:
- cyctype(t);
- sizetype(t);
- for(id = t->ids; id != nil; id = id->next)
- cycsizetype(id->ty);
- sizeids(t->ids, 0);
- break;
- case Tfn:
- cyctype(t);
- sizetype(t);
- for(id = t->ids; id != nil; id = id->next)
- cycsizetype(id->ty);
- for(id = t->polys; id != nil; id = id->next)
- cycsizetype(id->ty);
- cycsizetype(t->tof);
- sizeids(t->ids, MaxTemp);
- break;
- default:
- fatal("cycsizetype: unknown type kind %d", t->kind);
- break;
- }
- }
- /* check for circularity in type declarations
- * - has to be called before verifytypes
- */
- void
- tcycle(Type *t)
- {
- Decl *id;
- Type *tt;
- Typelist *tl;
- if(t == nil)
- return;
- switch(t->kind){
- default:
- break;
- case Tchan:
- case Tarray:
- case Tref:
- case Tlist:
- case Tdot:
- tcycle(t->tof);
- break;
- case Tfn:
- case Ttuple:
- tcycle(t->tof);
- for(id = t->ids; id != nil; id = id->next)
- tcycle(id->ty);
- break;
- case Tarrow:
- if(t->rec&TRvis){
- error(t->src.start, "circularity in definition of %T", t);
- *t = *terror; /* break the cycle */
- return;
- }
- tt = t->tof;
- t->rec |= TRvis;
- tcycle(tt);
- if(tt->kind == Tid)
- tt = tt->decl->ty;
- id = namedot(tt->ids, t->decl->sym);
- if(id != nil)
- tcycle(id->ty);
- t->rec &= ~TRvis;
- break;
- case Tid:
- if(t->rec&TRvis){
- error(t->src.start, "circularity in definition of %T", t);
- *t = *terror; /* break the cycle */
- return;
- }
- t->rec |= TRvis;
- tcycle(t->decl->ty);
- t->rec &= ~TRvis;
- break;
- case Tinst:
- tcycle(t->tof);
- for(tl = t->u.tlist; tl != nil; tl = tl->nxt)
- tcycle(tl->t);
- break;
- }
- }
- /*
- * marks for checking for arcs
- */
- enum
- {
- ArcValue = 1 << 0,
- ArcList = 1 << 1,
- ArcArray = 1 << 2,
- ArcRef = 1 << 3,
- ArcCyc = 1 << 4, /* cycle found */
- ArcPolycyc = 1 << 5,
- };
- void
- cyctype(Type *t)
- {
- Decl *id, *tg;
- if((t->ok & OKcyc) == OKcyc)
- return;
- t->ok |= OKcyc;
- t->rec |= TRcyc;
- switch(t->kind){
- case Terror:
- case Tint:
- case Tbig:
- case Tstring:
- case Treal:
- case Tbyte:
- case Tnone:
- case Tany:
- case Tfn:
- case Tchan:
- case Tarray:
- case Tref:
- case Tlist:
- case Tfix:
- case Tpoly:
- break;
- case Tadt:
- case Tmodule:
- case Ttuple:
- case Texception:
- for(id = t->ids; id != nil; id = id->next)
- cycfield(t, id);
- for(tg = t->tags; tg != nil; tg = tg->next){
- if((tg->ty->ok & OKcyc) == OKcyc)
- continue;
- tg->ty->ok |= OKcyc;
- for(id = tg->ty->ids; id != nil; id = id->next)
- cycfield(t, id);
- }
- break;
- default:
- fatal("checktype: unknown type kind %d", t->kind);
- break;
- }
- t->rec &= ~TRcyc;
- }
- void
- cycfield(Type *base, Decl *id)
- {
- int arc;
- if(!storespace[id->store])
- return;
- arc = cycarc(base, id->ty);
- if((arc & (ArcCyc|ArcValue)) == (ArcCyc|ArcValue)){
- if(id->cycerr == 0)
- error(base->src.start, "illegal type cycle without a reference in field %s of %t",
- id->sym->name, base);
- id->cycerr = 1;
- }else if(arc & ArcCyc){
- if((arc & ArcArray) && id->cyc == 0 && !(arc & ArcPolycyc)){
- if(id->cycerr == 0)
- error(base->src.start, "illegal circular reference to type %T in field %s of %t",
- id->ty, id->sym->name, base);
- id->cycerr = 1;
- }
- id->cycle = 1;
- }else if(id->cyc != 0){
- if(id->cycerr == 0)
- error(id->src.start, "spurious cyclic qualifier for field %s of %t", id->sym->name, base);
- id->cycerr = 1;
- }
- }
- int
- cycarc(Type *base, Type *t)
- {
- Decl *id, *tg;
- int me, arc;
- if(t == nil)
- return 0;
- if(t->rec & TRcyc){
- if(tequal(t, base)){
- if(t->kind == Tmodule)
- return ArcCyc | ArcRef;
- else
- return ArcCyc | ArcValue;
- }
- return 0;
- }
- t->rec |= TRcyc;
- me = 0;
- switch(t->kind){
- case Terror:
- case Tint:
- case Tbig:
- case Tstring:
- case Treal:
- case Tbyte:
- case Tnone:
- case Tany:
- case Tchan:
- case Tfn:
- case Tfix:
- case Tpoly:
- break;
- case Tarray:
- me = cycarc(base, t->tof) & ~ArcValue | ArcArray;
- break;
- case Tref:
- me = cycarc(base, t->tof) & ~ArcValue | ArcRef;
- break;
- case Tlist:
- me = cycarc(base, t->tof) & ~ArcValue | ArcList;
- break;
- case Tadt:
- case Tadtpick:
- case Tmodule:
- case Ttuple:
- case Texception:
- me = 0;
- for(id = t->ids; id != nil; id = id->next){
- if(!storespace[id->store])
- continue;
- arc = cycarc(base, id->ty);
- if((arc & ArcCyc) && id->cycerr == 0)
- me |= arc;
- }
- for(tg = t->tags; tg != nil; tg = tg->next){
- arc = cycarc(base, tg->ty);
- if((arc & ArcCyc) && tg->cycerr == 0)
- me |= arc;
- }
- if(t->kind == Tmodule)
- me = me & ArcCyc | ArcRef | ArcPolycyc;
- else
- me &= ArcCyc | ArcValue | ArcPolycyc;
- break;
- default:
- fatal("cycarc: unknown type kind %d", t->kind);
- break;
- }
- t->rec &= ~TRcyc;
- if(t->flags&CYCLIC)
- me |= ArcPolycyc;
- return me;
- }
- /*
- * set the sizes and field offsets for t
- * look only as deeply as needed to size this type.
- * cycsize type will clean up the rest.
- */
- void
- sizetype(Type *t)
- {
- Decl *id, *tg;
- Szal szal;
- long sz, al, a;
- if(t == nil)
- return;
- if((t->ok & OKsized) == OKsized)
- return;
- t->ok |= OKsized;
- if((t->ok & (OKverify|OKsized)) != (OKverify|OKsized))
- fatal("sizetype bogus ok for %t", t);
- switch(t->kind){
- default:
- fatal("sizetype: unknown type kind %d", t->kind);
- break;
- case Terror:
- case Tnone:
- case Tbyte:
- case Tint:
- case Tbig:
- case Tstring:
- case Tany:
- case Treal:
- fatal("%T should have a size", t);
- break;
- case Tref:
- case Tchan:
- case Tarray:
- case Tlist:
- case Tmodule:
- case Tfix:
- case Tpoly:
- t->size = t->align = IBY2WD;
- break;
- case Ttuple:
- case Tadt:
- case Texception:
- if(t->tags == nil){
- if(!debug['z']){
- szal = sizeids(t->ids, 0);
- t->size = align(szal.size, szal.align);
- t->align = szal.align;
- }else{
- szal = sizeids(t->ids, 0);
- t->align = IBY2LG;
- t->size = align(szal.size, IBY2LG);
- }
- return;
- }
- if(!debug['z']){
- szal = sizeids(t->ids, IBY2WD);
- sz = szal.size;
- al = szal.align;
- if(al < IBY2WD)
- al = IBY2WD;
- }else{
- szal = sizeids(t->ids, IBY2WD);
- sz = szal.size;
- al = IBY2LG;
- }
- for(tg = t->tags; tg != nil; tg = tg->next){
- if((tg->ty->ok & OKsized) == OKsized)
- continue;
- tg->ty->ok |= OKsized;
- if(!debug['z']){
- szal = sizeids(tg->ty->ids, sz);
- a = szal.align;
- if(a < al)
- a = al;
- tg->ty->size = align(szal.size, a);
- tg->ty->align = a;
- }else{
- szal = sizeids(tg->ty->ids, sz);
- tg->ty->size = align(szal.size, IBY2LG);
- tg->ty->align = IBY2LG;
- }
- }
- break;
- case Tfn:
- t->size = 0;
- t->align = 1;
- break;
- case Tainit:
- t->size = 0;
- t->align = 1;
- break;
- case Talt:
- t->size = t->cse->nlab * 2*IBY2WD + 2*IBY2WD;
- t->align = IBY2WD;
- break;
- case Tcase:
- case Tcasec:
- t->size = t->cse->nlab * 3*IBY2WD + 2*IBY2WD;
- t->align = IBY2WD;
- break;
- case Tcasel:
- t->size = t->cse->nlab * 6*IBY2WD + 3*IBY2WD;
- t->align = IBY2LG;
- break;
- case Tgoto:
- t->size = t->cse->nlab * IBY2WD + IBY2WD;
- if(t->cse->iwild != nil)
- t->size += IBY2WD;
- t->align = IBY2WD;
- break;
- case Tiface:
- sz = IBY2WD;
- for(id = t->ids; id != nil; id = id->next){
- sz = align(sz, IBY2WD) + IBY2WD;
- sz += id->sym->len + 1;
- if(id->dot->ty->kind == Tadt)
- sz += id->dot->sym->len + 1;
- }
- t->size = sz;
- t->align = IBY2WD;
- break;
- case Texcept:
- t->size = 0;
- t->align = IBY2WD;
- break;
- }
- }
- Szal
- sizeids(Decl *id, long off)
- {
- Szal szal;
- int a, al;
- al = 1;
- for(; id != nil; id = id->next){
- if(storespace[id->store]){
- sizetype(id->ty);
- /*
- * alignment can be 0 if we have
- * illegal forward declarations.
- * just patch a; other code will flag an error
- */
- a = id->ty->align;
- if(a == 0)
- a = 1;
- if(a > al)
- al = a;
- off = align(off, a);
- id->offset = off;
- off += id->ty->size;
- }
- }
- szal.size = off;
- szal.align = al;
- return szal;
- }
- long
- align(long off, int align)
- {
- if(align == 0)
- fatal("align 0");
- while(off % align)
- off++;
- return off;
- }
- /*
- * recalculate a type's size
- */
- void
- resizetype(Type *t)
- {
- if((t->ok & OKsized) == OKsized){
- t->ok &= ~OKsized;
- cycsizetype(t);
- }
- }
- /*
- * check if a module is accessable from t
- * if so, mark that module interface
- */
- void
- modrefable(Type *t)
- {
- Decl *id, *m, *tg;
- if(t == nil || (t->ok & OKmodref) == OKmodref)
- return;
- if((t->ok & OKverify) != OKverify)
- fatal("modrefable unused type %t", t);
- t->ok |= OKmodref;
- switch(t->kind){
- case Terror:
- case Tint:
- case Tbig:
- case Tstring:
- case Treal:
- case Tbyte:
- case Tnone:
- case Tany:
- case Tfix:
- case Tpoly:
- break;
- case Tchan:
- case Tref:
- case Tarray:
- case Tlist:
- modrefable(t->tof);
- break;
- case Tmodule:
- t->tof->linkall = 1;
- t->decl->refs++;
- for(id = t->ids; id != nil; id = id->next){
- switch(id->store){
- case Dglobal:
- case Dfn:
- modrefable(id->ty);
- break;
- case Dtype:
- if(id->ty->kind != Tadt)
- break;
- for(m = id->ty->ids; m != nil; m = m->next)
- if(m->store == Dfn)
- modrefable(m->ty);
- break;
- }
- }
- break;
- case Tfn:
- case Tadt:
- case Ttuple:
- case Texception:
- for(id = t->ids; id != nil; id = id->next)
- if(id->store != Dfn)
- modrefable(id->ty);
- for(tg = t->tags; tg != nil; tg = tg->next){
- /*
- if((tg->ty->ok & OKmodref) == OKmodref)
- continue;
- */
- tg->ty->ok |= OKmodref;
- for(id = tg->ty->ids; id != nil; id = id->next)
- modrefable(id->ty);
- }
- for(id = t->polys; id != nil; id = id->next)
- modrefable(id->ty);
- modrefable(t->tof);
- break;
- case Tadtpick:
- modrefable(t->decl->dot->ty);
- break;
- default:
- fatal("unknown type kind %d", t->kind);
- break;
- }
- }
- Desc*
- gendesc(Decl *d, long size, Decl *decls)
- {
- Desc *desc;
- if(debug['D'])
- print("generate desc for %D\n", d);
- if(ispoly(d))
- addfnptrs(d, 0);
- desc = usedesc(mkdesc(size, decls));
- return desc;
- }
- Desc*
- mkdesc(long size, Decl *d)
- {
- uchar *pmap;
- long len, n;
- len = (size+8*IBY2WD-1) / (8*IBY2WD);
- pmap = allocmem(len);
- memset(pmap, 0, len);
- n = descmap(d, pmap, 0);
- if(n >= 0)
- n = n / (8*IBY2WD) + 1;
- else
- n = 0;
- if(n > len)
- fatal("wrote off end of decl map: %ld %ld", n, len);
- return enterdesc(pmap, size, n);
- }
- Desc*
- mktdesc(Type *t)
- {
- Desc *d;
- uchar *pmap;
- long len, n;
- usedty(t);
- if(debug['D'])
- print("generate desc for %T\n", t);
- if(t->decl == nil){
- t->decl = mkdecl(&t->src, Dtype, t);
- t->decl->sym = enter("_mktdesc_", 0);
- }
- if(t->decl->desc != nil)
- return t->decl->desc;
- len = (t->size+8*IBY2WD-1) / (8*IBY2WD);
- pmap = allocmem(len);
- memset(pmap, 0, len);
- n = tdescmap(t, pmap, 0);
- if(n >= 0)
- n = n / (8*IBY2WD) + 1;
- else
- n = 0;
- if(n > len)
- fatal("wrote off end of type map for %T: %ld %ld 0x%2.2ux", t, n, len, t->ok);
- d = enterdesc(pmap, t->size, n);
- t->decl->desc = d;
- if(debug['j']){
- uchar *m, *e;
- print("generate desc for %T\n", t);
- print("\tdesc\t$%d,%lud,\"", d->id, d->size);
- e = d->map + d->nmap;
- for(m = d->map; m < e; m++)
- print("%.2x", *m);
- print("\"\n");
- }
- return d;
- }
- Desc*
- enterdesc(uchar *map, long size, long nmap)
- {
- Desc *d, *last;
- int c;
- last = nil;
- for(d = descriptors; d != nil; d = d->next){
- if(d->size > size || d->size == size && d->nmap > nmap)
- break;
- if(d->size == size && d->nmap == nmap){
- c = memcmp(d->map, map, nmap);
- if(c == 0){
- free(map);
- return d;
- }
- if(c > 0)
- break;
- }
- last = d;
- }
- d = allocmem(sizeof *d);
- d->id = -1;
- d->used = 0;
- d->map = map;
- d->size = size;
- d->nmap = nmap;
- if(last == nil){
- d->next = descriptors;
- descriptors = d;
- }else{
- d->next = last->next;
- last->next = d;
- }
- return d;
- }
- Desc*
- usedesc(Desc *d)
- {
- d->used = 1;
- return d;
- }
- /*
- * create the pointer description byte map for every type in decls
- * each bit corresponds to a word, and is 1 if occupied by a pointer
- * the high bit in the byte maps the first word
- */
- long
- descmap(Decl *decls, uchar *map, long start)
- {
- Decl *d;
- long last, m;
- if(debug['D'])
- print("descmap offset %ld\n", start);
- last = -1;
- for(d = decls; d != nil; d = d->next){
- if(d->store == Dtype && d->ty->kind == Tmodule
- || d->store == Dfn
- || d->store == Dconst)
- continue;
- if(d->store == Dlocal && d->link != nil)
- continue;
- m = tdescmap(d->ty, map, d->offset + start);
- if(debug['D']){
- if(d->sym != nil)
- print("descmap %s type %T offset %ld returns %ld\n",
- d->sym->name, d->ty, d->offset+start, m);
- else
- print("descmap type %T offset %ld returns %ld\n", d->ty, d->offset+start, m);
- }
- if(m >= 0)
- last = m;
- }
- return last;
- }
- long
- tdescmap(Type *t, uchar *map, long offset)
- {
- Label *lab;
- long i, e, m;
- int bit;
- if(t == nil)
- return -1;
- m = -1;
- if(t->kind == Talt){
- lab = t->cse->labs;
- e = t->cse->nlab;
- offset += IBY2WD * 2;
- for(i = 0; i < e; i++){
- if(lab[i].isptr){
- bit = offset / IBY2WD % 8;
- map[offset / (8*IBY2WD)] |= 1 << (7 - bit);
- m = offset;
- }
- offset += 2*IBY2WD;
- }
- return m;
- }
- if(t->kind == Tcasec){
- e = t->cse->nlab;
- offset += IBY2WD;
- for(i = 0; i < e; i++){
- bit = offset / IBY2WD % 8;
- map[offset / (8*IBY2WD)] |= 1 << (7 - bit);
- offset += IBY2WD;
- bit = offset / IBY2WD % 8;
- map[offset / (8*IBY2WD)] |= 1 << (7 - bit);
- m = offset;
- offset += 2*IBY2WD;
- }
- return m;
- }
- if(tattr[t->kind].isptr){
- bit = offset / IBY2WD % 8;
- map[offset / (8*IBY2WD)] |= 1 << (7 - bit);
- return offset;
- }
- if(t->kind == Tadtpick)
- t = t->tof;
- if(t->kind == Ttuple || t->kind == Tadt || t->kind == Texception){
- if(debug['D'])
- print("descmap adt offset %ld\n", offset);
- if(t->rec != 0)
- fatal("illegal cyclic type %t in tdescmap", t);
- t->rec = 1;
- offset = descmap(t->ids, map, offset);
- t->rec = 0;
- return offset;
- }
- return -1;
- }
- /*
- * can a t2 be assigned to a t1?
- * any means Tany matches all types,
- * not just references
- */
- int
- tcompat(Type *t1, Type *t2, int any)
- {
- int ok, v;
- if(t1 == t2)
- return 1;
- if(t1 == nil || t2 == nil)
- return 0;
- if(t2->kind == Texception && t1->kind != Texception)
- t2 = mkextuptype(t2);
- tcomset = 0;
- ok = rtcompat(t1, t2, any, 0);
- v = cleartcomrec(t1) + cleartcomrec(t2);
- if(v != tcomset)
- fatal("recid t1 %t and t2 %t not balanced in tcompat: %d v %d", t1, t2, v, tcomset);
- return ok;
- }
- static int
- rtcompat(Type *t1, Type *t2, int any, int inaorc)
- {
- if(t1 == t2)
- return 1;
- if(t1 == nil || t2 == nil)
- return 0;
- if(t1->kind == Terror || t2->kind == Terror)
- return 1;
- if(t2->kind == Texception && t1->kind != Texception)
- t2 = mkextuptype(t2);
- if(debug['x'])
- print("rtcompat: %t and %t\n", t1, t2);
- t1->rec |= TRcom;
- t2->rec |= TRcom;
- switch(t1->kind){
- default:
- fatal("unknown type %t v %t in rtcompat", t1, t2);
- case Tstring:
- return t2->kind == Tstring || t2->kind == Tany;
- case Texception:
- if(t2->kind == Texception && t1->cons == t2->cons){
- if(assumetcom(t1, t2))
- return 1;
- return idcompat(t1->ids, t2->ids, 0, inaorc);
- }
- return 0;
- case Tnone:
- case Tint:
- case Tbig:
- case Tbyte:
- case Treal:
- return t1->kind == t2->kind;
- case Tfix:
- return t1->kind == t2->kind && sametree(t1->val, t2->val);
- case Tany:
- if(tattr[t2->kind].isptr)
- return 1;
- return any;
- case Tref:
- case Tlist:
- case Tarray:
- case Tchan:
- if(t1->kind != t2->kind){
- if(t2->kind == Tany)
- return 1;
- return 0;
- }
- if(t1->kind != Tref && assumetcom(t1, t2))
- return 1;
- return rtcompat(t1->tof, t2->tof, 0, t1->kind == Tarray || t1->kind == Tchan || inaorc);
- case Tfn:
- break;
- case Ttuple:
- if(t2->kind == Tadt && t2->tags == nil
- || t2->kind == Ttuple){
- if(assumetcom(t1, t2))
- return 1;
- return idcompat(t1->ids, t2->ids, any, inaorc);
- }
- if(t2->kind == Tadtpick){
- t2->tof->rec |= TRcom;
- if(assumetcom(t1, t2->tof))
- return 1;
- return idcompat(t1->ids, t2->tof->ids->next, any, inaorc);
- }
- return 0;
- case Tadt:
- if(t2->kind == Ttuple && t1->tags == nil){
- if(assumetcom(t1, t2))
- return 1;
- return idcompat(t1->ids, t2->ids, any, inaorc);
- }
- if(t1->tags != nil && t2->kind == Tadtpick && !inaorc)
- t2 = t2->decl->dot->ty;
- break;
- case Tadtpick:
- /*
- if(t2->kind == Ttuple)
- return idcompat(t1->tof->ids->next, t2->ids, any, inaorc);
- */
- break;
- case Tmodule:
- if(t2->kind == Tany)
- return 1;
- break;
- case Tpoly:
- if(t2->kind == Tany)
- return 1;
- break;
- }
- return tequal(t1, t2);
- }
- /*
- * add the assumption that t1 and t2 are compatable
- */
- static int
- assumetcom(Type *t1, Type *t2)
- {
- Type *r1, *r2;
- if(t1->tcom == nil && t2->tcom == nil){
- tcomset += 2;
- t1->tcom = t2->tcom = t1;
- }else{
- if(t1->tcom == nil){
- r1 = t1;
- t1 = t2;
- t2 = r1;
- }
- for(r1 = t1->tcom; r1 != r1->tcom; r1 = r1->tcom)
- ;
- for(r2 = t2->tcom; r2 != nil && r2 != r2->tcom; r2 = r2->tcom)
- ;
- if(r1 == r2)
- return 1;
- if(r2 == nil)
- tcomset++;
- t2->tcom = t1;
- for(; t2 != r1; t2 = r2){
- r2 = t2->tcom;
- t2->tcom = r1;
- }
- }
- return 0;
- }
- static int
- cleartcomrec(Type *t)
- {
- Decl *id;
- int n;
- n = 0;
- for(; t != nil && (t->rec & TRcom) == TRcom; t = t->tof){
- t->rec &= ~TRcom;
- if(t->tcom != nil){
- t->tcom = nil;
- n++;
- }
- if(t->kind == Tadtpick)
- n += cleartcomrec(t->tof);
- if(t->kind == Tmodule)
- t = t->tof;
- for(id = t->ids; id != nil; id = id->next)
- n += cleartcomrec(id->ty);
- for(id = t->tags; id != nil; id = id->next)
- n += cleartcomrec(id->ty);
- for(id = t->polys; id != nil; id = id->next)
- n += cleartcomrec(id->ty);
- }
- return n;
- }
- /*
- * id1 and id2 are the fields in an adt or tuple
- * simple structural check; ignore names
- */
- static int
- idcompat(Decl *id1, Decl *id2, int any, int inaorc)
- {
- for(; id1 != nil; id1 = id1->next){
- if(id1->store != Dfield)
- continue;
- while(id2 != nil && id2->store != Dfield)
- id2 = id2->next;
- if(id2 == nil
- || id1->store != id2->store
- || !rtcompat(id1->ty, id2->ty, any, inaorc))
- return 0;
- id2 = id2->next;
- }
- while(id2 != nil && id2->store != Dfield)
- id2 = id2->next;
- return id2 == nil;
- }
- int
- tequal(Type *t1, Type *t2)
- {
- int ok, v;
- eqrec = 0;
- eqset = 0;
- ok = rtequal(t1, t2);
- v = cleareqrec(t1) + cleareqrec(t2);
- if(v != eqset && 0)
- fatal("recid t1 %t and t2 %t not balanced in tequal: %d %d", t1, t2, v, eqset);
- eqset = 0;
- return ok;
- }
- /*
- * structural equality on types
- */
- static int
- rtequal(Type *t1, Type *t2)
- {
- /*
- * this is just a shortcut
- */
- if(t1 == t2)
- return 1;
- if(t1 == nil || t2 == nil)
- return 0;
- if(t1->kind == Terror || t2->kind == Terror)
- return 1;
- if(t1->kind != t2->kind)
- return 0;
- if(t1->eq != nil && t2->eq != nil)
- return t1->eq == t2->eq;
- if(debug['x'])
- print("rtequal: %t and %t\n", t1, t2);
- t1->rec |= TReq;
- t2->rec |= TReq;
- switch(t1->kind){
- default:
- fatal("unknown type %t v %t in rtequal", t1, t2);
- case Tnone:
- case Tbig:
- case Tbyte:
- case Treal:
- case Tint:
- case Tstring:
- /*
- * this should always be caught by t1 == t2 check
- */
- fatal("bogus value type %t vs %t in rtequal", t1, t2);
- return 1;
- case Tfix:
- return sametree(t1->val, t2->val);
- case Tref:
- case Tlist:
- case Tarray:
- case Tchan:
- if(t1->kind != Tref && assumeteq(t1, t2))
- return 1;
- return rtequal(t1->tof, t2->tof);
- case Tfn:
- if(t1->varargs != t2->varargs)
- return 0;
- if(!idequal(t1->ids, t2->ids, 0, storespace))
- return 0;
- /* if(!idequal(t1->polys, t2->polys, 1, nil)) */
- if(!pyequal(t1, t2))
- return 0;
- return rtequal(t1->tof, t2->tof);
- case Ttuple:
- case Texception:
- if(t1->kind != t2->kind || t1->cons != t2->cons)
- return 0;
- if(assumeteq(t1, t2))
- return 1;
- return idequal(t1->ids, t2->ids, 0, storespace);
- case Tadt:
- case Tadtpick:
- case Tmodule:
- if(assumeteq(t1, t2))
- return 1;
- /*
- * compare interfaces when comparing modules
- */
- if(t1->kind == Tmodule)
- return idequal(t1->tof->ids, t2->tof->ids, 1, nil);
- /*
- * picked adts; check parent,
- * assuming equiv picked fields,
- * then check picked fields are equiv
- */
- if(t1->kind == Tadtpick && !rtequal(t1->decl->dot->ty, t2->decl->dot->ty))
- return 0;
- /*
- * adts with pick tags: check picked fields for equality
- */
- if(!idequal(t1->tags, t2->tags, 1, nil))
- return 0;
- /* if(!idequal(t1->polys, t2->polys, 1, nil)) */
- if(!pyequal(t1, t2))
- return 0;
- return idequal(t1->ids, t2->ids, 1, storespace);
- case Tpoly:
- if(assumeteq(t1, t2))
- return 1;
- if(t1->decl->sym != t2->decl->sym)
- return 0;
- return idequal(t1->ids, t2->ids, 1, nil);
- }
- }
- static int
- assumeteq(Type *t1, Type *t2)
- {
- Type *r1, *r2;
- if(t1->teq == nil && t2->teq == nil){
- eqrec++;
- eqset += 2;
- t1->teq = t2->teq = t1;
- }else{
- if(t1->teq == nil){
- r1 = t1;
- t1 = t2;
- t2 = r1;
- }
- for(r1 = t1->teq; r1 != r1->teq; r1 = r1->teq)
- ;
- for(r2 = t2->teq; r2 != nil && r2 != r2->teq; r2 = r2->teq)
- ;
- if(r1 == r2)
- return 1;
- if(r2 == nil)
- eqset++;
- t2->teq = t1;
- for(; t2 != r1; t2 = r2){
- r2 = t2->teq;
- t2->teq = r1;
- }
- }
- return 0;
- }
- /*
- * checking structural equality for adts, tuples, and fns
- */
- static int
- idequal(Decl *id1, Decl *id2, int usenames, int *storeok)
- {
- /*
- * this is just a shortcut
- */
- if(id1 == id2)
- return 1;
- for(; id1 != nil; id1 = id1->next){
- if(storeok != nil && !storeok[id1->store])
- continue;
- while(id2 != nil && storeok != nil && !storeok[id2->store])
- id2 = id2->next;
- if(id2 == nil
- || usenames && id1->sym != id2->sym
- || id1->store != id2->store
- || id1->implicit != id2->implicit
- || id1->cyc != id2->cyc
- || (id1->dot == nil) != (id2->dot == nil)
- || id1->dot != nil && id2->dot != nil && id1->dot->ty->kind != id2->dot->ty->kind
- || !rtequal(id1->ty, id2->ty))
- return 0;
- id2 = id2->next;
- }
- while(id2 != nil && storeok != nil && !storeok[id2->store])
- id2 = id2->next;
- return id1 == nil && id2 == nil;
- }
- static int
- pyequal(Type *t1, Type *t2)
- {
- Type *pt1, *pt2;
- Decl *id1, *id2;
- if(t1 == t2)
- return 1;
- id1 = t1->polys;
- id2 = t2->polys;
- for(; id1 != nil; id1 = id1->next){
- if(id2 == nil)
- return 0;
- pt1 = id1->ty;
- pt2 = id2->ty;
- if(!rtequal(pt1, pt2)){
- if(t1->u.tmap != nil)
- pt1 = valtmap(pt1, t1->u.tmap);
- if(t2->u.tmap != nil)
- pt2 = valtmap(pt2, t2->u.tmap);
- if(!rtequal(pt1, pt2))
- return 0;
- }
- id2 = id2->next;
- }
- return id1 == nil && id2 == nil;
- }
- static int
- cleareqrec(Type *t)
- {
- Decl *id;
- int n;
- n = 0;
- for(; t != nil && (t->rec & TReq) == TReq; t = t->tof){
- t->rec &= ~TReq;
- if(t->teq != nil){
- t->teq = nil;
- n++;
- }
- if(t->kind == Tadtpick)
- n += cleareqrec(t->decl->dot->ty);
- if(t->kind == Tmodule)
- t = t->tof;
- for(id = t->ids; id != nil; id = id->next)
- n += cleareqrec(id->ty);
- for(id = t->tags; id != nil; id = id->next)
- n += cleareqrec(id->ty);
- for(id = t->polys; id != nil; id = id->next)
- n += cleareqrec(id->ty);
- }
- return n;
- }
- int
- raisescompat(Node *n1, Node *n2)
- {
- if(n1 == n2)
- return 1;
- if(n2 == nil)
- return 1; /* no need to repeat in definition if given in declaration */
- if(n1 == nil)
- return 0;
- for(n1 = n1->left, n2 = n2->left; n1 != nil && n2 != nil; n1 = n1->right, n2 = n2->right){
- if(n1->left->decl != n2->left->decl)
- return 0;
- }
- return n1 == n2;
- }
- /* t1 a polymorphic type */
- static int
- fnunify(Type *t1, Type *t2, Tpair **tp, int swapped)
- {
- Decl *id, *ids;
- Sym *sym;
- for(ids = t1->ids; ids != nil; ids = ids->next){
- sym = ids->sym;
- id = fnlookup(sym, t2, nil);
- if(id != nil)
- usetype(id->ty);
- if(id == nil){
- if(dowarn)
- error(unifysrc.start, "type %T does not have a '%s' function", t2, sym->name);
- return 0;
- }
- else if(id->ty->kind != Tfn){
- if(dowarn)
- error(unifysrc.start, "%T is not a function", id->ty);
- return 0;
- }
- else if(!rtunify(ids->ty, id->ty, tp, !swapped)){
- if(dowarn)
- error(unifysrc.start, "%T and %T are not compatible wrt %s", ids->ty, id->ty, sym->name);
- return 0;
- }
- }
- return 1;
- }
- static int
- fncleareqrec(Type *t1, Type *t2)
- {
- Decl *id, *ids;
- int n;
- n = 0;
- n += cleareqrec(t1);
- n += cleareqrec(t2);
- for(ids = t1->ids; ids != nil; ids = ids->next){
- id = fnlookup(ids->sym, t2, nil);
- if(id == nil)
- continue;
- else{
- n += cleareqrec(ids->ty);
- n += cleareqrec(id->ty);
- }
- }
- return n;
- }
- int
- tunify(Type *t1, Type *t2, Tpair **tp)
- {
- int ok, v;
- Tpair *p;
- *tp = nil;
- eqrec = 0;
- eqset = 0;
- ok = rtunify(t1, t2, tp, 0);
- v = cleareqrec(t1) + cleareqrec(t2);
- for(p = *tp; p != nil; p = p->nxt)
- v += fncleareqrec(p->t1, p->t2);
- if(0 && v != eqset)
- fatal("recid t1 %t and t2 %t not balanced in tunify: %d %d", t1, t2, v, eqset);
- return ok;
- }
- static int
- rtunify(Type *t1, Type *t2, Tpair **tp, int swapped)
- {
- Type *tmp;
- if(debug['w']) print("rtunifya - %T %T\n", t1, t2);
- t1 = valtmap(t1, *tp);
- t2 = valtmap(t2, *tp);
- if(debug['w']) print("rtunifyb - %T %T\n", t1, t2);
- if(t1 == t2)
- return 1;
- if(t1 == nil || t2 == nil)
- return 0;
- if(t1->kind == Terror || t2->kind == Terror)
- return 1;
- if(t1->kind != Tpoly && t2->kind == Tpoly){
- tmp = t1;
- t1 = t2;
- t2 = tmp;
- swapped = !swapped;
- }
- if(t1->kind == Tpoly){
- /*
- if(typein(t1, t2))
- return 0;
- */
- if(!tattr[t2->kind].isptr)
- return 0;
- if(t2->kind != Tany)
- addtmap(t1, t2, tp);
- return fnunify(t1, t2, tp, swapped);
- }
- if(t1->kind != Tany && t2->kind == Tany){
- tmp = t1;
- t1 = t2;
- t2 = tmp;
- swapped = !swapped;
- }
- if(t1->kind == Tadt && t1->tags != nil && t2->kind == Tadtpick && !swapped)
- t2 = t2->decl->dot->ty;
- if(t2->kind == Tadt && t2->tags != nil && t1->kind == Tadtpick && swapped)
- t1 = t1->decl->dot->ty;
- if(t1->kind != Tany && t1->kind != t2->kind)
- return 0;
- t1->rec |= TReq;
- t2->rec |= TReq;
- switch(t1->kind){
- default:
- return tequal(t1, t2);
- case Tany:
- return tattr[t2->kind].isptr;
- case Tref:
- case Tlist:
- case Tarray:
- case Tchan:
- if(t1->kind != Tref && assumeteq(t1, t2))
- return 1;
- return rtunify(t1->tof, t2->tof, tp, swapped);
- case Tfn:
- if(!idunify(t1->ids, t2->ids, tp, swapped))
- return 0;
- if(!idunify(t1->polys, t2->polys, tp, swapped))
- return 0;
- return rtunify(t1->tof, t2->tof, tp, swapped);
- case Ttuple:
- if(assumeteq(t1, t2))
- return 1;
- return idunify(t1->ids, t2->ids, tp, swapped);
- case Tadt:
- case Tadtpick:
- if(assumeteq(t1, t2))
- return 1;
- if(!idunify(t1->polys, t2->polys, tp, swapped))
- return 0;
- if(!idunify(t1->tags, t2->tags, tp, swapped))
- return 0;
- return idunify(t1->ids, t2->ids, tp, swapped);
- case Tmodule:
- if(assumeteq(t1, t2))
- return 1;
- return idunify(t1->tof->ids, t2->tof->ids, tp, swapped);
- case Tpoly:
- return t1 == t2;
- }
- }
- static int
- idunify(Decl *id1, Decl *id2, Tpair **tp, int swapped)
- {
- if(id1 == id2)
- return 1;
- for(; id1 != nil; id1 = id1->next){
- if(id2 == nil || !rtunify(id1->ty, id2->ty, tp, swapped))
- return 0;
- id2 = id2->next;
- }
- return id1 == nil && id2 == nil;
- }
- int
- polyequal(Decl *id1, Decl *id2)
- {
- int ck2;
- Decl *d;
- /* allow id2 list to have an optional for clause */
- ck2 = 0;
- for(d = id2; d != nil; d = d->next)
- if(d->ty->ids != nil)
- ck2 = 1;
- for( ; id1 != nil; id1 = id1->next){
- if(id2 == nil
- || id1->sym != id2->sym
- || id1->ty->decl != nil && id2->ty->decl != nil && id1->ty->decl->sym != id2->ty->decl->sym)
- return 0;
- if(ck2 && !idequal(id1->ty->ids, id2->ty->ids, 1, nil))
- return 0;
- id2 = id2->next;
- }
- return id1 == nil && id2 == nil;
- }
- Type*
- calltype(Type *f, Node *a, Type *rt)
- {
- Type *t;
- Decl *id, *first, *last;
- first = last = nil;
- t = mktype(&f->src.start, &f->src.stop, Tfn, rt, nil);
- t->polys = f->kind == Tref ? f->tof->polys : f->polys;
- for( ; a != nil; a = a->right){
- id = mkdecl(&f->src, Darg, a->left->ty);
- if(last == nil)
- first = id;
- else
- last->next = id;
- last = id;
- }
- t->ids = first;
- if(f->kind == Tref)
- t = mktype(&f->src.start, &f->src.stop, Tref, t, nil);
- return t;
- }
- static Type*
- duptype(Type *t)
- {
- Type *nt;
- nt = allocmem(sizeof(*nt));
- *nt = *t;
- nt->ok &= ~(OKverify|OKref|OKclass|OKsized|OKcycsize|OKcyc);
- nt->flags |= INST;
- nt->eq = nil;
- nt->sbl = -1;
- if(t->decl != nil && (nt->kind == Tadt || nt->kind == Tadtpick || nt->kind == Ttuple)){
- nt->decl = dupdecl(t->decl);
- nt->decl->ty = nt;
- nt->decl->link = t->decl;
- if(t->decl->dot != nil){
- nt->decl->dot = dupdecl(t->decl->dot);
- nt->decl->dot->link = t->decl->dot;
- }
- }
- else
- nt->decl = nil;
- return nt;
- }
- static int
- dpolys(Decl *ids)
- {
- Decl *p;
- for(p = ids; p != nil; p = p->next)
- if(tpolys(p->ty))
- return 1;
- return 0;
- }
- static int
- tpolys(Type *t)
- {
- int v;
- Typelist *tl;
- if(t == nil)
- return 0;
- if(t->flags&(POLY|NOPOLY))
- return t->flags&POLY;
- switch(t->kind){
- default:
- v = 0;
- break;
- case Tarrow:
- case Tdot:
- case Tpoly:
- v = 1;
- break;
- case Tref:
- case Tlist:
- case Tarray:
- case Tchan:
- v = tpolys(t->tof);
- break;
- case Tid:
- v = tpolys(t->decl->ty);
- break;
- case Tinst:
- v = 0;
- for(tl = t->u.tlist; tl != nil; tl = tl->nxt)
- if(tpolys(tl->t)){
- v = 1;
- break;
- }
- if(v == 0)
- v = tpolys(t->tof);
- break;
- case Tfn:
- case Tadt:
- case Tadtpick:
- case Ttuple:
- case Texception:
- if(t->polys != nil){
- v = 1;
- break;
- }
- if(t->rec&TRvis)
- return 0;
- t->rec |= TRvis;
- v = tpolys(t->tof) || dpolys(t->polys) || dpolys(t->ids) || dpolys(t->tags);
- t->rec &= ~TRvis;
- if(t->kind == Tadtpick && v == 0)
- v = tpolys(t->decl->dot->ty);
- break;
- }
- if(v)
- t->flags |= POLY;
- else
- t->flags |= NOPOLY;
- return v;
- }
- static int
- doccurs(Decl *ids, Tpair **tp)
- {
- Decl *p;
- for(p = ids; p != nil; p = p->next)
- if(toccurs(p->ty, tp))
- return 1;
- return 0;
- }
- static int
- toccurs(Type *t, Tpair **tp)
- {
- int o;
- Typelist *tl;
- if(t == nil)
- return 0;
- if(!(t->flags&(POLY|NOPOLY)))
- tpolys(t);
- if(t->flags&NOPOLY)
- return 0;
- switch(t->kind){
- default:
- fatal("unknown type %t in toccurs", t);
- case Tnone:
- case Tbig:
- case Tbyte:
- case Treal:
- case Tint:
- case Tstring:
- case Tfix:
- case Tmodule:
- case Terror:
- return 0;
- case Tarrow:
- case Tdot:
- return 1;
- case Tpoly:
- return valtmap(t, *tp) != t;
- case Tref:
- case Tlist:
- case Tarray:
- case Tchan:
- return toccurs(t->tof, tp);
- case Tid:
- return toccurs(t->decl->ty, tp);
- case Tinst:
- for(tl = t->u.tlist; tl != nil; tl = tl->nxt)
- if(toccurs(tl->t, tp))
- return 1;
- return toccurs(t->tof, tp);
- case Tfn:
- case Tadt:
- case Tadtpick:
- case Ttuple:
- case Texception:
- if(t->rec&TRvis)
- return 0;
- t->rec |= TRvis;
- o = toccurs(t->tof, tp) || doccurs(t->polys, tp) || doccurs(t->ids, tp) || doccurs(t->tags, tp);
- t->rec &= ~TRvis;
- if(t->kind == Tadtpick && o == 0)
- o = toccurs(t->decl->dot->ty, tp);
- return o;
- }
- }
- static Decl*
- expandids(Decl *ids, Decl *adtt, Tpair **tp, int sym)
- {
- Decl *p, *q, *nids, *last;
- nids = last = nil;
- for(p = ids; p != nil; p = p->next){
- q = dupdecl(p);
- q->ty = expandtype(p->ty, nil, adtt, tp);
- if(sym && q->ty->decl != nil)
- q->sym = q->ty->decl->sym;
- if(q->store == Dfn){
- if(debug['v']) print("%p->link = %p\n", q, p);
- q->link = p;
- }
- if(nids == nil)
- nids = q;
- else
- last->next = q;
- last = q;
- }
- return nids;
- }
- Type*
- expandtype(Type *t, Type *instt, Decl *adtt, Tpair **tp)
- {
- Type *nt;
- Decl *ids;
- if(t == nil)
- return nil;
- if(debug['w']) print("expandtype %d %lux %T\n", t->kind, (ulong)t, t);
- if(!toccurs(t, tp))
- return t;
- if(debug['w']) print("\texpanding\n");
- switch(t->kind){
- default:
- fatal("unknown type %t in expandtype", t);
- case Tpoly:
- return valtmap(t, *tp);
- case Tref:
- case Tlist:
- case Tarray:
- case Tchan:
- nt = duptype(t);
- nt->tof = expandtype(t->tof, nil, adtt, tp);
- return nt;
- case Tid:
- return expandtype(idtype(t), nil, adtt, tp);
- case Tdot:
- return expandtype(dottype(t, adtt), nil, adtt, tp);
- case Tarrow:
- return expandtype(arrowtype(t, adtt), nil, adtt, tp);
- case Tinst:
- if((nt = valtmap(t, *tp)) != t)
- return nt;
- return expandtype(insttype(t, adtt, tp), nil, adtt, tp);
- case Tfn:
- case Tadt:
- case Tadtpick:
- case Ttuple:
- case Texception:
- if((nt = valtmap(t, *tp)) != t)
- return nt;
- if(t->kind == Tadt)
- adtt = t->decl;
- nt = duptype(t);
- addtmap(t, nt, tp);
- if(instt != nil)
- addtmap(instt, nt, tp);
- nt->tof = expandtype(t->tof, nil, adtt, tp);
- nt->polys = expandids(t->polys, adtt, tp, 1);
- nt->ids = expandids(t->ids, adtt, tp, 0);
- nt->tags = expandids(t->tags, adtt, tp, 0);
- if(t->kind == Tadt){
- for(ids = nt->tags; ids != nil; ids = ids->next)
- ids->ty->decl->dot = nt->decl;
- }
- if(t->kind == Tadtpick){
- nt->decl->dot->ty = expandtype(t->decl->dot->ty, nil, adtt, tp);
- }
- if((t->kind == Tadt || t->kind == Tadtpick) && t->u.tmap != nil){
- Tpair *p;
- nt->u.tmap = nil;
- for(p = t->u.tmap; p != nil; p = p->nxt)
- addtmap(valtmap(p->t1, *tp), valtmap(p->t2, *tp), &nt->u.tmap);
- if(debug['w']){
- print("new tmap for %T->%T: ", t, nt);
- for(p=nt->u.tmap;p!=nil;p=p->nxt)print("%T -> %T ", p->t1, p->t2);
- print("\n");
- }
- }
- return nt;
- }
- }
- /*
- * create type signatures
- * sign the same information used
- * for testing type equality
- */
- ulong
- sign(Decl *d)
- {
- Type *t;
- uchar *sig, md5sig[MD5dlen];
- char buf[StrSize];
- int i, sigend, sigalloc, v;
- t = d->ty;
- if(t->sig != 0)
- return t->sig;
- if(ispoly(d))
- rmfnptrs(d);
- sig = 0;
- sigend = -1;
- sigalloc = 1024;
- while(sigend < 0 || sigend >= sigalloc){
- sigalloc *= 2;
- sig = reallocmem(sig, sigalloc);
- eqrec = 0;
- sigend = rtsign(t, sig, sigalloc, 0);
- v = clearrec(t);
- if(v != eqrec)
- fatal("recid not balanced in sign: %d %d", v, eqrec);
- eqrec = 0;
- }
- sig[sigend] = '\0';
- if(signdump != nil){
- seprint(buf, buf+sizeof(buf), "%D", d);
- if(strcmp(buf, signdump) == 0){
- print("sign %D len %d\n", d, sigend);
- print("%s\n", (char*)sig);
- }
- }
- md5(sig, sigend, md5sig, nil);
- for(i = 0; i < MD5dlen; i += 4)
- t->sig ^= md5sig[i+0] | (md5sig[i+1]<<8) | (md5sig[i+2]<<16) | (md5sig[i+3]<<24);
- if(debug['S'])
- print("signed %D type %T len %d sig %#lux\n", d, t, sigend, t->sig);
- free(sig);
- return t->sig;
- }
- enum
- {
- SIGSELF = 'S',
- SIGVARARGS = '*',
- SIGCYC = 'y',
- SIGREC = '@'
- };
- static int sigkind[Tend] =
- {
- /* Tnone */ 'n',
- /* Tadt */ 'a',
- /* Tadtpick */ 'p',
- /* Tarray */ 'A',
- /* Tbig */ 'B',
- /* Tbyte */ 'b',
- /* Tchan */ 'C',
- /* Treal */ 'r',
- /* Tfn */ 'f',
- /* Tint */ 'i',
- /* Tlist */ 'L',
- /* Tmodule */ 'm',
- /* Tref */ 'R',
- /* Tstring */ 's',
- /* Ttuple */ 't',
- /* Texception */ 'e',
- /* Tfix */ 'x',
- /* Tpoly */ 'P',
- };
- static int
- rtsign(Type *t, uchar *sig, int lensig, int spos)
- {
- Decl *id, *tg;
- char name[32];
- int kind, lenname;
- if(t == nil)
- return spos;
- if(spos < 0 || spos + 8 >= lensig)
- return -1;
- if(t->eq != nil && t->eq->id){
- if(t->eq->id < 0 || t->eq->id > eqrec)
- fatal("sign rec %T %d %d", t, t->eq->id, eqrec);
- sig[spos++] = SIGREC;
- seprint(name, name+sizeof(name), "%d", t->eq->id);
- lenname = strlen(name);
- if(spos + lenname > lensig)
- return -1;
- strcpy((char*)&sig[spos], name);
- spos += lenname;
- return spos;
- }
- if(t->eq != nil){
- eqrec++;
- t->eq->id = eqrec;
- }
- kind = sigkind[t->kind];
- sig[spos++] = kind;
- if(kind == 0)
- fatal("no sigkind for %t", t);
- t->rec = 1;
- switch(t->kind){
- default:
- fatal("bogus type %t in rtsign", t);
- return -1;
- case Tnone:
- case Tbig:
- case Tbyte:
- case Treal:
- case Tint:
- case Tstring:
- case Tpoly:
- return spos;
- case Tfix:
- seprint(name, name+sizeof(name), "%g", t->val->rval);
- lenname = strlen(name);
- if(spos+lenname-1 >= lensig)
- return -1;
- strcpy((char*)&sig[spos], name);
- spos += lenname;
- return spos;
- case Tref:
- case Tlist:
- case Tarray:
- case Tchan:
- return rtsign(t->tof, sig, lensig, spos);
- case Tfn:
- if(t->varargs != 0)
- sig[spos++] = SIGVARARGS;
- if(t->polys != nil)
- spos = idsign(t->polys, 0, sig, lensig, spos);
- spos = idsign(t->ids, 0, sig, lensig, spos);
- if(t->u.eraises)
- spos = raisessign(t->u.eraises, sig, lensig, spos);
- return rtsign(t->tof, sig, lensig, spos);
- case Ttuple:
- return idsign(t->ids, 0, sig, lensig, spos);
- case Tadt:
- /*
- * this is a little different than in rtequal,
- * since we flatten the adt we used to represent the globals
- */
- if(t->eq == nil){
- if(strcmp(t->decl->sym->name, ".mp") != 0)
- fatal("no t->eq field for %t", t);
- spos--;
- for(id = t->ids; id != nil; id = id->next){
- spos = idsign1(id, 1, sig, lensig, spos);
- if(spos < 0 || spos >= lensig)
- return -1;
- sig[spos++] = ';';
- }
- return spos;
- }
- if(t->polys != nil)
- spos = idsign(t->polys, 0, sig, lensig, spos);
- spos = idsign(t->ids, 1, sig, lensig, spos);
- if(spos < 0 || t->tags == nil)
- return spos;
- /*
- * convert closing ')' to a ',', then sign any tags
- */
- sig[spos-1] = ',';
- for(tg = t->tags; tg != nil; tg = tg->next){
- lenname = tg->sym->len;
- if(spos + lenname + 2 >= lensig)
- return -1;
- strcpy((char*)&sig[spos], tg->sym->name);
- spos += lenname;
- sig[spos++] = '=';
- sig[spos++] = '>';
- spos = rtsign(tg->ty, sig, lensig, spos);
- if(spos < 0 || spos >= lensig)
- return -1;
- if(tg->next != nil)
- sig[spos++] = ',';
- }
- if(spos >= lensig)
- return -1;
- sig[spos++] = ')';
- return spos;
- case Tadtpick:
- spos = idsign(t->ids, 1, sig, lensig, spos);
- if(spos < 0)
- return spos;
- return rtsign(t->decl->dot->ty, sig, lensig, spos);
- case Tmodule:
- if(t->tof->linkall == 0)
- fatal("signing a narrowed module");
- if(spos >= lensig)
- return -1;
- sig[spos++] = '{';
- for(id = t->tof->ids; id != nil; id = id->next){
- if(id->tag)
- continue;
- if(strcmp(id->sym->name, ".mp") == 0){
- spos = rtsign(id->ty, sig, lensig, spos);
- if(spos < 0)
- return -1;
- continue;
- }
- spos = idsign1(id, 1, sig, lensig, spos);
- if(spos < 0 || spos >= lensig)
- return -1;
- sig[spos++] = ';';
- }
- if(spos >= lensig)
- return -1;
- sig[spos++] = '}';
- return spos;
- }
- }
- static int
- idsign(Decl *id, int usenames, uchar *sig, int lensig, int spos)
- {
- int first;
- if(spos >= lensig)
- return -1;
- sig[spos++] = '(';
- first = 1;
- for(; id != nil; id = id->next){
- if(id->store == Dlocal)
- fatal("local %s in idsign", id->sym->name);
- if(!storespace[id->store])
- continue;
- if(!first){
- if(spos >= lensig)
- return -1;
- sig[spos++] = ',';
- }
- spos = idsign1(id, usenames, sig, lensig, spos);
- if(spos < 0)
- return -1;
- first = 0;
- }
- if(spos >= lensig)
- return -1;
- sig[spos++] = ')';
- return spos;
- }
- static int
- idsign1(Decl *id, int usenames, uchar *sig, int lensig, int spos)
- {
- char *name;
- int lenname;
- if(usenames){
- name = id->sym->name;
- lenname = id->sym->len;
- if(spos + lenname + 1 >= lensig)
- return -1;
- strcpy((char*)&sig[spos], name);
- spos += lenname;
- sig[spos++] = ':';
- }
- if(spos + 2 >= lensig)
- return -1;
- if(id->implicit != 0)
- sig[spos++] = SIGSELF;
- if(id->cyc != 0)
- sig[spos++] = SIGCYC;
- return rtsign(id->ty, sig, lensig, spos);
- }
- static int
- raisessign(Node *n, uchar *sig, int lensig, int spos)
- {
- int m;
- char *s;
- Node *nn;
- if(spos >= lensig)
- return -1;
- sig[spos++] = '(';
- for(nn = n->left; nn != nil; nn = nn->right){
- s = nn->left->decl->sym->name;
- m = nn->left->decl->sym->len;
- if(spos+m-1 >= lensig)
- return -1;
- strcpy((char*)&sig[spos], s);
- spos += m;
- if(nn->right != nil){
- if(spos >= lensig)
- return -1;
- sig[spos++] = ',';
- }
- }
- if(spos >= lensig)
- return -1;
- sig[spos++] = ')';
- return spos;
- }
- static int
- clearrec(Type *t)
- {
- Decl *id;
- int n;
- n = 0;
- for(; t != nil && t->rec; t = t->tof){
- t->rec = 0;
- if(t->eq != nil && t->eq->id != 0){
- t->eq->id = 0;
- n++;
- }
- if(t->kind == Tmodule){
- for(id = t->tof->ids; id != nil; id = id->next)
- n += clearrec(id->ty);
- return n;
- }
- if(t->kind == Tadtpick)
- n += clearrec(t->decl->dot->ty);
- for(id = t->ids; id != nil; id = id->next)
- n += clearrec(id->ty);
- for(id = t->tags; id != nil; id = id->next)
- n += clearrec(id->ty);
- for(id = t->polys; id != nil; id = id->next)
- n += clearrec(id->ty);
- }
- return n;
- }
- /* must a variable of the given type be zeroed ? (for uninitialized declarations inside loops) */
- int
- tmustzero(Type *t)
- {
- if(t==nil)
- return 0;
- if(tattr[t->kind].isptr)
- return 1;
- if(t->kind == Tadtpick)
- t = t->tof;
- if(t->kind == Ttuple || t->kind == Tadt)
- return mustzero(t->ids);
- return 0;
- }
- int
- mustzero(Decl *decls)
- {
- Decl *d;
- for (d = decls; d != nil; d = d->next)
- if (tmustzero(d->ty))
- return 1;
- return 0;
- }
- int
- typeconv(Fmt *f)
- {
- Type *t;
- char *p, buf[1024];
- t = va_arg(f->args, Type*);
- if(t == nil){
- p = "nothing";
- }else{
- p = buf;
- buf[0] = 0;
- tprint(buf, buf+sizeof(buf), t);
- }
- return fmtstrcpy(f, p);
- }
- int
- stypeconv(Fmt *f)
- {
- Type *t;
- char *p, buf[1024];
- t = va_arg(f->args, Type*);
- if(t == nil){
- p = "nothing";
- }else{
- p = buf;
- buf[0] = 0;
- stprint(buf, buf+sizeof(buf), t);
- }
- return fmtstrcpy(f, p);
- }
- int
- ctypeconv(Fmt *f)
- {
- Type *t;
- char buf[1024];
- t = va_arg(f->args, Type*);
- buf[0] = 0;
- ctprint(buf, buf+sizeof(buf), t);
- return fmtstrcpy(f, buf);
- }
- char*
- tprint(char *buf, char *end, Type *t)
- {
- Decl *id;
- Typelist *tl;
- if(t == nil)
- return buf;
- if(t->kind >= Tend)
- return seprint(buf, end, "kind %d", t->kind);
- switch(t->kind){
- case Tarrow:
- buf = seprint(buf, end, "%T->%s", t->tof, t->decl->sym->name);
- break;
- case Tdot:
- buf = seprint(buf, end, "%T.%s", t->tof, t->decl->sym->name);
- break;
- case Tid:
- case Tpoly:
- buf = seprint(buf, end, "%s", t->decl->sym->name);
- break;
- case Tinst:
- buf = tprint(buf, end, t->tof);
- buf = secpy(buf ,end, "[");
- for(tl = t->u.tlist; tl != nil; tl = tl->nxt){
- buf = tprint(buf, end, tl->t);
- if(tl->nxt != nil)
- buf = secpy(buf, end, ", ");
- }
- buf = secpy(buf, end, "]");
- break;
- case Tint:
- case Tbig:
- case Tstring:
- case Treal:
- case Tbyte:
- case Tany:
- case Tnone:
- case Terror:
- case Tainit:
- case Talt:
- case Tcase:
- case Tcasel:
- case Tcasec:
- case Tgoto:
- case Tiface:
- case Texception:
- case Texcept:
- buf = secpy(buf, end, kindname[t->kind]);
- break;
- case Tfix:
- buf = seprint(buf, end, "%s(%v)", kindname[t->kind], t->val);
- break;
- case Tref:
- buf = secpy(buf, end, "ref ");
- buf = tprint(buf, end, t->tof);
- break;
- case Tchan:
- case Tarray:
- case Tlist:
- buf = seprint(buf, end, "%s of ", kindname[t->kind]);
- buf = tprint(buf, end, t->tof);
- break;
- case Tadtpick:
- buf = seprint(buf, end, "%s.%s", t->decl->dot->sym->name, t->decl->sym->name);
- break;
- case Tadt:
- if(t->decl->dot != nil && !isimpmod(t->decl->dot->sym))
- buf = seprint(buf, end, "%s->%s", t->decl->dot->sym->name, t->decl->sym->name);
- else
- buf = seprint(buf, end, "%s", t->decl->sym->name);
- if(t->polys != nil){
- buf = secpy(buf ,end, "[");
- for(id = t->polys; id != nil; id = id->next){
- if(t->u.tmap != nil)
- buf = tprint(buf, end, valtmap(id->ty, t->u.tmap));
- else
- buf = seprint(buf, end, "%s", id->sym->name);
- if(id->next != nil)
- buf = secpy(buf, end, ", ");
- }
- buf = secpy(buf, end, "]");
- }
- break;
- case Tmodule:
- buf = seprint(buf, end, "%s", t->decl->sym->name);
- break;
- case Ttuple:
- buf = secpy(buf, end, "(");
- for(id = t->ids; id != nil; id = id->next){
- buf = tprint(buf, end, id->ty);
- if(id->next != nil)
- buf = secpy(buf, end, ", ");
- }
- buf = secpy(buf, end, ")");
- break;
- case Tfn:
- buf = secpy(buf, end, "fn");
- if(t->polys != nil){
- buf = secpy(buf, end, "[");
- for(id = t->polys; id != nil; id = id->next){
- buf = seprint(buf, end, "%s", id->sym->name);
- if(id->next != nil)
- buf = secpy(buf, end, ", ");
- }
- buf = secpy(buf, end, "]");
- }
- buf = secpy(buf, end, "(");
- for(id = t->ids; id != nil; id = id->next){
- if(id->sym == nil)
- buf = secpy(buf, end, "nil: ");
- else
- buf = seprint(buf, end, "%s: ", id->sym->name);
- if(id->implicit)
- buf = secpy(buf, end, "self ");
- buf = tprint(buf, end, id->ty);
- if(id->next != nil)
- buf = secpy(buf, end, ", ");
- }
- if(t->varargs && t->ids != nil)
- buf = secpy(buf, end, ", *");
- else if(t->varargs)
- buf = secpy(buf, end, "*");
- if(t->tof != nil && t->tof->kind != Tnone){
- buf = secpy(buf, end, "): ");
- buf = tprint(buf, end, t->tof);
- break;
- }
- buf = secpy(buf, end, ")");
- break;
- default:
- yyerror("tprint: unknown type kind %d", t->kind);
- break;
- }
- return buf;
- }
- char*
- stprint(char *buf, char *end, Type *t)
- {
- if(t == nil)
- return buf;
- switch(t->kind){
- case Tid:
- return seprint(buf, end, "id %s", t->decl->sym->name);
- case Tadt:
- case Tadtpick:
- case Tmodule:
- buf = secpy(buf, end, kindname[t->kind]);
- buf = secpy(buf, end, " ");
- return tprint(buf, end, t);
- }
- return tprint(buf, end, t);
- }
- /* generalize ref P.A, ref P.B to ref P */
- /*
- Type*
- tparentx(Type *t1, Type* t2)
- {
- if(t1 == nil || t2 == nil || t1->kind != Tref || t2->kind != Tref)
- return t1;
- t1 = t1->tof;
- t2 = t2->tof;
- if(t1 == nil || t2 == nil || t1->kind != Tadtpick || t2->kind != Tadtpick)
- return t1;
- t1 = t1->decl->dot->ty;
- t2 = t2->decl->dot->ty;
- if(tequal(t1, t2))
- return mktype(&t1->src.start, &t1->src.stop, Tref, t1, nil);
- return t1;
- }
- */
- static int
- tparent0(Type *t1, Type *t2)
- {
- Decl *id1, *id2;
- if(t1 == t2)
- return 1;
- if(t1 == nil || t2 == nil)
- return 0;
- if(t1->kind == Tadt && t2->kind == Tadtpick)
- t2 = t2->decl->dot->ty;
- if(t1->kind == Tadtpick && t2->kind == Tadt)
- t1 = t1->decl->dot->ty;
- if(t1->kind != t2->kind)
- return 0;
- switch(t1->kind){
- default:
- fatal("unknown type %t v %t in tparent", t1, t2);
- break;
- case Terror:
- case Tstring:
- case Tnone:
- case Tint:
- case Tbig:
- case Tbyte:
- case Treal:
- case Tany:
- return 1;
- case Texception:
- case Tfix:
- case Tfn:
- case Tadt:
- case Tmodule:
- case Tpoly:
- return tcompat(t1, t2, 0);
- case Tref:
- case Tlist:
- case Tarray:
- case Tchan:
- return tparent0(t1->tof, t2->tof);
- case Ttuple:
- for(id1 = t1->ids, id2 = t2->ids; id1 != nil && id2 != nil; id1 = id1->next, id2 = id2->next)
- if(!tparent0(id1->ty, id2->ty))
- return 0;
- return id1 == nil && id2 == nil;
- case Tadtpick:
- return tequal(t1->decl->dot->ty, t2->decl->dot->ty);
- }
- return 0;
- }
- static Type*
- tparent1(Type *t1, Type *t2)
- {
- Type *t, *nt;
- Decl *id, *id1, *id2, *idt;
- if(t1->kind == Tadt && t2->kind == Tadtpick)
- t2 = t2->decl->dot->ty;
- if(t1->kind == Tadtpick && t2->kind == Tadt)
- t1 = t1->decl->dot->ty;
- switch(t1->kind){
- default:
- return t1;
- case Tref:
- case Tlist:
- case Tarray:
- case Tchan:
- t = tparent1(t1->tof, t2->tof);
- if(t == t1->tof)
- return t1;
- return mktype(&t1->src.start, &t1->src.stop, t1->kind, t, nil);
- case Ttuple:
- nt = nil;
- id = nil;
- for(id1 = t1->ids, id2 = t2->ids; id1 != nil && id2 != nil; id1 = id1->next, id2 = id2->next){
- t = tparent1(id1->ty, id2->ty);
- if(t != id1->ty){
- if(nt == nil){
- nt = mktype(&t1->src.start, &t1->src.stop, Ttuple, nil, dupdecls(t1->ids));
- for(id = nt->ids, idt = t1->ids; idt != id1; id = id->next, idt = idt->next)
- ;
- }
- id->ty = t;
- }
- if(id != nil)
- id = id->next;
- }
- if(nt == nil)
- return t1;
- return nt;
- case Tadtpick:
- if(tequal(t1, t2))
- return t1;
- return t1->decl->dot->ty;
- }
- }
- Type*
- tparent(Type *t1, Type *t2)
- {
- if(tparent0(t1, t2))
- return tparent1(t1, t2);
- return t1;
- }
- /*
- * make the tuple type used to initialize an exception type
- */
- Type*
- mkexbasetype(Type *t)
- {
- Decl *id, *new, *last;
- Type *nt;
- if(!t->cons)
- fatal("mkexbasetype on non-constant");
- last = mkids(&t->decl->src, nil, tstring, nil);
- last->store = Dfield;
- nt = mktype(&t->src.start, &t->src.stop, Texception, nil, last);
- nt->cons = 0;
- new = mkids(&t->decl->src, nil, tint, nil);
- new->store = Dfield;
- last->next = new;
- last = new;
- for(id = t->ids; id != nil; id = id->next){
- new = allocmem(sizeof *id);
- *new = *id;
- new->cyc = 0;
- last->next = new;
- last = new;
- }
- last->next = nil;
- return usetype(nt);
- }
- /*
- * make an instantiated exception type
- */
- Type*
- mkextype(Type *t)
- {
- Type *nt;
- if(!t->cons)
- fatal("mkextype on non-constant");
- if(t->tof != nil)
- return t->tof;
- nt = copytypeids(t);
- nt->cons = 0;
- t->tof = usetype(nt);
- return t->tof;
- }
- /*
- * convert an instantiated exception type to its underlying type
- */
- Type*
- mkextuptype(Type *t)
- {
- Decl *id;
- Type *nt;
- if(t->cons)
- return t;
- if(t->tof != nil)
- return t->tof;
- id = t->ids;
- if(id == nil)
- nt = t;
- else if(id->next == nil)
- nt = id->ty;
- else{
- nt = copytypeids(t);
- nt->cons = 0;
- nt->kind = Ttuple;
- }
- t->tof = usetype(nt);
- return t->tof;
- }
- static void
- ckfix(Type *t, double max)
- {
- int p;
- vlong k, x;
- double s;
- s = t->val->rval;
- if(max == 0.0)
- k = ((vlong)1<<32)-1;
- else
- k = 2*(vlong)(max/s+0.5)+1;
- x = 1;
- for(p = 0; k > x; p++)
- x *= 2;
- if(p == 0 || p > 32){
- error(t->src.start, "cannot fit fixed type into an int");
- return;
- }
- if(p < 32)
- t->val->rval /= (double)(1<<(32-p));
- }
- double
- scale(Type *t)
- {
- Node *n;
- if(t->kind == Tint || t->kind == Treal)
- return 1.0;
- if(t->kind != Tfix)
- fatal("scale() on non fixed point type");
- n = t->val;
- if(n->op != Oconst)
- fatal("non constant scale");
- if(n->ty != treal)
- fatal("non real scale");
- return n->rval;
- }
- double
- scale2(Type *f, Type *t)
- {
- return scale(f)/scale(t);
- }
- #define I(x) ((int)(x))
- #define V(x) ((Long)(x))
- #define D(x) ((double)(x))
- /* put x in normal form */
- static int
- nf(double x, int *mant)
- {
- int p;
- double m;
- p = 0;
- m = x;
- while(m >= 1){
- p++;
- m /= 2;
- }
- while(m < 0.5){
- p--;
- m *= 2;
- }
- m *= D(1<<16)*D(1<<15);
- if(m >= D(0x7fffffff) - 0.5){
- *mant = 0x7fffffff;
- return p;
- }
- *mant = I(m+0.5);
- return p;
- }
- static int
- ispow2(double x)
- {
- int m;
- nf(x, &m);
- if(m != 1<<30)
- return 0;
- return 1;
- }
- static int
- fround(double x, int n, int *m)
- {
- if(n != 31)
- fatal("not 31 in fround");
- return nf(x, m);
- }
- static int
- fixmul2(double sx, double sy, double sr, int *rp, int *ra)
- {
- int k, n, a;
- double alpha;
- alpha = (sx*sy)/sr;
- n = 31;
- k = fround(1/alpha, n, &a);
- *rp = 1-k;
- *ra = 0;
- return IMULX;
- }
- static int
- fixdiv2(double sx, double sy, double sr, int *rp, int *ra)
- {
- int k, n, b;
- double beta;
- beta = sx/(sy*sr);
- n = 31;
- k = fround(beta, n, &b);
- *rp = k-1;
- *ra = 0;
- return IDIVX;
- }
- static int
- fixmul(double sx, double sy, double sr, int *rp, int *ra)
- {
- int k, m, n, a, v;
- vlong W;
- double alpha, eps;
- alpha = (sx*sy)/sr;
- if(ispow2(alpha))
- return fixmul2(sx, sy, sr, rp, ra);
- n = 31;
- k = fround(1/alpha, n, &a);
- m = n-k;
- if(m < -n-1)
- return IMOVW; /* result is zero whatever the values */
- v = 0;
- W = 0;
- eps = D(1<<m)/(alpha*D(a)) - 1;
- if(eps < 0){
- v = a-1;
- eps = -eps;
- }
- if(m < 0 && D(1<<n)*eps*D(a) >= D(a)-1+D(1<<m))
- W = (V(1)<<(-m)) - 1;
- if(v != 0 || W != 0)
- m = m<<2|(v != 0)<<1|(W != 0);
- *rp = m;
- *ra = a;
- return v == 0 && W == 0 ? IMULX0: IMULX1;
- }
- static int
- fixdiv(double sx, double sy, double sr, int *rp, int *ra)
- {
- int k, m, n, b, v;
- vlong W;
- double beta, eps;
- beta = sx/(sy*sr);
- if(ispow2(beta))
- return fixdiv2(sx, sy, sr, rp, ra);
- n = 31;
- k = fround(beta, n, &b);
- m = k-n;
- if(m <= -2*n)
- return IMOVW; /* result is zero whatever the values */
- v = 0;
- W = 0;
- eps = (D(1<<m)*D(b))/beta - 1;
- if(eps < 0)
- v = 1;
- if(m < 0)
- W = (V(1)<<(-m)) - 1;
- if(v != 0 || W != 0)
- m = m<<2|(v != 0)<<1|(W != 0);
- *rp = m;
- *ra = b;
- return v == 0 && W == 0 ? IDIVX0: IDIVX1;
- }
- static int
- fixcast(double sx, double sr, int *rp, int *ra)
- {
- int op;
- op = fixmul(sx, 1.0, sr, rp, ra);
- return op-IMULX+ICVTXX;
- }
- int
- fixop(int op, Type *tx, Type *ty, Type *tr, int *rp, int *ra)
- {
- double sx, sy, sr;
- sx = scale(tx);
- sy = scale(ty);
- sr = scale(tr);
- if(op == IMULX)
- op = fixmul(sx, sy, sr, rp, ra);
- else if(op == IDIVX)
- op = fixdiv(sx, sy, sr, rp, ra);
- else
- op = fixcast(sx, sr, rp, ra);
- return op;
- }
- int
- ispoly(Decl *d)
- {
- Type *t;
- if(d == nil)
- return 0;
- t = d->ty;
- if(t->kind == Tfn){
- if(t->polys != nil)
- return 1;
- if((d = d->dot) == nil)
- return 0;
- t = d->ty;
- return t->kind == Tadt && t->polys != nil;
- }
- return 0;
- }
- int
- ispolyadt(Type *t)
- {
- return (t->kind == Tadt || t->kind == Tadtpick) && t->polys != nil && !(t->flags & INST);
- }
- Decl*
- polydecl(Decl *ids)
- {
- Decl *id;
- Type *t;
- for(id = ids; id != nil; id = id->next){
- t = mktype(&id->src.start, &id->src.stop, Tpoly, nil, nil);
- id->ty = t;
- t->decl = id;
- }
- return ids;
- }
- /* try to convert an expression tree to a type */
- Type*
- exptotype(Node *n)
- {
- Type *t, *tt;
- Decl *d;
- Typelist *tl;
- Src *src;
- if(n == nil)
- return nil;
- t = nil;
- switch(n->op){
- case Oname:
- if((d = n->decl) != nil && d->store == Dtype)
- t = d->ty;
- break;
- case Otype:
- case Ochan:
- t = n->ty;
- break;
- case Oref:
- t = exptotype(n->left);
- if(t != nil)
- t = mktype(&n->src.start, &n->src.stop, Tref, t, nil);
- break;
- case Odot:
- t = exptotype(n->left);
- if(t != nil){
- d = namedot(t->tags, n->right->decl->sym);
- if(d == nil)
- t = nil;
- else
- t = d->ty;
- }
- if(t == nil)
- t = exptotype(n->right);
- break;
- case Omdot:
- t = exptotype(n->right);
- break;
- case Oindex:
- t = exptotype(n->left);
- if(t != nil){
- src = &n->src;
- tl = nil;
- for(n = n->right; n != nil; n = n->right){
- if(n->op == Oseq)
- tt = exptotype(n->left);
- else
- tt = exptotype(n);
- if(tt == nil)
- return nil;
- tl = addtype(tt, tl);
- if(n->op != Oseq)
- break;
- }
- t = mkinsttype(src, t, tl);
- }
- break;
- }
- return t;
- }
- static char*
- uname(Decl *im)
- {
- Decl *p;
- int n;
- char *s;
- n = 0;
- for(p = im; p != nil; p = p->next)
- n += strlen(p->sym->name)+1;
- s = allocmem(n);
- strcpy(s, "");
- for(p = im; p != nil; p = p->next){
- strcat(s, p->sym->name);
- if(p->next != nil)
- strcat(s, "+");
- }
- return s;
- }
- /* check all implementation modules have consistent declarations
- * and create their union if needed
- */
- Decl*
- modimp(Dlist *dl, Decl *im)
- {
- Decl *u, *d, *dd, *ids, *dot, *last;
- Sym *s;
- Dlist *dl0;
- long sg, sg0;
- char buf[StrSize], *un;
- if(dl->next == nil)
- return dl->d;
- dl0 = dl;
- sg0 = 0;
- un = uname(im);
- seprint(buf, buf+sizeof(buf), ".m.%s", un);
- installids(Dglobal, mkids(&dl->d->src, enter(buf, 0), tnone, nil));
- u = dupdecl(dl->d);
- u->sym = enter(un, 0);
- u->sym->decl = u;
- u->ty = mktype(&u->src.start, &u->src.stop, Tmodule, nil, nil);
- u->ty->decl = u;
- last = nil;
- for( ; dl != nil; dl = dl->next){
- d = dl->d;
- ids = d->ty->tof->ids; /* iface */
- if(ids != nil && ids->store == Dglobal) /* .mp */
- sg = sign(ids);
- else
- sg = 0;
- if(dl == dl0)
- sg0 = sg;
- else if(sg != sg0)
- error(d->src.start, "%s's module data not consistent with that of %s\n", d->sym->name, dl0->d->sym->name);
- for(ids = d->ty->ids; ids != nil; ids = ids->next){
- s = ids->sym;
- if(s->decl != nil && s->decl->scope >= scope){
- if(ids == s->decl){
- dd = dupdecl(ids);
- if(u->ty->ids == nil)
- u->ty->ids = dd;
- else
- last->next = dd;
- last = dd;
- continue;
- }
- dot = s->decl->dot;
- if(s->decl->store != Dwundef && dot != nil && dot != d && isimpmod(dot->sym) && dequal(ids, s->decl, 1))
- ids->refs = s->decl->refs;
- else
- redecl(ids);
- ids->init = s->decl->init;
- }
- }
- }
- u->ty = usetype(u->ty);
- return u;
- }
- static void
- modres(Decl *d)
- {
- Decl *ids, *id, *n, *i;
- Type *t;
- for(ids = d->ty->ids; ids != nil; ids = ids->next){
- id = ids->sym->decl;
- if(ids != id){
- n = ids->next;
- i = ids->iface;
- t = ids->ty;
- *ids = *id;
- ids->next = n;
- ids->iface = i;
- ids->ty = t;
- }
- }
- }
- /* update the fields of duplicate declarations in other implementation modules
- * and their union
- */
- void
- modresolve(void)
- {
- Dlist *dl;
- dl = impdecls;
- if(dl->next == nil)
- return;
- for( ; dl != nil; dl = dl->next)
- modres(dl->d);
- modres(impdecl);
- }
|