diff options
Diffstat (limited to 'compiler')
62 files changed, 4643 insertions, 4566 deletions
diff --git a/compiler/ast.nim b/compiler/ast.nim index 274a49b52..3798410e8 100644 --- a/compiler/ast.nim +++ b/compiler/ast.nim @@ -1,7 +1,7 @@ # # # The Nim Compiler -# (c) Copyright 2013 Andreas Rumpf +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -257,7 +257,7 @@ type sfThread, # proc will run as a thread # variable is a thread variable sfCompileTime, # proc can be evaluated at compile time - sfMerge, # proc can be merged with itself + sfConstructor, # proc is a C++ constructor sfDeadCodeElim, # dead code elimination for the module is turned on sfBorrow, # proc is borrowed sfInfixCall, # symbol needs infix call syntax in target language; @@ -296,6 +296,7 @@ const sfCompileToCpp* = sfInfixCall # compile the module as C++ code sfCompileToObjc* = sfNamedParamCall # compile the module as Objective-C code sfExperimental* = sfOverriden # module uses the .experimental switch + sfGoto* = sfOverriden # var is used for 'goto' code generation const # getting ready for the future expr/stmt merge @@ -472,7 +473,7 @@ type # T and I here can bind to both typedesc and static types # before this is determined, we'll consider them to be a # wildcard type. - tfGuarded # guarded pointer + tfHasAsgn # type has overloaded assignment operator tfBorrowDot # distinct type borrows '.' TTypeFlags* = set[TTypeFlag] @@ -529,17 +530,20 @@ type TMagic* = enum # symbols that require compiler magic: mNone, mDefined, mDefinedInScope, mCompiles, - mLow, mHigh, mSizeOf, mTypeTrait, mIs, mOf, + mLow, mHigh, mSizeOf, mTypeTrait, mIs, mOf, mAddr, mTypeOf, mRoof, mPlugin, mEcho, mShallowCopy, mSlurp, mStaticExec, mParseExprToAst, mParseStmtToAst, mExpandToAst, mQuoteAst, - mUnaryLt, mSucc, - mPred, mInc, mDec, mOrd, mNew, mNewFinalize, mNewSeq, mLengthOpenArray, - mLengthStr, mLengthArray, mLengthSeq, mIncl, mExcl, mCard, mChr, mGCref, - mGCunref, mAddI, mSubI, mMulI, mDivI, mModI, mAddI64, mSubI64, mMulI64, - mDivI64, mModI64, + mUnaryLt, mInc, mDec, mOrd, mNew, mNewFinalize, mNewSeq, mLengthOpenArray, + mLengthStr, mLengthArray, mLengthSeq, mXLenStr, mXLenSeq, + mIncl, mExcl, mCard, mChr, + mGCref, mGCunref, + + mAddI, mSubI, mMulI, mDivI, mModI, mAddI64, mSubI64, mMulI64, + mDivI64, mModI64, mSucc, mPred, mAddF64, mSubF64, mMulF64, mDivF64, + mShrI, mShlI, mBitandI, mBitorI, mBitxorI, mMinI, mMaxI, - mShrI64, mShlI64, mBitandI64, mBitorI64, mBitxorI64, mMinI64, mMaxI64, + mShrI64, mShlI64, mBitandI64, mBitorI64, mBitxorI64, mMinF64, mMaxF64, mAddU, mSubU, mMulU, mDivU, mModU, mEqI, mLeI, mLtI, @@ -548,14 +552,14 @@ type mEqEnum, mLeEnum, mLtEnum, mEqCh, mLeCh, mLtCh, mEqB, mLeB, mLtB, mEqRef, mEqUntracedRef, mLePtr, mLtPtr, mEqCString, mXor, mEqProc, mUnaryMinusI, mUnaryMinusI64, mAbsI, mAbsI64, mNot, - mUnaryPlusI, mBitnotI, mUnaryPlusI64, + mUnaryPlusI, mBitnotI, mBitnotI64, mUnaryPlusF64, mUnaryMinusF64, mAbsF64, mZe8ToI, mZe8ToI64, mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64, mToU8, mToU16, mToU32, mToFloat, mToBiggestFloat, mToInt, mToBiggestInt, mCharToStr, mBoolToStr, mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, mStrToStr, mEnumToStr, mAnd, mOr, mEqStr, mLeStr, mLtStr, mEqSet, mLeSet, mLtSet, mMulSet, - mPlusSet, mMinusSet, mSymDiffSet, mConStrStr, mConArrArr, mConArrT, - mConTArr, mConTT, mSlice, + mPlusSet, mMinusSet, mSymDiffSet, mConStrStr, mSlice, + mDotDot, # this one is only necessary to give nice compile time warnings mFields, mFieldPairs, mOmpParFor, mAppendStrCh, mAppendStrStr, mAppendSeqElem, mInRange, mInSet, mRepr, mExit, mSetLengthStr, mSetLengthSeq, @@ -587,11 +591,12 @@ type const ctfeWhitelist* = {mNone, mUnaryLt, mSucc, mPred, mInc, mDec, mOrd, mLengthOpenArray, - mLengthStr, mLengthArray, mLengthSeq, mIncl, mExcl, mCard, mChr, + mLengthStr, mLengthArray, mLengthSeq, mXLenStr, mXLenSeq, + mIncl, mExcl, mCard, mChr, mAddI, mSubI, mMulI, mDivI, mModI, mAddI64, mSubI64, mMulI64, mDivI64, mModI64, mAddF64, mSubF64, mMulF64, mDivF64, mShrI, mShlI, mBitandI, mBitorI, mBitxorI, mMinI, mMaxI, - mShrI64, mShlI64, mBitandI64, mBitorI64, mBitxorI64, mMinI64, mMaxI64, + mShrI64, mShlI64, mBitandI64, mBitorI64, mBitxorI64, mMinF64, mMaxF64, mAddU, mSubU, mMulU, mDivU, mModU, mEqI, mLeI, mLtI, @@ -600,14 +605,13 @@ const mEqEnum, mLeEnum, mLtEnum, mEqCh, mLeCh, mLtCh, mEqB, mLeB, mLtB, mEqRef, mEqProc, mEqUntracedRef, mLePtr, mLtPtr, mEqCString, mXor, mUnaryMinusI, mUnaryMinusI64, mAbsI, mAbsI64, mNot, - mUnaryPlusI, mBitnotI, mUnaryPlusI64, + mUnaryPlusI, mBitnotI, mBitnotI64, mUnaryPlusF64, mUnaryMinusF64, mAbsF64, mZe8ToI, mZe8ToI64, mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64, mToU8, mToU16, mToU32, mToFloat, mToBiggestFloat, mToInt, mToBiggestInt, mCharToStr, mBoolToStr, mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, mStrToStr, mEnumToStr, mAnd, mOr, mEqStr, mLeStr, mLtStr, mEqSet, mLeSet, mLtSet, mMulSet, - mPlusSet, mMinusSet, mSymDiffSet, mConStrStr, mConArrArr, mConArrT, - mConTArr, mConTT, + mPlusSet, mMinusSet, mSymDiffSet, mConStrStr, mAppendStrCh, mAppendStrStr, mAppendSeqElem, mInRange, mInSet, mRepr, mCopyStr, mCopyStrLast} @@ -663,7 +667,9 @@ type locOther # location is something other TLocFlag* = enum lfIndirect, # backend introduced a pointer - lfParamCopy, # backend introduced a parameter copy (LLVM) + lfFullExternalName, # only used when 'gCmd == cmdPretty': Indicates + # that the symbol has been imported via 'importc: "fullname"' and + # no format string. lfNoDeepCopy, # no need for a deep copy lfNoDecl, # do not declare it in C lfDynamicLib, # link symbol to dynamic library @@ -682,8 +688,8 @@ type s*: TStorageLoc flags*: TLocFlags # location's flags t*: PType # type of location - r*: PRope # rope value of location (code generators) - heapRoot*: PRope # keeps track of the enclosing heap object that + r*: Rope # rope value of location (code generators) + heapRoot*: Rope # keeps track of the enclosing heap object that # owns this location (required by GC algorithms # employing heap snapshots or sliding views) @@ -695,7 +701,7 @@ type kind*: TLibKind generated*: bool # needed for the backends: isOverriden*: bool - name*: PRope + name*: Rope path*: PNode # can be a string literal! TInstantiation* = object @@ -725,7 +731,8 @@ type typScope*: PScope of routineKinds: procInstCache*: seq[PInstantiation] - scope*: PScope # the scope where the proc was defined + gcUnsafetyReason*: PSym # for better error messages wrt gcsafe + #scope*: PScope # the scope where the proc was defined of skModule: # modules keep track of the generic symbols they use from other modules. # this is because in incremental compilation, when a module is about to @@ -791,8 +798,8 @@ type # for enum types a list of symbols # for tyInt it can be the int literal # for procs and tyGenericBody, it's the - # the body of the user-defined type class # formal param list + # for concepts, the concept body # else: unused owner*: PSym # the 'owner' of the type sym*: PSym # types have the sym associated with them @@ -801,6 +808,7 @@ type # mean that there is no destructor. # see instantiateDestructor in semdestruct.nim deepCopy*: PSym # overriden 'deepCopy' operation + assignment*: PSym # overriden '=' operator size*: BiggestInt # the size of the type in bytes # -1 means that the size is unkwown align*: int16 # the type's alignment requirements @@ -915,10 +923,6 @@ const skIterators* = {skIterator, skClosureIterator} - lfFullExternalName* = lfParamCopy # \ - # only used when 'gCmd == cmdPretty': Indicates that the symbol has been - # imported via 'importc: "fullname"' and no format string. - var ggDebug* {.deprecated.}: bool ## convenience switch for trying out things proc isCallExpr*(n: PNode): bool = @@ -1169,7 +1173,9 @@ proc newType*(kind: TTypeKind, owner: PSym): PType = result.lockLevel = UnspecifiedLockLevel when debugIds: registerId(result) - #if result.id < 2000: + #if result.id == 92231: + # echo "KNID ", kind + # writeStackTrace() # messageOut(typeKindToStr[kind] & ' has id: ' & toString(result.id)) proc mergeLoc(a: var TLoc, b: TLoc) = @@ -1219,6 +1225,7 @@ proc assignType*(dest, src: PType) = dest.align = src.align dest.destructor = src.destructor dest.deepCopy = src.deepCopy + dest.assignment = src.assignment dest.lockLevel = src.lockLevel # this fixes 'type TLock = TSysLock': if src.sym != nil: @@ -1315,6 +1322,13 @@ proc skipTypes*(t: PType, kinds: TTypeKinds): PType = result = t while result.kind in kinds: result = lastSon(result) +proc skipTypesOrNil*(t: PType, kinds: TTypeKinds): PType = + ## same as skipTypes but handles 'nil' + result = t + while result != nil and result.kind in kinds: + if result.len == 0: return nil + result = lastSon(result) + proc isGCedMem*(t: PType): bool {.inline.} = result = t.kind in {tyString, tyRef, tySequence} or t.kind == tyProc and t.callConv == ccClosure @@ -1335,6 +1349,13 @@ proc propagateToOwner*(owner, elem: PType) = if elem.isMetaType: owner.flags.incl tfHasMeta + if tfHasAsgn in elem.flags: + let o2 = elem.skipTypes({tyGenericInst}) + if o2.kind in {tyTuple, tyObject, tyArray, tyArrayConstr, + tySequence, tySet, tyDistinct}: + o2.flags.incl tfHasAsgn + owner.flags.incl tfHasAsgn + if owner.kind notin {tyProc, tyGenericInst, tyGenericBody, tyGenericInvocation}: let elemB = elem.skipTypes({tyGenericInst}) diff --git a/compiler/astalgo.nim b/compiler/astalgo.nim index c53e53b88..1707718d7 100644 --- a/compiler/astalgo.nim +++ b/compiler/astalgo.nim @@ -11,18 +11,18 @@ # and sets of nodes are supported. Efficiency is important as # the data structures here are used in various places of the compiler. -import +import ast, hashes, intsets, strutils, options, msgs, ropes, idents, rodutils proc hashNode*(p: RootRef): THash -proc treeToYaml*(n: PNode, indent: int = 0, maxRecDepth: int = - 1): PRope +proc treeToYaml*(n: PNode, indent: int = 0, maxRecDepth: int = - 1): Rope # Convert a tree into its YAML representation; this is used by the # YAML code generator and it is invaluable for debugging purposes. # If maxRecDepht <> -1 then it won't print the whole graph. -proc typeToYaml*(n: PType, indent: int = 0, maxRecDepth: int = - 1): PRope -proc symToYaml*(n: PSym, indent: int = 0, maxRecDepth: int = - 1): PRope -proc lineInfoToStr*(info: TLineInfo): PRope - +proc typeToYaml*(n: PType, indent: int = 0, maxRecDepth: int = - 1): Rope +proc symToYaml*(n: PSym, indent: int = 0, maxRecDepth: int = - 1): Rope +proc lineInfoToStr*(info: TLineInfo): Rope + # ----------------------- node sets: --------------------------------------- proc objectSetContains*(t: TObjectSet, obj: RootRef): bool # returns true whether n is in t @@ -34,10 +34,10 @@ proc objectSetContainsOrIncl*(t: var TObjectSet, obj: RootRef): bool # ----------------------- (key, val)-Hashtables ---------------------------- proc tablePut*(t: var TTable, key, val: RootRef) proc tableGet*(t: TTable, key: RootRef): RootRef -type +type TCmpProc* = proc (key, closure: RootRef): bool {.nimcall.} # true if found -proc tableSearch*(t: TTable, key, closure: RootRef, +proc tableSearch*(t: TTable, key, closure: RootRef, comparator: TCmpProc): RootRef # return val as soon as comparator returns true; if this never happens, # nil is returned @@ -45,16 +45,16 @@ proc tableSearch*(t: TTable, key, closure: RootRef, # ----------------------- str table ----------------------------------------- proc strTableContains*(t: TStrTable, n: PSym): bool proc strTableAdd*(t: var TStrTable, n: PSym) -proc strTableGet*(t: TStrTable, name: PIdent): PSym - -type +proc strTableGet*(t: TStrTable, name: PIdent): PSym + +type TTabIter*{.final.} = object # consider all fields here private h*: THash # current hash proc initTabIter*(ti: var TTabIter, tab: TStrTable): PSym proc nextIter*(ti: var TTabIter, tab: TStrTable): PSym # usage: - # var + # var # i: TTabIter # s: PSym # s = InitTabIter(i, table) @@ -63,7 +63,7 @@ proc nextIter*(ti: var TTabIter, tab: TStrTable): PSym # s = NextIter(i, table) # -type +type TIdentIter*{.final.} = object # iterator over all syms with same identifier h*: THash # current hash name*: PIdent @@ -97,11 +97,11 @@ proc mustRehash*(length, counter: int): bool proc nextTry*(h, maxHash: THash): THash {.inline.} # ------------- table[int, int] --------------------------------------------- -const +const InvalidKey* = low(int) -type - TIIPair*{.final.} = object +type + TIIPair*{.final.} = object key*, val*: int TIIPairSeq* = seq[TIIPair] @@ -127,21 +127,21 @@ proc skipConvAndClosure*(n: PNode): PNode = result = result.sons[1] else: break -proc sameValue*(a, b: PNode): bool = +proc sameValue*(a, b: PNode): bool = result = false case a.kind - of nkCharLit..nkUInt64Lit: + of nkCharLit..nkUInt64Lit: if b.kind in {nkCharLit..nkUInt64Lit}: result = a.intVal == b.intVal - of nkFloatLit..nkFloat64Lit: + of nkFloatLit..nkFloat64Lit: if b.kind in {nkFloatLit..nkFloat64Lit}: result = a.floatVal == b.floatVal - of nkStrLit..nkTripleStrLit: + of nkStrLit..nkTripleStrLit: if b.kind in {nkStrLit..nkTripleStrLit}: result = a.strVal == b.strVal else: # don't raise an internal error for 'nimrod check': #InternalError(a.info, "SameValue") discard -proc leValue*(a, b: PNode): bool = +proc leValue*(a, b: PNode): bool = # a <= b? result = false case a.kind @@ -162,289 +162,289 @@ proc weakLeValue*(a, b: PNode): TImplication = else: result = if leValue(a, b): impYes else: impNo -proc lookupInRecord(n: PNode, field: PIdent): PSym = +proc lookupInRecord(n: PNode, field: PIdent): PSym = result = nil case n.kind - of nkRecList: - for i in countup(0, sonsLen(n) - 1): + of nkRecList: + for i in countup(0, sonsLen(n) - 1): result = lookupInRecord(n.sons[i], field) - if result != nil: return - of nkRecCase: + if result != nil: return + of nkRecCase: if (n.sons[0].kind != nkSym): internalError(n.info, "lookupInRecord") result = lookupInRecord(n.sons[0], field) - if result != nil: return - for i in countup(1, sonsLen(n) - 1): + if result != nil: return + for i in countup(1, sonsLen(n) - 1): case n.sons[i].kind - of nkOfBranch, nkElse: + of nkOfBranch, nkElse: result = lookupInRecord(lastSon(n.sons[i]), field) - if result != nil: return + if result != nil: return else: internalError(n.info, "lookupInRecord(record case branch)") - of nkSym: + of nkSym: if n.sym.name.id == field.id: result = n.sym else: internalError(n.info, "lookupInRecord()") - -proc getModule(s: PSym): PSym = + +proc getModule(s: PSym): PSym = result = s assert((result.kind == skModule) or (result.owner != result)) while result != nil and result.kind != skModule: result = result.owner - -proc getSymFromList(list: PNode, ident: PIdent, start: int = 0): PSym = - for i in countup(start, sonsLen(list) - 1): + +proc getSymFromList(list: PNode, ident: PIdent, start: int = 0): PSym = + for i in countup(start, sonsLen(list) - 1): if list.sons[i].kind == nkSym: result = list.sons[i].sym - if result.name.id == ident.id: return + if result.name.id == ident.id: return else: internalError(list.info, "getSymFromList") result = nil -proc hashNode(p: RootRef): THash = +proc hashNode(p: RootRef): THash = result = hash(cast[pointer](p)) -proc mustRehash(length, counter: int): bool = +proc mustRehash(length, counter: int): bool = assert(length > counter) result = (length * 2 < counter * 3) or (length - counter < 4) -proc rspaces(x: int): PRope = +proc rspaces(x: int): Rope = # returns x spaces - result = toRope(spaces(x)) + result = rope(spaces(x)) -proc toYamlChar(c: char): string = +proc toYamlChar(c: char): string = case c of '\0'..'\x1F', '\x80'..'\xFF': result = "\\u" & strutils.toHex(ord(c), 4) of '\'', '\"', '\\': result = '\\' & c else: result = $c - -proc makeYamlString*(s: string): PRope = + +proc makeYamlString*(s: string): Rope = # We have to split long strings into many ropes. Otherwise # this could trigger InternalError(111). See the ropes module for # further information. const MaxLineLength = 64 result = nil var res = "\"" - for i in countup(0, if s.isNil: -1 else: (len(s)-1)): - if (i + 1) mod MaxLineLength == 0: + for i in countup(0, if s.isNil: -1 else: (len(s)-1)): + if (i + 1) mod MaxLineLength == 0: add(res, '\"') add(res, "\n") - app(result, toRope(res)) + add(result, rope(res)) res = "\"" # reset add(res, toYamlChar(s[i])) add(res, '\"') - app(result, toRope(res)) + add(result, rope(res)) -proc flagsToStr[T](flags: set[T]): PRope = - if flags == {}: - result = toRope("[]") - else: +proc flagsToStr[T](flags: set[T]): Rope = + if flags == {}: + result = rope("[]") + else: result = nil - for x in items(flags): - if result != nil: app(result, ", ") - app(result, makeYamlString($x)) - result = con("[", con(result, "]")) - -proc lineInfoToStr(info: TLineInfo): PRope = - result = ropef("[$1, $2, $3]", [makeYamlString(toFilename(info)), - toRope(toLinenumber(info)), - toRope(toColumn(info))]) - -proc treeToYamlAux(n: PNode, marker: var IntSet, - indent, maxRecDepth: int): PRope -proc symToYamlAux(n: PSym, marker: var IntSet, - indent, maxRecDepth: int): PRope -proc typeToYamlAux(n: PType, marker: var IntSet, - indent, maxRecDepth: int): PRope -proc strTableToYaml(n: TStrTable, marker: var IntSet, indent: int, - maxRecDepth: int): PRope = + for x in items(flags): + if result != nil: add(result, ", ") + add(result, makeYamlString($x)) + result = "[" & result & "]" + +proc lineInfoToStr(info: TLineInfo): Rope = + result = "[$1, $2, $3]" % [makeYamlString(toFilename(info)), + rope(toLinenumber(info)), + rope(toColumn(info))] + +proc treeToYamlAux(n: PNode, marker: var IntSet, + indent, maxRecDepth: int): Rope +proc symToYamlAux(n: PSym, marker: var IntSet, + indent, maxRecDepth: int): Rope +proc typeToYamlAux(n: PType, marker: var IntSet, + indent, maxRecDepth: int): Rope +proc strTableToYaml(n: TStrTable, marker: var IntSet, indent: int, + maxRecDepth: int): Rope = var istr = rspaces(indent + 2) - result = toRope("[") + result = rope("[") var mycount = 0 - for i in countup(0, high(n.data)): - if n.data[i] != nil: - if mycount > 0: app(result, ",") - appf(result, "$N$1$2", + for i in countup(0, high(n.data)): + if n.data[i] != nil: + if mycount > 0: add(result, ",") + addf(result, "$N$1$2", [istr, symToYamlAux(n.data[i], marker, indent + 2, maxRecDepth - 1)]) inc(mycount) - if mycount > 0: appf(result, "$N$1", [rspaces(indent)]) - app(result, "]") + if mycount > 0: addf(result, "$N$1", [rspaces(indent)]) + add(result, "]") assert(mycount == n.counter) -proc ropeConstr(indent: int, c: openArray[PRope]): PRope = +proc ropeConstr(indent: int, c: openArray[Rope]): Rope = # array of (name, value) pairs var istr = rspaces(indent + 2) - result = toRope("{") + result = rope("{") var i = 0 - while i <= high(c): - if i > 0: app(result, ",") - appf(result, "$N$1\"$2\": $3", [istr, c[i], c[i + 1]]) + while i <= high(c): + if i > 0: add(result, ",") + addf(result, "$N$1\"$2\": $3", [istr, c[i], c[i + 1]]) inc(i, 2) - appf(result, "$N$1}", [rspaces(indent)]) - -proc symToYamlAux(n: PSym, marker: var IntSet, indent: int, - maxRecDepth: int): PRope = - if n == nil: - result = toRope("null") - elif containsOrIncl(marker, n.id): - result = ropef("\"$1 @$2\"", [toRope(n.name.s), toRope( - strutils.toHex(cast[ByteAddress](n), sizeof(n) * 2))]) - else: + addf(result, "$N$1}", [rspaces(indent)]) + +proc symToYamlAux(n: PSym, marker: var IntSet, indent: int, + maxRecDepth: int): Rope = + if n == nil: + result = rope("null") + elif containsOrIncl(marker, n.id): + result = "\"$1 @$2\"" % [rope(n.name.s), rope( + strutils.toHex(cast[ByteAddress](n), sizeof(n) * 2))] + else: var ast = treeToYamlAux(n.ast, marker, indent + 2, maxRecDepth - 1) - result = ropeConstr(indent, [toRope("kind"), - makeYamlString($n.kind), - toRope("name"), makeYamlString(n.name.s), - toRope("typ"), typeToYamlAux(n.typ, marker, - indent + 2, maxRecDepth - 1), - toRope("info"), lineInfoToStr(n.info), - toRope("flags"), flagsToStr(n.flags), - toRope("magic"), makeYamlString($n.magic), - toRope("ast"), ast, toRope("options"), - flagsToStr(n.options), toRope("position"), - toRope(n.position)]) - -proc typeToYamlAux(n: PType, marker: var IntSet, indent: int, - maxRecDepth: int): PRope = - if n == nil: - result = toRope("null") - elif containsOrIncl(marker, n.id): - result = ropef("\"$1 @$2\"", [toRope($n.kind), toRope( - strutils.toHex(cast[ByteAddress](n), sizeof(n) * 2))]) - else: - if sonsLen(n) > 0: - result = toRope("[") - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(result, ",") - appf(result, "$N$1$2", [rspaces(indent + 4), typeToYamlAux(n.sons[i], + result = ropeConstr(indent, [rope("kind"), + makeYamlString($n.kind), + rope("name"), makeYamlString(n.name.s), + rope("typ"), typeToYamlAux(n.typ, marker, + indent + 2, maxRecDepth - 1), + rope("info"), lineInfoToStr(n.info), + rope("flags"), flagsToStr(n.flags), + rope("magic"), makeYamlString($n.magic), + rope("ast"), ast, rope("options"), + flagsToStr(n.options), rope("position"), + rope(n.position)]) + +proc typeToYamlAux(n: PType, marker: var IntSet, indent: int, + maxRecDepth: int): Rope = + if n == nil: + result = rope("null") + elif containsOrIncl(marker, n.id): + result = "\"$1 @$2\"" % [rope($n.kind), rope( + strutils.toHex(cast[ByteAddress](n), sizeof(n) * 2))] + else: + if sonsLen(n) > 0: + result = rope("[") + for i in countup(0, sonsLen(n) - 1): + if i > 0: add(result, ",") + addf(result, "$N$1$2", [rspaces(indent + 4), typeToYamlAux(n.sons[i], marker, indent + 4, maxRecDepth - 1)]) - appf(result, "$N$1]", [rspaces(indent + 2)]) - else: - result = toRope("null") - result = ropeConstr(indent, [toRope("kind"), - makeYamlString($n.kind), - toRope("sym"), symToYamlAux(n.sym, marker, - indent + 2, maxRecDepth - 1), toRope("n"), treeToYamlAux(n.n, marker, - indent + 2, maxRecDepth - 1), toRope("flags"), flagsToStr(n.flags), - toRope("callconv"), - makeYamlString(CallingConvToStr[n.callConv]), - toRope("size"), toRope(n.size), - toRope("align"), toRope(n.align), - toRope("sons"), result]) - -proc treeToYamlAux(n: PNode, marker: var IntSet, indent: int, - maxRecDepth: int): PRope = - if n == nil: - result = toRope("null") - else: + addf(result, "$N$1]", [rspaces(indent + 2)]) + else: + result = rope("null") + result = ropeConstr(indent, [rope("kind"), + makeYamlString($n.kind), + rope("sym"), symToYamlAux(n.sym, marker, + indent + 2, maxRecDepth - 1), rope("n"), treeToYamlAux(n.n, marker, + indent + 2, maxRecDepth - 1), rope("flags"), flagsToStr(n.flags), + rope("callconv"), + makeYamlString(CallingConvToStr[n.callConv]), + rope("size"), rope(n.size), + rope("align"), rope(n.align), + rope("sons"), result]) + +proc treeToYamlAux(n: PNode, marker: var IntSet, indent: int, + maxRecDepth: int): Rope = + if n == nil: + result = rope("null") + else: var istr = rspaces(indent + 2) - result = ropef("{$N$1\"kind\": $2", [istr, makeYamlString($n.kind)]) - if maxRecDepth != 0: - appf(result, ",$N$1\"info\": $2", [istr, lineInfoToStr(n.info)]) + result = "{$N$1\"kind\": $2" % [istr, makeYamlString($n.kind)] + if maxRecDepth != 0: + addf(result, ",$N$1\"info\": $2", [istr, lineInfoToStr(n.info)]) case n.kind - of nkCharLit..nkInt64Lit: - appf(result, ",$N$1\"intVal\": $2", [istr, toRope(n.intVal)]) - of nkFloatLit, nkFloat32Lit, nkFloat64Lit: - appf(result, ",$N$1\"floatVal\": $2", - [istr, toRope(n.floatVal.toStrMaxPrecision)]) - of nkStrLit..nkTripleStrLit: + of nkCharLit..nkInt64Lit: + addf(result, ",$N$1\"intVal\": $2", [istr, rope(n.intVal)]) + of nkFloatLit, nkFloat32Lit, nkFloat64Lit: + addf(result, ",$N$1\"floatVal\": $2", + [istr, rope(n.floatVal.toStrMaxPrecision)]) + of nkStrLit..nkTripleStrLit: if n.strVal.isNil: - appf(result, ",$N$1\"strVal\": null", [istr]) + addf(result, ",$N$1\"strVal\": null", [istr]) else: - appf(result, ",$N$1\"strVal\": $2", [istr, makeYamlString(n.strVal)]) - of nkSym: - appf(result, ",$N$1\"sym\": $2", + addf(result, ",$N$1\"strVal\": $2", [istr, makeYamlString(n.strVal)]) + of nkSym: + addf(result, ",$N$1\"sym\": $2", [istr, symToYamlAux(n.sym, marker, indent + 2, maxRecDepth)]) - of nkIdent: - if n.ident != nil: - appf(result, ",$N$1\"ident\": $2", [istr, makeYamlString(n.ident.s)]) - else: - appf(result, ",$N$1\"ident\": null", [istr]) - else: - if sonsLen(n) > 0: - appf(result, ",$N$1\"sons\": [", [istr]) - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(result, ",") - appf(result, "$N$1$2", [rspaces(indent + 4), treeToYamlAux(n.sons[i], + of nkIdent: + if n.ident != nil: + addf(result, ",$N$1\"ident\": $2", [istr, makeYamlString(n.ident.s)]) + else: + addf(result, ",$N$1\"ident\": null", [istr]) + else: + if sonsLen(n) > 0: + addf(result, ",$N$1\"sons\": [", [istr]) + for i in countup(0, sonsLen(n) - 1): + if i > 0: add(result, ",") + addf(result, "$N$1$2", [rspaces(indent + 4), treeToYamlAux(n.sons[i], marker, indent + 4, maxRecDepth - 1)]) - appf(result, "$N$1]", [istr]) - appf(result, ",$N$1\"typ\": $2", + addf(result, "$N$1]", [istr]) + addf(result, ",$N$1\"typ\": $2", [istr, typeToYamlAux(n.typ, marker, indent + 2, maxRecDepth)]) - appf(result, "$N$1}", [rspaces(indent)]) + addf(result, "$N$1}", [rspaces(indent)]) -proc treeToYaml(n: PNode, indent: int = 0, maxRecDepth: int = - 1): PRope = +proc treeToYaml(n: PNode, indent: int = 0, maxRecDepth: int = - 1): Rope = var marker = initIntSet() result = treeToYamlAux(n, marker, indent, maxRecDepth) -proc typeToYaml(n: PType, indent: int = 0, maxRecDepth: int = - 1): PRope = +proc typeToYaml(n: PType, indent: int = 0, maxRecDepth: int = - 1): Rope = var marker = initIntSet() result = typeToYamlAux(n, marker, indent, maxRecDepth) -proc symToYaml(n: PSym, indent: int = 0, maxRecDepth: int = - 1): PRope = +proc symToYaml(n: PSym, indent: int = 0, maxRecDepth: int = - 1): Rope = var marker = initIntSet() result = symToYamlAux(n, marker, indent, maxRecDepth) -proc debugTree(n: PNode, indent: int, maxRecDepth: int; renderType=false): PRope -proc debugType(n: PType, maxRecDepth=100): PRope = - if n == nil: - result = toRope("null") +proc debugTree*(n: PNode, indent: int, maxRecDepth: int; renderType=false): Rope +proc debugType(n: PType, maxRecDepth=100): Rope = + if n == nil: + result = rope("null") else: - result = toRope($n.kind) - if n.sym != nil: - app(result, " ") - app(result, n.sym.name.s) + result = rope($n.kind) + if n.sym != nil: + add(result, " ") + add(result, n.sym.name.s) if n.kind in IntegralTypes and n.n != nil: - app(result, ", node: ") - app(result, debugTree(n.n, 2, maxRecDepth-1, renderType=true)) + add(result, ", node: ") + add(result, debugTree(n.n, 2, maxRecDepth-1, renderType=true)) if (n.kind != tyString) and (sonsLen(n) > 0) and maxRecDepth != 0: - app(result, "(") + add(result, "(") for i in countup(0, sonsLen(n) - 1): - if i > 0: app(result, ", ") + if i > 0: add(result, ", ") if n.sons[i] == nil: - app(result, "null") + add(result, "null") else: - app(result, debugType(n.sons[i], maxRecDepth-1)) + add(result, debugType(n.sons[i], maxRecDepth-1)) if n.kind == tyObject and n.n != nil: - app(result, ", node: ") - app(result, debugTree(n.n, 2, maxRecDepth-1, renderType=true)) - app(result, ")") + add(result, ", node: ") + add(result, debugTree(n.n, 2, maxRecDepth-1, renderType=true)) + add(result, ")") proc debugTree(n: PNode, indent: int, maxRecDepth: int; - renderType=false): PRope = - if n == nil: - result = toRope("null") - else: + renderType=false): Rope = + if n == nil: + result = rope("null") + else: var istr = rspaces(indent + 2) - result = ropef("{$N$1\"kind\": $2", - [istr, makeYamlString($n.kind)]) - if maxRecDepth != 0: + result = "{$N$1\"kind\": $2" % + [istr, makeYamlString($n.kind)] + if maxRecDepth != 0: case n.kind of nkCharLit..nkUInt64Lit: - appf(result, ",$N$1\"intVal\": $2", [istr, toRope(n.intVal)]) - of nkFloatLit, nkFloat32Lit, nkFloat64Lit: - appf(result, ",$N$1\"floatVal\": $2", - [istr, toRope(n.floatVal.toStrMaxPrecision)]) - of nkStrLit..nkTripleStrLit: + addf(result, ",$N$1\"intVal\": $2", [istr, rope(n.intVal)]) + of nkFloatLit, nkFloat32Lit, nkFloat64Lit: + addf(result, ",$N$1\"floatVal\": $2", + [istr, rope(n.floatVal.toStrMaxPrecision)]) + of nkStrLit..nkTripleStrLit: if n.strVal.isNil: - appf(result, ",$N$1\"strVal\": null", [istr]) + addf(result, ",$N$1\"strVal\": null", [istr]) else: - appf(result, ",$N$1\"strVal\": $2", [istr, makeYamlString(n.strVal)]) - of nkSym: - appf(result, ",$N$1\"sym\": $2_$3", - [istr, toRope(n.sym.name.s), toRope(n.sym.id)]) - # [istr, symToYaml(n.sym, indent, maxRecDepth), - # toRope(n.sym.id)]) + addf(result, ",$N$1\"strVal\": $2", [istr, makeYamlString(n.strVal)]) + of nkSym: + addf(result, ",$N$1\"sym\": $2_$3", + [istr, rope(n.sym.name.s), rope(n.sym.id)]) + # [istr, symToYaml(n.sym, indent, maxRecDepth), + # rope(n.sym.id)]) if renderType and n.sym.typ != nil: - appf(result, ",$N$1\"typ\": $2", [istr, debugType(n.sym.typ, 2)]) - of nkIdent: - if n.ident != nil: - appf(result, ",$N$1\"ident\": $2", [istr, makeYamlString(n.ident.s)]) - else: - appf(result, ",$N$1\"ident\": null", [istr]) - else: - if sonsLen(n) > 0: - appf(result, ",$N$1\"sons\": [", [istr]) - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(result, ",") - appf(result, "$N$1$2", [rspaces(indent + 4), debugTree(n.sons[i], + addf(result, ",$N$1\"typ\": $2", [istr, debugType(n.sym.typ, 2)]) + of nkIdent: + if n.ident != nil: + addf(result, ",$N$1\"ident\": $2", [istr, makeYamlString(n.ident.s)]) + else: + addf(result, ",$N$1\"ident\": null", [istr]) + else: + if sonsLen(n) > 0: + addf(result, ",$N$1\"sons\": [", [istr]) + for i in countup(0, sonsLen(n) - 1): + if i > 0: add(result, ",") + addf(result, "$N$1$2", [rspaces(indent + 4), debugTree(n.sons[i], indent + 4, maxRecDepth - 1, renderType)]) - appf(result, "$N$1]", [istr]) - appf(result, ",$N$1\"info\": $2", [istr, lineInfoToStr(n.info)]) - appf(result, "$N$1}", [rspaces(indent)]) + addf(result, "$N$1]", [istr]) + addf(result, ",$N$1\"info\": $2", [istr, lineInfoToStr(n.info)]) + addf(result, "$N$1}", [rspaces(indent)]) proc debug(n: PSym) = if n == nil: @@ -452,27 +452,26 @@ proc debug(n: PSym) = elif n.kind == skUnknown: msgWriteln("skUnknown") else: - #writeln(stdout, ropeToStr(symToYaml(n, 0, 1))) + #writeln(stdout, $symToYaml(n, 0, 1)) msgWriteln("$1_$2: $3, $4, $5, $6" % [ - n.name.s, $n.id, flagsToStr(n.flags).ropeToStr, - flagsToStr(n.loc.flags).ropeToStr, lineInfoToStr(n.info).ropeToStr, - $n.kind]) + n.name.s, $n.id, $flagsToStr(n.flags), $flagsToStr(n.loc.flags), + $lineInfoToStr(n.info), $n.kind]) -proc debug(n: PType) = - msgWriteln(ropeToStr(debugType(n))) +proc debug(n: PType) = + msgWriteln($debugType(n)) -proc debug(n: PNode) = - msgWriteln(ropeToStr(debugTree(n, 0, 100))) +proc debug(n: PNode) = + msgWriteln($debugTree(n, 0, 100)) -const +const EmptySeq = @[] -proc nextTry(h, maxHash: THash): THash = - result = ((5 * h) + 1) and maxHash +proc nextTry(h, maxHash: THash): THash = + result = ((5 * h) + 1) and maxHash # For any initial h in range(maxHash), repeating that maxHash times # generates each int in range(maxHash) exactly once (see any text on # random-number generation for proof). - + proc objectSetContains(t: TObjectSet, obj: RootRef): bool = # returns true whether n is in t var h: THash = hashNode(obj) and high(t.data) # start with real hash value @@ -490,94 +489,94 @@ proc objectSetRawInsert(data: var TObjectSeq, obj: RootRef) = assert(data[h] == nil) data[h] = obj -proc objectSetEnlarge(t: var TObjectSet) = +proc objectSetEnlarge(t: var TObjectSet) = var n: TObjectSeq newSeq(n, len(t.data) * GrowthFactor) for i in countup(0, high(t.data)): if t.data[i] != nil: objectSetRawInsert(n, t.data[i]) swap(t.data, n) -proc objectSetIncl(t: var TObjectSet, obj: RootRef) = +proc objectSetIncl(t: var TObjectSet, obj: RootRef) = if mustRehash(len(t.data), t.counter): objectSetEnlarge(t) objectSetRawInsert(t.data, obj) inc(t.counter) -proc objectSetContainsOrIncl(t: var TObjectSet, obj: RootRef): bool = +proc objectSetContainsOrIncl(t: var TObjectSet, obj: RootRef): bool = # returns true if obj is already in the string table: var h: THash = hashNode(obj) and high(t.data) - while true: + while true: var it = t.data[h] - if it == nil: break - if it == obj: + if it == nil: break + if it == obj: return true # found it h = nextTry(h, high(t.data)) - if mustRehash(len(t.data), t.counter): + if mustRehash(len(t.data), t.counter): objectSetEnlarge(t) objectSetRawInsert(t.data, obj) - else: + else: assert(t.data[h] == nil) t.data[h] = obj inc(t.counter) result = false -proc tableRawGet(t: TTable, key: RootRef): int = +proc tableRawGet(t: TTable, key: RootRef): int = var h: THash = hashNode(key) and high(t.data) # start with real hash value - while t.data[h].key != nil: - if t.data[h].key == key: + while t.data[h].key != nil: + if t.data[h].key == key: return h h = nextTry(h, high(t.data)) result = -1 -proc tableSearch(t: TTable, key, closure: RootRef, - comparator: TCmpProc): RootRef = +proc tableSearch(t: TTable, key, closure: RootRef, + comparator: TCmpProc): RootRef = var h: THash = hashNode(key) and high(t.data) # start with real hash value - while t.data[h].key != nil: - if t.data[h].key == key: - if comparator(t.data[h].val, closure): + while t.data[h].key != nil: + if t.data[h].key == key: + if comparator(t.data[h].val, closure): # BUGFIX 1 return t.data[h].val h = nextTry(h, high(t.data)) result = nil -proc tableGet(t: TTable, key: RootRef): RootRef = +proc tableGet(t: TTable, key: RootRef): RootRef = var index = tableRawGet(t, key) if index >= 0: result = t.data[index].val else: result = nil - -proc tableRawInsert(data: var TPairSeq, key, val: RootRef) = + +proc tableRawInsert(data: var TPairSeq, key, val: RootRef) = var h: THash = hashNode(key) and high(data) - while data[h].key != nil: + while data[h].key != nil: assert(data[h].key != key) h = nextTry(h, high(data)) assert(data[h].key == nil) data[h].key = key data[h].val = val -proc tableEnlarge(t: var TTable) = +proc tableEnlarge(t: var TTable) = var n: TPairSeq newSeq(n, len(t.data) * GrowthFactor) - for i in countup(0, high(t.data)): + for i in countup(0, high(t.data)): if t.data[i].key != nil: tableRawInsert(n, t.data[i].key, t.data[i].val) swap(t.data, n) -proc tablePut(t: var TTable, key, val: RootRef) = +proc tablePut(t: var TTable, key, val: RootRef) = var index = tableRawGet(t, key) - if index >= 0: + if index >= 0: t.data[index].val = val - else: + else: if mustRehash(len(t.data), t.counter): tableEnlarge(t) tableRawInsert(t.data, key, val) inc(t.counter) -proc strTableContains(t: TStrTable, n: PSym): bool = +proc strTableContains(t: TStrTable, n: PSym): bool = var h: THash = n.name.h and high(t.data) # start with real hash value - while t.data[h] != nil: - if (t.data[h] == n): + while t.data[h] != nil: + if (t.data[h] == n): return true h = nextTry(h, high(t.data)) result = false -proc strTableRawInsert(data: var TSymSeq, n: PSym) = +proc strTableRawInsert(data: var TSymSeq, n: PSym) = var h: THash = n.name.h and high(data) if sfImmediate notin n.flags: # fast path: @@ -614,18 +613,18 @@ proc symTabReplaceRaw(data: var TSymSeq, prevSym: PSym, newSym: PSym) = return h = nextTry(h, high(data)) assert false - + proc symTabReplace*(t: var TStrTable, prevSym: PSym, newSym: PSym) = symTabReplaceRaw(t.data, prevSym, newSym) -proc strTableEnlarge(t: var TStrTable) = +proc strTableEnlarge(t: var TStrTable) = var n: TSymSeq newSeq(n, len(t.data) * GrowthFactor) - for i in countup(0, high(t.data)): + for i in countup(0, high(t.data)): if t.data[i] != nil: strTableRawInsert(n, t.data[i]) swap(t.data, n) -proc strTableAdd(t: var TStrTable, n: PSym) = +proc strTableAdd(t: var TStrTable, n: PSym) = if mustRehash(len(t.data), t.counter): strTableEnlarge(t) strTableRawInsert(t.data, n) inc(t.counter) @@ -666,103 +665,103 @@ proc strTableIncl*(t: var TStrTable, n: PSym): bool {.discardable.} = inc(t.counter) result = false -proc strTableGet(t: TStrTable, name: PIdent): PSym = +proc strTableGet(t: TStrTable, name: PIdent): PSym = var h: THash = name.h and high(t.data) - while true: + while true: result = t.data[h] - if result == nil: break - if result.name.id == name.id: break + if result == nil: break + if result.name.id == name.id: break h = nextTry(h, high(t.data)) -proc initIdentIter(ti: var TIdentIter, tab: TStrTable, s: PIdent): PSym = +proc initIdentIter(ti: var TIdentIter, tab: TStrTable, s: PIdent): PSym = ti.h = s.h ti.name = s if tab.counter == 0: result = nil else: result = nextIdentIter(ti, tab) - -proc nextIdentIter(ti: var TIdentIter, tab: TStrTable): PSym = + +proc nextIdentIter(ti: var TIdentIter, tab: TStrTable): PSym = var h = ti.h and high(tab.data) var start = h result = tab.data[h] - while result != nil: - if result.name.id == ti.name.id: break + while result != nil: + if result.name.id == ti.name.id: break h = nextTry(h, high(tab.data)) - if h == start: + if h == start: result = nil - break + break result = tab.data[h] ti.h = nextTry(h, high(tab.data)) - -proc nextIdentExcluding*(ti: var TIdentIter, tab: TStrTable, + +proc nextIdentExcluding*(ti: var TIdentIter, tab: TStrTable, excluding: IntSet): PSym = var h: THash = ti.h and high(tab.data) var start = h result = tab.data[h] - while result != nil: - if result.name.id == ti.name.id and not contains(excluding, result.id): + while result != nil: + if result.name.id == ti.name.id and not contains(excluding, result.id): break h = nextTry(h, high(tab.data)) - if h == start: + if h == start: result = nil - break + break result = tab.data[h] ti.h = nextTry(h, high(tab.data)) if result != nil and contains(excluding, result.id): result = nil proc firstIdentExcluding*(ti: var TIdentIter, tab: TStrTable, s: PIdent, - excluding: IntSet): PSym = + excluding: IntSet): PSym = ti.h = s.h ti.name = s if tab.counter == 0: result = nil else: result = nextIdentExcluding(ti, tab, excluding) -proc initTabIter(ti: var TTabIter, tab: TStrTable): PSym = +proc initTabIter(ti: var TTabIter, tab: TStrTable): PSym = ti.h = 0 # we start by zero ... - if tab.counter == 0: + if tab.counter == 0: result = nil # FIX 1: removed endless loop - else: + else: result = nextIter(ti, tab) - -proc nextIter(ti: var TTabIter, tab: TStrTable): PSym = + +proc nextIter(ti: var TTabIter, tab: TStrTable): PSym = result = nil - while (ti.h <= high(tab.data)): + while (ti.h <= high(tab.data)): result = tab.data[ti.h] inc(ti.h) # ... and increment by one always - if result != nil: break + if result != nil: break -iterator items*(tab: TStrTable): PSym = +iterator items*(tab: TStrTable): PSym = var it: TTabIter var s = initTabIter(it, tab) - while s != nil: + while s != nil: yield s s = nextIter(it, tab) -proc hasEmptySlot(data: TIdPairSeq): bool = - for h in countup(0, high(data)): - if data[h].key == nil: +proc hasEmptySlot(data: TIdPairSeq): bool = + for h in countup(0, high(data)): + if data[h].key == nil: return true result = false -proc idTableRawGet(t: TIdTable, key: int): int = +proc idTableRawGet(t: TIdTable, key: int): int = var h: THash h = key and high(t.data) # start with real hash value - while t.data[h].key != nil: + while t.data[h].key != nil: if t.data[h].key.id == key: return h h = nextTry(h, high(t.data)) result = - 1 -proc idTableHasObjectAsKey(t: TIdTable, key: PIdObj): bool = +proc idTableHasObjectAsKey(t: TIdTable, key: PIdObj): bool = var index = idTableRawGet(t, key.id) if index >= 0: result = t.data[index].key == key else: result = false - -proc idTableGet(t: TIdTable, key: PIdObj): RootRef = + +proc idTableGet(t: TIdTable, key: PIdObj): RootRef = var index = idTableRawGet(t, key.id) if index >= 0: result = t.data[index].val else: result = nil - -proc idTableGet(t: TIdTable, key: int): RootRef = + +proc idTableGet(t: TIdTable, key: int): RootRef = var index = idTableRawGet(t, key) if index >= 0: result = t.data[index].val else: result = nil @@ -771,30 +770,30 @@ iterator pairs*(t: TIdTable): tuple[key: int, value: RootRef] = for i in 0..high(t.data): if t.data[i].key != nil: yield (t.data[i].key.id, t.data[i].val) - -proc idTableRawInsert(data: var TIdPairSeq, key: PIdObj, val: RootRef) = + +proc idTableRawInsert(data: var TIdPairSeq, key: PIdObj, val: RootRef) = var h: THash h = key.id and high(data) - while data[h].key != nil: + while data[h].key != nil: assert(data[h].key.id != key.id) h = nextTry(h, high(data)) assert(data[h].key == nil) data[h].key = key data[h].val = val -proc idTablePut(t: var TIdTable, key: PIdObj, val: RootRef) = - var +proc idTablePut(t: var TIdTable, key: PIdObj, val: RootRef) = + var index: int n: TIdPairSeq index = idTableRawGet(t, key.id) - if index >= 0: + if index >= 0: assert(t.data[index].key != nil) t.data[index].val = val - else: - if mustRehash(len(t.data), t.counter): + else: + if mustRehash(len(t.data), t.counter): newSeq(n, len(t.data) * GrowthFactor) - for i in countup(0, high(t.data)): - if t.data[i].key != nil: + for i in countup(0, high(t.data)): + if t.data[i].key != nil: idTableRawInsert(n, t.data[i].key, t.data[i].val) assert(hasEmptySlot(n)) swap(t.data, n) @@ -805,7 +804,7 @@ iterator idTablePairs*(t: TIdTable): tuple[key: PIdObj, val: RootRef] = for i in 0 .. high(t.data): if not isNil(t.data[i].key): yield (t.data[i].key, t.data[i].val) -proc idNodeTableRawGet(t: TIdNodeTable, key: PIdObj): int = +proc idNodeTableRawGet(t: TIdNodeTable, key: PIdObj): int = var h: THash h = key.id and high(t.data) # start with real hash value while t.data[h].key != nil: @@ -814,7 +813,7 @@ proc idNodeTableRawGet(t: TIdNodeTable, key: PIdObj): int = h = nextTry(h, high(t.data)) result = - 1 -proc idNodeTableGet(t: TIdNodeTable, key: PIdObj): PNode = +proc idNodeTableGet(t: TIdNodeTable, key: PIdObj): PNode = var index: int index = idNodeTableRawGet(t, key) if index >= 0: result = t.data[index].val @@ -823,28 +822,28 @@ proc idNodeTableGet(t: TIdNodeTable, key: PIdObj): PNode = proc idNodeTableGetLazy*(t: TIdNodeTable, key: PIdObj): PNode = if not isNil(t.data): result = idNodeTableGet(t, key) - -proc idNodeTableRawInsert(data: var TIdNodePairSeq, key: PIdObj, val: PNode) = + +proc idNodeTableRawInsert(data: var TIdNodePairSeq, key: PIdObj, val: PNode) = var h: THash h = key.id and high(data) - while data[h].key != nil: + while data[h].key != nil: assert(data[h].key.id != key.id) h = nextTry(h, high(data)) assert(data[h].key == nil) data[h].key = key data[h].val = val -proc idNodeTablePut(t: var TIdNodeTable, key: PIdObj, val: PNode) = +proc idNodeTablePut(t: var TIdNodeTable, key: PIdObj, val: PNode) = var index = idNodeTableRawGet(t, key) - if index >= 0: + if index >= 0: assert(t.data[index].key != nil) t.data[index].val = val - else: - if mustRehash(len(t.data), t.counter): + else: + if mustRehash(len(t.data), t.counter): var n: TIdNodePairSeq newSeq(n, len(t.data) * GrowthFactor) - for i in countup(0, high(t.data)): - if t.data[i].key != nil: + for i in countup(0, high(t.data)): + if t.data[i].key != nil: idNodeTableRawInsert(n, t.data[i].key, t.data[i].val) swap(t.data, n) idNodeTableRawInsert(t.data, key, val) @@ -858,46 +857,46 @@ iterator pairs*(t: TIdNodeTable): tuple[key: PIdObj, val: PNode] = for i in 0 .. high(t.data): if not isNil(t.data[i].key): yield (t.data[i].key, t.data[i].val) -proc initIITable(x: var TIITable) = +proc initIITable(x: var TIITable) = x.counter = 0 newSeq(x.data, StartSize) for i in countup(0, StartSize - 1): x.data[i].key = InvalidKey - -proc iiTableRawGet(t: TIITable, key: int): int = + +proc iiTableRawGet(t: TIITable, key: int): int = var h: THash h = key and high(t.data) # start with real hash value - while t.data[h].key != InvalidKey: + while t.data[h].key != InvalidKey: if t.data[h].key == key: return h h = nextTry(h, high(t.data)) result = -1 -proc iiTableGet(t: TIITable, key: int): int = +proc iiTableGet(t: TIITable, key: int): int = var index = iiTableRawGet(t, key) if index >= 0: result = t.data[index].val else: result = InvalidKey - -proc iiTableRawInsert(data: var TIIPairSeq, key, val: int) = + +proc iiTableRawInsert(data: var TIIPairSeq, key, val: int) = var h: THash h = key and high(data) - while data[h].key != InvalidKey: + while data[h].key != InvalidKey: assert(data[h].key != key) h = nextTry(h, high(data)) assert(data[h].key == InvalidKey) data[h].key = key data[h].val = val -proc iiTablePut(t: var TIITable, key, val: int) = +proc iiTablePut(t: var TIITable, key, val: int) = var index = iiTableRawGet(t, key) - if index >= 0: + if index >= 0: assert(t.data[index].key != InvalidKey) t.data[index].val = val - else: - if mustRehash(len(t.data), t.counter): + else: + if mustRehash(len(t.data), t.counter): var n: TIIPairSeq newSeq(n, len(t.data) * GrowthFactor) for i in countup(0, high(n)): n[i].key = InvalidKey - for i in countup(0, high(t.data)): - if t.data[i].key != InvalidKey: + for i in countup(0, high(t.data)): + if t.data[i].key != InvalidKey: iiTableRawInsert(n, t.data[i].key, t.data[i].val) swap(t.data, n) iiTableRawInsert(t.data, key, val) diff --git a/compiler/canonicalizer.nim b/compiler/canonicalizer.nim index 50d3fd017..6fcc57a91 100644 --- a/compiler/canonicalizer.nim +++ b/compiler/canonicalizer.nim @@ -243,24 +243,24 @@ proc encodeNode(w: PRodWriter, fInfo: TLineInfo, n: PNode, encodeNode(w, n.info, n.sons[i], result) add(result, ')') -proc encodeLoc(w: PRodWriter, loc: TLoc, result: var string) = +proc encodeLoc(w: PRodWriter, loc: TLoc, result: var string) = var oldLen = result.len result.add('<') if loc.k != low(loc.k): encodeVInt(ord(loc.k), result) - if loc.s != low(loc.s): + if loc.s != low(loc.s): add(result, '*') encodeVInt(ord(loc.s), result) - if loc.flags != {}: + if loc.flags != {}: add(result, '$') encodeVInt(cast[int32](loc.flags), result) if loc.t != nil: add(result, '^') encodeVInt(cast[int32](loc.t.id), result) pushType(w, loc.t) - if loc.r != nil: + if loc.r != nil: add(result, '!') - encodeStr(ropeToStr(loc.r), result) - if loc.a != 0: + encodeStr($loc.r, result) + if loc.a != 0: add(result, '?') encodeVInt(loc.a, result) if oldLen + 1 == result.len: @@ -317,7 +317,7 @@ proc encodeLib(w: PRodWriter, lib: PLib, info: TLineInfo, result: var string) = add(result, '|') encodeVInt(ord(lib.kind), result) add(result, '|') - encodeStr(ropeToStr(lib.name), result) + encodeStr($lib.name, result) add(result, '|') encodeNode(w, info, lib.path, result) diff --git a/compiler/ccgcalls.nim b/compiler/ccgcalls.nim index 91dcaef42..2dacc25e9 100644 --- a/compiler/ccgcalls.nim +++ b/compiler/ccgcalls.nim @@ -1,7 +1,7 @@ # # # The Nim Compiler -# (c) Copyright 2013 Andreas Rumpf +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -19,13 +19,13 @@ proc hasNoInit(call: PNode): bool {.inline.} = result = call.sons[0].kind == nkSym and sfNoInit in call.sons[0].sym.flags proc fixupCall(p: BProc, le, ri: PNode, d: var TLoc, - callee, params: PRope) = - var pl = con(callee, ~"(", params) + callee, params: Rope) = + var pl = callee & ~"(" & params # getUniqueType() is too expensive here: var typ = skipTypes(ri.sons[0].typ, abstractInst) if typ.sons[0] != nil: if isInvalidReturnType(typ.sons[0]): - if params != nil: pl.app(~", ") + if params != nil: pl.add(~", ") # beware of 'result = p(result)'. We may need to allocate a temporary: if d.k in {locTemp, locNone} or not leftAppearsOnRightSide(le, ri): # Great, we can use 'd': @@ -33,18 +33,18 @@ proc fixupCall(p: BProc, le, ri: PNode, d: var TLoc, elif d.k notin {locExpr, locTemp} and not hasNoInit(ri): # reset before pass as 'result' var: resetLoc(p, d) - app(pl, addrLoc(d)) - app(pl, ~");$n") + add(pl, addrLoc(d)) + add(pl, ~");$n") line(p, cpsStmts, pl) else: var tmp: TLoc getTemp(p, typ.sons[0], tmp, needsInit=true) - app(pl, addrLoc(tmp)) - app(pl, ~");$n") + add(pl, addrLoc(tmp)) + add(pl, ~");$n") line(p, cpsStmts, pl) genAssignment(p, d, tmp, {}) # no need for deep copying else: - app(pl, ~")") + add(pl, ~")") if p.module.compileToCpp and lfSingleUse in d.flags: # do not generate spurious temporaries for C++! For C we're better off # with them to prevent undefined behaviour and because the codegen @@ -60,7 +60,7 @@ proc fixupCall(p: BProc, le, ri: PNode, d: var TLoc, list.r = pl genAssignment(p, d, list, {}) # no need for deep copying else: - app(pl, ~");$n") + add(pl, ~");$n") line(p, cpsStmts, pl) proc isInCurrentFrame(p: BProc, n: PNode): bool = @@ -83,7 +83,7 @@ proc isInCurrentFrame(p: BProc, n: PNode): bool = result = isInCurrentFrame(p, n.sons[0]) else: discard -proc openArrayLoc(p: BProc, n: PNode): PRope = +proc openArrayLoc(p: BProc, n: PNode): Rope = var a: TLoc let q = skipConv(n) @@ -104,28 +104,28 @@ proc openArrayLoc(p: BProc, n: PNode): PRope = else: "$1->data+($2), ($3)-($2)+1" else: (internalError("openArrayLoc: " & typeToString(a.t)); "") - result = ropef(fmt, [rdLoc(a), rdLoc(b), rdLoc(c)]) + result = fmt % [rdLoc(a), rdLoc(b), rdLoc(c)] else: initLocExpr(p, n, a) case skipTypes(a.t, abstractVar).kind of tyOpenArray, tyVarargs: - result = ropef("$1, $1Len0", [rdLoc(a)]) + result = "$1, $1Len0" % [rdLoc(a)] of tyString, tySequence: if skipTypes(n.typ, abstractInst).kind == tyVar and not compileToCpp(p.module): - result = ropef("(*$1)->data, (*$1)->$2", [a.rdLoc, lenField(p)]) + result = "(*$1)->data, (*$1)->$2" % [a.rdLoc, lenField(p)] else: - result = ropef("$1->data, $1->$2", [a.rdLoc, lenField(p)]) + result = "$1->data, $1->$2" % [a.rdLoc, lenField(p)] of tyArray, tyArrayConstr: - result = ropef("$1, $2", [rdLoc(a), toRope(lengthOrd(a.t))]) + result = "$1, $2" % [rdLoc(a), rope(lengthOrd(a.t))] else: internalError("openArrayLoc: " & typeToString(a.t)) -proc genArgStringToCString(p: BProc, n: PNode): PRope {.inline.} = +proc genArgStringToCString(p: BProc, n: PNode): Rope {.inline.} = var a: TLoc initLocExpr(p, n.sons[0], a) - result = ropef("$1->data", [a.rdLoc]) + result = "$1->data" % [a.rdLoc] -proc genArg(p: BProc, n: PNode, param: PSym; call: PNode): PRope = +proc genArg(p: BProc, n: PNode, param: PSym; call: PNode): Rope = var a: TLoc if n.kind == nkStringToCString: result = genArgStringToCString(p, n) @@ -151,7 +151,7 @@ proc genArg(p: BProc, n: PNode, param: PSym; call: PNode): PRope = initLocExprSingleUse(p, n, a) result = rdLoc(a) -proc genArgNoParam(p: BProc, n: PNode): PRope = +proc genArgNoParam(p: BProc, n: PNode): Rope = var a: TLoc if n.kind == nkStringToCString: result = genArgStringToCString(p, n) @@ -163,7 +163,7 @@ proc genPrefixCall(p: BProc, le, ri: PNode, d: var TLoc) = var op: TLoc # this is a hotspot in the compiler initLocExpr(p, ri.sons[0], op) - var params: PRope + var params: Rope # getUniqueType() is too expensive here: var typ = skipTypes(ri.sons[0].typ, abstractInst) assert(typ.kind == tyProc) @@ -171,48 +171,49 @@ proc genPrefixCall(p: BProc, le, ri: PNode, d: var TLoc) = var length = sonsLen(ri) for i in countup(1, length - 1): if ri.sons[i].typ.isCompileTimeOnly: continue - if params != nil: app(params, ~", ") + if params != nil: add(params, ~", ") if i < sonsLen(typ): assert(typ.n.sons[i].kind == nkSym) - app(params, genArg(p, ri.sons[i], typ.n.sons[i].sym, ri)) + add(params, genArg(p, ri.sons[i], typ.n.sons[i].sym, ri)) else: - app(params, genArgNoParam(p, ri.sons[i])) + add(params, genArgNoParam(p, ri.sons[i])) fixupCall(p, le, ri, d, op.r, params) proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = - proc getRawProcType(p: BProc, t: PType): PRope = + proc getRawProcType(p: BProc, t: PType): Rope = result = getClosureType(p.module, t, clHalf) - proc addComma(r: PRope): PRope = - result = if r == nil: r else: con(r, ~", ") + proc addComma(r: Rope): Rope = + result = if r == nil: r else: r & ~", " const PatProc = "$1.ClEnv? $1.ClPrc($3$1.ClEnv):(($4)($1.ClPrc))($2)" const PatIter = "$1.ClPrc($3$1.ClEnv)" # we know the env exists var op: TLoc initLocExpr(p, ri.sons[0], op) - var pl: PRope + var pl: Rope var typ = skipTypes(ri.sons[0].typ, abstractInst) assert(typ.kind == tyProc) var length = sonsLen(ri) for i in countup(1, length - 1): assert(sonsLen(typ) == sonsLen(typ.n)) + if ri.sons[i].typ.isCompileTimeOnly: continue if i < sonsLen(typ): assert(typ.n.sons[i].kind == nkSym) - app(pl, genArg(p, ri.sons[i], typ.n.sons[i].sym, ri)) + add(pl, genArg(p, ri.sons[i], typ.n.sons[i].sym, ri)) else: - app(pl, genArgNoParam(p, ri.sons[i])) - if i < length - 1: app(pl, ~", ") + add(pl, genArgNoParam(p, ri.sons[i])) + if i < length - 1: add(pl, ~", ") template genCallPattern {.dirty.} = - lineF(p, cpsStmts, callPattern & ";$n", op.r, pl, pl.addComma, rawProc) + lineF(p, cpsStmts, callPattern & ";$n", [op.r, pl, pl.addComma, rawProc]) let rawProc = getRawProcType(p, typ) let callPattern = if tfIterator in typ.flags: PatIter else: PatProc if typ.sons[0] != nil: if isInvalidReturnType(typ.sons[0]): - if sonsLen(ri) > 1: app(pl, ~", ") + if sonsLen(ri) > 1: add(pl, ~", ") # beware of 'result = p(result)'. We may need to allocate a temporary: if d.k in {locTemp, locNone} or not leftAppearsOnRightSide(le, ri): # Great, we can use 'd': @@ -221,12 +222,12 @@ proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = elif d.k notin {locExpr, locTemp} and not hasNoInit(ri): # reset before pass as 'result' var: resetLoc(p, d) - app(pl, addrLoc(d)) + add(pl, addrLoc(d)) genCallPattern() else: var tmp: TLoc getTemp(p, typ.sons[0], tmp, needsInit=true) - app(pl, addrLoc(tmp)) + add(pl, addrLoc(tmp)) genCallPattern() genAssignment(p, d, tmp, {}) # no need for deep copying else: @@ -234,13 +235,15 @@ proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = assert(d.t != nil) # generate an assignment to d: var list: TLoc initLoc(list, locCall, d.t, OnUnknown) - list.r = ropef(callPattern, op.r, pl, pl.addComma, rawProc) + list.r = callPattern % [op.r, pl, pl.addComma, rawProc] genAssignment(p, d, list, {}) # no need for deep copying else: genCallPattern() -proc genOtherArg(p: BProc; ri: PNode; i: int; typ: PType): PRope = - if i < sonsLen(typ): +proc genOtherArg(p: BProc; ri: PNode; i: int; typ: PType): Rope = + if ri.sons[i].typ.isCompileTimeOnly: + result = nil + elif i < sonsLen(typ): # 'var T' is 'T&' in C++. This means we ignore the request of # any nkHiddenAddr when it's a 'var T'. assert(typ.n.sons[i].kind == nkSym) @@ -288,7 +291,25 @@ y.v() --> y.v() is correct """ -proc genThisArg(p: BProc; ri: PNode; i: int; typ: PType): PRope = +proc skipAddrDeref(node: PNode): PNode = + var n = node + var isAddr = false + case n.kind + of nkAddr, nkHiddenAddr: + n = n.sons[0] + isAddr = true + of nkDerefExpr, nkHiddenDeref: + n = n.sons[0] + else: return n + if n.kind == nkObjDownConv: n = n.sons[0] + if isAddr and n.kind in {nkDerefExpr, nkHiddenDeref}: + result = n.sons[0] + elif n.kind in {nkAddr, nkHiddenAddr}: + result = n.sons[0] + else: + result = node + +proc genThisArg(p: BProc; ri: PNode; i: int; typ: PType): Rope = # for better or worse c2nim translates the 'this' argument to a 'var T'. # However manual wrappers may also use 'ptr T'. In any case we support both # for convenience. @@ -298,83 +319,84 @@ proc genThisArg(p: BProc; ri: PNode; i: int; typ: PType): PRope = # skip the deref: var ri = ri[i] while ri.kind == nkObjDownConv: ri = ri[0] - if typ.sons[i].kind == tyVar: + let t = typ.sons[i].skipTypes({tyGenericInst}) + if t.kind == tyVar: let x = if ri.kind == nkHiddenAddr: ri[0] else: ri if x.typ.kind == tyPtr: result = genArgNoParam(p, x) - result.app("->") + result.add("->") elif x.kind in {nkHiddenDeref, nkDerefExpr} and x[0].typ.kind == tyPtr: result = genArgNoParam(p, x[0]) - result.app("->") + result.add("->") else: result = genArgNoParam(p, x) - result.app(".") - elif typ.sons[i].kind == tyPtr: + result.add(".") + elif t.kind == tyPtr: if ri.kind in {nkAddr, nkHiddenAddr}: result = genArgNoParam(p, ri[0]) - result.app(".") + result.add(".") else: result = genArgNoParam(p, ri) - result.app("->") + result.add("->") else: + ri = skipAddrDeref(ri) + if ri.kind in {nkAddr, nkHiddenAddr}: ri = ri[0] result = genArgNoParam(p, ri) #, typ.n.sons[i].sym) - result.app(".") + result.add(".") -proc genPatternCall(p: BProc; ri: PNode; pat: string; typ: PType): PRope = +proc genPatternCall(p: BProc; ri: PNode; pat: string; typ: PType): Rope = var i = 0 var j = 1 while i < pat.len: case pat[i] of '@': if j < ri.len: - result.app genOtherArg(p, ri, j, typ) + result.add genOtherArg(p, ri, j, typ) for k in j+1 .. < ri.len: - result.app(~", ") - result.app genOtherArg(p, ri, k, typ) + result.add(~", ") + result.add genOtherArg(p, ri, k, typ) inc i of '#': if pat[i+1] in {'+', '@'}: let ri = ri[j] if ri.kind in nkCallKinds: let typ = skipTypes(ri.sons[0].typ, abstractInst) - if pat[i+1] == '+': result.app genArgNoParam(p, ri.sons[0]) - result.app(~"(") + if pat[i+1] == '+': result.add genArgNoParam(p, ri.sons[0]) + result.add(~"(") if 1 < ri.len: - result.app genOtherArg(p, ri, 1, typ) + result.add genOtherArg(p, ri, 1, typ) for k in j+1 .. < ri.len: - result.app(~", ") - result.app genOtherArg(p, ri, k, typ) - result.app(~")") + result.add(~", ") + result.add genOtherArg(p, ri, k, typ) + result.add(~")") else: localError(ri.info, "call expression expected for C++ pattern") inc i elif pat[i+1] == '.': - result.app genThisArg(p, ri, j, typ) + result.add genThisArg(p, ri, j, typ) inc i + elif pat[i+1] == '[': + var arg = ri.sons[j].skipAddrDeref + while arg.kind in {nkAddr, nkHiddenAddr, nkObjDownConv}: arg = arg[0] + result.add genArgNoParam(p, arg) + #result.add debugTree(arg, 0, 10) else: - result.app genOtherArg(p, ri, j, typ) + result.add genOtherArg(p, ri, j, typ) inc j inc i of '\'': - inc i - let stars = i - while pat[i] == '*': inc i - if pat[i] in Digits: - let j = pat[i].ord - '0'.ord - var t = typ.sons[j] - for k in 1..i-stars: - if t != nil and t.len > 0: - t = if t.kind == tyGenericInst: t.sons[1] else: t.elemType - if t == nil: result.app(~"void") - else: result.app(getTypeDesc(p.module, t)) - inc i + var idx, stars: int + if scanCppGenericSlot(pat, i, idx, stars): + var t = resolveStarsInCppType(typ, idx, stars) + if t == nil: result.add(~"void") + else: result.add(getTypeDesc(p.module, t)) else: let start = i while i < pat.len: if pat[i] notin {'@', '#', '\''}: inc(i) else: break if i - 1 >= start: - app(result, substr(pat, start, i - 1)) + add(result, substr(pat, start, i - 1)) proc genInfixCall(p: BProc, le, ri: PNode, d: var TLoc) = var op, a: TLoc @@ -384,7 +406,7 @@ proc genInfixCall(p: BProc, le, ri: PNode, d: var TLoc) = assert(typ.kind == tyProc) var length = sonsLen(ri) assert(sonsLen(typ) == sonsLen(typ.n)) - # don't call 'ropeToStr' here for efficiency: + # don't call '$' here for efficiency: let pat = ri.sons[0].sym.loc.r.data internalAssert pat != nil if pat.contains({'#', '(', '@', '\''}): @@ -407,19 +429,19 @@ proc genInfixCall(p: BProc, le, ri: PNode, d: var TLoc) = list.r = pl genAssignment(p, d, list, {}) # no need for deep copying else: - app(pl, ~";$n") + add(pl, ~";$n") line(p, cpsStmts, pl) else: - var pl: PRope = nil + var pl: Rope = nil #var param = typ.n.sons[1].sym if 1 < ri.len: - app(pl, genThisArg(p, ri, 1, typ)) - app(pl, op.r) - var params: PRope + add(pl, genThisArg(p, ri, 1, typ)) + add(pl, op.r) + var params: Rope for i in countup(2, length - 1): - if params != nil: params.app(~", ") + if params != nil: params.add(~", ") assert(sonsLen(typ) == sonsLen(typ.n)) - app(params, genOtherArg(p, ri, i, typ)) + add(params, genOtherArg(p, ri, i, typ)) fixupCall(p, le, ri, d, pl, params) proc genNamedParamCall(p: BProc, ri: PNode, d: var TLoc) = @@ -433,55 +455,55 @@ proc genNamedParamCall(p: BProc, ri: PNode, d: var TLoc) = var length = sonsLen(ri) assert(sonsLen(typ) == sonsLen(typ.n)) - # don't call 'ropeToStr' here for efficiency: + # don't call '$' here for efficiency: let pat = ri.sons[0].sym.loc.r.data internalAssert pat != nil var start = 3 if ' ' in pat: start = 1 - app(pl, op.r) + add(pl, op.r) if length > 1: - app(pl, ~": ") - app(pl, genArg(p, ri.sons[1], typ.n.sons[1].sym, ri)) + add(pl, ~": ") + add(pl, genArg(p, ri.sons[1], typ.n.sons[1].sym, ri)) start = 2 else: if length > 1: - app(pl, genArg(p, ri.sons[1], typ.n.sons[1].sym, ri)) - app(pl, ~" ") - app(pl, op.r) + add(pl, genArg(p, ri.sons[1], typ.n.sons[1].sym, ri)) + add(pl, ~" ") + add(pl, op.r) if length > 2: - app(pl, ~": ") - app(pl, genArg(p, ri.sons[2], typ.n.sons[2].sym, ri)) + add(pl, ~": ") + add(pl, genArg(p, ri.sons[2], typ.n.sons[2].sym, ri)) for i in countup(start, length-1): assert(sonsLen(typ) == sonsLen(typ.n)) if i >= sonsLen(typ): internalError(ri.info, "varargs for objective C method?") assert(typ.n.sons[i].kind == nkSym) var param = typ.n.sons[i].sym - app(pl, ~" ") - app(pl, param.name.s) - app(pl, ~": ") - app(pl, genArg(p, ri.sons[i], param, ri)) + add(pl, ~" ") + add(pl, param.name.s) + add(pl, ~": ") + add(pl, genArg(p, ri.sons[i], param, ri)) if typ.sons[0] != nil: if isInvalidReturnType(typ.sons[0]): - if sonsLen(ri) > 1: app(pl, ~" ") + if sonsLen(ri) > 1: add(pl, ~" ") # beware of 'result = p(result)'. We always allocate a temporary: if d.k in {locTemp, locNone}: # We already got a temp. Great, special case it: if d.k == locNone: getTemp(p, typ.sons[0], d, needsInit=true) - app(pl, ~"Result: ") - app(pl, addrLoc(d)) - app(pl, ~"];$n") + add(pl, ~"Result: ") + add(pl, addrLoc(d)) + add(pl, ~"];$n") line(p, cpsStmts, pl) else: var tmp: TLoc getTemp(p, typ.sons[0], tmp, needsInit=true) - app(pl, addrLoc(tmp)) - app(pl, ~"];$n") + add(pl, addrLoc(tmp)) + add(pl, ~"];$n") line(p, cpsStmts, pl) genAssignment(p, d, tmp, {}) # no need for deep copying else: - app(pl, ~"]") + add(pl, ~"]") if d.k == locNone: getTemp(p, typ.sons[0], d) assert(d.t != nil) # generate an assignment to d: var list: TLoc @@ -489,7 +511,7 @@ proc genNamedParamCall(p: BProc, ri: PNode, d: var TLoc) = list.r = pl genAssignment(p, d, list, {}) # no need for deep copying else: - app(pl, ~"];$n") + add(pl, ~"];$n") line(p, cpsStmts, pl) proc genCall(p: BProc, e: PNode, d: var TLoc) = diff --git a/compiler/ccgexprs.nim b/compiler/ccgexprs.nim index 564d1fd36..93a9dd65d 100644 --- a/compiler/ccgexprs.nim +++ b/compiler/ccgexprs.nim @@ -11,45 +11,45 @@ # -------------------------- constant expressions ------------------------ -proc int64Literal(i: BiggestInt): PRope = +proc int64Literal(i: BiggestInt): Rope = if i > low(int64): - result = rfmt(nil, "IL64($1)", toRope(i)) + result = rfmt(nil, "IL64($1)", rope(i)) else: result = ~"(IL64(-9223372036854775807) - IL64(1))" -proc uint64Literal(i: uint64): PRope = toRope($i & "ULL") +proc uint64Literal(i: uint64): Rope = rope($i & "ULL") -proc intLiteral(i: BiggestInt): PRope = +proc intLiteral(i: BiggestInt): Rope = if i > low(int32) and i <= high(int32): - result = toRope(i) + result = rope(i) elif i == low(int32): # Nim has the same bug for the same reasons :-) result = ~"(-2147483647 -1)" elif i > low(int64): - result = rfmt(nil, "IL64($1)", toRope(i)) + result = rfmt(nil, "IL64($1)", rope(i)) else: result = ~"(IL64(-9223372036854775807) - IL64(1))" -proc int32Literal(i: int): PRope = +proc int32Literal(i: int): Rope = if i == int(low(int32)): result = ~"(-2147483647 -1)" else: - result = toRope(i) + result = rope(i) -proc genHexLiteral(v: PNode): PRope = +proc genHexLiteral(v: PNode): Rope = # hex literals are unsigned in C # so we don't generate hex literals any longer. if v.kind notin {nkIntLit..nkUInt64Lit}: internalError(v.info, "genHexLiteral") result = intLiteral(v.intVal) -proc getStrLit(m: BModule, s: string): PRope = +proc getStrLit(m: BModule, s: string): Rope = discard cgsym(m, "TGenericSeq") - result = con("TMP", toRope(backendId())) - appf(m.s[cfsData], "STRING_LITERAL($1, $2, $3);$n", - [result, makeCString(s), toRope(len(s))]) + result = "TMP" & rope(backendId()) + addf(m.s[cfsData], "STRING_LITERAL($1, $2, $3);$n", + [result, makeCString(s), rope(len(s))]) -proc genLiteral(p: BProc, n: PNode, ty: PType): PRope = +proc genLiteral(p: BProc, n: PNode, ty: PType): Rope = if ty == nil: internalError(n.info, "genLiteral: ty is nil") case n.kind of nkCharLit..nkUInt64Lit: @@ -62,21 +62,21 @@ proc genLiteral(p: BProc, n: PNode, ty: PType): PRope = of tyInt64: result = int64Literal(n.intVal) of tyUInt64: result = uint64Literal(uint64(n.intVal)) else: - result = ropef("(($1) $2)", [getTypeDesc(p.module, - skipTypes(ty, abstractVarRange)), intLiteral(n.intVal)]) + result = "(($1) $2)" % [getTypeDesc(p.module, + skipTypes(ty, abstractVarRange)), intLiteral(n.intVal)] of nkNilLit: let t = skipTypes(ty, abstractVarRange) if t.kind == tyProc and t.callConv == ccClosure: var id = nodeTableTestOrSet(p.module.dataCache, n, gBackendId) - result = con("TMP", toRope(id)) + result = "TMP" & rope(id) if id == gBackendId: # not found in cache: inc(gBackendId) - appf(p.module.s[cfsData], + addf(p.module.s[cfsData], "static NIM_CONST $1 $2 = {NIM_NIL,NIM_NIL};$n", [getTypeDesc(p.module, t), result]) else: - result = toRope("NIM_NIL") + result = rope("NIM_NIL") of nkStrLit..nkTripleStrLit: if n.strVal.isNil: result = ropecg(p.module, "((#NimStringDesc*) NIM_NIL)", []) @@ -87,16 +87,16 @@ proc genLiteral(p: BProc, n: PNode, ty: PType): PRope = result = ropecg(p.module, "((#NimStringDesc*) &$1)", [getStrLit(p.module, n.strVal)]) else: - result = ropecg(p.module, "((#NimStringDesc*) &TMP$1)", [toRope(id)]) + result = ropecg(p.module, "((#NimStringDesc*) &TMP$1)", [rope(id)]) else: result = makeCString(n.strVal) of nkFloatLit..nkFloat64Lit: - result = toRope(n.floatVal.toStrMaxPrecision) + result = rope(n.floatVal.toStrMaxPrecision) else: internalError(n.info, "genLiteral(" & $n.kind & ')') result = nil -proc genLiteral(p: BProc, n: PNode): PRope = +proc genLiteral(p: BProc, n: PNode): Rope = result = genLiteral(p, n, n.typ) proc bitSetToWord(s: TBitSet, size: int): BiggestInt = @@ -113,10 +113,10 @@ proc bitSetToWord(s: TBitSet, size: int): BiggestInt = for j in countup(0, size - 1): if j < len(s): result = result or `shl`(Ze64(s[j]), (Size - 1 - j) * 8) -proc genRawSetData(cs: TBitSet, size: int): PRope = - var frmt: TFormatStr +proc genRawSetData(cs: TBitSet, size: int): Rope = + var frmt: FormatStr if size > 8: - result = ropef("{$n") + result = "{$n" % [] for i in countup(0, size - 1): if i < size - 1: # not last iteration? @@ -124,22 +124,22 @@ proc genRawSetData(cs: TBitSet, size: int): PRope = else: frmt = "0x$1, " else: frmt = "0x$1}$n" - appf(result, frmt, [toRope(toHex(ze64(cs[i]), 2))]) + addf(result, frmt, [rope(toHex(ze64(cs[i]), 2))]) else: result = intLiteral(bitSetToWord(cs, size)) - # result := toRope('0x' + ToHex(bitSetToWord(cs, size), size * 2)) + # result := rope('0x' + ToHex(bitSetToWord(cs, size), size * 2)) -proc genSetNode(p: BProc, n: PNode): PRope = +proc genSetNode(p: BProc, n: PNode): Rope = var cs: TBitSet var size = int(getSize(n.typ)) toBitSet(n, cs) if size > 8: var id = nodeTableTestOrSet(p.module.dataCache, n, gBackendId) - result = con("TMP", toRope(id)) + result = "TMP" & rope(id) if id == gBackendId: # not found in cache: inc(gBackendId) - appf(p.module.s[cfsData], "static NIM_CONST $1 $2 = $3;$n", + addf(p.module.s[cfsData], "static NIM_CONST $1 $2 = $3;$n", [getTypeDesc(p.module, n.typ), result, genRawSetData(cs, size)]) else: result = genRawSetData(cs, size) @@ -211,12 +211,12 @@ proc asgnComplexity(n: PNode): int = result += asgnComplexity(t) else: discard -proc optAsgnLoc(a: TLoc, t: PType, field: PRope): TLoc = +proc optAsgnLoc(a: TLoc, t: PType, field: Rope): TLoc = assert field != nil result.k = locField result.s = a.s result.t = t - result.r = rdLoc(a).con(".").con(field) + result.r = rdLoc(a) & "." & field result.heapRoot = a.heapRoot proc genOptAsgnTuple(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = @@ -230,7 +230,7 @@ proc genOptAsgnTuple(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = let t = skipTypes(dest.t, abstractInst).getUniqueType() for i in 0 .. <t.len: let t = t.sons[i] - let field = ropef("Field$1", i.toRope) + let field = "Field$1" % [i.rope] genAssignment(p, optAsgnLoc(dest, t, field), optAsgnLoc(src, t, field), newflags) @@ -313,8 +313,8 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = of tyProc: if needsComplexAssignment(dest.t): # optimize closure assignment: - let a = optAsgnLoc(dest, dest.t, "ClEnv".toRope) - let b = optAsgnLoc(src, dest.t, "ClEnv".toRope) + let a = optAsgnLoc(dest, dest.t, "ClEnv".rope) + let b = optAsgnLoc(src, dest.t, "ClEnv".rope) genRefAssign(p, a, b, flags) linefmt(p, cpsStmts, "$1.ClPrc = $2.ClPrc;$n", rdLoc(dest), rdLoc(src)) else: @@ -365,7 +365,7 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = if mapType(ty) == ctArray: useStringh(p.module) linefmt(p, cpsStmts, "memcpy((void*)$1, (NIM_CONST void*)$2, $3);$n", - rdLoc(dest), rdLoc(src), toRope(getSize(dest.t))) + rdLoc(dest), rdLoc(src), rope(getSize(dest.t))) else: linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) of tyPtr, tyPointer, tyChar, tyBool, tyEnum, tyCString, @@ -391,7 +391,7 @@ proc genDeepCopy(p: BProc; dest, src: TLoc) = if mapType(ty) == ctArray: useStringh(p.module) linefmt(p, cpsStmts, "memcpy((void*)$1, (NIM_CONST void*)$2, $3);$n", - rdLoc(dest), rdLoc(src), toRope(getSize(dest.t))) + rdLoc(dest), rdLoc(src), rope(getSize(dest.t))) else: linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) of tyPointer, tyChar, tyBool, tyEnum, tyCString, @@ -409,7 +409,7 @@ proc putLocIntoDest(p: BProc, d: var TLoc, s: TLoc) = else: d = s # ``d`` is free, so fill it with ``s`` -proc putDataIntoDest(p: BProc, d: var TLoc, t: PType, r: PRope) = +proc putDataIntoDest(p: BProc, d: var TLoc, t: PType, r: Rope) = var a: TLoc if d.k != locNone: # need to generate an assignment here @@ -424,7 +424,7 @@ proc putDataIntoDest(p: BProc, d: var TLoc, t: PType, r: PRope) = d.t = t d.r = r -proc putIntoDest(p: BProc, d: var TLoc, t: PType, r: PRope) = +proc putIntoDest(p: BProc, d: var TLoc, t: PType, r: Rope) = var a: TLoc if d.k != locNone: # need to generate an assignment here @@ -485,37 +485,48 @@ proc unaryExprChar(p: BProc, e: PNode, d: var TLoc, frmt: string) = initLocExpr(p, e.sons[1], a) putIntoDest(p, d, e.typ, ropecg(p.module, frmt, [rdCharLoc(a)])) +proc binaryArithOverflowRaw(p: BProc, t: PType, a, b: TLoc; + frmt: string): Rope = + var size = getSize(t) + let storage = if size < platform.intSize: rope("NI") + else: getTypeDesc(p.module, t) + result = getTempName() + linefmt(p, cpsLocals, "$1 $2;$n", storage, result) + lineCg(p, cpsStmts, frmt, result, rdCharLoc(a), rdCharLoc(b)) + if size < platform.intSize or t.kind in {tyRange, tyEnum}: + linefmt(p, cpsStmts, "if ($1 < $2 || $1 > $3) #raiseOverflow();$n", + result, intLiteral(firstOrd(t)), intLiteral(lastOrd(t))) + proc binaryArithOverflow(p: BProc, e: PNode, d: var TLoc, m: TMagic) = const - prc: array[mAddI..mModI64, string] = ["addInt", "subInt", "mulInt", - "divInt", "modInt", "addInt64", "subInt64", "mulInt64", "divInt64", - "modInt64"] - opr: array[mAddI..mModI64, string] = ["+", "-", "*", "/", "%", "+", "-", - "*", "/", "%"] + prc: array[mAddI..mPred, string] = [ + "$# = #addInt($#, $#);$n", "$# = #subInt($#, $#);$n", + "$# = #mulInt($#, $#);$n", "$# = #divInt($#, $#);$n", + "$# = #modInt($#, $#);$n", + "$# = #addInt64($#, $#);$n", "$# = #subInt64($#, $#);$n", + "$# = #mulInt64($#, $#);$n", "$# = #divInt64($#, $#);$n", + "$# = #modInt64($#, $#);$n", + "$# = #addInt($#, $#);$n", "$# = #subInt($#, $#);$n"] + opr: array[mAddI..mPred, string] = [ + "($#)($# + $#)", "($#)($# - $#)", "($#)($# * $#)", + "($#)($# / $#)", "($#)($# % $#)", + "($#)($# + $#)", "($#)($# - $#)", "($#)($# * $#)", + "($#)($# / $#)", "($#)($# % $#)", + "($#)($# + $#)", "($#)($# - $#)"] var a, b: TLoc assert(e.sons[1].typ != nil) assert(e.sons[2].typ != nil) initLocExpr(p, e.sons[1], a) initLocExpr(p, e.sons[2], b) - var t = skipTypes(e.typ, abstractRange) + # skipping 'range' is correct here as we'll generate a proper range check + # later via 'chckRange' + let t = e.typ.skipTypes(abstractRange) if optOverflowCheck notin p.options: - putIntoDest(p, d, e.typ, ropef("(NI$4)($2 $1 $3)", [toRope(opr[m]), - rdLoc(a), rdLoc(b), toRope(getSize(t) * 8)])) + let res = opr[m] % [getTypeDesc(p.module, t), rdLoc(a), rdLoc(b)] + putIntoDest(p, d, e.typ, res) else: - var storage: PRope - var size = getSize(t) - if size < platform.intSize: - storage = toRope("NI") - else: - storage = getTypeDesc(p.module, t) - var tmp = getTempName() - linefmt(p, cpsLocals, "$1 $2;$n", storage, tmp) - lineCg(p, cpsStmts, "$1 = #$2($3, $4);$n", - tmp, toRope(prc[m]), rdLoc(a), rdLoc(b)) - if size < platform.intSize or t.kind in {tyRange, tyEnum, tySet}: - linefmt(p, cpsStmts, "if ($1 < $2 || $1 > $3) #raiseOverflow();$n", - tmp, intLiteral(firstOrd(t)), intLiteral(lastOrd(t))) - putIntoDest(p, d, e.typ, ropef("(NI$1)($2)", [toRope(getSize(t)*8), tmp])) + let res = binaryArithOverflowRaw(p, t, a, b, prc[m]) + putIntoDest(p, d, e.typ, "($#)($#)" % [getTypeDesc(p.module, t), res]) proc unaryArithOverflow(p: BProc, e: PNode, d: var TLoc, m: TMagic) = const @@ -533,7 +544,7 @@ proc unaryArithOverflow(p: BProc, e: PNode, d: var TLoc, m: TMagic) = if optOverflowCheck in p.options: linefmt(p, cpsStmts, "if ($1 == $2) #raiseOverflow();$n", rdLoc(a), intLiteral(firstOrd(t))) - putIntoDest(p, d, e.typ, ropef(opr[m], [rdLoc(a), toRope(getSize(t) * 8)])) + putIntoDest(p, d, e.typ, opr[m] % [rdLoc(a), rope(getSize(t) * 8)]) proc binaryArith(p: BProc, e: PNode, d: var TLoc, op: TMagic) = const @@ -555,8 +566,6 @@ proc binaryArith(p: BProc, e: PNode, d: var TLoc, op: TMagic) = "($4)($1 & $2)", # BitandI64 "($4)($1 | $2)", # BitorI64 "($4)($1 ^ $2)", # BitxorI64 - "(($1 <= $2) ? $1 : $2)", # MinI64 - "(($1 >= $2) ? $1 : $2)", # MaxI64 "(($1 <= $2) ? $1 : $2)", # MinF64 "(($1 >= $2) ? $1 : $2)", # MaxF64 "($4)((NU$3)($1) + (NU$3)($2))", # AddU @@ -602,8 +611,8 @@ proc binaryArith(p: BProc, e: PNode, d: var TLoc, op: TMagic) = # BUGFIX: cannot use result-type here, as it may be a boolean s = max(getSize(a.t), getSize(b.t)) * 8 putIntoDest(p, d, e.typ, - ropef(binArithTab[op], [rdLoc(a), rdLoc(b), toRope(s), - getSimpleTypeDesc(p.module, e.typ)])) + binArithTab[op] % [rdLoc(a), rdLoc(b), rope(s), + getSimpleTypeDesc(p.module, e.typ)]) proc genEqProc(p: BProc, e: PNode, d: var TLoc) = var a, b: TLoc @@ -613,10 +622,9 @@ proc genEqProc(p: BProc, e: PNode, d: var TLoc) = initLocExpr(p, e.sons[2], b) if a.t.callConv == ccClosure: putIntoDest(p, d, e.typ, - ropef("($1.ClPrc == $2.ClPrc && $1.ClEnv == $2.ClEnv)", [ - rdLoc(a), rdLoc(b)])) + "($1.ClPrc == $2.ClPrc && $1.ClEnv == $2.ClEnv)" % [rdLoc(a), rdLoc(b)]) else: - putIntoDest(p, d, e.typ, ropef("($1 == $2)", [rdLoc(a), rdLoc(b)])) + putIntoDest(p, d, e.typ, "($1 == $2)" % [rdLoc(a), rdLoc(b)]) proc genIsNil(p: BProc, e: PNode, d: var TLoc) = let t = skipTypes(e.sons[1].typ, abstractRange) @@ -630,7 +638,6 @@ proc unaryArith(p: BProc, e: PNode, d: var TLoc, op: TMagic) = unArithTab: array[mNot..mToBiggestInt, string] = ["!($1)", # Not "$1", # UnaryPlusI "($3)((NU$2) ~($1))", # BitnotI - "$1", # UnaryPlusI64 "($3)((NU$2) ~($1))", # BitnotI64 "$1", # UnaryPlusF64 "-($1)", # UnaryMinusF64 @@ -656,8 +663,8 @@ proc unaryArith(p: BProc, e: PNode, d: var TLoc, op: TMagic) = initLocExpr(p, e.sons[1], a) t = skipTypes(e.typ, abstractRange) putIntoDest(p, d, e.typ, - ropef(unArithTab[op], [rdLoc(a), toRope(getSize(t) * 8), - getSimpleTypeDesc(p.module, e.typ)])) + unArithTab[op] % [rdLoc(a), rope(getSize(t) * 8), + getSimpleTypeDesc(p.module, e.typ)]) proc isCppRef(p: BProc; typ: PType): bool {.inline.} = result = p.module.compileToCpp and @@ -666,7 +673,7 @@ proc isCppRef(p: BProc; typ: PType): bool {.inline.} = proc genDeref(p: BProc, e: PNode, d: var TLoc; enforceDeref=false) = let mt = mapType(e.sons[0].typ) - if (mt in {ctArray, ctPtrToArray} and not enforceDeref): + if mt in {ctArray, ctPtrToArray} and not enforceDeref: # XXX the amount of hacks for C's arrays is incredible, maybe we should # simply wrap them in a struct? --> Losing auto vectorization then? #if e[0].kind != nkBracketExpr: @@ -675,19 +682,29 @@ proc genDeref(p: BProc, e: PNode, d: var TLoc; enforceDeref=false) = else: var a: TLoc initLocExprSingleUse(p, e.sons[0], a) - let typ = skipTypes(a.t, abstractInst) - case typ.kind - of tyRef: - d.s = OnHeap - of tyVar: - d.s = OnUnknown - if tfVarIsPtr notin typ.flags and p.module.compileToCpp and - e.kind == nkHiddenDeref: + if d.k == locNone: + let typ = skipTypes(a.t, abstractInst) + # dest = *a; <-- We do not know that 'dest' is on the heap! + # It is completely wrong to set 'd.s' here, unless it's not yet + # been assigned to. + case typ.kind + of tyRef: + d.s = OnHeap + of tyVar: + d.s = OnUnknown + if tfVarIsPtr notin typ.flags and p.module.compileToCpp and + e.kind == nkHiddenDeref: + putIntoDest(p, d, e.typ, rdLoc(a)) + return + of tyPtr: + d.s = OnUnknown # BUGFIX! + else: internalError(e.info, "genDeref " & $a.t.kind) + elif p.module.compileToCpp: + let typ = skipTypes(a.t, abstractInst) + if typ.kind == tyVar and tfVarIsPtr notin typ.flags and + e.kind == nkHiddenDeref: putIntoDest(p, d, e.typ, rdLoc(a)) return - of tyPtr: - d.s = OnUnknown # BUGFIX! - else: internalError(e.info, "genDeref " & $a.t.kind) if enforceDeref and mt == ctPtrToArray: # we lie about the type for better C interop: 'ptr array[3,T]' is # translated to 'ptr T', but for deref'ing this produces wrong code. @@ -696,14 +713,14 @@ proc genDeref(p: BProc, e: PNode, d: var TLoc; enforceDeref=false) = # so the '&' and '*' cancel out: putIntoDest(p, d, a.t.sons[0], rdLoc(a)) else: - putIntoDest(p, d, e.typ, ropef("(*$1)", [rdLoc(a)])) + putIntoDest(p, d, e.typ, "(*$1)" % [rdLoc(a)]) proc genAddr(p: BProc, e: PNode, d: var TLoc) = # careful 'addr(myptrToArray)' needs to get the ampersand: if e.sons[0].typ.skipTypes(abstractInst).kind in {tyRef, tyPtr}: var a: TLoc initLocExpr(p, e.sons[0], a) - putIntoDest(p, d, e.typ, con("&", a.r)) + putIntoDest(p, d, e.typ, "&" & a.r) #Message(e.info, warnUser, "HERE NEW &") elif mapType(e.sons[0].typ) == ctArray or isCppRef(p, e.sons[0].typ): expr(p, e.sons[0], d) @@ -736,7 +753,7 @@ proc genTupleElem(p: BProc, e: PNode, d: var TLoc) = case e.sons[1].kind of nkIntLit..nkUInt64Lit: i = int(e.sons[1].intVal) else: internalError(e.info, "genTupleElem") - appf(r, ".Field$1", [toRope(i)]) + addf(r, ".Field$1", [rope(i)]) putIntoDest(p, d, ty.sons[i], r) proc genRecordField(p: BProc, e: PNode, d: var TLoc) = @@ -747,7 +764,7 @@ proc genRecordField(p: BProc, e: PNode, d: var TLoc) = if ty.kind == tyTuple: # we found a unique tuple type which lacks field information # so we use Field$i - appf(r, ".Field$1", [toRope(f.position)]) + addf(r, ".Field$1", [rope(f.position)]) putIntoDest(p, d, f.typ, r) else: var field: PSym = nil @@ -756,16 +773,17 @@ proc genRecordField(p: BProc, e: PNode, d: var TLoc) = internalError(e.info, "genRecordField") field = lookupInRecord(ty.n, f.name) if field != nil: break - if not p.module.compileToCpp: app(r, ".Sup") + if not p.module.compileToCpp: add(r, ".Sup") ty = getUniqueType(ty.sons[0]) if field == nil: internalError(e.info, "genRecordField 2 ") if field.loc.r == nil: internalError(e.info, "genRecordField 3") - appf(r, ".$1", [field.loc.r]) + addf(r, ".$1", [field.loc.r]) putIntoDest(p, d, field.typ, r) + #d.s = a.s proc genInExprAux(p: BProc, e: PNode, a, b, d: var TLoc) -proc genFieldCheck(p: BProc, e: PNode, obj: PRope, field: PSym) = +proc genFieldCheck(p: BProc, e: PNode, obj: Rope, field: PSym) = var test, u, v: TLoc for i in countup(1, sonsLen(e) - 1): var it = e.sons[i] @@ -778,12 +796,12 @@ proc genFieldCheck(p: BProc, e: PNode, obj: PRope, field: PSym) = initLoc(test, locNone, it.typ, OnStack) initLocExpr(p, it.sons[1], u) initLoc(v, locExpr, disc.typ, OnUnknown) - v.r = ropef("$1.$2", [obj, disc.sym.loc.r]) + v.r = "$1.$2" % [obj, disc.sym.loc.r] genInExprAux(p, it, u, v, test) let id = nodeTableTestOrSet(p.module.dataCache, newStrNode(nkStrLit, field.name.s), gBackendId) let strLit = if id == gBackendId: getStrLit(p.module, field.name.s) - else: con("TMP", toRope(id)) + else: "TMP" & rope(id) if op.magic == mNot: linefmt(p, cpsStmts, "if ($1) #raiseFieldError(((#NimStringDesc*) &$2));$n", @@ -799,7 +817,7 @@ proc genCheckedRecordField(p: BProc, e: PNode, d: var TLoc) = a: TLoc f, field: PSym ty: PType - r: PRope + r: Rope ty = genRecordFieldAux(p, e.sons[0], d, a) r = rdLoc(a) f = e.sons[0].sons[1].sym @@ -808,13 +826,13 @@ proc genCheckedRecordField(p: BProc, e: PNode, d: var TLoc) = assert(ty.kind in {tyTuple, tyObject}) field = lookupInRecord(ty.n, f.name) if field != nil: break - if not p.module.compileToCpp: app(r, ".Sup") + if not p.module.compileToCpp: add(r, ".Sup") ty = getUniqueType(ty.sons[0]) if field == nil: internalError(e.info, "genCheckedRecordField") if field.loc.r == nil: internalError(e.info, "genCheckedRecordField") # generate the checks: genFieldCheck(p, e, r, field) - app(r, rfmt(nil, ".$1", field.loc.r)) + add(r, rfmt(nil, ".$1", field.loc.r)) putIntoDest(p, d, field.typ, r) else: genRecordField(p, e.sons[0], d) @@ -943,11 +961,11 @@ proc genEcho(p: BProc, n: PNode) = # is threadsafe. internalAssert n.kind == nkBracket discard lists.includeStr(p.module.headerFiles, "<stdio.h>") - var args: PRope = nil + var args: Rope = nil var a: TLoc for i in countup(0, n.len-1): initLocExpr(p, n.sons[i], a) - appf(args, ", $1? ($1)->data:\"nil\"", [rdLoc(a)]) + addf(args, ", $1? ($1)->data:\"nil\"", [rdLoc(a)]) linefmt(p, cpsStmts, "printf($1$2);$n", makeCString(repeat("%s", n.len) & tnl), args) @@ -974,22 +992,22 @@ proc genStrConcat(p: BProc, e: PNode, d: var TLoc) = var a, tmp: TLoc getTemp(p, e.typ, tmp) var L = 0 - var appends: PRope = nil - var lens: PRope = nil + var appends: Rope = nil + var lens: Rope = nil for i in countup(0, sonsLen(e) - 2): # compute the length expression: initLocExpr(p, e.sons[i + 1], a) if skipTypes(e.sons[i + 1].typ, abstractVarRange).kind == tyChar: inc(L) - app(appends, rfmt(p.module, "#appendChar($1, $2);$n", tmp.r, rdLoc(a))) + add(appends, rfmt(p.module, "#appendChar($1, $2);$n", tmp.r, rdLoc(a))) else: if e.sons[i + 1].kind in {nkStrLit..nkTripleStrLit}: inc(L, len(e.sons[i + 1].strVal)) else: - appf(lens, "$1->$2 + ", [rdLoc(a), lenField(p)]) - app(appends, rfmt(p.module, "#appendString($1, $2);$n", tmp.r, rdLoc(a))) - linefmt(p, cpsStmts, "$1 = #rawNewString($2$3);$n", tmp.r, lens, toRope(L)) - app(p.s(cpsStmts), appends) + addf(lens, "$1->$2 + ", [rdLoc(a), lenField(p)]) + add(appends, rfmt(p.module, "#appendString($1, $2);$n", tmp.r, rdLoc(a))) + linefmt(p, cpsStmts, "$1 = #rawNewString($2$3);$n", tmp.r, lens, rope(L)) + add(p.s(cpsStmts), appends) if d.k == locNone: d = tmp keepAlive(p, tmp) @@ -1011,7 +1029,7 @@ proc genStrAppend(p: BProc, e: PNode, d: var TLoc) = # } var a, dest: TLoc - appends, lens: PRope + appends, lens: Rope assert(d.k == locNone) var L = 0 initLocExpr(p, e.sons[1], dest) @@ -1020,19 +1038,19 @@ proc genStrAppend(p: BProc, e: PNode, d: var TLoc) = initLocExpr(p, e.sons[i + 2], a) if skipTypes(e.sons[i + 2].typ, abstractVarRange).kind == tyChar: inc(L) - app(appends, rfmt(p.module, "#appendChar($1, $2);$n", + add(appends, rfmt(p.module, "#appendChar($1, $2);$n", rdLoc(dest), rdLoc(a))) else: if e.sons[i + 2].kind in {nkStrLit..nkTripleStrLit}: inc(L, len(e.sons[i + 2].strVal)) else: - appf(lens, "$1->$2 + ", [rdLoc(a), lenField(p)]) - app(appends, rfmt(p.module, "#appendString($1, $2);$n", + addf(lens, "$1->$2 + ", [rdLoc(a), lenField(p)]) + add(appends, rfmt(p.module, "#appendString($1, $2);$n", rdLoc(dest), rdLoc(a))) linefmt(p, cpsStmts, "$1 = #resizeString($1, $2$3);$n", - rdLoc(dest), lens, toRope(L)) + rdLoc(dest), lens, rope(L)) keepAlive(p, dest) - app(p.s(cpsStmts), appends) + add(p.s(cpsStmts), appends) gcUsage(e) proc genSeqElemAppend(p: BProc, e: PNode, d: var TLoc) = @@ -1062,14 +1080,14 @@ proc genReset(p: BProc, n: PNode) = linefmt(p, cpsStmts, "#genericReset((void*)$1, $2);$n", addrLoc(a), genTypeInfo(p.module, skipTypes(a.t, abstractVarRange))) -proc rawGenNew(p: BProc, a: TLoc, sizeExpr: PRope) = +proc rawGenNew(p: BProc, a: TLoc, sizeExpr: Rope) = var sizeExpr = sizeExpr let refType = skipTypes(a.t, abstractVarRange) var b: TLoc initLoc(b, locExpr, a.t, OnHeap) if sizeExpr.isNil: - sizeExpr = ropef("sizeof($1)", - getTypeDesc(p.module, skipTypes(refType.sons[0], abstractRange))) + sizeExpr = "sizeof($1)" % + [getTypeDesc(p.module, skipTypes(refType.sons[0], abstractRange))] let args = [getTypeDesc(p.module, refType), genTypeInfo(p.module, refType), sizeExpr] @@ -1099,7 +1117,7 @@ proc genNew(p: BProc, e: PNode) = rawGenNew(p, a, nil) gcUsage(e) -proc genNewSeqAux(p: BProc, dest: TLoc, length: PRope) = +proc genNewSeqAux(p: BProc, dest: TLoc, length: Rope) = let seqtype = skipTypes(dest.t, abstractVarRange) let args = [getTypeDesc(p.module, seqtype), genTypeInfo(p.module, seqtype), length] @@ -1132,7 +1150,7 @@ proc genObjConstr(p: BProc, e: PNode, d: var TLoc) = if isRef: rawGenNew(p, tmp, nil) t = t.lastSon.skipTypes(abstractInst) - r = ropef("(*$1)", r) + r = "(*$1)" % [r] gcUsage(e) else: constructLoc(p, tmp) @@ -1146,13 +1164,13 @@ proc genObjConstr(p: BProc, e: PNode, d: var TLoc) = while ty != nil: field = lookupInRecord(ty.n, it.sons[0].sym.name) if field != nil: break - if not p.module.compileToCpp: app(tmp2.r, ".Sup") + if not p.module.compileToCpp: add(tmp2.r, ".Sup") ty = getUniqueType(ty.sons[0]) if field == nil or field.loc.r == nil: internalError(e.info, "genObjConstr") if it.len == 3 and optFieldCheck in p.options: genFieldCheck(p, it.sons[2], tmp2.r, field) - app(tmp2.r, ".") - app(tmp2.r, field.loc.r) + add(tmp2.r, ".") + add(tmp2.r, field.loc.r) tmp2.k = locTemp tmp2.t = field.loc.t tmp2.s = if isRef: OnHeap else: OnStack @@ -1202,14 +1220,14 @@ proc genNewFinalize(p: BProc, e: PNode) = var a, b, f: TLoc refType, bt: PType - ti: PRope + ti: Rope oldModule: BModule refType = skipTypes(e.sons[1].typ, abstractVarRange) initLocExpr(p, e.sons[1], a) initLocExpr(p, e.sons[2], f) initLoc(b, locExpr, a.t, OnHeap) ti = genTypeInfo(p.module, refType) - appf(p.module.s[cfsTypeInit3], "$1->finalizer = (void*)$2;$n", [ti, rdLoc(f)]) + addf(p.module.s[cfsTypeInit3], "$1->finalizer = (void*)$2;$n", [ti, rdLoc(f)]) b.r = ropecg(p.module, "($1) #newObj($2, sizeof($3))", [ getTypeDesc(p.module, refType), ti, getTypeDesc(p.module, skipTypes(refType.lastSon, abstractRange))]) @@ -1218,18 +1236,18 @@ proc genNewFinalize(p: BProc, e: PNode) = genObjectInit(p, cpsStmts, bt, a, false) gcUsage(e) -proc genOfHelper(p: BProc; dest: PType; a: PRope): PRope = +proc genOfHelper(p: BProc; dest: PType; a: Rope): Rope = # unfortunately 'genTypeInfo' sets tfObjHasKids as a side effect, so we # have to call it here first: let ti = genTypeInfo(p.module, dest) if tfFinal in dest.flags or (p.module.objHasKidsValid and tfObjHasKids notin dest.flags): - result = ropef("$1.m_type == $2", a, ti) + result = "$1.m_type == $2" % [a, ti] else: discard cgsym(p.module, "TNimType") inc p.module.labels - let cache = con("Nim_OfCheck_CACHE", p.module.labels.toRope) - appf(p.module.s[cfsVars], "static TNimType* $#[2];$n", cache) + let cache = "Nim_OfCheck_CACHE" & p.module.labels.rope + addf(p.module.s[cfsVars], "static TNimType* $#[2];$n", [cache]) result = rfmt(p.module, "#isObjWithCache($#.m_type, $#, $#)", a, ti, cache) when false: # former version: @@ -1241,7 +1259,7 @@ proc genOf(p: BProc, x: PNode, typ: PType, d: var TLoc) = initLocExpr(p, x, a) var dest = skipTypes(typ, typedescPtrs) var r = rdLoc(a) - var nilCheck: PRope = nil + var nilCheck: Rope = nil var t = skipTypes(a.t, abstractInst) while t.kind in {tyVar, tyPtr, tyRef}: if t.kind != tyVar: nilCheck = r @@ -1250,7 +1268,7 @@ proc genOf(p: BProc, x: PNode, typ: PType, d: var TLoc) = t = skipTypes(t.lastSon, typedescInst) if not p.module.compileToCpp: while t.kind == tyObject and t.sons[0] != nil: - app(r, ~".Sup") + add(r, ~".Sup") t = skipTypes(t.sons[0], typedescInst) if isObjLackingTypeField(t): globalError(x.info, errGenerated, @@ -1291,13 +1309,13 @@ proc genRepr(p: BProc, e: PNode, d: var TLoc) = var b: TLoc case a.t.kind of tyOpenArray, tyVarargs: - putIntoDest(p, b, e.typ, ropef("$1, $1Len0", [rdLoc(a)])) + putIntoDest(p, b, e.typ, "$1, $1Len0" % [rdLoc(a)]) of tyString, tySequence: putIntoDest(p, b, e.typ, - ropef("$1->data, $1->$2", [rdLoc(a), lenField(p)])) + "$1->data, $1->$2" % [rdLoc(a), lenField(p)]) of tyArray, tyArrayConstr: putIntoDest(p, b, e.typ, - ropef("$1, $2", [rdLoc(a), toRope(lengthOrd(a.t))])) + "$1, $2" % [rdLoc(a), rope(lengthOrd(a.t))]) else: internalError(e.sons[0].info, "genRepr()") putIntoDest(p, d, e.typ, ropecg(p.module, "#reprOpenArray($1, $2)", [rdLoc(b), @@ -1334,19 +1352,19 @@ proc genArrayLen(p: BProc, e: PNode, d: var TLoc, op: TMagic) = else: unaryExpr(p, e, d, "$1Len0") of tyCString: useStringh(p.module) - if op == mHigh: unaryExpr(p, e, d, "(strlen($1)-1)") - else: unaryExpr(p, e, d, "strlen($1)") + if op == mHigh: unaryExpr(p, e, d, "($1 ? (strlen($1)-1) : -1)") + else: unaryExpr(p, e, d, "($1 ? strlen($1) : 0)") of tyString, tySequence: if not p.module.compileToCpp: - if op == mHigh: unaryExpr(p, e, d, "($1->Sup.len-1)") - else: unaryExpr(p, e, d, "$1->Sup.len") + if op == mHigh: unaryExpr(p, e, d, "($1 ? ($1->Sup.len-1) : -1)") + else: unaryExpr(p, e, d, "($1 ? $1->Sup.len : 0)") else: - if op == mHigh: unaryExpr(p, e, d, "($1->len-1)") - else: unaryExpr(p, e, d, "$1->len") + if op == mHigh: unaryExpr(p, e, d, "($1 ? ($1->len-1) : -1)") + else: unaryExpr(p, e, d, "($1 ? $1->len : 0)") of tyArray, tyArrayConstr: # YYY: length(sideeffect) is optimized away incorrectly? - if op == mHigh: putIntoDest(p, d, e.typ, toRope(lastOrd(typ))) - else: putIntoDest(p, d, e.typ, toRope(lengthOrd(typ))) + if op == mHigh: putIntoDest(p, d, e.typ, rope(lastOrd(typ))) + else: putIntoDest(p, d, e.typ, rope(lengthOrd(typ))) else: internalError(e.info, "genArrayLen()") proc genSetLengthSeq(p: BProc, e: PNode, d: var TLoc) = @@ -1384,13 +1402,13 @@ proc genSwap(p: BProc, e: PNode, d: var TLoc) = genAssignment(p, a, b, {}) genAssignment(p, b, tmp, {}) -proc rdSetElemLoc(a: TLoc, setType: PType): PRope = +proc rdSetElemLoc(a: TLoc, setType: PType): Rope = # read a location of an set element; it may need a subtraction operation # before the set operation result = rdCharLoc(a) assert(setType.kind == tySet) if firstOrd(setType) != 0: - result = ropef("($1- $2)", [result, toRope(firstOrd(setType))]) + result = "($1- $2)" % [result, rope(firstOrd(setType))] proc fewCmps(s: PNode): bool = # this function estimates whether it is better to emit code @@ -1404,7 +1422,7 @@ proc fewCmps(s: PNode): bool = result = sonsLen(s) <= 8 # 8 seems to be a good value proc binaryExprIn(p: BProc, e: PNode, a, b, d: var TLoc, frmt: string) = - putIntoDest(p, d, e.typ, ropef(frmt, [rdLoc(a), rdSetElemLoc(b, a.t)])) + putIntoDest(p, d, e.typ, frmt % [rdLoc(a), rdSetElemLoc(b, a.t)]) proc genInExprAux(p: BProc, e: PNode, a, b, d: var TLoc) = case int(getSize(skipTypes(e.sons[1].typ, abstractVar))) @@ -1434,19 +1452,19 @@ proc genInOp(p: BProc, e: PNode, d: var TLoc) = e.sons[2] initLocExpr(p, ea, a) initLoc(b, locExpr, e.typ, OnUnknown) - b.r = toRope("(") + b.r = rope("(") var length = sonsLen(e.sons[1]) for i in countup(0, length - 1): if e.sons[1].sons[i].kind == nkRange: initLocExpr(p, e.sons[1].sons[i].sons[0], x) initLocExpr(p, e.sons[1].sons[i].sons[1], y) - appf(b.r, "$1 >= $2 && $1 <= $3", + addf(b.r, "$1 >= $2 && $1 <= $3", [rdCharLoc(a), rdCharLoc(x), rdCharLoc(y)]) else: initLocExpr(p, e.sons[1].sons[i], x) - appf(b.r, "$1 == $2", [rdCharLoc(a), rdCharLoc(x)]) - if i < length - 1: app(b.r, " || ") - app(b.r, ")") + addf(b.r, "$1 == $2", [rdCharLoc(a), rdCharLoc(x)]) + if i < length - 1: add(b.r, " || ") + add(b.r, ")") putIntoDest(p, d, e.typ, b.r) else: assert(e.sons[1].typ != nil) @@ -1502,7 +1520,7 @@ proc genSetOp(p: BProc, e: PNode, d: var TLoc, op: TMagic) = initLocExpr(p, e.sons[2], b) if d.k == locNone: getTemp(p, getSysType(tyBool), d) lineF(p, cpsStmts, lookupOpr[op], - [rdLoc(i), toRope(size), rdLoc(d), rdLoc(a), rdLoc(b)]) + [rdLoc(i), rope(size), rdLoc(d), rdLoc(a), rdLoc(b)]) of mEqSet: useStringh(p.module) binaryExprChar(p, e, d, "(memcmp($1, $2, " & $(size) & ")==0)") @@ -1515,8 +1533,8 @@ proc genSetOp(p: BProc, e: PNode, d: var TLoc, op: TMagic) = lineF(p, cpsStmts, "for ($1 = 0; $1 < $2; $1++) $n" & " $3[$1] = $4[$1] $6 $5[$1];$n", [ - rdLoc(i), toRope(size), rdLoc(d), rdLoc(a), rdLoc(b), - toRope(lookupOpr[op])]) + rdLoc(i), rope(size), rdLoc(d), rdLoc(a), rdLoc(b), + rope(lookupOpr[op])]) of mInSet: genInOp(p, e, d) else: internalError(e.info, "genSetOp") @@ -1533,14 +1551,14 @@ proc genSomeCast(p: BProc, e: PNode, d: var TLoc) = initLocExpr(p, e.sons[1], a) let etyp = skipTypes(e.typ, abstractRange) if etyp.kind in ValueTypes and lfIndirect notin a.flags: - putIntoDest(p, d, e.typ, ropef("(*($1*) ($2))", - [getTypeDesc(p.module, e.typ), addrLoc(a)])) + putIntoDest(p, d, e.typ, "(*($1*) ($2))" % + [getTypeDesc(p.module, e.typ), addrLoc(a)]) elif etyp.kind == tyProc and etyp.callConv == ccClosure: - putIntoDest(p, d, e.typ, ropef("(($1) ($2))", - [getClosureType(p.module, etyp, clHalfWithEnv), rdCharLoc(a)])) + putIntoDest(p, d, e.typ, "(($1) ($2))" % + [getClosureType(p.module, etyp, clHalfWithEnv), rdCharLoc(a)]) else: - putIntoDest(p, d, e.typ, ropef("(($1) ($2))", - [getTypeDesc(p.module, e.typ), rdCharLoc(a)])) + putIntoDest(p, d, e.typ, "(($1) ($2))" % + [getTypeDesc(p.module, e.typ), rdCharLoc(a)]) proc genCast(p: BProc, e: PNode, d: var TLoc) = const floatTypes = {tyFloat..tyFloat128} @@ -1550,9 +1568,9 @@ proc genCast(p: BProc, e: PNode, d: var TLoc) = if destt.kind in floatTypes or srct.kind in floatTypes: # 'cast' and some float type involved? --> use a union. inc(p.labels) - var lbl = p.labels.toRope + var lbl = p.labels.rope var tmp: TLoc - tmp.r = ropef("LOC$1.source", lbl) + tmp.r = "LOC$1.source" % [lbl] linefmt(p, cpsLocals, "union { $1 source; $2 dest; } LOC$3;$n", getTypeDesc(p.module, srct), getTypeDesc(p.module, destt), lbl) tmp.k = locExpr @@ -1560,7 +1578,7 @@ proc genCast(p: BProc, e: PNode, d: var TLoc) = tmp.s = OnStack tmp.flags = {} expr(p, e.sons[1], tmp) - putIntoDest(p, d, e.typ, ropef("LOC$#.dest", lbl)) + putIntoDest(p, d, e.typ, "LOC$#.dest" % [lbl]) else: # I prefer the shorter cast version for pointer types -> generate less # C code; plus it's the right thing to do for closures: @@ -1572,16 +1590,14 @@ proc genRangeChck(p: BProc, n: PNode, d: var TLoc, magic: string) = # range checks for unsigned turned out to be buggy and annoying: if optRangeCheck notin p.options or dest.kind in {tyUInt..tyUInt64}: initLocExpr(p, n.sons[0], a) - putIntoDest(p, d, n.typ, ropef("(($1) ($2))", - [getTypeDesc(p.module, dest), rdCharLoc(a)])) + putIntoDest(p, d, n.typ, "(($1) ($2))" % + [getTypeDesc(p.module, dest), rdCharLoc(a)]) else: initLocExpr(p, n.sons[0], a) - if leValue(n.sons[2], n.sons[1]): - internalError(n.info, "range check will always fail; empty range") putIntoDest(p, d, dest, ropecg(p.module, "(($1)#$5($2, $3, $4))", [ getTypeDesc(p.module, dest), rdCharLoc(a), genLiteral(p, n.sons[1], dest), genLiteral(p, n.sons[2], dest), - toRope(magic)])) + rope(magic)])) proc genConv(p: BProc, e: PNode, d: var TLoc) = let destType = e.typ.skipTypes({tyVar, tyGenericInst}) @@ -1593,8 +1609,7 @@ proc genConv(p: BProc, e: PNode, d: var TLoc) = proc convStrToCStr(p: BProc, n: PNode, d: var TLoc) = var a: TLoc initLocExpr(p, n.sons[0], a) - putIntoDest(p, d, skipTypes(n.typ, abstractVar), ropef("$1->data", - [rdLoc(a)])) + putIntoDest(p, d, skipTypes(n.typ, abstractVar), "$1->data" % [rdLoc(a)]) proc convCStrToStr(p: BProc, n: PNode, d: var TLoc) = var a: TLoc @@ -1629,7 +1644,7 @@ proc binaryFloatArith(p: BProc, e: PNode, d: var TLoc, m: TMagic) = initLocExpr(p, e.sons[1], a) initLocExpr(p, e.sons[2], b) putIntoDest(p, d, e.typ, rfmt(nil, "(($4)($2) $1 ($4)($3))", - toRope(opr[m]), rdLoc(a), rdLoc(b), + rope(opr[m]), rdLoc(a), rdLoc(b), getSimpleTypeDesc(p.module, e[1].typ))) if optNaNCheck in p.options: linefmt(p, cpsStmts, "#nanCheck($1);$n", rdLoc(d)) @@ -1639,7 +1654,7 @@ proc binaryFloatArith(p: BProc, e: PNode, d: var TLoc, m: TMagic) = binaryArith(p, e, d, m) proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = - var line, filen: PRope + var line, filen: Rope case op of mOr, mAnd: genAndOr(p, e, d, op) of mNot..mToBiggestInt: unaryArith(p, e, d, op) @@ -1647,35 +1662,35 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = of mAddF64..mDivF64: binaryFloatArith(p, e, d, op) of mShrI..mXor: binaryArith(p, e, d, op) of mEqProc: genEqProc(p, e, d) - of mAddI..mModI64: binaryArithOverflow(p, e, d, op) + of mAddI..mPred: binaryArithOverflow(p, e, d, op) of mRepr: genRepr(p, e, d) of mGetTypeInfo: genGetTypeInfo(p, e, d) of mSwap: genSwap(p, e, d) of mUnaryLt: if optOverflowCheck notin p.options: unaryExpr(p, e, d, "($1 - 1)") else: unaryExpr(p, e, d, "#subInt($1, 1)") - of mPred: - # XXX: range checking? - if optOverflowCheck notin p.options: binaryExpr(p, e, d, "($1 - $2)") - else: binaryExpr(p, e, d, "#subInt($1, $2)") - of mSucc: - # XXX: range checking? - if optOverflowCheck notin p.options: binaryExpr(p, e, d, "($1 + $2)") - else: binaryExpr(p, e, d, "#addInt($1, $2)") - of mInc: - if optOverflowCheck notin p.options: - binaryStmt(p, e, d, "$1 += $2;$n") - elif skipTypes(e.sons[1].typ, abstractVar).kind == tyInt64: - binaryStmt(p, e, d, "$1 = #addInt64($1, $2);$n") - else: - binaryStmt(p, e, d, "$1 = #addInt($1, $2);$n") - of ast.mDec: - if optOverflowCheck notin p.options: - binaryStmt(p, e, d, "$1 -= $2;$n") - elif skipTypes(e.sons[1].typ, abstractVar).kind == tyInt64: - binaryStmt(p, e, d, "$1 = #subInt64($1, $2);$n") + of mInc, mDec: + const opr: array [mInc..mDec, string] = ["$1 += $2;$n", "$1 -= $2;$n"] + const fun64: array [mInc..mDec, string] = ["$# = #addInt64($#, $#);$n", + "$# = #subInt64($#, $#);$n"] + const fun: array [mInc..mDec, string] = ["$# = #addInt($#, $#);$n", + "$# = #subInt($#, $#);$n"] + let underlying = skipTypes(e.sons[1].typ, {tyGenericInst, tyVar, tyRange}) + if optOverflowCheck notin p.options or underlying.kind in {tyUInt..tyUInt64}: + binaryStmt(p, e, d, opr[op]) else: - binaryStmt(p, e, d, "$1 = #subInt($1, $2);$n") + var a, b: TLoc + assert(e.sons[1].typ != nil) + assert(e.sons[2].typ != nil) + initLocExpr(p, e.sons[1], a) + initLocExpr(p, e.sons[2], b) + + let ranged = skipTypes(e.sons[1].typ, {tyGenericInst, tyVar}) + let res = binaryArithOverflowRaw(p, ranged, a, b, + if underlying.kind == tyInt64: fun64[op] else: fun[op]) + putIntoDest(p, a, ranged, "($#)($#)" % [ + getTypeDesc(p.module, ranged), res]) + of mConStrStr: genStrConcat(p, e, d) of mAppendStrCh: binaryStmt(p, e, d, "$1 = #addChar($1, $2);$n") @@ -1701,12 +1716,16 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = of mNewSeq: genNewSeq(p, e) of mSizeOf: let t = e.sons[1].typ.skipTypes({tyTypeDesc}) - putIntoDest(p, d, e.typ, ropef("((NI)sizeof($1))", - [getTypeDesc(p.module, t)])) + putIntoDest(p, d, e.typ, "((NI)sizeof($1))" % [getTypeDesc(p.module, t)]) of mChr: genSomeCast(p, e, d) of mOrd: genOrd(p, e, d) of mLengthArray, mHigh, mLengthStr, mLengthSeq, mLengthOpenArray: genArrayLen(p, e, d, op) + of mXLenStr, mXLenSeq: + if not p.module.compileToCpp: + unaryExpr(p, e, d, "($1->Sup.len-1)") + else: + unaryExpr(p, e, d, "$1->len") of mGCref: unaryStmt(p, e, d, "#nimGCref($1);$n") of mGCunref: unaryStmt(p, e, d, "#nimGCunref($1);$n") of mSetLengthStr: genSetLengthStr(p, e, d) @@ -1718,14 +1737,12 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = mParseBiggestFloat: var opr = e.sons[0].sym if lfNoDecl notin opr.loc.flags: - discard cgsym(p.module, opr.loc.r.ropeToStr) + discard cgsym(p.module, $opr.loc.r) genCall(p, e, d) of mReset: genReset(p, e) of mEcho: genEcho(p, e[1].skipConv) of mArrToSeq: genArrToSeq(p, e, d) - of mNLen..mNError: - localError(e.info, errCannotGenerateCodeForX, e.sons[0].sym.name.s) - of mSlurp..mQuoteAst: + of mNLen..mNError, mSlurp..mQuoteAst: localError(e.info, errXMustBeCompileTime, e.sons[0].sym.name.s) of mSpawn: let n = lowerings.wrapProcForSpawn(p.module.module, e, e.typ, nil, nil) @@ -1739,19 +1756,20 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = initLocExpr(p, x, a) initLocExpr(p, e.sons[2], b) genDeepCopy(p, a, b) + of mDotDot: genCall(p, e, d) else: internalError(e.info, "genMagicExpr: " & $op) -proc genConstExpr(p: BProc, n: PNode): PRope +proc genConstExpr(p: BProc, n: PNode): Rope proc handleConstExpr(p: BProc, n: PNode, d: var TLoc): bool = if nfAllConst in n.flags and d.k == locNone and n.len > 0 and n.isDeepConstExpr: var t = getUniqueType(n.typ) discard getTypeDesc(p.module, t) # so that any fields are initialized var id = nodeTableTestOrSet(p.module.dataCache, n, gBackendId) - fillLoc(d, locData, t, con("TMP", toRope(id)), OnHeap) + fillLoc(d, locData, t, "TMP" & rope(id), OnHeap) if id == gBackendId: # expression not found in the cache: inc(gBackendId) - appf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", + addf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", [getTypeDesc(p.module, t), d.r, genConstExpr(p, n)]) result = true else: @@ -1813,13 +1831,12 @@ proc genTupleConstr(p: BProc, n: PNode, d: var TLoc) = var it = n.sons[i] if it.kind == nkExprColonExpr: it = it.sons[1] initLoc(rec, locExpr, it.typ, d.s) - rec.r = ropef("$1.Field$2", [rdLoc(d), toRope(i)]) + rec.r = "$1.Field$2" % [rdLoc(d), rope(i)] expr(p, it, rec) when false: initLoc(rec, locExpr, it.typ, d.s) if (t.n.sons[i].kind != nkSym): InternalError(n.info, "genTupleConstr") - rec.r = ropef("$1.$2", - [rdLoc(d), mangleRecFieldName(t.n.sons[i].sym, t)]) + rec.r = "$1.$2" % [rdLoc(d), mangleRecFieldName(t.n.sons[i].sym, t)] expr(p, it, rec) proc isConstClosure(n: PNode): bool {.inline.} = @@ -1831,8 +1848,8 @@ proc genClosure(p: BProc, n: PNode, d: var TLoc) = if isConstClosure(n): inc(p.labels) - var tmp = con("LOC", toRope(p.labels)) - appf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", + var tmp = "LOC" & rope(p.labels) + addf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", [getTypeDesc(p.module, n.typ), tmp, genConstExpr(p, n)]) putIntoDest(p, d, n.typ, tmp) else: @@ -1850,7 +1867,7 @@ proc genArrayConstr(p: BProc, n: PNode, d: var TLoc) = if d.k == locNone: getTemp(p, n.typ, d) for i in countup(0, sonsLen(n) - 1): initLoc(arr, locExpr, elemType(skipTypes(n.typ, abstractInst)), d.s) - arr.r = ropef("$1[$2]", [rdLoc(d), intLiteral(i)]) + arr.r = "$1[$2]" % [rdLoc(d), intLiteral(i)] expr(p, n.sons[i], arr) proc genComplexConst(p: BProc, sym: PSym, d: var TLoc) = @@ -1869,16 +1886,16 @@ proc upConv(p: BProc, n: PNode, d: var TLoc) = var dest = skipTypes(n.typ, abstractPtrs) if optObjCheck in p.options and not isObjLackingTypeField(dest): var r = rdLoc(a) - var nilCheck: PRope = nil + var nilCheck: Rope = nil var t = skipTypes(a.t, abstractInst) while t.kind in {tyVar, tyPtr, tyRef}: if t.kind != tyVar: nilCheck = r if t.kind != tyVar or not p.module.compileToCpp: - r = ropef("(*$1)", [r]) + r = "(*$1)" % [r] t = skipTypes(t.lastSon, abstractInst) if not p.module.compileToCpp: while t.kind == tyObject and t.sons[0] != nil: - app(r, ".Sup") + add(r, ".Sup") t = skipTypes(t.sons[0], abstractInst) if nilCheck != nil: linefmt(p, cpsStmts, "if ($1) #chckObj($2.m_type, $3);$n", @@ -1888,10 +1905,10 @@ proc upConv(p: BProc, n: PNode, d: var TLoc) = r, genTypeInfo(p.module, dest)) if n.sons[0].typ.kind != tyObject: putIntoDest(p, d, n.typ, - ropef("(($1) ($2))", [getTypeDesc(p.module, n.typ), rdLoc(a)])) + "(($1) ($2))" % [getTypeDesc(p.module, n.typ), rdLoc(a)]) else: - putIntoDest(p, d, n.typ, ropef("(*($1*) ($2))", - [getTypeDesc(p.module, dest), addrLoc(a)])) + putIntoDest(p, d, n.typ, "(*($1*) ($2))" % + [getTypeDesc(p.module, dest), addrLoc(a)]) proc downConv(p: BProc, n: PNode, d: var TLoc) = if p.module.compileToCpp: @@ -1908,10 +1925,10 @@ proc downConv(p: BProc, n: PNode, d: var TLoc) = var r = rdLoc(a) let isRef = skipTypes(arg.typ, abstractInst).kind in {tyRef, tyPtr, tyVar} if isRef: - app(r, "->Sup") + add(r, "->Sup") else: - app(r, ".Sup") - for i in countup(2, abs(inheritanceDiff(dest, src))): app(r, ".Sup") + add(r, ".Sup") + for i in countup(2, abs(inheritanceDiff(dest, src))): add(r, ".Sup") if isRef: # it can happen that we end up generating '&&x->Sup' here, so we pack # the '&x->Sup' into a temporary and then those address is taken @@ -1922,7 +1939,7 @@ proc downConv(p: BProc, n: PNode, d: var TLoc) = getTemp(p, n.typ, d) linefmt(p, cpsStmts, "$1 = &$2;$n", rdLoc(d), r) else: - r = con("&", r) + r = "&" & r putIntoDest(p, d, n.typ, r) else: putIntoDest(p, d, n.typ, r) @@ -1931,12 +1948,12 @@ proc exprComplexConst(p: BProc, n: PNode, d: var TLoc) = var t = getUniqueType(n.typ) discard getTypeDesc(p.module, t) # so that any fields are initialized var id = nodeTableTestOrSet(p.module.dataCache, n, gBackendId) - var tmp = con("TMP", toRope(id)) + var tmp = "TMP" & rope(id) if id == gBackendId: # expression not found in the cache: inc(gBackendId) - appf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", + addf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", [getTypeDesc(p.module, t), tmp, genConstExpr(p, n)]) if d.k == locNone: @@ -1950,7 +1967,7 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = var sym = n.sym case sym.kind of skMethod: - if sym.getBody.kind == nkEmpty or sfDispatcher in sym.flags: + if {sfDispatcher, sfForward} * sym.flags != {}: # we cannot produce code for the dispatcher yet: fillProcLoc(sym) genProcPrototype(p.module, sym) @@ -1971,7 +1988,7 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = else: genComplexConst(p, sym, d) of skEnumField: - putIntoDest(p, d, n.typ, toRope(sym.position)) + putIntoDest(p, d, n.typ, rope(sym.position)) of skVar, skForVar, skResult, skLet: if sfGlobal in sym.flags: genVarPrototype(p.module, sym) if sym.loc.r == nil or sym.loc.t == nil: @@ -1980,7 +1997,7 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = if sfThread in sym.flags: accessThreadLocalVar(p, sym) if emulatedThreadVars(): - putIntoDest(p, d, sym.loc.t, con("NimTV->", sym.loc.r)) + putIntoDest(p, d, sym.loc.t, "NimTV->" & sym.loc.r) else: putLocIntoDest(p, d, sym.loc) else: @@ -2123,42 +2140,42 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = of nkBreakState: genBreakState(p, n) else: internalError(n.info, "expr(" & $n.kind & "); unknown node kind") -proc genNamedConstExpr(p: BProc, n: PNode): PRope = +proc genNamedConstExpr(p: BProc, n: PNode): Rope = if n.kind == nkExprColonExpr: result = genConstExpr(p, n.sons[1]) else: result = genConstExpr(p, n) -proc genConstSimpleList(p: BProc, n: PNode): PRope = +proc genConstSimpleList(p: BProc, n: PNode): Rope = var length = sonsLen(n) - result = toRope("{") + result = rope("{") for i in countup(0, length - 2): - appf(result, "$1,$n", [genNamedConstExpr(p, n.sons[i])]) - if length > 0: app(result, genNamedConstExpr(p, n.sons[length - 1])) - appf(result, "}$n") + addf(result, "$1,$n", [genNamedConstExpr(p, n.sons[i])]) + if length > 0: add(result, genNamedConstExpr(p, n.sons[length - 1])) + addf(result, "}$n", []) -proc genConstSeq(p: BProc, n: PNode, t: PType): PRope = - var data = ropef("{{$1, $1}", n.len.toRope) +proc genConstSeq(p: BProc, n: PNode, t: PType): Rope = + var data = "{{$1, $1}" % [n.len.rope] if n.len > 0: # array part needs extra curlies: - data.app(", {") + data.add(", {") for i in countup(0, n.len - 1): - if i > 0: data.appf(",$n") - data.app genConstExpr(p, n.sons[i]) - data.app("}") - data.app("}") + if i > 0: data.addf(",$n", []) + data.add genConstExpr(p, n.sons[i]) + data.add("}") + data.add("}") inc(gBackendId) - result = con("CNSTSEQ", gBackendId.toRope) + result = "CNSTSEQ" & gBackendId.rope appcg(p.module, cfsData, "NIM_CONST struct {$n" & " #TGenericSeq Sup;$n" & " $1 data[$2];$n" & "} $3 = $4;$n", [ - getTypeDesc(p.module, t.sons[0]), n.len.toRope, result, data]) + getTypeDesc(p.module, t.sons[0]), n.len.rope, result, data]) - result = ropef("(($1)&$2)", [getTypeDesc(p.module, t), result]) + result = "(($1)&$2)" % [getTypeDesc(p.module, t), result] -proc genConstExpr(p: BProc, n: PNode): PRope = +proc genConstExpr(p: BProc, n: PNode): Rope = case n.kind of nkHiddenStdConv, nkHiddenSubConv: result = genConstExpr(p, n.sons[1]) diff --git a/compiler/ccgmerge.nim b/compiler/ccgmerge.nim index f4f837834..2a37257b6 100644 --- a/compiler/ccgmerge.nim +++ b/compiler/ccgmerge.nim @@ -45,29 +45,29 @@ const ] NimMergeEndMark = "/*\tNIM_merge_END:*/" -proc genSectionStart*(fs: TCFileSection): PRope = +proc genSectionStart*(fs: TCFileSection): Rope = if compilationCachePresent: - result = toRope(tnl) - app(result, "/*\t") - app(result, CFileSectionNames[fs]) - app(result, ":*/") - app(result, tnl) + result = rope(tnl) + add(result, "/*\t") + add(result, CFileSectionNames[fs]) + add(result, ":*/") + add(result, tnl) -proc genSectionEnd*(fs: TCFileSection): PRope = +proc genSectionEnd*(fs: TCFileSection): Rope = if compilationCachePresent: - result = toRope(NimMergeEndMark & tnl) + result = rope(NimMergeEndMark & tnl) -proc genSectionStart*(ps: TCProcSection): PRope = +proc genSectionStart*(ps: TCProcSection): Rope = if compilationCachePresent: - result = toRope(tnl) - app(result, "/*\t") - app(result, CProcSectionNames[ps]) - app(result, ":*/") - app(result, tnl) + result = rope(tnl) + add(result, "/*\t") + add(result, CProcSectionNames[ps]) + add(result, ":*/") + add(result, tnl) -proc genSectionEnd*(ps: TCProcSection): PRope = +proc genSectionEnd*(ps: TCProcSection): Rope = if compilationCachePresent: - result = toRope(NimMergeEndMark & tnl) + result = rope(NimMergeEndMark & tnl) proc writeTypeCache(a: TIdTable, s: var string) = var i = 0 @@ -79,7 +79,7 @@ proc writeTypeCache(a: TIdTable, s: var string) = s.add(' ') encodeVInt(id, s) s.add(':') - encodeStr(PRope(value).ropeToStr, s) + encodeStr($Rope(value), s) inc i s.add('}') @@ -94,8 +94,8 @@ proc writeIntSet(a: IntSet, s: var string) = encodeVInt(x, s) inc i s.add('}') - -proc genMergeInfo*(m: BModule): PRope = + +proc genMergeInfo*(m: BModule): Rope = if optSymbolFiles notin gGlobalOptions: return nil var s = "/*\tNIM_merge_INFO:" s.add(tnl) @@ -111,9 +111,9 @@ proc genMergeInfo*(m: BModule): PRope = encodeVInt(ord(m.frameDeclared), s) s.add(tnl) s.add("*/") - result = s.toRope + result = s.rope -template `^`(pos: expr): expr = L.buf[pos] +template `^`(pos: int): expr = L.buf[pos] proc skipWhite(L: var TBaseLexer) = var pos = L.bufpos @@ -132,7 +132,7 @@ proc skipUntilCmd(L: var TBaseLexer) = of CR: pos = nimlexbase.handleCR(L, pos) of LF: pos = nimlexbase.handleLF(L, pos) of '\0': break - of '/': + of '/': if ^(pos+1) == '*' and ^(pos+2) == '\t': inc pos, 3 break @@ -145,7 +145,7 @@ proc atEndMark(buf: cstring, pos: int): bool = while s < NimMergeEndMark.len and buf[pos+s] == NimMergeEndMark[s]: inc s result = s == NimMergeEndMark.len -proc readVerbatimSection(L: var TBaseLexer): PRope = +proc readVerbatimSection(L: var TBaseLexer): Rope = var pos = L.bufpos var buf = L.buf var r = newStringOfCap(30_000) @@ -162,14 +162,14 @@ proc readVerbatimSection(L: var TBaseLexer): PRope = of '\0': internalError("ccgmerge: expected: " & NimMergeEndMark) break - else: + else: if atEndMark(buf, pos): inc pos, NimMergeEndMark.len break r.add(buf[pos]) inc pos L.bufpos = pos - result = r.toRope + result = r.rope proc readKey(L: var TBaseLexer, result: var string) = var pos = L.bufpos @@ -181,7 +181,7 @@ proc readKey(L: var TBaseLexer, result: var string) = if buf[pos] != ':': internalError("ccgmerge: ':' expected") L.bufpos = pos + 1 # skip ':' -proc newFakeType(id: int): PType = +proc newFakeType(id: int): PType = new(result) result.id = id @@ -197,7 +197,7 @@ proc readTypeCache(L: var TBaseLexer, result: var TIdTable) = # XXX little hack: we create a "fake" type object with the correct Id # better would be to adapt the data structure to not even store the # object as key, but only the Id - idTablePut(result, newFakeType(key), value.toRope) + idTablePut(result, newFakeType(key), value.rope) inc L.bufpos proc readIntSet(L: var TBaseLexer, result: var IntSet) = @@ -227,8 +227,8 @@ proc processMergeInfo(L: var TBaseLexer, m: BModule) = when not defined(nimhygiene): {.pragma: inject.} - -template withCFile(cfilename: string, body: stmt) {.immediate.} = + +template withCFile(cfilename: string, body: stmt) {.immediate.} = var s = llStreamOpen(cfilename, fmRead) if s == nil: return var L {.inject.}: TBaseLexer @@ -239,7 +239,7 @@ template withCFile(cfilename: string, body: stmt) {.immediate.} = if ^L.bufpos == '\0': break body closeBaseLexer(L) - + proc readMergeInfo*(cfilename: string, m: BModule) = ## reads the merge meta information into `m`. withCFile(cfilename): @@ -257,7 +257,7 @@ proc readMergeSections(cfilename: string, m: var TMergeSections) = ## reads the merge sections into `m`. withCFile(cfilename): readKey(L, k) - if k == "NIM_merge_INFO": + if k == "NIM_merge_INFO": discard elif ^L.bufpos == '*' and ^(L.bufpos+1) == '/': inc(L.bufpos, 2) @@ -280,19 +280,19 @@ proc readMergeSections(cfilename: string, m: var TMergeSections) = proc mergeRequired*(m: BModule): bool = for i in cfsHeaders..cfsProcs: if m.s[i] != nil: - #echo "not empty: ", i, " ", ropeToStr(m.s[i]) + #echo "not empty: ", i, " ", m.s[i] return true for i in low(TCProcSection)..high(TCProcSection): - if m.initProc.s(i) != nil: - #echo "not empty: ", i, " ", ropeToStr(m.initProc.s[i]) + if m.initProc.s(i) != nil: + #echo "not empty: ", i, " ", m.initProc.s[i] return true proc mergeFiles*(cfilename: string, m: BModule) = ## merges the C file with the old version on hard disc. var old: TMergeSections readMergeSections(cfilename, old) - # do the merge; old section before new section: + # do the merge; old section before new section: for i in low(TCFileSection)..high(TCFileSection): - m.s[i] = con(old.f[i], m.s[i]) + m.s[i] = old.f[i] & m.s[i] for i in low(TCProcSection)..high(TCProcSection): - m.initProc.s(i) = con(old.p[i], m.initProc.s(i)) + m.initProc.s(i) = old.p[i] & m.initProc.s(i) diff --git a/compiler/ccgstmts.nim b/compiler/ccgstmts.nim index a4938c9ac..c1e6b01ae 100644 --- a/compiler/ccgstmts.nim +++ b/compiler/ccgstmts.nim @@ -33,7 +33,7 @@ proc isAssignedImmediately(n: PNode): bool {.inline.} = return false result = true -proc genVarTuple(p: BProc, n: PNode) = +proc genVarTuple(p: BProc, n: PNode) = var tup, field: TLoc if n.kind != nkVarTuple: internalError(n.info, "genVarTuple") var L = sonsLen(n) @@ -49,7 +49,7 @@ proc genVarTuple(p: BProc, n: PNode) = genLineDir(p, n) initLocExpr(p, n.sons[L-1], tup) var t = tup.t.getUniqueType - for i in countup(0, L-3): + for i in countup(0, L-3): var v = n.sons[i].sym if sfCompileTime in v.flags: continue if sfGlobal in v.flags: @@ -60,12 +60,11 @@ proc genVarTuple(p: BProc, n: PNode) = assignLocalVar(p, v) initLocalVar(p, v, immediateAsgn=isAssignedImmediately(n[L-1])) initLoc(field, locExpr, t.sons[i], tup.s) - if t.kind == tyTuple: - field.r = ropef("$1.Field$2", [rdLoc(tup), toRope(i)]) - else: + if t.kind == tyTuple: + field.r = "$1.Field$2" % [rdLoc(tup), rope(i)] + else: if t.n.sons[i].kind != nkSym: internalError(n.info, "genVarTuple") - field.r = ropef("$1.$2", - [rdLoc(tup), mangleRecFieldName(t.n.sons[i].sym, t)]) + field.r = "$1.$2" % [rdLoc(tup), mangleRecFieldName(t.n.sons[i].sym, t)] putLocIntoDest(p, v.loc, field) proc genDeref(p: BProc, e: PNode, d: var TLoc; enforceDeref=false) @@ -86,8 +85,8 @@ proc loadInto(p: BProc, le, ri: PNode, a: var TLoc) {.inline.} = else: expr(p, ri, a) -proc startBlock(p: BProc, start: TFormatStr = "{$n", - args: varargs[PRope]): int {.discardable.} = +proc startBlock(p: BProc, start: FormatStr = "{$n", + args: varargs[Rope]): int {.discardable.} = lineCg(p, cpsStmts, start, args) inc(p.labels) result = len(p.blocks) @@ -96,35 +95,35 @@ proc startBlock(p: BProc, start: TFormatStr = "{$n", p.blocks[result].nestedTryStmts = p.nestedTryStmts.len.int16 p.blocks[result].nestedExceptStmts = p.inExceptBlock.int16 -proc assignLabel(b: var TBlock): PRope {.inline.} = - b.label = con("LA", b.id.toRope) +proc assignLabel(b: var TBlock): Rope {.inline.} = + b.label = "LA" & b.id.rope result = b.label -proc blockBody(b: var TBlock): PRope = +proc blockBody(b: var TBlock): Rope = result = b.sections[cpsLocals] if b.frameLen > 0: - result.appf("F.len+=$1;$n", b.frameLen.toRope) - result.app(b.sections[cpsInit]) - result.app(b.sections[cpsStmts]) + result.addf("F.len+=$1;$n", [b.frameLen.rope]) + result.add(b.sections[cpsInit]) + result.add(b.sections[cpsStmts]) -proc endBlock(p: BProc, blockEnd: PRope) = +proc endBlock(p: BProc, blockEnd: Rope) = let topBlock = p.blocks.len-1 # the block is merged into the parent block - app(p.blocks[topBlock-1].sections[cpsStmts], p.blocks[topBlock].blockBody) + add(p.blocks[topBlock-1].sections[cpsStmts], p.blocks[topBlock].blockBody) setLen(p.blocks, topBlock) # this is done after the block is popped so $n is # properly indented when pretty printing is enabled line(p, cpsStmts, blockEnd) proc endBlock(p: BProc) = - let topBlock = p.blocks.len - 1 + let topBlock = p.blocks.len - 1 var blockEnd = if p.blocks[topBlock].label != nil: rfmt(nil, "} $1: ;$n", p.blocks[topBlock].label) else: ~"}$n" let frameLen = p.blocks[topBlock].frameLen if frameLen > 0: - blockEnd.appf("F.len-=$1;$n", frameLen.toRope) + blockEnd.addf("F.len-=$1;$n", [frameLen.rope]) endBlock(p, blockEnd) proc genSimpleBlock(p: BProc, stmts: PNode) {.inline.} = @@ -145,7 +144,7 @@ template preserveBreakIdx(body: stmt): stmt {.immediate.} = proc genState(p: BProc, n: PNode) = internalAssert n.len == 1 and n.sons[0].kind == nkIntLit let idx = n.sons[0].intVal - linefmt(p, cpsStmts, "STATE$1: ;$n", idx.toRope) + linefmt(p, cpsStmts, "STATE$1: ;$n", idx.rope) proc genGotoState(p: BProc, n: PNode) = # we resist the temptation to translate it into duff's device as it later @@ -159,7 +158,7 @@ proc genGotoState(p: BProc, n: PNode) = p.beforeRetNeeded = true lineF(p, cpsStmts, "case -1: goto BeforeRet;$n", []) for i in 0 .. lastOrd(n.sons[0].typ): - lineF(p, cpsStmts, "case $1: goto STATE$1;$n", [toRope(i)]) + lineF(p, cpsStmts, "case $1: goto STATE$1;$n", [rope(i)]) lineF(p, cpsStmts, "}$n", []) proc genBreakState(p: BProc, n: PNode) = @@ -176,9 +175,18 @@ proc genBreakState(p: BProc, n: PNode) = proc genVarPrototypeAux(m: BModule, sym: PSym) +proc genGotoVar(p: BProc; value: PNode) = + if value.kind notin {nkCharLit..nkUInt64Lit}: + localError(value.info, "'goto' target must be a literal value") + else: + lineF(p, cpsStmts, "goto NIMSTATE_$#;$n", [value.intVal.rope]) + proc genSingleVar(p: BProc, a: PNode) = var v = a.sons[0].sym - if sfCompileTime in v.flags: return + if {sfCompileTime, sfGoto} * v.flags != {}: + # translate 'var state {.goto.} = X' into 'goto LX': + if sfGoto in v.flags: genGotoVar(p, a.sons[2]) + return var targetProc = p if sfGlobal in v.flags: if v.flags * {sfImportc, sfExportc} == {sfImportc} and @@ -190,10 +198,10 @@ proc genSingleVar(p: BProc, a: PNode) = targetProc = p.module.preInitProc assignGlobalVar(targetProc, v) # XXX: be careful here. - # Global variables should not be zeromem-ed within loops + # Global variables should not be zeromem-ed within loops # (see bug #20). # That's why we are doing the construction inside the preInitProc. - # genObjectInit relies on the C runtime's guarantees that + # genObjectInit relies on the C runtime's guarantees that # global variables will be initialized to zero. genObjectInit(p.module.preInitProc, cpsInit, v.typ, v.loc, true) # Alternative construction using default constructor (which may zeromem): @@ -202,7 +210,8 @@ proc genSingleVar(p: BProc, a: PNode) = genVarPrototypeAux(generatedHeader, v) registerGcRoot(p, v) else: - let imm = isAssignedImmediately(a.sons[2]) + let value = a.sons[2] + let imm = isAssignedImmediately(value) if imm and p.module.compileToCpp and p.splitDecls == 0 and not containsHiddenPointer(v.typ): # C++ really doesn't like things like 'Foo f; f = x' as that invokes a @@ -211,8 +220,19 @@ proc genSingleVar(p: BProc, a: PNode) = genLineDir(p, a) let decl = localVarDecl(p, v) var tmp: TLoc - initLocExprSingleUse(p, a.sons[2], tmp) - lineF(p, cpsStmts, "$# = $#;$n", decl, tmp.rdLoc) + if value.kind in nkCallKinds and value[0].kind == nkSym and + sfConstructor in value[0].sym.flags: + var params: Rope + let typ = skipTypes(value.sons[0].typ, abstractInst) + assert(typ.kind == tyProc) + for i in 1.. <value.len: + if params != nil: params.add(~", ") + assert(sonsLen(typ) == sonsLen(typ.n)) + add(params, genOtherArg(p, value, i, typ)) + lineF(p, cpsStmts, "$#($#);$n", [decl, params]) + else: + initLocExprSingleUse(p, value, tmp) + lineF(p, cpsStmts, "$# = $#;$n", [decl, tmp.rdLoc]) return assignLocalVar(p, v) initLocalVar(p, v, imm) @@ -229,10 +249,10 @@ proc genClosureVar(p: BProc, a: PNode) = genLineDir(p, a) loadInto(p, a.sons[0], a.sons[2], v) -proc genVarStmt(p: BProc, n: PNode) = - for i in countup(0, sonsLen(n) - 1): +proc genVarStmt(p: BProc, n: PNode) = + for i in countup(0, sonsLen(n) - 1): var a = n.sons[i] - if a.kind == nkCommentStmt: continue + if a.kind == nkCommentStmt: continue if a.kind == nkIdentDefs: # can be a lifted var nowadays ... if a.sons[0].kind == nkSym: @@ -242,12 +262,12 @@ proc genVarStmt(p: BProc, n: PNode) = else: genVarTuple(p, a) -proc genConstStmt(p: BProc, t: PNode) = - for i in countup(0, sonsLen(t) - 1): +proc genConstStmt(p: BProc, t: PNode) = + for i in countup(0, sonsLen(t) - 1): var it = t.sons[i] - if it.kind == nkCommentStmt: continue + if it.kind == nkCommentStmt: continue if it.kind != nkConstDef: internalError(t.info, "genConstStmt") - var c = it.sons[0].sym + var c = it.sons[0].sym if c.typ.containsCompileTimeOnly: continue if sfFakeConst in c.flags: genSingleVar(p, it) @@ -274,9 +294,9 @@ proc genIf(p: BProc, n: PNode, d: var TLoc) = getTemp(p, n.typ, d) genLineDir(p, n) let lend = getLabel(p) - for i in countup(0, sonsLen(n) - 1): + for i in countup(0, sonsLen(n) - 1): let it = n.sons[i] - if it.len == 2: + if it.len == 2: when newScopeForIf: startBlock(p) initLocExprSingleUse(p, it.sons[0], a) lelse = getLabel(p) @@ -286,9 +306,9 @@ proc genIf(p: BProc, n: PNode, d: var TLoc) = when not newScopeForIf: startBlock(p) if p.module.compileToCpp: # avoid "jump to label crosses initialization" error: - app(p.s(cpsStmts), "{") + add(p.s(cpsStmts), "{") expr(p, it.sons[1], d) - app(p.s(cpsStmts), "}") + add(p.s(cpsStmts), "}") else: expr(p, it.sons[1], d) endBlock(p) @@ -303,13 +323,13 @@ proc genIf(p: BProc, n: PNode, d: var TLoc) = if sonsLen(n) > 1: fixLabel(p, lend) -proc blockLeaveActions(p: BProc, howManyTrys, howManyExcepts: int) = +proc blockLeaveActions(p: BProc, howManyTrys, howManyExcepts: int) = # Called by return and break stmts. # Deals with issues faced when jumping out of try/except/finally stmts, var stack: seq[PNode] newSeq(stack, 0) - + var alreadyPoppedCnt = p.inExceptBlock for i in countup(1, howManyTrys): if not p.module.compileToCpp: @@ -327,11 +347,11 @@ proc blockLeaveActions(p: BProc, howManyTrys, howManyExcepts: int) = # Find finally-stmt for this try-stmt # and generate a copy of its sons var finallyStmt = lastSon(tryStmt) - if finallyStmt.kind == nkFinally: + if finallyStmt.kind == nkFinally: genStmts(p, finallyStmt.sons[0]) # push old elements again: - for i in countdown(howManyTrys-1, 0): + for i in countdown(howManyTrys-1, 0): p.nestedTryStmts.add(stack[i]) if not p.module.compileToCpp: @@ -344,16 +364,29 @@ proc genReturnStmt(p: BProc, t: PNode) = p.beforeRetNeeded = true genLineDir(p, t) if (t.sons[0].kind != nkEmpty): genStmts(p, t.sons[0]) - blockLeaveActions(p, + blockLeaveActions(p, howManyTrys = p.nestedTryStmts.len, howManyExcepts = p.inExceptBlock) if (p.finallySafePoints.len > 0): # If we're in a finally block, and we came here by exception # consume it before we return. var safePoint = p.finallySafePoints[p.finallySafePoints.len-1] - linefmt(p, cpsStmts, "if ($1.status != 0) #popCurrentException();$n", safePoint) + linefmt(p, cpsStmts, "if ($1.status != 0) #popCurrentException();$n", safePoint) lineF(p, cpsStmts, "goto BeforeRet;$n", []) +proc genGotoForCase(p: BProc; caseStmt: PNode) = + for i in 1 .. <caseStmt.len: + startBlock(p) + let it = caseStmt.sons[i] + for j in 0 .. it.len-2: + if it.sons[j].kind == nkRange: + localError(it.info, "range notation not available for computed goto") + return + let val = getOrdValue(it.sons[j]) + lineF(p, cpsStmts, "NIMSTATE_$#:$n", [val.rope]) + genStmts(p, it.lastSon) + endBlock(p) + proc genComputedGoto(p: BProc; n: PNode) = # first pass: Generate array of computed labels: var casePos = -1 @@ -377,17 +410,17 @@ proc genComputedGoto(p: BProc; n: PNode) = localError(n.info, "no case statement found for computed goto"); return var id = p.labels+1 inc p.labels, arraySize+1 - let tmp = ropef("TMP$1", id.toRope) - var gotoArray = ropef("static void* $#[$#] = {", tmp, arraySize.toRope) + let tmp = "TMP$1" % [id.rope] + var gotoArray = "static void* $#[$#] = {" % [tmp, arraySize.rope] for i in 1..arraySize-1: - gotoArray.appf("&&TMP$#, ", (id+i).toRope) - gotoArray.appf("&&TMP$#};$n", (id+arraySize).toRope) + gotoArray.addf("&&TMP$#, ", [(id+i).rope]) + gotoArray.addf("&&TMP$#};$n", [(id+arraySize).rope]) line(p, cpsLocals, gotoArray) let topBlock = p.blocks.len-1 let oldBody = p.blocks[topBlock].sections[cpsStmts] p.blocks[topBlock].sections[cpsStmts] = nil - + for j in casePos+1 .. <n.len: genStmts(p, n.sons[j]) let tailB = p.blocks[topBlock].sections[cpsStmts] @@ -395,14 +428,14 @@ proc genComputedGoto(p: BProc; n: PNode) = for j in 0 .. casePos-1: genStmts(p, n.sons[j]) let tailA = p.blocks[topBlock].sections[cpsStmts] - p.blocks[topBlock].sections[cpsStmts] = oldBody.con(tailA) + p.blocks[topBlock].sections[cpsStmts] = oldBody & tailA let caseStmt = n.sons[casePos] var a: TLoc initLocExpr(p, caseStmt.sons[0], a) # first goto: - lineF(p, cpsStmts, "goto *$#[$#];$n", tmp, a.rdLoc) - + lineF(p, cpsStmts, "goto *$#[$#];$n", [tmp, a.rdLoc]) + for i in 1 .. <caseStmt.len: startBlock(p) let it = caseStmt.sons[i] @@ -411,22 +444,22 @@ proc genComputedGoto(p: BProc; n: PNode) = localError(it.info, "range notation not available for computed goto") return let val = getOrdValue(it.sons[j]) - lineF(p, cpsStmts, "TMP$#:$n", intLiteral(val+id+1)) + lineF(p, cpsStmts, "TMP$#:$n", [intLiteral(val+id+1)]) genStmts(p, it.lastSon) #for j in casePos+1 .. <n.len: genStmts(p, n.sons[j]) # tailB #for j in 0 .. casePos-1: genStmts(p, n.sons[j]) # tailA - app(p.s(cpsStmts), tailB) - app(p.s(cpsStmts), tailA) + add(p.s(cpsStmts), tailB) + add(p.s(cpsStmts), tailA) var a: TLoc initLocExpr(p, caseStmt.sons[0], a) - lineF(p, cpsStmts, "goto *$#[$#];$n", tmp, a.rdLoc) + lineF(p, cpsStmts, "goto *$#[$#];$n", [tmp, a.rdLoc]) endBlock(p) proc genWhileStmt(p: BProc, t: PNode) = # we don't generate labels here as for example GCC would produce # significantly worse code - var + var a: TLoc labl: TLabel assert(sonsLen(t) == 2) @@ -437,7 +470,7 @@ proc genWhileStmt(p: BProc, t: PNode) = p.breakIdx = startBlock(p, "while (1) {$n") p.blocks[p.breakIdx].isLoop = true initLocExpr(p, t.sons[0], a) - if (t.sons[0].kind != nkIntLit) or (t.sons[0].intVal == 0): + if (t.sons[0].kind != nkIntLit) or (t.sons[0].intVal == 0): let label = assignLabel(p.blocks[p.breakIdx]) lineF(p, cpsStmts, "if (!$1) goto $2;$n", [rdLoc(a), label]) var loopBody = t.sons[1] @@ -483,23 +516,23 @@ proc genParForStmt(p: BProc, t: PNode) = let call = t.sons[1] initLocExpr(p, call.sons[1], rangeA) initLocExpr(p, call.sons[2], rangeB) - + lineF(p, cpsStmts, "#pragma omp parallel for $4$n" & - "for ($1 = $2; $1 <= $3; ++$1)", - forLoopVar.loc.rdLoc, + "for ($1 = $2; $1 <= $3; ++$1)", + [forLoopVar.loc.rdLoc, rangeA.rdLoc, rangeB.rdLoc, - call.sons[3].getStr.toRope) - + call.sons[3].getStr.rope]) + p.breakIdx = startBlock(p) p.blocks[p.breakIdx].isLoop = true genStmts(p, t.sons[2]) endBlock(p) dec(p.withinLoop) - -proc genBreakStmt(p: BProc, t: PNode) = + +proc genBreakStmt(p: BProc, t: PNode) = var idx = p.breakIdx - if t.sons[0].kind != nkEmpty: + if t.sons[0].kind != nkEmpty: # named break? assert(t.sons[0].kind == nkSym) var sym = t.sons[0].sym @@ -511,13 +544,13 @@ proc genBreakStmt(p: BProc, t: PNode) = if idx < 0 or not p.blocks[idx].isLoop: internalError(t.info, "no loop to break") let label = assignLabel(p.blocks[idx]) - blockLeaveActions(p, + blockLeaveActions(p, p.nestedTryStmts.len - p.blocks[idx].nestedTryStmts, p.inExceptBlock - p.blocks[idx].nestedExceptStmts) genLineDir(p, t) lineF(p, cpsStmts, "goto $1;$n", [label]) -proc getRaiseFrmt(p: BProc): string = +proc getRaiseFrmt(p: BProc): string = if p.module.compileToCpp: result = "throw NimException($1, $2);$n" elif getCompilerProc("Exception") != nil: @@ -532,7 +565,7 @@ proc genRaiseStmt(p: BProc, t: PNode) = var finallyBlock = p.nestedTryStmts[p.nestedTryStmts.len - 1].lastSon if finallyBlock.kind == nkFinally: genSimpleBlock(p, finallyBlock.sons[0]) - if t.sons[0].kind != nkEmpty: + if t.sons[0].kind != nkEmpty: var a: TLoc initLocExpr(p, t.sons[0], a) var e = rdLoc(a) @@ -547,26 +580,26 @@ proc genRaiseStmt(p: BProc, t: PNode) = else: linefmt(p, cpsStmts, "#reraiseException();$n") -proc genCaseGenericBranch(p: BProc, b: PNode, e: TLoc, - rangeFormat, eqFormat: TFormatStr, labl: TLabel) = - var +proc genCaseGenericBranch(p: BProc, b: PNode, e: TLoc, + rangeFormat, eqFormat: FormatStr, labl: TLabel) = + var x, y: TLoc var length = sonsLen(b) - for i in countup(0, length - 2): - if b.sons[i].kind == nkRange: + for i in countup(0, length - 2): + if b.sons[i].kind == nkRange: initLocExpr(p, b.sons[i].sons[0], x) initLocExpr(p, b.sons[i].sons[1], y) - lineCg(p, cpsStmts, rangeFormat, + lineCg(p, cpsStmts, rangeFormat, [rdCharLoc(e), rdCharLoc(x), rdCharLoc(y), labl]) - else: + else: initLocExpr(p, b.sons[i], x) lineCg(p, cpsStmts, eqFormat, [rdCharLoc(e), rdCharLoc(x), labl]) -proc genCaseSecondPass(p: BProc, t: PNode, d: var TLoc, - labId, until: int): TLabel = +proc genCaseSecondPass(p: BProc, t: PNode, d: var TLoc, + labId, until: int): TLabel = var lend = getLabel(p) for i in 1..until: - lineF(p, cpsStmts, "LA$1: ;$n", [toRope(labId + i)]) + lineF(p, cpsStmts, "LA$1: ;$n", [rope(labId + i)]) if t.sons[i].kind == nkOfBranch: var length = sonsLen(t.sons[i]) exprBlock(p, t.sons[i].sons[length - 1], d) @@ -576,7 +609,7 @@ proc genCaseSecondPass(p: BProc, t: PNode, d: var TLoc, result = lend proc genIfForCaseUntil(p: BProc, t: PNode, d: var TLoc, - rangeFormat, eqFormat: TFormatStr, + rangeFormat, eqFormat: FormatStr, until: int, a: TLoc): TLabel = # generate a C-if statement for a Nim case statement var labId = p.labels @@ -584,35 +617,35 @@ proc genIfForCaseUntil(p: BProc, t: PNode, d: var TLoc, inc(p.labels) if t.sons[i].kind == nkOfBranch: # else statement genCaseGenericBranch(p, t.sons[i], a, rangeFormat, eqFormat, - con("LA", toRope(p.labels))) + "LA" & rope(p.labels)) else: - lineF(p, cpsStmts, "goto LA$1;$n", [toRope(p.labels)]) + lineF(p, cpsStmts, "goto LA$1;$n", [rope(p.labels)]) if until < t.len-1: inc(p.labels) var gotoTarget = p.labels - lineF(p, cpsStmts, "goto LA$1;$n", [toRope(gotoTarget)]) + lineF(p, cpsStmts, "goto LA$1;$n", [rope(gotoTarget)]) result = genCaseSecondPass(p, t, d, labId, until) - lineF(p, cpsStmts, "LA$1: ;$n", [toRope(gotoTarget)]) + lineF(p, cpsStmts, "LA$1: ;$n", [rope(gotoTarget)]) else: result = genCaseSecondPass(p, t, d, labId, until) -proc genCaseGeneric(p: BProc, t: PNode, d: var TLoc, - rangeFormat, eqFormat: TFormatStr) = +proc genCaseGeneric(p: BProc, t: PNode, d: var TLoc, + rangeFormat, eqFormat: FormatStr) = var a: TLoc initLocExpr(p, t.sons[0], a) var lend = genIfForCaseUntil(p, t, d, rangeFormat, eqFormat, sonsLen(t)-1, a) fixLabel(p, lend) -proc genCaseStringBranch(p: BProc, b: PNode, e: TLoc, labl: TLabel, - branches: var openArray[PRope]) = +proc genCaseStringBranch(p: BProc, b: PNode, e: TLoc, labl: TLabel, + branches: var openArray[Rope]) = var x: TLoc var length = sonsLen(b) - for i in countup(0, length - 2): + for i in countup(0, length - 2): assert(b.sons[i].kind != nkRange) initLocExpr(p, b.sons[i], x) assert(b.sons[i].kind in {nkStrLit..nkTripleStrLit}) var j = int(hashString(b.sons[i].strVal) and high(branches)) - appcg(p.module, branches[j], "if (#eqStrings($1, $2)) goto $3;$n", + appcg(p.module, branches[j], "if (#eqStrings($1, $2)) goto $3;$n", [rdLoc(e), rdLoc(x), labl]) proc genStringCase(p: BProc, t: PNode, d: var TLoc) = @@ -622,40 +655,40 @@ proc genStringCase(p: BProc, t: PNode, d: var TLoc) = if t.sons[i].kind == nkOfBranch: inc(strings, sonsLen(t.sons[i]) - 1) if strings > stringCaseThreshold: var bitMask = math.nextPowerOfTwo(strings) - 1 - var branches: seq[PRope] + var branches: seq[Rope] newSeq(branches, bitMask + 1) var a: TLoc initLocExpr(p, t.sons[0], a) # fist pass: gnerate ifs+goto: var labId = p.labels - for i in countup(1, sonsLen(t) - 1): + for i in countup(1, sonsLen(t) - 1): inc(p.labels) - if t.sons[i].kind == nkOfBranch: - genCaseStringBranch(p, t.sons[i], a, con("LA", toRope(p.labels)), + if t.sons[i].kind == nkOfBranch: + genCaseStringBranch(p, t.sons[i], a, "LA" & rope(p.labels), branches) - else: + else: # else statement: nothing to do yet # but we reserved a label, which we use later discard - linefmt(p, cpsStmts, "switch (#hashString($1) & $2) {$n", - rdLoc(a), toRope(bitMask)) + linefmt(p, cpsStmts, "switch (#hashString($1) & $2) {$n", + rdLoc(a), rope(bitMask)) for j in countup(0, high(branches)): if branches[j] != nil: - lineF(p, cpsStmts, "case $1: $n$2break;$n", + lineF(p, cpsStmts, "case $1: $n$2break;$n", [intLiteral(j), branches[j]]) - lineF(p, cpsStmts, "}$n") # else statement: - if t.sons[sonsLen(t)-1].kind != nkOfBranch: - lineF(p, cpsStmts, "goto LA$1;$n", [toRope(p.labels)]) + lineF(p, cpsStmts, "}$n", []) # else statement: + if t.sons[sonsLen(t)-1].kind != nkOfBranch: + lineF(p, cpsStmts, "goto LA$1;$n", [rope(p.labels)]) # third pass: generate statements var lend = genCaseSecondPass(p, t, d, labId, sonsLen(t)-1) fixLabel(p, lend) else: genCaseGeneric(p, t, d, "", "if (#eqStrings($1, $2)) goto $3;$n") - -proc branchHasTooBigRange(b: PNode): bool = - for i in countup(0, sonsLen(b)-2): + +proc branchHasTooBigRange(b: PNode): bool = + for i in countup(0, sonsLen(b)-2): # last son is block if (b.sons[i].kind == nkRange) and - b.sons[i].sons[1].intVal - b.sons[i].sons[0].intVal > RangeExpandLimit: + b.sons[i].sons[1].intVal - b.sons[i].sons[0].intVal > RangeExpandLimit: return true proc ifSwitchSplitPoint(p: BProc, n: PNode): int = @@ -664,21 +697,21 @@ proc ifSwitchSplitPoint(p: BProc, n: PNode): int = var stmtBlock = lastSon(branch) if stmtBlock.stmtsContainPragma(wLinearScanEnd): result = i - elif hasSwitchRange notin CC[cCompiler].props: - if branch.kind == nkOfBranch and branchHasTooBigRange(branch): + elif hasSwitchRange notin CC[cCompiler].props: + if branch.kind == nkOfBranch and branchHasTooBigRange(branch): result = i proc genCaseRange(p: BProc, branch: PNode) = var length = branch.len - for j in 0 .. length-2: - if branch[j].kind == nkRange: - if hasSwitchRange in CC[cCompiler].props: + for j in 0 .. length-2: + if branch[j].kind == nkRange: + if hasSwitchRange in CC[cCompiler].props: lineF(p, cpsStmts, "case $1 ... $2:$n", [ - genLiteral(p, branch[j][0]), + genLiteral(p, branch[j][0]), genLiteral(p, branch[j][1])]) - else: + else: var v = copyNode(branch[j][0]) - while v.intVal <= branch[j][1].intVal: + while v.intVal <= branch[j][1].intVal: lineF(p, cpsStmts, "case $1:$n", [genLiteral(p, v)]) inc(v.intVal) else: @@ -687,53 +720,56 @@ proc genCaseRange(p: BProc, branch: PNode) = proc genOrdinalCase(p: BProc, n: PNode, d: var TLoc) = # analyse 'case' statement: var splitPoint = ifSwitchSplitPoint(p, n) - + # generate if part (might be empty): var a: TLoc initLocExpr(p, n.sons[0], a) var lend = if splitPoint > 0: genIfForCaseUntil(p, n, d, rangeFormat = "if ($1 >= $2 && $1 <= $3) goto $4;$n", - eqFormat = "if ($1 == $2) goto $3;$n", + eqFormat = "if ($1 == $2) goto $3;$n", splitPoint, a) else: nil - + # generate switch part (might be empty): if splitPoint+1 < n.len: lineF(p, cpsStmts, "switch ($1) {$n", [rdCharLoc(a)]) var hasDefault = false - for i in splitPoint+1 .. < n.len: + for i in splitPoint+1 .. < n.len: var branch = n[i] - if branch.kind == nkOfBranch: + if branch.kind == nkOfBranch: genCaseRange(p, branch) - else: + else: # else part of case statement: - lineF(p, cpsStmts, "default:$n") + lineF(p, cpsStmts, "default:$n", []) hasDefault = true exprBlock(p, branch.lastSon, d) - lineF(p, cpsStmts, "break;$n") - if (hasAssume in CC[cCompiler].props) and not hasDefault: - lineF(p, cpsStmts, "default: __assume(0);$n") - lineF(p, cpsStmts, "}$n") + lineF(p, cpsStmts, "break;$n", []) + if (hasAssume in CC[cCompiler].props) and not hasDefault: + lineF(p, cpsStmts, "default: __assume(0);$n", []) + lineF(p, cpsStmts, "}$n", []) if lend != nil: fixLabel(p, lend) - -proc genCase(p: BProc, t: PNode, d: var TLoc) = + +proc genCase(p: BProc, t: PNode, d: var TLoc) = genLineDir(p, t) if not isEmptyType(t.typ) and d.k == locNone: getTemp(p, t.typ, d) case skipTypes(t.sons[0].typ, abstractVarRange).kind of tyString: genStringCase(p, t, d) - of tyFloat..tyFloat128: - genCaseGeneric(p, t, d, "if ($1 >= $2 && $1 <= $3) goto $4;$n", + of tyFloat..tyFloat128: + genCaseGeneric(p, t, d, "if ($1 >= $2 && $1 <= $3) goto $4;$n", "if ($1 == $2) goto $3;$n") else: - genOrdinalCase(p, t, d) - -proc hasGeneralExceptSection(t: PNode): bool = + if t.sons[0].kind == nkSym and sfGoto in t.sons[0].sym.flags: + genGotoForCase(p, t) + else: + genOrdinalCase(p, t, d) + +proc hasGeneralExceptSection(t: PNode): bool = var length = sonsLen(t) var i = 1 - while (i < length) and (t.sons[i].kind == nkExceptBranch): + while (i < length) and (t.sons[i].kind == nkExceptBranch): var blen = sonsLen(t.sons[i]) - if blen == 1: + if blen == 1: return true inc(i) result = false @@ -762,7 +798,7 @@ proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = if not isEmptyType(t.typ) and d.k == locNone: getTemp(p, t.typ, d) var - exc: PRope + exc: Rope i, length, blen: int genLineDir(p, t) exc = getTempName() @@ -782,27 +818,27 @@ proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = var catchAllPresent = false while (i < length) and (t.sons[i].kind == nkExceptBranch): blen = sonsLen(t.sons[i]) - if i > 1: appf(p.s(cpsStmts), "else ") + if i > 1: addf(p.s(cpsStmts), "else ", []) if blen == 1: # general except section: catchAllPresent = true exprBlock(p, t.sons[i].sons[0], d) else: - var orExpr: PRope = nil + var orExpr: Rope = nil for j in countup(0, blen - 2): assert(t.sons[i].sons[j].kind == nkType) - if orExpr != nil: app(orExpr, "||") + if orExpr != nil: add(orExpr, "||") appcg(p.module, orExpr, "#isObj($1.exp->m_type, $2)", [exc, genTypeInfo(p.module, t.sons[i].sons[j].typ)]) lineF(p, cpsStmts, "if ($1) ", [orExpr]) exprBlock(p, t.sons[i].sons[blen-1], d) inc(i) - + # reraise the exception if there was no catch all # and none of the handlers matched if not catchAllPresent: - if i > 1: lineF(p, cpsStmts, "else ") + if i > 1: lineF(p, cpsStmts, "else ", []) startBlock(p) var finallyBlock = t.lastSon if finallyBlock.kind == nkFinally: @@ -811,15 +847,15 @@ proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = line(p, cpsStmts, ~"throw;$n") endBlock(p) - - lineF(p, cpsStmts, "}$n") # end of catch block + + lineF(p, cpsStmts, "}$n", []) # end of catch block dec p.inExceptBlock - + discard pop(p.nestedTryStmts) if (i < length) and (t.sons[i].kind == nkFinally): genSimpleBlock(p, t.sons[i].sons[0]) - -proc genTry(p: BProc, t: PNode, d: var TLoc) = + +proc genTry(p: BProc, t: PNode, d: var TLoc) = # code to generate: # # XXX: There should be a standard dispatch algorithm @@ -841,7 +877,7 @@ proc genTry(p: BProc, t: PNode, d: var TLoc) = # clearException(); # } # } - # { + # { # /* finally: */ # printf('fin!\n'); # } @@ -883,17 +919,17 @@ proc genTry(p: BProc, t: PNode, d: var TLoc) = var blen = sonsLen(t.sons[i]) if blen == 1: # general except section: - if i > 1: lineF(p, cpsStmts, "else") + if i > 1: lineF(p, cpsStmts, "else", []) startBlock(p) linefmt(p, cpsStmts, "$1.status = 0;$n", safePoint) expr(p, t.sons[i].sons[0], d) linefmt(p, cpsStmts, "#popCurrentException();$n") endBlock(p) else: - var orExpr: PRope = nil + var orExpr: Rope = nil for j in countup(0, blen - 2): assert(t.sons[i].sons[j].kind == nkType) - if orExpr != nil: app(orExpr, "||") + if orExpr != nil: add(orExpr, "||") appcg(p.module, orExpr, "#isObj(#getCurrentException()->Sup.m_type, $1)", [genTypeInfo(p.module, t.sons[i].sons[j].typ)]) @@ -913,7 +949,7 @@ proc genTry(p: BProc, t: PNode, d: var TLoc) = discard pop(p.finallySafePoints) linefmt(p, cpsStmts, "if ($1.status != 0) #reraiseException();$n", safePoint) -proc genAsmOrEmitStmt(p: BProc, t: PNode, isAsmStmt=false): PRope = +proc genAsmOrEmitStmt(p: BProc, t: PNode, isAsmStmt=false): Rope = var res = "" for i in countup(0, sonsLen(t) - 1): case t.sons[i].kind @@ -924,17 +960,17 @@ proc genAsmOrEmitStmt(p: BProc, t: PNode, isAsmStmt=false): PRope = if sym.kind in {skProc, skIterator, skClosureIterator, skMethod}: var a: TLoc initLocExpr(p, t.sons[i], a) - res.add(rdLoc(a).ropeToStr) + res.add($rdLoc(a)) else: var r = sym.loc.r - if r == nil: + if r == nil: # if no name has already been given, # it doesn't matter much: r = mangleName(sym) sym.loc.r = r # but be consequent! - res.add(r.ropeToStr) + res.add($r) else: internalError(t.sons[i].info, "genAsmOrEmitStmt()") - + if isAsmStmt and hasGnuAsm in CC[cCompiler].props: for x in splitLines(res): var j = 0 @@ -942,52 +978,56 @@ proc genAsmOrEmitStmt(p: BProc, t: PNode, isAsmStmt=false): PRope = if x[j] in {'"', ':'}: # don't modify the line if already in quotes or # some clobber register list: - app(result, x); app(result, tnl) + add(result, x); add(result, tnl) elif x[j] != '\0': # ignore empty lines - app(result, "\"") - app(result, x) - app(result, "\\n\"\n") + add(result, "\"") + add(result, x) + add(result, "\\n\"\n") else: res.add(tnl) - result = res.toRope + result = res.rope -proc genAsmStmt(p: BProc, t: PNode) = +proc genAsmStmt(p: BProc, t: PNode) = assert(t.kind == nkAsmStmt) genLineDir(p, t) var s = genAsmOrEmitStmt(p, t, isAsmStmt=true) + # see bug #2362, "top level asm statements" seem to be a mis-feature + # but even if we don't do this, the example in #2362 cannot possibly + # work: if p.prc == nil: # top level asm statement? - appf(p.module.s[cfsProcHeaders], CC[cCompiler].asmStmtFrmt, [s]) + addf(p.module.s[cfsProcHeaders], CC[cCompiler].asmStmtFrmt, [s]) else: lineF(p, cpsStmts, CC[cCompiler].asmStmtFrmt, [s]) -proc genEmit(p: BProc, t: PNode) = - genLineDir(p, t) +proc genEmit(p: BProc, t: PNode) = var s = genAsmOrEmitStmt(p, t.sons[1]) - if p.prc == nil: + if p.prc == nil: # top level emit pragma? - app(p.module.s[cfsProcHeaders], s) + genCLineDir(p.module.s[cfsProcHeaders], t.info) + add(p.module.s[cfsProcHeaders], s) else: + genLineDir(p, t) line(p, cpsStmts, s) -var +var breakPointId: int = 0 - gBreakpoints: PRope # later the breakpoints are inserted into the main proc + gBreakpoints: Rope # later the breakpoints are inserted into the main proc -proc genBreakPoint(p: BProc, t: PNode) = +proc genBreakPoint(p: BProc, t: PNode) = var name: string if optEndb in p.options: - if t.kind == nkExprColonExpr: + if t.kind == nkExprColonExpr: assert(t.sons[1].kind in {nkStrLit..nkTripleStrLit}) name = normalize(t.sons[1].strVal) - else: + else: inc(breakPointId) name = "bp" & $breakPointId genLineDir(p, t) # BUGFIX - appcg(p.module, gBreakpoints, + appcg(p.module, gBreakpoints, "#dbgRegisterBreakpoint($1, (NCSTRING)$2, (NCSTRING)$3);$n", [ - toRope(toLinenumber(t.info)), makeCString(toFilename(t.info)), + rope(toLinenumber(t.info)), makeCString(toFilename(t.info)), makeCString(name)]) proc genWatchpoint(p: BProc, n: PNode) = @@ -1006,14 +1046,14 @@ proc genPragma(p: BProc, n: PNode) = of wEmit: genEmit(p, it) of wBreakpoint: genBreakPoint(p, it) of wWatchPoint: genWatchpoint(p, it) - of wInjectStmt: + of wInjectStmt: var p = newProc(nil, p.module) p.options = p.options - {optLineTrace, optStackTrace} genStmts(p, it.sons[1]) p.module.injectStmt = p.s(cpsStmts) else: discard -proc fieldDiscriminantCheckNeeded(p: BProc, asgn: PNode): bool = +proc fieldDiscriminantCheckNeeded(p: BProc, asgn: PNode): bool = if optFieldCheck in p.options: var le = asgn.sons[0] if le.kind == nkCheckedFieldExpr: @@ -1021,23 +1061,23 @@ proc fieldDiscriminantCheckNeeded(p: BProc, asgn: PNode): bool = result = sfDiscriminant in field.flags elif le.kind == nkDotExpr: var field = le.sons[1].sym - result = sfDiscriminant in field.flags + result = sfDiscriminant in field.flags -proc genDiscriminantCheck(p: BProc, a, tmp: TLoc, objtype: PType, - field: PSym) = +proc genDiscriminantCheck(p: BProc, a, tmp: TLoc, objtype: PType, + field: PSym) = var t = skipTypes(objtype, abstractVar) assert t.kind == tyObject discard genTypeInfo(p.module, t) var L = lengthOrd(field.typ) if not containsOrIncl(p.module.declaredThings, field.id): - appcg(p.module, cfsVars, "extern $1", + appcg(p.module, cfsVars, "extern $1", discriminatorTableDecl(p.module, t, field)) lineCg(p, cpsStmts, "#FieldDiscriminantCheck((NI)(NU)($1), (NI)(NU)($2), $3, $4);$n", [rdLoc(a), rdLoc(tmp), discriminatorTableName(p.module, t, field), intLiteral(L+1)]) -proc asgnFieldDiscriminant(p: BProc, e: PNode) = +proc asgnFieldDiscriminant(p: BProc, e: PNode) = var a, tmp: TLoc var dotExpr = e.sons[0] var d: PSym @@ -1047,10 +1087,12 @@ proc asgnFieldDiscriminant(p: BProc, e: PNode) = expr(p, e.sons[1], tmp) genDiscriminantCheck(p, a, tmp, dotExpr.sons[0].typ, dotExpr.sons[1].sym) genAssignment(p, a, tmp, {}) - -proc genAsgn(p: BProc, e: PNode, fastAsgn: bool) = + +proc genAsgn(p: BProc, e: PNode, fastAsgn: bool) = genLineDir(p, e) - if not fieldDiscriminantCheckNeeded(p, e): + if e.sons[0].kind == nkSym and sfGoto in e.sons[0].sym.flags: + genGotoVar(p, e.sons[1]) + elif not fieldDiscriminantCheckNeeded(p, e): var a: TLoc initLocExpr(p, e.sons[0], a) if fastAsgn: incl(a.flags, lfNoDeepCopy) @@ -1059,7 +1101,7 @@ proc genAsgn(p: BProc, e: PNode, fastAsgn: bool) = else: asgnFieldDiscriminant(p, e) -proc genStmts(p: BProc, t: PNode) = +proc genStmts(p: BProc, t: PNode) = var a: TLoc expr(p, t, a) internalAssert a.k in {locNone, locTemp, locLocalVar} diff --git a/compiler/ccgthreadvars.nim b/compiler/ccgthreadvars.nim index c24dd5c41..d741c47a9 100644 --- a/compiler/ccgthreadvars.nim +++ b/compiler/ccgthreadvars.nim @@ -7,7 +7,7 @@ # distribution, for details about the copyright. # -## Thread var support for crappy architectures that lack native support for +## Thread var support for crappy architectures that lack native support for ## thread local storage. (**Thank you Mac OS X!**) # included from cgen.nim @@ -19,12 +19,12 @@ proc accessThreadLocalVar(p: BProc, s: PSym) = if emulatedThreadVars() and not p.threadVarAccessed: p.threadVarAccessed = true p.module.usesThreadVars = true - appf(p.procSec(cpsLocals), "\tNimThreadVars* NimTV;$n") - app(p.procSec(cpsInit), + addf(p.procSec(cpsLocals), "\tNimThreadVars* NimTV;$n", []) + add(p.procSec(cpsInit), ropecg(p.module, "\tNimTV = (NimThreadVars*) #GetThreadLocalVars();$n")) - + var - nimtv: PRope # nimrod thread vars; the struct body + nimtv: Rope # nimrod thread vars; the struct body nimtvDeps: seq[PType] = @[] # type deps: every module needs whole struct nimtvDeclared = initIntSet() # so that every var/field exists only once # in the struct @@ -43,23 +43,23 @@ proc declareThreadVar(m: BModule, s: PSym, isExtern: bool) = # allocator for it :-( if not containsOrIncl(nimtvDeclared, s.id): nimtvDeps.add(s.loc.t) - appf(nimtv, "$1 $2;$n", [getTypeDesc(m, s.loc.t), s.loc.r]) + addf(nimtv, "$1 $2;$n", [getTypeDesc(m, s.loc.t), s.loc.r]) else: - if isExtern: app(m.s[cfsVars], "extern ") - if optThreads in gGlobalOptions: app(m.s[cfsVars], "NIM_THREADVAR ") - app(m.s[cfsVars], getTypeDesc(m, s.loc.t)) - appf(m.s[cfsVars], " $1;$n", [s.loc.r]) - + if isExtern: add(m.s[cfsVars], "extern ") + if optThreads in gGlobalOptions: add(m.s[cfsVars], "NIM_THREADVAR ") + add(m.s[cfsVars], getTypeDesc(m, s.loc.t)) + addf(m.s[cfsVars], " $1;$n", [s.loc.r]) + proc generateThreadLocalStorage(m: BModule) = if nimtv != nil and (m.usesThreadVars or sfMainModule in m.module.flags): for t in items(nimtvDeps): discard getTypeDesc(m, t) - appf(m.s[cfsSeqTypes], "typedef struct {$1} NimThreadVars;$n", [nimtv]) + addf(m.s[cfsSeqTypes], "typedef struct {$1} NimThreadVars;$n", [nimtv]) proc generateThreadVarsSize(m: BModule) = if nimtv != nil: let externc = if gCmd != cmdCompileToCpp and sfCompileToCpp in m.module.flags: "extern \"C\"" else: "" - appf(m.s[cfsProcs], + addf(m.s[cfsProcs], "$#NI NimThreadVarsSize(){return (NI)sizeof(NimThreadVars);}$n", - [externc.toRope]) + [externc.rope]) diff --git a/compiler/ccgtrav.nim b/compiler/ccgtrav.nim index 8bb820283..5f59702e5 100644 --- a/compiler/ccgtrav.nim +++ b/compiler/ccgtrav.nim @@ -17,11 +17,11 @@ type p: BProc visitorFrmt: string -proc genTraverseProc(c: var TTraversalClosure, accessor: PRope, typ: PType) +proc genTraverseProc(c: var TTraversalClosure, accessor: Rope, typ: PType) proc genCaseRange(p: BProc, branch: PNode) proc getTemp(p: BProc, t: PType, result: var TLoc; needsInit=false) -proc genTraverseProc(c: var TTraversalClosure, accessor: PRope, n: PNode) = +proc genTraverseProc(c: var TTraversalClosure, accessor: Rope, n: PNode) = if n == nil: return case n.kind of nkRecList: @@ -31,31 +31,31 @@ proc genTraverseProc(c: var TTraversalClosure, accessor: PRope, n: PNode) = if (n.sons[0].kind != nkSym): internalError(n.info, "genTraverseProc") var p = c.p let disc = n.sons[0].sym - lineF(p, cpsStmts, "switch ($1.$2) {$n", accessor, disc.loc.r) + lineF(p, cpsStmts, "switch ($1.$2) {$n", [accessor, disc.loc.r]) for i in countup(1, sonsLen(n) - 1): let branch = n.sons[i] assert branch.kind in {nkOfBranch, nkElse} if branch.kind == nkOfBranch: genCaseRange(c.p, branch) else: - lineF(p, cpsStmts, "default:$n") + lineF(p, cpsStmts, "default:$n", []) genTraverseProc(c, accessor, lastSon(branch)) - lineF(p, cpsStmts, "break;$n") - lineF(p, cpsStmts, "} $n") + lineF(p, cpsStmts, "break;$n", []) + lineF(p, cpsStmts, "} $n", []) of nkSym: let field = n.sym if field.loc.t == nil: internalError(n.info, "genTraverseProc()") - genTraverseProc(c, ropef("$1.$2", accessor, field.loc.r), field.loc.t) + genTraverseProc(c, "$1.$2" % [accessor, field.loc.r], field.loc.t) else: internalError(n.info, "genTraverseProc()") -proc parentObj(accessor: PRope; m: BModule): PRope {.inline.} = +proc parentObj(accessor: Rope; m: BModule): Rope {.inline.} = if not m.compileToCpp: - result = ropef("$1.Sup", accessor) + result = "$1.Sup" % [accessor] else: result = accessor -proc genTraverseProc(c: var TTraversalClosure, accessor: PRope, typ: PType) = +proc genTraverseProc(c: var TTraversalClosure, accessor: Rope, typ: PType) = if typ == nil: return var p = c.p case typ.kind @@ -66,9 +66,9 @@ proc genTraverseProc(c: var TTraversalClosure, accessor: PRope, typ: PType) = var i: TLoc getTemp(p, getSysType(tyInt), i) linefmt(p, cpsStmts, "for ($1 = 0; $1 < $2; $1++) {$n", - i.r, arraySize.toRope) + i.r, arraySize.rope) genTraverseProc(c, rfmt(nil, "$1[$2]", accessor, i.r), typ.sons[1]) - lineF(p, cpsStmts, "}$n") + lineF(p, cpsStmts, "}$n", []) of tyObject: for i in countup(0, sonsLen(typ) - 1): genTraverseProc(c, accessor.parentObj(c.p.module), typ.sons[i]) @@ -76,7 +76,7 @@ proc genTraverseProc(c: var TTraversalClosure, accessor: PRope, typ: PType) = of tyTuple: let typ = getUniqueType(typ) for i in countup(0, sonsLen(typ) - 1): - genTraverseProc(c, rfmt(nil, "$1.Field$2", accessor, i.toRope), typ.sons[i]) + genTraverseProc(c, rfmt(nil, "$1.Field$2", accessor, i.rope), typ.sons[i]) of tyRef, tyString, tySequence: lineCg(p, cpsStmts, c.visitorFrmt, accessor) of tyProc: @@ -85,67 +85,67 @@ proc genTraverseProc(c: var TTraversalClosure, accessor: PRope, typ: PType) = else: discard -proc genTraverseProcSeq(c: var TTraversalClosure, accessor: PRope, typ: PType) = +proc genTraverseProcSeq(c: var TTraversalClosure, accessor: Rope, typ: PType) = var p = c.p - assert typ.kind == tySequence + assert typ.kind == tySequence var i: TLoc getTemp(p, getSysType(tyInt), i) lineF(p, cpsStmts, "for ($1 = 0; $1 < $2->$3; $1++) {$n", - i.r, accessor, toRope(if c.p.module.compileToCpp: "len" else: "Sup.len")) - genTraverseProc(c, ropef("$1->data[$2]", accessor, i.r), typ.sons[0]) - lineF(p, cpsStmts, "}$n") - -proc genTraverseProc(m: BModule, typ: PType, reason: TTypeInfoReason): PRope = + [i.r, accessor, rope(if c.p.module.compileToCpp: "len" else: "Sup.len")]) + genTraverseProc(c, "$1->data[$2]" % [accessor, i.r], typ.sons[0]) + lineF(p, cpsStmts, "}$n", []) + +proc genTraverseProc(m: BModule, typ: PType, reason: TTypeInfoReason): Rope = var c: TTraversalClosure var p = newProc(nil, m) result = getGlobalTempName() - + case reason of tiNew: c.visitorFrmt = "#nimGCvisit((void*)$1, op);$n" else: assert false - - let header = ropef("N_NIMCALL(void, $1)(void* p, NI op)", result) - + + let header = "N_NIMCALL(void, $1)(void* p, NI op)" % [result] + let t = getTypeDesc(m, typ) - lineF(p, cpsLocals, "$1 a;$n", t) - lineF(p, cpsInit, "a = ($1)p;$n", t) - + lineF(p, cpsLocals, "$1 a;$n", [t]) + lineF(p, cpsInit, "a = ($1)p;$n", [t]) + c.p = p assert typ.kind != tyTypeDesc if typ.kind == tySequence: - genTraverseProcSeq(c, "a".toRope, typ) + genTraverseProcSeq(c, "a".rope, typ) else: if skipTypes(typ.sons[0], typedescInst).kind in {tyArrayConstr, tyArray}: # C's arrays are broken beyond repair: - genTraverseProc(c, "a".toRope, typ.sons[0]) + genTraverseProc(c, "a".rope, typ.sons[0]) else: - genTraverseProc(c, "(*a)".toRope, typ.sons[0]) - - let generatedProc = ropef("$1 {$n$2$3$4}$n", - [header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)]) - - m.s[cfsProcHeaders].appf("$1;$n", header) - m.s[cfsProcs].app(generatedProc) - -proc genTraverseProcForGlobal(m: BModule, s: PSym): PRope = + genTraverseProc(c, "(*a)".rope, typ.sons[0]) + + let generatedProc = "$1 {$n$2$3$4}$n" % + [header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)] + + m.s[cfsProcHeaders].addf("$1;$n", [header]) + m.s[cfsProcs].add(generatedProc) + +proc genTraverseProcForGlobal(m: BModule, s: PSym): Rope = discard genTypeInfo(m, s.loc.t) - + var c: TTraversalClosure var p = newProc(nil, m) var sLoc = s.loc.r result = getGlobalTempName() - + if sfThread in s.flags and emulatedThreadVars(): accessThreadLocalVar(p, s) - sLoc = con("NimTV->", sLoc) - + sLoc = "NimTV->" & sLoc + c.visitorFrmt = "#nimGCvisit((void*)$1, 0);$n" c.p = p - let header = ropef("N_NIMCALL(void, $1)()", result) + let header = "N_NIMCALL(void, $1)()" % [result] genTraverseProc(c, sLoc, s.loc.t) - - let generatedProc = ropef("$1 {$n$2$3$4}$n", - [header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)]) - - m.s[cfsProcHeaders].appf("$1;$n", header) - m.s[cfsProcs].app(generatedProc) + + let generatedProc = "$1 {$n$2$3$4}$n" % + [header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)] + + m.s[cfsProcHeaders].addf("$1;$n", [header]) + m.s[cfsProcs].add(generatedProc) diff --git a/compiler/ccgtypes.nim b/compiler/ccgtypes.nim index 9a5a3ab34..60ebf591b 100644 --- a/compiler/ccgtypes.nim +++ b/compiler/ccgtypes.nim @@ -25,11 +25,11 @@ proc isKeyword(w: PIdent): bool = ord(wInline): return true else: return false -proc mangleName(s: PSym): PRope = +proc mangleName(s: PSym): Rope = result = s.loc.r if result == nil: when oKeepVariableNames: - let keepOrigName = s.kind in skLocalVars - {skForVar} and + let keepOrigName = s.kind in skLocalVars - {skForVar} and {sfFromGeneric, sfGlobal, sfShadowed, sfGenSym} * s.flags == {} and not isKeyword(s.name) # XXX: This is still very experimental @@ -77,30 +77,30 @@ proc mangleName(s: PSym): PRope = # These are not properly scoped now - we need to add blocks # around for loops in transf if keepOrigName: - result = s.name.s.mangle.newRope + result = s.name.s.mangle.rope else: - app(result, newRope(mangle(s.name.s))) - app(result, ~"_") - app(result, toRope(s.id)) + add(result, rope(mangle(s.name.s))) + add(result, ~"_") + add(result, rope(s.id)) else: - app(result, newRope(mangle(s.name.s))) - app(result, ~"_") - app(result, toRope(s.id)) + add(result, rope(mangle(s.name.s))) + add(result, ~"_") + add(result, rope(s.id)) s.loc.r = result -proc typeName(typ: PType): PRope = - result = if typ.sym != nil: typ.sym.name.s.mangle.toRope +proc typeName(typ: PType): Rope = + result = if typ.sym != nil: typ.sym.name.s.mangle.rope else: ~"TY" -proc getTypeName(typ: PType): PRope = +proc getTypeName(typ: PType): Rope = if typ.sym != nil and {sfImportc, sfExportc} * typ.sym.flags != {}: result = typ.sym.loc.r else: if typ.loc.r == nil: - typ.loc.r = con(typ.typeName, typ.id.toRope) + typ.loc.r = typ.typeName & typ.id.rope result = typ.loc.r if result == nil: internalError("getTypeName: " & $typ.kind) - + proc mapSetType(typ: PType): TCTypeKind = case int(getSize(typ)) of 1: result = ctInt8 @@ -109,7 +109,7 @@ proc mapSetType(typ: PType): TCTypeKind = of 8: result = ctInt64 else: result = ctArray -proc mapType(typ: PType): TCTypeKind = +proc mapType(typ: PType): TCTypeKind = ## Maps a nimrod type to a C type case typ.kind of tyNone, tyStmt: result = ctVoid @@ -121,10 +121,10 @@ proc mapType(typ: PType): TCTypeKind = of tyGenericBody, tyGenericInst, tyGenericParam, tyDistinct, tyOrdinal, tyConst, tyMutable, tyIter, tyTypeDesc: result = mapType(lastSon(typ)) - of tyEnum: - if firstOrd(typ) < 0: + of tyEnum: + if firstOrd(typ) < 0: result = ctInt32 - else: + else: case int(getSize(typ)) of 1: result = ctUInt8 of 2: result = ctUInt16 @@ -145,19 +145,19 @@ proc mapType(typ: PType): TCTypeKind = of tyInt..tyUInt64: result = TCTypeKind(ord(typ.kind) - ord(tyInt) + ord(ctInt)) else: internalError("mapType") - -proc mapReturnType(typ: PType): TCTypeKind = + +proc mapReturnType(typ: PType): TCTypeKind = if skipTypes(typ, typedescInst).kind == tyArray: result = ctPtr else: result = mapType(typ) -proc isImportedType(t: PType): bool = +proc isImportedType(t: PType): bool = result = t.sym != nil and sfImportc in t.sym.flags -proc isImportedCppType(t: PType): bool = +proc isImportedCppType(t: PType): bool = result = t.sym != nil and sfInfixCall in t.sym.flags -proc getTypeDescAux(m: BModule, typ: PType, check: var IntSet): PRope -proc needsComplexAssignment(typ: PType): bool = +proc getTypeDescAux(m: BModule, typ: PType, check: var IntSet): Rope +proc needsComplexAssignment(typ: PType): bool = result = containsGarbageCollectedRef(typ) proc isObjLackingTypeField(typ: PType): bool {.inline.} = @@ -182,120 +182,120 @@ proc isInvalidReturnType(rettype: PType): bool = (t.kind == tyObject and not isObjLackingTypeField(t)) else: result = false -const - CallingConvToStr: array[TCallingConvention, string] = ["N_NIMCALL", - "N_STDCALL", "N_CDECL", "N_SAFECALL", +const + CallingConvToStr: array[TCallingConvention, string] = ["N_NIMCALL", + "N_STDCALL", "N_CDECL", "N_SAFECALL", "N_SYSCALL", # this is probably not correct for all platforms, - # but one can #define it to what one wants + # but one can #define it to what one wants "N_INLINE", "N_NOINLINE", "N_FASTCALL", "N_CLOSURE", "N_NOCONV"] -proc cacheGetType(tab: TIdTable, key: PType): PRope = +proc cacheGetType(tab: TIdTable, key: PType): Rope = # returns nil if we need to declare this type # since types are now unique via the ``getUniqueType`` mechanism, this slow # linear search is not necessary anymore: - result = PRope(idTableGet(tab, key)) + result = Rope(idTableGet(tab, key)) -proc getTempName(): PRope = - result = rfmt(nil, "TMP$1", toRope(backendId())) +proc getTempName(): Rope = + result = rfmt(nil, "TMP$1", rope(backendId())) -proc getGlobalTempName(): PRope = - result = rfmt(nil, "TMP$1", toRope(backendId())) +proc getGlobalTempName(): Rope = + result = rfmt(nil, "TMP$1", rope(backendId())) -proc ccgIntroducedPtr(s: PSym): bool = +proc ccgIntroducedPtr(s: PSym): bool = var pt = skipTypes(s.typ, typedescInst) assert skResult != s.kind if tfByRef in pt.flags: return true elif tfByCopy in pt.flags: return false case pt.kind of tyObject: - if (optByRef in s.options) or (getSize(pt) > platform.floatSize * 2): + if (optByRef in s.options) or (getSize(pt) > platform.floatSize * 2): result = true # requested anyway - elif (tfFinal in pt.flags) and (pt.sons[0] == nil): + elif (tfFinal in pt.flags) and (pt.sons[0] == nil): result = false # no need, because no subtyping possible - else: + else: result = true # ordinary objects are always passed by reference, # otherwise casting doesn't work - of tyTuple: + of tyTuple: result = (getSize(pt) > platform.floatSize*2) or (optByRef in s.options) else: result = false - -proc fillResult(param: PSym) = + +proc fillResult(param: PSym) = fillLoc(param.loc, locParam, param.typ, ~"Result", OnStack) - if (mapReturnType(param.typ) != ctArray) and isInvalidReturnType(param.typ): + if (mapReturnType(param.typ) != ctArray) and isInvalidReturnType(param.typ): incl(param.loc.flags, lfIndirect) param.loc.s = OnUnknown -proc typeNameOrLiteral(t: PType, literal: string): PRope = - if t.sym != nil and sfImportc in t.sym.flags and t.sym.magic == mNone: +proc typeNameOrLiteral(t: PType, literal: string): Rope = + if t.sym != nil and sfImportc in t.sym.flags and t.sym.magic == mNone: result = getTypeName(t) - else: - result = toRope(literal) - -proc getSimpleTypeDesc(m: BModule, typ: PType): PRope = - const + else: + result = rope(literal) + +proc getSimpleTypeDesc(m: BModule, typ: PType): Rope = + const NumericalTypeToStr: array[tyInt..tyUInt64, string] = [ "NI", "NI8", "NI16", "NI32", "NI64", "NF", "NF32", "NF64", "NF128", "NU", "NU8", "NU16", "NU32", "NU64",] case typ.kind - of tyPointer: + of tyPointer: result = typeNameOrLiteral(typ, "void*") - of tyEnum: - if firstOrd(typ) < 0: + of tyEnum: + if firstOrd(typ) < 0: result = typeNameOrLiteral(typ, "NI32") - else: + else: case int(getSize(typ)) of 1: result = typeNameOrLiteral(typ, "NU8") of 2: result = typeNameOrLiteral(typ, "NU16") of 4: result = typeNameOrLiteral(typ, "NI32") of 8: result = typeNameOrLiteral(typ, "NI64") - else: + else: internalError(typ.sym.info, "getSimpleTypeDesc: " & $(getSize(typ))) result = nil - of tyString: + of tyString: discard cgsym(m, "NimStringDesc") result = typeNameOrLiteral(typ, "NimStringDesc*") of tyCString: result = typeNameOrLiteral(typ, "NCSTRING") of tyBool: result = typeNameOrLiteral(typ, "NIM_BOOL") of tyChar: result = typeNameOrLiteral(typ, "NIM_CHAR") of tyNil: result = typeNameOrLiteral(typ, "0") - of tyInt..tyUInt64: + of tyInt..tyUInt64: result = typeNameOrLiteral(typ, NumericalTypeToStr[typ.kind]) of tyDistinct, tyRange, tyOrdinal: result = getSimpleTypeDesc(m, typ.sons[0]) else: result = nil -proc pushType(m: BModule, typ: PType) = +proc pushType(m: BModule, typ: PType) = add(m.typeStack, typ) -proc getTypePre(m: BModule, typ: PType): PRope = - if typ == nil: result = toRope("void") - else: +proc getTypePre(m: BModule, typ: PType): Rope = + if typ == nil: result = rope("void") + else: result = getSimpleTypeDesc(m, typ) if result == nil: result = cacheGetType(m.typeCache, typ) -proc structOrUnion(t: PType): PRope = - (if tfUnion in t.flags: toRope("union") else: toRope("struct")) +proc structOrUnion(t: PType): Rope = + (if tfUnion in t.flags: rope("union") else: rope("struct")) -proc getForwardStructFormat(m: BModule): string = +proc getForwardStructFormat(m: BModule): string = if m.compileToCpp: result = "$1 $2;$n" else: result = "typedef $1 $2 $2;$n" - -proc getTypeForward(m: BModule, typ: PType): PRope = + +proc getTypeForward(m: BModule, typ: PType): Rope = result = cacheGetType(m.forwTypeCache, typ) - if result != nil: return + if result != nil: return result = getTypePre(m, typ) - if result != nil: return + if result != nil: return case typ.kind - of tySequence, tyTuple, tyObject: + of tySequence, tyTuple, tyObject: result = getTypeName(typ) - if not isImportedType(typ): - appf(m.s[cfsForwardTypes], getForwardStructFormat(m), + if not isImportedType(typ): + addf(m.s[cfsForwardTypes], getForwardStructFormat(m), [structOrUnion(typ), result]) idTablePut(m.forwTypeCache, typ, result) else: internalError("getTypeForward(" & $typ.kind & ')') -proc getTypeDescWeak(m: BModule; t: PType; check: var IntSet): PRope = +proc getTypeDescWeak(m: BModule; t: PType; check: var IntSet): Rope = ## like getTypeDescAux but creates only a *weak* dependency. In other words ## we know we only need a pointer to it so we only generate a struct forward ## declaration: @@ -308,6 +308,10 @@ proc getTypeDescWeak(m: BModule; t: PType; check: var IntSet): PRope = let x = getUniqueType(etB) result = getTypeForward(m, x) pushType(m, x) + of tySequence: + let x = getUniqueType(etB) + result = getTypeForward(m, x) & "*" + pushType(m, x) else: result = getTypeDescAux(m, t, check) @@ -317,29 +321,29 @@ proc paramStorageLoc(param: PSym): TStorageLoc = else: result = OnUnknown -proc genProcParams(m: BModule, t: PType, rettype, params: var PRope, - check: var IntSet, declareEnvironment=true) = +proc genProcParams(m: BModule, t: PType, rettype, params: var Rope, + check: var IntSet, declareEnvironment=true) = params = nil - if (t.sons[0] == nil) or isInvalidReturnType(t.sons[0]): + if (t.sons[0] == nil) or isInvalidReturnType(t.sons[0]): rettype = ~"void" - else: + else: rettype = getTypeDescAux(m, t.sons[0], check) - for i in countup(1, sonsLen(t.n) - 1): + for i in countup(1, sonsLen(t.n) - 1): if t.n.sons[i].kind != nkSym: internalError(t.n.info, "genProcParams") var param = t.n.sons[i].sym if isCompileTimeOnly(param.typ): continue - if params != nil: app(params, ~", ") + if params != nil: add(params, ~", ") fillLoc(param.loc, locParam, param.typ, mangleName(param), param.paramStorageLoc) - if ccgIntroducedPtr(param): - app(params, getTypeDescWeak(m, param.typ, check)) - app(params, ~"*") + if ccgIntroducedPtr(param): + add(params, getTypeDescWeak(m, param.typ, check)) + add(params, ~"*") incl(param.loc.flags, lfIndirect) param.loc.s = OnUnknown else: - app(params, getTypeDescAux(m, param.typ, check)) - app(params, ~" ") - app(params, param.loc.r) + add(params, getTypeDescAux(m, param.typ, check)) + add(params, ~" ") + add(params, param.loc.r) # declare the len field for open arrays: var arr = param.typ if arr.kind == tyVar: arr = arr.sons[0] @@ -348,78 +352,78 @@ proc genProcParams(m: BModule, t: PType, rettype, params: var PRope, # this fixes the 'sort' bug: if param.typ.kind == tyVar: param.loc.s = OnUnknown # need to pass hidden parameter: - appf(params, ", NI $1Len$2", [param.loc.r, j.toRope]) + addf(params, ", NI $1Len$2", [param.loc.r, j.rope]) inc(j) arr = arr.sons[0] if (t.sons[0] != nil) and isInvalidReturnType(t.sons[0]): var arr = t.sons[0] - if params != nil: app(params, ", ") + if params != nil: add(params, ", ") if (mapReturnType(t.sons[0]) != ctArray): - app(params, getTypeDescWeak(m, arr, check)) - app(params, "*") + add(params, getTypeDescWeak(m, arr, check)) + add(params, "*") else: - app(params, getTypeDescAux(m, arr, check)) - appf(params, " Result", []) - if t.callConv == ccClosure and declareEnvironment: - if params != nil: app(params, ", ") - app(params, "void* ClEnv") + add(params, getTypeDescAux(m, arr, check)) + addf(params, " Result", []) + if t.callConv == ccClosure and declareEnvironment: + if params != nil: add(params, ", ") + add(params, "void* ClEnv") if tfVarargs in t.flags: - if params != nil: app(params, ", ") - app(params, "...") - if params == nil: app(params, "void)") - else: app(params, ")") - params = con("(", params) - -proc mangleRecFieldName(field: PSym, rectype: PType): PRope = + if params != nil: add(params, ", ") + add(params, "...") + if params == nil: add(params, "void)") + else: add(params, ")") + params = "(" & params + +proc mangleRecFieldName(field: PSym, rectype: PType): Rope = if (rectype.sym != nil) and - ({sfImportc, sfExportc} * rectype.sym.flags != {}): + ({sfImportc, sfExportc} * rectype.sym.flags != {}): result = field.loc.r else: - result = toRope(mangleField(field.name.s)) + result = rope(mangleField(field.name.s)) if result == nil: internalError(field.info, "mangleRecFieldName") - -proc genRecordFieldsAux(m: BModule, n: PNode, - accessExpr: PRope, rectype: PType, - check: var IntSet): PRope = - var - ae, uname, sname, a: PRope + +proc genRecordFieldsAux(m: BModule, n: PNode, + accessExpr: Rope, rectype: PType, + check: var IntSet): Rope = + var + ae, uname, sname, a: Rope k: PNode field: PSym result = nil case n.kind - of nkRecList: - for i in countup(0, sonsLen(n) - 1): - app(result, genRecordFieldsAux(m, n.sons[i], accessExpr, rectype, check)) - of nkRecCase: + of nkRecList: + for i in countup(0, sonsLen(n) - 1): + add(result, genRecordFieldsAux(m, n.sons[i], accessExpr, rectype, check)) + of nkRecCase: if n.sons[0].kind != nkSym: internalError(n.info, "genRecordFieldsAux") - app(result, genRecordFieldsAux(m, n.sons[0], accessExpr, rectype, check)) - uname = toRope(mangle(n.sons[0].sym.name.s) & 'U') - if accessExpr != nil: ae = ropef("$1.$2", [accessExpr, uname]) + add(result, genRecordFieldsAux(m, n.sons[0], accessExpr, rectype, check)) + uname = rope(mangle(n.sons[0].sym.name.s) & 'U') + if accessExpr != nil: ae = "$1.$2" % [accessExpr, uname] else: ae = uname - var unionBody: PRope = nil - for i in countup(1, sonsLen(n) - 1): + var unionBody: Rope = nil + for i in countup(1, sonsLen(n) - 1): case n.sons[i].kind - of nkOfBranch, nkElse: + of nkOfBranch, nkElse: k = lastSon(n.sons[i]) - if k.kind != nkSym: - sname = con("S", toRope(i)) - a = genRecordFieldsAux(m, k, ropef("$1.$2", [ae, sname]), rectype, + if k.kind != nkSym: + sname = "S" & rope(i) + a = genRecordFieldsAux(m, k, "$1.$2" % [ae, sname], rectype, check) - if a != nil: - app(unionBody, "struct {") - app(unionBody, a) - appf(unionBody, "} $1;$n", [sname]) + if a != nil: + add(unionBody, "struct {") + add(unionBody, a) + addf(unionBody, "} $1;$n", [sname]) else: - app(unionBody, genRecordFieldsAux(m, k, ae, rectype, check)) + add(unionBody, genRecordFieldsAux(m, k, ae, rectype, check)) else: internalError("genRecordFieldsAux(record case branch)") if unionBody != nil: - appf(result, "union{$n$1} $2;$n", [unionBody, uname]) + addf(result, "union{$n$1} $2;$n", [unionBody, uname]) of nkSym: field = n.sym if field.typ.kind == tyEmpty: return #assert(field.ast == nil) sname = mangleRecFieldName(field, rectype) - if accessExpr != nil: ae = ropef("$1.$2", [accessExpr, sname]) + if accessExpr != nil: ae = "$1.$2" % [accessExpr, sname] else: ae = sname fillLoc(field.loc, locField, field.typ, ae, OnUnknown) # for importcpp'ed objects, we only need to set field.loc, but don't @@ -428,76 +432,106 @@ proc genRecordFieldsAux(m: BModule, n: PNode, if not isImportedCppType(rectype): let fieldType = field.loc.t.skipTypes(abstractInst) if fieldType.kind == tyArray and tfUncheckedArray in fieldType.flags: - appf(result, "$1 $2[SEQ_DECL_SIZE];$n", + addf(result, "$1 $2[SEQ_DECL_SIZE];$n", [getTypeDescAux(m, fieldType.elemType, check), sname]) + elif fieldType.kind == tySequence: + # we need to use a weak dependency here for trecursive_table. + addf(result, "$1 $2;$n", [getTypeDescWeak(m, field.loc.t, check), sname]) else: # don't use fieldType here because we need the # tyGenericInst for C++ template support - appf(result, "$1 $2;$n", [getTypeDescAux(m, field.loc.t, check), sname]) + addf(result, "$1 $2;$n", [getTypeDescAux(m, field.loc.t, check), sname]) else: internalError(n.info, "genRecordFieldsAux()") - -proc getRecordFields(m: BModule, typ: PType, check: var IntSet): PRope = + +proc getRecordFields(m: BModule, typ: PType, check: var IntSet): Rope = result = genRecordFieldsAux(m, typ.n, nil, typ, check) -proc getRecordDesc(m: BModule, typ: PType, name: PRope, - check: var IntSet): PRope = +proc getRecordDesc(m: BModule, typ: PType, name: Rope, + check: var IntSet): Rope = # declare the record: var hasField = false - var attribute: PRope = - if tfPacked in typ.flags: toRope(CC[cCompiler].packedPragma) + var attribute: Rope = + if tfPacked in typ.flags: rope(CC[cCompiler].packedPragma) else: nil - result = ropecg(m, CC[cCompiler].structStmtFmt, + result = ropecg(m, CC[cCompiler].structStmtFmt, [structOrUnion(typ), name, attribute]) - if typ.kind == tyObject: + if typ.kind == tyObject: - if typ.sons[0] == nil: - if (typ.sym != nil and sfPure in typ.sym.flags) or tfFinal in typ.flags: + if typ.sons[0] == nil: + if (typ.sym != nil and sfPure in typ.sym.flags) or tfFinal in typ.flags: appcg(m, result, " {$n", []) - else: + else: appcg(m, result, " {$n#TNimType* m_type;$n", [name, attribute]) hasField = true elif m.compileToCpp: - appcg(m, result, " : public $1 {$n", + appcg(m, result, " : public $1 {$n", [getTypeDescAux(m, typ.sons[0], check)]) hasField = true - else: - appcg(m, result, " {$n $1 Sup;$n", + else: + appcg(m, result, " {$n $1 Sup;$n", [getTypeDescAux(m, typ.sons[0], check)]) hasField = true - else: - appf(result, " {$n", [name]) + else: + addf(result, " {$n", [name]) var desc = getRecordFields(m, typ, check) - if desc == nil and not hasField: - appf(result, "char dummy;$n", []) - else: - app(result, desc) - app(result, "};" & tnl) - -proc getTupleDesc(m: BModule, typ: PType, name: PRope, - check: var IntSet): PRope = - result = ropef("$1 $2 {$n", [structOrUnion(typ), name]) - var desc: PRope = nil - for i in countup(0, sonsLen(typ) - 1): - appf(desc, "$1 Field$2;$n", - [getTypeDescAux(m, typ.sons[i], check), toRope(i)]) - if (desc == nil): app(result, "char dummy;" & tnl) - else: app(result, desc) - app(result, "};" & tnl) - -proc getTypeDescAux(m: BModule, typ: PType, check: var IntSet): PRope = + if desc == nil and not hasField: + addf(result, "char dummy;$n", []) + else: + add(result, desc) + add(result, "};" & tnl) + +proc getTupleDesc(m: BModule, typ: PType, name: Rope, + check: var IntSet): Rope = + result = "$1 $2 {$n" % [structOrUnion(typ), name] + var desc: Rope = nil + for i in countup(0, sonsLen(typ) - 1): + addf(desc, "$1 Field$2;$n", + [getTypeDescAux(m, typ.sons[i], check), rope(i)]) + if desc == nil: add(result, "char dummy;" & tnl) + else: add(result, desc) + add(result, "};" & tnl) + +proc scanCppGenericSlot(pat: string, cursor, outIdx, outStars: var int): bool = + # A helper proc for handling cppimport patterns, involving numeric + # placeholders for generic types (e.g. '0, '**2, etc). + # pre: the cursor must be placed at the ' symbol + # post: the cursor will be placed after the final digit + # false will returned if the input is not recognized as a placeholder + inc cursor + let begin = cursor + while pat[cursor] == '*': inc cursor + if pat[cursor] in Digits: + outIdx = pat[cursor].ord - '0'.ord + outStars = cursor - begin + inc cursor + return true + else: + return false + +proc resolveStarsInCppType(typ: PType, idx, stars: int): PType = + # XXX: we should catch this earlier and report it as a semantic error + if idx >= typ.len: internalError "invalid apostrophe type parameter index" + + result = typ.sons[idx] + for i in 1..stars: + if result != nil and result.len > 0: + result = if result.kind == tyGenericInst: result.sons[1] + else: result.elemType + +proc getTypeDescAux(m: BModule, typ: PType, check: var IntSet): Rope = # returns only the type's name var t = getUniqueType(typ) if t == nil: internalError("getTypeDescAux: t == nil") if t.sym != nil: useHeader(m, t.sym) result = getTypePre(m, t) - if result != nil: return + if result != nil: return if containsOrIncl(check, t.id): if isImportedCppType(typ) or isImportedCppType(t): return - internalError("cannot generate C type for: " & typeToString(typ)) + internalError("cannot generate C type for: " & typeToString(typ)) # XXX: this BUG is hard to fix -> we need to introduce helper structs, # but determining when this needs to be done is hard. We should split # C type generation into an analysis and a code generation phase somehow. @@ -507,7 +541,7 @@ proc getTypeDescAux(m: BModule, typ: PType, check: var IntSet): PRope = compileToCpp(m): "&" else: "*" var et = t.lastSon var etB = et.skipTypes(abstractInst) - if etB.kind in {tyArrayConstr, tyArray, tyOpenArray, tyVarargs}: + if etB.kind in {tyArrayConstr, tyArray, tyOpenArray, tyVarargs}: # this is correct! sets have no proper base type, so we treat # ``var set[char]`` in `getParamTypeDesc` et = elemType(etB) @@ -516,85 +550,107 @@ proc getTypeDescAux(m: BModule, typ: PType, check: var IntSet): PRope = case etB.kind of tyObject, tyTuple: if isImportedCppType(etB) and et.kind == tyGenericInst: - result = con(getTypeDescAux(m, et, check), star) + result = getTypeDescAux(m, et, check) & star else: # no restriction! We have a forward declaration for structs let x = getUniqueType(etB) let name = getTypeForward(m, x) - result = con(name, star) + result = name & star idTablePut(m.typeCache, t, result) pushType(m, x) of tySequence: # no restriction! We have a forward declaration for structs let x = getUniqueType(etB) let name = getTypeForward(m, x) - result = con(name, "*" & star) + result = name & "*" & star idTablePut(m.typeCache, t, result) pushType(m, x) else: # else we have a strong dependency :-( - result = con(getTypeDescAux(m, et, check), star) + result = getTypeDescAux(m, et, check) & star idTablePut(m.typeCache, t, result) of tyOpenArray, tyVarargs: - result = con(getTypeDescAux(m, t.sons[0], check), "*") + result = getTypeDescAux(m, t.sons[0], check) & "*" idTablePut(m.typeCache, t, result) of tyProc: result = getTypeName(t) idTablePut(m.typeCache, t, result) - var rettype, desc: PRope + var rettype, desc: Rope genProcParams(m, t, rettype, desc, check) - if not isImportedType(t): + if not isImportedType(t): if t.callConv != ccClosure: # procedure vars may need a closure! - appf(m.s[cfsTypes], "typedef $1_PTR($2, $3) $4;$n", - [toRope(CallingConvToStr[t.callConv]), rettype, result, desc]) + addf(m.s[cfsTypes], "typedef $1_PTR($2, $3) $4;$n", + [rope(CallingConvToStr[t.callConv]), rettype, result, desc]) else: - appf(m.s[cfsTypes], "typedef struct {$n" & - "N_NIMCALL_PTR($2, ClPrc) $3;$n" & + addf(m.s[cfsTypes], "typedef struct {$n" & + "N_NIMCALL_PTR($2, ClPrc) $3;$n" & "void* ClEnv;$n} $1;$n", [result, rettype, desc]) - of tySequence: + of tySequence: # we cannot use getTypeForward here because then t would be associated # with the name of the struct, not with the pointer to the struct: result = cacheGetType(m.forwTypeCache, t) if result == nil: result = getTypeName(t) - if not isImportedType(t): - appf(m.s[cfsForwardTypes], getForwardStructFormat(m), + if not isImportedType(t): + addf(m.s[cfsForwardTypes], getForwardStructFormat(m), [structOrUnion(t), result]) idTablePut(m.forwTypeCache, t, result) assert(cacheGetType(m.typeCache, t) == nil) - idTablePut(m.typeCache, t, con(result, "*")) - if not isImportedType(t): - if skipTypes(t.sons[0], typedescInst).kind != tyEmpty: + idTablePut(m.typeCache, t, result & "*") + if not isImportedType(t): + if skipTypes(t.sons[0], typedescInst).kind != tyEmpty: const cppSeq = "struct $2 : #TGenericSeq {$n" cSeq = "struct $2 {$n" & " #TGenericSeq Sup;$n" appcg(m, m.s[cfsSeqTypes], (if m.compileToCpp: cppSeq else: cSeq) & - " $1 data[SEQ_DECL_SIZE];$n" & + " $1 data[SEQ_DECL_SIZE];$n" & "};$n", [getTypeDescAux(m, t.sons[0], check), result]) - else: - result = toRope("TGenericSeq") - app(result, "*") - of tyArrayConstr, tyArray: + else: + result = rope("TGenericSeq") + add(result, "*") + of tyArrayConstr, tyArray: var n: BiggestInt = lengthOrd(t) if n <= 0: n = 1 # make an array of at least one element result = getTypeName(t) idTablePut(m.typeCache, t, result) if not isImportedType(t): let foo = getTypeDescAux(m, t.sons[1], check) - appf(m.s[cfsTypes], "typedef $1 $2[$3];$n", - [foo, result, toRope(n)]) + addf(m.s[cfsTypes], "typedef $1 $2[$3];$n", + [foo, result, rope(n)]) of tyObject, tyTuple: if isImportedCppType(t) and typ.kind == tyGenericInst: # for instantiated templates we do not go through the type cache as the # the type cache is not aware of 'tyGenericInst'. - result = getTypeName(t).con("<") - for i in 1 .. typ.len-2: - if i > 1: result.app(", ") - result.app(getTypeDescAux(m, typ.sons[i], check)) - result.app("> ") + let cppName = getTypeName(t) + var i = 0 + var chunkStart = 0 + while i < cppName.data.len: + if cppName.data[i] == '\'': + var chunkEnd = <i + var idx, stars: int + if scanCppGenericSlot(cppName.data, i, idx, stars): + result.add cppName.data.substr(chunkStart, chunkEnd) + chunkStart = i + + let typeInSlot = resolveStarsInCppType(typ, idx + 1, stars) + if typeInSlot == nil or typeInSlot.kind == tyEmpty: + result.add(~"void") + else: + result.add getTypeDescAux(m, typeInSlot, check) + else: + inc i + + if chunkStart != 0: + result.add cppName.data.substr(chunkStart) + else: + result = cppName & "<" + for i in 1 .. typ.len-2: + if i > 1: result.add(", ") + result.add(getTypeDescAux(m, typ.sons[i], check)) + result.add("> ") # always call for sideeffects: assert t.kind != tyTuple discard getRecordDesc(m, t, result, check) @@ -602,27 +658,27 @@ proc getTypeDescAux(m: BModule, typ: PType, check: var IntSet): PRope = result = cacheGetType(m.forwTypeCache, t) if result == nil: result = getTypeName(t) - if not isImportedType(t): - appf(m.s[cfsForwardTypes], getForwardStructFormat(m), + if not isImportedType(t): + addf(m.s[cfsForwardTypes], getForwardStructFormat(m), [structOrUnion(t), result]) idTablePut(m.forwTypeCache, t, result) idTablePut(m.typeCache, t, result) # always call for sideeffects: let recdesc = if t.kind != tyTuple: getRecordDesc(m, t, result, check) else: getTupleDesc(m, t, result, check) - if not isImportedType(t): app(m.s[cfsTypes], recdesc) + if not isImportedType(t): add(m.s[cfsTypes], recdesc) of tySet: case int(getSize(t)) - of 1: result = toRope("NU8") - of 2: result = toRope("NU16") - of 4: result = toRope("NU32") - of 8: result = toRope("NU64") - else: + of 1: result = rope("NU8") + of 2: result = rope("NU16") + of 4: result = rope("NU32") + of 8: result = rope("NU64") + else: result = getTypeName(t) idTablePut(m.typeCache, t, result) - if not isImportedType(t): - appf(m.s[cfsTypes], "typedef NU8 $1[$2];$n", - [result, toRope(getSize(t))]) - of tyGenericInst, tyDistinct, tyOrdinal, tyConst, tyMutable, + if not isImportedType(t): + addf(m.s[cfsTypes], "typedef NU8 $1[$2];$n", + [result, rope(getSize(t))]) + of tyGenericInst, tyDistinct, tyOrdinal, tyConst, tyMutable, tyIter, tyTypeDesc: result = getTypeDescAux(m, lastSon(t), check) else: @@ -631,7 +687,7 @@ proc getTypeDescAux(m: BModule, typ: PType, check: var IntSet): PRope = # fixes bug #145: excl(check, t.id) -proc getTypeDesc(m: BModule, typ: PType): PRope = +proc getTypeDesc(m: BModule, typ: PType): Rope = var check = initIntSet() result = getTypeDescAux(m, typ, check) @@ -639,216 +695,215 @@ type TClosureTypeKind = enum clHalf, clHalfWithEnv, clFull -proc getClosureType(m: BModule, t: PType, kind: TClosureTypeKind): PRope = +proc getClosureType(m: BModule, t: PType, kind: TClosureTypeKind): Rope = assert t.kind == tyProc var check = initIntSet() result = getTempName() - var rettype, desc: PRope + var rettype, desc: Rope genProcParams(m, t, rettype, desc, check, declareEnvironment=kind != clHalf) if not isImportedType(t): if t.callConv != ccClosure or kind != clFull: - appf(m.s[cfsTypes], "typedef $1_PTR($2, $3) $4;$n", - [toRope(CallingConvToStr[t.callConv]), rettype, result, desc]) + addf(m.s[cfsTypes], "typedef $1_PTR($2, $3) $4;$n", + [rope(CallingConvToStr[t.callConv]), rettype, result, desc]) else: - appf(m.s[cfsTypes], "typedef struct {$n" & - "N_NIMCALL_PTR($2, ClPrc) $3;$n" & + addf(m.s[cfsTypes], "typedef struct {$n" & + "N_NIMCALL_PTR($2, ClPrc) $3;$n" & "void* ClEnv;$n} $1;$n", [result, rettype, desc]) -proc getTypeDesc(m: BModule, magic: string): PRope = +proc getTypeDesc(m: BModule, magic: string): Rope = var sym = magicsys.getCompilerProc(magic) - if sym != nil: + if sym != nil: result = getTypeDesc(m, sym.typ) - else: + else: rawMessage(errSystemNeeds, magic) result = nil -proc finishTypeDescriptions(m: BModule) = +proc finishTypeDescriptions(m: BModule) = var i = 0 - while i < len(m.typeStack): + while i < len(m.typeStack): discard getTypeDesc(m, m.typeStack[i]) inc(i) template cgDeclFrmt*(s: PSym): string = s.constraint.strVal -proc genProcHeader(m: BModule, prc: PSym): PRope = - var - rettype, params: PRope +proc genProcHeader(m: BModule, prc: PSym): Rope = + var + rettype, params: Rope genCLineDir(result, prc.info) # using static is needed for inline procs if lfExportLib in prc.loc.flags: if m.isHeaderFile: - result.app "N_LIB_IMPORT " + result.add "N_LIB_IMPORT " else: - result.app "N_LIB_EXPORT " + result.add "N_LIB_EXPORT " elif prc.typ.callConv == ccInline: - result.app "static " + result.add "static " var check = initIntSet() fillLoc(prc.loc, locProc, prc.typ, mangleName(prc), OnUnknown) genProcParams(m, prc.typ, rettype, params, check) # careful here! don't access ``prc.ast`` as that could reload large parts of # the object graph! if prc.constraint.isNil: - appf(result, "$1($2, $3)$4", - [toRope(CallingConvToStr[prc.typ.callConv]), rettype, prc.loc.r, + addf(result, "$1($2, $3)$4", + [rope(CallingConvToStr[prc.typ.callConv]), rettype, prc.loc.r, params]) else: - result = ropef(prc.cgDeclFrmt, [rettype, prc.loc.r, params]) + result = prc.cgDeclFrmt % [rettype, prc.loc.r, params] # ------------------ type info generation ------------------------------------- -proc genTypeInfo(m: BModule, t: PType): PRope -proc getNimNode(m: BModule): PRope = - result = ropef("$1[$2]", [m.typeNodesName, toRope(m.typeNodes)]) +proc genTypeInfo(m: BModule, t: PType): Rope +proc getNimNode(m: BModule): Rope = + result = "$1[$2]" % [m.typeNodesName, rope(m.typeNodes)] inc(m.typeNodes) -proc genTypeInfoAuxBase(m: BModule; typ, origType: PType; name, base: PRope) = +proc genTypeInfoAuxBase(m: BModule; typ, origType: PType; name, base: Rope) = var nimtypeKind: int #allocMemTI(m, typ, name) if isObjLackingTypeField(typ): nimtypeKind = ord(tyPureObject) else: nimtypeKind = ord(typ.kind) - - var size: PRope - if tfIncompleteStruct in typ.flags: size = toRope"void*" + + var size: Rope + if tfIncompleteStruct in typ.flags: size = rope"void*" elif m.compileToCpp: size = getTypeDesc(m, origType) else: size = getTypeDesc(m, typ) - appf(m.s[cfsTypeInit3], - "$1.size = sizeof($2);$n" & "$1.kind = $3;$n" & "$1.base = $4;$n", - [name, size, toRope(nimtypeKind), base]) + addf(m.s[cfsTypeInit3], + "$1.size = sizeof($2);$n" & "$1.kind = $3;$n" & "$1.base = $4;$n", + [name, size, rope(nimtypeKind), base]) # compute type flags for GC optimization var flags = 0 if not containsGarbageCollectedRef(typ): flags = flags or 1 - if not canFormAcycle(typ): flags = flags or 2 + if not canFormAcycle(typ): flags = flags or 2 #else MessageOut("can contain a cycle: " & typeToString(typ)) - if flags != 0: - appf(m.s[cfsTypeInit3], "$1.flags = $2;$n", [name, toRope(flags)]) + if flags != 0: + addf(m.s[cfsTypeInit3], "$1.flags = $2;$n", [name, rope(flags)]) discard cgsym(m, "TNimType") - appf(m.s[cfsVars], "TNimType $1; /* $2 */$n", - [name, toRope(typeToString(typ))]) + addf(m.s[cfsVars], "TNimType $1; /* $2 */$n", + [name, rope(typeToString(typ))]) -proc genTypeInfoAux(m: BModule, typ, origType: PType, name: PRope) = - var base: PRope - if (sonsLen(typ) > 0) and (typ.sons[0] != nil): +proc genTypeInfoAux(m: BModule, typ, origType: PType, name: Rope) = + var base: Rope + if (sonsLen(typ) > 0) and (typ.sons[0] != nil): base = genTypeInfo(m, typ.sons[0]) - else: - base = toRope("0") + else: + base = rope("0") genTypeInfoAuxBase(m, typ, origType, name, base) -proc discriminatorTableName(m: BModule, objtype: PType, d: PSym): PRope = +proc discriminatorTableName(m: BModule, objtype: PType, d: PSym): Rope = # bugfix: we need to search the type that contains the discriminator: var objtype = objtype while lookupInRecord(objtype.n, d.name) == nil: objtype = objtype.sons[0] - if objtype.sym == nil: + if objtype.sym == nil: internalError(d.info, "anonymous obj with discriminator") - result = ropef("NimDT_$1_$2", [ - toRope(objtype.id), toRope(d.name.s.mangle)]) + result = "NimDT_$1_$2" % [rope(objtype.id), rope(d.name.s.mangle)] -proc discriminatorTableDecl(m: BModule, objtype: PType, d: PSym): PRope = +proc discriminatorTableDecl(m: BModule, objtype: PType, d: PSym): Rope = discard cgsym(m, "TNimNode") var tmp = discriminatorTableName(m, objtype, d) - result = ropef("TNimNode* $1[$2];$n", [tmp, toRope(lengthOrd(d.typ)+1)]) + result = "TNimNode* $1[$2];$n" % [tmp, rope(lengthOrd(d.typ)+1)] -proc genObjectFields(m: BModule, typ: PType, n: PNode, expr: PRope) = +proc genObjectFields(m: BModule, typ: PType, n: PNode, expr: Rope) = case n.kind - of nkRecList: + of nkRecList: var L = sonsLen(n) - if L == 1: + if L == 1: genObjectFields(m, typ, n.sons[0], expr) - elif L > 0: + elif L > 0: var tmp = getTempName() - appf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", [tmp, toRope(L)]) - for i in countup(0, L-1): + addf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", [tmp, rope(L)]) + for i in countup(0, L-1): var tmp2 = getNimNode(m) - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, toRope(i), tmp2]) + addf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, rope(i), tmp2]) genObjectFields(m, typ, n.sons[i], tmp2) - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n", - [expr, toRope(L), tmp]) + addf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n", + [expr, rope(L), tmp]) else: - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2;$n", [expr, toRope(L)]) - of nkRecCase: + addf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2;$n", [expr, rope(L)]) + of nkRecCase: assert(n.sons[0].kind == nkSym) var field = n.sons[0].sym var tmp = discriminatorTableName(m, typ, field) var L = lengthOrd(field.typ) assert L > 0 - appf(m.s[cfsTypeInit3], "$1.kind = 3;$n" & + addf(m.s[cfsTypeInit3], "$1.kind = 3;$n" & "$1.offset = offsetof($2, $3);$n" & "$1.typ = $4;$n" & "$1.name = $5;$n" & "$1.sons = &$6[0];$n" & - "$1.len = $7;$n", [expr, getTypeDesc(m, typ), field.loc.r, - genTypeInfo(m, field.typ), - makeCString(field.name.s), - tmp, toRope(L)]) - appf(m.s[cfsData], "TNimNode* $1[$2];$n", [tmp, toRope(L+1)]) - for i in countup(1, sonsLen(n)-1): + "$1.len = $7;$n", [expr, getTypeDesc(m, typ), field.loc.r, + genTypeInfo(m, field.typ), + makeCString(field.name.s), + tmp, rope(L)]) + addf(m.s[cfsData], "TNimNode* $1[$2];$n", [tmp, rope(L+1)]) + for i in countup(1, sonsLen(n)-1): var b = n.sons[i] # branch var tmp2 = getNimNode(m) genObjectFields(m, typ, lastSon(b), tmp2) case b.kind - of nkOfBranch: - if sonsLen(b) < 2: + of nkOfBranch: + if sonsLen(b) < 2: internalError(b.info, "genObjectFields; nkOfBranch broken") - for j in countup(0, sonsLen(b) - 2): - if b.sons[j].kind == nkRange: + for j in countup(0, sonsLen(b) - 2): + if b.sons[j].kind == nkRange: var x = int(getOrdValue(b.sons[j].sons[0])) var y = int(getOrdValue(b.sons[j].sons[1])) - while x <= y: - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, toRope(x), tmp2]) + while x <= y: + addf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, rope(x), tmp2]) inc(x) - else: - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", - [tmp, toRope(getOrdValue(b.sons[j])), tmp2]) - of nkElse: - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", - [tmp, toRope(L), tmp2]) + else: + addf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", + [tmp, rope(getOrdValue(b.sons[j])), tmp2]) + of nkElse: + addf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", + [tmp, rope(L), tmp2]) else: internalError(n.info, "genObjectFields(nkRecCase)") - of nkSym: + of nkSym: var field = n.sym - appf(m.s[cfsTypeInit3], "$1.kind = 1;$n" & + addf(m.s[cfsTypeInit3], "$1.kind = 1;$n" & "$1.offset = offsetof($2, $3);$n" & "$1.typ = $4;$n" & - "$1.name = $5;$n", [expr, getTypeDesc(m, typ), + "$1.name = $5;$n", [expr, getTypeDesc(m, typ), field.loc.r, genTypeInfo(m, field.typ), makeCString(field.name.s)]) else: internalError(n.info, "genObjectFields") - -proc genObjectInfo(m: BModule, typ, origType: PType, name: PRope) = + +proc genObjectInfo(m: BModule, typ, origType: PType, name: Rope) = if typ.kind == tyObject: genTypeInfoAux(m, typ, origType, name) - else: genTypeInfoAuxBase(m, typ, origType, name, toRope("0")) + else: genTypeInfoAuxBase(m, typ, origType, name, rope("0")) var tmp = getNimNode(m) if not isImportedCppType(typ): genObjectFields(m, typ, typ.n, tmp) - appf(m.s[cfsTypeInit3], "$1.node = &$2;$n", [name, tmp]) + addf(m.s[cfsTypeInit3], "$1.node = &$2;$n", [name, tmp]) var t = typ.sons[0] while t != nil: t = t.skipTypes(abstractInst) t.flags.incl tfObjHasKids t = t.sons[0] -proc genTupleInfo(m: BModule, typ: PType, name: PRope) = - genTypeInfoAuxBase(m, typ, typ, name, toRope("0")) +proc genTupleInfo(m: BModule, typ: PType, name: Rope) = + genTypeInfoAuxBase(m, typ, typ, name, rope("0")) var expr = getNimNode(m) var length = sonsLen(typ) - if length > 0: + if length > 0: var tmp = getTempName() - appf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", [tmp, toRope(length)]) - for i in countup(0, length - 1): + addf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", [tmp, rope(length)]) + for i in countup(0, length - 1): var a = typ.sons[i] var tmp2 = getNimNode(m) - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, toRope(i), tmp2]) - appf(m.s[cfsTypeInit3], "$1.kind = 1;$n" & - "$1.offset = offsetof($2, Field$3);$n" & + addf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, rope(i), tmp2]) + addf(m.s[cfsTypeInit3], "$1.kind = 1;$n" & + "$1.offset = offsetof($2, Field$3);$n" & "$1.typ = $4;$n" & - "$1.name = \"Field$3\";$n", - [tmp2, getTypeDesc(m, typ), toRope(i), genTypeInfo(m, a)]) - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n", - [expr, toRope(length), tmp]) - else: - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2;$n", - [expr, toRope(length)]) - appf(m.s[cfsTypeInit3], "$1.node = &$2;$n", [name, expr]) - -proc genEnumInfo(m: BModule, typ: PType, name: PRope) = + "$1.name = \"Field$3\";$n", + [tmp2, getTypeDesc(m, typ), rope(i), genTypeInfo(m, a)]) + addf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n", + [expr, rope(length), tmp]) + else: + addf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2;$n", + [expr, rope(length)]) + addf(m.s[cfsTypeInit3], "$1.node = &$2;$n", [name, expr]) + +proc genEnumInfo(m: BModule, typ: PType, name: Rope) = # Type information for enumerations is quite heavy, so we do some # optimizations here: The ``typ`` field is never set, as it is redundant # anyway. We generate a cstring array and a loop over it. Exceptional @@ -856,49 +911,49 @@ proc genEnumInfo(m: BModule, typ: PType, name: PRope) = genTypeInfoAux(m, typ, typ, name) var nodePtrs = getTempName() var length = sonsLen(typ.n) - appf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", - [nodePtrs, toRope(length)]) - var enumNames, specialCases: PRope + addf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", + [nodePtrs, rope(length)]) + var enumNames, specialCases: Rope var firstNimNode = m.typeNodes var hasHoles = false - for i in countup(0, length - 1): + for i in countup(0, length - 1): assert(typ.n.sons[i].kind == nkSym) var field = typ.n.sons[i].sym var elemNode = getNimNode(m) if field.ast == nil: # no explicit string literal for the enum field, so use field.name: - app(enumNames, makeCString(field.name.s)) + add(enumNames, makeCString(field.name.s)) else: - app(enumNames, makeCString(field.ast.strVal)) - if i < length - 1: app(enumNames, ", " & tnl) + add(enumNames, makeCString(field.ast.strVal)) + if i < length - 1: add(enumNames, ", " & tnl) if field.position != i or tfEnumHasHoles in typ.flags: - appf(specialCases, "$1.offset = $2;$n", [elemNode, toRope(field.position)]) + addf(specialCases, "$1.offset = $2;$n", [elemNode, rope(field.position)]) hasHoles = true var enumArray = getTempName() var counter = getTempName() - appf(m.s[cfsTypeInit1], "NI $1;$n", [counter]) - appf(m.s[cfsTypeInit1], "static char* NIM_CONST $1[$2] = {$n$3};$n", - [enumArray, toRope(length), enumNames]) - appf(m.s[cfsTypeInit3], "for ($1 = 0; $1 < $2; $1++) {$n" & + addf(m.s[cfsTypeInit1], "NI $1;$n", [counter]) + addf(m.s[cfsTypeInit1], "static char* NIM_CONST $1[$2] = {$n$3};$n", + [enumArray, rope(length), enumNames]) + addf(m.s[cfsTypeInit3], "for ($1 = 0; $1 < $2; $1++) {$n" & "$3[$1+$4].kind = 1;$n" & "$3[$1+$4].offset = $1;$n" & - "$3[$1+$4].name = $5[$1];$n" & "$6[$1] = &$3[$1+$4];$n" & "}$n", [counter, - toRope(length), m.typeNodesName, toRope(firstNimNode), enumArray, nodePtrs]) - app(m.s[cfsTypeInit3], specialCases) - appf(m.s[cfsTypeInit3], - "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n$4.node = &$1;$n", - [getNimNode(m), toRope(length), nodePtrs, name]) + "$3[$1+$4].name = $5[$1];$n" & "$6[$1] = &$3[$1+$4];$n" & "}$n", [counter, + rope(length), m.typeNodesName, rope(firstNimNode), enumArray, nodePtrs]) + add(m.s[cfsTypeInit3], specialCases) + addf(m.s[cfsTypeInit3], + "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n$4.node = &$1;$n", + [getNimNode(m), rope(length), nodePtrs, name]) if hasHoles: # 1 << 2 is {ntfEnumHole} - appf(m.s[cfsTypeInit3], "$1.flags = 1<<2;$n", [name]) + addf(m.s[cfsTypeInit3], "$1.flags = 1<<2;$n", [name]) -proc genSetInfo(m: BModule, typ: PType, name: PRope) = +proc genSetInfo(m: BModule, typ: PType, name: Rope) = assert(typ.sons[0] != nil) genTypeInfoAux(m, typ, typ, name) var tmp = getNimNode(m) - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 0;$n" & "$3.node = &$1;$n", - [tmp, toRope(firstOrd(typ)), name]) + addf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 0;$n" & "$3.node = &$1;$n", + [tmp, rope(firstOrd(typ)), name]) -proc genArrayInfo(m: BModule, typ: PType, name: PRope) = +proc genArrayInfo(m: BModule, typ: PType, name: Rope) = genTypeInfoAuxBase(m, typ, typ, name, genTypeInfo(m, typ.sons[1])) proc fakeClosureType(owner: PSym): PType = @@ -918,18 +973,18 @@ type include ccgtrav -proc genDeepCopyProc(m: BModule; s: PSym; result: PRope) = +proc genDeepCopyProc(m: BModule; s: PSym; result: Rope) = genProc(m, s) - appf(m.s[cfsTypeInit3], "$1.deepcopy =(void* (N_RAW_NIMCALL*)(void*))$2;$n", + addf(m.s[cfsTypeInit3], "$1.deepcopy =(void* (N_RAW_NIMCALL*)(void*))$2;$n", [result, s.loc.r]) -proc genTypeInfo(m: BModule, t: PType): PRope = +proc genTypeInfo(m: BModule, t: PType): Rope = let origType = t var t = getUniqueType(t) - result = ropef("NTI$1", [toRope(t.id)]) + result = "NTI$1" % [rope(t.id)] if containsOrIncl(m.typeInfoMarker, t.id): - return con("(&".toRope, result, ")".toRope) - + return "(&".rope & result & ")".rope + # getUniqueType doesn't skip tyDistinct when that has an overriden operation: while t.kind == tyDistinct: t = t.lastSon let owner = t.skipTypes(typedescPtrs).owner.getModule @@ -939,23 +994,23 @@ proc genTypeInfo(m: BModule, t: PType): PRope = # reference the type info as extern here discard cgsym(m, "TNimType") discard cgsym(m, "TNimNode") - appf(m.s[cfsVars], "extern TNimType $1; /* $2 */$n", - [result, toRope(typeToString(t))]) - return con("(&".toRope, result, ")".toRope) + addf(m.s[cfsVars], "extern TNimType $1; /* $2 */$n", + [result, rope(typeToString(t))]) + return "(&".rope & result & ")".rope case t.kind - of tyEmpty: result = toRope"0" + of tyEmpty: result = rope"0" of tyPointer, tyBool, tyChar, tyCString, tyString, tyInt..tyUInt64, tyVar: - genTypeInfoAuxBase(m, t, t, result, toRope"0") + genTypeInfoAuxBase(m, t, t, result, rope"0") of tyProc: if t.callConv != ccClosure: - genTypeInfoAuxBase(m, t, t, result, toRope"0") + genTypeInfoAuxBase(m, t, t, result, rope"0") else: genTupleInfo(m, fakeClosureType(t.owner), result) of tySequence, tyRef: genTypeInfoAux(m, t, t, result) if gSelectedGC >= gcMarkAndSweep: let markerProc = genTraverseProc(m, t, tiNew) - appf(m.s[cfsTypeInit3], "$1.marker = $2;$n", [result, markerProc]) + addf(m.s[cfsTypeInit3], "$1.marker = $2;$n", [result, markerProc]) of tyPtr, tyRange: genTypeInfoAux(m, t, t, result) of tyArrayConstr, tyArray: genArrayInfo(m, t, result) of tySet: genSetInfo(m, t, result) @@ -971,8 +1026,8 @@ proc genTypeInfo(m: BModule, t: PType): PRope = if t.deepCopy != nil: genDeepCopyProc(m, t.deepCopy, result) elif origType.deepCopy != nil: - genDeepCopyProc(m, origType.deepCopy, result) - result = con("(&".toRope, result, ")".toRope) + genDeepCopyProc(m, origType.deepCopy, result) + result = "(&".rope & result & ")".rope -proc genTypeSection(m: BModule, n: PNode) = +proc genTypeSection(m: BModule, n: PNode) = discard diff --git a/compiler/ccgutils.nim b/compiler/ccgutils.nim index 25c1a12e5..4e94c1867 100644 --- a/compiler/ccgutils.nim +++ b/compiler/ccgutils.nim @@ -193,13 +193,13 @@ proc mangle*(name: string): string = else: add(result, "HEX" & toHex(ord(c), 2)) -proc makeLLVMString*(s: string): PRope = +proc makeLLVMString*(s: string): Rope = const MaxLineLength = 64 result = nil var res = "c\"" for i in countup(0, len(s) - 1): if (i + 1) mod MaxLineLength == 0: - app(result, toRope(res)) + add(result, rope(res)) setLen(res, 0) case s[i] of '\0'..'\x1F', '\x80'..'\xFF', '\"', '\\': @@ -207,6 +207,6 @@ proc makeLLVMString*(s: string): PRope = add(res, toHex(ord(s[i]), 2)) else: add(res, s[i]) add(res, "\\00\"") - app(result, toRope(res)) + add(result, rope(res)) initTypeTables() diff --git a/compiler/cgen.nim b/compiler/cgen.nim index cc376d87a..da9c6f653 100644 --- a/compiler/cgen.nim +++ b/compiler/cgen.nim @@ -9,14 +9,16 @@ ## This module implements the C code generator. -import - ast, astalgo, strutils, hashes, trees, platform, magicsys, extccomp, +import + ast, astalgo, hashes, trees, platform, magicsys, extccomp, options, intsets, nversion, nimsets, msgs, crc, bitsets, idents, lists, types, ccgutils, os, - times, ropes, math, passes, rodread, wordrecg, treetab, cgmeth, condsyms, + ropes, math, passes, rodread, wordrecg, treetab, cgmeth, condsyms, rodutils, renderer, idgen, cgendata, ccgmerge, semfold, aliases, lowerings, semparallel +import strutils except `%` # collides with ropes.`%` + when options.hasTinyCBackend: import tccgen @@ -25,7 +27,7 @@ when options.hasTinyCBackend: var generatedHeader: BModule -proc addForwardedProc(m: BModule, prc: PSym) = +proc addForwardedProc(m: BModule, prc: PSym) = m.forwardedProcs.add(prc) inc(gForwardedProcsCounter) @@ -33,7 +35,7 @@ proc getCgenModule(s: PSym): BModule = result = if s.position >= 0 and s.position < gModules.len: gModules[s.position] else: nil -proc findPendingModule(m: BModule, s: PSym): BModule = +proc findPendingModule(m: BModule, s: PSym): BModule = var ms = getModule(s) result = gModules[ms.position] @@ -41,21 +43,21 @@ proc emitLazily(s: PSym): bool {.inline.} = result = optDeadCodeElim in gGlobalOptions or sfDeadCodeElim in getModule(s).flags -proc initLoc(result: var TLoc, k: TLocKind, typ: PType, s: TStorageLoc) = +proc initLoc(result: var TLoc, k: TLocKind, typ: PType, s: TStorageLoc) = result.k = k result.s = s result.t = typ result.r = nil result.flags = {} -proc fillLoc(a: var TLoc, k: TLocKind, typ: PType, r: PRope, s: TStorageLoc) = +proc fillLoc(a: var TLoc, k: TLocKind, typ: PType, r: Rope, s: TStorageLoc) = # fills the loc if it is not already initialized - if a.k == locNone: + if a.k == locNone: a.k = k a.t = typ a.s = s if a.r == nil: a.r = r - + proc isSimpleConst(typ: PType): bool = let t = skipTypes(typ, abstractVar) result = t.kind notin @@ -67,44 +69,44 @@ proc useStringh(m: BModule) = m.includesStringh = true discard lists.includeStr(m.headerFiles, "<string.h>") -proc useHeader(m: BModule, sym: PSym) = - if lfHeader in sym.loc.flags: +proc useHeader(m: BModule, sym: PSym) = + if lfHeader in sym.loc.flags: assert(sym.annex != nil) discard lists.includeStr(m.headerFiles, getStr(sym.annex.path)) -proc cgsym(m: BModule, name: string): PRope +proc cgsym(m: BModule, name: string): Rope -proc ropecg(m: BModule, frmt: TFormatStr, args: varargs[PRope]): PRope = +proc ropecg(m: BModule, frmt: FormatStr, args: varargs[Rope]): Rope = var i = 0 var length = len(frmt) result = nil var num = 0 - while i < length: - if frmt[i] == '$': + while i < length: + if frmt[i] == '$': inc(i) # skip '$' case frmt[i] - of '$': - app(result, "$") + of '$': + add(result, "$") inc(i) - of '#': + of '#': inc(i) - app(result, args[num]) + add(result, args[num]) inc(num) - of '0'..'9': + of '0'..'9': var j = 0 - while true: + while true: j = (j * 10) + ord(frmt[i]) - ord('0') inc(i) - if i >= length or not (frmt[i] in {'0'..'9'}): break + if i >= length or not (frmt[i] in {'0'..'9'}): break num = j - if j > high(args) + 1: + if j > high(args) + 1: internalError("ropes: invalid format string $" & $j) - app(result, args[j-1]) + add(result, args[j-1]) of 'n': - if optLineDir notin gOptions: app(result, rnl) + if optLineDir notin gOptions: add(result, rnl) inc(i) - of 'N': - app(result, rnl) + of 'N': + add(result, rnl) inc(i) else: internalError("ropes: invalid format string $" & frmt[i]) elif frmt[i] == '#' and frmt[i+1] in IdentStartChars: @@ -113,93 +115,102 @@ proc ropecg(m: BModule, frmt: TFormatStr, args: varargs[PRope]): PRope = while frmt[j] in IdentChars: inc(j) var ident = substr(frmt, i, j-1) i = j - app(result, cgsym(m, ident)) + add(result, cgsym(m, ident)) elif frmt[i] == '#' and frmt[i+1] == '$': inc(i, 2) var j = 0 - while frmt[i] in Digits: + while frmt[i] in Digits: j = (j * 10) + ord(frmt[i]) - ord('0') inc(i) - app(result, cgsym(m, args[j-1].ropeToStr)) + add(result, cgsym(m, $args[j-1])) var start = i - while i < length: + while i < length: if frmt[i] != '$' and frmt[i] != '#': inc(i) - else: break - if i - 1 >= start: - app(result, substr(frmt, start, i - 1)) + else: break + if i - 1 >= start: + add(result, substr(frmt, start, i - 1)) -template rfmt(m: BModule, fmt: string, args: varargs[PRope]): expr = +template rfmt(m: BModule, fmt: string, args: varargs[Rope]): expr = ropecg(m, fmt, args) -proc appcg(m: BModule, c: var PRope, frmt: TFormatStr, - args: varargs[PRope]) = - app(c, ropecg(m, frmt, args)) +proc appcg(m: BModule, c: var Rope, frmt: FormatStr, + args: varargs[Rope]) = + add(c, ropecg(m, frmt, args)) -proc appcg(m: BModule, s: TCFileSection, frmt: TFormatStr, - args: varargs[PRope]) = - app(m.s[s], ropecg(m, frmt, args)) +proc appcg(m: BModule, s: TCFileSection, frmt: FormatStr, + args: varargs[Rope]) = + add(m.s[s], ropecg(m, frmt, args)) -proc appcg(p: BProc, s: TCProcSection, frmt: TFormatStr, - args: varargs[PRope]) = - app(p.s(s), ropecg(p.module, frmt, args)) +proc appcg(p: BProc, s: TCProcSection, frmt: FormatStr, + args: varargs[Rope]) = + add(p.s(s), ropecg(p.module, frmt, args)) -var indent = "\t".toRope -proc indentLine(p: BProc, r: PRope): PRope = +var indent = "\t".rope +proc indentLine(p: BProc, r: Rope): Rope = result = r for i in countup(0, p.blocks.len-1): prepend(result, indent) - -proc line(p: BProc, s: TCProcSection, r: PRope) = - app(p.s(s), indentLine(p, r)) + +proc line(p: BProc, s: TCProcSection, r: Rope) = + add(p.s(s), indentLine(p, r)) proc line(p: BProc, s: TCProcSection, r: string) = - app(p.s(s), indentLine(p, r.toRope)) + add(p.s(s), indentLine(p, r.rope)) -proc lineF(p: BProc, s: TCProcSection, frmt: TFormatStr, - args: varargs[PRope]) = - app(p.s(s), indentLine(p, ropef(frmt, args))) +proc lineF(p: BProc, s: TCProcSection, frmt: FormatStr, + args: openarray[Rope]) = + add(p.s(s), indentLine(p, frmt % args)) -proc lineCg(p: BProc, s: TCProcSection, frmt: TFormatStr, - args: varargs[PRope]) = - app(p.s(s), indentLine(p, ropecg(p.module, frmt, args))) +proc lineCg(p: BProc, s: TCProcSection, frmt: FormatStr, + args: varargs[Rope]) = + add(p.s(s), indentLine(p, ropecg(p.module, frmt, args))) -proc linefmt(p: BProc, s: TCProcSection, frmt: TFormatStr, - args: varargs[PRope]) = - app(p.s(s), indentLine(p, ropecg(p.module, frmt, args))) +proc linefmt(p: BProc, s: TCProcSection, frmt: FormatStr, + args: varargs[Rope]) = + add(p.s(s), indentLine(p, ropecg(p.module, frmt, args))) -proc appLineCg(p: BProc, r: var PRope, frmt: TFormatStr, - args: varargs[PRope]) = - app(r, indentLine(p, ropecg(p.module, frmt, args))) +proc appLineCg(p: BProc, r: var Rope, frmt: FormatStr, + args: varargs[Rope]) = + add(r, indentLine(p, ropecg(p.module, frmt, args))) proc safeLineNm(info: TLineInfo): int = result = toLinenumber(info) if result < 0: result = 0 # negative numbers are not allowed in #line -proc genCLineDir(r: var PRope, filename: string, line: int) = +proc genCLineDir(r: var Rope, filename: string, line: int) = assert line >= 0 if optLineDir in gOptions: - appf(r, "$N#line $2 $1$N", - [toRope(makeSingleLineCString(filename)), toRope(line)]) + addf(r, "$N#line $2 $1$N", + [rope(makeSingleLineCString(filename)), rope(line)]) -proc genCLineDir(r: var PRope, info: TLineInfo) = +proc genCLineDir(r: var Rope, info: TLineInfo) = genCLineDir(r, info.toFullPath, info.safeLineNm) +proc freshLineInfo(p: BProc; info: TLineInfo): bool = + if p.lastLineInfo.line != info.line or + p.lastLineInfo.fileIndex != info.fileIndex: + p.lastLineInfo.line = info.line + p.lastLineInfo.fileIndex = info.fileIndex + result = true + proc genLineDir(p: BProc, t: PNode) = var line = t.info.safeLineNm if optEmbedOrigSrc in gGlobalOptions: - app(p.s(cpsStmts), con(~"//", t.info.sourceLine, rnl)) + add(p.s(cpsStmts), ~"//" & t.info.sourceLine & rnl) genCLineDir(p.s(cpsStmts), t.info.toFullPath, line) if ({optStackTrace, optEndb} * p.options == {optStackTrace, optEndb}) and (p.prc == nil or sfPure notin p.prc.flags): - linefmt(p, cpsStmts, "#endb($1, $2);$n", - line.toRope, makeCString(toFilename(t.info))) + if freshLineInfo(p, t.info): + linefmt(p, cpsStmts, "#endb($1, $2);$n", + line.rope, makeCString(toFilename(t.info))) elif ({optLineTrace, optStackTrace} * p.options == {optLineTrace, optStackTrace}) and (p.prc == nil or sfPure notin p.prc.flags) and t.info.fileIndex >= 0: - linefmt(p, cpsStmts, "nimln($1, $2);$n", - line.toRope, t.info.quotedFilename) + if freshLineInfo(p, t.info): + linefmt(p, cpsStmts, "nimln($1, $2);$n", + line.rope, t.info.quotedFilename) proc postStmtActions(p: BProc) {.inline.} = - app(p.s(cpsStmts), p.module.injectStmt) + add(p.s(cpsStmts), p.module.injectStmt) proc accessThreadLocalVar(p: BProc, s: PSym) proc emulatedThreadVars(): bool {.inline.} @@ -212,21 +223,21 @@ include "ccgtypes.nim" # ------------------------------ Manager of temporaries ------------------ -proc rdLoc(a: TLoc): PRope = +proc rdLoc(a: TLoc): Rope = # 'read' location (deref if indirect) result = a.r - if lfIndirect in a.flags: result = ropef("(*$1)", [result]) + if lfIndirect in a.flags: result = "(*$1)" % [result] -proc addrLoc(a: TLoc): PRope = +proc addrLoc(a: TLoc): Rope = result = a.r if lfIndirect notin a.flags and mapType(a.t) != ctArray: - result = con("(&", result).con(")") + result = "(&" & result & ")" -proc rdCharLoc(a: TLoc): PRope = +proc rdCharLoc(a: TLoc): Rope = # read a location that may need a char-cast: result = rdLoc(a) if skipTypes(a.t, abstractRange).kind == tyChar: - result = ropef("((NU8)($1))", [result]) + result = "((NU8)($1))" % [result] proc genObjectInit(p: BProc, section: TCProcSection, t: PType, a: TLoc, takeAddr: bool) = @@ -235,11 +246,11 @@ proc genObjectInit(p: BProc, section: TCProcSection, t: PType, a: TLoc, discard of frHeader: var r = rdLoc(a) - if not takeAddr: r = ropef("(*$1)", [r]) + if not takeAddr: r = "(*$1)" % [r] var s = skipTypes(t, abstractInst) if not p.module.compileToCpp: while (s.kind == tyObject) and (s.sons[0] != nil): - app(r, ".Sup") + add(r, ".Sup") s = skipTypes(s.sons[0], abstractInst) linefmt(p, section, "$1.m_type = $2;$n", r, genTypeInfo(p.module, t)) of frEmbedded: @@ -261,11 +272,13 @@ proc isComplexValueType(t: PType): bool {.inline.} = proc resetLoc(p: BProc, loc: var TLoc) = let containsGcRef = containsGarbageCollectedRef(loc.t) - if not isComplexValueType(skipTypes(loc.t, abstractVarRange)): + let typ = skipTypes(loc.t, abstractVarRange) + if isImportedCppType(typ): return + if not isComplexValueType(typ): if containsGcRef: var nilLoc: TLoc initLoc(nilLoc, locTemp, loc.t, OnStack) - nilLoc.r = toRope("NIM_NIL") + nilLoc.r = rope("NIM_NIL") genRefAssign(p, loc, nilLoc, {afSrcIsNil}) else: linefmt(p, cpsStmts, "$1 = 0;$n", rdLoc(loc)) @@ -282,37 +295,39 @@ proc resetLoc(p: BProc, loc: var TLoc) = useStringh(p.module) linefmt(p, cpsStmts, "memset((void*)$1, 0, sizeof($2));$n", addrLoc(loc), rdLoc(loc)) - # XXX: We can be extra clever here and call memset only + # XXX: We can be extra clever here and call memset only # on the bytes following the m_type field? genObjectInit(p, cpsStmts, loc.t, loc, true) proc constructLoc(p: BProc, loc: TLoc, isTemp = false) = - if not isComplexValueType(skipTypes(loc.t, abstractRange)): + let typ = skipTypes(loc.t, abstractRange) + if not isComplexValueType(typ): linefmt(p, cpsStmts, "$1 = 0;$n", rdLoc(loc)) else: if not isTemp or containsGarbageCollectedRef(loc.t): # don't use memset for temporary values for performance if we can # avoid it: - useStringh(p.module) - linefmt(p, cpsStmts, "memset((void*)$1, 0, sizeof($2));$n", - addrLoc(loc), rdLoc(loc)) + if not isImportedCppType(typ): + useStringh(p.module) + linefmt(p, cpsStmts, "memset((void*)$1, 0, sizeof($2));$n", + addrLoc(loc), rdLoc(loc)) genObjectInit(p, cpsStmts, loc.t, loc, true) proc initLocalVar(p: BProc, v: PSym, immediateAsgn: bool) = if sfNoInit notin v.flags: # we know it is a local variable and thus on the stack! # If ``not immediateAsgn`` it is not initialized in a binding like - # ``var v = X`` and thus we need to init it. + # ``var v = X`` and thus we need to init it. # If ``v`` contains a GC-ref we may pass it to ``unsureAsgnRef`` somehow # which requires initialization. However this can really only happen if - # ``var v = X()`` gets transformed into ``X(&v)``. + # ``var v = X()`` gets transformed into ``X(&v)``. # Nowadays the logic in ccgcalls deals with this case however. if not immediateAsgn: constructLoc(p, v.loc) -proc getTemp(p: BProc, t: PType, result: var TLoc; needsInit=false) = +proc getTemp(p: BProc, t: PType, result: var TLoc; needsInit=false) = inc(p.labels) - result.r = con("LOC", toRope(p.labels)) + result.r = "LOC" & rope(p.labels) linefmt(p, cpsLocals, "$1 $2;$n", getTypeDesc(p.module, t), result.r) result.k = locTemp #result.a = - 1 @@ -327,9 +342,9 @@ proc keepAlive(p: BProc, toKeepAlive: TLoc) = # of interior pointers instead if optRefcGC notin gGlobalOptions: return var result: TLoc - var fid = toRope(p.gcFrameId) - result.r = con("GCFRAME.F", fid) - appf(p.gcFrameType, " $1 F$2;$n", + var fid = rope(p.gcFrameId) + result.r = "GCFRAME.F" & fid + addf(p.gcFrameType, " $1 F$2;$n", [getTypeDesc(p.module, toKeepAlive.t), fid]) inc(p.gcFrameId) result.k = locTemp @@ -346,116 +361,105 @@ proc keepAlive(p: BProc, toKeepAlive: TLoc) = "memcpy((void*)$1, (NIM_CONST void*)$2, sizeof($3));$n", addrLoc(result), addrLoc(toKeepAlive), rdLoc(result)) -proc initGCFrame(p: BProc): PRope = - if p.gcFrameId > 0: result = ropef("struct {$1} GCFRAME;$n", p.gcFrameType) +proc initGCFrame(p: BProc): Rope = + if p.gcFrameId > 0: result = "struct {$1} GCFRAME;$n" % [p.gcFrameType] -proc deinitGCFrame(p: BProc): PRope = +proc deinitGCFrame(p: BProc): Rope = if p.gcFrameId > 0: result = ropecg(p.module, "if (((NU)&GCFRAME) < 4096) #nimGCFrame(&GCFRAME);$n") - -proc allocParam(p: BProc, s: PSym) = - assert(s.kind == skParam) - if lfParamCopy notin s.loc.flags: - inc(p.labels) - var tmp = con("%LOC", toRope(p.labels)) - incl(s.loc.flags, lfParamCopy) - incl(s.loc.flags, lfIndirect) - lineF(p, cpsInit, "$1 = alloca $3$n" & "store $3 $2, $3* $1$n", - [tmp, s.loc.r, getTypeDesc(p.module, s.loc.t)]) - s.loc.r = tmp - -proc localDebugInfo(p: BProc, s: PSym) = - if {optStackTrace, optEndb} * p.options != {optStackTrace, optEndb}: return + +proc localDebugInfo(p: BProc, s: PSym) = + if {optStackTrace, optEndb} * p.options != {optStackTrace, optEndb}: return # XXX work around a bug: No type information for open arrays possible: if skipTypes(s.typ, abstractVar).kind in {tyOpenArray, tyVarargs}: return - var a = con("&", s.loc.r) + var a = "&" & s.loc.r if s.kind == skParam and ccgIntroducedPtr(s): a = s.loc.r lineF(p, cpsInit, "F.s[$1].address = (void*)$3; F.s[$1].typ = $4; F.s[$1].name = $2;$n", - [p.maxFrameLen.toRope, makeCString(normalize(s.name.s)), a, + [p.maxFrameLen.rope, makeCString(normalize(s.name.s)), a, genTypeInfo(p.module, s.loc.t)]) inc(p.maxFrameLen) inc p.blocks[p.blocks.len-1].frameLen -proc localVarDecl(p: BProc; s: PSym): PRope = - if s.loc.k == locNone: +proc localVarDecl(p: BProc; s: PSym): Rope = + if s.loc.k == locNone: fillLoc(s.loc, locLocalVar, s.typ, mangleName(s), OnStack) if s.kind == skLet: incl(s.loc.flags, lfNoDeepCopy) result = getTypeDesc(p.module, s.loc.t) if s.constraint.isNil: - if sfRegister in s.flags: app(result, " register") + if sfRegister in s.flags: add(result, " register") #elif skipTypes(s.typ, abstractInst).kind in GcTypeKinds: - # app(decl, " GC_GUARD") - if sfVolatile in s.flags: app(result, " volatile") - app(result, " ") - app(result, s.loc.r) + # add(decl, " GC_GUARD") + if sfVolatile in s.flags: add(result, " volatile") + add(result, " ") + add(result, s.loc.r) else: - result = ropef(s.cgDeclFrmt, result, s.loc.r) + result = s.cgDeclFrmt % [result, s.loc.r] proc assignLocalVar(p: BProc, s: PSym) = #assert(s.loc.k == locNone) # not yet assigned # this need not be fulfilled for inline procs; they are regenerated # for each module that uses them! - let decl = localVarDecl(p, s).con(";" & tnl) + let decl = localVarDecl(p, s) & ";" & tnl line(p, cpsLocals, decl) localDebugInfo(p, s) include ccgthreadvars proc varInDynamicLib(m: BModule, sym: PSym) -proc mangleDynLibProc(sym: PSym): PRope +proc mangleDynLibProc(sym: PSym): Rope -proc assignGlobalVar(p: BProc, s: PSym) = - if s.loc.k == locNone: +proc assignGlobalVar(p: BProc, s: PSym) = + if s.loc.k == locNone: fillLoc(s.loc, locGlobalVar, s.typ, mangleName(s), OnHeap) - + if lfDynamicLib in s.loc.flags: var q = findPendingModule(p.module, s) - if q != nil and not containsOrIncl(q.declaredThings, s.id): + if q != nil and not containsOrIncl(q.declaredThings, s.id): varInDynamicLib(q, s) else: s.loc.r = mangleDynLibProc(s) return useHeader(p.module, s) if lfNoDecl in s.loc.flags: return - if sfThread in s.flags: + if sfThread in s.flags: declareThreadVar(p.module, s, sfImportc in s.flags) - else: - var decl: PRope = nil + else: + var decl: Rope = nil var td = getTypeDesc(p.module, s.loc.t) if s.constraint.isNil: - if sfImportc in s.flags: app(decl, "extern ") - app(decl, td) - if sfRegister in s.flags: app(decl, " register") - if sfVolatile in s.flags: app(decl, " volatile") - appf(decl, " $1;$n", [s.loc.r]) + if sfImportc in s.flags: add(decl, "extern ") + add(decl, td) + if sfRegister in s.flags: add(decl, " register") + if sfVolatile in s.flags: add(decl, " volatile") + addf(decl, " $1;$n", [s.loc.r]) else: - decl = ropef(s.cgDeclFrmt & ";$n", td, s.loc.r) - app(p.module.s[cfsVars], decl) + decl = (s.cgDeclFrmt & ";$n") % [td, s.loc.r] + add(p.module.s[cfsVars], decl) if p.withinLoop > 0: # fixes tests/run/tzeroarray: resetLoc(p, s.loc) if p.module.module.options * {optStackTrace, optEndb} == - {optStackTrace, optEndb}: - appcg(p.module, p.module.s[cfsDebugInit], - "#dbgRegisterGlobal($1, &$2, $3);$n", - [makeCString(normalize(s.owner.name.s & '.' & s.name.s)), + {optStackTrace, optEndb}: + appcg(p.module, p.module.s[cfsDebugInit], + "#dbgRegisterGlobal($1, &$2, $3);$n", + [makeCString(normalize(s.owner.name.s & '.' & s.name.s)), s.loc.r, genTypeInfo(p.module, s.typ)]) - -proc assignParam(p: BProc, s: PSym) = + +proc assignParam(p: BProc, s: PSym) = assert(s.loc.r != nil) localDebugInfo(p, s) -proc fillProcLoc(sym: PSym) = - if sym.loc.k == locNone: +proc fillProcLoc(sym: PSym) = + if sym.loc.k == locNone: fillLoc(sym.loc, locProc, sym.typ, mangleName(sym), OnStack) - -proc getLabel(p: BProc): TLabel = + +proc getLabel(p: BProc): TLabel = inc(p.labels) - result = con("LA", toRope(p.labels)) + result = "LA" & rope(p.labels) -proc fixLabel(p: BProc, labl: TLabel) = +proc fixLabel(p: BProc, labl: TLabel) = lineF(p, cpsStmts, "$1: ;$n", [labl]) proc genVarPrototype(m: BModule, sym: PSym) @@ -465,8 +469,9 @@ proc expr(p: BProc, n: PNode, d: var TLoc) proc genProcPrototype(m: BModule, sym: PSym) proc putLocIntoDest(p: BProc, d: var TLoc, s: TLoc) proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) -proc intLiteral(i: BiggestInt): PRope -proc genLiteral(p: BProc, n: PNode): PRope +proc intLiteral(i: BiggestInt): Rope +proc genLiteral(p: BProc, n: PNode): Rope +proc genOtherArg(p: BProc; ri: PNode; i: int; typ: PType): Rope proc initLocExpr(p: BProc, e: PNode, result: var TLoc) = initLoc(result, locNone, e.typ, OnUnknown) @@ -477,63 +482,63 @@ proc initLocExprSingleUse(p: BProc, e: PNode, result: var TLoc) = result.flags.incl lfSingleUse expr(p, e, result) -proc lenField(p: BProc): PRope = - result = toRope(if p.module.compileToCpp: "len" else: "Sup.len") +proc lenField(p: BProc): Rope = + result = rope(if p.module.compileToCpp: "len" else: "Sup.len") include ccgcalls, "ccgstmts.nim", "ccgexprs.nim" # ----------------------------- dynamic library handling ----------------- -# We don't finalize dynamic libs as this does the OS for us. +# We don't finalize dynamic libs as the OS does this for us. proc isGetProcAddr(lib: PLib): bool = let n = lib.path - result = n.kind in nkCallKinds and n.typ != nil and + result = n.kind in nkCallKinds and n.typ != nil and n.typ.kind in {tyPointer, tyProc} -proc loadDynamicLib(m: BModule, lib: PLib) = +proc loadDynamicLib(m: BModule, lib: PLib) = assert(lib != nil) - if not lib.generated: + if not lib.generated: lib.generated = true var tmp = getGlobalTempName() assert(lib.name == nil) lib.name = tmp # BUGFIX: cgsym has awful side-effects - appf(m.s[cfsVars], "static void* $1;$n", [tmp]) + addf(m.s[cfsVars], "static void* $1;$n", [tmp]) if lib.path.kind in {nkStrLit..nkTripleStrLit}: var s: TStringSeq = @[] libCandidates(lib.path.strVal, s) if gVerbosity >= 2: msgWriteln("Dependency: " & lib.path.strVal) - var loadlib: PRope = nil - for i in countup(0, high(s)): + var loadlib: Rope = nil + for i in countup(0, high(s)): inc(m.labels) - if i > 0: app(loadlib, "||") - appcg(m, loadlib, "($1 = #nimLoadLibrary((#NimStringDesc*) &$2))$n", + if i > 0: add(loadlib, "||") + appcg(m, loadlib, "($1 = #nimLoadLibrary((#NimStringDesc*) &$2))$n", [tmp, getStrLit(m, s[i])]) - appcg(m, m.s[cfsDynLibInit], - "if (!($1)) #nimLoadLibraryError((#NimStringDesc*) &$2);$n", - [loadlib, getStrLit(m, lib.path.strVal)]) + appcg(m, m.s[cfsDynLibInit], + "if (!($1)) #nimLoadLibraryError((#NimStringDesc*) &$2);$n", + [loadlib, getStrLit(m, lib.path.strVal)]) else: var p = newProc(nil, m) p.options = p.options - {optStackTrace, optEndb} var dest: TLoc initLocExpr(p, lib.path, dest) - app(m.s[cfsVars], p.s(cpsLocals)) - app(m.s[cfsDynLibInit], p.s(cpsInit)) - app(m.s[cfsDynLibInit], p.s(cpsStmts)) - appcg(m, m.s[cfsDynLibInit], - "if (!($1 = #nimLoadLibrary($2))) #nimLoadLibraryError($2);$n", + add(m.s[cfsVars], p.s(cpsLocals)) + add(m.s[cfsDynLibInit], p.s(cpsInit)) + add(m.s[cfsDynLibInit], p.s(cpsStmts)) + appcg(m, m.s[cfsDynLibInit], + "if (!($1 = #nimLoadLibrary($2))) #nimLoadLibraryError($2);$n", [tmp, rdLoc(dest)]) - + if lib.name == nil: internalError("loadDynamicLib") - -proc mangleDynLibProc(sym: PSym): PRope = - if sfCompilerProc in sym.flags: + +proc mangleDynLibProc(sym: PSym): Rope = + if sfCompilerProc in sym.flags: # NOTE: sym.loc.r is the external name! - result = toRope(sym.name.s) + result = rope(sym.name.s) else: - result = ropef("Dl_$1", [toRope(sym.id)]) - -proc symInDynamicLib(m: BModule, sym: PSym) = + result = "Dl_$1" % [rope(sym.id)] + +proc symInDynamicLib(m: BModule, sym: PSym) = var lib = sym.annex let isCall = isGetProcAddr(lib) var extname = sym.loc.r @@ -546,32 +551,30 @@ proc symInDynamicLib(m: BModule, sym: PSym) = let n = lib.path var a: TLoc initLocExpr(m.initProc, n[0], a) - var params = con(rdLoc(a), "(") + var params = rdLoc(a) & "(" for i in 1 .. n.len-2: initLocExpr(m.initProc, n[i], a) - params.app(rdLoc(a)) - params.app(", ") - let load = ropef("\t$1 = ($2) ($3$4));$n", - [tmp, getTypeDesc(m, sym.typ), - params, makeCString(ropeToStr(extname))]) + params.add(rdLoc(a)) + params.add(", ") + let load = "\t$1 = ($2) ($3$4));$n" % + [tmp, getTypeDesc(m, sym.typ), params, makeCString($extname)] var last = lastSon(n) if last.kind == nkHiddenStdConv: last = last.sons[1] internalAssert(last.kind == nkStrLit) let idx = last.strVal if idx.len == 0: - app(m.initProc.s(cpsStmts), load) + add(m.initProc.s(cpsStmts), load) elif idx.len == 1 and idx[0] in {'0'..'9'}: - app(m.extensionLoaders[idx[0]], load) + add(m.extensionLoaders[idx[0]], load) else: internalError(sym.info, "wrong index: " & idx) else: - appcg(m, m.s[cfsDynLibInit], - "\t$1 = ($2) #nimGetProcAddr($3, $4);$n", - [tmp, getTypeDesc(m, sym.typ), - lib.name, makeCString(ropeToStr(extname))]) - appf(m.s[cfsVars], "$2 $1;$n", [sym.loc.r, getTypeDesc(m, sym.loc.t)]) + appcg(m, m.s[cfsDynLibInit], + "\t$1 = ($2) #nimGetProcAddr($3, $4);$n", + [tmp, getTypeDesc(m, sym.typ), lib.name, makeCString($extname)]) + addf(m.s[cfsVars], "$2 $1;$n", [sym.loc.r, getTypeDesc(m, sym.loc.t)]) -proc varInDynamicLib(m: BModule, sym: PSym) = +proc varInDynamicLib(m: BModule, sym: PSym) = var lib = sym.annex var extname = sym.loc.r loadDynamicLib(m, lib) @@ -579,20 +582,19 @@ proc varInDynamicLib(m: BModule, sym: PSym) = var tmp = mangleDynLibProc(sym) sym.loc.r = tmp # from now on we only need the internal name inc(m.labels, 2) - appcg(m, m.s[cfsDynLibInit], - "$1 = ($2*) #nimGetProcAddr($3, $4);$n", - [tmp, getTypeDesc(m, sym.typ), - lib.name, makeCString(ropeToStr(extname))]) - appf(m.s[cfsVars], "$2* $1;$n", + appcg(m, m.s[cfsDynLibInit], + "$1 = ($2*) #nimGetProcAddr($3, $4);$n", + [tmp, getTypeDesc(m, sym.typ), lib.name, makeCString($extname)]) + addf(m.s[cfsVars], "$2* $1;$n", [sym.loc.r, getTypeDesc(m, sym.loc.t)]) proc symInDynamicLibPartial(m: BModule, sym: PSym) = sym.loc.r = mangleDynLibProc(sym) sym.typ.sym = nil # generate a new name -proc cgsym(m: BModule, name: string): PRope = +proc cgsym(m: BModule, name: string): Rope = var sym = magicsys.getCompilerProc(name) - if sym != nil: + if sym != nil: case sym.kind of skProc, skMethod, skConverter, skIterators: genProc(m, sym) of skVar, skResult, skLet: genVarPrototype(m, sym) @@ -604,31 +606,31 @@ proc cgsym(m: BModule, name: string): PRope = # we're picky here for the system module too: rawMessage(errSystemNeeds, name) result = sym.loc.r - + proc generateHeaders(m: BModule) = - app(m.s[cfsHeaders], tnl & "#include \"nimbase.h\"" & tnl) + add(m.s[cfsHeaders], tnl & "#include \"nimbase.h\"" & tnl) var it = PStrEntry(m.headerFiles.head) while it != nil: - if it.data[0] notin {'\"', '<'}: - appf(m.s[cfsHeaders], "$N#include \"$1\"$N", [toRope(it.data)]) + if it.data[0] notin {'\"', '<'}: + addf(m.s[cfsHeaders], "$N#include \"$1\"$N", [rope(it.data)]) else: - appf(m.s[cfsHeaders], "$N#include $1$N", [toRope(it.data)]) + addf(m.s[cfsHeaders], "$N#include $1$N", [rope(it.data)]) it = PStrEntry(it.next) -proc retIsNotVoid(s: PSym): bool = +proc retIsNotVoid(s: PSym): bool = result = (s.typ.sons[0] != nil) and not isInvalidReturnType(s.typ.sons[0]) -proc initFrame(p: BProc, procname, filename: PRope): PRope = +proc initFrame(p: BProc, procname, filename: Rope): Rope = discard cgsym(p.module, "nimFrame") if p.maxFrameLen > 0: discard cgsym(p.module, "TVarSlot") result = rfmt(nil, "\tnimfrs($1, $2, $3, $4)$N", - procname, filename, p.maxFrameLen.toRope, - p.blocks[0].frameLen.toRope) + procname, filename, p.maxFrameLen.rope, + p.blocks[0].frameLen.rope) else: result = rfmt(nil, "\tnimfr($1, $2)$N", procname, filename) -proc deinitFrame(p: BProc): PRope = +proc deinitFrame(p: BProc): Rope = result = rfmt(p.module, "\t#popFrame();$n") proc closureSetup(p: BProc, prc: PSym) = @@ -647,7 +649,7 @@ proc closureSetup(p: BProc, prc: PSym) = proc genProcAux(m: BModule, prc: PSym) = var p = newProc(prc, m) var header = genProcHeader(m, prc) - var returnStmt: PRope = nil + var returnStmt: Rope = nil assert(prc.ast != nil) if sfPure notin prc.flags and prc.typ.sons[0] != nil: if resultPos >= prc.ast.len: @@ -663,72 +665,72 @@ proc genProcAux(m: BModule, prc: PSym) = else: fillResult(res) assignParam(p, res) - if skipTypes(res.typ, abstractInst).kind == tyArray: + if skipTypes(res.typ, abstractInst).kind == tyArray: incl(res.loc.flags, lfIndirect) res.loc.s = OnUnknown - - for i in countup(1, sonsLen(prc.typ.n) - 1): + + for i in countup(1, sonsLen(prc.typ.n) - 1): var param = prc.typ.n.sons[i].sym if param.typ.isCompileTimeOnly: continue assignParam(p, param) closureSetup(p, prc) genStmts(p, prc.getBody) # modifies p.locals, p.init, etc. - var generatedProc: PRope + var generatedProc: Rope if sfPure in prc.flags: if hasNakedDeclspec in extccomp.CC[extccomp.cCompiler].props: - header = con("__declspec(naked) ", header) + header = "__declspec(naked) " & header generatedProc = rfmt(nil, "$N$1 {$n$2$3$4}$N$N", header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)) else: generatedProc = rfmt(nil, "$N$1 {$N", header) - app(generatedProc, initGCFrame(p)) - if optStackTrace in prc.options: - app(generatedProc, p.s(cpsLocals)) + add(generatedProc, initGCFrame(p)) + if optStackTrace in prc.options: + add(generatedProc, p.s(cpsLocals)) var procname = makeCString(prc.name.s) - app(generatedProc, initFrame(p, procname, prc.info.quotedFilename)) - else: - app(generatedProc, p.s(cpsLocals)) + add(generatedProc, initFrame(p, procname, prc.info.quotedFilename)) + else: + add(generatedProc, p.s(cpsLocals)) if optProfiler in prc.options: # invoke at proc entry for recursion: appcg(p, cpsInit, "\t#nimProfile();$n", []) - if p.beforeRetNeeded: app(generatedProc, "{") - app(generatedProc, p.s(cpsInit)) - app(generatedProc, p.s(cpsStmts)) - if p.beforeRetNeeded: app(generatedProc, ~"\t}BeforeRet: ;$n") - app(generatedProc, deinitGCFrame(p)) - if optStackTrace in prc.options: app(generatedProc, deinitFrame(p)) - app(generatedProc, returnStmt) - app(generatedProc, ~"}$N") - app(m.s[cfsProcs], generatedProc) + if p.beforeRetNeeded: add(generatedProc, "{") + add(generatedProc, p.s(cpsInit)) + add(generatedProc, p.s(cpsStmts)) + if p.beforeRetNeeded: add(generatedProc, ~"\t}BeforeRet: ;$n") + add(generatedProc, deinitGCFrame(p)) + if optStackTrace in prc.options: add(generatedProc, deinitFrame(p)) + add(generatedProc, returnStmt) + add(generatedProc, ~"}$N") + add(m.s[cfsProcs], generatedProc) proc crossesCppBoundary(m: BModule; sym: PSym): bool {.inline.} = result = sfCompileToCpp in m.module.flags and sfCompileToCpp notin sym.getModule().flags and gCmd != cmdCompileToCpp -proc genProcPrototype(m: BModule, sym: PSym) = +proc genProcPrototype(m: BModule, sym: PSym) = useHeader(m, sym) - if lfNoDecl in sym.loc.flags: return + if lfNoDecl in sym.loc.flags: return if lfDynamicLib in sym.loc.flags: if getModule(sym).id != m.module.id and - not containsOrIncl(m.declaredThings, sym.id): - app(m.s[cfsVars], rfmt(nil, "extern $1 $2;$n", + not containsOrIncl(m.declaredThings, sym.id): + add(m.s[cfsVars], rfmt(nil, "extern $1 $2;$n", getTypeDesc(m, sym.loc.t), mangleDynLibProc(sym))) elif not containsOrIncl(m.declaredProtos, sym.id): var header = genProcHeader(m, sym) if sym.typ.callConv != ccInline and crossesCppBoundary(m, sym): - header = con("extern \"C\" ", header) + header = "extern \"C\" " & header if sfPure in sym.flags and hasNakedAttribute in CC[cCompiler].props: - header.app(" __attribute__((naked))") - app(m.s[cfsProcHeaders], rfmt(nil, "$1;$n", header)) + header.add(" __attribute__((naked))") + add(m.s[cfsProcHeaders], rfmt(nil, "$1;$n", header)) -proc genProcNoForward(m: BModule, prc: PSym) = +proc genProcNoForward(m: BModule, prc: PSym) = fillProcLoc(prc) useHeader(m, prc) if lfImportCompilerProc in prc.loc.flags: # dependency to a compilerproc: discard cgsym(m, prc.name.s) - return + return genProcPrototype(m, prc) if lfNoDecl in prc.loc.flags: discard elif prc.typ.callConv == ccInline: @@ -738,13 +740,13 @@ proc genProcNoForward(m: BModule, prc: PSym) = if not containsOrIncl(m.declaredThings, prc.id): genProcAux(m, prc) elif lfDynamicLib in prc.loc.flags: var q = findPendingModule(m, prc) - if q != nil and not containsOrIncl(q.declaredThings, prc.id): + if q != nil and not containsOrIncl(q.declaredThings, prc.id): symInDynamicLib(q, prc) else: symInDynamicLibPartial(m, prc) elif sfImportc notin prc.flags: var q = findPendingModule(m, prc) - if q != nil and not containsOrIncl(q.declaredThings, prc.id): + if q != nil and not containsOrIncl(q.declaredThings, prc.id): genProcAux(q, prc) proc requestConstImpl(p: BProc, sym: PSym) = @@ -757,20 +759,20 @@ proc requestConstImpl(p: BProc, sym: PSym) = var q = findPendingModule(m, sym) if q != nil and not containsOrIncl(q.declaredThings, sym.id): assert q.initProc.module == q - appf(q.s[cfsData], "NIM_CONST $1 $2 = $3;$n", + addf(q.s[cfsData], "NIM_CONST $1 $2 = $3;$n", [getTypeDesc(q, sym.typ), sym.loc.r, genConstExpr(q.initProc, sym.ast)]) # declare header: if q != m and not containsOrIncl(m.declaredThings, sym.id): assert(sym.loc.r != nil) - let headerDecl = ropef("extern NIM_CONST $1 $2;$n", - [getTypeDesc(m, sym.loc.t), sym.loc.r]) - app(m.s[cfsData], headerDecl) + let headerDecl = "extern NIM_CONST $1 $2;$n" % + [getTypeDesc(m, sym.loc.t), sym.loc.r] + add(m.s[cfsData], headerDecl) if sfExportc in sym.flags and generatedHeader != nil: - app(generatedHeader.s[cfsData], headerDecl) + add(generatedHeader.s[cfsData], headerDecl) proc isActivated(prc: PSym): bool = prc.typ != nil -proc genProc(m: BModule, prc: PSym) = +proc genProc(m: BModule, prc: PSym) = if sfBorrow in prc.flags or not isActivated(prc): return fillProcLoc(prc) if sfForward in prc.flags: addForwardedProc(m, prc) @@ -780,65 +782,65 @@ proc genProc(m: BModule, prc: PSym) = generatedHeader != nil and lfNoDecl notin prc.loc.flags: genProcPrototype(generatedHeader, prc) if prc.typ.callConv == ccInline: - if not containsOrIncl(generatedHeader.declaredThings, prc.id): + if not containsOrIncl(generatedHeader.declaredThings, prc.id): genProcAux(generatedHeader, prc) -proc genVarPrototypeAux(m: BModule, sym: PSym) = +proc genVarPrototypeAux(m: BModule, sym: PSym) = assert(sfGlobal in sym.flags) useHeader(m, sym) fillLoc(sym.loc, locGlobalVar, sym.typ, mangleName(sym), OnHeap) - if (lfNoDecl in sym.loc.flags) or containsOrIncl(m.declaredThings, sym.id): - return - if sym.owner.id != m.module.id: + if (lfNoDecl in sym.loc.flags) or containsOrIncl(m.declaredThings, sym.id): + return + if sym.owner.id != m.module.id: # else we already have the symbol generated! assert(sym.loc.r != nil) - if sfThread in sym.flags: + if sfThread in sym.flags: declareThreadVar(m, sym, true) else: - app(m.s[cfsVars], "extern ") - app(m.s[cfsVars], getTypeDesc(m, sym.loc.t)) - if lfDynamicLib in sym.loc.flags: app(m.s[cfsVars], "*") - if sfRegister in sym.flags: app(m.s[cfsVars], " register") - if sfVolatile in sym.flags: app(m.s[cfsVars], " volatile") - appf(m.s[cfsVars], " $1;$n", [sym.loc.r]) + add(m.s[cfsVars], "extern ") + add(m.s[cfsVars], getTypeDesc(m, sym.loc.t)) + if lfDynamicLib in sym.loc.flags: add(m.s[cfsVars], "*") + if sfRegister in sym.flags: add(m.s[cfsVars], " register") + if sfVolatile in sym.flags: add(m.s[cfsVars], " volatile") + addf(m.s[cfsVars], " $1;$n", [sym.loc.r]) proc genVarPrototype(m: BModule, sym: PSym) = genVarPrototypeAux(m, sym) -proc addIntTypes(result: var PRope) {.inline.} = - appf(result, "#define NIM_INTBITS $1", [ - platform.CPU[targetCPU].intSize.toRope]) +proc addIntTypes(result: var Rope) {.inline.} = + addf(result, "#define NIM_INTBITS $1", [ + platform.CPU[targetCPU].intSize.rope]) -proc getCopyright(cfile: string): PRope = +proc getCopyright(cfile: string): Rope = if optCompileOnly in gGlobalOptions: - result = ropef("/* Generated by Nim Compiler v$1 */$N" & + result = ("/* Generated by Nim Compiler v$1 */$N" & "/* (c) 2015 Andreas Rumpf */$N" & - "/* The generated code is subject to the original license. */$N", - [toRope(VersionAsString)]) + "/* The generated code is subject to the original license. */$N") % + [rope(VersionAsString)] else: - result = ropef("/* Generated by Nim Compiler v$1 */$N" & + result = ("/* Generated by Nim Compiler v$1 */$N" & "/* (c) 2015 Andreas Rumpf */$N" & "/* The generated code is subject to the original license. */$N" & "/* Compiled for: $2, $3, $4 */$N" & - "/* Command for C compiler:$n $5 */$N", - [toRope(VersionAsString), - toRope(platform.OS[targetOS].name), - toRope(platform.CPU[targetCPU].name), - toRope(extccomp.CC[extccomp.cCompiler].name), - toRope(getCompileCFileCmd(cfile))]) - -proc getFileHeader(cfile: string): PRope = + "/* Command for C compiler:$n $5 */$N") % + [rope(VersionAsString), + rope(platform.OS[targetOS].name), + rope(platform.CPU[targetCPU].name), + rope(extccomp.CC[extccomp.cCompiler].name), + rope(getCompileCFileCmd(cfile))] + +proc getFileHeader(cfile: string): Rope = result = getCopyright(cfile) addIntTypes(result) -proc genFilenames(m: BModule): PRope = +proc genFilenames(m: BModule): Rope = discard cgsym(m, "dbgRegisterFilename") result = nil for i in 0.. <fileInfos.len: - result.appf("dbgRegisterFilename($1);$N", fileInfos[i].projPath.makeCString) + result.addf("dbgRegisterFilename($1);$N", [fileInfos[i].projPath.makeCString]) proc genMainProc(m: BModule) = - const + const # The use of a volatile function pointer to call Pre/NimMainInner # prevents inlining of the NimMainInner function and dependent # functions, which might otherwise merge their stack frames. @@ -859,7 +861,7 @@ proc genMainProc(m: BModule) = MainProcs = "\tNimMain();$N" - + MainProcsWithResult = MainProcs & "\treturn nim_program_result;$N" @@ -880,7 +882,7 @@ proc genMainProc(m: BModule) = "char** cmdLine;$N" & "char** gEnv;$N" & NimMainBody - + PosixCMain = "int main(int argc, char** args, char** env) {$N" & "\tcmdLine = args;$N" & @@ -888,20 +890,20 @@ proc genMainProc(m: BModule) = "\tgEnv = env;$N" & MainProcsWithResult & "}$N$N" - + StandaloneCMain = "int main(void) {$N" & MainProcs & "\treturn 0;$N" & "}$N$N" - + WinNimMain = NimMainBody - + WinCMain = "N_STDCALL(int, WinMain)(HINSTANCE hCurInstance, $N" & " HINSTANCE hPrevInstance, $N" & " LPSTR lpCmdLine, int nCmdShow) {$N" & MainProcsWithResult & "}$N$N" - + WinNimDllMain = "N_LIB_EXPORT " & NimMainBody WinCDllMain = @@ -911,19 +913,19 @@ proc genMainProc(m: BModule) = "\treturn 1;$N}$N$N" PosixNimDllMain = WinNimDllMain - + PosixCDllMain = "void NIM_POSIX_INIT NimMainInit(void) {$N" & MainProcs & "}$N$N" - var nimMain, otherMain: TFormatStr + var nimMain, otherMain: FormatStr if platform.targetOS == osWindows and - gGlobalOptions * {optGenGuiApp, optGenDynLib} != {}: - if optGenGuiApp in gGlobalOptions: + gGlobalOptions * {optGenGuiApp, optGenDynLib} != {}: + if optGenGuiApp in gGlobalOptions: nimMain = WinNimMain otherMain = WinCMain - else: + else: nimMain = WinNimDllMain otherMain = WinCDllMain discard lists.includeStr(m.headerFiles, "<windows.h>") @@ -938,10 +940,10 @@ proc genMainProc(m: BModule) = otherMain = PosixCMain if gBreakpoints != nil: discard cgsym(m, "dbgRegisterBreakpoint") if optEndb in gOptions: - gBreakpoints.app(m.genFilenames) - + gBreakpoints.add(m.genFilenames) + let initStackBottomCall = - if platform.targetOS == osStandalone: "".toRope + if platform.targetOS == osStandalone: "".rope else: ropecg(m, "\t#initStackBottomWith((void *)&inner);$N") inc(m.labels) appcg(m, m.s[cfsProcs], PreMainBody, [ @@ -949,56 +951,56 @@ proc genMainProc(m: BModule) = if emulatedThreadVars() and platform.targetOS != osStandalone: ropecg(m, "\t#initThreadVarsEmulation();$N") else: - "".toRope, + "".rope, initStackBottomCall]) - appcg(m, m.s[cfsProcs], nimMain, [mainModInit, initStackBottomCall, toRope(m.labels)]) + appcg(m, m.s[cfsProcs], nimMain, [mainModInit, initStackBottomCall, rope(m.labels)]) if optNoMain notin gGlobalOptions: appcg(m, m.s[cfsProcs], otherMain, []) -proc getSomeInitName(m: PSym, suffix: string): PRope = +proc getSomeInitName(m: PSym, suffix: string): Rope = assert m.kind == skModule assert m.owner.kind == skPackage if {sfSystemModule, sfMainModule} * m.flags == {}: - result = m.owner.name.s.mangle.toRope - result.app "_" - result.app m.name.s - result.app suffix - -proc getInitName(m: PSym): PRope = getSomeInitName(m, "Init") -proc getDatInitName(m: PSym): PRope = getSomeInitName(m, "DatInit") - -proc registerModuleToMain(m: PSym) = + result = m.owner.name.s.mangle.rope + result.add "_" + result.add m.name.s + result.add suffix + +proc getInitName(m: PSym): Rope = getSomeInitName(m, "Init") +proc getDatInitName(m: PSym): Rope = getSomeInitName(m, "DatInit") + +proc registerModuleToMain(m: PSym) = var init = m.getInitName datInit = m.getDatInitName - appf(mainModProcs, "NIM_EXTERNC N_NOINLINE(void, $1)(void);$N", [init]) - appf(mainModProcs, "NIM_EXTERNC N_NOINLINE(void, $1)(void);$N", [datInit]) + addf(mainModProcs, "NIM_EXTERNC N_NOINLINE(void, $1)(void);$N", [init]) + addf(mainModProcs, "NIM_EXTERNC N_NOINLINE(void, $1)(void);$N", [datInit]) if sfSystemModule notin m.flags: - appf(mainDatInit, "\t$1();$N", [datInit]) - let initCall = ropef("\t$1();$N", [init]) + addf(mainDatInit, "\t$1();$N", [datInit]) + let initCall = "\t$1();$N" % [init] if sfMainModule in m.flags: - app(mainModInit, initCall) + add(mainModInit, initCall) else: - app(otherModsInit, initCall) - -proc genInitCode(m: BModule) = + add(otherModsInit, initCall) + +proc genInitCode(m: BModule) = var initname = getInitName(m.module) - var prc = ropef("NIM_EXTERNC N_NOINLINE(void, $1)(void) {$N", [initname]) - if m.typeNodes > 0: - appcg(m, m.s[cfsTypeInit1], "static #TNimNode $1[$2];$n", - [m.typeNodesName, toRope(m.typeNodes)]) - if m.nimTypes > 0: - appcg(m, m.s[cfsTypeInit1], "static #TNimType $1[$2];$n", - [m.nimTypesName, toRope(m.nimTypes)]) - - app(prc, initGCFrame(m.initProc)) - - app(prc, genSectionStart(cpsLocals)) - app(prc, m.preInitProc.s(cpsLocals)) - app(prc, m.initProc.s(cpsLocals)) - app(prc, m.postInitProc.s(cpsLocals)) - app(prc, genSectionEnd(cpsLocals)) + var prc = "NIM_EXTERNC N_NOINLINE(void, $1)(void) {$N" % [initname] + if m.typeNodes > 0: + appcg(m, m.s[cfsTypeInit1], "static #TNimNode $1[$2];$n", + [m.typeNodesName, rope(m.typeNodes)]) + if m.nimTypes > 0: + appcg(m, m.s[cfsTypeInit1], "static #TNimType $1[$2];$n", + [m.nimTypesName, rope(m.nimTypes)]) + + add(prc, initGCFrame(m.initProc)) + + add(prc, genSectionStart(cpsLocals)) + add(prc, m.preInitProc.s(cpsLocals)) + add(prc, m.initProc.s(cpsLocals)) + add(prc, m.postInitProc.s(cpsLocals)) + add(prc, genSectionEnd(cpsLocals)) if optStackTrace in m.initProc.options and not m.frameDeclared: # BUT: the generated init code might depend on a current frame, so @@ -1006,58 +1008,58 @@ proc genInitCode(m: BModule) = m.frameDeclared = true if not m.preventStackTrace: var procname = makeCString(m.module.name.s) - app(prc, initFrame(m.initProc, procname, m.module.info.quotedFilename)) + add(prc, initFrame(m.initProc, procname, m.module.info.quotedFilename)) else: - app(prc, ~"\tTFrame F; F.len = 0;$N") - - app(prc, genSectionStart(cpsInit)) - app(prc, m.preInitProc.s(cpsInit)) - app(prc, m.initProc.s(cpsInit)) - app(prc, m.postInitProc.s(cpsInit)) - app(prc, genSectionEnd(cpsInit)) - - app(prc, genSectionStart(cpsStmts)) - app(prc, m.preInitProc.s(cpsStmts)) - app(prc, m.initProc.s(cpsStmts)) - app(prc, m.postInitProc.s(cpsStmts)) - app(prc, genSectionEnd(cpsStmts)) + add(prc, ~"\tTFrame F; F.len = 0;$N") + + add(prc, genSectionStart(cpsInit)) + add(prc, m.preInitProc.s(cpsInit)) + add(prc, m.initProc.s(cpsInit)) + add(prc, m.postInitProc.s(cpsInit)) + add(prc, genSectionEnd(cpsInit)) + + add(prc, genSectionStart(cpsStmts)) + add(prc, m.preInitProc.s(cpsStmts)) + add(prc, m.initProc.s(cpsStmts)) + add(prc, m.postInitProc.s(cpsStmts)) + add(prc, genSectionEnd(cpsStmts)) if optStackTrace in m.initProc.options and not m.preventStackTrace: - app(prc, deinitFrame(m.initProc)) - app(prc, deinitGCFrame(m.initProc)) - appf(prc, "}$N$N") + add(prc, deinitFrame(m.initProc)) + add(prc, deinitGCFrame(m.initProc)) + addf(prc, "}$N$N", []) - prc.appf("NIM_EXTERNC N_NOINLINE(void, $1)(void) {$N", + prc.addf("NIM_EXTERNC N_NOINLINE(void, $1)(void) {$N", [getDatInitName(m.module)]) for i in cfsTypeInit1..cfsDynLibInit: - app(prc, genSectionStart(i)) - app(prc, m.s[i]) - app(prc, genSectionEnd(i)) - - appf(prc, "}$N$N") + add(prc, genSectionStart(i)) + add(prc, m.s[i]) + add(prc, genSectionEnd(i)) + + addf(prc, "}$N$N", []) # we cannot simply add the init proc to ``m.s[cfsProcs]`` anymore because # that would lead to a *nesting* of merge sections which the merger does # not support. So we add it to another special section: ``cfsInitProc`` - app(m.s[cfsInitProc], prc) - + add(m.s[cfsInitProc], prc) + for i, el in pairs(m.extensionLoaders): if el != nil: - let ex = ropef("N_NIMCALL(void, nimLoadProcs$1)(void) {$2}$N$N", - (i.ord - '0'.ord).toRope, el) - app(m.s[cfsInitProc], ex) + let ex = "N_NIMCALL(void, nimLoadProcs$1)(void) {$2}$N$N" % + [(i.ord - '0'.ord).rope, el] + add(m.s[cfsInitProc], ex) -proc genModule(m: BModule, cfile: string): PRope = +proc genModule(m: BModule, cfile: string): Rope = result = getFileHeader(cfile) - result.app(genMergeInfo(m)) - + result.add(genMergeInfo(m)) + generateHeaders(m) generateThreadLocalStorage(m) - for i in countup(cfsHeaders, cfsProcs): - app(result, genSectionStart(i)) - app(result, m.s[i]) - app(result, genSectionEnd(i)) - app(result, m.s[cfsInitProc]) + for i in countup(cfsHeaders, cfsProcs): + add(result, genSectionStart(i)) + add(result, m.s[i]) + add(result, genSectionEnd(i)) + add(result, m.s[cfsInitProc]) proc newPreInitProc(m: BModule): BProc = result = newProc(nil, m) @@ -1069,7 +1071,7 @@ proc newPostInitProc(m: BModule): BProc = # little hack so that unique temporaries are generated: result.labels = 200_000 -proc initProcOptions(m: BModule): TOptions = +proc initProcOptions(m: BModule): TOptions = if sfSystemModule in m.module.flags: gOptions-{optStackTrace} else: gOptions proc rawNewModule(module: PSym, filename: string): BModule = @@ -1124,11 +1126,11 @@ proc resetModule*(m: BModule) = m.typeNodes = 0 m.nimTypes = 0 nullify m.extensionLoaders - + # indicate that this is now cached module # the cache will be invalidated by nullifying gModules m.fromCache = true - + # we keep only the "merge info" information for the module # and the properties that can't change: # m.filename @@ -1155,11 +1157,11 @@ proc newModule(module: PSym): BModule = growCache gModules, module.position gModules[module.position] = result - if (optDeadCodeElim in gGlobalOptions): - if (sfDeadCodeElim in module.flags): + if (optDeadCodeElim in gGlobalOptions): + if (sfDeadCodeElim in module.flags): internalError("added pending module twice: " & module.filename) -proc myOpen(module: PSym): PPassContext = +proc myOpen(module: PSym): PPassContext = result = newModule(module) if optGenIndex in gGlobalOptions and generatedHeader == nil: let f = if headerFile.len > 0: headerFile else: gProjectFull @@ -1169,22 +1171,22 @@ proc myOpen(module: PSym): PPassContext = proc writeHeader(m: BModule) = var result = getCopyright(m.filename) - var guard = ropef("__$1__", m.filename.splitFile.name.toRope) - result.appf("#ifndef $1$n#define $1$n", guard) + var guard = "__$1__" % [m.filename.splitFile.name.rope] + result.addf("#ifndef $1$n#define $1$n", [guard]) addIntTypes(result) generateHeaders(m) generateThreadLocalStorage(m) - for i in countup(cfsHeaders, cfsProcs): - app(result, genSectionStart(i)) - app(result, m.s[i]) - app(result, genSectionEnd(i)) - app(result, m.s[cfsInitProc]) - + for i in countup(cfsHeaders, cfsProcs): + add(result, genSectionStart(i)) + add(result, m.s[i]) + add(result, genSectionEnd(i)) + add(result, m.s[cfsInitProc]) + if optGenDynLib in gGlobalOptions: - result.app("N_LIB_IMPORT ") - result.appf("N_CDECL(void, NimMain)(void);$n") - result.appf("#endif /* $1 */$n", guard) + result.add("N_LIB_IMPORT ") + result.addf("N_CDECL(void, NimMain)(void);$n", []) + result.addf("#endif /* $1 */$n", [guard]) writeRope(result, m.filename) proc getCFile(m: BModule): string = @@ -1200,20 +1202,20 @@ proc myOpenCached(module: PSym, rd: PRodReader): PPassContext = readMergeInfo(getCFile(m), m) result = m -proc myProcess(b: PPassContext, n: PNode): PNode = +proc myProcess(b: PPassContext, n: PNode): PNode = result = n if b == nil or passes.skipCodegen(n): return var m = BModule(b) m.initProc.options = initProcOptions(m) genStmts(m.initProc, n) -proc finishModule(m: BModule) = +proc finishModule(m: BModule) = var i = 0 - while i <= high(m.forwardedProcs): + while i <= high(m.forwardedProcs): # Note: ``genProc`` may add to ``m.forwardedProcs``, so we cannot use # a ``for`` loop here var prc = m.forwardedProcs[i] - if sfForward in prc.flags: + if sfForward in prc.flags: internalError(prc.info, "still forwarded: " & prc.name.s) genProcNoForward(m, prc) inc(i) @@ -1221,13 +1223,13 @@ proc finishModule(m: BModule) = dec(gForwardedProcsCounter, i) setLen(m.forwardedProcs, 0) -proc shouldRecompile(code: PRope, cfile: string): bool = +proc shouldRecompile(code: Rope, cfile: string): bool = result = true if optForceFullMake notin gGlobalOptions: var objFile = toObjFile(cfile) - if writeRopeIfNotEqual(code, cfile): return + if writeRopeIfNotEqual(code, cfile): return if existsFile(objFile) and os.fileNewer(objFile, cfile): result = false - else: + else: writeRope(code, cfile) # We need 2 different logics here: pending modules (including @@ -1240,19 +1242,19 @@ proc writeModule(m: BModule, pending: bool) = # generate code for the init statements of the module: var cfile = getCFile(m) var cfilenoext = changeFileExt(cfile, "") - + if not m.fromCache or optForceFullMake in gGlobalOptions: genInitCode(m) finishTypeDescriptions(m) - if sfMainModule in m.module.flags: + if sfMainModule in m.module.flags: # generate main file: - app(m.s[cfsProcHeaders], mainModProcs) + add(m.s[cfsProcHeaders], mainModProcs) generateThreadVarsSize(m) - + var code = genModule(m, cfile) when hasTinyCBackend: if gCmd == cmdRun: - tccgen.compileCCode(ropeToStr(code)) + tccgen.compileCCode($code) return if shouldRecompile(code, cfile): @@ -1269,13 +1271,13 @@ proc writeModule(m: BModule, pending: bool) = # ``system.c`` but then compilation fails due to an error. This means # that ``system.o`` is missing, so we need to call the C compiler for it: addFileToCompile(cfile) - + addFileToLink(cfilenoext) proc updateCachedModule(m: BModule) = let cfile = getCFile(m) let cfilenoext = changeFileExt(cfile, "") - + if mergeRequired(m) and sfMainModule notin m.module.flags: mergeFiles(cfile, m) genInitCode(m) @@ -1286,17 +1288,17 @@ proc updateCachedModule(m: BModule) = addFileToLink(cfilenoext) -proc myClose(b: PPassContext, n: PNode): PNode = +proc myClose(b: PPassContext, n: PNode): PNode = result = n - if b == nil or passes.skipCodegen(n): return + if b == nil or passes.skipCodegen(n): return var m = BModule(b) - if n != nil: + if n != nil: m.initProc.options = initProcOptions(m) genStmts(m.initProc, n) - # cached modules need to registered too: + # cached modules need to registered too: registerModuleToMain(m.module) - if sfMainModule in m.module.flags: + if sfMainModule in m.module.flags: m.objHasKidsValid = true var disp = generateMethodDispatchers() for i in 0..sonsLen(disp)-1: genProcAux(m, disp.sons[i].sym) diff --git a/compiler/cgendata.nim b/compiler/cgendata.nim index bb98454a7..187186373 100644 --- a/compiler/cgendata.nim +++ b/compiler/cgendata.nim @@ -9,11 +9,13 @@ ## This module contains the data structures for the C code generation phase. -import +import ast, astalgo, ropes, passes, options, intsets, lists, platform +from msgs import TLineInfo + type - TLabel* = PRope # for the C generator a label is just a rope + TLabel* = Rope # for the C generator a label is just a rope TCFileSection* = enum # the sections a generated C file consists of cfsMergeInfo, # section containing merge information cfsHeaders, # section for C include file headers @@ -43,34 +45,35 @@ type ctUInt, ctUInt8, ctUInt16, ctUInt32, ctUInt64, ctArray, ctPtrToArray, ctStruct, ctPtr, ctNimStr, ctNimSeq, ctProc, ctCString - TCFileSections* = array[TCFileSection, PRope] # represents a generated C file + TCFileSections* = array[TCFileSection, Rope] # represents a generated C file TCProcSection* = enum # the sections a generated C proc consists of cpsLocals, # section of local variables for C proc cpsInit, # section for init of variables for C proc cpsStmts # section of local statements for C proc - TCProcSections* = array[TCProcSection, PRope] # represents a generated C proc + TCProcSections* = array[TCProcSection, Rope] # represents a generated C proc BModule* = ref TCGen BProc* = ref TCProc - TBlock*{.final.} = object + TBlock*{.final.} = object id*: int # the ID of the label; positive means that it - label*: PRope # generated text for the label + label*: Rope # generated text for the label # nil if label is not used sections*: TCProcSections # the code beloging isLoop*: bool # whether block is a loop nestedTryStmts*: int16 # how many try statements is it nested into nestedExceptStmts*: int16 # how many except statements is it nested into frameLen*: int16 - + TCProc{.final.} = object # represents C proc that is currently generated prc*: PSym # the Nim proc that this C proc belongs to beforeRetNeeded*: bool # true iff 'BeforeRet' label for proc is needed threadVarAccessed*: bool # true if the proc already accessed some threadvar + lastLineInfo*: TLineInfo # to avoid generating excessive 'nimln' statements nestedTryStmts*: seq[PNode] # in how many nested try statements we are # (the vars must be volatile then) inExceptBlock*: int # are we currently inside an except block? # leaving such scopes by raise or by return must # execute any applicable finally blocks - finallySafePoints*: seq[PRope] # For correctly cleaning up exceptions when + finallySafePoints*: seq[Rope] # For correctly cleaning up exceptions when # using return in finally statements labels*: Natural # for generating unique labels in the C proc blocks*: seq[TBlock] # nested blocks @@ -86,8 +89,8 @@ type # requires 'T x = T()' to become 'T x; x = T()' # (yes, C++ is weird like that) gcFrameId*: Natural # for the GC stack marking - gcFrameType*: PRope # the struct {} we put the GC markers into - + gcFrameType*: Rope # the struct {} we put the GC markers into + TTypeSeq* = seq[PType] TCGen = object of TPassContext # represents a C source file module*: PSym @@ -115,24 +118,24 @@ type dataCache*: TNodeTable forwardedProcs*: TSymSeq # keep forwarded procs here typeNodes*, nimTypes*: int # used for type info generation - typeNodesName*, nimTypesName*: PRope # used for type info generation + typeNodesName*, nimTypesName*: Rope # used for type info generation labels*: Natural # for generating unique module-scope names - extensionLoaders*: array['0'..'9', PRope] # special procs for the + extensionLoaders*: array['0'..'9', Rope] # special procs for the # OpenGL wrapper - injectStmt*: PRope + injectStmt*: Rope var - mainModProcs*, mainModInit*, otherModsInit*, mainDatInit*: PRope + mainModProcs*, mainModInit*, otherModsInit*, mainDatInit*: Rope # varuious parts of the main module - gMapping*: PRope # the generated mapping file (if requested) + gMapping*: Rope # the generated mapping file (if requested) gModules*: seq[BModule] = @[] # list of all compiled modules gForwardedProcsCounter*: int = 0 -proc s*(p: BProc, s: TCProcSection): var PRope {.inline.} = +proc s*(p: BProc, s: TCProcSection): var Rope {.inline.} = # section in the current block result = p.blocks[p.blocks.len - 1].sections[s] -proc procSec*(p: BProc, s: TCProcSection): var PRope {.inline.} = +proc procSec*(p: BProc, s: TCProcSection): var Rope {.inline.} = # top level proc sections result = p.blocks[0].sections[s] @@ -140,7 +143,7 @@ proc bmod*(module: PSym): BModule = # obtains the BModule for a given module PSym result = gModules[module.position] -proc newProc*(prc: PSym, module: BModule): BProc = +proc newProc*(prc: PSym, module: BModule): BProc = new(result) result.prc = prc result.module = module diff --git a/compiler/commands.nim b/compiler/commands.nim index a2d02e469..5b5f461ef 100644 --- a/compiler/commands.nim +++ b/compiler/commands.nim @@ -24,8 +24,8 @@ bootSwitch(usedMarkAndSweep, defined(gcmarkandsweep), "--gc:markAndSweep") bootSwitch(usedGenerational, defined(gcgenerational), "--gc:generational") bootSwitch(usedNoGC, defined(nogc), "--gc:none") -import - os, msgs, options, nversion, condsyms, strutils, extccomp, platform, lists, +import + os, msgs, options, nversion, condsyms, strutils, extccomp, platform, lists, wordrecg, parseutils, nimblecmd, idents, parseopt # but some have deps to imported modules. Yay. @@ -39,8 +39,8 @@ bootSwitch(usedFFI, hasFFI, "-d:useFFI") proc writeCommandLineUsage*() -type - TCmdLinePass* = enum +type + TCmdLinePass* = enum passCmd1, # first pass over the command line passCmd2, # second pass over the command line passPP # preprocessor called processCommand() @@ -54,35 +54,35 @@ const HelpMessage = "Nim Compiler Version $1 (" & CompileDate & ") [$2: $3]\n" & "Copyright (c) 2006-2015 by Andreas Rumpf\n" -const +const Usage = slurp"doc/basicopt.txt".replace("//", "") AdvancedUsage = slurp"doc/advopt.txt".replace("//", "") -proc getCommandLineDesc(): string = - result = (HelpMessage % [VersionAsString, platform.OS[platform.hostOS].name, +proc getCommandLineDesc(): string = + result = (HelpMessage % [VersionAsString, platform.OS[platform.hostOS].name, CPU[platform.hostCPU].name]) & Usage -proc helpOnError(pass: TCmdLinePass) = +proc helpOnError(pass: TCmdLinePass) = if pass == passCmd1: msgWriteln(getCommandLineDesc()) msgQuit(0) -proc writeAdvancedUsage(pass: TCmdLinePass) = +proc writeAdvancedUsage(pass: TCmdLinePass) = if pass == passCmd1: - msgWriteln(`%`(HelpMessage, [VersionAsString, - platform.OS[platform.hostOS].name, + msgWriteln(`%`(HelpMessage, [VersionAsString, + platform.OS[platform.hostOS].name, CPU[platform.hostCPU].name]) & AdvancedUsage) msgQuit(0) -proc writeVersionInfo(pass: TCmdLinePass) = +proc writeVersionInfo(pass: TCmdLinePass) = if pass == passCmd1: - msgWriteln(`%`(HelpMessage, [VersionAsString, - platform.OS[platform.hostOS].name, + msgWriteln(`%`(HelpMessage, [VersionAsString, + platform.OS[platform.hostOS].name, CPU[platform.hostCPU].name])) - discard """const gitHash = gorge("git log -n 1 --format=%H") - if gitHash.strip.len == 40: - msgWriteln("git hash: " & gitHash)""" + const gitHash = gorge("git log -n 1 --format=%H").strip + when gitHash.len == 40: + msgWriteln("git hash: " & gitHash) msgWriteln("active boot switches:" & usedRelease & usedAvoidTimeMachine & usedTinyC & usedGnuReadline & usedNativeStacktrace & usedNoCaas & @@ -92,8 +92,8 @@ proc writeVersionInfo(pass: TCmdLinePass) = var helpWritten: bool -proc writeCommandLineUsage() = - if not helpWritten: +proc writeCommandLineUsage() = + if not helpWritten: msgWriteln(getCommandLineDesc()) helpWritten = true @@ -101,51 +101,51 @@ proc addPrefix(switch: string): string = if len(switch) == 1: result = "-" & switch else: result = "--" & switch -proc invalidCmdLineOption(pass: TCmdLinePass, switch: string, info: TLineInfo) = +proc invalidCmdLineOption(pass: TCmdLinePass, switch: string, info: TLineInfo) = if switch == " ": localError(info, errInvalidCmdLineOption, "-") else: localError(info, errInvalidCmdLineOption, addPrefix(switch)) -proc splitSwitch(switch: string, cmd, arg: var string, pass: TCmdLinePass, - info: TLineInfo) = +proc splitSwitch(switch: string, cmd, arg: var string, pass: TCmdLinePass, + info: TLineInfo) = cmd = "" var i = 0 if i < len(switch) and switch[i] == '-': inc(i) if i < len(switch) and switch[i] == '-': inc(i) - while i < len(switch): + while i < len(switch): case switch[i] of 'a'..'z', 'A'..'Z', '0'..'9', '_', '.': add(cmd, switch[i]) - else: break + else: break inc(i) if i >= len(switch): arg = "" elif switch[i] in {':', '=', '['}: arg = substr(switch, i + 1) else: invalidCmdLineOption(pass, switch, info) - -proc processOnOffSwitch(op: TOptions, arg: string, pass: TCmdLinePass, - info: TLineInfo) = + +proc processOnOffSwitch(op: TOptions, arg: string, pass: TCmdLinePass, + info: TLineInfo) = case whichKeyword(arg) of wOn: gOptions = gOptions + op of wOff: gOptions = gOptions - op else: localError(info, errOnOrOffExpectedButXFound, arg) - -proc processOnOffSwitchG(op: TGlobalOptions, arg: string, pass: TCmdLinePass, - info: TLineInfo) = + +proc processOnOffSwitchG(op: TGlobalOptions, arg: string, pass: TCmdLinePass, + info: TLineInfo) = case whichKeyword(arg) of wOn: gGlobalOptions = gGlobalOptions + op of wOff: gGlobalOptions = gGlobalOptions - op else: localError(info, errOnOrOffExpectedButXFound, arg) - -proc expectArg(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = + +proc expectArg(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = if arg == "": localError(info, errCmdLineArgExpected, addPrefix(switch)) - -proc expectNoArg(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = + +proc expectNoArg(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = if arg != "": localError(info, errCmdLineNoArgExpected, addPrefix(switch)) - -proc processSpecificNote(arg: string, state: TSpecialWord, pass: TCmdLinePass, - info: TLineInfo; orig: string) = + +proc processSpecificNote(arg: string, state: TSpecialWord, pass: TCmdLinePass, + info: TLineInfo; orig: string) = var id = "" # arg = "X]:on|off" var i = 0 var n = hintMin - while i < len(arg) and (arg[i] != ']'): + while i < len(arg) and (arg[i] != ']'): add(id, arg[i]) inc(i) if i < len(arg) and (arg[i] == ']'): inc(i) @@ -165,7 +165,7 @@ proc processSpecificNote(arg: string, state: TSpecialWord, pass: TCmdLinePass, of wOff: excl(gNotes, n) else: localError(info, errOnOrOffExpectedButXFound, arg) -proc processCompile(filename: string) = +proc processCompile(filename: string) = var found = findFile(filename) if found == "": found = filename var trunc = changeFileExt(found, "") @@ -191,7 +191,7 @@ proc testCompileOptionArg*(switch, arg: string, info: TLineInfo): bool = else: localError(info, errNoneSpeedOrSizeExpectedButXFound, arg) else: invalidCmdLineOption(passCmd1, switch, info) -proc testCompileOption*(switch: string, info: TLineInfo): bool = +proc testCompileOption*(switch: string, info: TLineInfo): bool = case switch.normalize of "debuginfo": result = contains(gGlobalOptions, optCDebug) of "compileonly", "c": result = contains(gGlobalOptions, optCompileOnly) @@ -228,11 +228,11 @@ proc testCompileOption*(switch: string, info: TLineInfo): bool = of "patterns": result = contains(gOptions, optPatterns) of "experimental": result = gExperimentalMode else: invalidCmdLineOption(passCmd1, switch, info) - + proc processPath(path: string, notRelativeToProj = false): string = let p = if notRelativeToProj or os.isAbsolute(path) or - '$' in path or path[0] == '.': - path + '$' in path or path[0] == '.': + path else: options.gProjectPath / path result = unixToNativePath(p % ["nimrod", getPrefixDir(), @@ -251,14 +251,14 @@ proc trackDirty(arg: string, info: TLineInfo) = localError(info, errInvalidNumber, a[1]) if parseUtils.parseInt(a[3], column) <= 0: localError(info, errInvalidNumber, a[2]) - + let dirtyOriginalIdx = a[1].fileInfoIdx if dirtyOriginalIdx >= 0: msgs.setDirtyFile(dirtyOriginalIdx, a[0]) gTrackPos = newLineInfo(dirtyOriginalIdx, line, column) -proc track(arg: string, info: TLineInfo) = +proc track(arg: string, info: TLineInfo) = var a = arg.split(',') if a.len != 3: localError(info, errTokenExpected, "FILE,LINE,COLUMN") var line, column: int @@ -273,13 +273,13 @@ proc dynlibOverride(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = expectArg(switch, arg, pass, info) options.inclDynlibOverride(arg) -proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = - var +proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = + var theOS: TSystemOS cpu: TSystemCPU key, val: string case switch.normalize - of "path", "p": + of "path", "p": expectArg(switch, arg, pass, info) addPath(processPath(arg), info) of "nimblepath", "babelpath": @@ -303,7 +303,7 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = of "nimcache": expectArg(switch, arg, pass, info) options.nimcacheDir = processPath(arg) - of "out", "o": + of "out", "o": expectArg(switch, arg, pass, info) options.outFile = arg of "docseesrcurl": @@ -311,19 +311,19 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = options.docSeeSrcUrl = arg of "mainmodule", "m": discard "allow for backwards compatibility, but don't do anything" - of "define", "d": + of "define", "d": expectArg(switch, arg, pass, info) defineSymbol(arg) - of "undef", "u": + of "undef", "u": expectArg(switch, arg, pass, info) undefSymbol(arg) of "symbol": expectArg(switch, arg, pass, info) - declareSymbol(arg) - of "compile": + declareSymbol(arg) + of "compile": expectArg(switch, arg, pass, info) if pass in {passCmd2, passPP}: processCompile(arg) - of "link": + of "link": expectArg(switch, arg, pass, info) if pass in {passCmd2, passPP}: addFileToLink(arg) of "debuginfo": @@ -332,25 +332,25 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = of "embedsrc": expectNoArg(switch, arg, pass, info) incl(gGlobalOptions, optEmbedOrigSrc) - of "compileonly", "c": + of "compileonly", "c": expectNoArg(switch, arg, pass, info) incl(gGlobalOptions, optCompileOnly) - of "nolinking": + of "nolinking": expectNoArg(switch, arg, pass, info) incl(gGlobalOptions, optNoLinking) - of "nomain": + of "nomain": expectNoArg(switch, arg, pass, info) incl(gGlobalOptions, optNoMain) - of "forcebuild", "f": + of "forcebuild", "f": expectNoArg(switch, arg, pass, info) incl(gGlobalOptions, optForceFullMake) of "project": expectNoArg(switch, arg, pass, info) gWholeProject = true - of "gc": + of "gc": expectArg(switch, arg, pass, info) case arg.normalize - of "boehm": + of "boehm": gSelectedGC = gcBoehm defineSymbol("boehmgc") of "refc": @@ -388,7 +388,7 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = undefSymbol("endb") else: localError(info, "expected endb|gdb but found " & arg) - of "profiler": + of "profiler": processOnOffSwitch({optProfiler}, arg, pass, info) if optProfiler in gOptions: defineSymbol("profiler") else: undefSymbol("profiler") @@ -407,7 +407,7 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = of "deadcodeelim": processOnOffSwitchG({optDeadCodeElim}, arg, pass, info) of "threads": processOnOffSwitchG({optThreads}, arg, pass, info) - if optThreads in gGlobalOptions: incl(gNotes, warnGcUnsafe) + #if optThreads in gGlobalOptions: incl(gNotes, warnGcUnsafe) of "tlsemulation": processOnOffSwitchG({optTlsEmulation}, arg, pass, info) of "taintmode": processOnOffSwitchG({optTaintMode}, arg, pass, info) of "implicitstatic": @@ -417,17 +417,17 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = of "opt": expectArg(switch, arg, pass, info) case arg.normalize - of "speed": + of "speed": incl(gOptions, optOptimizeSpeed) excl(gOptions, optOptimizeSize) - of "size": + of "size": excl(gOptions, optOptimizeSpeed) incl(gOptions, optOptimizeSize) of "none": excl(gOptions, optOptimizeSpeed) excl(gOptions, optOptimizeSize) else: localError(info, errNoneSpeedOrSizeExpectedButXFound, arg) - of "app": + of "app": expectArg(switch, arg, pass, info) case arg.normalize of "gui": @@ -449,10 +449,10 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = defineSymbol("library") defineSymbol("staticlib") else: localError(info, errGuiConsoleOrLibExpectedButXFound, arg) - of "passc", "t": + of "passc", "t": expectArg(switch, arg, pass, info) if pass in {passCmd2, passPP}: extccomp.addCompileOption(arg) - of "passl", "l": + of "passl", "l": expectArg(switch, arg, pass, info) if pass in {passCmd2, passPP}: extccomp.addLinkOption(arg) of "cincludes": @@ -475,52 +475,52 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = of "include": expectArg(switch, arg, pass, info) if pass in {passCmd2, passPP}: implicitIncludes.add arg - of "listcmd": + of "listcmd": expectNoArg(switch, arg, pass, info) incl(gGlobalOptions, optListCmd) - of "genmapping": + of "genmapping": expectNoArg(switch, arg, pass, info) incl(gGlobalOptions, optGenMapping) - of "os": + of "os": expectArg(switch, arg, pass, info) - if pass in {passCmd1, passPP}: + if pass in {passCmd1, passPP}: theOS = platform.nameToOS(arg) if theOS == osNone: localError(info, errUnknownOS, arg) - elif theOS != platform.hostOS: + elif theOS != platform.hostOS: setTarget(theOS, targetCPU) condsyms.initDefines() - of "cpu": + of "cpu": expectArg(switch, arg, pass, info) - if pass in {passCmd1, passPP}: + if pass in {passCmd1, passPP}: cpu = platform.nameToCPU(arg) if cpu == cpuNone: localError(info, errUnknownCPU, arg) - elif cpu != platform.hostCPU: + elif cpu != platform.hostCPU: setTarget(targetOS, cpu) condsyms.initDefines() - of "run", "r": + of "run", "r": expectNoArg(switch, arg, pass, info) incl(gGlobalOptions, optRun) - of "verbosity": + of "verbosity": expectArg(switch, arg, pass, info) gVerbosity = parseInt(arg) - of "parallelbuild": + of "parallelbuild": expectArg(switch, arg, pass, info) gNumberOfProcessors = parseInt(arg) - of "version", "v": + of "version", "v": expectNoArg(switch, arg, pass, info) writeVersionInfo(pass) - of "advanced": + of "advanced": expectNoArg(switch, arg, pass, info) writeAdvancedUsage(pass) - of "help", "h": + of "help", "h": expectNoArg(switch, arg, pass, info) helpOnError(pass) - of "symbolfiles": + of "symbolfiles": processOnOffSwitchG({optSymbolFiles}, arg, pass, info) - of "skipcfg": + of "skipcfg": expectNoArg(switch, arg, pass, info) incl(gGlobalOptions, optSkipConfigFile) - of "skipprojcfg": + of "skipprojcfg": expectNoArg(switch, arg, pass, info) incl(gGlobalOptions, optSkipProjConfigFile) of "skipusercfg": @@ -529,17 +529,17 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = of "skipparentcfg": expectNoArg(switch, arg, pass, info) incl(gGlobalOptions, optSkipParentConfigFiles) - of "genscript": + of "genscript": expectNoArg(switch, arg, pass, info) incl(gGlobalOptions, optGenScript) of "lib": expectArg(switch, arg, pass, info) libpath = processPath(arg, notRelativeToProj=true) - of "putenv": + of "putenv": expectArg(switch, arg, pass, info) splitSwitch(arg, key, val, pass, info) os.putEnv(key, val) - of "cc": + of "cc": expectArg(switch, arg, pass, info) setCC(arg) of "track": @@ -548,7 +548,7 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = of "trackdirty": expectArg(switch, arg, pass, info) trackDirty(arg, info) - of "suggest": + of "suggest": expectNoArg(switch, arg, pass, info) gIdeCmd = ideSug of "def": @@ -584,7 +584,7 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = else: if strutils.find(switch, '.') >= 0: options.setConfigVar(switch, arg) else: invalidCmdLineOption(pass, switch, info) - + proc processCommand(switch: string, pass: TCmdLinePass) = var cmd, arg: string splitSwitch(switch, cmd, arg, pass, gCmdLineInfo) @@ -600,14 +600,14 @@ proc processSwitch*(pass: TCmdLinePass; p: OptParser) = # hint[X]:off is parsed as (p.key = "hint[X]", p.val = "off") # we fix this here var bracketLe = strutils.find(p.key, '[') - if bracketLe >= 0: + if bracketLe >= 0: var key = substr(p.key, 0, bracketLe - 1) var val = substr(p.key, bracketLe + 1) & ':' & p.val processSwitch(key, val, pass, gCmdLineInfo) - else: + else: processSwitch(p.key, p.val, pass, gCmdLineInfo) -proc processArgument*(pass: TCmdLinePass; p: OptParser; +proc processArgument*(pass: TCmdLinePass; p: OptParser; argsCount: var int): bool = if argsCount == 0: options.command = p.key diff --git a/compiler/depends.nim b/compiler/depends.nim index 115a98f84..1ccb134f2 100644 --- a/compiler/depends.nim +++ b/compiler/depends.nim @@ -9,41 +9,41 @@ # This module implements a dependency file generator. -import +import os, options, ast, astalgo, msgs, ropes, idents, passes, importer proc generateDot*(project: string) -type +type TGen = object of TPassContext module*: PSym PGen = ref TGen -var gDotGraph: PRope # the generated DOT file; we need a global variable +var gDotGraph: Rope # the generated DOT file; we need a global variable -proc addDependencyAux(importing, imported: string) = - appf(gDotGraph, "$1 -> $2;$n", [toRope(importing), toRope(imported)]) +proc addDependencyAux(importing, imported: string) = + addf(gDotGraph, "$1 -> $2;$n", [rope(importing), rope(imported)]) # s1 -> s2_4[label="[0-9]"]; - -proc addDotDependency(c: PPassContext, n: PNode): PNode = + +proc addDotDependency(c: PPassContext, n: PNode): PNode = result = n var g = PGen(c) case n.kind - of nkImportStmt: - for i in countup(0, sonsLen(n) - 1): + of nkImportStmt: + for i in countup(0, sonsLen(n) - 1): var imported = getModuleName(n.sons[i]) addDependencyAux(g.module.name.s, imported) - of nkFromStmt, nkImportExceptStmt: + of nkFromStmt, nkImportExceptStmt: var imported = getModuleName(n.sons[0]) addDependencyAux(g.module.name.s, imported) - of nkStmtList, nkBlockStmt, nkStmtListExpr, nkBlockExpr: + of nkStmtList, nkBlockStmt, nkStmtListExpr, nkBlockExpr: for i in countup(0, sonsLen(n) - 1): discard addDotDependency(c, n.sons[i]) - else: + else: discard -proc generateDot(project: string) = - writeRope(ropef("digraph $1 {$n$2}$n", [ - toRope(changeFileExt(extractFilename(project), "")), gDotGraph]), +proc generateDot(project: string) = + writeRope("digraph $1 {$n$2}$n" % [ + rope(changeFileExt(extractFilename(project), "")), gDotGraph], changeFileExt(project, "dot")) proc myOpen(module: PSym): PPassContext = diff --git a/compiler/docgen.nim b/compiler/docgen.nim index 5439922af..f8489d825 100644 --- a/compiler/docgen.nim +++ b/compiler/docgen.nim @@ -17,9 +17,9 @@ import importer, sempass2, json, xmltree, cgi, typesrenderer type - TSections = array[TSymKind, PRope] + TSections = array[TSymKind, Rope] TDocumentor = object of rstgen.TRstGenerator - modDesc: PRope # module description + modDesc: Rope # module description id: int # for generating IDs toc, section: TSections indexValFilename: string @@ -82,9 +82,9 @@ proc newDocumentor*(filename: string, config: StringTableRef): PDoc = result.seenSymbols = newStringTable(modeCaseInsensitive) result.id = 100 -proc dispA(dest: var PRope, xml, tex: string, args: openArray[PRope]) = - if gCmd != cmdRst2tex: appf(dest, xml, args) - else: appf(dest, tex, args) +proc dispA(dest: var Rope, xml, tex: string, args: openArray[Rope]) = + if gCmd != cmdRst2tex: addf(dest, xml, args) + else: addf(dest, tex, args) proc getVarIdx(varnames: openArray[string], id: string): int = for i in countup(0, high(varnames)): @@ -92,8 +92,8 @@ proc getVarIdx(varnames: openArray[string], id: string): int = return i result = -1 -proc ropeFormatNamedVars(frmt: TFormatStr, varnames: openArray[string], - varvalues: openArray[PRope]): PRope = +proc ropeFormatNamedVars(frmt: FormatStr, varnames: openArray[string], + varvalues: openArray[Rope]): Rope = var i = 0 var L = len(frmt) result = nil @@ -103,11 +103,11 @@ proc ropeFormatNamedVars(frmt: TFormatStr, varnames: openArray[string], inc(i) # skip '$' case frmt[i] of '#': - app(result, varvalues[num]) + add(result, varvalues[num]) inc(num) inc(i) of '$': - app(result, "$") + add(result, "$") inc(i) of '0'..'9': var j = 0 @@ -117,7 +117,7 @@ proc ropeFormatNamedVars(frmt: TFormatStr, varnames: openArray[string], if (i > L + 0 - 1) or not (frmt[i] in {'0'..'9'}): break if j > high(varvalues) + 1: internalError("ropeFormatNamedVars") num = j - app(result, varvalues[j - 1]) + add(result, varvalues[j - 1]) of 'A'..'Z', 'a'..'z', '\x80'..'\xFF': var id = "" while true: @@ -125,7 +125,7 @@ proc ropeFormatNamedVars(frmt: TFormatStr, varnames: openArray[string], inc(i) if not (frmt[i] in {'A'..'Z', '_', 'a'..'z', '\x80'..'\xFF'}): break var idx = getVarIdx(varnames, id) - if idx >= 0: app(result, varvalues[idx]) + if idx >= 0: add(result, varvalues[idx]) else: rawMessage(errUnknownSubstitionVar, id) of '{': var id = "" @@ -137,14 +137,14 @@ proc ropeFormatNamedVars(frmt: TFormatStr, varnames: openArray[string], inc(i) # skip } # search for the variable: var idx = getVarIdx(varnames, id) - if idx >= 0: app(result, varvalues[idx]) + if idx >= 0: add(result, varvalues[idx]) else: rawMessage(errUnknownSubstitionVar, id) else: internalError("ropeFormatNamedVars") var start = i while i < L: if frmt[i] != '$': inc(i) else: break - if i - 1 >= start: app(result, substr(frmt, start, i - 1)) + if i - 1 >= start: add(result, substr(frmt, start, i - 1)) proc genComment(d: PDoc, n: PNode): string = result = "" @@ -154,9 +154,9 @@ proc genComment(d: PDoc, n: PNode): string = toLinenumber(n.info), toColumn(n.info), dummyHasToc, d.options + {roSkipPounds}), result) -proc genRecComment(d: PDoc, n: PNode): PRope = +proc genRecComment(d: PDoc, n: PNode): Rope = if n == nil: return nil - result = genComment(d, n).toRope + result = genComment(d, n).rope if result == nil: if n.kind notin {nkEmpty..nkNilLit}: for i in countup(0, len(n)-1): @@ -331,9 +331,9 @@ proc genItem(d: PDoc, n, nameNode: PNode, k: TSymKind) = if not isVisible(nameNode): return let name = getName(d, nameNode) - nameRope = name.toRope + nameRope = name.rope plainDocstring = getPlainDocstring(n) # call here before genRecComment! - var result: PRope = nil + var result: Rope = nil var literal, plainName = "" var kind = tkEof var comm = genRecComment(d, n) # call this here for the side-effect! @@ -356,69 +356,69 @@ proc genItem(d: PDoc, n, nameNode: PNode, k: TSymKind) = break of tkComment: dispA(result, "<span class=\"Comment\">$1</span>", "\\spanComment{$1}", - [toRope(esc(d.target, literal))]) + [rope(esc(d.target, literal))]) of tokKeywordLow..tokKeywordHigh: dispA(result, "<span class=\"Keyword\">$1</span>", "\\spanKeyword{$1}", - [toRope(literal)]) + [rope(literal)]) of tkOpr: dispA(result, "<span class=\"Operator\">$1</span>", "\\spanOperator{$1}", - [toRope(esc(d.target, literal))]) + [rope(esc(d.target, literal))]) of tkStrLit..tkTripleStrLit: dispA(result, "<span class=\"StringLit\">$1</span>", - "\\spanStringLit{$1}", [toRope(esc(d.target, literal))]) + "\\spanStringLit{$1}", [rope(esc(d.target, literal))]) of tkCharLit: dispA(result, "<span class=\"CharLit\">$1</span>", "\\spanCharLit{$1}", - [toRope(esc(d.target, literal))]) + [rope(esc(d.target, literal))]) of tkIntLit..tkUInt64Lit: dispA(result, "<span class=\"DecNumber\">$1</span>", - "\\spanDecNumber{$1}", [toRope(esc(d.target, literal))]) + "\\spanDecNumber{$1}", [rope(esc(d.target, literal))]) of tkFloatLit..tkFloat128Lit: dispA(result, "<span class=\"FloatNumber\">$1</span>", - "\\spanFloatNumber{$1}", [toRope(esc(d.target, literal))]) + "\\spanFloatNumber{$1}", [rope(esc(d.target, literal))]) of tkSymbol: dispA(result, "<span class=\"Identifier\">$1</span>", - "\\spanIdentifier{$1}", [toRope(esc(d.target, literal))]) + "\\spanIdentifier{$1}", [rope(esc(d.target, literal))]) of tkSpaces, tkInvalid: - app(result, literal) + add(result, literal) of tkParLe, tkParRi, tkBracketLe, tkBracketRi, tkCurlyLe, tkCurlyRi, tkBracketDotLe, tkBracketDotRi, tkCurlyDotLe, tkCurlyDotRi, tkParDotLe, tkParDotRi, tkComma, tkSemiColon, tkColon, tkEquals, tkDot, tkDotDot, tkAccent, tkColonColon, tkGStrLit, tkGTripleStrLit, tkInfixOpr, tkPrefixOpr, tkPostfixOpr: dispA(result, "<span class=\"Other\">$1</span>", "\\spanOther{$1}", - [toRope(esc(d.target, literal))]) + [rope(esc(d.target, literal))]) inc(d.id) let - plainNameRope = toRope(xmltree.escape(plainName.strip)) + plainNameRope = rope(xmltree.escape(plainName.strip)) cleanPlainSymbol = renderPlainSymbolName(nameNode) complexSymbol = complexName(k, n, cleanPlainSymbol) - plainSymbolRope = toRope(cleanPlainSymbol) - plainSymbolEncRope = toRope(encodeUrl(cleanPlainSymbol)) - itemIDRope = toRope(d.id) + plainSymbolRope = rope(cleanPlainSymbol) + plainSymbolEncRope = rope(encodeUrl(cleanPlainSymbol)) + itemIDRope = rope(d.id) symbolOrId = d.newUniquePlainSymbol(complexSymbol) - symbolOrIdRope = symbolOrId.toRope - symbolOrIdEncRope = encodeUrl(symbolOrId).toRope + symbolOrIdRope = symbolOrId.rope + symbolOrIdEncRope = encodeUrl(symbolOrId).rope - var seeSrcRope: PRope = nil + var seeSrcRope: Rope = nil let docItemSeeSrc = getConfigVar("doc.item.seesrc") if docItemSeeSrc.len > 0 and options.docSeeSrcUrl.len > 0: # XXX toFilename doesn't really work. We need to ensure that this keeps # returning a relative path. let urlRope = ropeFormatNamedVars(options.docSeeSrcUrl, - ["path", "line"], [n.info.toFilename.toRope, toRope($n.info.line)]) + ["path", "line"], [n.info.toFilename.rope, rope($n.info.line)]) dispA(seeSrcRope, "$1", "", [ropeFormatNamedVars(docItemSeeSrc, - ["path", "line", "url"], [n.info.toFilename.toRope, - toRope($n.info.line), urlRope])]) + ["path", "line", "url"], [n.info.toFilename.rope, + rope($n.info.line), urlRope])]) - app(d.section[k], ropeFormatNamedVars(getConfigVar("doc.item"), + add(d.section[k], ropeFormatNamedVars(getConfigVar("doc.item"), ["name", "header", "desc", "itemID", "header_plain", "itemSym", "itemSymOrID", "itemSymEnc", "itemSymOrIDEnc", "seeSrc"], [nameRope, result, comm, itemIDRope, plainNameRope, plainSymbolRope, symbolOrIdRope, plainSymbolEncRope, symbolOrIdEncRope, seeSrcRope])) - app(d.toc[k], ropeFormatNamedVars(getConfigVar("doc.item.toc"), + add(d.toc[k], ropeFormatNamedVars(getConfigVar("doc.item.toc"), ["name", "header", "desc", "itemID", "header_plain", "itemSym", "itemSymOrID", "itemSymEnc", "itemSymOrIDEnc"], - [toRope(getName(d, nameNode, d.splitAfter)), result, comm, + [rope(getName(d, nameNode, d.splitAfter)), result, comm, itemIDRope, plainNameRope, plainSymbolRope, symbolOrIdRope, plainSymbolEncRope, symbolOrIdEncRope])) @@ -436,7 +436,7 @@ proc genJSONItem(d: PDoc, n, nameNode: PNode, k: TSymKind): JsonNode = if not isVisible(nameNode): return var name = getName(d, nameNode) - comm = genRecComment(d, n).ropeToStr() + comm = $genRecComment(d, n) r: TSrcGen initTokRender(r, n, {renderNoBody, renderNoComments, renderDocComments}) @@ -453,14 +453,14 @@ proc checkForFalse(n: PNode): bool = proc traceDeps(d: PDoc, n: PNode) = const k = skModule - if d.section[k] != nil: app(d.section[k], ", ") + if d.section[k] != nil: add(d.section[k], ", ") dispA(d.section[k], "<a class=\"reference external\" href=\"$1.html\">$1</a>", - "$1", [toRope(getModuleName(n))]) + "$1", [rope(getModuleName(n))]) proc generateDoc*(d: PDoc, n: PNode) = case n.kind - of nkCommentStmt: app(d.modDesc, genComment(d, n)) + of nkCommentStmt: add(d.modDesc, genComment(d, n)) of nkProcDef: when useEffectSystem: documentRaises(n) genItem(d, n, n.sons[namePos], skProc) @@ -521,13 +521,13 @@ proc generateJson(d: PDoc, n: PNode, jArray: JsonNode = nil): JsonNode = result = genJSONItem(d, n.sons[i], n.sons[i].sons[0], succ(skType, ord(n.kind)-ord(nkTypeSection))) of nkStmtList: - var elem = jArray - if elem == nil: elem = newJArray() + result = if jArray != nil: jArray else: newJArray() + for i in countup(0, sonsLen(n) - 1): - var r = generateJson(d, n.sons[i], elem) + var r = generateJson(d, n.sons[i], result) if r != nil: - elem.add(r) - if result == nil: result = elem + result.add(r) + of nkWhenStmt: # generate documentation for the first branch only: if not checkForFalse(n.sons[0].sons[0]) and jArray != nil: @@ -540,28 +540,28 @@ proc genSection(d: PDoc, kind: TSymKind) = "Iterators", "Iterators", "Converters", "Macros", "Templates" ] if d.section[kind] == nil: return - var title = sectionNames[kind].toRope + var title = sectionNames[kind].rope d.section[kind] = ropeFormatNamedVars(getConfigVar("doc.section"), [ "sectionid", "sectionTitle", "sectionTitleID", "content"], [ - ord(kind).toRope, title, toRope(ord(kind) + 50), d.section[kind]]) + ord(kind).rope, title, rope(ord(kind) + 50), d.section[kind]]) d.toc[kind] = ropeFormatNamedVars(getConfigVar("doc.section.toc"), [ "sectionid", "sectionTitle", "sectionTitleID", "content"], [ - ord(kind).toRope, title, toRope(ord(kind) + 50), d.toc[kind]]) + ord(kind).rope, title, rope(ord(kind) + 50), d.toc[kind]]) -proc genOutFile(d: PDoc): PRope = +proc genOutFile(d: PDoc): Rope = var - code, content: PRope + code, content: Rope title = "" var j = 0 var tmp = "" renderTocEntries(d[], j, 1, tmp) - var toc = tmp.toRope + var toc = tmp.rope for i in countup(low(TSymKind), high(TSymKind)): genSection(d, i) - app(toc, d.toc[i]) + add(toc, d.toc[i]) if toc != nil: toc = ropeFormatNamedVars(getConfigVar("doc.toc"), ["content"], [toc]) - for i in countup(low(TSymKind), high(TSymKind)): app(code, d.section[i]) + for i in countup(low(TSymKind), high(TSymKind)): add(code, d.section[i]) # Extract the title. Non API modules generate an entry in the index table. if d.meta[metaTitle].len != 0: @@ -574,16 +574,16 @@ proc genOutFile(d: PDoc): PRope = let bodyname = if d.hasToc: "doc.body_toc" else: "doc.body_no_toc" content = ropeFormatNamedVars(getConfigVar(bodyname), ["title", "tableofcontents", "moduledesc", "date", "time", "content"], - [title.toRope, toc, d.modDesc, toRope(getDateStr()), - toRope(getClockStr()), code]) + [title.rope, toc, d.modDesc, rope(getDateStr()), + rope(getClockStr()), code]) if optCompileOnly notin gGlobalOptions: # XXX what is this hack doing here? 'optCompileOnly' means raw output!? code = ropeFormatNamedVars(getConfigVar("doc.file"), ["title", "tableofcontents", "moduledesc", "date", "time", "content", "author", "version", "analytics"], - [title.toRope, toc, d.modDesc, toRope(getDateStr()), - toRope(getClockStr()), content, d.meta[metaAuthor].toRope, - d.meta[metaVersion].toRope, d.analytics.toRope]) + [title.rope, toc, d.modDesc, rope(getDateStr()), + rope(getClockStr()), content, d.meta[metaAuthor].rope, + d.meta[metaVersion].rope, d.analytics.rope]) else: code = content result = code @@ -618,7 +618,7 @@ proc commandRstAux(filename, outExt: string) = #d.modDesc = newMutableRope(30_000) renderRstToOut(d[], rst, modDesc) #freezeMutableRope(d.modDesc) - d.modDesc = toRope(modDesc) + d.modDesc = rope(modDesc) writeOutput(d, filename, outExt) generateIndex(d) @@ -635,7 +635,7 @@ proc commandJSON*() = var d = newDocumentor(gProjectFull, options.gConfigVars) d.hasToc = true var json = generateJson(d, ast) - var content = newRope(pretty(json)) + var content = rope(pretty(json)) if optStdout in gGlobalOptions: writeRope(stdout, content) @@ -644,12 +644,12 @@ proc commandJSON*() = writeRope(content, getOutFile(gProjectFull, JsonExt), useWarning = false) proc commandBuildIndex*() = - var content = mergeIndexes(gProjectFull).toRope + var content = mergeIndexes(gProjectFull).rope let code = ropeFormatNamedVars(getConfigVar("doc.file"), ["title", "tableofcontents", "moduledesc", "date", "time", "content", "author", "version", "analytics"], - ["Index".toRope, nil, nil, toRope(getDateStr()), - toRope(getClockStr()), content, nil, nil, nil]) + ["Index".rope, nil, nil, rope(getDateStr()), + rope(getClockStr()), content, nil, nil, nil]) # no analytics because context is not available writeRope(code, getOutFile("theindex", HtmlExt)) diff --git a/compiler/evalffi.nim b/compiler/evalffi.nim deleted file mode 100644 index b1a23802d..000000000 --- a/compiler/evalffi.nim +++ /dev/null @@ -1,496 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2015 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This file implements the FFI part of the evaluator for Nim code. - -import ast, astalgo, ropes, types, options, tables, dynlib, libffi, msgs, os - -when defined(windows): - const libcDll = "msvcrt.dll" -else: - const libcDll = "libc.so(.6|.5|)" - -type - TDllCache = tables.TTable[string, TLibHandle] -var - gDllCache = initTable[string, TLibHandle]() - -when defined(windows): - var gExeHandle = loadLib(os.getAppFilename()) -else: - var gExeHandle = loadLib() - -proc getDll(cache: var TDllCache; dll: string; info: TLineInfo): pointer = - result = cache[dll] - if result.isNil: - var libs: seq[string] = @[] - libCandidates(dll, libs) - for c in libs: - result = loadLib(c) - if not result.isNil: break - if result.isNil: - globalError(info, "cannot load: " & dll) - cache[dll] = result - -const - nkPtrLit = nkIntLit # hopefully we can get rid of this hack soon - -var myerrno {.importc: "errno", header: "<errno.h>".}: cint ## error variable - -proc importcSymbol*(sym: PSym): PNode = - let name = ropeToStr(sym.loc.r) - - # the AST does not support untyped pointers directly, so we use an nkIntLit - # that contains the address instead: - result = newNodeIT(nkPtrLit, sym.info, sym.typ) - case name - of "stdin": result.intVal = cast[TAddress](system.stdin) - of "stdout": result.intVal = cast[TAddress](system.stdout) - of "stderr": result.intVal = cast[TAddress](system.stderr) - of "vmErrnoWrapper": result.intVal = cast[TAddress](myerrno) - else: - let lib = sym.annex - if lib != nil and lib.path.kind notin {nkStrLit..nkTripleStrLit}: - globalError(sym.info, "dynlib needs to be a string lit for the REPL") - var theAddr: pointer - if lib.isNil and not gExehandle.isNil: - # first try this exe itself: - theAddr = gExehandle.symAddr(name) - # then try libc: - if theAddr.isNil: - let dllhandle = gDllCache.getDll(libcDll, sym.info) - theAddr = dllhandle.symAddr(name) - elif not lib.isNil: - let dllhandle = gDllCache.getDll(if lib.kind == libHeader: libcDll - else: lib.path.strVal, sym.info) - theAddr = dllhandle.symAddr(name) - if theAddr.isNil: globalError(sym.info, "cannot import: " & sym.name.s) - result.intVal = cast[TAddress](theAddr) - -proc mapType(t: ast.PType): ptr libffi.TType = - if t == nil: return addr libffi.type_void - - case t.kind - of tyBool, tyEnum, tyChar, tyInt..tyInt64, tyUInt..tyUInt64, tySet: - case t.getSize - of 1: result = addr libffi.type_uint8 - of 2: result = addr libffi.type_sint16 - of 4: result = addr libffi.type_sint32 - of 8: result = addr libffi.type_sint64 - else: result = nil - of tyFloat, tyFloat64: result = addr libffi.type_double - of tyFloat32: result = addr libffi.type_float - of tyVar, tyPointer, tyPtr, tyRef, tyCString, tySequence, tyString, tyExpr, - tyStmt, tyTypeDesc, tyProc, tyArray, tyArrayConstr, tyStatic, tyNil: - result = addr libffi.type_pointer - of tyDistinct: - result = mapType(t.sons[0]) - else: - result = nil - # too risky: - #of tyFloat128: result = addr libffi.type_longdouble - -proc mapCallConv(cc: TCallingConvention, info: TLineInfo): TABI = - case cc - of ccDefault: result = DEFAULT_ABI - of ccStdCall: result = when defined(windows): STDCALL else: DEFAULT_ABI - of ccCDecl: result = DEFAULT_ABI - else: - globalError(info, "cannot map calling convention to FFI") - -template rd(T, p: expr): expr {.immediate.} = (cast[ptr T](p))[] -template wr(T, p, v: expr) {.immediate.} = (cast[ptr T](p))[] = v -template `+!`(x, y: expr): expr {.immediate.} = - cast[pointer](cast[TAddress](x) + y) - -proc packSize(v: PNode, typ: PType): int = - ## computes the size of the blob - case typ.kind - of tyPtr, tyRef, tyVar: - if v.kind in {nkNilLit, nkPtrLit}: - result = sizeof(pointer) - else: - result = sizeof(pointer) + packSize(v.sons[0], typ.lastSon) - of tyDistinct, tyGenericInst: - result = packSize(v, typ.sons[0]) - of tyArray, tyArrayConstr: - # consider: ptr array[0..1000_000, int] which is common for interfacing; - # we use the real length here instead - if v.kind in {nkNilLit, nkPtrLit}: - result = sizeof(pointer) - elif v.len != 0: - result = v.len * packSize(v.sons[0], typ.sons[1]) - else: - result = typ.getSize.int - -proc pack(v: PNode, typ: PType, res: pointer) - -proc getField(n: PNode; position: int): PSym = - case n.kind - of nkRecList: - for i in countup(0, sonsLen(n) - 1): - result = getField(n.sons[i], position) - if result != nil: return - of nkRecCase: - result = getField(n.sons[0], position) - if result != nil: return - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind - of nkOfBranch, nkElse: - result = getField(lastSon(n.sons[i]), position) - if result != nil: return - else: internalError(n.info, "getField(record case branch)") - of nkSym: - if n.sym.position == position: result = n.sym - else: discard - -proc packObject(x: PNode, typ: PType, res: pointer) = - internalAssert x.kind in {nkObjConstr, nkPar} - # compute the field's offsets: - discard typ.getSize - for i in countup(ord(x.kind == nkObjConstr), sonsLen(x) - 1): - var it = x.sons[i] - if it.kind == nkExprColonExpr: - internalAssert it.sons[0].kind == nkSym - let field = it.sons[0].sym - pack(it.sons[1], field.typ, res +! field.offset) - elif typ.n != nil: - let field = getField(typ.n, i) - pack(it, field.typ, res +! field.offset) - else: - # XXX: todo - globalError(x.info, "cannot pack unnamed tuple") - -const maxPackDepth = 20 -var packRecCheck = 0 - -proc pack(v: PNode, typ: PType, res: pointer) = - template awr(T, v: expr) {.immediate, dirty.} = - wr(T, res, v) - - case typ.kind - of tyBool: awr(bool, v.intVal != 0) - of tyChar: awr(char, v.intVal.chr) - of tyInt: awr(int, v.intVal.int) - of tyInt8: awr(int8, v.intVal.int8) - of tyInt16: awr(int16, v.intVal.int16) - of tyInt32: awr(int32, v.intVal.int32) - of tyInt64: awr(int64, v.intVal.int64) - of tyUInt: awr(uint, v.intVal.uint) - of tyUInt8: awr(uint8, v.intVal.uint8) - of tyUInt16: awr(uint16, v.intVal.uint16) - of tyUInt32: awr(uint32, v.intVal.uint32) - of tyUInt64: awr(uint64, v.intVal.uint64) - of tyEnum, tySet: - case v.typ.getSize - of 1: awr(uint8, v.intVal.uint8) - of 2: awr(uint16, v.intVal.uint16) - of 4: awr(int32, v.intVal.int32) - of 8: awr(int64, v.intVal.int64) - else: - globalError(v.info, "cannot map value to FFI (tyEnum, tySet)") - of tyFloat: awr(float, v.floatVal) - of tyFloat32: awr(float32, v.floatVal) - of tyFloat64: awr(float64, v.floatVal) - - of tyPointer, tyProc, tyCString, tyString: - if v.kind == nkNilLit: - # nothing to do since the memory is 0 initialized anyway - discard - elif v.kind == nkPtrLit: - awr(pointer, cast[pointer](v.intVal)) - elif v.kind in {nkStrLit..nkTripleStrLit}: - awr(cstring, cstring(v.strVal)) - else: - globalError(v.info, "cannot map pointer/proc value to FFI") - of tyPtr, tyRef, tyVar: - if v.kind == nkNilLit: - # nothing to do since the memory is 0 initialized anyway - discard - elif v.kind == nkPtrLit: - awr(pointer, cast[pointer](v.intVal)) - else: - if packRecCheck > maxPackDepth: - packRecCheck = 0 - globalError(v.info, "cannot map value to FFI " & typeToString(v.typ)) - inc packRecCheck - pack(v.sons[0], typ.lastSon, res +! sizeof(pointer)) - dec packRecCheck - awr(pointer, res +! sizeof(pointer)) - of tyArray, tyArrayConstr: - let baseSize = typ.sons[1].getSize - for i in 0 .. <v.len: - pack(v.sons[i], typ.sons[1], res +! i * baseSize) - of tyObject, tyTuple: - packObject(v, typ, res) - of tyNil: - discard - of tyDistinct, tyGenericInst: - pack(v, typ.sons[0], res) - else: - globalError(v.info, "cannot map value to FFI " & typeToString(v.typ)) - -proc unpack(x: pointer, typ: PType, n: PNode): PNode - -proc unpackObjectAdd(x: pointer, n, result: PNode) = - case n.kind - of nkRecList: - for i in countup(0, sonsLen(n) - 1): - unpackObjectAdd(x, n.sons[i], result) - of nkRecCase: - globalError(result.info, "case objects cannot be unpacked") - of nkSym: - var pair = newNodeI(nkExprColonExpr, result.info, 2) - pair.sons[0] = n - pair.sons[1] = unpack(x +! n.sym.offset, n.sym.typ, nil) - #echo "offset: ", n.sym.name.s, " ", n.sym.offset - result.add pair - else: discard - -proc unpackObject(x: pointer, typ: PType, n: PNode): PNode = - # compute the field's offsets: - discard typ.getSize - - # iterate over any actual field of 'n' ... if n is nil we need to create - # the nkPar node: - if n.isNil: - result = newNode(nkPar) - result.typ = typ - if typ.n.isNil: - internalError("cannot unpack unnamed tuple") - unpackObjectAdd(x, typ.n, result) - else: - result = n - if result.kind notin {nkObjConstr, nkPar}: - globalError(n.info, "cannot map value from FFI") - if typ.n.isNil: - globalError(n.info, "cannot unpack unnamed tuple") - for i in countup(ord(n.kind == nkObjConstr), sonsLen(n) - 1): - var it = n.sons[i] - if it.kind == nkExprColonExpr: - internalAssert it.sons[0].kind == nkSym - let field = it.sons[0].sym - it.sons[1] = unpack(x +! field.offset, field.typ, it.sons[1]) - else: - let field = getField(typ.n, i) - n.sons[i] = unpack(x +! field.offset, field.typ, it) - -proc unpackArray(x: pointer, typ: PType, n: PNode): PNode = - if n.isNil: - result = newNode(nkBracket) - result.typ = typ - newSeq(result.sons, lengthOrd(typ).int) - else: - result = n - if result.kind != nkBracket: - globalError(n.info, "cannot map value from FFI") - let baseSize = typ.sons[1].getSize - for i in 0 .. < result.len: - result.sons[i] = unpack(x +! i * baseSize, typ.sons[1], result.sons[i]) - -proc canonNodeKind(k: TNodeKind): TNodeKind = - case k - of nkCharLit..nkUInt64Lit: result = nkIntLit - of nkFloatLit..nkFloat128Lit: result = nkFloatLit - of nkStrLit..nkTripleStrLit: result = nkStrLit - else: result = k - -proc unpack(x: pointer, typ: PType, n: PNode): PNode = - template aw(k, v, field: expr) {.immediate, dirty.} = - if n.isNil: - result = newNode(k) - result.typ = typ - else: - # check we have the right field: - result = n - if result.kind.canonNodeKind != k.canonNodeKind: - #echo "expected ", k, " but got ", result.kind - #debug result - return newNodeI(nkExceptBranch, n.info) - #globalError(n.info, "cannot map value from FFI") - result.field = v - - template setNil() = - if n.isNil: - result = newNode(nkNilLit) - result.typ = typ - else: - reset n[] - result = n - result.kind = nkNilLit - result.typ = typ - - template awi(kind, v: expr) {.immediate, dirty.} = aw(kind, v, intVal) - template awf(kind, v: expr) {.immediate, dirty.} = aw(kind, v, floatVal) - template aws(kind, v: expr) {.immediate, dirty.} = aw(kind, v, strVal) - - case typ.kind - of tyBool: awi(nkIntLit, rd(bool, x).ord) - of tyChar: awi(nkCharLit, rd(char, x).ord) - of tyInt: awi(nkIntLit, rd(int, x)) - of tyInt8: awi(nkInt8Lit, rd(int8, x)) - of tyInt16: awi(nkInt16Lit, rd(int16, x)) - of tyInt32: awi(nkInt32Lit, rd(int32, x)) - of tyInt64: awi(nkInt64Lit, rd(int64, x)) - of tyUInt: awi(nkUIntLit, rd(uint, x).BiggestInt) - of tyUInt8: awi(nkUInt8Lit, rd(uint8, x).BiggestInt) - of tyUInt16: awi(nkUInt16Lit, rd(uint16, x).BiggestInt) - of tyUInt32: awi(nkUInt32Lit, rd(uint32, x).BiggestInt) - of tyUInt64: awi(nkUInt64Lit, rd(uint64, x).BiggestInt) - of tyEnum: - case typ.getSize - of 1: awi(nkIntLit, rd(uint8, x).BiggestInt) - of 2: awi(nkIntLit, rd(uint16, x).BiggestInt) - of 4: awi(nkIntLit, rd(int32, x).BiggestInt) - of 8: awi(nkIntLit, rd(int64, x).BiggestInt) - else: - globalError(n.info, "cannot map value from FFI (tyEnum, tySet)") - of tyFloat: awf(nkFloatLit, rd(float, x)) - of tyFloat32: awf(nkFloat32Lit, rd(float32, x)) - of tyFloat64: awf(nkFloat64Lit, rd(float64, x)) - of tyPointer, tyProc: - let p = rd(pointer, x) - if p.isNil: - setNil() - elif n != nil and n.kind == nkStrLit: - # we passed a string literal as a pointer; however strings are already - # in their unboxed representation so nothing it to be unpacked: - result = n - else: - awi(nkPtrLit, cast[TAddress](p)) - of tyPtr, tyRef, tyVar: - let p = rd(pointer, x) - if p.isNil: - setNil() - elif n == nil or n.kind == nkPtrLit: - awi(nkPtrLit, cast[TAddress](p)) - elif n != nil and n.len == 1: - internalAssert n.kind == nkRefTy - n.sons[0] = unpack(p, typ.lastSon, n.sons[0]) - result = n - else: - globalError(n.info, "cannot map value from FFI " & typeToString(typ)) - of tyObject, tyTuple: - result = unpackObject(x, typ, n) - of tyArray, tyArrayConstr: - result = unpackArray(x, typ, n) - of tyCString, tyString: - let p = rd(cstring, x) - if p.isNil: - setNil() - else: - aws(nkStrLit, $p) - of tyNil: - setNil() - of tyDistinct, tyGenericInst: - result = unpack(x, typ.sons[0], n) - else: - # XXX what to do with 'array' here? - globalError(n.info, "cannot map value from FFI " & typeToString(typ)) - -proc fficast*(x: PNode, destTyp: PType): PNode = - if x.kind == nkPtrLit and x.typ.kind in {tyPtr, tyRef, tyVar, tyPointer, - tyProc, tyCString, tyString, - tySequence}: - result = newNodeIT(x.kind, x.info, destTyp) - result.intVal = x.intVal - elif x.kind == nkNilLit: - result = newNodeIT(x.kind, x.info, destTyp) - else: - # we play safe here and allocate the max possible size: - let size = max(packSize(x, x.typ), packSize(x, destTyp)) - var a = alloc0(size) - pack(x, x.typ, a) - # cast through a pointer needs a new inner object: - let y = if x.kind == nkRefTy: newNodeI(nkRefTy, x.info, 1) - else: x.copyTree - y.typ = x.typ - result = unpack(a, destTyp, y) - dealloc a - -proc callForeignFunction*(call: PNode): PNode = - internalAssert call.sons[0].kind == nkPtrLit - - var cif: TCif - var sig: TParamList - # use the arguments' types for varargs support: - for i in 1..call.len-1: - sig[i-1] = mapType(call.sons[i].typ) - if sig[i-1].isNil: - globalError(call.info, "cannot map FFI type") - - let typ = call.sons[0].typ - if prep_cif(cif, mapCallConv(typ.callConv, call.info), cuint(call.len-1), - mapType(typ.sons[0]), sig) != OK: - globalError(call.info, "error in FFI call") - - var args: TArgList - let fn = cast[pointer](call.sons[0].intVal) - for i in 1 .. call.len-1: - var t = call.sons[i].typ - args[i-1] = alloc0(packSize(call.sons[i], t)) - pack(call.sons[i], t, args[i-1]) - let retVal = if isEmptyType(typ.sons[0]): pointer(nil) - else: alloc(typ.sons[0].getSize.int) - - libffi.call(cif, fn, retVal, args) - - if retVal.isNil: - result = emptyNode - else: - result = unpack(retVal, typ.sons[0], nil) - result.info = call.info - - if retVal != nil: dealloc retVal - for i in 1 .. call.len-1: - call.sons[i] = unpack(args[i-1], typ.sons[i], call[i]) - dealloc args[i-1] - -proc callForeignFunction*(fn: PNode, fntyp: PType, - args: var TNodeSeq, start, len: int, - info: TLineInfo): PNode = - internalAssert fn.kind == nkPtrLit - - var cif: TCif - var sig: TParamList - for i in 0..len-1: - var aTyp = args[i+start].typ - if aTyp.isNil: - internalAssert i+1 < fntyp.len - aTyp = fntyp.sons[i+1] - args[i+start].typ = aTyp - sig[i] = mapType(aTyp) - if sig[i].isNil: globalError(info, "cannot map FFI type") - - if prep_cif(cif, mapCallConv(fntyp.callConv, info), cuint(len), - mapType(fntyp.sons[0]), sig) != OK: - globalError(info, "error in FFI call") - - var cargs: TArgList - let fn = cast[pointer](fn.intVal) - for i in 0 .. len-1: - let t = args[i+start].typ - cargs[i] = alloc0(packSize(args[i+start], t)) - pack(args[i+start], t, cargs[i]) - let retVal = if isEmptyType(fntyp.sons[0]): pointer(nil) - else: alloc(fntyp.sons[0].getSize.int) - - libffi.call(cif, fn, retVal, cargs) - - if retVal.isNil: - result = emptyNode - else: - result = unpack(retVal, fntyp.sons[0], nil) - result.info = info - - if retVal != nil: dealloc retVal - for i in 0 .. len-1: - let t = args[i+start].typ - args[i+start] = unpack(cargs[i], t, args[i+start]) - dealloc cargs[i] diff --git a/compiler/extccomp.nim b/compiler/extccomp.nim index a68e7f734..499d9ae52 100644 --- a/compiler/extccomp.nim +++ b/compiler/extccomp.nim @@ -449,7 +449,7 @@ proc execExternalProgram*(cmd: string, prettyCmd = "") = if execWithEcho(cmd, prettyCmd) != 0: rawMessage(errExecutionOfProgramFailed, "") -proc generateScript(projectFile: string, script: PRope) = +proc generateScript(projectFile: string, script: Rope) = let (dir, name, ext) = splitFile(projectFile) writeRope(script, dir / addFileExt("compile_" & name, platform.OS[targetOS].scriptExt)) @@ -604,7 +604,7 @@ proc addExternalFileToCompile*(filename: string) = if optForceFullMake in gGlobalOptions or externalFileChanged(filename): appendStr(externalToCompile, filename) -proc compileCFile(list: TLinkedList, script: var PRope, cmds: var TStringSeq, +proc compileCFile(list: TLinkedList, script: var Rope, cmds: var TStringSeq, prettyCmds: var TStringSeq, isExternal: bool) = var it = PStrEntry(list.head) while it != nil: @@ -615,8 +615,8 @@ proc compileCFile(list: TLinkedList, script: var PRope, cmds: var TStringSeq, let (dir, name, ext) = splitFile(it.data) add(prettyCmds, "CC: " & name) if optGenScript in gGlobalOptions: - app(script, compileCmd) - app(script, tnl) + add(script, compileCmd) + add(script, tnl) it = PStrEntry(it.next) proc callCCompiler*(projectfile: string) = @@ -627,7 +627,7 @@ proc callCCompiler*(projectfile: string) = # generated fileCounter = 0 var c = cCompiler - var script: PRope = nil + var script: Rope = nil var cmds: TStringSeq = @[] var prettyCmds: TStringSeq = @[] let prettyCb = proc (idx: int) = @@ -710,30 +710,30 @@ proc callCCompiler*(projectfile: string) = else: linkCmd = "" if optGenScript in gGlobalOptions: - app(script, linkCmd) - app(script, tnl) + add(script, linkCmd) + add(script, tnl) generateScript(projectfile, script) -proc genMappingFiles(list: TLinkedList): PRope = +proc genMappingFiles(list: TLinkedList): Rope = var it = PStrEntry(list.head) while it != nil: - appf(result, "--file:r\"$1\"$N", [toRope(it.data)]) + addf(result, "--file:r\"$1\"$N", [rope(it.data)]) it = PStrEntry(it.next) -proc writeMapping*(gSymbolMapping: PRope) = +proc writeMapping*(gSymbolMapping: Rope) = if optGenMapping notin gGlobalOptions: return - var code = toRope("[C_Files]\n") - app(code, genMappingFiles(toCompile)) - app(code, genMappingFiles(externalToCompile)) - app(code, "\n[C_Compiler]\nFlags=") - app(code, strutils.escape(getCompileOptions())) + var code = rope("[C_Files]\n") + add(code, genMappingFiles(toCompile)) + add(code, genMappingFiles(externalToCompile)) + add(code, "\n[C_Compiler]\nFlags=") + add(code, strutils.escape(getCompileOptions())) - app(code, "\n[Linker]\nFlags=") - app(code, strutils.escape(getLinkOptions() & " " & + add(code, "\n[Linker]\nFlags=") + add(code, strutils.escape(getLinkOptions() & " " & getConfigVar(cCompiler, ".options.linker"))) - app(code, "\n[Environment]\nlibpath=") - app(code, strutils.escape(libpath)) + add(code, "\n[Environment]\nlibpath=") + add(code, strutils.escape(libpath)) - appf(code, "\n[Symbols]$n$1", [gSymbolMapping]) + addf(code, "\n[Symbols]$n$1", [gSymbolMapping]) writeRope(code, joinPath(gProjectPath, "mapping.txt")) diff --git a/compiler/guards.nim b/compiler/guards.nim index cedd2be2b..dc2b24add 100644 --- a/compiler/guards.nim +++ b/compiler/guards.nim @@ -22,7 +22,8 @@ const someLt = {mLtI, mLtI64, mLtF64, mLtU, mLtU64, mLtEnum, mLtCh, mLtB, mLtPtr, mLtStr} - someLen = {mLengthOpenArray, mLengthStr, mLengthArray, mLengthSeq} + someLen = {mLengthOpenArray, mLengthStr, mLengthArray, mLengthSeq, + mXLenStr, mXLenSeq} someIn = {mInRange, mInSet} @@ -34,8 +35,8 @@ const someMul = {mMulI, mMulI64, mMulF64} someDiv = {mDivI, mDivI64, mDivF64} someMod = {mModI, mModI64} - someMax = {mMaxI, mMaxI64, mMaxF64} - someMin = {mMinI, mMinI64, mMinF64} + someMax = {mMaxI, mMaxF64} + someMin = {mMinI, mMinF64} proc isValue(n: PNode): bool = n.kind in {nkCharLit..nkNilLit} proc isLocation(n: PNode): bool = not n.isValue diff --git a/compiler/importer.nim b/compiler/importer.nim index 57a1e542b..d619725db 100644 --- a/compiler/importer.nim +++ b/compiler/importer.nim @@ -9,7 +9,7 @@ # This module implements the symbol importing mechanism. -import +import intsets, strutils, os, ast, astalgo, msgs, options, idents, rodread, lookups, semdata, passes, renderer @@ -73,12 +73,12 @@ proc rawImportSymbol(c: PContext, s: PSym) = if etyp.kind in {tyBool, tyEnum} and sfPure notin s.flags: for j in countup(0, sonsLen(etyp.n) - 1): var e = etyp.n.sons[j].sym - if e.kind != skEnumField: - internalError(s.info, "rawImportSymbol") + if e.kind != skEnumField: + internalError(s.info, "rawImportSymbol") # BUGFIX: because of aliases for enums the symbol may already # have been put into the symbol table # BUGFIX: but only iff they are the same symbols! - var it: TIdentIter + var it: TIdentIter check = initIdentIter(it, c.importTable.symbols, e.name) while check != nil: if check.id == e.id: @@ -92,7 +92,7 @@ proc rawImportSymbol(c: PContext, s: PSym) = if s.kind == skConverter: addConverter(c, s) if hasPattern(s): addPattern(c, s) -proc importSymbol(c: PContext, n: PNode, fromMod: PSym) = +proc importSymbol(c: PContext, n: PNode, fromMod: PSym) = let ident = lookups.considerQuotedIdent(n) let s = strTableGet(fromMod.tab, ident) if s == nil: @@ -143,7 +143,7 @@ proc importForwarded(c: PContext, n: PNode, exceptSet: IntSet) = of nkExportExceptStmt: localError(n.info, errGenerated, "'export except' not implemented") else: - for i in 0 ..safeLen(n)-1: + for i in 0..safeLen(n)-1: importForwarded(c, n.sons[i], exceptSet) proc importModuleAs(n: PNode, realModule: PSym): PSym = @@ -155,7 +155,7 @@ proc importModuleAs(n: PNode, realModule: PSym): PSym = # some misguided guy will write 'import abc.foo as foo' ... result = createModuleAlias(realModule, n.sons[1].ident, realModule.info) -proc myImportModule(c: PContext, n: PNode): PSym = +proc myImportModule(c: PContext, n: PNode): PSym = var f = checkModuleName(n) if f != InvalidFileIDX: result = importModuleAs(n, gImportModule(c.module, f)) @@ -164,10 +164,10 @@ proc myImportModule(c: PContext, n: PNode): PSym = if sfDeprecated in result.flags: message(n.info, warnDeprecated, result.name.s) -proc evalImport(c: PContext, n: PNode): PNode = +proc evalImport(c: PContext, n: PNode): PNode = result = n var emptySet: IntSet - for i in countup(0, sonsLen(n) - 1): + for i in countup(0, sonsLen(n) - 1): var m = myImportModule(c, n.sons[i]) if m != nil: # ``addDecl`` needs to be done before ``importAllSymbols``! @@ -175,7 +175,7 @@ proc evalImport(c: PContext, n: PNode): PNode = importAllSymbolsExcept(c, m, emptySet) #importForwarded(c, m.ast, emptySet) -proc evalFrom(c: PContext, n: PNode): PNode = +proc evalFrom(c: PContext, n: PNode): PNode = result = n checkMinSonsLen(n, 2) var m = myImportModule(c, n.sons[0]) @@ -186,7 +186,7 @@ proc evalFrom(c: PContext, n: PNode): PNode = if n.sons[i].kind != nkNilLit: importSymbol(c, n.sons[i], m) -proc evalImportExcept*(c: PContext, n: PNode): PNode = +proc evalImportExcept*(c: PContext, n: PNode): PNode = result = n checkMinSonsLen(n, 2) var m = myImportModule(c, n.sons[0]) @@ -194,7 +194,7 @@ proc evalImportExcept*(c: PContext, n: PNode): PNode = n.sons[0] = newSymNode(m) addDecl(c, m) # add symbol to symbol table of module var exceptSet = initIntSet() - for i in countup(1, sonsLen(n) - 1): + for i in countup(1, sonsLen(n) - 1): let ident = lookups.considerQuotedIdent(n.sons[i]) exceptSet.incl(ident.id) importAllSymbolsExcept(c, m, exceptSet) diff --git a/compiler/installer.ini b/compiler/installer.ini index b4160cab3..12a8e702d 100644 --- a/compiler/installer.ini +++ b/compiler/installer.ini @@ -62,7 +62,7 @@ Files: "icons/koch_icon.o" Files: "compiler/readme.txt" Files: "compiler/installer.ini" -Files: "compiler/nim.nimrod.cfg" +Files: "compiler/nim.nim.cfg" Files: "compiler/*.nim" Files: "doc/*.txt" Files: "doc/manual/*.txt" diff --git a/compiler/jsgen.nim b/compiler/jsgen.nim index 0bdaeff83..704713243 100644 --- a/compiler/jsgen.nim +++ b/compiler/jsgen.nim @@ -59,9 +59,9 @@ type TCompRes = object kind: TResKind typ: TJSTypeKind - res: PRope # result part; index if this is an + res: Rope # result part; index if this is an # (address, index)-tuple - address: PRope # address of an (address, index)-tuple + address: Rope # address of an (address, index)-tuple TBlock = object id: int # the ID of the label; positive means that it @@ -69,7 +69,7 @@ type isLoop: bool # whether it's a 'block' or 'while' TGlobals = object - typeInfo, code: PRope + typeInfo, code: Rope forwarded: seq[PSym] generatedSyms: IntSet typeInfoGenerated: IntSet @@ -79,7 +79,7 @@ type TProc = object procDef: PNode prc: PSym - locals, body: PRope + locals, body: Rope options: TOptions module: BModule g: PGlobals @@ -104,13 +104,13 @@ proc initCompRes(r: var TCompRes) = r.typ = etyNone r.kind = resNone -proc rdLoc(a: TCompRes): PRope {.inline.} = +proc rdLoc(a: TCompRes): Rope {.inline.} = result = a.res when false: if a.typ != etyBaseIndex: result = a.res else: - result = ropef("$1[$2]", a.address, a.res) + result = "$1[$2]" % [a.address, a.res] proc newProc(globals: PGlobals, module: BModule, procDef: PNode, options: TOptions): PProc = @@ -124,7 +124,7 @@ proc newProc(globals: PGlobals, module: BModule, procDef: PNode, const MappedToObject = {tyObject, tyArray, tyArrayConstr, tyTuple, tyOpenArray, - tySet, tyVar, tyRef, tyPtr, tyBigNum, tyVarargs} + tySet, tyBigNum, tyVarargs} proc mapType(typ: PType): TJSTypeKind = let t = skipTypes(typ, abstractInst) @@ -155,21 +155,22 @@ proc mapType(typ: PType): TJSTypeKind = of tyProc: result = etyProc of tyCString: result = etyString -proc mangleName(s: PSym): PRope = +proc mangleName(s: PSym): Rope = result = s.loc.r if result == nil: - result = toRope(mangle(s.name.s)) - app(result, "_") - app(result, toRope(s.id)) + result = rope(mangle(s.name.s)) + add(result, "_") + add(result, rope(s.id)) s.loc.r = result -proc makeJSString(s: string): PRope = strutils.escape(s).toRope +proc makeJSString(s: string): Rope = + (if s.isNil: "null".rope else: strutils.escape(s).rope) include jstypes proc gen(p: PProc, n: PNode, r: var TCompRes) proc genStmt(p: PProc, n: PNode) -proc genProc(oldProc: PProc, prc: PSym): PRope +proc genProc(oldProc: PProc, prc: PSym): Rope proc genConstant(p: PProc, c: PSym) proc useMagic(p: PProc, name: string) = @@ -178,7 +179,7 @@ proc useMagic(p: PProc, name: string) = if s != nil: internalAssert s.kind in {skProc, skMethod, skConverter} if not p.g.generatedSyms.containsOrIncl(s.id): - app(p.g.code, genProc(p, s)) + add(p.g.code, genProc(p, s)) else: # we used to exclude the system module from this check, but for DLL # generation support this sloppyness leads to hard to detect bugs, so @@ -196,10 +197,10 @@ proc isSimpleExpr(n: PNode): bool = elif n.isAtom: result = true -proc getTemp(p: PProc): PRope = +proc getTemp(p: PProc): Rope = inc(p.unique) - result = ropef("Tmp$1", [toRope(p.unique)]) - appf(p.locals, "var $1;$n" | "local $1;$n", [result]) + result = "Tmp$1" % [rope(p.unique)] + addf(p.locals, "var $1;$n" | "local $1;$n", [result]) proc genAnd(p: PProc, a, b: PNode, r: var TCompRes) = assert r.kind == resNone @@ -208,7 +209,7 @@ proc genAnd(p: PProc, a, b: PNode, r: var TCompRes) = gen(p, a, x) gen(p, b, y) r.kind = resExpr - r.res = ropef("($1 && $2)" | "($1 and $2)", [x.rdLoc, y.rdLoc]) + r.res = ("($1 && $2)" | "($1 and $2)") % [x.rdLoc, y.rdLoc] else: r.res = p.getTemp r.kind = resVal @@ -222,11 +223,11 @@ proc genAnd(p: PProc, a, b: PNode, r: var TCompRes) = # tmp = b # tmp gen(p, a, x) - p.body.appf("if (!$1) $2 = false; else {" | - "if not $1 then $2 = false; else", x.rdLoc, r.rdLoc) + p.body.addf("if (!$1) $2 = false; else {" | + "if not $1 then $2 = false; else", [x.rdLoc, r.rdLoc]) gen(p, b, y) - p.body.appf("$2 = $1; }" | - "$2 = $1 end", y.rdLoc, r.rdLoc) + p.body.addf("$2 = $1; }" | + "$2 = $1 end", [y.rdLoc, r.rdLoc]) proc genOr(p: PProc, a, b: PNode, r: var TCompRes) = assert r.kind == resNone @@ -235,16 +236,16 @@ proc genOr(p: PProc, a, b: PNode, r: var TCompRes) = gen(p, a, x) gen(p, b, y) r.kind = resExpr - r.res = ropef("($1 || $2)" | "($1 or $2)", [x.rdLoc, y.rdLoc]) + r.res = ("($1 || $2)" | "($1 or $2)") % [x.rdLoc, y.rdLoc] else: r.res = p.getTemp r.kind = resVal gen(p, a, x) - p.body.appf("if ($1) $2 = true; else {" | - "if $1 then $2 = true; else", x.rdLoc, r.rdLoc) + p.body.addf("if ($1) $2 = true; else {" | + "if $1 then $2 = true; else", [x.rdLoc, r.rdLoc]) gen(p, b, y) - p.body.appf("$2 = $1; }" | - "$2 = $1 end", y.rdLoc, r.rdLoc) + p.body.addf("$2 = $1; }" | + "$2 = $1 end", [y.rdLoc, r.rdLoc]) type TMagicFrmt = array[0..3, string] @@ -262,6 +263,8 @@ const # magic checked op; magic unchecked op; checked op; unchecked op ["mulInt64", "", "mulInt64($1, $2)", "($1 * $2)"], # MulI64 ["divInt64", "", "divInt64($1, $2)", "Math.floor($1 / $2)"], # DivI64 ["modInt64", "", "modInt64($1, $2)", "Math.floor($1 % $2)"], # ModI64 + ["addInt", "", "addInt($1, $2)", "($1 + $2)"], # Succ + ["subInt", "", "subInt($1, $2)", "($1 - $2)"], # Pred ["", "", "($1 + $2)", "($1 + $2)"], # AddF64 ["", "", "($1 - $2)", "($1 - $2)"], # SubF64 ["", "", "($1 * $2)", "($1 * $2)"], # MulF64 @@ -278,8 +281,6 @@ const # magic checked op; magic unchecked op; checked op; unchecked op ["", "", "($1 & $2)", "($1 & $2)"], # BitandI64 ["", "", "($1 | $2)", "($1 | $2)"], # BitorI64 ["", "", "($1 ^ $2)", "($1 ^ $2)"], # BitxorI64 - ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinI64 - ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxI64 ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinF64 ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxF64 ["addU", "addU", "addU($1, $2)", "addU($1, $2)"], # addU @@ -323,7 +324,6 @@ const # magic checked op; magic unchecked op; checked op; unchecked op ["", "", "!($1)", "!($1)"], # Not ["", "", "+($1)", "+($1)"], # UnaryPlusI ["", "", "~($1)", "~($1)"], # BitnotI - ["", "", "+($1)", "+($1)"], # UnaryPlusI64 ["", "", "~($1)", "~($1)"], # BitnotI64 ["", "", "+($1)", "+($1)"], # UnaryPlusF64 ["", "", "-($1)", "-($1)"], # UnaryMinusF64 @@ -362,6 +362,8 @@ const # magic checked op; magic unchecked op; checked op; unchecked op ["mulInt64", "", "mulInt64($1, $2)", "($1 * $2)"], # MulI64 ["divInt64", "", "divInt64($1, $2)", "Math.floor($1 / $2)"], # DivI64 ["modInt64", "", "modInt64($1, $2)", "Math.floor($1 % $2)"], # ModI64 + ["addInt", "", "addInt($1, $2)", "($1 + $2)"], # Succ + ["subInt", "", "subInt($1, $2)", "($1 - $2)"], # Pred ["", "", "($1 + $2)", "($1 + $2)"], # AddF64 ["", "", "($1 - $2)", "($1 - $2)"], # SubF64 ["", "", "($1 * $2)", "($1 * $2)"], # MulF64 @@ -378,8 +380,6 @@ const # magic checked op; magic unchecked op; checked op; unchecked op ["", "", "($1 & $2)", "($1 & $2)"], # BitandI64 ["", "", "($1 | $2)", "($1 | $2)"], # BitorI64 ["", "", "($1 ^ $2)", "($1 ^ $2)"], # BitxorI64 - ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinI64 - ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxI64 ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinF64 ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxF64 ["addU", "addU", "addU($1, $2)", "addU($1, $2)"], # addU @@ -423,7 +423,6 @@ const # magic checked op; magic unchecked op; checked op; unchecked op ["", "", "not ($1)", "not ($1)"], # Not ["", "", "+($1)", "+($1)"], # UnaryPlusI ["", "", "~($1)", "~($1)"], # BitnotI - ["", "", "+($1)", "+($1)"], # UnaryPlusI64 ["", "", "~($1)", "~($1)"], # BitnotI64 ["", "", "+($1)", "+($1)"], # UnaryPlusF64 ["", "", "-($1)", "-($1)"], # UnaryMinusF64 @@ -456,7 +455,7 @@ proc binaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = useMagic(p, magic) gen(p, n.sons[1], x) gen(p, n.sons[2], y) - r.res = ropef(frmt, [x.rdLoc, y.rdLoc]) + r.res = frmt % [x.rdLoc, y.rdLoc] r.kind = resExpr proc ternaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = @@ -465,13 +464,13 @@ proc ternaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = gen(p, n.sons[1], x) gen(p, n.sons[2], y) gen(p, n.sons[3], z) - r.res = ropef(frmt, [x.rdLoc, y.rdLoc, z.rdLoc]) + r.res = frmt % [x.rdLoc, y.rdLoc, z.rdLoc] r.kind = resExpr proc unaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = useMagic(p, magic) gen(p, n.sons[1], r) - r.res = ropef(frmt, [r.rdLoc]) + r.res = frmt % [r.rdLoc] r.kind = resExpr proc arithAux(p: PProc, n: PNode, r: var TCompRes, op: TMagic, ops: TMagicOps) = @@ -482,10 +481,10 @@ proc arithAux(p: PProc, n: PNode, r: var TCompRes, op: TMagic, ops: TMagicOps) = if sonsLen(n) > 2: gen(p, n.sons[1], x) gen(p, n.sons[2], y) - r.res = ropef(ops[op][i + 2], [x.rdLoc, y.rdLoc]) + r.res = ops[op][i + 2] % [x.rdLoc, y.rdLoc] else: gen(p, n.sons[1], r) - r.res = ropef(ops[op][i + 2], [r.rdLoc]) + r.res = ops[op][i + 2] % [r.rdLoc] r.kind = resExpr proc arith(p: PProc, n: PNode, r: var TCompRes, op: TMagic) = @@ -494,16 +493,16 @@ proc arith(p: PProc, n: PNode, r: var TCompRes, op: TMagic) = proc genLineDir(p: PProc, n: PNode) = let line = toLinenumber(n.info) if optLineDir in p.options: - appf(p.body, "// line $2 \"$1\"$n" | "-- line $2 \"$1\"$n", - [toRope(toFilename(n.info)), toRope(line)]) + addf(p.body, "// line $2 \"$1\"$n" | "-- line $2 \"$1\"$n", + [rope(toFilename(n.info)), rope(line)]) if {optStackTrace, optEndb} * p.options == {optStackTrace, optEndb} and ((p.prc == nil) or sfPure notin p.prc.flags): useMagic(p, "endb") - appf(p.body, "endb($1);$n", [toRope(line)]) + addf(p.body, "endb($1);$n", [rope(line)]) elif ({optLineTrace, optStackTrace} * p.options == {optLineTrace, optStackTrace}) and ((p.prc == nil) or not (sfPure in p.prc.flags)): - appf(p.body, "F.line = $1;$n", [toRope(line)]) + addf(p.body, "F.line = $1;$n", [rope(line)]) proc genWhileStmt(p: PProc, n: PNode) = var @@ -515,21 +514,21 @@ proc genWhileStmt(p: PProc, n: PNode) = setLen(p.blocks, length + 1) p.blocks[length].id = -p.unique p.blocks[length].isLoop = true - let labl = p.unique.toRope - appf(p.body, "L$1: while (true) {$n" | "while true do$n", labl) + let labl = p.unique.rope + addf(p.body, "L$1: while (true) {$n" | "while true do$n", [labl]) gen(p, n.sons[0], cond) - appf(p.body, "if (!$1) break L$2;$n" | "if not $1 then goto ::L$2:: end;$n", + addf(p.body, "if (!$1) break L$2;$n" | "if not $1 then goto ::L$2:: end;$n", [cond.res, labl]) genStmt(p, n.sons[1]) - appf(p.body, "}$n" | "end ::L$#::$n", [labl]) + addf(p.body, "}$n" | "end ::L$#::$n", [labl]) setLen(p.blocks, length) proc moveInto(p: PProc, src: var TCompRes, dest: TCompRes) = if src.kind != resNone: if dest.kind != resNone: - p.body.appf("$1 = $2;$n", dest.rdLoc, src.rdLoc) + p.body.addf("$1 = $2;$n", [dest.rdLoc, src.rdLoc]) else: - p.body.appf("$1;$n", src.rdLoc) + p.body.addf("$1;$n", [src.rdLoc]) src.kind = resNone src.res = nil @@ -558,52 +557,52 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = r.kind = resVal r.res = getTemp(p) inc(p.unique) - var safePoint = ropef("Tmp$1", [toRope(p.unique)]) - appf(p.body, + var safePoint = "Tmp$1" % [rope(p.unique)] + addf(p.body, "var $1 = {prev: excHandler, exc: null};$nexcHandler = $1;$n" | "local $1 = pcall(", [safePoint]) - if optStackTrace in p.options: app(p.body, "framePtr = F;" & tnl) - appf(p.body, "try {$n" | "function()$n") + if optStackTrace in p.options: add(p.body, "framePtr = F;" & tnl) + addf(p.body, "try {$n" | "function()$n", []) var length = sonsLen(n) var a: TCompRes gen(p, n.sons[0], a) moveInto(p, a, r) var i = 1 if p.target == targetJS and length > 1 and n.sons[i].kind == nkExceptBranch: - appf(p.body, "} catch (EXC) {$n lastJSError = EXC;$n") + addf(p.body, "} catch (EXC) {$n lastJSError = EXC;$n", []) elif p.target == targetLua: - appf(p.body, "end)$n") + addf(p.body, "end)$n", []) while i < length and n.sons[i].kind == nkExceptBranch: let blen = sonsLen(n.sons[i]) if blen == 1: # general except section: - if i > 1: appf(p.body, "else {$n" | "else$n") + if i > 1: addf(p.body, "else {$n" | "else$n", []) gen(p, n.sons[i].sons[0], a) moveInto(p, a, r) - if i > 1: appf(p.body, "}$n" | "end$n") + if i > 1: addf(p.body, "}$n" | "end$n", []) else: - var orExpr: PRope = nil + var orExpr: Rope = nil useMagic(p, "isObj") for j in countup(0, blen - 2): if n.sons[i].sons[j].kind != nkType: internalError(n.info, "genTryStmt") - if orExpr != nil: app(orExpr, "||" | " or ") - appf(orExpr, "isObj($1.exc.m_type, $2)", + if orExpr != nil: add(orExpr, "||" | " or ") + addf(orExpr, "isObj($1.exc.m_type, $2)", [safePoint, genTypeInfo(p, n.sons[i].sons[j].typ)]) - if i > 1: app(p.body, "else ") - appf(p.body, "if ($1.exc && ($2)) {$n" | "if $1.exc and ($2) then$n", + if i > 1: add(p.body, "else ") + addf(p.body, "if ($1.exc && ($2)) {$n" | "if $1.exc and ($2) then$n", [safePoint, orExpr]) gen(p, n.sons[i].sons[blen - 1], a) moveInto(p, a, r) - appf(p.body, "}$n" | "end$n") + addf(p.body, "}$n" | "end$n", []) inc(i) if p.target == targetJS: - app(p.body, "} finally {" & tnl & "excHandler = excHandler.prev;" & tnl) + add(p.body, "} finally {" & tnl & "excHandler = excHandler.prev;" & tnl) if i < length and n.sons[i].kind == nkFinally: genStmt(p, n.sons[i].sons[0]) if p.target == targetJS: - app(p.body, "}" & tnl) + add(p.body, "}" & tnl) if p.target == targetLua: # we need to repeat the finally block for Lua ... if i < length and n.sons[i].kind == nkFinally: @@ -616,11 +615,11 @@ proc genRaiseStmt(p: PProc, n: PNode) = gen(p, n.sons[0], a) let typ = skipTypes(n.sons[0].typ, abstractPtrs) useMagic(p, "raiseException") - appf(p.body, "raiseException($1, $2);$n", + addf(p.body, "raiseException($1, $2);$n", [a.rdLoc, makeJSString(typ.sym.name.s)]) else: useMagic(p, "reraiseException") - app(p.body, "reraiseException();" & tnl) + add(p.body, "reraiseException();" & tnl) proc genCaseJS(p: PProc, n: PNode, r: var TCompRes) = var @@ -630,9 +629,9 @@ proc genCaseJS(p: PProc, n: PNode, r: var TCompRes) = let stringSwitch = skipTypes(n.sons[0].typ, abstractVar).kind == tyString if stringSwitch: useMagic(p, "toJSStr") - appf(p.body, "switch (toJSStr($1)) {$n", [cond.rdLoc]) + addf(p.body, "switch (toJSStr($1)) {$n", [cond.rdLoc]) else: - appf(p.body, "switch ($1) {$n", [cond.rdLoc]) + addf(p.body, "switch ($1) {$n", [cond.rdLoc]) if not isEmptyType(n.typ): r.kind = resVal r.res = getTemp(p) @@ -646,27 +645,27 @@ proc genCaseJS(p: PProc, n: PNode, r: var TCompRes) = var v = copyNode(e.sons[0]) while v.intVal <= e.sons[1].intVal: gen(p, v, cond) - appf(p.body, "case $1: ", [cond.rdLoc]) + addf(p.body, "case $1: ", [cond.rdLoc]) inc(v.intVal) else: if stringSwitch: case e.kind - of nkStrLit..nkTripleStrLit: appf(p.body, "case $1: ", + of nkStrLit..nkTripleStrLit: addf(p.body, "case $1: ", [makeJSString(e.strVal)]) else: internalError(e.info, "jsgen.genCaseStmt: 2") else: gen(p, e, cond) - appf(p.body, "case $1: ", [cond.rdLoc]) + addf(p.body, "case $1: ", [cond.rdLoc]) gen(p, lastSon(it), stmt) moveInto(p, stmt, r) - appf(p.body, "$nbreak;$n") + addf(p.body, "$nbreak;$n", []) of nkElse: - appf(p.body, "default: $n") + addf(p.body, "default: $n", []) gen(p, it.sons[0], stmt) moveInto(p, stmt, r) - appf(p.body, "break;$n") + addf(p.body, "break;$n", []) else: internalError(it.info, "jsgen.genCaseStmt") - appf(p.body, "}$n") + addf(p.body, "}$n", []) proc genCaseLua(p: PProc, n: PNode, r: var TCompRes) = var @@ -677,7 +676,7 @@ proc genCaseLua(p: PProc, n: PNode, r: var TCompRes) = if stringSwitch: useMagic(p, "eqStr") let tmp = getTemp(p) - appf(p.body, "$1 = $2;$n", [tmp, cond.rdLoc]) + addf(p.body, "$1 = $2;$n", [tmp, cond.rdLoc]) if not isEmptyType(n.typ): r.kind = resVal r.res = getTemp(p) @@ -685,34 +684,34 @@ proc genCaseLua(p: PProc, n: PNode, r: var TCompRes) = let it = n.sons[i] case it.kind of nkOfBranch: - if i != 1: appf(p.body, "$nelsif ") - else: appf(p.body, "if ") + if i != 1: addf(p.body, "$nelsif ", []) + else: addf(p.body, "if ", []) for j in countup(0, sonsLen(it) - 2): - if j != 0: app(p.body, " or ") + if j != 0: add(p.body, " or ") let e = it.sons[j] if e.kind == nkRange: var ia, ib: TCompRes gen(p, e.sons[0], ia) gen(p, e.sons[1], ib) - appf(p.body, "$1 >= $2 and $1 <= $3", [tmp, ia.rdLoc, ib.rdLoc]) + addf(p.body, "$1 >= $2 and $1 <= $3", [tmp, ia.rdLoc, ib.rdLoc]) else: if stringSwitch: case e.kind - of nkStrLit..nkTripleStrLit: appf(p.body, "eqStr($1, $2)", + of nkStrLit..nkTripleStrLit: addf(p.body, "eqStr($1, $2)", [tmp, makeJSString(e.strVal)]) else: internalError(e.info, "jsgen.genCaseStmt: 2") else: gen(p, e, cond) - appf(p.body, "$1 == $2", [tmp, cond.rdLoc]) - appf(p.body, " then$n") + addf(p.body, "$1 == $2", [tmp, cond.rdLoc]) + addf(p.body, " then$n", []) gen(p, lastSon(it), stmt) moveInto(p, stmt, r) of nkElse: - appf(p.body, "else$n") + addf(p.body, "else$n", []) gen(p, it.sons[0], stmt) moveInto(p, stmt, r) else: internalError(it.info, "jsgen.genCaseStmt") - appf(p.body, "$nend$n") + addf(p.body, "$nend$n", []) proc genBlock(p: PProc, n: PNode, r: var TCompRes) = inc(p.unique) @@ -726,9 +725,9 @@ proc genBlock(p: PProc, n: PNode, r: var TCompRes) = setLen(p.blocks, idx + 1) p.blocks[idx].id = - p.unique # negative because it isn't used yet let labl = p.unique - appf(p.body, "L$1: do {$n" | "", labl.toRope) + addf(p.body, "L$1: do {$n" | "", [labl.rope]) gen(p, n.sons[1], r) - appf(p.body, "} while(false);$n" | "$n::L$#::$n", labl.toRope) + addf(p.body, "} while(false);$n" | "$n::L$#::$n", [labl.rope]) setLen(p.blocks, idx) proc genBreakStmt(p: PProc, n: PNode) = @@ -747,15 +746,15 @@ proc genBreakStmt(p: PProc, n: PNode) = if idx < 0 or not p.blocks[idx].isLoop: internalError(n.info, "no loop to break") p.blocks[idx].id = abs(p.blocks[idx].id) # label is used - appf(p.body, "break L$1;$n" | "goto ::L$1::;$n", [toRope(p.blocks[idx].id)]) + addf(p.body, "break L$1;$n" | "goto ::L$1::;$n", [rope(p.blocks[idx].id)]) proc genAsmStmt(p: PProc, n: PNode) = genLineDir(p, n) assert(n.kind == nkAsmStmt) for i in countup(0, sonsLen(n) - 1): case n.sons[i].kind - of nkStrLit..nkTripleStrLit: app(p.body, n.sons[i].strVal) - of nkSym: app(p.body, mangleName(n.sons[i].sym)) + of nkStrLit..nkTripleStrLit: add(p.body, n.sons[i].strVal) + of nkSym: add(p.body, mangleName(n.sons[i].sym)) else: internalError(n.sons[i].info, "jsgen: genAsmStmt()") proc genIf(p: PProc, n: PNode, r: var TCompRes) = @@ -768,35 +767,35 @@ proc genIf(p: PProc, n: PNode, r: var TCompRes) = let it = n.sons[i] if sonsLen(it) != 1: if i > 0: - appf(p.body, "else {$n" | "else$n", []) + addf(p.body, "else {$n" | "else$n", []) inc(toClose) gen(p, it.sons[0], cond) - appf(p.body, "if ($1) {$n" | "if $# then$n", cond.rdLoc) + addf(p.body, "if ($1) {$n" | "if $# then$n", [cond.rdLoc]) gen(p, it.sons[1], stmt) else: # else part: - appf(p.body, "else {$n" | "else$n") + addf(p.body, "else {$n" | "else$n", []) gen(p, it.sons[0], stmt) moveInto(p, stmt, r) - appf(p.body, "}$n" | "end$n") + addf(p.body, "}$n" | "end$n", []) if p.target == targetJS: - app(p.body, repeat('}', toClose) & tnl) + add(p.body, repeat('}', toClose) & tnl) else: - for i in 1..toClose: appf(p.body, "end$n") + for i in 1..toClose: addf(p.body, "end$n", []) -proc generateHeader(p: PProc, typ: PType): PRope = +proc generateHeader(p: PProc, typ: PType): Rope = result = nil for i in countup(1, sonsLen(typ.n) - 1): - if result != nil: app(result, ", ") assert(typ.n.sons[i].kind == nkSym) var param = typ.n.sons[i].sym if isCompileTimeOnly(param.typ): continue + if result != nil: add(result, ", ") var name = mangleName(param) - app(result, name) + add(result, name) if mapType(param.typ) == etyBaseIndex: - app(result, ", ") - app(result, name) - app(result, "_Idx") + add(result, ", ") + add(result, name) + add(result, "_Idx") const nodeKindsNeedNoCopy = {nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, @@ -815,17 +814,17 @@ proc genAsgnAux(p: PProc, x, y: PNode, noCopyNeeded: bool) = case mapType(x.typ) of etyObject: if needsNoCopy(y) or noCopyNeeded: - appf(p.body, "$1 = $2;$n", [a.rdLoc, b.rdLoc]) + addf(p.body, "$1 = $2;$n", [a.rdLoc, b.rdLoc]) else: useMagic(p, "nimCopy") - appf(p.body, "$1 = nimCopy($2, $3);$n", + addf(p.body, "$1 = nimCopy($2, $3);$n", [a.res, b.res, genTypeInfo(p, y.typ)]) of etyBaseIndex: if a.typ != etyBaseIndex or b.typ != etyBaseIndex: internalError(x.info, "genAsgn") - appf(p.body, "$1 = $2; $3 = $4;$n", [a.address, b.address, a.res, b.res]) + addf(p.body, "$1 = $2; $3 = $4;$n", [a.address, b.address, a.res, b.res]) else: - appf(p.body, "$1 = $2;$n", [a.res, b.res]) + addf(p.body, "$1 = $2;$n", [a.res, b.res]) proc genAsgn(p: PProc, n: PNode) = genLineDir(p, n) @@ -840,17 +839,17 @@ proc genSwap(p: PProc, n: PNode) = gen(p, n.sons[1], a) gen(p, n.sons[2], b) inc(p.unique) - var tmp = ropef("Tmp$1", [toRope(p.unique)]) + var tmp = "Tmp$1" % [rope(p.unique)] if mapType(skipTypes(n.sons[1].typ, abstractVar)) == etyBaseIndex: inc(p.unique) - let tmp2 = ropef("Tmp$1", [toRope(p.unique)]) + let tmp2 = "Tmp$1" % [rope(p.unique)] if a.typ != etyBaseIndex or b.typ != etyBaseIndex: internalError(n.info, "genSwap") - appf(p.body, "var $1 = $2; $2 = $3; $3 = $1;$n" | + addf(p.body, "var $1 = $2; $2 = $3; $3 = $1;$n" | "local $1 = $2; $2 = $3; $3 = $1;$n", [ tmp, a.address, b.address]) tmp = tmp2 - appf(p.body, "var $1 = $2; $2 = $3; $3 = $1;" | + addf(p.body, "var $1 = $2; $2 = $3; $3 = $1;" | "local $1 = $2; $2 = $3; $3 = $1;", [tmp, a.res, b.res]) proc getFieldPosition(f: PNode): int = @@ -870,7 +869,7 @@ proc genFieldAddr(p: PProc, n: PNode, r: var TCompRes) = if b.sons[1].kind != nkSym: internalError(b.sons[1].info, "genFieldAddr") var f = b.sons[1].sym if f.loc.r == nil: f.loc.r = mangleName(f) - r.res = makeJSString(ropeToStr(f.loc.r)) + r.res = makeJSString($f.loc.r) internalAssert a.typ != etyBaseIndex r.address = a.res r.kind = resExpr @@ -879,12 +878,12 @@ proc genFieldAccess(p: PProc, n: PNode, r: var TCompRes) = r.typ = etyNone gen(p, n.sons[0], r) if skipTypes(n.sons[0].typ, abstractVarRange).kind == tyTuple: - r.res = ropef("$1.Field$2", [r.res, getFieldPosition(n.sons[1]).toRope]) + r.res = "$1.Field$2" % [r.res, getFieldPosition(n.sons[1]).rope] else: if n.sons[1].kind != nkSym: internalError(n.sons[1].info, "genFieldAddr") var f = n.sons[1].sym if f.loc.r == nil: f.loc.r = mangleName(f) - r.res = ropef("$1.$2", [r.res, f.loc.r]) + r.res = "$1.$2" % [r.res, f.loc.r] r.kind = resExpr proc genCheckedFieldAddr(p: PProc, n: PNode, r: var TCompRes) = @@ -910,10 +909,9 @@ proc genArrayAddr(p: PProc, n: PNode, r: var TCompRes) = else: first = 0 if optBoundsCheck in p.options and not isConstExpr(m.sons[1]): useMagic(p, "chckIndx") - r.res = ropef("chckIndx($1, $2, $3.length)-$2", - [b.res, toRope(first), a.res]) + r.res = "chckIndx($1, $2, $3.length)-$2" % [b.res, rope(first), a.res] elif first != 0: - r.res = ropef("($1)-$2", [b.res, toRope(first)]) + r.res = "($1)-$2" % [b.res, rope(first)] else: r.res = b.res r.kind = resExpr @@ -930,10 +928,17 @@ proc genArrayAccess(p: PProc, n: PNode, r: var TCompRes) = else: internalError(n.info, "expr(nkBracketExpr, " & $ty.kind & ')') r.typ = etyNone if r.res == nil: internalError(n.info, "genArrayAccess") - r.res = ropef("$1[$2]", [r.address, r.res]) + r.res = "$1[$2]" % [r.address, r.res] r.address = nil r.kind = resExpr +proc isIndirect(v: PSym): bool = + result = {sfAddrTaken, sfGlobal} * v.flags != {} and + #(mapType(v.typ) != etyObject) and + {sfImportc, sfVolatile, sfExportc} * v.flags == {} and + v.kind notin {skProc, skConverter, skMethod, skIterator, skClosureIterator, + skConst, skTemp, skLet} + proc genAddr(p: PProc, n: PNode, r: var TCompRes) = case n.sons[0].kind of nkSym: @@ -942,17 +947,21 @@ proc genAddr(p: PProc, n: PNode, r: var TCompRes) = case s.kind of skVar, skLet, skResult: r.kind = resExpr - if mapType(n.sons[0].typ) == etyObject: + let jsType = mapType(n.typ) + if jsType == etyObject: # make addr() a no-op: r.typ = etyNone - r.res = s.loc.r + if isIndirect(s): + r.res = s.loc.r & "[0]" + else: + r.res = s.loc.r r.address = nil - elif {sfGlobal, sfAddrTaken} * s.flags != {}: + elif {sfGlobal, sfAddrTaken} * s.flags != {} or jsType == etyBaseIndex: # for ease of code generation, we do not distinguish between # sfAddrTaken and sfGlobal. r.typ = etyBaseIndex r.address = s.loc.r - r.res = toRope("0") + r.res = rope("0") else: # 'var openArray' for instance produces an 'addr' but this is harmless: gen(p, n.sons[0], r) @@ -984,13 +993,13 @@ proc genSym(p: PProc, n: PNode, r: var TCompRes) = if k == etyBaseIndex: r.typ = etyBaseIndex if {sfAddrTaken, sfGlobal} * s.flags != {}: - r.address = ropef("$1[0]", [s.loc.r]) - r.res = ropef("$1[1]", [s.loc.r]) + r.address = "$1[0]" % [s.loc.r] + r.res = "$1[1]" % [s.loc.r] else: r.address = s.loc.r - r.res = con(s.loc.r, "_Idx") - elif k != etyObject and {sfAddrTaken, sfGlobal} * s.flags != {}: - r.res = ropef("$1[0]", [s.loc.r]) + r.res = s.loc.r & "_Idx" + elif isIndirect(s): + r.res = "$1[0]" % [s.loc.r] else: r.res = s.loc.r of skConst: @@ -1014,8 +1023,8 @@ proc genSym(p: PProc, n: PNode, r: var TCompRes) = var owner = p while owner != nil and owner.prc != s.owner: owner = owner.up - if owner != nil: app(owner.locals, newp) - else: app(p.g.code, newp) + if owner != nil: add(owner.locals, newp) + else: add(p.g.code, newp) else: if s.loc.r == nil: internalError(n.info, "symbol has no generated name: " & s.name.s) @@ -1029,26 +1038,26 @@ proc genDeref(p: PProc, n: PNode, r: var TCompRes) = var a: TCompRes gen(p, n.sons[0], a) if a.typ != etyBaseIndex: internalError(n.info, "genDeref") - r.res = ropef("$1[$2]", [a.address, a.res]) + r.res = "$1[$2]" % [a.address, a.res] proc genArg(p: PProc, n: PNode, r: var TCompRes) = var a: TCompRes gen(p, n, a) if a.typ == etyBaseIndex: - app(r.res, a.address) - app(r.res, ", ") - app(r.res, a.res) + add(r.res, a.address) + add(r.res, ", ") + add(r.res, a.res) else: - app(r.res, a.res) + add(r.res, a.res) proc genArgs(p: PProc, n: PNode, r: var TCompRes) = - app(r.res, "(") + add(r.res, "(") for i in countup(1, sonsLen(n) - 1): let it = n.sons[i] if it.typ.isCompileTimeOnly: continue - if i > 1: app(r.res, ", ") + if i > 1: add(r.res, ", ") genArg(p, it, r) - app(r.res, ")") + add(r.res, ")") r.kind = resExpr proc genCall(p: PProc, n: PNode, r: var TCompRes) = @@ -1060,68 +1069,68 @@ proc genInfixCall(p: PProc, n: PNode, r: var TCompRes) = if r.typ == etyBaseIndex: if r.address == nil: globalError(n.info, "cannot invoke with infix syntax") - r.res = ropef("$1[$2]", [r.address, r.res]) + r.res = "$1[$2]" % [r.address, r.res] r.address = nil r.typ = etyNone - app(r.res, ".") + add(r.res, ".") var op: TCompRes gen(p, n.sons[0], op) - app(r.res, op.res) + add(r.res, op.res) - app(r.res, "(") + add(r.res, "(") for i in countup(2, sonsLen(n) - 1): - if i > 2: app(r.res, ", ") + if i > 2: add(r.res, ", ") genArg(p, n.sons[i], r) - app(r.res, ")") + add(r.res, ")") r.kind = resExpr proc genEcho(p: PProc, n: PNode, r: var TCompRes) = useMagic(p, "rawEcho") - app(r.res, "rawEcho(") + add(r.res, "rawEcho(") let n = n[1].skipConv internalAssert n.kind == nkBracket for i in countup(0, sonsLen(n) - 1): let it = n.sons[i] if it.typ.isCompileTimeOnly: continue - if i > 0: app(r.res, ", ") + if i > 0: add(r.res, ", ") genArg(p, it, r) - app(r.res, ")") + add(r.res, ")") r.kind = resExpr -proc putToSeq(s: string, indirect: bool): PRope = - result = toRope(s) - if indirect: result = ropef("[$1]", [result]) +proc putToSeq(s: string, indirect: bool): Rope = + result = rope(s) + if indirect: result = "[$1]" % [result] -proc createVar(p: PProc, typ: PType, indirect: bool): PRope -proc createRecordVarAux(p: PProc, rec: PNode, c: var int): PRope = +proc createVar(p: PProc, typ: PType, indirect: bool): Rope +proc createRecordVarAux(p: PProc, rec: PNode, c: var int): Rope = result = nil case rec.kind of nkRecList: for i in countup(0, sonsLen(rec) - 1): - app(result, createRecordVarAux(p, rec.sons[i], c)) + add(result, createRecordVarAux(p, rec.sons[i], c)) of nkRecCase: - app(result, createRecordVarAux(p, rec.sons[0], c)) + add(result, createRecordVarAux(p, rec.sons[0], c)) for i in countup(1, sonsLen(rec) - 1): - app(result, createRecordVarAux(p, lastSon(rec.sons[i]), c)) + add(result, createRecordVarAux(p, lastSon(rec.sons[i]), c)) of nkSym: - if c > 0: app(result, ", ") - app(result, mangleName(rec.sym)) - app(result, ": ") - app(result, createVar(p, rec.sym.typ, false)) + if c > 0: add(result, ", ") + add(result, mangleName(rec.sym)) + add(result, ": ") + add(result, createVar(p, rec.sym.typ, false)) inc(c) else: internalError(rec.info, "createRecordVarAux") -proc createVar(p: PProc, typ: PType, indirect: bool): PRope = +proc createVar(p: PProc, typ: PType, indirect: bool): Rope = var t = skipTypes(typ, abstractInst) case t.kind - of tyInt..tyInt64, tyEnum, tyChar: + of tyInt..tyInt64, tyUInt..tyUInt64, tyEnum, tyChar: result = putToSeq("0", indirect) of tyFloat..tyFloat128: result = putToSeq("0.0", indirect) of tyRange, tyGenericInst: result = createVar(p, lastSon(typ), indirect) of tySet: - result = toRope("{}") + result = putToSeq("{}", indirect) of tyBool: result = putToSeq("false", indirect) of tyArray, tyArrayConstr: @@ -1131,33 +1140,36 @@ proc createVar(p: PProc, typ: PType, indirect: bool): PRope = useMagic(p, "arrayConstr") # XXX: arrayConstr depends on nimCopy. This line shouldn't be necessary. useMagic(p, "nimCopy") - result = ropef("arrayConstr($1, $2, $3)", [toRope(length), - createVar(p, e, false), genTypeInfo(p, e)]) + result = "arrayConstr($1, $2, $3)" % [rope(length), + createVar(p, e, false), genTypeInfo(p, e)] else: - result = toRope("[") + result = rope("[") var i = 0 while i < length: - if i > 0: app(result, ", ") - app(result, createVar(p, e, false)) + if i > 0: add(result, ", ") + add(result, createVar(p, e, false)) inc(i) - app(result, "]") + add(result, "]") + if indirect: result = "[$1]" % [result] of tyTuple: - result = toRope("{") + result = rope("{") for i in 0.. <t.sonsLen: - if i > 0: app(result, ", ") - appf(result, "Field$1: $2" | "Field$# = $#", i.toRope, - createVar(p, t.sons[i], false)) - app(result, "}") + if i > 0: add(result, ", ") + addf(result, "Field$1: $2" | "Field$# = $#", [i.rope, + createVar(p, t.sons[i], false)]) + add(result, "}") + if indirect: result = "[$1]" % [result] of tyObject: - result = toRope("{") + result = rope("{") var c = 0 if tfFinal notin t.flags or t.sons[0] != nil: inc(c) - appf(result, "m_type: $1" | "m_type = $#", [genTypeInfo(p, t)]) + addf(result, "m_type: $1" | "m_type = $#", [genTypeInfo(p, t)]) while t != nil: - app(result, createRecordVarAux(p, t.n, c)) + add(result, createRecordVarAux(p, t.n, c)) t = t.sons[0] - app(result, "}") + add(result, "}") + if indirect: result = "[$1]" % [result] of tyVar, tyPtr, tyRef: if mapType(t) == etyBaseIndex: result = putToSeq("[null, 0]" | "{nil, 0}", indirect) @@ -1169,17 +1181,12 @@ proc createVar(p: PProc, typ: PType, indirect: bool): PRope = internalError("createVar: " & $t.kind) result = nil -proc isIndirect(v: PSym): bool = - result = {sfAddrTaken, sfGlobal} * v.flags != {} and - (mapType(v.typ) != etyObject) and - v.kind notin {skProc, skConverter, skMethod, skIterator, skClosureIterator} - proc genVarInit(p: PProc, v: PSym, n: PNode) = var a: TCompRes - s: PRope + s: Rope if n.kind == nkEmpty: - appf(p.body, "var $1 = $2;$n" | "local $1 = $2;$n", + addf(p.body, "var $1 = $2;$n" | "local $1 = $2;$n", [mangleName(v), createVar(p, v.typ, isIndirect(v))]) else: discard mangleName(v) @@ -1190,23 +1197,23 @@ proc genVarInit(p: PProc, v: PSym, n: PNode) = s = a.res else: useMagic(p, "nimCopy") - s = ropef("nimCopy($1, $2)", [a.res, genTypeInfo(p, n.typ)]) + s = "nimCopy($1, $2)" % [a.res, genTypeInfo(p, n.typ)] of etyBaseIndex: if (a.typ != etyBaseIndex): internalError(n.info, "genVarInit") if {sfAddrTaken, sfGlobal} * v.flags != {}: - appf(p.body, "var $1 = [$2, $3];$n" | "local $1 = {$2, $3};$n", + addf(p.body, "var $1 = [$2, $3];$n" | "local $1 = {$2, $3};$n", [v.loc.r, a.address, a.res]) else: - appf(p.body, "var $1 = $2; var $1_Idx = $3;$n" | + addf(p.body, "var $1 = $2; var $1_Idx = $3;$n" | "local $1 = $2; local $1_Idx = $3;$n", [ v.loc.r, a.address, a.res]) return else: s = a.res if isIndirect(v): - appf(p.body, "var $1 = [$2];$n" | "local $1 = {$2};$n", [v.loc.r, s]) + addf(p.body, "var $1 = /**/[$2];$n" | "local $1 = {$2};$n", [v.loc.r, s]) else: - appf(p.body, "var $1 = $2;$n" | "local $1 = $2;$n", [v.loc.r, s]) + addf(p.body, "var $1 = $2;$n" | "local $1 = $2;$n", [v.loc.r, s]) proc genVarStmt(p: PProc, n: PNode) = for i in countup(0, sonsLen(n) - 1): @@ -1229,21 +1236,21 @@ proc genConstant(p: PProc, c: PSym) = p.body = nil #genLineDir(p, c.ast) genVarInit(p, c, c.ast) - app(p.g.code, p.body) + add(p.g.code, p.body) p.body = oldBody proc genNew(p: PProc, n: PNode) = var a: TCompRes gen(p, n.sons[1], a) var t = skipTypes(n.sons[1].typ, abstractVar).sons[0] - appf(p.body, "$1 = $2;$n", [a.res, createVar(p, t, true)]) + addf(p.body, "$1 = $2;$n", [a.res, createVar(p, t, false)]) proc genNewSeq(p: PProc, n: PNode) = var x, y: TCompRes gen(p, n.sons[1], x) gen(p, n.sons[2], y) let t = skipTypes(n.sons[1].typ, abstractVar).sons[0] - appf(p.body, "$1 = new Array($2); for (var i=0;i<$2;++i) {$1[i]=$3;}", [ + addf(p.body, "$1 = new Array($2); for (var i=0;i<$2;++i) {$1[i]=$3;}", [ x.rdLoc, y.rdLoc, createVar(p, t, false)]) proc genOrd(p: PProc, n: PNode, r: var TCompRes) = @@ -1258,22 +1265,22 @@ proc genConStrStr(p: PProc, n: PNode, r: var TCompRes) = gen(p, n.sons[1], a) r.kind = resExpr if skipTypes(n.sons[1].typ, abstractVarRange).kind == tyChar: - r.res.app(ropef("[$1].concat(", [a.res])) + r.res.add("[$1].concat(" % [a.res]) else: - r.res.app(ropef("($1.slice(0,-1)).concat(", [a.res])) + r.res.add("($1.slice(0,-1)).concat(" % [a.res]) for i in countup(2, sonsLen(n) - 2): gen(p, n.sons[i], a) if skipTypes(n.sons[i].typ, abstractVarRange).kind == tyChar: - r.res.app(ropef("[$1],", [a.res])) + r.res.add("[$1]," % [a.res]) else: - r.res.app(ropef("$1.slice(0,-1),", [a.res])) + r.res.add("$1.slice(0,-1)," % [a.res]) gen(p, n.sons[sonsLen(n) - 1], a) if skipTypes(n.sons[sonsLen(n) - 1].typ, abstractVarRange).kind == tyChar: - r.res.app(ropef("[$1, 0])", [a.res])) + r.res.add("[$1, 0])" % [a.res]) else: - r.res.app(ropef("$1)", [a.res])) + r.res.add("$1)" % [a.res]) proc genRepr(p: PProc, n: PNode, r: var TCompRes) = var t = skipTypes(n.sons[1].typ, abstractVarRange) @@ -1284,8 +1291,7 @@ proc genRepr(p: PProc, n: PNode, r: var TCompRes) = gen(p, n.sons[1], r) useMagic(p, "cstrToNimstr") r.kind = resExpr - r.res = ropef("cstrToNimstr($1.node.sons[$2].name)", - [genTypeInfo(p, t), r.res]) + r.res = "cstrToNimstr($1.node.sons[$2].name)" % [genTypeInfo(p, t), r.res] else: # XXX: internalError(n.info, "genRepr: Not implemented") @@ -1295,23 +1301,23 @@ proc genOf(p: PProc, n: PNode, r: var TCompRes) = let t = skipTypes(n.sons[2].typ, abstractVarRange+{tyRef, tyPtr, tyTypeDesc}) gen(p, n.sons[1], x) if tfFinal in t.flags: - r.res = ropef("($1.m_type == $2)", [x.res, genTypeInfo(p, t)]) + r.res = "($1.m_type == $2)" % [x.res, genTypeInfo(p, t)] else: useMagic(p, "isObj") - r.res = ropef("isObj($1.m_type, $2)", [x.res, genTypeInfo(p, t)]) + r.res = "isObj($1.m_type, $2)" % [x.res, genTypeInfo(p, t)] r.kind = resExpr proc genReset(p: PProc, n: PNode) = var x: TCompRes useMagic(p, "genericReset") gen(p, n.sons[1], x) - appf(p.body, "$1 = genericReset($1, $2);$n", [x.res, + addf(p.body, "$1 = genericReset($1, $2);$n", [x.res, genTypeInfo(p, n.sons[1].typ)]) proc genMagic(p: PProc, n: PNode, r: var TCompRes) = var a: TCompRes - line, filen: PRope + line, filen: Rope var op = n.sons[0].sym.magic case op of mOr: genOr(p, n.sons[1], n.sons[2], r) @@ -1323,22 +1329,17 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = # XXX: range checking? if not (optOverflowCheck in p.options): unaryExpr(p, n, r, "", "$1 - 1") else: unaryExpr(p, n, r, "subInt", "subInt($1, 1)") - of mPred: - # XXX: range checking? - if not (optOverflowCheck in p.options): binaryExpr(p, n, r, "", "$1 - $2") - else: binaryExpr(p, n, r, "subInt", "subInt($1, $2)") - of mSucc: - # XXX: range checking? - if not (optOverflowCheck in p.options): binaryExpr(p, n, r, "", "$1 - $2") - else: binaryExpr(p, n, r, "addInt", "addInt($1, $2)") - of mAppendStrCh: binaryExpr(p, n, r, "addChar", "addChar($1, $2)") + of mAppendStrCh: binaryExpr(p, n, r, "addChar", + "if ($1 != null) { addChar($1, $2); } else { $1 = [$2, 0]; }") of mAppendStrStr: if skipTypes(n.sons[1].typ, abstractVarRange).kind == tyCString: - binaryExpr(p, n, r, "", "$1 += $2") + binaryExpr(p, n, r, "", "if ($1 != null) { $1 += $2; } else { $1 = $2; }") else: - binaryExpr(p, n, r, "", "$1 = ($1.slice(0, -1)).concat($2)") + binaryExpr(p, n, r, "", + "if ($1 != null) { $1 = ($1.slice(0, -1)).concat($2); } else { $1 = $2;}") # XXX: make a copy of $2, because of Javascript's sucking semantics - of mAppendSeqElem: binaryExpr(p, n, r, "", "$1.push($2)") + of mAppendSeqElem: binaryExpr(p, n, r, "", + "if ($1 != null) { $1.push($2); } else { $1 = [$2]; }") of mConStrStr: genConStrStr(p, n, r) of mEqStr: binaryExpr(p, n, r, "eqStrings", "eqStrings($1, $2)") of mLeStr: binaryExpr(p, n, r, "cmpStrings", "(cmpStrings($1, $2) <= 0)") @@ -1346,17 +1347,20 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = of mIsNil: unaryExpr(p, n, r, "", "$1 == null") of mEnumToStr: genRepr(p, n, r) of mNew, mNewFinalize: genNew(p, n) - of mSizeOf: r.res = toRope(getSize(n.sons[1].typ)) + of mSizeOf: r.res = rope(getSize(n.sons[1].typ)) of mChr, mArrToSeq: gen(p, n.sons[1], r) # nothing to do of mOrd: genOrd(p, n, r) - of mLengthStr: unaryExpr(p, n, r, "", "($1.length-1)") + of mLengthStr: unaryExpr(p, n, r, "", "($1 != null ? $1.length-1 : 0)") + of mXLenStr: unaryExpr(p, n, r, "", "$1.length-1") of mLengthSeq, mLengthOpenArray, mLengthArray: + unaryExpr(p, n, r, "", "($1 != null ? $1.length : 0)") + of mXLenSeq: unaryExpr(p, n, r, "", "$1.length") of mHigh: if skipTypes(n.sons[1].typ, abstractVar).kind == tyString: - unaryExpr(p, n, r, "", "($1.length-2)") + unaryExpr(p, n, r, "", "($1 != null ? ($1.length-2) : -1)") else: - unaryExpr(p, n, r, "", "($1.length-1)") + unaryExpr(p, n, r, "", "($1 != null ? ($1.length-1) : -1)") of mInc: if optOverflowCheck notin p.options: binaryExpr(p, n, r, "", "$1 += $2") else: binaryExpr(p, n, r, "addInt", "$1 = addInt($1, $2)") @@ -1375,13 +1379,11 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = of mIncl: binaryExpr(p, n, r, "", "$1[$2] = true") of mExcl: binaryExpr(p, n, r, "", "delete $1[$2]") of mInSet: binaryExpr(p, n, r, "", "($1[$2] != undefined)") - of mNLen..mNError: - localError(n.info, errCannotGenerateCodeForX, n.sons[0].sym.name.s) of mNewSeq: genNewSeq(p, n) of mOf: genOf(p, n, r) of mReset: genReset(p, n) of mEcho: genEcho(p, n, r) - of mSlurp, mStaticExec: + of mNLen..mNError, mSlurp, mStaticExec: localError(n.info, errXMustBeCompileTime, n.sons[0].sym.name.s) of mCopyStr: binaryExpr(p, n, r, "", "($1.slice($2))") of mCopyStrLast: ternaryExpr(p, n, r, "", "($1.slice($2, ($3)+1).concat(0))") @@ -1395,56 +1397,56 @@ proc genSetConstr(p: PProc, n: PNode, r: var TCompRes) = var a, b: TCompRes useMagic(p, "SetConstr") - r.res = toRope("SetConstr(") + r.res = rope("SetConstr(") r.kind = resExpr for i in countup(0, sonsLen(n) - 1): - if i > 0: app(r.res, ", ") + if i > 0: add(r.res, ", ") var it = n.sons[i] if it.kind == nkRange: gen(p, it.sons[0], a) gen(p, it.sons[1], b) - appf(r.res, "[$1, $2]", [a.res, b.res]) + addf(r.res, "[$1, $2]", [a.res, b.res]) else: gen(p, it, a) - app(r.res, a.res) - app(r.res, ")") + add(r.res, a.res) + add(r.res, ")") proc genArrayConstr(p: PProc, n: PNode, r: var TCompRes) = var a: TCompRes - r.res = toRope("[") + r.res = rope("[") r.kind = resExpr for i in countup(0, sonsLen(n) - 1): - if i > 0: app(r.res, ", ") + if i > 0: add(r.res, ", ") gen(p, n.sons[i], a) - app(r.res, a.res) - app(r.res, "]") + add(r.res, a.res) + add(r.res, "]") proc genTupleConstr(p: PProc, n: PNode, r: var TCompRes) = var a: TCompRes - r.res = toRope("{") + r.res = rope("{") r.kind = resExpr for i in countup(0, sonsLen(n) - 1): - if i > 0: app(r.res, ", ") + if i > 0: add(r.res, ", ") var it = n.sons[i] if it.kind == nkExprColonExpr: it = it.sons[1] gen(p, it, a) - appf(r.res, "Field$#: $#" | "Field$# = $#", [i.toRope, a.res]) - r.res.app("}") + addf(r.res, "Field$#: $#" | "Field$# = $#", [i.rope, a.res]) + r.res.add("}") proc genObjConstr(p: PProc, n: PNode, r: var TCompRes) = # XXX inheritance? var a: TCompRes - r.res = toRope("{") + r.res = rope("{") r.kind = resExpr for i in countup(1, sonsLen(n) - 1): - if i > 1: app(r.res, ", ") + if i > 1: add(r.res, ", ") var it = n.sons[i] internalAssert it.kind == nkExprColonExpr gen(p, it.sons[1], a) var f = it.sons[0].sym if f.loc.r == nil: f.loc.r = mangleName(f) - appf(r.res, "$#: $#" | "$# = $#" , [f.loc.r, a.res]) - r.res.app("}") + addf(r.res, "$#: $#" | "$# = $#" , [f.loc.r, a.res]) + r.res.add("}") proc genConv(p: PProc, n: PNode, r: var TCompRes) = var dest = skipTypes(n.typ, abstractVarRange) @@ -1455,10 +1457,10 @@ proc genConv(p: PProc, n: PNode, r: var TCompRes) = return case dest.kind: of tyBool: - r.res = ropef("(($1)? 1:0)" | "toBool($#)", [r.res]) + r.res = ("(($1)? 1:0)" | "toBool($#)") % [r.res] r.kind = resExpr of tyInt: - r.res = ropef("($1|0)", [r.res]) + r.res = "($1|0)" % [r.res] else: # TODO: What types must we handle here? discard @@ -1473,7 +1475,7 @@ proc genRangeChck(p: PProc, n: PNode, r: var TCompRes, magic: string) = gen(p, n.sons[1], a) gen(p, n.sons[2], b) useMagic(p, "chckRange") - r.res = ropef("chckRange($1, $2, $3)", [r.res, a.res, b.res]) + r.res = "chckRange($1, $2, $3)" % [r.res, a.res, b.res] r.kind = resExpr proc convStrToCStr(p: PProc, n: PNode, r: var TCompRes) = @@ -1485,7 +1487,7 @@ proc convStrToCStr(p: PProc, n: PNode, r: var TCompRes) = gen(p, n.sons[0], r) if r.res == nil: internalError(n.info, "convStrToCStr") useMagic(p, "toJSStr") - r.res = ropef("toJSStr($1)", [r.res]) + r.res = "toJSStr($1)" % [r.res] r.kind = resExpr proc convCStrToStr(p: PProc, n: PNode, r: var TCompRes) = @@ -1497,7 +1499,7 @@ proc convCStrToStr(p: PProc, n: PNode, r: var TCompRes) = gen(p, n.sons[0], r) if r.res == nil: internalError(n.info, "convCStrToStr") useMagic(p, "cstrToNimstr") - r.res = ropef("cstrToNimstr($1)", [r.res]) + r.res = "cstrToNimstr($1)" % [r.res] r.kind = resExpr proc genReturnStmt(p: PProc, n: PNode) = @@ -1507,32 +1509,32 @@ proc genReturnStmt(p: PProc, n: PNode) = genStmt(p, n.sons[0]) else: genLineDir(p, n) - appf(p.body, "break BeforeRet;$n" | "goto ::BeforeRet::;$n") + addf(p.body, "break BeforeRet;$n" | "goto ::BeforeRet::;$n", []) -proc genProcBody(p: PProc, prc: PSym): PRope = +proc genProcBody(p: PProc, prc: PSym): Rope = if optStackTrace in prc.options: - result = ropef(("var F={procname:$1,prev:framePtr,filename:$2,line:0};$n" | - "local F={procname=$#,prev=framePtr,filename=$#,line=0};$n") & - "framePtr = F;$n", [ - makeJSString(prc.owner.name.s & '.' & prc.name.s), - makeJSString(toFilename(prc.info))]) + result = (("var F={procname:$1,prev:framePtr,filename:$2,line:0};$n" | + "local F={procname=$#,prev=framePtr,filename=$#,line=0};$n") & + "framePtr = F;$n") % [ + makeJSString(prc.owner.name.s & '.' & prc.name.s), + makeJSString(toFilename(prc.info))] else: result = nil if p.beforeRetNeeded: - appf(result, "BeforeRet: do {$n$1} while (false); $n" | + addf(result, "BeforeRet: do {$n$1} while (false); $n" | "$#;::BeforeRet::$n", [p.body]) else: - app(result, p.body) + add(result, p.body) if prc.typ.callConv == ccSysCall and p.target == targetJS: - result = ropef("try {$n$1} catch (e) {$n" & - " alert(\"Unhandled exception:\\n\" + e.message + \"\\n\"$n}", [result]) + result = ("try {$n$1} catch (e) {$n" & + " alert(\"Unhandled exception:\\n\" + e.message + \"\\n\"$n}") % [result] if optStackTrace in prc.options: - app(result, "framePtr = framePtr.prev;" & tnl) + add(result, "framePtr = framePtr.prev;" & tnl) -proc genProc(oldProc: PProc, prc: PSym): PRope = +proc genProc(oldProc: PProc, prc: PSym): Rope = var resultSym: PSym - name, returnStmt, resultAsgn, header: PRope + name, returnStmt, resultAsgn, header: Rope a: TCompRes #if gVerbosity >= 3: # echo "BEGIN generating code for: " & prc.name.s @@ -1545,23 +1547,23 @@ proc genProc(oldProc: PProc, prc: PSym): PRope = header = generateHeader(p, prc.typ) if prc.typ.sons[0] != nil and sfPure notin prc.flags: resultSym = prc.ast.sons[resultPos].sym - resultAsgn = ropef("var $# = $#;$n" | "local $# = $#;$n", [ + resultAsgn = ("var $# = $#;$n" | "local $# = $#;$n") % [ mangleName(resultSym), - createVar(p, resultSym.typ, isIndirect(resultSym))]) + createVar(p, resultSym.typ, isIndirect(resultSym))] gen(p, prc.ast.sons[resultPos], a) - returnStmt = ropef("return $#;$n", [a.res]) + returnStmt = "return $#;$n" % [a.res] genStmt(p, prc.getBody) - result = ropef("function $#($#) {$n$#$#$#$#}$n" | - "function $#($#) $n$#$#$#$#$nend$n", - [name, header, p.locals, resultAsgn, - genProcBody(p, prc), returnStmt]) + result = ("function $#($#) {$n$#$#$#$#}$n" | + "function $#($#) $n$#$#$#$#$nend$n") % + [name, header, p.locals, resultAsgn, + genProcBody(p, prc), returnStmt] #if gVerbosity >= 3: # echo "END generated code for: " & prc.name.s proc genStmt(p: PProc, n: PNode) = var r: TCompRes gen(p, n, r) - if r.res != nil: appf(p.body, "$#;$n", r.res) + if r.res != nil: addf(p.body, "$#;$n", [r.res]) proc gen(p: PProc, n: PNode, r: var TCompRes) = r.typ = etyNone @@ -1572,34 +1574,34 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = of nkSym: genSym(p, n, r) of nkCharLit..nkInt64Lit: - r.res = toRope(n.intVal) + r.res = rope(n.intVal) r.kind = resExpr of nkNilLit: if isEmptyType(n.typ): discard elif mapType(n.typ) == etyBaseIndex: r.typ = etyBaseIndex - r.address = toRope"null" | toRope"nil" - r.res = toRope"0" + r.address = rope"null" | rope"nil" + r.res = rope"0" r.kind = resExpr else: - r.res = toRope"null" | toRope"nil" + r.res = rope"null" | rope"nil" r.kind = resExpr of nkStrLit..nkTripleStrLit: if skipTypes(n.typ, abstractVarRange).kind == tyString: useMagic(p, "cstrToNimstr") - r.res = ropef("cstrToNimstr($1)", [makeJSString(n.strVal)]) + r.res = "cstrToNimstr($1)" % [makeJSString(n.strVal)] else: r.res = makeJSString(n.strVal) r.kind = resExpr of nkFloatLit..nkFloat64Lit: let f = n.floatVal - if f != f: r.res = toRope"NaN" - elif f == 0.0: r.res = toRope"0.0" + if f != f: r.res = rope"NaN" + elif f == 0.0: r.res = rope"0.0" elif f == 0.5 * f: - if f > 0.0: r.res = toRope"Infinity" - else: r.res = toRope"-Infinity" - else: r.res = toRope(f.toStrMaxPrecision) + if f > 0.0: r.res = rope"Infinity" + else: r.res = rope"-Infinity" + else: r.res = rope(f.toStrMaxPrecision) r.kind = resExpr of nkCallKinds: if (n.sons[0].kind == nkSym) and (n.sons[0].sym.magic != mNone): @@ -1634,7 +1636,7 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = r.res = s.loc.r if lfNoDecl in s.loc.flags or s.magic != mNone: discard elif not p.g.generatedSyms.containsOrIncl(s.id): - app(p.locals, genProc(p, s)) + add(p.locals, genProc(p, s)) of nkType: r.res = genTypeInfo(p, n.typ) of nkStmtList, nkStmtListExpr: # this shows the distinction is nice for backends and should be kept @@ -1685,23 +1687,23 @@ proc newModule(module: PSym): BModule = result.module = module if globals == nil: globals = newGlobals() -proc genHeader(): PRope = - result = ropef("/* Generated by the Nim Compiler v$1 */$n" & - "/* (c) 2015 Andreas Rumpf */$n$n" & - "var framePtr = null;$n" & - "var excHandler = null;$n" & - "var lastJSError = null;$n", - [toRope(VersionAsString)]) +proc genHeader(): Rope = + result = ("/* Generated by the Nim Compiler v$1 */$n" & + "/* (c) 2015 Andreas Rumpf */$n$n" & + "var framePtr = null;$n" & + "var excHandler = null;$n" & + "var lastJSError = null;$n") % + [rope(VersionAsString)] proc genModule(p: PProc, n: PNode) = if optStackTrace in p.options: - appf(p.body, "var F = {procname:$1,prev:framePtr,filename:$2,line:0};$n" & + addf(p.body, "var F = {procname:$1,prev:framePtr,filename:$2,line:0};$n" & "framePtr = F;$n", [ makeJSString("module " & p.module.module.name.s), makeJSString(toFilename(p.module.module.info))]) genStmt(p, n) if optStackTrace in p.options: - appf(p.body, "framePtr = framePtr.prev;$n") + addf(p.body, "framePtr = framePtr.prev;$n", []) proc myProcess(b: PPassContext, n: PNode): PNode = if passes.skipCodegen(n): return n @@ -1710,23 +1712,23 @@ proc myProcess(b: PPassContext, n: PNode): PNode = if m.module == nil: internalError(n.info, "myProcess") var p = newProc(globals, m, nil, m.module.options) genModule(p, n) - app(p.g.code, p.locals) - app(p.g.code, p.body) + add(p.g.code, p.locals) + add(p.g.code, p.body) -proc wholeCode*(m: BModule): PRope = +proc wholeCode*(m: BModule): Rope = for prc in globals.forwarded: if not globals.generatedSyms.containsOrIncl(prc.id): var p = newProc(globals, m, nil, m.module.options) - app(p.g.code, genProc(p, prc)) + add(p.g.code, genProc(p, prc)) var disp = generateMethodDispatchers() for i in 0..sonsLen(disp)-1: let prc = disp.sons[i].sym if not globals.generatedSyms.containsOrIncl(prc.id): var p = newProc(globals, m, nil, m.module.options) - app(p.g.code, genProc(p, prc)) + add(p.g.code, genProc(p, prc)) - result = con(globals.typeInfo, globals.code) + result = globals.typeInfo & globals.code proc myClose(b: PPassContext, n: PNode): PNode = if passes.skipCodegen(n): return n @@ -1740,7 +1742,7 @@ proc myClose(b: PPassContext, n: PNode): PNode = else: getCurrentDir() / options.outFile else: changeFileExt(completeCFilePath(m.module.filename), "js") - discard writeRopeIfNotEqual(con(genHeader(), code), outfile) + discard writeRopeIfNotEqual(genHeader() & code, outfile) proc myOpenCached(s: PSym, rd: PRodReader): PPassContext = internalError("symbol files are not possible with the JS code generator") diff --git a/compiler/jstypes.nim b/compiler/jstypes.nim index 1288c854d..851938327 100644 --- a/compiler/jstypes.nim +++ b/compiler/jstypes.nim @@ -9,138 +9,138 @@ ## Type info generation for the JS backend. -proc genTypeInfo(p: PProc, typ: PType): PRope -proc genObjectFields(p: PProc, typ: PType, n: PNode): PRope = - var - s, u: PRope +proc genTypeInfo(p: PProc, typ: PType): Rope +proc genObjectFields(p: PProc, typ: PType, n: PNode): Rope = + var + s, u: Rope length: int field: PSym b: PNode result = nil case n.kind - of nkRecList: + of nkRecList: length = sonsLen(n) - if length == 1: + if length == 1: result = genObjectFields(p, typ, n.sons[0]) - else: + else: s = nil - for i in countup(0, length - 1): - if i > 0: app(s, ", " & tnl) - app(s, genObjectFields(p, typ, n.sons[i])) - result = ropef("{kind: 2, len: $1, offset: 0, " & - "typ: null, name: null, sons: [$2]}", [toRope(length), s]) - of nkSym: + for i in countup(0, length - 1): + if i > 0: add(s, ", " & tnl) + add(s, genObjectFields(p, typ, n.sons[i])) + result = ("{kind: 2, len: $1, offset: 0, " & + "typ: null, name: null, sons: [$2]}") % [rope(length), s] + of nkSym: field = n.sym s = genTypeInfo(p, field.typ) - result = ropef("{kind: 1, offset: \"$1\", len: 0, " & - "typ: $2, name: $3, sons: null}", - [mangleName(field), s, makeJSString(field.name.s)]) - of nkRecCase: + result = ("{kind: 1, offset: \"$1\", len: 0, " & + "typ: $2, name: $3, sons: null}") % + [mangleName(field), s, makeJSString(field.name.s)] + of nkRecCase: length = sonsLen(n) if (n.sons[0].kind != nkSym): internalError(n.info, "genObjectFields") field = n.sons[0].sym s = genTypeInfo(p, field.typ) - for i in countup(1, length - 1): + for i in countup(1, length - 1): b = n.sons[i] # branch u = nil case b.kind - of nkOfBranch: - if sonsLen(b) < 2: + of nkOfBranch: + if sonsLen(b) < 2: internalError(b.info, "genObjectFields; nkOfBranch broken") - for j in countup(0, sonsLen(b) - 2): - if u != nil: app(u, ", ") - if b.sons[j].kind == nkRange: - appf(u, "[$1, $2]", [toRope(getOrdValue(b.sons[j].sons[0])), - toRope(getOrdValue(b.sons[j].sons[1]))]) - else: - app(u, toRope(getOrdValue(b.sons[j]))) - of nkElse: - u = toRope(lengthOrd(field.typ)) + for j in countup(0, sonsLen(b) - 2): + if u != nil: add(u, ", ") + if b.sons[j].kind == nkRange: + addf(u, "[$1, $2]", [rope(getOrdValue(b.sons[j].sons[0])), + rope(getOrdValue(b.sons[j].sons[1]))]) + else: + add(u, rope(getOrdValue(b.sons[j]))) + of nkElse: + u = rope(lengthOrd(field.typ)) else: internalError(n.info, "genObjectFields(nkRecCase)") - if result != nil: app(result, ", " & tnl) - appf(result, "[SetConstr($1), $2]", + if result != nil: add(result, ", " & tnl) + addf(result, "[SetConstr($1), $2]", [u, genObjectFields(p, typ, lastSon(b))]) - result = ropef("{kind: 3, offset: \"$1\", len: $3, " & - "typ: $2, name: $4, sons: [$5]}", [mangleName(field), s, - toRope(lengthOrd(field.typ)), makeJSString(field.name.s), result]) + result = ("{kind: 3, offset: \"$1\", len: $3, " & + "typ: $2, name: $4, sons: [$5]}") % [mangleName(field), s, + rope(lengthOrd(field.typ)), makeJSString(field.name.s), result] else: internalError(n.info, "genObjectFields") - -proc genObjectInfo(p: PProc, typ: PType, name: PRope) = - var s = ropef("var $1 = {size: 0, kind: $2, base: null, node: null, " & - "finalizer: null};$n", [name, toRope(ord(typ.kind))]) + +proc genObjectInfo(p: PProc, typ: PType, name: Rope) = + var s = ("var $1 = {size: 0, kind: $2, base: null, node: null, " & + "finalizer: null};$n") % [name, rope(ord(typ.kind))] prepend(p.g.typeInfo, s) - appf(p.g.typeInfo, "var NNI$1 = $2;$n", - [toRope(typ.id), genObjectFields(p, typ, typ.n)]) - appf(p.g.typeInfo, "$1.node = NNI$2;$n", [name, toRope(typ.id)]) - if (typ.kind == tyObject) and (typ.sons[0] != nil): - appf(p.g.typeInfo, "$1.base = $2;$n", + addf(p.g.typeInfo, "var NNI$1 = $2;$n", + [rope(typ.id), genObjectFields(p, typ, typ.n)]) + addf(p.g.typeInfo, "$1.node = NNI$2;$n", [name, rope(typ.id)]) + if (typ.kind == tyObject) and (typ.sons[0] != nil): + addf(p.g.typeInfo, "$1.base = $2;$n", [name, genTypeInfo(p, typ.sons[0])]) -proc genTupleFields(p: PProc, typ: PType): PRope = - var s: PRope = nil +proc genTupleFields(p: PProc, typ: PType): Rope = + var s: Rope = nil for i in 0 .. <typ.len: - if i > 0: app(s, ", " & tnl) - s.appf("{kind: 1, offset: \"Field$1\", len: 0, " & + if i > 0: add(s, ", " & tnl) + s.addf("{kind: 1, offset: \"Field$1\", len: 0, " & "typ: $2, name: \"Field$1\", sons: null}", - [i.toRope, genTypeInfo(p, typ.sons[i])]) - result = ropef("{kind: 2, len: $1, offset: 0, " & - "typ: null, name: null, sons: [$2]}", [toRope(typ.len), s]) + [i.rope, genTypeInfo(p, typ.sons[i])]) + result = ("{kind: 2, len: $1, offset: 0, " & + "typ: null, name: null, sons: [$2]}") % [rope(typ.len), s] -proc genTupleInfo(p: PProc, typ: PType, name: PRope) = - var s = ropef("var $1 = {size: 0, kind: $2, base: null, node: null, " & - "finalizer: null};$n", [name, toRope(ord(typ.kind))]) +proc genTupleInfo(p: PProc, typ: PType, name: Rope) = + var s = ("var $1 = {size: 0, kind: $2, base: null, node: null, " & + "finalizer: null};$n") % [name, rope(ord(typ.kind))] prepend(p.g.typeInfo, s) - appf(p.g.typeInfo, "var NNI$1 = $2;$n", - [toRope(typ.id), genTupleFields(p, typ)]) - appf(p.g.typeInfo, "$1.node = NNI$2;$n", [name, toRope(typ.id)]) + addf(p.g.typeInfo, "var NNI$1 = $2;$n", + [rope(typ.id), genTupleFields(p, typ)]) + addf(p.g.typeInfo, "$1.node = NNI$2;$n", [name, rope(typ.id)]) -proc genEnumInfo(p: PProc, typ: PType, name: PRope) = +proc genEnumInfo(p: PProc, typ: PType, name: Rope) = let length = sonsLen(typ.n) - var s: PRope = nil - for i in countup(0, length - 1): + var s: Rope = nil + for i in countup(0, length - 1): if (typ.n.sons[i].kind != nkSym): internalError(typ.n.info, "genEnumInfo") let field = typ.n.sons[i].sym - if i > 0: app(s, ", " & tnl) + if i > 0: add(s, ", " & tnl) let extName = if field.ast == nil: field.name.s else: field.ast.strVal - appf(s, "{kind: 1, offset: $1, typ: $2, name: $3, len: 0, sons: null}", - [toRope(field.position), name, makeJSString(extName)]) - var n = ropef("var NNI$1 = {kind: 2, offset: 0, typ: null, " & - "name: null, len: $2, sons: [$3]};$n", [toRope(typ.id), toRope(length), s]) - s = ropef("var $1 = {size: 0, kind: $2, base: null, node: null, " & - "finalizer: null};$n", [name, toRope(ord(typ.kind))]) + addf(s, "{kind: 1, offset: $1, typ: $2, name: $3, len: 0, sons: null}", + [rope(field.position), name, makeJSString(extName)]) + var n = ("var NNI$1 = {kind: 2, offset: 0, typ: null, " & + "name: null, len: $2, sons: [$3]};$n") % [rope(typ.id), rope(length), s] + s = ("var $1 = {size: 0, kind: $2, base: null, node: null, " & + "finalizer: null};$n") % [name, rope(ord(typ.kind))] prepend(p.g.typeInfo, s) - app(p.g.typeInfo, n) - appf(p.g.typeInfo, "$1.node = NNI$2;$n", [name, toRope(typ.id)]) + add(p.g.typeInfo, n) + addf(p.g.typeInfo, "$1.node = NNI$2;$n", [name, rope(typ.id)]) if typ.sons[0] != nil: - appf(p.g.typeInfo, "$1.base = $2;$n", + addf(p.g.typeInfo, "$1.base = $2;$n", [name, genTypeInfo(p, typ.sons[0])]) -proc genTypeInfo(p: PProc, typ: PType): PRope = +proc genTypeInfo(p: PProc, typ: PType): Rope = var t = typ if t.kind == tyGenericInst: t = lastSon(t) - result = ropef("NTI$1", [toRope(t.id)]) - if containsOrIncl(p.g.typeInfoGenerated, t.id): return + result = "NTI$1" % [rope(t.id)] + if containsOrIncl(p.g.typeInfoGenerated, t.id): return case t.kind - of tyDistinct: + of tyDistinct: result = genTypeInfo(p, typ.sons[0]) of tyPointer, tyProc, tyBool, tyChar, tyCString, tyString, tyInt..tyUInt64: - var s = ropef( - "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n", - [result, toRope(ord(t.kind))]) + var s = + "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n" % + [result, rope(ord(t.kind))] prepend(p.g.typeInfo, s) - of tyVar, tyRef, tyPtr, tySequence, tyRange, tySet: - var s = ropef( - "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n", - [result, toRope(ord(t.kind))]) + of tyVar, tyRef, tyPtr, tySequence, tyRange, tySet: + var s = + "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n" % + [result, rope(ord(t.kind))] prepend(p.g.typeInfo, s) - appf(p.g.typeInfo, "$1.base = $2;$n", + addf(p.g.typeInfo, "$1.base = $2;$n", [result, genTypeInfo(p, typ.lastSon)]) - of tyArrayConstr, tyArray: - var s = ropef( - "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n", - [result, toRope(ord(t.kind))]) + of tyArrayConstr, tyArray: + var s = + "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n" % + [result, rope(ord(t.kind))] prepend(p.g.typeInfo, s) - appf(p.g.typeInfo, "$1.base = $2;$n", + addf(p.g.typeInfo, "$1.base = $2;$n", [result, genTypeInfo(p, typ.sons[1])]) of tyEnum: genEnumInfo(p, t, result) of tyObject: genObjectInfo(p, t, result) diff --git a/compiler/lambdalifting.nim b/compiler/lambdalifting.nim index 123445e1f..c68bc352c 100644 --- a/compiler/lambdalifting.nim +++ b/compiler/lambdalifting.nim @@ -9,92 +9,92 @@ # This include file implements lambda lifting for the transformator. -import - intsets, strutils, lists, options, ast, astalgo, trees, treetab, msgs, os, +import + intsets, strutils, lists, options, ast, astalgo, trees, treetab, msgs, os, idents, renderer, types, magicsys, rodread, lowerings discard """ The basic approach is that captured vars need to be put on the heap and that the calling chain needs to be explicitly modelled. Things to consider: - + proc a = var v = 0 proc b = var w = 2 - + for x in 0..3: proc c = capture v, w, x c() b() - + for x in 0..4: proc d = capture x d() - + Needs to be translated into: - + proc a = var cl: * new cl cl.v = 0 - + proc b(cl) = var bcl: * new bcl bcl.w = 2 bcl.up = cl - + for x in 0..3: var bcl2: * new bcl2 bcl2.up = bcl bcl2.up2 = cl bcl2.x = x - + proc c(cl) = capture cl.up2.v, cl.up.w, cl.x c(bcl2) - + c(bcl) - + b(cl) - + for x in 0..4: var acl2: * new acl2 acl2.x = x proc d(cl) = capture cl.x d(acl2) - + Closures as interfaces: - + proc outer: T = var captureMe: TObject # value type required for efficiency proc getter(): int = result = captureMe.x proc setter(x: int) = captureMe.x = x - + result = (getter, setter) - + Is translated to: - + proc outer: T = var cl: * new cl - + proc getter(cl): int = result = cl.captureMe.x proc setter(cl: *, x: int) = cl.captureMe.x = x - + result = ((cl, getter), (cl, setter)) - - + + For 'byref' capture, the outer proc needs to access the captured var through the indirection too. For 'bycopy' capture, the outer proc accesses the var not through the indirection. - - Possible optimizations: - + + Possible optimizations: + 1) If the closure contains a single 'ref' and this reference is not re-assigned (check ``sfAddrTaken`` flag) make this the - closure. This is an important optimization if closures are used as + closure. This is an important optimization if closures are used as interfaces. 2) If the closure does not escape, put it onto the stack, not on the heap. 3) Dataflow analysis would help to eliminate the 'up' indirections. @@ -126,7 +126,7 @@ type fn, closureParam, state, resultSym: PSym # most are only valid if # fn.kind == skClosureIterator obj: PType - + PEnv = ref TEnv TEnv {.final.} = object of RootObj attachedNode, replacementNode: PNode @@ -141,7 +141,7 @@ type # if up.fn != fn then we cross function boundaries. # This is an important case to consider. vars: IntSet # variables belonging to this environment - + TOuterContext = object fn: PSym # may also be a module! head: PEnv @@ -284,7 +284,7 @@ proc addClosureParam(fn: PSym; e: PEnv) = #assert e.obj.kind == tyObject proc illegalCapture(s: PSym): bool {.inline.} = - result = skipTypes(s.typ, abstractInst).kind in + result = skipTypes(s.typ, abstractInst).kind in {tyVar, tyOpenArray, tyVarargs} or s.kind == skResult @@ -344,7 +344,7 @@ proc createUpField(obj, fieldType: PType): PSym = #rawAddField(obj, result) addField(obj, result) -proc captureVar(o: POuterContext; top: PEnv; local: PSym; +proc captureVar(o: POuterContext; top: PEnv; local: PSym; info: TLineInfo): bool = # first check if we should be concerned at all: var it = top @@ -408,7 +408,7 @@ proc gatherVars(o: POuterContext; e: PEnv; n: PNode): int = var s = n.sym if interestingVar(s) and e.fn != s.owner: if captureVar(o, e, s, n.info): result = 1 - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit, nkClosure, nkProcDef, + of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit, nkClosure, nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, nkTemplateDef, nkTypeSection: discard else: @@ -418,7 +418,7 @@ proc gatherVars(o: POuterContext; e: PEnv; n: PNode): int = proc generateThunk(prc: PNode, dest: PType): PNode = ## Converts 'prc' into '(thunk, nil)' so that it's compatible with ## a closure. - + # we cannot generate a proper thunk here for GC-safety reasons (see internal # documentation): if gCmd == cmdCompileToJS: return prc @@ -515,7 +515,7 @@ proc closureCreationPoint(n: PNode): PNode = proc addParamsToEnv(fn: PSym; env: PEnv) = let params = fn.typ.n - for i in 1.. <params.len: + for i in 1.. <params.len: if params.sons[i].kind != nkSym: internalError(params.info, "liftLambdas: strange params") let param = params.sons[i].sym @@ -541,7 +541,7 @@ proc searchForInnerProcs(o: POuterContext, n: PNode, env: PEnv) = addParamsToEnv(fn, envB) searchForInnerProcs(o, body, envB) fn.ast.sons[bodyPos] = ex - + let capturedCounter = gatherVars(o, envB, body) # dummy closure param needed? if capturedCounter == 0 and fn.typ.callConv == ccClosure: @@ -560,7 +560,7 @@ proc searchForInnerProcs(o: POuterContext, n: PNode, env: PEnv) = of nkWhileStmt, nkForStmt, nkParForStmt, nkBlockStmt: # some nodes open a new scope, so they are candidates for the insertion # of closure creation; however for simplicity we merge closures between - # branches, in fact, only loop bodies are of interest here as only they + # branches, in fact, only loop bodies are of interest here as only they # yield observable changes in semantics. For Zahary we also # include ``nkBlock``. We don't do this for closure iterators because # 'yield' can produce wrong code otherwise (XXX show example): @@ -598,7 +598,7 @@ proc searchForInnerProcs(o: POuterContext, n: PNode, env: PEnv) = internalError(it.info, "searchForInnerProcs") of nkClosure: searchForInnerProcs(o, n.sons[0], env) - of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, nkTemplateDef, + of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, nkTemplateDef, nkTypeSection: # don't recurse here: discard @@ -606,7 +606,7 @@ proc searchForInnerProcs(o: POuterContext, n: PNode, env: PEnv) = for i in countup(0, sonsLen(n) - 1): searchForInnerProcs(o, n.sons[i], env) -proc newAsgnStmt(le, ri: PNode, info: TLineInfo): PNode = +proc newAsgnStmt(le, ri: PNode, info: TLineInfo): PNode = # Bugfix: unfortunately we cannot use 'nkFastAsgn' here as that would # mean to be able to capture string literals which have no GC header. # However this can only happen if the capture happens through a parameter, @@ -624,7 +624,7 @@ proc rawClosureCreation(o: POuterContext, scope: PEnv; env: PNode): PNode = result.add(v) # add 'new' statement: result.add(newCall(getSysSym"internalNew", env)) - + # add assignment statements: for local in scope.capturedVars: let fieldAccess = indirectAccess(env, local, env.info) @@ -696,10 +696,10 @@ proc transformYield(c: POuterContext, n: PNode, it: TIter): PNode = retStmt.add(a) else: retStmt.add(emptyNode) - + var stateLabelStmt = newNodeI(nkState, n.info) stateLabelStmt.add(newIntTypeNode(nkIntLit, stateNo, getSysType(tyInt))) - + result = newNodeI(nkStmtList, n.info) result.add(stateAsgnStmt) result.add(retStmt) @@ -725,7 +725,7 @@ proc liftIterSym(n: PNode; owner: PSym): PNode = assert iter.kind == skClosureIterator result = newNodeIT(nkStmtListExpr, n.info, n.typ) - + let hp = getHiddenParam(iter) let env = newSym(skLet, iter.name, owner, n.info) env.typ = hp.typ @@ -800,7 +800,7 @@ proc transformOuterProcBody(o: POuterContext, n: PNode; it: TIter): PNode = # with some rather primitive check for now: if n.kind == nkStmtList and n.len > 0: if n.sons[0].kind == nkGotoState: return nil - if n.len > 1 and n[1].kind == nkStmtList and n[1].len > 0 and + if n.len > 1 and n[1].kind == nkStmtList and n[1].len > 0 and n[1][0].kind == nkGotoState: return nil result = newNodeI(nkStmtList, it.fn.info) @@ -812,7 +812,7 @@ proc transformOuterProcBody(o: POuterContext, n: PNode; it: TIter): PNode = var state0 = newNodeI(nkState, it.fn.info) state0.add(newIntNode(nkIntLit, 0)) result.add(state0) - + let newBody = transformOuterProc(o, n, it) if newBody != nil: result.add(newBody) @@ -899,7 +899,7 @@ proc transformOuterProc(o: POuterContext, n: PNode; it: TIter): PNode = let x = closure.createdVar assert x != nil return makeClosure(local, x, n.info) - + if not contains(o.capturedVars, local.id): return # change 'local' to 'closure.local', unless it's a 'byCopy' variable: # if sfByCopy notin local.flags: @@ -946,7 +946,7 @@ proc transformOuterProc(o: POuterContext, n: PNode; it: TIter): PNode = proc liftLambdas*(fn: PSym, body: PNode): PNode = # XXX gCmd == cmdCompileToJS does not suffice! The compiletime stuff needs # the transformation even when compiling to JS ... - if body.kind == nkEmpty or gCmd == cmdCompileToJS or + if body.kind == nkEmpty or gCmd == cmdCompileToJS or fn.skipGenericOwner.kind != skModule: # ignore forward declaration: result = body @@ -985,17 +985,17 @@ proc liftLambdasForTopLevel*(module: PSym, body: PNode): PNode = proc liftForLoop*(body: PNode): PNode = # problem ahead: the iterator could be invoked indirectly, but then - # we don't know what environment to create here: - # + # we don't know what environment to create here: + # # iterator count(): int = # yield 0 - # + # # iterator count2(): int = # var x = 3 # yield x # inc x # yield x - # + # # proc invoke(iter: iterator(): int) = # for x in iter(): echo x # @@ -1004,7 +1004,7 @@ proc liftForLoop*(body: PNode): PNode = for i in foo(): ... Is transformed to: - + cl = createClosure() while true: let i = foo(cl) @@ -1016,7 +1016,7 @@ proc liftForLoop*(body: PNode): PNode = var call = body[L-2] result = newNodeI(nkStmtList, body.info) - + # static binding? var env: PSym if call[0].kind == nkSym and call[0].sym.kind == skClosureIterator: @@ -1030,18 +1030,18 @@ proc liftForLoop*(body: PNode): PNode = result.add(v) # add 'new' statement: result.add(newCall(getSysSym"internalNew", env.newSymNode)) - + var loopBody = newNodeI(nkStmtList, body.info, 3) var whileLoop = newNodeI(nkWhileStmt, body.info, 2) whileLoop.sons[0] = newIntTypeNode(nkIntLit, 1, getSysType(tyBool)) whileLoop.sons[1] = loopBody result.add whileLoop - + # setup loopBody: # gather vars in a tuple: var v2 = newNodeI(nkLetSection, body.info) var vpart = newNodeI(if L == 3: nkIdentDefs else: nkVarTuple, body.info) - for i in 0 .. L-3: + for i in 0 .. L-3: assert body[i].kind == nkSym body[i].sym.kind = skLet addSon(vpart, body[i]) diff --git a/compiler/lexer.nim b/compiler/lexer.nim index c86762121..694d6f4d7 100644 --- a/compiler/lexer.nim +++ b/compiler/lexer.nim @@ -10,51 +10,51 @@ # This scanner is handwritten for efficiency. I used an elegant buffering # scheme which I have not seen anywhere else: # We guarantee that a whole line is in the buffer. Thus only when scanning -# the \n or \r character we have to check wether we need to read in the next +# the \n or \r character we have to check wether we need to read in the next # chunk. (\n or \r already need special handling for incrementing the line # counter; choosing both \n and \r allows the scanner to properly read Unix, # DOS or Macintosh text files, even when it is not the native format. -import +import hashes, options, msgs, strutils, platform, idents, nimlexbase, llstream, wordrecg -const +const MaxLineLength* = 80 # lines longer than this lead to a warning numChars*: set[char] = {'0'..'9', 'a'..'z', 'A'..'Z'} SymChars*: set[char] = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF'} SymStartChars*: set[char] = {'a'..'z', 'A'..'Z', '\x80'..'\xFF'} - OpChars*: set[char] = {'+', '-', '*', '/', '\\', '<', '>', '!', '?', '^', '.', + OpChars*: set[char] = {'+', '-', '*', '/', '\\', '<', '>', '!', '?', '^', '.', '|', '=', '%', '&', '$', '@', '~', ':', '\x80'..'\xFF'} # don't forget to update the 'highlite' module if these charsets should change -type - TTokType* = enum +type + TTokType* = enum tkInvalid, tkEof, # order is important here! tkSymbol, # keywords: - tkAddr, tkAnd, tkAs, tkAsm, tkAtomic, - tkBind, tkBlock, tkBreak, tkCase, tkCast, - tkConst, tkContinue, tkConverter, + tkAddr, tkAnd, tkAs, tkAsm, tkAtomic, + tkBind, tkBlock, tkBreak, tkCase, tkCast, + tkConcept, tkConst, tkContinue, tkConverter, tkDefer, tkDiscard, tkDistinct, tkDiv, tkDo, tkElif, tkElse, tkEnd, tkEnum, tkExcept, tkExport, tkFinally, tkFor, tkFrom, tkFunc, - tkGeneric, tkIf, tkImport, tkIn, tkInclude, tkInterface, + tkGeneric, tkIf, tkImport, tkIn, tkInclude, tkInterface, tkIs, tkIsnot, tkIterator, tkLet, - tkMacro, tkMethod, tkMixin, tkMod, tkNil, tkNot, tkNotin, - tkObject, tkOf, tkOr, tkOut, + tkMacro, tkMethod, tkMixin, tkMod, tkNil, tkNot, tkNotin, + tkObject, tkOf, tkOr, tkOut, tkProc, tkPtr, tkRaise, tkRef, tkReturn, tkShl, tkShr, tkStatic, - tkTemplate, - tkTry, tkTuple, tkType, tkUsing, + tkTemplate, + tkTry, tkTuple, tkType, tkUsing, tkVar, tkWhen, tkWhile, tkWith, tkWithout, tkXor, tkYield, # end of keywords tkIntLit, tkInt8Lit, tkInt16Lit, tkInt32Lit, tkInt64Lit, tkUIntLit, tkUInt8Lit, tkUInt16Lit, tkUInt32Lit, tkUInt64Lit, tkFloatLit, tkFloat32Lit, tkFloat64Lit, tkFloat128Lit, tkStrLit, tkRStrLit, tkTripleStrLit, - tkGStrLit, tkGTripleStrLit, tkCharLit, tkParLe, tkParRi, tkBracketLe, - tkBracketRi, tkCurlyLe, tkCurlyRi, + tkGStrLit, tkGTripleStrLit, tkCharLit, tkParLe, tkParRi, tkBracketLe, + tkBracketRi, tkCurlyLe, tkCurlyRi, tkBracketDotLe, tkBracketDotRi, # [. and .] tkCurlyDotLe, tkCurlyDotRi, # {. and .} tkParDotLe, tkParDotRi, # (. and .) @@ -62,27 +62,27 @@ type tkColon, tkColonColon, tkEquals, tkDot, tkDotDot, tkOpr, tkComment, tkAccent, tkSpaces, tkInfixOpr, tkPrefixOpr, tkPostfixOpr, - + TTokTypes* = set[TTokType] -const +const tokKeywordLow* = succ(tkSymbol) tokKeywordHigh* = pred(tkIntLit) - TokTypeToStr*: array[TTokType, string] = ["tkInvalid", "[EOF]", + TokTypeToStr*: array[TTokType, string] = ["tkInvalid", "[EOF]", "tkSymbol", - "addr", "and", "as", "asm", "atomic", - "bind", "block", "break", "case", "cast", - "const", "continue", "converter", + "addr", "and", "as", "asm", "atomic", + "bind", "block", "break", "case", "cast", + "concept", "const", "continue", "converter", "defer", "discard", "distinct", "div", "do", "elif", "else", "end", "enum", "except", "export", - "finally", "for", "from", "func", "generic", "if", + "finally", "for", "from", "func", "generic", "if", "import", "in", "include", "interface", "is", "isnot", "iterator", "let", - "macro", "method", "mixin", "mod", - "nil", "not", "notin", "object", "of", "or", - "out", "proc", "ptr", "raise", "ref", "return", + "macro", "method", "mixin", "mod", + "nil", "not", "notin", "object", "of", "or", + "out", "proc", "ptr", "raise", "ref", "return", "shl", "shr", "static", - "template", + "template", "try", "tuple", "type", "using", "var", "when", "while", "with", "without", "xor", "yield", @@ -90,7 +90,7 @@ const "tkUIntLit", "tkUInt8Lit", "tkUInt16Lit", "tkUInt32Lit", "tkUInt64Lit", "tkFloatLit", "tkFloat32Lit", "tkFloat64Lit", "tkFloat128Lit", "tkStrLit", "tkRStrLit", - "tkTripleStrLit", "tkGStrLit", "tkGTripleStrLit", "tkCharLit", "(", + "tkTripleStrLit", "tkGStrLit", "tkGTripleStrLit", "tkCharLit", "(", ")", "[", "]", "{", "}", "[.", ".]", "{.", ".}", "(.", ".)", ",", ";", ":", "::", "=", ".", "..", @@ -98,8 +98,8 @@ const "tkSpaces", "tkInfixOpr", "tkPrefixOpr", "tkPostfixOpr"] -type - TNumericalBase* = enum +type + TNumericalBase* = enum base10, # base10 is listed as the first element, # so that it is the correct default value base2, base8, base16 @@ -131,62 +131,48 @@ type var gLinesCompiled*: int # all lines that have been compiled -proc isKeyword*(kind: TTokType): bool -proc openLexer*(lex: var TLexer, fileidx: int32, inputstream: PLLStream) -proc rawGetTok*(L: var TLexer, tok: var TToken) - # reads in the next token into tok and skips it - proc getLineInfo*(L: TLexer, tok: TToken): TLineInfo {.inline.} = newLineInfo(L.fileIdx, tok.line, tok.col) -proc closeLexer*(lex: var TLexer) -proc printTok*(tok: TToken) -proc tokToStr*(tok: TToken): string - -proc openLexer*(lex: var TLexer, filename: string, inputstream: PLLStream) = - openLexer(lex, filename.fileInfoIdx, inputstream) - -proc lexMessage*(L: TLexer, msg: TMsgKind, arg = "") - -proc isKeyword(kind: TTokType): bool = +proc isKeyword*(kind: TTokType): bool = result = (kind >= tokKeywordLow) and (kind <= tokKeywordHigh) proc isNimIdentifier*(s: string): bool = if s[0] in SymStartChars: var i = 1 while i < s.len: - if s[i] == '_': + if s[i] == '_': inc(i) if s[i] notin SymChars: return if s[i] notin SymChars: return inc(i) result = true -proc tokToStr*(tok: TToken): string = +proc tokToStr*(tok: TToken): string = case tok.tokType of tkIntLit..tkInt64Lit: result = $tok.iNumber of tkFloatLit..tkFloat64Lit: result = $tok.fNumber of tkInvalid, tkStrLit..tkCharLit, tkComment: result = tok.literal - of tkParLe..tkColon, tkEof, tkAccent: + of tkParLe..tkColon, tkEof, tkAccent: result = TokTypeToStr[tok.tokType] else: if tok.ident != nil: result = tok.ident.s - else: + else: internalError("tokToStr") result = "" - + proc prettyTok*(tok: TToken): string = if isKeyword(tok.tokType): result = "keyword " & tok.ident.s else: result = tokToStr(tok) - -proc printTok*(tok: TToken) = + +proc printTok*(tok: TToken) = msgWriteln($tok.line & ":" & $tok.col & "\t" & TokTypeToStr[tok.tokType] & " " & tokToStr(tok)) var dummyIdent: PIdent -proc initToken*(L: var TToken) = +proc initToken*(L: var TToken) = L.tokType = tkInvalid L.iNumber = 0 L.indent = 0 @@ -196,7 +182,7 @@ proc initToken*(L: var TToken) = L.base = base10 L.ident = dummyIdent -proc fillToken(L: var TToken) = +proc fillToken(L: var TToken) = L.tokType = tkInvalid L.iNumber = 0 L.indent = 0 @@ -205,22 +191,25 @@ proc fillToken(L: var TToken) = L.fNumber = 0.0 L.base = base10 L.ident = dummyIdent - -proc openLexer(lex: var TLexer, fileIdx: int32, inputstream: PLLStream) = + +proc openLexer*(lex: var TLexer, fileIdx: int32, inputstream: PLLStream) = openBaseLexer(lex, inputstream) lex.fileIdx = fileidx lex.indentAhead = - 1 lex.currLineIndent = 0 - inc(lex.lineNumber, inputstream.lineOffset) + inc(lex.lineNumber, inputstream.lineOffset) -proc closeLexer(lex: var TLexer) = +proc openLexer*(lex: var TLexer, filename: string, inputstream: PLLStream) = + openLexer(lex, filename.fileInfoIdx, inputstream) + +proc closeLexer*(lex: var TLexer) = inc(gLinesCompiled, lex.lineNumber) closeBaseLexer(lex) -proc getColumn(L: TLexer): int = +proc getColumn(L: TLexer): int = result = getColNumber(L, L.bufpos) -proc getLineInfo(L: TLexer): TLineInfo = +proc getLineInfo(L: TLexer): TLineInfo = result = newLineInfo(L.fileIdx, L.lineNumber, getColNumber(L, L.bufpos)) proc dispMessage(L: TLexer; info: TLineInfo; msg: TMsgKind; arg: string) = @@ -229,31 +218,31 @@ proc dispMessage(L: TLexer; info: TLineInfo; msg: TMsgKind; arg: string) = else: L.errorHandler(info, msg, arg) -proc lexMessage(L: TLexer, msg: TMsgKind, arg = "") = +proc lexMessage*(L: TLexer, msg: TMsgKind, arg = "") = L.dispMessage(getLineInfo(L), msg, arg) proc lexMessagePos(L: var TLexer, msg: TMsgKind, pos: int, arg = "") = var info = newLineInfo(L.fileIdx, L.lineNumber, pos - L.lineStart) L.dispMessage(info, msg, arg) -proc matchUnderscoreChars(L: var TLexer, tok: var TToken, chars: set[char]) = +proc matchUnderscoreChars(L: var TLexer, tok: var TToken, chars: set[char]) = var pos = L.bufpos # use registers for pos, buf var buf = L.buf - while true: - if buf[pos] in chars: + while true: + if buf[pos] in chars: add(tok.literal, buf[pos]) inc(pos) - else: - break - if buf[pos] == '_': - if buf[pos+1] notin chars: + else: + break + if buf[pos] == '_': + if buf[pos+1] notin chars: lexMessage(L, errInvalidToken, "_") break add(tok.literal, '_') inc(pos) L.bufpos = pos -proc matchTwoChars(L: TLexer, first: char, second: set[char]): bool = +proc matchTwoChars(L: TLexer, first: char, second: set[char]): bool = result = (L.buf[L.bufpos] == first) and (L.buf[L.bufpos + 1] in second) proc isFloatLiteral(s: string): bool = @@ -275,8 +264,8 @@ proc unsafeParseUInt(s: string, b: var BiggestInt, start = 0): int = result = i - start {.pop.} # overflowChecks -proc getNumber(L: var TLexer): TToken = - var +proc getNumber(L: var TLexer): TToken = + var pos, endpos: int xi: BiggestInt # get the base: @@ -290,15 +279,15 @@ proc getNumber(L: var TLexer): TToken = else: matchUnderscoreChars(L, result, {'0'..'9', 'b', 'B', 'o', 'c', 'C'}) eallowed = true - if (L.buf[L.bufpos] == '.') and (L.buf[L.bufpos + 1] in {'0'..'9'}): + if (L.buf[L.bufpos] == '.') and (L.buf[L.bufpos + 1] in {'0'..'9'}): add(result.literal, '.') inc(L.bufpos) matchUnderscoreChars(L, result, {'0'..'9'}) eallowed = true - if eallowed and L.buf[L.bufpos] in {'e', 'E'}: + if eallowed and L.buf[L.bufpos] in {'e', 'E'}: add(result.literal, 'e') inc(L.bufpos) - if L.buf[L.bufpos] in {'+', '-'}: + if L.buf[L.bufpos] in {'+', '-'}: add(result.literal, L.buf[L.bufpos]) inc(L.bufpos) matchUnderscoreChars(L, result, {'0'..'9'}) @@ -307,7 +296,7 @@ proc getNumber(L: var TLexer): TToken = if L.buf[endpos] == '\'': inc(endpos) L.bufpos = pos # restore position case L.buf[endpos] - of 'f', 'F': + of 'f', 'F': inc(endpos) if (L.buf[endpos] == '3') and (L.buf[endpos + 1] == '2'): result.tokType = tkFloat32Lit @@ -320,36 +309,36 @@ proc getNumber(L: var TLexer): TToken = (L.buf[endpos + 2] == '8'): result.tokType = tkFloat128Lit inc(endpos, 3) - else: + else: lexMessage(L, errInvalidNumber, result.literal & "'f" & L.buf[endpos]) - of 'i', 'I': + of 'i', 'I': inc(endpos) - if (L.buf[endpos] == '6') and (L.buf[endpos + 1] == '4'): + if (L.buf[endpos] == '6') and (L.buf[endpos + 1] == '4'): result.tokType = tkInt64Lit inc(endpos, 2) - elif (L.buf[endpos] == '3') and (L.buf[endpos + 1] == '2'): + elif (L.buf[endpos] == '3') and (L.buf[endpos + 1] == '2'): result.tokType = tkInt32Lit inc(endpos, 2) - elif (L.buf[endpos] == '1') and (L.buf[endpos + 1] == '6'): + elif (L.buf[endpos] == '1') and (L.buf[endpos + 1] == '6'): result.tokType = tkInt16Lit inc(endpos, 2) - elif (L.buf[endpos] == '8'): + elif (L.buf[endpos] == '8'): result.tokType = tkInt8Lit inc(endpos) - else: + else: lexMessage(L, errInvalidNumber, result.literal & "'i" & L.buf[endpos]) of 'u', 'U': inc(endpos) - if (L.buf[endpos] == '6') and (L.buf[endpos + 1] == '4'): + if (L.buf[endpos] == '6') and (L.buf[endpos + 1] == '4'): result.tokType = tkUInt64Lit inc(endpos, 2) - elif (L.buf[endpos] == '3') and (L.buf[endpos + 1] == '2'): + elif (L.buf[endpos] == '3') and (L.buf[endpos + 1] == '2'): result.tokType = tkUInt32Lit inc(endpos, 2) - elif (L.buf[endpos] == '1') and (L.buf[endpos + 1] == '6'): + elif (L.buf[endpos] == '1') and (L.buf[endpos + 1] == '6'): result.tokType = tkUInt16Lit inc(endpos, 2) - elif (L.buf[endpos] == '8'): + elif (L.buf[endpos] == '8'): result.tokType = tkUInt8Lit inc(endpos) else: @@ -357,45 +346,45 @@ proc getNumber(L: var TLexer): TToken = else: lexMessage(L, errInvalidNumber, result.literal & "'" & L.buf[endpos]) else: L.bufpos = pos # restore position - try: + try: if (L.buf[pos] == '0') and - (L.buf[pos + 1] in {'x', 'X', 'b', 'B', 'o', 'O', 'c', 'C'}): + (L.buf[pos + 1] in {'x', 'X', 'b', 'B', 'o', 'O', 'c', 'C'}): inc(pos, 2) xi = 0 # it may be a base prefix case L.buf[pos - 1] # now look at the optional type suffix: - of 'b', 'B': + of 'b', 'B': result.base = base2 - while true: + while true: case L.buf[pos] - of '2'..'9', '.': + of '2'..'9', '.': lexMessage(L, errInvalidNumber, result.literal) inc(pos) - of '_': - if L.buf[pos+1] notin {'0'..'1'}: + of '_': + if L.buf[pos+1] notin {'0'..'1'}: lexMessage(L, errInvalidToken, "_") break inc(pos) - of '0', '1': + of '0', '1': xi = `shl`(xi, 1) or (ord(L.buf[pos]) - ord('0')) inc(pos) - else: break - of 'o', 'c', 'C': + else: break + of 'o', 'c', 'C': result.base = base8 - while true: + while true: case L.buf[pos] - of '8'..'9', '.': + of '8'..'9', '.': lexMessage(L, errInvalidNumber, result.literal) inc(pos) - of '_': + of '_': if L.buf[pos+1] notin {'0'..'7'}: lexMessage(L, errInvalidToken, "_") break inc(pos) - of '0'..'7': + of '0'..'7': xi = `shl`(xi, 3) or (ord(L.buf[pos]) - ord('0')) inc(pos) - else: break - of 'O': + else: break + of 'O': lexMessage(L, errInvalidNumber, result.literal) of 'x', 'X': result.base = base16 @@ -415,7 +404,7 @@ proc getNumber(L: var TLexer): TToken = of 'A'..'F': xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10) inc(pos) - else: break + else: break else: internalError(getLineInfo(L), "getNumber") case result.tokType of tkIntLit, tkInt64Lit: result.iNumber = xi @@ -426,14 +415,14 @@ proc getNumber(L: var TLexer): TToken = of tkUInt8Lit: result.iNumber = BiggestInt(int8(toU8(int(xi)))) of tkUInt16Lit: result.iNumber = BiggestInt(toU16(int(xi))) of tkUInt32Lit: result.iNumber = BiggestInt(toU32(xi)) - of tkFloat32Lit: - result.fNumber = (cast[PFloat32](addr(xi)))[] + of tkFloat32Lit: + result.fNumber = (cast[PFloat32](addr(xi)))[] # note: this code is endian neutral! # XXX: Test this on big endian machine! - of tkFloat64Lit: result.fNumber = (cast[PFloat64](addr(xi)))[] + of tkFloat64Lit: result.fNumber = (cast[PFloat64](addr(xi)))[] else: internalError(getLineInfo(L), "getNumber") elif isFloatLiteral(result.literal) or (result.tokType == tkFloat32Lit) or - (result.tokType == tkFloat64Lit): + (result.tokType == tkFloat64Lit): result.fNumber = parseFloat(result.literal) if result.tokType == tkIntLit: result.tokType = tkFloatLit elif result.tokType == tkUint64Lit: @@ -461,69 +450,69 @@ proc getNumber(L: var TLexer): TToken = lexMessage(L, errNumberOutOfRange, result.literal) L.bufpos = endpos -proc handleHexChar(L: var TLexer, xi: var int) = +proc handleHexChar(L: var TLexer, xi: var int) = case L.buf[L.bufpos] - of '0'..'9': + of '0'..'9': xi = (xi shl 4) or (ord(L.buf[L.bufpos]) - ord('0')) inc(L.bufpos) - of 'a'..'f': + of 'a'..'f': xi = (xi shl 4) or (ord(L.buf[L.bufpos]) - ord('a') + 10) inc(L.bufpos) - of 'A'..'F': + of 'A'..'F': xi = (xi shl 4) or (ord(L.buf[L.bufpos]) - ord('A') + 10) inc(L.bufpos) else: discard -proc handleDecChars(L: var TLexer, xi: var int) = - while L.buf[L.bufpos] in {'0'..'9'}: +proc handleDecChars(L: var TLexer, xi: var int) = + while L.buf[L.bufpos] in {'0'..'9'}: xi = (xi * 10) + (ord(L.buf[L.bufpos]) - ord('0')) inc(L.bufpos) -proc getEscapedChar(L: var TLexer, tok: var TToken) = +proc getEscapedChar(L: var TLexer, tok: var TToken) = inc(L.bufpos) # skip '\' case L.buf[L.bufpos] - of 'n', 'N': + of 'n', 'N': if tok.tokType == tkCharLit: lexMessage(L, errNnotAllowedInCharacter) add(tok.literal, tnl) inc(L.bufpos) - of 'r', 'R', 'c', 'C': + of 'r', 'R', 'c', 'C': add(tok.literal, CR) inc(L.bufpos) - of 'l', 'L': + of 'l', 'L': add(tok.literal, LF) inc(L.bufpos) - of 'f', 'F': + of 'f', 'F': add(tok.literal, FF) inc(L.bufpos) - of 'e', 'E': + of 'e', 'E': add(tok.literal, ESC) inc(L.bufpos) - of 'a', 'A': + of 'a', 'A': add(tok.literal, BEL) inc(L.bufpos) - of 'b', 'B': + of 'b', 'B': add(tok.literal, BACKSPACE) inc(L.bufpos) - of 'v', 'V': + of 'v', 'V': add(tok.literal, VT) inc(L.bufpos) - of 't', 'T': + of 't', 'T': add(tok.literal, '\t') inc(L.bufpos) - of '\'', '\"': + of '\'', '\"': add(tok.literal, L.buf[L.bufpos]) inc(L.bufpos) - of '\\': + of '\\': add(tok.literal, '\\') inc(L.bufpos) - of 'x', 'X': + of 'x', 'X': inc(L.bufpos) var xi = 0 handleHexChar(L, xi) handleHexChar(L, xi) add(tok.literal, chr(xi)) - of '0'..'9': - if matchTwoChars(L, '0', {'0'..'9'}): + of '0'..'9': + if matchTwoChars(L, '0', {'0'..'9'}): lexMessage(L, warnOctalEscape) var xi = 0 handleDecChars(L, xi) @@ -540,7 +529,7 @@ proc newString(s: cstring, len: int): string = proc handleCRLF(L: var TLexer, pos: int): int = template registerLine = let col = L.getColNumber(pos) - + if col > MaxLineLength: lexMessagePos(L, hintLineTooLong, pos) @@ -548,7 +537,7 @@ proc handleCRLF(L: var TLexer, pos: int): int = let lineStart = cast[ByteAddress](L.buf) + L.lineStart let line = newString(cast[cstring](lineStart), col) addSourceLine(L.fileIdx, line) - + case L.buf[pos] of CR: registerLine() @@ -557,12 +546,12 @@ proc handleCRLF(L: var TLexer, pos: int): int = registerLine() result = nimlexbase.handleLF(L, pos) else: result = pos - -proc getString(L: var TLexer, tok: var TToken, rawMode: bool) = + +proc getString(L: var TLexer, tok: var TToken, rawMode: bool) = var pos = L.bufpos + 1 # skip " var buf = L.buf # put `buf` in a register var line = L.lineNumber # save linenumber for better error message - if buf[pos] == '\"' and buf[pos+1] == '\"': + if buf[pos] == '\"' and buf[pos+1] == '\"': tok.tokType = tkTripleStrLit # long string literal: inc(pos, 2) # skip "" # skip leading newline: @@ -572,105 +561,105 @@ proc getString(L: var TLexer, tok: var TToken, rawMode: bool) = if buf[newpos] in {CR, LF}: pos = newpos pos = handleCRLF(L, pos) buf = L.buf - while true: + while true: case buf[pos] - of '\"': + of '\"': if buf[pos+1] == '\"' and buf[pos+2] == '\"' and - buf[pos+3] != '\"': + buf[pos+3] != '\"': L.bufpos = pos + 3 # skip the three """ - break + break add(tok.literal, '\"') inc(pos) - of CR, LF: + of CR, LF: pos = handleCRLF(L, pos) buf = L.buf add(tok.literal, tnl) - of nimlexbase.EndOfFile: + of nimlexbase.EndOfFile: var line2 = L.lineNumber L.lineNumber = line lexMessagePos(L, errClosingTripleQuoteExpected, L.lineStart) L.lineNumber = line2 - break - else: + break + else: add(tok.literal, buf[pos]) inc(pos) - else: + else: # ordinary string literal if rawMode: tok.tokType = tkRStrLit else: tok.tokType = tkStrLit - while true: + while true: var c = buf[pos] - if c == '\"': + if c == '\"': if rawMode and buf[pos+1] == '\"': inc(pos, 2) add(tok.literal, '"') else: inc(pos) # skip '"' break - elif c in {CR, LF, nimlexbase.EndOfFile}: + elif c in {CR, LF, nimlexbase.EndOfFile}: lexMessage(L, errClosingQuoteExpected) - break - elif (c == '\\') and not rawMode: + break + elif (c == '\\') and not rawMode: L.bufpos = pos getEscapedChar(L, tok) pos = L.bufpos - else: + else: add(tok.literal, c) inc(pos) L.bufpos = pos -proc getCharacter(L: var TLexer, tok: var TToken) = +proc getCharacter(L: var TLexer, tok: var TToken) = inc(L.bufpos) # skip ' var c = L.buf[L.bufpos] case c of '\0'..pred(' '), '\'': lexMessage(L, errInvalidCharacterConstant) of '\\': getEscapedChar(L, tok) - else: + else: tok.literal = $c inc(L.bufpos) if L.buf[L.bufpos] != '\'': lexMessage(L, errMissingFinalQuote) inc(L.bufpos) # skip ' - -proc getSymbol(L: var TLexer, tok: var TToken) = + +proc getSymbol(L: var TLexer, tok: var TToken) = var h: THash = 0 var pos = L.bufpos var buf = L.buf - while true: + while true: var c = buf[pos] case c - of 'a'..'z', '0'..'9', '\x80'..'\xFF': + of 'a'..'z', '0'..'9', '\x80'..'\xFF': h = h !& ord(c) - of 'A'..'Z': + of 'A'..'Z': c = chr(ord(c) + (ord('a') - ord('A'))) # toLower() h = h !& ord(c) of '_': - if buf[pos+1] notin SymChars: + if buf[pos+1] notin SymChars: lexMessage(L, errInvalidToken, "_") break - else: break + else: break inc(pos) h = !$h tok.ident = getIdent(addr(L.buf[L.bufpos]), pos - L.bufpos, h) L.bufpos = pos if (tok.ident.id < ord(tokKeywordLow) - ord(tkSymbol)) or - (tok.ident.id > ord(tokKeywordHigh) - ord(tkSymbol)): + (tok.ident.id > ord(tokKeywordHigh) - ord(tkSymbol)): tok.tokType = tkSymbol - else: + else: tok.tokType = TTokType(tok.ident.id + ord(tkSymbol)) - + proc endOperator(L: var TLexer, tok: var TToken, pos: int, - hash: THash) {.inline.} = + hash: THash) {.inline.} = var h = !$hash tok.ident = getIdent(addr(L.buf[L.bufpos]), pos - L.bufpos, h) if (tok.ident.id < oprLow) or (tok.ident.id > oprHigh): tok.tokType = tkOpr else: tok.tokType = TTokType(tok.ident.id - oprLow + ord(tkColon)) L.bufpos = pos - -proc getOperator(L: var TLexer, tok: var TToken) = + +proc getOperator(L: var TLexer, tok: var TToken) = var pos = L.bufpos var buf = L.buf var h: THash = 0 - while true: + while true: var c = buf[pos] if c notin OpChars: break h = h !& ord(c) @@ -699,7 +688,7 @@ proc scanComment(L: var TLexer, tok: var TToken) = return else: lexMessagePos(L, warnDeprecated, pos, "use '## [' instead; '##['") - + tok.tokType = tkComment # iNumber contains the number of '\n' in the token tok.iNumber = 0 @@ -723,7 +712,7 @@ proc scanComment(L: var TLexer, tok: var TToken) = pos = handleCRLF(L, pos) buf = L.buf var indent = 0 - while buf[pos] == ' ': + while buf[pos] == ' ': inc(pos) inc(indent) @@ -738,7 +727,7 @@ proc scanComment(L: var TLexer, tok: var TToken) = when defined(nimfix): col = indent inc tok.iNumber else: - if buf[pos] > ' ': + if buf[pos] > ' ': L.indentAhead = indent break L.bufpos = pos @@ -785,7 +774,7 @@ proc skip(L: var TLexer, tok: var TToken) = break # EndOfFile also leaves the loop L.bufpos = pos -proc rawGetTok(L: var TLexer, tok: var TToken) = +proc rawGetTok*(L: var TLexer, tok: var TToken) = fillToken(tok) if L.indentAhead >= 0: tok.indent = L.indentAhead @@ -801,10 +790,10 @@ proc rawGetTok(L: var TLexer, tok: var TToken) = getSymbol(L, tok) else: case c - of '#': + of '#': scanComment(L, tok) of '*': - # '*:' is unfortunately a special case, because it is two tokens in + # '*:' is unfortunately a special case, because it is two tokens in # 'var v*: int'. if L.buf[L.bufpos+1] == ':' and L.buf[L.bufpos+2] notin OpChars: var h = 0 !& ord('*') @@ -814,29 +803,29 @@ proc rawGetTok(L: var TLexer, tok: var TToken) = of ',': tok.tokType = tkComma inc(L.bufpos) - of 'l': + of 'l': # if we parsed exactly one character and its a small L (l), this # is treated as a warning because it may be confused with the number 1 if L.buf[L.bufpos+1] notin (SymChars + {'_'}): lexMessage(L, warnSmallLshouldNotBeUsed) getSymbol(L, tok) of 'r', 'R': - if L.buf[L.bufpos + 1] == '\"': + if L.buf[L.bufpos + 1] == '\"': inc(L.bufpos) getString(L, tok, true) - else: + else: getSymbol(L, tok) - of '(': + of '(': inc(L.bufpos) - if L.buf[L.bufpos] == '.' and L.buf[L.bufpos+1] != '.': + if L.buf[L.bufpos] == '.' and L.buf[L.bufpos+1] != '.': tok.tokType = tkParDotLe inc(L.bufpos) - else: + else: tok.tokType = tkParLe - of ')': + of ')': tok.tokType = tkParRi inc(L.bufpos) - of '[': + of '[': inc(L.bufpos) if L.buf[L.bufpos] == '.' and L.buf[L.bufpos+1] != '.': tok.tokType = tkBracketDotLe @@ -847,34 +836,34 @@ proc rawGetTok(L: var TLexer, tok: var TToken) = tok.tokType = tkBracketRi inc(L.bufpos) of '.': - if L.buf[L.bufpos+1] == ']': + if L.buf[L.bufpos+1] == ']': tok.tokType = tkBracketDotRi inc(L.bufpos, 2) - elif L.buf[L.bufpos+1] == '}': + elif L.buf[L.bufpos+1] == '}': tok.tokType = tkCurlyDotRi inc(L.bufpos, 2) - elif L.buf[L.bufpos+1] == ')': + elif L.buf[L.bufpos+1] == ')': tok.tokType = tkParDotRi inc(L.bufpos, 2) - else: + else: getOperator(L, tok) - of '{': + of '{': inc(L.bufpos) if L.buf[L.bufpos] == '.' and L.buf[L.bufpos+1] != '.': tok.tokType = tkCurlyDotLe inc(L.bufpos) - else: + else: tok.tokType = tkCurlyLe - of '}': + of '}': tok.tokType = tkCurlyRi inc(L.bufpos) - of ';': + of ';': tok.tokType = tkSemiColon inc(L.bufpos) - of '`': + of '`': tok.tokType = tkAccent inc(L.bufpos) - of '\"': + of '\"': # check for extended raw string literal: var rawMode = L.bufpos > 0 and L.buf[L.bufpos-1] in SymChars getString(L, tok, rawMode) @@ -889,7 +878,7 @@ proc rawGetTok(L: var TLexer, tok: var TToken) = of '0'..'9': tok = getNumber(L) else: - if c in OpChars: + if c in OpChars: getOperator(L, tok) elif c == nimlexbase.EndOfFile: tok.tokType = tkEof diff --git a/compiler/lookups.nim b/compiler/lookups.nim index 6d3379bb9..88e32404a 100644 --- a/compiler/lookups.nim +++ b/compiler/lookups.nim @@ -9,8 +9,8 @@ # This module implements lookup helpers. -import - intsets, ast, astalgo, idents, semdata, types, msgs, options, rodread, +import + intsets, ast, astalgo, idents, semdata, types, msgs, options, rodread, renderer, wordrecg, idgen, nimfix.prettybase proc ensureNoMissingOrUnusedSymbols(scope: PScope) @@ -87,14 +87,14 @@ proc searchInScopes*(c: PContext, s: PIdent): PSym = if result != nil: return result = nil -proc debugScopes*(c: PContext) {.deprecated.} = +proc debugScopes*(c: PContext; limit=0) {.deprecated.} = var i = 0 for scope in walkScopes(c.currentScope): echo "scope ", i for h in 0 .. high(scope.symbols.data): if scope.symbols.data[h] != nil: echo scope.symbols.data[h].name.s - if i == 2: break + if i == limit: break inc i proc searchInScopes*(c: PContext, s: PIdent, filter: TSymKinds): PSym = @@ -108,7 +108,7 @@ proc errorSym*(c: PContext, n: PNode): PSym = var m = n # ensure that 'considerQuotedIdent' can't fail: if m.kind == nkDotExpr: m = m.sons[1] - let ident = if m.kind in {nkIdent, nkSym, nkAccQuoted}: + let ident = if m.kind in {nkIdent, nkSym, nkAccQuoted}: considerQuotedIdent(m) else: getIdent("err:" & renderTree(m)) @@ -119,11 +119,11 @@ proc errorSym*(c: PContext, n: PNode): PSym = if gCmd != cmdInteractive and c.inCompilesContext == 0: c.importTable.addSym(result) -type - TOverloadIterMode* = enum +type + TOverloadIterMode* = enum oimDone, oimNoQualifier, oimSelfModule, oimOtherModule, oimSymChoice, oimSymChoiceLocalLookup - TOverloadIter*{.final.} = object + TOverloadIter*{.final.} = object it*: TIdentIter m*: PSym mode*: TOverloadIterMode @@ -131,7 +131,7 @@ type scope*: PScope inSymChoice: IntSet -proc getSymRepr*(s: PSym): string = +proc getSymRepr*(s: PSym): string = case s.kind of skProc, skMethod, skConverter, skIterators: result = getProcHeader(s) else: result = s.name.s @@ -148,7 +148,7 @@ proc ensureNoMissingOrUnusedSymbols(scope: PScope) = if missingImpls == 0: localError(s.info, errImplOfXexpected, getSymRepr(s)) inc missingImpls - elif {sfUsed, sfExported} * s.flags == {} and optHints in s.options: + elif {sfUsed, sfExported} * s.flags == {} and optHints in s.options: # BUGFIX: check options in s! if s.kind notin {skForVar, skParam, skMethod, skUnknown, skGenericParam}: # XXX: implicit type params are currently skTypes @@ -156,11 +156,11 @@ proc ensureNoMissingOrUnusedSymbols(scope: PScope) = if s.typ != nil and tfImplicitTypeParam notin s.typ.flags: message(s.info, hintXDeclaredButNotUsed, getSymRepr(s)) s = nextIter(it, scope.symbols) - + proc wrongRedefinition*(info: TLineInfo, s: string) = if gCmd != cmdInteractive: localError(info, errAttemptToRedefine, s) - + proc addDecl*(c: PContext, sym: PSym) = if not c.currentScope.addUniqueSym(sym): wrongRedefinition(sym.info, sym.name.s) @@ -172,7 +172,7 @@ proc addDeclAt*(scope: PScope, sym: PSym) = if not scope.addUniqueSym(sym): wrongRedefinition(sym.info, sym.name.s) -proc addInterfaceDeclAux(c: PContext, sym: PSym) = +proc addInterfaceDeclAux(c: PContext, sym: PSym) = if sfExported in sym.flags: # add to interface: if c.module != nil: strTableAdd(c.module.tab, sym) @@ -183,16 +183,16 @@ proc addInterfaceDeclAt*(c: PContext, scope: PScope, sym: PSym) = addInterfaceDeclAux(c, sym) proc addOverloadableSymAt*(scope: PScope, fn: PSym) = - if fn.kind notin OverloadableSyms: + if fn.kind notin OverloadableSyms: internalError(fn.info, "addOverloadableSymAt") return let check = strTableGet(scope.symbols, fn.name) - if check != nil and check.kind notin OverloadableSyms: + if check != nil and check.kind notin OverloadableSyms: wrongRedefinition(fn.info, fn.name.s) else: scope.addSym(fn) - -proc addInterfaceDecl*(c: PContext, sym: PSym) = + +proc addInterfaceDecl*(c: PContext, sym: PSym) = # it adds the symbol to the interface if appropriate addDecl(c, sym) addInterfaceDeclAux(c, sym) @@ -221,7 +221,7 @@ when defined(nimfix): else: template fixSpelling(n: PNode; ident: PIdent; op: expr) = discard -proc lookUp*(c: PContext, n: PNode): PSym = +proc lookUp*(c: PContext, n: PNode): PSym = # Looks up a symbol. Generates an error in case of nil. case n.kind of nkIdent: @@ -242,12 +242,12 @@ proc lookUp*(c: PContext, n: PNode): PSym = else: internalError(n.info, "lookUp") return - if contains(c.ambiguousSymbols, result.id): + if contains(c.ambiguousSymbols, result.id): localError(n.info, errUseQualifier, result.name.s) if result.kind == skStub: loadStub(result) - -type - TLookupFlag* = enum + +type + TLookupFlag* = enum checkAmbiguity, checkUndeclared proc qualifiedLookUp*(c: PContext, n: PNode, flags = {checkUndeclared}): PSym = @@ -294,7 +294,7 @@ proc qualifiedLookUp*(c: PContext, n: PNode, flags = {checkUndeclared}): PSym = else: result = nil if result != nil and result.kind == skStub: loadStub(result) - + proc initOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = case n.kind of nkIdent, nkAccQuoted: @@ -311,17 +311,17 @@ proc initOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = of nkSym: result = n.sym o.mode = oimDone - of nkDotExpr: + of nkDotExpr: o.mode = oimOtherModule o.m = qualifiedLookUp(c, n.sons[0]) if o.m != nil and o.m.kind == skModule: var ident: PIdent = nil - if n.sons[1].kind == nkIdent: + if n.sons[1].kind == nkIdent: ident = n.sons[1].ident elif n.sons[1].kind == nkAccQuoted: ident = considerQuotedIdent(n.sons[1]) - if ident != nil: - if o.m == c.module: + if ident != nil: + if o.m == c.module: # a module may access its private members: result = initIdentIter(o.it, c.topLevelScope.symbols, ident).skipAlias(n) @@ -329,7 +329,7 @@ proc initOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = else: result = initIdentIter(o.it, o.m.tab, ident).skipAlias(n) else: - localError(n.sons[1].info, errIdentifierExpected, + localError(n.sons[1].info, errIdentifierExpected, renderTree(n.sons[1])) result = errorSym(c, n.sons[1]) of nkClosedSymChoice, nkOpenSymChoice: @@ -347,12 +347,12 @@ proc lastOverloadScope*(o: TOverloadIter): int = of oimSelfModule: result = 1 of oimOtherModule: result = 0 else: result = -1 - -proc nextOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = + +proc nextOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = case o.mode - of oimDone: + of oimDone: result = nil - of oimNoQualifier: + of oimNoQualifier: if o.scope != nil: result = nextIdentIter(o.it, o.scope.symbols).skipAlias(n) while result == nil: @@ -360,13 +360,13 @@ proc nextOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = if o.scope == nil: break result = initIdentIter(o.it, o.scope.symbols, o.it.name).skipAlias(n) # BUGFIX: o.it.name <-> n.ident - else: + else: result = nil - of oimSelfModule: + of oimSelfModule: result = nextIdentIter(o.it, c.topLevelScope.symbols).skipAlias(n) - of oimOtherModule: + of oimOtherModule: result = nextIdentIter(o.it, o.m.tab).skipAlias(n) - of oimSymChoice: + of oimSymChoice: if o.symChoiceIndex < sonsLen(n): result = n.sons[o.symChoiceIndex].sym incl(o.inSymChoice, result.id) @@ -389,7 +389,7 @@ proc nextOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = if o.scope == nil: break result = firstIdentExcluding(o.it, o.scope.symbols, n.sons[0].sym.name, o.inSymChoice).skipAlias(n) - + if result != nil and result.kind == skStub: loadStub(result) proc pickSym*(c: PContext, n: PNode; kind: TSymKind; diff --git a/compiler/lowerings.nim b/compiler/lowerings.nim index a51ca9ed6..0b4f97ead 100644 --- a/compiler/lowerings.nim +++ b/compiler/lowerings.nim @@ -382,11 +382,11 @@ proc getRoot*(n: PNode): PSym = if getMagic(n) == mSlice: result = getRoot(n.sons[1]) else: discard -proc newIntLit(value: BiggestInt): PNode = +proc newIntLit*(value: BiggestInt): PNode = result = nkIntLit.newIntNode(value) result.typ = getSysType(tyInt) -proc genHigh(n: PNode): PNode = +proc genHigh*(n: PNode): PNode = if skipTypes(n.typ, abstractVar).kind in {tyArrayConstr, tyArray}: result = newIntLit(lastOrd(skipTypes(n.typ, abstractVar))) else: diff --git a/compiler/main.nim b/compiler/main.nim index 363327e40..0c80c19b7 100644 --- a/compiler/main.nim +++ b/compiler/main.nim @@ -54,6 +54,7 @@ proc commandDoc2 = finishDoc2Pass(gProjectName) proc commandCompileToC = + extccomp.initVars() semanticPasses() registerPass(cgenPass) rodPass() diff --git a/compiler/msgs.nim b/compiler/msgs.nim index 0f7921ddb..778b839f3 100644 --- a/compiler/msgs.nim +++ b/compiler/msgs.nim @@ -387,7 +387,7 @@ const warnProveField: "cannot prove that field '$1' is accessible [ProveField]", warnProveIndex: "cannot prove index '$1' is valid [ProveIndex]", warnGcUnsafe: "not GC-safe: '$1' [GcUnsafe]", - warnGcUnsafe2: "cannot prove '$1' is GC-safe. Does not compile with --threads:on.", + warnGcUnsafe2: "$1", warnUninit: "'$1' might not have been initialized [Uninit]", warnGcMem: "'$1' uses GC'ed memory [GcMem]", warnDestructor: "usage of a type with a destructor in a non destructible context. This will become a compile time error in the future. [Destructor]", @@ -449,10 +449,10 @@ type fullPath: string # This is a canonical full filesystem path projPath*: string # This is relative to the project's root shortName*: string # short name of the module - quotedName*: PRope # cached quoted short name for codegen + quotedName*: Rope # cached quoted short name for codegen # purposes - lines*: seq[PRope] # the source code of the module + lines*: seq[Rope] # the source code of the module # used for better error messages and # embedding the original source in the # generated code @@ -493,24 +493,20 @@ proc toCChar*(c: char): string = of '\'', '\"', '\\': result = '\\' & c else: result = $(c) -proc makeCString*(s: string): PRope = - # BUGFIX: We have to split long strings into many ropes. Otherwise - # this could trigger an internalError(). See the ropes module for - # further information. +proc makeCString*(s: string): Rope = const MaxLineLength = 64 result = nil - var res = "\"" + var res = newStringOfCap(int(s.len.toFloat * 1.1) + 1) + add(res, "\"") for i in countup(0, len(s) - 1): if (i + 1) mod MaxLineLength == 0: add(res, '\"') add(res, tnl) - app(result, toRope(res)) # reset: - setLen(res, 1) - res[0] = '\"' + add(res, '\"') add(res, toCChar(s[i])) add(res, '\"') - app(result, toRope(res)) + add(result, rope(res)) proc newFileInfo(fullPath, projPath: string): TFileInfo = @@ -568,7 +564,7 @@ var gCodegenLineInfo* = newLineInfo(int32(1), 1, 1) proc raiseRecoverableError*(msg: string) {.noinline, noreturn.} = raise newException(ERecoverableError, msg) -proc sourceLine*(i: TLineInfo): PRope +proc sourceLine*(i: TLineInfo): Rope var gNotes*: TNoteKinds = {low(TNoteKind)..high(TNoteKind)} - @@ -587,22 +583,15 @@ proc unknownLineInfo*(): TLineInfo = var msgContext: seq[TLineInfo] = @[] lastError = unknownLineInfo() - bufferedMsgs*: seq[string] errorOutputs* = {eStdOut, eStdErr} writelnHook*: proc (output: string) {.closure.} -proc clearBufferedMsgs* = - bufferedMsgs = nil - proc suggestWriteln*(s: string) = if eStdOut in errorOutputs: if isNil(writelnHook): writeln(stdout, s) else: writelnHook(s) - if eInMemory in errorOutputs: - bufferedMsgs.safeAdd(s) - proc msgQuit*(x: int8) = quit x proc msgQuit*(x: string) = quit x @@ -705,8 +694,6 @@ proc msgWriteln*(s: string) = else: if eStdOut in errorOutputs: writeln(stdout, s) - if eInMemory in errorOutputs: bufferedMsgs.safeAdd(s) - proc coordToStr(coord: int): string = if coord == -1: result = "???" else: result = $coord @@ -785,7 +772,7 @@ proc rawMessage*(msg: TMsgKind, arg: string) = proc writeSurroundingSrc(info: TLineInfo) = const indent = " " - msgWriteln(indent & info.sourceLine.ropeToStr) + msgWriteln(indent & $info.sourceLine) msgWriteln(indent & spaces(info.col) & '^') proc formatMsg*(info: TLineInfo, msg: TMsgKind, arg: string): string = @@ -840,6 +827,9 @@ proc localError*(info: TLineInfo, msg: TMsgKind, arg = "") = proc localError*(info: TLineInfo, arg: string) = liMessage(info, errGenerated, arg, doNothing) +proc localError*(info: TLineInfo, format: string, params: openarray[string]) = + localError(info, format % params) + proc message*(info: TLineInfo, msg: TMsgKind, arg = "") = liMessage(info, msg, arg, doNothing) @@ -861,9 +851,9 @@ template internalAssert*(e: bool): stmt = if not e: internalError($instantiationInfo()) proc addSourceLine*(fileIdx: int32, line: string) = - fileInfos[fileIdx].lines.add line.toRope + fileInfos[fileIdx].lines.add line.rope -proc sourceLine*(i: TLineInfo): PRope = +proc sourceLine*(i: TLineInfo): Rope = if i.fileIndex < 0: return nil if not optPreserveOrigSource and fileInfos[i.fileIndex].lines.len == 0: @@ -878,16 +868,14 @@ proc sourceLine*(i: TLineInfo): PRope = result = fileInfos[i.fileIndex].lines[i.line-1] -proc quotedFilename*(i: TLineInfo): PRope = +proc quotedFilename*(i: TLineInfo): Rope = internalAssert i.fileIndex >= 0 result = fileInfos[i.fileIndex].quotedName -ropes.errorHandler = proc (err: TRopesError, msg: string, useWarning: bool) = +ropes.errorHandler = proc (err: RopesError, msg: string, useWarning: bool) = case err of rInvalidFormatStr: internalError("ropes: invalid format string: " & msg) - of rTokenTooLong: - internalError("ropes: token too long: " & msg) of rCannotOpenFile: rawMessage(if useWarning: warnCannotOpenFile else: errCannotOpenFile, msg) diff --git a/compiler/options.nim b/compiler/options.nim index 1b4a624ab..65250f519 100644 --- a/compiler/options.nim +++ b/compiler/options.nim @@ -9,7 +9,7 @@ import os, lists, strutils, strtabs, osproc, sets - + const hasTinyCBackend* = defined(tinyc) useEffectSystem* = true @@ -21,10 +21,10 @@ const type # please make sure we have under 32 options # (improves code efficiency a lot!) TOption* = enum # **keep binary compatible** - optNone, optObjCheck, optFieldCheck, optRangeCheck, optBoundsCheck, + optNone, optObjCheck, optFieldCheck, optRangeCheck, optBoundsCheck, optOverflowCheck, optNilCheck, optNaNCheck, optInfCheck, - optAssert, optLineDir, optWarns, optHints, + optAssert, optLineDir, optWarns, optHints, optOptimizeSpeed, optOptimizeSize, optStackTrace, # stack tracing support optLineTrace, # line tracing support (includes stack tracing) optEndb, # embedded debugger @@ -37,8 +37,8 @@ type # please make sure we have under 32 options TOptions* = set[TOption] TGlobalOption* = enum # **keep binary compatible** - gloptNone, optForceFullMake, optDeadCodeElim, - optListCmd, optCompileOnly, optNoLinking, + gloptNone, optForceFullMake, optDeadCodeElim, + optListCmd, optCompileOnly, optNoLinking, optSafeCode, # only allow safe code optCDebug, # turn on debugging information optGenDynLib, # generate a dynamic library @@ -67,9 +67,9 @@ type # please make sure we have under 32 options TGlobalOptions* = set[TGlobalOption] TCommands* = enum # Nim's commands # **keep binary compatible** - cmdNone, cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, - cmdCompileToJS, cmdCompileToLLVM, cmdInterpret, cmdPretty, cmdDoc, - cmdGenDepend, cmdDump, + cmdNone, cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, + cmdCompileToJS, cmdCompileToLLVM, cmdInterpret, cmdPretty, cmdDoc, + cmdGenDepend, cmdDump, cmdCheck, # semantic checking for whole project cmdParse, # parse a single file (for debugging) cmdScan, # scan a single file (for debugging) @@ -90,12 +90,12 @@ var gIdeCmd*: TIdeCmd const - ChecksOptions* = {optObjCheck, optFieldCheck, optRangeCheck, optNilCheck, + ChecksOptions* = {optObjCheck, optFieldCheck, optRangeCheck, optNilCheck, optOverflowCheck, optBoundsCheck, optAssert, optNaNCheck, optInfCheck} -var - gOptions*: TOptions = {optObjCheck, optFieldCheck, optRangeCheck, - optBoundsCheck, optOverflowCheck, optAssert, optWarns, +var + gOptions*: TOptions = {optObjCheck, optFieldCheck, optRangeCheck, + optBoundsCheck, optOverflowCheck, optAssert, optWarns, optHints, optStackTrace, optLineTrace, optPatterns, optNilCheck} gGlobalOptions*: TGlobalOptions = {optThreadAnalysis} @@ -129,7 +129,7 @@ template optPreserveOrigSource*: expr = template optPrintSurroundingSrc*: expr = gVerbosity >= 2 -const +const genSubDir* = "nimcache" NimExt* = "nim" RodExt* = "rod" @@ -168,20 +168,20 @@ proc mainCommandArg*: string = else: result = gProjectName -proc existsConfigVar*(key: string): bool = +proc existsConfigVar*(key: string): bool = result = hasKey(gConfigVars, key) -proc getConfigVar*(key: string): string = +proc getConfigVar*(key: string): string = result = gConfigVars[key] -proc setConfigVar*(key, val: string) = +proc setConfigVar*(key, val: string) = gConfigVars[key] = val -proc getOutFile*(filename, ext: string): string = +proc getOutFile*(filename, ext: string): string = if options.outFile != "": result = options.outFile else: result = changeFileExt(filename, ext) - -proc getPrefixDir*(): string = + +proc getPrefixDir*(): string = ## gets the application directory result = splitPath(getAppDir()).head @@ -189,22 +189,22 @@ proc canonicalizePath*(path: string): string = when not FileSystemCaseSensitive: result = path.expandFilename.toLower else: result = path.expandFilename -proc shortenDir*(dir: string): string = +proc shortenDir*(dir: string): string = ## returns the interesting part of a dir var prefix = getPrefixDir() & DirSep - if startsWith(dir, prefix): + if startsWith(dir, prefix): return substr(dir, len(prefix)) prefix = gProjectPath & DirSep if startsWith(dir, prefix): return substr(dir, len(prefix)) result = dir -proc removeTrailingDirSep*(path: string): string = - if (len(path) > 0) and (path[len(path) - 1] == DirSep): +proc removeTrailingDirSep*(path: string): string = + if (len(path) > 0) and (path[len(path) - 1] == DirSep): result = substr(path, 0, len(path) - 2) - else: + else: result = path - + proc getGeneratedPath: string = result = if nimcacheDir.len > 0: nimcacheDir else: gProjectPath.shortenDir / genSubDir @@ -257,7 +257,7 @@ proc withPackageName*(path: string): string = let (p, file, ext) = path.splitFile result = (p / (x & '_' & file)) & ext -proc toGeneratedFile*(path, ext: string): string = +proc toGeneratedFile*(path, ext: string): string = ## converts "/home/a/mymodule.nim", "rod" to "/home/a/nimcache/mymodule.rod" var (head, tail) = splitPath(path) #if len(head) > 0: head = shortenDir(head & dirSep) @@ -301,7 +301,7 @@ proc completeGeneratedFilePath*(f: string, createSubDir: bool = true): string = result = joinPath(subdir, tail) #echo "completeGeneratedFilePath(", f, ") = ", result -iterator iterSearchPath*(searchPaths: TLinkedList): string = +iterator iterSearchPath*(searchPaths: TLinkedList): string = var it = PStrEntry(searchPaths.head) while it != nil: yield it.data @@ -324,7 +324,7 @@ proc rawFindFile2(f: string): string = it = PStrEntry(it.next) result = "" -proc findFile*(f: string): string {.procvar.} = +proc findFile*(f: string): string {.procvar.} = result = f.rawFindFile if result.len == 0: result = f.toLower.rawFindFile @@ -351,7 +351,7 @@ proc findModule*(modulename, currentModule: string): string = if not existsFile(result): result = findFile(m) -proc libCandidates*(s: string, dest: var seq[string]) = +proc libCandidates*(s: string, dest: var seq[string]) = var le = strutils.find(s, '(') var ri = strutils.find(s, ')', le+1) if le >= 0 and ri > le: @@ -359,7 +359,7 @@ proc libCandidates*(s: string, dest: var seq[string]) = var suffix = substr(s, ri + 1) for middle in split(substr(s, le + 1, ri - 1), '|'): libCandidates(prefix & middle & suffix, dest) - else: + else: add(dest, s) proc canonDynlibName(s: string): string = @@ -376,17 +376,17 @@ proc inclDynlibOverride*(lib: string) = proc isDynlibOverride*(lib: string): bool = result = gDllOverrides.hasKey(lib.canonDynlibName) -proc binaryStrSearch*(x: openArray[string], y: string): int = +proc binaryStrSearch*(x: openArray[string], y: string): int = var a = 0 var b = len(x) - 1 - while a <= b: + while a <= b: var mid = (a + b) div 2 var c = cmpIgnoreCase(x[mid], y) - if c < 0: + if c < 0: a = mid + 1 - elif c > 0: + elif c > 0: b = mid - 1 - else: + else: return mid result = - 1 diff --git a/compiler/parampatterns.nim b/compiler/parampatterns.nim index 8c0875ab1..b7fe269df 100644 --- a/compiler/parampatterns.nim +++ b/compiler/parampatterns.nim @@ -131,11 +131,10 @@ proc semNodeKindConstraints*(p: PNode): PNode = result.strVal.add(ppEof) type - TSideEffectAnalysis = enum + TSideEffectAnalysis* = enum seUnknown, seSideEffect, seNoSideEffect -proc checkForSideEffects(n: PNode): TSideEffectAnalysis = - # XXX is 'raise' a side effect? +proc checkForSideEffects*(n: PNode): TSideEffectAnalysis = case n.kind of nkCallKinds: # only calls can produce side effects: @@ -162,6 +161,8 @@ proc checkForSideEffects(n: PNode): TSideEffectAnalysis = # an atom cannot produce a side effect: result = seNoSideEffect else: + # assume no side effect: + result = seNoSideEffect for i in 0 .. <n.len: let ret = checkForSideEffects(n.sons[i]) if ret == seSideEffect: return ret @@ -189,6 +190,8 @@ proc isAssignable*(owner: PSym, n: PNode): TAssignableResult = result = arLocalLValue else: result = arLValue + elif n.sym.kind == skParam and n.sym.typ.kind == tyVar: + result = arLValue elif n.sym.kind == skType: let t = n.sym.typ.skipTypes({tyTypeDesc}) if t.kind == tyVar: result = arStrange diff --git a/compiler/parser.nim b/compiler/parser.nim index 9e4d45cd2..8f27774ed 100644 --- a/compiler/parser.nim +++ b/compiler/parser.nim @@ -12,7 +12,7 @@ # it uses several helper routines to keep the parser small. A special # efficient algorithm is used for the precedence levels. The parser here can # be seen as a refinement of the grammar, as it specifies how the AST is built -# from the grammar and how comments belong to the AST. +# from the grammar and how comments belong to the AST. # In fact the grammar is generated from this file: @@ -74,7 +74,7 @@ proc getTok(p: var TParser) = proc openParser*(p: var TParser, fileIdx: int32, inputStream: PLLStream, strongSpaces=false) = ## Open a parser, using the given arguments to set up its internal state. - ## + ## initToken(p.tok) openLexer(p.lex, fileIdx, inputStream) getTok(p) # read the first token @@ -143,11 +143,11 @@ proc getTokNoInd(p: var TParser) = proc expectIdentOrKeyw(p: TParser) = if p.tok.tokType != tkSymbol and not isKeyword(p.tok.tokType): lexMessage(p.lex, errIdentifierExpected, prettyTok(p.tok)) - + proc expectIdent(p: TParser) = if p.tok.tokType != tkSymbol: lexMessage(p.lex, errIdentifierExpected, prettyTok(p.tok)) - + proc eat(p: var TParser, tokType: TTokType) = ## Move the parser to the next token if the current token is of type ## `tokType`, otherwise error. @@ -155,7 +155,7 @@ proc eat(p: var TParser, tokType: TTokType) = getTok(p) else: lexMessage(p.lex, errTokenExpected, TokTypeToStr[tokType]) - + proc parLineInfo(p: TParser): TLineInfo = ## Retrieve the line information associated with the parser's current state. result = getLineInfo(p.lex, p.tok) @@ -166,24 +166,24 @@ proc indAndComment(p: var TParser, n: PNode) = else: parMessage(p, errInvalidIndentation) else: skipComment(p, n) - -proc newNodeP(kind: TNodeKind, p: TParser): PNode = + +proc newNodeP(kind: TNodeKind, p: TParser): PNode = result = newNodeI(kind, parLineInfo(p)) -proc newIntNodeP(kind: TNodeKind, intVal: BiggestInt, p: TParser): PNode = +proc newIntNodeP(kind: TNodeKind, intVal: BiggestInt, p: TParser): PNode = result = newNodeP(kind, p) result.intVal = intVal -proc newFloatNodeP(kind: TNodeKind, floatVal: BiggestFloat, +proc newFloatNodeP(kind: TNodeKind, floatVal: BiggestFloat, p: TParser): PNode = result = newNodeP(kind, p) result.floatVal = floatVal -proc newStrNodeP(kind: TNodeKind, strVal: string, p: TParser): PNode = +proc newStrNodeP(kind: TNodeKind, strVal: string, p: TParser): PNode = result = newNodeP(kind, p) result.strVal = strVal -proc newIdentNodeP(ident: PIdent, p: TParser): PNode = +proc newIdentNodeP(ident: PIdent, p: TParser): PNode = result = newNodeP(nkIdent, p) result.ident = ident @@ -212,27 +212,29 @@ proc getPrecedence(tok: TToken, strongSpaces: bool): int = let relevantChar = tok.ident.s[0] # arrow like? - if L > 1 and tok.ident.s[L-1] == '>': return considerStrongSpaces(1) - + if L > 1 and tok.ident.s[L-1] == '>' and + tok.ident.s[L-2] in {'-', '~', '='}: return considerStrongSpaces(1) + template considerAsgn(value: expr) = - result = if tok.ident.s[L-1] == '=': 1 else: considerStrongSpaces(value) - + result = if tok.ident.s[L-1] == '=': 1 else: value + case relevantChar of '$', '^': considerAsgn(10) of '*', '%', '/', '\\': considerAsgn(9) - of '~': result = considerStrongSpaces(8) + of '~': result = 8 of '+', '-', '|': considerAsgn(8) of '&': considerAsgn(7) - of '=', '<', '>', '!': result = considerStrongSpaces(5) + of '=', '<', '>', '!': result = 5 of '.': considerAsgn(6) - of '?': result = considerStrongSpaces(2) + of '?': result = 2 else: considerAsgn(2) of tkDiv, tkMod, tkShl, tkShr: result = 9 of tkIn, tkNotin, tkIs, tkIsnot, tkNot, tkOf, tkAs: result = 5 - of tkDotDot: result = considerStrongSpaces(6) + of tkDotDot: result = 6 of tkAnd: result = 4 of tkOr, tkXor, tkPtr, tkRef: result = 3 - else: result = -10 + else: return -10 + result = considerStrongSpaces(result) proc isOperator(tok: TToken): bool = ## Determines if the given token is an operator type token. @@ -241,9 +243,15 @@ proc isOperator(tok: TToken): bool = proc isUnary(p: TParser): bool = ## Check if the current parser token is a unary operator - p.strongSpaces and p.tok.tokType in {tkOpr, tkDotDot} and - p.tok.strongSpaceB == 0 and - p.tok.strongSpaceA > 0 + if p.tok.tokType in {tkOpr, tkDotDot} and + p.tok.strongSpaceB == 0 and + p.tok.strongSpaceA > 0: + # XXX change this after 0.10.4 is out + if p.strongSpaces: + result = true + else: + parMessage(p, warnDeprecated, + "will be parsed as unary operator; inconsistent spacing") proc checkBinary(p: TParser) {.inline.} = ## Check if the current parser token is a binary operator. @@ -262,14 +270,14 @@ proc checkBinary(p: TParser) {.inline.} = #| semicolon = ';' COMMENT? #| colon = ':' COMMENT? #| colcom = ':' COMMENT? -#| +#| #| operator = OP0 | OP1 | OP2 | OP3 | OP4 | OP5 | OP6 | OP7 | OP8 | OP9 #| | 'or' | 'xor' | 'and' #| | 'is' | 'isnot' | 'in' | 'notin' | 'of' -#| | 'div' | 'mod' | 'shl' | 'shr' | 'not' | 'addr' | 'static' | '..' -#| +#| | 'div' | 'mod' | 'shl' | 'shr' | 'not' | 'static' | '..' +#| #| prefixOperator = operator -#| +#| #| optInd = COMMENT? #| optPar = (IND{>} | IND{=})? #| @@ -291,18 +299,18 @@ proc colcom(p: var TParser, n: PNode) = proc parseSymbol(p: var TParser, allowNil = false): PNode = #| symbol = '`' (KEYW|IDENT|literal|(operator|'('|')'|'['|']'|'{'|'}'|'=')+)+ '`' - #| | IDENT + #| | IDENT | 'addr' | 'type' case p.tok.tokType - of tkSymbol: + of tkSymbol, tkAddr, tkType: result = newIdentNodeP(p.tok.ident, p) getTok(p) - of tkAccent: + of tkAccent: result = newNodeP(nkAccQuoted, p) getTok(p) while true: case p.tok.tokType of tkAccent: - if result.len == 0: + if result.len == 0: parMessage(p, errIdentifierExpected, p.tok) break of tkOpr, tkDot, tkDotDot, tkEquals, tkParLe..tkParDotRi: @@ -330,12 +338,12 @@ proc parseSymbol(p: var TParser, allowNil = false): PNode = if not isKeyword(p.tok.tokType): getTok(p) result = ast.emptyNode -proc indexExpr(p: var TParser): PNode = +proc indexExpr(p: var TParser): PNode = #| indexExpr = expr result = parseExpr(p) -proc indexExprList(p: var TParser, first: PNode, k: TNodeKind, - endToken: TTokType): PNode = +proc indexExprList(p: var TParser, first: PNode, k: TNodeKind, + endToken: TTokType): PNode = #| indexExprList = indexExpr ^+ comma result = newNodeP(k, p) addSon(result, first) @@ -344,7 +352,7 @@ proc indexExprList(p: var TParser, first: PNode, k: TNodeKind, while p.tok.tokType notin {endToken, tkEof}: var a = indexExpr(p) addSon(result, a) - if p.tok.tokType != tkComma: break + if p.tok.tokType != tkComma: break getTok(p) skipComment(p, a) optPar(p) @@ -371,39 +379,28 @@ proc exprColonEqExpr(p: var TParser): PNode = var a = parseExpr(p) result = colonOrEquals(p, a) -proc exprList(p: var TParser, endTok: TTokType, result: PNode) = +proc exprList(p: var TParser, endTok: TTokType, result: PNode) = #| exprList = expr ^+ comma getTok(p) optInd(p, result) - while (p.tok.tokType != endTok) and (p.tok.tokType != tkEof): + while (p.tok.tokType != endTok) and (p.tok.tokType != tkEof): var a = parseExpr(p) addSon(result, a) - if p.tok.tokType != tkComma: break + if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) - eat(p, endTok) proc dotExpr(p: var TParser, a: PNode): PNode = - #| dotExpr = expr '.' optInd ('type' | 'addr' | symbol) + #| dotExpr = expr '.' optInd symbol var info = p.parLineInfo getTok(p) result = newNodeI(nkDotExpr, info) optInd(p, result) - case p.tok.tokType - of tkType: - result = newNodeP(nkTypeOfExpr, p) - getTok(p) - addSon(result, a) - of tkAddr: - result = newNodeP(nkAddr, p) - getTok(p) - addSon(result, a) - else: - addSon(result, a) - addSon(result, parseSymbol(p)) + addSon(result, a) + addSon(result, parseSymbol(p)) -proc qualifiedIdent(p: var TParser): PNode = - #| qualifiedIdent = symbol ('.' optInd ('type' | 'addr' | symbol))? +proc qualifiedIdent(p: var TParser): PNode = + #| qualifiedIdent = symbol ('.' optInd symbol)? result = parseSymbol(p) if p.tok.tokType == tkDot: result = dotExpr(p, result) @@ -414,7 +411,7 @@ proc exprColonEqExprListAux(p: var TParser, endTok: TTokType, result: PNode) = while p.tok.tokType != endTok and p.tok.tokType != tkEof: var a = exprColonEqExpr(p) addSon(result, a) - if p.tok.tokType != tkComma: break + if p.tok.tokType != tkComma: break getTok(p) skipComment(p, a) optPar(p) @@ -439,13 +436,13 @@ proc setOrTableConstr(p: var TParser): PNode = var a = exprColonEqExpr(p) if a.kind == nkExprColonExpr: result.kind = nkTableConstr addSon(result, a) - if p.tok.tokType != tkComma: break + if p.tok.tokType != tkComma: break getTok(p) skipComment(p, a) optPar(p) eat(p, tkCurlyRi) # skip '}' -proc parseCast(p: var TParser): PNode = +proc parseCast(p: var TParser): PNode = #| castExpr = 'cast' '[' optInd typeDesc optPar ']' '(' optInd expr optPar ')' result = newNodeP(nkCast, p) getTok(p) @@ -460,21 +457,21 @@ proc parseCast(p: var TParser): PNode = optPar(p) eat(p, tkParRi) -proc setBaseFlags(n: PNode, base: TNumericalBase) = +proc setBaseFlags(n: PNode, base: TNumericalBase) = case base of base10: discard of base2: incl(n.flags, nfBase2) of base8: incl(n.flags, nfBase8) of base16: incl(n.flags, nfBase16) - -proc parseGStrLit(p: var TParser, a: PNode): PNode = + +proc parseGStrLit(p: var TParser, a: PNode): PNode = case p.tok.tokType - of tkGStrLit: + of tkGStrLit: result = newNodeP(nkCallStrLit, p) addSon(result, a) addSon(result, newStrNodeP(nkRStrLit, p.tok.literal, p)) getTok(p) - of tkGTripleStrLit: + of tkGTripleStrLit: result = newNodeP(nkCallStrLit, p) addSon(result, a) addSon(result, newStrNodeP(nkTripleStrLit, p.tok.literal, p)) @@ -502,18 +499,18 @@ proc parsePar(p: var TParser): PNode = #| parKeyw = 'discard' | 'include' | 'if' | 'while' | 'case' | 'try' #| | 'finally' | 'except' | 'for' | 'block' | 'const' | 'let' #| | 'when' | 'var' | 'mixin' - #| par = '(' optInd (&parKeyw complexOrSimpleStmt ^+ ';' + #| par = '(' optInd (&parKeyw complexOrSimpleStmt ^+ ';' #| | simpleExpr ('=' expr (';' complexOrSimpleStmt ^+ ';' )? )? #| | (':' expr)? (',' (exprColonEqExpr comma?)*)? )? #| optPar ')' # - # unfortunately it's ambiguous: (expr: expr) vs (exprStmt); however a + # unfortunately it's ambiguous: (expr: expr) vs (exprStmt); however a # leading ';' could be used to enforce a 'stmt' context ... result = newNodeP(nkPar, p) getTok(p) optInd(p, result) - if p.tok.tokType in {tkDiscard, tkInclude, tkIf, tkWhile, tkCase, - tkTry, tkDefer, tkFinally, tkExcept, tkFor, tkBlock, + if p.tok.tokType in {tkDiscard, tkInclude, tkIf, tkWhile, tkCase, + tkTry, tkDefer, tkFinally, tkExcept, tkFor, tkBlock, tkConst, tkLet, tkWhen, tkVar, tkMixin}: # XXX 'bind' used to be an expression, so we exclude it here; @@ -550,13 +547,13 @@ proc parsePar(p: var TParser): PNode = while p.tok.tokType != tkParRi and p.tok.tokType != tkEof: var a = exprColonEqExpr(p) addSon(result, a) - if p.tok.tokType != tkComma: break + if p.tok.tokType != tkComma: break getTok(p) skipComment(p, a) optPar(p) eat(p, tkParRi) -proc identOrLiteral(p: var TParser, mode: TPrimaryMode): PNode = +proc identOrLiteral(p: var TParser, mode: TPrimaryMode): PNode = #| literal = | INT_LIT | INT8_LIT | INT16_LIT | INT32_LIT | INT64_LIT #| | UINT_LIT | UINT8_LIT | UINT16_LIT | UINT32_LIT | UINT64_LIT #| | FLOAT_LIT | FLOAT32_LIT | FLOAT64_LIT @@ -570,61 +567,61 @@ proc identOrLiteral(p: var TParser, mode: TPrimaryMode): PNode = #| tupleConstr = '(' optInd (exprColonEqExpr comma?)* optPar ')' #| arrayConstr = '[' optInd (exprColonEqExpr comma?)* optPar ']' case p.tok.tokType - of tkSymbol: + of tkSymbol, tkType, tkAddr: result = newIdentNodeP(p.tok.ident, p) getTok(p) result = parseGStrLit(p, result) - of tkAccent: + of tkAccent: result = parseSymbol(p) # literals of tkIntLit: result = newIntNodeP(nkIntLit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkInt8Lit: + of tkInt8Lit: result = newIntNodeP(nkInt8Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkInt16Lit: + of tkInt16Lit: result = newIntNodeP(nkInt16Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkInt32Lit: + of tkInt32Lit: result = newIntNodeP(nkInt32Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkInt64Lit: + of tkInt64Lit: result = newIntNodeP(nkInt64Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkUIntLit: + of tkUIntLit: result = newIntNodeP(nkUIntLit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkUInt8Lit: + of tkUInt8Lit: result = newIntNodeP(nkUInt8Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkUInt16Lit: + of tkUInt16Lit: result = newIntNodeP(nkUInt16Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkUInt32Lit: + of tkUInt32Lit: result = newIntNodeP(nkUInt32Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkUInt64Lit: + of tkUInt64Lit: result = newIntNodeP(nkUInt64Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkFloatLit: + of tkFloatLit: result = newFloatNodeP(nkFloatLit, p.tok.fNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkFloat32Lit: + of tkFloat32Lit: result = newFloatNodeP(nkFloat32Lit, p.tok.fNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkFloat64Lit: + of tkFloat64Lit: result = newFloatNodeP(nkFloat64Lit, p.tok.fNumber, p) setBaseFlags(result, p.tok.base) getTok(p) @@ -632,19 +629,19 @@ proc identOrLiteral(p: var TParser, mode: TPrimaryMode): PNode = result = newFloatNodeP(nkFloat128Lit, p.tok.fNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkStrLit: + of tkStrLit: result = newStrNodeP(nkStrLit, p.tok.literal, p) getTok(p) - of tkRStrLit: + of tkRStrLit: result = newStrNodeP(nkRStrLit, p.tok.literal, p) getTok(p) - of tkTripleStrLit: + of tkTripleStrLit: result = newStrNodeP(nkTripleStrLit, p.tok.literal, p) getTok(p) - of tkCharLit: + of tkCharLit: result = newIntNodeP(nkCharLit, ord(p.tok.literal[0]), p) getTok(p) - of tkNil: + of tkNil: result = newNodeP(nkNilLit, p) getTok(p) of tkParLe: @@ -659,7 +656,7 @@ proc identOrLiteral(p: var TParser, mode: TPrimaryMode): PNode = of tkBracketLe: # [] constructor result = exprColonEqExprList(p, nkBracket, tkBracketRi) - of tkCast: + of tkCast: result = parseCast(p) else: parMessage(p, errExprExpected, p.tok) @@ -676,11 +673,11 @@ proc namedParams(p: var TParser, callee: PNode, proc parseMacroColon(p: var TParser, x: PNode): PNode proc primarySuffix(p: var TParser, r: PNode, baseIndent: int): PNode = #| primarySuffix = '(' (exprColonEqExpr comma?)* ')' doBlocks? - #| | doBlocks - #| | '.' optInd ('type' | 'addr' | symbol) generalizedLit? - #| | '[' optInd indexExprList optPar ']' - #| | '{' optInd indexExprList optPar '}' - #| | &( '`'|IDENT|literal|'cast') expr # command syntax + #| | doBlocks + #| | '.' optInd symbol generalizedLit? + #| | '[' optInd indexExprList optPar ']' + #| | '{' optInd indexExprList optPar '}' + #| | &( '`'|IDENT|literal|'cast'|'addr'|'type') expr # command syntax result = r while p.tok.indent < 0 or (p.tok.tokType == tkDot and p.tok.indent >= baseIndent): @@ -706,21 +703,22 @@ proc primarySuffix(p: var TParser, r: PNode, baseIndent: int): PNode = of tkCurlyLe: if p.strongSpaces and p.tok.strongSpaceA > 0: break result = namedParams(p, result, nkCurlyExpr, tkCurlyRi) - of tkSymbol, tkAccent, tkIntLit..tkCharLit, tkNil, tkCast: + of tkSymbol, tkAccent, tkIntLit..tkCharLit, tkNil, tkCast, tkAddr, tkType: if p.inPragma == 0: # actually parsing {.push hints:off.} as {.push(hints:off).} is a sweet # solution, but pragmas.nim can't handle that let a = result result = newNodeP(nkCommand, p) addSon(result, a) - addSon result, parseExpr(p) - when false: + when true: + addSon result, parseExpr(p) + else: while p.tok.tokType != tkEof: - let a = parseExpr(p) - addSon(result, a) + let x = parseExpr(p) + addSon(result, x) if p.tok.tokType != tkComma: break getTok(p) - optInd(p, a) + optInd(p, x) if p.tok.tokType == tkDo: parseDoBlocks(p, result) else: @@ -728,7 +726,7 @@ proc primarySuffix(p: var TParser, r: PNode, baseIndent: int): PNode = break else: break - + proc primary(p: var TParser, mode: TPrimaryMode): PNode proc simpleExprAux(p: var TParser, limit: int, mode: TPrimaryMode): PNode @@ -757,7 +755,7 @@ proc parseOperators(p: var TParser, headNode: PNode, proc simpleExprAux(p: var TParser, limit: int, mode: TPrimaryMode): PNode = result = primary(p, mode) result = parseOperators(p, result, limit, mode) - + proc simpleExpr(p: var TParser, mode = pmNormal): PNode = result = simpleExprAux(p, -1, mode) @@ -776,7 +774,7 @@ proc parseIfExpr(p: var TParser, kind: TNodeKind): PNode = addSon(branch, parseExpr(p)) optInd(p, branch) addSon(result, branch) - if p.tok.tokType != tkElif: break + if p.tok.tokType != tkElif: break var branch = newNodeP(nkElseExpr, p) eat(p, tkElse) colcom(p, branch) @@ -799,67 +797,67 @@ proc parsePragma(p: var TParser): PNode = if p.tok.tokType in {tkCurlyDotRi, tkCurlyRi}: getTok(p) else: parMessage(p, errTokenExpected, ".}") dec p.inPragma - -proc identVis(p: var TParser): PNode = + +proc identVis(p: var TParser): PNode = #| identVis = symbol opr? # postfix position var a = parseSymbol(p) - if p.tok.tokType == tkOpr: + if p.tok.tokType == tkOpr: result = newNodeP(nkPostfix, p) addSon(result, newIdentNodeP(p.tok.ident, p)) addSon(result, a) getTok(p) - else: + else: result = a - -proc identWithPragma(p: var TParser): PNode = + +proc identWithPragma(p: var TParser): PNode = #| identWithPragma = identVis pragma? var a = identVis(p) - if p.tok.tokType == tkCurlyDotLe: + if p.tok.tokType == tkCurlyDotLe: result = newNodeP(nkPragmaExpr, p) addSon(result, a) addSon(result, parsePragma(p)) - else: + else: result = a type - TDeclaredIdentFlag = enum + TDeclaredIdentFlag = enum withPragma, # identifier may have pragma withBothOptional # both ':' and '=' parts are optional TDeclaredIdentFlags = set[TDeclaredIdentFlag] -proc parseIdentColonEquals(p: var TParser, flags: TDeclaredIdentFlags): PNode = +proc parseIdentColonEquals(p: var TParser, flags: TDeclaredIdentFlags): PNode = #| declColonEquals = identWithPragma (comma identWithPragma)* comma? #| (':' optInd typeDesc)? ('=' optInd expr)? #| identColonEquals = ident (comma ident)* comma? #| (':' optInd typeDesc)? ('=' optInd expr)?) var a: PNode result = newNodeP(nkIdentDefs, p) - while true: + while true: case p.tok.tokType - of tkSymbol, tkAccent: + of tkSymbol, tkAccent: if withPragma in flags: a = identWithPragma(p) else: a = parseSymbol(p) - if a.kind == nkEmpty: return - else: break + if a.kind == nkEmpty: return + else: break addSon(result, a) - if p.tok.tokType != tkComma: break + if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) - if p.tok.tokType == tkColon: + if p.tok.tokType == tkColon: getTok(p) optInd(p, result) addSon(result, parseTypeDesc(p)) - else: + else: addSon(result, ast.emptyNode) - if p.tok.tokType != tkEquals and withBothOptional notin flags: + if p.tok.tokType != tkEquals and withBothOptional notin flags: parMessage(p, errColonOrEqualsExpected, p.tok) - if p.tok.tokType == tkEquals: + if p.tok.tokType == tkEquals: getTok(p) optInd(p, result) addSon(result, parseExpr(p)) - else: + else: addSon(result, ast.emptyNode) - + proc parseTuple(p: var TParser, indentAllowed = false): PNode = #| inlTupleDecl = 'tuple' #| [' optInd (identColonEquals (comma/semicolon)?)* optPar ']' @@ -911,15 +909,15 @@ proc parseParamList(p: var TParser, retColon = true): PNode = optInd(p, result) while true: case p.tok.tokType - of tkSymbol, tkAccent: + of tkSymbol, tkAccent: a = parseIdentColonEquals(p, {withBothOptional, withPragma}) - of tkParRi: - break - else: + of tkParRi: + break + else: parMessage(p, errTokenExpected, ")") - break + break addSon(result, a) - if p.tok.tokType notin {tkComma, tkSemiColon}: break + if p.tok.tokType notin {tkComma, tkSemiColon}: break getTok(p) skipComment(p, a) optPar(p) @@ -946,8 +944,7 @@ proc parseDoBlock(p: var TParser): PNode = getTok(p) let params = parseParamList(p, retColon=false) let pragmas = optPragmas(p) - eat(p, tkColon) - skipComment(p, result) + colcom(p, result) result = newProcNode(nkDo, info, parseStmt(p), params = params, pragmas = pragmas) @@ -957,9 +954,9 @@ proc parseDoBlocks(p: var TParser, call: PNode) = if p.tok.tokType == tkDo: addSon(call, parseDoBlock(p)) while sameInd(p) and p.tok.tokType == tkDo: - addSon(call, parseDoBlock(p)) + addSon(call, parseDoBlock(p)) -proc parseProcExpr(p: var TParser, isExpr: bool): PNode = +proc parseProcExpr(p: var TParser, isExpr: bool): PNode = #| procExpr = 'proc' paramListColon pragmas? ('=' COMMENT? stmt)? # either a proc type or a anonymous proc let info = parLineInfo(p) @@ -967,7 +964,7 @@ proc parseProcExpr(p: var TParser, isExpr: bool): PNode = let hasSignature = p.tok.tokType in {tkParLe, tkColon} and p.tok.indent < 0 let params = parseParamList(p) let pragmas = optPragmas(p) - if p.tok.tokType == tkEquals and isExpr: + if p.tok.tokType == tkEquals and isExpr: getTok(p) skipComment(p, result) result = newProcNode(nkLambda, info, parseStmt(p), @@ -979,11 +976,11 @@ proc parseProcExpr(p: var TParser, isExpr: bool): PNode = addSon(result, params) addSon(result, pragmas) -proc isExprStart(p: TParser): bool = +proc isExprStart(p: TParser): bool = case p.tok.tokType - of tkSymbol, tkAccent, tkOpr, tkNot, tkNil, tkCast, tkIf, + of tkSymbol, tkAccent, tkOpr, tkNot, tkNil, tkCast, tkIf, tkProc, tkIterator, tkBind, tkAddr, - tkParLe, tkBracketLe, tkCurlyLe, tkIntLit..tkCharLit, tkVar, tkRef, tkPtr, + tkParLe, tkBracketLe, tkCurlyLe, tkIntLit..tkCharLit, tkVar, tkRef, tkPtr, tkTuple, tkObject, tkType, tkWhen, tkCase: result = true else: result = false @@ -1013,7 +1010,7 @@ proc parseTypeDescKAux(p: var TParser, kind: TNodeKind, result.addSon list parseSymbolList(p, list, allowNil = true) -proc parseExpr(p: var TParser): PNode = +proc parseExpr(p: var TParser): PNode = #| expr = (ifExpr #| | whenExpr #| | caseExpr @@ -1030,12 +1027,11 @@ proc parseEnum(p: var TParser): PNode proc parseObject(p: var TParser): PNode proc parseTypeClass(p: var TParser): PNode -proc primary(p: var TParser, mode: TPrimaryMode): PNode = - #| typeKeyw = 'var' | 'ref' | 'ptr' | 'shared' | 'type' | 'tuple' +proc primary(p: var TParser, mode: TPrimaryMode): PNode = + #| typeKeyw = 'var' | 'ref' | 'ptr' | 'shared' | 'tuple' #| | 'proc' | 'iterator' | 'distinct' | 'object' | 'enum' #| primary = typeKeyw typeDescK #| / prefixOperator* identOrLiteral primarySuffix* - #| / 'addr' primary #| / 'static' primary #| / 'bind' primary if isOperator(p.tok): @@ -1045,7 +1041,7 @@ proc primary(p: var TParser, mode: TPrimaryMode): PNode = addSon(result, a) getTok(p) optInd(p, a) - if isSigil: + if isSigil: #XXX prefix operators let baseInd = p.lex.currLineIndent addSon(result, primary(p, pmSkipSuffix)) @@ -1053,13 +1049,8 @@ proc primary(p: var TParser, mode: TPrimaryMode): PNode = else: addSon(result, primary(p, pmNormal)) return - + case p.tok.tokType: - of tkVar: result = parseTypeDescKAux(p, nkVarTy, mode) - of tkRef: result = parseTypeDescKAux(p, nkRefTy, mode) - of tkPtr: result = parseTypeDescKAux(p, nkPtrTy, mode) - of tkDistinct: result = parseTypeDescKAux(p, nkDistinctTy, mode) - of tkType: result = parseTypeDescKAux(p, nkTypeOfExpr, mode) of tkTuple: result = parseTuple(p, mode == pmTypeDef) of tkProc: result = parseProcExpr(p, mode notin {pmTypeDesc, pmTypeDef}) of tkIterator: @@ -1088,15 +1079,15 @@ proc primary(p: var TParser, mode: TPrimaryMode): PNode = else: result = newNodeP(nkObjectTy, p) getTok(p) - of tkGeneric: + of tkGeneric, tkConcept: if mode == pmTypeDef: + let wasGeneric = p.tok.tokType == tkGeneric result = parseTypeClass(p) + # hack so that it's remembered and can be marked as deprecated in + # sem'check: + if wasGeneric: result.flags.incl nfBase2 else: parMessage(p, errInvalidToken, p.tok) - of tkAddr: - result = newNodeP(nkAddr, p) - getTokNoInd(p) - addSon(result, primary(p, pmNormal)) of tkStatic: let info = parLineInfo(p) getTokNoInd(p) @@ -1110,6 +1101,10 @@ proc primary(p: var TParser, mode: TPrimaryMode): PNode = getTok(p) optInd(p, result) addSon(result, primary(p, pmNormal)) + of tkVar: result = parseTypeDescKAux(p, nkVarTy, mode) + of tkRef: result = parseTypeDescKAux(p, nkRefTy, mode) + of tkPtr: result = parseTypeDescKAux(p, nkPtrTy, mode) + of tkDistinct: result = parseTypeDescKAux(p, nkDistinctTy, mode) else: let baseInd = p.lex.currLineIndent result = identOrLiteral(p, mode) @@ -1120,9 +1115,9 @@ proc parseTypeDesc(p: var TParser): PNode = #| typeDesc = simpleExpr result = simpleExpr(p, pmTypeDesc) -proc parseTypeDefAux(p: var TParser): PNode = +proc parseTypeDefAux(p: var TParser): PNode = #| typeDefAux = simpleExpr - #| | 'generic' typeClass + #| | 'concept' typeClass result = simpleExpr(p, pmTypeDef) proc makeCall(n: PNode): PNode = @@ -1134,7 +1129,7 @@ proc makeCall(n: PNode): PNode = result.add n proc parseMacroColon(p: var TParser, x: PNode): PNode = - #| macroColon = ':' stmt? ( IND{=} 'of' exprList ':' stmt + #| macroColon = ':' stmt? ( IND{=} 'of' exprList ':' stmt #| | IND{=} 'elif' expr ':' stmt #| | IND{=} 'except' exprList ':' stmt #| | IND{=} 'else' ':' stmt )* @@ -1143,45 +1138,48 @@ proc parseMacroColon(p: var TParser, x: PNode): PNode = result = makeCall(result) getTok(p) skipComment(p, result) + let stmtList = newNodeP(nkStmtList, p) if p.tok.tokType notin {tkOf, tkElif, tkElse, tkExcept}: let body = parseStmt(p) - addSon(result, makeStmtList(body)) + stmtList.add body + #addSon(result, makeStmtList(body)) while sameInd(p): var b: PNode case p.tok.tokType of tkOf: b = newNodeP(nkOfBranch, p) exprList(p, tkColon, b) - of tkElif: + of tkElif: b = newNodeP(nkElifBranch, p) getTok(p) optInd(p, b) addSon(b, parseExpr(p)) - eat(p, tkColon) - of tkExcept: + of tkExcept: b = newNodeP(nkExceptBranch, p) exprList(p, tkColon, b) - skipComment(p, b) - of tkElse: + of tkElse: b = newNodeP(nkElse, p) getTok(p) - eat(p, tkColon) - else: break + else: break + eat(p, tkColon) addSon(b, parseStmt(p)) - addSon(result, b) + addSon(stmtList, b) if b.kind == nkElse: break + if stmtList.len == 1 and stmtList[0].kind == nkStmtList: + # to keep backwards compatibility (see tests/vm/tstringnil) + result.add stmtList[0] + else: + result.add stmtList -proc parseExprStmt(p: var TParser): PNode = +proc parseExprStmt(p: var TParser): PNode = #| exprStmt = simpleExpr #| (( '=' optInd expr ) #| / ( expr ^+ comma #| doBlocks #| / macroColon #| ))? - inc p.inPragma var a = simpleExpr(p) - dec p.inPragma - if p.tok.tokType == tkEquals: + if p.tok.tokType == tkEquals: getTok(p) optInd(p, result) var b = parseExpr(p) @@ -1189,12 +1187,24 @@ proc parseExprStmt(p: var TParser): PNode = addSon(result, a) addSon(result, b) else: - if p.tok.indent < 0 and isExprStart(p): - result = newNode(nkCommand, a.info, @[a]) + # simpleExpr parsed 'p a' from 'p a, b'? + if p.tok.indent < 0 and p.tok.tokType == tkComma and a.kind == nkCommand: + result = a while true: + getTok(p) + optInd(p, result) var e = parseExpr(p) addSon(result, e) - if p.tok.tokType != tkComma: break + if p.tok.tokType != tkComma: break + elif p.tok.indent < 0 and isExprStart(p): + if a.kind == nkCommand: + result = a + else: + result = newNode(nkCommand, a.info, @[a]) + while true: + var e = parseExpr(p) + addSon(result, e) + if p.tok.tokType != tkComma: break getTok(p) optInd(p, result) else: @@ -1250,7 +1260,7 @@ proc parseIncludeStmt(p: var TParser): PNode = var a = parseExpr(p) if a.kind == nkEmpty: break addSon(result, a) - if p.tok.tokType != tkComma: break + if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) #expectNl(p) @@ -1269,12 +1279,12 @@ proc parseFromStmt(p: var TParser): PNode = a = parseExpr(p) if a.kind == nkEmpty: break addSon(result, a) - if p.tok.tokType != tkComma: break + if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) #expectNl(p) -proc parseReturnOrRaise(p: var TParser, kind: TNodeKind): PNode = +proc parseReturnOrRaise(p: var TParser, kind: TNodeKind): PNode = #| returnStmt = 'return' optInd expr? #| raiseStmt = 'raise' optInd expr? #| yieldStmt = 'yield' optInd expr? @@ -1304,8 +1314,7 @@ proc parseIfOrWhen(p: var TParser, kind: TNodeKind): PNode = var branch = newNodeP(nkElifBranch, p) optInd(p, branch) addSon(branch, parseExpr(p)) - eat(p, tkColon) - skipComment(p, branch) + colcom(p, branch) addSon(branch, parseStmt(p)) skipComment(p, branch) addSon(result, branch) @@ -1313,8 +1322,7 @@ proc parseIfOrWhen(p: var TParser, kind: TNodeKind): PNode = if p.tok.tokType == tkElse and sameOrNoInd(p): var branch = newNodeP(nkElse, p) eat(p, tkElse) - eat(p, tkColon) - skipComment(p, branch) + colcom(p, branch) addSon(branch, parseStmt(p)) addSon(result, branch) @@ -1344,12 +1352,12 @@ proc parseCase(p: var TParser): PNode = addSon(result, parseExpr(p)) if p.tok.tokType == tkColon: getTok(p) skipComment(p, result) - + let oldInd = p.currInd if realInd(p): p.currInd = p.tok.indent wasIndented = true - + while sameInd(p): case p.tok.tokType of tkOf: @@ -1362,20 +1370,18 @@ proc parseCase(p: var TParser): PNode = getTok(p) optInd(p, b) addSon(b, parseExpr(p)) - eat(p, tkColon) of tkElse: b = newNodeP(nkElse, p) getTok(p) - eat(p, tkColon) else: break - skipComment(p, b) + colcom(p, b) addSon(b, parseStmt(p)) addSon(result, b) if b.kind == nkElse: break - + if wasIndented: p.currInd = oldInd - + proc parseTry(p: var TParser; isExpr: bool): PNode = #| tryStmt = 'try' colcom stmt &(IND{=}? 'except'|'finally') #| (IND{=}? 'except' exprList colcom stmt)* @@ -1385,8 +1391,7 @@ proc parseTry(p: var TParser; isExpr: bool): PNode = #| (optInd 'finally' colcom stmt)? result = newNodeP(nkTryStmt, p) getTok(p) - eat(p, tkColon) - skipComment(p, result) + colcom(p, result) addSon(result, parseStmt(p)) var b: PNode = nil while sameOrNoInd(p) or isExpr: @@ -1396,19 +1401,18 @@ proc parseTry(p: var TParser; isExpr: bool): PNode = exprList(p, tkColon, b) of tkFinally: b = newNodeP(nkFinally, p) - getTokNoInd(p) - eat(p, tkColon) + getTok(p) else: break - skipComment(p, b) + colcom(p, b) addSon(b, parseStmt(p)) addSon(result, b) - if b.kind == nkFinally: break + if b.kind == nkFinally: break if b == nil: parMessage(p, errTokenExpected, "except") proc parseExceptBlock(p: var TParser, kind: TNodeKind): PNode = #| exceptBlock = 'except' colcom stmt result = newNodeP(kind, p) - getTokNoInd(p) + getTok(p) colcom(p, result) addSon(result, parseStmt(p)) @@ -1428,7 +1432,7 @@ proc parseFor(p: var TParser): PNode = colcom(p, result) addSon(result, parseStmt(p)) -proc parseBlock(p: var TParser): PNode = +proc parseBlock(p: var TParser): PNode = #| blockStmt = 'block' symbol? colcom stmt result = newNodeP(nkBlockStmt, p) getTokNoInd(p) @@ -1441,10 +1445,10 @@ proc parseStaticOrDefer(p: var TParser; k: TNodeKind): PNode = #| staticStmt = 'static' colcom stmt #| deferStmt = 'defer' colcom stmt result = newNodeP(k, p) - getTokNoInd(p) + getTok(p) colcom(p, result) addSon(result, parseStmt(p)) - + proc parseAsm(p: var TParser): PNode = #| asmStmt = 'asm' pragma? (STR_LIT | RSTR_LIT | TRIPLE_STR_LIT) result = newNodeP(nkAsmStmt, p) @@ -1454,51 +1458,51 @@ proc parseAsm(p: var TParser): PNode = case p.tok.tokType of tkStrLit: addSon(result, newStrNodeP(nkStrLit, p.tok.literal, p)) of tkRStrLit: addSon(result, newStrNodeP(nkRStrLit, p.tok.literal, p)) - of tkTripleStrLit: addSon(result, + of tkTripleStrLit: addSon(result, newStrNodeP(nkTripleStrLit, p.tok.literal, p)) - else: + else: parMessage(p, errStringLiteralExpected) addSon(result, ast.emptyNode) - return + return getTok(p) proc parseGenericParam(p: var TParser): PNode = #| genericParam = symbol (comma symbol)* (colon expr)? ('=' optInd expr)? var a: PNode result = newNodeP(nkIdentDefs, p) - while true: + while true: case p.tok.tokType - of tkSymbol, tkAccent: + of tkSymbol, tkAccent: a = parseSymbol(p) - if a.kind == nkEmpty: return - else: break + if a.kind == nkEmpty: return + else: break addSon(result, a) - if p.tok.tokType != tkComma: break + if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) - if p.tok.tokType == tkColon: + if p.tok.tokType == tkColon: getTok(p) optInd(p, result) addSon(result, parseExpr(p)) - else: + else: addSon(result, ast.emptyNode) - if p.tok.tokType == tkEquals: + if p.tok.tokType == tkEquals: getTok(p) optInd(p, result) addSon(result, parseExpr(p)) - else: + else: addSon(result, ast.emptyNode) -proc parseGenericParamList(p: var TParser): PNode = +proc parseGenericParamList(p: var TParser): PNode = #| genericParamList = '[' optInd #| genericParam ^* (comma/semicolon) optPar ']' result = newNodeP(nkGenericParams, p) getTok(p) optInd(p, result) - while p.tok.tokType in {tkSymbol, tkAccent}: + while p.tok.tokType in {tkSymbol, tkAccent}: var a = parseGenericParam(p) addSon(result, a) - if p.tok.tokType notin {tkComma, tkSemiColon}: break + if p.tok.tokType notin {tkComma, tkSemiColon}: break getTok(p) skipComment(p, a) optPar(p) @@ -1513,7 +1517,7 @@ proc parsePattern(p: var TParser): PNode = proc validInd(p: var TParser): bool = result = p.tok.indent < 0 or p.tok.indent > p.currInd -proc parseRoutine(p: var TParser, kind: TNodeKind): PNode = +proc parseRoutine(p: var TParser, kind: TNodeKind): PNode = #| indAndComment = (IND{>} COMMENT)? | COMMENT? #| routine = optInd identVis pattern? genericParamList? #| paramListColon pragma? ('=' COMMENT? stmt)? indAndComment @@ -1532,14 +1536,14 @@ proc parseRoutine(p: var TParser, kind: TNodeKind): PNode = else: addSon(result, ast.emptyNode) # empty exception tracking: addSon(result, ast.emptyNode) - if p.tok.tokType == tkEquals and p.validInd: + if p.tok.tokType == tkEquals and p.validInd: getTok(p) skipComment(p, result) addSon(result, parseStmt(p)) else: addSon(result, ast.emptyNode) indAndComment(p, result) - + proc newCommentStmt(p: var TParser): PNode = #| commentStmt = COMMENT result = newNodeP(nkCommentStmt, p) @@ -1560,39 +1564,39 @@ proc parseSection(p: var TParser, kind: TNodeKind, skipComment(p, result) while sameInd(p): case p.tok.tokType - of tkSymbol, tkAccent, tkParLe: + of tkSymbol, tkAccent, tkParLe: var a = defparser(p) skipComment(p, a) addSon(result, a) - of tkComment: + of tkComment: var a = newCommentStmt(p) addSon(result, a) - else: + else: parMessage(p, errIdentifierExpected, p.tok) break if result.len == 0: parMessage(p, errIdentifierExpected, p.tok) elif p.tok.tokType in {tkSymbol, tkAccent, tkParLe} and p.tok.indent < 0: # tkParLe is allowed for ``var (x, y) = ...`` tuple parsing addSon(result, defparser(p)) - else: + else: parMessage(p, errIdentifierExpected, p.tok) - + proc parseConstant(p: var TParser): PNode = #| constant = identWithPragma (colon typedesc)? '=' optInd expr indAndComment result = newNodeP(nkConstDef, p) addSon(result, identWithPragma(p)) - if p.tok.tokType == tkColon: + if p.tok.tokType == tkColon: getTok(p) optInd(p, result) addSon(result, parseTypeDesc(p)) - else: + else: addSon(result, ast.emptyNode) eat(p, tkEquals) optInd(p, result) addSon(result, parseExpr(p)) indAndComment(p, result) - -proc parseEnum(p: var TParser): PNode = + +proc parseEnum(p: var TParser): PNode = #| enum = 'enum' optInd (symbol optInd ('=' optInd expr COMMENT?)? comma?)+ result = newNodeP(nkEnumTy, p) getTok(p) @@ -1604,7 +1608,7 @@ proc parseEnum(p: var TParser): PNode = if p.tok.indent >= 0 and p.tok.indent <= p.currInd: add(result, a) break - if p.tok.tokType == tkEquals and p.tok.indent < 0: + if p.tok.tokType == tkEquals and p.tok.indent < 0: getTok(p) optInd(p, a) var b = a @@ -1625,12 +1629,12 @@ proc parseEnum(p: var TParser): PNode = lexMessage(p.lex, errIdentifierExpected, prettyTok(p.tok)) proc parseObjectPart(p: var TParser): PNode -proc parseObjectWhen(p: var TParser): PNode = +proc parseObjectWhen(p: var TParser): PNode = #| objectWhen = 'when' expr colcom objectPart COMMENT? #| ('elif' expr colcom objectPart COMMENT?)* #| ('else' colcom objectPart COMMENT?)? result = newNodeP(nkRecWhen, p) - while sameInd(p): + while sameInd(p): getTok(p) # skip `when`, `elif` var branch = newNodeP(nkElifBranch, p) optInd(p, branch) @@ -1648,7 +1652,7 @@ proc parseObjectWhen(p: var TParser): PNode = skipComment(p, branch) addSon(result, branch) -proc parseObjectCase(p: var TParser): PNode = +proc parseObjectCase(p: var TParser): PNode = #| objectBranch = 'of' exprList colcom objectPart #| objectBranches = objectBranch (IND{=} objectBranch)* #| (IND{=} 'elif' expr colcom objectPart)* @@ -1674,15 +1678,14 @@ proc parseObjectCase(p: var TParser): PNode = while sameInd(p): var b: PNode case p.tok.tokType - of tkOf: + of tkOf: b = newNodeP(nkOfBranch, p) exprList(p, tkColon, b) - of tkElse: + of tkElse: b = newNodeP(nkElse, p) getTok(p) - eat(p, tkColon) - else: break - skipComment(p, b) + else: break + colcom(p, b) var fields = parseObjectPart(p) if fields.kind == nkEmpty: parMessage(p, errIdentifierExpected, p.tok) @@ -1692,8 +1695,8 @@ proc parseObjectCase(p: var TParser): PNode = if b.kind == nkElse: break if wasIndented: p.currInd = oldInd - -proc parseObjectPart(p: var TParser): PNode = + +proc parseObjectPart(p: var TParser): PNode = #| objectPart = IND{>} objectPart^+IND{=} DED #| / objectWhen / objectCase / 'nil' / 'discard' / declColonEquals if realInd(p): @@ -1702,7 +1705,7 @@ proc parseObjectPart(p: var TParser): PNode = rawSkipComment(p, result) while sameInd(p): case p.tok.tokType - of tkCase, tkWhen, tkSymbol, tkAccent, tkNil, tkDiscard: + of tkCase, tkWhen, tkSymbol, tkAccent, tkNil, tkDiscard: addSon(result, parseObjectPart(p)) else: parMessage(p, errIdentifierExpected, p.tok) @@ -1721,8 +1724,8 @@ proc parseObjectPart(p: var TParser): PNode = getTok(p) else: result = ast.emptyNode - -proc parseObject(p: var TParser): PNode = + +proc parseObject(p: var TParser): PNode = #| object = 'object' pragma? ('of' typeDesc)? COMMENT? objectPart result = newNodeP(nkObjectTy, p) getTok(p) @@ -1735,7 +1738,7 @@ proc parseObject(p: var TParser): PNode = getTok(p) addSon(a, parseTypeDesc(p)) addSon(result, a) - else: + else: addSon(result, ast.emptyNode) if p.tok.tokType == tkComment: skipComment(p, result) @@ -1787,7 +1790,7 @@ proc parseTypeClass(p: var TParser): PNode = else: addSon(result, parseStmt(p)) -proc parseTypeDef(p: var TParser): PNode = +proc parseTypeDef(p: var TParser): PNode = #| typeDef = identWithPragma genericParamList? '=' optInd typeDefAux #| indAndComment? result = newNodeP(nkTypeDef, p) @@ -1803,16 +1806,16 @@ proc parseTypeDef(p: var TParser): PNode = else: addSon(result, ast.emptyNode) indAndComment(p, result) # special extension! - + proc parseVarTuple(p: var TParser): PNode = #| varTuple = '(' optInd identWithPragma ^+ comma optPar ')' '=' optInd expr result = newNodeP(nkVarTuple, p) getTok(p) # skip '(' optInd(p, result) - while p.tok.tokType in {tkSymbol, tkAccent}: + while p.tok.tokType in {tkSymbol, tkAccent}: var a = identWithPragma(p) addSon(result, a) - if p.tok.tokType != tkComma: break + if p.tok.tokType != tkComma: break getTok(p) skipComment(p, a) addSon(result, ast.emptyNode) # no type desc @@ -1827,7 +1830,7 @@ proc parseVariable(p: var TParser): PNode = if p.tok.tokType == tkParLe: result = parseVarTuple(p) else: result = parseIdentColonEquals(p, {withPragma}) indAndComment(p, result) - + proc parseBind(p: var TParser, k: TNodeKind): PNode = #| bindStmt = 'bind' optInd qualifiedIdent ^+ comma #| mixinStmt = 'mixin' optInd qualifiedIdent ^+ comma @@ -1841,7 +1844,7 @@ proc parseBind(p: var TParser, k: TNodeKind): PNode = getTok(p) optInd(p, a) #expectNl(p) - + proc parseStmtPragma(p: var TParser): PNode = #| pragmaStmt = pragma (':' COMMENT? stmt)? result = parsePragma(p) @@ -1853,7 +1856,7 @@ proc parseStmtPragma(p: var TParser): PNode = result.add a result.add parseStmt(p) -proc simpleStmt(p: var TParser): PNode = +proc simpleStmt(p: var TParser): PNode = #| simpleStmt = ((returnStmt | raiseStmt | yieldStmt | discardStmt | breakStmt #| | continueStmt | pragmaStmt | importStmt | exportStmt | fromStmt #| | includeStmt | commentStmt) / exprStmt) COMMENT? @@ -1875,7 +1878,7 @@ proc simpleStmt(p: var TParser): PNode = if isExprStart(p): result = parseExprStmt(p) else: result = ast.emptyNode if result.kind notin {nkEmpty, nkCommentStmt}: skipComment(p, result) - + proc complexOrSimpleStmt(p: var TParser): PNode = #| complexOrSimpleStmt = (ifStmt | whenStmt | whileStmt #| | tryStmt | finallyStmt | exceptStmt | forStmt @@ -1927,7 +1930,7 @@ proc complexOrSimpleStmt(p: var TParser): PNode = of tkMixin: result = parseBind(p, nkMixinStmt) of tkUsing: result = parseBind(p, nkUsingStmt) else: result = simpleStmt(p) - + proc parseStmt(p: var TParser): PNode = #| stmt = (IND{>} complexOrSimpleStmt^+(IND{=} / ';') DED) #| / simpleStmt ^+ ';' @@ -1976,14 +1979,14 @@ proc parseStmt(p: var TParser): PNode = result.add(a) if p.tok.tokType != tkSemiColon: break getTok(p) - + proc parseAll(p: var TParser): PNode = ## Parses the rest of the input stream held by the parser into a PNode. result = newNodeP(nkStmtList, p) - while p.tok.tokType != tkEof: + while p.tok.tokType != tkEof: var a = complexOrSimpleStmt(p) - if a.kind != nkEmpty: - addSon(result, a) + if a.kind != nkEmpty: + addSon(result, a) else: parMessage(p, errExprExpected, p.tok) # bugfix: consume a token here to prevent an endless loop: @@ -2025,8 +2028,8 @@ proc parseString*(s: string; filename: string = ""; line: int = 0; var parser: TParser # XXX for now the builtin 'parseStmt/Expr' functions do not know about strong # spaces... - openParser(parser, filename, stream, false) parser.lex.errorHandler = errorHandler + openParser(parser, filename, stream, false) result = parser.parseAll closeParser(parser) diff --git a/compiler/platform.nim b/compiler/platform.nim index a21e73248..4dd5d8836 100644 --- a/compiler/platform.nim +++ b/compiler/platform.nim @@ -13,192 +13,192 @@ # Nimrod has been tested on this platform or that the RTL has been ported. # Feel free to test for your excentric platform! -import +import strutils -type +type TSystemOS* = enum # Also add OS in initialization section and alias # conditionals to condsyms (end of module). - osNone, osDos, osWindows, osOs2, osLinux, osMorphos, osSkyos, osSolaris, - osIrix, osNetbsd, osFreebsd, osOpenbsd, osAix, osPalmos, osQnx, osAmiga, + osNone, osDos, osWindows, osOs2, osLinux, osMorphos, osSkyos, osSolaris, + osIrix, osNetbsd, osFreebsd, osOpenbsd, osAix, osPalmos, osQnx, osAmiga, osAtari, osNetware, osMacos, osMacosx, osHaiku, osVxworks, osJS, osNimrodVM, osStandalone -type - TInfoOSProp* = enum +type + TInfoOSProp* = enum ospNeedsPIC, # OS needs PIC for libraries ospCaseInsensitive, # OS filesystem is case insensitive ospPosix, # OS is posix-like ospLacksThreadVars # OS lacks proper __threadvar support TInfoOSProps* = set[TInfoOSProp] - TInfoOS* = tuple[name: string, parDir: string, dllFrmt: string, - altDirSep: string, objExt: string, newLine: string, - pathSep: string, dirSep: string, scriptExt: string, - curDir: string, exeExt: string, extSep: string, + TInfoOS* = tuple[name: string, parDir: string, dllFrmt: string, + altDirSep: string, objExt: string, newLine: string, + pathSep: string, dirSep: string, scriptExt: string, + curDir: string, exeExt: string, extSep: string, props: TInfoOSProps] -const +const OS*: array[succ(low(TSystemOS))..high(TSystemOS), TInfoOS] = [ - (name: "DOS", - parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", objExt: ".obj", - newLine: "\x0D\x0A", pathSep: ";", dirSep: "\\", scriptExt: ".bat", - curDir: ".", exeExt: ".exe", extSep: ".", props: {ospCaseInsensitive}), - (name: "Windows", parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", - objExt: ".obj", newLine: "\x0D\x0A", pathSep: ";", dirSep: "\\", - scriptExt: ".bat", curDir: ".", exeExt: ".exe", extSep: ".", - props: {ospCaseInsensitive}), - (name: "OS2", parDir: "..", - dllFrmt: "$1.dll", altDirSep: "/", - objExt: ".obj", newLine: "\x0D\x0A", - pathSep: ";", dirSep: "\\", - scriptExt: ".bat", curDir: ".", - exeExt: ".exe", extSep: ".", - props: {ospCaseInsensitive}), - (name: "Linux", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "MorphOS", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "SkyOS", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "Solaris", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "Irix", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "NetBSD", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "FreeBSD", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "OpenBSD", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "AIX", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "PalmOS", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", - props: {ospNeedsPIC}), - (name: "QNX", - parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", objExt: ".o", - newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", props: {ospNeedsPIC, ospPosix}), - (name: "Amiga", - parDir: "..", dllFrmt: "$1.library", altDirSep: "/", objExt: ".o", - newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", props: {ospNeedsPIC}), - (name: "Atari", - parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", objExt: ".o", - newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: "", curDir: ".", - exeExt: ".tpp", extSep: ".", props: {ospNeedsPIC}), - (name: "Netware", - parDir: "..", dllFrmt: "$1.nlm", altDirSep: "/", objExt: "", - newLine: "\x0D\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", - curDir: ".", exeExt: ".nlm", extSep: ".", props: {ospCaseInsensitive}), - (name: "MacOS", parDir: "::", dllFrmt: "$1Lib", altDirSep: ":", - objExt: ".o", newLine: "\x0D", pathSep: ",", dirSep: ":", scriptExt: "", - curDir: ":", exeExt: "", extSep: ".", props: {ospCaseInsensitive}), - (name: "MacOSX", parDir: "..", dllFrmt: "lib$1.dylib", altDirSep: ":", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix, ospLacksThreadVars}), - (name: "Haiku", parDir: "..", dllFrmt: "lib$1.so", altDirSep: ":", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + (name: "DOS", + parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", objExt: ".obj", + newLine: "\x0D\x0A", pathSep: ";", dirSep: "\\", scriptExt: ".bat", + curDir: ".", exeExt: ".exe", extSep: ".", props: {ospCaseInsensitive}), + (name: "Windows", parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", + objExt: ".obj", newLine: "\x0D\x0A", pathSep: ";", dirSep: "\\", + scriptExt: ".bat", curDir: ".", exeExt: ".exe", extSep: ".", + props: {ospCaseInsensitive}), + (name: "OS2", parDir: "..", + dllFrmt: "$1.dll", altDirSep: "/", + objExt: ".obj", newLine: "\x0D\x0A", + pathSep: ";", dirSep: "\\", + scriptExt: ".bat", curDir: ".", + exeExt: ".exe", extSep: ".", + props: {ospCaseInsensitive}), + (name: "Linux", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "MorphOS", parDir: "..", + dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", + pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "SkyOS", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "Solaris", parDir: "..", + dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", + pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "Irix", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "NetBSD", parDir: "..", + dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", + pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "FreeBSD", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "OpenBSD", parDir: "..", + dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", + pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "AIX", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "PalmOS", parDir: "..", + dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", + pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", + props: {ospNeedsPIC}), + (name: "QNX", + parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", objExt: ".o", + newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", props: {ospNeedsPIC, ospPosix}), + (name: "Amiga", + parDir: "..", dllFrmt: "$1.library", altDirSep: "/", objExt: ".o", + newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", props: {ospNeedsPIC}), + (name: "Atari", + parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", objExt: ".o", + newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: "", curDir: ".", + exeExt: ".tpp", extSep: ".", props: {ospNeedsPIC}), + (name: "Netware", + parDir: "..", dllFrmt: "$1.nlm", altDirSep: "/", objExt: "", + newLine: "\x0D\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", + curDir: ".", exeExt: ".nlm", extSep: ".", props: {ospCaseInsensitive}), + (name: "MacOS", parDir: "::", dllFrmt: "$1Lib", altDirSep: ":", + objExt: ".o", newLine: "\x0D", pathSep: ",", dirSep: ":", scriptExt: "", + curDir: ":", exeExt: "", extSep: ".", props: {ospCaseInsensitive}), + (name: "MacOSX", parDir: "..", dllFrmt: "lib$1.dylib", altDirSep: ":", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix, ospLacksThreadVars}), + (name: "Haiku", parDir: "..", dllFrmt: "lib$1.so", altDirSep: ":", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", props: {ospNeedsPIC, ospPosix, ospLacksThreadVars}), (name: "VxWorks", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", objExt: ".o", newLine: "\x0A", pathSep: ";", dirSep: "\\", scriptExt: ".sh", curDir: ".", exeExt: ".vxe", extSep: ".", props: {ospNeedsPIC, ospPosix, ospLacksThreadVars}), - (name: "JS", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", props: {}), - (name: "NimrodVM", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + (name: "JS", parDir: "..", + dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", + pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", props: {}), + (name: "NimrodVM", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", props: {}), (name: "Standalone", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", props: {})] -type - TSystemCPU* = enum # Also add CPU for in initialization section and +type + TSystemCPU* = enum # Also add CPU for in initialization section and # alias conditionals to condsyms (end of module). cpuNone, cpuI386, cpuM68k, cpuAlpha, cpuPowerpc, cpuPowerpc64, - cpuSparc, cpuVm, cpuIa64, cpuAmd64, cpuMips, cpuArm, + cpuSparc, cpuVm, cpuIa64, cpuAmd64, cpuMips, cpuArm, cpuJS, cpuNimrodVM, cpuAVR -type - TEndian* = enum +type + TEndian* = enum littleEndian, bigEndian - TInfoCPU* = tuple[name: string, intSize: int, endian: TEndian, + TInfoCPU* = tuple[name: string, intSize: int, endian: TEndian, floatSize, bit: int] const EndianToStr*: array[TEndian, string] = ["littleEndian", "bigEndian"] CPU*: array[succ(low(TSystemCPU))..high(TSystemCPU), TInfoCPU] = [ - (name: "i386", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), - (name: "m68k", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), - (name: "alpha", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), + (name: "i386", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), + (name: "m68k", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), + (name: "alpha", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), (name: "powerpc", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), - (name: "powerpc64", intSize: 64, endian: bigEndian, floatSize: 64,bit: 64), - (name: "sparc", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), - (name: "vm", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), - (name: "ia64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), - (name: "amd64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), - (name: "mips", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), - (name: "arm", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), - (name: "js", intSize: 32, endian: bigEndian,floatSize: 64,bit: 32), + (name: "powerpc64", intSize: 64, endian: bigEndian, floatSize: 64,bit: 64), + (name: "sparc", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), + (name: "vm", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), + (name: "ia64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), + (name: "amd64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), + (name: "mips", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), + (name: "arm", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), + (name: "js", intSize: 32, endian: bigEndian,floatSize: 64,bit: 32), (name: "nimrodvm", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), (name: "avr", intSize: 16, endian: littleEndian, floatSize: 32, bit: 16)] -var +var targetCPU*, hostCPU*: TSystemCPU targetOS*, hostOS*: TSystemOS proc nameToOS*(name: string): TSystemOS proc nameToCPU*(name: string): TSystemCPU -var +var intSize*: int floatSize*: int ptrSize*: int tnl*: string # target newline -proc setTarget*(o: TSystemOS, c: TSystemCPU) = +proc setTarget*(o: TSystemOS, c: TSystemCPU) = assert(c != cpuNone) assert(o != osNone) #echo "new Target: OS: ", o, " CPU: ", c @@ -209,15 +209,15 @@ proc setTarget*(o: TSystemOS, c: TSystemCPU) = ptrSize = CPU[c].bit div 8 tnl = OS[o].newLine -proc nameToOS(name: string): TSystemOS = - for i in countup(succ(osNone), high(TSystemOS)): - if cmpIgnoreStyle(name, OS[i].name) == 0: +proc nameToOS(name: string): TSystemOS = + for i in countup(succ(osNone), high(TSystemOS)): + if cmpIgnoreStyle(name, OS[i].name) == 0: return i result = osNone -proc nameToCPU(name: string): TSystemCPU = - for i in countup(succ(cpuNone), high(TSystemCPU)): - if cmpIgnoreStyle(name, CPU[i].name) == 0: +proc nameToCPU(name: string): TSystemCPU = + for i in countup(succ(cpuNone), high(TSystemCPU)): + if cmpIgnoreStyle(name, CPU[i].name) == 0: return i result = cpuNone diff --git a/compiler/plugins.nim b/compiler/plugins.nim new file mode 100644 index 000000000..1c9b7b77b --- /dev/null +++ b/compiler/plugins.nim @@ -0,0 +1,43 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Plugin support for the Nim compiler. Right now there are no plugins and they +## need to be build with the compiler, no DLL support. + +import ast, semdata, idents + +type + Transformation* = proc (c: PContext; n: PNode): PNode {.nimcall.} + Plugin = ref object + fn, module, package: PIdent + t: Transformation + next: Plugin + +proc pluginMatches(p: Plugin; s: PSym): bool = + if s.name.id != p.fn.id: return false + let module = s.owner + if module == nil or module.kind != skModule or + module.name.id != p.module.id: return false + let package = module.owner + if package == nil or package.kind != skPackage or + package.name.id != p.package.id: return false + return true + +var head: Plugin + +proc getPlugin*(fn: PSym): Transformation = + var it = head + while it != nil: + if pluginMatches(it, fn): return it.t + it = it.next + +proc registerPlugin*(package, module, fn: string; t: Transformation) = + let oldHead = head + head = Plugin(fn: getIdent(fn), module: getIdent(module), + package: getIdent(package), t: t, next: oldHead) diff --git a/compiler/pragmas.nim b/compiler/pragmas.nim index 78ee490e2..c048d78e9 100644 --- a/compiler/pragmas.nim +++ b/compiler/pragmas.nim @@ -9,23 +9,23 @@ # This module implements semantic checking for pragmas -import - os, platform, condsyms, ast, astalgo, idents, semdata, msgs, renderer, +import + os, platform, condsyms, ast, astalgo, idents, semdata, msgs, renderer, wordrecg, ropes, options, strutils, lists, extccomp, math, magicsys, trees, rodread, types, lookups -const +const FirstCallConv* = wNimcall LastCallConv* = wNoconv const - procPragmas* = {FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, - wMagic, wNosideeffect, wSideeffect, wNoreturn, wDynlib, wHeader, - wCompilerproc, wProcVar, wDeprecated, wVarargs, wCompileTime, wMerge, + procPragmas* = {FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, + wMagic, wNosideeffect, wSideeffect, wNoreturn, wDynlib, wHeader, + wCompilerproc, wProcVar, wDeprecated, wVarargs, wCompileTime, wMerge, wBorrow, wExtern, wImportCompilerProc, wThread, wImportCpp, wImportObjC, wAsmNoStackFrame, wError, wDiscardable, wNoInit, wDestructor, wCodegenDecl, wGensym, wInject, wRaises, wTags, wLocks, wDelegator, wGcSafe, - wOverride} + wOverride, wConstructor} converterPragmas* = procPragmas methodPragmas* = procPragmas templatePragmas* = {wImmediate, wDeprecated, wError, wGensym, wInject, wDirty, @@ -33,7 +33,7 @@ const macroPragmas* = {FirstCallConv..LastCallConv, wImmediate, wImportc, wExportc, wNodecl, wMagic, wNosideeffect, wCompilerproc, wDeprecated, wExtern, wImportCpp, wImportObjC, wError, wDiscardable, wGensym, wInject, wDelegator} - iteratorPragmas* = {FirstCallConv..LastCallConv, wNosideeffect, wSideeffect, + iteratorPragmas* = {FirstCallConv..LastCallConv, wNosideeffect, wSideeffect, wImportc, wExportc, wNodecl, wMagic, wDeprecated, wBorrow, wExtern, wImportCpp, wImportObjC, wError, wDiscardable, wGensym, wInject, wRaises, wTags, wLocks, wGcSafe} @@ -46,21 +46,21 @@ const wFloatchecks, wInfChecks, wNanChecks, wPragma, wEmit, wUnroll, wLinearScanEnd, wPatterns, wEffects, wNoForward, wComputedGoto, wInjectStmt, wDeprecated, wExperimental} - lambdaPragmas* = {FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, - wNosideeffect, wSideeffect, wNoreturn, wDynlib, wHeader, + lambdaPragmas* = {FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, + wNosideeffect, wSideeffect, wNoreturn, wDynlib, wHeader, wDeprecated, wExtern, wThread, wImportCpp, wImportObjC, wAsmNoStackFrame, wRaises, wLocks, wTags, wGcSafe} - typePragmas* = {wImportc, wExportc, wDeprecated, wMagic, wAcyclic, wNodecl, + typePragmas* = {wImportc, wExportc, wDeprecated, wMagic, wAcyclic, wNodecl, wPure, wHeader, wCompilerproc, wFinal, wSize, wExtern, wShallow, wImportCpp, wImportObjC, wError, wIncompleteStruct, wByCopy, wByRef, wInheritable, wGensym, wInject, wRequiresInit, wUnchecked, wUnion, wPacked, wBorrow, wGcSafe} - fieldPragmas* = {wImportc, wExportc, wDeprecated, wExtern, + fieldPragmas* = {wImportc, wExportc, wDeprecated, wExtern, wImportCpp, wImportObjC, wError, wGuard} - varPragmas* = {wImportc, wExportc, wVolatile, wRegister, wThreadVar, wNodecl, + varPragmas* = {wImportc, wExportc, wVolatile, wRegister, wThreadVar, wNodecl, wMagic, wHeader, wDeprecated, wCompilerproc, wDynlib, wExtern, wImportCpp, wImportObjC, wError, wNoInit, wCompileTime, wGlobal, - wGensym, wInject, wCodegenDecl, wGuard} + wGensym, wInject, wCodegenDecl, wGuard, wGoto} constPragmas* = {wImportc, wExportc, wHeader, wDeprecated, wMagic, wNodecl, wExtern, wImportCpp, wImportObjC, wError, wGensym, wInject} letPragmas* = varPragmas @@ -74,27 +74,27 @@ proc pragma*(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) proc invalidPragma(n: PNode) = localError(n.info, errInvalidPragmaX, renderTree(n, {renderNoComments})) -proc pragmaAsm*(c: PContext, n: PNode): char = +proc pragmaAsm*(c: PContext, n: PNode): char = result = '\0' - if n != nil: - for i in countup(0, sonsLen(n) - 1): + if n != nil: + for i in countup(0, sonsLen(n) - 1): let it = n.sons[i] if it.kind == nkExprColonExpr and it.sons[0].kind == nkIdent: case whichKeyword(it.sons[0].ident) - of wSubsChar: + of wSubsChar: if it.sons[1].kind == nkCharLit: result = chr(int(it.sons[1].intVal)) else: invalidPragma(it) else: invalidPragma(it) - else: + else: invalidPragma(it) proc setExternName(s: PSym, extname: string) = - s.loc.r = toRope(extname % s.name.s) + s.loc.r = rope(extname % s.name.s) if gCmd == cmdPretty and '$' notin extname: # note that '{.importc.}' is transformed into '{.importc: "$1".}' s.loc.flags.incl(lfFullExternalName) -proc makeExternImport(s: PSym, extname: string) = +proc makeExternImport(s: PSym, extname: string) = setExternName(s, extname) incl(s.flags, sfImportc) excl(s.flags, sfForward) @@ -105,7 +105,7 @@ proc validateExternCName(s: PSym, info: TLineInfo) = ## Valid identifiers are those alphanumeric including the underscore not ## starting with a number. If the check fails, a generic error will be ## displayed to the user. - let target = ropeToStr(s.loc.r) + let target = $s.loc.r if target.len < 1 or target[0] notin IdentStartChars or not target.allCharsInSet(IdentChars): localError(info, errGenerated, "invalid exported symbol") @@ -145,7 +145,7 @@ proc newEmptyStrNode(n: PNode): PNode {.noinline.} = result.strVal = "" proc getStrLitNode(c: PContext, n: PNode): PNode = - if n.kind != nkExprColonExpr: + if n.kind != nkExprColonExpr: localError(n.info, errStringLiteralExpected) # error correction: result = newEmptyStrNode(n) @@ -153,62 +153,62 @@ proc getStrLitNode(c: PContext, n: PNode): PNode = n.sons[1] = c.semConstExpr(c, n.sons[1]) case n.sons[1].kind of nkStrLit, nkRStrLit, nkTripleStrLit: result = n.sons[1] - else: + else: localError(n.info, errStringLiteralExpected) # error correction: result = newEmptyStrNode(n) -proc expectStrLit(c: PContext, n: PNode): string = +proc expectStrLit(c: PContext, n: PNode): string = result = getStrLitNode(c, n).strVal -proc expectIntLit(c: PContext, n: PNode): int = - if n.kind != nkExprColonExpr: +proc expectIntLit(c: PContext, n: PNode): int = + if n.kind != nkExprColonExpr: localError(n.info, errIntLiteralExpected) - else: + else: n.sons[1] = c.semConstExpr(c, n.sons[1]) case n.sons[1].kind of nkIntLit..nkInt64Lit: result = int(n.sons[1].intVal) else: localError(n.info, errIntLiteralExpected) -proc getOptionalStr(c: PContext, n: PNode, defaultStr: string): string = +proc getOptionalStr(c: PContext, n: PNode, defaultStr: string): string = if n.kind == nkExprColonExpr: result = expectStrLit(c, n) else: result = defaultStr proc processCodegenDecl(c: PContext, n: PNode, sym: PSym) = sym.constraint = getStrLitNode(c, n) -proc processMagic(c: PContext, n: PNode, s: PSym) = +proc processMagic(c: PContext, n: PNode, s: PSym) = #if sfSystemModule notin c.module.flags: # liMessage(n.info, errMagicOnlyInSystem) - if n.kind != nkExprColonExpr: + if n.kind != nkExprColonExpr: localError(n.info, errStringLiteralExpected) return var v: string if n.sons[1].kind == nkIdent: v = n.sons[1].ident.s else: v = expectStrLit(c, n) - for m in countup(low(TMagic), high(TMagic)): - if substr($m, 1) == v: + for m in countup(low(TMagic), high(TMagic)): + if substr($m, 1) == v: s.magic = m break if s.magic == mNone: message(n.info, warnUnknownMagic, v) -proc wordToCallConv(sw: TSpecialWord): TCallingConvention = +proc wordToCallConv(sw: TSpecialWord): TCallingConvention = # this assumes that the order of special words and calling conventions is # the same result = TCallingConvention(ord(ccDefault) + ord(sw) - ord(wNimcall)) -proc isTurnedOn(c: PContext, n: PNode): bool = +proc isTurnedOn(c: PContext, n: PNode): bool = if n.kind == nkExprColonExpr: let x = c.semConstBoolExpr(c, n.sons[1]) n.sons[1] = x if x.kind == nkIntLit: return x.intVal != 0 localError(n.info, errOnOrOffExpected) -proc onOff(c: PContext, n: PNode, op: TOptions) = +proc onOff(c: PContext, n: PNode, op: TOptions) = if isTurnedOn(c, n): gOptions = gOptions + op else: gOptions = gOptions - op - -proc pragmaDeadCodeElim(c: PContext, n: PNode) = + +proc pragmaDeadCodeElim(c: PContext, n: PNode) = if isTurnedOn(c, n): incl(c.module.flags, sfDeadCodeElim) else: excl(c.module.flags, sfDeadCodeElim) @@ -216,20 +216,20 @@ proc pragmaNoForward(c: PContext, n: PNode) = if isTurnedOn(c, n): incl(c.module.flags, sfNoForward) else: excl(c.module.flags, sfNoForward) -proc processCallConv(c: PContext, n: PNode) = - if (n.kind == nkExprColonExpr) and (n.sons[1].kind == nkIdent): +proc processCallConv(c: PContext, n: PNode) = + if (n.kind == nkExprColonExpr) and (n.sons[1].kind == nkIdent): var sw = whichKeyword(n.sons[1].ident) case sw - of FirstCallConv..LastCallConv: + of FirstCallConv..LastCallConv: POptionEntry(c.optionStack.tail).defaultCC = wordToCallConv(sw) else: localError(n.info, errCallConvExpected) - else: + else: localError(n.info, errCallConvExpected) - -proc getLib(c: PContext, kind: TLibKind, path: PNode): PLib = + +proc getLib(c: PContext, kind: TLibKind, path: PNode): PLib = var it = PLib(c.libs.head) - while it != nil: - if it.kind == kind: + while it != nil: + if it.kind == kind: if trees.exprStructuralEquivalent(it.path, path): return it it = PLib(it.next) result = newLib(kind) @@ -252,10 +252,10 @@ proc expectDynlibNode(c: PContext, n: PNode): PNode = if result.typ == nil or result.typ.kind notin {tyPointer, tyString, tyProc}: localError(n.info, errStringLiteralExpected) result = newEmptyStrNode(n) - -proc processDynLib(c: PContext, n: PNode, sym: PSym) = + +proc processDynLib(c: PContext, n: PNode, sym: PSym) = if (sym == nil) or (sym.kind == skModule): - POptionEntry(c.optionStack.tail).dynlib = getLib(c, libDynamic, + POptionEntry(c.optionStack.tail).dynlib = getLib(c, libDynamic, expectDynlibNode(c, n)) else: if n.kind == nkExprColonExpr: @@ -268,7 +268,7 @@ proc processDynLib(c: PContext, n: PNode, sym: PSym) = # since we'll be loading the dynlib symbols dynamically, we must use # a calling convention that doesn't introduce custom name mangling # cdecl is the default - the user can override this explicitly - if sym.kind in routineKinds and sym.typ != nil and + if sym.kind in routineKinds and sym.typ != nil and sym.typ.callConv == ccDefault: sym.typ.callConv = ccCDecl @@ -295,10 +295,10 @@ proc processNote(c: PContext, n: PNode) = n.sons[1] = x if x.kind == nkIntLit and x.intVal != 0: incl(gNotes, nk) else: excl(gNotes, nk) - else: + else: invalidPragma(n) - -proc processOption(c: PContext, n: PNode): bool = + +proc processOption(c: PContext, n: PNode): bool = if n.kind != nkExprColonExpr: result = true elif n.sons[0].kind == nkBracketExpr: processNote(c, n) elif n.sons[0].kind != nkIdent: result = true @@ -318,34 +318,34 @@ proc processOption(c: PContext, n: PNode): bool = of wAssertions: onOff(c, n, {optAssert}) of wWarnings: onOff(c, n, {optWarns}) of wHints: onOff(c, n, {optHints}) - of wCallconv: processCallConv(c, n) + of wCallconv: processCallConv(c, n) of wLinedir: onOff(c, n, {optLineDir}) of wStacktrace: onOff(c, n, {optStackTrace}) of wLinetrace: onOff(c, n, {optLineTrace}) of wDebugger: onOff(c, n, {optEndb}) of wProfiler: onOff(c, n, {optProfiler}) of wByRef: onOff(c, n, {optByRef}) - of wDynlib: processDynLib(c, n, nil) - of wOptimization: - if n.sons[1].kind != nkIdent: + of wDynlib: processDynLib(c, n, nil) + of wOptimization: + if n.sons[1].kind != nkIdent: invalidPragma(n) - else: + else: case n.sons[1].ident.s.normalize - of "speed": + of "speed": incl(gOptions, optOptimizeSpeed) excl(gOptions, optOptimizeSize) of "size": excl(gOptions, optOptimizeSpeed) incl(gOptions, optOptimizeSize) - of "none": + of "none": excl(gOptions, optOptimizeSpeed) excl(gOptions, optOptimizeSize) else: localError(n.info, errNoneSpeedOrSizeExpected) of wImplicitStatic: onOff(c, n, {optImplicitStatic}) of wPatterns: onOff(c, n, {optPatterns}) else: result = true - -proc processPush(c: PContext, n: PNode, start: int) = + +proc processPush(c: PContext, n: PNode, start: int) = if n.sons[start-1].kind == nkExprColonExpr: localError(n.info, errGenerated, "':' after 'push' not supported") var x = newOptionEntry() @@ -355,41 +355,41 @@ proc processPush(c: PContext, n: PNode, start: int) = x.dynlib = y.dynlib x.notes = gNotes append(c.optionStack, x) - for i in countup(start, sonsLen(n) - 1): + for i in countup(start, sonsLen(n) - 1): if processOption(c, n.sons[i]): # simply store it somewhere: if x.otherPragmas.isNil: x.otherPragmas = newNodeI(nkPragma, n.info) x.otherPragmas.add n.sons[i] #localError(n.info, errOptionExpected) - -proc processPop(c: PContext, n: PNode) = - if c.optionStack.counter <= 1: + +proc processPop(c: PContext, n: PNode) = + if c.optionStack.counter <= 1: localError(n.info, errAtPopWithoutPush) - else: - gOptions = POptionEntry(c.optionStack.tail).options + else: + gOptions = POptionEntry(c.optionStack.tail).options gNotes = POptionEntry(c.optionStack.tail).notes remove(c.optionStack, c.optionStack.tail) -proc processDefine(c: PContext, n: PNode) = - if (n.kind == nkExprColonExpr) and (n.sons[1].kind == nkIdent): +proc processDefine(c: PContext, n: PNode) = + if (n.kind == nkExprColonExpr) and (n.sons[1].kind == nkIdent): defineSymbol(n.sons[1].ident.s) message(n.info, warnDeprecated, "define") - else: + else: invalidPragma(n) - -proc processUndef(c: PContext, n: PNode) = - if (n.kind == nkExprColonExpr) and (n.sons[1].kind == nkIdent): + +proc processUndef(c: PContext, n: PNode) = + if (n.kind == nkExprColonExpr) and (n.sons[1].kind == nkIdent): undefSymbol(n.sons[1].ident.s) message(n.info, warnDeprecated, "undef") - else: + else: invalidPragma(n) - -type - TLinkFeature = enum + +type + TLinkFeature = enum linkNormal, linkSys -proc processCompile(c: PContext, n: PNode) = +proc processCompile(c: PContext, n: PNode) = var s = expectStrLit(c, n) var found = findFile(s) if found == "": found = s @@ -397,7 +397,7 @@ proc processCompile(c: PContext, n: PNode) = extccomp.addExternalFileToCompile(found) extccomp.addFileToLink(completeCFilePath(trunc, false)) -proc processCommonLink(c: PContext, n: PNode, feature: TLinkFeature) = +proc processCommonLink(c: PContext, n: PNode, feature: TLinkFeature) = var f = expectStrLit(c, n) if splitFile(f).ext == "": f = addFileExt(f, CC[cCompiler].objExt) var found = findFile(f) @@ -407,8 +407,8 @@ proc processCommonLink(c: PContext, n: PNode, feature: TLinkFeature) = of linkSys: extccomp.addFileToLink(libpath / completeCFilePath(found, false)) else: internalError(n.info, "processCommonLink") - -proc pragmaBreakpoint(c: PContext, n: PNode) = + +proc pragmaBreakpoint(c: PContext, n: PNode) = discard getOptionalStr(c, n, "") proc pragmaWatchpoint(c: PContext, n: PNode) = @@ -427,59 +427,59 @@ proc semAsmOrEmit*(con: PContext, n: PNode, marker: char): PNode = return # now parse the string literal and substitute symbols: var a = 0 - while true: + while true: var b = strutils.find(str, marker, a) var sub = if b < 0: substr(str, a) else: substr(str, a, b - 1) if sub != "": addSon(result, newStrNode(nkStrLit, sub)) - if b < 0: break + if b < 0: break var c = strutils.find(str, marker, b + 1) if c < 0: sub = substr(str, b + 1) else: sub = substr(str, b + 1, c - 1) - if sub != "": + if sub != "": var e = searchInScopes(con, getIdent(sub)) - if e != nil: + if e != nil: if e.kind == skStub: loadStub(e) addSon(result, newSymNode(e)) - else: + else: addSon(result, newStrNode(nkStrLit, sub)) else: # an empty '``' produces a single '`' addSon(result, newStrNode(nkStrLit, $marker)) - if c < 0: break + if c < 0: break a = c + 1 else: illFormedAstLocal(n) result = newNode(nkAsmStmt, n.info) - -proc pragmaEmit(c: PContext, n: PNode) = + +proc pragmaEmit(c: PContext, n: PNode) = discard getStrLitNode(c, n) n.sons[1] = semAsmOrEmit(c, n, '`') -proc noVal(n: PNode) = +proc noVal(n: PNode) = if n.kind == nkExprColonExpr: invalidPragma(n) -proc pragmaUnroll(c: PContext, n: PNode) = - if c.p.nestedLoopCounter <= 0: +proc pragmaUnroll(c: PContext, n: PNode) = + if c.p.nestedLoopCounter <= 0: invalidPragma(n) elif n.kind == nkExprColonExpr: var unrollFactor = expectIntLit(c, n) - if unrollFactor <% 32: + if unrollFactor <% 32: n.sons[1] = newIntNode(nkIntLit, unrollFactor) - else: + else: invalidPragma(n) proc pragmaLine(c: PContext, n: PNode) = if n.kind == nkExprColonExpr: n.sons[1] = c.semConstExpr(c, n.sons[1]) let a = n.sons[1] - if a.kind == nkPar: + if a.kind == nkPar: var x = a.sons[0] var y = a.sons[1] if x.kind == nkExprColonExpr: x = x.sons[1] if y.kind == nkExprColonExpr: y = y.sons[1] - if x.kind != nkStrLit: + if x.kind != nkStrLit: localError(n.info, errStringLiteralExpected) - elif y.kind != nkIntLit: + elif y.kind != nkIntLit: localError(n.info, errIntLiteralExpected) else: n.info.fileIndex = msgs.fileInfoIdx(x.strVal) @@ -490,12 +490,12 @@ proc pragmaLine(c: PContext, n: PNode) = # sensible default: n.info = getInfoContext(-1) -proc processPragma(c: PContext, n: PNode, i: int) = +proc processPragma(c: PContext, n: PNode, i: int) = var it = n.sons[i] if it.kind != nkExprColonExpr: invalidPragma(n) elif it.sons[0].kind != nkIdent: invalidPragma(n) elif it.sons[1].kind != nkIdent: invalidPragma(n) - + var userPragma = newSym(skTemplate, it.sons[1].ident, nil, it.info) var body = newNodeI(nkPragma, n.info) for j in i+1 .. sonsLen(n)-1: addSon(body, n.sons[j]) @@ -508,7 +508,7 @@ proc pragmaRaisesOrTags(c: PContext, n: PNode) = if t.kind != tyObject: localError(x.info, errGenerated, "invalid type for raises/tags list") x.typ = t - + if n.kind == nkExprColonExpr: let it = n.sons[1] if it.kind notin {nkCurly, nkBracket}: @@ -569,7 +569,7 @@ proc deprecatedStmt(c: PContext; pragma: PNode) = localError(n.info, "key:value pair expected") proc pragmaGuard(c: PContext; it: PNode; kind: TSymKind): PSym = - if it.kind != nkExprColonExpr: + if it.kind != nkExprColonExpr: invalidPragma(it); return let n = it[1] if n.kind == nkSym: @@ -592,9 +592,9 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, var key = if it.kind == nkExprColonExpr: it.sons[0] else: it if key.kind == nkIdent: var userPragma = strTableGet(c.userPragmas, key.ident) - if userPragma != nil: + if userPragma != nil: inc c.instCounter - if c.instCounter > 100: + if c.instCounter > 100: globalError(it.info, errRecursiveDependencyX, userPragma.name.s) pragma(c, sym, userPragma.ast, validPragmas) # ensure the pragma is also remember for generic instantiations in other @@ -603,9 +603,9 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, dec c.instCounter else: var k = whichKeyword(key.ident) - if k in validPragmas: + if k in validPragmas: case k - of wExportc: + of wExportc: makeExternExport(sym, getOptionalStr(c, it, "$1"), it.info) incl(sym.flags, sfUsed) # avoid wrong hints of wImportc: makeExternImport(sym, getOptionalStr(c, it, "$1")) @@ -627,16 +627,16 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, var align = expectIntLit(c, it) if (not isPowerOfTwo(align) and align != 0) or align >% high(int16): localError(it.info, errPowerOfTwoExpected) - else: + else: sym.typ.align = align.int16 of wSize: if sym.typ == nil: invalidPragma(it) var size = expectIntLit(c, it) - if not isPowerOfTwo(size) or size <= 0 or size > 8: + if not isPowerOfTwo(size) or size <= 0 or size > 8: localError(it.info, errPowerOfTwoExpected) else: sym.typ.size = size - of wNodecl: + of wNodecl: noVal(it) incl(sym.loc.flags, lfNoDecl) of wPure, wAsmNoStackFrame: @@ -644,19 +644,19 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, if sym != nil: if k == wPure and sym.kind in routineKinds: invalidPragma(it) else: incl(sym.flags, sfPure) - of wVolatile: + of wVolatile: noVal(it) incl(sym.flags, sfVolatile) - of wRegister: + of wRegister: noVal(it) incl(sym.flags, sfRegister) - of wThreadVar: + of wThreadVar: noVal(it) incl(sym.flags, sfThread) of wDeadCodeElim: pragmaDeadCodeElim(c, it) of wNoForward: pragmaNoForward(c, it) of wMagic: processMagic(c, it, sym) - of wCompileTime: + of wCompileTime: noVal(it) incl(sym.flags, sfCompileTime) incl(sym.loc.flags, lfNoDecl) @@ -664,17 +664,20 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, noVal(it) incl(sym.flags, sfGlobal) incl(sym.flags, sfPure) - of wMerge: + of wMerge: + # only supported for backwards compat, doesn't do anything anymore + noVal(it) + of wConstructor: noVal(it) - incl(sym.flags, sfMerge) - of wHeader: + incl(sym.flags, sfConstructor) + of wHeader: var lib = getLib(c, libHeader, getStrLitNode(c, it)) addToLib(lib, sym) incl(sym.flags, sfImportc) incl(sym.loc.flags, lfHeader) - incl(sym.loc.flags, lfNoDecl) + incl(sym.loc.flags, lfNoDecl) # implies nodecl, because otherwise header would not make sense - if sym.loc.r == nil: sym.loc.r = toRope(sym.name.s) + if sym.loc.r == nil: sym.loc.r = rope(sym.name.s) of wDestructor: sym.flags.incl sfOverriden if sym.name.s.normalize != "destroy": @@ -685,13 +688,13 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, noVal(it) incl(sym.flags, sfNoSideEffect) if sym.typ != nil: incl(sym.typ.flags, tfNoSideEffect) - of wSideeffect: + of wSideeffect: noVal(it) incl(sym.flags, sfSideEffect) - of wNoreturn: + of wNoreturn: noVal(it) incl(sym.flags, sfNoReturn) - of wDynlib: + of wDynlib: processDynLib(c, it, sym) of wCompilerproc: noVal(it) # compilerproc may not get a string! @@ -703,7 +706,7 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, if it.kind == nkExprColonExpr: deprecatedStmt(c, it) elif sym != nil: incl(sym.flags, sfDeprecated) else: incl(c.module.flags, sfDeprecated) - of wVarargs: + of wVarargs: noVal(it) if sym.typ == nil: invalidPragma(it) else: incl(sym.typ.flags, tfVarargs) @@ -713,7 +716,7 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, else: noVal(it) incl(sym.flags, sfBorrow) - of wFinal: + of wFinal: noVal(it) if sym.typ == nil: invalidPragma(it) else: incl(sym.typ.flags, tfFinal) @@ -745,10 +748,10 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, else: incl(sym.typ.flags, tfPacked) of wHint: message(it.info, hintUser, expectStrLit(c, it)) of wWarning: message(it.info, warnUser, expectStrLit(c, it)) - of wError: + of wError: if sym != nil and sym.isRoutine: # This is subtle but correct: the error *statement* is only - # allowed for top level statements. Seems to be easier than + # allowed for top level statements. Seems to be easier than # distinguishing properly between # ``proc p() {.error}`` and ``proc p() = {.error: "msg".}`` noVal(it) @@ -765,11 +768,11 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, of wPassc: extccomp.addCompileOption(expectStrLit(c, it)) of wBreakpoint: pragmaBreakpoint(c, it) of wWatchPoint: pragmaWatchpoint(c, it) - of wPush: + of wPush: processPush(c, n, i + 1) - result = true + result = true of wPop: processPop(c, it) - of wPragma: + of wPragma: processPragma(c, n, i) result = true of wDiscardable: @@ -779,16 +782,16 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, noVal(it) if sym != nil: incl(sym.flags, sfNoInit) of wCodegenDecl: processCodegenDecl(c, it, sym) - of wChecks, wObjChecks, wFieldChecks, wRangechecks, wBoundchecks, - wOverflowchecks, wNilchecks, wAssertions, wWarnings, wHints, + of wChecks, wObjChecks, wFieldChecks, wRangechecks, wBoundchecks, + wOverflowchecks, wNilchecks, wAssertions, wWarnings, wHints, wLinedir, wStacktrace, wLinetrace, wOptimization, - wCallconv, + wCallconv, wDebugger, wProfiler, wFloatchecks, wNanChecks, wInfChecks, wPatterns: if processOption(c, it): # calling conventions (boring...): localError(it.info, errOptionExpected) - of FirstCallConv..LastCallConv: + of FirstCallConv..LastCallConv: assert(sym != nil) if sym.typ == nil: invalidPragma(it) else: sym.typ.callConv = wordToCallConv(k) @@ -840,17 +843,22 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, invalidPragma(it) else: sym.guard = pragmaGuard(c, it, sym.kind) + of wGoto: + if sym == nil or sym.kind notin {skVar, skLet}: + invalidPragma(it) + else: + sym.flags.incl sfGoto of wInjectStmt: if it.kind != nkExprColonExpr: localError(it.info, errExprExpected) - else: + else: it.sons[1] = c.semExpr(c, it.sons[1]) of wExperimental: noVal(it) if isTopLevel(c): c.module.flags.incl sfExperimental else: - localError(it.info, "'experimental' pragma only valid as toplevel statement") + localError(it.info, "'experimental' pragma only valid as toplevel statement") else: invalidPragma(it) else: invalidPragma(it) else: processNote(c, it) @@ -862,9 +870,11 @@ proc implicitPragmas*(c: PContext, sym: PSym, n: PNode, while it != nil: let o = it.otherPragmas if not o.isNil: + pushInfoContext(n.info) for i in countup(0, sonsLen(o) - 1): if singlePragma(c, sym, o, i, validPragmas): internalError(n.info, "implicitPragmas") + popInfoContext() it = it.next.POptionEntry if lfExportLib in sym.loc.flags and sfExportc notin sym.flags: @@ -874,7 +884,7 @@ proc implicitPragmas*(c: PContext, sym: PSym, n: PNode, sfImportc in sym.flags and lib != nil: incl(sym.loc.flags, lfDynamicLib) addToLib(lib, sym) - if sym.loc.r == nil: sym.loc.r = toRope(sym.name.s) + if sym.loc.r == nil: sym.loc.r = rope(sym.name.s) proc hasPragma*(n: PNode, pragma: TSpecialWord): bool = if n == nil or n.sons == nil: @@ -884,7 +894,7 @@ proc hasPragma*(n: PNode, pragma: TSpecialWord): bool = var key = if p.kind == nkExprColonExpr: p[0] else: p if key.kind == nkIdent and whichKeyword(key.ident) == pragma: return true - + return false proc pragmaRec(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) = diff --git a/compiler/renderer.nim b/compiler/renderer.nim index 689bf23c8..ffdb60696 100644 --- a/compiler/renderer.nim +++ b/compiler/renderer.nim @@ -385,7 +385,7 @@ proc lsub(n: PNode): int = result = lsub(n.sons[0]) + lcomma(n, 1) + 2 of nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv: result = lsub(n[1]) of nkCast: result = lsub(n.sons[0]) + lsub(n.sons[1]) + len("cast[]()") - of nkAddr: result = lsub(n.sons[0]) + len("addr()") + of nkAddr: result = (if n.len>0: lsub(n.sons[0]) + len("addr()") else: 4) of nkStaticExpr: result = lsub(n.sons[0]) + len("static_") of nkHiddenAddr, nkHiddenDeref: result = lsub(n.sons[0]) of nkCommand: result = lsub(n.sons[0]) + lcomma(n, 1) + 1 @@ -433,7 +433,7 @@ proc lsub(n: PNode): int = len("if_:_") of nkElifExpr: result = lsons(n) + len("_elif_:_") of nkElseExpr: result = lsub(n.sons[0]) + len("_else:_") # type descriptions - of nkTypeOfExpr: result = lsub(n.sons[0]) + len("type_") + of nkTypeOfExpr: result = (if n.len > 0: lsub(n.sons[0]) else: 0)+len("type_") of nkRefTy: result = (if n.len > 0: lsub(n.sons[0])+1 else: 0) + len("ref") of nkPtrTy: result = (if n.len > 0: lsub(n.sons[0])+1 else: 0) + len("ptr") of nkVarTy: result = (if n.len > 0: lsub(n.sons[0])+1 else: 0) + len("var") @@ -503,6 +503,7 @@ proc gsub(g: var TSrcGen, n: PNode) = proc hasCom(n: PNode): bool = result = false + if n.isNil: return false if n.comment != nil: return true case n.kind of nkEmpty..nkNilLit: discard @@ -725,7 +726,7 @@ proc gproc(g: var TSrcGen, n: PNode) = proc gTypeClassTy(g: var TSrcGen, n: PNode) = var c: TContext initContext(c) - putWithSpace(g, tkGeneric, "generic") + putWithSpace(g, tkConcept, "concept") gsons(g, n[0], c) # arglist gsub(g, n[1]) # pragmas gsub(g, n[2]) # of @@ -846,9 +847,10 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkParRi, ")") of nkAddr: put(g, tkAddr, "addr") - put(g, tkParLe, "(") - gsub(g, n.sons[0]) - put(g, tkParRi, ")") + if n.len > 0: + put(g, tkParLe, "(") + gsub(g, n.sons[0]) + put(g, tkParRi, ")") of nkStaticExpr: put(g, tkStatic, "static") put(g, tkSpaces, Space) @@ -1269,9 +1271,12 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = putWithSpace(g, tkColon, ":") gcoms(g) gstmts(g, n.sons[0], c) - of nkFinally: + of nkFinally, nkDefer: optNL(g) - put(g, tkFinally, "finally") + if n.kind == nkFinally: + put(g, tkFinally, "finally") + else: + put(g, tkDefer, "defer") putWithSpace(g, tkColon, ":") gcoms(g) gstmts(g, n.sons[0], c) diff --git a/compiler/rodread.nim b/compiler/rodread.nim index 545a8dda9..e92f7ecfa 100644 --- a/compiler/rodread.nim +++ b/compiler/rodread.nim @@ -277,7 +277,7 @@ proc decodeLoc(r: PRodReader, loc: var TLoc, info: TLineInfo) = loc.t = nil if r.s[r.pos] == '!': inc(r.pos) - loc.r = toRope(decodeStr(r.s, r.pos)) + loc.r = rope(decodeStr(r.s, r.pos)) else: loc.r = nil if r.s[r.pos] == '>': inc(r.pos) @@ -344,7 +344,7 @@ proc decodeLib(r: PRodReader, info: TLineInfo): PLib = result.kind = TLibKind(decodeVInt(r.s, r.pos)) if r.s[r.pos] != '|': internalError("decodeLib: 1") inc(r.pos) - result.name = toRope(decodeStr(r.s, r.pos)) + result.name = rope(decodeStr(r.s, r.pos)) if r.s[r.pos] != '|': internalError("decodeLib: 2") inc(r.pos) result.path = decodeNode(r, info) diff --git a/compiler/rodwrite.nim b/compiler/rodwrite.nim index 0f211b4ba..e178b7ce6 100644 --- a/compiler/rodwrite.nim +++ b/compiler/rodwrite.nim @@ -186,7 +186,7 @@ proc encodeLoc(w: PRodWriter, loc: TLoc, result: var string) = pushType(w, loc.t) if loc.r != nil: add(result, '!') - encodeStr(ropeToStr(loc.r), result) + encodeStr($loc.r, result) if oldLen + 1 == result.len: # no data was necessary, so remove the '<' again: setLen(result, oldLen) @@ -241,7 +241,7 @@ proc encodeLib(w: PRodWriter, lib: PLib, info: TLineInfo, result: var string) = add(result, '|') encodeVInt(ord(lib.kind), result) add(result, '|') - encodeStr(ropeToStr(lib.name), result) + encodeStr($lib.name, result) add(result, '|') encodeNode(w, info, lib.path, result) diff --git a/compiler/ropes.nim b/compiler/ropes.nim index ad6801d18..edac8e9d0 100644 --- a/compiler/ropes.nim +++ b/compiler/ropes.nim @@ -55,81 +55,63 @@ # share leaves across different rope trees. # To cache them they are inserted in a `cache` array. -import - strutils, platform, hashes, crc, options +import + platform, hashes type - TFormatStr* = string # later we may change it to CString for better - # performance of the code generator (assignments + FormatStr* = string # later we may change it to CString for better + # performance of the code generator (assignments # copy the format strings # though it is not necessary) - PRope* = ref TRope - TRope*{.acyclic.} = object of RootObj # the empty rope is represented - # by nil to safe space - left*, right*: PRope + Rope* = ref RopeObj + RopeObj*{.acyclic.} = object of RootObj # the empty rope is represented + # by nil to safe space + left*, right*: Rope length*: int data*: string # != nil if a leaf - - TRopeSeq* = seq[PRope] - TRopesError* = enum + RopeSeq* = seq[Rope] + + RopesError* = enum rCannotOpenFile rInvalidFormatStr - rTokenTooLong - -proc con*(a, b: PRope): PRope -proc con*(a: PRope, b: string): PRope -proc con*(a: string, b: PRope): PRope -proc con*(a: varargs[PRope]): PRope -proc app*(a: var PRope, b: PRope) -proc app*(a: var PRope, b: string) -proc prepend*(a: var PRope, b: PRope) -proc toRope*(s: string): PRope -proc toRope*(i: BiggestInt): PRope -proc ropeLen*(a: PRope): int -proc writeRopeIfNotEqual*(r: PRope, filename: string): bool -proc ropeToStr*(p: PRope): string -proc ropef*(frmt: TFormatStr, args: varargs[PRope]): PRope -proc appf*(c: var PRope, frmt: TFormatStr, args: varargs[PRope]) -proc ropeEqualsFile*(r: PRope, f: string): bool - # returns true if the rope r is the same as the contents of file f -proc ropeInvariant*(r: PRope): bool - # exported for debugging + # implementation -var errorHandler*: proc(err: TRopesError, msg: string, useWarning = false) +var errorHandler*: proc(err: RopesError, msg: string, useWarning = false) # avoid dependency on msgs.nim - -proc ropeLen(a: PRope): int = + +proc len*(a: Rope): int = + ## the rope's length if a == nil: result = 0 else: result = a.length - -proc newRope*(data: string = nil): PRope = + +proc newRope(data: string = nil): Rope = new(result) - if data != nil: + if data != nil: result.length = len(data) result.data = data -proc newMutableRope*(capacity = 30): PRope = +proc newMutableRope*(capacity = 30): Rope = ## creates a new rope that supports direct modifications of the rope's ## 'data' and 'length' fields. new(result) result.data = newStringOfCap(capacity) -proc freezeMutableRope*(r: PRope) {.inline.} = +proc freezeMutableRope*(r: Rope) {.inline.} = r.length = r.data.len -var - cache: array[0..2048*2 -1, PRope] +var + cache: array[0..2048*2 - 1, Rope] proc resetRopeCache* = for i in low(cache)..high(cache): cache[i] = nil -proc ropeInvariant(r: PRope): bool = - if r == nil: +proc ropeInvariant(r: Rope): bool = + if r == nil: result = true - else: + else: result = true # # if r.data <> snil then # result := true @@ -137,13 +119,13 @@ proc ropeInvariant(r: PRope): bool = # result := (r.left <> nil) and (r.right <> nil); # if result then result := ropeInvariant(r.left); # if result then result := ropeInvariant(r.right); - # end + # end var gCacheTries* = 0 var gCacheMisses* = 0 var gCacheIntTries* = 0 -proc insertInCache(s: string): PRope = +proc insertInCache(s: string): Rope = inc gCacheTries var h = hash(s) and high(cache) result = cache[h] @@ -151,83 +133,78 @@ proc insertInCache(s: string): PRope = inc gCacheMisses result = newRope(s) cache[h] = result - -proc toRope(s: string): PRope = + +proc rope*(s: string): Rope = + ## Converts a string to a rope. if s.len == 0: result = nil else: result = insertInCache(s) assert(ropeInvariant(result)) -proc ropeSeqInsert(rs: var TRopeSeq, r: PRope, at: Natural) = - var length = len(rs) - if at > length: - setLen(rs, at + 1) - else: - setLen(rs, length + 1) # move old rope elements: - for i in countdown(length, at + 1): - rs[i] = rs[i - 1] # this is correct, I used pen and paper to validate it - rs[at] = r - -proc newRecRopeToStr(result: var string, resultLen: var int, r: PRope) = - var stack = @[r] - while len(stack) > 0: - var it = pop(stack) - while it.data == nil: - add(stack, it.right) - it = it.left - assert(it.data != nil) - copyMem(addr(result[resultLen]), addr(it.data[0]), it.length) - inc(resultLen, it.length) - assert(resultLen <= len(result)) - -proc ropeToStr(p: PRope): string = - if p == nil: - result = "" - else: - result = newString(p.length) - var resultLen = 0 - newRecRopeToStr(result, resultLen, p) - -proc con(a, b: PRope): PRope = - if a == nil: result = b - elif b == nil: result = a +proc rope*(i: BiggestInt): Rope = + ## Converts an int to a rope. + inc gCacheIntTries + result = rope($i) + +proc rope*(f: BiggestFloat): Rope = + ## Converts a float to a rope. + result = rope($f) + +proc `&`*(a, b: Rope): Rope = + if a == nil: + result = b + elif b == nil: + result = a else: result = newRope() result.length = a.length + b.length result.left = a result.right = b -proc con(a: PRope, b: string): PRope = result = con(a, toRope(b)) -proc con(a: string, b: PRope): PRope = result = con(toRope(a), b) - -proc con(a: varargs[PRope]): PRope = - for i in countup(0, high(a)): result = con(result, a[i]) - -proc ropeConcat*(a: varargs[PRope]): PRope = - # not overloaded version of concat to speed-up `rfmt` a little bit - for i in countup(0, high(a)): result = con(result, a[i]) - -proc toRope(i: BiggestInt): PRope = - inc gCacheIntTries - result = toRope($i) - -proc app(a: var PRope, b: PRope) = a = con(a, b) -proc app(a: var PRope, b: string) = a = con(a, b) -proc prepend(a: var PRope, b: PRope) = a = con(b, a) - -proc writeRope*(f: File, c: PRope) = - var stack = @[c] - while len(stack) > 0: - var it = pop(stack) - while it.data == nil: - add(stack, it.right) - it = it.left - assert(it != nil) - assert(it.data != nil) - write(f, it.data) - -proc writeRope*(head: PRope, filename: string, useWarning = false) = +proc `&`*(a: Rope, b: string): Rope = + ## the concatenation operator for ropes. + result = a & rope(b) + +proc `&`*(a: string, b: Rope): Rope = + ## the concatenation operator for ropes. + result = rope(a) & b + +proc `&`*(a: openArray[Rope]): Rope = + ## the concatenation operator for an openarray of ropes. + for i in countup(0, high(a)): result = result & a[i] + +proc add*(a: var Rope, b: Rope) = + ## adds `b` to the rope `a`. + a = a & b + +proc add*(a: var Rope, b: string) = + ## adds `b` to the rope `a`. + a = a & b + +iterator leaves*(r: Rope): string = + ## iterates over any leaf string in the rope `r`. + if r != nil: + var stack = @[r] + while stack.len > 0: + var it = stack.pop + while isNil(it.data): + stack.add(it.right) + it = it.left + assert(it != nil) + assert(it.data != nil) + yield it.data + +iterator items*(r: Rope): char = + ## iterates over any character in the rope `r`. + for s in leaves(r): + for c in items(s): yield c + +proc writeRope*(f: File, r: Rope) = + ## writes a rope to a file. + for s in leaves(r): write(f, s) + +proc writeRope*(head: Rope, filename: string, useWarning = false) = var f: File if open(f, filename, fmWrite): if head != nil: writeRope(f, head) @@ -235,42 +212,69 @@ proc writeRope*(head: PRope, filename: string, useWarning = false) = else: errorHandler(rCannotOpenFile, filename, useWarning) +proc `$`*(r: Rope): string = + ## converts a rope back to a string. + result = newString(r.len) + setLen(result, 0) + for s in leaves(r): add(result, s) + +proc ropeConcat*(a: varargs[Rope]): Rope = + # not overloaded version of concat to speed-up `rfmt` a little bit + for i in countup(0, high(a)): result = result & a[i] + +proc prepend*(a: var Rope, b: Rope) = a = b & a +proc prepend*(a: var Rope, b: string) = a = b & a + var rnl* = tnl.newRope softRnl* = tnl.newRope -proc ropef(frmt: TFormatStr, args: varargs[PRope]): PRope = +proc `%`*(frmt: FormatStr, args: openArray[Rope]): Rope = var i = 0 var length = len(frmt) result = nil var num = 0 - while i <= length - 1: - if frmt[i] == '$': + while i < length: + if frmt[i] == '$': inc(i) # skip '$' case frmt[i] - of '$': - app(result, "$") + of '$': + add(result, "$") inc(i) - of '#': + of '#': inc(i) - app(result, args[num]) + add(result, args[num]) inc(num) - of '0'..'9': + of '0'..'9': var j = 0 - while true: - j = (j * 10) + ord(frmt[i]) - ord('0') + while true: + j = j * 10 + ord(frmt[i]) - ord('0') inc(i) - if (i > length + 0 - 1) or not (frmt[i] in {'0'..'9'}): break + if frmt[i] notin {'0'..'9'}: break num = j if j > high(args) + 1: errorHandler(rInvalidFormatStr, $(j)) else: - app(result, args[j - 1]) + add(result, args[j-1]) + of '{': + inc(i) + var j = 0 + while frmt[i] in {'0'..'9'}: + j = j * 10 + ord(frmt[i]) - ord('0') + inc(i) + num = j + if frmt[i] == '}': inc(i) + else: errorHandler(rInvalidFormatStr, $(frmt[i])) + + if j > high(args) + 1: + errorHandler(rInvalidFormatStr, $(j)) + else: + add(result, args[j-1]) of 'n': - app(result, softRnl) - inc i + add(result, softRnl) + inc(i) of 'N': - app(result, rnl) + add(result, rnl) inc(i) else: errorHandler(rInvalidFormatStr, $(frmt[i])) @@ -278,85 +282,69 @@ proc ropef(frmt: TFormatStr, args: varargs[PRope]): PRope = while i < length: if frmt[i] != '$': inc(i) else: break - if i - 1 >= start: - app(result, substr(frmt, start, i - 1)) + if i - 1 >= start: + add(result, substr(frmt, start, i - 1)) assert(ropeInvariant(result)) +proc addf*(c: var Rope, frmt: FormatStr, args: openArray[Rope]) = + ## shortcut for ``add(c, frmt % args)``. + add(c, frmt % args) + when true: - template `~`*(r: string): PRope = r.ropef + template `~`*(r: string): Rope = r % [] else: {.push stack_trace: off, line_trace: off.} - proc `~`*(r: static[string]): PRope = + proc `~`*(r: static[string]): Rope = # this is the new optimized "to rope" operator # the mnemonic is that `~` looks a bit like a rope :) - var r {.global.} = r.ropef + var r {.global.} = r % [] return r {.pop.} -proc appf(c: var PRope, frmt: TFormatStr, args: varargs[PRope]) = - app(c, ropef(frmt, args)) - -const +const bufSize = 1024 # 1 KB is reasonable -proc auxRopeEqualsFile(r: PRope, bin: var File, buf: pointer): bool = - if r.data != nil: - if r.length > bufSize: - errorHandler(rTokenTooLong, r.data) - return - var readBytes = readBuffer(bin, buf, r.length) - result = readBytes == r.length and - equalMem(buf, addr(r.data[0]), r.length) # BUGFIX - else: - result = auxRopeEqualsFile(r.left, bin, buf) - if result: result = auxRopeEqualsFile(r.right, bin, buf) - -proc ropeEqualsFile(r: PRope, f: string): bool = - var bin: File - result = open(bin, f) - if not result: - return # not equal if file does not exist - var buf = alloc(bufSize) - result = auxRopeEqualsFile(r, bin, buf) - if result: - result = readBuffer(bin, buf, bufSize) == 0 # really at the end of file? - dealloc(buf) - close(bin) - -proc crcFromRopeAux(r: PRope, startVal: TCrc32): TCrc32 = - if r.data != nil: - result = startVal - for i in countup(0, len(r.data) - 1): - result = updateCrc32(r.data[i], result) - else: - result = crcFromRopeAux(r.left, startVal) - result = crcFromRopeAux(r.right, result) - -proc newCrcFromRopeAux(r: PRope, startVal: TCrc32): TCrc32 = - # XXX profiling shows this is actually expensive - var stack: TRopeSeq = @[r] - result = startVal - while len(stack) > 0: - var it = pop(stack) - while it.data == nil: - add(stack, it.right) - it = it.left - assert(it.data != nil) - var i = 0 - var L = len(it.data) - while i < L: - result = updateCrc32(it.data[i], result) - inc(i) - -proc crcFromRope(r: PRope): TCrc32 = - result = newCrcFromRopeAux(r, InitCrc32) - -proc writeRopeIfNotEqual(r: PRope, filename: string): bool = +proc equalsFile*(r: Rope, f: File): bool = + ## returns true if the contents of the file `f` equal `r`. + var + buf: array[bufSize, char] + bpos = buf.len + blen = buf.len + + for s in leaves(r): + var spos = 0 + let slen = s.len + while spos < slen: + if bpos == blen: + # Read more data + bpos = 0 + blen = readBuffer(f, addr(buf[0]), buf.len) + if blen == 0: # no more data in file + result = false + return + let n = min(blen - bpos, slen - spos) + # TODO There's gotta be a better way of comparing here... + if not equalMem(addr(buf[bpos]), cast[pointer](cast[int](cstring(s))+spos), n): + result = false + return + spos += n + bpos += n + + result = readBuffer(f, addr(buf[0]), 1) == 0 # check that we've read all + +proc equalsFile*(r: Rope, filename: string): bool = + ## returns true if the contents of the file `f` equal `r`. If `f` does not + ## exist, false is returned. + var f: File + result = open(f, filename) + if result: + result = equalsFile(r, f) + close(f) + +proc writeRopeIfNotEqual*(r: Rope, filename: string): bool = # returns true if overwritten - var c: TCrc32 - c = crcFromFile(filename) - if c != crcFromRope(r): + if not equalsFile(r, filename): writeRope(r, filename) result = true - else: + else: result = false diff --git a/compiler/sem.nim b/compiler/sem.nim index 2d2f15fab..965556a36 100644 --- a/compiler/sem.nim +++ b/compiler/sem.nim @@ -16,7 +16,7 @@ import procfind, lookups, rodread, pragmas, passes, semdata, semtypinst, sigmatch, intsets, transf, vmdef, vm, idgen, aliases, cgmeth, lambdalifting, evaltempl, patterns, parampatterns, sempass2, nimfix.pretty, semmacrosanity, - semparallel, lowerings + semparallel, lowerings, plugins when defined(nimfix): import nimfix.prettybase @@ -398,7 +398,7 @@ proc myOpen(module: PSym): PPassContext = c.semInferredLambda = semInferredLambda c.semGenerateInstance = generateInstance c.semTypeNode = semTypeNode - c.instDeepCopy = sigmatch.instDeepCopy + c.instTypeBoundOp = sigmatch.instTypeBoundOp pushProcCon(c, module) pushOwner(c.module) diff --git a/compiler/semasgn.nim b/compiler/semasgn.nim index 61e39877a..a1e209263 100644 --- a/compiler/semasgn.nim +++ b/compiler/semasgn.nim @@ -7,7 +7,8 @@ # distribution, for details about the copyright. # -## This module implements lifting for assignments and ``deepCopy``. +## This module implements lifting for assignments. Later versions of this code +## will be able to also lift ``=deepCopy`` and ``=destroy``. # included from sem.nim @@ -15,98 +16,75 @@ type TLiftCtx = object c: PContext info: TLineInfo # for construction - result: PNode kind: TTypeAttachedOp + fn: PSym + asgnForType: PType + recurse: bool -type - TFieldInstCtx = object # either 'tup[i]' or 'field' is valid - tupleType: PType # if != nil we're traversing a tuple - tupleIndex: int - field: PSym - replaceByFieldName: bool +proc liftBodyAux(c: var TLiftCtx; t: PType; body, x, y: PNode) +proc liftBody(c: PContext; typ: PType; info: TLineInfo): PSym + +proc at(a, i: PNode, elemType: PType): PNode = + result = newNodeI(nkBracketExpr, a.info, 2) + result.sons[0] = a + result.sons[1] = i + result.typ = elemType + +proc liftBodyTup(c: var TLiftCtx; t: PType; body, x, y: PNode) = + for i in 0 .. <t.len: + let lit = lowerings.newIntLit(i) + liftBodyAux(c, t.sons[i], body, x.at(lit, t.sons[i]), y.at(lit, t.sons[i])) + +proc dotField(x: PNode, f: PSym): PNode = + result = newNodeI(nkDotExpr, x.info, 2) + result.sons[0] = x + result.sons[1] = newSymNode(f, x.info) + result.typ = f.typ -proc instFieldLoopBody(c: TFieldInstCtx, n: PNode, forLoop: PNode): PNode = +proc liftBodyObj(c: var TLiftCtx; n, body, x, y: PNode) = case n.kind - of nkEmpty..pred(nkIdent), succ(nkIdent)..nkNilLit: result = n - of nkIdent: - result = n - var L = sonsLen(forLoop) - if c.replaceByFieldName: - if n.ident.id == forLoop[0].ident.id: - let fieldName = if c.tupleType.isNil: c.field.name.s - elif c.tupleType.n.isNil: "Field" & $c.tupleIndex - else: c.tupleType.n.sons[c.tupleIndex].sym.name.s - result = newStrNode(nkStrLit, fieldName) - return - # other fields: - for i in ord(c.replaceByFieldName)..L-3: - if n.ident.id == forLoop[i].ident.id: - var call = forLoop.sons[L-2] - var tupl = call.sons[i+1-ord(c.replaceByFieldName)] - if c.field.isNil: - result = newNodeI(nkBracketExpr, n.info) - result.add(tupl) - result.add(newIntNode(nkIntLit, c.tupleIndex)) - else: - result = newNodeI(nkDotExpr, n.info) - result.add(tupl) - result.add(newSymNode(c.field, n.info)) - break - else: - if n.kind == nkContinueStmt: - localError(n.info, errGenerated, - "'continue' not supported in a 'fields' loop") - result = copyNode(n) - newSons(result, sonsLen(n)) - for i in countup(0, sonsLen(n)-1): - result.sons[i] = instFieldLoopBody(c, n.sons[i], forLoop) - -proc liftBodyObj(c: TLiftCtx; typ, x, y: PNode) = - case typ.kind of nkSym: - var fc: TFieldInstCtx # either 'tup[i]' or 'field' is valid - fc.field = typ.sym - fc.replaceByFieldName = c.m == mFieldPairs - openScope(c.c) - inc c.c.inUnrolledContext - let body = instFieldLoopBody(fc, lastSon(forLoop), forLoop) - father.add(semStmt(c.c, body)) - dec c.c.inUnrolledContext - closeScope(c.c) + let f = n.sym + liftBodyAux(c, f.typ, body, x.dotField(f), y.dotField(f)) of nkNilLit: discard of nkRecCase: - let L = forLoop.len - let call = forLoop.sons[L-2] - if call.len > 2: - localError(forLoop.info, errGenerated, - "parallel 'fields' iterator does not work for 'case' objects") - return - # iterate over the selector: - asgnForObjectFields(c, typ[0], forLoop, father) + # copy the selector: + liftBodyObj(c, n[0], body, x, y) # we need to generate a case statement: var caseStmt = newNodeI(nkCaseStmt, c.info) + # XXX generate 'if' that checks same branches # generate selector: - var access = newNodeI(nkDotExpr, forLoop.info, 2) - access.sons[0] = call.sons[1] - access.sons[1] = newSymNode(typ.sons[0].sym, forLoop.info) - caseStmt.add(semExprWithType(c.c, access)) + var access = dotField(x, n[0].sym) + caseStmt.add(access) # copy the branches over, but replace the fields with the for loop body: - for i in 1 .. <typ.len: - var branch = copyTree(typ[i]) + for i in 1 .. <n.len: + var branch = copyTree(n[i]) let L = branch.len - branch.sons[L-1] = newNodeI(nkStmtList, forLoop.info) - semForObjectFields(c, typ[i].lastSon, forLoop, branch[L-1]) + branch.sons[L-1] = newNodeI(nkStmtList, c.info) + + liftBodyObj(c, n[i].lastSon, branch.sons[L-1], x, y) caseStmt.add(branch) - father.add(caseStmt) + body.add(caseStmt) + localError(c.info, "cannot lift assignment operator to 'case' object") of nkRecList: - for t in items(typ): liftBodyObj(c, t, x, y) + for t in items(n): liftBodyObj(c, t, body, x, y) + else: + illFormedAstLocal(n) + +proc genAddr(c: PContext; x: PNode): PNode = + if x.kind == nkHiddenDeref: + checkSonsLen(x, 1) + result = x.sons[0] else: - illFormedAstLocal(typ) + result = newNodeIT(nkHiddenAddr, x.info, makeVarType(c, x.typ)) + addSon(result, x) -proc newAsgnCall(op: PSym; x, y: PNode): PNode = +proc newAsgnCall(c: PContext; op: PSym; x, y: PNode): PNode = + if sfError in op.flags: + localError(x.info, errWrongSymbolX, op.name.s) result = newNodeI(nkCall, x.info) - result.add(newSymNode(op)) - result.add x + result.add newSymNode(op) + result.add genAddr(c, x) result.add y proc newAsgnStmt(le, ri: PNode): PNode = @@ -117,68 +95,129 @@ proc newAsgnStmt(le, ri: PNode): PNode = proc newDestructorCall(op: PSym; x: PNode): PNode = result = newNodeIT(nkCall, x.info, op.typ.sons[0]) result.add(newSymNode(op)) - result.add x + result.add x proc newDeepCopyCall(op: PSym; x, y: PNode): PNode = result = newAsgnStmt(x, newDestructorCall(op, y)) -proc considerOverloadedOp(c: TLiftCtx; t: PType; x, y: PNode): bool = - let op = t.attachedOps[c.kind] - if op != nil: - markUsed(c.info, op) - styleCheckUse(c.info, op) - case c.kind - of attachedDestructor: - c.result.add newDestructorCall(op, x) - of attachedAsgn: - c.result.add newAsgnCall(op, x, y) - of attachedDeepCopy: - c.result.add newDeepCopyCall(op, x, y) - result = true - -proc defaultOp(c: TLiftCtx; t: PType; x, y: PNode) = +proc considerOverloadedOp(c: var TLiftCtx; t: PType; body, x, y: PNode): bool = + case c.kind + of attachedDestructor: + let op = t.destructor + if op != nil: + markUsed(c.info, op) + styleCheckUse(c.info, op) + body.add newDestructorCall(op, x) + result = true + of attachedAsgn: + if tfHasAsgn in t.flags: + var op: PSym + if sameType(t, c.asgnForType): + # generate recursive call: + if c.recurse: + op = c.fn + else: + c.recurse = true + return false + else: + op = t.assignment + if op == nil: + op = liftBody(c.c, t, c.info) + markUsed(c.info, op) + styleCheckUse(c.info, op) + body.add newAsgnCall(c.c, op, x, y) + result = true + of attachedDeepCopy: + let op = t.deepCopy + if op != nil: + markUsed(c.info, op) + styleCheckUse(c.info, op) + body.add newDeepCopyCall(op, x, y) + result = true + +proc defaultOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = if c.kind != attachedDestructor: - c.result.add newAsgnStmt(x, y) - -proc liftBodyAux(c: TLiftCtx; t: PType; x, y: PNode) = - const hasAttachedOp: array[TTypeAttachedOp, TTypeIter] = [ - (proc (t: PType, closure: PObject): bool = - t.attachedOp[attachedDestructor] != nil), - (proc (t: PType, closure: PObject): bool = - t.attachedOp[attachedAsgn] != nil), - (proc (t: PType, closure: PObject): bool = - t.attachedOp[attachedDeepCopy] != nil)] + body.add newAsgnStmt(x, y) + +proc addVar(father, v, value: PNode) = + var vpart = newNodeI(nkIdentDefs, v.info, 3) + vpart.sons[0] = v + vpart.sons[1] = ast.emptyNode + vpart.sons[2] = value + addSon(father, vpart) + +proc declareCounter(c: var TLiftCtx; body: PNode; first: BiggestInt): PNode = + var temp = newSym(skTemp, getIdent(lowerings.genPrefix), c.fn, c.info) + temp.typ = getSysType(tyInt) + incl(temp.flags, sfFromGeneric) + + var v = newNodeI(nkVarSection, c.info) + result = newSymNode(temp) + v.addVar(result, lowerings.newIntLit(first)) + body.add v + +proc genBuiltin(magic: TMagic; name: string; i: PNode): PNode = + result = newNodeI(nkCall, i.info) + result.add createMagic(name, magic).newSymNode + result.add i + +proc genWhileLoop(c: var TLiftCtx; i, dest: PNode): PNode = + result = newNodeI(nkWhileStmt, c.info, 2) + let cmp = genBuiltin(mLeI, "<=", i) + cmp.add genHigh(dest) + cmp.typ = getSysType(tyBool) + result.sons[0] = cmp + result.sons[1] = newNodeI(nkStmtList, c.info) + +proc addIncStmt(body, i: PNode) = + let incCall = genBuiltin(mInc, "inc", i) + incCall.add lowerings.newIntLit(1) + body.add incCall + +proc newSeqCall(c: PContext; x, y: PNode): PNode = + # don't call genAddr(c, x) here: + result = genBuiltin(mNewSeq, "newSeq", x) + let lenCall = genBuiltin(mLengthSeq, "len", y) + lenCall.typ = getSysType(tyInt) + result.add lenCall + +proc liftBodyAux(c: var TLiftCtx; t: PType; body, x, y: PNode) = case t.kind of tyNone, tyEmpty: discard - of tyPointer, tySet, tyBool, tyChar, tyEnum, tyInt..tyUInt64, tyCString: - defaultOp(c, t, x, y) - of tyPtr, tyString: - if not considerOverloadedOp(c, t, x, y): - defaultOp(c, t, x, y) + of tyPointer, tySet, tyBool, tyChar, tyEnum, tyInt..tyUInt64, tyCString, + tyPtr, tyString, tyRef: + defaultOp(c, t, body, x, y) of tyArrayConstr, tyArray, tySequence: - if iterOverType(lastSon(t), hasAttachedOp[c.kind], nil): - # generate loop and call the attached Op: - + if tfHasAsgn in t.flags: + if t.kind == tySequence: + # XXX add 'nil' handling here + body.add newSeqCall(c.c, x, y) + let i = declareCounter(c, body, firstOrd(t)) + let whileLoop = genWhileLoop(c, i, x) + let elemType = t.lastSon + liftBodyAux(c, elemType, whileLoop.sons[1], x.at(i, elemType), + y.at(i, elemType)) + addIncStmt(whileLoop.sons[1], i) + body.add whileLoop else: - defaultOp(c, t, x, y) - of tyObject: - liftBodyObj(c, t.n, x, y) + defaultOp(c, t, body, x, y) + of tyObject, tyDistinct: + if not considerOverloadedOp(c, t, body, x, y): + if t.sons[0] != nil: liftBodyAux(c, t.sons[0], body, x, y) + if t.kind == tyObject: liftBodyObj(c, t.n, body, x, y) of tyTuple: - liftBodyTup(c, t, x, y) - of tyRef: - # we MUST not check for acyclic here as a DAG might still share nodes: - + liftBodyTup(c, t, body, x, y) of tyProc: if t.callConv != ccClosure or c.kind != attachedDeepCopy: - defaultOp(c, t, x, y) + defaultOp(c, t, body, x, y) else: # a big problem is that we don't know the enviroment's type here, so we # have to go through some indirection; we delegate this to the codegen: - call = newNodeI(nkCall, n.info, 2) + let call = newNodeI(nkCall, c.info, 2) call.typ = t call.sons[0] = newSymNode(createMagic("deepCopy", mDeepCopy)) call.sons[1] = y - c.result.add newAsgnStmt(x, call) + body.add newAsgnStmt(x, call) of tyVarargs, tyOpenArray: localError(c.info, errGenerated, "cannot copy openArray") of tyFromExpr, tyIter, tyProxy, tyBuiltInTypeClass, tyUserTypeClass, @@ -186,12 +225,60 @@ proc liftBodyAux(c: TLiftCtx; t: PType; x, y: PNode) = tyMutable, tyGenericParam, tyGenericBody, tyNil, tyExpr, tyStmt, tyTypeDesc, tyGenericInvocation, tyBigNum, tyConst, tyForward: internalError(c.info, "assignment requested for type: " & typeToString(t)) - of tyDistinct, tyOrdinal, tyRange, + of tyOrdinal, tyRange, tyGenericInst, tyFieldAccessor, tyStatic, tyVar: - liftBodyAux(c, lastSon(t)) + liftBodyAux(c, lastSon(t), body, x, y) + +proc newProcType(info: TLineInfo; owner: PSym): PType = + result = newType(tyProc, owner) + result.n = newNodeI(nkFormalParams, info) + rawAddSon(result, nil) # return type + # result.n[0] used to be `nkType`, but now it's `nkEffectList` because + # the effects are now stored in there too ... this is a bit hacky, but as + # usual we desperately try to save memory: + addSon(result.n, newNodeI(nkEffectList, info)) + +proc addParam(procType: PType; param: PSym) = + param.position = procType.len-1 + addSon(procType.n, newSymNode(param)) + rawAddSon(procType, param.typ) -proc liftBody(c: PContext; typ: PType; info: TLineInfo): PNode = +proc liftBody(c: PContext; typ: PType; info: TLineInfo): PSym = var a: TLiftCtx a.info = info - a.result = newNodeI(nkStmtList, info) - liftBodyAux(a, typ) + let body = newNodeI(nkStmtList, info) + result = newSym(skProc, getIdent":lifted=", typ.owner, info) + a.fn = result + a.asgnForType = typ + + let dest = newSym(skParam, getIdent"dest", result, info) + let src = newSym(skParam, getIdent"src", result, info) + dest.typ = makeVarType(c, typ) + src.typ = typ + + result.typ = newProcType(info, typ.owner) + result.typ.addParam dest + result.typ.addParam src + + liftBodyAux(a, typ, body, newSymNode(dest).newDeref, newSymNode(src)) + + var n = newNodeI(nkProcDef, info, bodyPos+1) + for i in 0 .. < n.len: n.sons[i] = emptyNode + n.sons[namePos] = newSymNode(result) + n.sons[paramsPos] = result.typ.n + n.sons[bodyPos] = body + result.ast = n + + # register late as recursion is handled differently + typ.assignment = result + #echo "Produced this ", n + +proc getAsgnOrLiftBody(c: PContext; typ: PType; info: TLineInfo): PSym = + let t = typ.skipTypes({tyGenericInst, tyVar}) + result = t.assignment + if result.isNil: + result = liftBody(c, t, info) + +proc overloadedAsgn(c: PContext; dest, src: PNode): PNode = + let a = getAsgnOrLiftBody(c, dest.typ, dest.info) + result = newAsgnCall(c, a, dest, src) diff --git a/compiler/semcall.nim b/compiler/semcall.nim index 4309661f3..c48e761e3 100644 --- a/compiler/semcall.nim +++ b/compiler/semcall.nim @@ -201,7 +201,8 @@ proc resolveOverloads(c: PContext, n, orig: PNode, elif nfDotSetter in n.flags: internalAssert f.kind == nkIdent and n.sonsLen == 3 - let calleeName = newStrNode(nkStrLit, f.ident.s[0.. -2]).withInfo(n.info) + let calleeName = newStrNode(nkStrLit, + f.ident.s[0..f.ident.s.len-2]).withInfo(n.info) let callOp = newIdentNode(getIdent".=", n.info) n.sons[0..1] = [callOp, n[1], calleeName] orig.sons[0..1] = [callOp, orig[1], calleeName] diff --git a/compiler/semdata.nim b/compiler/semdata.nim index 27d441000..345a8c0d1 100644 --- a/compiler/semdata.nim +++ b/compiler/semdata.nim @@ -9,13 +9,13 @@ ## This module contains the data structures for the semantic checking phase. -import +import strutils, lists, intsets, options, lexer, ast, astalgo, trees, treetab, - wordrecg, - ropes, msgs, platform, os, condsyms, idents, renderer, types, extccomp, math, + wordrecg, + ropes, msgs, platform, os, condsyms, idents, renderer, types, extccomp, math, magicsys, nversion, nimsets, parser, times, passes, rodread, vmdef -type +type TOptionEntry* = object of lists.TListEntry # entries to put on a # stack for pragma parsing options*: TOptions @@ -26,7 +26,7 @@ type POptionEntry* = ref TOptionEntry PProcCon* = ref TProcCon - TProcCon*{.final.} = object # procedure context; also used for top-level + TProcCon* = object # procedure context; also used for top-level # statements owner*: PSym # the symbol this context belongs to resultSym*: PSym # the result symbol (if we are in a proc) @@ -36,16 +36,23 @@ type # in standalone ``except`` and ``finally`` next*: PProcCon # used for stacking procedure contexts wasForwarded*: bool # whether the current proc has a separate header - + bracketExpr*: PNode # current bracket expression (for ^ support) + TInstantiationPair* = object genericSym*: PSym inst*: PInstantiation - TExprFlag* = enum - efLValue, efWantIterator, efInTypeof, efWantStmt, efDetermineType, + TExprFlag* = enum + efLValue, efWantIterator, efInTypeof, + efWantStmt, efAllowStmt, efDetermineType, efAllowDestructor, efWantValue, efOperand, efNoSemCheck TExprFlags* = set[TExprFlag] + TTypeAttachedOp* = enum + attachedAsgn, + attachedDeepCopy, + attachedDestructor + PContext* = ref TContext TContext* = object of TPassContext # a context represents a module module*: PSym # the module sym belonging to the context @@ -57,7 +64,7 @@ type # this is used so that generic instantiations # can access private object fields instCounter*: int # to prevent endless instantiations - + ambiguousSymbols*: IntSet # ids of all ambiguous symbols (cannot # store this info in the syms themselves!) inTypeClass*: int # > 0 if we are in a user-defined type class @@ -92,10 +99,10 @@ type lastGenericIdx*: int # used for the generics stack hloLoopDetector*: int # used to prevent endless loops in the HLO inParallelStmt*: int - instDeepCopy*: proc (c: PContext; dc: PSym; t: PType; - info: TLineInfo): PSym {.nimcall.} + instTypeBoundOp*: proc (c: PContext; dc: PSym; t: PType; info: TLineInfo; + op: TTypeAttachedOp): PSym {.nimcall.} + - proc makeInstPair*(s: PSym, inst: PInstantiation): TInstantiationPair = result.genericSym = s result.inst = inst @@ -111,7 +118,6 @@ proc newOptionEntry*(): POptionEntry proc newLib*(kind: TLibKind): PLib proc addToLib*(lib: PLib, sym: PSym) proc makePtrType*(c: PContext, baseType: PType): PType -proc makeVarType*(c: PContext, baseType: PType): PType proc newTypeS*(kind: TTypeKind, c: PContext): PType proc fillTypeS*(dest: PType, kind: TTypeKind, c: PContext) @@ -127,7 +133,7 @@ proc popOwner*() var gOwners*: seq[PSym] = @[] -proc getCurrOwner(): PSym = +proc getCurrOwner(): PSym = # owner stack (used for initializing the # owner field of syms) # the documentation comment always gets @@ -135,19 +141,19 @@ proc getCurrOwner(): PSym = # BUGFIX: global array is needed! result = gOwners[high(gOwners)] -proc pushOwner(owner: PSym) = +proc pushOwner(owner: PSym) = add(gOwners, owner) -proc popOwner() = +proc popOwner() = var length = len(gOwners) if length > 0: setLen(gOwners, length - 1) else: internalError("popOwner") -proc lastOptionEntry(c: PContext): POptionEntry = +proc lastOptionEntry(c: PContext): POptionEntry = result = POptionEntry(c.optionStack.tail) -proc pushProcCon*(c: PContext, owner: PSym) {.inline.} = - if owner == nil: +proc pushProcCon*(c: PContext, owner: PSym) {.inline.} = + if owner == nil: internalError("owner is nil") return var x: PProcCon @@ -158,7 +164,7 @@ proc pushProcCon*(c: PContext, owner: PSym) {.inline.} = proc popProcCon*(c: PContext) {.inline.} = c.p = c.p.next -proc newOptionEntry(): POptionEntry = +proc newOptionEntry(): POptionEntry = new(result) result.options = gOptions result.defaultCC = ccDefault @@ -182,8 +188,8 @@ proc newContext(module: PSym): PContext = proc inclSym(sq: var TSymSeq, s: PSym) = var L = len(sq) - for i in countup(0, L - 1): - if sq[i].id == s.id: return + for i in countup(0, L - 1): + if sq[i].id == s.id: return setLen(sq, L + 1) sq[L] = s @@ -193,22 +199,25 @@ proc addConverter*(c: PContext, conv: PSym) = proc addPattern*(c: PContext, p: PSym) = inclSym(c.patterns, p) -proc newLib(kind: TLibKind): PLib = +proc newLib(kind: TLibKind): PLib = new(result) result.kind = kind #initObjectSet(result.syms) - + proc addToLib(lib: PLib, sym: PSym) = #if sym.annex != nil and not isGenericRoutine(sym): # LocalError(sym.info, errInvalidPragma) sym.annex = lib -proc makePtrType(c: PContext, baseType: PType): PType = +proc makePtrType(c: PContext, baseType: PType): PType = result = newTypeS(tyPtr, c) addSonSkipIntLit(result, baseType.assertNotNil) -proc makeVarType(c: PContext, baseType: PType): PType = - result = newTypeS(tyVar, c) - addSonSkipIntLit(result, baseType.assertNotNil) +proc makeVarType*(c: PContext, baseType: PType): PType = + if baseType.kind == tyVar: + result = baseType + else: + result = newTypeS(tyVar, c) + addSonSkipIntLit(result, baseType.assertNotNil) proc makeTypeDesc*(c: PContext, typ: PType): PType = result = newTypeS(tyTypeDesc, c) @@ -240,6 +249,7 @@ proc makeAndType*(c: PContext, t1, t2: PType): PType = propagateToOwner(result, t1) propagateToOwner(result, t2) result.flags.incl((t1.flags + t2.flags) * {tfHasStatic}) + result.flags.incl tfHasMeta proc makeOrType*(c: PContext, t1, t2: PType): PType = result = newTypeS(tyOr, c) @@ -247,12 +257,14 @@ proc makeOrType*(c: PContext, t1, t2: PType): PType = propagateToOwner(result, t1) propagateToOwner(result, t2) result.flags.incl((t1.flags + t2.flags) * {tfHasStatic}) + result.flags.incl tfHasMeta proc makeNotType*(c: PContext, t1: PType): PType = result = newTypeS(tyNot, c) result.sons = @[t1] propagateToOwner(result, t1) result.flags.incl(t1.flags * {tfHasStatic}) + result.flags.incl tfHasMeta proc nMinusOne*(n: PNode): PNode = result = newNode(nkCall, n.info, @[ @@ -286,7 +298,7 @@ proc errorNode*(c: PContext, n: PNode): PNode = result = newNodeI(nkEmpty, n.info) result.typ = errorType(c) -proc fillTypeS(dest: PType, kind: TTypeKind, c: PContext) = +proc fillTypeS(dest: PType, kind: TTypeKind, c: PContext) = dest.kind = kind dest.owner = getCurrOwner() dest.size = - 1 @@ -311,13 +323,13 @@ proc illFormedAst*(n: PNode) = proc illFormedAstLocal*(n: PNode) = localError(n.info, errIllFormedAstX, renderTree(n, {renderNoComments})) -proc checkSonsLen*(n: PNode, length: int) = +proc checkSonsLen*(n: PNode, length: int) = if sonsLen(n) != length: illFormedAst(n) - -proc checkMinSonsLen*(n: PNode, length: int) = + +proc checkMinSonsLen*(n: PNode, length: int) = if sonsLen(n) < length: illFormedAst(n) -proc isTopLevel*(c: PContext): bool {.inline.} = +proc isTopLevel*(c: PContext): bool {.inline.} = result = c.currentScope.depthLevel <= 2 proc experimentalMode*(c: PContext): bool {.inline.} = diff --git a/compiler/semdestruct.nim b/compiler/semdestruct.nim index bbc68ee87..aaab49a10 100644 --- a/compiler/semdestruct.nim +++ b/compiler/semdestruct.nim @@ -12,7 +12,7 @@ # included from sem.nim # special marker values that indicates that we are -# 1) AnalyzingDestructor: currently analyzing the type for destructor +# 1) AnalyzingDestructor: currently analyzing the type for destructor # generation (needed for recursive types) # 2) DestructorIsTrivial: completed the analysis before and determined # that the type has a trivial destructor @@ -41,7 +41,7 @@ proc doDestructorStuff(c: PContext, s: PSym, n: PNode) = if t.kind != tyGenericBody: localError(n.info, errDestructorNotGenericEnough) return - + t.destructor = s # automatically insert calls to base classes' destructors if n.sons[bodyPos].kind != nkEmpty: @@ -71,17 +71,18 @@ proc destroyCase(c: PContext, n: PNode, holder: PNode): PNode = result.addSon(newNode(nkDotExpr, n.info, @[holder, n.sons[0]])) for i in countup(1, n.len - 1): # of A, B: - var caseBranch = newNode(n[i].kind, n[i].info, n[i].sons[0 .. -2]) - - let stmt = destroyFieldOrFields(c, n[i].lastSon, holder) + let ni = n[i] + var caseBranch = newNode(ni.kind, ni.info, ni.sons[0..ni.len-2]) + + let stmt = destroyFieldOrFields(c, ni.lastSon, holder) if stmt == nil: - caseBranch.addSon(newNode(nkStmtList, n[i].info, @[])) + caseBranch.addSon(newNode(nkStmtList, ni.info, @[])) else: caseBranch.addSon(stmt) nonTrivialFields += stmt.len - + result.addSon(caseBranch) - + # maybe no fields were destroyed? if nonTrivialFields == 0: result = nil @@ -107,7 +108,7 @@ proc destroyFieldOrFields(c: PContext, field: PNode, holder: PNode): PNode = proc generateDestructor(c: PContext, t: PType): PNode = ## generate a destructor for a user-defined object or tuple type ## returns nil if the destructor turns out to be trivial - + # XXX: This may be true for some C-imported types such as # Tposix_spawnattr if t.n == nil or t.n.sons == nil: return @@ -120,13 +121,13 @@ proc generateDestructor(c: PContext, t: PType): PNode = proc instantiateDestructor(c: PContext, typ: PType): PType = # returns nil if a variable of type `typ` doesn't require a - # destructor. Otherwise, returns the type, which holds the + # destructor. Otherwise, returns the type, which holds the # destructor that must be used for the varialbe. # The destructor is either user-defined or automatically # generated by the compiler in a member-wise fashion. var t = skipTypes(typ, {tyConst, tyMutable}).skipGenericAlias let typeHoldingUserDefinition = if t.kind == tyGenericInst: t.base else: t - + if typeHoldingUserDefinition.destructor != nil: # XXX: This is not entirely correct for recursive types, but we need # it temporarily to hide the "destroy is already defined" problem @@ -135,7 +136,7 @@ proc instantiateDestructor(c: PContext, typ: PType): PType = return typeHoldingUserDefinition else: return nil - + t = t.skipTypes({tyGenericInst}) case t.kind of tySequence, tyArray, tyArrayConstr, tyOpenArray, tyVarargs: @@ -200,16 +201,16 @@ proc insertDestructors(c: PContext, varId = varSection[j][0] varTyp = varId.sym.typ info = varId.info - + if varTyp == nil or sfGlobal in varId.sym.flags: continue let destructableT = instantiateDestructor(c, varTyp) - + if destructableT != nil: var tryStmt = newNodeI(nkTryStmt, info) if j < totalVars - 1: var remainingVars = newNodeI(varSection.kind, info) - remainingVars.sons = varSection.sons[(j+1)..(-1)] + remainingVars.sons = varSection.sons[(j+1)..varSection.len-1] let (outer, inner) = insertDestructors(c, remainingVars) if outer != nil: tryStmt.addSon(outer) @@ -221,7 +222,7 @@ proc insertDestructors(c: PContext, else: result.inner = newNodeI(nkStmtList, info) tryStmt.addSon(result.inner) - + tryStmt.addSon( newNode(nkFinally, info, @[ semStmt(c, newNode(nkCall, info, @[ diff --git a/compiler/semexprs.nim b/compiler/semexprs.nim index d236687c3..eb8d0c561 100644 --- a/compiler/semexprs.nim +++ b/compiler/semexprs.nim @@ -31,7 +31,7 @@ proc semOperand(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = if result.typ != nil: # XXX tyGenericInst here? if result.typ.kind == tyVar: result = newDeref(result) - elif efWantStmt in flags: + elif {efWantStmt, efAllowStmt} * flags != {}: result.typ = newTypeS(tyEmpty, c) else: localError(n.info, errExprXHasNoType, @@ -389,7 +389,7 @@ proc isOpImpl(c: PContext, n: PNode): PNode = maybeLiftType(t2, c, n.info) var m: TCandidate initCandidate(c, m, t2) - let match = typeRel(m, t2, t1) != isNone + let match = typeRel(m, t2, t1) >= isSubtype # isNone result = newIntNode(nkIntLit, ord(match)) result.typ = n.typ @@ -456,7 +456,7 @@ proc changeType(n: PNode, newType: PType, check: bool) = internalError(m.info, "changeType(): invalid tuple constr") return if tup.n != nil: - var f = getSymFromList(newType.n, m.sym.name) + var f = getSymFromList(tup.n, m.sym.name) if f == nil: internalError(m.info, "changeType(): invalid identifier") return @@ -1133,19 +1133,20 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = ## returns nil if not a built-in subscript operator; also called for the ## checking of assignments if sonsLen(n) == 1: - var x = semDeref(c, n) + let x = semDeref(c, n) if x == nil: return nil result = newNodeIT(nkDerefExpr, x.info, x.typ) result.add(x[0]) return checkMinSonsLen(n, 2) n.sons[0] = semExprWithType(c, n.sons[0]) - var arr = skipTypes(n.sons[0].typ, {tyGenericInst, tyVar, tyPtr, tyRef}) + let arr = skipTypes(n.sons[0].typ, {tyGenericInst, tyVar, tyPtr, tyRef}) case arr.kind of tyArray, tyOpenArray, tyVarargs, tyArrayConstr, tySequence, tyString, tyCString: if n.len != 2: return nil n.sons[0] = makeDeref(n.sons[0]) + c.p.bracketExpr = n.sons[0] for i in countup(1, sonsLen(n) - 1): n.sons[i] = semExprWithType(c, n.sons[i], flags*{efInTypeof, efDetermineType}) @@ -1166,6 +1167,7 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = of tyTuple: checkSonsLen(n, 2) n.sons[0] = makeDeref(n.sons[0]) + c.p.bracketExpr = n.sons[0] # [] operator for tuples requires constant expression: n.sons[1] = semConstExpr(c, n.sons[1]) if skipTypes(n.sons[1].typ, {tyGenericInst, tyRange, tyOrdinal}).kind in @@ -1176,13 +1178,16 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = else: localError(n.info, errIndexTypesDoNotMatch) result = n - else: discard + else: + c.p.bracketExpr = n.sons[0] proc semArrayAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = + let oldBracketExpr = c.p.bracketExpr result = semSubscript(c, n, flags) if result == nil: # overloaded [] operator: result = semExpr(c, buildOverloadedSubscripts(n, getIdent"[]")) + c.p.bracketExpr = oldBracketExpr proc propertyWriteAccess(c: PContext, n, nOrig, a: PNode): PNode = var id = considerQuotedIdent(a[1]) @@ -1249,11 +1254,15 @@ proc semAsgn(c: PContext, n: PNode): PNode = of nkBracketExpr: # a[i] = x # --> `[]=`(a, i, x) + let oldBracketExpr = c.p.bracketExpr a = semSubscript(c, a, {efLValue}) if a == nil: result = buildOverloadedSubscripts(n.sons[0], getIdent"[]=") add(result, n[1]) - return semExprNoType(c, result) + result = semExprNoType(c, result) + c.p.bracketExpr = oldBracketExpr + return result + c.p.bracketExpr = oldBracketExpr of nkCurlyExpr: # a{i} = x --> `{}=`(a, i, x) result = buildOverloadedSubscripts(n.sons[0], getIdent"{}=") @@ -1289,6 +1298,9 @@ proc semAsgn(c: PContext, n: PNode): PNode = typeMismatch(n, lhs.typ, rhs.typ) n.sons[1] = fitNode(c, le, rhs) + if tfHasAsgn in lhs.typ.flags and not lhsIsResult: + return overloadedAsgn(c, lhs, n.sons[1]) + fixAbstractType(c, n) asgnToResultVar(c, n, n.sons[0], n.sons[1]) result = n @@ -1672,6 +1684,12 @@ proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = # DON'T forget to update ast.SpecialSemMagics if you add a magic here! result = n case s.magic # magics that need special treatment + of mAddr: + checkSonsLen(n, 2) + result = semAddr(c, n.sons[1]) + of mTypeOf: + checkSonsLen(n, 2) + result = semTypeOf(c, n.sons[1]) of mDefined: result = semDefined(c, setMs(n, s), false) of mDefinedInScope: result = semDefined(c, setMs(n, s), true) of mCompiles: result = semCompiles(c, setMs(n, s), flags) @@ -1889,7 +1907,8 @@ proc checkInitialized(n: PNode, ids: IntSet, info: TLineInfo) = of nkOfBranch, nkElse: checkInitialized(lastSon(n.sons[i]), ids, info) else: internalError(info, "checkInitialized") of nkSym: - if tfNeedsInit in n.sym.typ.flags and n.sym.name.id notin ids: + if {tfNotNil, tfNeedsInit} * n.sym.typ.flags != {} and + n.sym.name.id notin ids: message(info, errGenerated, "field not initialized: " & n.sym.name.s) else: internalError(info, "checkInitialized") @@ -2005,7 +2024,7 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = case n.kind of nkIdent, nkAccQuoted: var s = lookUp(c, n) - semCaptureSym(s, c.p.owner) + if c.inTypeClass == 0: semCaptureSym(s, c.p.owner) result = semSym(c, n, s, flags) if s.kind in {skProc, skMethod, skConverter}+skIterators: #performProcvarCheck(c, n, s) @@ -2155,10 +2174,7 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = of nkAddr: result = n checkSonsLen(n, 1) - n.sons[0] = semExprWithType(c, n.sons[0]) - if isAssignable(c, n.sons[0]) notin {arLValue, arLocalLValue}: - localError(n.info, errExprHasNoAddress) - n.typ = makePtrType(c, n.sons[0].typ) + result = semAddr(c, n.sons[0]) of nkHiddenAddr, nkHiddenDeref: checkSonsLen(n, 1) n.sons[0] = semExpr(c, n.sons[0], flags) @@ -2224,6 +2240,8 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = result = semPragmaBlock(c, n) of nkStaticStmt: result = semStaticStmt(c, n) + of nkDefer: + localError(n.info, errGenerated, "'defer' not allowed in this context") else: localError(n.info, errInvalidExpressionX, renderTree(n, {renderNoComments})) diff --git a/compiler/semfold.nim b/compiler/semfold.nim index a3f1b1c13..0150a3405 100644 --- a/compiler/semfold.nim +++ b/compiler/semfold.nim @@ -10,8 +10,8 @@ # this module folds constants; used by semantic checking phase # and evaluation phase -import - strutils, lists, options, ast, astalgo, trees, treetab, nimsets, times, +import + strutils, lists, options, ast, astalgo, trees, treetab, nimsets, times, nversion, platform, math, msgs, os, condsyms, idents, renderer, types, commands, magicsys, saturate @@ -41,7 +41,7 @@ proc newIntNodeT(intVal: BiggestInt, n: PNode): PNode = result.typ = n.typ result.info = n.info -proc newFloatNodeT(floatVal: BiggestFloat, n: PNode): PNode = +proc newFloatNodeT(floatVal: BiggestFloat, n: PNode): PNode = result = newFloatNode(nkFloatLit, floatVal) if skipTypes(n.typ, abstractVarRange).kind == tyFloat: result.typ = getFloatLitType(result) @@ -49,27 +49,27 @@ proc newFloatNodeT(floatVal: BiggestFloat, n: PNode): PNode = result.typ = n.typ result.info = n.info -proc newStrNodeT(strVal: string, n: PNode): PNode = +proc newStrNodeT(strVal: string, n: PNode): PNode = result = newStrNode(nkStrLit, strVal) result.typ = n.typ result.info = n.info -proc ordinalValToString*(a: PNode): string = +proc ordinalValToString*(a: PNode): string = # because $ has the param ordinal[T], `a` is not necessarily an enum, but an # ordinal var x = getInt(a) - + var t = skipTypes(a.typ, abstractRange) case t.kind - of tyChar: + of tyChar: result = $chr(int(x) and 0xff) of tyEnum: var n = t.n - for i in countup(0, sonsLen(n) - 1): + for i in countup(0, sonsLen(n) - 1): if n.sons[i].kind != nkSym: internalError(a.info, "ordinalValToString") var field = n.sons[i].sym - if field.position == x: - if field.ast == nil: + if field.position == x: + if field.ast == nil: return field.name.s else: return field.ast.strVal @@ -112,12 +112,15 @@ proc pickMaxInt(n: PNode): BiggestInt = else: internalError(n.info, "pickMaxInt") -proc makeRange(typ: PType, first, last: BiggestInt): PType = +proc makeRange(typ: PType, first, last: BiggestInt): PType = let minA = min(first, last) let maxA = max(first, last) let lowerNode = newIntNode(nkIntLit, minA) if typ.kind == tyInt and minA == maxA: result = getIntLitType(lowerNode) + elif typ.kind in {tyUint, tyUInt64}: + # these are not ordinal types, so you get no subrange type for these: + result = typ else: var n = newNode(nkRange) addSon(n, lowerNode) @@ -135,10 +138,11 @@ proc makeRangeF(typ: PType, first, last: BiggestFloat): PType = addSonSkipIntLit(result, skipTypes(typ, {tyRange})) proc getIntervalType*(m: TMagic, n: PNode): PType = - # Nimrod requires interval arithmetic for ``range`` types. Lots of tedious + # Nim requires interval arithmetic for ``range`` types. Lots of tedious # work but the feature is very nice for reducing explicit conversions. + const ordIntLit = {nkIntLit..nkUInt64Lit} result = n.typ - + template commutativeOp(opr: expr) {.immediate.} = let a = n.sons[1] let b = n.sons[2] @@ -146,7 +150,7 @@ proc getIntervalType*(m: TMagic, n: PNode): PType = result = makeRange(pickIntRange(a.typ, b.typ), opr(pickMinInt(a), pickMinInt(b)), opr(pickMaxInt(a), pickMaxInt(b))) - + template binaryOp(opr: expr) {.immediate.} = let a = n.sons[1] let b = n.sons[2] @@ -154,7 +158,7 @@ proc getIntervalType*(m: TMagic, n: PNode): PType = result = makeRange(a.typ, opr(pickMinInt(a), pickMinInt(b)), opr(pickMaxInt(a), pickMaxInt(b))) - + case m of mUnaryMinusI, mUnaryMinusI64: let a = n.sons[1].typ @@ -170,13 +174,19 @@ proc getIntervalType*(m: TMagic, n: PNode): PType = let a = n.sons[1].typ if isFloatRange(a): # abs(-5.. 1) == (1..5) - result = makeRangeF(a, abs(getFloat(a.n.sons[1])), - abs(getFloat(a.n.sons[0]))) + if a.n[0].floatVal <= 0.0: + result = makeRangeF(a, 0.0, abs(getFloat(a.n.sons[0]))) + else: + result = makeRangeF(a, abs(getFloat(a.n.sons[1])), + abs(getFloat(a.n.sons[0]))) of mAbsI, mAbsI64: let a = n.sons[1].typ if isIntRange(a): - result = makeRange(a, `|abs|`(getInt(a.n.sons[1])), - `|abs|`(getInt(a.n.sons[0]))) + if a.n[0].intVal <= 0: + result = makeRange(a, 0, `|abs|`(getInt(a.n.sons[0]))) + else: + result = makeRange(a, `|abs|`(getInt(a.n.sons[1])), + `|abs|`(getInt(a.n.sons[0]))) of mSucc: let a = n.sons[1].typ let b = n.sons[2].typ @@ -202,15 +212,15 @@ proc getIntervalType*(m: TMagic, n: PNode): PType = var a = n.sons[1] var b = n.sons[2] # symmetrical: - if b.kind notin {nkIntLit..nkUInt32Lit}: swap(a, b) - if b.kind in {nkIntLit..nkUInt32Lit}: + if b.kind notin ordIntLit: swap(a, b) + if b.kind in ordIntLit: let x = b.intVal|+|1 if (x and -x) == x and x >= 0: result = makeRange(a.typ, 0, b.intVal) of mModU: let a = n.sons[1] let b = n.sons[2] - if b.kind in {nkIntLit..nkUInt32Lit}: + if a.kind in ordIntLit: if b.intVal >= 0: result = makeRange(a.typ, 0, b.intVal-1) else: @@ -226,12 +236,12 @@ proc getIntervalType*(m: TMagic, n: PNode): PType = result = makeRange(a.typ, b.intVal+1, -(b.intVal+1)) of mDivI, mDivI64, mDivU: binaryOp(`|div|`) - of mMinI, mMinI64: + of mMinI: commutativeOp(min) - of mMaxI, mMaxI64: + of mMaxI: commutativeOp(max) else: discard - + discard """ mShlI, mShlI64, mShrI, mShrI64, mAddF64, mSubF64, mMulF64, mDivF64, mMaxF64, mMinF64 @@ -242,7 +252,7 @@ proc evalIs(n, a: PNode): PNode = internalAssert a.kind == nkSym and a.sym.kind == skType internalAssert n.sonsLen == 3 and n[2].kind in {nkStrLit..nkTripleStrLit, nkType} - + let t1 = a.sym.typ if n[2].kind in {nkStrLit..nkTripleStrLit}: @@ -250,12 +260,12 @@ proc evalIs(n, a: PNode): PNode = of "closure": let t = skipTypes(t1, abstractRange) result = newIntNode(nkIntLit, ord(t.kind == tyProc and - t.callConv == ccClosure and + t.callConv == ccClosure and tfIterator notin t.flags)) of "iterator": let t = skipTypes(t1, abstractRange) result = newIntNode(nkIntLit, ord(t.kind == tyProc and - t.callConv == ccClosure and + t.callConv == ccClosure and tfIterator in t.flags)) else: discard else: @@ -265,7 +275,7 @@ proc evalIs(n, a: PNode): PNode = result = newIntNode(nkIntLit, ord(match)) result.typ = n.typ -proc evalOp(m: TMagic, n, a, b, c: PNode): PNode = +proc evalOp(m: TMagic, n, a, b, c: PNode): PNode = # b and c may be nil result = nil case m @@ -276,18 +286,19 @@ proc evalOp(m: TMagic, n, a, b, c: PNode): PNode = of mNot: result = newIntNodeT(1 - getInt(a), n) of mCard: result = newIntNodeT(nimsets.cardSet(a), n) of mBitnotI, mBitnotI64: result = newIntNodeT(not getInt(a), n) - of mLengthStr: result = newIntNodeT(len(getStr(a)), n) + of mLengthStr, mXLenStr: result = newIntNodeT(len(getStr(a)), n) of mLengthArray: result = newIntNodeT(lengthOrd(a.typ), n) - of mLengthSeq, mLengthOpenArray: result = newIntNodeT(sonsLen(a), n) # BUGFIX - of mUnaryPlusI, mUnaryPlusI64, mUnaryPlusF64: result = a # throw `+` away - of mToFloat, mToBiggestFloat: + of mLengthSeq, mLengthOpenArray, mXLenSeq: + result = newIntNodeT(sonsLen(a), n) # BUGFIX + of mUnaryPlusI, mUnaryPlusF64: result = a # throw `+` away + of mToFloat, mToBiggestFloat: result = newFloatNodeT(toFloat(int(getInt(a))), n) of mToInt, mToBiggestInt: result = newIntNodeT(system.toInt(getFloat(a)), n) of mAbsF64: result = newFloatNodeT(abs(getFloat(a)), n) - of mAbsI, mAbsI64: + of mAbsI, mAbsI64: if getInt(a) >= 0: result = a else: result = newIntNodeT(- getInt(a), n) - of mZe8ToI, mZe8ToI64, mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64: + of mZe8ToI, mZe8ToI64, mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64: # byte(-128) = 1...1..1000_0000'64 --> 0...0..1000_0000'64 result = newIntNodeT(getInt(a) and (`shl`(1, getSize(a.typ) * 8) - 1), n) of mToU8: result = newIntNodeT(getInt(a) and 0x000000FF, n) @@ -299,21 +310,21 @@ proc evalOp(m: TMagic, n, a, b, c: PNode): PNode = of mAddI, mAddI64: result = newIntNodeT(getInt(a) + getInt(b), n) of mSubI, mSubI64: result = newIntNodeT(getInt(a) - getInt(b), n) of mMulI, mMulI64: result = newIntNodeT(getInt(a) * getInt(b), n) - of mMinI, mMinI64: + of mMinI: if getInt(a) > getInt(b): result = newIntNodeT(getInt(b), n) else: result = newIntNodeT(getInt(a), n) - of mMaxI, mMaxI64: + of mMaxI: if getInt(a) > getInt(b): result = newIntNodeT(getInt(a), n) else: result = newIntNodeT(getInt(b), n) - of mShlI, mShlI64: + of mShlI, mShlI64: case skipTypes(n.typ, abstractRange).kind of tyInt8: result = newIntNodeT(int8(getInt(a)) shl int8(getInt(b)), n) of tyInt16: result = newIntNodeT(int16(getInt(a)) shl int16(getInt(b)), n) of tyInt32: result = newIntNodeT(int32(getInt(a)) shl int32(getInt(b)), n) - of tyInt64, tyInt, tyUInt..tyUInt64: + of tyInt64, tyInt, tyUInt..tyUInt64: result = newIntNodeT(`shl`(getInt(a), getInt(b)), n) else: internalError(n.info, "constant folding for shl") - of mShrI, mShrI64: + of mShrI, mShrI64: case skipTypes(n.typ, abstractRange).kind of tyInt8: result = newIntNodeT(int8(getInt(a)) shr int8(getInt(b)), n) of tyInt16: result = newIntNodeT(int16(getInt(a)) shr int16(getInt(b)), n) @@ -332,34 +343,34 @@ proc evalOp(m: TMagic, n, a, b, c: PNode): PNode = of mAddF64: result = newFloatNodeT(getFloat(a) + getFloat(b), n) of mSubF64: result = newFloatNodeT(getFloat(a) - getFloat(b), n) of mMulF64: result = newFloatNodeT(getFloat(a) * getFloat(b), n) - of mDivF64: - if getFloat(b) == 0.0: + of mDivF64: + if getFloat(b) == 0.0: if getFloat(a) == 0.0: result = newFloatNodeT(NaN, n) else: result = newFloatNodeT(Inf, n) - else: + else: result = newFloatNodeT(getFloat(a) / getFloat(b), n) - of mMaxF64: + of mMaxF64: if getFloat(a) > getFloat(b): result = newFloatNodeT(getFloat(a), n) else: result = newFloatNodeT(getFloat(b), n) - of mMinF64: + of mMinF64: if getFloat(a) > getFloat(b): result = newFloatNodeT(getFloat(b), n) else: result = newFloatNodeT(getFloat(a), n) of mIsNil: result = newIntNodeT(ord(a.kind == nkNilLit), n) - of mLtI, mLtI64, mLtB, mLtEnum, mLtCh: + of mLtI, mLtI64, mLtB, mLtEnum, mLtCh: result = newIntNodeT(ord(getOrdValue(a) < getOrdValue(b)), n) - of mLeI, mLeI64, mLeB, mLeEnum, mLeCh: + of mLeI, mLeI64, mLeB, mLeEnum, mLeCh: result = newIntNodeT(ord(getOrdValue(a) <= getOrdValue(b)), n) - of mEqI, mEqI64, mEqB, mEqEnum, mEqCh: - result = newIntNodeT(ord(getOrdValue(a) == getOrdValue(b)), n) + of mEqI, mEqI64, mEqB, mEqEnum, mEqCh: + result = newIntNodeT(ord(getOrdValue(a) == getOrdValue(b)), n) of mLtF64: result = newIntNodeT(ord(getFloat(a) < getFloat(b)), n) of mLeF64: result = newIntNodeT(ord(getFloat(a) <= getFloat(b)), n) - of mEqF64: result = newIntNodeT(ord(getFloat(a) == getFloat(b)), n) + of mEqF64: result = newIntNodeT(ord(getFloat(a) == getFloat(b)), n) of mLtStr: result = newIntNodeT(ord(getStr(a) < getStr(b)), n) of mLeStr: result = newIntNodeT(ord(getStr(a) <= getStr(b)), n) of mEqStr: result = newIntNodeT(ord(getStr(a) == getStr(b)), n) - of mLtU, mLtU64: + of mLtU, mLtU64: result = newIntNodeT(ord(`<%`(getOrdValue(a), getOrdValue(b))), n) - of mLeU, mLeU64: + of mLeU, mLeU64: result = newIntNodeT(ord(`<=%`(getOrdValue(a), getOrdValue(b))), n) of mBitandI, mBitandI64, mAnd: result = newIntNodeT(a.getInt and b.getInt, n) of mBitorI, mBitorI64, mOr: result = newIntNodeT(getInt(a) or getInt(b), n) @@ -377,18 +388,18 @@ proc evalOp(m: TMagic, n, a, b, c: PNode): PNode = result = newIntNodeT(`/%`(getInt(a), y), n) of mLeSet: result = newIntNodeT(ord(containsSets(a, b)), n) of mEqSet: result = newIntNodeT(ord(equalSets(a, b)), n) - of mLtSet: + of mLtSet: result = newIntNodeT(ord(containsSets(a, b) and not equalSets(a, b)), n) - of mMulSet: + of mMulSet: result = nimsets.intersectSets(a, b) result.info = n.info - of mPlusSet: + of mPlusSet: result = nimsets.unionSets(a, b) result.info = n.info - of mMinusSet: + of mMinusSet: result = nimsets.diffSets(a, b) result.info = n.info - of mSymDiffSet: + of mSymDiffSet: result = nimsets.symdiffSets(a, b) result.info = n.info of mConStrStr: result = newStrNodeT(getStrOrChar(a) & getStrOrChar(b), n) @@ -397,104 +408,104 @@ proc evalOp(m: TMagic, n, a, b, c: PNode): PNode = # BUGFIX: we cannot eval mRepr here for reasons that I forgot. discard of mIntToStr, mInt64ToStr: result = newStrNodeT($(getOrdValue(a)), n) - of mBoolToStr: + of mBoolToStr: if getOrdValue(a) == 0: result = newStrNodeT("false", n) else: result = newStrNodeT("true", n) of mCopyStr: result = newStrNodeT(substr(getStr(a), int(getOrdValue(b))), n) - of mCopyStrLast: - result = newStrNodeT(substr(getStr(a), int(getOrdValue(b)), + of mCopyStrLast: + result = newStrNodeT(substr(getStr(a), int(getOrdValue(b)), int(getOrdValue(c))), n) of mFloatToStr: result = newStrNodeT($getFloat(a), n) of mCStrToStr, mCharToStr: result = newStrNodeT(getStrOrChar(a), n) of mStrToStr: result = a of mEnumToStr: result = newStrNodeT(ordinalValToString(a), n) - of mArrToSeq: + of mArrToSeq: result = copyTree(a) result.typ = n.typ of mCompileOption: - result = newIntNodeT(ord(commands.testCompileOption(a.getStr, n.info)), n) + result = newIntNodeT(ord(commands.testCompileOption(a.getStr, n.info)), n) of mCompileOptionArg: result = newIntNodeT(ord( testCompileOptionArg(getStr(a), getStr(b), n.info)), n) - of mNewString, mNewStringOfCap, - mExit, mInc, ast.mDec, mEcho, mSwap, mAppendStrCh, - mAppendStrStr, mAppendSeqElem, mSetLengthStr, mSetLengthSeq, - mParseExprToAst, mParseStmtToAst, mExpandToAst, mTypeTrait, + of mNewString, mNewStringOfCap, + mExit, mInc, ast.mDec, mEcho, mSwap, mAppendStrCh, + mAppendStrStr, mAppendSeqElem, mSetLengthStr, mSetLengthSeq, + mParseExprToAst, mParseStmtToAst, mExpandToAst, mTypeTrait, mDotDot, mNLen..mNError, mEqRef, mSlurp, mStaticExec, mNGenSym, mSpawn, mParallel: discard else: internalError(a.info, "evalOp(" & $m & ')') - -proc getConstIfExpr(c: PSym, n: PNode): PNode = + +proc getConstIfExpr(c: PSym, n: PNode): PNode = result = nil - for i in countup(0, sonsLen(n) - 1): + for i in countup(0, sonsLen(n) - 1): var it = n.sons[i] if it.len == 2: var e = getConstExpr(c, it.sons[0]) if e == nil: return nil - if getOrdValue(e) != 0: - if result == nil: + if getOrdValue(e) != 0: + if result == nil: result = getConstExpr(c, it.sons[1]) - if result == nil: return + if result == nil: return elif it.len == 1: if result == nil: result = getConstExpr(c, it.sons[0]) else: internalError(it.info, "getConstIfExpr()") -proc partialAndExpr(c: PSym, n: PNode): PNode = +proc partialAndExpr(c: PSym, n: PNode): PNode = # partial evaluation result = n var a = getConstExpr(c, n.sons[1]) var b = getConstExpr(c, n.sons[2]) - if a != nil: + if a != nil: if getInt(a) == 0: result = a elif b != nil: result = b else: result = n.sons[2] - elif b != nil: + elif b != nil: if getInt(b) == 0: result = b else: result = n.sons[1] - -proc partialOrExpr(c: PSym, n: PNode): PNode = + +proc partialOrExpr(c: PSym, n: PNode): PNode = # partial evaluation result = n var a = getConstExpr(c, n.sons[1]) var b = getConstExpr(c, n.sons[2]) - if a != nil: + if a != nil: if getInt(a) != 0: result = a elif b != nil: result = b else: result = n.sons[2] - elif b != nil: + elif b != nil: if getInt(b) != 0: result = b else: result = n.sons[1] - -proc leValueConv(a, b: PNode): bool = + +proc leValueConv(a, b: PNode): bool = result = false case a.kind - of nkCharLit..nkUInt64Lit: + of nkCharLit..nkUInt64Lit: case b.kind of nkCharLit..nkUInt64Lit: result = a.intVal <= b.intVal of nkFloatLit..nkFloat128Lit: result = a.intVal <= round(b.floatVal) else: internalError(a.info, "leValueConv") - of nkFloatLit..nkFloat128Lit: + of nkFloatLit..nkFloat128Lit: case b.kind of nkFloatLit..nkFloat128Lit: result = a.floatVal <= b.floatVal of nkCharLit..nkUInt64Lit: result = a.floatVal <= toFloat(int(b.intVal)) else: internalError(a.info, "leValueConv") else: internalError(a.info, "leValueConv") - + proc magicCall(m: PSym, n: PNode): PNode = if sonsLen(n) <= 1: return var s = n.sons[0].sym var a = getConstExpr(m, n.sons[1]) var b, c: PNode - if a == nil: return - if sonsLen(n) > 2: + if a == nil: return + if sonsLen(n) > 2: b = getConstExpr(m, n.sons[2]) - if b == nil: return - if sonsLen(n) > 3: + if b == nil: return + if sonsLen(n) > 3: c = getConstExpr(m, n.sons[3]) - if c == nil: return + if c == nil: return result = evalOp(s.magic, n, a, b, c) - + proc getAppType(n: PNode): PNode = if gGlobalOptions.contains(optGenDynLib): result = newStrNodeT("lib", n) @@ -510,48 +521,48 @@ proc rangeCheck(n: PNode, value: BiggestInt) = localError(n.info, errGenerated, "cannot convert " & $value & " to " & typeToString(n.typ)) -proc foldConv*(n, a: PNode; check = false): PNode = +proc foldConv*(n, a: PNode; check = false): PNode = # XXX range checks? case skipTypes(n.typ, abstractRange).kind - of tyInt..tyInt64: + of tyInt..tyInt64: case skipTypes(a.typ, abstractRange).kind of tyFloat..tyFloat64: result = newIntNodeT(int(getFloat(a)), n) of tyChar: result = newIntNodeT(getOrdValue(a), n) - else: + else: result = a result.typ = n.typ if check: rangeCheck(n, result.intVal) of tyFloat..tyFloat64: case skipTypes(a.typ, abstractRange).kind - of tyInt..tyInt64, tyEnum, tyBool, tyChar: + of tyInt..tyInt64, tyEnum, tyBool, tyChar: result = newFloatNodeT(toFloat(int(getOrdValue(a))), n) else: result = a result.typ = n.typ - of tyOpenArray, tyVarargs, tyProc: + of tyOpenArray, tyVarargs, tyProc: discard - else: + else: result = a result.typ = n.typ - + proc getArrayConstr(m: PSym, n: PNode): PNode = if n.kind == nkBracket: result = n else: result = getConstExpr(m, n) if result == nil: result = n - -proc foldArrayAccess(m: PSym, n: PNode): PNode = + +proc foldArrayAccess(m: PSym, n: PNode): PNode = var x = getConstExpr(m, n.sons[0]) if x == nil or x.typ.skipTypes({tyGenericInst}).kind == tyTypeDesc: return - + var y = getConstExpr(m, n.sons[1]) if y == nil: return - + var idx = getOrdValue(y) case x.kind - of nkPar: + of nkPar: if idx >= 0 and idx < sonsLen(x): result = x.sons[int(idx)] if result.kind == nkExprColonExpr: result = result.sons[1] @@ -563,14 +574,14 @@ proc foldArrayAccess(m: PSym, n: PNode): PNode = else: localError(n.info, errIndexOutOfBounds) of nkStrLit..nkTripleStrLit: result = newNodeIT(nkCharLit, x.info, n.typ) - if idx >= 0 and idx < len(x.strVal): + if idx >= 0 and idx < len(x.strVal): result.intVal = ord(x.strVal[int(idx)]) - elif idx == len(x.strVal): + elif idx == len(x.strVal): discard - else: + else: localError(n.info, errIndexOutOfBounds) else: discard - + proc foldFieldAccess(m: PSym, n: PNode): PNode = # a real field access; proc calls have already been transformed var x = getConstExpr(m, n.sons[0]) @@ -584,15 +595,15 @@ proc foldFieldAccess(m: PSym, n: PNode): PNode = result = x.sons[field.position] if result.kind == nkExprColonExpr: result = result.sons[1] return - if it.sons[0].sym.name.id == field.name.id: + if it.sons[0].sym.name.id == field.name.id: result = x.sons[i].sons[1] return localError(n.info, errFieldXNotFound, field.name.s) - -proc foldConStrStr(m: PSym, n: PNode): PNode = + +proc foldConStrStr(m: PSym, n: PNode): PNode = result = newNodeIT(nkStrLit, n.info, n.typ) result.strVal = "" - for i in countup(1, sonsLen(n) - 1): + for i in countup(1, sonsLen(n) - 1): let a = getConstExpr(m, n.sons[i]) if a == nil: return nil result.strVal.add(getStrOrChar(a)) @@ -602,10 +613,10 @@ proc newSymNodeTypeDesc*(s: PSym; info: TLineInfo): PNode = result.typ = newType(tyTypeDesc, s.owner) result.typ.addSonSkipIntLit(s.typ) -proc getConstExpr(m: PSym, n: PNode): PNode = +proc getConstExpr(m: PSym, n: PNode): PNode = result = nil case n.kind - of nkSym: + of nkSym: var s = n.sym case s.kind of skEnumField: @@ -636,14 +647,14 @@ proc getConstExpr(m: PSym, n: PNode): PNode = else: result = newSymNodeTypeDesc(s, n.info) else: discard - of nkCharLit..nkNilLit: + of nkCharLit..nkNilLit: result = copyNode(n) - of nkIfExpr: + of nkIfExpr: result = getConstIfExpr(m, n) - of nkCall, nkCommand, nkCallStrLit, nkPrefix, nkInfix: - if n.sons[0].kind != nkSym: return + of nkCall, nkCommand, nkCallStrLit, nkPrefix, nkInfix: + if n.sons[0].kind != nkSym: return var s = n.sons[0].sym - if s.kind != skProc: return + if s.kind != skProc: return try: case s.magic of mNone: @@ -651,8 +662,8 @@ proc getConstExpr(m: PSym, n: PNode): PNode = return of mSizeOf: var a = n.sons[1] - if computeSize(a.typ) < 0: - localError(a.info, errCannotEvalXBecauseIncompletelyDefined, + if computeSize(a.typ) < 0: + localError(a.info, errCannotEvalXBecauseIncompletelyDefined, "sizeof") result = nil elif skipTypes(a.typ, typedescInst).kind in @@ -662,21 +673,21 @@ proc getConstExpr(m: PSym, n: PNode): PNode = else: result = nil # XXX: size computation for complex types is still wrong - of mLow: + of mLow: result = newIntNodeT(firstOrd(n.sons[1].typ), n) - of mHigh: + of mHigh: if skipTypes(n.sons[1].typ, abstractVar).kind notin {tySequence, tyString, tyCString, tyOpenArray, tyVarargs}: result = newIntNodeT(lastOrd(skipTypes(n[1].typ, abstractVar)), n) else: var a = getArrayConstr(m, n.sons[1]) if a.kind == nkBracket: - # we can optimize it away: + # we can optimize it away: result = newIntNodeT(sonsLen(a)-1, n) of mLengthOpenArray: var a = getArrayConstr(m, n.sons[1]) if a.kind == nkBracket: - # we can optimize it away! This fixes the bug ``len(134)``. + # we can optimize it away! This fixes the bug ``len(134)``. result = newIntNodeT(sonsLen(a), n) else: result = magicCall(m, n) @@ -694,33 +705,33 @@ proc getConstExpr(m: PSym, n: PNode): PNode = result = evalIs(n, a) else: result = magicCall(m, n) - except OverflowError: + except OverflowError: localError(n.info, errOverOrUnderflow) - except DivByZeroError: + except DivByZeroError: localError(n.info, errConstantDivisionByZero) - of nkAddr: + of nkAddr: var a = getConstExpr(m, n.sons[0]) - if a != nil: + if a != nil: result = n n.sons[0] = a - of nkBracket: + of nkBracket: result = copyTree(n) - for i in countup(0, sonsLen(n) - 1): + for i in countup(0, sonsLen(n) - 1): var a = getConstExpr(m, n.sons[i]) if a == nil: return nil result.sons[i] = a incl(result.flags, nfAllConst) - of nkRange: + of nkRange: var a = getConstExpr(m, n.sons[0]) - if a == nil: return + if a == nil: return var b = getConstExpr(m, n.sons[1]) - if b == nil: return + if b == nil: return result = copyNode(n) addSon(result, a) addSon(result, b) - of nkCurly: + of nkCurly: result = copyTree(n) - for i in countup(0, sonsLen(n) - 1): + for i in countup(0, sonsLen(n) - 1): var a = getConstExpr(m, n.sons[i]) if a == nil: return nil result.sons[i] = a @@ -735,33 +746,33 @@ proc getConstExpr(m: PSym, n: PNode): PNode = of nkPar: # tuple constructor result = copyTree(n) - if (sonsLen(n) > 0) and (n.sons[0].kind == nkExprColonExpr): - for i in countup(0, sonsLen(n) - 1): + if (sonsLen(n) > 0) and (n.sons[0].kind == nkExprColonExpr): + for i in countup(0, sonsLen(n) - 1): var a = getConstExpr(m, n.sons[i].sons[1]) if a == nil: return nil result.sons[i].sons[1] = a - else: - for i in countup(0, sonsLen(n) - 1): + else: + for i in countup(0, sonsLen(n) - 1): var a = getConstExpr(m, n.sons[i]) if a == nil: return nil result.sons[i] = a incl(result.flags, nfAllConst) - of nkChckRangeF, nkChckRange64, nkChckRange: + of nkChckRangeF, nkChckRange64, nkChckRange: var a = getConstExpr(m, n.sons[0]) - if a == nil: return - if leValueConv(n.sons[1], a) and leValueConv(a, n.sons[2]): + if a == nil: return + if leValueConv(n.sons[1], a) and leValueConv(a, n.sons[2]): result = a # a <= x and x <= b result.typ = n.typ - else: + else: localError(n.info, errGenerated, `%`( - msgKindToString(errIllegalConvFromXtoY), + msgKindToString(errIllegalConvFromXtoY), [typeToString(n.sons[0].typ), typeToString(n.typ)])) - of nkStringToCString, nkCStringToString: + of nkStringToCString, nkCStringToString: var a = getConstExpr(m, n.sons[0]) - if a == nil: return + if a == nil: return result = a result.typ = n.typ - of nkHiddenStdConv, nkHiddenSubConv, nkConv: + of nkHiddenStdConv, nkHiddenSubConv, nkConv: var a = getConstExpr(m, n.sons[1]) if a == nil: return result = foldConv(n, a, check=n.kind == nkHiddenStdConv) diff --git a/compiler/seminst.nim b/compiler/seminst.nim index dc36ecf34..f72e2dc5b 100644 --- a/compiler/seminst.nim +++ b/compiler/seminst.nim @@ -176,7 +176,9 @@ proc instantiateProcType(c: PContext, pt: TIdTable, for i in 1 .. <result.len: # twrong_field_caching requires these 'resetIdTable' calls: - if i > 1: resetIdTable(cl.symMap) + if i > 1: + resetIdTable(cl.symMap) + resetIdTable(cl.localCache) result.sons[i] = replaceTypeVarsT(cl, result.sons[i]) propagateToOwner(result, result.sons[i]) internalAssert originalParams[i].kind == nkSym @@ -196,6 +198,7 @@ proc instantiateProcType(c: PContext, pt: TIdTable, addDecl(c, result.n.sons[i].sym) resetIdTable(cl.symMap) + resetIdTable(cl.localCache) result.sons[0] = replaceTypeVarsT(cl, result.sons[0]) result.n.sons[0] = originalParams[0].copyTree diff --git a/compiler/semmagic.nim b/compiler/semmagic.nim index d5d6bbbd3..478e2cf37 100644 --- a/compiler/semmagic.nim +++ b/compiler/semmagic.nim @@ -10,10 +10,24 @@ # This include file implements the semantic checking for magics. # included from sem.nim +proc semAddr(c: PContext; n: PNode): PNode = + result = newNodeI(nkAddr, n.info) + let x = semExprWithType(c, n) + if isAssignable(c, x) notin {arLValue, arLocalLValue}: + localError(n.info, errExprHasNoAddress) + result.add x + result.typ = makePtrType(c, x.typ) + +proc semTypeOf(c: PContext; n: PNode): PNode = + result = newNodeI(nkTypeOfExpr, n.info) + let typExpr = semExprWithType(c, n, {efInTypeof}) + result.add typExpr + result.typ = makeTypeDesc(c, typExpr.typ.skipTypes({tyTypeDesc, tyIter})) + proc semIsPartOf(c: PContext, n: PNode, flags: TExprFlags): PNode = var r = isPartOf(n[1], n[2]) result = newIntNodeT(ord(r), n) - + proc expectIntLit(c: PContext, n: PNode): int = let x = c.semConstExpr(c, n) case x.kind @@ -31,7 +45,7 @@ proc semInstantiationInfo(c: PContext, n: PNode): PNode = line.intVal = toLinenumber(info) result.add(filename) result.add(line) - + proc evalTypeTrait(trait: PNode, operand: PType, context: PSym): PNode = let typ = operand.skipTypes({tyTypeDesc}) case trait.sym.name.s.normalize @@ -40,7 +54,7 @@ proc evalTypeTrait(trait: PNode, operand: PType, context: PSym): PNode = result.typ = newType(tyString, context) result.info = trait.info of "arity": - result = newIntNode(nkIntLit, typ.n.len-1) + result = newIntNode(nkIntLit, typ.len - ord(typ.kind==tyProc)) result.typ = newType(tyInt, context) result.info = trait.info else: @@ -66,18 +80,18 @@ proc semOrd(c: PContext, n: PNode): PNode = proc semBindSym(c: PContext, n: PNode): PNode = result = copyNode(n) result.add(n.sons[0]) - + let sl = semConstExpr(c, n.sons[1]) - if sl.kind notin {nkStrLit, nkRStrLit, nkTripleStrLit}: + if sl.kind notin {nkStrLit, nkRStrLit, nkTripleStrLit}: localError(n.sons[1].info, errStringLiteralExpected) return errorNode(c, n) - + let isMixin = semConstExpr(c, n.sons[2]) if isMixin.kind != nkIntLit or isMixin.intVal < 0 or isMixin.intVal > high(TSymChoiceRule).int: localError(n.sons[2].info, errConstExprExpected) return errorNode(c, n) - + let id = newIdentNode(getIdent(sl.strVal), n.info) let s = qualifiedLookUp(c, id) if s != nil: @@ -110,15 +124,33 @@ proc semLocals(c: PContext, n: PNode): PNode = addSon(tupleType.n, newSymNode(field)) addSonSkipIntLit(tupleType, field.typ) - + var a = newSymNode(it, result.info) if it.typ.skipTypes({tyGenericInst}).kind == tyVar: a = newDeref(a) result.add(a) proc semShallowCopy(c: PContext, n: PNode, flags: TExprFlags): PNode -proc magicsAfterOverloadResolution(c: PContext, n: PNode, + +proc isStrangeArray(t: PType): bool = + let t = t.skipTypes(abstractInst) + result = t.kind == tyArray and t.firstOrd != 0 + +proc isNegative(n: PNode): bool = + let n = n.skipConv + if n.kind in {nkCharLit..nkUInt64Lit}: + result = n.intVal < 0 + elif n.kind in nkCallKinds and n.sons[0].kind == nkSym: + result = n.sons[0].sym.magic in {mUnaryMinusI, mUnaryMinusI64} + +proc magicsAfterOverloadResolution(c: PContext, n: PNode, flags: TExprFlags): PNode = case n[0].sym.magic + of mAddr: + checkSonsLen(n, 2) + result = semAddr(c, n.sons[1]) + of mTypeOf: + checkSonsLen(n, 2) + result = semTypeOf(c, n.sons[1]) of mIsPartOf: result = semIsPartOf(c, n, flags) of mTypeTrait: result = semTypeTraits(c, n) of mAstToStr: @@ -133,4 +165,42 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, of mProcCall: result = n result.typ = n[1].typ + of mDotDot: + result = n + # disallow negative indexing for now: + if not c.p.bracketExpr.isNil: + if isNegative(n.sons[1]) or (n.len > 2 and isNegative(n.sons[2])): + localError(n.info, "use '^' instead of '-'; negative indexing is obsolete") + of mRoof: + # error correction: + result = n.sons[1] + if c.p.bracketExpr.isNil: + localError(n.info, "no surrounding array access context for '^'") + elif c.p.bracketExpr.checkForSideEffects != seNoSideEffect: + localError(n.info, "invalid context for '^' as '$#' has side effects" % + renderTree(c.p.bracketExpr)) + elif c.p.bracketExpr.typ.isStrangeArray: + localError(n.info, "invalid context for '^' as len!=high+1 for '$#'" % + renderTree(c.p.bracketExpr)) + else: + # ^x is rewritten to: len(a)-x + let lenExpr = newNodeI(nkCall, n.info) + lenExpr.add newIdentNode(getIdent"len", n.info) + lenExpr.add c.p.bracketExpr + let lenExprB = semExprWithType(c, lenExpr) + if lenExprB.typ.isNil or not isOrdinalType(lenExprB.typ): + localError(n.info, "'$#' has to be of an ordinal type for '^'" % + renderTree(lenExpr)) + else: + result = newNodeIT(nkCall, n.info, getSysType(tyInt)) + result.add newSymNode(createMagic("-", mSubI), n.info) + result.add lenExprB + result.add n.sons[1] + of mPlugin: + let plugin = getPlugin(n[0].sym) + if plugin.isNil: + localError(n.info, "cannot find plugin " & n[0].sym.name.s) + result = n + else: + result = plugin(c, n) else: result = n diff --git a/compiler/sempass2.nim b/compiler/sempass2.nim index 48f54fa6c..5a243afa0 100644 --- a/compiler/sempass2.nim +++ b/compiler/sempass2.nim @@ -194,8 +194,38 @@ proc warnAboutGcUnsafe(n: PNode) = #assert false message(n.info, warnGcUnsafe, renderTree(n)) -template markGcUnsafe(a: PEffects) = +proc markGcUnsafe(a: PEffects; reason: PSym) = a.gcUnsafe = true + if a.owner.kind in routineKinds: a.owner.gcUnsafetyReason = reason + +proc markGcUnsafe(a: PEffects; reason: PNode) = + a.gcUnsafe = true + if a.owner.kind in routineKinds: + if reason.kind == nkSym: + a.owner.gcUnsafetyReason = reason.sym + else: + a.owner.gcUnsafetyReason = newSym(skUnknown, getIdent("<unknown>"), + a.owner, reason.info) + +proc listGcUnsafety(s: PSym; onlyWarning: bool) = + let u = s.gcUnsafetyReason + if u != nil: + let msgKind = if onlyWarning: warnGcUnsafe2 else: errGenerated + if u.kind in {skLet, skVar}: + message(s.info, msgKind, + ("'$#' is not GC-safe as it accesses '$#'" & + " which is a global using GC'ed memory") % [s.name.s, u.name.s]) + elif u.kind in routineKinds: + # recursive call *always* produces only a warning so the full error + # message is printed: + listGcUnsafety(u, true) + message(s.info, msgKind, + "'$#' is not GC-safe as it calls '$#'" % + [s.name.s, u.name.s]) + else: + internalAssert u.kind == skUnknown + message(u.info, msgKind, + "'$#' is not GC-safe as it performs an indirect call here" % s.name.s) proc useVar(a: PEffects, n: PNode) = let s = n.sym @@ -210,8 +240,8 @@ proc useVar(a: PEffects, n: PNode) = if {sfGlobal, sfThread} * s.flags == {sfGlobal} and s.kind in {skVar, skLet}: if s.guard != nil: guardGlobal(a, n, s.guard) if (tfHasGCedMem in s.typ.flags or s.typ.isGCedMem): - if warnGcUnsafe in gNotes: warnAboutGcUnsafe(n) - markGcUnsafe(a) + #if warnGcUnsafe in gNotes: warnAboutGcUnsafe(n) + markGcUnsafe(a, s) type TIntersection = seq[tuple[id, count: int]] # a simple count table @@ -450,7 +480,7 @@ proc propagateEffects(tracked: PEffects, n: PNode, s: PSym) = if notGcSafe(s.typ) and sfImportc notin s.flags: if warnGcUnsafe in gNotes: warnAboutGcUnsafe(n) - markGcUnsafe(tracked) + markGcUnsafe(tracked, s) mergeLockLevels(tracked, n, s.getLockLevel) proc notNilCheck(tracked: PEffects, n: PNode, paramType: PType) = @@ -504,13 +534,13 @@ proc trackOperand(tracked: PEffects, n: PNode, paramType: PType) = # assume GcUnsafe unless in its type; 'forward' does not matter: if notGcSafe(op) and not isOwnedProcVar(a, tracked.owner): if warnGcUnsafe in gNotes: warnAboutGcUnsafe(n) - markGcUnsafe(tracked) + markGcUnsafe(tracked, a) else: mergeEffects(tracked, effectList.sons[exceptionEffects], n) mergeTags(tracked, effectList.sons[tagEffects], n) if notGcSafe(op): if warnGcUnsafe in gNotes: warnAboutGcUnsafe(n) - markGcUnsafe(tracked) + markGcUnsafe(tracked, a) notNilCheck(tracked, n, paramType) proc breaksBlock(n: PNode): bool = @@ -658,7 +688,7 @@ proc track(tracked: PEffects, n: PNode) = # and it's not a recursive call: if not (a.kind == nkSym and a.sym == tracked.owner): warnAboutGcUnsafe(n) - markGcUnsafe(tracked) + markGcUnsafe(tracked, a) for i in 1 .. <len(n): trackOperand(tracked, n.sons[i], paramType(op, i)) if a.kind == nkSym and a.sym.magic in {mNew, mNewFinalize, mNewSeq}: # may not look like an assignment, but it is: @@ -734,7 +764,7 @@ proc track(tracked: PEffects, n: PNode) = setLen(tracked.locked, oldLocked) tracked.currLockLevel = oldLockLevel of nkTypeSection, nkProcDef, nkConverterDef, nkMethodDef, nkIteratorDef, - nkMacroDef, nkTemplateDef: + nkMacroDef, nkTemplateDef, nkLambda, nkDo: discard else: for i in 0 .. <safeLen(n): track(tracked, n.sons[i]) @@ -853,9 +883,11 @@ proc trackProc*(s: PSym, body: PNode) = if sfThread in s.flags and t.gcUnsafe: if optThreads in gGlobalOptions and optThreadAnalysis in gGlobalOptions: - localError(s.info, "'$1' is not GC-safe" % s.name.s) + #localError(s.info, "'$1' is not GC-safe" % s.name.s) + listGcUnsafety(s, onlyWarning=false) else: - localError(s.info, warnGcUnsafe2, s.name.s) + listGcUnsafety(s, onlyWarning=true) + #localError(s.info, warnGcUnsafe2, s.name.s) if not t.gcUnsafe: s.typ.flags.incl tfGcSafe if s.typ.lockLevel == UnspecifiedLockLevel: diff --git a/compiler/semstmts.nim b/compiler/semstmts.nim index 19514263f..a8463cbed 100644 --- a/compiler/semstmts.nim +++ b/compiler/semstmts.nim @@ -340,6 +340,39 @@ proc checkNilable(v: PSym) = elif tfNotNil in v.typ.flags and tfNotNil notin v.ast.typ.flags: message(v.info, warnProveInit, v.name.s) +include semasgn + +proc addToVarSection(c: PContext; result: var PNode; orig, identDefs: PNode) = + # consider this: + # var + # x = 0 + # withOverloadedAssignment = foo() + # y = use(withOverloadedAssignment) + # We need to split this into a statement list with multiple 'var' sections + # in order for this transformation to be correct. + let L = identDefs.len + let value = identDefs[L-1] + if value.typ != nil and tfHasAsgn in value.typ.flags: + # the spec says we need to rewrite 'var x = T()' to 'var x: T; x = T()': + identDefs.sons[L-1] = emptyNode + if result.kind != nkStmtList: + let oldResult = result + oldResult.add identDefs + result = newNodeI(nkStmtList, result.info) + result.add oldResult + else: + let o = copyNode(orig) + o.add identDefs + result.add o + for i in 0 .. L-3: + result.add overloadedAsgn(c, identDefs[i], value) + elif result.kind == nkStmtList: + let o = copyNode(orig) + o.add identDefs + result.add o + else: + result.add identDefs + proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = var b: PNode result = copyNode(n) @@ -396,7 +429,7 @@ proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = newSons(b, length) b.sons[length-2] = a.sons[length-2] # keep type desc for doc generator b.sons[length-1] = def - addSon(result, b) + addToVarSection(c, result, n, b) elif tup.kind == tyTuple and def.kind == nkPar and a.kind == nkIdentDefs and a.len > 3: message(a.info, warnEachIdentIsTuple) @@ -429,7 +462,7 @@ proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = addSon(b, newSymNode(v)) addSon(b, a.sons[length-2]) # keep type desc for doc generator addSon(b, copyTree(def)) - addSon(result, b) + addToVarSection(c, result, n, b) else: if def.kind == nkPar: v.ast = def[j] v.typ = tup.sons[j] @@ -654,6 +687,16 @@ proc typeSectionRightSidePass(c: PContext, n: PNode) = #debug s.typ s.ast = a popOwner() + let aa = a.sons[2] + if aa.kind in {nkRefTy, nkPtrTy} and aa.len == 1 and + aa.sons[0].kind == nkObjectTy: + # give anonymous object a dummy symbol: + var st = s.typ + if st.kind == tyGenericBody: st = st.lastSon + internalAssert st.kind in {tyPtr, tyRef} + internalAssert st.lastSon.sym == nil + st.lastSon.sym = newSym(skType, getIdent(s.name.s & ":ObjectType"), + getCurrOwner(), s.info) proc checkForMetaFields(n: PNode) = template checkMeta(t) = @@ -697,16 +740,6 @@ proc typeSectionFinalPass(c: PContext, n: PNode) = checkConstructedType(s.info, s.typ) if s.typ.kind in {tyObject, tyTuple} and not s.typ.n.isNil: checkForMetaFields(s.typ.n) - let aa = a.sons[2] - if aa.kind in {nkRefTy, nkPtrTy} and aa.len == 1 and - aa.sons[0].kind == nkObjectTy: - # give anonymous object a dummy symbol: - var st = s.typ - if st.kind == tyGenericBody: st = st.lastSon - internalAssert st.kind in {tyPtr, tyRef} - internalAssert st.lastSon.sym == nil - st.lastSon.sym = newSym(skType, getIdent(s.name.s & ":ObjectType"), - getCurrOwner(), s.info) proc semTypeSection(c: PContext, n: PNode): PNode = ## Processes a type section. This must be done in separate passes, in order @@ -909,11 +942,12 @@ proc maybeAddResult(c: PContext, s: PSym, n: PNode) = proc semOverride(c: PContext, s: PSym, n: PNode) = case s.name.s.normalize - of "destroy": + of "destroy", "=destroy": doDestructorStuff(c, s, n) if not experimentalMode(c): localError n.info, "use the {.experimental.} pragma to enable destructors" - of "deepcopy": + incl(s.flags, sfUsed) + of "deepcopy", "=deepcopy": if s.typ.len == 2 and s.typ.sons[1].skipTypes(abstractInst).kind in {tyRef, tyPtr} and sameType(s.typ.sons[1], s.typ.sons[0]): @@ -935,10 +969,35 @@ proc semOverride(c: PContext, s: PSym, n: PNode) = else: localError(n.info, errGenerated, "signature for 'deepCopy' must be proc[T: ptr|ref](x: T): T") - of "=": discard - else: localError(n.info, errGenerated, - "'destroy' or 'deepCopy' expected for 'override'") - incl(s.flags, sfUsed) + incl(s.flags, sfUsed) + of "=": + incl(s.flags, sfUsed) + let t = s.typ + if t.len == 3 and t.sons[0] == nil and t.sons[1].kind == tyVar: + var obj = t.sons[1].sons[0] + while true: + incl(obj.flags, tfHasAsgn) + if obj.kind == tyGenericBody: obj = obj.lastSon + elif obj.kind == tyGenericInvocation: obj = obj.sons[0] + else: break + var objB = t.sons[2] + while true: + if objB.kind == tyGenericBody: objB = objB.lastSon + elif objB.kind == tyGenericInvocation: objB = objB.sons[0] + else: break + if obj.kind in {tyObject, tyDistinct} and sameType(obj, objB): + if obj.assignment.isNil: + obj.assignment = s + else: + localError(n.info, errGenerated, + "cannot bind another '=' to: " & typeToString(obj)) + return + localError(n.info, errGenerated, + "signature for '=' must be proc[T: object](x: var T; y: T)") + else: + if sfOverriden in s.flags: + localError(n.info, errGenerated, + "'destroy' or 'deepCopy' expected for 'override'") type TProcCompilationSteps = enum @@ -970,7 +1029,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, s = semIdentDef(c, n.sons[0], kind) n.sons[namePos] = newSymNode(s) s.ast = n - s.scope = c.currentScope + #s.scope = c.currentScope if sfNoForward in c.module.flags and sfSystemModule notin c.module.flags: @@ -982,14 +1041,14 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, s.owner = getCurrOwner() typeIsDetermined = s.typ == nil s.ast = n - s.scope = c.currentScope + #s.scope = c.currentScope # if typeIsDetermined: assert phase == stepCompileBody # else: assert phase == stepDetermineType # before compiling the proc body, set as current the scope # where the proc was declared let oldScope = c.currentScope - c.currentScope = s.scope + #c.currentScope = s.scope pushOwner(s) openScope(c) var gp: PNode @@ -1014,7 +1073,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if s.kind in skIterators: s.typ.flags.incl(tfIterator) - var proto = searchForProc(c, s.scope, s) + var proto = searchForProc(c, oldScope, s) if proto == nil: if s.kind == skClosureIterator: s.typ.callConv = ccClosure else: s.typ.callConv = lastOptionEntry(c).defaultCC @@ -1022,10 +1081,10 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if sfGenSym in s.flags: discard elif kind in OverloadableSyms: if not typeIsDetermined: - addInterfaceOverloadableSymAt(c, s.scope, s) + addInterfaceOverloadableSymAt(c, oldScope, s) else: if not typeIsDetermined: - addInterfaceDeclAt(c, s.scope, s) + addInterfaceDeclAt(c, oldScope, s) if n.sons[pragmasPos].kind != nkEmpty: pragma(c, s, n.sons[pragmasPos], validPragmas) else: @@ -1055,7 +1114,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, popOwner() pushOwner(s) s.options = gOptions - if sfOverriden in s.flags: semOverride(c, s, n) + if sfOverriden in s.flags or s.name.s[0] == '=': semOverride(c, s, n) if n.sons[bodyPos].kind != nkEmpty: # for DLL generation it is annoying to check for sfImportc! if sfBorrow in s.flags: @@ -1093,7 +1152,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, elif sfBorrow in s.flags: semBorrow(c, n, s) sideEffectsCheck(c, s) closeScope(c) # close scope for parameters - c.currentScope = oldScope + # c.currentScope = oldScope popOwner() if n.sons[patternPos].kind != nkEmpty: c.patterns.add(s) @@ -1151,7 +1210,10 @@ proc semMethod(c: PContext, n: PNode): PNode = result = semProcAux(c, n, skMethod, methodPragmas) var s = result.sons[namePos].sym - if not isGenericRoutine(s) and result.sons[bodyPos].kind != nkEmpty: + if not isGenericRoutine(s): + # why check for the body? bug #2400 has none. Checking for sfForward makes + # no sense either. + # and result.sons[bodyPos].kind != nkEmpty: if hasObjParam(s): methodDef(s, fromCache=false) else: @@ -1278,7 +1340,7 @@ proc semStmtList(c: PContext, n: PNode, flags: TExprFlags): PNode = var tryStmt = newNodeI(nkTryStmt, n.sons[i].info) var body = newNodeI(nkStmtList, n.sons[i].info) if i < n.sonsLen - 1: - body.sons = n.sons[(i+1)..(-1)] + body.sons = n.sons[(i+1)..n.len-1] tryStmt.addSon(body) tryStmt.addSon(deferPart) n.sons[i] = semTry(c, tryStmt) diff --git a/compiler/semtempl.nim b/compiler/semtempl.nim index a48f045a2..161d22fc1 100644 --- a/compiler/semtempl.nim +++ b/compiler/semtempl.nim @@ -10,17 +10,17 @@ # included from sem.nim discard """ - hygienic templates: - + hygienic templates: + template `||` (a, b: expr): expr = let aa = a if aa: aa else: b - + var a, b: T - + a || b || a - + Each evaluation context has to be different and we need to perform some form of preliminary symbol lookup in template definitions. Hygiene is a way to achieve lexical scoping at compile time. @@ -50,7 +50,7 @@ proc symChoice(c: PContext, n: PNode, s: PSym, r: TSymChoiceRule): PNode = o: TOverloadIter var i = 0 a = initOverloadIter(o, c, n) - while a != nil: + while a != nil: a = nextOverloadIter(o, c, n) inc(i) if i > 1: break @@ -96,7 +96,7 @@ proc semMixinStmt(c: PContext, n: PNode, toMixin: var IntSet): PNode = for i in 0 .. < n.len: toMixin.incl(considerQuotedIdent(n.sons[i]).id) result = newNodeI(nkEmpty, n.info) - + proc replaceIdentBySym(n: var PNode, s: PNode) = case n.kind of nkPostfix: replaceIdentBySym(n.sons[1], s) @@ -135,7 +135,7 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode proc openScope(c: var TemplCtx) = openScope(c.c) proc closeScope(c: var TemplCtx) = closeScope(c.c) -proc semTemplBodyScope(c: var TemplCtx, n: PNode): PNode = +proc semTemplBodyScope(c: var TemplCtx, n: PNode): PNode = openScope(c) result = semTemplBody(c, n) closeScope(c) @@ -191,24 +191,24 @@ proc addLocalDecl(c: var TemplCtx, n: var PNode, k: TSymKind) = else: replaceIdentBySym(n, ident) -proc semTemplSymbol(c: PContext, n: PNode, s: PSym): PNode = +proc semTemplSymbol(c: PContext, n: PNode, s: PSym): PNode = incl(s.flags, sfUsed) # we do not call styleCheckUse here, as the identifier is not really # resolved here. We will fixup the used identifiers later. case s.kind - of skUnknown: + of skUnknown: # Introduced in this pass! Leave it as an identifier. result = n of OverloadableSyms: result = symChoice(c, n, s, scOpen) - of skGenericParam: + of skGenericParam: result = newSymNodeTypeDesc(s, n.info) - of skParam: + of skParam: result = n - of skType: - if (s.typ != nil) and (s.typ.kind != tyGenericParam): + of skType: + if (s.typ != nil) and (s.typ.kind != tyGenericParam): result = newSymNodeTypeDesc(s, n.info) - else: + else: result = n else: result = newSymNode(s, n.info) @@ -305,21 +305,21 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = n.sons[i] = semTemplBodyScope(c, it) of nkWhileStmt: openScope(c) - for i in countup(0, sonsLen(n)-1): + for i in countup(0, sonsLen(n)-1): n.sons[i] = semTemplBody(c, n.sons[i]) closeScope(c) of nkCaseStmt: openScope(c) n.sons[0] = semTemplBody(c, n.sons[0]) - for i in countup(1, sonsLen(n)-1): + for i in countup(1, sonsLen(n)-1): var a = n.sons[i] checkMinSonsLen(a, 1) var L = sonsLen(a) - for j in countup(0, L-2): + for j in countup(0, L-2): a.sons[j] = semTemplBody(c, a.sons[j]) a.sons[L-1] = semTemplBodyScope(c, a.sons[L-1]) closeScope(c) - of nkForStmt, nkParForStmt: + of nkForStmt, nkParForStmt: var L = sonsLen(n) openScope(c) n.sons[L-2] = semTemplBody(c, n.sons[L-2]) @@ -338,14 +338,14 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = n.sons[0] = newSymNode(s, n.sons[0].info) n.sons[1] = semTemplBody(c, n.sons[1]) closeScope(c) - of nkTryStmt: + of nkTryStmt: checkMinSonsLen(n, 2) n.sons[0] = semTemplBodyScope(c, n.sons[0]) - for i in countup(1, sonsLen(n)-1): + for i in countup(1, sonsLen(n)-1): var a = n.sons[i] checkMinSonsLen(a, 1) var L = sonsLen(a) - for j in countup(0, L-2): + for j in countup(0, L-2): a.sons[j] = semTemplBody(c, a.sons[j]) a.sons[L-1] = semTemplBodyScope(c, a.sons[L-1]) of nkVarSection: semTemplSomeDecl(c, n, skVar) @@ -355,32 +355,32 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = n.sons[0] = semTemplBody(c, n.sons[0]) semTemplSomeDecl(c, n, skParam, 1) of nkConstSection: - for i in countup(0, sonsLen(n) - 1): + for i in countup(0, sonsLen(n) - 1): var a = n.sons[i] - if a.kind == nkCommentStmt: continue + if a.kind == nkCommentStmt: continue if (a.kind != nkConstDef): illFormedAst(a) checkSonsLen(a, 3) addLocalDecl(c, a.sons[0], skConst) a.sons[1] = semTemplBody(c, a.sons[1]) a.sons[2] = semTemplBody(c, a.sons[2]) - of nkTypeSection: - for i in countup(0, sonsLen(n) - 1): + of nkTypeSection: + for i in countup(0, sonsLen(n) - 1): var a = n.sons[i] - if a.kind == nkCommentStmt: continue + if a.kind == nkCommentStmt: continue if (a.kind != nkTypeDef): illFormedAst(a) checkSonsLen(a, 3) addLocalDecl(c, a.sons[0], skType) for i in countup(0, sonsLen(n) - 1): var a = n.sons[i] - if a.kind == nkCommentStmt: continue + if a.kind == nkCommentStmt: continue if (a.kind != nkTypeDef): illFormedAst(a) checkSonsLen(a, 3) - if a.sons[1].kind != nkEmpty: + if a.sons[1].kind != nkEmpty: openScope(c) a.sons[1] = semTemplBody(c, a.sons[1]) a.sons[2] = semTemplBody(c, a.sons[2]) closeScope(c) - else: + else: a.sons[2] = semTemplBody(c, a.sons[2]) of nkProcDef, nkLambdaKinds: result = semRoutineInTemplBody(c, n, skProc) @@ -408,7 +408,13 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = if n.kind == nkDotExpr or n.kind == nkAccQuoted: let s = qualifiedLookUp(c.c, n, {}) if s != nil: - if contains(c.toBind, s.id): + # do not symchoice a quoted template parameter (bug #2390): + if s.owner == c.owner and s.kind == skParam and + n.kind == nkAccQuoted and n.len == 1: + incl(s.flags, sfUsed) + styleCheckUse(n.info, s) + return newSymNode(s, n.info) + elif contains(c.toBind, s.id): return symChoice(c.c, n, s, scClosed) elif contains(c.toMixin, s.name.id): return symChoice(c.c, n, s, scForceOpen) @@ -445,38 +451,38 @@ proc semTemplBodyDirty(c: var TemplCtx, n: PNode): PNode = result = n for i in countup(0, sonsLen(n) - 1): result.sons[i] = semTemplBodyDirty(c, n.sons[i]) - -proc transformToExpr(n: PNode): PNode = + +proc transformToExpr(n: PNode): PNode = var realStmt: int result = n case n.kind - of nkStmtList: + of nkStmtList: realStmt = - 1 - for i in countup(0, sonsLen(n) - 1): + for i in countup(0, sonsLen(n) - 1): case n.sons[i].kind - of nkCommentStmt, nkEmpty, nkNilLit: + of nkCommentStmt, nkEmpty, nkNilLit: discard - else: + else: if realStmt == - 1: realStmt = i else: realStmt = - 2 if realStmt >= 0: result = transformToExpr(n.sons[realStmt]) else: n.kind = nkStmtListExpr - of nkBlockStmt: + of nkBlockStmt: n.kind = nkBlockExpr #nkIfStmt: n.kind = nkIfExpr // this is not correct! else: discard -proc semTemplateDef(c: PContext, n: PNode): PNode = +proc semTemplateDef(c: PContext, n: PNode): PNode = var s: PSym - if c.p.owner.kind == skModule: + if c.p.owner.kind == skModule: s = semIdentVis(c, skTemplate, n.sons[0], {sfExported}) incl(s.flags, sfGlobal) else: s = semIdentVis(c, skTemplate, n.sons[0], {}) styleCheckDef(s) # check parameter list: - s.scope = c.currentScope + #s.scope = c.currentScope pushOwner(s) openScope(c) n.sons[namePos] = newSymNode(s, n.sons[namePos].info) @@ -484,10 +490,10 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = pragma(c, s, n.sons[pragmasPos], templatePragmas) var gp: PNode - if n.sons[genericParamsPos].kind != nkEmpty: + if n.sons[genericParamsPos].kind != nkEmpty: n.sons[genericParamsPos] = semGenericParamList(c, n.sons[genericParamsPos]) gp = n.sons[genericParamsPos] - else: + else: gp = newNodeI(nkGenericParams, n.info) # process parameters: if n.sons[paramsPos].kind != nkEmpty: @@ -525,14 +531,14 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = else: n.sons[bodyPos] = semTemplBody(ctx, n.sons[bodyPos]) if s.typ.sons[0].kind notin {tyStmt, tyTypeDesc}: - n.sons[bodyPos] = transformToExpr(n.sons[bodyPos]) + n.sons[bodyPos] = transformToExpr(n.sons[bodyPos]) # only parameters are resolved, no type checking is performed semIdeForTemplateOrGeneric(c, n.sons[bodyPos], ctx.cursorInBody) closeScope(c) popOwner() s.ast = n result = n - if n.sons[bodyPos].kind == nkEmpty: + if n.sons[bodyPos].kind == nkEmpty: localError(n.info, errImplOfXexpected, s.name.s) var proto = searchForProc(c, c.currentScope, s) if proto == nil: @@ -545,7 +551,7 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = proc semPatternBody(c: var TemplCtx, n: PNode): PNode = template templToExpand(s: expr): expr = s.kind == skTemplate and (s.typ.len == 1 or sfImmediate in s.flags) - + proc newParam(c: var TemplCtx, n: PNode, s: PSym): PNode = # the param added in the current scope is actually wrong here for # macros because they have a shadowed param of type 'PNimNode' (see @@ -556,7 +562,7 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = let x = c.owner.typ.n.sons[s.position+1].sym assert x.name == s.name result = newSymNode(x, n.info) - + proc handleSym(c: var TemplCtx, n: PNode, s: PSym): PNode = result = n if s != nil: @@ -570,7 +576,7 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = discard # we keep the ident unbound for matching instantiated symbols and # more flexibility - + proc expectParam(c: var TemplCtx, n: PNode): PNode = let s = qualifiedLookUp(c.c, n, {}) if s != nil and s.owner == c.owner and s.kind == skParam: @@ -578,7 +584,7 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = else: localError(n.info, errInvalidExpression) result = n - + result = n case n.kind of nkIdent: @@ -588,7 +594,7 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = result = semBindStmt(c.c, n, c.toBind) of nkEmpty, nkSym..nkNilLit: discard of nkCurlyExpr: - # we support '(pattern){x}' to bind a subpattern to a parameter 'x'; + # we support '(pattern){x}' to bind a subpattern to a parameter 'x'; # '(pattern){|x}' does the same but the matches will be gathered in 'x' if n.len != 2: localError(n.info, errInvalidExpression) @@ -611,7 +617,7 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = elif contains(c.toBind, s.id): discard elif templToExpand(s): return semPatternBody(c, semTemplateExpr(c.c, n, s, {efNoSemCheck})) - + if n.kind == nkInfix and n.sons[0].kind == nkIdent: # we interpret `*` and `|` only as pattern operators if they occur in # infix notation, so that '`*`(a, b)' can be used for verbatim matching: @@ -628,7 +634,7 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = result.sons[1] = semPatternBody(c, n.sons[1]) result.sons[2] = semPatternBody(c, n.sons[2]) return - + if n.kind == nkPrefix and n.sons[0].kind == nkIdent: let opr = n.sons[0] if opr.ident.s == "~": @@ -636,13 +642,13 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = result.sons[0] = opr result.sons[1] = semPatternBody(c, n.sons[1]) return - + for i in countup(0, sonsLen(n) - 1): result.sons[i] = semPatternBody(c, n.sons[i]) else: # dotExpr is ambiguous: note that we explicitly allow 'x.TemplateParam', # so we use the generic code for nkDotExpr too - case n.kind + case n.kind of nkDotExpr, nkAccQuoted: let s = qualifiedLookUp(c.c, n, {}) if s != nil: diff --git a/compiler/semtypes.nim b/compiler/semtypes.nim index 245f86427..304fe6d14 100644 --- a/compiler/semtypes.nim +++ b/compiler/semtypes.nim @@ -228,7 +228,7 @@ proc semArrayIndex(c: PContext, n: PNode): PType = if not isOrdinalType(e.typ.lastSon): localError(n[1].info, errOrdinalTypeExpected) result = makeRangeWithStaticExpr(c, e) - if c.inGenericContext >0: result.flags.incl tfUnresolved + if c.inGenericContext > 0: result.flags.incl tfUnresolved elif e.kind in nkCallKinds and hasGenericArguments(e): if not isOrdinalType(e.typ): localError(n[1].info, errOrdinalTypeExpected) @@ -261,7 +261,8 @@ proc semArray(c: PContext, n: PNode, prev: PType): PType = if not isOrdinalType(indx): localError(n.sons[1].info, errOrdinalTypeExpected) elif enumHasHoles(indx): - localError(n.sons[1].info, errEnumXHasHoles, indx.sym.name.s) + localError(n.sons[1].info, errEnumXHasHoles, + typeToString(indx.skipTypes({tyRange}))) base = semTypeNode(c, n.sons[2], nil) addSonSkipIntLit(result, base) else: @@ -593,7 +594,7 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, f.position = pos if (rec != nil) and ({sfImportc, sfExportc} * rec.flags != {}) and (f.loc.r == nil): - f.loc.r = toRope(f.name.s) + f.loc.r = rope(f.name.s) f.flags = f.flags + ({sfImportc, sfExportc} * rec.flags) inc(pos) if containsOrIncl(check, f.name.id): @@ -646,14 +647,17 @@ proc semObjectNode(c: PContext, n: PNode, prev: PType): PType = # n.sons[0] contains the pragmas (if any). We process these later... checkSonsLen(n, 3) if n.sons[1].kind != nkEmpty: - base = skipTypes(semTypeNode(c, n.sons[1].sons[0], nil), skipPtrs) - var concreteBase = skipGenericInvocation(base).skipTypes(skipPtrs) - if concreteBase.kind == tyObject and tfFinal notin concreteBase.flags: - addInheritedFields(c, check, pos, concreteBase) + base = skipTypesOrNil(semTypeNode(c, n.sons[1].sons[0], nil), skipPtrs) + if base.isNil: + localError(n.info, errIllegalRecursionInTypeX, "object") else: - if concreteBase.kind != tyError: - localError(n.sons[1].info, errInheritanceOnlyWithNonFinalObjects) - base = nil + var concreteBase = skipGenericInvocation(base).skipTypes(skipPtrs) + if concreteBase.kind == tyObject and tfFinal notin concreteBase.flags: + addInheritedFields(c, check, pos, concreteBase) + else: + if concreteBase.kind != tyError: + localError(n.sons[1].info, errInheritanceOnlyWithNonFinalObjects) + base = nil if n.kind != nkObjectTy: internalError(n.info, "semObjectNode") result = newOrPrevType(tyObject, prev, c) rawAddSon(result, base) @@ -786,7 +790,7 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, @[newTypeS(paramType.kind, c)]) result = addImplicitGeneric(typ) else: - for i in 0 .. <paramType.sons.len: + for i in 0 .. <paramType.len: if paramType.sons[i] == paramType: globalError(info, errIllegalRecursionInTypeX, typeToString(paramType)) var lifted = liftingWalk(paramType.sons[i]) @@ -831,7 +835,7 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, cp.kind = tyUserTypeClassInst return addImplicitGeneric(cp) - for i in 1 .. (paramType.sons.len - 2): + for i in 1 .. paramType.len-2: var lifted = liftingWalk(paramType.sons[i]) if lifted != nil: paramType.sons[i] = lifted @@ -844,7 +848,7 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, result.shouldHaveMeta of tyGenericInvocation: - for i in 1 .. <paramType.sonsLen: + for i in 1 .. <paramType.len: let lifted = liftingWalk(paramType.sons[i]) if lifted != nil: paramType.sons[i] = lifted when false: @@ -1039,8 +1043,8 @@ proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = addToResult(elem) return elif t.kind != tyGenericBody: - #we likely got code of the form TypeA[TypeB] where TypeA is - #not generic. + # we likely got code of the form TypeA[TypeB] where TypeA is + # not generic. localError(n.info, errNoGenericParamsAllowedForX, s.name.s) return newOrPrevType(tyError, prev, c) else: @@ -1057,9 +1061,14 @@ proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = var isConcrete = true for i in 1 .. <m.call.len: - let typ = m.call[i].typ.skipTypes({tyTypeDesc}) - if containsGenericType(typ): isConcrete = false - addToResult(typ) + var typ = m.call[i].typ + if typ.kind == tyTypeDesc and typ.sons[0].kind == tyNone: + isConcrete = false + addToResult(typ) + else: + typ = typ.skipTypes({tyTypeDesc}) + if containsGenericType(typ): isConcrete = false + addToResult(typ) if isConcrete: if s.ast == nil and s.typ.kind != tyCompositeTypeClass: @@ -1085,6 +1094,8 @@ proc freshType(res, prev: PType): PType {.inline.} = proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = # if n.sonsLen == 0: return newConstraint(c, tyTypeClass) + if nfBase2 in n.flags: + message(n.info, warnDeprecated, "use 'concept' instead; 'generic'") result = newOrPrevType(tyUserTypeClass, prev, c) result.n = n @@ -1168,6 +1179,10 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = semAnyRef(c, n, tyPtr, prev) elif op.id == ord(wRef): result = semAnyRef(c, n, tyRef, prev) + elif op.id == ord(wType): + checkSonsLen(n, 2) + let typExpr = semExprWithType(c, n.sons[1], {efInTypeof}) + result = typExpr.typ.skipTypes({tyIter}) else: result = semTypeExpr(c, n) of nkWhenStmt: diff --git a/compiler/semtypinst.nim b/compiler/semtypinst.nim index 9e0716114..c5caf8b92 100644 --- a/compiler/semtypinst.nim +++ b/compiler/semtypinst.nim @@ -16,9 +16,9 @@ const proc sharedPtrCheck(info: TLineInfo, t: PType) = if t.kind == tyPtr and t.len > 1: - if t.sons[0].sym.magic in {mShared, mGuarded}: + if t.sons[0].sym.magic == mShared: incl(t.flags, tfShared) - if t.sons[0].sym.magic == mGuarded: incl(t.flags, tfGuarded) + #if t.sons[0].sym.magic == mGuarded: incl(t.flags, tfGuarded) if tfHasGCedMem in t.flags or t.isGCedMem: localError(info, errGenerated, "shared memory may not refer to GC'ed thread local memory") @@ -89,6 +89,7 @@ type info*: TLineInfo allowMetaTypes*: bool # allow types such as seq[Number] # i.e. the result contains unresolved generics + skipTypedesc*: bool # wether we should skip typeDescs proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType proc replaceTypeVarsS(cl: var TReplTypeVars, s: PSym): PSym @@ -232,7 +233,9 @@ proc instCopyType*(cl: var TReplTypeVars, t: PType): PType = # XXX: relying on allowMetaTypes is a kludge result = copyType(t, t.owner, cl.allowMetaTypes) result.flags.incl tfFromGeneric - result.flags.excl tfInstClearedFlags + if not (t.kind in tyMetaTypes or + (t.kind == tyStatic and t.n == nil)): + result.flags.excl tfInstClearedFlags proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = # tyGenericInvocation[A, tyGenericInvocation[A, B]] @@ -276,6 +279,8 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = else: idTablePut(cl.localCache, t, result) + let oldSkipTypedesc = cl.skipTypedesc + cl.skipTypedesc = true for i in countup(1, sonsLen(t) - 1): var x = replaceTypeVarsT(cl, t.sons[i]) assert x.kind != tyGenericInvocation @@ -289,6 +294,7 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = rawAddSon(result, header.sons[i]) var newbody = replaceTypeVarsT(cl, lastSon(body)) + cl.skipTypedesc = oldSkipTypedesc newbody.flags = newbody.flags + (t.flags + body.flags - tfInstClearedFlags) result.flags = result.flags + newbody.flags - tfInstClearedFlags # This is actually wrong: tgeneric_closure fails with this line: @@ -303,7 +309,13 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = if dc != nil and sfFromGeneric notin newbody.deepCopy.flags: # 'deepCopy' needs to be instantiated for # generics *when the type is constructed*: - newbody.deepCopy = cl.c.instDeepCopy(cl.c, dc, result, cl.info) + newbody.deepCopy = cl.c.instTypeBoundOp(cl.c, dc, result, cl.info, + attachedDeepCopy) + let asgn = newbody.assignment + if asgn != nil and sfFromGeneric notin asgn.flags: + # '=' needs to be instantiated for generics when the type is constructed: + newbody.assignment = cl.c.instTypeBoundOp(cl.c, asgn, result, cl.info, + attachedAsgn) proc eraseVoidParams*(t: PType) = # transform '(): void' into '()' because old parts of the compiler really @@ -400,7 +412,7 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = let lookup = PType(idTableGet(cl.typeMap, t)) # lookupTypeVar(cl, t) if lookup != nil: result = lookup - if tfUnresolved in t.flags: result = result.base + if tfUnresolved in t.flags or cl.skipTypedesc: result = result.base elif t.sons[0].kind != tyNone: result = makeTypeDesc(cl.c, replaceTypeVarsT(cl, t.sons[0])) @@ -408,15 +420,23 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = result = t of tyGenericInst: + result = PType(idTableGet(cl.localCache, t)) + if result != nil: return result result = instCopyType(cl, t) + idTablePut(cl.localCache, t, result) for i in 1 .. <result.sonsLen: result.sons[i] = replaceTypeVarsT(cl, result.sons[i]) propagateToOwner(result, result.lastSon) else: if containsGenericType(t): + #if not cl.allowMetaTypes: + result = PType(idTableGet(cl.localCache, t)) + if result != nil: return result result = instCopyType(cl, t) result.size = -1 # needs to be recomputed + #if not cl.allowMetaTypes: + idTablePut(cl.localCache, t, result) for i in countup(0, sonsLen(result) - 1): if result.sons[i] != nil: diff --git a/compiler/sigmatch.nim b/compiler/sigmatch.nim index 38340ffb7..5c8a3bc58 100644 --- a/compiler/sigmatch.nim +++ b/compiler/sigmatch.nim @@ -99,9 +99,12 @@ proc initCandidate*(ctx: PContext, c: var TCandidate, callee: PSym, c.calleeSym = callee if callee.kind in skProcKinds and calleeScope == -1: if callee.originatingModule == ctx.module: - let rootSym = if sfFromGeneric notin callee.flags: callee - else: callee.owner - c.calleeScope = rootSym.scope.depthLevel + c.calleeScope = 2 + var owner = callee + while true: + owner = owner.skipGenericOwner + if owner.kind == skModule: break + inc c.calleeScope else: c.calleeScope = 1 else: @@ -499,6 +502,7 @@ proc matchUserTypeClass*(c: PContext, m: var TCandidate, param.typ = makeTypeDesc(c, typ) addDecl(c, param) + #echo "A ", param.name.s, " ", typeToString(param.typ), " ", param.kind for param in body.n[0]: var @@ -507,30 +511,19 @@ proc matchUserTypeClass*(c: PContext, m: var TCandidate, if param.kind == nkVarTy: dummyName = param[0] - dummyType = if a.kind != tyVar: makeVarType(c, a) - else: a + dummyType = if a.kind != tyVar: makeVarType(c, a) else: a else: dummyName = param dummyType = a internalAssert dummyName.kind == nkIdent - var dummyParam = newSym(skType, dummyName.ident, body.sym, body.sym.info) + var dummyParam = newSym(skVar, dummyName.ident, body.sym, body.sym.info) dummyParam.typ = dummyType addDecl(c, dummyParam) + #echo "B ", dummyName.ident.s, " ", typeToString(dummyType), " ", dummyparam.kind var checkedBody = c.semTryExpr(c, body.n[3].copyTree) - #m.errors = bufferedMsgs - clearBufferedMsgs() if checkedBody == nil: return isNone - - if checkedBody.kind == nkStmtList: - for stmt in checkedBody: - case stmt.kind - of nkReturnStmt: discard - of nkTypeSection: discard - of nkConstDef: discard - else: discard - return isGeneric proc shouldSkipDistinct(rules: PNode, callIdent: PIdent): bool = @@ -902,14 +895,27 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, doBind = true): TTypeRelation = elif typeRel(c, f.sons[i], x.sons[i]) <= isSubtype: return result = isGeneric else: - result = typeRel(c, f.sons[0], x) + let genericBody = f.sons[0] + result = typeRel(c, genericBody, x) if result != isNone: + # see tests/generics/tgeneric3.nim for an example that triggers this + # piece of code: + # + # proc internalFind[T,D](n: PNode[T,D], key: T): ref TItem[T,D] + # proc internalPut[T,D](ANode: ref TNode[T,D], Akey: T, Avalue: D, + # Oldvalue: var D): ref TNode[T,D] + # var root = internalPut[int, int](nil, 312, 312, oldvalue) + # var it1 = internalFind(root, 312) # cannot instantiate: 'D' + # # we steal the generic parameters from the tyGenericBody: for i in countup(1, sonsLen(f) - 1): - var x = PType(idTableGet(c.bindings, f.sons[0].sons[i - 1])) - if x == nil or x.kind in {tyGenericInvocation, tyGenericParam}: + var x = PType(idTableGet(c.bindings, genericBody.sons[i-1])) + if x == nil: + discard "maybe fine (for eg. a==tyNil)" + elif x.kind in {tyGenericInvocation, tyGenericParam}: internalError("wrong instantiated type!") - put(c.bindings, f.sons[i], x) + else: + put(c.bindings, f.sons[i], x) of tyAnd: considerPreviousT: @@ -1102,8 +1108,10 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, doBind = true): TTypeRelation = localError(f.n.info, errTypeExpected) result = isNone + of tyNone: + if a.kind == tyNone: result = isEqual else: - internalAssert false + internalError " unknown type kind " & $f.kind proc cmpTypes*(c: PContext, f, a: PType): TTypeRelation = var m: TCandidate @@ -1197,6 +1205,17 @@ proc isEmptyContainer*(t: PType): bool = of tyGenericInst: result = isEmptyContainer(t.lastSon) else: result = false +proc incMatches(m: var TCandidate; r: TTypeRelation; convMatch = 1) = + case r + of isConvertible, isIntConv: inc(m.convMatches, convMatch) + of isSubtype, isSubrange: inc(m.subtypeMatches) + of isGeneric, isInferred: inc(m.genericMatches) + of isFromIntLit: inc(m.intConvMatches, 256) + of isInferredConvertible: + inc(m.convMatches) + of isEqual: inc(m.exactMatches) + of isNone: discard + proc paramTypesMatchAux(m: var TCandidate, f, argType: PType, argSemantized, argOrig: PNode): PNode = var @@ -1237,18 +1256,9 @@ proc paramTypesMatchAux(m: var TCandidate, f, argType: PType, if r != isNone and m.calleeSym != nil and m.calleeSym.kind in {skMacro, skTemplate}: - # XXX: duplicating this is ugly, maybe we should move this + # XXX: duplicating this is ugly, but we cannot (!) move this # directly into typeRel using return-like templates - case r - of isConvertible, isIntConv: inc(m.convMatches) - of isSubtype, isSubrange: inc(m.subtypeMatches) - of isGeneric, isInferred: inc(m.genericMatches) - of isFromIntLit: inc(m.intConvMatches, 256) - of isInferredConvertible: - inc(m.convMatches) - of isEqual: inc(m.exactMatches) - of isNone: discard - + incMatches(m, r) if f.kind == tyStmt: return arg elif f.kind == tyTypeDesc: @@ -1363,20 +1373,23 @@ proc paramTypesMatch*(m: var TCandidate, f, a: PType, z.calleeSym = arg.sons[i].sym #if arg.sons[i].sym.name.s == "cmp": # ggDebug = true - # echo "CALLLEEEEEEEE ", typeToString(z.callee) - var r = typeRel(z, f, arg.sons[i].typ) + # echo "CALLLEEEEEEEE A ", typeToString(z.callee) + # XXX this is still all wrong: (T, T) should be 2 generic matches + # and (int, int) 2 exact matches, etc. Essentially you cannot call + # typeRel here and expect things to work! + let r = typeRel(z, f, arg.sons[i].typ) + incMatches(z, r, 2) #if arg.sons[i].sym.name.s == "cmp": # and arg.info.line == 606: # echo "M ", r, " ", arg.info, " ", typeToString(arg.sons[i].sym.typ) - # debug arg.sons[i].sym # writeMatches(z) if r != isNone: + z.state = csMatch case x.state of csEmpty, csNoMatch: x = z best = i - x.state = csMatch of csMatch: - var cmp = cmpCandidates(x, z) + let cmp = cmpCandidates(x, z) if cmp < 0: best = i x = z @@ -1399,6 +1412,7 @@ proc paramTypesMatch*(m: var TCandidate, f, a: PType, result = paramTypesMatchAux(m, f, arg.sons[best].typ, arg.sons[best], argOrig) + proc setSon(father: PNode, at: int, son: PNode) = if sonsLen(father) <= at: setLen(father.sons, at + 1) father.sons[at] = son @@ -1410,9 +1424,12 @@ proc prepareOperand(c: PContext; formal: PType; a: PNode): PNode = # a.typ == nil is valid result = a elif a.typ.isNil: + # XXX This is unsound! 'formal' can differ from overloaded routine to + # overloaded routine! let flags = if formal.kind == tyIter: {efDetermineType, efWantIterator} - elif formal.kind == tyStmt: {efDetermineType, efWantStmt} - else: {efDetermineType} + else: {efDetermineType, efAllowStmt} + #elif formal.kind == tyStmt: {efDetermineType, efWantStmt} + #else: {efDetermineType} result = c.semOperand(c, a, flags) else: result = a @@ -1524,7 +1541,9 @@ proc matchesAux(c: PContext, n, nOrig: PNode, copyTree(n.sons[a]), m, c)) else: addSon(m.call, copyTree(n.sons[a])) - elif formal != nil: + elif formal != nil and formal.typ.kind == tyVarargs: + # beware of the side-effects in 'prepareOperand'! So only do it for + # varags matching. See tests/metatype/tstatic_overloading. m.baseTypeMatch = false n.sons[a] = prepareOperand(c, formal.typ, n.sons[a]) var arg = paramTypesMatch(m, formal.typ, n.sons[a].typ, @@ -1616,12 +1635,15 @@ proc argtypeMatches*(c: PContext, f, a: PType): bool = # instantiate generic converters for that result = res != nil -proc instDeepCopy*(c: PContext; dc: PSym; t: PType; info: TLineInfo): PSym {. - procvar.} = +proc instTypeBoundOp*(c: PContext; dc: PSym; t: PType; info: TLineInfo; + op: TTypeAttachedOp): PSym {.procvar.} = var m: TCandidate initCandidate(c, m, dc.typ) var f = dc.typ.sons[1] - if f.kind in {tyRef, tyPtr}: f = f.lastSon + if op == attachedDeepCopy: + if f.kind in {tyRef, tyPtr}: f = f.lastSon + else: + if f.kind == tyVar: f = f.lastSon if typeRel(m, f, t) == isNone: localError(info, errGenerated, "cannot instantiate 'deepCopy'") else: diff --git a/compiler/transf.nim b/compiler/transf.nim index 325ce9d5e..2143b6bec 100644 --- a/compiler/transf.nim +++ b/compiler/transf.nim @@ -579,8 +579,7 @@ proc getMergeOp(n: PNode): PSym = case n.kind of nkCall, nkHiddenCallConv, nkCommand, nkInfix, nkPrefix, nkPostfix, nkCallStrLit: - if (n.sons[0].kind == nkSym) and (n.sons[0].sym.kind == skProc) and - (sfMerge in n.sons[0].sym.flags): + if n.sons[0].kind == nkSym and n.sons[0].sym.magic == mConStrStr: result = n.sons[0].sym else: discard diff --git a/compiler/trees.nim b/compiler/trees.nim index 86a1139a0..2c631af99 100644 --- a/compiler/trees.nim +++ b/compiler/trees.nim @@ -9,40 +9,40 @@ # tree helper routines -import +import ast, astalgo, lexer, msgs, strutils, wordrecg -proc hasSon(father, son: PNode): bool = - for i in countup(0, sonsLen(father) - 1): - if father.sons[i] == son: +proc hasSon(father, son: PNode): bool = + for i in countup(0, sonsLen(father) - 1): + if father.sons[i] == son: return true result = false -proc cyclicTreeAux(n, s: PNode): bool = - if n == nil: +proc cyclicTreeAux(n, s: PNode): bool = + if n == nil: return false - if hasSon(s, n): + if hasSon(s, n): return true var m = sonsLen(s) addSon(s, n) - if not (n.kind in {nkEmpty..nkNilLit}): - for i in countup(0, sonsLen(n) - 1): - if cyclicTreeAux(n.sons[i], s): + if not (n.kind in {nkEmpty..nkNilLit}): + for i in countup(0, sonsLen(n) - 1): + if cyclicTreeAux(n.sons[i], s): return true result = false delSon(s, m) -proc cyclicTree*(n: PNode): bool = +proc cyclicTree*(n: PNode): bool = var s = newNodeI(nkEmpty, n.info) result = cyclicTreeAux(n, s) -proc exprStructuralEquivalent*(a, b: PNode): bool = +proc exprStructuralEquivalent*(a, b: PNode): bool = result = false - if a == b: + if a == b: result = true - elif (a != nil) and (b != nil) and (a.kind == b.kind): + elif (a != nil) and (b != nil) and (a.kind == b.kind): case a.kind - of nkSym: + of nkSym: # don't go nuts here: same symbol as string is enough: result = a.sym.name.id == b.sym.name.id of nkIdent: result = a.ident.id == b.ident.id @@ -50,12 +50,12 @@ proc exprStructuralEquivalent*(a, b: PNode): bool = of nkFloatLit..nkFloat64Lit: result = a.floatVal == b.floatVal of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal of nkEmpty, nkNilLit, nkType: result = true - else: - if sonsLen(a) == sonsLen(b): - for i in countup(0, sonsLen(a) - 1): - if not exprStructuralEquivalent(a.sons[i], b.sons[i]): return + else: + if sonsLen(a) == sonsLen(b): + for i in countup(0, sonsLen(a) - 1): + if not exprStructuralEquivalent(a.sons[i], b.sons[i]): return result = true - + proc sameTree*(a, b: PNode): bool = result = false if a == b: @@ -66,7 +66,7 @@ proc sameTree*(a, b: PNode): bool = if a.info.col != b.info.col: return #if a.info.fileIndex <> b.info.fileIndex then exit; case a.kind - of nkSym: + of nkSym: # don't go nuts here: same symbol as string is enough: result = a.sym.name.id == b.sym.name.id of nkIdent: result = a.ident.id == b.ident.id @@ -75,15 +75,15 @@ proc sameTree*(a, b: PNode): bool = of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal of nkEmpty, nkNilLit, nkType: result = true else: - if sonsLen(a) == sonsLen(b): - for i in countup(0, sonsLen(a) - 1): - if not sameTree(a.sons[i], b.sons[i]): return + if sonsLen(a) == sonsLen(b): + for i in countup(0, sonsLen(a) - 1): + if not sameTree(a.sons[i], b.sons[i]): return result = true - -proc getProcSym*(call: PNode): PSym = + +proc getProcSym*(call: PNode): PSym = result = call.sons[0].sym -proc getOpSym*(op: PNode): PSym = +proc getOpSym*(op: PNode): PSym = if op.kind notin {nkCall, nkHiddenCallConv, nkCommand, nkCallStrLit}: result = nil else: @@ -91,25 +91,25 @@ proc getOpSym*(op: PNode): PSym = elif op.sons[0].kind == nkSym: result = op.sons[0].sym else: result = nil -proc getMagic*(op: PNode): TMagic = +proc getMagic*(op: PNode): TMagic = case op.kind of nkCallKinds: case op.sons[0].kind of nkSym: result = op.sons[0].sym.magic else: result = mNone else: result = mNone - -proc treeToSym*(t: PNode): PSym = + +proc treeToSym*(t: PNode): PSym = result = t.sym -proc isConstExpr*(n: PNode): bool = +proc isConstExpr*(n: PNode): bool = result = (n.kind in - {nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, + {nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, nkFloatLit..nkFloat64Lit, nkNilLit}) or (nfAllConst in n.flags) proc isDeepConstExpr*(n: PNode): bool = case n.kind - of nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, + of nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, nkFloatLit..nkFloat64Lit, nkNilLit: result = true of nkExprEqExpr, nkExprColonExpr, nkHiddenStdConv, nkHiddenSubConv: @@ -122,33 +122,33 @@ proc isDeepConstExpr*(n: PNode): bool = result = n.typ.isNil or n.typ.skipTypes({tyGenericInst, tyDistinct}).kind != tyObject else: discard -proc flattenTreeAux(d, a: PNode, op: TMagic) = +proc flattenTreeAux(d, a: PNode, op: TMagic) = if (getMagic(a) == op): # a is a "leaf", so add it: for i in countup(1, sonsLen(a) - 1): # BUGFIX flattenTreeAux(d, a.sons[i], op) - else: + else: addSon(d, copyTree(a)) - -proc flattenTree*(root: PNode, op: TMagic): PNode = + +proc flattenTree*(root: PNode, op: TMagic): PNode = result = copyNode(root) if getMagic(root) == op: # BUGFIX: forget to copy prc addSon(result, copyNode(root.sons[0])) flattenTreeAux(result, root, op) -proc swapOperands*(op: PNode) = +proc swapOperands*(op: PNode) = var tmp = op.sons[1] op.sons[1] = op.sons[2] op.sons[2] = tmp -proc isRange*(n: PNode): bool {.inline.} = - if n.kind == nkInfix: +proc isRange*(n: PNode): bool {.inline.} = + if n.kind in nkCallKinds: if n[0].kind == nkIdent and n[0].ident.id == ord(wDotDot) or - n[0].kind in {nkClosedSymChoice, nkOpenSymChoice} and + n[0].kind in {nkClosedSymChoice, nkOpenSymChoice} and n[0][1].sym.name.id == ord(wDotDot): result = true -proc whichPragma*(n: PNode): TSpecialWord = +proc whichPragma*(n: PNode): TSpecialWord = let key = if n.kind == nkExprColonExpr: n.sons[0] else: n if key.kind == nkIdent: result = whichKeyword(key.ident) diff --git a/compiler/types.nim b/compiler/types.nim index 5f506f10f..7f05e7051 100644 --- a/compiler/types.nim +++ b/compiler/types.nim @@ -434,7 +434,7 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = result = "int literal(" & $t.n.intVal & ")" of tyGenericBody, tyGenericInst, tyGenericInvocation: result = typeToString(t.sons[0]) & '[' - for i in countup(1, sonsLen(t) -1 -ord(t.kind != tyGenericInvocation)): + for i in countup(1, sonsLen(t)-1-ord(t.kind != tyGenericInvocation)): if i > 1: add(result, ", ") add(result, typeToString(t.sons[i], preferGenericArg)) add(result, ']') @@ -541,6 +541,9 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = of tyProc: result = if tfIterator in t.flags: "iterator (" else: "proc (" for i in countup(1, sonsLen(t) - 1): + if t.n != nil and i < t.n.len and t.n[i].kind == nkSym: + add(result, t.n[i].sym.name.s) + add(result, ": ") add(result, typeToString(t.sons[i])) if i < sonsLen(t) - 1: add(result, ", ") add(result, ')') @@ -590,7 +593,7 @@ proc firstOrd(t: PType): BiggestInt = of tyUInt..tyUInt64: result = 0 of tyEnum: # if basetype <> nil then return firstOrd of basetype - if (sonsLen(t) > 0) and (t.sons[0] != nil): + if sonsLen(t) > 0 and t.sons[0] != nil: result = firstOrd(t.sons[0]) else: assert(t.n.sons[0].kind == nkSym) @@ -919,6 +922,9 @@ proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool = result = sameFlags(a, b) of tyStatic, tyFromExpr: result = exprStructuralEquivalent(a.n, b.n) and sameFlags(a, b) + if result and a.len == b.len and a.len == 1: + cycleCheck() + result = sameTypeAux(a.sons[0], b.sons[0], c) of tyObject: ifFastObjectTypeCheckFailed(a, b): cycleCheck() @@ -1089,9 +1095,11 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, if result != nil: break if result.isNil and t.sons[0] != nil: result = typeAllowedAux(marker, t.sons[0], skResult, flags) - of tyExpr, tyStmt, tyTypeDesc, tyStatic: + of tyTypeDesc: + # XXX: This is still a horrible idea... result = nil - # XXX er ... no? these should not be allowed! + of tyExpr, tyStmt, tyStatic: + if kind notin {skParam, skResult}: result = t of tyEmpty: if taField notin flags: result = t of tyTypeClasses: diff --git a/compiler/vm.nim b/compiler/vm.nim index 3b5c8e7f3..6fae5a8b7 100644 --- a/compiler/vm.nim +++ b/compiler/vm.nim @@ -1043,7 +1043,14 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = decodeB(rkNode) let newLen = regs[rb].intVal.int if regs[ra].node.isNil: stackTrace(c, tos, pc, errNilAccess) - else: setLen(regs[ra].node.sons, newLen) + else: + let oldLen = regs[ra].node.len + setLen(regs[ra].node.sons, newLen) + if oldLen < newLen: + # XXX This is still not entirely correct + # set to default value: + for i in oldLen .. <newLen: + regs[ra].node.sons[i] = newNodeI(nkEmpty, c.debug[pc]) of opcSwap: let rb = instr.regB if regs[ra].kind == regs[rb].kind: diff --git a/compiler/vmdef.nim b/compiler/vmdef.nim index 90b9f2517..b4892d010 100644 --- a/compiler/vmdef.nim +++ b/compiler/vmdef.nim @@ -16,7 +16,7 @@ const byteExcess* = 128 # we use excess-K for immediates wordExcess* = 32768 - MaxLoopIterations* = 500_000 # max iterations of all loops + MaxLoopIterations* = 1500_000 # max iterations of all loops type @@ -29,7 +29,7 @@ type opcRet, # return opcYldYoid, # yield with no value opcYldVal, # yield with a value - + opcAsgnInt, opcAsgnStr, opcAsgnFloat, @@ -48,8 +48,8 @@ type opcWrDeref, opcWrStrIdx, opcLdStrIdx, # a = b[c] - - opcAddInt, + + opcAddInt, opcAddImmInt, opcSubInt, opcSubImmInt, @@ -58,36 +58,36 @@ type opcIncl, opcInclRange, opcExcl, opcCard, opcMulInt, opcDivInt, opcModInt, opcAddFloat, opcSubFloat, opcMulFloat, opcDivFloat, opcShrInt, opcShlInt, - opcBitandInt, opcBitorInt, opcBitxorInt, opcAddu, opcSubu, opcMulu, - opcDivu, opcModu, opcEqInt, opcLeInt, opcLtInt, opcEqFloat, - opcLeFloat, opcLtFloat, opcLeu, opcLtu, opcEqRef, opcEqNimrodNode, opcXor, - opcNot, opcUnaryMinusInt, opcUnaryMinusFloat, opcBitnotInt, + opcBitandInt, opcBitorInt, opcBitxorInt, opcAddu, opcSubu, opcMulu, + opcDivu, opcModu, opcEqInt, opcLeInt, opcLtInt, opcEqFloat, + opcLeFloat, opcLtFloat, opcLeu, opcLtu, opcEqRef, opcEqNimrodNode, opcXor, + opcNot, opcUnaryMinusInt, opcUnaryMinusFloat, opcBitnotInt, opcEqStr, opcLeStr, opcLtStr, opcEqSet, opcLeSet, opcLtSet, opcMulSet, opcPlusSet, opcMinusSet, opcSymdiffSet, opcConcatStr, opcContainsSet, opcRepr, opcSetLenStr, opcSetLenSeq, opcSwap, opcIsNil, opcOf, opcIs, opcSubStr, opcParseFloat, opcConv, opcCast, opcQuit, opcReset, opcNarrowS, opcNarrowU, - + opcAddStrCh, opcAddStrStr, opcAddSeqElem, opcRangeChck, - + opcNAdd, opcNAddMultiple, - opcNKind, - opcNIntVal, - opcNFloatVal, - opcNSymbol, + opcNKind, + opcNIntVal, + opcNFloatVal, + opcNSymbol, opcNIdent, opcNGetType, opcNStrVal, - + opcNSetIntVal, opcNSetFloatVal, opcNSetSymbol, opcNSetIdent, opcNSetType, opcNSetStrVal, opcNNewNimNode, opcNCopyNimNode, opcNCopyNimTree, opcNDel, opcGenSym, - + opcSlurp, opcGorge, opcParseExprToAst, @@ -100,7 +100,7 @@ type opcEqIdent, opcStrToIdent, opcIdentToStr, - + opcEcho, opcIndCall, # dest = call regStart, n; where regStart = fn, arg1, ... opcIndCallAsgn, # dest = call regStart, n; where regStart = fn, arg1, ... @@ -110,7 +110,7 @@ type opcNSetChild, opcCallSite, opcNewStr, - + opcTJmp, # jump Bx if A != 0 opcFJmp, # jump Bx if A == 0 opcJmp, # jump Bx @@ -178,13 +178,13 @@ type slots*: pointer currentException*: PNode VmCallback* = proc (args: VmArgs) {.closure.} - + PCtx* = ref TCtx TCtx* = object of passes.TPassContext # code gen context code*: seq[TInstr] debug*: seq[TLineInfo] # line info for every instruction; kept separate # to not slow down interpretation - globals*: PNode # + globals*: PNode # constants*: PNode # constant data types*: seq[PType] # some instructions reference types (e.g. 'except') currentExceptionA*, currentExceptionB*: PNode @@ -203,7 +203,7 @@ type TPosition* = distinct int PEvalContext* = PCtx - + proc newCtx*(module: PSym): PCtx = PCtx(code: @[], debug: @[], globals: newNode(nkStmtListExpr), constants: newNode(nkStmtList), types: @[], diff --git a/compiler/vmdeps.nim b/compiler/vmdeps.nim index 2b80f6aed..21ee4967b 100644 --- a/compiler/vmdeps.nim +++ b/compiler/vmdeps.nim @@ -42,6 +42,7 @@ proc opSlurp*(file: string, info: TLineInfo, module: PSym): string = proc atomicTypeX(name: string; t: PType; info: TLineInfo): PNode = let sym = newSym(skType, getIdent(name), t.owner, info) + sym.typ = t result = newSymNode(sym) result.typ = t @@ -143,7 +144,9 @@ proc mapTypeToAst(t: PType, info: TLineInfo; allowRecursion=false): PNode = of tyIter: result = mapTypeToBracket("iter", t, info) of tyProxy: result = atomicType"error" of tyBuiltInTypeClass: result = mapTypeToBracket("builtinTypeClass", t, info) - of tyUserTypeClass: result = mapTypeToBracket("userTypeClass", t, info) + of tyUserTypeClass: + result = mapTypeToBracket("concept", t, info) + result.add t.n.copyTree of tyCompositeTypeClass: result = mapTypeToBracket("compositeTypeClass", t, info) of tyAnd: result = mapTypeToBracket("and", t, info) of tyOr: result = mapTypeToBracket("or", t, info) diff --git a/compiler/vmgen.nim b/compiler/vmgen.nim index 2383e2542..b354061a9 100644 --- a/compiler/vmgen.nim +++ b/compiler/vmgen.nim @@ -368,7 +368,7 @@ proc sameConstant*(a, b: PNode): bool = case a.kind of nkSym: result = a.sym == b.sym of nkIdent: result = a.ident.id == b.ident.id - of nkCharLit..nkInt64Lit: result = a.intVal == b.intVal + of nkCharLit..nkUInt64Lit: result = a.intVal == b.intVal of nkFloatLit..nkFloat64Lit: result = a.floatVal == b.floatVal of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal of nkType, nkNilLit: result = a.typ == b.typ @@ -742,9 +742,9 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest) = c.gABC(n, opcNewStr, dest, tmp) c.freeTemp(tmp) # XXX buggy - of mLengthOpenArray, mLengthArray, mLengthSeq: + of mLengthOpenArray, mLengthArray, mLengthSeq, mXLenSeq: genUnaryABI(c, n, dest, opcLenSeq) - of mLengthStr: + of mLengthStr, mXLenStr: genUnaryABI(c, n, dest, opcLenStr) of mIncl, mExcl: unused(n, dest) @@ -791,7 +791,7 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest) = genUnaryABC(c, n, dest, opcUnaryMinusInt) genNarrow(c, n, dest) of mUnaryMinusF64: genUnaryABC(c, n, dest, opcUnaryMinusFloat) - of mUnaryPlusI, mUnaryPlusI64, mUnaryPlusF64: gen(c, n.sons[1], dest) + of mUnaryPlusI, mUnaryPlusF64: gen(c, n.sons[1], dest) of mBitnotI, mBitnotI64: genUnaryABC(c, n, dest, opcBitnotInt) genNarrowU(c, n, dest) @@ -1008,7 +1008,8 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest) = if dest < 0: dest = c.getTemp(n.typ) c.gABC(n, opcCallSite, dest) of mNGenSym: genBinaryABC(c, n, dest, opcGenSym) - of mMinI, mMaxI, mMinI64, mMaxI64, mAbsF64, mMinF64, mMaxF64, mAbsI, mAbsI64: + of mMinI, mMaxI, mAbsF64, mMinF64, mMaxF64, mAbsI, + mAbsI64, mDotDot: c.genCall(n, dest) of mExpandToAst: if n.len != 2: @@ -1363,7 +1364,7 @@ proc getNullValue(typ: PType, info: TLineInfo): PNode = of tyCString, tyString: result = newNodeIT(nkStrLit, info, t) of tyVar, tyPointer, tyPtr, tySequence, tyExpr, - tyStmt, tyTypeDesc, tyStatic, tyRef: + tyStmt, tyTypeDesc, tyStatic, tyRef, tyNil: result = newNodeIT(nkNilLit, info, t) of tyProc: if t.callConv != ccClosure: @@ -1390,7 +1391,7 @@ proc getNullValue(typ: PType, info: TLineInfo): PNode = addSon(result, getNullValue(t.sons[i], info)) of tySet: result = newNodeIT(nkCurly, info, t) - else: internalError("getNullValue: " & $t.kind) + else: internalError(info, "getNullValue: " & $t.kind) proc ldNullOpcode(t: PType): TOpcode = if fitsRegister(t): opcLdNullReg else: opcLdNull @@ -1609,7 +1610,8 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = genBreak(c, n) of nkTryStmt: genTry(c, n, dest) of nkStmtList: - unused(n, dest) + #unused(n, dest) + # XXX Fix this bug properly, lexim triggers it for x in n: gen(c, x) of nkStmtListExpr: let L = n.len-1 diff --git a/compiler/wordrecg.nim b/compiler/wordrecg.nim index ae036bc0c..63fd995c4 100644 --- a/compiler/wordrecg.nim +++ b/compiler/wordrecg.nim @@ -13,44 +13,44 @@ # does not support strings. Without this the code would # be slow and unreadable. -import +import hashes, strutils, idents # Keywords must be kept sorted and within a range type - TSpecialWord* = enum - wInvalid, - - wAddr, wAnd, wAs, wAsm, wAtomic, - wBind, wBlock, wBreak, wCase, wCast, wConst, - wContinue, wConverter, wDefer, wDiscard, wDistinct, wDiv, wDo, + TSpecialWord* = enum + wInvalid, + + wAddr, wAnd, wAs, wAsm, wAtomic, + wBind, wBlock, wBreak, wCase, wCast, wConcept, wConst, + wContinue, wConverter, wDefer, wDiscard, wDistinct, wDiv, wDo, wElif, wElse, wEnd, wEnum, wExcept, wExport, - wFinally, wFor, wFrom, wFunc, wGeneric, wIf, wImport, wIn, + wFinally, wFor, wFrom, wFunc, wGeneric, wIf, wImport, wIn, wInclude, wInterface, wIs, wIsnot, wIterator, wLet, - wMacro, wMethod, wMixin, wMod, wNil, - wNot, wNotin, wObject, wOf, wOr, wOut, wProc, wPtr, wRaise, wRef, wReturn, - wShl, wShr, wStatic, wTemplate, wTry, wTuple, wType, wUsing, wVar, + wMacro, wMethod, wMixin, wMod, wNil, + wNot, wNotin, wObject, wOf, wOr, wOut, wProc, wPtr, wRaise, wRef, wReturn, + wShl, wShr, wStatic, wTemplate, wTry, wTuple, wType, wUsing, wVar, wWhen, wWhile, wWith, wWithout, wXor, wYield, - + wColon, wColonColon, wEquals, wDot, wDotDot, wStar, wMinus, wMagic, wThread, wFinal, wProfiler, wObjChecks, wDestroy, - - wImmediate, wDestructor, wDelegator, wOverride, + + wImmediate, wConstructor, wDestructor, wDelegator, wOverride, wImportCpp, wImportObjC, wImportCompilerProc, wImportc, wExportc, wIncompleteStruct, wRequiresInit, wAlign, wNodecl, wPure, wSideeffect, wHeader, - wNosideeffect, wGcSafe, wNoreturn, wMerge, wLib, wDynlib, - wCompilerproc, wProcVar, - wFatal, wError, wWarning, wHint, wLine, wPush, wPop, wDefine, wUndef, - wLinedir, wStacktrace, wLinetrace, wLink, wCompile, - wLinksys, wDeprecated, wVarargs, wCallconv, wBreakpoint, wDebugger, - wNimcall, wStdcall, wCdecl, wSafecall, wSyscall, wInline, wNoInline, - wFastcall, wClosure, wNoconv, wOn, wOff, wChecks, wRangechecks, + wNosideeffect, wGcSafe, wNoreturn, wMerge, wLib, wDynlib, + wCompilerproc, wProcVar, + wFatal, wError, wWarning, wHint, wLine, wPush, wPop, wDefine, wUndef, + wLinedir, wStacktrace, wLinetrace, wLink, wCompile, + wLinksys, wDeprecated, wVarargs, wCallconv, wBreakpoint, wDebugger, + wNimcall, wStdcall, wCdecl, wSafecall, wSyscall, wInline, wNoInline, + wFastcall, wClosure, wNoconv, wOn, wOff, wChecks, wRangechecks, wBoundchecks, wOverflowchecks, wNilchecks, wFloatchecks, wNanChecks, wInfChecks, wAssertions, wPatterns, wWarnings, @@ -59,11 +59,11 @@ type wPragma, wCompileTime, wNoInit, wPassc, wPassl, wBorrow, wDiscardable, - wFieldChecks, - wWatchPoint, wSubsChar, - wAcyclic, wShallow, wUnroll, wLinearScanEnd, wComputedGoto, + wFieldChecks, + wWatchPoint, wSubsChar, + wAcyclic, wShallow, wUnroll, wLinearScanEnd, wComputedGoto, wInjectStmt, wExperimental, - wWrite, wGensym, wInject, wDirty, wInheritable, wThreadVar, wEmit, + wWrite, wGensym, wInject, wDirty, wInheritable, wThreadVar, wEmit, wAsmNoStackFrame, wImplicitStatic, wGlobal, wCodegenDecl, wUnchecked, wGuard, wLocks, @@ -82,38 +82,38 @@ type wStdIn, wStdOut, wStdErr, wInOut, wByCopy, wByRef, wOneWay, - + TSpecialWords* = set[TSpecialWord] -const +const oprLow* = ord(wColon) oprHigh* = ord(wDotDot) - + nimKeywordsLow* = ord(wAsm) nimKeywordsHigh* = ord(wYield) - + ccgKeywordsLow* = ord(wAuto) ccgKeywordsHigh* = ord(wOneWay) - + cppNimSharedKeywords* = { wAsm, wBreak, wCase, wConst, wContinue, wDo, wElse, wEnum, wExport, wFor, wIf, wReturn, wStatic, wTemplate, wTry, wWhile, wUsing} - specialWords*: array[low(TSpecialWord)..high(TSpecialWord), string] = ["", - - "addr", "and", "as", "asm", "atomic", - "bind", "block", "break", "case", "cast", - "const", "continue", "converter", + specialWords*: array[low(TSpecialWord)..high(TSpecialWord), string] = ["", + + "addr", "and", "as", "asm", "atomic", + "bind", "block", "break", "case", "cast", + "concept", "const", "continue", "converter", "defer", "discard", "distinct", "div", "do", - "elif", "else", "end", "enum", "except", "export", - "finally", "for", "from", "func", "generic", "if", + "elif", "else", "end", "enum", "except", "export", + "finally", "for", "from", "func", "generic", "if", "import", "in", "include", "interface", "is", "isnot", "iterator", "let", "macro", "method", "mixin", "mod", "nil", "not", "notin", - "object", "of", "or", + "object", "of", "or", "out", "proc", "ptr", "raise", "ref", "return", "shl", "shr", "static", - "template", "try", "tuple", "type", "using", "var", + "template", "try", "tuple", "type", "using", "var", "when", "while", "with", "without", "xor", "yield", @@ -122,22 +122,22 @@ const "magic", "thread", "final", "profiler", "objchecks", "destroy", - - "immediate", "destructor", "delegator", "override", + + "immediate", "constructor", "destructor", "delegator", "override", "importcpp", "importobjc", "importcompilerproc", "importc", "exportc", "incompletestruct", "requiresinit", "align", "nodecl", "pure", "sideeffect", - "header", "nosideeffect", "gcsafe", "noreturn", "merge", "lib", "dynlib", - "compilerproc", "procvar", "fatal", "error", "warning", "hint", "line", - "push", "pop", "define", "undef", "linedir", "stacktrace", "linetrace", - "link", "compile", "linksys", "deprecated", "varargs", - "callconv", "breakpoint", "debugger", "nimcall", "stdcall", + "header", "nosideeffect", "gcsafe", "noreturn", "merge", "lib", "dynlib", + "compilerproc", "procvar", "fatal", "error", "warning", "hint", "line", + "push", "pop", "define", "undef", "linedir", "stacktrace", "linetrace", + "link", "compile", "linksys", "deprecated", "varargs", + "callconv", "breakpoint", "debugger", "nimcall", "stdcall", "cdecl", "safecall", "syscall", "inline", "noinline", "fastcall", "closure", - "noconv", "on", "off", "checks", "rangechecks", "boundchecks", + "noconv", "on", "off", "checks", "rangechecks", "boundchecks", "overflowchecks", "nilchecks", "floatchecks", "nanchecks", "infchecks", - "assertions", "patterns", "warnings", "hints", + "assertions", "patterns", "warnings", "hints", "optimization", "raises", "writes", "reads", "size", "effects", "tags", "deadcodeelim", "safecode", "noforward", "pragma", @@ -149,7 +149,7 @@ const "write", "gensym", "inject", "dirty", "inheritable", "threadvar", "emit", "asmnostackframe", "implicitstatic", "global", "codegendecl", "unchecked", "guard", "locks", - + "auto", "bool", "catch", "char", "class", "const_cast", "default", "delete", "double", "dynamic_cast", "explicit", "extern", "false", @@ -169,22 +169,22 @@ const "inout", "bycopy", "byref", "oneway", ] -proc findStr*(a: openArray[string], s: string): int = - for i in countup(low(a), high(a)): - if cmpIgnoreStyle(a[i], s) == 0: +proc findStr*(a: openArray[string], s: string): int = + for i in countup(low(a), high(a)): + if cmpIgnoreStyle(a[i], s) == 0: return i result = - 1 -proc whichKeyword*(id: PIdent): TSpecialWord = +proc whichKeyword*(id: PIdent): TSpecialWord = if id.id < 0: result = wInvalid else: result = TSpecialWord(id.id) -proc whichKeyword*(id: string): TSpecialWord = +proc whichKeyword*(id: string): TSpecialWord = result = whichKeyword(getIdent(id)) - -proc initSpecials() = + +proc initSpecials() = # initialize the keywords: - for s in countup(succ(low(specialWords)), high(specialWords)): + for s in countup(succ(low(specialWords)), high(specialWords)): getIdent(specialWords[s], hashIgnoreStyle(specialWords[s])).id = ord(s) - + initSpecials() |