1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834 |
- ' Copyright (c) 2013-2024 Bruce A Henderson
- '
- ' Based on the public domain Monkey "trans" by Mark Sibly
- '
- ' This software is provided 'as-is', without any express or implied
- ' warranty. In no event will the authors be held liable for any damages
- ' arising from the use of this software.
- '
- ' Permission is granted to anyone to use this software for any purpose,
- ' including commercial applications, and to alter it and redistribute it
- ' freely, subject to the following restrictions:
- '
- ' 1. The origin of this software must not be misrepresented; you must not
- ' claim that you wrote the original software. If you use this software
- ' in a product, an acknowledgment in the product documentation would be
- ' appreciated but is not required.
- '
- ' 2. Altered source versions must be plainly marked as such, and must not be
- ' misrepresented as being the original software.
- '
- ' 3. This notice may not be removed or altered from any source
- ' distribution.
- '
- SuperStrict
- Import BRL.MaxUtil
- Import "toker.bmx"
- Include "iparser.bmx"
- Global FILE_EXT$="bmx"
- Type TForEachinStmt Extends TLoopStmt
- Field varid$
- Field varty:TType
- Field varlocal:Int
- Field expr:TExpr
- Field varExpr:TExpr
-
- Method Create:TForEachinStmt( varid$,varty:TType,varlocal:Int,expr:TExpr,block:TBlockDecl,loopLabel:TLoopLabelDecl,varExpr:TExpr )
- Self.varid=varid
- Self.varty=varty
- Self.varlocal=varlocal
- Self.expr=expr
- Self.block=block
- block.extra = Self
- Self.loopLabel=loopLabel
- Self.varExpr = varExpr
- Return Self
- End Method
- Method OnCopy:TStmt( scope:TScopeDecl )
- If loopLabel Then
- If varExpr Then
- Return New TForEachinStmt.Create( varid,varty,varlocal,expr.Copy(),block.CopyBlock( scope ),TLoopLabelDecl(loopLabel.Copy()), varExpr.Copy() )
- Else
- Return New TForEachinStmt.Create( varid,varty,varlocal,expr.Copy(),block.CopyBlock( scope ),TLoopLabelDecl(loopLabel.Copy()), Null )
- End If
- Else
- If varExpr Then
- Return New TForEachinStmt.Create( varid,varty,varlocal,expr.Copy(),block.CopyBlock( scope ),Null, varExpr.Copy() )
- Else
- Return New TForEachinStmt.Create( varid,varty,varlocal,expr.Copy(),block.CopyBlock( scope ),Null, Null )
- End If
- End If
- End Method
- Method OnSemant()
- Const NotIterableError:String = "EachIn requires a type that implements IIterable or has a suitable ObjectEnumerator method."
-
- expr=expr.Semant()
- If TArrayType( expr.exprType ) Or TStringType( expr.exprType )
- Local exprTmp:TLocalDecl
- Local exprVar:TExpr
- If TArrayType( expr.exprType ).isStatic And (TVarExpr(expr) Or TMemberVarExpr(expr)) Then ' TODO TSliceExpr
- exprVar = expr
- Else
- exprTmp = New TLocalDecl.Create( "",Null,expr,,True )
- exprVar = New TVarExpr.Create( exprTmp )
- End If
-
- Local indexTmp:TLocalDecl=New TLocalDecl.Create( "",Null,New TConstExpr.Create( New TUIntType,"0" ),,True )
- Local lenExpr:TExpr=New TIdentExpr.Create( "Length",exprVar )
- Local cmpExpr:TExpr=New TBinaryCompareExpr.Create( "<",New TVarExpr.Create( indexTmp ),lenExpr )
- Local indexExpr:TExpr=New TIndexExpr.Create( exprVar,[New TVarExpr.Create( indexTmp )] )
- Local addExpr:TExpr=New TBinaryMathExpr.Create( "+",New TVarExpr.Create( indexTmp ),New TConstExpr.Create( New TIntType,"1" ) )
- Local cont:TContinueStmt
-
- If varlocal
- ' array of object ?
- If TArrayType( expr.exprType ) And TObjectType(TArrayType( expr.exprType ).elemType) And (Not TObjectType(TArrayType( expr.exprType ).elemType).classdecl.IsExtern() ..
- Or (TObjectType(TArrayType( expr.exprType ).elemType).classdecl.IsExtern() ..
- And IsPointerType(TArrayType( expr.exprType ).elemType))) Then
- Local isStruct:Int = TObjectType(TArrayType( expr.exprType ).elemType).classdecl.IsStruct()
- Local cExpr:TExpr
- Local varObjTmp:TLocalDecl
- Local varObjStmt:TStmt
-
- If exprTmp Then
- exprTmp.Semant()
- End If
- indexTmp.Semant()
-
- If TIdentType(varty) And TIdentType(varty).ident = "Object" Then
- cExpr = indexExpr
- Else
- If TStringType(varty) Then
- varObjTmp = New TLocalDecl.Create( "",TType.objectType,indexExpr,,True)
- varObjTmp.Semant()
- Local varObjExpr:TExpr=New TVarExpr.Create( varObjTmp )
-
- Local expr:TExpr = New TFuncCallExpr.Create( New TIdentExpr.Create( "ObjectIsString"), [varObjExpr])
- expr=New TBinaryCompareExpr.Create( "=",expr, New TConstExpr.Create( New TIntType,"0" ))
-
- Local thenBlock:TBlockDecl=New TBlockDecl.Create( block.scope, True, BLOCK_IF )
- Local elseBlock:TBlockDecl=New TBlockDecl.Create( block.scope, True, BLOCK_ELSE )
- cont = New TContinueStmt.Create(Null, True)
- thenBlock.AddStmt cont
-
- varObjStmt = New TIfStmt.Create( expr,thenBlock,elseBlock, True )
- 'block.stmts.AddFirst New TIfStmt.Create( expr,thenBlock,elseBlock, True )
-
- cExpr = New TCastExpr.Create( varty, varObjExpr,CAST_EXPLICIT )
- Else
- cExpr = New TCastExpr.Create( varty, indexExpr,CAST_EXPLICIT )
- End If
- 'cExpr = New TCastExpr.Create( varty, indexExpr,CAST_EXPLICIT )
- End If
- ' local variable
- Local varTmp:TLocalDecl=New TLocalDecl.Create( varid,varty,cExpr )
- ' local var as expression
- Local expr:TExpr=New TVarExpr.Create( varTmp )
- If Not isStruct And Not varObjTmp Then
- ' var = Null
- expr=New TBinaryCompareExpr.Create( "=",expr, New TNullExpr.Create(TType.nullObjectType))
-
- ' then continue
- Local thenBlock:TBlockDecl=New TBlockDecl.Create( block.scope, , BLOCK_IF )
- Local elseBlock:TBlockDecl=New TBlockDecl.Create( block.scope, , BLOCK_ELSE )
- cont = New TContinueStmt
- thenBlock.AddStmt cont
-
- block.stmts.AddFirst New TIfStmt.Create( expr,thenBlock,elseBlock )
- End If
- block.stmts.AddFirst New TAssignStmt.Create( "=",New TVarExpr.Create( indexTmp ),addExpr )
- block.stmts.AddFirst New TDeclStmt.Create( varTmp )
- If varObjTmp Then
- block.stmts.AddFirst varObjStmt
- block.stmts.AddFirst New TDeclStmt.Create( varObjTmp, True )
- End If
- Else
- Local varTmp:TLocalDecl=New TLocalDecl.Create( varid,varty,indexExpr )
- block.stmts.AddFirst New TAssignStmt.Create( "=",New TVarExpr.Create( indexTmp ),addExpr, True )
- block.stmts.AddFirst New TDeclStmt.Create( varTmp, True )
- End If
- Else
-
- If TArrayType( expr.exprType ) And TObjectType(TArrayType( expr.exprType ).elemType) Then
- ' var = Null
- If Not varty Then
- varExpr = varExpr.Semant()
- varty = varExpr.exprType
- 'Local decl:TValDecl = block.scope.FindValDecl(varid.ToLower())
-
- 'If decl Then
- ' decl.Semant()
- '
- ' varty = decl.ty.Copy()
- 'End If
- End If
- Local isStruct:Int = TObjectType(TArrayType( expr.exprType ).elemType).classdecl.IsStruct()
- ' expr=New TBinaryCompareExpr.Create( "=",New TIdentExpr.Create( varid ), New TNullExpr.Create(TType.nullObjectType))
- If Not isStruct Then
- expr=New TBinaryCompareExpr.Create( "=",varExpr, New TNullExpr.Create(TType.nullObjectType))
-
- ' then continue
- Local thenBlock:TBlockDecl=New TBlockDecl.Create( block.scope, , BLOCK_IF )
- Local elseBlock:TBlockDecl=New TBlockDecl.Create( block.scope, , BLOCK_ELSE )
- cont = New TContinueStmt
- thenBlock.AddStmt cont
-
- block.stmts.AddFirst New TIfStmt.Create( expr,thenBlock,elseBlock )
- End If
- 'block.stmts.AddFirst New TDeclStmt.Create( varTmp )
- block.stmts.AddFirst New TAssignStmt.Create( "=",New TVarExpr.Create( indexTmp ),addExpr, True )
- ' block.stmts.AddFirst New TAssignStmt.Create( "=",New TIdentExpr.Create( varid ),New TCastExpr.Create( varty, indexExpr,CAST_EXPLICIT ), True )
- block.stmts.AddFirst New TAssignStmt.Create( "=",varExpr,New TCastExpr.Create( varty, indexExpr,CAST_EXPLICIT ), True )
- Else
- block.stmts.AddFirst New TAssignStmt.Create( "=",New TVarExpr.Create( indexTmp ),addExpr, True )
- ' block.stmts.AddFirst New TAssignStmt.Create( "=",New TIdentExpr.Create( varid ),indexExpr, True )
- block.stmts.AddFirst New TAssignStmt.Create( "=",varExpr,indexExpr, True )
- End If
- EndIf
- Local whileStmt:TWhileStmt=New TWhileStmt.Create( cmpExpr,block,loopLabel, True )
- block=New TBlockDecl.Create( block.scope, True, BLOCK_LOOP )
- If exprTmp Then
- block.AddStmt New TDeclStmt.Create( exprTmp, True )
- End If
- block.AddStmt New TDeclStmt.Create( indexTmp, True )
- block.AddStmt whileStmt
-
- If cont Then
- cont.loop = whileStmt
- End If
- Else If TObjectType( expr.exprType )
- Local tmpDecl:TDeclStmt
- Local iterable:Int
- ' ensure semanted
- TObjectType(expr.exprType).classDecl.Semant()
-
- If TObjectType(expr.exprType).classDecl.ImplementsInterface("iiterable") Or (TObjectType(expr.exprType).classDecl.ident="IIterable" And TObjectType(expr.exprType).classDecl.IsInterface()) Then
- iterable = True
- Else
- Local declList:TFuncDeclList = TFuncDeclList(TObjectType(expr.exprType).classDecl.GetDecl("objectenumerator"))
- If Not declList Then
- Err NotIterableError
- End If
- End If
- If TInvokeExpr(expr) Or TInvokeMemberExpr(expr) Then
- Local tmpVar:TLocalDecl=New TLocalDecl.Create( "",expr.exprType,expr,,True )
- tmpVar.Semant()
- tmpDecl = New TDeclStmt.Create( tmpVar, True )
- expr = New TVarExpr.Create( tmpVar )
- End If
- Local enumerInit:TExpr
- If iterable Then
- enumerInit = New TFuncCallExpr.Create( New TIdentExpr.Create( "GetIterator",expr ) )
- Else
- enumerInit = New TFuncCallExpr.Create( New TIdentExpr.Create( "ObjectEnumerator",expr ) )
- End If
- Local enumerTmp:TLocalDecl=New TLocalDecl.Create( "",Null,enumerInit,,True )
- enumerTmp.Semant()
- Local hasNextExpr:TExpr
- If iterable Then
- hasNextExpr = New TFuncCallExpr.Create( New TIdentExpr.Create( "MoveNext",New TVarExpr.Create( enumerTmp ) ) )
- Else
- hasNextExpr = New TFuncCallExpr.Create( New TIdentExpr.Create( "HasNext",New TVarExpr.Create( enumerTmp ) ) )
- End If
-
- Local nextObjExpr:TExpr
- If iterable Then
- nextObjExpr = New TFuncCallExpr.Create( New TIdentExpr.Create( "Current",New TVarExpr.Create( enumerTmp ) ) )
- Else
- nextObjExpr = New TFuncCallExpr.Create( New TIdentExpr.Create( "NextObject",New TVarExpr.Create( enumerTmp ) ) )
- End If
- Local cont:TContinueStmt
-
- If varlocal
- ' Local varTmp:TLocalDecl=New TLocalDecl.Create( varid,varty,nextObjExpr )
- ' block.stmts.AddFirst New TDeclStmt.Create( varTmp )
- Local cExpr:TExpr
-
- Local varObjTmp:TLocalDecl
- Local varObjStmt:TStmt
-
- If iterable Or (TIdentType(varty) And TIdentType(varty).ident = "Object") Then
- cExpr = nextObjExpr
- Else
- If TStringType(varty) Then
- varObjTmp = New TLocalDecl.Create( "",TType.objectType,nextObjExpr,,True)
- varObjTmp.Semant()
- Local varObjExpr:TExpr=New TVarExpr.Create( varObjTmp )
-
- Local expr:TExpr = New TFuncCallExpr.Create( New TIdentExpr.Create( "ObjectIsString"), [varObjExpr])
- expr=New TBinaryCompareExpr.Create( "=",expr, New TConstExpr.Create( New TIntType,"0" ))
-
- Local thenBlock:TBlockDecl=New TBlockDecl.Create( block.scope, True, BLOCK_IF )
- Local elseBlock:TBlockDecl=New TBlockDecl.Create( block.scope, True, BLOCK_ELSE )
- cont = New TContinueStmt.Create(Null, True)
- thenBlock.AddStmt cont
-
- varObjStmt = New TIfStmt.Create( expr,thenBlock,elseBlock, True )
- 'block.stmts.AddFirst New TIfStmt.Create( expr,thenBlock,elseBlock, True )
-
- cExpr = New TCastExpr.Create( varty, varObjExpr,CAST_EXPLICIT )
- Else
- cExpr = New TCastExpr.Create( varty, nextObjExpr,CAST_EXPLICIT )
- End If
- End If
- ' local variable
- Local varTmp:TLocalDecl=New TLocalDecl.Create( varid,varty,cExpr)
- If Not TNumericType(varty) And Not varObjTmp Then
- If iterable Then
- '
- Else
- ' local var as expression
- Local expr:TExpr=New TVarExpr.Create( varTmp )
-
- ' var = Null
- expr=New TBinaryCompareExpr.Create( "=",expr, New TNullExpr.Create(TType.nullObjectType))
-
- ' then continue
- Local thenBlock:TBlockDecl=New TBlockDecl.Create( block.scope, True, BLOCK_IF )
- Local elseBlock:TBlockDecl=New TBlockDecl.Create( block.scope, True, BLOCK_ELSE )
- cont = New TContinueStmt.Create(Null, True)
- thenBlock.AddStmt cont
-
- block.stmts.AddFirst New TIfStmt.Create( expr,thenBlock,elseBlock, True )
- End If
- End If
- block.stmts.AddFirst New TDeclStmt.Create( varTmp, True )
- If varObjTmp Then
- block.stmts.AddFirst varObjStmt
- block.stmts.AddFirst New TDeclStmt.Create( varObjTmp, True )
- End If
- Else
- If Not varty Then
- varExpr = varExpr.Semant()
- varty = varExpr.exprType
- End If
-
- Local varObjTmp:TLocalDecl
- Local varObjStmt:TStmt
- Local cExpr:TExpr
-
- If TStringType(varty) Then
- varObjTmp = New TLocalDecl.Create( "",TType.objectType,nextObjExpr,,True)
- varObjTmp.Semant()
- Local varObjExpr:TExpr=New TVarExpr.Create( varObjTmp )
-
- Local expr:TExpr = New TFuncCallExpr.Create( New TIdentExpr.Create( "ObjectIsString"), [varObjExpr])
- expr=New TBinaryCompareExpr.Create( "=",expr, New TConstExpr.Create( New TIntType,"0" ))
-
- Local thenBlock:TBlockDecl=New TBlockDecl.Create( block.scope, True, BLOCK_IF )
- Local elseBlock:TBlockDecl=New TBlockDecl.Create( block.scope, True, BLOCK_ELSE )
- cont = New TContinueStmt.Create(Null, True)
- thenBlock.AddStmt cont
- varObjStmt = New TIfStmt.Create( expr,thenBlock,elseBlock, True )
- 'block.stmts.AddFirst New TIfStmt.Create( expr,thenBlock,elseBlock, True )
-
- cExpr = New TCastExpr.Create( varty, varObjExpr,CAST_EXPLICIT )
- Else
- cExpr = New TCastExpr.Create( varty, nextObjExpr,CAST_EXPLICIT )
- End If
- ' If Not varty Then
- ' Local decl:TValDecl = block.scope.FindValDecl(varid.ToLower())
- '
- ' If decl Then
- ' decl.Semant()
- '
- ' varty = decl.ty.Copy()
- ' End If
- ' End If
-
- ' var = Null
- ' Local expr:TExpr=New TBinaryCompareExpr.Create( "=",New TIdentExpr.Create( varid ), New TNullExpr.Create(TType.nullObjectType))
- If Not TNumericType(varty) And Not varObjTmp Then
- If iterable Then
- '
- Else
- Local expr:TExpr=New TBinaryCompareExpr.Create( "=",varExpr, New TNullExpr.Create(TType.nullObjectType))
-
- ' then continue
- Local thenBlock:TBlockDecl=New TBlockDecl.Create( block.scope, ,BLOCK_IF )
- Local elseBlock:TBlockDecl=New TBlockDecl.Create( block.scope, ,BLOCK_ELSE )
- cont = New TContinueStmt
- thenBlock.AddStmt cont
-
- block.stmts.AddFirst New TIfStmt.Create( expr,thenBlock,elseBlock )
- 'block.stmts.AddFirst New TDeclStmt.Create( varTmp )
- End If
- End If
- ' block.stmts.AddFirst New TAssignStmt.Create( "=",New TIdentExpr.Create( varid ),New TCastExpr.Create( varty, nextObjExpr,CAST_EXPLICIT ))
- block.stmts.AddFirst New TAssignStmt.Create( "=",varExpr,cExpr)
- If varObjTmp Then
- block.stmts.AddFirst varObjStmt
- block.stmts.AddFirst New TDeclStmt.Create( varObjTmp, True )
- End If
- EndIf
- Local whileStmt:TWhileStmt=New TWhileStmt.Create( hasNextExpr,block, loopLabel, True )
- block=New TBlockDecl.Create( block.scope, True, BLOCK_LOOP )
- If tmpDecl Then
- block.AddStmt tmpDecl
- End If
- block.AddStmt New TDeclStmt.Create( enumerTmp, True )
- block.AddStmt whileStmt
-
- If cont Then
- cont.loop = whileStmt
- End If
- Else
- Err NotIterableError
- EndIf
- block.Semant
- End Method
- Method Trans$()
- _trans.EmitBlock block
- End Method
- End Type
- Type TIncbin
- Field file:String
- Field path:String
- Field id:Int
- Field length:Int
- Global count:Int
- Method Create:TIncbin(file:String, source:String)
- count :+ 1
- Self.file = file
- ' find the file
- If Not FileType(file) Then
- ' maybe relative to source
- Local dir:String = ExtractDir(source) + "/" + file
- If FileType(dir) = FILETYPE_FILE Then
- path = RealPath(dir)
- Else
- Return Null
- End If
- Else
- path = RealPath(file)
- End If
- id = count
- Return Self
- End Method
-
- Method GeneratedDataName:String(app:TAppDecl)
- Return "_ib" + app.munged + "_" + id + "_data"
- End Method
- Method GeneratedSizeName:String(app:TAppDecl)
- Return "_ib" + app.munged + "_" + id + "_size"
- End Method
- End Type
- '***** Parser *****
- Type TParser Extends TGenProcessor
- Field _toker:TToker
- Field _toke:String
- Field _tokeType:Int
- Field _block:TBlockDecl
- Field _blockStack:TList=New TList'<TBlockDecl>
- Field _errStack:TStringList=New TStringList
- Field _app:TAppDecl
- Field _module:TModuleDecl
- Field _externCasts:TMap = New TMap
-
- Field unknownIdentsEvalFalse:Int
- Method SetErr(toker:TToker = Null)
- Local t:TToker = _toker
- If toker Then
- t = toker
- End If
- If t.Path()
- _errInfo=FormatError(t.Path(),t.Line(),0)
- EndIf
- End Method
- Method DoErr(error:String, toker:TToker = Null)
- SetErr(toker)
- Err error
- End Method
- Method PushBlock( block:TBlockDecl )
- If _block <> Null Then
- _blockStack.AddLast _block
- End If
- _errStack.AddLast _errInfo
- _block=block
- End Method
- Method PopBlock()
- _block=TBlockDecl(_blockStack.RemoveLast())
- _errInfo=String(_errStack.RemoveLast())
- End Method
- Method RealPath$( path$ )
- Local popDir$=CurrentDir()
- ChangeDir ExtractDir( _toker.Path() )
- path=BRL.FileSystem.RealPath( path )
- ChangeDir popDir
- Return path
- End Method
- Method ActualPath:String(path:String)
- Local dir:String = ExtractDir(path)
- Local origFile:String = StripDir(path)
- Local lowerFile:String = origFile.ToLower()
-
- Local actualDir:String = ExtractDir(RealPath(path))
- Local files:String[] = LoadDir(actualDir)
- For Local file:String = EachIn files
- If file.ToLower() = lowerFile Then
- If file <> origFile Then
- ' we could raise as a warning instead, but an error encourages the user to fix their code ;-)
- Err "Actual file '" + file + "' differs in case with import '" + origFile + "'"
-
- ' what we might do were we to warn instead...
- If dir Then
- Return dir + "/" + file
- Else
- Return file
- End If
- End If
- Exit
- End If
- Next
- Return path
- End Method
-
- Method NextToke$()
- Local toke$=_toke
- Repeat
- _toke=_toker.NextToke()
- _tokeType=_toker.TokeType()
- Until _tokeType<>TOKE_SPACE
- If _tokeType=TOKE_KEYWORD _toke=_toker._tokeLower
- If toke="," SkipEols
- Return _toke
- End Method
- Method NextTokeToker$(toker:TToker)
- ' Local toke$=toker._toke
- Repeat
- toker.NextToke()
- Until toker.tokeType()<>TOKE_SPACE
- Return toker._toke
- End Method
- Method DescribeToke:String( toke:String )
- Select toke
- Case "~n"
- Return "end-of-line"
- End Select
- Local uni:String
- If toke.length > 0 And toke[0] > 255 Then
- uni = " (unicode : " + _toker._lastTCHR + ")"
- End If
- Return "'" + toke + "'" + uni
- End Method
- Method CParse:Int( toke$ )
- If _toke.ToLower()<>toke
- Return False
- EndIf
- NextToke
- Return True
- End Method
- Method CParseToker:Int( toker:TToker, toke$ )
- If toker._toke.ToLower()<>toke
- Return False
- EndIf
- NextTokeToker(toker)
- Return True
- End Method
- Method Parse( toke$ )
- If Not CParse( toke )
- DoErr "Syntax error - expecting '"+toke+"' but found " + DescribeToke(_toke)
- EndIf
- End Method
- Method ParseToker( toker:TToker, toke$ )
- If Not CParseToker( toker, toke )
- DoErr "Syntax error - expecting '"+toke+"'.", toker
- EndIf
- End Method
- Method AtEos:Int()
- Return _toke="" Or _toke=";" Or _toke="~n" Or _toke="else"
- End Method
- Method SkipEols()
- While CParse( "~n" ) Or CParse(";")
- Wend
- SetErr
- End Method
- Method SkipEolsToker(toker:TToker)
- While CParseToker( toker, "~n" )
- Wend
- SetErr
- End Method
- Method ParseStringLit$()
- If _tokeType<>TOKE_STRINGLIT Err "Expecting string literal."
- Local str$=BmxUnquote( _toke )
- NextToke
- Return str
- End Method
- Method ParseIdent$()
- Select _toke
- Case "@" NextToke
- Case "string","object", "self"
- Default
- If _tokeType<>TOKE_IDENT Then
- Local kw:String
- If _tokeType = TOKE_KEYWORD Then
- kw = " keyword"
- End If
- Err "Syntax error - expecting identifier, but found" + kw + " '" + EscapeLines(_toke) + "'"
- End If
- End Select
- Local id$=_toke
- NextToke
- Return id
- End Method
- Method ParseIdentType:TIdentType()
- Local id$=ParseIdent()
- If CParse( "." ) id:+"."+ParseIdent()
- If CParse( "." ) id:+"."+ParseIdent()
- Local args:TType[]
- If CParse( "<" )
- Local nargs:Int
- Repeat
- Local arg:TType = ParseType()
-
- Repeat
- If (_toke = "[" Or _toke = "[]") And IsArrayDef()
- arg = ParseArrayType(arg)
- Else If _toke = "(" Then
- Local argDecls:TArgDecl[] = ParseFuncParamDecl()
- arg = New TFunctionPtrType.Create(New TFuncDecl.CreateF("", arg, argDecls, FUNC_PTR))
- Else
- Exit
- End If
- Forever
-
- If args.Length=nargs args=args+ New TType[10]
- args[nargs]=arg
- nargs:+1
- Until Not CParse(",")
- args=args[..nargs]
- Parse ">"
- EndIf
- Return New TIdentType.Create( id,args )
- End Method
- Method CParseIdentType:TIdentType( inner:Int=False )
- If _tokeType<>TOKE_IDENT Return Null
- Local id$=ParseIdent()
- While CParse( "." )
- If _tokeType<>TOKE_IDENT Return Null
- id:+"."+ParseIdent()
- Wend
- If Not CParse( "<" )
- If inner Return New TIdentType.Create( id,Null )
- Return Null
- EndIf
- Local args:TType[]
- Local nargs:Int
- Repeat
- Local arg:TType=CParsePrimitiveType()
- If Not arg
- arg=CParseIdentType( True )
- If Not arg Return Null
- EndIf
- While IsArrayDef()
- arg = ParseArrayType(arg)
- Wend
- ' While CParse( "[]" )
- ' arg=arg.ArrayOf()
- ' Wend
- args = args + [arg]
- nargs :+ 1
- Until Not CParse(",")
- If Not CParse( ">" ) Return Null
- Return New TIdentType.Create( id,args )
- End Method
- Method CParsePrimitiveType:TType()
- If CParse( "string" ) Return TType.stringType
- If CParse( "object" ) Return New TIdentType.Create( "brl.classes.object" )
- Local ty:TType
- If CParse( "short" )
- ty = New TShortType
- Else If CParse( "byte" )
- ty = New TByteType
- Else If CParse( "int" )
- ty = New TIntType
- Else If CParse( "uint" )
- ty = New TUIntType
- Else If CParse( "float" )
- ty = New TFloatType
- Else If CParse( "long" )
- ty = New TLongType
- Else If CParse( "ulong" )
- ty = New TULongType
- Else If CParse( "longint" )
- ty = New TLongIntType
- Else If CParse( "ulongint" )
- ty = New TULongIntType
- Else If CParse( "double" )
- ty = New TDoubleType
- Else If CParse( "size_t" )
- ty = New TSizeTType
- Else If CParse( "int128" ) Then
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- ty = New TInt128Type
- Else If CParse( "float128" ) Then
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- ty = New TFloat128Type
- Else If CParse( "double128" ) Then
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- ty = New TDouble128Type
- Else If CParse( "float64" ) Then
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- ty = New TFloat64Type
- Else If CParse( "wparam" ) Then
- If opt_platform <> "win32" Err "WParam types only available on Win32"
- ty = New TWParamType
- Else If CParse( "lparam" ) Then
- If opt_platform <> "win32" Err "LParam types only available on Win32"
- ty = New TLParamType
- End If
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- Return ty
- End Method
- Method CParsePrimitiveNumberType:TType()
- If CParse( "short" ) Return New TShortType
- If CParse( "byte" ) Return New TByteType
- If CParse( "int" ) Return New TIntType
- If CParse( "uint" ) Return New TUIntType
- If CParse( "float" ) Return New TFloatType
- If CParse( "long" ) Return New TLongType
- If CParse( "ulong" ) Return New TULongType
- If CParse( "longint" ) Return New TLongIntType
- If CParse( "ulongint" ) Return New TULongIntType
- If CParse( "double" ) Return New TDoubleType
- If CParse( "size_t" ) Return New TSizeTType
- If CParse( "int128" ) Then
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- Return New TInt128Type
- End If
- If CParse( "float128" ) Then
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- Return New TFloat128Type
- End If
- If CParse( "double128" ) Then
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- Return New TDouble128Type
- End If
- If CParse( "float64" ) Then
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- Return New TFloat64Type
- End If
- If CParse( "wparam" ) Then
- If opt_platform <> "win32" Err "WParam types only available on Win32"
- Return New TWParamType
- End If
- If CParse( "lparam" ) Then
- If opt_platform <> "win32" Err "LParam types only available on Win32"
- Return New TLParamType
- End If
- End Method
- Method ParseNewType:TType()
- If CParse( "void" ) Return New TVoidType
- If CParse( "short" ) Return New TShortType
- If CParse( "byte" ) Return New TByteType
- If CParse( "int" ) Return New TIntType
- If CParse( "uint" ) Return New TUIntType
- If CParse( "float" ) Return New TFloatType
- If CParse( "string" ) Return TType.stringType
- If CParse( "object" ) Return New TIdentType.Create( "brl.classes.object" )
- If CParse( "long" ) Return New TLongType
- If CParse( "ulong" ) Return New TULongType
- If CParse( "longint" ) Return New TLongIntType
- If CParse( "ulongint" ) Return New TULongIntType
- If CParse( "double" ) Return New TDoubleType
- If CParse( "size_t" ) Return New TSizeTType
- If CParse( "int128" ) Then
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- Return New TInt128Type
- End If
- If CParse( "float128" ) Then
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- Return New TFloat128Type
- End If
- If CParse( "double128" ) Then
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- Return New TDouble128Type
- End If
- If CParse( "float64" ) Then
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- Return New TFloat64Type
- End If
- If CParse( "wparam" ) Then
- If opt_platform <> "win32" Err "WParam types only available on Win32"
- Return New TWParamType
- End If
- If CParse( "lparam" ) Then
- If opt_platform <> "win32" Err "LParam types only available on Win32"
- Return New TLParamType
- End If
- Return ParseIdentType()
- End Method
- Method ParseType:TType()
- Local ty:TType=CParsePrimitiveType()
- If ty Return ty
- Return ParseIdentType()
- End Method
- Method ParseConstNumberType:TType()
- Local ty:TType
- Select _toke
- Case "@"
- NextToke
- ty=New TByteType
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- Case "@@"
- NextToke
- ty=New TShortType
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- Case "%"
- NextToke
- ty=New TIntType
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- Case "#"
- NextToke
- ty=New TFloatType
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- Case "$"
- NextToke
- ty=New TStringType
- Case "!"
- NextToke
- ty=New TDoubleType
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- Case "%%"
- NextToke
- ty=New TLongType
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- Case ":"
- NextToke
- ty=CParsePrimitiveNumberType()
- If Not ty Then
- If CParse("string") Then
- ty=New TStringType
- Else
- ty = ParseIdentType()
- End If
- Else
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- End If
- End Select
- While IsArrayDef()
- ty = ParseArrayType(ty)
- Wend
- 'While CParse( "[]" )
- ' ty=New TArrayType.Create( ty )
- 'Wend
- Return ty
- End Method
- Method ParseDeclType:TType(attr:Long = 0)
- Local ty:TType
- Select _toke
- Case "@"
- NextToke
- ty=New TByteType
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- Case "@@"
- NextToke
- ty=New TShortType
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- Case "%"
- NextToke
- ty=New TIntType
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- Case "%%"
- NextToke
- ty=New TLongType
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- Case "#"
- NextToke
- ty=New TFloatType
- If CParse("ptr") Then
- ty = TType.MapToPointerType(ty)
- End If
- Case "$"
- NextToke
- ty=New TStringType
- If CParse("z") Then
- ty._flags :| TType.T_CHAR_PTR
- Else If CParse("w") Then
- ty._flags :| TType.T_SHORT_PTR
- End If
- Case "!"
- NextToke
- ty=New TDoubleType
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- Case ":"
- NextToke
- ty=ParseType()
- If CParse("ptr") Then
-
- ' FIXME #200
- 'If TStringType(ty) = Null And (TObjectType(ty) = Null Or (TObjectType(ty) <> Null And TObjectType(ty).classDecl.IsExtern())) And TArrayType(ty) = Null Then
- ty = TType.MapToPointerType(ty)
-
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- 'Else
- ' ty = Null
- 'End If
- If Not ty DoErr "Invalid Pointer type."
- End If
- Case "("
- ' for Strict code, void will be converted to Int during semanting.
- ty=New TVoidType
- Default
- If _module.IsSuperStrict() Err "Missing type specifier."
- ty=New TIntType
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- End Select
-
- ' array or function pointer?
- Repeat
- If (_toke = "[" Or _toke = "[]") And (IsArrayDef() Or IsArrayDef(attr & DECL_STATIC > 0)) Then
- If Not IsArrayDef(attr & DECL_STATIC > 0) Then
- Err "Invalid static array initialization."
- Else
- If attr & DECL_STATIC > 0 Then
- Exit
- End If
- ty = ParseArrayType(ty)
- End If
- Else If _toke = "(" Then
- Local args:TArgDecl[] = ParseFuncParamDecl()
- attr :| ParseCallConvention(attr & DECL_API_STDCALL)
- ty = New TFunctionPtrType.Create(New TFuncDecl.CreateF("", ty, args, FUNC_PTR | (attr & DECL_API_STDCALL)))
- Else
- Exit
- End If
- Forever
-
- Return ty
- End Method
- Method ParseArrayExpr:TArrayExpr()
- Parse "["
- Local args:TExpr[],nargs:Int
- Repeat
- Local arg:TExpr=ParseExpr()
- If args.Length=nargs args=args + New TExpr[10]
- args[nargs]=arg
- nargs:+1
- Until Not CParse(",")
- args=args[..nargs]
- Parse "]"
- Return New TArrayExpr.Create( args )
- End Method
- ' replaces While CParse( "[]" ) sections, with support for multi-dimension arrays
- Method ParseArrayType:TType(ty:TType, isStatic:Int = False)
- If isStatic Then
- Parse("[")
- Local expr:TExpr = ParseUnaryExpr()
- ty = New TArrayType.Create( ty )
- TArrayType(ty).isStatic = True
- Parse("]")
- Return ty
- End If
- While True
- Local dims:Int = 1
-
- If CParse("[]") Then
- ty=New TArrayType.Create( ty )
-
- ' test for array of arrays
- If IsArrayTypeNext(_toker) Continue
-
- Exit
- End If
-
- If Not CParse("[") Then
- Exit
- End If
-
- While CParse( ",")
- dims :+ 1
- Wend
-
- Parse "]"
-
- ty=New TArrayType.Create( ty, dims )
-
- ' test for array of arrays
- If IsArrayTypeNext(_toker) Continue
-
- Exit
- Wend
- Return ty
- End Method
-
- Method IsArrayTypeNext:Int(tok:TToker)
- Local toker:TToker=New TToker.Copy(tok)
- If CParseToker(toker, "[]") Return True
- If CParseToker(toker, "[") Then
- ' look ahead to see if this is an array decl, or something else..
- If CParseToker(toker, "]") Or CParseToker(toker, ",") Then
- Return True
- End If
- End If
- Return False
- End Method
-
- Method IsArrayDef:Int(isStatic:Int = False)
- Local isDef:Int = True
- Local toker:TToker=New TToker.Copy(_toker)
- If isStatic Then
- If Not CParseToker(toker, "[") Then
- Return False
- End If
- NextTokeToker(toker)
- If Not CParseToker(toker, "]") Then
- Return False
- End If
- Return True
- End If
- While True
- 'Local dims:Int = 1
-
- If CParseToker(toker, "[]") Then
- Exit
- End If
-
- If Not CParseToker(toker, "[") Then
- isDef = False
- Exit
- End If
-
- While CParseToker(toker, ",")
- 'dims :+ 1
- Wend
-
- If Not CParseToker(toker, "]") Then
- isDef = False
- Exit
- End If
- Exit
- Wend
- Return isDef
- End Method
- Method ParseArgs:TExpr[]( stmt:Int )
- Local args:TExpr[]
- If stmt
- If AtEos() Return args
- Else
- If _toke<>"(" Return args
- EndIf
- Local nargs:Int,eat:Int
- If _toke="("
- If stmt
- Local toker:TToker=New TToker.Copy(_toker),bra:Int=1
- Repeat
- toker.NextToke
- toker.SkipSpace
- Select toker.Toke().ToLower()
- Case "","else"
- Err "Parenthesis mismatch error."
- Case "(","["
- bra:+1
- Case "]",")"
- bra:-1
- If bra Continue
- toker.NextToke
- toker.SkipSpace
- Select toker.Toke().ToLower()
- Case ".","(","[","",";","~n","else"
- eat=True
- End Select
- Exit
- Case ","
- If bra<>1 Continue
- eat=True
- Exit
- End Select
- Forever
- Else
- eat=True
- EndIf
- If eat And NextToke()=")"
- NextToke
- Return args
- EndIf
- EndIf
- Repeat
- Local arg:TExpr
- If _toke And _toke<>"," arg=ParseExpr()
- If args.Length=nargs args=args + New TExpr[10]
- args[nargs]=arg
- nargs:+1
- Until Not CParse(",")
- args=args[..nargs]
- If eat Parse ")"
- Return args
- End Method
- Method ParsePrimaryExpr:TExpr( stmt:Int )
- Local expr:TExpr
- Select _toke.ToLower()
- Case "("
- NextToke
- expr=ParseExpr()
- Parse ")"
- Case "["
- expr=ParseArrayExpr()
- Case "[]"
- NextToke
- expr=New TConstExpr.Create( TType.emptyArrayType,"" )
- Case "."
- expr=New TScopeExpr.Create( _module )
- Case "new"
- NextToke
-
- If _toke = "(" Then
- ' call constructor
- expr=New TNewExpr.Create( ParseArgs(stmt) )
- Else
- Local ty:TType=ParseType()
-
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
-
- If _toke = "[" Or _toke = "[]" Then
- Local depth:Int = 0
- Local ln:TExpr[]
- Local tmpTy:TType = ty.Copy()
-
- Repeat
- Local dims:Int = 1
-
- If CParse("[]") Then
- tmpTy=New TArrayType.Create( tmpTy )
- depth :+ 1
- Continue
- End If
-
- ' looking for an array with expression
- If Not ln Then
- Parse "["
- Else
- If Not CParse("[") Then
- Exit
- Else
- Err "Unexpected '[' after array size declaration"
- End If
- End If
-
- Repeat
- If CParse(",") Then
- dims :+ 1
- Continue
- End If
- If CParse("]") Exit
- ln = ln + [ParseExpr()]
- If CParse("]") Exit
- Parse(",")
- dims :+ 1
- Forever
-
- If Not ln Then
- tmpTy=New TArrayType.Create( tmpTy, dims )
- End If
- Forever
-
- If ln Then
- ty = tmpTy
- End If
-
- ' Repeat
- 'If CParse( "[" )
- ' Repeat
- ' ln = ln + [ParseExpr()]
- ' If CParse("]") Exit
- ' Parse ","
- ' Forever
- 'Parse "]"
- ' ty = ParseArrayType(ty)
- ' Forever
- 'While CParse( "[]" )
- ' ty=New TArrayType.Create( ty)
- 'Wend
- expr=New TNewArrayExpr.Create( ty,ln )
- Else
- expr=New TNewObjectExpr.Create( ty,ParseArgs( stmt ) )
- EndIf
- End If
- Case "null"
- NextToke
- expr = New TNullExpr.Create(TType.nullObjectType)
- 'expr=New TConstExpr.Create( TType.nullObjectType,"" )
- Case "true"
- NextToke
- expr=New TConstExpr.Create( New TIntType,"1" )
- Case "false"
- NextToke
- expr=New TConstExpr.Create( New TIntType,"" )
- Case "int","long","float","double","object","short","byte","size_t","uint","ulong","longint","ulongint","int128","float64","float128","double128","lparam","wparam","string"
- Local id$=_toke
- Local ty:TType=ParseType()
- If TIntType(ty) And id.ToLower() <> "int" Then
- Select id.ToLower()
- Case "byte"
- ty = New TByteType
- Case "short"
- ty = New TShortType
- Case "uint"
- ty = New TUIntType
- Case "long"
- ty = New TLongType
- Case "ulong"
- ty = New TULongType
- Case "longint"
- ty = New TLongIntType
- Case "ulongint"
- ty = New TULongIntType
- Case "float"
- ty = New TFloatType
- Case "double"
- ty = New TDoubleType
- Case "size_t"
- ty = New TSizeTType
- Case "int128"
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- ty = New TInt128Type
- Case "float128"
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- ty = New TFloat128Type
- Case "double128"
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- ty = New TDouble128Type
- Case "float64"
- If opt_arch <> "x64" Err "Intrinsic types only available on x64"
- ty = New TFloat64Type
- Case "wparam"
- If opt_platform <> "win32" Err "WParam types only available on Win32"
- ty = New TWParamType
- Case "lparam"
- If opt_platform <> "win32" Err "LParam types only available on Win32"
- ty = New TLParamType
- End Select
- End If
- While CParse("ptr")
- ty = TType.MapToPointerType(ty)
- Wend
- ' array
- ty = ParseArrayType(ty)
- ' optional brackets
- If CParse( "(" )
- expr=ParseExpr()
- Parse ")"
- expr=New TCastExpr.Create( ty,expr,CAST_EXPLICIT )
- Else
- Local tok:TToker=New TToker.Copy( _toker )
- If id="string" And CParseToker(tok, ".") Then
- expr=New TIdentExpr.Create( id )
- Else
- expr=ParseExpr()
-
- If TBinaryExpr(expr) Then
- ' cast lhs and apply to rhs
- Local cexpr:TCastExpr=New TCastExpr.Create( ty,TBinaryExpr(expr).lhs,CAST_EXPLICIT )
- TBinaryExpr(expr).lhs = cexpr
- Else
- expr=New TCastExpr.Create( ty,expr,CAST_EXPLICIT )
- End If
- End If
- EndIf
- Case "sizeof"
- NextToke
- Local ty:TType = ParseConstNumberType()
- If ty Then
- If Not TIntType(ty) Then
- Err "Return type for 'SizeOf' must be Int"
- End If
- End If
- ' optional brackets
- If CParse( "(" )
- expr=ParseExpr()
- Parse ")"
- expr=New TSizeOfExpr.Create( expr )
- Else
- expr=ParseExpr()
- expr=New TSizeOfExpr.Create( expr )
- EndIf
- Case "len"
- NextToke
-
- Local ty:TType = ParseConstNumberType()
- If ty Then
- If Not TIntType(ty) Then
- Err "Return type for 'Len' must be Int"
- End If
- End If
- ' optional brackets
- If CParse( "(" )
- expr=ParseExpr()
- Parse ")"
- expr=New TLenExpr.Create( expr )
- Else
- expr=ParseExpr()
- expr=New TLenExpr.Create( expr )
- EndIf
- Case "asc"
- NextToke
- Local ty:TType = ParseConstNumberType()
- If ty Then
- If Not TIntType(ty) Then
- Err "Return type for 'Asc' must be Int"
- End If
- End If
-
- ' optional brackets
- If CParse( "(" )
- expr=ParseExpr()
- Parse ")"
- expr=New TAscExpr.Create( expr )
- Else
- expr=ParseExpr()
- expr=New TAscExpr.Create( expr )
- EndIf
- Case "chr"
- NextToke
- Local ty:TType = ParseConstNumberType()
- If ty Then
- If Not TStringType(ty) Then
- Err "Return type for 'Chr' must be String"
- End If
- End If
-
- ' optional brackets
- If CParse( "(" )
- expr=ParseExpr()
- Parse ")"
- expr=New TChrExpr.Create( expr )
- Else
- expr=ParseExpr()
- expr=New TChrExpr.Create( expr )
- EndIf
- Case "varptr"
- NextToke
- expr=ParseExpr()
- expr=New TCastExpr.Create( New TVarPtrType, expr, CAST_EXPLICIT )
- Case "pi"
- NextToke
- expr=New TConstExpr.Create( New TDoubleType, Pi )
- Case "self"
- NextToke
- expr=New TSelfExpr
- Case "super"
- NextToke
- Parse "."
- If _toke="new"
- Err "Call to super class constructor must be first statement in a constructor."
- EndIf
- Local id$=ParseIdent()
-
- ' eat any type stuff
- ParseConstNumberType()
- expr=New TInvokeSuperExpr.Create( id,ParseArgs( stmt ) )
- Case "stackalloc"
- NextToke
-
- ' optional brackets
- If CParse( "(" )
- expr=ParseExpr()
- Parse ")"
- expr=New TStackAllocExpr.Create( expr )
- Else
- expr=ParseExpr()
- expr=New TStackAllocExpr.Create( expr )
- EndIf
- Case "fieldoffset"
- NextToke
-
- Local withBrackets:Int
-
- If CParse("(")
- withBrackets = True
- End If
-
- Local typeExpr:TExpr = ParseExpr()
- Parse ","
- Local fieldExpr:TExpr = ParseExpr()
-
- If withBrackets Then
- Parse(")")
- End If
-
- expr=New TFieldOffsetExpr.Create( typeExpr, fieldExpr )
- Default
- Select _tokeType
- Case TOKE_IDENT
- Local tok:TToker=New TToker.Copy( _toker )
- Local ty:TType=CParseIdentType()
- If ty
- expr=New TIdentTypeExpr.Create( ty )
- Else
- _toker=tok
- _toke=_toker.Toke()
- _tokeType=_toker.TokeType()
- expr=New TIdentExpr.Create( ParseIdent(),,,unknownIdentsEvalFalse )
- ty = ParseConstNumberType()
-
- If TArrayType(ty) Then
- If Not TArrayType(ty).elemType Then
- TArrayType(ty).elemType = New TIdentType.Create(TIdentExpr(expr).ident)
- expr=New TIdentTypeExpr.Create( ty )
- End If
- End If
- EndIf
- 'expr=New TIdentExpr.Create( ParseIdent() )
- Case TOKE_INTLIT
- expr=New TConstExpr.Create( New TIntType,_toke )
- NextToke
- Local ty:TType = ParseConstNumberType()
- If ty Then
- TConstExpr(expr).UpdateType(ty)
- End If
- Case TOKE_LONGLIT
- expr=New TConstExpr.Create( New TLongType,_toke )
- NextToke
-
- Local ty:TType = ParseConstNumberType()
- If ty Then
- TConstExpr(expr).UpdateType(ty)
- End If
- Case TOKE_FLOATLIT
- expr=New TConstExpr.Create( New TFloatType,_toke )
- NextToke
- Local ty:TType = ParseConstNumberType()
- If ty Then
- TConstExpr(expr).ty = ty
- End If
- Case TOKE_STRINGLIT
- Local s:String = BmxUnquote( _toke )
- expr=New TConstExpr.Create( TType.stringType,s )
- _app.mapStringConsts(s)
- NextToke
- Case TOKE_STRINGMULTI
- Local s:String = BmxProcessMultiString( _toke )
- expr=New TConstExpr.Create( TType.stringType,s )
- _app.mapStringConsts(s)
- NextToke
- Default
- Err "Expecting expression but encountered "+DescribeToke(_toke)
- End Select
- End Select
- Repeat
- Select _toke
- Case "."
- NextToke
-
- expr=New TIdentExpr.Create( ParseIdent(),expr )
-
- ParseConstNumberType()
- 'DebugLog expr.ToString()
- Case "("
- If expr = Null Then
- NextToke
- expr=ParseExpr()
- Parse ")"
- Else
- expr=New TFuncCallExpr.Create( expr,ParseArgs( stmt ) )
- End If
- Case "["
- NextToke
- If CParse( ".." )
- If _toke="]"
- expr=New TSliceExpr.Create( expr,Null,Null )
- Else
- expr=New TSliceExpr.Create( expr,Null,ParseExpr() )
- EndIf
- Parse "]"
- Else
- Local from:TExpr=ParseExpr()
- If CParse( ".." )
- If _toke="]"
- expr=New TSliceExpr.Create( expr,from,Null )
- Else
- expr=New TSliceExpr.Create( expr,from,ParseExpr() )
- EndIf
- Parse "]"
- Else
- Local ind:TExpr[] = [from]
- Repeat
- If CParse("]") Then
- Exit
- End If
- Parse ","
- ind = ind + [ParseExpr()]
- Forever
- expr=New TIndexExpr.Create( expr,ind )
- EndIf
- EndIf
- Default
- Return expr
- End Select
- Forever
- End Method
- Method ParseUnaryExpr:TExpr()
- Local op$=_toke
- Select op
- Case "+","-","~~","not"
- NextToke
- Local expr:TExpr=ParseUnaryExpr()
- Return New TUnaryExpr.Create( op,expr )
- End Select
- Return ParsePrimaryExpr( False )
- End Method
- Method ParsePowExpr:TExpr()
- Local expr:TExpr=ParseUnaryExpr()
- Repeat
- Local op$=_toke
- Select op
- Case "^"
- NextToke
- Local rhs:TExpr=ParseUnaryExpr()
- expr=New TBinaryMathExpr.Create( op,expr,rhs )
- Default
- Return expr
- End Select
- Forever
- End Method
- Method ParseMulDivExpr:TExpr()
- Local expr:TExpr=ParsePowExpr()
- Repeat
- Local op$=_toke
- Select op
- Case "*","/","mod","shl","shr", "sar"
- NextToke
- Local rhs:TExpr=ParsePowExpr()
- expr=New TBinaryMathExpr.Create( op,expr,rhs )
- Default
- Return expr
- End Select
- Forever
- End Method
- Method ParseAddSubExpr:TExpr()
- Local expr:TExpr=ParseMulDivExpr()
- Repeat
- Local op$=_toke
- Select op
- Case "+","-"
- NextToke
- Local rhs:TExpr=ParseMulDivExpr()
- expr=New TBinaryMathExpr.Create( op,expr,rhs )
- Default
- Return expr
- End Select
- Forever
- End Method
- Method ParseBitandExpr:TExpr()
- Local expr:TExpr=ParseAddSubExpr()
- Repeat
- Local op$=_toke
- Select op
- Case "&","~~"
- NextToke
- Local rhs:TExpr=ParseAddSubExpr()
- expr=New TBinaryMathExpr.Create( op,expr,rhs )
- Default
- Return expr
- End Select
- Forever
- End Method
- Method ParseBitorExpr:TExpr()
- Local expr:TExpr=ParseBitandExpr()
- Repeat
- Local op$=_toke
- Select op
- Case "|"
- NextToke
- Local rhs:TExpr=ParseBitandExpr()
- expr=New TBinaryMathExpr.Create( op,expr,rhs )
- Default
- Return expr
- End Select
- Forever
- End Method
- Method ParseCompareExpr:TExpr()
- Local expr:TExpr=ParseBitorExpr()
- Repeat
- Local op$=_toke
- Select op
- Case "=","<",">","<=","=<",">=","=>","<>"
- NextToke
- ' <= or =>
- If (op=">" And (_toke="=")) Or (op="=" And (_toke=">"))
- op:+_toke
- NextToke
- ' <> or <= or =<
- Else If (op="<" And _toke=">") Or (op="<" And _toke="=") Or (op="=" And _toke="<")
- op:+_toke
- NextToke
- EndIf
- Local rhs:TExpr=ParseBitorExpr()
- expr=New TBinaryCompareExpr.Create( op,expr,rhs )
- Default
- Return expr
- End Select
- Forever
- End Method
- Method ParseAndExpr:TExpr()
- Local expr:TExpr=ParseCompareExpr()
- Repeat
- Local op$=_toke
- If op="and"
- NextToke
- Local rhs:TExpr=ParseCompareExpr()
- expr=New TBinaryLogicExpr.Create( op,expr,rhs )
- Else
- Return expr
- EndIf
- Forever
- End Method
- Method ParseOrExpr:TExpr()
- Local expr:TExpr=ParseAndExpr()
- Repeat
- Local op$=_toke
- If op="or"
- NextToke
- Local rhs:TExpr=ParseAndExpr()
- expr=New TBinaryLogicExpr.Create( op,expr,rhs )
- Else
- Return expr
- EndIf
- Forever
- End Method
- Method ParseExpr:TExpr()
- Return ParseOrExpr()
- End Method
- Rem
- unused atm
- Method ReadTillNextToken:string(amount:int=1)
- 'copy current toker and move one token forward
- local tok:TToker = New TToker.Copy(_toker)
- local result:string = _toker._toke
- for local i:int = 0 until amount
- NextTokeToker(tok)
- result :+ " "+ tok._toke
- Next
- return _toker._toke+" "+tok._toke
- End Method
- End Rem
-
- Method ParseIfStmt( term$, elseIfEndIfReadAheadCheck:Int = False )
- Local tok:TToker
- 'rules:
- '- the command "end" cannot be used as condition
- '- "endif" or "end if" is not allowed in singleline-ifs
- 'if current toke is "if", move on to the next toke
- CParse "if"
- 'read in the expression/condition following after "if"
- Local expr:TExpr=ParseExpr()
- 'if current toke is "then", move to next, else stay at this
- 'position -> makes "then" usage voluntary
- CParse "then"
- 'create empty blocks for then/else
- Local thenBlock:TBlockDecl=New TBlockDecl.Create( _block, ,BLOCK_IF )
- Local elseBlock:TBlockDecl=New TBlockDecl.Create( _block, ,BLOCK_ELSE )
- 'define if the current if is a "singleline if"
- '"singleline ifs" are not allowed to contain "endif" "end if"
- Local singleLineIf:Int = True
- 'to know if it is a multiline or singleline if we have to check
- 'for certain situations
- Select _toke
- Case "~n"
- 'if a <- newline
- ' print "a"
- 'endif
- singleLineIf = False
- Case "if"
- 'another "if" means the outer one is a singleline if!
- singleLineIf = True
- Case "else"
- 'if ReadTillNextToken().toLower() = "else if"
- ' print "IF: found if X then Y else if ..."
- 'else
- ' print "IF: found if X then Y else ..."
- 'endif
- 'also read "else if"
- singleLineIf = True
- Case "elseif"
- singleLineIf = True
- End Select
- 'set thenBlock as the active block
- PushBlock( thenBlock )
- 'now check each toke until we reach our desired term
- 'for singleline-if this is "~n", for multiline-if this is
- '"endif" or "end if"
- If singleLineIf
- term = "~n"
- Else
- term = "end" 'endif, end if
- EndIf
- 'only read until reaching the limit - or no valid toke was returned
- While _toke <> term
- Local currentToke:String = _toke
- Select currentToke
- 'file end before endif/end/elseif
- Case ""
- Err("Expecting expression but encountered end-of-file")
- '"endif" / "end if"
- Case "endif", "end"
- NextToke()
-
- If singleLineIf Then
- 'check for "end"-command ("if a=1 end")
- If currentToke = "end" And (currentToke + _toke) <> "endif" Then
- ParseEndStmt(False)
- 'found "end if"
- Else
- Err "'End If' without matching 'If'"
- Exit
- EndIf
- EndIf
-
- 'If currentToke = "endif" or (currentToke + _toke)="endif"
- ' 'do something if "endif/end if" happens ?
- 'Endif
- 'finish this if-statement
- Exit
- '"else" and "elseif" / "else if"
- Case "else","elseif"
- ' print "parsing "+currentToke
- If _block = elseBlock
- Err("If statement can only have one 'else' block.")
- EndIf
- 'switch from thenBlock to elseBlock
- PopBlock()
- PushBlock(elseBlock)
- 'move to next token, might contain "if" for "else if"
- 'doing it this way avoids to parse "elseif if" as
- 'else-statement
- NextToke()
- If currentToke = "elseif" Or (currentToke + _toke)="elseif"
- 'create a new if-statement and exit current handling
- SetErr
- ParseIfStmt(term, True)
- Exit
- EndIf
-
- Default
- 'parse the current and next tokens
- ParseStmt()
- currentToke = _toke
- 'handle the end-function and "end if"
- Select currentToke
- Case "end"
- 'check next toke too
- NextToke()
- 'found end-function
- If currentToke = "end" And (currentToke + _toke)<>"endif"
- ' print " parsing end .... handling"
- ParseEndStmt(False)
- 'found "end if"
- Else
- If CParse("if") Then
- If singleLineIf Then
- Err "'End If' without matching 'If'"
- End If
-
- Exit
- End If
-
- 'NextToke()
- EndIf
- End Select
- End Select
- Wend
-
- 'change block
- PopBlock()
- 'create a if-then[-else]-statement
- Local stmt:TIfStmt=New TIfStmt.Create( expr,thenBlock,elseBlock )
- _block.AddStmt stmt
- End Method
- Method ParseWhileStmt(loopLabel:TLoopLabelDecl = Null)
- Parse "while"
- Local expr:TExpr=ParseExpr()
- Local block:TBlockDecl=New TBlockDecl.Create( _block, , BLOCK_LOOP )
- PushBlock block
- While Not CParse( "wend" ) And Not CParse( "endwhile" )
- ' If CParse( "end" )
- ' CParse "while"
- ' Exit
- ' EndIf
- ParseStmt
- ' to handle "end" statement
- If _toke = "end" Then
- NextToke
- If _toke = "while" Then
- NextToke
- Exit
- Else
- ParseEndStmt(False)
- End If
- End If
- Wend
- PopBlock
- Local stmt:TWhileStmt=New TWhileStmt.Create( expr,block,loopLabel )
- _block.AddStmt stmt
- End Method
- Method ParseRepeatStmt(loopLabel:TLoopLabelDecl = Null)
- Parse "repeat"
- Local block:TBlockDecl=New TBlockDecl.Create( _block, , BLOCK_LOOP )
- PushBlock block
- While _toke<>"until" And _toke<>"forever"
- ParseStmt
- Wend
- PopBlock
- SetErr
- Local expr:TExpr
- If CParse( "until" )
- expr=ParseExpr()
- Else
- Parse "forever"
- expr=New TConstExpr.Create( New TBoolType,"" )
- EndIf
- Local stmt:TRepeatStmt=New TRepeatStmt.Create( block,expr,loopLabel )
- _block.AddStmt stmt
- End Method
- Method ParseForStmt(loopLabel:TLoopLabelDecl = Null)
- Parse "for"
- Local varid$,varty:TType,varlocal:Int
- Local varExpr:TExpr
- If CParse( "local" )
- varlocal=True
- varid=ParseIdent()
- varty=ParseDeclType()
- If varty._flags & (TType.T_CHAR_PTR | TType.T_SHORT_PTR) Then
- DoErr "Illegal variable type"
- End If
-
- Parse( "=" )
-
- ' use an ident expr to pass the variable to different parts of the statement.
- ' the original implementation passed decl references, which cause problems if we wanted to
- ' copy the statement later.
- varExpr = New TIdentExpr.Create(varid)
- Else
- varlocal=False
- varExpr=ParsePrimaryExpr( False )
- Parse "="
- EndIf
- If CParse( "eachin" )
- Local expr:TExpr=ParseExpr()
- Local block:TBlockDecl=New TBlockDecl.Create( _block, , BLOCK_LOOP )
- PushBlock block
- While Not CParse( "next" )
- ParseStmt
- Wend
- PopBlock
- Local stmt:TForEachinStmt=New TForEachinStmt.Create( varid,varty,varlocal,expr,block,loopLabel, varExpr )
- _block.AddStmt stmt
- Return
- EndIf
- Local from:TExpr=ParseExpr()
- Local op$
- If CParse( "to" )
- op="<="
- Else If CParse( "until" )
- op="<"
- Else
- Err "Expecting 'To' or 'Until'."
- EndIf
- Local term:TExpr=ParseExpr()
- Local stp:TExpr
- If CParse( "step" )
- stp=ParseExpr()
- Else
- stp=New TConstExpr.Create( New TIntType,"1" )
- EndIf
- ' for negative direction we need to invert the operator
- If TUnaryExpr(stp) And TUnaryExpr(stp).op = "-" Then
- If op="<=" Then
- op=">="
- Else
- op=">"
- End If
- End If
- Local init:TStmt,expr:TExpr,incr:TStmt
- If varlocal
- Local indexVar:TLocalDecl=New TLocalDecl.Create( varid,varty,New TCastExpr.Create( varty,from,CAST_EXPLICIT ),0 )
- init=New TDeclStmt.Create( indexVar )
- ' expr=New TBinaryCompareExpr.Create( op,New TVarExpr.Create( indexVar ),New TCastExpr.Create( varty,term,1 ) )
- ' incr=New TAssignStmt.Create( "=",New TVarExpr.Create( indexVar ),New TBinaryMathExpr.Create( "+",New TVarExpr.Create( indexVar ),New TCastExpr.Create( varty,stp,1 ) ) )
- expr=New TBinaryCompareExpr.Create( op, varExpr,New TCastExpr.Create( varty,term,CAST_EXPLICIT ) )
- If TUnaryExpr(stp) And TUnaryExpr(stp).op = "-" Then
- incr=New TAssignStmt.Create( "=",varExpr,New TBinaryMathExpr.Create( "-",varExpr,New TCastExpr.Create( varty,TUnaryExpr(stp).expr,CAST_EXPLICIT ) ) )
- Else
- incr=New TAssignStmt.Create( "=",varExpr,New TBinaryMathExpr.Create( "+",varExpr,New TCastExpr.Create( varty,stp,CAST_EXPLICIT ) ) )
- End If
- Else
- ' varty is NULL here for the casts. We will back-populate it later.
- ' init=New TAssignStmt.Create( "=",New TIdentExpr.Create( varid ),from )
- ' expr=New TBinaryCompareExpr.Create( op,New TIdentExpr.Create( varid ),New TCastExpr.Create( varty,term,1 ) )
- ' incr=New TAssignStmt.Create( "=",New TIdentExpr.Create( varid ),New TBinaryMathExpr.Create( "+",New TIdentExpr.Create( varid ),New TCastExpr.Create( varty,stp,1 ) ) )
- init=New TAssignStmt.Create( "=",varExpr,from )
- expr=New TBinaryCompareExpr.Create( op,varExpr,New TCastExpr.Create( varty,term,CAST_EXPLICIT ) )
- If TUnaryExpr(stp) And TUnaryExpr(stp).op = "-" Then
- incr=New TAssignStmt.Create( "=",varExpr,New TBinaryMathExpr.Create( "-",varExpr,New TCastExpr.Create( varty,TUnaryExpr(stp).expr,CAST_EXPLICIT ) ) )
- Else
- incr=New TAssignStmt.Create( "=",varExpr,New TBinaryMathExpr.Create( "+",varExpr,New TCastExpr.Create( varty,stp,CAST_EXPLICIT ) ) )
- End If
- EndIf
- Local block:TBlockDecl=New TBlockDecl.Create( _block, , BLOCK_LOOP )
- PushBlock block
- While Not CParse( "next" )
- ParseStmt
- Wend
- PopBlock
- NextToke
- Local stmt:TForStmt=New TForStmt.Create( init,expr,incr,block,loopLabel )
- _block.AddStmt stmt
- End Method
- Method ParseDefDataStmt(label:TLoopLabelDecl = Null)
- Parse "defdata"
-
- If AtEos() Then
- Err "Expecting expression but encountered " + DescribeToke(_toke)
- End If
-
- Local args:TExpr[]
- Local nargs:Int
- Repeat
- Local arg:TExpr
- If _toke And _toke<>"," arg=ParseExpr()
- If args.Length=nargs args=args + New TExpr[10]
- args[nargs]=arg
- nargs:+1
- Until Not CParse(",")
- args=args[..nargs]
-
- Local dataLabel:TDataLabelDecl
- If label Then
- dataLabel = New TDataLabelDecl.Create(label.ident, label.attrs)
- End If
-
- Local decl:TDefDataDecl = New TDefDataDecl.Create(args, dataLabel)
-
- _app.dataDefs.AddLast(decl)
-
- End Method
- Method ParseReadDataStmt()
- Parse "readdata"
- Local args:TExpr[]
- Local nargs:Int
- If Not AtEos() Then
- Repeat
- Local arg:TExpr
- If _toke And _toke<>"," arg=ParseExpr()
- If args.Length=nargs args=args + New TExpr[10]
- args[nargs]=arg
- nargs:+1
- Until Not CParse(",")
- args=args[..nargs]
- End If
- _block.AddStmt New TReadDataStmt.Create( args )
- End Method
- Method ParseRestoreDataStmt()
- Parse "restoredata"
-
- Local expr:TExpr = ParseExpr()
- _block.AddStmt New TRestoreDataStmt.Create( expr )
- End Method
-
- Method ParseReturnStmt()
- Parse "return"
- Local expr:TExpr
- If Not AtEos() expr=ParseExpr()
- _block.AddStmt New TReturnStmt.Create( expr )
- End Method
- Method ParseExitStmt()
- Parse "exit"
- Local expr:TExpr
- If Not AtEos() expr=ParseExpr()
- _block.AddStmt New TBreakStmt.Create(expr)
- End Method
- Method ParseContinueStmt()
- Parse "continue"
- Local expr:TExpr
- If Not AtEos() expr=ParseExpr()
- _block.AddStmt New TContinueStmt.Create(expr)
- End Method
- Method ParseTryStmt()
- Parse "try"
- Local tryStmtDecl:TTryStmtDecl = TTryStmtDecl(New TTryStmtDecl.Create( _block ))
-
- PushBlock tryStmtDecl
- Local block:TBlockDecl=New TBlockDecl.Create( tryStmtDecl, , BLOCK_TRY )
- Local catches:TList=New TList
- Local finallyStmt:TFinallyStmt = Null
- PushBlock block
- While _toke<>"end" And _toke<>"endtry"
- If CParse( "catch" )
- If finallyStmt Then Err "'Catch' can not appear after 'Finally'."
- Local id:String=ParseIdent()
- Local ty:TType
- If Not CParse(":") Then
- Parse "$"
- ty= TType.stringType
- Else
- ty=ParseType()
- While IsArrayDef()
- ty=ParseArrayType(ty)
- Wend
- End If
- PopBlock
- Local init:TLocalDecl=New TLocalDecl.Create( id,ty,Null,0 )
- Local block:TBlockDecl=New TBlockDecl.Create( _block, , BLOCK_CATCH )
- catches.AddLast(New TCatchStmt.Create( init,block ))
- PushBlock block
- Else If CParse("finally") Then
- If finallyStmt Then Err "Try statement cannot have more than one Finally block."
- PopBlock
- Local block:TBlockDecl = New TBlockDecl.Create(_block, , BLOCK_FINALLY)
- finallyStmt = New TFinallyStmt.Create(block)
- PushBlock block
- Else
- ParseStmt
- If _toke = "end" Then
- NextToke
- If _toke = "try" Then
- ' we are done with the try statement
- Exit
- Else
- ParseEndStmt(False)
- End If
- End If
- End If
- Wend
- If catches.Count() = 0 And Not finallyStmt Then Err "Expecting 'Catch' or 'Finally'."
-
- PopBlock ' try block
-
- If Not CParse("endtry") Then
- NextToke
- CParse "try"
- End If
- PopBlock ' tryStmtDecl
-
- Local tryStmt:TTryStmt = New TTryStmt.Create(block,TCatchStmt[](catches.ToArray()), finallyStmt)
- tryStmtDecl.tryStmt = tryStmt
- _block.AddStmt tryStmt
-
- End Method
- Method ParseThrowStmt()
- Parse "throw"
- Local expr:TExpr = ParseExpr()
- _block.AddStmt New TThrowStmt.Create( expr )
- End Method
- Method ParseReleaseStmt()
- Parse "release"
- Local expr:TExpr = ParseExpr()
- _block.AddStmt New TReleaseStmt.Create( expr )
- End Method
-
- Method ParseAssertStmt()
- Parse "assert"
- Local expr:TExpr = ParseExpr()
- Local elseExpr:TExpr
- If _toke = "," Or _toke = "else" Then
- NextToke
- elseExpr = ParseExpr()
- End If
- _block.AddStmt New TAssertStmt.Create( expr, elseExpr )
- End Method
- Method ParseEndStmt(eatEnd:Int = True)
- If eatEnd Then
- Parse "end"
- End If
- _block.AddStmt New TEndStmt.Create( )
- End Method
- Method ParseSelectStmt()
- Parse "select"
- Local block:TBlockDecl=_block
-
- Local tmpVar:TLocalDecl
- Local selectExpr:TExpr = ParseExpr()
- If Not TNullType(selectExpr.exprType)
- tmpVar = New TLocalDecl.Create("", Null, selectExpr, DECL_NO_VAR, True)
- block.AddStmt New TDeclStmt.Create(tmpVar)
- End If
-
- While _toke<>"end" And _toke<>"default" And _toke<>"endselect"
- SetErr
- Select _toke
- Case "~n"
- NextToke
- Case "case"
- NextToke
- Local comp:TExpr
- Repeat
- Local expr:TExpr
- If TNullType(selectExpr.exprType)
- expr = New TNullExpr.Create(TType.nullObjectType)
- Else
- expr = New TVarExpr.Create(tmpVar)
- End If
- expr=New TBinaryCompareExpr.Create( "=",expr,ParseExpr() )
- If comp
- comp=New TBinaryLogicExpr.Create( "or",comp,expr )
- Else
- comp=expr
- EndIf
- Until Not CParse(",")
- Local thenBlock:TBlockDecl=New TBlockDecl.Create( _block, , BLOCK_IF )
- Local elseBlock:TBlockDecl=New TBlockDecl.Create( _block, , BLOCK_ELSE )
- Local ifstmt:TIfStmt=New TIfStmt.Create( comp,thenBlock,elseBlock )
- block.AddStmt ifstmt
- block=ifstmt.thenBlock
- PushBlock block
- Local fin:Int = False
- While _toke<>"case" And _toke<>"default" And _toke<>"end" And _toke<>"endselect"
- ParseStmt
- If _toke = "end" Then
- NextToke
- If _toke = "select" Then
- ' we are done with the select statement, full exit
- fin = True
- Exit
- Else
- ParseEndStmt(False)
- End If
- End If
- Wend
- PopBlock
- block=elseBlock
- If fin Exit
- Default
- Err "Syntax error - expecting 'Case', 'Default' or 'End'."
- End Select
- Wend
- If _toke="default"
- NextToke
- PushBlock block
- While _toke<>"end" And _toke<>"endselect"
- SetErr
- Select _toke
- Case "case"
- Err "Case can not appear after Default."
- Case "default"
- Err "Select statement can have only one Default block."
- End Select
- ParseStmt
- If _toke = "end" Then
- NextToke
- If _toke = "select" Then
- Exit
- Else
- ParseEndStmt(False)
- End If
- End If
- Wend
- PopBlock
- EndIf
- SetErr
- If Not CParse("endselect") Then
- If Not CParse("select")
- Parse "end"
- Parse "select"
- End If
- End If
- End Method
- Method ParseExternBlock(mdecl:TModuleDecl, attrs:Long)
- NextToke
- attrs :| ParseCallConvention()
-
- attrs = attrs | DECL_EXTERN
- If CParse( "private" ) attrs=attrs|DECL_PRIVATE
- While _toke<>"endextern"
- If CParse( "end" )
- Parse "extern"
- Exit
- EndIf
- SetErr
- Select _toke
- Case "~n"
- NextToke
- Case "const"
- mdecl.InsertDecls ParseDecls( _toke,attrs )
- Case "global"
- ParseDeclStmts(True, attrs, mdecl)
- Case "threadedglobal"
- ParseDeclStmts(True, attrs | DECL_THREADED, mdecl)
- Case "struct"
- mdecl.InsertDecl ParseClassDecl( _toke,attrs | CLASS_STRUCT )
- Case "type"
- mdecl.InsertDecl ParseClassDecl( _toke,attrs )
- Case "function"
- mdecl.InsertDecl ParseFuncDecl( _toke,attrs )
- Case "interface"
- mdecl.InsertDecl ParseClassDecl( _toke,attrs | CLASS_INTERFACE )
- Default
- If _toke <> "end" And _toke <> "endextern" Then
- Err "Expecting expression but encountered '"+_toke+"'"
- End If
- End Select
- Wend
-
- If _toke="endextern" Then
- NextToke
- End If
- End Method
- Method ParseStmt()
- SetErr
- Select _toke
- Case ";","~n"
- NextToke
- Case "const","local","global","threadedglobal"
- ParseDeclStmts
- ' nested function - needs to get added to the "module"
- Case "function"
- _block.InsertDecl ParseFuncDecl( _toke,FUNC_NESTED)
- Case "type"
- _block.InsertDecl ParseClassDecl( _toke,DECL_NESTED)
- Case "return"
- ParseReturnStmt()
- Case "exit"
- ParseExitStmt()
- Case "continue"
- ParseContinueStmt()
- Case "if"
- ParseIfStmt( "" )
- Case "while"
- ParseWhileStmt()
- Case "repeat"
- ParseRepeatStmt()
- Case "for"
- ParseForStmt()
- Case "select"
- ParseSelectStmt()
- Case "assert"
- ParseAssertStmt()
- Case "try"
- ParseTryStmt()
- Case "throw"
- ParseThrowStmt()
- Case "end"
- ParseEndStmt()
- Case "extern"
- ParseExternBlock(_module, 0)
- Case "#"
- Local decl:TLoopLabelDecl = ParseLoopLabelDecl()
- NextToke
- While _toke
- SetErr
- Select _toke.ToLower()
- Case "~n"
- NextToke
- Case "while"
- ParseWhileStmt(decl)
- Exit
- Case "repeat"
- ParseRepeatStmt(decl)
- Exit
- Case "for"
- ParseForStmt(decl)
- Exit
- Case "defdata"
- ParseDefDataStmt(decl)
- Exit
- Default
- Err "Labels must appear before a loop or DefData statement"
- End Select
- Wend
- Case "release"
- ParseReleaseStmt()
- Case "defdata"
- ParseDefDataStmt()
- Case "readdata"
- ParseReadDataStmt()
- Case "restoredata"
- ParseRestoreDataStmt()
- Default
- If _toke.StartsWith("'!") Then
- If _tokeType = TOKE_NATIVE Then
- ParseNativeStmt()
- End If
- Else
- Local expr:TExpr=ParsePrimaryExpr( True )
-
- Select _toke.ToLower()
- Case "=",":*",":/",":+",":-",":&",":|",":~~", ":shl", ":shr", "sar", ":sar", ":mod"
-
- If TIdentExpr( expr ) Or TIndexExpr( expr )
- Local op$=_toke.ToLower()
- NextToke
- ' If Not op.EndsWith( "=" ) And Not op.StartsWith("=")
- ' Parse "="
- ' op:+"="
- ' EndIf
- _block.AddStmt New TAssignStmt.Create( op,expr,ParseExpr() )
- Else
- Err "Assignment operator '"+_toke+"' cannot be used this way."
- EndIf
- Return
- End Select
-
- If TIdentExpr( expr )
-
- expr=New TFuncCallExpr.Create( expr,ParseArgs( True ) )
-
- Else If TFuncCallExpr( expr) Or TInvokeSuperExpr( expr ) Or TNewObjectExpr( expr ) Or TNewExpr(expr)
-
- Else If TIndexExpr(expr)
- expr = New TFuncCallExpr.Create( expr, ParseArgs( True ) )
- Else
- Err "Expression cannot be used as a statement."
- EndIf
-
- _block.AddStmt New TExprStmt.Create( expr )
- End If
- End Select
- End Method
- Method ParseDecl:TDecl( toke$,attrs:Long )
- SetErr
- If CParse("staticarray") Then
- If toke = "const" Then
- Err "Const cannot be used in this way"
- End If
- If attrs & DECL_STATIC Then
- Err "Already declared as a static array"
- End If
- attrs :| DECL_STATIC
- End If
- Local id$=ParseIdent()
- Local ty:TType
- Local init:TExpr
-
-
- If attrs & DECL_EXTERN
- ty=ParseDeclType(attrs & (DECL_STATIC | DECL_API_STDCALL))
-
- If toke = "const" Then
- If CParse("=") Then
- init=ParseExpr()
- End If
- End If
- ' Else If CParse( ":=" )
- ' init=ParseExpr()
- ' ty = init.exprType
- Else
- ty=ParseDeclType(attrs & (DECL_STATIC | DECL_API_STDCALL))
- If CParse( "=" )
- If (attrs & DECL_STATIC) Then
- Err "Static arrays cannot be initialized in this way"
- End If
- init=ParseExpr()
- Else If CParse( "[" ) ' an initialised array?
- If (attrs & DECL_STATIC) Then
- init = ParseExpr()
- Parse "]"
- ty=New TArrayType.Create( ty,1,, attrs & DECL_STATIC > 0 )
- Else
- Local ln:TExpr[]
- Repeat
- If CParse(",") Then
- ln = ln + [New TNullExpr]
- Continue
- End If
- If CParse("]") Exit
- ln = ln + [ParseExpr()]
- If CParse("]") Exit
- Parse(",")
- Forever
- 'Parse "]"
- ty = ParseArrayType(ty)
- 'While CParse( "[]" )
- ' ty=New TArrayType.Create(ty)
- 'Wend
- init=New TNewArrayExpr.Create( ty,ln)
- ty=New TArrayType.Create( ty, ln.length,, attrs & DECL_STATIC > 0 )
- End If
- Else If toke <> "const"
- If toke="global" Or toke="local" Or toke="threadedglobal" Then
- init=New TConstExpr.Create( ty,"" )
- End If
- Else
- Err "Constants must be initialized."
- EndIf
-
- EndIf
-
- Local decl:TValDecl
- Select toke
- Case "global"
- decl=New TGlobalDecl.Create( id,ty,init,attrs )
- Case "threadedglobal"
- decl=New TGlobalDecl.Create( id,ty,init,attrs | DECL_THREADED )
- Case "field"
- decl=New TFieldDecl.Create( id,ty,init,attrs )
- If TFunctionPtrType(ty) Then
- TFunctionPtrType(ty).func.attrs :| FUNC_FIELD
- End If
- Case "const" decl=New TConstDecl.Create( id,ty,init,attrs )
- Case "local" decl=New TLocalDecl.Create( id,ty,init,attrs )
- End Select
- If decl.IsExtern()
- Local cdets:TCastDets
- If CParse( "=" )
- Local munged:String = ParseStringLit()
-
- If munged.Find("(") > 0 Then
- cdets = ParseExternCast(munged, True)
- If cdets Then
- decl.munged = cdets.name
- End If
- Else
- decl.munged = munged
- End If
- Else
- decl.munged=decl.ident
- EndIf
- If TFunctionPtrType(ty) Then
- TFunctionPtrType(ty).func.munged = decl.munged
-
- If Not cdets Then
- cdets = TCastDets(_externCasts.ValueForKey(TFunctionPtrType(ty).func.munged))
- End If
-
- If cdets Then
- TFunctionPtrType(ty).func.cdets = cdets
- TFunctionPtrType(ty).func.castTo = cdets.retType
- If cdets.noGen Then
- TFunctionPtrType(ty).func.noCastGen = True
- End If
- For Local i:Int = 0 Until cdets.args.length
- If i < TFunctionPtrType(ty).func.argDecls.length Then
- TFunctionPtrType(ty).func.argDecls[i].castTo = cdets.args[i]
- End If
- Next
- End If
-
- End If
- EndIf
- ' apply any function ptr metadata to decl
- If TFunctionPtrType(ty) Then
- If TFunctionPtrType(ty).func And TFunctionPtrType(ty).func.metadata Then
- decl.metadata = TFunctionPtrType(ty).func.metadata
- End If
- End If
- 'meta data for variables
- Local meta:TMetaData = ParseMetaData()
- If meta Then
- decl.metadata = meta
- End If
- Return decl
- End Method
- Method ParseDecls:TList( toke$,attrs:Long, isField:Int = False )
- If toke Parse toke
- If isField Then
- Repeat
- If CParse("readonly") Then
- If attrs & DECL_READ_ONLY
- Err "Duplicate modifier 'ReadOnly'."
- End If
- attrs :| DECL_READ_ONLY
- Else If CParse("staticarray") Then
- If attrs & DECL_STATIC
- Err "Duplicate modifier 'Static'."
- End If
- attrs :| DECL_STATIC
- Else
- Exit
- End If
- Forever
- End If
- Local decls:TList=New TList'<Decl>
- Repeat
- Local decl:TDecl=ParseDecl( toke,attrs )
- decls.AddLast decl
- If Not CParse(",") Return decls
- Forever
- End Method
- Method ParseDeclStmts(initOnly:Int = False, attrs:Long = 0, mdecl:TModuleDecl = Null)
- Local toke$=_toke
- NextToke
- Repeat
- Local decl:TDecl=ParseDecl( toke,attrs )
- If Not (attrs & DECL_EXTERN) Then
- _block.AddStmt New TDeclStmt.Create( decl )
- End If
-
- ' reset the decl scope, adding decl to the block decl list.
- ' this improves scope visibilty - for decls such as embedded functions
- If TConstDecl(decl) Or TGlobalDecl(decl) Then
- If mdecl Then
- mdecl.InsertDecl decl
- End If
- If Not (attrs & DECL_EXTERN) Then
- decl.scope = Null
- _block.InsertDecl(decl)
- End If
-
- If TGlobalDecl(decl) Then
- If initOnly Then
- decl.attrs :| DECL_INITONLY
- TGlobalDecl(decl).mscope = _module
- Else
- TGlobalDecl(decl).funcGlobal = True
- End If
- End If
- End If
-
- Until Not CParse(",")
- End Method
-
- Method ParseLoopLabelDecl:TLoopLabelDecl()
- NextToke
- Local id:String = ParseIdent()
- Return New TLoopLabelDecl.Create(id, 0)
- End Method
- 'handle end-of-line "dot dot return"-line connector
- '-> skips EOL tokens
- Method HandleDotsLineConnector(eatToke:Int = False)
- Local tok:TToker = New TToker.Copy(_toker)
- Local t:String = tok.NextToke()
- Local count:Int = tok.SkipSpace()
- For Local i:Int = 0 Until count
- NextToke
- Next
-
- t = tok._toke
- If t = "~r" Then
- t = tok.NextToke()
- If t = "~n" Then
- NextToke
- NextToke
- Else
- NextToke
- End If
- Else
- If t = "~n" Then
- NextToke
- End If
- End If
-
- If eatToke And Not count Then
- NextToke
- End If
- End Method
- 'should return a specific "metadata object" ?
- ' metadata is in the form : {key key=value key="value"}
- Method ParseMetaData:TMetadata()
- If Not CParse( "{" ) Then
- Return Null
- End If
- Local meta:TMetadata = New TMetadata
- SkipEols
- Repeat
- 'reached end of meta data declaration
- If _toke="}" Then Exit
- If meta.metadataString Then
- meta.metadataString :+ " "
- End If
-
- Select _tokeType
- Case TOKE_INTLIT
- Err "Expecting '}' but encountered integer literal"
- Case TOKE_FLOATLIT
- Err "Expecting '}' but encountered floating point literal"
- Case TOKE_STRINGLIT
- Err "Expecting '}' but encountered string literal"
- Case TOKE_SYMBOL
- Err "Expecting '}' but encountered " + _toke
- End Select
-
- 'append current token to metaDataString
- Local key:String = _toke
- meta.metadataString :+ key
- 'read next token
- NextToke()
- Local value:String
- ' got a value
- If CParse("=") Then
-
- If _tokeType = TOKE_IDENT Then
- Err "Meta data must be literal constant"
- End If
-
- value = _toke
- meta.metadataString :+ "=" + value
- 'read next token
- NextToke()
- Else
- value = "1"
- meta.metadataString :+ "=1"
- End If
-
- meta.InsertMeta(key.ToLower(), value)
- Forever
- 'continue to next token
- NextToke()
- 'parse this into something
- Return meta
- End Method
-
-
- Method ParseFuncDecl:TFuncDecl( toke$, attrs:Long, parent:TScopeDecl = Null )
- SetErr
- If toke Parse toke
- Local id$
- Local ty:TType
- Local meth:Int = attrs & FUNC_METHOD
- Local meta:TMetadata
- Local noMangle:Int
- Local exported:Int
- Local inInterface:Int = attrs & DECL_ABSTRACT
- Local classDecl:TClassDecl = TClassDecl(parent)
- If attrs & FUNC_METHOD
- If _toke="new"
- If attrs & DECL_EXTERN
- Err "Extern classes cannot have constructors"
- EndIf
- id="New"
- NextToke
- attrs:|FUNC_CTOR
- attrs:&~FUNC_METHOD
- ty=ParseDeclType()
- Else If _toke="operator" Then
- attrs:|FUNC_OPERATOR
- NextToke
-
- Local t:String = _toke.ToLower()
- NextToke
-
- Select t
- Case "*","/","+","-","&","|","~~","^"
- id = t
- Case ":*",":/",":+",":-",":&",":|",":~~",":^"
- id = t
- Case "<",">"',"="',"<=",">=","=","<>"
- If CParse("=") Then
- t :+ "="
- Else If t = "<" And CParse(">") Then
- t :+ ">"
- End If
- id = t
- Case "="
- id = t
- Case "mod", "shl", "shr"
- id = t
- Case ":mod", ":shl", ":shr"
- id = t
- Case "[]"
- If CParse("=") Then t :+ "="
- id = t
- Default
- DoErr "Operator must be one of: * / + - & | ~~ :* :/ :+ :- :& :| :~~ < > <= >= = <> mod shl shr :mod :shl :shr [] []="
- End Select
- ty=ParseDeclType()
- Else
- id=ParseIdent()
- ty=ParseDeclType(attrs & DECL_API_STDCALL)
- If ty._flags & (TType.T_CHAR_PTR | TType.T_SHORT_PTR) Then
- DoErr "Illegal function return type"
- End If
- ' Delete() return type should always be Void
- If id.ToLower() = "delete" Then
- attrs:|FUNC_DTOR
- If TIntType(ty) Then
- ty = New TVoidType
- End If
- End If
- ' TODO: make sure Delete cannot be declared with parameters?
- EndIf
- Else
- 'If Not (attrs & FUNC_PTR) Then
- id=ParseIdent()
- ty=ParseDeclType(attrs & DECL_API_STDCALL)
- ' can only return "$z" and "$w" from an extern function.
- If ty._flags & (TType.T_CHAR_PTR | TType.T_SHORT_PTR) And Not (attrs & DECL_EXTERN) Then
- DoErr "Illegal function return type"
- End If
- 'End If
- EndIf
- ' every branch in that nested If block up there contains the line "ty=ParseDeclType()";
- ' this already consumed all sets of parentheses and brackets belonging to this function declaration
- ' so we will now extract our actual return type and args from the result
- Local args:TArgDecl[]
- If Not TFunctionPtrType(ty) Then
- DoErr "Expecting function type"
- Else
- Local fdecl:TFuncDecl = TFunctionPtrType(ty).func
- ty = fdecl.retTypeExpr
- args = fdecl.argDecls
- attrs :| (fdecl.attrs & DECL_API_FLAGS)
- End If
-
- Local declaredAttrs:Long
- While True
- If CParse( "nodebug" ) Then
- If declaredAttrs & DECL_NODEBUG Then Err "Duplicate modifier 'NoDebug'"
- declaredAttrs :| DECL_NODEBUG
- Continue
- End If
-
- If CParse( "final" )
- If Not classDecl Then
- Err "Final cannot be used with global functions"
- End If
- If inInterface Then
- If attrs & FUNC_METHOD Then
- Err "Final methods cannot appear in interfaces"
- Else
- Err "Final functions cannot appear in interfaces"
- End If
- End If
- If declaredAttrs & DECL_FINAL Then Err "Duplicate modifier 'Final'"
- declaredAttrs :| DECL_FINAL
- Continue
- End If
-
- If CParse( "abstract" )
- If Not classDecl Then
- Err "Abstract cannot be used with global functions"
- End If
- If classDecl And classDecl.attrs & DECL_FINAL Then
- Err "Abstract methods cannot appear in final types"
- End If
- If inInterface Then
- If attrs & FUNC_METHOD Then
- Err "Abstract cannot be used in interfaces (interface methods are automatically abstract)"
- Else
- Err "Abstract cannot be used in interfaces (interface functions are automatically abstract)"
- End If
- End If
- If declaredAttrs & DECL_ABSTRACT Then Err "Duplicate modifier 'Abstract'"
- declaredAttrs :| DECL_ABSTRACT
- Continue
- End If
-
- If CParse("override") Then
- If Not classDecl Then
- Err "Override cannot be used with global functions"
- End If
- If declaredAttrs & DECL_OVERRIDE Then Err "Duplicate modifier 'Override'"
- declaredAttrs :| DECL_OVERRIDE
- Continue
- End If
-
- If CParse("inline") And Not opt_debug Then
- If classDecl Then
- Err "Inline can only be used with global functions"
- End If
- If declaredAttrs & DECL_INLINE Then Err "Duplicate modifier 'Inline'"
- declaredAttrs :| DECL_INLINE
- Continue
- End If
-
- Exit
- Wend
- attrs :| declaredAttrs
- 'meta data for functions/methods
- meta = ParseMetaData()
-
- If meta And meta.HasMeta("nomangle") Then
- If attrs & FUNC_METHOD Then
- Err "Only functions can specify NoMangle"
- Else
- noMangle = True
- End If
- End If
-
- If CParse("export") Then
- attrs :| DECL_EXPORT
- If attrs & FUNC_METHOD Then
- Err "Only functions can specify Export"
- Else
- exported = True
- End If
- End If
-
- attrs :| ParseCallConvention(attrs & DECL_API_STDCALL)
-
- If CParse( "nodebug" ) Then
- attrs :| DECL_NODEBUG
- End If
- Local funcDecl:TFuncDecl
- If attrs & FUNC_CTOR Then
- funcDecl=New TNewDecl.CreateF( id,ty,args,attrs )
- TNewDecl(funcDecl).cdecl = classdecl
- Else
- 'If fdecl Then
- ' funcDecl = fdecl
- ' funcDecl.ident = id
- 'Else
- funcDecl=New TFuncDecl.CreateF( id,ty,args,attrs )
- 'End If
- funcDecl.noMangle = noMangle
- funcDecl.exported = exported
- End If
- If meta Then
- funcDecl.metadata = meta
- End If
- If funcDecl.IsExtern() Or (attrs & FUNC_PTR)
- funcDecl.munged=funcDecl.ident
- ' a normal function pointer definition *probably* can't be defined with a munged name?
- ' If there is an equals here, one can assume it is for an initialisation...
- 'If (Not (attrs & FUNC_PTR)) Or (attrs & FUNC_PTR And Not (attrs & DECL_ARG)) Then
- Local cdets:TCastDets
-
- If Not (attrs & FUNC_PTR) Then
- If CParse( "=" )
- Local munged:String = ParseStringLit()
-
- If munged.Find("(") > 0 Then
- cdets = ParseExternCast(munged, True)
- If cdets Then
- funcDecl.munged = cdets.name
- End If
- Else
- funcDecl.munged = munged
- End If
- End If
- 'Array $resize hack!
- 'If funcDecl.munged="$resize"
- ' funcDecl.retTypeExpr=TType.emptyArrayType
- 'EndIf
- EndIf
- If funcDecl.munged Then
- ' look up extern cast list
- If Not cdets Then
- cdets = TCastDets(_externCasts.ValueForKey(funcDecl.munged))
- End If
-
- If cdets Then
- funcDecl.castTo = cdets.retType
- If cdets.noGen Then
- funcDecl.noCastGen = True
- End If
- For Local i:Int = 0 Until cdets.args.length
- If i < funcDecl.argDecls.length Then
- funcDecl.argDecls[i].castTo = cdets.args[i]
- End If
- Next
- End If
- End If
- Return funcDecl
- EndIf
- If funcDecl.IsAbstract() Return funcDecl
- 'Ok, only first statement of a constructor can call super constructor - not pretty, should be in semant.
- If attrs & FUNC_CTOR
- SkipEols
- If CParse( "super" )
- Parse "."
- If _toke="new"
- Local id$="New"
- NextToke
- 'funcDecl.superCtor=New TInvokeSuperExpr.Create( id,ParseArgs( True ) )
- 'funcDecl.AddStmt New TExprStmt.Create( funcDecl.superCtor )
- funcDecl.AddStmt New TExprStmt.Create( New TNewExpr.Create(ParseArgs(True), True))
- Else
- Local id$=ParseIdent()
- funcDecl.AddStmt New TExprStmt.Create( New TInvokeSuperExpr.Create( id,ParseArgs( True ) ) )
- EndIf
- Else
- 'Invoke super default ctor
- 'funcDecl.superCtor=New InvokeSuperExpr( "new",[] )
- 'funcDecl.AddStmt New TExprStmt( funcDecl.superCtor )
- EndIf
- EndIf
- PushBlock funcDecl
- While (Not meth And _toke.ToLower()<>"endfunction") Or (meth And _toke.ToLower()<>"endmethod")
- If CParse( "end" )
- If (Not meth And CParse("function")) Or (meth And CParse("method"))
- Exit
- End If
- ' handle "end" statement
- ParseEndStmt(False)
- EndIf
- ParseStmt
- Wend
- PopBlock
- NextToke
- 'If toke CParse toke
- Return funcDecl
- End Method
-
- Method ParseCallConvention:Long(callConvention:Long = DECL_API_DEFAULT)
- If _tokeType <> TOKE_STRINGLIT Then
- Return callConvention
- End If
-
- Local api:String = ParseStringLit().ToLower()
-
- If api = "os" Then
- Select opt_platform
- Case "macos", "osx", "ios"
- api = "macos"
- Case "linux", "android", "raspberrypi", "haiku"
- api = "linux"
- Case "win32"
- api = "win32"
- Case "nx"
- api = "nx"
- End Select
- End If
- Select api
- Case "c", "blitz", "macos", "linux", "nx"
- Return DECL_API_CDECL
- Case "win32"
- ' only if we are compiling for win32
- If opt_platform = "win32"
- Return DECL_API_STDCALL
- Else
- Return DECL_API_CDECL
- End If
- End Select
-
- Err "Unrecognized calling convention '" + api+ "'"
- End Method
- Method ParseFuncParamDecl:TArgDecl[]()
- Local args:TArgDecl[]
- Parse "("
- SkipEols
- If _toke<>")"
- Local nargs:Int
- Repeat
- Local attrs:Long
- If CParse("staticarray") Then
- attrs :| DECL_STATIC
- End If
-
- Local argId$=ParseIdent()
- Local ty:TType=ParseDeclType(attrs)
- Local init:TExpr
-
- ' var argument?
- If CParse("var") Then
- If attrs & DECL_STATIC Then
- Err "Unexpected 'Var' for static array argument"
- End If
- ty = TType.MapToVarType(ty)
- Else If CParse( "=" )
- init=ParseExpr()
- Else
- If CParse( "[" ) And (attrs & DECL_STATIC) Then
- init = ParseExpr()
- Parse "]"
- ty=New TArrayType.Create( ty,1,, attrs & DECL_STATIC > 0 )
- End If
- End If
-
- Local arg:TArgDecl=New TArgDecl.Create( argId,ty,init,attrs )
- If args.Length=nargs args=args + New TArgDecl[10]
- args[nargs]=arg
- nargs:+1
- If _toke=")" Exit
- Parse ","
- Forever
- args=args[..nargs]
- EndIf
- Parse ")"
- Return args
- End Method
-
- Method ParseEnumDecl:TEnumDecl( toke:String )
- SetErr
- If toke Parse toke
- Local id:String = ParseIdent()
- Local ty:TType = ParseConstNumberType()
- If Not ty Then
- ty = New TIntType
- End If
- Local isFlags:Int = 0
- Local values:TEnumValueDecl[0]
-
- If CParse("flags")
- isFlags = True
- End If
-
- Local decl:TEnumDecl = New TEnumDecl.Create(id, ty, isFlags, values)
- Local nValues:Int
-
- Repeat
-
- SkipEols
- If CParse("end") Then
- Parse("enum")
- Exit
- End If
-
- If CParse("endenum") Then
- Exit
- End If
-
- Local valId:String = ParseIdent()
- Local value:TExpr
-
- If CParse( "=" ) Then
- value = ParseExpr()
- End If
-
- Local v:TEnumValueDecl = New TEnumValueDecl.Create(valId, nValues, value)
- If decl.values.Length = nValues Then
- decl.values = decl.values + New TEnumValueDecl[10]
- End If
- decl.values[nValues] = v
- nValues :+ 1
-
- CParse(",")
-
- Forever
- decl.values = decl.values[..nValues]
- Return decl
-
- End Method
- Method ParseClassDecl:TClassDecl( toke$,attrs:Long, templateDets:TTemplateDets = Null )
- SetErr
- Local calculatedStartLine:Int = _toker.Line()
- Local startLine:Int = _toker._line
- If toke Parse toke
- Local id$=ParseIdent()
- Local args:TList = New TList
- Local superTy:TIdentType
- Local imps:TIdentType[]
- Local meta:TMetadata
- 'If (attrs & CLASS_INTERFACE) And (attrs & DECL_EXTERN)
- ' Err "Interfaces cannot be extern."
- 'EndIf
- If CParse( "<" )
- If attrs & DECL_EXTERN
- Err "Extern classes cannot be generic."
- EndIf
- 'If attrs & CLASS_INTERFACE
- ' Err "Interfaces cannot be generic."
- 'EndIf
- 'If attrs & CLASS_TEMPLATEARG
- ' Err "Class parameters cannot be generic."
- 'EndIf
- Local nargs:Int
- Repeat
- 'Local decl:TClassDecl=ParseClassDecl( "",CLASS_TEMPLATEARG )
- 'If args.Length=nargs args=args + New TClassDecl[10]
- 'args[nargs]=decl
- 'nargs:+1
- Local arg:TTemplateArg = New TTemplateArg
- arg.ident = ParseIdent()
-
- ' If CParse("extends") Then
- ' arg.superTy = ParseIdentType()
- ' End If
-
- args.AddLast arg
- Until Not CParse(",")
- 'args=args[..nargs]
- Parse ">"
- If CParse( "where" ) Then
- 'DebugStop
- Repeat
- Local argIdent:String = ParseIdent()
-
- Parse("extends")
-
- Local found:Int
- For Local arg:TTemplateArg = EachIn args
- If arg.ident = argIdent Then
-
- Repeat
-
- arg.ExtendsType(ParseIdentType())
-
- Until Not CParse("and")
-
- found = True
- Exit
- EndIf
- Next
- If Not found Then
- Err "Use of undeclared type '" + argIdent + "'."
- End If
-
- Until Not CParse(",")
- End If
- EndIf
- If CParse( "extends" )
- 'If attrs & CLASS_TEMPLATEARG
- ' Err "Extends cannot be used with class parameters."
- 'EndIf
- ' If CParse( "null" )
- '
- If attrs & CLASS_STRUCT
- Err "Structs cannot be extended"
- EndIf
- '
- ' If Not (attrs & DECL_EXTERN)
- ' Err "Only extern objects can extend null."
- ' EndIf
- '
- ' superTy=Null
- '
- ' Else
- If attrs & CLASS_INTERFACE And Not (attrs & DECL_EXTERN)
- Local nimps:Int
- Repeat
- If imps.Length=nimps imps=imps + New TIdentType[10]
- imps[nimps]=ParseIdentType()
- nimps:+1
- Until Not CParse(",")
- imps=imps[..nimps]
- superTy=New TIdentType.Create( "brl.classes.object" )
- Else
- superTy=ParseIdentType()
- EndIf
- Else
- If Not (attrs & DECL_EXTERN) And Not (attrs & CLASS_STRUCT) Then
- superTy=New TIdentType.Create( "brl.classes.object" )
- End If
- EndIf
- If CParse( "implements" )
- If attrs & CLASS_STRUCT
- Err "Implements cannot be used with Structs"
- EndIf
- 'If attrs & DECL_EXTERN
- ' Err "Implements cannot be used with external classes."
- 'EndIf
- If attrs & CLASS_INTERFACE
- Err "Implements cannot be used with interfaces."
- EndIf
- 'If attrs & CLASS_TEMPLATEARG
- ' Err "Implements cannot be used with class parameters."
- 'EndIf
- Local nimps:Int
- Repeat
- If imps.Length=nimps imps=imps + New TIdentType[10]
- imps[nimps]=ParseIdentType()
- nimps:+1
- Until Not CParse(",")
- imps=imps[..nimps]
- EndIf
- Repeat
- If CParse( "final" )
- If attrs & CLASS_INTERFACE
- Err "Final cannot be used with interfaces."
- End If
-
- If attrs & CLASS_STRUCT
- Err "Final cannot be used with structs."
- End If
-
- If attrs & DECL_FINAL
- Err "Duplicate modifier 'Final'."
- End If
- If attrs & DECL_ABSTRACT
- Err "Classes cannot be both final and abstract."
- End If
-
- attrs:|DECL_FINAL
- Else If CParse( "abstract" )
- If attrs & CLASS_INTERFACE
- Err "Abstract cannot be used with interfaces."
- EndIf
-
- If attrs & CLASS_STRUCT
- Err "Abstract cannot be used with structs."
- EndIf
-
- If attrs & DECL_ABSTRACT
- Err "Duplicate modifier 'Abstract'."
- End If
-
- If attrs & DECL_FINAL
- Err "Types cannot be both final and abstract."
- End If
- attrs:|DECL_ABSTRACT
- Else
- Exit
- EndIf
- Forever
- 'check for metadata
- meta = ParseMetaData()
-
- Local sargs:TTemplateArg[] = New TTemplateArg[args.Count()]
- Local i:Int = 0
- For Local arg:TTemplateArg = EachIn args
- sargs[i] = arg
- i :+ 1
- Next
- Local classDecl:TClassDecl=New TClassDecl.Create( id,sargs,superTy,imps,attrs )
-
- If meta Then
- If attrs & CLASS_STRUCT
- Err "Structs cannot store metadata."
- EndIf
- classDecl.metadata = meta
- End If
- If classDecl.IsExtern()
- classDecl.munged=classDecl.ident
- If CParse( "=" ) classDecl.munged=ParseStringLit()
- EndIf
- 'If classDecl.IsTemplateArg() Return classDecl
- Local decl_attrs:Long=(attrs & DECL_EXTERN) | (attrs & DECL_NODEBUG) | (attrs & DECL_API_STDCALL)
- Repeat
- Local method_attrs:Long=decl_attrs|FUNC_METHOD | (attrs & DECL_NODEBUG)
- Local abst_attrs:Long = 0
- If attrs & CLASS_INTERFACE abst_attrs:|DECL_ABSTRACT
-
- SkipEols
- Select _toke
- Case "end"
- NextToke
- Exit
- Case "endtype"
- If attrs & CLASS_INTERFACE Then
- Err "Syntax error - expecting End Interface, not 'EndType'"
- End If
- If attrs & CLASS_STRUCT Then
- Err "Syntax error - expecting End Struct, not 'EndType'"
- End If
- toke = Null
- NextToke
- Exit
- Case "endstruct"
- If attrs & CLASS_INTERFACE Then
- Err "Syntax error - expecting End Interface, not 'EndStruct'"
- End If
- If Not (attrs & CLASS_STRUCT) Then
- Err "Syntax error - expecting End Type, not 'EndStruct'"
- End If
- toke = Null
- NextToke
- Exit
- Case "endinterface"
- If Not (attrs & CLASS_INTERFACE) And Not (attrs & CLASS_STRUCT) Then
- Err "Syntax error - expecting End Type, not 'EndInterface'"
- End If
- If Not (attrs & CLASS_INTERFACE) And (attrs & CLASS_STRUCT) Then
- Err "Syntax error - expecting End Struct, not 'EndInterface'"
- End If
- toke = Null
- NextToke
- Exit
- Case "private"
- If attrs & CLASS_INTERFACE Then
- Err "Private cannot be used with interfaces."
- End If
- NextToke
- decl_attrs=decl_attrs | DECL_PRIVATE
- decl_attrs:& ~DECL_PROTECTED
- Case "protected"
- If attrs & CLASS_INTERFACE Then
- Err "Protected cannot be used with interfaces."
- End If
- NextToke
- decl_attrs=decl_attrs | DECL_PROTECTED
- decl_attrs:& ~DECL_PRIVATE
- Case "public"
- NextToke
- decl_attrs:& ~DECL_PRIVATE
- decl_attrs:& ~DECL_PROTECTED
- Case "const","global","field","threadedglobal"
- Local extra_attrs:Long
- If _toke = "threadedglobal" Then
- extra_attrs = DECL_THREADED
- End If
-
- If attrs & DECL_EXTERN Then
- If (attrs & CLASS_INTERFACE) Then
- Err "Extern Interfaces can only contain methods."
- End If
- If Not (attrs & CLASS_STRUCT) Then
- Err "Extern Types can only contain methods."
- End If
- End If
- If (attrs & CLASS_INTERFACE) And _toke<>"const"
- Err "Interfaces can only contain constants and methods."
- EndIf
- If (attrs & CLASS_STRUCT) And _toke<>"field" And _toke<>"global" And _toke<>"threadedglobal"
- Err "Structs can only contain fields."
- EndIf
-
- classDecl.InsertDecls ParseDecls( _toke,decl_attrs | extra_attrs, _toke = "field")
- Case "method"
- If (attrs & CLASS_STRUCT) And (attrs & DECL_EXTERN) Then
- Err "Structs can only contain fields."
- EndIf
- Local decl:TFuncDecl=ParseFuncDecl( _toke,method_attrs | abst_attrs,classDecl )
- classDecl.InsertDecl decl
- Case "function"
- 'If (attrs & CLASS_INTERFACE)
- ' Err "Interfaces can only contain constants and methods."
- 'EndIf
- If attrs & CLASS_STRUCT Then
- If (attrs & DECL_EXTERN) Then
- Err "Structs can only contain fields."
- End If
- EndIf
- If attrs & DECL_EXTERN Then
- Err "Extern Types can only contain methods."
- End If
- Local decl:TFuncDecl=ParseFuncDecl( _toke,decl_attrs | abst_attrs,classDecl )
- classDecl.InsertDecl decl
- Case "type"
- If templateDets Then
- Local cdecl:TClassDecl = ParseClassDecl( _toke,DECL_NESTED, templateDets)
- cdecl = cdecl.GenClassInstance(templateDets.instArgs, False, Null, templateDets)
- classDecl.InsertDecl cdecl, True
- Else
- classDecl.InsertDecl ParseClassDecl( _toke,DECL_NESTED)
- End If
- Default
- Err "Syntax error - expecting class member declaration, not '" + _toke + "'"
- End Select
- Forever
-
- If Not args.IsEmpty() Then
- Local endline:Int = _toker._line
- classDecl.templateSource = New TTemplateRecord.Create(calculatedStartLine - 1, _toker._path, _toker.Join(startLine, endLine, "~n"))
- End If
- If toke Parse toke
- Return classDecl
- End Method
-
- Method ParseNativeStmt()
- If Not _toke.StartsWith("'!") Then
- Err "Syntax error - expecting '!"
- End If
- Local raw:String = _toke[2..]
- _block.AddStmt New TNativeStmt.Create( raw )
- NextToke
- End Method
- Method ParsePragmaStmt()
-
- Local pragma:String = _toke
- If pragma.StartsWith("'") Then
- pragma = pragma[1..].Trim()
- If Not pragma.StartsWith("@bmk") Then
- Err "Syntax error - expecting @bmk pragma"
- End If
- pragma = pragma[4..].Trim()
- _module.pragmas.AddLast(pragma)
- End If
- NextToke
- End Method
- Method ParseModuleDecl:String( toke$,attrs:Long )
- NextToke
- ' namespace . module
- Return ParseModPath().ToLower()
- End Method
- Method ParseModPath$()
- Local path$=ParseIdent()
- While CParse( "." )
- path:+"."+ParseIdent()
- Wend
- Return path
- End Method
- Method ExtractModIdent$( modpath$ )
- Local i:Int=modpath.FindLast( "." )
- If i<>-1 Return modpath[i+1..]
- Return modpath
- End Method
- Method ImportFile( filepath$ )
- If filepath.Endswith(".bmx") Then
- filepath = ActualPath(filepath)
- Local origPath:String = RealPath(filepath)
- Local path:String = OutputFilePath(origPath, FileMung(), "i")
- If FileType( origPath )<>FILETYPE_FILE
- Err "File '"+ origPath +"' not found."
- EndIf
- If FileType( path )<>FILETYPE_FILE
- Err "File '"+ path +"' not found."
- EndIf
- If _module.imported.Contains( path ) Return
- Local modpath:String
- If opt_buildtype = BUILDTYPE_MODULE Then
- Local dir:String = ExtractDir(origPath).ToLower()
- dir = dir[dir.findLast("/") + 1..]
- If dir.EndsWith(".mod") Then
- dir = ""
- Else
- dir :+ "_"
- End If
- Local file:String = StripDir(origPath).ToLower()
- modpath = opt_modulename + "_" + dir + StripExt(file)
- Else
- modpath = StripExt(filepath)
- End If
- 'sanitize the path, remove non-allowed chars
- modpath = TStringHelper.Sanitize(modpath.ToLower())
- ' try to import interface
- Local par:TIParser = New TIParser
- If par.ParseModuleImport(_module, modpath, origPath, path, , , filepath, True) Return
- Else If filepath.startswith("-") Then
- If Not _app.fileimports.Contains(filepath) Then
- _app.fileimports.AddLast filepath
- End If
- Else
- If filepath.EndsWith(".h") Or filepath.EndsWith(".hpp") Or filepath.EndsWith(".hxx") Then
- If filepath.Find("*") = -1 Then
- _app.headers.AddLast filepath
- End If
- Else
- Local path:String = ActualPath(RealPath(filepath))
- If FileType( path )<>FILETYPE_FILE
- Err "File '"+ path +"' not found."
- End If
- End If
- End If
- End Method
- Method ImportAllModules(attrs:Long)
- ' get all brl and pub modules
- Local mods:TList = EnumModules("brl")
- mods = EnumModules("pub", mods)
- For Local m:String = EachIn mods
- ImportModule(m, attrs)
- Next
- End Method
-
- Method ImportModule( modpath$,attrs:Long )
- ' SetErr
-
- modpath = modpath.ToLower()
- Local basepath:String = ModulePath(modpath)
- If _module.imported.Contains( basepath ) Return
- ' try to import interface
- Local par:TIParser = New TIParser
- If par.ParseModuleImport(_module, modpath, basepath, , , attrs) Return
- 'DebugStop
- 'Local mdecl:TDecl=_app.imported.ValueForKey( basepath )
- 'If Not mdecl
- ' mdecl=ParseModule( filepath,_app )
- 'EndIf
- '_module.imported.Insert mdecl.filepath,mdecl
- 'If Not (attrs & DECL_PRIVATE) _module.pubImported.Insert mdecl.filepath,mdecl
- '_module.InsertDecl New AliasDecl( mdecl.ident,mdecl,attrs )
- 'End Rem
- End Method
- Method ValidateModIdent( id$ )
- If id.Length
- If IsAlpha( id[0] ) Or id[0]="_"[0]
- Local err:Int
- For Local i:Int=1 Until id.Length
- If IsAlpha( id[i] ) Or IsDigit( id[i] ) Or id[i]="_"[0] Continue
- err=1
- Exit
- Next
- If Not err Return
- EndIf
- EndIf
- Err "Invalid module identifier '"+id+"'."
- End Method
- Method MungAppDecl(app:TAppDecl)
- If opt_buildtype = BUILDTYPE_MODULE And opt_ismain Then
- app.munged = MungModuleName(opt_modulename)
- Else If opt_buildtype = BUILDTYPE_MODULE Then
- Local dir:String = ExtractDir(opt_filepath).ToLower()
- dir = dir[dir.findLast("/") + 1..]
- If dir.EndsWith(".mod") Then
- dir = ""
- Else
- dir :+ "_"
- End If
- app.munged = "_bb_" + opt_modulename + "_" + dir + StripExt(StripDir(opt_filepath).ToLower())
- Else
- ' main application file?
- If opt_apptype Then
- app.munged = "_bb_main"
- Else
- Local dir:String = ExtractDir(opt_filepath).ToLower()
- dir = dir[dir.findLast("/") + 1..]
- If dir.EndsWith(".mod") Then
- dir = dir.Replace(".mod", "")
- End If
- Local file:String = StripDir(opt_filepath).ToLower()
- app.munged = "_bb_" + dir + "_" + StripExt(file)
- End If
- End If
- 'sanitize, remove non-allowed chars
- app.munged = TStringHelper.Sanitize(app.munged)
- End Method
- ' load external cast defs
- Method LoadExternCasts(path:String)
- For Local externs:Int = 0 Until 3
-
- Local ePath:String
-
- ' we will iterate through all possibilities as there may be different sets
- ' of explicit casts/no gen funcs for each.
- Select externs
- Case 0
- ' eg. file.win32.x86.x
- ePath = StripExt(path) + "." + opt_platform + "." + opt_arch + ".x"
- Case 1
- ' eg. file.win32.x
- ePath = StripExt(path) + "." + opt_platform + ".x"
- Case 2
- ' eg. file.x
- ePath = StripExt(path) + ".x"
- End Select
- If FileType(ePath) = FILETYPE_FILE Then
-
- Print "Warning: .x cast definition files are deprecated. You should now place the details in the extern function's alias string. (" + path + ")"
- ParseExternCast(LoadText( ePath ), False, ePath)
- End If
-
- Next
- End Method
- Method ParseExternCast:TCastDets(txt:String, single:Int = False, path:String = "")
- Local toker:TToker = New TToker.Create(path, txt)
- toker.NextToke
- Local dets:TCastDets
-
- While True
- SkipEolsToker(toker)
- If toker._tokeType = TOKE_EOF Exit
- dets = New TCastDets
- Local rt$=toker._toke
- If CParseToker(toker, "const") Then
- rt :+ " " + toker._toke
- End If
- If CParseToker(toker, "unsigned") Then
- rt :+ " " + toker._toke
- End If
- NextTokeToker(toker)
-
- If CParseToker(toker,"*") Then
- rt:+ "*"
- If CParseToker(toker,"*") Then
- rt:+ "*"
- End If
- End If
- If CParseToker(toker, "__stdcall") Then
- dets.api = "__stdcall"
- End If
- ' fname
- Local fn$=toker._toke
- NextTokeToker(toker)
- dets.name = fn
- dets.retType = rt
- ' add to global map (may be referenced by function ptr defs)
- _externCasts.Insert(fn, dets)
- ' args
- ParseToker(toker, "(")
- If CParseToker(toker, ")") Then
- ' don't generate header extern
- If CParseToker(toker, "!") Then
- dets.noGen = True
- End If
- Continue
- End If
- Local i:Int = 0
- Repeat
- Local at$=toker._toke
- If CParseToker(toker, "const") Then
- at :+ " " + toker._toke
- End If
- If CParseToker(toker, "unsigned") Then
- at :+ " " + toker._toke
- End If
- If CParseToker(toker, "struct") Then
- at :+ " " + toker._toke
- End If
- NextTokeToker(toker)
- If CParseToker(toker, "*") Then
- at:+ "*"
- If CParseToker(toker, "const") Then
- at :+ " const"
- End If
- If CParseToker(toker, "*") Then
- at:+ "*"
- End If
- End If
- ' function pointer
- If CParseToker(toker, "(") Then
- ParseToker(toker, "*")
- ParseToker(toker, ")")
- at :+ "(*)"
- ParseToker(toker, "(")
- at :+ "("
- While Not CParseToker(toker, ")")
- NextTokeToker(toker)
- at :+ toker._toke
- Wend
- at :+ ")"
- End If
- dets.args :+ [at]
- If toker._toke=")" Exit
- ParseToker(toker, ",")
- i:+ 1
- Forever
- NextTokeToker(toker)
- ' don't generate header extern
- If CParseToker(toker, "!") Then
- dets.noGen = True
- End If
-
- If single Then
- Exit
- End If
- Wend
-
- Return dets
- End Method
- Method ParseCurrentFile:Long(path:String, attrs:Long)
- LoadExternCasts(path)
- While _toke
- SetErr
- Select _toke.toLower()
- Case "~n"
- NextToke
- Case "public"
- NextToke
- attrs=attrs & ~DECL_PRIVATE
- Case "private"
- NextToke
- attrs=attrs | DECL_PRIVATE
- Case "extern"
- ParseExternBlock(_module, attrs)
- Case "const"
- _module.InsertDecls ParseDecls( _toke,attrs )
- Case "global"
- ParseDeclStmts(True, attrs, _module)
- Case "threadedglobal"
- ParseDeclStmts(True, attrs | DECL_THREADED, _module)
- Case "struct"
- _module.InsertDecl ParseClassDecl( _toke,attrs | CLASS_STRUCT )
- Case "type"
- _module.InsertDecl ParseClassDecl( _toke,attrs)
- Case "interface"
- _module.InsertDecl ParseClassDecl( _toke,attrs|CLASS_INTERFACE|DECL_ABSTRACT )
- Case "enum"
- _module.InsertDecl ParseEnumDecl( _toke )
- Case "function"
- _module.InsertDecl ParseFuncDecl( _toke,attrs )
- Case "incbin"
- SetErr
- NextToke
- Local s:String = ParseStringLit()
- _app.mapStringConsts(s)
- Local ib:TIncBin = New TIncbin.Create(s, path)
- If Not ib Then
- Err "Incbin file '"+ s +"' not found."
- End If
- _app.incbins.AddLast(ib)
- Case "include"
- SetErr
- 'include command is NOT just a pattern to replace with
- 'content. BlitzMax parses each included file before the
- 'content gets appended to the source (right before
- 'semanting or analyzing content)
- NextToke
- Local includeFile:String = ParseStringLit()
- 'convert the URI of the to include file as it might be
- 'a relative one
- includeFile = RealPath(includeFile)
- 'instead of merging the data of multiple parsers, the
- 'same parser is used for all included files - but each
- 'of them uses an individual toker
- If FileType( includeFile )<>FILETYPE_FILE
- Err "File '"+ includeFile +"' not found."
- EndIf
- 'instead of "LoadText" "PreProcess" is used to include
- 'handling of conditionals and comments
- Try
- Local includeSource:String = PreProcess(includeFile)
- Local includeToker:TToker = New TToker.Create(includeFile, includeSource)
- 'backup old vars
- Local oldToker:TToker = Self._toker
- 'assign temporary vars
- Self._toker = includeToker
- 'parse the include file
- parseCurrentFile(includeFile, attrs)
- 'restore backup vars
- Self._toker = oldToker
- Catch e:TStreamException
- DoErr "Failed to include file '" + includeFile + "' : '" + e.ToString() + "'"
- End Try
- 'move on to next toke (after include "xyz.bmx")
- NextToke
- Default
- ParseStmt
- 'Err "Syntax error - expecting declaration."
- End Select
- Wend
- Return attrs
- End Method
- Method ParseGeneric:Object(templateSource:TTemplateRecord, templateDets:TTemplateDets)
- Local toker:TToker = New TToker.Create(templateSource.file, templateSource.source, False, templateSource.start)
- Local parser:TParser = New TParser.Create( toker, _appInstance )
-
- Local m:TModuleDecl = New TModuleDecl
- parser._module = m
-
- Local cdecl:TClassDecl = Null
-
- Select parser._toke
- Case "type"
- cdecl = parser.ParseClassDecl(parser._toke,0, templateDets )
- Case "interface"
- cdecl = parser.ParseClassDecl(parser._toke, CLASS_INTERFACE|DECL_ABSTRACT, templateDets )
- End Select
-
- Return cdecl
- End Method
- Method ParseMain()
- SkipEols
- Local mattrs:Long
- 'If CParse( "strict" ) mattrs:|MODULE_STRICT
- 'If CParse( "superstrict" ) mattrs:|MODULE_SUPERSTRICT
- Local path$=_toker.Path()
- Local ident$=StripAll( path )
- Local munged$ '="bb_"+ident+"_"
- If opt_buildtype = BUILDTYPE_MODULE And opt_ismain
- ValidateModIdent ident
- Else If opt_buildtype = BUILDTYPE_MODULE Then
- Local dir:String = ExtractDir(opt_filepath).ToLower()
- dir = dir[dir.findLast("/") + 1..]
- If dir.EndsWith(".mod") Then
- dir = ""
- Else
- dir :+ "_"
- End If
- munged = opt_modulename + "_" + dir + ident
- 'sanitize, remove non-allowed chars
- munged = TStringHelper.Sanitize(munged.ToLower())
- End If
- If opt_ismain Then 'And opt_modulename <> "brl.blitz" Then
- ident = opt_modulename
- End If
-
- If opt_buildtype = BUILDTYPE_APP Then
- ident = "m_" + ident
- End If
- _module=New TModuleDecl.Create( ident,munged,path,mattrs )
- If Not _env Then
- _env = _module
- End If
- _module.AddImport path,_module
- _app.InsertModule _module
- ' mung the app decl
- MungAppDecl(_app)
- If opt_buildtype = BUILDTYPE_MODULE And opt_modulename = "brl.blitz" Then
- ' import Object and String definitions
- Local par:TIParser = New TIParser
- par.ParseModuleImport(_module, "brl.classes", modulepath("brl.blitz"), modulepath("brl.blitz") + "/blitz_classes.i")
- ' set up built-in keywords
- par = New TIParser
- par.ParseModuleImport(_module, "brl.blitzkeywords", "", "", MakeKeywords())
- End If
- ' don't import ourself
- If opt_modulename <> "brl.blitz" Then
- Local par:TIParser = New TIParser
- par.ParseModuleImport(_module, "brl.blitz", modulepath("brl.blitz"), , , MODULE_ACTUALMOD)
- End If
- Local mainFunc:TFuncDecl = New TFuncDecl.CreateF("__LocalMain", New TIntType,Null,0)
- '_app.InsertDecl mainFunc
- _module.insertDecl(mainFunc)
- 'Local mainBlock:TBlockDecl = New TBlockDecl.Create( _block )
- ' import all brl and pub modules if we haven't specified one
- If opt_buildtype <> BUILDTYPE_MODULE And Not opt_framework Then
- ImportAllModules MODULE_ACTUALMOD
- Else
- If opt_framework Then
- Local par:TIParser = New TIParser
- par.ParseModuleImport(_module, opt_framework, modulepath(opt_framework), , , MODULE_ACTUALMOD)
- End If
- End If
- Local attrs:Long
- While _toke
- SetErr
- Select _toke.ToLower()
- Case "~n"
- NextToke
- Case "strict"
- If _module.attrs & (MODULE_STRICT | MODULE_SUPERSTRICT) Then
- Err "Strict or SuperStrict already specified"
- End If
- _module.attrs :| MODULE_STRICT
- nextToke
- Case "superstrict"
- If _module.attrs & (MODULE_STRICT | MODULE_SUPERSTRICT) Then
- Err "Strict or SuperStrict already specified"
- End If
- _module.attrs :| MODULE_SUPERSTRICT
- opt_issuperstrict = True
- NextToke
- Default
- Exit
- End Select
- Wend
- ' auto enable superstrict mode?
- If Not (_module.attrs & (MODULE_STRICT | MODULE_SUPERSTRICT)) Then
- If opt_no_auto_superstrict Then
- If opt_need_strict And Not (_module.attrs & (MODULE_STRICT | MODULE_SUPERSTRICT)) Then
- Err "Strict or SuperStrict must be declared at the start of the file."
- End If
- Else
- _module.attrs :| MODULE_SUPERSTRICT
- End If
- End If
- 'Parse header - imports etc.
- While _toke
- SetErr
- Select _toke.ToLower()
- Case "~n"
- NextToke
- Case "public"
- NextToke
- attrs=attrs & ~DECL_PRIVATE
- Case "private"
- NextToke
- attrs=attrs | DECL_PRIVATE
- Case "import"
- NextToke
- If _tokeType=TOKE_STRINGLIT
- ' TODO
- 'ImportFile ReplaceEnvTags( ParseStringLit() )
- ImportFile ParseStringLit()
- Else
- ImportModule ParseModPath(),attrs | MODULE_ACTUALMOD
- EndIf
- Case "framework"
- If _module.attrs & MODULE_FRAMEWORK Then
- Err "Framework already specified"
- End If
- If _module.attrs & MODULE_MODULE Then
- Err "Module already specified"
- End If
-
- NextToke
- ImportModule ParseModPath(),attrs
- _module.attrs :| MODULE_FRAMEWORK
- Case "alias"
- NextToke
- Repeat
- Local ident$=ParseIdent()
- Parse "="
- Local decl:Object
- Local scope:TScopeDecl=_module
- _env=_module 'naughty! Shouldn't be doing GetDecl in parser...
- Repeat
- Local id$=ParseIdent()
- decl=scope.FindDecl( id )
- If Not decl Err "Identifier '"+id+"' not found."
- If Not CParse( "." ) Exit
- scope=TScopeDecl( decl )
- If Not scope Or TFuncDecl( scope ) Err "Invalid scope '"+id+"'."
- Forever
- _env=Null '/naughty
- _module.InsertDecl New TAliasDecl.Create( ident,decl,attrs )
- Until Not CParse(",")
- Case "module"
- If _module.attrs & MODULE_FRAMEWORK Then
- Err "Framework already specified"
- End If
- If _module.attrs & MODULE_MODULE Then
- Err "Module already specified"
- End If
- Local m:String = ParseModuleDecl(_toke, attrs)
- If m.ToLower() <> opt_modulename Then
- Err "Module does not match commandline module"
- End If
- 'sanitize, remove non-allowed chars
- _module.munged = TStringHelper.Sanitize(m)
- _module.attrs :| MODULE_MODULE
- Case "nodebug"
- mainFunc.attrs :| DECL_NODEBUG
- attrs :| DECL_NODEBUG
- NextToke
- Case "moduleinfo"
- NextToke
- Local info:String = ParseStringLit()
- _module.modInfo.AddLast(info)
- Default
- Exit
- End Select
- If _tokeType = TOKE_PRAGMA Then
- ParsePragmaStmt()
- NextToke
- End If
- Wend
- ' app code
- PushBlock(mainFunc)
- 'Parse main app
- attrs = ParseCurrentFile(path, attrs)
- PopBlock
- End Method
- Method ParseModule()
- End Method
- Method Create:TParser( toker:TToker,app:TAppDecl, unknownIdentsEvalFalse:Int = False )
- _toke="~n"
- _toker=toker
- _app=app
- SetErr
- NextToke
- Self.unknownIdentsEvalFalse = unknownIdentsEvalFalse
- Return Self
- End Method
- End Type
- Function Eval$( toker:TToker,_type:TType )
- Local src$
- While toker.Toke() And toker.Toke()<>"'" And toker.Toke()<>"~n" And toker.Toke()<>"~r"
- src:+toker.Toke()
- toker.NextToke()
- Wend
- Local t:String=EvalS( src,_type )
- Return t
- End Function
- Function PreProcessNextToke$(toker:TToker)
- Repeat
- toker.NextToke()
- Until toker.tokeType()<>TOKE_SPACE Or toker.Toke().Endswith("~n")
- Return toker._toke
- End Function
- Function PreProcess$( path$ )
- Local ifnest:Int,con:Int=1,line:Int,source:TStringList=New TStringList
- Local toker:TToker=New TToker.Create( path,LoadText( path ), True )
- PreProcessNextToke(toker)
- Repeat
- If line
- source.AddLast "~n"
- While toker.Toke() And Not toker.Toke().Endswith("~n") And toker.TokeType()<>TOKE_LINECOMMENT
- PreProcessNextToke(toker)
- Wend
- If Not toker.Toke() Exit
- PreProcessNextToke(toker)
- EndIf
-
- line :+ 1
- ' catch up with any skipped lines
- While line < toker._line - 1
- line:+1
- source.AddLast "~n"
- Wend
- If toker.TokeType()=TOKE_SPACE And Not toker.Toke().Endswith("~n") PreProcessNextToke(toker)
- If toker.Toke()<>"?"
- If con
- Local textline$
- While toker.Toke() And toker.Toke()<>"~n" And toker.TokeType()<>TOKE_LINECOMMENT
- Local toke$=toker.Toke()
- textline:+toke
- toker.NextToke()
- Wend
- If textline Then
- source.AddLast textline
- EndIf
- EndIf
- Continue
- EndIf
- Local stm$= PreProcessNextToke(toker).ToLower()
- 'toker.NextToke()
- Local isNot:Int = False
- If stm = "not" Then
- If toker.TokeType()=TOKE_SPACE PreProcessNextToke(toker)
- stm = toker.Toke().ToLower()
- isNot = True
- End If
- 'If stm="end" Or stm="else"
- ' If toker.TokeType()=TOKE_SPACE toker.NextToke()
- ' If toker.Toke().ToLower()="if"
- ' toker.NextToke()
- ' stm:+"if"
- ' EndIf
- 'EndIf
- Rem
- Debug True if program is being compiled in debug mode.
- Threaded True if program is being compiled in threaded mode.
- Win32 True if program is being compiled for the Windows operating system.
- MacOS True if program is being compiled for the MacOS operating system.
- Linux True if program is being compiled for the Linux operating system.
- X86 True if program is being compiled for the Intel CPU.
- PPC True if program is being compiled for the PowerPC CPU.
- MacOSX86 True if program is being compiled for an Intel Mac.
- MacOSPPC True if program is being compiled for a PowerPC Mac.
- BigEndian True if program is being compiled for a big endian CPU.
- LittleEndian
- End Rem
- Select stm
- Case "~r", "~n"
- 'ifnest = 0
- con = 1
- Default
- ' test for EOF
- If Not toker.Toke() Exit
- con = 0
- Try
- If Eval( toker,New TIntType ) = "1" con = 1
- Catch Error:String
- con = 0
- End Try
- Rem
- Case "macos", "macosx86", "x86", "littleendian", "bigendian"
- con = 1
- ' If con=ifnest
- ' If Eval( toker,TType.intType ) con:+1
- ' EndIf
- '
- ifnest = 1
- ' Case "rem"
- '
- ' ifnest:+1
- Case "threaded", "win32", "linux", "ppc", "win32x86", "linuxx86", "macosppc"
- If isNot Then
- con = 1
- Else
- con = 0
- End If
- ifnest = 1
- Case "else","elseif"
- If Not ifnest Err "#Else without #If"
- If con=ifnest
- con=-con
- Else If con=ifnest-1
- If stm="elseif"
- If Eval( toker,TType.intType ) con:+1
- Else
- con:+1
- EndIf
- EndIf
- Case "end","endif"
- If Not ifnest Err "#End without #If"
- ifnest:-1
- If con<0 con=-con
- If ifnest<con con=ifnest
- ' Case "print"
- ' If con=ifnest
- ' TODO
- 'Print ReplaceEnvTags( Eval( toker,TType.stringType ) )
- ' EndIf
- ' Case "error"
- ' If con=ifnest
- ' TODO
- 'Err ReplaceEnvTags( Eval( toker,TType.stringType ) )
- ' EndIf
- Default
- Err "Unrecognized preprocessor directive '"+stm+"'."
- End Rem
- End Select
- Forever
- Return source.Join( "" )
- End Function
- Function ParseModule:TModuleDecl( path$,app:TAppDecl )
- 'Local source$=PreProcess( path )
- Local source:String = LoadText(path)
- Local toker:TToker=New TToker.Create( path,source )
- Local parser:TParser=New TParser.Create( toker,app )
- parser.ParseMain
- Return parser._module
- End Function
- Function AppendLibInit:String(source:String)
- Local sb:TStringBuffer = TStringBuffer.Create(source)
-
- sb.Append("~n")
- sb.Append("Extern~n")
- sb.Append("Function bbLibInit()~n")
- sb.Append("End Extern~n")
- sb.Append("Function InitBRL() Export~n")
- sb.Append("bbLibInit()~n")
- sb.Append("End Function~n")
-
- Return sb.ToString()
- End Function
- '***** PUBLIC API ******
- Function ParseApp:TAppDecl( path$ )
- Local app:TAppDecl=New TAppDecl
- _appInstance = app
- Local source$=PreProcess( path )
- 'Local source:String = LoadString(path)
-
- If opt_makelib And opt_apptype Then
- source = AppendLibInit(source)
- End If
- Local toker:TToker=New TToker.Create( path,source )
- Local parser:TParser=New TParser.Create( toker,app )
- parser.ParseMain
- Return app
- End Function
- Function MungModuleName:String(ident:Object)
- Local mung:String
- If String(ident) Then
- Local id:String = String(ident)
- mung = "__bb_" + id + "_" + id[id.Find(".") + 1..]
- Else
- Local mdecl:TModuleDecl = TModuleDecl(ident)
- If mdecl Then
- Local id:String = mdecl.ident
- Local dir:String = ExtractDir(mdecl.filepath).ToLower()
- dir = dir[dir.findLast("/") + 1..]
- If dir.EndsWith(".mod") Then
- dir = ""
- Else
- dir :+ "_"
- End If
- mung = "__bb_" + id + "_" + dir + id[id.Find(".") + 1..]
- End If
- End If
- 'return sanitized, remove non-allowed chars
- Return TStringHelper.Sanitize(mung)
- End Function
- Function EvalS$( source$,ty:TType )
- Local env:TScopeDecl=New TScopeDecl
- ' debug/release
- env.InsertDecl New TConstDecl.Create( "debug",New TIntType,New TConstExpr.Create( New TIntType,opt_debug ),0 )
- env.InsertDecl New TConstDecl.Create( "gdbdebug",New TIntType,New TConstExpr.Create( New TIntType,opt_gdbdebug ),0 )
- ' threaded
- env.InsertDecl New TConstDecl.Create( "threaded",New TIntType,New TConstExpr.Create( New TIntType,opt_threaded ),0 )
- ' macos
- env.InsertDecl New TConstDecl.Create( "macos",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="macos" Or opt_platform="osx" Or opt_platform="ios"),0 )
- env.InsertDecl New TConstDecl.Create( "macosx86",New TIntType,New TConstExpr.Create( New TIntType,(opt_platform="macos" Or opt_platform="osx" Or opt_platform="ios") And opt_arch="x86"),0 )
- env.InsertDecl New TConstDecl.Create( "macosppc",New TIntType,New TConstExpr.Create( New TIntType,(opt_platform="macos" Or opt_platform="osx") And opt_arch="ppc"),0 )
- env.InsertDecl New TConstDecl.Create( "macosx64",New TIntType,New TConstExpr.Create( New TIntType,(opt_platform="macos" Or opt_platform="osx" Or opt_platform="ios") And opt_arch="x64"),0 )
- env.InsertDecl New TConstDecl.Create( "macosarm64",New TIntType,New TConstExpr.Create( New TIntType,(opt_platform="macos" Or opt_platform="osx" Or opt_platform="ios") And opt_arch="arm64"),0 )
- ' osx
- env.InsertDecl New TConstDecl.Create( "osx",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="macos" Or opt_platform="osx" ),0 )
- env.InsertDecl New TConstDecl.Create( "osxx86",New TIntType,New TConstExpr.Create( New TIntType,(opt_platform="macos" Or opt_platform="osx") And opt_arch="x86"),0 )
- env.InsertDecl New TConstDecl.Create( "osxppc",New TIntType,New TConstExpr.Create( New TIntType,(opt_platform="macos" Or opt_platform="osx") And opt_arch="ppc"),0 )
- env.InsertDecl New TConstDecl.Create( "osxx64",New TIntType,New TConstExpr.Create( New TIntType,(opt_platform="macos" Or opt_platform="osx") And opt_arch="x64"),0 )
- env.InsertDecl New TConstDecl.Create( "osxarm64",New TIntType,New TConstExpr.Create( New TIntType,(opt_platform="macos" Or opt_platform="osx") And opt_arch="arm64"),0 )
- ' ios
- env.InsertDecl New TConstDecl.Create( "ios",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="ios" ),0 )
- env.InsertDecl New TConstDecl.Create( "iosx86",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="ios" And opt_arch="x86"),0 )
- env.InsertDecl New TConstDecl.Create( "iosx64",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="ios" And opt_arch="x64"),0 )
- env.InsertDecl New TConstDecl.Create( "iosarmv7",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="ios" And opt_arch="armv7"),0 )
- env.InsertDecl New TConstDecl.Create( "iosarm64",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="ios" And opt_arch="arm64"),0 )
- ' windows
- env.InsertDecl New TConstDecl.Create( "win32",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="win32" ),0 )
- env.InsertDecl New TConstDecl.Create( "win32x86",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="win32" And opt_arch="x86"),0 )
- env.InsertDecl New TConstDecl.Create( "win32x64",New TIntType,New TConstExpr.Create( New TIntType,(opt_platform="win64" And opt_arch="x64") Or (opt_platform="win32" And opt_arch="x64")),0 )
- env.InsertDecl New TConstDecl.Create( "win64",New TIntType,New TConstExpr.Create( New TIntType,(opt_platform="win64" And opt_arch="x64") Or (opt_platform="win32" And opt_arch="x64") Or (opt_platform="win32" And opt_arch="arm64")),0 )
- env.InsertDecl New TConstDecl.Create( "win32armv7",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="win32" And opt_arch="armv7"),0 )
- env.InsertDecl New TConstDecl.Create( "win32arm64",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="win32" And opt_arch="arm64"),0 )
- ' linux
- env.InsertDecl New TConstDecl.Create( "linux",New TIntType,New TConstExpr.Create( New TIntType,(opt_platform="linux" Or opt_platform="android" Or opt_platform="raspberrypi")),0 )
- env.InsertDecl New TConstDecl.Create( "linuxx86",New TIntType,New TConstExpr.Create( New TIntType,(opt_platform="linux" Or opt_platform="android") And opt_arch="x86"),0 )
- env.InsertDecl New TConstDecl.Create( "linuxx64",New TIntType,New TConstExpr.Create( New TIntType,(opt_platform="linux" Or opt_platform="android") And opt_arch="x64"),0 )
- env.InsertDecl New TConstDecl.Create( "linuxarm",New TIntType,New TConstExpr.Create( New TIntType, ((opt_platform="android" Or opt_platform="linux") And (opt_arch="arm" Or opt_arch="armeabi" Or opt_arch="armeabiv7a" Or opt_arch="arm64v8a")) Or (opt_platform="raspberrypi" And opt_arch="arm")),0 )
- env.InsertDecl New TConstDecl.Create( "linuxarm64",New TIntType,New TConstExpr.Create( New TIntType, (opt_platform="android" And opt_arch="arm64v8a") Or ((opt_platform="linux" Or opt_platform="raspberrypi") And opt_arch="arm64")),0 )
- env.InsertDecl New TConstDecl.Create( "linuxriscv32",New TIntType,New TConstExpr.Create( New TIntType, (opt_platform="linux" And opt_arch="riscv32")),0 )
- env.InsertDecl New TConstDecl.Create( "linuxriscv64",New TIntType,New TConstExpr.Create( New TIntType, (opt_platform="linux" And opt_arch="riscv64")),0 )
- ' android
- env.InsertDecl New TConstDecl.Create( "android",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="android" ),0 )
- env.InsertDecl New TConstDecl.Create( "androidx86",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="android" And opt_arch="x86"),0 )
- env.InsertDecl New TConstDecl.Create( "androidx64",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="android" And opt_arch="x64"),0 )
- env.InsertDecl New TConstDecl.Create( "androidarm",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="android" And (opt_arch="arm" Or opt_arch="armeabi" Or opt_arch="armeabiv7a" Or opt_arch="arm64v8a") ),0 )
- env.InsertDecl New TConstDecl.Create( "androidarmeabi",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="android" And opt_arch="armeabi"),0 )
- env.InsertDecl New TConstDecl.Create( "androidarmeabiv7a",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="android" And opt_arch="armeabiv7a"),0 )
- env.InsertDecl New TConstDecl.Create( "androidarm64v8a",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="android" And opt_arch="arm64v8a"),0 )
- ' raspberrypi - ARM only
- env.InsertDecl New TConstDecl.Create( "raspberrypi",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="raspberrypi" And (opt_arch="arm" Or opt_arch="arm64")),0 )
- env.InsertDecl New TConstDecl.Create( "raspberrypiarm",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="raspberrypi" And opt_arch="arm"),0 )
- env.InsertDecl New TConstDecl.Create( "raspberrypiarm64",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="raspberrypi" And opt_arch="arm64"),0 )
- ' haiku
- env.InsertDecl New TConstDecl.Create( "haiku",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="haiku" And (opt_arch="x86" Or opt_arch="x64")),0 )
- env.InsertDecl New TConstDecl.Create( "haikux86",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="haiku" And opt_arch="x86"),0 )
- env.InsertDecl New TConstDecl.Create( "haikux64",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="haiku" And opt_arch="x64"),0 )
- ' emscripten
- env.InsertDecl New TConstDecl.Create( "emscripten",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="emscripten" ),0 )
- env.InsertDecl New TConstDecl.Create( "emscriptenjs",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="emscripten" And opt_arch="js"),0 )
- ' arch
- env.InsertDecl New TConstDecl.Create( "ppc",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="ppc" ),0 )
- env.InsertDecl New TConstDecl.Create( "x86",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="x86" ),0 )
- env.InsertDecl New TConstDecl.Create( "x64",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="x64" ),0 )
- env.InsertDecl New TConstDecl.Create( "arm",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="arm" Or opt_arch="armeabi" Or opt_arch="armeabiv7a" Or opt_arch="arm64v8a" ),0 )
- env.InsertDecl New TConstDecl.Create( "armeabi",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="armeabi" ),0 )
- env.InsertDecl New TConstDecl.Create( "armeabiv7a",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="armeabiv7a" ),0 )
- env.InsertDecl New TConstDecl.Create( "arm64v8a",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="arm64v8a" ),0 )
- env.InsertDecl New TConstDecl.Create( "js",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="js" ),0 )
- env.InsertDecl New TConstDecl.Create( "armv7",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="armv7" ),0 )
- env.InsertDecl New TConstDecl.Create( "arm64",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="arm64" ),0 )
- env.InsertDecl New TConstDecl.Create( "riscv32",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="riscv32" ),0 )
- env.InsertDecl New TConstDecl.Create( "riscv64",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="riscv64" ),0 )
- env.InsertDecl New TConstDecl.Create( "ptr32",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="x86" Or opt_arch="ppc" Or opt_arch="armv7" Or opt_arch="arm" Or opt_arch="armeabi" Or opt_arch="armeabiv7a" Or opt_arch="riscv32" ),0 )
- env.InsertDecl New TConstDecl.Create( "ptr64",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="x64" Or opt_arch="arm64" Or opt_arch="arm64v8a" Or opt_arch="riscv64" ),0 )
- ' endian
- env.InsertDecl New TConstDecl.Create( "bigendian",New TIntType,New TConstExpr.Create( New TIntType,opt_arch="ppc" ),0 )
- env.InsertDecl New TConstDecl.Create( "littleendian",New TIntType,New TConstExpr.Create( New TIntType,opt_arch<>"ppc" ),0 )
- ' opengles target platform
- env.InsertDecl New TConstDecl.Create( "opengles",New TIntType,New TConstExpr.Create( New TIntType, opt_platform="android" Or opt_platform="raspberrypi" Or opt_platform="emscripten" Or opt_platform="ios"),0 )
- ' musl - linux only
- env.InsertDecl New TConstDecl.Create( "musl",New TIntType,New TConstExpr.Create( New TIntType,(opt_musl And (opt_platform="linux" Or opt_platform="android" Or opt_platform="raspberrypi"))),0 )
- ' nx / switch
- env.InsertDecl New TConstDecl.Create( "nx",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="nx" ),0 )
- env.InsertDecl New TConstDecl.Create( "nxarm64",New TIntType,New TConstExpr.Create( New TIntType,opt_platform="nx" And opt_arch="arm64"),0 )
-
- ' new compiler
- env.InsertDecl New TConstDecl.Create( "bmxng",New TIntType,New TConstExpr.Create( New TIntType, True ),0 )
- ' coverage
- env.InsertDecl New TConstDecl.Create( "coverage",New TIntType,New TConstExpr.Create( New TIntType, opt_coverage ),0 )
- ' console or gui build?
- env.InsertDecl New TConstDecl.Create( "console",New TIntType,New TConstExpr.Create( New TIntType, opt_apptype = APPTYPE_CONSOLE ),0 )
- env.InsertDecl New TConstDecl.Create( "gui",New TIntType,New TConstExpr.Create( New TIntType, opt_apptype = APPTYPE_GUI ),0 )
- ' user defines
- If opt_userdefs Then
- Local defs:String[] = opt_userdefs.ToLower().Split(",")
- For Local def:String = EachIn defs
- def = def.Trim()
- If def Then
-
- Local name:String = def
- Local value:Int = 1
-
- Local dp:String[] = def.Split("=")
- If dp.length = 2 Then
- name = dp[0].Trim()
- value = Int(dp[1])
- End If
-
- env.InsertDecl New TConstDecl.Create( name,New TIntType,New TConstExpr.Create( New TIntType, value ),0 )
- End If
- Next
- End If
- PushEnv env
- Local toker:TToker=New TToker.Create( "",source )
- Local parser:TParser=New TParser.Create( toker,Null,True )
- Local val:String
- Try
- Local expr:TExpr=parser.ParseExpr()
-
- expr=expr.Semant()
-
- If ty expr=expr.Cast( ty )
-
- val=expr.Eval()
- Catch error:String
- val = "0"
- End Try
-
- PopEnv
-
- Return val
- End Function
|