diff options
228 files changed, 10020 insertions, 8457 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() diff --git a/doc/grammar.txt b/doc/grammar.txt index 2b04e6ca8..b53515495 100644 --- a/doc/grammar.txt +++ b/doc/grammar.txt @@ -3,17 +3,13 @@ comma = ',' COMMENT? semicolon = ';' COMMENT? colon = ':' COMMENT? colcom = ':' COMMENT? - -operator = OP0 | OP1 | OP2 | OP3 | OP4 | OP5 | OP6 | OP7 | OP8 | OP9 | OP10 +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{=})? - simpleExpr = arrowExpr (OP0 optInd arrowExpr)* arrowExpr = assignExpr (OP1 optInd assignExpr)* assignExpr = orExpr (OP2 optInd orExpr)* @@ -26,20 +22,20 @@ plusExpr = mulExpr (OP8 optInd mulExpr)* mulExpr = dollarExpr (OP9 optInd dollarExpr)* dollarExpr = primary (OP10 optInd primary)* symbol = '`' (KEYW|IDENT|literal|(operator|'('|')'|'['|']'|'{'|'}'|'=')+)+ '`' - | IDENT + | IDENT | 'addr' | 'type' indexExpr = expr indexExprList = indexExpr ^+ comma exprColonEqExpr = expr (':'|'=' expr)? exprList = expr ^+ comma -dotExpr = expr '.' optInd ('type' | 'addr' | symbol) -qualifiedIdent = symbol ('.' optInd ('type' | 'addr' | symbol))? +dotExpr = expr '.' optInd symbol +qualifiedIdent = symbol ('.' optInd symbol)? exprColonEqExprList = exprColonEqExpr (comma exprColonEqExpr)* (comma)? setOrTableConstr = '{' ((exprColonEqExpr comma)* | ':' ) '}' castExpr = 'cast' '[' optInd typeDesc optPar ']' '(' optInd expr optPar ')' 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 ')' @@ -56,11 +52,11 @@ identOrLiteral = generalizedLit | symbol | literal tupleConstr = '(' optInd (exprColonEqExpr comma?)* optPar ')' arrayConstr = '[' optInd (exprColonEqExpr comma?)* optPar ']' 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 condExpr = expr colcom expr optInd ('elif' expr colcom expr optInd)* 'else' colcom expr @@ -77,6 +73,7 @@ inlTupleDecl = 'tuple' [' optInd (identColonEquals (comma/semicolon)?)* optPar ']' extTupleDecl = 'tuple' COMMENT? (IND{>} identColonEquals (IND{=} identColonEquals)*)? +tupleClass = 'tuple' paramList = '(' declColonEquals ^* (comma/semicolon) ')' paramListArrow = paramList? ('->' optInd typeDesc)? paramListColon = paramList? (':' optInd typeDesc)? @@ -89,17 +86,16 @@ expr = (ifExpr | caseExpr | tryExpr) / simpleExpr -typeKeyw = 'var' | 'ref' | 'ptr' | 'shared' | 'type' | 'tuple' +typeKeyw = 'var' | 'ref' | 'ptr' | 'shared' | 'tuple' | 'proc' | 'iterator' | 'distinct' | 'object' | 'enum' primary = typeKeyw typeDescK / prefixOperator* identOrLiteral primarySuffix* - / 'addr' primary / 'static' primary / 'bind' primary typeDesc = simpleExpr typeDefAux = simpleExpr - | 'generic' typeClass -macroColon = ':' stmt? ( IND{=} 'of' exprList ':' stmt + | 'concept' typeClass +macroColon = ':' stmt? ( IND{=} 'of' exprList ':' stmt | IND{=} 'elif' expr ':' stmt | IND{=} 'except' exprList ':' stmt | IND{=} 'else' ':' stmt )* diff --git a/doc/keywords.txt b/doc/keywords.txt index 7a4f8c696..405bf1981 100644 --- a/doc/keywords.txt +++ b/doc/keywords.txt @@ -1,6 +1,6 @@ addr and as asm atomic bind block break -case cast const continue converter +case cast concept const continue converter defer discard distinct div do elif else end enum except export finally for from func diff --git a/doc/manual/generics.txt b/doc/manual/generics.txt index f3e7b7b4c..2736f88fb 100644 --- a/doc/manual/generics.txt +++ b/doc/manual/generics.txt @@ -60,7 +60,7 @@ Is operator ----------- The ``is`` operator checks for type equivalence at compile time. It is -therefore very useful for type specialization within generic code: +therefore very useful for type specialization within generic code: .. code-block:: nim type @@ -75,7 +75,7 @@ Type operator ------------- The ``type`` (in many other languages called `typeof`:idx:) operator can -be used to get the type of an expression: +be used to get the type of an expression: .. code-block:: nim var x = 0 @@ -88,7 +88,7 @@ other interpretations: .. code-block:: nim import strutils - + # strutils contains both a ``split`` proc and iterator, but since an # an iterator is the preferred interpretation, `y` has the type ``string``: var y: type("a b c".split) @@ -98,7 +98,7 @@ Type Classes ------------ A type class is a special pseudo-type that can be used to match against -types in the context of overload resolution or the ``is`` operator. +types in the context of overload resolution or the ``is`` operator. Nim supports the following built-in type classes: ================== =================================================== @@ -116,7 +116,7 @@ type class matches ``array`` any array type ``set`` any set type ``seq`` any seq type -``auto`` any type +``auto`` any type ================== =================================================== Furthermore, every generic type automatically creates a type class of the same @@ -134,7 +134,7 @@ more complex type classes: echo key, " = ", value Procedures utilizing type classes in such manner are considered to be -`implicitly generic`:idx:. They will be instantiated once for each unique +`implicitly generic`:idx:. They will be instantiated once for each unique combination of param types used within the program. Nim also allows for type classes and regular types to be specified @@ -142,7 +142,7 @@ as `type constraints`:idx: of the generic type parameter: .. code-block:: nim proc onlyIntOrString[T: int|string](x, y: T) = discard - + onlyIntOrString(450, 616) # valid onlyIntOrString(5.0, 0.0) # type mismatch onlyIntOrString("xy", 50) # invalid as 'T' cannot be both at the same time @@ -152,7 +152,7 @@ exactly one concrete type. Here is an example taken directly from the system module to illustrate this: .. code-block:: nim - proc `==`*(x, y: tuple): bool = + proc `==`*(x, y: tuple): bool = ## requires `x` and `y` to be of the same tuple type ## generic ``==`` operator for tuples that is lifted from the components ## of `x` and `y`. @@ -160,8 +160,8 @@ module to illustrate this: for a, b in fields(x, y): if a != b: result = false -Alternatively, the ``distinct`` type modifier can be applied to the type class -to allow each param matching the type class to bind to a different type. +Alternatively, the ``distinct`` type modifier can be applied to the type class +to allow each param matching the type class to bind to a different type. If a proc param doesn't have a type specified, Nim will use the ``distinct auto`` type class (also known as ``any``): @@ -178,7 +178,7 @@ the dot syntax: type Matrix[T, Rows, Columns] = object ... - proc `[]`(m: Matrix, row, col: int): Matrix.T = + proc `[]`(m: Matrix, row, col: int): Matrix.T = m.data[col * high(Matrix.Columns) + row] Alternatively, the `type` operator can be used over the proc params for similar @@ -189,7 +189,7 @@ type, this results in another more specific type class: .. code-block:: nim seq[ref object] # Any sequence storing references to any object type - + type T1 = auto proc foo(s: seq[T1], e: T1) # seq[T1] is the same as just `seq`, but T1 will be allowed to bind @@ -203,34 +203,33 @@ be inferred to have the equivalent of the `any` type class and thus they will match anything without discrimination. -User defined type classes -------------------------- +Concepts +-------- -**Note**: User defined type classes are still in development. +**Note**: Concepts are still in development. -The user-defined type classes are available in two flavours - declarative and -imperative. Both are used to specify an arbitrary set of requirements that the -matched type must satisfy. +Concepts, also known as "user-defined type classes", are used to specify an +arbitrary set of requirements that the matched type must satisfy. -Declarative type classes are written in the following form: +Concepts are written in the following form: .. code-block:: nim type - Comparable = generic x, y + Comparable = concept x, y (x < y) is bool - Container[T] = generic c - c.len is ordinal + Container[T] = concept c + c.len is Ordinal items(c) is iterator for value in c: type(value) is T -The type class will be matched if: +The concept is a match if: a) all of the expressions within the body can be compiled for the tested type b) all statically evaluatable boolean expressions in the body must be true -The identifiers following the `generic` keyword represent instances of the +The identifiers following the ``concept`` keyword represent instances of the currently matched type. These instances can act both as variables of the type, when used in contexts where a value is expected, and as the type itself when used in contexts where a type is expected. @@ -240,45 +239,21 @@ type signatures of the required operations, but since type inference and default parameters are still applied in the provided block, it's also possible to encode usage protocols that do not reveal implementation details. -As a special rule providing further convenience when writing type classes, any +As a special rule providing further convenience when writing concepts, any type value appearing in a callable expression will be treated as a variable of the designated type for overload resolution purposes, unless the type value was passed in its explicit ``typedesc[T]`` form: .. code-block:: nim type - OutputStream = generic S - write(var S, string) + OutputStream = concept s + write(var s, string) -Much like generics, the user defined type classes will be instantiated exactly -once for each tested type and any static code included within them will also be +Much like generics, concepts are instantiated exactly +once for each tested type and any static code included within them is also executed once. -Type inference with type classes --------------------------------- - -If a type class is used as the return type of a proc and it won't be bound to -a concrete type by some of the proc params, Nim will infer the return type -from the proc body. This is usually used with the ``auto`` type class: - -.. code-block:: nim - proc makePair(a, b): auto = (first: a, second: b) - -The return type will be treated as an additional generic param and can be -explicitly specified at call sites as any other generic param. - -Future versions of Nim may also support overloading based on the return type -of the overloads. In such settings, the expected result type at call sites may -also influence the inferred return type. - -.. - Likewise, if a type class is used in another position where Nim expects a - concrete type (e.g. a variable declaration or a type coercion), Nim will try - to infer the concrete type by applying the matching algorithm that also used - in overload resolution. - - Symbol lookup in generics ------------------------- @@ -293,12 +268,12 @@ at definition and the context at instantiation are considered: .. code-block:: nim type Index = distinct int - + proc `==` (a, b: Index): bool {.borrow.} - + var a = (0, 0.Index) var b = (0, 0.Index) - + echo a == b # works! In the example the generic ``==`` for tuples (as defined in the system module) @@ -307,7 +282,7 @@ the ``Index`` type is defined *after* the ``==`` for tuples; yet the example compiles as the instantiation takes the currently defined symbols into account too. -A symbol can be forced to be open by a `mixin`:idx: declaration: +A symbol can be forced to be open by a `mixin`:idx: declaration: .. code-block:: nim proc create*[T](): ref T = @@ -321,16 +296,16 @@ A symbol can be forced to be open by a `mixin`:idx: declaration: Bind statement -------------- -The ``bind`` statement is the counterpart to the ``mixin`` statement. It +The ``bind`` statement is the counterpart to the ``mixin`` statement. It can be used to explicitly declare identifiers that should be bound early (i.e. the identifiers should be looked up in the scope of the template/generic definition): .. code-block:: nim # Module A - var + var lastId = 0 - + template genId*: expr = bind lastId inc(lastId) @@ -339,7 +314,7 @@ definition): .. code-block:: nim # Module B import A - + echo genId() But a ``bind`` is rarely useful because symbol binding from the definition diff --git a/doc/manual/lexing.txt b/doc/manual/lexing.txt index e2f006f04..df6d85636 100644 --- a/doc/manual/lexing.txt +++ b/doc/manual/lexing.txt @@ -289,7 +289,7 @@ Numerical constants are of a single type and have the form:: INT32_LIT = INT_LIT ['\''] ('i' | 'I') '32' INT64_LIT = INT_LIT ['\''] ('i' | 'I') '64' - UINT8_LIT = INT_LIT ['\''] ('u' | 'U') + UINT_LIT = INT_LIT ['\''] ('u' | 'U') UINT8_LIT = INT_LIT ['\''] ('u' | 'U') '8' UINT16_LIT = INT_LIT ['\''] ('u' | 'U') '16' UINT32_LIT = INT_LIT ['\''] ('u' | 'U') '32' diff --git a/doc/manual/pragmas.txt b/doc/manual/pragmas.txt index 34428233f..39aebd826 100644 --- a/doc/manual/pragmas.txt +++ b/doc/manual/pragmas.txt @@ -14,7 +14,7 @@ deprecated pragma The deprecated pragma is used to mark a symbol as deprecated: -.. code-block:: nimrod +.. code-block:: nim proc p() {.deprecated.} var x {.deprecated.}: char @@ -22,7 +22,7 @@ It can also be used as a statement. Then it takes a list of *renamings*. The upcoming ``nimfix`` tool can automatically update the code and perform these renamings: -.. code-block:: nimrod +.. code-block:: nim type File = object Stream = ref object @@ -71,14 +71,13 @@ procedural variable. compileTime pragma ------------------ -The ``compileTime`` pragma is used to mark a proc to be used at compile -time only. No code will be generated for it. Compile time procs are useful -as helpers for macros. - +The ``compileTime`` pragma is used to mark a proc or variable to be used at +compile time only. No code will be generated for it. Compile time procs are +useful as helpers for macros. noReturn pragma --------------- -The ``noreturn`` pragma is used to mark a proc that never returns. +The ``noreturn`` pragma is used to mark a proc that never returns. acyclic pragma @@ -122,25 +121,25 @@ shallow pragma -------------- The ``shallow`` pragma affects the semantics of a type: The compiler is allowed to make a shallow copy. This can cause serious semantic issues and -break memory safety! However, it can speed up assignments considerably, -because the semantics of Nim require deep copying of sequences and strings. +break memory safety! However, it can speed up assignments considerably, +because the semantics of Nim require deep copying of sequences and strings. This can be expensive, especially if sequences are used to build a tree -structure: +structure: .. code-block:: nim type NodeKind = enum nkLeaf, nkInner Node {.final, shallow.} = object case kind: NodeKind - of nkLeaf: + of nkLeaf: strVal: string - of nkInner: + of nkInner: children: seq[Node] pure pragma ----------- -An object type can be marked with the ``pure`` pragma so that its type +An object type can be marked with the ``pure`` pragma so that its type field which is used for runtime type identification is omitted. This used to be necessary for binary compatibility with other compiled languages. @@ -163,12 +162,12 @@ error pragma ------------ The ``error`` pragma is used to make the compiler output an error message with the given content. Compilation does not necessarily abort after an error -though. +though. The ``error`` pragma can also be used to annotate a symbol (like an iterator or proc). The *usage* of the symbol then triggers a compile-time error. This is especially useful to rule out that some -operation is valid due to overloading and type conversions: +operation is valid due to overloading and type conversions: .. code-block:: nim ## check that underlying int values are compared and not the pointers: @@ -201,7 +200,7 @@ The ``line`` pragma can be used to affect line information of the annotated statement as seen in stack backtraces: .. code-block:: nim - + template myassert*(cond: expr, msg = "") = if not cond: # change run-time line information of the 'raise' statement: @@ -215,26 +214,26 @@ If the ``line`` pragma is used with a parameter, the parameter needs be a linearScanEnd pragma -------------------- -The ``linearScanEnd`` pragma can be used to tell the compiler how to +The ``linearScanEnd`` pragma can be used to tell the compiler how to compile a Nim `case`:idx: statement. Syntactically it has to be used as a statement: .. code-block:: nim case myInt - of 0: + of 0: echo "most common case" - of 1: + of 1: {.linearScanEnd.} echo "second most common case" of 2: echo "unlikely: use branch table" else: echo "unlikely too: use branch table for ", myInt -In the example, the case branches ``0`` and ``1`` are much more common than -the other cases. Therefore the generated assembler code should test for these -values first, so that the CPU's branch predictor has a good chance to succeed +In the example, the case branches ``0`` and ``1`` are much more common than +the other cases. Therefore the generated assembler code should test for these +values first, so that the CPU's branch predictor has a good chance to succeed (avoiding an expensive CPU pipeline stall). The other cases might be put into a jump table for O(1) overhead, but at the cost of a (very likely) pipeline -stall. +stall. The ``linearScanEnd`` pragma should be put into the last branch that should be tested against via linear scanning. If put into the last branch of the @@ -243,8 +242,8 @@ whole ``case`` statement, the whole ``case`` statement uses linear scanning. computedGoto pragma ------------------- -The ``computedGoto`` pragma can be used to tell the compiler how to -compile a Nim `case`:idx: in a ``while true`` statement. +The ``computedGoto`` pragma can be used to tell the compiler how to +compile a Nim `case`:idx: in a ``while true`` statement. Syntactically it has to be used as a statement inside the loop: .. code-block:: nim @@ -278,21 +277,21 @@ Syntactically it has to be used as a statement inside the loop: of enumE: break inc(pc) - + vm() As the example shows ``computedGoto`` is mostly useful for interpreters. If -the underlying backend (C compiler) does not support the computed goto +the underlying backend (C compiler) does not support the computed goto extension the pragma is simply ignored. unroll pragma ------------- The ``unroll`` pragma can be used to tell the compiler that it should unroll -a `for`:idx: or `while`:idx: loop for runtime efficiency: +a `for`:idx: or `while`:idx: loop for runtime efficiency: .. code-block:: nim - proc searchChar(s: string, c: char): int = + proc searchChar(s: string, c: char): int = for i in 0 .. s.high: {.unroll: 4.} if s[i] == c: return i @@ -440,7 +439,7 @@ Example: Please note that if a callable symbol is never used in this scenario, its body will never be compiled. This is the default behavior leading to best compilation - times, but if exhaustive compilation of all definitions is required, using + times, but if exhaustive compilation of all definitions is required, using ``nim check`` provides this option as well. Example: @@ -461,9 +460,9 @@ Example: pragma pragma ------------- -The ``pragma`` pragma can be used to declare user defined pragmas. This is -useful because Nim's templates and macros do not affect pragmas. User -defined pragmas are in a different module-wide scope than all other symbols. +The ``pragma`` pragma can be used to declare user defined pragmas. This is +useful because Nim's templates and macros do not affect pragmas. User +defined pragmas are in a different module-wide scope than all other symbols. They cannot be imported from a module. Example: @@ -473,8 +472,8 @@ Example: {.pragma: rtl, exportc, dynlib, cdecl.} else: {.pragma: rtl, importc, dynlib: "client.dll", cdecl.} - - proc p*(a, b: int): int {.rtl.} = + + proc p*(a, b: int): int {.rtl.} = result = a+b In the example a new pragma named ``rtl`` is introduced that either imports diff --git a/doc/manual/procs.txt b/doc/manual/procs.txt index 9b04bf518..9de984ecf 100644 --- a/doc/manual/procs.txt +++ b/doc/manual/procs.txt @@ -121,7 +121,7 @@ different; for this a special setter syntax is needed: .. code-block:: nim type - Socket* = object of RootObj + Socket* = ref object of RootObj FHost: int # cannot be accessed from the outside of the module # the `F` prefix is a convention to avoid clashes since # the accessors are named `host` @@ -134,8 +134,8 @@ different; for this a special setter syntax is needed: ## getter of hostAddr s.FHost - var - s: Socket + var s: Socket + new s s.host = 34 # same as `host=`(s, 34) @@ -351,32 +351,32 @@ dispatch. .. code-block:: nim type - Expression = object of RootObj ## abstract base class for an expression - Literal = object of Expression + Expression = ref object of RootObj ## abstract base class for an expression + Literal = ref object of Expression x: int - PlusExpr = object of Expression - a, b: ref Expression - - method eval(e: ref Expression): int = + PlusExpr = ref object of Expression + a, b: Expression + + method eval(e: Expression): int = # override this base method quit "to override!" - method eval(e: ref Literal): int = return e.x - - method eval(e: ref PlusExpr): int = + method eval(e: Literal): int = return e.x + + method eval(e: PlusExpr): int = # watch out: relies on dynamic binding result = eval(e.a) + eval(e.b) - proc newLit(x: int): ref Literal = + proc newLit(x: int): Literal = new(result) result.x = x - - proc newPlus(a, b: ref Expression): ref PlusExpr = + + proc newPlus(a, b: Expression): PlusExpr = new(result) result.a = a result.b = b - - echo eval(newPlus(newPlus(newLit(1), newLit(2)), newLit(4))) + +echo eval(newPlus(newPlus(newLit(1), newLit(2)), newLit(4))) In the example the constructors ``newLit`` and ``newPlus`` are procs because they should use static binding, but ``eval`` is a method because it @@ -387,8 +387,8 @@ dispatching: .. code-block:: nim type - Thing = object of RootObj - Unit = object of Thing + Thing = ref object of RootObj + Unit = ref object of Thing x: int method collide(a, b: Thing) {.inline.} = @@ -400,8 +400,9 @@ dispatching: method collide(a: Unit, b: Thing) {.inline.} = echo "2" - var - a, b: Unit + var a, b: Unit + new a + new b collide(a, b) # output: 2 diff --git a/doc/manual/syntax.txt b/doc/manual/syntax.txt index cf44eb588..24644bce2 100644 --- a/doc/manual/syntax.txt +++ b/doc/manual/syntax.txt @@ -15,8 +15,6 @@ Associativity Binary operators whose first character is ``^`` are right-associative, all other binary operators are left-associative. -Operators ending in ``>`` but longer than a single character are -called `arrow like`:idx:. Precedence @@ -33,9 +31,12 @@ as ``(@x).abc`` whereas ``$x.abc`` is parsed as ``$(x.abc)``. For binary operators that are not keywords the precedence is determined by the following rules: +Operators ending in either ``->``, ``~>`` or ``=>`` are called +`arrow like`:idx:, and have the lowest precedence of all operators. + If the operator ends with ``=`` and its first character is none of ``<``, ``>``, ``!``, ``=``, ``~``, ``?``, it is an *assignment operator* which -has the lowest precedence. +has the second lowest precedence. Otherwise precedence is determined by the first character. @@ -43,14 +44,14 @@ Otherwise precedence is determined by the first character. Precedence level Operators First character Terminal symbol ================ =============================================== ================== =============== 10 (highest) ``$ ^`` OP10 - 9 ``* / div mod shl shr %`` ``* % \ /`` OP9 - 8 ``+ -`` ``+ ~ |`` OP8 + 9 ``* / div mod shl shr %`` ``* % \ /`` OP9 + 8 ``+ -`` ``+ - ~ |`` OP8 7 ``&`` ``&`` OP7 6 ``..`` ``.`` OP6 - 5 ``== <= < >= > != in notin is isnot not of`` ``= < > !`` OP5 + 5 ``== <= < >= > != in notin is isnot not of`` ``= < > !`` OP5 4 ``and`` OP4 3 ``or xor`` OP3 - 2 ``@ : ?`` OP2 + 2 ``@ : ?`` OP2 1 *assignment operator* (like ``+=``, ``*=``) OP1 0 (lowest) *arrow like operator* (like ``->``, ``=>``) OP0 ================ =============================================== ================== =============== @@ -67,7 +68,7 @@ is still parsed as ``1 + (3 * 4)``, but ``1+3 * 4`` is parsed as ``(1+3) * 4``: .. code-block:: nim #! strongSpaces - if foo+4 * 4 == 8 and b&c | 9 ++ + if foo+4 * 4 == 8 and b&c | 9 ++ bar: echo "" # is parsed as diff --git a/doc/manual/threads.txt b/doc/manual/threads.txt index 245545f6f..fc3040c87 100644 --- a/doc/manual/threads.txt +++ b/doc/manual/threads.txt @@ -1,16 +1,16 @@ Threads ======= -To enable thread support the ``--threads:on`` command line switch needs to -be used. The ``system`` module then contains several threading primitives. -See the `threads <threads.html>`_ and `channels <channels.html>`_ modules +To enable thread support the ``--threads:on`` command line switch needs to +be used. The ``system`` module then contains several threading primitives. +See the `threads <threads.html>`_ and `channels <channels.html>`_ modules for the low level thread API. There are also high level parallelism constructs available. See `spawn`_ for further details. Nim's memory model for threads is quite different than that of other common -programming languages (C, Pascal, Java): Each thread has its own (garbage -collected) heap and sharing of memory is restricted to global variables. This -helps to prevent race conditions. GC efficiency is improved quite a lot, +programming languages (C, Pascal, Java): Each thread has its own (garbage +collected) heap and sharing of memory is restricted to global variables. This +helps to prevent race conditions. GC efficiency is improved quite a lot, because the GC never has to stop other threads and see what they reference. Memory allocation requires no lock at all! This design easily scales to massive multicore processors that are becoming the norm. @@ -22,10 +22,10 @@ Thread pragma A proc that is executed as a new thread of execution should be marked by the ``thread`` pragma for reasons of readability. The compiler checks for violations of the `no heap sharing restriction`:idx:\: This restriction implies -that it is invalid to construct a data structure that consists of memory +that it is invalid to construct a data structure that consists of memory allocated from different (thread local) heaps. -A thread proc is passed to ``createThread`` or ``spawn`` and invoked +A thread proc is passed to ``createThread`` or ``spawn`` and invoked indirectly; so the ``thread`` pragma implies ``procvar``. @@ -34,7 +34,7 @@ GC safety We call a proc ``p`` `GC safe`:idx: when it doesn't access any global variable that contains GC'ed memory (``string``, ``seq``, ``ref`` or a closure) either -directly or indirectly through a call to a GC unsafe proc. +directly or indirectly through a call to a GC unsafe proc. The `gcsafe`:idx: annotation can be used to mark a proc to be gcsafe, otherwise this property is inferred by the compiler. Note that ``noSideEfect`` @@ -45,10 +45,9 @@ contain a ``ref`` or ``closure`` type. This enforces the *no heap sharing restriction*. Routines that are imported from C are always assumed to be ``gcsafe``. -To enable the GC-safety checking the ``--threadAnalysis:on`` command line -switch must be used. This is a temporary workaround to ease the porting effort -from old code to the new threading model. In the future the thread analysis -will always be performed. +To disable the GC-safety checking the ``--threadAnalysis:off`` command line +switch can be used. This is a temporary workaround to ease the porting effort +from old code to the new threading model. Future directions: @@ -59,13 +58,13 @@ Future directions: Threadvar pragma ---------------- -A global variable can be marked with the ``threadvar`` pragma; it is +A global variable can be marked with the ``threadvar`` pragma; it is a `thread-local`:idx: variable then: .. code-block:: nim var checkpoints* {.threadvar.}: seq[string] -Due to implementation restrictions thread local variables cannot be +Due to implementation restrictions thread local variables cannot be initialized within the ``var`` section. (Every thread local variable needs to be replicated at thread creation.) @@ -73,7 +72,7 @@ be replicated at thread creation.) Threads and exceptions ---------------------- -The interaction between threads and exceptions is simple: A *handled* exception +The interaction between threads and exceptions is simple: A *handled* exception in one thread cannot affect any other thread. However, an *unhandled* exception in one thread terminates the whole *process*! @@ -82,7 +81,7 @@ in one thread terminates the whole *process*! Parallel & Spawn ================ -Nim has two flavors of parallelism: +Nim has two flavors of parallelism: 1) `Structured`:idx: parallelism via the ``parallel`` statement. 2) `Unstructured`:idx: parallelism via the standalone ``spawn`` statement. @@ -115,7 +114,7 @@ Spawn statement proc processLine(line: string) = discard "do some heavy lifting here" - + for x in lines("myinput.txt"): spawn processLine(x) sync() @@ -144,7 +143,7 @@ wait on multiple flow variables at the same time: .. code-block:: nim import threadpool, ... - + # wait until 2 out of 3 servers received the update: proc main = var responses = newSeq[RawFlowVar](3) @@ -203,8 +202,7 @@ restrictions / changes: the ``parallel`` section. This is called the *immutability check*. Currently it is not specified what exactly "complex location" means. We need to make this an optimization! -* Every array access has to be provably within bounds. This is called +* Every array access has to be provably within bounds. This is called the *bounds check*. * Slices are optimized so that no copy is performed. This optimization is not - yet performed for ordinary slices outside of a ``parallel`` section. Slices - are also special in that they currently do not support negative indexes! + yet performed for ordinary slices outside of a ``parallel`` section. diff --git a/doc/manual/type_bound_ops.txt b/doc/manual/type_bound_ops.txt index 59d55a6cd..c707979fe 100644 --- a/doc/manual/type_bound_ops.txt +++ b/doc/manual/type_bound_ops.txt @@ -21,27 +21,49 @@ helper distinct or object type has to be used for one pointer type. operator `=` ------------ -This operator is the assignment operator. Note that in the contexts -like ``let v = expr``, ``var v = expr``, ``parameter = defaultValue`` or for -parameter passing no assignment is performed. The ``override`` pragma is -optional for overriding ``=``. +This operator is the assignment operator. Note that in the contexts +``result = expr``, ``parameter = defaultValue`` or for +parameter passing no assignment is performed. For a type ``T`` that has an +overloaded assignment operator ``var v = T()`` is rewritten +to ``var v: T; v = T()``; in other words ``var`` and ``let`` contexts do count +as assignments. + +The assignment operator needs to be attached to an object or distinct +type ``T``. Its signature has to be ``(var T, T)``. Example: + +.. code-block:: nim + type + Concrete = object + a, b: string + + proc `=`(d: var Concrete; src: Concrete) = + shallowCopy(d.a, src.a) + shallowCopy(d.b, src.b) + echo "Concrete '=' called" + + var x, y: array[0..2, Concrete] + var cA, cB: Concrete + + var cATup, cBTup: tuple[x: int, ha: Concrete] + + x = y + cA = cB + cATup = cBTup -**Note**: Overriding of operator ``=`` is not yet implemented. destructors ----------- A destructor must have a single parameter with a concrete type (the name of a -generic type is allowed too). The name of the destructor has to be ``destroy`` -and it need to be annotated with the ``override`` pragma. +generic type is allowed too). The name of the destructor has to be ``=destroy``. -``destroy(v)`` will be automatically invoked for every local stack +``=destroy(v)`` will be automatically invoked for every local stack variable ``v`` that goes out of scope. -If a structured type features a field with destructable type and +If a structured type features a field with destructable type and the user has not provided an explicit implementation, a destructor for the -structured type will be automatically generated. Calls to any base class +structured type will be automatically generated. Calls to any base class destructors in both user-defined and generated destructors will be inserted. A destructor is attached to the type it destructs; expressions of this type @@ -52,13 +74,13 @@ can then only be used in *destructible contexts* and as parameters: MyObj = object x, y: int p: pointer - - proc destroy(o: var MyObj) {.override.} = + + proc `=destroy`(o: var MyObj) = if o.p != nil: dealloc o.p - + proc open: MyObj = result = MyObj(x: 1, y: 2, p: alloc(3)) - + proc work(o: MyObj) = echo o.x # No destructor invoked here for 'o' as 'o' is a parameter. @@ -68,7 +90,7 @@ can then only be used in *destructible contexts* and as parameters: var x = open() # valid: pass 'x' to some other proc: work(x) - + # Error: usage of a type with a destructor in a non destructible context echo open() @@ -85,7 +107,7 @@ be destructed at its scope exit. Later versions of the language will improve the support of destructors. Be aware that destructors are not called for objects allocated with ``new``. -This may change in future versions of language, but for now the ``finalizer`` +This may change in future versions of language, but for now the `finalizer`:idx: parameter to ``new`` has to be used. **Note**: Destructors are still experimental and the spec might change @@ -95,7 +117,7 @@ significantly in order to incorporate an escape analysis. deepCopy -------- -``deepCopy`` is a builtin that is invoked whenever data is passed to +``=deepCopy`` is a builtin that is invoked whenever data is passed to a ``spawn``'ed proc to ensure memory safety. The programmer can override its behaviour for a specific ``ref`` or ``ptr`` type ``T``. (Later versions of the language may weaken this restriction.) @@ -103,10 +125,10 @@ language may weaken this restriction.) The signature has to be: .. code-block:: nim - proc deepCopy(x: T): T {.override.} + proc `=deepCopy`(x: T): T -This mechanism is used by most data structures that support shared memory like -channels to implement thread safe automatic memory management. +This mechanism will be used by most data structures that support shared memory +like channels to implement thread safe automatic memory management. The builtin ``deepCopy`` can even clone closures and their environments. See the documentation of `spawn`_ for details. diff --git a/doc/manual/typedesc.txt b/doc/manual/typedesc.txt index 5087c1204..de1d84d7d 100644 --- a/doc/manual/typedesc.txt +++ b/doc/manual/typedesc.txt @@ -6,7 +6,7 @@ static[T] **Note**: static[T] is still in development. -As their name suggests, static params must be known at compile-time: +As their name suggests, static parameters must be known at compile-time: .. code-block:: nim @@ -23,23 +23,7 @@ As their name suggests, static params must be known at compile-time: For the purposes of code generation, all static params are treated as generic params - the proc will be compiled separately for each unique -supplied value (or combination of values). - -Furthermore, the system module defines a `semistatic[T]` type that can be -used to declare procs accepting both static and run-time values, which can -optimize their body according to the supplied param using the `isStatic(p)` -predicate: - -.. code-block:: nim - - # The following proc will be compiled once for each unique static - # value and also once for the case handling all run-time values: - - proc re(pattern: semistatic[string]): RegEx = - when isStatic(pattern): - result = precompiledRegex(pattern) - else: - result = compile(pattern) +supplied value (or combination of values). Static params can also appear in the signatures of generic types: @@ -61,7 +45,7 @@ typedesc -------- `typedesc` is a special type allowing one to treat types as compile-time values -(i.e. if types are compile-time values and all values have a type, then +(i.e. if types are compile-time values and all values have a type, then typedesc must be their type). When used as a regular proc param, typedesc acts as a type class. The proc @@ -82,9 +66,6 @@ When multiple typedesc params are present, they act like a distinct type class one can use a named alias or an explicit `typedesc` generic param: .. code-block:: nim - - # `type1` and `type2` are aliases for typedesc available from system.nim - proc acceptOnlyTypePairs(A, B: type1; C, D: type2) proc acceptOnlyTypePairs[T: typedesc, U: typedesc](A, B: T; C, D: U) Once bound, typedesc params can appear in the rest of the proc signature: @@ -100,7 +81,7 @@ When used with macros and .compileTime. procs on the other hand, the compiler does not need to instantiate the code multiple times, because types then can be manipulated using the unified internal symbol representation. In such context typedesc acts as any other type. One can create variables, store typedesc -values inside containers and so on. For example, here is how one can create +values inside containers and so on. For example, here is how one can create a type-safe wrapper for the unsafe `printf` function from C: .. code-block:: nim @@ -114,7 +95,7 @@ a type-safe wrapper for the unsafe `printf` function from C: of 's': string of 'p': pointer else: EOutOfRange - + var actualType = args[i].getType inc i @@ -123,7 +104,7 @@ a type-safe wrapper for the unsafe `printf` function from C: elif expectedType != actualType: error "type mismatch for argument ", i, ". expected type: ", expectedType.name, ", actual type: ", actualType.name - + # keep the original callsite, but use cprintf instead result = callsite() result[0] = newIdentNode(!"cprintf") diff --git a/doc/manual/types.txt b/doc/manual/types.txt index c78984db8..bdf51941d 100644 --- a/doc/manual/types.txt +++ b/doc/manual/types.txt @@ -568,7 +568,7 @@ the ``of`` operator can be used to determine the object's type. name*: string # the * means that `name` is accessible from other modules age: int # no * means that the field is hidden - Student = object of Person # a student is a person + Student = ref object of Person # a student is a person id: int # with an id field var @@ -864,7 +864,9 @@ Future directions: * Builtin regions like ``private``, ``global`` and ``local`` will prove very useful for the upcoming OpenCL target. * Builtin "regions" can model ``lent`` and ``unique`` pointers. - +* An assignment operator can be attached to a region so that proper write + barriers can be generated. This would imply that the GC can be implemented + completely in user-space. Procedural type diff --git a/doc/nimc.txt b/doc/nimc.txt index c6b0b5255..cfbccc479 100644 --- a/doc/nimc.txt +++ b/doc/nimc.txt @@ -506,7 +506,7 @@ For example: .. code-block:: nim type Input {.importcpp: "System::Input".} = object - proc getSubsystem*[T](): ptr T {.importcpp: "SystemManager::getSubsystem<'*0>()".} + proc getSubsystem*[T](): ptr T {.importcpp: "SystemManager::getSubsystem<'*0>()", nodecl.} let x: ptr Input = getSubsystem[Input]() @@ -545,6 +545,20 @@ instead: let x = newFoo(3, 4) +Wrapping constructors +~~~~~~~~~~~~~~~~~~~~~ + +Sometimes a C++ class has a private copy constructor and so code like +``Class c = Class(1,2);`` must not be generated but instead ``Class c(1,2);``. +For this purpose the Nim proc that wraps a C++ constructor needs to be +annotated with the `constructor`:idx: pragma. This pragma also helps to generate +faster C++ code since construction then doesn't invoke the copy constructor: + +.. code-block:: nim + # a better constructor of 'Foo': + proc constructFoo(a, b: cint): Foo {.importcpp: "Foo(@)", constructor.} + + Wrapping destructors ~~~~~~~~~~~~~~~~~~~~ @@ -582,6 +596,25 @@ Produces: x[6] = 91.4; +- If more precise control is needed, the apostrophe ``'`` can be used in the + supplied pattern to denote the concrete type parameters of the generic type. + See the usage of the apostrophe operator in proc patterns for more details. + +.. code-block:: nim + + type + VectorIterator {.importcpp: "std::vector<'0>::iterator".} [T] = object + + var x: VectorIterator[cint] + + +Produces: + +.. code-block:: C + + std::vector<int>::iterator x; + + ImportObjC pragma ----------------- Similar to the `importc pragma for C <manual.html#importc-pragma>`_, the @@ -608,7 +641,7 @@ allows *sloppy* interfacing with libraries written in Objective C: - (void)greet:(long)x y:(long)dummy { - printf("Hello, World!\n"); + printf("Hello, World!\n"); } @end diff --git a/doc/tut2.txt b/doc/tut2.txt index 4d30b1445..e1ac20074 100644 --- a/doc/tut2.txt +++ b/doc/tut2.txt @@ -56,12 +56,12 @@ Objects have access to their type at runtime. There is an .. code-block:: nim type - Person = object of RootObj + Person = ref object of RootObj name*: string # the * means that `name` is accessible from other modules age: int # no * means that the field is hidden from other modules - Student = object of Person # Student inherits from Person - id: int # with an id field + Student = ref object of Person # Student inherits from Person + id: int # with an id field var student: Student @@ -69,6 +69,7 @@ Objects have access to their type at runtime. There is an assert(student of Student) # is true # object construction: student = Student(name: "Anton", age: 5, id: 2) + echo student[] Object fields that should be visible from outside the defining module have to be marked by ``*``. In contrast to tuples, different object types are @@ -82,6 +83,9 @@ no ancestor are implicitly ``final``. You can use the ``inheritable`` pragma to introduce new object roots apart from ``system.RootObj``. (This is used in the GTK wrapper for instance.) +Ref objects should be used whenever inheritance is used. It isn't strictly +necessary, but with non-ref objects assignments such as ``let person: Person = +Student(id: 123)`` will truncate subclass fields. **Note**: Composition (*has-a* relation) is often preferable to inheritance (*is-a* relation) for simple code reuse. Since objects are value types in @@ -228,7 +232,7 @@ is needed: .. code-block:: nim type - Socket* = object of RootObj + Socket* = ref object of RootObj FHost: int # cannot be accessed from the outside of the module # the `F` prefix is a convention to avoid clashes since # the accessors are named `host` @@ -241,8 +245,8 @@ is needed: ## getter of hostAddr s.FHost - var - s: Socket + var s: Socket + new s s.host = 34 # same as `host=`(s, 34) (The example also shows ``inline`` procedures.) @@ -313,8 +317,8 @@ dispatching: .. code-block:: nim type - Thing = object of RootObj - Unit = object of Thing + Thing = ref object of RootObj + Unit = ref object of Thing x: int method collide(a, b: Thing) {.inline.} = @@ -326,8 +330,9 @@ dispatching: method collide(a: Unit, b: Thing) {.inline.} = echo "2" - var - a, b: Unit + var a, b: Unit + new a + new b collide(a, b) # output: 2 diff --git a/koch.nim b/koch.nim index 508d7e007..3ebfb6655 100644 --- a/koch.nim +++ b/koch.nim @@ -81,7 +81,7 @@ proc exec(cmd: string, errorcode: int = QuitFailure) = echo(cmd) if execShellCmd(cmd) != 0: quit("FAILURE", errorcode) -proc tryExec(cmd: string): bool = +proc tryExec(cmd: string): bool = echo(cmd) result = execShellCmd(cmd) == 0 @@ -96,7 +96,7 @@ proc copyExe(source, dest: string) = const compileNimInst = "-d:useLibzipSrc tools/niminst/niminst" -proc csource(args: string) = +proc csource(args: string) = exec("$4 cc $1 -r $3 --var:version=$2 --var:mingw=none csource --main:compiler/nim.nim compiler/installer.ini $1" % [args, VersionAsString, compileNimInst, findNim()]) @@ -114,13 +114,13 @@ proc nsis(args: string) = # make sure we have generated the niminst executables: buildTool("tools/niminst/niminst", args) buildTool("tools/nimgrep", args) - # produce 'nimrod_debug.exe': + # produce 'nim_debug.exe': exec "nim c compiler" / "nim.nim" copyExe("compiler/nim".exe, "bin/nim_debug".exe) exec(("tools" / "niminst" / "niminst --var:version=$# --var:mingw=mingw$#" & " nsis compiler/nim") % [VersionAsString, $(sizeof(pointer)*8)]) -proc install(args: string) = +proc install(args: string) = exec("$# cc -r $# --var:version=$# --var:mingw=none --main:compiler/nim.nim scripts compiler/installer.ini" % [findNim(), compileNimInst, VersionAsString]) exec("sh ./install.sh $#" % args) @@ -139,12 +139,10 @@ proc pdf(args="") = # -------------- boot --------------------------------------------------------- -proc findStartNim: string = +proc findStartNim: string = # we try several things before giving up: # * bin/nim # * $PATH/nim - # * bin/nimrod - # * $PATH/nimrod # If these fail, we try to build nim with the "build.(sh|bat)" script. var nim = "nim".exe result = "bin" / nim @@ -152,34 +150,27 @@ proc findStartNim: string = for dir in split(getEnv("PATH"), PathSep): if existsFile(dir / nim): return dir / nim - # try the old "nimrod.exe": - var nimrod = "nimrod".exe - result = "bin" / nimrod - if existsFile(result): return - for dir in split(getEnv("PATH"), PathSep): - if existsFile(dir / nim): return dir / nimrod - when defined(Posix): const buildScript = "build.sh" - if existsFile(buildScript): + if existsFile(buildScript): if tryExec("./" & buildScript): return "bin" / nim else: const buildScript = "build.bat" - if existsFile(buildScript): + if existsFile(buildScript): if tryExec(buildScript): return "bin" / nim echo("Found no nim compiler and every attempt to build one failed!") quit("FAILURE") -proc thVersion(i: int): string = +proc thVersion(i: int): string = result = ("compiler" / "nim" & $i).exe - + proc boot(args: string) = var output = "compiler" / "nim".exe var finalDest = "bin" / "nim".exe # default to use the 'c' command: let bootOptions = if args.len == 0 or args.startsWith("-"): "c" else: "" - + copyExe(findStartNim(), 0.thVersion) for i in 0..2: echo "iteration: ", i+1 @@ -204,7 +195,7 @@ const ".bzrignore", "nim", "nim.exe", "koch", "koch.exe", ".gitignore" ] -proc cleanAux(dir: string) = +proc cleanAux(dir: string) = for kind, path in walkDir(dir): case kind of pcFile: @@ -215,25 +206,25 @@ proc cleanAux(dir: string) = removeFile(path) of pcDir: case splitPath(path).tail - of "nimcache": + of "nimcache": echo "removing dir: ", path removeDir(path) of "dist", ".git", "icons": discard else: cleanAux(path) else: discard -proc removePattern(pattern: string) = - for f in walkFiles(pattern): +proc removePattern(pattern: string) = + for f in walkFiles(pattern): echo "removing: ", f removeFile(f) -proc clean(args: string) = +proc clean(args: string) = if existsFile("koch.dat"): removeFile("koch.dat") removePattern("web/*.html") removePattern("doc/*.html") cleanAux(getCurrentDir()) for kind, path in walkDir(getCurrentDir() / "build"): - if kind == pcDir: + if kind == pcDir: echo "removing dir: ", path removeDir(path) @@ -276,7 +267,7 @@ when defined(withUpdate): "Local branch must be ahead of it. Exiting...") else: quit("An error has occurred.") - + else: echo("No repo or executable found!") when defined(haveZipLib): @@ -293,7 +284,7 @@ when defined(withUpdate): quit("Error reading archive.") else: quit("No failback available. Exiting...") - + echo("Starting update...") boot(args) echo("Update complete!") @@ -346,8 +337,8 @@ proc temp(args: string) = copyExe(output, finalDest) if args.len > 0: exec(finalDest & " " & args) -proc showHelp() = - quit(HelpText % [VersionAsString & spaces(44-len(VersionAsString)), +proc showHelp() = + quit(HelpText % [VersionAsString & spaces(44-len(VersionAsString)), CompileDate, CompileTime], QuitSuccess) var op = initOptParser() diff --git a/lib/core/macros.nim b/lib/core/macros.nim index c18e805e0..35f0f61c1 100644 --- a/lib/core/macros.nim +++ b/lib/core/macros.nim @@ -88,7 +88,9 @@ type ntyBigNum, ntyConst, ntyMutable, ntyVarargs, ntyIter, - ntyError + ntyError, + ntyBuiltinTypeClass, ntyConcept, ntyConceptInst, ntyComposite, + ntyAnd, ntyOr, ntyNot TNimTypeKinds* {.deprecated.} = set[NimTypeKind] NimSymKind* = enum @@ -162,6 +164,7 @@ proc kind*(n: NimNode): NimNodeKind {.magic: "NKind", noSideEffect.} ## returns the `kind` of the node `n`. proc intVal*(n: NimNode): BiggestInt {.magic: "NIntVal", noSideEffect.} +proc boolVal*(n: NimNode): bool {.compileTime, noSideEffect.} = n.intVal != 0 proc floatVal*(n: NimNode): BiggestFloat {.magic: "NFloatVal", noSideEffect.} proc symbol*(n: NimNode): NimSym {.magic: "NSymbol", noSideEffect.} proc ident*(n: NimNode): NimIdent {.magic: "NIdent", noSideEffect.} @@ -355,6 +358,12 @@ proc expectLen*(n: NimNode, len: int) {.compileTime.} = ## macros that check its number of arguments. if n.len != len: error("macro expects a node with " & $len & " children") +proc newTree*(kind: NimNodeKind, + children: varargs[NimNode]): NimNode {.compileTime.} = + ## produces a new node with children. + result = newNimNode(kind) + result.add(children) + proc newCall*(theProc: NimNode, args: varargs[NimNode]): NimNode {.compileTime.} = ## produces a new call node. `theProc` is the proc that is called with @@ -389,6 +398,11 @@ proc newLit*(i: BiggestInt): NimNode {.compileTime.} = result = newNimNode(nnkIntLit) result.intVal = i +proc newLit*(b: bool): NimNode {.compileTime.} = + ## produces a new boolean literal node. + result = newNimNode(nnkIntLit) + result.intVal = ord(b) + proc newLit*(f: BiggestFloat): NimNode {.compileTime.} = ## produces a new float literal node. result = newNimNode(nnkFloatLit) @@ -734,14 +748,14 @@ proc basename*(a: NimNode): NimNode = of nnkIdent: return a of nnkPostfix, nnkPrefix: return a[1] else: - quit "Do not know how to get basename of ("& treeRepr(a) &")\n"& repr(a) + quit "Do not know how to get basename of (" & treeRepr(a) & ")\n" & repr(a) proc `basename=`*(a: NimNode; val: string) {.compileTime.}= case a.kind of nnkIdent: macros.`ident=`(a, !val) of nnkPostfix, nnkPrefix: a[1] = ident(val) else: - quit "Do not know how to get basename of ("& treeRepr(a)& ")\n"& repr(a) + quit "Do not know how to get basename of (" & treeRepr(a) & ")\n" & repr(a) proc postfix*(node: NimNode; op: string): NimNode {.compileTime.} = newNimNode(nnkPostfix).add(ident(op), node) diff --git a/lib/impure/db_sqlite.nim b/lib/impure/db_sqlite.nim index 4be692f39..8536ab6f2 100644 --- a/lib/impure/db_sqlite.nim +++ b/lib/impure/db_sqlite.nim @@ -205,7 +205,7 @@ proc setEncoding*(connection: TDbConn, encoding: string): bool {. exec(connection, sql"PRAGMA encoding = ?", [encoding]) result = connection.getValue(sql"PRAGMA encoding") == encoding -when isMainModule: +when not defined(testing) and isMainModule: var db = open("db.sql", "", "", "") exec(db, sql"create table tbl1(one varchar(10), two smallint)", []) exec(db, sql"insert into tbl1 values('hello!',10)", []) diff --git a/lib/impure/graphics.nim b/lib/impure/graphics.nim index dfadb46ee..814c0ebe1 100644 --- a/lib/impure/graphics.nim +++ b/lib/impure/graphics.nim @@ -499,7 +499,7 @@ template withEvents*(surf: PSurface, event: expr, actions: stmt): stmt {. if sdl.init(sdl.INIT_VIDEO) < 0: raiseEGraphics() if sdl_ttf.init() < 0: raiseEGraphics() -when isMainModule: +when not defined(testing) and isMainModule: var surf = newScreenSurface(800, 600) surf.fillSurface(colWhite) diff --git a/lib/impure/re.nim b/lib/impure/re.nim index 921a24fd1..fb95610f6 100644 --- a/lib/impure/re.nim +++ b/lib/impure/re.nim @@ -7,8 +7,11 @@ # distribution, for details about the copyright. # -## Regular expression support for Nim. Consider using the pegs module -## instead. +## Regular expression support for Nim. Consider using the pegs module instead. +## +## There is an alternative regular expressions library with a more unified API: +## `nre <https://github.com/flaviut/nre>`_. It may be added to the standard +## library in the future, instead of `re`. ## ## **Note:** The 're' proc defaults to the **extended regular expression ## syntax** which lets you use whitespace freely to make your regexes readable. @@ -36,31 +39,31 @@ const type RegexFlag* = enum ## options for regular expressions reIgnoreCase = 0, ## do caseless matching - reMultiLine = 1, ## ``^`` and ``$`` match newlines within data + reMultiLine = 1, ## ``^`` and ``$`` match newlines within data reDotAll = 2, ## ``.`` matches anything including NL reExtended = 3, ## ignore whitespace and ``#`` comments reStudy = 4 ## study the expression (may be omitted if the ## expression will be used only once) - + RegexDesc = object - h: PPcre - e: ptr TExtra - + h: ptr Pcre + e: ptr ExtraData + Regex* = ref RegexDesc ## a compiled regular expression - + RegexError* = object of ValueError ## is raised if the pattern is no valid regular expression. {.deprecated: [TRegexFlag: RegexFlag, TRegexDesc: RegexDesc, TRegex: Regex, EInvalidRegEx: RegexError].} -proc raiseInvalidRegex(msg: string) {.noinline, noreturn.} = +proc raiseInvalidRegex(msg: string) {.noinline, noreturn.} = var e: ref RegexError new(e) e.msg = msg raise e -proc rawCompile(pattern: string, flags: cint): PPcre = +proc rawCompile(pattern: string, flags: cint): ptr Pcre = var msg: cstring offset: cint @@ -68,10 +71,10 @@ proc rawCompile(pattern: string, flags: cint): PPcre = if result == nil: raiseInvalidRegex($msg & "\n" & pattern & "\n" & spaces(offset) & "^\n") -proc finalizeRegEx(x: Regex) = +proc finalizeRegEx(x: Regex) = # XXX This is a hack, but PCRE does not export its "free" function properly. # Sigh. The hack relies on PCRE's implementation (see ``pcre_get.c``). - # Fortunately the implementation is unlikely to change. + # Fortunately the implementation is unlikely to change. pcre.free_substring(cast[cstring](x.h)) if not isNil(x.e): pcre.free_substring(cast[cstring](x.e)) @@ -84,7 +87,7 @@ proc re*(s: string, flags = {reExtended, reStudy}): Regex = result.h = rawCompile(s, cast[cint](flags - {reStudy})) if reStudy in flags: var msg: cstring - result.e = pcre.study(result.h, 0, msg) + result.e = pcre.study(result.h, 0, addr msg) if not isNil(msg): raiseInvalidRegex($msg) proc matchOrFind(s: string, pattern: Regex, matches: var openArray[string], @@ -101,10 +104,10 @@ proc matchOrFind(s: string, pattern: Regex, matches: var openArray[string], if a >= 0'i32: matches[i-1] = substr(s, int(a), int(b)-1) else: matches[i-1] = nil return rawMatches[1] - rawMatches[0] - + proc findBounds*(s: string, pattern: Regex, matches: var openArray[string], start = 0): tuple[first, last: int] = - ## returns the starting position and end position of `pattern` in `s` + ## returns the starting position and end position of `pattern` in `s` ## and the captured ## substrings in the array `matches`. If it does not match, nothing ## is written into `matches` and ``(-1,0)`` is returned. @@ -120,12 +123,12 @@ proc findBounds*(s: string, pattern: Regex, matches: var openArray[string], if a >= 0'i32: matches[i-1] = substr(s, int(a), int(b)-1) else: matches[i-1] = nil return (rawMatches[0].int, rawMatches[1].int - 1) - -proc findBounds*(s: string, pattern: Regex, + +proc findBounds*(s: string, pattern: Regex, matches: var openArray[tuple[first, last: int]], start = 0): tuple[first, last: int] = - ## returns the starting position and end position of ``pattern`` in ``s`` - ## and the captured substrings in the array `matches`. + ## returns the starting position and end position of ``pattern`` in ``s`` + ## and the captured substrings in the array `matches`. ## If it does not match, nothing is written into `matches` and ## ``(-1,0)`` is returned. var @@ -141,7 +144,7 @@ proc findBounds*(s: string, pattern: Regex, else: matches[i-1] = (-1,0) return (rawMatches[0].int, rawMatches[1].int - 1) -proc findBounds*(s: string, pattern: Regex, +proc findBounds*(s: string, pattern: Regex, start = 0): tuple[first, last: int] = ## returns the starting position of `pattern` in `s`. If it does not ## match, ``(-1,0)`` is returned. @@ -152,7 +155,7 @@ proc findBounds*(s: string, pattern: Regex, cast[ptr cint](rawMatches), 3) if res < 0'i32: return (int(res), 0) return (int(rawMatches[0]), int(rawMatches[1]-1)) - + proc matchOrFind(s: string, pattern: Regex, start, flags: cint): cint = var rtarray = initRtArray[cint](3) @@ -162,19 +165,6 @@ proc matchOrFind(s: string, pattern: Regex, start, flags: cint): cint = if result >= 0'i32: result = rawMatches[1] - rawMatches[0] -proc match*(s: string, pattern: Regex, matches: var openArray[string], - start = 0): bool = - ## returns ``true`` if ``s[start..]`` matches the ``pattern`` and - ## the captured substrings in the array ``matches``. If it does not - ## match, nothing is written into ``matches`` and ``false`` is - ## returned. - return matchOrFind(s, pattern, matches, start.cint, - pcre.ANCHORED) == cint(s.len - start) - -proc match*(s: string, pattern: Regex, start = 0): bool = - ## returns ``true`` if ``s[start..]`` matches the ``pattern``. - return matchOrFind(s, pattern, start.cint, pcre.ANCHORED) == cint(s.len-start) - proc matchLen*(s: string, pattern: Regex, matches: var openArray[string], start = 0): int = ## the same as ``match``, but it returns the length of the match, @@ -185,9 +175,21 @@ proc matchLen*(s: string, pattern: Regex, matches: var openArray[string], proc matchLen*(s: string, pattern: Regex, start = 0): int = ## the same as ``match``, but it returns the length of the match, ## if there is no match, -1 is returned. Note that a match length - ## of zero can happen. + ## of zero can happen. return matchOrFind(s, pattern, start.cint, pcre.ANCHORED) +proc match*(s: string, pattern: Regex, start = 0): bool = + ## returns ``true`` if ``s[start..]`` matches the ``pattern``. + result = matchLen(s, pattern, start) != -1 + +proc match*(s: string, pattern: Regex, matches: var openArray[string], + start = 0): bool = + ## returns ``true`` if ``s[start..]`` matches the ``pattern`` and + ## the captured substrings in the array ``matches``. If it does not + ## match, nothing is written into ``matches`` and ``false`` is + ## returned. + result = matchLen(s, pattern, matches, start) != -1 + proc find*(s: string, pattern: Regex, matches: var openArray[string], start = 0): int = ## returns the starting position of ``pattern`` in ``s`` and the captured @@ -217,7 +219,7 @@ proc find*(s: string, pattern: Regex, start = 0): int = if res < 0'i32: return res return rawMatches[0] -iterator findAll*(s: string, pattern: Regex, start = 0): string = +iterator findAll*(s: string, pattern: Regex, start = 0): string = ## Yields all matching *substrings* of `s` that match `pattern`. ## ## Note that since this is an iterator you should not modify the string you @@ -232,10 +234,11 @@ iterator findAll*(s: string, pattern: Regex, start = 0): string = if res < 0'i32: break let a = rawMatches[0] let b = rawMatches[1] + if a == b and a == i: break yield substr(s, int(a), int(b)-1) i = b -proc findAll*(s: string, pattern: Regex, start = 0): seq[string] = +proc findAll*(s: string, pattern: Regex, start = 0): seq[string] = ## returns all matching *substrings* of `s` that match `pattern`. ## If it does not match, @[] is returned. accumulateResult(findAll(s, pattern, start)) @@ -243,13 +246,13 @@ proc findAll*(s: string, pattern: Regex, start = 0): seq[string] = when not defined(nimhygiene): {.pragma: inject.} -template `=~` *(s: string, pattern: Regex): expr = - ## This calls ``match`` with an implicit declared ``matches`` array that - ## can be used in the scope of the ``=~`` call: - ## +template `=~` *(s: string, pattern: Regex): expr = + ## This calls ``match`` with an implicit declared ``matches`` array that + ## can be used in the scope of the ``=~`` call: + ## ## .. code-block:: nim ## - ## if line =~ re"\s*(\w+)\s*\=\s*(\w+)": + ## if line =~ re"\s*(\w+)\s*\=\s*(\w+)": ## # matches a key=value pair: ## echo("Key: ", matches[0]) ## echo("Value: ", matches[1]) @@ -261,9 +264,9 @@ template `=~` *(s: string, pattern: Regex): expr = ## else: ## echo("syntax error") ## - bind MaxSubPatterns + bind MaxSubpatterns when not declaredInScope(matches): - var matches {.inject.}: array[0..MaxSubpatterns-1, string] + var matches {.inject.}: array[MaxSubpatterns, string] match(s, pattern, matches) # ------------------------- more string handling ------------------------------ @@ -287,7 +290,7 @@ proc endsWith*(s: string, suffix: Regex): bool = if matchLen(s, suffix, i) == s.len - i: return true proc replace*(s: string, sub: Regex, by = ""): string = - ## Replaces `sub` in `s` by the string `by`. Captures cannot be + ## Replaces `sub` in `s` by the string `by`. Captures cannot be ## accessed in `by`. Examples: ## ## .. code-block:: nim @@ -307,7 +310,7 @@ proc replace*(s: string, sub: Regex, by = ""): string = add(result, by) prev = match.last + 1 add(result, substr(s, prev)) - + proc replacef*(s: string, sub: Regex, by: string): string = ## Replaces `sub` in `s` by the string `by`. Captures can be accessed in `by` ## with the notation ``$i`` and ``$#`` (see strutils.`%`). Examples: @@ -321,7 +324,7 @@ proc replacef*(s: string, sub: Regex, by: string): string = ## ## "var1<-keykey; val2<-key2key2" result = "" - var caps: array[0..MaxSubpatterns-1, string] + var caps: array[MaxSubpatterns, string] var prev = 0 while true: var match = findBounds(s, sub, caps, prev) @@ -339,7 +342,7 @@ proc parallelReplace*(s: string, subs: openArray[ ## applied in parallel. result = "" var i = 0 - var caps: array[0..MaxSubpatterns-1, string] + var caps: array[MaxSubpatterns, string] while i < s.len: block searchSubs: for j in 0..high(subs): @@ -360,7 +363,7 @@ proc transformFile*(infile, outfile: string, ## error occurs. This is supposed to be used for quick scripting. var x = readFile(infile).string writeFile(outfile, x.parallelReplace(subs)) - + iterator split*(s: string, sep: Regex): string = ## Splits the string `s` into substrings. ## @@ -374,64 +377,73 @@ iterator split*(s: string, sep: Regex): string = ## Results in: ## ## .. code-block:: nim + ## "" ## "this" ## "is" ## "an" ## "example" + ## "" ## var - first = 0 - last = 0 + first = -1 + last = -1 while last < len(s): var x = matchLen(s, sep, last) if x > 0: inc(last, x) first = last + if x == 0: inc(last) while last < len(s): - inc(last) x = matchLen(s, sep, last) - if x > 0: break - if first < last: + if x >= 0: break + inc(last) + if first <= last: yield substr(s, first, last-1) proc split*(s: string, sep: Regex): seq[string] = ## Splits the string `s` into substrings. accumulateResult(split(s, sep)) - -proc escapeRe*(s: string): string = - ## escapes `s` so that it is matched verbatim when used as a regular + +proc escapeRe*(s: string): string = + ## escapes `s` so that it is matched verbatim when used as a regular ## expression. result = "" for c in items(s): case c of 'a'..'z', 'A'..'Z', '0'..'9', '_': result.add(c) - else: + else: result.add("\\x") result.add(toHex(ord(c), 2)) - + const ## common regular expressions - reIdentifier* = r"\b[a-zA-Z_]+[a-zA-Z_0-9]*\b" ## describes an identifier - reNatural* = r"\b\d+\b" ## describes a natural number - reInteger* = r"\b[-+]?\d+\b" ## describes an integer - reHex* = r"\b0[xX][0-9a-fA-F]+\b" ## describes a hexadecimal number - reBinary* = r"\b0[bB][01]+\b" ## describes a binary number (example: 0b11101) - reOctal* = r"\b0[oO][0-7]+\b" ## describes an octal number (example: 0o777) - reFloat* = r"\b[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?\b" + reIdentifier* {.deprecated.} = r"\b[a-zA-Z_]+[a-zA-Z_0-9]*\b" + ## describes an identifier + reNatural* {.deprecated.} = r"\b\d+\b" + ## describes a natural number + reInteger* {.deprecated.} = r"\b[-+]?\d+\b" + ## describes an integer + reHex* {.deprecated.} = r"\b0[xX][0-9a-fA-F]+\b" + ## describes a hexadecimal number + reBinary* {.deprecated.} = r"\b0[bB][01]+\b" + ## describes a binary number (example: 0b11101) + reOctal* {.deprecated.} = r"\b0[oO][0-7]+\b" + ## describes an octal number (example: 0o777) + reFloat* {.deprecated.} = r"\b[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?\b" ## describes a floating point number - reEmail* = r"\b[a-zA-Z0-9!#$%&'*+/=?^_`{|}~\-]+(?:\. &" & - r"[a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+)" & - r"*@(?:[a-zA-Z0-9](?:[a-zA-Z0-9-]*[a-zA-Z0-9])?\.)+" & - r"(?:[a-zA-Z]{2}|com|org|" & - r"net|gov|mil|biz|info|mobi|name|aero|jobs|museum)\b" + reEmail* {.deprecated.} = r"\b[a-zA-Z0-9!#$%&'*+/=?^_`{|}~\-]+(?:\. &" & + r"[a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+)*@" & + r"(?:[a-zA-Z0-9](?:[a-zA-Z0-9-]*[a-zA-Z0-9])?\.)+" & + r"(?:[a-zA-Z]{2}|com|org|net|gov|mil|biz|" & + r"info|mobi|name|aero|jobs|museum)\b" ## describes a common email address - reURL* = r"\b(http(s)?|ftp|gopher|telnet|file|notes|ms\-help):" & - r"((//)|(\\\\))+[\w\d:#@%/;$()~_?\+\-\=\\\.\&]*\b" + reURL* {.deprecated.} = r"\b(http(s)?|ftp|gopher|telnet|file|notes|ms-help)" & + r":((//)|(\\\\))+[\w\d:#@%/;$()~_?\+\-\=\\\.\&]*\b" ## describes an URL when isMainModule: assert match("(a b c)", re"\( .* \)") assert match("WHiLe", re("while", {reIgnoreCase})) - + assert "0158787".match(re"\d+") assert "ABC 0232".match(re"\w+\s+\d+") assert "ABC".match(re"\d+ | \w+") @@ -440,21 +452,21 @@ when isMainModule: var pattern = re"[a-z0-9]+\s*=\s*[a-z0-9]+" assert matchLen("key1= cal9", pattern) == 11 - + assert find("_____abc_______", re"abc") == 5 - - var matches: array[0..5, string] - if match("abcdefg", re"c(d)ef(g)", matches, 2): + + var matches: array[6, string] + if match("abcdefg", re"c(d)ef(g)", matches, 2): assert matches[0] == "d" assert matches[1] == "g" else: assert false - + if "abc" =~ re"(a)bcxyz|(\w+)": assert matches[1] == "abc" else: assert false - + if "abc" =~ re"(cba)?.*": assert matches[0] == nil else: assert false @@ -462,23 +474,35 @@ when isMainModule: if "abc" =~ re"().*": assert matches[0] == "" else: assert false - + assert "var1=key; var2=key2".endsWith(re"\w+=\w+") assert("var1=key; var2=key2".replacef(re"(\w+)=(\w+)", "$1<-$2$2") == "var1<-keykey; var2<-key2key2") assert("var1=key; var2=key2".replace(re"(\w+)=(\w+)", "$1<-$2$2") == "$1<-$2$2; $1<-$2$2") + var accum: seq[string] = @[] for word in split("00232this02939is39an22example111", re"\d+"): - writeln(stdout, word) + accum.add(word) + assert(accum == @["", "this", "is", "an", "example", ""]) + + accum = @[] + for word in split("AAA : : BBB", re"\s*:\s*"): + accum.add(word) + assert(accum == @["AAA", "", "BBB"]) for x in findAll("abcdef", re"^{.}", 3): assert x == "d" + accum = @[] for x in findAll("abcdef", re".", 3): - echo x + accum.add(x) + assert(accum == @["d", "e", "f"]) + + assert("XYZ".find(re"^\d*") == 0) + assert("XYZ".match(re"^\d*") == true) block: - var matches: array[0..15, string] + var matches: array[16, string] if match("abcdefghijklmnop", re"(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)(k)(l)(m)(n)(o)(p)", matches): for i in 0..matches.high: assert matches[i] == $chr(i + 'a'.ord) diff --git a/lib/impure/ssl.nim b/lib/impure/ssl.nim index bb7cfc0d3..d318a1979 100644 --- a/lib/impure/ssl.nim +++ b/lib/impure/ssl.nim @@ -82,7 +82,7 @@ proc close*(sock: TSecureSocket) = ERR_print_errors_fp(stderr) raiseOSError(osLastError()) -when isMainModule: +when not defined(testing) and isMainModule: var s: TSecureSocket echo connect(s, "smtp.gmail.com", 465) diff --git a/lib/js/dom.nim b/lib/js/dom.nim index 870213db3..94f4fa29c 100644 --- a/lib/js/dom.nim +++ b/lib/js/dom.nim @@ -36,8 +36,11 @@ type onsubmit*: proc (event: ref TEvent) {.nimcall.} onunload*: proc (event: ref TEvent) {.nimcall.} - TWindow* {.importc.} = object of TEventHandlers - document*: ref TDocument + addEventListener*: proc(ev: cstring, cb: proc(ev: ref TEvent), useCapture: bool = false) {.nimcall.} + + Window* = ref WindowObj + WindowObj {.importc.} = object of TEventHandlers + document*: Document event*: ref TEvent history*: ref THistory location*: ref TLocation @@ -55,7 +58,6 @@ type status*: cstring toolbar*: ref TToolBar - addEventListener*: proc(ev: cstring, cb: proc(ev: ref TEvent) ) {.nimcall.} alert*: proc (msg: cstring) {.nimcall.} back*: proc () {.nimcall.} blur*: proc () {.nimcall.} @@ -66,7 +68,7 @@ type confirm*: proc (msg: cstring): bool {.nimcall.} disableExternalCapture*: proc () {.nimcall.} enableExternalCapture*: proc () {.nimcall.} - find*: proc (text: cstring, caseSensitive = false, + find*: proc (text: cstring, caseSensitive = false, backwards = false) {.nimcall.} focus*: proc () {.nimcall.} forward*: proc () {.nimcall.} @@ -75,7 +77,7 @@ type moveBy*: proc (x, y: int) {.nimcall.} moveTo*: proc (x, y: int) {.nimcall.} open*: proc (uri, windowname: cstring, - properties: cstring = nil): ref TWindow {.nimcall.} + properties: cstring = nil): Window {.nimcall.} print*: proc () {.nimcall.} prompt*: proc (text, default: cstring): cstring {.nimcall.} releaseEvents*: proc (eventMask: int) {.nimcall.} @@ -89,10 +91,65 @@ type stop*: proc () {.nimcall.} frames*: seq[TFrame] - TFrame* {.importc.} = object of TWindow + Frame* = ref FrameObj + FrameObj {.importc.} = object of WindowObj + + ClassList* {.importc.} = object of RootObj + add*: proc (class: cstring) {.nimcall.} + remove*: proc (class: cstring) {.nimcall.} + contains*: proc (class: cstring):bool {.nimcall.} + toggle*: proc (class: cstring) {.nimcall.} + + TNodeType* = enum + ElementNode = 1, + AttributeNode, + TextNode, + CDATANode, + EntityRefNode, + EntityNode, + ProcessingInstructionNode, + CommentNode, + DocumentNode, + DocumentTypeNode, + DocumentFragmentNode, + NotationNode + + Node* = ref NodeObj + NodeObj {.importc.} = object of TEventHandlers + attributes*: seq[Node] + childNodes*: seq[Node] + children*: seq[Node] + data*: cstring + firstChild*: Node + lastChild*: Node + nextSibling*: Node + nodeName*: cstring + nodeType*: TNodeType + nodeValue*: cstring + parentNode*: Node + previousSibling*: Node + appendChild*: proc (child: Node) {.nimcall.} + appendData*: proc (data: cstring) {.nimcall.} + cloneNode*: proc (copyContent: bool): Node {.nimcall.} + deleteData*: proc (start, len: int) {.nimcall.} + getAttribute*: proc (attr: cstring): cstring {.nimcall.} + getAttributeNode*: proc (attr: cstring): Node {.nimcall.} + hasChildNodes*: proc (): bool {.nimcall.} + innerHTML*: cstring + insertBefore*: proc (newNode, before: Node) {.nimcall.} + insertData*: proc (position: int, data: cstring) {.nimcall.} + removeAttribute*: proc (attr: cstring) {.nimcall.} + removeAttributeNode*: proc (attr: Node) {.nimcall.} + removeChild*: proc (child: Node) {.nimcall.} + replaceChild*: proc (newNode, oldNode: Node) {.nimcall.} + replaceData*: proc (start, len: int, text: cstring) {.nimcall.} + scrollIntoView*: proc () {.nimcall.} + setAttribute*: proc (name, value: cstring) {.nimcall.} + setAttributeNode*: proc (attr: Node) {.nimcall.} + style*: ref TStyle - TDocument* {.importc.} = object of TEventHandlers - addEventListener*: proc(ev: cstring, cb: proc(ev: ref TEvent) ) {.nimcall.} + Document* = ref DocumentObj + DocumentObj {.importc.} = object of NodeObj alinkColor*: cstring bgColor*: cstring charset*: cstring @@ -106,13 +163,13 @@ type URL*: cstring vlinkColor*: cstring captureEvents*: proc (eventMask: int) {.nimcall.} - createAttribute*: proc (identifier: cstring): ref TNode {.nimcall.} - createElement*: proc (identifier: cstring): ref TNode {.nimcall.} - createTextNode*: proc (identifier: cstring): ref TNode {.nimcall.} - getElementById*: proc (id: cstring): ref TNode {.nimcall.} - getElementsByName*: proc (name: cstring): seq[ref TNode] {.nimcall.} - getElementsByTagName*: proc (name: cstring): seq[ref TNode] {.nimcall.} - getElementsByClassName*: proc (name: cstring): seq[ref TNode] {.nimcall.} + createAttribute*: proc (identifier: cstring): Node {.nimcall.} + createElement*: proc (identifier: cstring): Element {.nimcall.} + createTextNode*: proc (identifier: cstring): Node {.nimcall.} + getElementById*: proc (id: cstring): Element {.nimcall.} + getElementsByName*: proc (name: cstring): seq[Element] {.nimcall.} + getElementsByTagName*: proc (name: cstring): seq[Element] {.nimcall.} + getElementsByClassName*: proc (name: cstring): seq[Element] {.nimcall.} getSelection*: proc (): cstring {.nimcall.} handleEvent*: proc (event: ref TEvent) {.nimcall.} open*: proc () {.nimcall.} @@ -120,24 +177,43 @@ type routeEvent*: proc (event: ref TEvent) {.nimcall.} write*: proc (text: cstring) {.nimcall.} writeln*: proc (text: cstring) {.nimcall.} - anchors*: seq[ref TAnchor] - forms*: seq[ref TForm] - images*: seq[ref TImage] + anchors*: seq[AnchorElement] + forms*: seq[FormElement] + images*: seq[ImageElement] applets*: seq[ref TApplet] - embeds*: seq[ref TEmbed] - links*: seq[ref TLink] + embeds*: seq[EmbedElement] + links*: seq[LinkElement] - TLink* {.importc.} = object of RootObj + Element* = ref ElementObj + ElementObj {.importc.} = object of NodeObj + classList*: ref Classlist + checked*: bool + defaultChecked*: bool + defaultValue*: cstring + disabled*: bool + form*: FormElement name*: cstring + readOnly*: bool + blur*: proc () {.nimcall.} + click*: proc () {.nimcall.} + focus*: proc () {.nimcall.} + handleEvent*: proc (event: ref TEvent) {.nimcall.} + select*: proc () {.nimcall.} + options*: seq[OptionElement] + getElementsByTagName*: proc (name: cstring): seq[Element] {.nimcall.} + getElementsByClassName*: proc (name: cstring): seq[Element] {.nimcall.} + + LinkElement* = ref LinkObj + LinkObj {.importc.} = object of ElementObj target*: cstring text*: cstring x*: int y*: int - TEmbed* {.importc.} = object of RootObj + EmbedElement* = ref EmbedObj + EmbedObj {.importc.} = object of ElementObj height*: int hspace*: int - name*: cstring src*: cstring width*: int `type`*: cstring @@ -145,115 +221,42 @@ type play*: proc () {.nimcall.} stop*: proc () {.nimcall.} - TAnchor* {.importc.} = object of RootObj - name*: cstring + AnchorElement* = ref AnchorObj + AnchorObj {.importc.} = object of ElementObj text*: cstring x*, y*: int TApplet* {.importc.} = object of RootObj - TElement* {.importc.} = object of TEventHandlers - checked*: bool - defaultChecked*: bool - defaultValue*: cstring - disabled*: bool - form*: ref TForm - name*: cstring - readOnly*: bool - `type`*: cstring - value*: cstring - blur*: proc () {.nimcall.} - click*: proc () {.nimcall.} - focus*: proc () {.nimcall.} - handleEvent*: proc (event: ref TEvent) {.nimcall.} - select*: proc () {.nimcall.} - options*: seq[ref TOption] - - TOption* {.importc.} = object of RootObj + OptionElement* = ref OptionObj + OptionObj {.importc.} = object of ElementObj defaultSelected*: bool selected*: bool selectedIndex*: int text*: cstring value*: cstring - TForm* {.importc.} = object of TEventHandlers + FormElement* = ref FormObj + FormObj {.importc.} = object of ElementObj action*: cstring encoding*: cstring `method`*: cstring - name*: cstring target*: cstring - handleEvent*: proc (event: ref TEvent) {.nimcall.} reset*: proc () {.nimcall.} submit*: proc () {.nimcall.} - elements*: seq[ref TElement] + elements*: seq[Element] - TImage* {.importc.} = object of TEventHandlers + ImageElement* = ref ImageObj + ImageObj {.importc.} = object of ElementObj border*: int complete*: bool height*: int hspace*: int lowsrc*: cstring - name*: cstring src*: cstring vspace*: int width*: int - handleEvent*: proc (event: ref TEvent) {.nimcall.} - ClassList* {.importc.} = object of RootObj - add*: proc (class: cstring) {.nimcall.} - remove*: proc (class: cstring) {.nimcall.} - contains*: proc (class: cstring):bool {.nimcall.} - toggle*: proc (class: cstring) {.nimcall.} - - TNodeType* = enum - ElementNode = 1, - AttributeNode, - TextNode, - CDATANode, - EntityRefNode, - EntityNode, - ProcessingInstructionNode, - CommentNode, - DocumentNode, - DocumentTypeNode, - DocumentFragmentNode, - NotationNode - TNode* {.importc.} = object of RootObj - attributes*: seq[ref TNode] - childNodes*: seq[ref TNode] - children*: seq[ref TNode] - classList*: ref Classlist - data*: cstring - firstChild*: ref TNode - lastChild*: ref TNode - nextSibling*: ref TNode - nodeName*: cstring - nodeType*: TNodeType - nodeValue*: cstring - parentNode*: ref TNode - previousSibling*: ref TNode - appendChild*: proc (child: ref TNode) {.nimcall.} - appendData*: proc (data: cstring) {.nimcall.} - cloneNode*: proc (copyContent: bool): ref TNode {.nimcall.} - deleteData*: proc (start, len: int) {.nimcall.} - getAttribute*: proc (attr: cstring): cstring {.nimcall.} - getAttributeNode*: proc (attr: cstring): ref TNode {.nimcall.} - getElementsByTagName*: proc (name: cstring): seq[ref TNode] {.nimcall.} - getElementsByClassName*: proc (name: cstring): seq[ref TNode] {.nimcall.} - hasChildNodes*: proc (): bool {.nimcall.} - innerHTML*: cstring - insertBefore*: proc (newNode, before: ref TNode) {.nimcall.} - insertData*: proc (position: int, data: cstring) {.nimcall.} - addEventListener*: proc(ev: cstring, cb: proc(ev: ref TEvent)) {.nimcall.} - removeAttribute*: proc (attr: cstring) {.nimcall.} - removeAttributeNode*: proc (attr: ref TNode) {.nimcall.} - removeChild*: proc (child: ref TNode) {.nimcall.} - replaceChild*: proc (newNode, oldNode: ref TNode) {.nimcall.} - replaceData*: proc (start, len: int, text: cstring) {.nimcall.} - scrollIntoView*: proc () {.nimcall.} - setAttribute*: proc (name, value: cstring) {.nimcall.} - setAttributeNode*: proc (attr: ref TNode) {.nimcall.} - style*: ref TStyle TStyle* {.importc.} = object of RootObj background*: cstring @@ -350,7 +353,7 @@ type setAttribute*: proc (attr, value: cstring, caseSensitive=false) {.nimcall.} TEvent* {.importc.} = object of RootObj - target*: ref TNode + target*: Node altKey*, ctrlKey*, shiftKey*: bool button*: int clientX*, clientY*: int @@ -448,8 +451,8 @@ type TInterval* {.importc.} = object of RootObj var - window* {.importc, nodecl.}: ref TWindow - document* {.importc, nodecl.}: ref TDocument + window* {.importc, nodecl.}: Window + document* {.importc, nodecl.}: Document navigator* {.importc, nodecl.}: ref TNavigator screen* {.importc, nodecl.}: ref TScreen @@ -466,3 +469,17 @@ proc isNaN*(x: BiggestFloat): bool {.importc, nodecl.} proc parseFloat*(s: cstring): BiggestFloat {.importc, nodecl.} proc parseInt*(s: cstring): int {.importc, nodecl.} proc parseInt*(s: cstring, radix: int):int {.importc, nodecl.} + + +type + TWindow* {.deprecated.} = WindowObj + TFrame* {.deprecated.} = FrameObj + TNode* {.deprecated.} = NodeObj + TDocument* {.deprecated.} = DocumentObj + TElement* {.deprecated.} = ElementObj + TLink* {.deprecated.} = LinkObj + TEmbed* {.deprecated.} = EmbedObj + TAnchor* {.deprecated.} = AnchorObj + TOption* {.deprecated.} = OptionObj + TForm* {.deprecated.} = FormObj + TImage* {.deprecated.} = ImageObj diff --git a/lib/packages/docutils/highlite.nim b/lib/packages/docutils/highlite.nim index 7fc2e1aa3..9485f3912 100644 --- a/lib/packages/docutils/highlite.nim +++ b/lib/packages/docutils/highlite.nim @@ -14,14 +14,14 @@ import strutils -type - TTokenClass* = enum - gtEof, gtNone, gtWhitespace, gtDecNumber, gtBinNumber, gtHexNumber, - gtOctNumber, gtFloatNumber, gtIdentifier, gtKeyword, gtStringLit, +type + TTokenClass* = enum + gtEof, gtNone, gtWhitespace, gtDecNumber, gtBinNumber, gtHexNumber, + gtOctNumber, gtFloatNumber, gtIdentifier, gtKeyword, gtStringLit, gtLongStringLit, gtCharLit, gtEscapeSequence, # escape sequence like \xff - gtOperator, gtPunctuation, gtComment, gtLongComment, gtRegularExpression, - gtTagStart, gtTagEnd, gtKey, gtValue, gtRawData, gtAssembler, - gtPreprocessor, gtDirective, gtCommand, gtRule, gtHyperlink, gtLabel, + gtOperator, gtPunctuation, gtComment, gtLongComment, gtRegularExpression, + gtTagStart, gtTagEnd, gtKey, gtValue, gtRawData, gtAssembler, + gtPreprocessor, gtDirective, gtCommand, gtRule, gtHyperlink, gtLabel, gtReference, gtOther TGeneralTokenizer* = object of RootObj kind*: TTokenClass @@ -30,27 +30,27 @@ type pos: int state: TTokenClass - TSourceLanguage* = enum + TSourceLanguage* = enum langNone, langNim, langNimrod, langCpp, langCsharp, langC, langJava -const +const sourceLanguageToStr*: array[TSourceLanguage, string] = ["none", "Nim", "Nimrod", "C++", "C#", "C", "Java"] - tokenClassToStr*: array[TTokenClass, string] = ["Eof", "None", "Whitespace", - "DecNumber", "BinNumber", "HexNumber", "OctNumber", "FloatNumber", - "Identifier", "Keyword", "StringLit", "LongStringLit", "CharLit", - "EscapeSequence", "Operator", "Punctuation", "Comment", "LongComment", - "RegularExpression", "TagStart", "TagEnd", "Key", "Value", "RawData", - "Assembler", "Preprocessor", "Directive", "Command", "Rule", "Hyperlink", + tokenClassToStr*: array[TTokenClass, string] = ["Eof", "None", "Whitespace", + "DecNumber", "BinNumber", "HexNumber", "OctNumber", "FloatNumber", + "Identifier", "Keyword", "StringLit", "LongStringLit", "CharLit", + "EscapeSequence", "Operator", "Punctuation", "Comment", "LongComment", + "RegularExpression", "TagStart", "TagEnd", "Key", "Value", "RawData", + "Assembler", "Preprocessor", "Directive", "Command", "Rule", "Hyperlink", "Label", "Reference", "Other"] # The following list comes from doc/keywords.txt, make sure it is # synchronized with this array by running the module itself as a test case. nimKeywords = ["addr", "and", "as", "asm", "atomic", "bind", "block", - "break", "case", "cast", "const", "continue", "converter", + "break", "case", "cast", "concept", "const", "continue", "converter", "defer", "discard", "distinct", "div", "do", "elif", "else", "end", "enum", "except", "export", - "finally", "for", "from", "func", + "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", @@ -58,12 +58,12 @@ const "template", "try", "tuple", "type", "using", "var", "when", "while", "with", "without", "xor", "yield"] -proc getSourceLanguage*(name: string): TSourceLanguage = - for i in countup(succ(low(TSourceLanguage)), high(TSourceLanguage)): - if cmpIgnoreStyle(name, sourceLanguageToStr[i]) == 0: +proc getSourceLanguage*(name: string): TSourceLanguage = + for i in countup(succ(low(TSourceLanguage)), high(TSourceLanguage)): + if cmpIgnoreStyle(name, sourceLanguageToStr[i]) == 0: return i result = langNone - + proc initGeneralTokenizer*(g: var TGeneralTokenizer, buf: cstring) = g.buf = buf g.kind = low(TTokenClass) @@ -74,52 +74,52 @@ proc initGeneralTokenizer*(g: var TGeneralTokenizer, buf: cstring) = while g.buf[pos] in {' ', '\x09'..'\x0D'}: inc(pos) g.pos = pos -proc initGeneralTokenizer*(g: var TGeneralTokenizer, buf: string) = +proc initGeneralTokenizer*(g: var TGeneralTokenizer, buf: string) = initGeneralTokenizer(g, cstring(buf)) -proc deinitGeneralTokenizer*(g: var TGeneralTokenizer) = +proc deinitGeneralTokenizer*(g: var TGeneralTokenizer) = discard -proc nimGetKeyword(id: string): TTokenClass = +proc nimGetKeyword(id: string): TTokenClass = for k in nimKeywords: if cmpIgnoreStyle(id, k) == 0: return gtKeyword result = gtIdentifier when false: var i = getIdent(id) if (i.id >= ord(tokKeywordLow) - ord(tkSymbol)) and - (i.id <= ord(tokKeywordHigh) - ord(tkSymbol)): + (i.id <= ord(tokKeywordHigh) - ord(tkSymbol)): result = gtKeyword - else: + else: result = gtIdentifier - -proc nimNumberPostfix(g: var TGeneralTokenizer, position: int): int = + +proc nimNumberPostfix(g: var TGeneralTokenizer, position: int): int = var pos = position - if g.buf[pos] == '\'': + if g.buf[pos] == '\'': inc(pos) case g.buf[pos] - of 'f', 'F': + of 'f', 'F': g.kind = gtFloatNumber inc(pos) if g.buf[pos] in {'0'..'9'}: inc(pos) if g.buf[pos] in {'0'..'9'}: inc(pos) - of 'i', 'I': + of 'i', 'I': inc(pos) if g.buf[pos] in {'0'..'9'}: inc(pos) if g.buf[pos] in {'0'..'9'}: inc(pos) - else: + else: discard result = pos -proc nimNumber(g: var TGeneralTokenizer, position: int): int = +proc nimNumber(g: var TGeneralTokenizer, position: int): int = const decChars = {'0'..'9', '_'} var pos = position g.kind = gtDecNumber while g.buf[pos] in decChars: inc(pos) - if g.buf[pos] == '.': + if g.buf[pos] == '.': g.kind = gtFloatNumber inc(pos) while g.buf[pos] in decChars: inc(pos) - if g.buf[pos] in {'e', 'E'}: + if g.buf[pos] in {'e', 'E'}: g.kind = gtFloatNumber inc(pos) if g.buf[pos] in {'+', '-'}: inc(pos) @@ -127,150 +127,150 @@ proc nimNumber(g: var TGeneralTokenizer, position: int): int = result = nimNumberPostfix(g, pos) const - OpChars = {'+', '-', '*', '/', '\\', '<', '>', '!', '?', '^', '.', + OpChars = {'+', '-', '*', '/', '\\', '<', '>', '!', '?', '^', '.', '|', '=', '%', '&', '$', '@', '~', ':', '\x80'..'\xFF'} -proc nimNextToken(g: var TGeneralTokenizer) = - const +proc nimNextToken(g: var TGeneralTokenizer) = + const hexChars = {'0'..'9', 'A'..'F', 'a'..'f', '_'} octChars = {'0'..'7', '_'} binChars = {'0'..'1', '_'} SymChars = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF'} var pos = g.pos g.start = g.pos - if g.state == gtStringLit: + if g.state == gtStringLit: g.kind = gtStringLit - while true: + while true: case g.buf[pos] - of '\\': + of '\\': g.kind = gtEscapeSequence inc(pos) case g.buf[pos] - of 'x', 'X': + of 'x', 'X': inc(pos) if g.buf[pos] in hexChars: inc(pos) if g.buf[pos] in hexChars: inc(pos) - of '0'..'9': + of '0'..'9': while g.buf[pos] in {'0'..'9'}: inc(pos) - of '\0': + of '\0': g.state = gtNone else: inc(pos) - break - of '\0', '\x0D', '\x0A': + break + of '\0', '\x0D', '\x0A': g.state = gtNone - break - of '\"': + break + of '\"': inc(pos) g.state = gtNone - break + break else: inc(pos) - else: + else: case g.buf[pos] - of ' ', '\x09'..'\x0D': + of ' ', '\x09'..'\x0D': g.kind = gtWhitespace while g.buf[pos] in {' ', '\x09'..'\x0D'}: inc(pos) - of '#': + of '#': g.kind = gtComment while not (g.buf[pos] in {'\0', '\x0A', '\x0D'}): inc(pos) - of 'a'..'z', 'A'..'Z', '_', '\x80'..'\xFF': + of 'a'..'z', 'A'..'Z', '_', '\x80'..'\xFF': var id = "" - while g.buf[pos] in SymChars + {'_'}: + while g.buf[pos] in SymChars + {'_'}: add(id, g.buf[pos]) inc(pos) - if (g.buf[pos] == '\"'): - if (g.buf[pos + 1] == '\"') and (g.buf[pos + 2] == '\"'): + if (g.buf[pos] == '\"'): + if (g.buf[pos + 1] == '\"') and (g.buf[pos + 2] == '\"'): inc(pos, 3) g.kind = gtLongStringLit - while true: + while true: case g.buf[pos] - of '\0': - break - of '\"': + of '\0': + break + of '\"': inc(pos) - if g.buf[pos] == '\"' and g.buf[pos+1] == '\"' and - g.buf[pos+2] != '\"': + if g.buf[pos] == '\"' and g.buf[pos+1] == '\"' and + g.buf[pos+2] != '\"': inc(pos, 2) - break + break else: inc(pos) - else: + else: g.kind = gtRawData inc(pos) - while not (g.buf[pos] in {'\0', '\x0A', '\x0D'}): + while not (g.buf[pos] in {'\0', '\x0A', '\x0D'}): if g.buf[pos] == '"' and g.buf[pos+1] != '"': break inc(pos) if g.buf[pos] == '\"': inc(pos) - else: + else: g.kind = nimGetKeyword(id) - of '0': + of '0': inc(pos) case g.buf[pos] - of 'b', 'B': + of 'b', 'B': inc(pos) while g.buf[pos] in binChars: inc(pos) pos = nimNumberPostfix(g, pos) - of 'x', 'X': + of 'x', 'X': inc(pos) while g.buf[pos] in hexChars: inc(pos) pos = nimNumberPostfix(g, pos) - of 'o', 'O': + of 'o', 'O': inc(pos) while g.buf[pos] in octChars: inc(pos) pos = nimNumberPostfix(g, pos) else: pos = nimNumber(g, pos) - of '1'..'9': + of '1'..'9': pos = nimNumber(g, pos) - of '\'': + of '\'': inc(pos) g.kind = gtCharLit - while true: + while true: case g.buf[pos] - of '\0', '\x0D', '\x0A': - break - of '\'': + of '\0', '\x0D', '\x0A': + break + of '\'': inc(pos) - break - of '\\': + break + of '\\': inc(pos, 2) else: inc(pos) - of '\"': + of '\"': inc(pos) - if (g.buf[pos] == '\"') and (g.buf[pos + 1] == '\"'): + if (g.buf[pos] == '\"') and (g.buf[pos + 1] == '\"'): inc(pos, 2) g.kind = gtLongStringLit - while true: + while true: case g.buf[pos] - of '\0': - break - of '\"': + of '\0': + break + of '\"': inc(pos) - if g.buf[pos] == '\"' and g.buf[pos+1] == '\"' and - g.buf[pos+2] != '\"': + if g.buf[pos] == '\"' and g.buf[pos+1] == '\"' and + g.buf[pos+2] != '\"': inc(pos, 2) - break + break else: inc(pos) - else: + else: g.kind = gtStringLit - while true: + while true: case g.buf[pos] - of '\0', '\x0D', '\x0A': - break - of '\"': + of '\0', '\x0D', '\x0A': + break + of '\"': inc(pos) - break - of '\\': + break + of '\\': g.state = g.kind - break + break else: inc(pos) - of '(', ')', '[', ']', '{', '}', '`', ':', ',', ';': + of '(', ')', '[', ']', '{', '}', '`', ':', ',', ';': inc(pos) g.kind = gtPunctuation - of '\0': + of '\0': g.kind = gtEof - else: - if g.buf[pos] in OpChars: + else: + if g.buf[pos] in OpChars: g.kind = gtOperator while g.buf[pos] in OpChars: inc(pos) - else: + else: inc(pos) g.kind = gtNone g.length = pos - g.pos @@ -278,211 +278,211 @@ proc nimNextToken(g: var TGeneralTokenizer) = assert false, "nimNextToken: produced an empty token" g.pos = pos -proc generalNumber(g: var TGeneralTokenizer, position: int): int = +proc generalNumber(g: var TGeneralTokenizer, position: int): int = const decChars = {'0'..'9'} var pos = position g.kind = gtDecNumber while g.buf[pos] in decChars: inc(pos) - if g.buf[pos] == '.': + if g.buf[pos] == '.': g.kind = gtFloatNumber inc(pos) while g.buf[pos] in decChars: inc(pos) - if g.buf[pos] in {'e', 'E'}: + if g.buf[pos] in {'e', 'E'}: g.kind = gtFloatNumber inc(pos) if g.buf[pos] in {'+', '-'}: inc(pos) while g.buf[pos] in decChars: inc(pos) result = pos -proc generalStrLit(g: var TGeneralTokenizer, position: int): int = - const +proc generalStrLit(g: var TGeneralTokenizer, position: int): int = + const decChars = {'0'..'9'} hexChars = {'0'..'9', 'A'..'F', 'a'..'f'} var pos = position g.kind = gtStringLit var c = g.buf[pos] inc(pos) # skip " or ' - while true: + while true: case g.buf[pos] - of '\0': - break - of '\\': + of '\0': + break + of '\\': inc(pos) case g.buf[pos] - of '\0': - break - of '0'..'9': + of '\0': + break + of '0'..'9': while g.buf[pos] in decChars: inc(pos) - of 'x', 'X': + of 'x', 'X': inc(pos) if g.buf[pos] in hexChars: inc(pos) if g.buf[pos] in hexChars: inc(pos) else: inc(pos, 2) - else: - if g.buf[pos] == c: + else: + if g.buf[pos] == c: inc(pos) - break - else: + break + else: inc(pos) result = pos -proc isKeyword(x: openArray[string], y: string): int = +proc isKeyword(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 = cmp(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 -proc isKeywordIgnoreCase(x: openArray[string], y: string): int = +proc isKeywordIgnoreCase(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 -type - TTokenizerFlag = enum +type + TTokenizerFlag = enum hasPreprocessor, hasNestedComments TTokenizerFlags = set[TTokenizerFlag] -proc clikeNextToken(g: var TGeneralTokenizer, keywords: openArray[string], - flags: TTokenizerFlags) = - const +proc clikeNextToken(g: var TGeneralTokenizer, keywords: openArray[string], + flags: TTokenizerFlags) = + const hexChars = {'0'..'9', 'A'..'F', 'a'..'f'} octChars = {'0'..'7'} binChars = {'0'..'1'} symChars = {'A'..'Z', 'a'..'z', '0'..'9', '_', '\x80'..'\xFF'} var pos = g.pos g.start = g.pos - if g.state == gtStringLit: + if g.state == gtStringLit: g.kind = gtStringLit - while true: + while true: case g.buf[pos] - of '\\': + of '\\': g.kind = gtEscapeSequence inc(pos) case g.buf[pos] - of 'x', 'X': + of 'x', 'X': inc(pos) if g.buf[pos] in hexChars: inc(pos) if g.buf[pos] in hexChars: inc(pos) - of '0'..'9': + of '0'..'9': while g.buf[pos] in {'0'..'9'}: inc(pos) - of '\0': + of '\0': g.state = gtNone else: inc(pos) - break - of '\0', '\x0D', '\x0A': + break + of '\0', '\x0D', '\x0A': g.state = gtNone - break - of '\"': + break + of '\"': inc(pos) g.state = gtNone - break + break else: inc(pos) - else: + else: case g.buf[pos] - of ' ', '\x09'..'\x0D': + of ' ', '\x09'..'\x0D': g.kind = gtWhitespace while g.buf[pos] in {' ', '\x09'..'\x0D'}: inc(pos) - of '/': + of '/': inc(pos) - if g.buf[pos] == '/': + if g.buf[pos] == '/': g.kind = gtComment while not (g.buf[pos] in {'\0', '\x0A', '\x0D'}): inc(pos) - elif g.buf[pos] == '*': + elif g.buf[pos] == '*': g.kind = gtLongComment var nested = 0 inc(pos) - while true: + while true: case g.buf[pos] - of '*': + of '*': inc(pos) - if g.buf[pos] == '/': + if g.buf[pos] == '/': inc(pos) - if nested == 0: break - of '/': + if nested == 0: break + of '/': inc(pos) - if g.buf[pos] == '*': + if g.buf[pos] == '*': inc(pos) if hasNestedComments in flags: inc(nested) - of '\0': - break + of '\0': + break else: inc(pos) - of '#': + of '#': inc(pos) - if hasPreprocessor in flags: + if hasPreprocessor in flags: g.kind = gtPreprocessor while g.buf[pos] in {' ', '\t'}: inc(pos) while g.buf[pos] in symChars: inc(pos) - else: + else: g.kind = gtOperator - of 'a'..'z', 'A'..'Z', '_', '\x80'..'\xFF': + of 'a'..'z', 'A'..'Z', '_', '\x80'..'\xFF': var id = "" - while g.buf[pos] in symChars: + while g.buf[pos] in symChars: add(id, g.buf[pos]) inc(pos) if isKeyword(keywords, id) >= 0: g.kind = gtKeyword else: g.kind = gtIdentifier - of '0': + of '0': inc(pos) case g.buf[pos] - of 'b', 'B': + of 'b', 'B': inc(pos) while g.buf[pos] in binChars: inc(pos) if g.buf[pos] in {'A'..'Z', 'a'..'z'}: inc(pos) - of 'x', 'X': + of 'x', 'X': inc(pos) while g.buf[pos] in hexChars: inc(pos) if g.buf[pos] in {'A'..'Z', 'a'..'z'}: inc(pos) - of '0'..'7': + of '0'..'7': inc(pos) while g.buf[pos] in octChars: inc(pos) if g.buf[pos] in {'A'..'Z', 'a'..'z'}: inc(pos) - else: + else: pos = generalNumber(g, pos) if g.buf[pos] in {'A'..'Z', 'a'..'z'}: inc(pos) - of '1'..'9': + of '1'..'9': pos = generalNumber(g, pos) if g.buf[pos] in {'A'..'Z', 'a'..'z'}: inc(pos) - of '\'': + of '\'': pos = generalStrLit(g, pos) g.kind = gtCharLit - of '\"': + of '\"': inc(pos) g.kind = gtStringLit - while true: + while true: case g.buf[pos] - of '\0': - break - of '\"': + of '\0': + break + of '\"': inc(pos) - break - of '\\': + break + of '\\': g.state = g.kind - break + break else: inc(pos) - of '(', ')', '[', ']', '{', '}', ':', ',', ';', '.': + of '(', ')', '[', ']', '{', '}', ':', ',', ';', '.': inc(pos) g.kind = gtPunctuation - of '\0': + of '\0': g.kind = gtEof - else: - if g.buf[pos] in OpChars: + else: + if g.buf[pos] in OpChars: g.kind = gtOperator while g.buf[pos] in OpChars: inc(pos) else: @@ -493,55 +493,55 @@ proc clikeNextToken(g: var TGeneralTokenizer, keywords: openArray[string], assert false, "clikeNextToken: produced an empty token" g.pos = pos -proc cNextToken(g: var TGeneralTokenizer) = - const - keywords: array[0..36, string] = ["_Bool", "_Complex", "_Imaginary", "auto", - "break", "case", "char", "const", "continue", "default", "do", "double", - "else", "enum", "extern", "float", "for", "goto", "if", "inline", "int", - "long", "register", "restrict", "return", "short", "signed", "sizeof", - "static", "struct", "switch", "typedef", "union", "unsigned", "void", +proc cNextToken(g: var TGeneralTokenizer) = + const + keywords: array[0..36, string] = ["_Bool", "_Complex", "_Imaginary", "auto", + "break", "case", "char", "const", "continue", "default", "do", "double", + "else", "enum", "extern", "float", "for", "goto", "if", "inline", "int", + "long", "register", "restrict", "return", "short", "signed", "sizeof", + "static", "struct", "switch", "typedef", "union", "unsigned", "void", "volatile", "while"] clikeNextToken(g, keywords, {hasPreprocessor}) -proc cppNextToken(g: var TGeneralTokenizer) = - const - keywords: array[0..47, string] = ["asm", "auto", "break", "case", "catch", - "char", "class", "const", "continue", "default", "delete", "do", "double", - "else", "enum", "extern", "float", "for", "friend", "goto", "if", - "inline", "int", "long", "new", "operator", "private", "protected", - "public", "register", "return", "short", "signed", "sizeof", "static", - "struct", "switch", "template", "this", "throw", "try", "typedef", +proc cppNextToken(g: var TGeneralTokenizer) = + const + keywords: array[0..47, string] = ["asm", "auto", "break", "case", "catch", + "char", "class", "const", "continue", "default", "delete", "do", "double", + "else", "enum", "extern", "float", "for", "friend", "goto", "if", + "inline", "int", "long", "new", "operator", "private", "protected", + "public", "register", "return", "short", "signed", "sizeof", "static", + "struct", "switch", "template", "this", "throw", "try", "typedef", "union", "unsigned", "virtual", "void", "volatile", "while"] clikeNextToken(g, keywords, {hasPreprocessor}) -proc csharpNextToken(g: var TGeneralTokenizer) = - const - keywords: array[0..76, string] = ["abstract", "as", "base", "bool", "break", - "byte", "case", "catch", "char", "checked", "class", "const", "continue", - "decimal", "default", "delegate", "do", "double", "else", "enum", "event", - "explicit", "extern", "false", "finally", "fixed", "float", "for", - "foreach", "goto", "if", "implicit", "in", "int", "interface", "internal", - "is", "lock", "long", "namespace", "new", "null", "object", "operator", - "out", "override", "params", "private", "protected", "public", "readonly", - "ref", "return", "sbyte", "sealed", "short", "sizeof", "stackalloc", - "static", "string", "struct", "switch", "this", "throw", "true", "try", - "typeof", "uint", "ulong", "unchecked", "unsafe", "ushort", "using", +proc csharpNextToken(g: var TGeneralTokenizer) = + const + keywords: array[0..76, string] = ["abstract", "as", "base", "bool", "break", + "byte", "case", "catch", "char", "checked", "class", "const", "continue", + "decimal", "default", "delegate", "do", "double", "else", "enum", "event", + "explicit", "extern", "false", "finally", "fixed", "float", "for", + "foreach", "goto", "if", "implicit", "in", "int", "interface", "internal", + "is", "lock", "long", "namespace", "new", "null", "object", "operator", + "out", "override", "params", "private", "protected", "public", "readonly", + "ref", "return", "sbyte", "sealed", "short", "sizeof", "stackalloc", + "static", "string", "struct", "switch", "this", "throw", "true", "try", + "typeof", "uint", "ulong", "unchecked", "unsafe", "ushort", "using", "virtual", "void", "volatile", "while"] clikeNextToken(g, keywords, {hasPreprocessor}) -proc javaNextToken(g: var TGeneralTokenizer) = - const - keywords: array[0..52, string] = ["abstract", "assert", "boolean", "break", - "byte", "case", "catch", "char", "class", "const", "continue", "default", - "do", "double", "else", "enum", "extends", "false", "final", "finally", - "float", "for", "goto", "if", "implements", "import", "instanceof", "int", - "interface", "long", "native", "new", "null", "package", "private", - "protected", "public", "return", "short", "static", "strictfp", "super", - "switch", "synchronized", "this", "throw", "throws", "transient", "true", +proc javaNextToken(g: var TGeneralTokenizer) = + const + keywords: array[0..52, string] = ["abstract", "assert", "boolean", "break", + "byte", "case", "catch", "char", "class", "const", "continue", "default", + "do", "double", "else", "enum", "extends", "false", "final", "finally", + "float", "for", "goto", "if", "implements", "import", "instanceof", "int", + "interface", "long", "native", "new", "null", "package", "private", + "protected", "public", "return", "short", "static", "strictfp", "super", + "switch", "synchronized", "this", "throw", "throws", "transient", "true", "try", "void", "volatile", "while"] clikeNextToken(g, keywords, {}) -proc getNextToken*(g: var TGeneralTokenizer, lang: TSourceLanguage) = +proc getNextToken*(g: var TGeneralTokenizer, lang: TSourceLanguage) = case lang of langNone: assert false of langNim, langNimrod: nimNextToken(g) @@ -549,15 +549,17 @@ proc getNextToken*(g: var TGeneralTokenizer, lang: TSourceLanguage) = of langCsharp: csharpNextToken(g) of langC: cNextToken(g) of langJava: javaNextToken(g) - + when isMainModule: var keywords: seq[string] # Try to work running in both the subdir or at the root. for filename in ["doc/keywords.txt", "../../../doc/keywords.txt"]: - except: echo filename, " not found" - let input = string(readFile(filename)) - keywords = input.split() - break + try: + let input = string(readFile(filename)) + keywords = input.split() + break + except: + echo filename, " not found" doAssert(not keywords.isNil, "Couldn't read any keywords.txt file!") doAssert keywords.len == nimKeywords.len, "No matching lengths" for i in 0..keywords.len-1: diff --git a/lib/packages/docutils/rst.nim b/lib/packages/docutils/rst.nim index 97784898e..2ee94ba13 100644 --- a/lib/packages/docutils/rst.nim +++ b/lib/packages/docutils/rst.nim @@ -11,25 +11,25 @@ ## subset is implemented. Some features of the `markdown`:idx: wiki syntax are ## also supported. -import +import os, strutils, rstast type - TRstParseOption* = enum ## options for the RST parser + TRstParseOption* = enum ## options for the RST parser roSkipPounds, ## skip ``#`` at line beginning (documentation ## embedded in Nim comments) roSupportSmilies, ## make the RST parser support smilies like ``:)`` roSupportRawDirective, ## support the ``raw`` directive (don't support ## it for sandboxing) roSupportMarkdown ## support additional features of markdown - + TRstParseOptions* = set[TRstParseOption] - + TMsgClass* = enum - mcHint = "Hint", - mcWarning = "Warning", + mcHint = "Hint", + mcWarning = "Warning", mcError = "Error" - + TMsgKind* = enum ## the possible messages meCannotOpenFile, meExpected, @@ -41,20 +41,20 @@ type mwUnknownSubstitution, mwUnsupportedLanguage, mwUnsupportedField - + TMsgHandler* = proc (filename: string, line, col: int, msgKind: TMsgKind, arg: string) {.nimcall.} ## what to do in case of an error TFindFileHandler* = proc (filename: string): string {.nimcall.} const messages: array [TMsgKind, string] = [ - meCannotOpenFile: "cannot open '$1'", + meCannotOpenFile: "cannot open '$1'", meExpected: "'$1' expected", meGridTableNotImplemented: "grid table is not implemented", - meNewSectionExpected: "new section expected", + meNewSectionExpected: "new section expected", meGeneralParseError: "general parse error", meInvalidDirective: "invalid directive: '$1'", - mwRedefinitionOfLabel: "redefinition of label '$1'", + mwRedefinitionOfLabel: "redefinition of label '$1'", mwUnknownSubstitution: "unknown substitution '$1'", mwUnsupportedLanguage: "language '$1' not supported", mwUnsupportedField: "field '$1' not supported" @@ -67,7 +67,7 @@ proc getArgument*(n: PRstNode): string # ----------------------------- scanner part -------------------------------- -const +const SymChars: set[char] = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF'} SmileyStartChars: set[char] = {':', ';', '8'} Smilies = { @@ -111,14 +111,14 @@ const } type - TTokType = enum + TTokType = enum tkEof, tkIndent, tkWhite, tkWord, tkAdornment, tkPunct, tkOther TToken = object # a RST token kind*: TTokType # the type of the token ival*: int # the indentation or parsed integer value symbol*: string # the parsed symbol as string line*, col*: int # line and column of the token - + TTokenSeq = seq[TToken] TLexer = object of RootObj buf*: cstring @@ -127,61 +127,61 @@ type skipPounds*: bool -proc getThing(L: var TLexer, tok: var TToken, s: set[char]) = +proc getThing(L: var TLexer, tok: var TToken, s: set[char]) = tok.kind = tkWord tok.line = L.line tok.col = L.col var pos = L.bufpos - while true: + while true: add(tok.symbol, L.buf[pos]) inc(pos) - if L.buf[pos] notin s: break + if L.buf[pos] notin s: break inc(L.col, pos - L.bufpos) L.bufpos = pos -proc getAdornment(L: var TLexer, tok: var TToken) = +proc getAdornment(L: var TLexer, tok: var TToken) = tok.kind = tkAdornment tok.line = L.line tok.col = L.col var pos = L.bufpos var c = L.buf[pos] - while true: + while true: add(tok.symbol, L.buf[pos]) inc(pos) - if L.buf[pos] != c: break + if L.buf[pos] != c: break inc(L.col, pos - L.bufpos) L.bufpos = pos -proc getIndentAux(L: var TLexer, start: int): int = +proc getIndentAux(L: var TLexer, start: int): int = var pos = start - var buf = L.buf + var buf = L.buf # skip the newline (but include it in the token!) - if buf[pos] == '\x0D': + if buf[pos] == '\x0D': if buf[pos + 1] == '\x0A': inc(pos, 2) else: inc(pos) - elif buf[pos] == '\x0A': + elif buf[pos] == '\x0A': inc(pos) - if L.skipPounds: + if L.skipPounds: if buf[pos] == '#': inc(pos) if buf[pos] == '#': inc(pos) - while true: + while true: case buf[pos] - of ' ', '\x0B', '\x0C': + of ' ', '\x0B', '\x0C': inc(pos) inc(result) - of '\x09': + of '\x09': inc(pos) result = result - (result mod 8) + 8 - else: + else: break # EndOfFile also leaves the loop - if buf[pos] == '\0': + if buf[pos] == '\0': result = 0 - elif (buf[pos] == '\x0A') or (buf[pos] == '\x0D'): + elif (buf[pos] == '\x0A') or (buf[pos] == '\x0D'): # look at the next line for proper indentation: result = getIndentAux(L, pos) L.bufpos = pos # no need to set back buf - -proc getIndent(L: var TLexer, tok: var TToken) = + +proc getIndent(L: var TLexer, tok: var TToken) = tok.col = 0 tok.kind = tkIndent # skip the newline (but include it in the token!) tok.ival = getIndentAux(L, L.bufpos) @@ -191,85 +191,85 @@ proc getIndent(L: var TLexer, tok: var TToken) = tok.ival = max(tok.ival - L.baseIndent, 0) tok.symbol = "\n" & spaces(tok.ival) -proc rawGetTok(L: var TLexer, tok: var TToken) = +proc rawGetTok(L: var TLexer, tok: var TToken) = tok.symbol = "" tok.ival = 0 var c = L.buf[L.bufpos] case c - of 'a'..'z', 'A'..'Z', '\x80'..'\xFF', '0'..'9': + of 'a'..'z', 'A'..'Z', '\x80'..'\xFF', '0'..'9': getThing(L, tok, SymChars) - of ' ', '\x09', '\x0B', '\x0C': + of ' ', '\x09', '\x0B', '\x0C': getThing(L, tok, {' ', '\x09'}) tok.kind = tkWhite - if L.buf[L.bufpos] in {'\x0D', '\x0A'}: + if L.buf[L.bufpos] in {'\x0D', '\x0A'}: rawGetTok(L, tok) # ignore spaces before \n - of '\x0D', '\x0A': + of '\x0D', '\x0A': getIndent(L, tok) - of '!', '\"', '#', '$', '%', '&', '\'', '(', ')', '*', '+', ',', '-', '.', + of '!', '\"', '#', '$', '%', '&', '\'', '(', ')', '*', '+', ',', '-', '.', '/', ':', ';', '<', '=', '>', '?', '@', '[', '\\', ']', '^', '_', '`', '{', - '|', '}', '~': + '|', '}', '~': getAdornment(L, tok) if len(tok.symbol) <= 3: tok.kind = tkPunct - else: + else: tok.line = L.line tok.col = L.col - if c == '\0': + if c == '\0': tok.kind = tkEof - else: + else: tok.kind = tkOther add(tok.symbol, c) inc(L.bufpos) inc(L.col) tok.col = max(tok.col - L.baseIndent, 0) -proc getTokens(buffer: string, skipPounds: bool, tokens: var TTokenSeq): int = +proc getTokens(buffer: string, skipPounds: bool, tokens: var TTokenSeq): int = var L: TLexer var length = len(tokens) L.buf = cstring(buffer) L.line = 0 # skip UTF-8 BOM - if (L.buf[0] == '\xEF') and (L.buf[1] == '\xBB') and (L.buf[2] == '\xBF'): + if (L.buf[0] == '\xEF') and (L.buf[1] == '\xBB') and (L.buf[2] == '\xBF'): inc(L.bufpos, 3) L.skipPounds = skipPounds - if skipPounds: - if L.buf[L.bufpos] == '#': + if skipPounds: + if L.buf[L.bufpos] == '#': inc(L.bufpos) inc(result) - if L.buf[L.bufpos] == '#': + if L.buf[L.bufpos] == '#': inc(L.bufpos) inc(result) L.baseIndent = 0 - while L.buf[L.bufpos] == ' ': + while L.buf[L.bufpos] == ' ': inc(L.bufpos) inc(L.baseIndent) inc(result) - while true: + while true: inc(length) setLen(tokens, length) rawGetTok(L, tokens[length - 1]) - if tokens[length - 1].kind == tkEof: break - if tokens[0].kind == tkWhite: + if tokens[length - 1].kind == tkEof: break + if tokens[0].kind == tkWhite: # BUGFIX tokens[0].ival = len(tokens[0].symbol) tokens[0].kind = tkIndent type TLevelMap = array[char, int] - TSubstitution = object + TSubstitution = object key*: string value*: PRstNode - TSharedState = object + TSharedState = object options: TRstParseOptions # parsing options uLevel, oLevel: int # counters for the section levels subs: seq[TSubstitution] # substitutions refs: seq[TSubstitution] # references underlineToLevel: TLevelMap # Saves for each possible title adornment # character its level in the - # current document. + # current document. # This is for single underline adornments. - overlineToLevel: TLevelMap # Saves for each possible title adornment + overlineToLevel: TLevelMap # Saves for each possible title adornment # character its level in the current - # document. + # document. # This is for over-underline adornments. msgHandler: TMsgHandler # How to handle errors. findFile: TFindFileHandler # How to find files. @@ -293,7 +293,7 @@ proc whichMsgClass*(k: TMsgKind): TMsgClass = of 'w', 'W': result = mcWarning of 'h', 'H': result = mcHint else: assert false, "msgkind does not fit naming scheme" - + proc defaultMsgHandler*(filename: string, line, col: int, msgkind: TMsgKind, arg: string) {.procvar.} = let mc = msgkind.whichMsgClass @@ -302,31 +302,31 @@ proc defaultMsgHandler*(filename: string, line, col: int, msgkind: TMsgKind, if mc == mcError: raise newException(EParseError, message) else: writeln(stdout, message) -proc defaultFindFile*(filename: string): string {.procvar.} = +proc defaultFindFile*(filename: string): string {.procvar.} = if existsFile(filename): result = filename else: result = "" proc newSharedState(options: TRstParseOptions, findFile: TFindFileHandler, - msgHandler: TMsgHandler): PSharedState = + msgHandler: TMsgHandler): PSharedState = new(result) result.subs = @[] result.refs = @[] result.options = options result.msgHandler = if not isNil(msgHandler): msgHandler else: defaultMsgHandler result.findFile = if not isNil(findFile): findFile else: defaultFindFile - -proc rstMessage(p: TRstParser, msgKind: TMsgKind, arg: string) = - p.s.msgHandler(p.filename, p.line + p.tok[p.idx].line, + +proc rstMessage(p: TRstParser, msgKind: TMsgKind, arg: string) = + p.s.msgHandler(p.filename, p.line + p.tok[p.idx].line, p.col + p.tok[p.idx].col, msgKind, arg) -proc rstMessage(p: TRstParser, msgKind: TMsgKind, arg: string, line, col: int) = +proc rstMessage(p: TRstParser, msgKind: TMsgKind, arg: string, line, col: int) = p.s.msgHandler(p.filename, p.line + line, p.col + col, msgKind, arg) -proc rstMessage(p: TRstParser, msgKind: TMsgKind) = - p.s.msgHandler(p.filename, p.line + p.tok[p.idx].line, - p.col + p.tok[p.idx].col, msgKind, +proc rstMessage(p: TRstParser, msgKind: TMsgKind) = + p.s.msgHandler(p.filename, p.line + p.tok[p.idx].line, + p.col + p.tok[p.idx].col, msgKind, p.tok[p.idx].symbol) when false: @@ -334,16 +334,16 @@ when false: assert p.indentStack[0] == 0 for i in 1 .. high(p.indentStack): assert p.indentStack[i] < 1_000 -proc currInd(p: TRstParser): int = +proc currInd(p: TRstParser): int = result = p.indentStack[high(p.indentStack)] -proc pushInd(p: var TRstParser, ind: int) = +proc pushInd(p: var TRstParser, ind: int) = add(p.indentStack, ind) proc popInd(p: var TRstParser) = if len(p.indentStack) > 1: setLen(p.indentStack, len(p.indentStack) - 1) - -proc initParser(p: var TRstParser, sharedState: PSharedState) = + +proc initParser(p: var TRstParser, sharedState: PSharedState) = p.indentStack = @[0] p.tok = @[] p.idx = 0 @@ -353,150 +353,150 @@ proc initParser(p: var TRstParser, sharedState: PSharedState) = p.line = 1 p.s = sharedState -proc addNodesAux(n: PRstNode, result: var string) = - if n.kind == rnLeaf: +proc addNodesAux(n: PRstNode, result: var string) = + if n.kind == rnLeaf: add(result, n.text) - else: + else: for i in countup(0, len(n) - 1): addNodesAux(n.sons[i], result) - -proc addNodes(n: PRstNode): string = + +proc addNodes(n: PRstNode): string = result = "" addNodesAux(n, result) -proc rstnodeToRefnameAux(n: PRstNode, r: var string, b: var bool) = - if n.kind == rnLeaf: - for i in countup(0, len(n.text) - 1): +proc rstnodeToRefnameAux(n: PRstNode, r: var string, b: var bool) = + if n.kind == rnLeaf: + for i in countup(0, len(n.text) - 1): case n.text[i] - of '0'..'9': - if b: + of '0'..'9': + if b: add(r, '-') b = false if len(r) == 0: add(r, 'Z') add(r, n.text[i]) - of 'a'..'z': - if b: + of 'a'..'z': + if b: add(r, '-') b = false add(r, n.text[i]) - of 'A'..'Z': - if b: + of 'A'..'Z': + if b: add(r, '-') b = false add(r, chr(ord(n.text[i]) - ord('A') + ord('a'))) - else: + else: if (len(r) > 0): b = true - else: + else: for i in countup(0, len(n) - 1): rstnodeToRefnameAux(n.sons[i], r, b) - -proc rstnodeToRefname(n: PRstNode): string = + +proc rstnodeToRefname(n: PRstNode): string = result = "" var b = false rstnodeToRefnameAux(n, result, b) -proc findSub(p: var TRstParser, n: PRstNode): int = - var key = addNodes(n) +proc findSub(p: var TRstParser, n: PRstNode): int = + var key = addNodes(n) # the spec says: if no exact match, try one without case distinction: - for i in countup(0, high(p.s.subs)): - if key == p.s.subs[i].key: + for i in countup(0, high(p.s.subs)): + if key == p.s.subs[i].key: return i - for i in countup(0, high(p.s.subs)): - if cmpIgnoreStyle(key, p.s.subs[i].key) == 0: + for i in countup(0, high(p.s.subs)): + if cmpIgnoreStyle(key, p.s.subs[i].key) == 0: return i result = -1 -proc setSub(p: var TRstParser, key: string, value: PRstNode) = +proc setSub(p: var TRstParser, key: string, value: PRstNode) = var length = len(p.s.subs) - for i in countup(0, length - 1): - if key == p.s.subs[i].key: + for i in countup(0, length - 1): + if key == p.s.subs[i].key: p.s.subs[i].value = value - return + return setLen(p.s.subs, length + 1) p.s.subs[length].key = key p.s.subs[length].value = value -proc setRef(p: var TRstParser, key: string, value: PRstNode) = +proc setRef(p: var TRstParser, key: string, value: PRstNode) = var length = len(p.s.refs) - for i in countup(0, length - 1): + for i in countup(0, length - 1): if key == p.s.refs[i].key: if p.s.refs[i].value.addNodes != value.addNodes: rstMessage(p, mwRedefinitionOfLabel, key) p.s.refs[i].value = value - return + return setLen(p.s.refs, length + 1) p.s.refs[length].key = key p.s.refs[length].value = value -proc findRef(p: var TRstParser, key: string): PRstNode = - for i in countup(0, high(p.s.refs)): - if key == p.s.refs[i].key: +proc findRef(p: var TRstParser, key: string): PRstNode = + for i in countup(0, high(p.s.refs)): + if key == p.s.refs[i].key: return p.s.refs[i].value -proc newLeaf(p: var TRstParser): PRstNode = +proc newLeaf(p: var TRstParser): PRstNode = result = newRstNode(rnLeaf, p.tok[p.idx].symbol) -proc getReferenceName(p: var TRstParser, endStr: string): PRstNode = +proc getReferenceName(p: var TRstParser, endStr: string): PRstNode = var res = newRstNode(rnInner) - while true: + while true: case p.tok[p.idx].kind - of tkWord, tkOther, tkWhite: + of tkWord, tkOther, tkWhite: add(res, newLeaf(p)) - of tkPunct: - if p.tok[p.idx].symbol == endStr: + of tkPunct: + if p.tok[p.idx].symbol == endStr: inc(p.idx) - break - else: + break + else: add(res, newLeaf(p)) - else: + else: rstMessage(p, meExpected, endStr) - break + break inc(p.idx) result = res -proc untilEol(p: var TRstParser): PRstNode = +proc untilEol(p: var TRstParser): PRstNode = result = newRstNode(rnInner) - while not (p.tok[p.idx].kind in {tkIndent, tkEof}): + while not (p.tok[p.idx].kind in {tkIndent, tkEof}): add(result, newLeaf(p)) inc(p.idx) -proc expect(p: var TRstParser, tok: string) = +proc expect(p: var TRstParser, tok: string) = if p.tok[p.idx].symbol == tok: inc(p.idx) else: rstMessage(p, meExpected, tok) - -proc isInlineMarkupEnd(p: TRstParser, markup: string): bool = + +proc isInlineMarkupEnd(p: TRstParser, markup: string): bool = result = p.tok[p.idx].symbol == markup - if not result: + if not result: return # Rule 3: result = not (p.tok[p.idx - 1].kind in {tkIndent, tkWhite}) - if not result: + if not result: return # Rule 4: result = (p.tok[p.idx + 1].kind in {tkIndent, tkWhite, tkEof}) or (p.tok[p.idx + 1].symbol[0] in - {'\'', '\"', ')', ']', '}', '>', '-', '/', '\\', ':', '.', ',', ';', '!', + {'\'', '\"', ')', ']', '}', '>', '-', '/', '\\', ':', '.', ',', ';', '!', '?', '_'}) - if not result: + if not result: return # Rule 7: - if p.idx > 0: - if (markup != "``") and (p.tok[p.idx - 1].symbol == "\\"): + if p.idx > 0: + if (markup != "``") and (p.tok[p.idx - 1].symbol == "\\"): result = false -proc isInlineMarkupStart(p: TRstParser, markup: string): bool = +proc isInlineMarkupStart(p: TRstParser, markup: string): bool = var d: char result = p.tok[p.idx].symbol == markup - if not result: + if not result: return # Rule 1: result = (p.idx == 0) or (p.tok[p.idx - 1].kind in {tkIndent, tkWhite}) or (p.tok[p.idx - 1].symbol[0] in {'\'', '\"', '(', '[', '{', '<', '-', '/', ':', '_'}) - if not result: + if not result: return # Rule 2: result = not (p.tok[p.idx + 1].kind in {tkIndent, tkWhite, tkEof}) - if not result: + if not result: return # Rule 5 & 7: - if p.idx > 0: - if p.tok[p.idx - 1].symbol == "\\": + if p.idx > 0: + if p.tok[p.idx - 1].symbol == "\\": result = false - else: + else: var c = p.tok[p.idx - 1].symbol[0] case c of '\'', '\"': d = c @@ -507,7 +507,7 @@ proc isInlineMarkupStart(p: TRstParser, markup: string): bool = else: d = '\0' if d != '\0': result = p.tok[p.idx + 1].symbol[0] != d -proc match(p: TRstParser, start: int, expr: string): bool = +proc match(p: TRstParser, start: int, expr: string): bool = # regular expressions are: # special char exact match # 'w' tkWord @@ -521,7 +521,7 @@ proc match(p: TRstParser, start: int, expr: string): bool = var i = 0 var j = start var last = len(expr) - 1 - while i <= last: + while i <= last: case expr[i] of 'w': result = p.tok[j].kind == tkWord of ' ': result = p.tok[j].kind == tkWhite @@ -531,75 +531,75 @@ proc match(p: TRstParser, start: int, expr: string): bool = of 'o': result = p.tok[j].kind == tkOther of 'T': result = true of 'E': result = p.tok[j].kind in {tkEof, tkWhite, tkIndent} - of 'e': + of 'e': result = (p.tok[j].kind == tkWord) or (p.tok[j].symbol == "#") - if result: + if result: case p.tok[j].symbol[0] of 'a'..'z', 'A'..'Z': result = len(p.tok[j].symbol) == 1 of '0'..'9': result = allCharsInSet(p.tok[j].symbol, {'0'..'9'}) else: discard - else: + else: var c = expr[i] var length = 0 - while (i <= last) and (expr[i] == c): + while (i <= last) and (expr[i] == c): inc(i) inc(length) dec(i) result = (p.tok[j].kind in {tkPunct, tkAdornment}) and (len(p.tok[j].symbol) == length) and (p.tok[j].symbol[0] == c) - if not result: return + if not result: return inc(j) inc(i) result = true - -proc fixupEmbeddedRef(n, a, b: PRstNode) = + +proc fixupEmbeddedRef(n, a, b: PRstNode) = var sep = - 1 - for i in countdown(len(n) - 2, 0): - if n.sons[i].text == "<": + for i in countdown(len(n) - 2, 0): + if n.sons[i].text == "<": sep = i - break + break var incr = if (sep > 0) and (n.sons[sep - 1].text[0] == ' '): 2 else: 1 for i in countup(0, sep - incr): add(a, n.sons[i]) for i in countup(sep + 1, len(n) - 2): add(b, n.sons[i]) - -proc parsePostfix(p: var TRstParser, n: PRstNode): PRstNode = + +proc parsePostfix(p: var TRstParser, n: PRstNode): PRstNode = result = n - if isInlineMarkupEnd(p, "_"): + if isInlineMarkupEnd(p, "_") or isInlineMarkupEnd(p, "__"): inc(p.idx) if p.tok[p.idx-2].symbol == "`" and p.tok[p.idx-3].symbol == ">": var a = newRstNode(rnInner) var b = newRstNode(rnInner) fixupEmbeddedRef(n, a, b) - if len(a) == 0: + if len(a) == 0: result = newRstNode(rnStandaloneHyperlink) add(result, b) - else: + else: result = newRstNode(rnHyperlink) add(result, a) add(result, b) setRef(p, rstnodeToRefname(a), b) - elif n.kind == rnInterpretedText: + elif n.kind == rnInterpretedText: n.kind = rnRef - else: + else: result = newRstNode(rnRef) add(result, n) - elif match(p, p.idx, ":w:"): + elif match(p, p.idx, ":w:"): # a role: - if p.tok[p.idx + 1].symbol == "idx": + if p.tok[p.idx + 1].symbol == "idx": n.kind = rnIdx - elif p.tok[p.idx + 1].symbol == "literal": + elif p.tok[p.idx + 1].symbol == "literal": n.kind = rnInlineLiteral - elif p.tok[p.idx + 1].symbol == "strong": + elif p.tok[p.idx + 1].symbol == "strong": n.kind = rnStrongEmphasis - elif p.tok[p.idx + 1].symbol == "emphasis": + elif p.tok[p.idx + 1].symbol == "emphasis": n.kind = rnEmphasis elif (p.tok[p.idx + 1].symbol == "sub") or - (p.tok[p.idx + 1].symbol == "subscript"): + (p.tok[p.idx + 1].symbol == "subscript"): n.kind = rnSub elif (p.tok[p.idx + 1].symbol == "sup") or - (p.tok[p.idx + 1].symbol == "supscript"): + (p.tok[p.idx + 1].symbol == "supscript"): n.kind = rnSup - else: + else: result = newRstNode(rnGeneralRole) n.kind = rnInner add(result, n) @@ -614,7 +614,7 @@ proc matchVerbatim(p: TRstParser, start: int, expr: string): int = inc j, p.tok[result].symbol.len inc result if j < expr.len: result = 0 - + proc parseSmiley(p: var TRstParser): PRstNode = if p.tok[p.idx].symbol[0] notin SmileyStartChars: return for key, val in items(Smilies): @@ -636,17 +636,17 @@ proc isUrl(p: TRstParser, i: int): bool = (p.tok[i+3].kind == tkWord) and (p.tok[i].symbol in ["http", "https", "ftp", "telnet", "file"]) -proc parseUrl(p: var TRstParser, father: PRstNode) = +proc parseUrl(p: var TRstParser, father: PRstNode) = #if p.tok[p.idx].symbol[strStart] == '<': if isUrl(p, p.idx): var n = newRstNode(rnStandaloneHyperlink) - while true: + while true: case p.tok[p.idx].kind of tkWord, tkAdornment, tkOther: discard - of tkPunct: + of tkPunct: if p.tok[p.idx+1].kind notin {tkWord, tkAdornment, tkOther, tkPunct}: break - else: break + else: break add(n, newLeaf(p)) inc(p.idx) add(father, n) @@ -655,13 +655,13 @@ proc parseUrl(p: var TRstParser, father: PRstNode) = inc(p.idx) if p.tok[p.idx].symbol == "_": n = parsePostfix(p, n) add(father, n) - -proc parseBackslash(p: var TRstParser, father: PRstNode) = + +proc parseBackslash(p: var TRstParser, father: PRstNode) = assert(p.tok[p.idx].kind == tkPunct) - if p.tok[p.idx].symbol == "\\\\": + if p.tok[p.idx].symbol == "\\\\": add(father, newRstNode(rnLeaf, "\\")) inc(p.idx) - elif p.tok[p.idx].symbol == "\\": + elif p.tok[p.idx].symbol == "\\": # XXX: Unicode? inc(p.idx) if p.tok[p.idx].kind != tkWhite: add(father, newLeaf(p)) @@ -674,13 +674,13 @@ when false: proc parseAdhoc(p: var TRstParser, father: PRstNode, verbatim: bool) = if not verbatim and isURL(p, p.idx): var n = newRstNode(rnStandaloneHyperlink) - while true: + while true: case p.tok[p.idx].kind of tkWord, tkAdornment, tkOther: nil - of tkPunct: + of tkPunct: if p.tok[p.idx+1].kind notin {tkWord, tkAdornment, tkOther, tkPunct}: break - else: break + else: break add(n, newLeaf(p)) inc(p.idx) add(father, n) @@ -694,33 +694,33 @@ when false: if p.tok[p.idx].symbol == "_": n = parsePostfix(p, n) add(father, n) -proc parseUntil(p: var TRstParser, father: PRstNode, postfix: string, - interpretBackslash: bool) = +proc parseUntil(p: var TRstParser, father: PRstNode, postfix: string, + interpretBackslash: bool) = let line = p.tok[p.idx].line col = p.tok[p.idx].col inc p.idx - while true: + while true: case p.tok[p.idx].kind - of tkPunct: - if isInlineMarkupEnd(p, postfix): + of tkPunct: + if isInlineMarkupEnd(p, postfix): inc(p.idx) - break - elif interpretBackslash: + break + elif interpretBackslash: parseBackslash(p, father) - else: + else: add(father, newLeaf(p)) inc(p.idx) - of tkAdornment, tkWord, tkOther: + of tkAdornment, tkWord, tkOther: add(father, newLeaf(p)) inc(p.idx) - of tkIndent: + of tkIndent: add(father, newRstNode(rnLeaf, " ")) inc(p.idx) - if p.tok[p.idx].kind == tkIndent: + if p.tok[p.idx].kind == tkIndent: rstMessage(p, meExpected, postfix, line, col) - break - of tkWhite: + break + of tkWhite: add(father, newRstNode(rnLeaf, " ")) inc(p.idx) else: rstMessage(p, meExpected, postfix, line, col) @@ -753,20 +753,20 @@ proc parseMarkdownCodeblock(p: var TRstParser): PRstNode = result = newRstNode(rnCodeBlock) add(result, args) add(result, nil) - add(result, lb) - -proc parseInline(p: var TRstParser, father: PRstNode) = + add(result, lb) + +proc parseInline(p: var TRstParser, father: PRstNode) = case p.tok[p.idx].kind - of tkPunct: + of tkPunct: if isInlineMarkupStart(p, "***"): var n = newRstNode(rnTripleEmphasis) parseUntil(p, n, "***", true) add(father, n) - elif isInlineMarkupStart(p, "**"): + elif isInlineMarkupStart(p, "**"): var n = newRstNode(rnStrongEmphasis) parseUntil(p, n, "**", true) add(father, n) - elif isInlineMarkupStart(p, "*"): + elif isInlineMarkupStart(p, "*"): var n = newRstNode(rnEmphasis) parseUntil(p, n, "*", true) add(father, n) @@ -777,12 +777,12 @@ proc parseInline(p: var TRstParser, father: PRstNode) = var n = newRstNode(rnInlineLiteral) parseUntil(p, n, "``", false) add(father, n) - elif isInlineMarkupStart(p, "`"): + elif isInlineMarkupStart(p, "`"): var n = newRstNode(rnInterpretedText) parseUntil(p, n, "`", true) n = parsePostfix(p, n) add(father, n) - elif isInlineMarkupStart(p, "|"): + elif isInlineMarkupStart(p, "|"): var n = newRstNode(rnSubstitutionReferences) parseUntil(p, n, "|", false) add(father, n) @@ -800,7 +800,7 @@ proc parseInline(p: var TRstParser, father: PRstNode) = add(father, n) return parseUrl(p, father) - of tkAdornment, tkOther, tkWhite: + of tkAdornment, tkOther, tkWhite: if roSupportSmilies in p.s.options: let n = parseSmiley(p) if n != nil: @@ -809,75 +809,75 @@ proc parseInline(p: var TRstParser, father: PRstNode) = add(father, newLeaf(p)) inc(p.idx) else: discard - -proc getDirective(p: var TRstParser): string = - if p.tok[p.idx].kind == tkWhite and p.tok[p.idx+1].kind == tkWord: + +proc getDirective(p: var TRstParser): string = + if p.tok[p.idx].kind == tkWhite and p.tok[p.idx+1].kind == tkWord: var j = p.idx inc(p.idx) result = p.tok[p.idx].symbol inc(p.idx) - while p.tok[p.idx].kind in {tkWord, tkPunct, tkAdornment, tkOther}: - if p.tok[p.idx].symbol == "::": break + while p.tok[p.idx].kind in {tkWord, tkPunct, tkAdornment, tkOther}: + if p.tok[p.idx].symbol == "::": break add(result, p.tok[p.idx].symbol) inc(p.idx) if p.tok[p.idx].kind == tkWhite: inc(p.idx) - if p.tok[p.idx].symbol == "::": + if p.tok[p.idx].symbol == "::": inc(p.idx) if (p.tok[p.idx].kind == tkWhite): inc(p.idx) - else: + else: p.idx = j # set back result = "" # error - else: + else: result = "" - -proc parseComment(p: var TRstParser): PRstNode = + +proc parseComment(p: var TRstParser): PRstNode = case p.tok[p.idx].kind - of tkIndent, tkEof: - if p.tok[p.idx].kind != tkEof and p.tok[p.idx + 1].kind == tkIndent: + of tkIndent, tkEof: + if p.tok[p.idx].kind != tkEof and p.tok[p.idx + 1].kind == tkIndent: inc(p.idx) # empty comment - else: + else: var indent = p.tok[p.idx].ival - while true: + while true: case p.tok[p.idx].kind - of tkEof: - break - of tkIndent: - if (p.tok[p.idx].ival < indent): break - else: + of tkEof: + break + of tkIndent: + if (p.tok[p.idx].ival < indent): break + else: discard inc(p.idx) else: while p.tok[p.idx].kind notin {tkIndent, tkEof}: inc(p.idx) result = nil -type +type TDirKind = enum # must be ordered alphabetically! dkNone, dkAuthor, dkAuthors, dkCode, dkCodeBlock, dkContainer, dkContents, dkFigure, dkImage, dkInclude, dkIndex, dkRaw, dkTitle -const +const DirIds: array[0..12, string] = ["", "author", "authors", "code", "code-block", "container", "contents", "figure", "image", "include", "index", "raw", "title"] -proc getDirKind(s: string): TDirKind = +proc getDirKind(s: string): TDirKind = let i = find(DirIds, s) if i >= 0: result = TDirKind(i) else: result = dkNone - -proc parseLine(p: var TRstParser, father: PRstNode) = - while true: + +proc parseLine(p: var TRstParser, father: PRstNode) = + while true: case p.tok[p.idx].kind of tkWhite, tkWord, tkOther, tkPunct: parseInline(p, father) - else: break + else: break -proc parseUntilNewline(p: var TRstParser, father: PRstNode) = - while true: +proc parseUntilNewline(p: var TRstParser, father: PRstNode) = + while true: case p.tok[p.idx].kind of tkWhite, tkWord, tkAdornment, tkOther, tkPunct: parseInline(p, father) of tkEof, tkIndent: break - -proc parseSection(p: var TRstParser, result: PRstNode) + +proc parseSection(p: var TRstParser, result: PRstNode) {.gcsafe.} proc parseField(p: var TRstParser): PRstNode = ## Returns a parsed rnField node. ## @@ -888,9 +888,9 @@ proc parseField(p: var TRstParser): PRstNode = parseUntil(p, fieldname, ":", false) var fieldbody = newRstNode(rnFieldBody) if p.tok[p.idx].kind != tkIndent: parseLine(p, fieldbody) - if p.tok[p.idx].kind == tkIndent: + if p.tok[p.idx].kind == tkIndent: var indent = p.tok[p.idx].ival - if indent > col: + if indent > col: pushInd(p, indent) parseSection(p, fieldbody) popInd(p) @@ -909,14 +909,14 @@ proc parseFields(p: var TRstParser): PRstNode = var col = if atStart: p.tok[p.idx].col else: p.tok[p.idx].ival result = newRstNode(rnFieldList) if not atStart: inc(p.idx) - while true: + while true: add(result, parseField(p)) if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx].ival == col) and - (p.tok[p.idx + 1].symbol == ":"): + (p.tok[p.idx + 1].symbol == ":"): inc(p.idx) - else: - break - + else: + break + proc getFieldValue*(n: PRstNode): string = ## Returns the value of a specific ``rnField`` node. ## @@ -929,122 +929,122 @@ proc getFieldValue*(n: PRstNode): string = assert n.sons[1].kind == rnFieldBody result = addNodes(n.sons[1]).strip -proc getFieldValue(n: PRstNode, fieldname: string): string = +proc getFieldValue(n: PRstNode, fieldname: string): string = result = "" - if n.sons[1] == nil: return - if (n.sons[1].kind != rnFieldList): + if n.sons[1] == nil: return + if (n.sons[1].kind != rnFieldList): #InternalError("getFieldValue (2): " & $n.sons[1].kind) # We don't like internal errors here anymore as that would break the forum! return - for i in countup(0, len(n.sons[1]) - 1): + for i in countup(0, len(n.sons[1]) - 1): var f = n.sons[1].sons[i] - if cmpIgnoreStyle(addNodes(f.sons[0]), fieldname) == 0: + if cmpIgnoreStyle(addNodes(f.sons[0]), fieldname) == 0: result = addNodes(f.sons[1]) if result == "": result = "\x01\x01" # indicates that the field exists - return + return -proc getArgument(n: PRstNode): string = +proc getArgument(n: PRstNode): string = if n.sons[0] == nil: result = "" else: result = addNodes(n.sons[0]) - -proc parseDotDot(p: var TRstParser): PRstNode -proc parseLiteralBlock(p: var TRstParser): PRstNode = + +proc parseDotDot(p: var TRstParser): PRstNode {.gcsafe.} +proc parseLiteralBlock(p: var TRstParser): PRstNode = result = newRstNode(rnLiteralBlock) var n = newRstNode(rnLeaf, "") - if p.tok[p.idx].kind == tkIndent: + if p.tok[p.idx].kind == tkIndent: var indent = p.tok[p.idx].ival inc(p.idx) - while true: + while true: case p.tok[p.idx].kind - of tkEof: - break - of tkIndent: - if (p.tok[p.idx].ival < indent): - break - else: + of tkEof: + break + of tkIndent: + if (p.tok[p.idx].ival < indent): + break + else: add(n.text, "\n") add(n.text, spaces(p.tok[p.idx].ival - indent)) inc(p.idx) - else: + else: add(n.text, p.tok[p.idx].symbol) inc(p.idx) - else: - while not (p.tok[p.idx].kind in {tkIndent, tkEof}): + else: + while not (p.tok[p.idx].kind in {tkIndent, tkEof}): add(n.text, p.tok[p.idx].symbol) inc(p.idx) add(result, n) -proc getLevel(map: var TLevelMap, lvl: var int, c: char): int = - if map[c] == 0: +proc getLevel(map: var TLevelMap, lvl: var int, c: char): int = + if map[c] == 0: inc(lvl) map[c] = lvl result = map[c] -proc tokenAfterNewline(p: TRstParser): int = +proc tokenAfterNewline(p: TRstParser): int = result = p.idx - while true: + while true: case p.tok[result].kind - of tkEof: - break - of tkIndent: + of tkEof: + break + of tkIndent: inc(result) - break + break else: inc(result) - -proc isLineBlock(p: TRstParser): bool = + +proc isLineBlock(p: TRstParser): bool = var j = tokenAfterNewline(p) result = (p.tok[p.idx].col == p.tok[j].col) and (p.tok[j].symbol == "|") or (p.tok[j].col > p.tok[p.idx].col) -proc predNL(p: TRstParser): bool = +proc predNL(p: TRstParser): bool = result = true if p.idx > 0: result = p.tok[p.idx-1].kind == tkIndent and p.tok[p.idx-1].ival == currInd(p) - -proc isDefList(p: TRstParser): bool = + +proc isDefList(p: TRstParser): bool = var j = tokenAfterNewline(p) result = (p.tok[p.idx].col < p.tok[j].col) and (p.tok[j].kind in {tkWord, tkOther, tkPunct}) and (p.tok[j - 2].symbol != "::") -proc isOptionList(p: TRstParser): bool = +proc isOptionList(p: TRstParser): bool = result = match(p, p.idx, "-w") or match(p, p.idx, "--w") or match(p, p.idx, "/w") or match(p, p.idx, "//w") -proc whichSection(p: TRstParser): TRstNodeKind = +proc whichSection(p: TRstParser): TRstNodeKind = case p.tok[p.idx].kind - of tkAdornment: + of tkAdornment: if match(p, p.idx + 1, "ii"): result = rnTransition elif match(p, p.idx + 1, " a"): result = rnTable elif match(p, p.idx + 1, "i"): result = rnOverline else: result = rnLeaf - of tkPunct: - if match(p, tokenAfterNewline(p), "ai"): + of tkPunct: + if match(p, tokenAfterNewline(p), "ai"): result = rnHeadline - elif p.tok[p.idx].symbol == "::": + elif p.tok[p.idx].symbol == "::": result = rnLiteralBlock elif predNL(p) and ((p.tok[p.idx].symbol == "+") or (p.tok[p.idx].symbol == "*") or - (p.tok[p.idx].symbol == "-")) and (p.tok[p.idx + 1].kind == tkWhite): + (p.tok[p.idx].symbol == "-")) and (p.tok[p.idx + 1].kind == tkWhite): result = rnBulletList - elif (p.tok[p.idx].symbol == "|") and isLineBlock(p): + elif (p.tok[p.idx].symbol == "|") and isLineBlock(p): result = rnLineBlock - elif (p.tok[p.idx].symbol == "..") and predNL(p): + elif (p.tok[p.idx].symbol == "..") and predNL(p): result = rnDirective elif match(p, p.idx, ":w:") and predNL(p): # (p.tok[p.idx].symbol == ":") result = rnFieldList - elif match(p, p.idx, "(e) "): + elif match(p, p.idx, "(e) "): result = rnEnumList - elif match(p, p.idx, "+a+"): + elif match(p, p.idx, "+a+"): result = rnGridTable rstMessage(p, meGridTableNotImplemented) - elif isDefList(p): + elif isDefList(p): result = rnDefList - elif isOptionList(p): + elif isOptionList(p): result = rnOptionList - else: + else: result = rnParagraph of tkWord, tkOther, tkWhite: if match(p, tokenAfterNewline(p), "ai"): result = rnHeadline @@ -1052,58 +1052,58 @@ proc whichSection(p: TRstParser): TRstNodeKind = elif isDefList(p): result = rnDefList else: result = rnParagraph else: result = rnLeaf - -proc parseLineBlock(p: var TRstParser): PRstNode = + +proc parseLineBlock(p: var TRstParser): PRstNode = result = nil - if p.tok[p.idx + 1].kind == tkWhite: + if p.tok[p.idx + 1].kind == tkWhite: var col = p.tok[p.idx].col result = newRstNode(rnLineBlock) pushInd(p, p.tok[p.idx + 2].col) inc(p.idx, 2) - while true: + while true: var item = newRstNode(rnLineBlockItem) parseSection(p, item) add(result, item) if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx].ival == col) and (p.tok[p.idx + 1].symbol == "|") and - (p.tok[p.idx + 2].kind == tkWhite): + (p.tok[p.idx + 2].kind == tkWhite): inc(p.idx, 3) - else: - break + else: + break popInd(p) -proc parseParagraph(p: var TRstParser, result: PRstNode) = - while true: +proc parseParagraph(p: var TRstParser, result: PRstNode) = + while true: case p.tok[p.idx].kind - of tkIndent: - if p.tok[p.idx + 1].kind == tkIndent: + of tkIndent: + if p.tok[p.idx + 1].kind == tkIndent: inc(p.idx) - break - elif (p.tok[p.idx].ival == currInd(p)): + break + elif (p.tok[p.idx].ival == currInd(p)): inc(p.idx) case whichSection(p) - of rnParagraph, rnLeaf, rnHeadline, rnOverline, rnDirective: + of rnParagraph, rnLeaf, rnHeadline, rnOverline, rnDirective: add(result, newRstNode(rnLeaf, " ")) - of rnLineBlock: + of rnLineBlock: addIfNotNil(result, parseLineBlock(p)) - else: break - else: - break - of tkPunct: + else: break + else: + break + of tkPunct: if (p.tok[p.idx].symbol == "::") and (p.tok[p.idx + 1].kind == tkIndent) and - (currInd(p) < p.tok[p.idx + 1].ival): + (currInd(p) < p.tok[p.idx + 1].ival): add(result, newRstNode(rnLeaf, ":")) inc(p.idx) # skip '::' add(result, parseLiteralBlock(p)) - break - else: + break + else: parseInline(p, result) - of tkWhite, tkWord, tkAdornment, tkOther: + of tkWhite, tkWord, tkAdornment, tkOther: parseInline(p, result) else: break -proc parseHeadline(p: var TRstParser): PRstNode = +proc parseHeadline(p: var TRstParser): PRstNode = result = newRstNode(rnHeadline) parseUntilNewline(p, result) assert(p.tok[p.idx].kind == tkIndent) @@ -1112,31 +1112,31 @@ proc parseHeadline(p: var TRstParser): PRstNode = inc(p.idx, 2) result.level = getLevel(p.s.underlineToLevel, p.s.uLevel, c) -type +type TIntSeq = seq[int] -proc tokEnd(p: TRstParser): int = +proc tokEnd(p: TRstParser): int = result = p.tok[p.idx].col + len(p.tok[p.idx].symbol) - 1 -proc getColumns(p: var TRstParser, cols: var TIntSeq) = +proc getColumns(p: var TRstParser, cols: var TIntSeq) = var L = 0 - while true: + while true: inc(L) setLen(cols, L) cols[L - 1] = tokEnd(p) assert(p.tok[p.idx].kind == tkAdornment) inc(p.idx) - if p.tok[p.idx].kind != tkWhite: break + if p.tok[p.idx].kind != tkWhite: break inc(p.idx) - if p.tok[p.idx].kind != tkAdornment: break - if p.tok[p.idx].kind == tkIndent: inc(p.idx) + if p.tok[p.idx].kind != tkAdornment: break + if p.tok[p.idx].kind == tkIndent: inc(p.idx) # last column has no limit: cols[L - 1] = 32000 -proc parseDoc(p: var TRstParser): PRstNode +proc parseDoc(p: var TRstParser): PRstNode {.gcsafe.} -proc parseSimpleTable(p: var TRstParser): PRstNode = - var +proc parseSimpleTable(p: var TRstParser): PRstNode = + var cols: TIntSeq row: seq[string] i, last, line: int @@ -1148,36 +1148,36 @@ proc parseSimpleTable(p: var TRstParser): PRstNode = row = @[] a = nil c = p.tok[p.idx].symbol[0] - while true: - if p.tok[p.idx].kind == tkAdornment: + while true: + if p.tok[p.idx].kind == tkAdornment: last = tokenAfterNewline(p) - if p.tok[last].kind in {tkEof, tkIndent}: + if p.tok[last].kind in {tkEof, tkIndent}: # skip last adornment line: p.idx = last - break + break getColumns(p, cols) setLen(row, len(cols)) - if a != nil: + if a != nil: for j in 0..len(a)-1: a.sons[j].kind = rnTableHeaderCell - if p.tok[p.idx].kind == tkEof: break + if p.tok[p.idx].kind == tkEof: break for j in countup(0, high(row)): row[j] = "" # the following while loop iterates over the lines a single cell may span: line = p.tok[p.idx].line - while true: + while true: i = 0 - while not (p.tok[p.idx].kind in {tkIndent, tkEof}): - if (tokEnd(p) <= cols[i]): + while not (p.tok[p.idx].kind in {tkIndent, tkEof}): + if (tokEnd(p) <= cols[i]): add(row[i], p.tok[p.idx].symbol) inc(p.idx) - else: + else: if p.tok[p.idx].kind == tkWhite: inc(p.idx) inc(i) if p.tok[p.idx].kind == tkIndent: inc(p.idx) - if tokEnd(p) <= cols[0]: break - if p.tok[p.idx].kind in {tkEof, tkAdornment}: break + if tokEnd(p) <= cols[0]: break + if p.tok[p.idx].kind in {tkEof, tkAdornment}: break for j in countup(1, high(row)): add(row[j], '\x0A') a = newRstNode(rnTableRow) - for j in countup(0, high(row)): + for j in countup(0, high(row)): initParser(q, p.s) q.col = cols[j] q.line = line - 1 @@ -1188,95 +1188,95 @@ proc parseSimpleTable(p: var TRstParser): PRstNode = add(a, b) add(result, a) -proc parseTransition(p: var TRstParser): PRstNode = +proc parseTransition(p: var TRstParser): PRstNode = result = newRstNode(rnTransition) inc(p.idx) if p.tok[p.idx].kind == tkIndent: inc(p.idx) if p.tok[p.idx].kind == tkIndent: inc(p.idx) - -proc parseOverline(p: var TRstParser): PRstNode = + +proc parseOverline(p: var TRstParser): PRstNode = var c = p.tok[p.idx].symbol[0] inc(p.idx, 2) result = newRstNode(rnOverline) - while true: + while true: parseUntilNewline(p, result) - if p.tok[p.idx].kind == tkIndent: + if p.tok[p.idx].kind == tkIndent: inc(p.idx) - if p.tok[p.idx - 1].ival > currInd(p): + if p.tok[p.idx - 1].ival > currInd(p): add(result, newRstNode(rnLeaf, " ")) - else: - break - else: - break + else: + break + else: + break result.level = getLevel(p.s.overlineToLevel, p.s.oLevel, c) - if p.tok[p.idx].kind == tkAdornment: + if p.tok[p.idx].kind == tkAdornment: inc(p.idx) # XXX: check? if p.tok[p.idx].kind == tkIndent: inc(p.idx) - -proc parseBulletList(p: var TRstParser): PRstNode = + +proc parseBulletList(p: var TRstParser): PRstNode = result = nil - if p.tok[p.idx + 1].kind == tkWhite: + if p.tok[p.idx + 1].kind == tkWhite: var bullet = p.tok[p.idx].symbol var col = p.tok[p.idx].col result = newRstNode(rnBulletList) pushInd(p, p.tok[p.idx + 2].col) inc(p.idx, 2) - while true: + while true: var item = newRstNode(rnBulletItem) parseSection(p, item) add(result, item) if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx].ival == col) and (p.tok[p.idx + 1].symbol == bullet) and - (p.tok[p.idx + 2].kind == tkWhite): + (p.tok[p.idx + 2].kind == tkWhite): inc(p.idx, 3) - else: - break + else: + break popInd(p) -proc parseOptionList(p: var TRstParser): PRstNode = +proc parseOptionList(p: var TRstParser): PRstNode = result = newRstNode(rnOptionList) - while true: + while true: if isOptionList(p): var a = newRstNode(rnOptionGroup) var b = newRstNode(rnDescription) var c = newRstNode(rnOptionListItem) if match(p, p.idx, "//w"): inc(p.idx) - while not (p.tok[p.idx].kind in {tkIndent, tkEof}): - if (p.tok[p.idx].kind == tkWhite) and (len(p.tok[p.idx].symbol) > 1): + while not (p.tok[p.idx].kind in {tkIndent, tkEof}): + if (p.tok[p.idx].kind == tkWhite) and (len(p.tok[p.idx].symbol) > 1): inc(p.idx) - break + break add(a, newLeaf(p)) inc(p.idx) var j = tokenAfterNewline(p) if (j > 0) and (p.tok[j - 1].kind == tkIndent) and - (p.tok[j - 1].ival > currInd(p)): + (p.tok[j - 1].ival > currInd(p)): pushInd(p, p.tok[j - 1].ival) parseSection(p, b) popInd(p) - else: + else: parseLine(p, b) if (p.tok[p.idx].kind == tkIndent): inc(p.idx) add(c, a) add(c, b) add(result, c) - else: - break - -proc parseDefinitionList(p: var TRstParser): PRstNode = + else: + break + +proc parseDefinitionList(p: var TRstParser): PRstNode = result = nil var j = tokenAfterNewline(p) - 1 if (j >= 1) and (p.tok[j].kind == tkIndent) and - (p.tok[j].ival > currInd(p)) and (p.tok[j - 1].symbol != "::"): + (p.tok[j].ival > currInd(p)) and (p.tok[j - 1].symbol != "::"): var col = p.tok[p.idx].col result = newRstNode(rnDefList) - while true: + while true: j = p.idx var a = newRstNode(rnDefName) parseLine(p, a) if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx].ival > currInd(p)) and (p.tok[p.idx + 1].symbol != "::") and - not (p.tok[p.idx + 1].kind in {tkIndent, tkEof}): + not (p.tok[p.idx + 1].kind in {tkIndent, tkEof}): pushInd(p, p.tok[p.idx].ival) var b = newRstNode(rnDefBody) parseSection(p, b) @@ -1285,74 +1285,74 @@ proc parseDefinitionList(p: var TRstParser): PRstNode = add(c, b) add(result, c) popInd(p) - else: + else: p.idx = j - break - if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx].ival == col): + break + if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx].ival == col): inc(p.idx) j = tokenAfterNewline(p) - 1 if j >= 1 and p.tok[j].kind == tkIndent and p.tok[j].ival > col and - p.tok[j-1].symbol != "::" and p.tok[j+1].kind != tkIndent: + p.tok[j-1].symbol != "::" and p.tok[j+1].kind != tkIndent: discard - else: - break + else: + break if len(result) == 0: result = nil - -proc parseEnumList(p: var TRstParser): PRstNode = - const + +proc parseEnumList(p: var TRstParser): PRstNode = + const wildcards: array[0..2, string] = ["(e) ", "e) ", "e. "] wildpos: array[0..2, int] = [1, 0, 0] result = nil var w = 0 - while w <= 2: - if match(p, p.idx, wildcards[w]): break + while w <= 2: + if match(p, p.idx, wildcards[w]): break inc(w) - if w <= 2: + if w <= 2: var col = p.tok[p.idx].col result = newRstNode(rnEnumList) inc(p.idx, wildpos[w] + 3) var j = tokenAfterNewline(p) - if (p.tok[j].col == p.tok[p.idx].col) or match(p, j, wildcards[w]): + if (p.tok[j].col == p.tok[p.idx].col) or match(p, j, wildcards[w]): pushInd(p, p.tok[p.idx].col) - while true: + while true: var item = newRstNode(rnEnumItem) parseSection(p, item) add(result, item) if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx].ival == col) and - match(p, p.idx + 1, wildcards[w]): + match(p, p.idx + 1, wildcards[w]): inc(p.idx, wildpos[w] + 4) - else: - break + else: + break popInd(p) - else: + else: dec(p.idx, wildpos[w] + 3) result = nil -proc sonKind(father: PRstNode, i: int): TRstNodeKind = +proc sonKind(father: PRstNode, i: int): TRstNodeKind = result = rnLeaf if i < len(father): result = father.sons[i].kind - -proc parseSection(p: var TRstParser, result: PRstNode) = - while true: + +proc parseSection(p: var TRstParser, result: PRstNode) = + while true: var leave = false assert(p.idx >= 0) - while p.tok[p.idx].kind == tkIndent: - if currInd(p) == p.tok[p.idx].ival: + while p.tok[p.idx].kind == tkIndent: + if currInd(p) == p.tok[p.idx].ival: inc(p.idx) - elif p.tok[p.idx].ival > currInd(p): + elif p.tok[p.idx].ival > currInd(p): pushInd(p, p.tok[p.idx].ival) var a = newRstNode(rnBlockQuote) parseSection(p, a) add(result, a) popInd(p) - else: + else: leave = true break if leave or p.tok[p.idx].kind == tkEof: break var a: PRstNode = nil var k = whichSection(p) case k - of rnLiteralBlock: + of rnLiteralBlock: inc(p.idx) # skip '::' a = parseLiteralBlock(p) of rnBulletList: a = parseBulletList(p) @@ -1362,7 +1362,7 @@ proc parseSection(p: var TRstParser, result: PRstNode) = of rnLeaf: rstMessage(p, meNewSectionExpected) of rnParagraph: discard of rnDefList: a = parseDefinitionList(p) - of rnFieldList: + of rnFieldList: if p.idx > 0: dec(p.idx) a = parseFields(p) of rnTransition: a = parseTransition(p) @@ -1373,35 +1373,35 @@ proc parseSection(p: var TRstParser, result: PRstNode) = else: #InternalError("rst.parseSection()") discard - if a == nil and k != rnDirective: + if a == nil and k != rnDirective: a = newRstNode(rnParagraph) parseParagraph(p, a) addIfNotNil(result, a) - if sonKind(result, 0) == rnParagraph and sonKind(result, 1) != rnParagraph: + if sonKind(result, 0) == rnParagraph and sonKind(result, 1) != rnParagraph: result.sons[0].kind = rnInner - -proc parseSectionWrapper(p: var TRstParser): PRstNode = + +proc parseSectionWrapper(p: var TRstParser): PRstNode = result = newRstNode(rnInner) parseSection(p, result) - while (result.kind == rnInner) and (len(result) == 1): + while (result.kind == rnInner) and (len(result) == 1): result = result.sons[0] - + proc `$`(t: TToken): string = result = $t.kind & ' ' & (if isNil(t.symbol): "NIL" else: t.symbol) -proc parseDoc(p: var TRstParser): PRstNode = +proc parseDoc(p: var TRstParser): PRstNode = result = parseSectionWrapper(p) - if p.tok[p.idx].kind != tkEof: + if p.tok[p.idx].kind != tkEof: when false: assert isAllocatedPtr(cast[pointer](p.tok)) for i in 0 .. high(p.tok): - assert isNil(p.tok[i].symbol) or + assert isNil(p.tok[i].symbol) or isAllocatedPtr(cast[pointer](p.tok[i].symbol)) echo "index: ", p.idx, " length: ", high(p.tok), "##", p.tok[p.idx-1], p.tok[p.idx], p.tok[p.idx+1] #assert isAllocatedPtr(cast[pointer](p.indentStack)) rstMessage(p, meGeneralParseError) - + type TDirFlag = enum hasArg, hasOptions, argIsFile, argIsWord @@ -1421,55 +1421,55 @@ proc parseDirective(p: var TRstParser, flags: TDirFlags): PRstNode = result = newRstNode(rnDirective) var args: PRstNode = nil var options: PRstNode = nil - if hasArg in flags: + if hasArg in flags: args = newRstNode(rnDirArg) - if argIsFile in flags: - while true: + if argIsFile in flags: + while true: case p.tok[p.idx].kind - of tkWord, tkOther, tkPunct, tkAdornment: + of tkWord, tkOther, tkPunct, tkAdornment: add(args, newLeaf(p)) inc(p.idx) - else: break + else: break elif argIsWord in flags: while p.tok[p.idx].kind == tkWhite: inc(p.idx) - if p.tok[p.idx].kind == tkWord: + if p.tok[p.idx].kind == tkWord: add(args, newLeaf(p)) inc(p.idx) else: args = nil - else: + else: parseLine(p, args) add(result, args) - if hasOptions in flags: + if hasOptions in flags: if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx].ival >= 3) and - (p.tok[p.idx + 1].symbol == ":"): + (p.tok[p.idx + 1].symbol == ":"): options = parseFields(p) add(result, options) - -proc indFollows(p: TRstParser): bool = + +proc indFollows(p: TRstParser): bool = result = p.tok[p.idx].kind == tkIndent and p.tok[p.idx].ival > currInd(p) - -proc parseDirective(p: var TRstParser, flags: TDirFlags, - contentParser: TSectionParser): PRstNode = + +proc parseDirective(p: var TRstParser, flags: TDirFlags, + contentParser: TSectionParser): PRstNode = ## Returns a generic rnDirective tree. ## ## The children are rnDirArg, rnFieldList and rnLineBlock. Any might be nil. result = parseDirective(p, flags) - if not isNil(contentParser) and indFollows(p): + if not isNil(contentParser) and indFollows(p): pushInd(p, p.tok[p.idx].ival) var content = contentParser(p) popInd(p) add(result, content) - else: + else: add(result, nil) -proc parseDirBody(p: var TRstParser, contentParser: TSectionParser): PRstNode = - if indFollows(p): +proc parseDirBody(p: var TRstParser, contentParser: TSectionParser): PRstNode = + if indFollows(p): pushInd(p, p.tok[p.idx].ival) result = contentParser(p) popInd(p) - -proc dirInclude(p: var TRstParser): PRstNode = + +proc dirInclude(p: var TRstParser): PRstNode = # #The following options are recognized: # @@ -1490,18 +1490,18 @@ proc dirInclude(p: var TRstParser): PRstNode = var n = parseDirective(p, {hasArg, argIsFile, hasOptions}, nil) var filename = strip(addNodes(n.sons[0])) var path = p.s.findFile(filename) - if path == "": + if path == "": rstMessage(p, meCannotOpenFile, filename) - else: + else: # XXX: error handling; recursive file inclusion! - if getFieldValue(n, "literal") != "": + if getFieldValue(n, "literal") != "": result = newRstNode(rnLiteralBlock) add(result, newRstNode(rnLeaf, readFile(path))) else: var q: TRstParser initParser(q, p.s) q.filename = filename - q.col += getTokens(readFile(path), false, q.tok) + q.col += getTokens(readFile(path), false, q.tok) # workaround a GCC bug; more like the interior pointer bug? #if find(q.tok[high(q.tok)].symbol, "\0\x01\x02") > 0: # InternalError("Too many binary zeros in include file") @@ -1526,7 +1526,7 @@ proc dirCodeBlock(p: var TRstParser, nimrodExtension = false): PRstNode = ## file. result = parseDirective(p, {hasArg, hasOptions}, parseLiteralBlock) var filename = strip(getFieldValue(result, "file")) - if filename != "": + if filename != "": var path = p.s.findFile(filename) if path == "": rstMessage(p, meCannotOpenFile, filename) var n = newRstNode(rnLiteralBlock) @@ -1548,49 +1548,49 @@ proc dirCodeBlock(p: var TRstParser, nimrodExtension = false): PRstNode = result.kind = rnCodeBlock -proc dirContainer(p: var TRstParser): PRstNode = +proc dirContainer(p: var TRstParser): PRstNode = result = parseDirective(p, {hasArg}, parseSectionWrapper) assert(result.kind == rnDirective) assert(len(result) == 3) result.kind = rnContainer -proc dirImage(p: var TRstParser): PRstNode = +proc dirImage(p: var TRstParser): PRstNode = result = parseDirective(p, {hasOptions, hasArg, argIsFile}, nil) result.kind = rnImage -proc dirFigure(p: var TRstParser): PRstNode = - result = parseDirective(p, {hasOptions, hasArg, argIsFile}, +proc dirFigure(p: var TRstParser): PRstNode = + result = parseDirective(p, {hasOptions, hasArg, argIsFile}, parseSectionWrapper) result.kind = rnFigure -proc dirTitle(p: var TRstParser): PRstNode = +proc dirTitle(p: var TRstParser): PRstNode = result = parseDirective(p, {hasArg}, nil) result.kind = rnTitle -proc dirContents(p: var TRstParser): PRstNode = +proc dirContents(p: var TRstParser): PRstNode = result = parseDirective(p, {hasArg}, nil) result.kind = rnContents -proc dirIndex(p: var TRstParser): PRstNode = +proc dirIndex(p: var TRstParser): PRstNode = result = parseDirective(p, {}, parseSectionWrapper) result.kind = rnIndex proc dirRawAux(p: var TRstParser, result: var PRstNode, kind: TRstNodeKind, - contentParser: TSectionParser) = + contentParser: TSectionParser) = var filename = getFieldValue(result, "file") - if filename.len > 0: + if filename.len > 0: var path = p.s.findFile(filename) - if path.len == 0: + if path.len == 0: rstMessage(p, meCannotOpenFile, filename) - else: + else: var f = readFile(path) result = newRstNode(kind) add(result, newRstNode(rnLeaf, f)) - else: + else: result.kind = kind add(result, parseDirBody(p, contentParser)) -proc dirRaw(p: var TRstParser): PRstNode = +proc dirRaw(p: var TRstParser): PRstNode = # #The following options are recognized: # @@ -1603,19 +1603,19 @@ proc dirRaw(p: var TRstParser): PRstNode = if result.sons[0] != nil: if cmpIgnoreCase(result.sons[0].sons[0].text, "html") == 0: dirRawAux(p, result, rnRawHtml, parseLiteralBlock) - elif cmpIgnoreCase(result.sons[0].sons[0].text, "latex") == 0: + elif cmpIgnoreCase(result.sons[0].sons[0].text, "latex") == 0: dirRawAux(p, result, rnRawLatex, parseLiteralBlock) else: rstMessage(p, meInvalidDirective, result.sons[0].sons[0].text) else: dirRawAux(p, result, rnRaw, parseSectionWrapper) -proc parseDotDot(p: var TRstParser): PRstNode = +proc parseDotDot(p: var TRstParser): PRstNode = result = nil var col = p.tok[p.idx].col inc(p.idx) var d = getDirective(p) - if d != "": + if d != "": pushInd(p, col) case getDirKind(d) of dkInclude: result = dirInclude(p) @@ -1634,66 +1634,66 @@ proc parseDotDot(p: var TRstParser): PRstNode = of dkIndex: result = dirIndex(p) else: rstMessage(p, meInvalidDirective, d) popInd(p) - elif match(p, p.idx, " _"): + elif match(p, p.idx, " _"): # hyperlink target: inc(p.idx, 2) var a = getReferenceName(p, ":") if p.tok[p.idx].kind == tkWhite: inc(p.idx) var b = untilEol(p) setRef(p, rstnodeToRefname(a), b) - elif match(p, p.idx, " |"): + elif match(p, p.idx, " |"): # substitution definitions: inc(p.idx, 2) var a = getReferenceName(p, "|") var b: PRstNode if p.tok[p.idx].kind == tkWhite: inc(p.idx) - if cmpIgnoreStyle(p.tok[p.idx].symbol, "replace") == 0: + if cmpIgnoreStyle(p.tok[p.idx].symbol, "replace") == 0: inc(p.idx) expect(p, "::") b = untilEol(p) - elif cmpIgnoreStyle(p.tok[p.idx].symbol, "image") == 0: + elif cmpIgnoreStyle(p.tok[p.idx].symbol, "image") == 0: inc(p.idx) b = dirImage(p) - else: + else: rstMessage(p, meInvalidDirective, p.tok[p.idx].symbol) setSub(p, addNodes(a), b) - elif match(p, p.idx, " ["): + elif match(p, p.idx, " ["): # footnotes, citations inc(p.idx, 2) var a = getReferenceName(p, "]") if p.tok[p.idx].kind == tkWhite: inc(p.idx) var b = untilEol(p) setRef(p, rstnodeToRefname(a), b) - else: + else: result = parseComment(p) - -proc resolveSubs(p: var TRstParser, n: PRstNode): PRstNode = + +proc resolveSubs(p: var TRstParser, n: PRstNode): PRstNode = result = n - if n == nil: return + if n == nil: return case n.kind - of rnSubstitutionReferences: + of rnSubstitutionReferences: var x = findSub(p, n) - if x >= 0: + if x >= 0: result = p.s.subs[x].value - else: + else: var key = addNodes(n) var e = getEnv(key) if e != "": result = newRstNode(rnLeaf, e) else: rstMessage(p, mwUnknownSubstitution, key) - of rnRef: + of rnRef: var y = findRef(p, rstnodeToRefname(n)) - if y != nil: + if y != nil: result = newRstNode(rnHyperlink) n.kind = rnInner add(result, n) add(result, y) - of rnLeaf: + of rnLeaf: discard - of rnContents: + of rnContents: p.hasToc = true - else: + else: for i in countup(0, len(n) - 1): n.sons[i] = resolveSubs(p, n.sons[i]) - + proc rstParse*(text, filename: string, line, column: int, hasToc: var bool, options: TRstParseOptions, diff --git a/lib/packages/docutils/rstast.nim b/lib/packages/docutils/rstast.nim index 614001d76..c3956ab8b 100644 --- a/lib/packages/docutils/rstast.nim +++ b/lib/packages/docutils/rstast.nim @@ -30,7 +30,7 @@ type rnField, # a field item rnFieldName, # consisting of a field name ... rnFieldBody, # ... and a field body - rnOptionList, rnOptionListItem, rnOptionGroup, rnOption, rnOptionString, + rnOptionList, rnOptionListItem, rnOptionGroup, rnOption, rnOptionString, rnOptionArgument, rnDescription, rnLiteralBlock, rnQuotedLiteralBlock, rnLineBlock, # the | thingie rnLineBlockItem, # sons of the | thing @@ -50,7 +50,7 @@ type # * `file#id <file#id>'_ rnSubstitutionDef, # a definition of a substitution rnGeneralRole, # Inline markup: - rnSub, rnSup, rnIdx, + rnSub, rnSup, rnIdx, rnEmphasis, # "*" rnStrongEmphasis, # "**" rnTripleEmphasis, # "***" @@ -71,25 +71,25 @@ type level*: int ## valid for some node kinds sons*: TRstNodeSeq ## the node's sons -proc len*(n: PRstNode): int = +proc len*(n: PRstNode): int = result = len(n.sons) -proc newRstNode*(kind: TRstNodeKind): PRstNode = +proc newRstNode*(kind: TRstNodeKind): PRstNode = new(result) result.sons = @[] result.kind = kind -proc newRstNode*(kind: TRstNodeKind, s: string): PRstNode = +proc newRstNode*(kind: TRstNodeKind, s: string): PRstNode = result = newRstNode(kind) result.text = s -proc lastSon*(n: PRstNode): PRstNode = +proc lastSon*(n: PRstNode): PRstNode = result = n.sons[len(n.sons)-1] proc add*(father, son: PRstNode) = add(father.sons, son) -proc addIfNotNil*(father, son: PRstNode) = +proc addIfNotNil*(father, son: PRstNode) = if son != nil: add(father, son) @@ -98,26 +98,27 @@ type indent: int verbatim: int -proc renderRstToRst(d: var TRenderContext, n: PRstNode, result: var string) +proc renderRstToRst(d: var TRenderContext, n: PRstNode, + result: var string) {.gcsafe.} -proc renderRstSons(d: var TRenderContext, n: PRstNode, result: var string) = - for i in countup(0, len(n) - 1): +proc renderRstSons(d: var TRenderContext, n: PRstNode, result: var string) = + for i in countup(0, len(n) - 1): renderRstToRst(d, n.sons[i], result) - + proc renderRstToRst(d: var TRenderContext, n: PRstNode, result: var string) = # this is needed for the index generation; it may also be useful for # debugging, but most code is already debugged... - const + const lvlToChar: array[0..8, char] = ['!', '=', '-', '~', '`', '<', '*', '|', '+'] if n == nil: return var ind = spaces(d.indent) case n.kind - of rnInner: + of rnInner: renderRstSons(d, n, result) of rnHeadline: result.add("\n") result.add(ind) - + let oldLen = result.len renderRstSons(d, n, result) let headlineLen = result.len - oldLen @@ -131,16 +132,16 @@ proc renderRstToRst(d: var TRenderContext, n: PRstNode, result: var string) = var headline = "" renderRstSons(d, n, headline) - + let lvl = repeat(lvlToChar[n.level], headline.len - d.indent) result.add(lvl) result.add("\n") result.add(headline) - + result.add("\n") result.add(ind) result.add(lvl) - of rnTransition: + of rnTransition: result.add("\n\n") result.add(ind) result.add repeat('-', 78-d.indent) @@ -149,11 +150,11 @@ proc renderRstToRst(d: var TRenderContext, n: PRstNode, result: var string) = result.add("\n\n") result.add(ind) renderRstSons(d, n, result) - of rnBulletItem: + of rnBulletItem: inc(d.indent, 2) var tmp = "" renderRstSons(d, n, tmp) - if tmp.len > 0: + if tmp.len > 0: result.add("\n") result.add(ind) result.add("* ") @@ -163,22 +164,22 @@ proc renderRstToRst(d: var TRenderContext, n: PRstNode, result: var string) = inc(d.indent, 4) var tmp = "" renderRstSons(d, n, tmp) - if tmp.len > 0: + if tmp.len > 0: result.add("\n") result.add(ind) result.add("(#) ") result.add(tmp) dec(d.indent, 4) - of rnOptionList, rnFieldList, rnDefList, rnDefItem, rnLineBlock, rnFieldName, - rnFieldBody, rnStandaloneHyperlink, rnBulletList, rnEnumList: + of rnOptionList, rnFieldList, rnDefList, rnDefItem, rnLineBlock, rnFieldName, + rnFieldBody, rnStandaloneHyperlink, rnBulletList, rnEnumList: renderRstSons(d, n, result) - of rnDefName: + of rnDefName: result.add("\n\n") result.add(ind) renderRstSons(d, n, result) of rnDefBody: inc(d.indent, 2) - if n.sons[0].kind != rnBulletList: + if n.sons[0].kind != rnBulletList: result.add("\n") result.add(ind) result.add(" ") @@ -187,10 +188,10 @@ proc renderRstToRst(d: var TRenderContext, n: PRstNode, result: var string) = of rnField: var tmp = "" renderRstToRst(d, n.sons[0], tmp) - + var L = max(tmp.len + 3, 30) inc(d.indent, L) - + result.add "\n" result.add ind result.add ':' @@ -198,9 +199,9 @@ proc renderRstToRst(d: var TRenderContext, n: PRstNode, result: var string) = result.add ':' result.add spaces(L - tmp.len - 2) renderRstToRst(d, n.sons[1], result) - + dec(d.indent, L) - of rnLineBlockItem: + of rnLineBlockItem: result.add("\n") result.add(ind) result.add("| ") @@ -209,11 +210,11 @@ proc renderRstToRst(d: var TRenderContext, n: PRstNode, result: var string) = inc(d.indent, 2) renderRstSons(d, n, result) dec(d.indent, 2) - of rnRef: + of rnRef: result.add("`") renderRstSons(d, n, result) result.add("`_") - of rnHyperlink: + of rnHyperlink: result.add('`') renderRstToRst(d, n.sons[0], result) result.add(" <") @@ -225,23 +226,23 @@ proc renderRstToRst(d: var TRenderContext, n: PRstNode, result: var string) = result.add("`:") renderRstToRst(d, n.sons[1],result) result.add(':') - of rnSub: + of rnSub: result.add('`') renderRstSons(d, n, result) result.add("`:sub:") - of rnSup: + of rnSup: result.add('`') renderRstSons(d, n, result) result.add("`:sup:") - of rnIdx: + of rnIdx: result.add('`') renderRstSons(d, n, result) result.add("`:idx:") - of rnEmphasis: + of rnEmphasis: result.add("*") renderRstSons(d, n, result) result.add("*") - of rnStrongEmphasis: + of rnStrongEmphasis: result.add("**") renderRstSons(d, n, result) result.add("**") @@ -249,11 +250,11 @@ proc renderRstToRst(d: var TRenderContext, n: PRstNode, result: var string) = result.add("***") renderRstSons(d, n, result) result.add("***") - of rnInterpretedText: + of rnInterpretedText: result.add('`') renderRstSons(d, n, result) result.add('`') - of rnInlineLiteral: + of rnInlineLiteral: inc(d.verbatim) result.add("``") renderRstSons(d, n, result) @@ -266,11 +267,11 @@ proc renderRstToRst(d: var TRenderContext, n: PRstNode, result: var string) = result.add("\\\\") # XXX: escape more special characters! else: result.add(n.text) - of rnIndex: + of rnIndex: result.add("\n\n") result.add(ind) result.add(".. index::\n") - + inc(d.indent, 3) if n.sons[2] != nil: renderRstSons(d, n.sons[2], result) dec(d.indent, 3) @@ -280,7 +281,7 @@ proc renderRstToRst(d: var TRenderContext, n: PRstNode, result: var string) = result.add(".. contents::") else: result.add("Error: cannot render: " & $n.kind) - + proc renderRstToRst*(n: PRstNode, result: var string) = ## renders `n` into its string representation and appends to `result`. var d: TRenderContext @@ -302,7 +303,7 @@ proc renderRstToJsonNode(node: PRstNode): JsonNode = proc renderRstToJson*(node: PRstNode): string = ## Writes the given RST node as JSON that is in the form - ## :: + ## :: ## { ## "kind":string node.kind, ## "text":optional string node.text, diff --git a/lib/packages/docutils/rstgen.nim b/lib/packages/docutils/rstgen.nim index da05be9bf..9e96d8a63 100644 --- a/lib/packages/docutils/rstgen.nim +++ b/lib/packages/docutils/rstgen.nim @@ -34,14 +34,14 @@ type TOutputTarget* = enum ## which document type to generate outHtml, # output is HTML outLatex # output is Latex - - TTocEntry = object + + TTocEntry = object n*: PRstNode refname*, header*: string - TMetaEnum* = enum + TMetaEnum* = enum metaNone, metaTitle, metaSubtitle, metaAuthor, metaVersion - + TRstGenerator* = object of RootObj target*: TOutputTarget config*: StringTableRef @@ -60,7 +60,7 @@ type seenIndexTerms: Table[string, int] ## \ ## Keeps count of same text index terms to generate different identifiers ## for hyperlinks. See renderIndexTerm proc for details. - + PDoc = var TRstGenerator ## Alias to type less. CodeBlockParams = object ## Stores code block params. @@ -136,7 +136,7 @@ proc initRstGenerator*(g: var TRstGenerator, target: TOutputTarget, g.currentSection = "Module " & fileParts.name g.seenIndexTerms = initTable[string, int]() g.msgHandler = msgHandler - + let s = config["split.item.toc"] if s != "": g.splitAfter = parseInt(s) for i in low(g.meta)..high(g.meta): g.meta[i] = "" @@ -147,23 +147,23 @@ proc writeIndexFile*(g: var TRstGenerator, outfile: string) = ## You previously need to add entries to the index with the `setIndexTerm() ## <#setIndexTerm>`_ proc. If the index is empty the file won't be created. if g.theIndex.len > 0: writeFile(outfile, g.theIndex) - -proc addXmlChar(dest: var string, c: char) = + +proc addXmlChar(dest: var string, c: char) = case c of '&': add(dest, "&") of '<': add(dest, "<") of '>': add(dest, ">") of '\"': add(dest, """) else: add(dest, c) - -proc addRtfChar(dest: var string, c: char) = + +proc addRtfChar(dest: var string, c: char) = case c of '{': add(dest, "\\{") of '}': add(dest, "\\}") of '\\': add(dest, "\\\\") else: add(dest, c) - -proc addTexChar(dest: var string, c: char) = + +proc addTexChar(dest: var string, c: char) = case c of '_': add(dest, "\\_") of '{': add(dest, "\\symbol{123}") @@ -183,54 +183,54 @@ proc addTexChar(dest: var string, c: char) = var splitter*: string = "<wbr />" -proc escChar*(target: TOutputTarget, dest: var string, c: char) {.inline.} = +proc escChar*(target: TOutputTarget, dest: var string, c: char) {.inline.} = case target of outHtml: addXmlChar(dest, c) of outLatex: addTexChar(dest, c) - -proc nextSplitPoint*(s: string, start: int): int = + +proc nextSplitPoint*(s: string, start: int): int = result = start - while result < len(s) + 0: + while result < len(s) + 0: case s[result] - of '_': return - of 'a'..'z': - if result + 1 < len(s) + 0: - if s[result + 1] in {'A'..'Z'}: return + of '_': return + of 'a'..'z': + if result + 1 < len(s) + 0: + if s[result + 1] in {'A'..'Z'}: return else: discard inc(result) dec(result) # last valid index - -proc esc*(target: TOutputTarget, s: string, splitAfter = -1): string = + +proc esc*(target: TOutputTarget, s: string, splitAfter = -1): string = result = "" - if splitAfter >= 0: + if splitAfter >= 0: var partLen = 0 var j = 0 - while j < len(s): + while j < len(s): var k = nextSplitPoint(s, j) - if (splitter != " ") or (partLen + k - j + 1 > splitAfter): + if (splitter != " ") or (partLen + k - j + 1 > splitAfter): partLen = 0 add(result, splitter) for i in countup(j, k): escChar(target, result, s[i]) inc(partLen, k - j + 1) j = k + 1 - else: + else: for i in countup(0, len(s) - 1): escChar(target, result, s[i]) proc disp(target: TOutputTarget, xml, tex: string): string = - if target != outLatex: result = xml + if target != outLatex: result = xml else: result = tex - -proc dispF(target: TOutputTarget, xml, tex: string, - args: varargs[string]): string = - if target != outLatex: result = xml % args + +proc dispF(target: TOutputTarget, xml, tex: string, + args: varargs[string]): string = + if target != outLatex: result = xml % args else: result = tex % args - -proc dispA(target: TOutputTarget, dest: var string, + +proc dispA(target: TOutputTarget, dest: var string, xml, tex: string, args: varargs[string]) = if target != outLatex: addf(dest, xml, args) else: addf(dest, tex, args) - + proc `or`(x, y: string): string {.inline.} = result = if x.isNil: y else: x @@ -248,7 +248,7 @@ proc renderRstToOut*(d: var TRstGenerator, n: PRstNode, result: var string) ## renderRstToOut(gen, rst, generatedHTML) ## echo generatedHTML -proc renderAux(d: PDoc, n: PRstNode, result: var string) = +proc renderAux(d: PDoc, n: PRstNode, result: var string) = for i in countup(0, len(n)-1): renderRstToOut(d, n.sons[i], result) proc renderAux(d: PDoc, n: PRstNode, frmtA, frmtB: string, result: var string) = @@ -347,7 +347,7 @@ proc renderIndexTerm*(d: PDoc, n: PRstNode, result: var string) = var term = "" renderAux(d, n, term) setIndexTerm(d, id, term, d.currentSection) - dispA(d.target, result, "<span id=\"$1\">$2</span>", "$2\\label{$1}", + dispA(d.target, result, "<span id=\"$1\">$2</span>", "$2\\label{$1}", [id, term]) type @@ -656,7 +656,7 @@ proc mergeIndexes*(dir: string): string = result.add("<h2>API symbols</h2>\n") result.add(generateSymbolIndex(symbols)) - + # ---------------------------------------------------------------------------- proc stripTOCHTML(s: string): string = @@ -677,7 +677,7 @@ proc stripTOCHTML(s: string): string = result.delete(first, last) first = result.find('<', first) -proc renderHeadline(d: PDoc, n: PRstNode, result: var string) = +proc renderHeadline(d: PDoc, n: PRstNode, result: var string) = var tmp = "" for i in countup(0, len(n) - 1): renderRstToOut(d, n.sons[i], tmp) d.currentSection = tmp @@ -700,9 +700,9 @@ proc renderHeadline(d: PDoc, n: PRstNode, result: var string) = "id=\"$2\" href=\"#$2\">$3</a></h$1>", "\\rsth$4{$3}\\label{$2}\n", [$n.level, d.tocPart[length].refname, tmp, $chr(n.level - 1 + ord('A'))]) else: - dispA(d.target, result, "\n<h$1 id=\"$2\">$3</h$1>", + dispA(d.target, result, "\n<h$1 id=\"$2\">$3</h$1>", "\\rsth$4{$3}\\label{$2}\n", [ - $n.level, refname, tmp, + $n.level, refname, tmp, $chr(n.level - 1 + ord('A'))]) # Generate index entry using spaces to indicate TOC level for the output HTML. @@ -710,7 +710,7 @@ proc renderHeadline(d: PDoc, n: PRstNode, result: var string) = setIndexTerm(d, refname, tmp.stripTOCHTML, spaces(max(0, n.level)) & tmp) -proc renderOverline(d: PDoc, n: PRstNode, result: var string) = +proc renderOverline(d: PDoc, n: PRstNode, result: var string) = if d.meta[metaTitle].len == 0: for i in countup(0, len(n)-1): renderRstToOut(d, n.sons[i], d.meta[metaTitle]) @@ -723,14 +723,14 @@ proc renderOverline(d: PDoc, n: PRstNode, result: var string) = var tmp = "" for i in countup(0, len(n) - 1): renderRstToOut(d, n.sons[i], tmp) d.currentSection = tmp - dispA(d.target, result, "<h$1 id=\"$2\"><center>$3</center></h$1>", + dispA(d.target, result, "<h$1 id=\"$2\"><center>$3</center></h$1>", "\\rstov$4{$3}\\label{$2}\n", [$n.level, rstnodeToRefname(n), tmp, $chr(n.level - 1 + ord('A'))]) - -proc renderTocEntry(d: PDoc, e: TTocEntry, result: var string) = + +proc renderTocEntry(d: PDoc, e: TTocEntry, result: var string) = dispA(d.target, result, - "<li><a class=\"reference\" id=\"$1_toc\" href=\"#$1\">$2</a></li>\n", + "<li><a class=\"reference\" id=\"$1_toc\" href=\"#$1\">$2</a></li>\n", "\\item\\label{$1_toc} $2\\ref{$1}\n", [e.refname, e.header]) proc renderTocEntries*(d: var TRstGenerator, j: var int, lvl: int, @@ -759,33 +759,33 @@ proc renderImage(d: PDoc, n: PRstNode, result: var string) = var options = "" var s = getFieldValue(n, "scale") if s.valid: dispA(d.target, options, " scale=\"$1\"", " scale=$1", [strip(s)]) - + s = getFieldValue(n, "height") if s.valid: dispA(d.target, options, " height=\"$1\"", " height=$1", [strip(s)]) - + s = getFieldValue(n, "width") if s.valid: dispA(d.target, options, " width=\"$1\"", " width=$1", [strip(s)]) - + s = getFieldValue(n, "alt") if s.valid: dispA(d.target, options, " alt=\"$1\"", "", [strip(s)]) - + s = getFieldValue(n, "align") if s.valid: dispA(d.target, options, " align=\"$1\"", "", [strip(s)]) - + if options.len > 0: options = dispF(d.target, "$1", "[$1]", [options]) let arg = getArgument(n) if arg.valid: - dispA(d.target, result, "<img src=\"$1\"$2 />", "\\includegraphics$2{$1}", + dispA(d.target, result, "<img src=\"$1\"$2 />", "\\includegraphics$2{$1}", [arg, options]) if len(n) >= 3: renderRstToOut(d, n.sons[2], result) - + proc renderSmiley(d: PDoc, n: PRstNode, result: var string) = dispA(d.target, result, - """<img src="$1" width="15" + """<img src="$1" width="15" height="17" hspace="2" vspace="2" class="smiley" />""", "\\includegraphics{$1}", [d.config["doc.smiley_format"] % n.text]) - + proc parseCodeBlockField(d: PDoc, n: PRstNode, params: var CodeBlockParams) = ## Parses useful fields which can appear before a code block. ## @@ -880,11 +880,11 @@ proc renderCodeBlock(d: PDoc, n: PRstNode, result: var string) = else: var g: TGeneralTokenizer initGeneralTokenizer(g, m.text) - while true: + while true: getNextToken(g, params.lang) case g.kind - of gtEof: break - of gtNone, gtWhitespace: + of gtEof: break + of gtNone, gtWhitespace: add(result, substr(m.text, g.start, g.length + g.start - 1)) else: dispA(d.target, result, "<span class=\"$2\">$1</span>", "\\span$2{$1}", [ @@ -893,36 +893,36 @@ proc renderCodeBlock(d: PDoc, n: PRstNode, result: var string) = deinitGeneralTokenizer(g) dispA(d.target, result, blockEnd, "\n\\end{rstpre}\n") -proc renderContainer(d: PDoc, n: PRstNode, result: var string) = +proc renderContainer(d: PDoc, n: PRstNode, result: var string) = var tmp = "" renderRstToOut(d, n.sons[2], tmp) var arg = strip(getArgument(n)) - if arg == "": + if arg == "": dispA(d.target, result, "<div>$1</div>", "$1", [tmp]) else: dispA(d.target, result, "<div class=\"$1\">$2</div>", "$2", [arg, tmp]) - -proc texColumns(n: PRstNode): string = + +proc texColumns(n: PRstNode): string = result = "" for i in countup(1, len(n)): add(result, "|X") - -proc renderField(d: PDoc, n: PRstNode, result: var string) = + +proc renderField(d: PDoc, n: PRstNode, result: var string) = var b = false - if d.target == outLatex: + if d.target == outLatex: var fieldname = addNodes(n.sons[0]) var fieldval = esc(d.target, strip(addNodes(n.sons[1]))) - if cmpIgnoreStyle(fieldname, "author") == 0 or + if cmpIgnoreStyle(fieldname, "author") == 0 or cmpIgnoreStyle(fieldname, "authors") == 0: if d.meta[metaAuthor].len == 0: d.meta[metaAuthor] = fieldval b = true - elif cmpIgnoreStyle(fieldname, "version") == 0: + elif cmpIgnoreStyle(fieldname, "version") == 0: if d.meta[metaVersion].len == 0: d.meta[metaVersion] = fieldval b = true if not b: renderAux(d, n, "<tr>$1</tr>\n", "$1", result) - + proc renderRstToOut(d: PDoc, n: PRstNode, result: var string) = if n == nil: return case n.kind @@ -947,54 +947,54 @@ proc renderRstToOut(d: PDoc, n: PRstNode, result: var string) = of rnDefBody: renderAux(d, n, "<dd>$1</dd>\n", "$1\n", result) of rnFieldList: var tmp = "" - for i in countup(0, len(n) - 1): + for i in countup(0, len(n) - 1): renderRstToOut(d, n.sons[i], tmp) - if tmp.len != 0: + if tmp.len != 0: dispA(d.target, result, "<table class=\"docinfo\" frame=\"void\" rules=\"none\">" & "<col class=\"docinfo-name\" />" & - "<col class=\"docinfo-content\" />" & + "<col class=\"docinfo-content\" />" & "<tbody valign=\"top\">$1" & - "</tbody></table>", - "\\begin{description}$1\\end{description}\n", + "</tbody></table>", + "\\begin{description}$1\\end{description}\n", [tmp]) of rnField: renderField(d, n, result) - of rnFieldName: + of rnFieldName: renderAux(d, n, "<th class=\"docinfo-name\">$1:</th>", "\\item[$1:]", result) - of rnFieldBody: + of rnFieldBody: renderAux(d, n, "<td>$1</td>", " $1\n", result) - of rnIndex: + of rnIndex: renderRstToOut(d, n.sons[2], result) - of rnOptionList: - renderAux(d, n, "<table frame=\"void\">$1</table>", + of rnOptionList: + renderAux(d, n, "<table frame=\"void\">$1</table>", "\\begin{description}\n$1\\end{description}\n", result) - of rnOptionListItem: + of rnOptionListItem: renderAux(d, n, "<tr>$1</tr>\n", "$1", result) - of rnOptionGroup: + of rnOptionGroup: renderAux(d, n, "<th align=\"left\">$1</th>", "\\item[$1]", result) - of rnDescription: + of rnDescription: renderAux(d, n, "<td align=\"left\">$1</td>\n", " $1\n", result) - of rnOption, rnOptionString, rnOptionArgument: + of rnOption, rnOptionString, rnOptionArgument: doAssert false, "renderRstToOut" of rnLiteralBlock: - renderAux(d, n, "<pre>$1</pre>\n", + renderAux(d, n, "<pre>$1</pre>\n", "\\begin{rstpre}\n$1\n\\end{rstpre}\n", result) - of rnQuotedLiteralBlock: + of rnQuotedLiteralBlock: doAssert false, "renderRstToOut" - of rnLineBlock: + of rnLineBlock: renderAux(d, n, "<p>$1</p>", "$1\n\n", result) - of rnLineBlockItem: + of rnLineBlockItem: renderAux(d, n, "$1<br />", "$1\\\\\n", result) - of rnBlockQuote: - renderAux(d, n, "<blockquote><p>$1</p></blockquote>\n", + of rnBlockQuote: + renderAux(d, n, "<blockquote><p>$1</p></blockquote>\n", "\\begin{quote}$1\\end{quote}\n", result) - of rnTable, rnGridTable: - renderAux(d, n, - "<table border=\"1\" class=\"docutils\">$1</table>", + of rnTable, rnGridTable: + renderAux(d, n, + "<table border=\"1\" class=\"docutils\">$1</table>", "\\begin{table}\\begin{rsttab}{" & texColumns(n) & "|}\n\\hline\n$1\\end{rsttab}\\end{table}", result) - of rnTableRow: + of rnTableRow: if len(n) >= 1: if d.target == outLatex: #var tmp = "" @@ -1007,25 +1007,25 @@ proc renderRstToOut(d: PDoc, n: PRstNode, result: var string) = result.add("<tr>") renderAux(d, n, result) result.add("</tr>\n") - of rnTableDataCell: + of rnTableDataCell: renderAux(d, n, "<td>$1</td>", "$1", result) - of rnTableHeaderCell: + of rnTableHeaderCell: renderAux(d, n, "<th>$1</th>", "\\textbf{$1}", result) - of rnLabel: + of rnLabel: doAssert false, "renderRstToOut" # used for footnotes and other - of rnFootnote: + of rnFootnote: doAssert false, "renderRstToOut" # a footnote - of rnCitation: + of rnCitation: doAssert false, "renderRstToOut" # similar to footnote - of rnRef: + of rnRef: var tmp = "" renderAux(d, n, tmp) dispA(d.target, result, "<a class=\"reference external\" href=\"#$2\">$1</a>", "$1\\ref{$2}", [tmp, rstnodeToRefname(n)]) - of rnStandaloneHyperlink: - renderAux(d, n, - "<a class=\"reference external\" href=\"$1\">$1</a>", + of rnStandaloneHyperlink: + renderAux(d, n, + "<a class=\"reference external\" href=\"$1\">$1</a>", "\\href{$1}{$1}", result) of rnHyperlink: var tmp0 = "" @@ -1042,11 +1042,11 @@ proc renderRstToOut(d: PDoc, n: PRstNode, result: var string) = of rnRawLatex: if d.target == outLatex: result.add addNodes(lastSon(n)) - + of rnImage, rnFigure: renderImage(d, n, result) of rnCodeBlock: renderCodeBlock(d, n, result) of rnContainer: renderContainer(d, n, result) - of rnSubstitutionReferences, rnSubstitutionDef: + of rnSubstitutionReferences, rnSubstitutionDef: renderAux(d, n, "|$1|", "|$1|", result) of rnDirective: renderAux(d, n, "", "", result) @@ -1063,15 +1063,15 @@ proc renderRstToOut(d: PDoc, n: PRstNode, result: var string) = of rnStrongEmphasis: renderAux(d, n, "<strong>$1</strong>", "\\textbf{$1}", result) of rnTripleEmphasis: - renderAux(d, n, "<strong><em>$1</em></strong>", + renderAux(d, n, "<strong><em>$1</em></strong>", "\\textbf{emph{$1}}", result) of rnInterpretedText: renderAux(d, n, "<cite>$1</cite>", "\\emph{$1}", result) of rnIdx: renderIndexTerm(d, n, result) - of rnInlineLiteral: - renderAux(d, n, - "<tt class=\"docutils literal\"><span class=\"pre\">$1</span></tt>", + of rnInlineLiteral: + renderAux(d, n, + "<tt class=\"docutils literal\"><span class=\"pre\">$1</span></tt>", "\\texttt{$1}", result) of rnSmiley: renderSmiley(d, n, result) of rnLeaf: result.add(esc(d.target, n.text)) @@ -1082,55 +1082,55 @@ proc renderRstToOut(d: PDoc, n: PRstNode, result: var string) = # ----------------------------------------------------------------------------- -proc getVarIdx(varnames: openArray[string], id: string): int = - for i in countup(0, high(varnames)): - if cmpIgnoreStyle(varnames[i], id) == 0: +proc getVarIdx(varnames: openArray[string], id: string): int = + for i in countup(0, high(varnames)): + if cmpIgnoreStyle(varnames[i], id) == 0: return i result = -1 -proc formatNamedVars*(frmt: string, varnames: openArray[string], - varvalues: openArray[string]): string = +proc formatNamedVars*(frmt: string, varnames: openArray[string], + varvalues: openArray[string]): string = var i = 0 var L = len(frmt) result = "" var num = 0 - while i < L: - if frmt[i] == '$': + while i < L: + if frmt[i] == '$': inc(i) # skip '$' case frmt[i] - of '#': + of '#': add(result, varvalues[num]) inc(num) inc(i) - of '$': + of '$': add(result, "$") inc(i) - 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 > L-1 or frmt[i] notin {'0'..'9'}: break + if i > L-1 or frmt[i] notin {'0'..'9'}: break if j > high(varvalues) + 1: raise newException(ValueError, "invalid index: " & $j) num = j add(result, varvalues[j - 1]) - of 'A'..'Z', 'a'..'z', '\x80'..'\xFF': + of 'A'..'Z', 'a'..'z', '\x80'..'\xFF': var id = "" - while true: + while true: add(id, frmt[i]) inc(i) - if frmt[i] notin {'A'..'Z', '_', 'a'..'z', '\x80'..'\xFF'}: break + if frmt[i] notin {'A'..'Z', '_', 'a'..'z', '\x80'..'\xFF'}: break var idx = getVarIdx(varnames, id) - if idx >= 0: + if idx >= 0: add(result, varvalues[idx]) else: raise newException(ValueError, "unknown substitution var: " & id) - of '{': + of '{': var id = "" inc(i) - while frmt[i] != '}': - if frmt[i] == '\0': + while frmt[i] != '}': + if frmt[i] == '\0': raise newException(ValueError, "'}' expected") add(id, frmt[i]) inc(i) @@ -1138,12 +1138,12 @@ proc formatNamedVars*(frmt: string, varnames: openArray[string], # search for the variable: var idx = getVarIdx(varnames, id) if idx >= 0: add(result, varvalues[idx]) - else: + else: raise newException(ValueError, "unknown substitution var: " & id) else: raise newException(ValueError, "unknown substitution: $" & $frmt[i]) var start = i - while i < L: + while i < L: if frmt[i] != '$': inc(i) else: break if i-1 >= start: add(result, substr(frmt, start, i - 1)) @@ -1163,10 +1163,10 @@ proc defaultConfig*(): StringTableRef = ## pages, while this proc returns just the content for procs like ## ``rstToHtml`` to generate the bare minimum HTML. result = newStringTable(modeStyleInsensitive) - + template setConfigVar(key, val: expr) = result[key] = val - + # If you need to modify these values, it might be worth updating the template # file in config/nimdoc.cfg. setConfigVar("split.item.toc", "20") @@ -1214,7 +1214,7 @@ $content # ---------- forum --------------------------------------------------------- -proc rstToHtml*(s: string, options: TRstParseOptions, +proc rstToHtml*(s: string, options: TRstParseOptions, config: StringTableRef): string = ## Converts an input rst string into embeddable HTML. ## @@ -1236,13 +1236,13 @@ proc rstToHtml*(s: string, options: TRstParseOptions, ## output you have to create your own ``TRstGenerator`` with ## ``initRstGenerator`` and related procs. - proc myFindFile(filename: string): string = + proc myFindFile(filename: string): string = # we don't find any files in online mode: result = "" const filen = "input" var d: TRstGenerator - initRstGenerator(d, outHtml, config, filen, options, myFindFile, + initRstGenerator(d, outHtml, config, filen, options, myFindFile, rst.defaultMsgHandler) var dummyHasToc = false var rst = rstParse(s, filen, 0, 1, dummyHasToc, options) @@ -1251,5 +1251,6 @@ proc rstToHtml*(s: string, options: TRstParseOptions, when isMainModule: - echo rstToHtml("*Hello* **world**!", {}, - newStringTable(modeStyleInsensitive)) + assert rstToHtml("*Hello* **world**!", {}, + newStringTable(modeStyleInsensitive)) == + "<em>Hello</em> <strong>world</strong>!" diff --git a/lib/posix/posix.nim b/lib/posix/posix.nim index 7d3e3ddba..0c7b84090 100644 --- a/lib/posix/posix.nim +++ b/lib/posix/posix.nim @@ -94,10 +94,12 @@ type Tdirent* {.importc: "struct dirent", header: "<dirent.h>", final, pure.} = object ## dirent_t struct d_ino*: Tino ## File serial number. - d_off*: TOff ## Not an offset. Value that ``telldir()`` would return. - d_reclen*: cshort ## Length of this record. (not POSIX) - d_type*: int8 ## Type of file; not supported by all filesystem types. - ## (not POSIX) + when defined(linux) or defined(macosx) or defined(bsd): + d_reclen*: cshort ## Length of this record. (not POSIX) + d_type*: int8 ## Type of file; not supported by all filesystem types. + ## (not POSIX) + when defined(linux) or defined(bsd): + d_off*: TOff ## Not an offset. Value that ``telldir()`` would return. d_name*: array [0..255, char] ## Name of entry. Tflock* {.importc: "struct flock", final, pure, @@ -1578,8 +1580,11 @@ else: when defined(macosx): # We can't use the NOSIGNAL flag in the ``send`` function, it has no effect - var + # Instead we should use SO_NOSIGPIPE in setsockopt + const MSG_NOSIGNAL* = 0'i32 + var + SO_NOSIGPIPE* {.importc, header: "<sys/socket.h>".}: cint else: var MSG_NOSIGNAL* {.importc, header: "<sys/socket.h>".}: cint diff --git a/lib/pure/actors.nim b/lib/pure/actors.nim index 8c61ce7df..294c24741 100644 --- a/lib/pure/actors.nim +++ b/lib/pure/actors.nim @@ -221,7 +221,7 @@ proc spawn*[TIn](p: var TActorPool[TIn, void], input: TIn, setupTask() schedule() -when isMainModule: +when not defined(testing) and isMainModule: var a: TActorPool[int, void] createActorPool(a) diff --git a/lib/pure/algorithm.nim b/lib/pure/algorithm.nim index 08d224dfd..f7ccb9234 100644 --- a/lib/pure/algorithm.nim +++ b/lib/pure/algorithm.nim @@ -24,7 +24,7 @@ proc `*`*(x: int, order: SortOrder): int {.inline.} = var y = order.ord - 1 result = (x xor y) - y -proc reverse*[T](a: var openArray[T], first, last: int) = +proc reverse*[T](a: var openArray[T], first, last: Natural) = ## reverses the array ``a[first..last]``. var x = first var y = last @@ -37,11 +37,11 @@ proc reverse*[T](a: var openArray[T]) = ## reverses the array `a`. reverse(a, 0, a.high) -proc reversed*[T](a: openArray[T], first, last: int): seq[T] = +proc reversed*[T](a: openArray[T], first, last: Natural): seq[T] = ## returns the reverse of the array `a[first..last]`. result = newSeq[T](last - first + 1) - var x = first - var y = last + var x = first.int + var y = last.int while x <= last: result[x] = a[y] dec(y) @@ -253,16 +253,16 @@ proc product*[T](x: openArray[seq[T]]): seq[seq[T]] = while true: while indexes[index] == -1: indexes[index] = initial[index] - index +=1 + index += 1 if index == x.len: return - indexes[index] -=1 + indexes[index] -= 1 for ni, i in indexes: next[ni] = x[ni][i] var res: seq[T] shallowCopy(res, next) result.add(res) index = 0 - indexes[index] -=1 + indexes[index] -= 1 proc nextPermutation*[T](x: var openarray[T]): bool {.discardable.} = ## Calculates the next lexicographic permutation, directly modifying ``x``. diff --git a/lib/pure/asyncdispatch.nim b/lib/pure/asyncdispatch.nim index 8e0ac8d21..27f77cef2 100644 --- a/lib/pure/asyncdispatch.nim +++ b/lib/pure/asyncdispatch.nim @@ -841,6 +841,8 @@ else: proc newAsyncRawSocket*(domain: cint, typ: cint, protocol: cint): TAsyncFD = result = newRawSocket(domain, typ, protocol).TAsyncFD result.SocketHandle.setBlocking(false) + when defined(macosx): + result.SocketHandle.setSockOptInt(SOL_SOCKET, SO_NOSIGPIPE, 1) register(result) proc newAsyncRawSocket*(domain: Domain = AF_INET, @@ -848,6 +850,8 @@ else: protocol: Protocol = IPPROTO_TCP): TAsyncFD = result = newRawSocket(domain, typ, protocol).TAsyncFD result.SocketHandle.setBlocking(false) + when defined(macosx): + result.SocketHandle.setSockOptInt(SOL_SOCKET, SO_NOSIGPIPE, 1) register(result) proc closeSocket*(sock: TAsyncFD) = @@ -959,7 +963,6 @@ else: result = true let res = recv(sock.SocketHandle, addr readBuffer[0], size.cint, flags.toOSFlags()) - #echo("recv cb res: ", res) if res < 0: let lastError = osLastError() if lastError.int32 notin {EINTR, EWOULDBLOCK, EAGAIN}: @@ -1273,7 +1276,7 @@ proc processBody(node, retFutureSym: NimNode, else: discard for i in 0 .. <result.len: - result[i] = processBody(result[i], retFutureSym, subTypeIsVoid, tryStmt) + result[i] = processBody(result[i], retFutureSym, subTypeIsVoid, nil) proc getName(node: NimNode): string {.compileTime.} = case node.kind @@ -1378,8 +1381,8 @@ macro async*(prc: stmt): stmt {.immediate.} = result[6] = outerProcBody #echo(treeRepr(result)) - if prc[0].getName == "test3": - echo(toStrLit(result)) + #if prc[0].getName == "test": + # echo(toStrLit(result)) proc recvLine*(socket: TAsyncFD): Future[string] {.async.} = ## Reads a line of data from ``socket``. Returned future will complete once diff --git a/lib/pure/asyncftpclient.nim b/lib/pure/asyncftpclient.nim index 8558ad10d..daf69d59f 100644 --- a/lib/pure/asyncftpclient.nim +++ b/lib/pure/asyncftpclient.nim @@ -61,8 +61,8 @@ proc pasv(ftp: AsyncFtpClient) {.async.} = assertReply(pasvMsg, "227") var betweenParens = captureBetween(pasvMsg.string, '(', ')') var nums = betweenParens.split(',') - var ip = nums[0.. -3] - var port = nums[-2.. -1] + var ip = nums[0.. ^3] + var port = nums[^2.. ^1] var properPort = port[0].parseInt()*256+port[1].parseInt() await ftp.dsock.connect(ip.join("."), Port(properPort.toU16)) ftp.dsockConnected = true @@ -300,7 +300,7 @@ proc newAsyncFtpClient*(address: string, port = Port(21), result.dsockConnected = false result.csock = newAsyncSocket() -when isMainModule: +when not defined(testing) and isMainModule: var ftp = newAsyncFtpClient("example.com", user = "test", pass = "test") proc main(ftp: AsyncFtpClient) {.async.} = await ftp.connect() diff --git a/lib/pure/asynchttpserver.nim b/lib/pure/asynchttpserver.nim index 52de9531e..f7a2b693f 100644 --- a/lib/pure/asynchttpserver.nim +++ b/lib/pure/asynchttpserver.nim @@ -263,7 +263,7 @@ proc close*(server: AsyncHttpServer) = ## Terminates the async http server instance. server.socket.close() -when isMainModule: +when not defined(testing) and isMainModule: proc main = var server = newAsyncHttpServer() proc cb(req: Request) {.async.} = diff --git a/lib/pure/asyncio.nim b/lib/pure/asyncio.nim index 6a7cbe396..6ae2c608b 100644 --- a/lib/pure/asyncio.nim +++ b/lib/pure/asyncio.nim @@ -18,8 +18,8 @@ import sockets, os ## This module implements an asynchronous event loop together with asynchronous ## sockets which use this event loop. ## It is akin to Python's asyncore module. Many modules that use sockets -## have an implementation for this module, those modules should all have a -## ``register`` function which you should use to add the desired objects to a +## have an implementation for this module, those modules should all have a +## ``register`` function which you should use to add the desired objects to a ## dispatcher which you created so ## that you can receive the events associated with that module's object. ## @@ -27,19 +27,19 @@ import sockets, os ## function in a while loop. ## ## **Note:** Most modules have tasks which need to be ran regularly, this is -## why you should not call ``poll`` with a infinite timeout, or even a +## why you should not call ``poll`` with a infinite timeout, or even a ## very long one. In most cases the default timeout is fine. ## ## **Note:** This module currently only supports select(), this is limited by ## FD_SETSIZE, which is usually 1024. So you may only be able to use 1024 ## sockets at a time. -## +## ## Most (if not all) modules that use asyncio provide a userArg which is passed ## on with the events. The type that you set userArg to must be inheriting from ## ``RootObj``! ## -## **Note:** If you want to provide async ability to your module please do not -## use the ``Delegate`` object, instead use ``AsyncSocket``. It is possible +## **Note:** If you want to provide async ability to your module please do not +## use the ``Delegate`` object, instead use ``AsyncSocket``. It is possible ## that in the future this type's fields will not be exported therefore breaking ## your code. ## @@ -59,11 +59,11 @@ import sockets, os ## socket which will give you the client which is connecting. You should then ## set any events that you want to use on that client and add it to your dispatcher ## using the ``register`` procedure. -## +## ## An example ``handleAccept`` follows: -## +## ## .. code-block:: nim -## +## ## var disp = newDispatcher() ## ... ## proc handleAccept(s: AsyncSocket) = @@ -74,7 +74,7 @@ import sockets, os ## client.handleRead = ... ## disp.register(client) ## ... -## +## ## For client sockets you should only be interested in the ``handleRead`` and ## ``handleConnect`` events. The former gets called whenever the socket has ## received messages and can be read from and the latter gets called whenever @@ -83,14 +83,14 @@ import sockets, os ## ## Getting a blocking client from an AsyncSocket ## ============================================= -## +## ## If you need a asynchronous server socket but you wish to process the clients ## synchronously then you can use the ``getSocket`` converter to get ## a ``Socket`` from the ``AsyncSocket`` object, this can then be combined ## with ``accept`` like so: ## ## .. code-block:: nim -## +## ## proc handleAccept(s: AsyncSocket) = ## var client: Socket ## getSocket(s).accept(client) @@ -113,11 +113,11 @@ type handleWrite*: proc (h: RootRef) {.nimcall, gcsafe.} handleError*: proc (h: RootRef) {.nimcall, gcsafe.} hasDataBuffered*: proc (h: RootRef): bool {.nimcall, gcsafe.} - + open*: bool task*: proc (h: RootRef) {.nimcall, gcsafe.} mode*: FileMode - + Delegate* = ref DelegateObj Dispatcher* = ref DispatcherObj @@ -144,7 +144,7 @@ type deleg: Delegate SocketStatus* = enum - SockIdle, SockConnecting, SockConnected, SockListening, SockClosed, + SockIdle, SockConnecting, SockConnected, SockListening, SockClosed, SockUDPBound {.deprecated: [TDelegate: DelegateObj, PDelegate: Delegate, @@ -176,8 +176,8 @@ proc newAsyncSocket(): AsyncSocket = result.lineBuffer = "".TaintedString result.sendBuffer = "" -proc asyncSocket*(domain: Domain = AF_INET, typ: SockType = SOCK_STREAM, - protocol: Protocol = IPPROTO_TCP, +proc asyncSocket*(domain: Domain = AF_INET, typ: SockType = SOCK_STREAM, + protocol: Protocol = IPPROTO_TCP, buffered = true): AsyncSocket = ## Initialises an AsyncSocket object. If a socket cannot be initialised ## EOS is raised. @@ -236,7 +236,7 @@ proc asyncSockHandleWrite(h: RootRef) = if AsyncSocket(h).socket.isSSL and not AsyncSocket(h).socket.gotHandshake: return - + if AsyncSocket(h).info == SockConnecting: AsyncSocket(h).handleConnect(AsyncSocket(h)) AsyncSocket(h).info = SockConnected @@ -256,10 +256,10 @@ proc asyncSockHandleWrite(h: RootRef) = # do nothing instead. discard elif bytesSent != sock.sendBuffer.len: - sock.sendBuffer = sock.sendBuffer[bytesSent .. -1] + sock.sendBuffer = sock.sendBuffer[bytesSent .. ^1] elif bytesSent == sock.sendBuffer.len: sock.sendBuffer = "" - + if AsyncSocket(h).handleWrite != nil: AsyncSocket(h).handleWrite(AsyncSocket(h)) except OSError: @@ -284,7 +284,7 @@ when defined(ssl): else: # handshake will set socket's ``sslNoHandshake`` field. discard AsyncSocket(h).socket.handshake() - + proc asyncSockTask(h: RootRef) = when defined(ssl): @@ -377,9 +377,9 @@ proc acceptAddr*(server: AsyncSocket, client: var AsyncSocket, if c == invalidSocket: raiseSocketError(server.socket) c.setBlocking(false) # TODO: Needs to be tested. - + # deleg.open is set in ``toDelegate``. - + client.socket = c client.lineBuffer = "".TaintedString client.sendBuffer = "" @@ -393,7 +393,7 @@ proc accept*(server: AsyncSocket, client: var AsyncSocket) = proc acceptAddr*(server: AsyncSocket): tuple[sock: AsyncSocket, address: string] {.deprecated.} = ## Equivalent to ``sockets.acceptAddr``. - ## + ## ## **Deprecated since version 0.9.0:** Please use the function above. var client = newAsyncSocket() var address: string = "" @@ -441,17 +441,17 @@ proc isConnected*(s: AsyncSocket): bool = ## Determines whether ``s`` is connected. return s.info == SockConnected proc isListening*(s: AsyncSocket): bool = - ## Determines whether ``s`` is listening for incoming connections. + ## Determines whether ``s`` is listening for incoming connections. return s.info == SockListening proc isConnecting*(s: AsyncSocket): bool = - ## Determines whether ``s`` is connecting. + ## Determines whether ``s`` is connecting. return s.info == SockConnecting proc isClosed*(s: AsyncSocket): bool = ## Determines whether ``s`` has been closed. return s.info == SockClosed proc isSendDataBuffered*(s: AsyncSocket): bool = ## Determines whether ``s`` has data waiting to be sent, i.e. whether this - ## socket's sendBuffer contains data. + ## socket's sendBuffer contains data. return s.sendBuffer.len != 0 proc setHandleWrite*(s: AsyncSocket, @@ -550,7 +550,7 @@ proc send*(sock: AsyncSocket, data: string) = sock.sendBuffer.add(data) sock.deleg.mode = fmReadWrite elif bytesSent != data.len: - sock.sendBuffer.add(data[bytesSent .. -1]) + sock.sendBuffer.add(data[bytesSent .. ^1]) sock.deleg.mode = fmReadWrite proc timeValFromMilliseconds(timeout = 500): Timeval = @@ -561,10 +561,10 @@ proc timeValFromMilliseconds(timeout = 500): Timeval = proc createFdSet(fd: var TFdSet, s: seq[Delegate], m: var int) = FD_ZERO(fd) - for i in items(s): + for i in items(s): m = max(m, int(i.fd)) FD_SET(i.fd, fd) - + proc pruneSocketSet(s: var seq[Delegate], fd: var TFdSet) = var i = 0 var L = s.len @@ -576,16 +576,16 @@ proc pruneSocketSet(s: var seq[Delegate], fd: var TFdSet) = inc(i) setLen(s, L) -proc select(readfds, writefds, exceptfds: var seq[Delegate], +proc select(readfds, writefds, exceptfds: var seq[Delegate], timeout = 500): int = var tv {.noInit.}: Timeval = timeValFromMilliseconds(timeout) - + var rd, wr, ex: TFdSet var m = 0 createFdSet(rd, readfds, m) createFdSet(wr, writefds, m) createFdSet(ex, exceptfds, m) - + if timeout != -1: result = int(select(cint(m+1), addr(rd), addr(wr), addr(ex), addr(tv))) else: @@ -599,7 +599,7 @@ proc poll*(d: Dispatcher, timeout: int = 500): bool = ## This function checks for events on all the delegates in the `PDispatcher`. ## It then proceeds to call the correct event handler. ## - ## This function returns ``True`` if there are file descriptors that are still + ## This function returns ``True`` if there are file descriptors that are still ## open, otherwise ``False``. File descriptors that have been ## closed are immediately removed from the dispatcher automatically. ## @@ -611,7 +611,7 @@ proc poll*(d: Dispatcher, timeout: int = 500): bool = var readDg, writeDg, errorDg: seq[Delegate] = @[] var len = d.delegates.len var dc = 0 - + while dc < len: let deleg = d.delegates[dc] if (deleg.mode != fmWrite or deleg.mode != fmAppend) and deleg.open: @@ -625,20 +625,20 @@ proc poll*(d: Dispatcher, timeout: int = 500): bool = # File/socket has been closed. Remove it from dispatcher. d.delegates[dc] = d.delegates[len-1] dec len - + d.delegates.setLen(len) - + var hasDataBufferedCount = 0 for d in d.delegates: if d.hasDataBuffered(d.deleVal): hasDataBufferedCount.inc() d.handleRead(d.deleVal) if hasDataBufferedCount > 0: return true - + if readDg.len() == 0 and writeDg.len() == 0: ## TODO: Perhaps this shouldn't return if errorDg has something? return false - + if select(readDg, writeDg, errorDg, timeout) != 0: for i in 0..len(d.delegates)-1: if i > len(d.delegates)-1: break # One delegate might've been removed. @@ -651,7 +651,7 @@ proc poll*(d: Dispatcher, timeout: int = 500): bool = deleg.handleWrite(deleg.deleVal) if deleg notin errorDg: deleg.handleError(deleg.deleVal) - + # Execute tasks for i in items(d.delegates): i.task(i.deleVal) @@ -660,11 +660,11 @@ proc len*(disp: Dispatcher): int = ## Retrieves the amount of delegates in ``disp``. return disp.delegates.len -when isMainModule: +when not defined(testing) and isMainModule: proc testConnect(s: AsyncSocket, no: int) = echo("Connected! " & $no) - + proc testRead(s: AsyncSocket, no: int) = echo("Reading! " & $no) var data = "" @@ -682,31 +682,31 @@ when isMainModule: var address = "" s.acceptAddr(client, address) echo("Accepted ", address) - client.handleRead = + client.handleRead = proc (s: AsyncSocket) = testRead(s, 2) disp.register(client) proc main = var d = newDispatcher() - + var s = asyncSocket() s.connect("amber.tenthbit.net", Port(6667)) - s.handleConnect = + s.handleConnect = proc (s: AsyncSocket) = testConnect(s, 1) - s.handleRead = + s.handleRead = proc (s: AsyncSocket) = testRead(s, 1) d.register(s) - + var server = asyncSocket() server.handleAccept = - proc (s: AsyncSocket) = + proc (s: AsyncSocket) = testAccept(s, d, 78) server.bindAddr(Port(5555)) server.listen() d.register(server) - + while d.poll(-1): discard main() diff --git a/lib/pure/asyncnet.nim b/lib/pure/asyncnet.nim index fa67b212a..7d23ad4b7 100644 --- a/lib/pure/asyncnet.nim +++ b/lib/pure/asyncnet.nim @@ -605,7 +605,7 @@ proc isClosed*(socket: AsyncSocket): bool = ## Determines whether the socket has been closed. return socket.closed -when isMainModule: +when not defined(testing) and isMainModule: type TestCases = enum HighClient, LowClient, LowServer diff --git a/lib/pure/collections/LockFreeHash.nim b/lib/pure/collections/LockFreeHash.nim index c3954468a..0df97c685 100644 --- a/lib/pure/collections/LockFreeHash.nim +++ b/lib/pure/collections/LockFreeHash.nim @@ -525,7 +525,7 @@ proc get*[K,V](table: var PConcTable[K,V], key: var K): V = #Tests ---------------------------- -when isMainModule: +when not defined(testing) and isMainModule: import locks, times, mersenne const diff --git a/lib/pure/collections/critbits.nim b/lib/pure/collections/critbits.nim index 3d10e39aa..7e3f23851 100644 --- a/lib/pure/collections/critbits.nim +++ b/lib/pure/collections/critbits.nim @@ -286,18 +286,19 @@ proc `$`*[T](c: CritBitTree[T]): string = result.add("}") when isMainModule: + import sequtils + var r: CritBitTree[void] r.incl "abc" r.incl "xyz" r.incl "def" r.incl "definition" r.incl "prefix" + doAssert r.contains"def" - #r.del "def" - for w in r.items: - echo w - - for w in r.itemsWithPrefix("de"): - echo w + r.excl "def" + + assert toSeq(r.items) == @["abc", "definition", "prefix", "xyz"] + assert toSeq(r.itemsWithPrefix("de")) == @["definition"] diff --git a/lib/pure/collections/intsets.nim b/lib/pure/collections/intsets.nim index 7520e6e46..25f6616a6 100644 --- a/lib/pure/collections/intsets.nim +++ b/lib/pure/collections/intsets.nim @@ -14,12 +14,12 @@ ## copy; use ``assign`` to get a deep copy. import - os, hashes, math + hashes, math type BitScalar = int -const +const InitIntSetSize = 8 # must be a power of two! TrunkShift = 9 BitsPerTrunk = 1 shl TrunkShift # needs to be a power of 2 and @@ -31,11 +31,11 @@ const type PTrunk = ref TTrunk - TTrunk {.final.} = object + TTrunk {.final.} = object next: PTrunk # all nodes are connected with this pointer key: int # start address at bit 0 bits: array[0..IntsPerTrunk - 1, BitScalar] # a bit vector - + TTrunkSeq = seq[PTrunk] IntSet* = object ## an efficient set of 'int' implemented as a sparse bit set counter, max: int @@ -44,42 +44,42 @@ type {.deprecated: [TIntSet: IntSet].} -proc mustRehash(length, counter: int): bool {.inline.} = +proc mustRehash(length, counter: int): bool {.inline.} = assert(length > counter) result = (length * 2 < counter * 3) or (length - counter < 4) -proc nextTry(h, maxHash: THash): THash {.inline.} = - result = ((5 * h) + 1) and maxHash +proc nextTry(h, maxHash: THash): THash {.inline.} = + result = ((5 * h) + 1) and maxHash -proc intSetGet(t: IntSet, key: int): PTrunk = +proc intSetGet(t: IntSet, key: int): PTrunk = var h = key and t.max - while t.data[h] != nil: - if t.data[h].key == key: + while t.data[h] != nil: + if t.data[h].key == key: return t.data[h] h = nextTry(h, t.max) result = nil -proc intSetRawInsert(t: IntSet, data: var TTrunkSeq, desc: PTrunk) = +proc intSetRawInsert(t: IntSet, data: var TTrunkSeq, desc: PTrunk) = var h = desc.key and t.max - while data[h] != nil: + while data[h] != nil: assert(data[h] != desc) h = nextTry(h, t.max) assert(data[h] == nil) data[h] = desc -proc intSetEnlarge(t: var IntSet) = +proc intSetEnlarge(t: var IntSet) = var n: TTrunkSeq var oldMax = t.max t.max = ((t.max + 1) * 2) - 1 newSeq(n, t.max + 1) - for i in countup(0, oldMax): + for i in countup(0, oldMax): if t.data[i] != nil: intSetRawInsert(t, n, t.data[i]) swap(t.data, n) -proc intSetPut(t: var IntSet, key: int): PTrunk = +proc intSetPut(t: var IntSet, key: int): PTrunk = var h = key and t.max - while t.data[h] != nil: - if t.data[h].key == key: + while t.data[h] != nil: + if t.data[h].key == key: return t.data[h] h = nextTry(h, t.max) if mustRehash(t.max + 1, t.counter): intSetEnlarge(t) @@ -94,43 +94,43 @@ proc intSetPut(t: var IntSet, key: int): PTrunk = t.data[h] = result proc contains*(s: IntSet, key: int): bool = - ## returns true iff `key` is in `s`. + ## returns true iff `key` is in `s`. var t = intSetGet(s, `shr`(key, TrunkShift)) - if t != nil: + if t != nil: var u = key and TrunkMask result = (t.bits[`shr`(u, IntShift)] and `shl`(1, u and IntMask)) != 0 - else: + else: result = false - -proc incl*(s: var IntSet, key: int) = + +proc incl*(s: var IntSet, key: int) = ## includes an element `key` in `s`. var t = intSetPut(s, `shr`(key, TrunkShift)) var u = key and TrunkMask t.bits[`shr`(u, IntShift)] = t.bits[`shr`(u, IntShift)] or `shl`(1, u and IntMask) -proc excl*(s: var IntSet, key: int) = +proc excl*(s: var IntSet, key: int) = ## excludes `key` from the set `s`. var t = intSetGet(s, `shr`(key, TrunkShift)) - if t != nil: + if t != nil: var u = key and TrunkMask t.bits[`shr`(u, IntShift)] = t.bits[`shr`(u, IntShift)] and not `shl`(1, u and IntMask) -proc containsOrIncl*(s: var IntSet, key: int): bool = +proc containsOrIncl*(s: var IntSet, key: int): bool = ## returns true if `s` contains `key`, otherwise `key` is included in `s` ## and false is returned. var t = intSetGet(s, `shr`(key, TrunkShift)) - if t != nil: + if t != nil: var u = key and TrunkMask result = (t.bits[`shr`(u, IntShift)] and `shl`(1, u and IntMask)) != 0 - if not result: + if not result: t.bits[`shr`(u, IntShift)] = t.bits[`shr`(u, IntShift)] or `shl`(1, u and IntMask) - else: + else: incl(s, key) result = false - + proc initIntSet*: IntSet = ## creates a new int set that is empty. newSeq(result.data, InitIntSetSize) @@ -140,14 +140,14 @@ proc initIntSet*: IntSet = proc assign*(dest: var IntSet, src: IntSet) = ## copies `src` to `dest`. `dest` does not need to be initialized by - ## `initIntSet`. + ## `initIntSet`. dest.counter = src.counter dest.max = src.max newSeq(dest.data, src.data.len) - + var it = src.head while it != nil: - + var h = it.key and dest.max while dest.data[h] != nil: h = nextTry(h, dest.max) assert(dest.data[h] == nil) @@ -168,7 +168,7 @@ iterator items*(s: IntSet): int {.inline.} = while r != nil: var i = 0 while i <= high(r.bits): - var w = r.bits[i] + var w = r.bits[i] # taking a copy of r.bits[i] here is correct, because # modifying operations are not allowed during traversation var j = 0 @@ -198,14 +198,21 @@ proc empty*(s: IntSet): bool {.inline, deprecated.} = result = s.counter == 0 when isMainModule: + import sequtils, algorithm + var x = initIntSet() x.incl(1) x.incl(2) x.incl(7) x.incl(1056) - for e in items(x): echo e - var y: TIntSet + var xs = toSeq(items(x)) + xs.sort(cmp[int]) + assert xs == @[1, 2, 7, 1056] + + var y: IntSet assign(y, x) - for e in items(y): echo e + var ys = toSeq(items(y)) + ys.sort(cmp[int]) + assert ys == @[1, 2, 7, 1056] diff --git a/lib/pure/collections/sequtils.nim b/lib/pure/collections/sequtils.nim index edb904cc6..e9cd2cb3c 100644 --- a/lib/pure/collections/sequtils.nim +++ b/lib/pure/collections/sequtils.nim @@ -81,7 +81,7 @@ proc deduplicate*[T](seq1: seq[T]): seq[T] = if not result.contains(itm): result.add(itm) {.deprecated: [distnct: deduplicate].} - + proc zip*[S, T](seq1: seq[S], seq2: seq[T]): seq[tuple[a: S, b: T]] = ## Returns a new sequence with a combination of the two input sequences. ## @@ -181,7 +181,7 @@ iterator filter*[T](seq1: seq[T], pred: proc(item: T): bool {.closure.}): T = ## for n in filter(numbers, proc (x: int): bool = x mod 2 == 0): ## echo($n) ## # echoes 4, 8, 4 in separate lines - for i in countup(0, len(seq1) -1): + for i in countup(0, len(seq1)-1): var item = seq1[i] if pred(item): yield seq1[i] @@ -228,7 +228,7 @@ proc delete*[T](s: var seq[T], first=0, last=0) = ## var dest = @[1,1,1,2,2,2,2,2,2,1,1,1,1,1] ## dest.delete(3, 8) ## assert outcome == dest - + var i = first var j = last+1 var newLen = len(s)-j+i @@ -246,12 +246,12 @@ proc insert*[T](dest: var seq[T], src: openArray[T], pos=0) = ## ##.. code-block:: ## var dest = @[1,1,1,1,1,1,1,1] - ## let + ## let ## src = @[2,2,2,2,2,2] ## outcome = @[1,1,1,2,2,2,2,2,2,1,1,1,1,1] ## dest.insert(src, 3) ## assert dest == outcome - + var j = len(dest) - 1 var i = len(dest) + len(src) - 1 dest.setLen(i + 1) @@ -492,9 +492,8 @@ when isMainModule: block: # filter iterator test let numbers = @[1, 4, 5, 8, 9, 7, 4] - for n in filter(numbers, proc (x: int): bool = x mod 2 == 0): - echo($n) - # echoes 4, 8, 4 in separate lines + assert toSeq(filter(numbers, proc (x: int): bool = x mod 2 == 0)) == + @[4, 8, 4] block: # keepIf test var floats = @[13.0, 12.5, 5.8, 2.0, 6.1, 9.9, 10.1] @@ -553,12 +552,12 @@ when isMainModule: var dest = @[1,1,1,2,2,2,2,2,2,1,1,1,1,1] dest.delete(3, 8) assert outcome == dest, """\ - Deleting range 3-9 from [1,1,1,2,2,2,2,2,2,1,1,1,1,1] + Deleting range 3-9 from [1,1,1,2,2,2,2,2,2,1,1,1,1,1] is [1,1,1,1,1,1,1,1]""" block: # insert tests var dest = @[1,1,1,1,1,1,1,1] - let + let src = @[2,2,2,2,2,2] outcome = @[1,1,1,2,2,2,2,2,2,1,1,1,1,1] dest.insert(src, 3) @@ -610,10 +609,11 @@ when isMainModule: let a = @[1, 2, 3] b: seq[int] = @[] - + doAssert a.repeat(3) == @[1, 2, 3, 1, 2, 3, 1, 2, 3] doAssert a.repeat(0) == @[] #doAssert a.repeat(-1) == @[] # will not compile! doAssert b.repeat(3) == @[] - echo "Finished doc tests" + when not defined(testing): + echo "Finished doc tests" diff --git a/lib/pure/collections/sets.nim b/lib/pure/collections/sets.nim index 4a20d00a4..280e0eeba 100644 --- a/lib/pure/collections/sets.nim +++ b/lib/pure/collections/sets.nim @@ -114,7 +114,7 @@ proc mustRehash(length, counter: int): bool {.inline.} = assert(length > counter) result = (length * 2 < counter * 3) or (length - counter < 4) -proc rightSize*(count: int): int {.inline.} = +proc rightSize*(count: Natural): int {.inline.} = ## Return the value of `initialSize` to support `count` items. ## ## If more items are expected to be added, simply add that @@ -798,177 +798,179 @@ proc `==`*[A](s, t: OrderedSet[A]): bool = g = nxg result = compared == s.counter -proc testModule() = - ## Internal micro test to validate docstrings and such. - block isValidTest: - var options: HashSet[string] - proc savePreferences(options: HashSet[string]) = - assert options.isValid, "Pass an initialized set!" - options = initSet[string]() - options.savePreferences - - block lenTest: - var values: HashSet[int] - assert(not values.isValid) - assert values.len == 0 - assert values.card == 0 - - block setIterator: - type pair = tuple[a, b: int] - var a, b = initSet[pair]() - a.incl((2, 3)) - a.incl((3, 2)) - a.incl((2, 3)) - for x, y in a.items: - b.incl((x - 2, y + 1)) - assert a.len == b.card - assert a.len == 2 - #echo b - - block setContains: - var values = initSet[int]() - assert(not values.contains(2)) - values.incl(2) - assert values.contains(2) - values.excl(2) - assert(not values.contains(2)) - - values.incl(4) - var others = toSet([6, 7]) - values.incl(others) - assert values.len == 3 - - values.init - assert values.containsOrIncl(2) == false - assert values.containsOrIncl(2) == true - var - a = toSet([1, 2]) - b = toSet([1]) - b.incl(2) - assert a == b - - block exclusions: - var s = toSet([2, 3, 6, 7]) - s.excl(2) - s.excl(2) - assert s.len == 3 - - var - numbers = toSet([1, 2, 3, 4, 5]) - even = toSet([2, 4, 6, 8]) - numbers.excl(even) - #echo numbers - # --> {1, 3, 5} - - block toSeqAndString: - var a = toSet([2, 4, 5]) - var b = initSet[int]() - for x in [2, 4, 5]: b.incl(x) - assert($a == $b) - #echo a - #echo toSet(["no", "esc'aping", "is \" provided"]) - - #block orderedToSeqAndString: - # echo toOrderedSet([2, 4, 5]) - # echo toOrderedSet(["no", "esc'aping", "is \" provided"]) - - block setOperations: - var - a = toSet(["a", "b"]) - b = toSet(["b", "c"]) - c = union(a, b) - assert c == toSet(["a", "b", "c"]) - var d = intersection(a, b) - assert d == toSet(["b"]) - var e = difference(a, b) - assert e == toSet(["a"]) - var f = symmetricDifference(a, b) - assert f == toSet(["a", "c"]) - assert d < a and d < b - assert((a < a) == false) - assert d <= a and d <= b - assert((a <= a)) - # Alias test. - assert a + b == toSet(["a", "b", "c"]) - assert a * b == toSet(["b"]) - assert a - b == toSet(["a"]) - assert a -+- b == toSet(["a", "c"]) - assert disjoint(a, b) == false - assert disjoint(a, b - a) == true - - block mapSet: - var a = toSet([1, 2, 3]) - var b = a.map(proc (x: int): string = $x) - assert b == toSet(["1", "2", "3"]) - - block isValidTest: - var cards: OrderedSet[string] - proc saveTarotCards(cards: OrderedSet[string]) = - assert cards.isValid, "Pass an initialized set!" - cards = initOrderedSet[string]() - cards.saveTarotCards - - block lenTest: - var values: OrderedSet[int] - assert(not values.isValid) - assert values.len == 0 - assert values.card == 0 - - block setIterator: - type pair = tuple[a, b: int] - var a, b = initOrderedSet[pair]() - a.incl((2, 3)) - a.incl((3, 2)) - a.incl((2, 3)) - for x, y in a.items: - b.incl((x - 2, y + 1)) - assert a.len == b.card - assert a.len == 2 - - #block orderedSetIterator: - # var a = initOrderedSet[int]() - # for value in [9, 2, 1, 5, 1, 8, 4, 2]: - # a.incl(value) - # for value in a.items: - # echo "Got ", value - - block setContains: - var values = initOrderedSet[int]() - assert(not values.contains(2)) - values.incl(2) - assert values.contains(2) - - block toSeqAndString: - var a = toOrderedSet([2, 4, 5]) - var b = initOrderedSet[int]() - for x in [2, 4, 5]: b.incl(x) - assert($a == $b) - assert(a == b) # https://github.com/Araq/Nimrod/issues/1413 - - block initBlocks: - var a: OrderedSet[int] - a.init(4) - a.incl(2) - a.init - assert a.len == 0 and a.isValid - a = initOrderedSet[int](4) - a.incl(2) - assert a.len == 1 - - var b: HashSet[int] - b.init(4) - b.incl(2) - b.init - assert b.len == 0 and b.isValid - b = initSet[int](4) - b.incl(2) - assert b.len == 1 - - for i in 0 .. 32: - var s = rightSize(i) - if s <= i or mustRehash(s, i): - echo "performance issue: rightSize() will not elide enlarge() at ", i - - echo "Micro tests run successfully." - -when isMainModule and not defined(release): testModule() +when isMainModule and not defined(release): + proc testModule() = + ## Internal micro test to validate docstrings and such. + block isValidTest: + var options: HashSet[string] + proc savePreferences(options: HashSet[string]) = + assert options.isValid, "Pass an initialized set!" + options = initSet[string]() + options.savePreferences + + block lenTest: + var values: HashSet[int] + assert(not values.isValid) + assert values.len == 0 + assert values.card == 0 + + block setIterator: + type pair = tuple[a, b: int] + var a, b = initSet[pair]() + a.incl((2, 3)) + a.incl((3, 2)) + a.incl((2, 3)) + for x, y in a.items: + b.incl((x - 2, y + 1)) + assert a.len == b.card + assert a.len == 2 + #echo b + + block setContains: + var values = initSet[int]() + assert(not values.contains(2)) + values.incl(2) + assert values.contains(2) + values.excl(2) + assert(not values.contains(2)) + + values.incl(4) + var others = toSet([6, 7]) + values.incl(others) + assert values.len == 3 + + values.init + assert values.containsOrIncl(2) == false + assert values.containsOrIncl(2) == true + var + a = toSet([1, 2]) + b = toSet([1]) + b.incl(2) + assert a == b + + block exclusions: + var s = toSet([2, 3, 6, 7]) + s.excl(2) + s.excl(2) + assert s.len == 3 + + var + numbers = toSet([1, 2, 3, 4, 5]) + even = toSet([2, 4, 6, 8]) + numbers.excl(even) + #echo numbers + # --> {1, 3, 5} + + block toSeqAndString: + var a = toSet([2, 4, 5]) + var b = initSet[int]() + for x in [2, 4, 5]: b.incl(x) + assert($a == $b) + #echo a + #echo toSet(["no", "esc'aping", "is \" provided"]) + + #block orderedToSeqAndString: + # echo toOrderedSet([2, 4, 5]) + # echo toOrderedSet(["no", "esc'aping", "is \" provided"]) + + block setOperations: + var + a = toSet(["a", "b"]) + b = toSet(["b", "c"]) + c = union(a, b) + assert c == toSet(["a", "b", "c"]) + var d = intersection(a, b) + assert d == toSet(["b"]) + var e = difference(a, b) + assert e == toSet(["a"]) + var f = symmetricDifference(a, b) + assert f == toSet(["a", "c"]) + assert d < a and d < b + assert((a < a) == false) + assert d <= a and d <= b + assert((a <= a)) + # Alias test. + assert a + b == toSet(["a", "b", "c"]) + assert a * b == toSet(["b"]) + assert a - b == toSet(["a"]) + assert a -+- b == toSet(["a", "c"]) + assert disjoint(a, b) == false + assert disjoint(a, b - a) == true + + block mapSet: + var a = toSet([1, 2, 3]) + var b = a.map(proc (x: int): string = $x) + assert b == toSet(["1", "2", "3"]) + + block isValidTest: + var cards: OrderedSet[string] + proc saveTarotCards(cards: OrderedSet[string]) = + assert cards.isValid, "Pass an initialized set!" + cards = initOrderedSet[string]() + cards.saveTarotCards + + block lenTest: + var values: OrderedSet[int] + assert(not values.isValid) + assert values.len == 0 + assert values.card == 0 + + block setIterator: + type pair = tuple[a, b: int] + var a, b = initOrderedSet[pair]() + a.incl((2, 3)) + a.incl((3, 2)) + a.incl((2, 3)) + for x, y in a.items: + b.incl((x - 2, y + 1)) + assert a.len == b.card + assert a.len == 2 + + #block orderedSetIterator: + # var a = initOrderedSet[int]() + # for value in [9, 2, 1, 5, 1, 8, 4, 2]: + # a.incl(value) + # for value in a.items: + # echo "Got ", value + + block setContains: + var values = initOrderedSet[int]() + assert(not values.contains(2)) + values.incl(2) + assert values.contains(2) + + block toSeqAndString: + var a = toOrderedSet([2, 4, 5]) + var b = initOrderedSet[int]() + for x in [2, 4, 5]: b.incl(x) + assert($a == $b) + assert(a == b) # https://github.com/Araq/Nimrod/issues/1413 + + block initBlocks: + var a: OrderedSet[int] + a.init(4) + a.incl(2) + a.init + assert a.len == 0 and a.isValid + a = initOrderedSet[int](4) + a.incl(2) + assert a.len == 1 + + var b: HashSet[int] + b.init(4) + b.incl(2) + b.init + assert b.len == 0 and b.isValid + b = initSet[int](4) + b.incl(2) + assert b.len == 1 + + for i in 0 .. 32: + var s = rightSize(i) + if s <= i or mustRehash(s, i): + echo "performance issue: rightSize() will not elide enlarge() at ", i + + when not defined(testing): + echo "Micro tests run successfully." + + testModule() diff --git a/lib/pure/collections/tables.nim b/lib/pure/collections/tables.nim index feb965af3..232e52c89 100644 --- a/lib/pure/collections/tables.nim +++ b/lib/pure/collections/tables.nim @@ -128,7 +128,7 @@ proc mustRehash(length, counter: int): bool {.inline.} = assert(length > counter) result = (length * 2 < counter * 3) or (length - counter < 4) -proc rightSize*(count: int): int {.inline.} = +proc rightSize*(count: Natural): int {.inline.} = ## Return the value of `initialSize` to support `count` items. ## ## If more items are expected to be added, simply add that @@ -192,7 +192,7 @@ proc `[]`*[A, B](t: Table[A, B], key: A): B = proc mget*[A, B](t: var Table[A, B], key: A): var B = ## retrieves the value at ``t[key]``. The value can be modified. - ## If `key` is not in `t`, the ``EInvalidKey`` exception is raised. + ## If `key` is not in `t`, the ``KeyError`` exception is raised. var hc: THash var index = rawGet(t, key, hc) if index >= 0: result = t.data[index].val @@ -314,7 +314,7 @@ proc initTable*[A, B](initialSize=64): Table[A, B] = result.counter = 0 newSeq(result.data, initialSize) -proc toTable*[A, B](pairs: openArray[(A, +proc toTable*[A, B](pairs: openArray[(A, B)]): Table[A, B] = ## creates a new hash table that contains the given `pairs`. result = initTable[A, B](rightSize(pairs.len)) @@ -532,7 +532,7 @@ proc hasKey*[A, B](t: OrderedTable[A, B], key: A): bool = var hc: THash result = rawGet(t, key, hc) >= 0 -proc rawInsert[A, B](t: var OrderedTable[A, B], +proc rawInsert[A, B](t: var OrderedTable[A, B], data: var OrderedKeyValuePairSeq[A, B], key: A, val: B, hc: THash, h: THash) = rawInsertImpl() @@ -584,7 +584,7 @@ proc initOrderedTable*[A, B](initialSize=64): OrderedTable[A, B] = result.last = -1 newSeq(result.data, initialSize) -proc toOrderedTable*[A, B](pairs: openArray[(A, +proc toOrderedTable*[A, B](pairs: openArray[(A, B)]): OrderedTable[A, B] = ## creates a new ordered hash table that contains the given `pairs`. result = initOrderedTable[A, B](rightSize(pairs.len)) @@ -594,7 +594,7 @@ proc `$`*[A, B](t: OrderedTable[A, B]): string = ## The `$` operator for ordered hash tables. dollarImpl() -proc sort*[A, B](t: var OrderedTable[A, B], +proc sort*[A, B](t: var OrderedTable[A, B], cmp: proc (x,y: (A, B)): int) = ## sorts `t` according to `cmp`. This modifies the internal list ## that kept the insertion order, so insertion order is lost after this @@ -617,7 +617,7 @@ proc sort*[A, B](t: var OrderedTable[A, B], while i < insize: inc(psize) q = t.data[q].next - if q < 0: break + if q < 0: break inc(i) qsize = insize while psize > 0 or (qsize > 0 and q >= 0): @@ -625,7 +625,7 @@ proc sort*[A, B](t: var OrderedTable[A, B], e = q; q = t.data[q].next; dec(qsize) elif qsize == 0 or q < 0: e = p; p = t.data[p].next; dec(psize) - elif cmp((t.data[p].key, t.data[p].val), + elif cmp((t.data[p].key, t.data[p].val), (t.data[q].key, t.data[q].val)) <= 0: e = p; p = t.data[p].next; dec(psize) else: @@ -730,7 +730,7 @@ proc `$`*[A, B](t: OrderedTableRef[A, B]): string = ## The `$` operator for ordered hash tables. dollarImpl() -proc sort*[A, B](t: OrderedTableRef[A, B], +proc sort*[A, B](t: OrderedTableRef[A, B], cmp: proc (x,y: (A, B)): int) = ## sorts `t` according to `cmp`. This modifies the internal list ## that kept the insertion order, so insertion order is lost after this @@ -848,7 +848,7 @@ proc `$`*[A](t: CountTable[A]): string = ## The `$` operator for count tables. dollarImpl() -proc inc*[A](t: var CountTable[A], key: A, val = 1) = +proc inc*[A](t: var CountTable[A], key: A, val = 1) = ## increments `t[key]` by `val`. var index = rawGet(t, key) if index >= 0: @@ -965,7 +965,7 @@ proc `$`*[A](t: CountTableRef[A]): string = ## The `$` operator for count tables. dollarImpl() -proc inc*[A](t: CountTableRef[A], key: A, val = 1) = +proc inc*[A](t: CountTableRef[A], key: A, val = 1) = ## increments `t[key]` by `val`. t[].inc(key, val) @@ -984,6 +984,22 @@ proc sort*[A](t: CountTableRef[A]) = ## `t` in the sorted order. t[].sort +proc merge*[A](s: var CountTable[A], t: CountTable[A]) = + ## merges the second table into the first one + for key, value in t: + s.inc(key, value) + +proc merge*[A](s, t: CountTable[A]): CountTable[A] = + ## merges the two tables into a new one + result = initCountTable[A](nextPowerOfTwo(max(s.len, t.len))) + for table in @[s, t]: + for key, value in table: + result.inc(key, value) + +proc merge*[A](s, t: CountTableRef[A]) = + ## merges the second table into the first one + s[].merge(t[]) + when isMainModule: type Person = object @@ -1012,3 +1028,48 @@ when isMainModule: s2[p2] = 45_000 s3[p1] = 30_000 s3[p2] = 45_000 + + var + t1 = initCountTable[string]() + t2 = initCountTable[string]() + t1.inc("foo") + t1.inc("bar", 2) + t1.inc("baz", 3) + t2.inc("foo", 4) + t2.inc("bar") + t2.inc("baz", 11) + merge(t1, t2) + assert(t1["foo"] == 5) + assert(t1["bar"] == 3) + assert(t1["baz"] == 14) + + let + t1r = newCountTable[string]() + t2r = newCountTable[string]() + t1r.inc("foo") + t1r.inc("bar", 2) + t1r.inc("baz", 3) + t2r.inc("foo", 4) + t2r.inc("bar") + t2r.inc("baz", 11) + merge(t1r, t2r) + assert(t1r["foo"] == 5) + assert(t1r["bar"] == 3) + assert(t1r["baz"] == 14) + + var + t1l = initCountTable[string]() + t2l = initCountTable[string]() + t1l.inc("foo") + t1l.inc("bar", 2) + t1l.inc("baz", 3) + t2l.inc("foo", 4) + t2l.inc("bar") + t2l.inc("baz", 11) + let + t1merging = t1l + t2merging = t2l + let merged = merge(t1merging, t2merging) + assert(merged["foo"] == 5) + assert(merged["bar"] == 3) + assert(merged["baz"] == 14) diff --git a/lib/pure/concurrency/cpuload.nim b/lib/pure/concurrency/cpuload.nim index c1796089a..7ce5e01b7 100644 --- a/lib/pure/concurrency/cpuload.nim +++ b/lib/pure/concurrency/cpuload.nim @@ -78,7 +78,7 @@ proc advice*(s: var ThreadPoolState): ThreadPoolAdvice = result = doNothing inc s.calls -when isMainModule: +when not defined(testing) and isMainModule: proc busyLoop() = while true: discard random(80) diff --git a/lib/pure/concurrency/threadpool.nim b/lib/pure/concurrency/threadpool.nim index a8ad30d04..9f1e53fb8 100644 --- a/lib/pure/concurrency/threadpool.nim +++ b/lib/pure/concurrency/threadpool.nim @@ -204,7 +204,7 @@ proc nimFlowVarSignal(fv: FlowVarBase) {.compilerProc.} = inc fv.ai.cv.counter release(fv.ai.cv.L) signal(fv.ai.cv.c) - if fv.usesSemaphore: + if fv.usesSemaphore: signal(fv.cv) proc awaitAndThen*[T](fv: FlowVar[T]; action: proc (x: T) {.closure.}) = diff --git a/lib/pure/cookies.nim b/lib/pure/cookies.nim index 6247efed2..9983c4a04 100644 --- a/lib/pure/cookies.nim +++ b/lib/pure/cookies.nim @@ -56,6 +56,12 @@ proc setCookie*(key, value: string, expires: TimeInfo, when isMainModule: var tim = Time(int(getTime()) + 76 * (60 * 60 * 24)) - echo(setCookie("test", "value", tim.getGMTime())) + let cookie = setCookie("test", "value", tim.getGMTime()) + when not defined(testing): + echo cookie + let start = "Set-Cookie: test=value; Expires=" + assert cookie[0..start.high] == start - echo parseCookies("uid=1; kp=2") + let table = parseCookies("uid=1; kp=2") + assert table["uid"] == "1" + assert table["kp"] == "2" diff --git a/lib/pure/encodings.nim b/lib/pure/encodings.nim index 25c7ad9ef..2a6134615 100644 --- a/lib/pure/encodings.nim +++ b/lib/pure/encodings.nim @@ -451,7 +451,7 @@ proc convert*(s: string, destEncoding = "UTF-8", finally: close(c) -when isMainModule: +when not defined(testing) and isMainModule: let orig = "öäüß" cp1252 = convert(orig, "CP1252", "UTF-8") diff --git a/lib/pure/fenv.nim b/lib/pure/fenv.nim index fd0eab310..f8f115ecc 100644 --- a/lib/pure/fenv.nim +++ b/lib/pure/fenv.nim @@ -104,7 +104,7 @@ proc feupdateenv*(envp: ptr Tfenv): cint {.importc, header: "<fenv.h>".} var FP_RADIX_INTERNAL {. importc: "FLT_RADIX" header: "<float.h>" .} : int -template fpRadix* : int = FLT_RADIX_INTERNAL +template fpRadix* : int = FP_RADIX_INTERNAL ## The (integer) value of the radix used to represent any floating ## point type on the architecture used to build the program. diff --git a/lib/pure/fsmonitor.nim b/lib/pure/fsmonitor.nim index e6919b661..83779eb9c 100644 --- a/lib/pure/fsmonitor.nim +++ b/lib/pure/fsmonitor.nim @@ -198,7 +198,7 @@ proc register*(d: Dispatcher, monitor: FSMonitor, var deleg = toDelegate(monitor) d.register(deleg) -when isMainModule: +when not defined(testing) and isMainModule: proc main = var disp = newDispatcher() var monitor = newMonitor() diff --git a/lib/pure/ftpclient.nim b/lib/pure/ftpclient.nim index 46af1d528..b46f8343c 100644 --- a/lib/pure/ftpclient.nim +++ b/lib/pure/ftpclient.nim @@ -15,8 +15,8 @@ from rawsockets import nil from asyncdispatch import PFuture ## This module **partially** implements an FTP client as specified -## by `RFC 959 <http://tools.ietf.org/html/rfc959>`_. -## +## by `RFC 959 <http://tools.ietf.org/html/rfc959>`_. +## ## This module provides both a synchronous and asynchronous implementation. ## The asynchronous implementation requires you to use the ``asyncFTPClient`` ## function. You are then required to register the ``AsyncFTPClient`` with a @@ -27,7 +27,7 @@ from asyncdispatch import PFuture ## file transfers, calls to functions which use the command socket will block. ## ## Here is some example usage of this module: -## +## ## .. code-block:: Nim ## var ftp = ftpClient("example.org", user = "user", pass = "pass") ## ftp.connect() @@ -51,7 +51,7 @@ type port*: rawsockets.Port else: port*: Port - + jobInProgress*: bool job*: FTPJob[SockType] @@ -91,7 +91,7 @@ type of EvLines: lines*: string ## Lines that have been transferred. of EvRetr, EvStore: ## Retr/Store operation finished. - nil + nil of EvTransferProgress: bytesTotal*: BiggestInt ## Bytes total. bytesFinished*: BiggestInt ## Bytes transferred. @@ -213,7 +213,7 @@ proc handleConnect(s: AsyncSocket, ftp: AsyncFTPClient) = proc handleRead(s: AsyncSocket, ftp: AsyncFTPClient) = assert ftp.jobInProgress assert ftp.job.typ != JStore - # This can never return true, because it shouldn't check for code + # This can never return true, because it shouldn't check for code # 226 from csock. assert(not ftp.job.prc(ftp, true)) @@ -236,13 +236,13 @@ proc pasv[T](ftp: FtpBase[T]) = ftp.disp.register(ftp.dsock) else: {.fatal: "Incorrect socket instantiation".} - + var pasvMsg = ftp.send("PASV").string.strip.TaintedString assertReply(pasvMsg, "227") var betweenParens = captureBetween(pasvMsg.string, '(', ')') var nums = betweenParens.split(',') - var ip = nums[0.. -3] - var port = nums[-2.. -1] + var ip = nums[0.. ^3] + var port = nums[^2.. ^1] var properPort = port[0].parseInt()*256+port[1].parseInt() ftp.dsock.connect(ip.join("."), Port(properPort.toU16)) when T is AsyncSocket: @@ -307,7 +307,7 @@ proc getLines[T](ftp: FtpBase[T], async: bool = false): bool = ftp.job.lines.add(r.string & "\n") else: {.fatal: "Incorrect socket instantiation".} - + if not async: var readSocks: seq[Socket] = @[ftp.csock] # This is only needed here. Asyncio gets this socket... @@ -396,7 +396,7 @@ proc chmod*[T](ftp: FtpBase[T], path: string, proc list*[T](ftp: FtpBase[T], dir: string = "", async = false): string = ## Lists all files in ``dir``. If ``dir`` is ``""``, uses the current ## working directory. If ``async`` is true, this function will return - ## immediately and it will be your job to call asyncio's + ## immediately and it will be your job to call asyncio's ## ``poll`` to progress this operation. ftp.createJob(getLines[T], JRetrText) ftp.pasv() @@ -417,7 +417,7 @@ proc retrText*[T](ftp: FtpBase[T], file: string, async = false): string = ftp.createJob(getLines[T], JRetrText) ftp.pasv() assertReply ftp.send("RETR " & file.normalizePathSep), ["125", "150"] - + if not async: while not ftp.job.prc(ftp, false): discard result = ftp.job.lines @@ -436,7 +436,7 @@ proc getFile[T](ftp: FtpBase[T], async = false): bool = else: bytesRead = ftp.dsock.recvAsync(r, BufferSize) returned = bytesRead != -1 - else: + else: bytesRead = ftp.dsock.recv(r, BufferSize) returned = true let r2 = r.string @@ -458,7 +458,7 @@ proc getFile[T](ftp: FtpBase[T], async = false): bool = proc retrFile*[T](ftp: FtpBase[T], file, dest: string, async = false) = ## Downloads ``file`` and saves it to ``dest``. Usage of this function ## asynchronously is recommended to view the progress of the download. - ## The ``EvRetr`` event is passed to the specified ``handleEvent`` function + ## The ``EvRetr`` event is passed to the specified ``handleEvent`` function ## when the download is finished, and the ``filename`` field will be equal ## to ``file``. ftp.createJob(getFile[T], JRetr) @@ -471,7 +471,7 @@ proc retrFile*[T](ftp: FtpBase[T], file, dest: string, async = false) = var fileSize: BiggestInt if reply.string.captureBetween('(', ')').parseBiggestInt(fileSize) == 0: raise newException(ReplyError, "Reply has no file size.") - + ftp.job.total = fileSize ftp.job.lastProgressReport = epochTime() ftp.job.filename = file.normalizePathSep @@ -488,7 +488,7 @@ proc doUpload[T](ftp: FtpBase[T], async = false): bool = if bytesSent == ftp.job.toStore.len: ftp.job.toStore = "" elif bytesSent != ftp.job.toStore.len and bytesSent != 0: - ftp.job.toStore = ftp.job.toStore[bytesSent .. -1] + ftp.job.toStore = ftp.job.toStore[bytesSent .. ^1] ftp.job.progress.inc(bytesSent) ftp.job.oneSecond.inc(bytesSent) else: @@ -499,12 +499,12 @@ proc doUpload[T](ftp: FtpBase[T], async = false): bool = # File finished uploading. ftp.dsock.close() ftp.dsockConnected = false - + if not async: assertReply ftp.expectReply(), "226" return true return false - + if not async: ftp.dsock.send(s) else: @@ -512,9 +512,9 @@ proc doUpload[T](ftp: FtpBase[T], async = false): bool = if bytesSent == 0: ftp.job.toStore.add(s) elif bytesSent != s.len: - ftp.job.toStore.add(s[bytesSent .. -1]) + ftp.job.toStore.add(s[bytesSent .. ^1]) len = bytesSent - + ftp.job.progress.inc(len) ftp.job.oneSecond.inc(len) @@ -522,8 +522,8 @@ proc store*[T](ftp: FtpBase[T], file, dest: string, async = false) = ## Uploads ``file`` to ``dest`` on the remote FTP server. Usage of this ## function asynchronously is recommended to view the progress of ## the download. - ## The ``EvStore`` event is passed to the specified ``handleEvent`` function - ## when the upload is finished, and the ``filename`` field will be + ## The ``EvStore`` event is passed to the specified ``handleEvent`` function + ## when the upload is finished, and the ``filename`` field will be ## equal to ``file``. ftp.createJob(doUpload[T], JStore) ftp.job.file = open(file) @@ -531,7 +531,7 @@ proc store*[T](ftp: FtpBase[T], file, dest: string, async = false) = ftp.job.lastProgressReport = epochTime() ftp.job.filename = file ftp.pasv() - + assertReply ftp.send("STOR " & dest.normalizePathSep), ["125", "150"] if not async: @@ -564,12 +564,12 @@ proc csockHandleRead(s: AsyncSocket, ftp: AsyncFTPClient) = if ftp.job.progress != ftp.job.total: raise newException(FTPError, "Didn't upload full file.") ftp.deleteJob() - + ftp.handleEvent(ftp, r) proc asyncFTPClient*(address: string, port = Port(21), user, pass = "", - handleEvent: proc (ftp: AsyncFTPClient, ev: FTPEvent) {.closure,gcsafe.} = + handleEvent: proc (ftp: AsyncFTPClient, ev: FTPEvent) {.closure,gcsafe.} = (proc (ftp: AsyncFTPClient, ev: FTPEvent) = discard)): AsyncFTPClient = ## Create a ``AsyncFTPClient`` object. ## @@ -617,7 +617,7 @@ when isMainModule: echo d.len else: assert(false) var ftp = asyncFTPClient("example.com", user = "foo", pass = "bar", handleEvent = hev) - + d.register(ftp) d.len.echo() ftp.connect() @@ -629,7 +629,7 @@ when isMainModule: if not d.poll(): break main() -when isMainModule and false: +when not defined(testing) and isMainModule: var ftp = ftpClient("example.com", user = "foo", pass = "bar") ftp.connect() echo ftp.pwd() diff --git a/lib/pure/gentabs.nim b/lib/pure/gentabs.nim index a6128efc9..8c89a0ac3 100644 --- a/lib/pure/gentabs.nim +++ b/lib/pure/gentabs.nim @@ -186,8 +186,19 @@ when isMainModule: assert( z["first"]["one"] == 1) # retrieve from first inner table assert( z["second"]["red"] == 10) # retrieve from second inner table - for k,v in pairs(z): - echo( "$# ($#) ->" % [k,$len(v)] ) - #for k2,v2 in pairs(v): - # echo( " $# <-> $#" % [k2,$v2] ) - echo() + var output = "" + for k, v in pairs(z): + output.add( "$# ($#) ->\n" % [k,$len(v)] ) + for k2,v2 in pairs(v): + output.add( " $# <-> $#\n" % [k2,$v2] ) + + let expected = unindent """ + first (3) -> + two <-> 2 + three <-> 3 + one <-> 1 + second (2) -> + red <-> 10 + blue <-> 20 + """ + assert output == expected diff --git a/lib/pure/htmlgen.nim b/lib/pure/htmlgen.nim index d712e53f3..e6c15371e 100644 --- a/lib/pure/htmlgen.nim +++ b/lib/pure/htmlgen.nim @@ -483,7 +483,8 @@ macro `var`*(e: expr): expr {.immediate.} = result = xmlCheckedTag(e, "var", commonAttr) when isMainModule: - var nim = "Nim" - echo h1(a(href="http://nim-lang.org", nim)) - echo form(action="test", `accept-charset` = "Content-Type") - + let nim = "Nim" + assert h1(a(href="http://nim-lang.org", nim)) == + """<h1><a href="http://nim-lang.org">Nim</a></h1>""" + assert form(action="test", `accept-charset` = "Content-Type") == + """<form action="test" accept-charset="Content-Type"></form>""" diff --git a/lib/pure/htmlparser.nim b/lib/pure/htmlparser.nim index 5e4eba4e5..9719181b8 100644 --- a/lib/pure/htmlparser.nim +++ b/lib/pure/htmlparser.nim @@ -593,7 +593,7 @@ proc loadHtml*(path: string): XmlNode = var errors: seq[string] = @[] result = loadHtml(path, errors) -when isMainModule: +when not defined(testing) and isMainModule: import os var errors: seq[string] = @[] diff --git a/lib/pure/httpclient.nim b/lib/pure/httpclient.nim index f11101511..9c27ecdab 100644 --- a/lib/pure/httpclient.nim +++ b/lib/pure/httpclient.nim @@ -227,7 +227,7 @@ proc parseResponse(s: Socket, getBody: bool, timeout: int): Response = inc(linei, le) # Status code linei.inc skipWhitespace(line, linei) - result.status = line[linei .. -1] + result.status = line[linei .. ^1] parsedStatus = true else: # Parse headers @@ -238,7 +238,7 @@ proc parseResponse(s: Socket, getBody: bool, timeout: int): Response = if line[linei] != ':': httpError("invalid headers") inc(linei) # Skip : - result.headers[name] = line[linei.. -1].strip() + result.headers[name] = line[linei.. ^1].strip() if not fullyRead: httpError("Connection was closed before full request has been made") if getBody: @@ -442,7 +442,7 @@ proc request*(url: string, httpMethod = httpGET, extraHeaders = "", ## | Extra headers can be specified and must be separated by ``\c\L`` ## | An optional timeout can be specified in miliseconds, if reading from the ## server takes longer than specified an ETimeout exception will be raised. - result = request(url, $httpMethod, extraHeaders, body, sslContext, timeout, + result = request(url, $httpMethod, extraHeaders, body, sslContext, timeout, userAgent, proxy) proc redirection(status: string): bool = @@ -725,7 +725,7 @@ proc parseResponse(client: AsyncHttpClient, inc(linei, le) # Status code linei.inc skipWhitespace(line, linei) - result.status = line[linei .. -1] + result.status = line[linei .. ^1] parsedStatus = true else: # Parse headers @@ -736,7 +736,7 @@ proc parseResponse(client: AsyncHttpClient, if line[linei] != ':': httpError("invalid headers") inc(linei) # Skip : - result.headers[name] = line[linei.. -1].strip() + result.headers[name] = line[linei.. ^1].strip() if not fullyRead: httpError("Connection was closed before full request has been made") if getBody: @@ -819,7 +819,7 @@ proc get*(client: AsyncHttpClient, url: string): Future[Response] {.async.} = result = await client.request(redirectTo, httpGET) lastUrl = redirectTo -when isMainModule: +when not defined(testing) and isMainModule: when true: # Async proc main() {.async.} = diff --git a/lib/pure/httpserver.nim b/lib/pure/httpserver.nim index 5efdbe297..dc76c9228 100644 --- a/lib/pure/httpserver.nim +++ b/lib/pure/httpserver.nim @@ -514,7 +514,7 @@ proc close*(h: PAsyncHTTPServer) = ## Closes the ``PAsyncHTTPServer``. h.asyncSocket.close() -when isMainModule: +when not defined(testing) and isMainModule: var counter = 0 var s: TServer diff --git a/lib/pure/json.nim b/lib/pure/json.nim index c3db5bdf8..5d824d6f8 100644 --- a/lib/pure/json.nim +++ b/lib/pure/json.nim @@ -605,6 +605,49 @@ proc newJArray*(): JsonNode = result.kind = JArray result.elems = @[] +proc getStr*(n: JsonNode, default: string = ""): string = + ## Retrieves the string value of a `JString JsonNode`. + ## + ## Returns ``default`` if ``n`` is not a ``JString``. + if n.kind != JString: return default + else: return n.str + +proc getNum*(n: JsonNode, default: BiggestInt = 0): BiggestInt = + ## Retrieves the int value of a `JInt JsonNode`. + ## + ## Returns ``default`` if ``n`` is not a ``JInt``. + if n.kind != JInt: return default + else: return n.num + +proc getFNum*(n: JsonNode, default: float = 0.0): float = + ## Retrieves the float value of a `JFloat JsonNode`. + ## + ## Returns ``default`` if ``n`` is not a ``JFloat``. + if n.kind != JFloat: return default + else: return n.fnum + +proc getBVal*(n: JsonNode, default: bool = false): bool = + ## Retrieves the bool value of a `JBool JsonNode`. + ## + ## Returns ``default`` if ``n`` is not a ``JBool``. + if n.kind != JBool: return default + else: return n.bval + +proc getFields*(n: JsonNode, + default: seq[tuple[key: string, val: JsonNode]] = @[]): + seq[tuple[key: string, val: JsonNode]] = + ## Retrieves the key, value pairs of a `JObject JsonNode`. + ## + ## Returns ``default`` if ``n`` is not a ``JObject``. + if n.kind != JObject: return default + else: return n.fields + +proc getElems*(n: JsonNode, default: seq[JsonNode] = @[]): seq[JsonNode] = + ## Retrieves the int value of a `JArray JsonNode`. + ## + ## Returns ``default`` if ``n`` is not a ``JArray``. + if n.kind != JArray: return default + else: return n.elems proc `%`*(s: string): JsonNode = ## Generic constructor for JSON data. Creates a new `JString JsonNode`. @@ -765,22 +808,25 @@ proc `[]=`*(obj: JsonNode, key: string, val: JsonNode) = return obj.fields.add((key, val)) -proc `{}`*(node: JsonNode, key: string): JsonNode = - ## Transverses the node and gets the given value. If any of the - ## names does not exist, returns nil +proc `{}`*(node: JsonNode, keys: varargs[string]): JsonNode = + ## Traverses the node and gets the given value. If any of the + ## keys do not exist, returns nil. Also returns nil if one of the + ## intermediate data structures is not an object result = node - if isNil(node): return nil - result = result[key] - -proc `{}=`*(node: JsonNode, names: varargs[string], value: JsonNode) = - ## Transverses the node and tries to set the value at the given location - ## to `value` If any of the names are missing, they are added + for key in keys: + if isNil(result) or result.kind!=JObject: + return nil + result=result[key] + +proc `{}=`*(node: JsonNode, keys: varargs[string], value: JsonNode) = + ## Traverses the node and tries to set the value at the given location + ## to `value` If any of the keys are missing, they are added var node = node - for i in 0..(names.len-2): - if isNil(node[names[i]]): - node[names[i]] = newJObject() - node = node[names[i]] - node[names[names.len-1]] = value + for i in 0..(keys.len-2): + if isNil(node[keys[i]]): + node[keys[i]] = newJObject() + node = node[keys[i]] + node[keys[keys.len-1]] = value proc delete*(obj: JsonNode, key: string) = ## Deletes ``obj[key]`` preserving the order of the other (key, value)-pairs. @@ -1107,19 +1153,22 @@ when false: when isMainModule: #var node = parse("{ \"test\": null }") #echo(node.existsKey("test56")) + var parsed = parseFile("tests/testdata/jsontest.json") var parsed2 = parseFile("tests/testdata/jsontest2.json") - echo(parsed) - echo() - echo(pretty(parsed, 2)) - echo() - echo(parsed["keyÄÖöoßß"]) - echo() - echo(pretty(parsed2)) - try: - echo(parsed["key2"][12123]) - raise newException(ValueError, "That line was expected to fail") - except IndexError: echo() + + when not defined(testing): + echo(parsed) + echo() + echo(pretty(parsed, 2)) + echo() + echo(parsed["keyÄÖöoßß"]) + echo() + echo(pretty(parsed2)) + try: + echo(parsed["key2"][12123]) + raise newException(ValueError, "That line was expected to fail") + except IndexError: echo() let testJson = parseJson"""{ "a": [1, 2, 3, 4], "b": "asd" }""" # nil passthrough @@ -1143,9 +1192,17 @@ when isMainModule: except: assert(false, "EInvalidIndex thrown for valid index") + assert(testJson{"b"}.str=="asd", "Couldn't fetch a singly nested key with {}") + assert(isNil(testJson{"nonexistent"}), "Non-existent keys should return nil") + assert(parsed2{"repository", "description"}.str=="IRC Library for Haskell", "Couldn't fetch via multiply nested key using {}") + assert(isNil(testJson{"a", "b"}), "Indexing through a list should return nil") + assert(isNil(testJson{"a", "b"}), "Indexing through a list should return nil") + assert(testJson{"a"}==parseJson"[1, 2, 3, 4]", "Didn't return a non-JObject when there was one to be found") + assert(isNil(parseJson("[1, 2, 3]"){"foo"}), "Indexing directly into a list should return nil") + # Generator: var j = %* [{"name": "John", "age": 30}, {"name": "Susan", "age": 31}] - assert j == %[%{"name": %"John", "age": %30}, %{"name": %"Susan", "age": %31}] + assert j == %[%{"name": %"John", "age": %30}, %{"name": %"Susan", "age": %31}] var j2 = %* [ @@ -1173,12 +1230,13 @@ when isMainModule: } ] assert j3 == %[%{"name": %"John", "age": %30}, %{"name": %"Susan", "age": %31}] - - discard """ - while true: - var json = stdin.readLine() - var node = parse(json) - echo(node) - echo() - echo() - """ + + when not defined(testing): + discard """ + while true: + var json = stdin.readLine() + var node = parse(json) + echo(node) + echo() + echo() + """ diff --git a/lib/pure/logging.nim b/lib/pure/logging.nim index 16c36e1f0..a2ea53472 100644 --- a/lib/pure/logging.nim +++ b/lib/pure/logging.nim @@ -10,7 +10,7 @@ ## This module implements a simple logger. It has been designed to be as simple ## as possible to avoid bloat, if this library does not fulfill your needs, ## write your own. -## +## ## Format strings support the following variables which must be prefixed with ## the dollar operator (``$``): ## @@ -21,13 +21,13 @@ ## $time Current time ## $app ``os.getAppFilename()`` ## ============ ======================= -## +## ## ## The following example demonstrates logging to three different handlers ## simultaneously: ## ## .. code-block:: nim -## +## ## var L = newConsoleLogger() ## var fL = newFileLogger("test.log", fmtStr = verboseFmtStr) ## var rL = newRollingFileLogger("rolling.log", fmtStr = verboseFmtStr) @@ -64,20 +64,20 @@ const type Logger* = ref object of RootObj ## abstract logger; the base type of all loggers - levelThreshold*: Level ## only messages of level >= levelThreshold + levelThreshold*: Level ## only messages of level >= levelThreshold ## should be processed fmtStr: string ## = defaultFmtStr by default, see substituteLog for $date etc. - + ConsoleLogger* = ref object of Logger ## logger that writes the messages to the ## console - + FileLogger* = ref object of Logger ## logger that writes the messages to a file f: File - - RollingFileLogger* = ref object of FileLogger ## logger that writes the + + RollingFileLogger* = ref object of FileLogger ## logger that writes the ## messages to a file and ## performs log rotation - maxLines: int # maximum number of lines + maxLines: int # maximum number of lines curLine : int baseName: string # initial filename baseMode: FileMode # initial file mode @@ -86,22 +86,22 @@ type {.deprecated: [TLevel: Level, PLogger: Logger, PConsoleLogger: ConsoleLogger, PFileLogger: FileLogger, PRollingFileLogger: RollingFileLogger].} -proc substituteLog(frmt: string): string = +proc substituteLog(frmt: string): string = ## converts $date to the current date ## converts $time to the current time ## converts $app to getAppFilename() - ## converts + ## converts result = newStringOfCap(frmt.len + 20) var i = 0 - while i < frmt.len: - if frmt[i] != '$': + while i < frmt.len: + if frmt[i] != '$': result.add(frmt[i]) inc(i) else: inc(i) var v = "" var app = getAppFilename() - while frmt[i] in IdentChars: + while frmt[i] in IdentChars: v.add(toLower(frmt[i])) inc(i) case v @@ -114,12 +114,12 @@ proc substituteLog(frmt: string): string = method log*(logger: Logger, level: Level, frmt: string, args: varargs[string, `$`]) {. - raises: [Exception], + raises: [Exception], tags: [TimeEffect, WriteIOEffect, ReadIOEffect].} = ## Override this method in custom loggers. Default implementation does ## nothing. discard - + method log*(logger: ConsoleLogger, level: Level, frmt: string, args: varargs[string, `$`]) = ## Logs to the console using ``logger`` only. @@ -127,14 +127,14 @@ method log*(logger: ConsoleLogger, level: Level, writeln(stdout, LevelNames[level], " ", substituteLog(logger.fmtStr), frmt % args) -method log*(logger: FileLogger, level: Level, +method log*(logger: FileLogger, level: Level, frmt: string, args: varargs[string, `$`]) = ## Logs to a file using ``logger`` only. if level >= logger.levelThreshold: writeln(logger.f, LevelNames[level], " ", substituteLog(logger.fmtStr), frmt % args) -proc defaultFilename*(): string = +proc defaultFilename*(): string = ## Returns the default filename for a logger. var (path, name, ext) = splitFile(getAppFilename()) result = changeFileExt(path / name, "log") @@ -145,10 +145,10 @@ proc newConsoleLogger*(levelThreshold = lvlAll, fmtStr = defaultFmtStr): Console result.fmtStr = fmtStr result.levelThreshold = levelThreshold -proc newFileLogger*(filename = defaultFilename(), +proc newFileLogger*(filename = defaultFilename(), mode: FileMode = fmAppend, levelThreshold = lvlAll, - fmtStr = defaultFmtStr): FileLogger = + fmtStr = defaultFmtStr): FileLogger = ## Creates a new file logger. This logger logs to a file. new(result) result.levelThreshold = levelThreshold @@ -170,14 +170,14 @@ proc countFiles(filename: string): int = if kind == pcFile: let llfn = name & ext & ExtSep if path.extractFilename.startsWith(llfn): - let numS = path.extractFilename[llfn.len .. -1] + let numS = path.extractFilename[llfn.len .. ^1] try: let num = parseInt(numS) if num > result: result = num except ValueError: discard -proc newRollingFileLogger*(filename = defaultFilename(), +proc newRollingFileLogger*(filename = defaultFilename(), mode: FileMode = fmReadWrite, levelThreshold = lvlAll, fmtStr = defaultFmtStr, @@ -192,9 +192,9 @@ proc newRollingFileLogger*(filename = defaultFilename(), result.curLine = 0 result.baseName = filename result.baseMode = mode - + result.logFiles = countFiles(filename) - + if mode == fmAppend: # We need to get a line count because we will be appending to the file. result.curLine = countLogLines(result) @@ -206,7 +206,7 @@ proc rotate(logger: RollingFileLogger) = moveFile(dir / (name & ext & srcSuff), dir / (name & ext & ExtSep & $(i+1))) -method log*(logger: RollingFileLogger, level: Level, +method log*(logger: RollingFileLogger, level: Level, frmt: string, args: varargs[string, `$`]) = ## Logs to a file using rolling ``logger`` only. if level >= logger.levelThreshold: @@ -216,7 +216,7 @@ method log*(logger: RollingFileLogger, level: Level, logger.logFiles.inc logger.curLine = 0 logger.f = open(logger.baseName, logger.baseMode) - + writeln(logger.f, LevelNames[level], " ",substituteLog(logger.fmtStr), frmt % args) logger.curLine.inc @@ -226,7 +226,7 @@ var level {.threadvar.}: Level ## global log filter var handlers {.threadvar.}: seq[Logger] ## handlers with their own log levels proc logLoop(level: Level, frmt: string, args: varargs[string, `$`]) = - for logger in items(handlers): + for logger in items(handlers): if level >= logger.levelThreshold: log(logger, level, frmt, args) @@ -235,7 +235,7 @@ template log*(level: Level, frmt: string, args: varargs[string, `$`]) = bind logLoop bind `%` bind logging.level - + if level >= logging.level: logLoop(level, frmt, args) @@ -243,19 +243,19 @@ template debug*(frmt: string, args: varargs[string, `$`]) = ## Logs a debug message to all registered handlers. log(lvlDebug, frmt, args) -template info*(frmt: string, args: varargs[string, `$`]) = +template info*(frmt: string, args: varargs[string, `$`]) = ## Logs an info message to all registered handlers. log(lvlInfo, frmt, args) -template warn*(frmt: string, args: varargs[string, `$`]) = +template warn*(frmt: string, args: varargs[string, `$`]) = ## Logs a warning message to all registered handlers. log(lvlWarn, frmt, args) -template error*(frmt: string, args: varargs[string, `$`]) = +template error*(frmt: string, args: varargs[string, `$`]) = ## Logs an error message to all registered handlers. log(lvlError, frmt, args) - -template fatal*(frmt: string, args: varargs[string, `$`]) = + +template fatal*(frmt: string, args: varargs[string, `$`]) = ## Logs a fatal error message to all registered handlers. log(lvlFatal, frmt, args) @@ -278,7 +278,7 @@ proc getLogFilter*(): Level = # -------------- -when isMainModule: +when not defined(testing) and isMainModule: var L = newConsoleLogger() var fL = newFileLogger("test.log", fmtStr = verboseFmtStr) var rL = newRollingFileLogger("rolling.log", fmtStr = verboseFmtStr) @@ -287,5 +287,5 @@ when isMainModule: addHandler(rL) for i in 0 .. 25: info("hello" & $i, []) - + diff --git a/lib/pure/marshal.nim b/lib/pure/marshal.nim index b63c334ff..bf9e33296 100644 --- a/lib/pure/marshal.nim +++ b/lib/pure/marshal.nim @@ -244,7 +244,7 @@ proc to*[T](data: string): T = var tab = initTable[BiggestInt, pointer]() loadAny(newStringStream(data), toAny(result), tab) -when isMainModule: +when not defined(testing) and isMainModule: template testit(x: expr) = echo($$to[type(x)]($$x)) var x: array[0..4, array[0..4, string]] = [ diff --git a/lib/pure/math.nim b/lib/pure/math.nim index c902af381..daa108460 100644 --- a/lib/pure/math.nim +++ b/lib/pure/math.nim @@ -152,6 +152,7 @@ proc randomize*(seed: int) {.benign.} ## Note: Does nothing for the JavaScript target, ## as JavaScript does not support this. +{.push noSideEffect.} when not defined(JS): proc sqrt*(x: float): float {.importc: "sqrt", header: "<math.h>".} ## computes the square root of `x`. @@ -273,6 +274,8 @@ else: var y = exp(2.0*x) return (y-1.0)/(y+1.0) +{.pop.} + proc `mod`*(x, y: float): float = result = if y == 0.0: x else: x - y * (x/y).floor @@ -369,4 +372,10 @@ when isMainModule and not defined(JS): randomize(seed) for i in 0..SIZE-1: assert buf[i] == random(high(int)), "non deterministic random seeding" - echo "random values equal after reseeding" + + when not defined(testing): + echo "random values equal after reseeding" + + # Check for no side effect annotation + proc mySqrt(num: float): float {.noSideEffect.} = + return sqrt(num) diff --git a/lib/pure/mersenne.nim b/lib/pure/mersenne.nim index a6a781cb8..74112e304 100644 --- a/lib/pure/mersenne.nim +++ b/lib/pure/mersenne.nim @@ -32,7 +32,7 @@ proc getNum*(m: var MersenneTwister): int = return int(y) # Test -when isMainModule: +when not defined(testing) and isMainModule: var mt = newMersenneTwister(2525) for i in 0..99: diff --git a/lib/pure/mimetypes.nim b/lib/pure/mimetypes.nim index a52ba4ebe..642419e64 100644 --- a/lib/pure/mimetypes.nim +++ b/lib/pure/mimetypes.nim @@ -518,5 +518,5 @@ proc register*(mimedb: var MimeDB, ext: string, mimetype: string) = when isMainModule: var m = newMimetypes() - echo m.getMimetype("mp4") - echo m.getExt("text/html") + assert m.getMimetype("mp4") == "video/mp4" + assert m.getExt("text/html") == "html" diff --git a/lib/pure/oids.nim b/lib/pure/oids.nim index 0dc8e3c15..ac90dd16b 100644 --- a/lib/pure/oids.nim +++ b/lib/pure/oids.nim @@ -88,6 +88,6 @@ proc generatedTime*(oid: Oid): Time = bigEndian32(addr(tmp), addr(dummy)) result = Time(tmp) -when isMainModule: +when not defined(testing) and isMainModule: let xo = genOid() echo xo.generatedTime diff --git a/lib/pure/os.nim b/lib/pure/os.nim index 82d6177e1..f53abe81d 100644 --- a/lib/pure/os.nim +++ b/lib/pure/os.nim @@ -1863,16 +1863,21 @@ proc getFileSize*(file: string): BiggestInt {.rtl, extern: "nos$1", close(f) else: raiseOSError(osLastError()) +proc expandTilde*(path: string): string {.tags: [ReadEnvEffect].} + proc findExe*(exe: string): string {.tags: [ReadDirEffect, ReadEnvEffect].} = ## Searches for `exe` in the current working directory and then ## in directories listed in the ``PATH`` environment variable. ## Returns "" if the `exe` cannot be found. On DOS-like platforms, `exe` - ## is added an ``.exe`` file extension if it has no extension. + ## is added the `ExeExt <#ExeExt>`_ file extension if it has none. result = addFileExt(exe, os.ExeExt) if existsFile(result): return var path = string(os.getEnv("PATH")) for candidate in split(path, PathSep): - var x = candidate / result + when defined(windows): + var x = candidate / result + else: + var x = expandTilde(candidate) / result if existsFile(x): return x result = "" diff --git a/lib/pure/osproc.nim b/lib/pure/osproc.nim index cd3700019..dce0673ba 100644 --- a/lib/pure/osproc.nim +++ b/lib/pure/osproc.nim @@ -137,7 +137,7 @@ proc startProcess*(command: string, ## `env` is the environment that will be passed to the process. ## If ``env == nil`` the environment is inherited of ## the parent process. `options` are additional flags that may be passed - ## to `startProcess`. See the documentation of ``TProcessOption`` for the + ## to `startProcess`. See the documentation of ``ProcessOption`` for the ## meaning of these flags. You need to `close` the process when done. ## ## Note that you can't pass any `args` if you use the option @@ -174,7 +174,7 @@ proc terminate*(p: Process) {.rtl, extern: "nosp$1", tags: [].} proc kill*(p: Process) {.rtl, extern: "nosp$1", tags: [].} ## Kill the process `p`. On Posix OSes the procedure sends ``SIGKILL`` to ## the process. On Windows ``kill()`` is simply an alias for ``terminate()``. - + proc running*(p: Process): bool {.rtl, extern: "nosp$1", tags: [].} ## Returns true iff the process `p` is still running. Returns immediately. @@ -666,7 +666,7 @@ elif not defined(useNimRtl): data.workingDir = workingDir - when declared(posix_spawn) and not defined(useFork) and + when declared(posix_spawn) and not defined(useFork) and not defined(useClone) and not defined(linux): pid = startProcessAuxSpawn(data) else: @@ -823,7 +823,7 @@ elif not defined(useNimRtl): discard execvp(data.sysCommand, data.sysArgs) else: when defined(uClibc): - # uClibc environment (OpenWrt included) doesn't have the full execvpe + # uClibc environment (OpenWrt included) doesn't have the full execvpe discard execve(data.sysCommand, data.sysArgs, data.sysEnv) else: discard execvpe(data.sysCommand, data.sysArgs, data.sysEnv) @@ -864,9 +864,9 @@ elif not defined(useNimRtl): raiseOsError(osLastError()) proc kill(p: Process) = - if kill(p.id, SIGKILL) != 0'i32: + if kill(p.id, SIGKILL) != 0'i32: raiseOsError(osLastError()) - + proc waitForExit(p: Process, timeout: int = -1): int = #if waitPid(p.id, p.exitCode, 0) == int(p.id): # ``waitPid`` fails if the process is not running anymore. But then @@ -883,7 +883,7 @@ elif not defined(useNimRtl): var ret = waitpid(p.id, p.exitCode, WNOHANG) var b = ret == int(p.id) if b: result = -1 - if p.exitCode == -3: result = -1 + if not WIFEXITED(p.exitCode): result = -1 else: result = p.exitCode.int shr 8 proc createStream(stream: var Stream, handle: var FileHandle, @@ -907,7 +907,7 @@ elif not defined(useNimRtl): createStream(p.errStream, p.errHandle, fmRead) return p.errStream - proc csystem(cmd: cstring): cint {.nodecl, importc: "system", + proc csystem(cmd: cstring): cint {.nodecl, importc: "system", header: "<stdlib.h>".} proc execCmd(command: string): int = diff --git a/lib/pure/parsecsv.nim b/lib/pure/parsecsv.nim index f4943ed89..117d75cfa 100644 --- a/lib/pure/parsecsv.nim +++ b/lib/pure/parsecsv.nim @@ -166,7 +166,7 @@ proc close*(my: var CsvParser) {.inline.} = ## closes the parser `my` and its associated input stream. lexbase.close(my) -when isMainModule: +when not defined(testing) and isMainModule: import os var s = newFileStream(paramStr(1), fmRead) if s == nil: quit("cannot open the file" & paramStr(1)) diff --git a/lib/pure/parsesql.nim b/lib/pure/parsesql.nim index bb4ede779..91917b1c5 100644 --- a/lib/pure/parsesql.nim +++ b/lib/pure/parsesql.nim @@ -1330,7 +1330,7 @@ proc renderSQL*(n: SqlNode): string = result = "" ra(n, result, 0) -when isMainModule: +when not defined(testing) and isMainModule: echo(renderSQL(parseSQL(newStringStream(""" CREATE TYPE happiness AS ENUM ('happy', 'very happy', 'ecstatic'); CREATE TABLE holidays ( diff --git a/lib/pure/parseutils.nim b/lib/pure/parseutils.nim index eb649a878..c07b713de 100644 --- a/lib/pure/parseutils.nim +++ b/lib/pure/parseutils.nim @@ -323,8 +323,12 @@ iterator interpolatedFragments*(s: string): tuple[kind: InterpolatedKind, i = j when isMainModule: - for k, v in interpolatedFragments("$test{} $this is ${an{ example}} "): - echo "(", k, ", \"", v, "\")" + import sequtils + let input = "$test{} $this is ${an{ example}} " + let expected = @[(ikVar, "test"), (ikStr, "{} "), (ikVar, "this"), + (ikStr, " is "), (ikExpr, "an{ example}"), (ikStr, " ")] + assert toSeq(interpolatedFragments(input)) == expected + var value = 0 discard parseHex("0x38", value) assert value == 56 diff --git a/lib/pure/parsexml.nim b/lib/pure/parsexml.nim index 2663c5b2f..eb792f086 100644 --- a/lib/pure/parsexml.nim +++ b/lib/pure/parsexml.nim @@ -628,7 +628,7 @@ proc next*(my: var XmlParser) = my.kind = xmlError my.state = stateNormal -when isMainModule: +when not defined(testing) and isMainModule: import os var s = newFileStream(paramStr(1), fmRead) if s == nil: quit("cannot open the file" & paramStr(1)) diff --git a/lib/pure/pegs.nim b/lib/pure/pegs.nim index 04c75ecae..39f0bfa95 100644 --- a/lib/pure/pegs.nim +++ b/lib/pure/pegs.nim @@ -744,24 +744,6 @@ template fillMatches(s, caps, c: expr) = else: caps[k] = nil -proc match*(s: string, pattern: Peg, matches: var openArray[string], - start = 0): bool {.nosideEffect, rtl, extern: "npegs$1Capture".} = - ## returns ``true`` if ``s[start..]`` matches the ``pattern`` and - ## the captured substrings in the array ``matches``. If it does not - ## match, nothing is written into ``matches`` and ``false`` is - ## returned. - var c: Captures - c.origStart = start - result = rawMatch(s, pattern, start, c) == len(s) - start - if result: fillMatches(s, matches, c) - -proc match*(s: string, pattern: Peg, - start = 0): bool {.nosideEffect, rtl, extern: "npegs$1".} = - ## returns ``true`` if ``s`` matches the ``pattern`` beginning from ``start``. - var c: Captures - c.origStart = start - result = rawMatch(s, pattern, start, c) == len(s)-start - proc matchLen*(s: string, pattern: Peg, matches: var openArray[string], start = 0): int {.nosideEffect, rtl, extern: "npegs$1Capture".} = ## the same as ``match``, but it returns the length of the match, @@ -783,6 +765,20 @@ proc matchLen*(s: string, pattern: Peg, c.origStart = start result = rawMatch(s, pattern, start, c) +proc match*(s: string, pattern: Peg, matches: var openArray[string], + start = 0): bool {.nosideEffect, rtl, extern: "npegs$1Capture".} = + ## returns ``true`` if ``s[start..]`` matches the ``pattern`` and + ## the captured substrings in the array ``matches``. If it does not + ## match, nothing is written into ``matches`` and ``false`` is + ## returned. + result = matchLen(s, pattern, matches, start) != -1 + +proc match*(s: string, pattern: Peg, + start = 0): bool {.nosideEffect, rtl, extern: "npegs$1".} = + ## returns ``true`` if ``s`` matches the ``pattern`` beginning from ``start``. + result = matchLen(s, pattern, start) != -1 + + proc find*(s: string, pattern: Peg, matches: var openArray[string], start = 0): int {.nosideEffect, rtl, extern: "npegs$1Capture".} = ## returns the starting position of ``pattern`` in ``s`` and the captured @@ -1686,8 +1682,10 @@ when isMainModule: assert "ABC 0232".match(peg"\w+\s+\d+") assert "ABC".match(peg"\d+ / \w+") + var accum: seq[string] = @[] for word in split("00232this02939is39an22example111", peg"\d+"): - writeln(stdout, word) + accum.add(word) + assert(accum == @["this", "is", "an", "example"]) assert matchLen("key", ident) == 3 @@ -1748,8 +1746,10 @@ when isMainModule: else: assert false + accum = @[] for x in findAll("abcdef", peg".", 3): - echo x + accum.add(x) + assert(accum == @["d", "e", "f"]) for x in findAll("abcdef", peg"^{.}", 3): assert x == "d" @@ -1783,3 +1783,9 @@ when isMainModule: if "foo" =~ peg"{'foo'}": assert matches[0] == "foo" else: assert false + + let empty_test = peg"^\d*" + let str = "XYZ" + + assert(str.find(empty_test) == 0) + assert(str.match(empty_test)) diff --git a/lib/pure/rationals.nim b/lib/pure/rationals.nim index 04aa8316a..3b68a2381 100644 --- a/lib/pure/rationals.nim +++ b/lib/pure/rationals.nim @@ -12,6 +12,7 @@ ## a denominator `den`, both of type int. The denominator can not be 0. import math +import hashes type Rational*[T] = object ## a rational number, consisting of a numerator and denominator @@ -32,7 +33,7 @@ proc `$`*[T](x: Rational[T]): string = ## Turn a rational number into a string. result = $x.num & "/" & $x.den -proc toRational*[T](x: SomeInteger): Rational[T] = +proc toRational*[T](x: T): Rational[T] = ## Convert some integer `x` to a rational number. result.num = x result.den = 1 @@ -188,7 +189,7 @@ proc `/=`*[T](x: var Rational[T], y: T) = x.den *= y reduce(x) -proc cmp*(x, y: Rational): int = +proc cmp*(x, y: Rational): int {.procvar.} = ## Compares two rationals. (x - y).num @@ -205,6 +206,17 @@ proc abs*[T](x: Rational[T]): Rational[T] = result.num = abs x.num result.den = abs x.den +proc hash*[T](x: Rational[T]): THash = + ## Computes hash for rational `x` + # reduce first so that hash(x) == hash(y) for x == y + var copy = x + reduce(copy) + + var h: THash = 0 + h = h !& hash(copy.num) + h = h !& hash(copy.den) + result = !$h + when isMainModule: var z = Rational[int](num: 0, den: 1) @@ -242,11 +254,13 @@ when isMainModule: assert( not(o > o) ) assert( cmp(o, o) == 0 ) assert( cmp(z, z) == 0 ) + assert( hash(o) == hash(o) ) assert( a == b ) assert( a >= b ) assert( not(b > a) ) assert( cmp(a, b) == 0 ) + assert( hash(a) == hash(b) ) var x = 1//3 @@ -270,6 +284,6 @@ when isMainModule: y /= 9 assert( y == 13//27 ) - assert toRational[int, int](5) == 5//1 + assert toRational(5) == 5//1 assert abs(toFloat(y) - 0.4814814814814815) < 1.0e-7 assert toInt(z) == 0 diff --git a/lib/pure/rawsockets.nim b/lib/pure/rawsockets.nim index ac348eb1b..a30c23ada 100644 --- a/lib/pure/rawsockets.nim +++ b/lib/pure/rawsockets.nim @@ -39,6 +39,9 @@ export SO_KEEPALIVE, SO_OOBINLINE, SO_REUSEADDR, MSG_PEEK +when defined(macosx): + export SO_NOSIGPIPE + type Port* = distinct uint16 ## port type @@ -428,10 +431,6 @@ proc selectWrite*(writefds: var seq[SocketHandle], pruneSocketSet(writefds, (wr)) -# We ignore signal SIGPIPE on Darwin -when defined(macosx): - signal(SIGPIPE, SIG_IGN) - when defined(Windows): var wsa: WSAData if wsaStartup(0x0101'i16, addr wsa) != 0: raiseOSError(osLastError()) diff --git a/lib/pure/redis.nim b/lib/pure/redis.nim index 9177ddee5..aa2e0f9bd 100644 --- a/lib/pure/redis.nim +++ b/lib/pure/redis.nim @@ -1080,7 +1080,7 @@ proc assertListsIdentical(listA, listB: seq[string]) = assert(item == listB[i]) i = i + 1 -when isMainModule: +when not defined(testing) and isMainModule: when false: var r = open() diff --git a/lib/pure/romans.nim b/lib/pure/romans.nim index 79fb75526..0c182843a 100644 --- a/lib/pure/romans.nim +++ b/lib/pure/romans.nim @@ -44,16 +44,13 @@ proc decimalToRoman*(number: range[1..3_999]): string = ("XC", 90), ("L", 50), ("XL", 40), ("X", 10), ("IX", 9), ("V", 5), ("IV", 4), ("I", 1)] result = "" - var decVal = number + var decVal: int = number for key, val in items(romanComposites): while decVal >= val: dec(decVal, val) result.add(key) when isMainModule: - import math - randomize() - for i in 1 .. 100: - var rnd = 1 + random(3990) - assert rnd == rnd.decimalToRoman.romanToDecimal + for i in 1 .. 3_999: + assert i == i.decimalToRoman.romanToDecimal diff --git a/lib/pure/ropes.nim b/lib/pure/ropes.nim index 4cc64a154..5c7fedfe3 100644 --- a/lib/pure/ropes.nim +++ b/lib/pure/ropes.nim @@ -52,9 +52,9 @@ proc len*(a: Rope): int {.rtl, extern: "nro$1".} = ## the rope's length if a == nil: result = 0 else: result = a.length - + proc newRope(): Rope = new(result) -proc newRope(data: string): Rope = +proc newRope(data: string): Rope = new(result) result.length = len(data) result.data = data @@ -65,18 +65,18 @@ var when countCacheMisses: var misses, hits: int - -proc splay(s: string, tree: Rope, cmpres: var int): Rope = + +proc splay(s: string, tree: Rope, cmpres: var int): Rope = var c: int var t = tree N.left = nil N.right = nil # reset to nil var le = N var r = N - while true: + while true: c = cmp(s, t.data) - if c < 0: - if (t.left != nil) and (s < t.left.data): + if c < 0: + if (t.left != nil) and (s < t.left.data): var y = t.left t.left = y.right y.right = t @@ -85,8 +85,8 @@ proc splay(s: string, tree: Rope, cmpres: var int): Rope = r.left = t r = t t = t.left - elif c > 0: - if (t.right != nil) and (s > t.right.data): + elif c > 0: + if (t.right != nil) and (s > t.right.data): var y = t.right t.right = y.left y.left = t @@ -95,8 +95,8 @@ proc splay(s: string, tree: Rope, cmpres: var int): Rope = le.right = t le = t t = t.right - else: - break + else: + break cmpres = c le.right = t.left r.left = t.right @@ -104,50 +104,50 @@ proc splay(s: string, tree: Rope, cmpres: var int): Rope = t.right = N.left result = t -proc insertInCache(s: string, tree: Rope): Rope = +proc insertInCache(s: string, tree: Rope): Rope = var t = tree - if t == nil: + if t == nil: result = newRope(s) when countCacheMisses: inc(misses) return var cmp: int t = splay(s, t, cmp) - if cmp == 0: + if cmp == 0: # We get here if it's already in the Tree # Don't add it again result = t when countCacheMisses: inc(hits) - else: + else: when countCacheMisses: inc(misses) result = newRope(s) - if cmp < 0: + if cmp < 0: result.left = t.left result.right = t t.left = nil - else: + else: # i > t.item: result.right = t.right result.left = t t.right = nil proc rope*(s: string): Rope {.rtl, extern: "nro$1Str".} = - ## Converts a string to a rope. - if s.len == 0: + ## Converts a string to a rope. + if s.len == 0: result = nil - elif cacheEnabled: + elif cacheEnabled: result = insertInCache(s, cache) cache = result - else: + else: result = newRope(s) - -proc rope*(i: BiggestInt): Rope {.rtl, extern: "nro$1BiggestInt".} = - ## Converts an int to a rope. + +proc rope*(i: BiggestInt): Rope {.rtl, extern: "nro$1BiggestInt".} = + ## Converts an int to a rope. result = rope($i) proc rope*(f: BiggestFloat): Rope {.rtl, extern: "nro$1BiggestFloat".} = - ## Converts a float to a rope. + ## Converts a float to a rope. result = rope($f) - + proc enableCache*() {.rtl, extern: "nro$1".} = ## Enables the caching of leaves. This reduces the memory footprint at ## the cost of runtime efficiency. @@ -160,9 +160,9 @@ proc disableCache*() {.rtl, extern: "nro$1".} = proc `&`*(a, b: Rope): Rope {.rtl, extern: "nroConcRopeRope".} = ## the concatenation operator for ropes. - if a == nil: + if a == nil: result = b - elif b == nil: + elif b == nil: result = a else: result = newRope() @@ -177,16 +177,16 @@ proc `&`*(a, b: Rope): Rope {.rtl, extern: "nroConcRopeRope".} = else: result.left = a result.right = b - -proc `&`*(a: Rope, b: string): Rope {.rtl, extern: "nroConcRopeStr".} = + +proc `&`*(a: Rope, b: string): Rope {.rtl, extern: "nroConcRopeStr".} = ## the concatenation operator for ropes. result = a & rope(b) - -proc `&`*(a: string, b: Rope): Rope {.rtl, extern: "nroConcStrRope".} = + +proc `&`*(a: string, b: Rope): Rope {.rtl, extern: "nroConcStrRope".} = ## the concatenation operator for ropes. result = rope(a) & b - -proc `&`*(a: openArray[Rope]): Rope {.rtl, extern: "nroConcOpenArray".} = + +proc `&`*(a: openArray[Rope]): Rope {.rtl, extern: "nroConcOpenArray".} = ## the concatenation operator for an openarray of ropes. for i in countup(0, high(a)): result = result & a[i] @@ -219,7 +219,7 @@ iterator leaves*(r: Rope): string = ## iterates over any leaf string in the rope `r`. if r != nil: var stack = @[r] - while stack.len > 0: + while stack.len > 0: var it = stack.pop while isConc(it): stack.add(it.right) @@ -227,7 +227,7 @@ iterator leaves*(r: Rope): string = 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): @@ -237,7 +237,7 @@ proc write*(f: File, r: Rope) {.rtl, extern: "nro$1".} = ## writes a rope to a file. for s in leaves(r): write(f, s) -proc `$`*(r: Rope): string {.rtl, extern: "nroToString".}= +proc `$`*(r: Rope): string {.rtl, extern: "nroToString".}= ## converts a rope back to a string. result = newString(r.len) setLen(result, 0) @@ -251,25 +251,25 @@ when false: new(result) result.length = -idx - proc compileFrmt(frmt: string): Rope = + proc compileFrmt(frmt: string): 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) case frmt[i] - of '$': + of '$': add(result, "$") inc(i) - of '#': + of '#': inc(i) add(result, compiledArg(num+1)) 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 frmt[i] notin {'0'..'9'}: break @@ -285,13 +285,13 @@ when false: add(s, compiledArg(j)) else: raise newException(EInvalidValue, "invalid format string") var start = i - while i < length: + while i < length: if frmt[i] != '$': inc(i) - else: break - if i - 1 >= start: + else: break + if i - 1 >= start: add(result, substr(frmt, start, i-1)) - -proc `%`*(frmt: string, args: openArray[Rope]): Rope {. + +proc `%`*(frmt: string, args: openArray[Rope]): Rope {. rtl, extern: "nroFormat".} = ## `%` substitution operator for ropes. Does not support the ``$identifier`` ## nor ``${identifier}`` notations. @@ -299,23 +299,23 @@ proc `%`*(frmt: string, args: openArray[Rope]): Rope {. var length = len(frmt) result = nil var num = 0 - while i < length: - if frmt[i] == '$': + while i < length: + if frmt[i] == '$': inc(i) case frmt[i] - of '$': + of '$': add(result, "$") inc(i) - of '#': + of '#': inc(i) 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 frmt[i] notin {'0'..'9'}: break + if frmt[i] notin {'0'..'9'}: break add(result, args[j-1]) of '{': inc(i) @@ -325,13 +325,14 @@ proc `%`*(frmt: string, args: openArray[Rope]): Rope {. inc(i) if frmt[i] == '}': inc(i) else: raise newException(ValueError, "invalid format string") + add(result, args[j-1]) else: raise newException(ValueError, "invalid format string") var start = i - while i < length: + while i < length: if frmt[i] != '$': inc(i) - else: break - if i - 1 >= start: + else: break + if i - 1 >= start: add(result, substr(frmt, start, i - 1)) proc addf*(c: var Rope, frmt: string, args: openArray[Rope]) {. @@ -339,29 +340,46 @@ proc addf*(c: var Rope, frmt: string, args: openArray[Rope]) {. ## shortcut for ``add(c, frmt % args)``. add(c, frmt % args) +const + bufSize = 1024 # 1 KB is reasonable + proc equalsFile*(r: Rope, f: File): bool {.rtl, extern: "nro$1File".} = ## returns true if the contents of the file `f` equal `r`. - var bufSize = 1024 # reasonable start value - var buf = alloc(bufSize) + var + buf: array[bufSize, char] + bpos = buf.len + blen = buf.len + for s in leaves(r): - if s.len > bufSize: - bufSize = max(bufSize * 2, s.len) - buf = realloc(buf, bufSize) - var readBytes = readBuffer(f, buf, s.len) - result = readBytes == s.len and equalMem(buf, cstring(s), s.len) - if not result: break - if result: - result = readBuffer(f, buf, 1) == 0 # really at the end of file? - dealloc(buf) + 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, f: string): bool {.rtl, extern: "nro$1Str".} = +proc equalsFile*(r: Rope, filename: string): bool {.rtl, extern: "nro$1Str".} = ## returns true if the contents of the file `f` equal `r`. If `f` does not ## exist, false is returned. - var bin: File - result = open(bin, f) + var f: File + result = open(f, filename) if result: - result = equalsFile(r, bin) - close(bin) + result = equalsFile(r, f) + close(f) new(N) # init dummy node for splay algorithm diff --git a/lib/pure/selectors.nim b/lib/pure/selectors.nim index b6bc9dd3a..6901ecf58 100644 --- a/lib/pure/selectors.nim +++ b/lib/pure/selectors.nim @@ -296,7 +296,7 @@ proc contains*(s: Selector, key: SelectorKey): bool = TReadyInfo: ReadyInfo, PSelector: Selector].} -when isMainModule and not defined(nimdoc): +when not defined(testing) and isMainModule and not defined(nimdoc): # Select() import sockets type diff --git a/lib/pure/smtp.nim b/lib/pure/smtp.nim index 26f0c9591..c1bc259a5 100644 --- a/lib/pure/smtp.nim +++ b/lib/pure/smtp.nim @@ -238,7 +238,7 @@ proc sendMail*(smtp: AsyncSmtp, fromAddr: string, await smtp.sock.send("MAIL FROM:<" & fromAddr & ">\c\L") await smtp.checkReply("250") for address in items(toAddrs): - await smtp.sock.send("RCPT TO:<" & smtp.address & ">\c\L") + await smtp.sock.send("RCPT TO:<" & address & ">\c\L") await smtp.checkReply("250") # Send the message @@ -253,7 +253,7 @@ proc close*(smtp: AsyncSmtp) {.async.} = await smtp.sock.send("QUIT\c\L") smtp.sock.close() -when isMainModule: +when not defined(testing) and isMainModule: #var msg = createMessage("Test subject!", # "Hello, my name is dom96.\n What\'s yours?", @["dominik@localhost"]) #echo(msg) diff --git a/lib/pure/strutils.nim b/lib/pure/strutils.nim index 655203cda..1b248126b 100644 --- a/lib/pure/strutils.nim +++ b/lib/pure/strutils.nim @@ -386,7 +386,7 @@ proc split*(s: string, sep: string): seq[string] {.noSideEffect, ## `split iterator <#split.i,string,string>`_. accumulateResult(split(s, sep)) -proc toHex*(x: BiggestInt, len: int): string {.noSideEffect, +proc toHex*(x: BiggestInt, len: Positive): string {.noSideEffect, rtl, extern: "nsuToHex".} = ## Converts `x` to its hexadecimal representation. ## @@ -403,7 +403,7 @@ proc toHex*(x: BiggestInt, len: int): string {.noSideEffect, # handle negative overflow if n == 0 and x < 0: n = -1 -proc intToStr*(x: int, minchars: int = 1): string {.noSideEffect, +proc intToStr*(x: int, minchars: Positive = 1): string {.noSideEffect, rtl, extern: "nsuIntToStr".} = ## Converts `x` to its decimal representation. ## @@ -499,7 +499,7 @@ proc parseEnum*[T: enum](s: string, default: T): T = return e result = default -proc repeat*(c: char, count: int): string {.noSideEffect, +proc repeat*(c: char, count: Natural): string {.noSideEffect, rtl, extern: "nsuRepeatChar".} = ## Returns a string of length `count` consisting only of ## the character `c`. You can use this proc to left align strings. Example: @@ -514,7 +514,7 @@ proc repeat*(c: char, count: int): string {.noSideEffect, result = newString(count) for i in 0..count-1: result[i] = c -proc repeat*(s: string, n: int): string {.noSideEffect, +proc repeat*(s: string, n: Natural): string {.noSideEffect, rtl, extern: "nsuRepeatStr".} = ## Returns String `s` concatenated `n` times. Example: ## @@ -523,7 +523,7 @@ proc repeat*(s: string, n: int): string {.noSideEffect, result = newStringOfCap(n * s.len) for i in 1..n: result.add(s) -template spaces*(n: int): string = repeat(' ',n) +template spaces*(n: Natural): string = repeat(' ',n) ## Returns a String with `n` space characters. You can use this proc ## to left align strings. Example: ## @@ -535,15 +535,15 @@ template spaces*(n: int): string = repeat(' ',n) ## echo text1 & spaces(max(0, width - text1.len)) & "|" ## echo text2 & spaces(max(0, width - text2.len)) & "|" -proc repeatChar*(count: int, c: char = ' '): string {.deprecated.} = repeat(c, count) +proc repeatChar*(count: Natural, c: char = ' '): string {.deprecated.} = repeat(c, count) ## deprecated: use repeat() or spaces() -proc repeatStr*(count: int, s: string): string {.deprecated.} = repeat(s, count) +proc repeatStr*(count: Natural, s: string): string {.deprecated.} = repeat(s, count) ## deprecated: use repeat(string, count) or string.repeat(count) -proc align*(s: string, count: int, padding = ' '): string {. +proc align*(s: string, count: Natural, padding = ' '): string {. noSideEffect, rtl, extern: "nsuAlignString".} = - ## Aligns a string `s` with `padding`, so that is of length `count`. + ## Aligns a string `s` with `padding`, so that it is of length `count`. ## ## `padding` characters (by default spaces) are added before `s` resulting in ## right alignment. If ``s.len >= count``, no spaces are added and `s` is @@ -682,7 +682,7 @@ proc endsWith*(s, suffix: string): bool {.noSideEffect, inc(i) if suffix[i] == '\0': return true -proc continuesWith*(s, substr: string, start: int): bool {.noSideEffect, +proc continuesWith*(s, substr: string, start: Natural): bool {.noSideEffect, rtl, extern: "nsuContinuesWith".} = ## Returns true iff ``s`` continues with ``substr`` at position ``start``. ## @@ -693,8 +693,8 @@ proc continuesWith*(s, substr: string, start: int): bool {.noSideEffect, if s[i+start] != substr[i]: return false inc(i) -proc addSep*(dest: var string, sep = ", ", startLen = 0) {.noSideEffect, - inline.} = +proc addSep*(dest: var string, sep = ", ", startLen: Natural = 0) + {.noSideEffect, inline.} = ## Adds a separator to `dest` only if its length is bigger than `startLen`. ## ## A shorthand for: @@ -784,7 +784,7 @@ proc findAux(s, sub: string, start: int, a: SkipTable): int = inc(j, a[s[j+m]]) return -1 -proc find*(s, sub: string, start: int = 0): int {.noSideEffect, +proc find*(s, sub: string, start: Natural = 0): int {.noSideEffect, rtl, extern: "nsuFindStr".} = ## Searches for `sub` in `s` starting at position `start`. ## @@ -793,7 +793,7 @@ proc find*(s, sub: string, start: int = 0): int {.noSideEffect, preprocessSub(sub, a) result = findAux(s, sub, start, a) -proc find*(s: string, sub: char, start: int = 0): int {.noSideEffect, +proc find*(s: string, sub: char, start: Natural = 0): int {.noSideEffect, rtl, extern: "nsuFindChar".} = ## Searches for `sub` in `s` starting at position `start`. ## @@ -802,7 +802,7 @@ proc find*(s: string, sub: char, start: int = 0): int {.noSideEffect, if sub == s[i]: return i return -1 -proc find*(s: string, chars: set[char], start: int = 0): int {.noSideEffect, +proc find*(s: string, chars: set[char], start: Natural = 0): int {.noSideEffect, rtl, extern: "nsuFindCharSet".} = ## Searches for `chars` in `s` starting at position `start`. ## @@ -933,7 +933,7 @@ proc replaceWord*(s, sub: string, by = ""): string {.noSideEffect, var j = findAux(s, sub, i, a) if j < 0: break # word boundary? - if (j == 0 or s[j-1] notin wordChars) and + if (j == 0 or s[j-1] notin wordChars) and (j+sub.len >= s.len or s[j+sub.len] notin wordChars): add result, substr(s, i, j - 1) add result, by @@ -976,7 +976,7 @@ proc parseOctInt*(s: string): int {.noSideEffect, of '\0': break else: raise newException(ValueError, "invalid integer: " & s) -proc toOct*(x: BiggestInt, len: int): string {.noSideEffect, +proc toOct*(x: BiggestInt, len: Positive): string {.noSideEffect, rtl, extern: "nsuToOct".} = ## Converts `x` into its octal representation. ## @@ -992,7 +992,7 @@ proc toOct*(x: BiggestInt, len: int): string {.noSideEffect, shift = shift + 3 mask = mask shl 3 -proc toBin*(x: BiggestInt, len: int): string {.noSideEffect, +proc toBin*(x: BiggestInt, len: Positive): string {.noSideEffect, rtl, extern: "nsuToBin".} = ## Converts `x` into its binary representation. ## @@ -1221,7 +1221,7 @@ proc formatBiggestFloat*(f: BiggestFloat, format: FloatFormatMode = ffDefault, ## of significant digits to be printed. ## `precision`'s default value is the maximum number of meaningful digits ## after the decimal point for Nim's ``biggestFloat`` type. - ## + ## ## If ``precision == 0``, it tries to format it nicely. const floatFormatToChar: array[FloatFormatMode, char] = ['g', 'f', 'e'] var @@ -1286,7 +1286,7 @@ proc findNormalized(x: string, inArray: openArray[string]): int = return -1 proc invalidFormatString() {.noinline.} = - raise newException(ValueError, "invalid format string") + raise newException(ValueError, "invalid format string") proc addf*(s: var string, formatstr: string, a: varargs[string, `$`]) {. noSideEffect, rtl, extern: "nsuAddf".} = @@ -1402,21 +1402,27 @@ when isMainModule: doAssert align("a", 0) == "a" doAssert align("1232", 6) == " 1232" doAssert align("1232", 6, '#') == "##1232" - echo wordWrap(""" this is a long text -- muchlongerthan10chars and here - it goes""", 10, false) + + let + inp = """ this is a long text -- muchlongerthan10chars and here + it goes""" + outp = " this is a\nlong text\n--\nmuchlongerthan10chars\nand here\nit goes" + doAssert wordWrap(inp, 10, false) == outp + doAssert formatBiggestFloat(0.00000000001, ffDecimal, 11) == "0.00000000001" doAssert formatBiggestFloat(0.00000000001, ffScientific, 1) == "1.0e-11" doAssert "$# $3 $# $#" % ["a", "b", "c"] == "a c b c" - echo formatSize(1'i64 shl 31 + 300'i64) # == "4,GB" - echo formatSize(1'i64 shl 31) + when not defined(testing): + echo formatSize(1'i64 shl 31 + 300'i64) # == "4,GB" + echo formatSize(1'i64 shl 31) doAssert "$animal eats $food." % ["animal", "The cat", "food", "fish"] == "The cat eats fish." doAssert "-ld a-ldz -ld".replaceWord("-ld") == " a-ldz " doAssert "-lda-ldz -ld abc".replaceWord("-ld") == "-lda-ldz abc" - + type MyEnum = enum enA, enB, enC, enuD, enE doAssert parseEnum[MyEnum]("enu_D") == enuD diff --git a/lib/pure/subexes.nim b/lib/pure/subexes.nim index d701b85b1..d213c99e6 100644 --- a/lib/pure/subexes.nim +++ b/lib/pure/subexes.nim @@ -386,8 +386,13 @@ when isMainModule: longishA, longish)""" - echo "type TMyEnum* = enum\n $', '2i'\n '{..}" % ["fieldA", - "fieldB", "FiledClkad", "fieldD", "fieldE", "longishFieldName"] + assert "type TMyEnum* = enum\n $', '2i'\n '{..}" % ["fieldA", + "fieldB", "FiledClkad", "fieldD", "fieldE", "longishFieldName"] == + strutils.unindent """ + type TMyEnum* = enum + fieldA, fieldB, + FiledClkad, fieldD, + fieldE, longishFieldName""" doAssert subex"$1($', '{2..})" % ["f", "a", "b", "c"] == "f(a, b, c)" @@ -395,7 +400,12 @@ when isMainModule: doAssert subex"$['''|'|''''|']']#" % "0" == "'|" - echo subex("type\n TEnum = enum\n $', '40c'\n '{..}") % [ - "fieldNameA", "fieldNameB", "fieldNameC", "fieldNameD"] + assert subex("type\n TEnum = enum\n $', '40c'\n '{..}") % [ + "fieldNameA", "fieldNameB", "fieldNameC", "fieldNameD"] == + strutils.unindent """ + type + TEnum = enum + fieldNameA, fieldNameB, fieldNameC, + fieldNameD""" diff --git a/lib/pure/terminal.nim b/lib/pure/terminal.nim index df637dcb6..a3c5cdcfb 100644 --- a/lib/pure/terminal.nim +++ b/lib/pure/terminal.nim @@ -375,7 +375,7 @@ when not defined(windows): result = stdin.readChar() discard fd.tcsetattr(TCSADRAIN, addr oldMode) -when isMainModule: +when not defined(testing) and isMainModule: system.addQuitProc(resetAttributes) write(stdout, "never mind") eraseLine() diff --git a/lib/pure/times.nim b/lib/pure/times.nim index 25f6b85f6..c275ede69 100644 --- a/lib/pure/times.nim +++ b/lib/pure/times.nim @@ -33,36 +33,36 @@ when not defined(JS): when defined(posix) and not defined(JS): type - TimeImpl {.importc: "time_t", header: "<sys/time.h>".} = int + TimeImpl {.importc: "time_t", header: "<time.h>".} = int Time* = distinct TimeImpl ## distinct type that represents a time ## measured as number of seconds since the epoch - - Timeval {.importc: "struct timeval", + + Timeval {.importc: "struct timeval", header: "<sys/select.h>".} = object ## struct timeval - tv_sec: int ## Seconds. - tv_usec: int ## Microseconds. - + tv_sec: int ## Seconds. + tv_usec: int ## Microseconds. + # we cannot import posix.nim here, because posix.nim depends on times.nim. - # Ok, we could, but I don't want circular dependencies. + # Ok, we could, but I don't want circular dependencies. # And gettimeofday() is not defined in the posix module anyway. Sigh. - + proc posix_gettimeofday(tp: var Timeval, unused: pointer = nil) {. importc: "gettimeofday", header: "<sys/time.h>".} # we also need tzset() to make sure that tzname is initialized - proc tzset() {.importc, header: "<sys/time.h>".} + proc tzset() {.importc, header: "<time.h>".} # calling tzset() implicitly to initialize tzname data. tzset() elif defined(windows): import winlean - + when defined(vcc): # newest version of Visual C++ defines time_t to be of 64 bits type TimeImpl {.importc: "time_t", header: "<time.h>".} = int64 else: type TimeImpl {.importc: "time_t", header: "<time.h>".} = int32 - + type Time* = distinct TimeImpl @@ -166,7 +166,7 @@ proc fromSeconds*(since1970: float): Time {.tags: [], raises: [], benign.} ## Takes a float which contains the number of seconds since the unix epoch and ## returns a time object. -proc fromSeconds*(since1970: int64): Time {.tags: [], raises: [], benign.} = +proc fromSeconds*(since1970: int64): Time {.tags: [], raises: [], benign.} = ## Takes an int which contains the number of seconds since the unix epoch and ## returns a time object. fromSeconds(float(since1970)) @@ -184,12 +184,12 @@ proc `-`*(a, b: Time): int64 {. ## computes the difference of two calendar times. Result is in seconds. proc `<`*(a, b: Time): bool {. - rtl, extern: "ntLtTime", tags: [], raises: [].} = + rtl, extern: "ntLtTime", tags: [], raises: [].} = ## returns true iff ``a < b``, that is iff a happened before b. result = a - b < 0 - + proc `<=` * (a, b: Time): bool {. - rtl, extern: "ntLeTime", tags: [], raises: [].}= + rtl, extern: "ntLeTime", tags: [], raises: [].}= ## returns true iff ``a <= b``. result = a - b <= 0 @@ -211,7 +211,7 @@ proc getStartMilsecs*(): int {.deprecated, tags: [TimeEffect], benign.} ## get the miliseconds from the start of the program. **Deprecated since ## version 0.8.10.** Use ``epochTime`` or ``cpuTime`` instead. -proc initInterval*(miliseconds, seconds, minutes, hours, days, months, +proc initInterval*(miliseconds, seconds, minutes, hours, days, months, years: int = 0): TimeInterval = ## creates a new ``TimeInterval``. result.miliseconds = miliseconds @@ -227,9 +227,9 @@ proc isLeapYear*(year: int): bool = if year mod 400 == 0: return true - elif year mod 100 == 0: + elif year mod 100 == 0: return false - elif year mod 4 == 0: + elif year mod 4 == 0: return true else: return false @@ -238,7 +238,7 @@ proc getDaysInMonth*(month: Month, year: int): int = ## gets the amount of days in a ``month`` of a ``year`` # http://www.dispersiondesign.com/articles/time/number_of_days_in_a_month - case month + case month of mFeb: result = if isLeapYear(year): 29 else: 28 of mApr, mJun, mSep, mNov: result = 30 else: result = 31 @@ -250,7 +250,7 @@ proc toSeconds(a: TimeInfo, interval: TimeInterval): float = var anew = a var newinterv = interval result = 0 - + newinterv.months += interval.years * 12 var curMonth = anew.month for mth in 1 .. newinterv.months: @@ -290,18 +290,18 @@ proc `-`*(a: TimeInfo, interval: TimeInterval): TimeInfo = else: result = getLocalTime(fromSeconds(t - secs)) -when not defined(JS): +when not defined(JS): proc epochTime*(): float {.rtl, extern: "nt$1", tags: [TimeEffect].} ## gets time after the UNIX epoch (1970) in seconds. It is a float - ## because sub-second resolution is likely to be supported (depending + ## because sub-second resolution is likely to be supported (depending ## on the hardware/OS). proc cpuTime*(): float {.rtl, extern: "nt$1", tags: [TimeEffect].} ## gets time spent that the CPU spent to run the current process in ## seconds. This may be more useful for benchmarking than ``epochTime``. ## However, it may measure the real time instead (depending on the OS). - ## The value of the result has no meaning. - ## To generate useful timing values, take the difference between + ## The value of the result has no meaning. + ## To generate useful timing values, take the difference between ## the results of two ``cpuTime`` calls: ## ## .. code-block:: nim @@ -322,10 +322,10 @@ when not defined(JS): weekday {.importc: "tm_wday".}, yearday {.importc: "tm_yday".}, isdst {.importc: "tm_isdst".}: cint - + TimeInfoPtr = ptr StructTM Clock {.importc: "clock_t".} = distinct int - + proc localtime(timer: ptr Time): TimeInfoPtr {. importc: "localtime", header: "<time.h>", tags: [].} proc gmtime(timer: ptr Time): TimeInfoPtr {. @@ -341,12 +341,12 @@ when not defined(JS): # strftime(s: CString, maxsize: int, fmt: CString, t: tm): int {. # importc: "strftime", header: "<time.h>".} proc getClock(): Clock {.importc: "clock", header: "<time.h>", tags: [TimeEffect].} - proc difftime(a, b: Time): float {.importc: "difftime", header: "<time.h>", + proc difftime(a, b: Time): float {.importc: "difftime", header: "<time.h>", tags: [].} - + var clocksPerSec {.importc: "CLOCKS_PER_SEC", nodecl.}: int - + # our own procs on top of that: proc tmToTimeInfo(tm: StructTM, local: bool): TimeInfo = const @@ -370,7 +370,7 @@ when not defined(JS): "UTC", timezone: if local: getTimezone() else: 0 ) - + proc timeInfoToTM(t: TimeInfo): StructTM = const weekDays: array [WeekDay, int8] = [1'i8,2'i8,3'i8,4'i8,5'i8,6'i8,0'i8] @@ -383,11 +383,11 @@ when not defined(JS): result.weekday = weekDays[t.weekday] result.yearday = t.yearday result.isdst = if t.isDST: 1 else: 0 - + when not defined(useNimRtl): proc `-` (a, b: Time): int64 = return toBiggestInt(difftime(a, b)) - + proc getStartMilsecs(): int = #echo "clocks per sec: ", clocksPerSec, "clock: ", int(getClock()) #return getClock() div (clocksPerSec div 1000) @@ -400,37 +400,37 @@ when not defined(JS): posix_gettimeofday(a) result = a.tv_sec * 1000'i64 + a.tv_usec div 1000'i64 #echo "result: ", result - + proc getTime(): Time = return timec(nil) proc getLocalTime(t: Time): TimeInfo = var a = t result = tmToTimeInfo(localtime(addr(a))[], true) # copying is needed anyway to provide reentrancity; thus # the conversion is not expensive - + proc getGMTime(t: Time): TimeInfo = var a = t result = tmToTimeInfo(gmtime(addr(a))[], false) # copying is needed anyway to provide reentrancity; thus # the conversion is not expensive - + proc timeInfoToTime(timeInfo: TimeInfo): Time = var cTimeInfo = timeInfo # for C++ we have to make a copy, # because the header of mktime is broken in my version of libc return mktime(timeInfoToTM(cTimeInfo)) - proc toStringTillNL(p: cstring): string = + proc toStringTillNL(p: cstring): string = result = "" var i = 0 - while p[i] != '\0' and p[i] != '\10' and p[i] != '\13': + while p[i] != '\0' and p[i] != '\10' and p[i] != '\13': add(result, p[i]) inc(i) - + proc `$`(timeInfo: TimeInfo): string = # BUGFIX: asctime returns a newline at the end! var p = asctime(timeInfoToTM(timeInfo)) result = toStringTillNL(p) - + proc `$`(time: Time): string = # BUGFIX: ctime returns a newline at the end! var a = time @@ -440,17 +440,17 @@ when not defined(JS): epochDiff = 116444736000000000'i64 rateDiff = 10000000'i64 # 100 nsecs - proc unixTimeToWinTime*(t: Time): int64 = + proc unixTimeToWinTime*(t: Time): int64 = ## converts a UNIX `Time` (``time_t``) to a Windows file time result = int64(t) * rateDiff + epochDiff - - proc winTimeToUnixTime*(t: int64): Time = + + proc winTimeToUnixTime*(t: int64): Time = ## converts a Windows time to a UNIX `Time` (``time_t``) result = Time((t - epochDiff) div rateDiff) - + proc getTzname(): tuple[nonDST, DST: string] = return ($tzname[0], $tzname[1]) - + proc getTimezone(): int = return timezone @@ -459,7 +459,7 @@ when not defined(JS): proc toSeconds(time: Time): float = float(time) when not defined(useNimRtl): - proc epochTime(): float = + proc epochTime(): float = when defined(posix): var a: Timeval posix_gettimeofday(a) @@ -473,14 +473,14 @@ when not defined(JS): result = toFloat(int(secs)) + toFloat(int(subsecs)) * 0.0000001 else: {.error: "unknown OS".} - - proc cpuTime(): float = + + proc cpuTime(): float = result = toFloat(int(getClock())) / toFloat(clocksPerSec) - + elif defined(JS): proc newDate(): Time {.importc: "new Date".} proc internGetTime(): Time {.importc: "new Date", tags: [].} - + proc newDate(value: float): Time {.importc: "new Date".} proc newDate(value: string): Time {.importc: "new Date".} proc getTime(): Time = @@ -490,7 +490,7 @@ elif defined(JS): const weekDays: array [0..6, WeekDay] = [ dSun, dMon, dTue, dWed, dThu, dFri, dSat] - + proc getLocalTime(t: Time): TimeInfo = result.second = t.getSeconds() result.minute = t.getMinutes() @@ -510,7 +510,7 @@ elif defined(JS): result.year = t.getUTCFullYear() result.weekday = weekDays[t.getUTCDay()] result.yearday = 0 - + proc timeInfoToTime*(timeInfo: TimeInfo): Time = result = internGetTime() result.setSeconds(timeInfo.second) @@ -519,16 +519,16 @@ elif defined(JS): result.setMonth(ord(timeInfo.month)) result.setFullYear(timeInfo.year) result.setDate(timeInfo.monthday) - + proc `$`(timeInfo: TimeInfo): string = return $(timeInfoToTime(timeInfo)) proc `$`(time: Time): string = return $time.toLocaleString() - - proc `-` (a, b: Time): int64 = + + proc `-` (a, b: Time): int64 = return a.getTime() - b.getTime() - + var startMilsecs = getTime() - + proc getStartMilsecs(): int = ## get the miliseconds from the start of the program return int(getTime() - startMilsecs) @@ -541,6 +541,8 @@ elif defined(JS): proc getTimezone(): int = result = newDate().getTimezoneOffset() + proc epochTime*(): float {.tags: [TimeEffect].} = newDate().toSeconds() + proc getDateStr*(): string {.rtl, extern: "nt$1", tags: [TimeEffect].} = ## gets the current date as a string of the format ``YYYY-MM-DD``. var ti = getLocalTime(getTime()) @@ -561,7 +563,7 @@ proc `$`*(day: WeekDay): string = proc `$`*(m: Month): string = ## stingify operator for ``Month``. - const lookup: array[Month, string] = ["January", "February", "March", + const lookup: array[Month, string] = ["January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"] return lookup[m] @@ -682,7 +684,7 @@ proc formatToken(info: TimeInfo, token: string, buf: var string) = proc format*(info: TimeInfo, f: string): string = ## This function formats `info` as specified by `f`. The following format ## specifiers are available: - ## + ## ## ========== ================================================================================= ================================================ ## Specifier Description Example ## ========== ================================================================================= ================================================ @@ -729,14 +731,14 @@ proc format*(info: TimeInfo, f: string): string = currentF = "" if f[i] == '\0': break - + if f[i] == '\'': inc(i) # Skip ' while f[i] != '\'' and f.len-1 > i: result.add(f[i]) inc(i) else: result.add(f[i]) - + else: # Check if the letter being added matches previous accumulated buffer. if currentF.len < 1 or currentF[high(currentF)] == f[i]: @@ -803,7 +805,7 @@ proc parseToken(info: var TimeInfo; token, value: string; j: var int) = info.weekday = dSat j += 8 else: - raise newException(ValueError, "invalid day of week ") + raise newException(ValueError, "invalid day of week ") of "h", "H": var pd = parseInt(value[j..j+1], sv) info.hour = sv @@ -854,7 +856,7 @@ proc parseToken(info: var TimeInfo; token, value: string; j: var int) = of "dec": info.month = mDec else: - raise newException(ValueError, "invalid month") + raise newException(ValueError, "invalid month") j += 3 of "MMMM": if value.len >= j+7 and value[j..j+6].cmpIgnoreCase("january") == 0: @@ -894,7 +896,7 @@ proc parseToken(info: var TimeInfo; token, value: string; j: var int) = info.month = mDec j += 8 else: - raise newException(ValueError, "invalid month") + raise newException(ValueError, "invalid month") of "s": var pd = parseInt(value[j..j+1], sv) info.second = sv @@ -949,7 +951,7 @@ proc parseToken(info: var TimeInfo; token, value: string; j: var int) = else: # Ignore the token and move forward in the value string by the same length j += token.len - + proc parse*(value, layout: string): TimeInfo = ## This function parses a date/time string using the standard format identifiers (below) ## The function defaults information not provided in the format string from the running program (timezone, month, year, etc) @@ -987,7 +989,7 @@ proc parse*(value, layout: string): TimeInfo = ## ``hh'->'mm`` will give ``01->56``. The following characters can be ## inserted without quoting them: ``:`` ``-`` ``(`` ``)`` ``/`` ``[`` ``]`` ## ``,``. However you don't need to necessarily separate format specifiers, a - ## unambiguous format string like ``yyyyMMddhhmmss`` is valid too. + ## unambiguous format string like ``yyyyMMddhhmmss`` is valid too. var i = 0 # pointer for format string var j = 0 # pointer for value string var token = "" @@ -1034,32 +1036,30 @@ when isMainModule: # Tue 19 Jan 03:14:07 GMT 2038 var t = getGMTime(fromSeconds(2147483647)) - echo t.format("ddd dd MMM hh:mm:ss ZZZ yyyy") - echo t.format("ddd ddMMMhhmmssZZZyyyy") assert t.format("ddd dd MMM hh:mm:ss ZZZ yyyy") == "Tue 19 Jan 03:14:07 UTC 2038" assert t.format("ddd ddMMMhh:mm:ssZZZyyyy") == "Tue 19Jan03:14:07UTC2038" - + assert t.format("d dd ddd dddd h hh H HH m mm M MM MMM MMMM s" & - " ss t tt y yy yyy yyyy yyyyy z zz zzz ZZZ") == + " ss t tt y yy yyy yyyy yyyyy z zz zzz ZZZ") == "19 19 Tue Tuesday 3 03 3 03 14 14 1 01 Jan January 7 07 A AM 8 38 038 2038 02038 0 00 00:00 UTC" assert t.format("yyyyMMddhhmmss") == "20380119031407" - + var t2 = getGMTime(fromSeconds(160070789)) # Mon 27 Jan 16:06:29 GMT 1975 assert t2.format("d dd ddd dddd h hh H HH m mm M MM MMM MMMM s" & " ss t tt y yy yyy yyyy yyyyy z zz zzz ZZZ") == "27 27 Mon Monday 4 04 16 16 6 06 1 01 Jan January 29 29 P PM 5 75 975 1975 01975 0 00 00:00 UTC" - + when not defined(JS) and sizeof(Time) == 8: var t3 = getGMTime(fromSeconds(889067643645)) # Fri 7 Jun 19:20:45 BST 30143 assert t3.format("d dd ddd dddd h hh H HH m mm M MM MMM MMMM s" & - " ss t tt y yy yyy yyyy yyyyy z zz zzz ZZZ") == + " ss t tt y yy yyy yyyy yyyyy z zz zzz ZZZ") == "7 07 Fri Friday 6 06 18 18 20 20 6 06 Jun June 45 45 P PM 3 43 143 0143 30143 0 00 00:00 UTC" - assert t3.format(":,[]()-/") == ":,[]()-/" - + assert t3.format(":,[]()-/") == ":,[]()-/" + var t4 = getGMTime(fromSeconds(876124714)) # Mon 6 Oct 08:58:34 BST 1997 assert t4.format("M MM MMM MMMM") == "10 10 Oct October" - + # Interval tests assert((t4 - initInterval(years = 2)).format("yyyy") == "1995") assert((t4 - initInterval(years = 7, minutes = 34, seconds = 24)).format("yyyy mm ss") == "1990 24 10") @@ -1110,4 +1110,6 @@ when isMainModule: # Kitchen = "3:04PM" s = "3:04PM" f = "h:mmtt" - echo "Kitchen: " & $s.parse(f) + assert "15:04:00" in $s.parse(f) + when not defined(testing): + echo "Kitchen: " & $s.parse(f) diff --git a/lib/pure/unicode.nim b/lib/pure/unicode.nim index a6f8f916b..4a9f4631d 100644 --- a/lib/pure/unicode.nim +++ b/lib/pure/unicode.nim @@ -19,7 +19,7 @@ type Rune16* = distinct int16 ## 16 bit Unicode character {.deprecated: [TRune: Rune, TRune16: Rune16].} - + proc `<=%`*(a, b: Rune): bool = return int(a) <=% int(b) proc `<%`*(a, b: Rune): bool = return int(a) <% int(b) proc `==`*(a, b: Rune): bool = return int(a) == int(b) @@ -39,7 +39,7 @@ proc runeLen*(s: string): int {.rtl, extern: "nuc$1".} = else: inc i inc(result) -proc runeLenAt*(s: string, i: int): int = +proc runeLenAt*(s: string, i: Natural): int = ## returns the number of bytes the rune starting at ``s[i]`` takes. if ord(s[i]) <=% 127: result = 1 elif ord(s[i]) shr 5 == 0b110: result = 2 @@ -58,7 +58,7 @@ template fastRuneAt*(s: string, i: int, result: expr, doInc = true) = when doInc: inc(i) elif ord(s[i]) shr 5 == 0b110: # assert(ord(s[i+1]) shr 6 == 0b10) - result = Rune((ord(s[i]) and (ones(5))) shl 6 or + result = Rune((ord(s[i]) and (ones(5))) shl 6 or (ord(s[i+1]) and ones(6))) when doInc: inc(i, 2) elif ord(s[i]) shr 4 == 0b1110: @@ -77,7 +77,7 @@ template fastRuneAt*(s: string, i: int, result: expr, doInc = true) = (ord(s[i+2]) and ones(6)) shl 6 or (ord(s[i+3]) and ones(6))) when doInc: inc(i, 4) - elif ord(s[i]) shr 2 == 0b111110: + elif ord(s[i]) shr 2 == 0b111110: # assert(ord(s[i+1]) shr 6 == 0b10) # assert(ord(s[i+2]) shr 6 == 0b10) # assert(ord(s[i+3]) shr 6 == 0b10) @@ -88,7 +88,7 @@ template fastRuneAt*(s: string, i: int, result: expr, doInc = true) = (ord(s[i+3]) and ones(6)) shl 6 or (ord(s[i+4]) and ones(6))) when doInc: inc(i, 5) - elif ord(s[i]) shr 1 == 0b1111110: + elif ord(s[i]) shr 1 == 0b1111110: # assert(ord(s[i+1]) shr 6 == 0b10) # assert(ord(s[i+2]) shr 6 == 0b10) # assert(ord(s[i+3]) shr 6 == 0b10) @@ -105,11 +105,11 @@ template fastRuneAt*(s: string, i: int, result: expr, doInc = true) = result = Rune(ord(s[i])) when doInc: inc(i) -proc runeAt*(s: string, i: int): Rune = +proc runeAt*(s: string, i: Natural): Rune = ## returns the unicode character in `s` at byte index `i` fastRuneAt(s, i, result, false) -proc toUTF8*(c: Rune): string {.rtl, extern: "nuc$1".} = +proc toUTF8*(c: Rune): string {.rtl, extern: "nuc$1".} = ## converts a rune into its UTF8 representation var i = RuneImpl(c) if i <=% 127: @@ -159,967 +159,967 @@ proc `$`*(runes: seq[Rune]): string = const alphaRanges = [ - 0x00d8, 0x00f6, # - - 0x00f8, 0x01f5, # - - 0x0250, 0x02a8, # - - 0x038e, 0x03a1, # - - 0x03a3, 0x03ce, # - - 0x03d0, 0x03d6, # - - 0x03e2, 0x03f3, # - - 0x0490, 0x04c4, # - - 0x0561, 0x0587, # - - 0x05d0, 0x05ea, # - - 0x05f0, 0x05f2, # - - 0x0621, 0x063a, # - - 0x0640, 0x064a, # - - 0x0671, 0x06b7, # - - 0x06ba, 0x06be, # - - 0x06c0, 0x06ce, # - - 0x06d0, 0x06d3, # - - 0x0905, 0x0939, # - - 0x0958, 0x0961, # - - 0x0985, 0x098c, # - - 0x098f, 0x0990, # - - 0x0993, 0x09a8, # - - 0x09aa, 0x09b0, # - - 0x09b6, 0x09b9, # - - 0x09dc, 0x09dd, # - - 0x09df, 0x09e1, # - - 0x09f0, 0x09f1, # - - 0x0a05, 0x0a0a, # - - 0x0a0f, 0x0a10, # - - 0x0a13, 0x0a28, # - - 0x0a2a, 0x0a30, # - - 0x0a32, 0x0a33, # - - 0x0a35, 0x0a36, # - - 0x0a38, 0x0a39, # - - 0x0a59, 0x0a5c, # - - 0x0a85, 0x0a8b, # - - 0x0a8f, 0x0a91, # - - 0x0a93, 0x0aa8, # - - 0x0aaa, 0x0ab0, # - - 0x0ab2, 0x0ab3, # - - 0x0ab5, 0x0ab9, # - - 0x0b05, 0x0b0c, # - - 0x0b0f, 0x0b10, # - - 0x0b13, 0x0b28, # - - 0x0b2a, 0x0b30, # - - 0x0b32, 0x0b33, # - - 0x0b36, 0x0b39, # - - 0x0b5c, 0x0b5d, # - - 0x0b5f, 0x0b61, # - - 0x0b85, 0x0b8a, # - - 0x0b8e, 0x0b90, # - - 0x0b92, 0x0b95, # - - 0x0b99, 0x0b9a, # - - 0x0b9e, 0x0b9f, # - - 0x0ba3, 0x0ba4, # - - 0x0ba8, 0x0baa, # - - 0x0bae, 0x0bb5, # - - 0x0bb7, 0x0bb9, # - - 0x0c05, 0x0c0c, # - - 0x0c0e, 0x0c10, # - - 0x0c12, 0x0c28, # - - 0x0c2a, 0x0c33, # - - 0x0c35, 0x0c39, # - - 0x0c60, 0x0c61, # - - 0x0c85, 0x0c8c, # - - 0x0c8e, 0x0c90, # - - 0x0c92, 0x0ca8, # - - 0x0caa, 0x0cb3, # - - 0x0cb5, 0x0cb9, # - - 0x0ce0, 0x0ce1, # - - 0x0d05, 0x0d0c, # - - 0x0d0e, 0x0d10, # - - 0x0d12, 0x0d28, # - - 0x0d2a, 0x0d39, # - - 0x0d60, 0x0d61, # - - 0x0e01, 0x0e30, # - - 0x0e32, 0x0e33, # - - 0x0e40, 0x0e46, # - - 0x0e5a, 0x0e5b, # - - 0x0e81, 0x0e82, # - - 0x0e87, 0x0e88, # - - 0x0e94, 0x0e97, # - - 0x0e99, 0x0e9f, # - - 0x0ea1, 0x0ea3, # - - 0x0eaa, 0x0eab, # - - 0x0ead, 0x0eae, # - - 0x0eb2, 0x0eb3, # - - 0x0ec0, 0x0ec4, # - - 0x0edc, 0x0edd, # - - 0x0f18, 0x0f19, # - - 0x0f40, 0x0f47, # - - 0x0f49, 0x0f69, # - - 0x10d0, 0x10f6, # - - 0x1100, 0x1159, # - - 0x115f, 0x11a2, # - - 0x11a8, 0x11f9, # - - 0x1e00, 0x1e9b, # - - 0x1f50, 0x1f57, # - - 0x1f80, 0x1fb4, # - - 0x1fb6, 0x1fbc, # - - 0x1fc2, 0x1fc4, # - - 0x1fc6, 0x1fcc, # - - 0x1fd0, 0x1fd3, # - - 0x1fd6, 0x1fdb, # - - 0x1fe0, 0x1fec, # - - 0x1ff2, 0x1ff4, # - - 0x1ff6, 0x1ffc, # - - 0x210a, 0x2113, # - - 0x2115, 0x211d, # - - 0x2120, 0x2122, # - - 0x212a, 0x2131, # - - 0x2133, 0x2138, # - - 0x3041, 0x3094, # - - 0x30a1, 0x30fa, # - - 0x3105, 0x312c, # - - 0x3131, 0x318e, # - - 0x3192, 0x319f, # - - 0x3260, 0x327b, # - - 0x328a, 0x32b0, # - - 0x32d0, 0x32fe, # - - 0x3300, 0x3357, # - - 0x3371, 0x3376, # - - 0x337b, 0x3394, # - - 0x3399, 0x339e, # - - 0x33a9, 0x33ad, # - - 0x33b0, 0x33c1, # - - 0x33c3, 0x33c5, # - - 0x33c7, 0x33d7, # - - 0x33d9, 0x33dd, # - - 0x4e00, 0x9fff, # - - 0xac00, 0xd7a3, # - - 0xf900, 0xfb06, # - - 0xfb13, 0xfb17, # - - 0xfb1f, 0xfb28, # - - 0xfb2a, 0xfb36, # - - 0xfb38, 0xfb3c, # - - 0xfb40, 0xfb41, # - - 0xfb43, 0xfb44, # - - 0xfb46, 0xfbb1, # - - 0xfbd3, 0xfd3d, # - - 0xfd50, 0xfd8f, # - - 0xfd92, 0xfdc7, # - - 0xfdf0, 0xfdf9, # - - 0xfe70, 0xfe72, # - - 0xfe76, 0xfefc, # - - 0xff66, 0xff6f, # - - 0xff71, 0xff9d, # - - 0xffa0, 0xffbe, # - - 0xffc2, 0xffc7, # - - 0xffca, 0xffcf, # - - 0xffd2, 0xffd7, # - - 0xffda, 0xffdc] # - + 0x00d8, 0x00f6, # - + 0x00f8, 0x01f5, # - + 0x0250, 0x02a8, # - + 0x038e, 0x03a1, # - + 0x03a3, 0x03ce, # - + 0x03d0, 0x03d6, # - + 0x03e2, 0x03f3, # - + 0x0490, 0x04c4, # - + 0x0561, 0x0587, # - + 0x05d0, 0x05ea, # - + 0x05f0, 0x05f2, # - + 0x0621, 0x063a, # - + 0x0640, 0x064a, # - + 0x0671, 0x06b7, # - + 0x06ba, 0x06be, # - + 0x06c0, 0x06ce, # - + 0x06d0, 0x06d3, # - + 0x0905, 0x0939, # - + 0x0958, 0x0961, # - + 0x0985, 0x098c, # - + 0x098f, 0x0990, # - + 0x0993, 0x09a8, # - + 0x09aa, 0x09b0, # - + 0x09b6, 0x09b9, # - + 0x09dc, 0x09dd, # - + 0x09df, 0x09e1, # - + 0x09f0, 0x09f1, # - + 0x0a05, 0x0a0a, # - + 0x0a0f, 0x0a10, # - + 0x0a13, 0x0a28, # - + 0x0a2a, 0x0a30, # - + 0x0a32, 0x0a33, # - + 0x0a35, 0x0a36, # - + 0x0a38, 0x0a39, # - + 0x0a59, 0x0a5c, # - + 0x0a85, 0x0a8b, # - + 0x0a8f, 0x0a91, # - + 0x0a93, 0x0aa8, # - + 0x0aaa, 0x0ab0, # - + 0x0ab2, 0x0ab3, # - + 0x0ab5, 0x0ab9, # - + 0x0b05, 0x0b0c, # - + 0x0b0f, 0x0b10, # - + 0x0b13, 0x0b28, # - + 0x0b2a, 0x0b30, # - + 0x0b32, 0x0b33, # - + 0x0b36, 0x0b39, # - + 0x0b5c, 0x0b5d, # - + 0x0b5f, 0x0b61, # - + 0x0b85, 0x0b8a, # - + 0x0b8e, 0x0b90, # - + 0x0b92, 0x0b95, # - + 0x0b99, 0x0b9a, # - + 0x0b9e, 0x0b9f, # - + 0x0ba3, 0x0ba4, # - + 0x0ba8, 0x0baa, # - + 0x0bae, 0x0bb5, # - + 0x0bb7, 0x0bb9, # - + 0x0c05, 0x0c0c, # - + 0x0c0e, 0x0c10, # - + 0x0c12, 0x0c28, # - + 0x0c2a, 0x0c33, # - + 0x0c35, 0x0c39, # - + 0x0c60, 0x0c61, # - + 0x0c85, 0x0c8c, # - + 0x0c8e, 0x0c90, # - + 0x0c92, 0x0ca8, # - + 0x0caa, 0x0cb3, # - + 0x0cb5, 0x0cb9, # - + 0x0ce0, 0x0ce1, # - + 0x0d05, 0x0d0c, # - + 0x0d0e, 0x0d10, # - + 0x0d12, 0x0d28, # - + 0x0d2a, 0x0d39, # - + 0x0d60, 0x0d61, # - + 0x0e01, 0x0e30, # - + 0x0e32, 0x0e33, # - + 0x0e40, 0x0e46, # - + 0x0e5a, 0x0e5b, # - + 0x0e81, 0x0e82, # - + 0x0e87, 0x0e88, # - + 0x0e94, 0x0e97, # - + 0x0e99, 0x0e9f, # - + 0x0ea1, 0x0ea3, # - + 0x0eaa, 0x0eab, # - + 0x0ead, 0x0eae, # - + 0x0eb2, 0x0eb3, # - + 0x0ec0, 0x0ec4, # - + 0x0edc, 0x0edd, # - + 0x0f18, 0x0f19, # - + 0x0f40, 0x0f47, # - + 0x0f49, 0x0f69, # - + 0x10d0, 0x10f6, # - + 0x1100, 0x1159, # - + 0x115f, 0x11a2, # - + 0x11a8, 0x11f9, # - + 0x1e00, 0x1e9b, # - + 0x1f50, 0x1f57, # - + 0x1f80, 0x1fb4, # - + 0x1fb6, 0x1fbc, # - + 0x1fc2, 0x1fc4, # - + 0x1fc6, 0x1fcc, # - + 0x1fd0, 0x1fd3, # - + 0x1fd6, 0x1fdb, # - + 0x1fe0, 0x1fec, # - + 0x1ff2, 0x1ff4, # - + 0x1ff6, 0x1ffc, # - + 0x210a, 0x2113, # - + 0x2115, 0x211d, # - + 0x2120, 0x2122, # - + 0x212a, 0x2131, # - + 0x2133, 0x2138, # - + 0x3041, 0x3094, # - + 0x30a1, 0x30fa, # - + 0x3105, 0x312c, # - + 0x3131, 0x318e, # - + 0x3192, 0x319f, # - + 0x3260, 0x327b, # - + 0x328a, 0x32b0, # - + 0x32d0, 0x32fe, # - + 0x3300, 0x3357, # - + 0x3371, 0x3376, # - + 0x337b, 0x3394, # - + 0x3399, 0x339e, # - + 0x33a9, 0x33ad, # - + 0x33b0, 0x33c1, # - + 0x33c3, 0x33c5, # - + 0x33c7, 0x33d7, # - + 0x33d9, 0x33dd, # - + 0x4e00, 0x9fff, # - + 0xac00, 0xd7a3, # - + 0xf900, 0xfb06, # - + 0xfb13, 0xfb17, # - + 0xfb1f, 0xfb28, # - + 0xfb2a, 0xfb36, # - + 0xfb38, 0xfb3c, # - + 0xfb40, 0xfb41, # - + 0xfb43, 0xfb44, # - + 0xfb46, 0xfbb1, # - + 0xfbd3, 0xfd3d, # - + 0xfd50, 0xfd8f, # - + 0xfd92, 0xfdc7, # - + 0xfdf0, 0xfdf9, # - + 0xfe70, 0xfe72, # - + 0xfe76, 0xfefc, # - + 0xff66, 0xff6f, # - + 0xff71, 0xff9d, # - + 0xffa0, 0xffbe, # - + 0xffc2, 0xffc7, # - + 0xffca, 0xffcf, # - + 0xffd2, 0xffd7, # - + 0xffda, 0xffdc] # - alphaSinglets = [ - 0x00aa, # - 0x00b5, # - 0x00ba, # - 0x03da, # - 0x03dc, # - 0x03de, # - 0x03e0, # - 0x06d5, # - 0x09b2, # - 0x0a5e, # - 0x0a8d, # - 0x0ae0, # - 0x0b9c, # - 0x0cde, # - 0x0e4f, # - 0x0e84, # - 0x0e8a, # - 0x0e8d, # - 0x0ea5, # - 0x0ea7, # - 0x0eb0, # - 0x0ebd, # - 0x1fbe, # - 0x207f, # - 0x20a8, # - 0x2102, # - 0x2107, # - 0x2124, # - 0x2126, # - 0x2128, # - 0xfb3e, # - 0xfe74] # + 0x00aa, # + 0x00b5, # + 0x00ba, # + 0x03da, # + 0x03dc, # + 0x03de, # + 0x03e0, # + 0x06d5, # + 0x09b2, # + 0x0a5e, # + 0x0a8d, # + 0x0ae0, # + 0x0b9c, # + 0x0cde, # + 0x0e4f, # + 0x0e84, # + 0x0e8a, # + 0x0e8d, # + 0x0ea5, # + 0x0ea7, # + 0x0eb0, # + 0x0ebd, # + 0x1fbe, # + 0x207f, # + 0x20a8, # + 0x2102, # + 0x2107, # + 0x2124, # + 0x2126, # + 0x2128, # + 0xfb3e, # + 0xfe74] # spaceRanges = [ - 0x0009, 0x000a, # tab and newline - 0x0020, 0x0020, # space - 0x00a0, 0x00a0, # - 0x2000, 0x200b, # - - 0x2028, 0x2029, # - 0x3000, 0x3000, # - 0xfeff, 0xfeff] # + 0x0009, 0x000a, # tab and newline + 0x0020, 0x0020, # space + 0x00a0, 0x00a0, # + 0x2000, 0x200b, # - + 0x2028, 0x2029, # - 0x3000, 0x3000, # + 0xfeff, 0xfeff] # toupperRanges = [ - 0x0061, 0x007a, 468, # a-z A-Z - 0x00e0, 0x00f6, 468, # - - - 0x00f8, 0x00fe, 468, # - - - 0x0256, 0x0257, 295, # - - - 0x0258, 0x0259, 298, # - - - 0x028a, 0x028b, 283, # - - - 0x03ad, 0x03af, 463, # - - - 0x03b1, 0x03c1, 468, # - - - 0x03c3, 0x03cb, 468, # - - - 0x03cd, 0x03ce, 437, # - - - 0x0430, 0x044f, 468, # - - - 0x0451, 0x045c, 420, # - - - 0x045e, 0x045f, 420, # - - - 0x0561, 0x0586, 452, # - - - 0x1f00, 0x1f07, 508, # - - - 0x1f10, 0x1f15, 508, # - - - 0x1f20, 0x1f27, 508, # - - - 0x1f30, 0x1f37, 508, # - - - 0x1f40, 0x1f45, 508, # - - - 0x1f60, 0x1f67, 508, # - - - 0x1f70, 0x1f71, 574, # - - - 0x1f72, 0x1f75, 586, # - - - 0x1f76, 0x1f77, 600, # - - - 0x1f78, 0x1f79, 628, # - - - 0x1f7a, 0x1f7b, 612, # - - - 0x1f7c, 0x1f7d, 626, # - - - 0x1f80, 0x1f87, 508, # - - - 0x1f90, 0x1f97, 508, # - - - 0x1fa0, 0x1fa7, 508, # - - - 0x1fb0, 0x1fb1, 508, # - - - 0x1fd0, 0x1fd1, 508, # - - - 0x1fe0, 0x1fe1, 508, # - - - 0x2170, 0x217f, 484, # - - - 0x24d0, 0x24e9, 474, # - - - 0xff41, 0xff5a, 468] # - - + 0x0061, 0x007a, 468, # a-z A-Z + 0x00e0, 0x00f6, 468, # - - + 0x00f8, 0x00fe, 468, # - - + 0x0256, 0x0257, 295, # - - + 0x0258, 0x0259, 298, # - - + 0x028a, 0x028b, 283, # - - + 0x03ad, 0x03af, 463, # - - + 0x03b1, 0x03c1, 468, # - - + 0x03c3, 0x03cb, 468, # - - + 0x03cd, 0x03ce, 437, # - - + 0x0430, 0x044f, 468, # - - + 0x0451, 0x045c, 420, # - - + 0x045e, 0x045f, 420, # - - + 0x0561, 0x0586, 452, # - - + 0x1f00, 0x1f07, 508, # - - + 0x1f10, 0x1f15, 508, # - - + 0x1f20, 0x1f27, 508, # - - + 0x1f30, 0x1f37, 508, # - - + 0x1f40, 0x1f45, 508, # - - + 0x1f60, 0x1f67, 508, # - - + 0x1f70, 0x1f71, 574, # - - + 0x1f72, 0x1f75, 586, # - - + 0x1f76, 0x1f77, 600, # - - + 0x1f78, 0x1f79, 628, # - - + 0x1f7a, 0x1f7b, 612, # - - + 0x1f7c, 0x1f7d, 626, # - - + 0x1f80, 0x1f87, 508, # - - + 0x1f90, 0x1f97, 508, # - - + 0x1fa0, 0x1fa7, 508, # - - + 0x1fb0, 0x1fb1, 508, # - - + 0x1fd0, 0x1fd1, 508, # - - + 0x1fe0, 0x1fe1, 508, # - - + 0x2170, 0x217f, 484, # - - + 0x24d0, 0x24e9, 474, # - - + 0xff41, 0xff5a, 468] # - - toupperSinglets = [ - 0x00ff, 621, # - 0x0101, 499, # - 0x0103, 499, # - 0x0105, 499, # - 0x0107, 499, # - 0x0109, 499, # - 0x010b, 499, # - 0x010d, 499, # - 0x010f, 499, # - 0x0111, 499, # - 0x0113, 499, # - 0x0115, 499, # - 0x0117, 499, # - 0x0119, 499, # - 0x011b, 499, # - 0x011d, 499, # - 0x011f, 499, # - 0x0121, 499, # - 0x0123, 499, # - 0x0125, 499, # - 0x0127, 499, # - 0x0129, 499, # - 0x012b, 499, # - 0x012d, 499, # - 0x012f, 499, # - 0x0131, 268, # I - 0x0133, 499, # - 0x0135, 499, # - 0x0137, 499, # - 0x013a, 499, # - 0x013c, 499, # - 0x013e, 499, # - 0x0140, 499, # - 0x0142, 499, # - 0x0144, 499, # - 0x0146, 499, # - 0x0148, 499, # - 0x014b, 499, # - 0x014d, 499, # - 0x014f, 499, # - 0x0151, 499, # - 0x0153, 499, # - 0x0155, 499, # - 0x0157, 499, # - 0x0159, 499, # - 0x015b, 499, # - 0x015d, 499, # - 0x015f, 499, # - 0x0161, 499, # - 0x0163, 499, # - 0x0165, 499, # - 0x0167, 499, # - 0x0169, 499, # - 0x016b, 499, # - 0x016d, 499, # - 0x016f, 499, # - 0x0171, 499, # - 0x0173, 499, # - 0x0175, 499, # - 0x0177, 499, # - 0x017a, 499, # - 0x017c, 499, # - 0x017e, 499, # - 0x017f, 200, # S - 0x0183, 499, # - 0x0185, 499, # - 0x0188, 499, # - 0x018c, 499, # - 0x0192, 499, # - 0x0199, 499, # - 0x01a1, 499, # - 0x01a3, 499, # - 0x01a5, 499, # - 0x01a8, 499, # - 0x01ad, 499, # - 0x01b0, 499, # - 0x01b4, 499, # - 0x01b6, 499, # - 0x01b9, 499, # - 0x01bd, 499, # - 0x01c5, 499, # - 0x01c6, 498, # - 0x01c8, 499, # - 0x01c9, 498, # - 0x01cb, 499, # - 0x01cc, 498, # - 0x01ce, 499, # - 0x01d0, 499, # - 0x01d2, 499, # - 0x01d4, 499, # - 0x01d6, 499, # - 0x01d8, 499, # - 0x01da, 499, # - 0x01dc, 499, # - 0x01df, 499, # - 0x01e1, 499, # - 0x01e3, 499, # - 0x01e5, 499, # - 0x01e7, 499, # - 0x01e9, 499, # - 0x01eb, 499, # - 0x01ed, 499, # - 0x01ef, 499, # - 0x01f2, 499, # - 0x01f3, 498, # - 0x01f5, 499, # - 0x01fb, 499, # - 0x01fd, 499, # - 0x01ff, 499, # - 0x0201, 499, # - 0x0203, 499, # - 0x0205, 499, # - 0x0207, 499, # - 0x0209, 499, # - 0x020b, 499, # - 0x020d, 499, # - 0x020f, 499, # - 0x0211, 499, # - 0x0213, 499, # - 0x0215, 499, # - 0x0217, 499, # - 0x0253, 290, # - 0x0254, 294, # - 0x025b, 297, # - 0x0260, 295, # - 0x0263, 293, # - 0x0268, 291, # - 0x0269, 289, # - 0x026f, 289, # - 0x0272, 287, # - 0x0283, 282, # - 0x0288, 282, # - 0x0292, 281, # - 0x03ac, 462, # - 0x03cc, 436, # - 0x03d0, 438, # - 0x03d1, 443, # - 0x03d5, 453, # - 0x03d6, 446, # - 0x03e3, 499, # - 0x03e5, 499, # - 0x03e7, 499, # - 0x03e9, 499, # - 0x03eb, 499, # - 0x03ed, 499, # - 0x03ef, 499, # - 0x03f0, 414, # - 0x03f1, 420, # - 0x0461, 499, # - 0x0463, 499, # - 0x0465, 499, # - 0x0467, 499, # - 0x0469, 499, # - 0x046b, 499, # - 0x046d, 499, # - 0x046f, 499, # - 0x0471, 499, # - 0x0473, 499, # - 0x0475, 499, # - 0x0477, 499, # - 0x0479, 499, # - 0x047b, 499, # - 0x047d, 499, # - 0x047f, 499, # - 0x0481, 499, # - 0x0491, 499, # - 0x0493, 499, # - 0x0495, 499, # - 0x0497, 499, # - 0x0499, 499, # - 0x049b, 499, # - 0x049d, 499, # - 0x049f, 499, # - 0x04a1, 499, # - 0x04a3, 499, # - 0x04a5, 499, # - 0x04a7, 499, # - 0x04a9, 499, # - 0x04ab, 499, # - 0x04ad, 499, # - 0x04af, 499, # - 0x04b1, 499, # - 0x04b3, 499, # - 0x04b5, 499, # - 0x04b7, 499, # - 0x04b9, 499, # - 0x04bb, 499, # - 0x04bd, 499, # - 0x04bf, 499, # - 0x04c2, 499, # - 0x04c4, 499, # - 0x04c8, 499, # - 0x04cc, 499, # - 0x04d1, 499, # - 0x04d3, 499, # - 0x04d5, 499, # - 0x04d7, 499, # - 0x04d9, 499, # - 0x04db, 499, # - 0x04dd, 499, # - 0x04df, 499, # - 0x04e1, 499, # - 0x04e3, 499, # - 0x04e5, 499, # - 0x04e7, 499, # - 0x04e9, 499, # - 0x04eb, 499, # - 0x04ef, 499, # - 0x04f1, 499, # - 0x04f3, 499, # - 0x04f5, 499, # - 0x04f9, 499, # - 0x1e01, 499, # - 0x1e03, 499, # - 0x1e05, 499, # - 0x1e07, 499, # - 0x1e09, 499, # - 0x1e0b, 499, # - 0x1e0d, 499, # - 0x1e0f, 499, # - 0x1e11, 499, # - 0x1e13, 499, # - 0x1e15, 499, # - 0x1e17, 499, # - 0x1e19, 499, # - 0x1e1b, 499, # - 0x1e1d, 499, # - 0x1e1f, 499, # - 0x1e21, 499, # - 0x1e23, 499, # - 0x1e25, 499, # - 0x1e27, 499, # - 0x1e29, 499, # - 0x1e2b, 499, # - 0x1e2d, 499, # - 0x1e2f, 499, # - 0x1e31, 499, # - 0x1e33, 499, # - 0x1e35, 499, # - 0x1e37, 499, # - 0x1e39, 499, # - 0x1e3b, 499, # - 0x1e3d, 499, # - 0x1e3f, 499, # - 0x1e41, 499, # - 0x1e43, 499, # - 0x1e45, 499, # - 0x1e47, 499, # - 0x1e49, 499, # - 0x1e4b, 499, # - 0x1e4d, 499, # - 0x1e4f, 499, # - 0x1e51, 499, # - 0x1e53, 499, # - 0x1e55, 499, # - 0x1e57, 499, # - 0x1e59, 499, # - 0x1e5b, 499, # - 0x1e5d, 499, # - 0x1e5f, 499, # - 0x1e61, 499, # - 0x1e63, 499, # - 0x1e65, 499, # - 0x1e67, 499, # - 0x1e69, 499, # - 0x1e6b, 499, # - 0x1e6d, 499, # - 0x1e6f, 499, # - 0x1e71, 499, # - 0x1e73, 499, # - 0x1e75, 499, # - 0x1e77, 499, # - 0x1e79, 499, # - 0x1e7b, 499, # - 0x1e7d, 499, # - 0x1e7f, 499, # - 0x1e81, 499, # - 0x1e83, 499, # - 0x1e85, 499, # - 0x1e87, 499, # - 0x1e89, 499, # - 0x1e8b, 499, # - 0x1e8d, 499, # - 0x1e8f, 499, # - 0x1e91, 499, # - 0x1e93, 499, # - 0x1e95, 499, # - 0x1ea1, 499, # - 0x1ea3, 499, # - 0x1ea5, 499, # - 0x1ea7, 499, # - 0x1ea9, 499, # - 0x1eab, 499, # - 0x1ead, 499, # - 0x1eaf, 499, # - 0x1eb1, 499, # - 0x1eb3, 499, # - 0x1eb5, 499, # - 0x1eb7, 499, # - 0x1eb9, 499, # - 0x1ebb, 499, # - 0x1ebd, 499, # - 0x1ebf, 499, # - 0x1ec1, 499, # - 0x1ec3, 499, # - 0x1ec5, 499, # - 0x1ec7, 499, # - 0x1ec9, 499, # - 0x1ecb, 499, # - 0x1ecd, 499, # - 0x1ecf, 499, # - 0x1ed1, 499, # - 0x1ed3, 499, # - 0x1ed5, 499, # - 0x1ed7, 499, # - 0x1ed9, 499, # - 0x1edb, 499, # - 0x1edd, 499, # - 0x1edf, 499, # - 0x1ee1, 499, # - 0x1ee3, 499, # - 0x1ee5, 499, # - 0x1ee7, 499, # - 0x1ee9, 499, # - 0x1eeb, 499, # - 0x1eed, 499, # - 0x1eef, 499, # - 0x1ef1, 499, # - 0x1ef3, 499, # - 0x1ef5, 499, # - 0x1ef7, 499, # - 0x1ef9, 499, # - 0x1f51, 508, # - 0x1f53, 508, # - 0x1f55, 508, # - 0x1f57, 508, # - 0x1fb3, 509, # - 0x1fc3, 509, # - 0x1fe5, 507, # - 0x1ff3, 509] # + 0x00ff, 621, # + 0x0101, 499, # + 0x0103, 499, # + 0x0105, 499, # + 0x0107, 499, # + 0x0109, 499, # + 0x010b, 499, # + 0x010d, 499, # + 0x010f, 499, # + 0x0111, 499, # + 0x0113, 499, # + 0x0115, 499, # + 0x0117, 499, # + 0x0119, 499, # + 0x011b, 499, # + 0x011d, 499, # + 0x011f, 499, # + 0x0121, 499, # + 0x0123, 499, # + 0x0125, 499, # + 0x0127, 499, # + 0x0129, 499, # + 0x012b, 499, # + 0x012d, 499, # + 0x012f, 499, # + 0x0131, 268, # I + 0x0133, 499, # + 0x0135, 499, # + 0x0137, 499, # + 0x013a, 499, # + 0x013c, 499, # + 0x013e, 499, # + 0x0140, 499, # + 0x0142, 499, # + 0x0144, 499, # + 0x0146, 499, # + 0x0148, 499, # + 0x014b, 499, # + 0x014d, 499, # + 0x014f, 499, # + 0x0151, 499, # + 0x0153, 499, # + 0x0155, 499, # + 0x0157, 499, # + 0x0159, 499, # + 0x015b, 499, # + 0x015d, 499, # + 0x015f, 499, # + 0x0161, 499, # + 0x0163, 499, # + 0x0165, 499, # + 0x0167, 499, # + 0x0169, 499, # + 0x016b, 499, # + 0x016d, 499, # + 0x016f, 499, # + 0x0171, 499, # + 0x0173, 499, # + 0x0175, 499, # + 0x0177, 499, # + 0x017a, 499, # + 0x017c, 499, # + 0x017e, 499, # + 0x017f, 200, # S + 0x0183, 499, # + 0x0185, 499, # + 0x0188, 499, # + 0x018c, 499, # + 0x0192, 499, # + 0x0199, 499, # + 0x01a1, 499, # + 0x01a3, 499, # + 0x01a5, 499, # + 0x01a8, 499, # + 0x01ad, 499, # + 0x01b0, 499, # + 0x01b4, 499, # + 0x01b6, 499, # + 0x01b9, 499, # + 0x01bd, 499, # + 0x01c5, 499, # + 0x01c6, 498, # + 0x01c8, 499, # + 0x01c9, 498, # + 0x01cb, 499, # + 0x01cc, 498, # + 0x01ce, 499, # + 0x01d0, 499, # + 0x01d2, 499, # + 0x01d4, 499, # + 0x01d6, 499, # + 0x01d8, 499, # + 0x01da, 499, # + 0x01dc, 499, # + 0x01df, 499, # + 0x01e1, 499, # + 0x01e3, 499, # + 0x01e5, 499, # + 0x01e7, 499, # + 0x01e9, 499, # + 0x01eb, 499, # + 0x01ed, 499, # + 0x01ef, 499, # + 0x01f2, 499, # + 0x01f3, 498, # + 0x01f5, 499, # + 0x01fb, 499, # + 0x01fd, 499, # + 0x01ff, 499, # + 0x0201, 499, # + 0x0203, 499, # + 0x0205, 499, # + 0x0207, 499, # + 0x0209, 499, # + 0x020b, 499, # + 0x020d, 499, # + 0x020f, 499, # + 0x0211, 499, # + 0x0213, 499, # + 0x0215, 499, # + 0x0217, 499, # + 0x0253, 290, # + 0x0254, 294, # + 0x025b, 297, # + 0x0260, 295, # + 0x0263, 293, # + 0x0268, 291, # + 0x0269, 289, # + 0x026f, 289, # + 0x0272, 287, # + 0x0283, 282, # + 0x0288, 282, # + 0x0292, 281, # + 0x03ac, 462, # + 0x03cc, 436, # + 0x03d0, 438, # + 0x03d1, 443, # + 0x03d5, 453, # + 0x03d6, 446, # + 0x03e3, 499, # + 0x03e5, 499, # + 0x03e7, 499, # + 0x03e9, 499, # + 0x03eb, 499, # + 0x03ed, 499, # + 0x03ef, 499, # + 0x03f0, 414, # + 0x03f1, 420, # + 0x0461, 499, # + 0x0463, 499, # + 0x0465, 499, # + 0x0467, 499, # + 0x0469, 499, # + 0x046b, 499, # + 0x046d, 499, # + 0x046f, 499, # + 0x0471, 499, # + 0x0473, 499, # + 0x0475, 499, # + 0x0477, 499, # + 0x0479, 499, # + 0x047b, 499, # + 0x047d, 499, # + 0x047f, 499, # + 0x0481, 499, # + 0x0491, 499, # + 0x0493, 499, # + 0x0495, 499, # + 0x0497, 499, # + 0x0499, 499, # + 0x049b, 499, # + 0x049d, 499, # + 0x049f, 499, # + 0x04a1, 499, # + 0x04a3, 499, # + 0x04a5, 499, # + 0x04a7, 499, # + 0x04a9, 499, # + 0x04ab, 499, # + 0x04ad, 499, # + 0x04af, 499, # + 0x04b1, 499, # + 0x04b3, 499, # + 0x04b5, 499, # + 0x04b7, 499, # + 0x04b9, 499, # + 0x04bb, 499, # + 0x04bd, 499, # + 0x04bf, 499, # + 0x04c2, 499, # + 0x04c4, 499, # + 0x04c8, 499, # + 0x04cc, 499, # + 0x04d1, 499, # + 0x04d3, 499, # + 0x04d5, 499, # + 0x04d7, 499, # + 0x04d9, 499, # + 0x04db, 499, # + 0x04dd, 499, # + 0x04df, 499, # + 0x04e1, 499, # + 0x04e3, 499, # + 0x04e5, 499, # + 0x04e7, 499, # + 0x04e9, 499, # + 0x04eb, 499, # + 0x04ef, 499, # + 0x04f1, 499, # + 0x04f3, 499, # + 0x04f5, 499, # + 0x04f9, 499, # + 0x1e01, 499, # + 0x1e03, 499, # + 0x1e05, 499, # + 0x1e07, 499, # + 0x1e09, 499, # + 0x1e0b, 499, # + 0x1e0d, 499, # + 0x1e0f, 499, # + 0x1e11, 499, # + 0x1e13, 499, # + 0x1e15, 499, # + 0x1e17, 499, # + 0x1e19, 499, # + 0x1e1b, 499, # + 0x1e1d, 499, # + 0x1e1f, 499, # + 0x1e21, 499, # + 0x1e23, 499, # + 0x1e25, 499, # + 0x1e27, 499, # + 0x1e29, 499, # + 0x1e2b, 499, # + 0x1e2d, 499, # + 0x1e2f, 499, # + 0x1e31, 499, # + 0x1e33, 499, # + 0x1e35, 499, # + 0x1e37, 499, # + 0x1e39, 499, # + 0x1e3b, 499, # + 0x1e3d, 499, # + 0x1e3f, 499, # + 0x1e41, 499, # + 0x1e43, 499, # + 0x1e45, 499, # + 0x1e47, 499, # + 0x1e49, 499, # + 0x1e4b, 499, # + 0x1e4d, 499, # + 0x1e4f, 499, # + 0x1e51, 499, # + 0x1e53, 499, # + 0x1e55, 499, # + 0x1e57, 499, # + 0x1e59, 499, # + 0x1e5b, 499, # + 0x1e5d, 499, # + 0x1e5f, 499, # + 0x1e61, 499, # + 0x1e63, 499, # + 0x1e65, 499, # + 0x1e67, 499, # + 0x1e69, 499, # + 0x1e6b, 499, # + 0x1e6d, 499, # + 0x1e6f, 499, # + 0x1e71, 499, # + 0x1e73, 499, # + 0x1e75, 499, # + 0x1e77, 499, # + 0x1e79, 499, # + 0x1e7b, 499, # + 0x1e7d, 499, # + 0x1e7f, 499, # + 0x1e81, 499, # + 0x1e83, 499, # + 0x1e85, 499, # + 0x1e87, 499, # + 0x1e89, 499, # + 0x1e8b, 499, # + 0x1e8d, 499, # + 0x1e8f, 499, # + 0x1e91, 499, # + 0x1e93, 499, # + 0x1e95, 499, # + 0x1ea1, 499, # + 0x1ea3, 499, # + 0x1ea5, 499, # + 0x1ea7, 499, # + 0x1ea9, 499, # + 0x1eab, 499, # + 0x1ead, 499, # + 0x1eaf, 499, # + 0x1eb1, 499, # + 0x1eb3, 499, # + 0x1eb5, 499, # + 0x1eb7, 499, # + 0x1eb9, 499, # + 0x1ebb, 499, # + 0x1ebd, 499, # + 0x1ebf, 499, # + 0x1ec1, 499, # + 0x1ec3, 499, # + 0x1ec5, 499, # + 0x1ec7, 499, # + 0x1ec9, 499, # + 0x1ecb, 499, # + 0x1ecd, 499, # + 0x1ecf, 499, # + 0x1ed1, 499, # + 0x1ed3, 499, # + 0x1ed5, 499, # + 0x1ed7, 499, # + 0x1ed9, 499, # + 0x1edb, 499, # + 0x1edd, 499, # + 0x1edf, 499, # + 0x1ee1, 499, # + 0x1ee3, 499, # + 0x1ee5, 499, # + 0x1ee7, 499, # + 0x1ee9, 499, # + 0x1eeb, 499, # + 0x1eed, 499, # + 0x1eef, 499, # + 0x1ef1, 499, # + 0x1ef3, 499, # + 0x1ef5, 499, # + 0x1ef7, 499, # + 0x1ef9, 499, # + 0x1f51, 508, # + 0x1f53, 508, # + 0x1f55, 508, # + 0x1f57, 508, # + 0x1fb3, 509, # + 0x1fc3, 509, # + 0x1fe5, 507, # + 0x1ff3, 509] # tolowerRanges = [ 0x0041, 0x005a, 532, # A-Z a-z - 0x00c0, 0x00d6, 532, # - - - 0x00d8, 0x00de, 532, # - - - 0x0189, 0x018a, 705, # - - - 0x018e, 0x018f, 702, # - - - 0x01b1, 0x01b2, 717, # - - - 0x0388, 0x038a, 537, # - - - 0x038e, 0x038f, 563, # - - - 0x0391, 0x03a1, 532, # - - - 0x03a3, 0x03ab, 532, # - - - 0x0401, 0x040c, 580, # - - - 0x040e, 0x040f, 580, # - - - 0x0410, 0x042f, 532, # - - - 0x0531, 0x0556, 548, # - - - 0x10a0, 0x10c5, 548, # - - - 0x1f08, 0x1f0f, 492, # - - - 0x1f18, 0x1f1d, 492, # - - - 0x1f28, 0x1f2f, 492, # - - - 0x1f38, 0x1f3f, 492, # - - - 0x1f48, 0x1f4d, 492, # - - - 0x1f68, 0x1f6f, 492, # - - - 0x1f88, 0x1f8f, 492, # - - - 0x1f98, 0x1f9f, 492, # - - - 0x1fa8, 0x1faf, 492, # - - - 0x1fb8, 0x1fb9, 492, # - - - 0x1fba, 0x1fbb, 426, # - - - 0x1fc8, 0x1fcb, 414, # - - - 0x1fd8, 0x1fd9, 492, # - - - 0x1fda, 0x1fdb, 400, # - - - 0x1fe8, 0x1fe9, 492, # - - - 0x1fea, 0x1feb, 388, # - - - 0x1ff8, 0x1ff9, 372, # - - - 0x1ffa, 0x1ffb, 374, # - - - 0x2160, 0x216f, 516, # - - - 0x24b6, 0x24cf, 526, # - - - 0xff21, 0xff3a, 532] # - - + 0x00c0, 0x00d6, 532, # - - + 0x00d8, 0x00de, 532, # - - + 0x0189, 0x018a, 705, # - - + 0x018e, 0x018f, 702, # - - + 0x01b1, 0x01b2, 717, # - - + 0x0388, 0x038a, 537, # - - + 0x038e, 0x038f, 563, # - - + 0x0391, 0x03a1, 532, # - - + 0x03a3, 0x03ab, 532, # - - + 0x0401, 0x040c, 580, # - - + 0x040e, 0x040f, 580, # - - + 0x0410, 0x042f, 532, # - - + 0x0531, 0x0556, 548, # - - + 0x10a0, 0x10c5, 548, # - - + 0x1f08, 0x1f0f, 492, # - - + 0x1f18, 0x1f1d, 492, # - - + 0x1f28, 0x1f2f, 492, # - - + 0x1f38, 0x1f3f, 492, # - - + 0x1f48, 0x1f4d, 492, # - - + 0x1f68, 0x1f6f, 492, # - - + 0x1f88, 0x1f8f, 492, # - - + 0x1f98, 0x1f9f, 492, # - - + 0x1fa8, 0x1faf, 492, # - - + 0x1fb8, 0x1fb9, 492, # - - + 0x1fba, 0x1fbb, 426, # - - + 0x1fc8, 0x1fcb, 414, # - - + 0x1fd8, 0x1fd9, 492, # - - + 0x1fda, 0x1fdb, 400, # - - + 0x1fe8, 0x1fe9, 492, # - - + 0x1fea, 0x1feb, 388, # - - + 0x1ff8, 0x1ff9, 372, # - - + 0x1ffa, 0x1ffb, 374, # - - + 0x2160, 0x216f, 516, # - - + 0x24b6, 0x24cf, 526, # - - + 0xff21, 0xff3a, 532] # - - tolowerSinglets = [ - 0x0100, 501, # - 0x0102, 501, # - 0x0104, 501, # - 0x0106, 501, # - 0x0108, 501, # - 0x010a, 501, # - 0x010c, 501, # - 0x010e, 501, # - 0x0110, 501, # - 0x0112, 501, # - 0x0114, 501, # - 0x0116, 501, # - 0x0118, 501, # - 0x011a, 501, # - 0x011c, 501, # - 0x011e, 501, # - 0x0120, 501, # - 0x0122, 501, # - 0x0124, 501, # - 0x0126, 501, # - 0x0128, 501, # - 0x012a, 501, # - 0x012c, 501, # - 0x012e, 501, # - 0x0130, 301, # i - 0x0132, 501, # - 0x0134, 501, # - 0x0136, 501, # - 0x0139, 501, # - 0x013b, 501, # - 0x013d, 501, # - 0x013f, 501, # - 0x0141, 501, # - 0x0143, 501, # - 0x0145, 501, # - 0x0147, 501, # - 0x014a, 501, # - 0x014c, 501, # - 0x014e, 501, # - 0x0150, 501, # - 0x0152, 501, # - 0x0154, 501, # - 0x0156, 501, # - 0x0158, 501, # - 0x015a, 501, # - 0x015c, 501, # - 0x015e, 501, # - 0x0160, 501, # - 0x0162, 501, # - 0x0164, 501, # - 0x0166, 501, # - 0x0168, 501, # - 0x016a, 501, # - 0x016c, 501, # - 0x016e, 501, # - 0x0170, 501, # - 0x0172, 501, # - 0x0174, 501, # - 0x0176, 501, # - 0x0178, 379, # - 0x0179, 501, # - 0x017b, 501, # - 0x017d, 501, # - 0x0181, 710, # - 0x0182, 501, # - 0x0184, 501, # - 0x0186, 706, # - 0x0187, 501, # - 0x018b, 501, # - 0x0190, 703, # - 0x0191, 501, # - 0x0193, 705, # - 0x0194, 707, # - 0x0196, 711, # - 0x0197, 709, # - 0x0198, 501, # - 0x019c, 711, # - 0x019d, 713, # - 0x01a0, 501, # - 0x01a2, 501, # - 0x01a4, 501, # - 0x01a7, 501, # - 0x01a9, 718, # - 0x01ac, 501, # - 0x01ae, 718, # - 0x01af, 501, # - 0x01b3, 501, # - 0x01b5, 501, # - 0x01b7, 719, # - 0x01b8, 501, # - 0x01bc, 501, # - 0x01c4, 502, # - 0x01c5, 501, # - 0x01c7, 502, # - 0x01c8, 501, # - 0x01ca, 502, # - 0x01cb, 501, # - 0x01cd, 501, # - 0x01cf, 501, # - 0x01d1, 501, # - 0x01d3, 501, # - 0x01d5, 501, # - 0x01d7, 501, # - 0x01d9, 501, # - 0x01db, 501, # - 0x01de, 501, # - 0x01e0, 501, # - 0x01e2, 501, # - 0x01e4, 501, # - 0x01e6, 501, # - 0x01e8, 501, # - 0x01ea, 501, # - 0x01ec, 501, # - 0x01ee, 501, # - 0x01f1, 502, # - 0x01f2, 501, # - 0x01f4, 501, # - 0x01fa, 501, # - 0x01fc, 501, # - 0x01fe, 501, # - 0x0200, 501, # - 0x0202, 501, # - 0x0204, 501, # - 0x0206, 501, # - 0x0208, 501, # - 0x020a, 501, # - 0x020c, 501, # - 0x020e, 501, # - 0x0210, 501, # - 0x0212, 501, # - 0x0214, 501, # - 0x0216, 501, # - 0x0386, 538, # - 0x038c, 564, # - 0x03e2, 501, # - 0x03e4, 501, # - 0x03e6, 501, # - 0x03e8, 501, # - 0x03ea, 501, # - 0x03ec, 501, # - 0x03ee, 501, # - 0x0460, 501, # - 0x0462, 501, # - 0x0464, 501, # - 0x0466, 501, # - 0x0468, 501, # - 0x046a, 501, # - 0x046c, 501, # - 0x046e, 501, # - 0x0470, 501, # - 0x0472, 501, # - 0x0474, 501, # - 0x0476, 501, # - 0x0478, 501, # - 0x047a, 501, # - 0x047c, 501, # - 0x047e, 501, # - 0x0480, 501, # - 0x0490, 501, # - 0x0492, 501, # - 0x0494, 501, # - 0x0496, 501, # - 0x0498, 501, # - 0x049a, 501, # - 0x049c, 501, # - 0x049e, 501, # - 0x04a0, 501, # - 0x04a2, 501, # - 0x04a4, 501, # - 0x04a6, 501, # - 0x04a8, 501, # - 0x04aa, 501, # - 0x04ac, 501, # - 0x04ae, 501, # - 0x04b0, 501, # - 0x04b2, 501, # - 0x04b4, 501, # - 0x04b6, 501, # - 0x04b8, 501, # - 0x04ba, 501, # - 0x04bc, 501, # - 0x04be, 501, # - 0x04c1, 501, # - 0x04c3, 501, # - 0x04c7, 501, # - 0x04cb, 501, # - 0x04d0, 501, # - 0x04d2, 501, # - 0x04d4, 501, # - 0x04d6, 501, # - 0x04d8, 501, # - 0x04da, 501, # - 0x04dc, 501, # - 0x04de, 501, # - 0x04e0, 501, # - 0x04e2, 501, # - 0x04e4, 501, # - 0x04e6, 501, # - 0x04e8, 501, # - 0x04ea, 501, # - 0x04ee, 501, # - 0x04f0, 501, # - 0x04f2, 501, # - 0x04f4, 501, # - 0x04f8, 501, # - 0x1e00, 501, # - 0x1e02, 501, # - 0x1e04, 501, # - 0x1e06, 501, # - 0x1e08, 501, # - 0x1e0a, 501, # - 0x1e0c, 501, # - 0x1e0e, 501, # - 0x1e10, 501, # - 0x1e12, 501, # - 0x1e14, 501, # - 0x1e16, 501, # - 0x1e18, 501, # - 0x1e1a, 501, # - 0x1e1c, 501, # - 0x1e1e, 501, # - 0x1e20, 501, # - 0x1e22, 501, # - 0x1e24, 501, # - 0x1e26, 501, # - 0x1e28, 501, # - 0x1e2a, 501, # - 0x1e2c, 501, # - 0x1e2e, 501, # - 0x1e30, 501, # - 0x1e32, 501, # - 0x1e34, 501, # - 0x1e36, 501, # - 0x1e38, 501, # - 0x1e3a, 501, # - 0x1e3c, 501, # - 0x1e3e, 501, # - 0x1e40, 501, # - 0x1e42, 501, # - 0x1e44, 501, # - 0x1e46, 501, # - 0x1e48, 501, # - 0x1e4a, 501, # - 0x1e4c, 501, # - 0x1e4e, 501, # - 0x1e50, 501, # - 0x1e52, 501, # - 0x1e54, 501, # - 0x1e56, 501, # - 0x1e58, 501, # - 0x1e5a, 501, # - 0x1e5c, 501, # - 0x1e5e, 501, # - 0x1e60, 501, # - 0x1e62, 501, # - 0x1e64, 501, # - 0x1e66, 501, # - 0x1e68, 501, # - 0x1e6a, 501, # - 0x1e6c, 501, # - 0x1e6e, 501, # - 0x1e70, 501, # - 0x1e72, 501, # - 0x1e74, 501, # - 0x1e76, 501, # - 0x1e78, 501, # - 0x1e7a, 501, # - 0x1e7c, 501, # - 0x1e7e, 501, # - 0x1e80, 501, # - 0x1e82, 501, # - 0x1e84, 501, # - 0x1e86, 501, # - 0x1e88, 501, # - 0x1e8a, 501, # - 0x1e8c, 501, # - 0x1e8e, 501, # - 0x1e90, 501, # - 0x1e92, 501, # - 0x1e94, 501, # - 0x1ea0, 501, # - 0x1ea2, 501, # - 0x1ea4, 501, # - 0x1ea6, 501, # - 0x1ea8, 501, # - 0x1eaa, 501, # - 0x1eac, 501, # - 0x1eae, 501, # - 0x1eb0, 501, # - 0x1eb2, 501, # - 0x1eb4, 501, # - 0x1eb6, 501, # - 0x1eb8, 501, # - 0x1eba, 501, # - 0x1ebc, 501, # - 0x1ebe, 501, # - 0x1ec0, 501, # - 0x1ec2, 501, # - 0x1ec4, 501, # - 0x1ec6, 501, # - 0x1ec8, 501, # - 0x1eca, 501, # - 0x1ecc, 501, # - 0x1ece, 501, # - 0x1ed0, 501, # - 0x1ed2, 501, # - 0x1ed4, 501, # - 0x1ed6, 501, # - 0x1ed8, 501, # - 0x1eda, 501, # - 0x1edc, 501, # - 0x1ede, 501, # - 0x1ee0, 501, # - 0x1ee2, 501, # - 0x1ee4, 501, # - 0x1ee6, 501, # - 0x1ee8, 501, # - 0x1eea, 501, # - 0x1eec, 501, # - 0x1eee, 501, # - 0x1ef0, 501, # - 0x1ef2, 501, # - 0x1ef4, 501, # - 0x1ef6, 501, # - 0x1ef8, 501, # - 0x1f59, 492, # - 0x1f5b, 492, # - 0x1f5d, 492, # - 0x1f5f, 492, # - 0x1fbc, 491, # - 0x1fcc, 491, # - 0x1fec, 493, # - 0x1ffc, 491] # + 0x0100, 501, # + 0x0102, 501, # + 0x0104, 501, # + 0x0106, 501, # + 0x0108, 501, # + 0x010a, 501, # + 0x010c, 501, # + 0x010e, 501, # + 0x0110, 501, # + 0x0112, 501, # + 0x0114, 501, # + 0x0116, 501, # + 0x0118, 501, # + 0x011a, 501, # + 0x011c, 501, # + 0x011e, 501, # + 0x0120, 501, # + 0x0122, 501, # + 0x0124, 501, # + 0x0126, 501, # + 0x0128, 501, # + 0x012a, 501, # + 0x012c, 501, # + 0x012e, 501, # + 0x0130, 301, # i + 0x0132, 501, # + 0x0134, 501, # + 0x0136, 501, # + 0x0139, 501, # + 0x013b, 501, # + 0x013d, 501, # + 0x013f, 501, # + 0x0141, 501, # + 0x0143, 501, # + 0x0145, 501, # + 0x0147, 501, # + 0x014a, 501, # + 0x014c, 501, # + 0x014e, 501, # + 0x0150, 501, # + 0x0152, 501, # + 0x0154, 501, # + 0x0156, 501, # + 0x0158, 501, # + 0x015a, 501, # + 0x015c, 501, # + 0x015e, 501, # + 0x0160, 501, # + 0x0162, 501, # + 0x0164, 501, # + 0x0166, 501, # + 0x0168, 501, # + 0x016a, 501, # + 0x016c, 501, # + 0x016e, 501, # + 0x0170, 501, # + 0x0172, 501, # + 0x0174, 501, # + 0x0176, 501, # + 0x0178, 379, # + 0x0179, 501, # + 0x017b, 501, # + 0x017d, 501, # + 0x0181, 710, # + 0x0182, 501, # + 0x0184, 501, # + 0x0186, 706, # + 0x0187, 501, # + 0x018b, 501, # + 0x0190, 703, # + 0x0191, 501, # + 0x0193, 705, # + 0x0194, 707, # + 0x0196, 711, # + 0x0197, 709, # + 0x0198, 501, # + 0x019c, 711, # + 0x019d, 713, # + 0x01a0, 501, # + 0x01a2, 501, # + 0x01a4, 501, # + 0x01a7, 501, # + 0x01a9, 718, # + 0x01ac, 501, # + 0x01ae, 718, # + 0x01af, 501, # + 0x01b3, 501, # + 0x01b5, 501, # + 0x01b7, 719, # + 0x01b8, 501, # + 0x01bc, 501, # + 0x01c4, 502, # + 0x01c5, 501, # + 0x01c7, 502, # + 0x01c8, 501, # + 0x01ca, 502, # + 0x01cb, 501, # + 0x01cd, 501, # + 0x01cf, 501, # + 0x01d1, 501, # + 0x01d3, 501, # + 0x01d5, 501, # + 0x01d7, 501, # + 0x01d9, 501, # + 0x01db, 501, # + 0x01de, 501, # + 0x01e0, 501, # + 0x01e2, 501, # + 0x01e4, 501, # + 0x01e6, 501, # + 0x01e8, 501, # + 0x01ea, 501, # + 0x01ec, 501, # + 0x01ee, 501, # + 0x01f1, 502, # + 0x01f2, 501, # + 0x01f4, 501, # + 0x01fa, 501, # + 0x01fc, 501, # + 0x01fe, 501, # + 0x0200, 501, # + 0x0202, 501, # + 0x0204, 501, # + 0x0206, 501, # + 0x0208, 501, # + 0x020a, 501, # + 0x020c, 501, # + 0x020e, 501, # + 0x0210, 501, # + 0x0212, 501, # + 0x0214, 501, # + 0x0216, 501, # + 0x0386, 538, # + 0x038c, 564, # + 0x03e2, 501, # + 0x03e4, 501, # + 0x03e6, 501, # + 0x03e8, 501, # + 0x03ea, 501, # + 0x03ec, 501, # + 0x03ee, 501, # + 0x0460, 501, # + 0x0462, 501, # + 0x0464, 501, # + 0x0466, 501, # + 0x0468, 501, # + 0x046a, 501, # + 0x046c, 501, # + 0x046e, 501, # + 0x0470, 501, # + 0x0472, 501, # + 0x0474, 501, # + 0x0476, 501, # + 0x0478, 501, # + 0x047a, 501, # + 0x047c, 501, # + 0x047e, 501, # + 0x0480, 501, # + 0x0490, 501, # + 0x0492, 501, # + 0x0494, 501, # + 0x0496, 501, # + 0x0498, 501, # + 0x049a, 501, # + 0x049c, 501, # + 0x049e, 501, # + 0x04a0, 501, # + 0x04a2, 501, # + 0x04a4, 501, # + 0x04a6, 501, # + 0x04a8, 501, # + 0x04aa, 501, # + 0x04ac, 501, # + 0x04ae, 501, # + 0x04b0, 501, # + 0x04b2, 501, # + 0x04b4, 501, # + 0x04b6, 501, # + 0x04b8, 501, # + 0x04ba, 501, # + 0x04bc, 501, # + 0x04be, 501, # + 0x04c1, 501, # + 0x04c3, 501, # + 0x04c7, 501, # + 0x04cb, 501, # + 0x04d0, 501, # + 0x04d2, 501, # + 0x04d4, 501, # + 0x04d6, 501, # + 0x04d8, 501, # + 0x04da, 501, # + 0x04dc, 501, # + 0x04de, 501, # + 0x04e0, 501, # + 0x04e2, 501, # + 0x04e4, 501, # + 0x04e6, 501, # + 0x04e8, 501, # + 0x04ea, 501, # + 0x04ee, 501, # + 0x04f0, 501, # + 0x04f2, 501, # + 0x04f4, 501, # + 0x04f8, 501, # + 0x1e00, 501, # + 0x1e02, 501, # + 0x1e04, 501, # + 0x1e06, 501, # + 0x1e08, 501, # + 0x1e0a, 501, # + 0x1e0c, 501, # + 0x1e0e, 501, # + 0x1e10, 501, # + 0x1e12, 501, # + 0x1e14, 501, # + 0x1e16, 501, # + 0x1e18, 501, # + 0x1e1a, 501, # + 0x1e1c, 501, # + 0x1e1e, 501, # + 0x1e20, 501, # + 0x1e22, 501, # + 0x1e24, 501, # + 0x1e26, 501, # + 0x1e28, 501, # + 0x1e2a, 501, # + 0x1e2c, 501, # + 0x1e2e, 501, # + 0x1e30, 501, # + 0x1e32, 501, # + 0x1e34, 501, # + 0x1e36, 501, # + 0x1e38, 501, # + 0x1e3a, 501, # + 0x1e3c, 501, # + 0x1e3e, 501, # + 0x1e40, 501, # + 0x1e42, 501, # + 0x1e44, 501, # + 0x1e46, 501, # + 0x1e48, 501, # + 0x1e4a, 501, # + 0x1e4c, 501, # + 0x1e4e, 501, # + 0x1e50, 501, # + 0x1e52, 501, # + 0x1e54, 501, # + 0x1e56, 501, # + 0x1e58, 501, # + 0x1e5a, 501, # + 0x1e5c, 501, # + 0x1e5e, 501, # + 0x1e60, 501, # + 0x1e62, 501, # + 0x1e64, 501, # + 0x1e66, 501, # + 0x1e68, 501, # + 0x1e6a, 501, # + 0x1e6c, 501, # + 0x1e6e, 501, # + 0x1e70, 501, # + 0x1e72, 501, # + 0x1e74, 501, # + 0x1e76, 501, # + 0x1e78, 501, # + 0x1e7a, 501, # + 0x1e7c, 501, # + 0x1e7e, 501, # + 0x1e80, 501, # + 0x1e82, 501, # + 0x1e84, 501, # + 0x1e86, 501, # + 0x1e88, 501, # + 0x1e8a, 501, # + 0x1e8c, 501, # + 0x1e8e, 501, # + 0x1e90, 501, # + 0x1e92, 501, # + 0x1e94, 501, # + 0x1ea0, 501, # + 0x1ea2, 501, # + 0x1ea4, 501, # + 0x1ea6, 501, # + 0x1ea8, 501, # + 0x1eaa, 501, # + 0x1eac, 501, # + 0x1eae, 501, # + 0x1eb0, 501, # + 0x1eb2, 501, # + 0x1eb4, 501, # + 0x1eb6, 501, # + 0x1eb8, 501, # + 0x1eba, 501, # + 0x1ebc, 501, # + 0x1ebe, 501, # + 0x1ec0, 501, # + 0x1ec2, 501, # + 0x1ec4, 501, # + 0x1ec6, 501, # + 0x1ec8, 501, # + 0x1eca, 501, # + 0x1ecc, 501, # + 0x1ece, 501, # + 0x1ed0, 501, # + 0x1ed2, 501, # + 0x1ed4, 501, # + 0x1ed6, 501, # + 0x1ed8, 501, # + 0x1eda, 501, # + 0x1edc, 501, # + 0x1ede, 501, # + 0x1ee0, 501, # + 0x1ee2, 501, # + 0x1ee4, 501, # + 0x1ee6, 501, # + 0x1ee8, 501, # + 0x1eea, 501, # + 0x1eec, 501, # + 0x1eee, 501, # + 0x1ef0, 501, # + 0x1ef2, 501, # + 0x1ef4, 501, # + 0x1ef6, 501, # + 0x1ef8, 501, # + 0x1f59, 492, # + 0x1f5b, 492, # + 0x1f5d, 492, # + 0x1f5f, 492, # + 0x1fbc, 491, # + 0x1fcc, 491, # + 0x1fec, 493, # + 0x1ffc, 491] # toTitleSinglets = [ - 0x01c4, 501, # - 0x01c6, 499, # - 0x01c7, 501, # - 0x01c9, 499, # - 0x01ca, 501, # - 0x01cc, 499, # - 0x01f1, 501, # - 0x01f3, 499] # + 0x01c4, 501, # + 0x01c6, 499, # + 0x01c7, 501, # + 0x01c9, 499, # + 0x01ca, 501, # + 0x01cc, 499, # + 0x01f1, 501, # + 0x01f3, 499] # -proc binarySearch(c: RuneImpl, tab: openArray[RuneImpl], len, stride: int): int = +proc binarySearch(c: RuneImpl, tab: openArray[RuneImpl], len, stride: int): int = var n = len var t = 0 - while n > 1: + while n > 1: var m = n div 2 var p = t + m*stride if c >= tab[p]: @@ -1131,9 +1131,9 @@ proc binarySearch(c: RuneImpl, tab: openArray[RuneImpl], len, stride: int): int return t return -1 -proc toLower*(c: Rune): Rune {.rtl, extern: "nuc$1", procvar.} = +proc toLower*(c: Rune): Rune {.rtl, extern: "nuc$1", procvar.} = ## Converts `c` into lower case. This works for any Unicode character. - ## If possible, prefer `toLower` over `toUpper`. + ## If possible, prefer `toLower` over `toUpper`. var c = RuneImpl(c) var p = binarySearch(c, tolowerRanges, len(tolowerRanges) div 3, 3) if p >= 0 and c >= tolowerRanges[p] and c <= tolowerRanges[p+1]: @@ -1143,9 +1143,9 @@ proc toLower*(c: Rune): Rune {.rtl, extern: "nuc$1", procvar.} = return Rune(c + tolowerSinglets[p+1] - 500) return Rune(c) -proc toUpper*(c: Rune): Rune {.rtl, extern: "nuc$1", procvar.} = +proc toUpper*(c: Rune): Rune {.rtl, extern: "nuc$1", procvar.} = ## Converts `c` into upper case. This works for any Unicode character. - ## If possible, prefer `toLower` over `toUpper`. + ## If possible, prefer `toLower` over `toUpper`. var c = RuneImpl(c) var p = binarySearch(c, toupperRanges, len(toupperRanges) div 3, 3) if p >= 0 and c >= toupperRanges[p] and c <= toupperRanges[p+1]: @@ -1155,16 +1155,16 @@ proc toUpper*(c: Rune): Rune {.rtl, extern: "nuc$1", procvar.} = return Rune(c + toupperSinglets[p+1] - 500) return Rune(c) -proc toTitle*(c: Rune): Rune {.rtl, extern: "nuc$1", procvar.} = +proc toTitle*(c: Rune): Rune {.rtl, extern: "nuc$1", procvar.} = var c = RuneImpl(c) var p = binarySearch(c, toTitleSinglets, len(toTitleSinglets) div 2, 2) if p >= 0 and c == toTitleSinglets[p]: return Rune(c + toTitleSinglets[p+1] - 500) return Rune(c) -proc isLower*(c: Rune): bool {.rtl, extern: "nuc$1", procvar.} = +proc isLower*(c: Rune): bool {.rtl, extern: "nuc$1", procvar.} = ## returns true iff `c` is a lower case Unicode character - ## If possible, prefer `isLower` over `isUpper`. + ## If possible, prefer `isLower` over `isUpper`. var c = RuneImpl(c) # Note: toUpperRanges is correct here! var p = binarySearch(c, toupperRanges, len(toupperRanges) div 3, 3) @@ -1174,9 +1174,9 @@ proc isLower*(c: Rune): bool {.rtl, extern: "nuc$1", procvar.} = if p >= 0 and c == toupperSinglets[p]: return true -proc isUpper*(c: Rune): bool {.rtl, extern: "nuc$1", procvar.} = +proc isUpper*(c: Rune): bool {.rtl, extern: "nuc$1", procvar.} = ## returns true iff `c` is a upper case Unicode character - ## If possible, prefer `isLower` over `isUpper`. + ## If possible, prefer `isLower` over `isUpper`. var c = RuneImpl(c) # Note: toLowerRanges is correct here! var p = binarySearch(c, tolowerRanges, len(tolowerRanges) div 3, 3) @@ -1186,9 +1186,9 @@ proc isUpper*(c: Rune): bool {.rtl, extern: "nuc$1", procvar.} = if p >= 0 and c == tolowerSinglets[p]: return true -proc isAlpha*(c: Rune): bool {.rtl, extern: "nuc$1", procvar.} = +proc isAlpha*(c: Rune): bool {.rtl, extern: "nuc$1", procvar.} = ## returns true iff `c` is an *alpha* Unicode character (i.e. a letter) - if isUpper(c) or isLower(c): + if isUpper(c) or isLower(c): return true var c = RuneImpl(c) var p = binarySearch(c, alphaRanges, len(alphaRanges) div 2, 2) @@ -1197,11 +1197,11 @@ proc isAlpha*(c: Rune): bool {.rtl, extern: "nuc$1", procvar.} = p = binarySearch(c, alphaSinglets, len(alphaSinglets), 1) if p >= 0 and c == alphaSinglets[p]: return true - -proc isTitle*(c: Rune): bool {.rtl, extern: "nuc$1", procvar.} = + +proc isTitle*(c: Rune): bool {.rtl, extern: "nuc$1", procvar.} = return isUpper(c) and isLower(c) -proc isWhiteSpace*(c: Rune): bool {.rtl, extern: "nuc$1", procvar.} = +proc isWhiteSpace*(c: Rune): bool {.rtl, extern: "nuc$1", procvar.} = ## returns true iff `c` is a Unicode whitespace character var c = RuneImpl(c) var p = binarySearch(c, spaceRanges, len(spaceRanges) div 2, 2) @@ -1228,7 +1228,7 @@ iterator runes*(s: string): Rune = fastRuneAt(s, i, result, true) yield result -proc cmpRunesIgnoreCase*(a, b: string): int {.rtl, extern: "nuc$1", procvar.} = +proc cmpRunesIgnoreCase*(a, b: string): int {.rtl, extern: "nuc$1", procvar.} = ## compares two UTF8 strings and ignores the case. Returns: ## ## | 0 iff a == b diff --git a/lib/pure/unidecode/unidecode.nim b/lib/pure/unidecode/unidecode.nim index 798eef5d0..a83b9be0f 100644 --- a/lib/pure/unidecode/unidecode.nim +++ b/lib/pure/unidecode/unidecode.nim @@ -70,5 +70,5 @@ proc unidecode*(s: string): string = when isMainModule: loadUnidecodeTable("lib/pure/unidecode/unidecode.dat") - echo unidecode("Äußerst") + assert unidecode("Äußerst") == "Ausserst" diff --git a/lib/pure/xmldom.nim b/lib/pure/xmldom.nim index 6242e589e..6cf837f25 100644 --- a/lib/pure/xmldom.nim +++ b/lib/pure/xmldom.nim @@ -365,23 +365,21 @@ discard """proc getElementById*(doc: PDocument, elementId: string): PElement = proc getElementsByTagName*(doc: PDocument, tagName: string): seq[PNode] = ## Returns a NodeList of all the Elements with a given tag name in ## the order in which they are encountered in a preorder traversal of the Document tree. - var result: seq[PNode] = @[] + result = @[] if doc.fDocumentElement.fNodeName == tagName or tagName == "*": result.add(doc.fDocumentElement) result.add(doc.fDocumentElement.findNodes(tagName)) - return result proc getElementsByTagNameNS*(doc: PDocument, namespaceURI: string, localName: string): seq[PNode] = ## Returns a NodeList of all the Elements with a given localName and namespaceURI ## in the order in which they are encountered in a preorder traversal of the Document tree. - var result: seq[PNode] = @[] + result = @[] if doc.fDocumentElement.fLocalName == localName or localName == "*": if doc.fDocumentElement.fNamespaceURI == namespaceURI or namespaceURI == "*": result.add(doc.fDocumentElement) result.add(doc.fDocumentElement.findNodesNS(namespaceURI, localName)) - return result proc importNode*(doc: PDocument, importedNode: PNode, deep: bool): PNode = ## Imports a node from another document to this document @@ -677,7 +675,7 @@ proc removeChild*(n: PNode, oldChild: PNode): PNode = if n.childNodes[i] == oldChild: result = n.childNodes[i] n.childNodes.delete(i) - return result + return raise newException(ENotFoundErr, "Node not found") @@ -693,7 +691,7 @@ proc replaceChild*(n: PNode, newChild: PNode, oldChild: PNode): PNode = if n.childNodes[i] == oldChild: result = n.childNodes[i] n.childNodes[i] = newChild - return result + return raise newException(ENotFoundErr, "Node not found") @@ -740,7 +738,7 @@ proc removeNamedItem*(nList: var seq[PNode], name: string): PNode = if nList[i].fNodeName == name: result = nList[i] nList.delete(i) - return result + return raise newException(ENotFoundErr, "Node not found") @@ -750,7 +748,7 @@ proc removeNamedItemNS*(nList: var seq[PNode], namespaceURI: string, localName: if nList[i].fLocalName == localName and nList[i].fNamespaceURI == namespaceURI: result = nList[i] nList.delete(i) - return result + return raise newException(ENotFoundErr, "Node not found") @@ -965,7 +963,7 @@ proc removeAttributeNode*(el: PElement, oldAttr: PAttr): PAttr = if el.attributes[i] == oldAttr: result = el.attributes[i] el.attributes.delete(i) - return result + return raise newException(ENotFoundErr, "oldAttr is not a member of el's Attributes") diff --git a/lib/pure/xmldomparser.nim b/lib/pure/xmldomparser.nim index 7f34d72a8..050362435 100644 --- a/lib/pure/xmldomparser.nim +++ b/lib/pure/xmldomparser.nim @@ -155,7 +155,7 @@ proc loadXMLFile*(path: string): PDocument = return loadXMLStream(s) -when isMainModule: +when not defined(testing) and isMainModule: var xml = loadXMLFile("nim/xmldom/test.xml") #echo(xml.getElementsByTagName("m:test2")[0].namespaceURI) #echo(xml.getElementsByTagName("bla:test")[0].namespaceURI) diff --git a/lib/pure/xmlparser.nim b/lib/pure/xmlparser.nim index 755bfcdbc..840cae734 100644 --- a/lib/pure/xmlparser.nim +++ b/lib/pure/xmlparser.nim @@ -143,7 +143,7 @@ proc loadXml*(path: string): XmlNode = result = loadXml(path, errors) if errors.len > 0: raiseInvalidXml(errors) -when isMainModule: +when not defined(testing) and isMainModule: import os var errors: seq[string] = @[] diff --git a/lib/pure/xmltree.nim b/lib/pure/xmltree.nim index 0bf5b52a4..7526a989a 100644 --- a/lib/pure/xmltree.nim +++ b/lib/pure/xmltree.nim @@ -353,5 +353,6 @@ proc findAll*(n: XmlNode, tag: string): seq[XmlNode] = findAll(n, tag, result) when isMainModule: - assert """<a href="http://nim-lang.org">Nim rules.</a>""" == + let link = "http://nim-lang.org" + assert """<a href="""" & escape(link) & """">Nim rules.</a>""" == $(<>a(href="http://nim-lang.org", newText("Nim rules."))) diff --git a/lib/system.nim b/lib/system.nim index d4e3fa2b3..1805dd813 100644 --- a/lib/system.nim +++ b/lib/system.nim @@ -76,6 +76,10 @@ type void* {.magic: "VoidType".} ## meta type to denote the absence of any type auto* = expr any* = distinct auto + untyped* {.magic: Expr.} ## meta type to denote an expression that + ## is not resolved (for templates) + typed* {.magic: Stmt.} ## meta type to denote an expression that + ## is resolved (for templates) SomeSignedInt* = int|int8|int16|int32|int64 ## type class matching all signed integer types @@ -140,6 +144,16 @@ proc declaredInScope*(x: expr): bool {. ## Special compile-time procedure that checks whether `x` is ## declared in the current scope. `x` has to be an identifier. +proc `addr`*[T](x: var T): ptr T {.magic: "Addr", noSideEffect.} = + ## Builtin 'addr' operator for taking the address of a memory location. + ## Cannot be overloaded. + discard + +proc `type`*(x: expr): typeDesc {.magic: "TypeOf", noSideEffect.} = + ## Builtin 'type' operator for accessing the type of an expression. + ## Cannot be overloaded. + discard + proc `not` *(x: bool): bool {.magic: "Not", noSideEffect.} ## Boolean not; returns true iff ``x == false``. @@ -163,12 +177,6 @@ proc new*(T: typedesc): ref T = ## reference to it as result value new(result) -proc unsafeNew*[T](a: var ref T, size: int) {.magic: "New", noSideEffect.} - ## creates a new object of type ``T`` and returns a safe (traced) - ## reference to it in ``a``. This is **unsafe** as it allocates an object - ## of the passed ``size``. This should only be used for optimization - ## purposes when you know what you're doing! - proc internalNew*[T](a: var ref T) {.magic: "New", noSideEffect.} ## leaked implementation detail. Do not use. @@ -212,13 +220,13 @@ type set*{.magic: "Set".}[T] ## Generic type to construct bit sets. type - Slice* {.final, pure.}[T] = object ## builtin slice type - a*, b*: T ## the bounds + Slice*[T] = object ## builtin slice type + a*, b*: T ## the bounds when defined(nimalias): {.deprecated: [TSlice: Slice].} -proc `..`*[T](a, b: T): Slice[T] {.noSideEffect, inline.} = +proc `..`*[T](a, b: T): Slice[T] {.noSideEffect, inline, magic: "DotDot".} = ## `slice`:idx: operator that constructs an interval ``[a, b]``, both `a` ## and `b` are inclusive. Slices can also be used in the set constructor ## and in ordinal case statements, but then they are special-cased by the @@ -226,7 +234,7 @@ proc `..`*[T](a, b: T): Slice[T] {.noSideEffect, inline.} = result.a = a result.b = b -proc `..`*[T](b: T): Slice[T] {.noSideEffect, inline.} = +proc `..`*[T](b: T): Slice[T] {.noSideEffect, inline, magic: "DotDot".} = ## `slice`:idx: operator that constructs an interval ``[default(T), b]`` result.b = b @@ -503,7 +511,13 @@ type ESynch: Exception ].} -proc sizeof*[T](x: T): Natural {.magic: "SizeOf", noSideEffect.} +proc unsafeNew*[T](a: var ref T, size: Natural) {.magic: "New", noSideEffect.} + ## creates a new object of type ``T`` and returns a safe (traced) + ## reference to it in ``a``. This is **unsafe** as it allocates an object + ## of the passed ``size``. This should only be used for optimization + ## purposes when you know what you're doing! + +proc sizeof*[T](x: T): int {.magic: "SizeOf", noSideEffect.} ## returns the size of ``x`` in bytes. Since this is a low-level proc, ## its usage is discouraged - using ``new`` for the most cases suffices ## that one never needs to know ``x``'s size. As a special semantic rule, @@ -537,7 +551,7 @@ proc dec*[T: Ordinal|uint|uint64](x: var T, y = 1) {.magic: "Dec", noSideEffect. ## exist, ``EOutOfRange`` is raised or a compile time error occurs. This is a ## short notation for: ``x = pred(x, y)``. -proc newSeq*[T](s: var seq[T], len: int) {.magic: "NewSeq", noSideEffect.} +proc newSeq*[T](s: var seq[T], len: Natural) {.magic: "NewSeq", noSideEffect.} ## creates a new sequence of type ``seq[T]`` with length ``len``. ## This is equivalent to ``s = @[]; setlen(s, len)``, but more ## efficient since no reallocation is needed. @@ -555,7 +569,7 @@ proc newSeq*[T](s: var seq[T], len: int) {.magic: "NewSeq", noSideEffect.} ## inputStrings[2] = "would crash" ## #inputStrings[3] = "out of bounds" -proc newSeq*[T](len = 0): seq[T] = +proc newSeq*[T](len = 0.Natural): seq[T] = ## creates a new sequence of type ``seq[T]`` with length ``len``. ## ## Note that the sequence will be filled with zeroed entries, which can be a @@ -649,7 +663,7 @@ proc `+` *(x: int): int {.magic: "UnaryPlusI", noSideEffect.} proc `+` *(x: int8): int8 {.magic: "UnaryPlusI", noSideEffect.} proc `+` *(x: int16): int16 {.magic: "UnaryPlusI", noSideEffect.} proc `+` *(x: int32): int32 {.magic: "UnaryPlusI", noSideEffect.} -proc `+` *(x: int64): int64 {.magic: "UnaryPlusI64", noSideEffect.} +proc `+` *(x: int64): int64 {.magic: "UnaryPlusI", noSideEffect.} ## Unary `+` operator for an integer. Has no effect. proc `-` *(x: int): int {.magic: "UnaryMinusI", noSideEffect.} @@ -694,6 +708,7 @@ proc `div` *(x, y: int32): int32 {.magic: "DivI", noSideEffect.} proc `div` *(x, y: int64): int64 {.magic: "DivI64", noSideEffect.} ## computes the integer division. This is roughly the same as ## ``floor(x/y)``. + ## ## .. code-block:: Nim ## 1 div 2 == 0 ## 2 div 2 == 1 @@ -713,6 +728,7 @@ proc `shr` *(x, y: int16): int16 {.magic: "ShrI", noSideEffect.} proc `shr` *(x, y: int32): int32 {.magic: "ShrI", noSideEffect.} proc `shr` *(x, y: int64): int64 {.magic: "ShrI64", noSideEffect.} ## computes the `shift right` operation of `x` and `y`. + ## ## .. code-block:: Nim ## 0b0001_0000'i8 shr 2 == 0b0100_0000'i8 ## 0b1000_0000'i8 shr 2 == 0b0000_0000'i8 @@ -927,7 +943,7 @@ proc `@` * [IDX, T](a: array[IDX, T]): seq[T] {. ## sequences with the array constructor: ``@[1, 2, 3]`` has the type ## ``seq[int]``, while ``[1, 2, 3]`` has the type ``array[0..2, int]``. -proc setLen*[T](s: var seq[T], newlen: int) {. +proc setLen*[T](s: var seq[T], newlen: Natural) {. magic: "SetLengthSeq", noSideEffect.} ## sets the length of `s` to `newlen`. ## ``T`` may be any sequence type. @@ -935,14 +951,14 @@ proc setLen*[T](s: var seq[T], newlen: int) {. ## ``s`` will be truncated. `s` cannot be nil! To initialize a sequence with ## a size, use ``newSeq`` instead. -proc setLen*(s: var string, newlen: int) {. +proc setLen*(s: var string, newlen: Natural) {. magic: "SetLengthStr", noSideEffect.} ## sets the length of `s` to `newlen`. ## If the current length is greater than the new length, ## ``s`` will be truncated. `s` cannot be nil! To initialize a string with ## a size, use ``newString`` instead. -proc newString*(len: int): string {. +proc newString*(len: Natural): string {. magic: "NewString", importc: "mnewString", noSideEffect.} ## returns a new string of length ``len`` but with uninitialized ## content. One needs to fill the string character after character @@ -950,7 +966,7 @@ proc newString*(len: int): string {. ## optimization purposes; the same effect can be achieved with the ## ``&`` operator or with ``add``. -proc newStringOfCap*(cap: int): string {. +proc newStringOfCap*(cap: Natural): string {. magic: "NewStringOfCap", importc: "rawNewString", noSideEffect.} ## returns a new string of length ``0`` but with capacity `cap`.This ## procedure exists only for optimization purposes; the same effect can @@ -1140,21 +1156,21 @@ proc shallowCopy*[T](x: var T, y: T) {.noSideEffect, magic: "ShallowCopy".} ## is a reason why the default assignment does a deep copy of sequences ## and strings. -proc del*[T](x: var seq[T], i: int) {.noSideEffect.} = +proc del*[T](x: var seq[T], i: Natural) {.noSideEffect.} = ## deletes the item at index `i` by putting ``x[high(x)]`` into position `i`. ## This is an O(1) operation. let xl = x.len shallowCopy(x[i], x[xl-1]) setLen(x, xl-1) -proc delete*[T](x: var seq[T], i: int) {.noSideEffect.} = +proc delete*[T](x: var seq[T], i: Natural) {.noSideEffect.} = ## deletes the item at index `i` by moving ``x[i+1..]`` by one position. ## This is an O(n) operation. let xl = x.len for j in i..xl-2: shallowCopy(x[j], x[j+1]) setLen(x, xl-1) -proc insert*[T](x: var seq[T], item: T, i = 0) {.noSideEffect.} = +proc insert*[T](x: var seq[T], item: T, i = 0.Natural) {.noSideEffect.} = ## inserts `item` into `x` at position `i`. let xl = x.len setLen(x, xl+1) @@ -1224,7 +1240,7 @@ type # these work for most platforms: ## This is the same as the type ``unsigned char`` in *C*. cushort* {.importc: "unsigned short", nodecl.} = uint16 ## This is the same as the type ``unsigned short`` in *C*. - cuint* {.importc: "int", nodecl.} = uint32 + cuint* {.importc: "unsigned int", nodecl.} = uint32 ## This is the same as the type ``unsigned int`` in *C*. culonglong* {.importc: "unsigned long long", nodecl.} = uint64 ## This is the same as the type ``unsigned long long`` in *C*. @@ -1300,19 +1316,19 @@ proc substr*(s: string, first, last: int): string {. ## or `limit`:idx: a string's length. when not defined(nimrodVM): - proc zeroMem*(p: pointer, size: int) {.importc, noDecl, benign.} + proc zeroMem*(p: pointer, size: Natural) {.importc, noDecl, benign.} ## overwrites the contents of the memory at ``p`` with the value 0. ## Exactly ``size`` bytes will be overwritten. Like any procedure ## dealing with raw memory this is *unsafe*. - proc copyMem*(dest, source: pointer, size: int) {. + proc copyMem*(dest, source: pointer, size: Natural) {. importc: "memcpy", header: "<string.h>", benign.} ## copies the contents from the memory at ``source`` to the memory ## at ``dest``. Exactly ``size`` bytes will be copied. The memory ## regions may not overlap. Like any procedure dealing with raw ## memory this is *unsafe*. - proc moveMem*(dest, source: pointer, size: int) {. + proc moveMem*(dest, source: pointer, size: Natural) {. importc: "memmove", header: "<string.h>", benign.} ## copies the contents from the memory at ``source`` to the memory ## at ``dest``. Exactly ``size`` bytes will be copied. The memory @@ -1320,7 +1336,7 @@ when not defined(nimrodVM): ## and is thus somewhat more safe than ``copyMem``. Like any procedure ## dealing with raw memory this is still *unsafe*, though. - proc equalMem*(a, b: pointer, size: int): bool {. + proc equalMem*(a, b: pointer, size: Natural): bool {. importc: "equalMem", noDecl, noSideEffect.} ## compares the memory blocks ``a`` and ``b``. ``size`` bytes will ## be compared. If the blocks are equal, true is returned, false @@ -1328,7 +1344,7 @@ when not defined(nimrodVM): ## *unsafe*. when hostOS != "standalone": - proc alloc*(size: int): pointer {.noconv, rtl, tags: [], benign.} + proc alloc*(size: Natural): pointer {.noconv, rtl, tags: [], benign.} ## allocates a new memory block with at least ``size`` bytes. The ## block has to be freed with ``realloc(block, 0)`` or ## ``dealloc(block)``. The block is not initialized, so reading @@ -1343,7 +1359,7 @@ when not defined(nimrodVM): ## The allocated memory belongs to its allocating thread! ## Use `createSharedU` to allocate from a shared heap. cast[ptr T](alloc(T.sizeof * size)) - proc alloc0*(size: int): pointer {.noconv, rtl, tags: [], benign.} + proc alloc0*(size: Natural): pointer {.noconv, rtl, tags: [], benign.} ## allocates a new memory block with at least ``size`` bytes. The ## block has to be freed with ``realloc(block, 0)`` or ## ``dealloc(block)``. The block is initialized with all bytes @@ -1358,8 +1374,8 @@ when not defined(nimrodVM): ## The allocated memory belongs to its allocating thread! ## Use `createShared` to allocate from a shared heap. cast[ptr T](alloc0(T.sizeof * size)) - proc realloc*(p: pointer, newSize: int): pointer {.noconv, rtl, tags: [], - benign.} + proc realloc*(p: pointer, newSize: Natural): pointer {.noconv, rtl, tags: [], + benign.} ## grows or shrinks a given memory block. If p is **nil** then a new ## memory block is returned. In either way the block has at least ## ``newSize`` bytes. If ``newSize == 0`` and p is not **nil** @@ -1386,7 +1402,7 @@ when not defined(nimrodVM): ## Use `deallocShared` to deallocate from a shared heap. proc free*[T](p: ptr T) {.inline, benign.} = dealloc(p) - proc allocShared*(size: int): pointer {.noconv, rtl, benign.} + proc allocShared*(size: Natural): pointer {.noconv, rtl, benign.} ## allocates a new memory block on the shared heap with at ## least ``size`` bytes. The block has to be freed with ## ``reallocShared(block, 0)`` or ``deallocShared(block)``. The block @@ -1400,7 +1416,7 @@ when not defined(nimrodVM): ## is not initialized, so reading from it before writing to it is ## undefined behaviour! cast[ptr T](allocShared(T.sizeof * size)) - proc allocShared0*(size: int): pointer {.noconv, rtl, benign.} + proc allocShared0*(size: Natural): pointer {.noconv, rtl, benign.} ## allocates a new memory block on the shared heap with at ## least ``size`` bytes. The block has to be freed with ## ``reallocShared(block, 0)`` or ``deallocShared(block)``. @@ -1413,8 +1429,8 @@ when not defined(nimrodVM): ## The block is initialized with all bytes ## containing zero, so it is somewhat safer than ``createSharedU``. cast[ptr T](allocShared0(T.sizeof * size)) - proc reallocShared*(p: pointer, newSize: int): pointer {.noconv, rtl, - benign.} + proc reallocShared*(p: pointer, newSize: Natural): pointer {.noconv, rtl, + benign.} ## grows or shrinks a given memory block on the heap. If p is **nil** ## then a new memory block is returned. In either way the block has at ## least ``newSize`` bytes. If ``newSize == 0`` and p is not **nil** @@ -1557,9 +1573,9 @@ when not defined(nimrodVM) and hostOS != "standalone": ## process. This is only available when threads are enabled. when sizeof(int) <= 2: - type IntLikeForCount = int|int8|int16|char|bool|uint8 + type IntLikeForCount = int|int8|int16|char|bool|uint8|enum else: - type IntLikeForCount = int|int8|int16|int32|char|bool|uint8|uint16 + type IntLikeForCount = int|int8|int16|int32|char|bool|uint8|uint16|enum iterator countdown*[T](a, b: T, step = 1): T {.inline.} = ## Counts from ordinal value `a` down to `b` with the given @@ -1622,7 +1638,7 @@ proc min*(x, y: int16): int16 {.magic: "MinI", noSideEffect.} = if x <= y: x else: y proc min*(x, y: int32): int32 {.magic: "MinI", noSideEffect.} = if x <= y: x else: y -proc min*(x, y: int64): int64 {.magic: "MinI64", noSideEffect.} = +proc min*(x, y: int64): int64 {.magic: "MinI", noSideEffect.} = ## The minimum value of two integers. if x <= y: x else: y @@ -1640,7 +1656,7 @@ proc max*(x, y: int16): int16 {.magic: "MaxI", noSideEffect.} = if y <= x: x else: y proc max*(x, y: int32): int32 {.magic: "MaxI", noSideEffect.} = if y <= x: x else: y -proc max*(x, y: int64): int64 {.magic: "MaxI64", noSideEffect.} = +proc max*(x, y: int64): int64 {.magic: "MaxI", noSideEffect.} = ## The maximum value of two integers. if y <= x: x else: y @@ -1704,12 +1720,10 @@ iterator items*[T](a: set[T]): T {.inline.} = ## iterates over each element of `a`. `items` iterates only over the ## elements that are really in the set (and not over the ones the set is ## able to hold). - var i = low(T) - if i <= high(T): - while true: - if i in a: yield i - if i >= high(T): break - inc(i) + var i = low(T).int + while i <= high(T).int: + if T(i) in a: yield T(i) + inc(i) iterator items*(a: cstring): char {.inline.} = ## iterates over each item of `a`. @@ -1730,6 +1744,12 @@ iterator items*(E: typedesc[enum]): E = for v in low(E)..high(E): yield v +iterator items*[T](s: Slice[T]): T = + ## iterates over the slice `s`, yielding each value between `s.a` and `s.b` + ## (inclusively). + for x in s.a..s.b: + yield x + iterator pairs*[T](a: openArray[T]): tuple[key: int, val: T] {.inline.} = ## iterates over each item of `a`. Yields ``(index, a[index])`` pairs. var i = 0 @@ -2479,37 +2499,37 @@ when not defined(JS): #and not defined(NimrodVM): proc getFileSize*(f: File): int64 {.tags: [ReadIOEffect], benign.} ## retrieves the file size (in bytes) of `f`. - proc readBytes*(f: File, a: var openArray[int8|uint8], start, len: int): int {. + proc readBytes*(f: File, a: var openArray[int8|uint8], start, len: Natural): int {. tags: [ReadIOEffect], benign.} ## reads `len` bytes into the buffer `a` starting at ``a[start]``. Returns ## the actual number of bytes that have been read which may be less than ## `len` (if not as many bytes are remaining), but not greater. - proc readChars*(f: File, a: var openArray[char], start, len: int): int {. + proc readChars*(f: File, a: var openArray[char], start, len: Natural): int {. tags: [ReadIOEffect], benign.} ## reads `len` bytes into the buffer `a` starting at ``a[start]``. Returns ## the actual number of bytes that have been read which may be less than ## `len` (if not as many bytes are remaining), but not greater. - proc readBuffer*(f: File, buffer: pointer, len: int): int {. + proc readBuffer*(f: File, buffer: pointer, len: Natural): int {. tags: [ReadIOEffect], benign.} ## reads `len` bytes into the buffer pointed to by `buffer`. Returns ## the actual number of bytes that have been read which may be less than ## `len` (if not as many bytes are remaining), but not greater. - proc writeBytes*(f: File, a: openArray[int8|uint8], start, len: int): int {. + proc writeBytes*(f: File, a: openArray[int8|uint8], start, len: Natural): int {. tags: [WriteIOEffect], benign.} ## writes the bytes of ``a[start..start+len-1]`` to the file `f`. Returns ## the number of actual written bytes, which may be less than `len` in case ## of an error. - proc writeChars*(f: File, a: openArray[char], start, len: int): int {. + proc writeChars*(f: File, a: openArray[char], start, len: Natural): int {. tags: [WriteIOEffect], benign.} ## writes the bytes of ``a[start..start+len-1]`` to the file `f`. Returns ## the number of actual written bytes, which may be less than `len` in case ## of an error. - proc writeBuffer*(f: File, buffer: pointer, len: int): int {. + proc writeBuffer*(f: File, buffer: pointer, len: Natural): int {. tags: [WriteIOEffect], benign.} ## writes the bytes of buffer pointed to by the parameter `buffer` to the ## file `f`. Returns the number of actual written bytes, which may be less @@ -2531,7 +2551,7 @@ when not defined(JS): #and not defined(NimrodVM): when not defined(nimfix): {.deprecated: [fileHandle: getFileHandle].} - proc cstringArrayToSeq*(a: cstringArray, len: int): seq[string] = + proc cstringArrayToSeq*(a: cstringArray, len: Natural): seq[string] = ## converts a ``cstringArray`` to a ``seq[string]``. `a` is supposed to be ## of length ``len``. newSeq(result, len) @@ -2801,14 +2821,14 @@ elif defined(JS): proc getTotalMem(): int = return -1 proc dealloc(p: pointer) = discard - proc alloc(size: int): pointer = discard - proc alloc0(size: int): pointer = discard - proc realloc(p: pointer, newsize: int): pointer = discard + proc alloc(size: Natural): pointer = discard + proc alloc0(size: Natural): pointer = discard + proc realloc(p: pointer, newsize: Natural): pointer = discard - proc allocShared(size: int): pointer = discard - proc allocShared0(size: int): pointer = discard + proc allocShared(size: Natural): pointer = discard + proc allocShared0(size: Natural): pointer = discard proc deallocShared(p: pointer) = discard - proc reallocShared(p: pointer, newsize: int): pointer = discard + proc reallocShared(p: pointer, newsize: Natural): pointer = discard when defined(JS): include "system/jssys" @@ -2856,28 +2876,27 @@ template spliceImpl(s, a, L, b: expr): stmt {.immediate.} = when hostOS != "standalone": proc `[]`*(s: string, x: Slice[int]): string {.inline.} = - ## slice operation for strings. Negative indexes are supported. - result = s.substr(x.a-|s, x.b-|s) + ## slice operation for strings. + result = s.substr(x.a, x.b) proc `[]=`*(s: var string, x: Slice[int], b: string) = - ## slice assignment for strings. Negative indexes are supported. If + ## slice assignment for strings. If ## ``b.len`` is not exactly the number of elements that are referred to ## by `x`, a `splice`:idx: is performed: ## ## .. code-block:: nim ## var s = "abcdef" - ## s[1 .. -2] = "xyz" + ## s[1 .. ^2] = "xyz" ## assert s == "axyzf" - var a = x.a-|s - var L = x.b-|s - a + 1 + var a = x.a + var L = x.b - a + 1 if L == b.len: for i in 0 .. <L: s[i+a] = b[i] else: spliceImpl(s, a, L, b) proc `[]`*[Idx, T](a: array[Idx, T], x: Slice[int]): seq[T] = - ## slice operation for arrays. Negative indexes are **not** supported - ## because the array might have negative bounds. + ## slice operation for arrays. when low(a) < 0: {.error: "Slicing for arrays with negative indices is unsupported.".} var L = x.b - x.a + 1 @@ -2885,8 +2904,7 @@ proc `[]`*[Idx, T](a: array[Idx, T], x: Slice[int]): seq[T] = for i in 0.. <L: result[i] = a[i + x.a] proc `[]=`*[Idx, T](a: var array[Idx, T], x: Slice[int], b: openArray[T]) = - ## slice assignment for arrays. Negative indexes are **not** supported - ## because the array might have negative bounds. + ## slice assignment for arrays. when low(a) < 0: {.error: "Slicing for arrays with negative indices is unsupported.".} var L = x.b - x.a + 1 @@ -2896,40 +2914,34 @@ proc `[]=`*[Idx, T](a: var array[Idx, T], x: Slice[int], b: openArray[T]) = sysFatal(RangeError, "different lengths for slice assignment") proc `[]`*[Idx, T](a: array[Idx, T], x: Slice[Idx]): seq[T] = - ## slice operation for arrays. Negative indexes are **not** supported - ## because the array might have negative bounds. + ## slice operation for arrays. var L = ord(x.b) - ord(x.a) + 1 newSeq(result, L) - var j = x.a for i in 0.. <L: - result[i] = a[j] - inc(j) + result[i] = a[Idx(ord(x.a) + i)] proc `[]=`*[Idx, T](a: var array[Idx, T], x: Slice[Idx], b: openArray[T]) = - ## slice assignment for arrays. Negative indexes are **not** supported - ## because the array might have negative bounds. + ## slice assignment for arrays. var L = ord(x.b) - ord(x.a) + 1 if L == b.len: - var j = x.a for i in 0 .. <L: - a[j] = b[i] - inc(j) + a[Idx(ord(x.a) + i)] = b[i] else: sysFatal(RangeError, "different lengths for slice assignment") proc `[]`*[T](s: seq[T], x: Slice[int]): seq[T] = - ## slice operation for sequences. Negative indexes are supported. - var a = x.a-|s - var L = x.b-|s - a + 1 + ## slice operation for sequences. + var a = x.a + var L = x.b - a + 1 newSeq(result, L) for i in 0.. <L: result[i] = s[i + a] proc `[]=`*[T](s: var seq[T], x: Slice[int], b: openArray[T]) = - ## slice assignment for sequences. Negative indexes are supported. If + ## slice assignment for sequences. If ## ``b.len`` is not exactly the number of elements that are referred to ## by `x`, a `splice`:idx: is performed. - var a = x.a-|s - var L = x.b-|s - a + 1 + var a = x.a + var L = x.b - a + 1 if L == b.len: for i in 0 .. <L: s[i+a] = b[i] else: @@ -3028,8 +3040,8 @@ proc instantiationInfo*(index = -1, fullPaths = false): tuple[ ## result = a[pos] ## ## when isMainModule: - ## testException(EInvalidIndex, tester(30)) - ## testException(EInvalidIndex, tester(1)) + ## testException(IndexError, tester(30)) + ## testException(IndexError, tester(1)) ## # --> Test failure at example.nim:20 with 'tester(1)' template currentSourcePath*: string = instantiationInfo(-1, true).filename @@ -3038,13 +3050,12 @@ template currentSourcePath*: string = instantiationInfo(-1, true).filename proc raiseAssert*(msg: string) {.noinline.} = sysFatal(AssertionError, msg) -when true: - proc failedAssertImpl*(msg: string) {.raises: [], tags: [].} = - # trick the compiler to not list ``EAssertionFailed`` when called - # by ``assert``. - type THide = proc (msg: string) {.noinline, raises: [], noSideEffect, - tags: [].} - THide(raiseAssert)(msg) +proc failedAssertImpl*(msg: string) {.raises: [], tags: [].} = + # trick the compiler to not list ``AssertionError`` when called + # by ``assert``. + type THide = proc (msg: string) {.noinline, raises: [], noSideEffect, + tags: [].} + THide(raiseAssert)(msg) template assert*(cond: bool, msg = "") = ## Raises ``AssertionError`` with `msg` if `cond` is false. Note @@ -3109,24 +3120,18 @@ when not defined(nimhygiene): template onFailedAssert*(msg: expr, code: stmt): stmt {.dirty, immediate.} = ## Sets an assertion failure handler that will intercept any assert - ## statements following `onFailedAssert` in the current lexical scope. - ## Can be defined multiple times in a single function. + ## statements following `onFailedAssert` in the current module scope. ## ## .. code-block:: nim - ## - ## proc example(x: int): TErrorCode = - ## onFailedAssert(msg): - ## log msg - ## return E_FAIL - ## - ## assert(...) - ## - ## onFailedAssert(msg): - ## raise newException(EMyException, msg) - ## - ## assert(...) - ## - template failedAssertImpl(msgIMPL: string): stmt {.dirty, immediate.} = + ## # module-wide policy to change the failed assert + ## # exception type in order to include a lineinfo + ## onFailedAssert(msg): + ## var e = new(TMyError) + ## e.msg = msg + ## e.lineinfo = instantiationInfo(-2) + ## raise e + ## + template failedAssertImpl(msgIMPL: string): stmt {.dirty.} = let msg = msgIMPL code @@ -3162,7 +3167,7 @@ when false: payload() when hostOS != "standalone": - proc insert*(x: var string, item: string, i = 0) {.noSideEffect.} = + proc insert*(x: var string, item: string, i = 0.Natural) {.noSideEffect.} = ## inserts `item` into `x` at position `i`. var xl = x.len setLen(x, xl+item.len) @@ -3243,4 +3248,28 @@ proc procCall*(x: expr) {.magic: "ProcCall".} = ## procCall someMethod(a, b) discard +proc `^`*(x: int): int {.noSideEffect, magic: "Roof".} = + ## builtin `roof`:idx: operator that can be used for convenient array access. + ## ``a[^x]`` is rewritten to ``a[a.len-x]``. However currently the ``a`` + ## expression must not have side effects for this to compile. Note that since + ## this is a builtin, it automatically works for all kinds of + ## overloaded ``[]`` or ``[]=`` accessors. + discard + +template `..^`*(a, b: expr): expr = + ## a shortcut for '.. ^' to avoid the common gotcha that a space between + ## '..' and '^' is required. + a .. ^b + +template `..<`*(a, b: expr): expr = + ## a shortcut for '.. <' to avoid the common gotcha that a space between + ## '..' and '<' is required. + a .. <b + +proc xlen*(x: string): int {.magic: "XLenStr", noSideEffect.} = discard +proc xlen*[T](x: seq[T]): int {.magic: "XLenSeq", noSideEffect.} = + ## returns the length of a sequence or a string without testing for 'nil'. + ## This is an optimization that rarely makes sense. + discard + {.pop.} #{.push warning[GcMem]: off.} diff --git a/lib/system/alloc.nim b/lib/system/alloc.nim index fd3ced832..ad3419808 100644 --- a/lib/system/alloc.nim +++ b/lib/system/alloc.nim @@ -8,7 +8,7 @@ # # Low level allocator for Nim. Has been designed to support the GC. -# TODO: +# TODO: # - eliminate "used" field # - make searching for block O(1) {.push profiler:off.} @@ -21,37 +21,37 @@ # used with a size of 0: const weirdUnmap = not (defined(amd64) or defined(i386)) or defined(windows) -when defined(posix): +when defined(posix): const - PROT_READ = 1 # page can be read - PROT_WRITE = 2 # page can be written - MAP_PRIVATE = 2'i32 # Changes are private - + PROT_READ = 1 # page can be read + PROT_WRITE = 2 # page can be written + MAP_PRIVATE = 2'i32 # Changes are private + when defined(macosx) or defined(bsd): const MAP_ANONYMOUS = 0x1000 - elif defined(solaris): + elif defined(solaris): const MAP_ANONYMOUS = 0x100 else: var MAP_ANONYMOUS {.importc: "MAP_ANONYMOUS", header: "<sys/mman.h>".}: cint - + proc mmap(adr: pointer, len: int, prot, flags, fildes: cint, off: int): pointer {.header: "<sys/mman.h>".} proc munmap(adr: pointer, len: int) {.header: "<sys/mman.h>".} - - proc osAllocPages(size: int): pointer {.inline.} = - result = mmap(nil, size, PROT_READ or PROT_WRITE, + + proc osAllocPages(size: int): pointer {.inline.} = + result = mmap(nil, size, PROT_READ or PROT_WRITE, MAP_PRIVATE or MAP_ANONYMOUS, -1, 0) if result == nil or result == cast[pointer](-1): raiseOutOfMem() - + proc osDeallocPages(p: pointer, size: int) {.inline} = when reallyOsDealloc: munmap(p, size) - -elif defined(windows): + +elif defined(windows): const - MEM_RESERVE = 0x2000 + MEM_RESERVE = 0x2000 MEM_COMMIT = 0x1000 MEM_TOP_DOWN = 0x100000 PAGE_READWRITE = 0x04 @@ -62,12 +62,12 @@ elif defined(windows): proc virtualAlloc(lpAddress: pointer, dwSize: int, flAllocationType, flProtect: int32): pointer {. header: "<windows.h>", stdcall, importc: "VirtualAlloc".} - - proc virtualFree(lpAddress: pointer, dwSize: int, + + proc virtualFree(lpAddress: pointer, dwSize: int, dwFreeType: int32) {.header: "<windows.h>", stdcall, importc: "VirtualFree".} - - proc osAllocPages(size: int): pointer {.inline.} = + + proc osAllocPages(size: int): pointer {.inline.} = result = virtualAlloc(nil, size, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE) if result == nil: raiseOutOfMem() @@ -82,7 +82,7 @@ elif defined(windows): when reallyOsDealloc: virtualFree(p, 0, MEM_RELEASE) #VirtualFree(p, size, MEM_DECOMMIT) -else: +else: {.error: "Port memory manager to your platform".} # --------------------- end of non-portable code ----------------------------- @@ -97,17 +97,17 @@ const InitialMemoryRequest = ChunkOsReturn div 2 # < ChunkOsReturn! SmallChunkSize = PageSize -type +type PTrunk = ptr TTrunk - TTrunk {.final.} = object + TTrunk {.final.} = object next: PTrunk # all nodes are connected with this pointer key: int # start address at bit 0 bits: array[0..IntsPerTrunk-1, int] # a bit vector - + TTrunkBuckets = array[0..255, PTrunk] - TIntSet {.final.} = object + TIntSet {.final.} = object data: TTrunkBuckets - + type TAlignType = BiggestFloat TFreeCell {.final, pure.} = object @@ -123,14 +123,14 @@ type prevSize: int # size of previous chunk; for coalescing size: int # if < PageSize it is a small chunk used: bool # later will be optimized into prevSize... - + TSmallChunk = object of TBaseChunk next, prev: PSmallChunk # chunks of the same size freeList: ptr TFreeCell - free: int # how many bytes remain + free: int # how many bytes remain acc: int # accumulator for small object allocation data: TAlignType # start of usable memory - + TBigChunk = object of TBaseChunk # not necessarily > PageSize! next, prev: PBigChunk # chunks of the same (or bigger) size align: int @@ -139,7 +139,7 @@ type template smallChunkOverhead(): expr = sizeof(TSmallChunk)-sizeof(TAlignType) template bigChunkOverhead(): expr = sizeof(TBigChunk)-sizeof(TAlignType) -proc roundup(x, v: int): int {.inline.} = +proc roundup(x, v: int): int {.inline.} = result = (x + (v-1)) and not (v-1) sysAssert(result >= x, "roundup: result < x") #return ((-x) and (v-1)) +% x @@ -153,7 +153,7 @@ sysAssert(roundup(65, 8) == 72, "roundup broken 2") # endings of big chunks. This is needed by the merging operation. The only # remaining operation is best-fit for big chunks. Since there is a size-limit # for big chunks (because greater than the limit means they are returned back -# to the OS), a fixed size array can be used. +# to the OS), a fixed size array can be used. type PLLChunk = ptr TLLChunk @@ -163,21 +163,21 @@ type next: PLLChunk # next low-level chunk; only needed for dealloc PAvlNode = ptr TAvlNode - TAvlNode {.pure, final.} = object - link: array[0..1, PAvlNode] # Left (0) and right (1) links + TAvlNode {.pure, final.} = object + link: array[0..1, PAvlNode] # Left (0) and right (1) links key, upperBound: int level: int - + TMemRegion {.final, pure.} = object minLargeObj, maxLargeObj: int freeSmallChunks: array[0..SmallChunkSize div MemAlign-1, PSmallChunk] llmem: PLLChunk currMem, maxMem, freeMem: int # memory sizes (allocated from OS) - lastSize: int # needed for the case that OS gives us pages linearly + lastSize: int # needed for the case that OS gives us pages linearly freeChunksList: PBigChunk # XXX make this a datastructure with O(1) access chunkStarts: TIntSet root, deleted, last, freeAvlNodes: PAvlNode - + # shared: var bottomData: TAvlNode @@ -191,7 +191,7 @@ proc initAllocator() = bottom.link[1] = bottom {.pop.} -proc incCurrMem(a: var TMemRegion, bytes: int) {.inline.} = +proc incCurrMem(a: var TMemRegion, bytes: int) {.inline.} = inc(a.currMem, bytes) proc decCurrMem(a: var TMemRegion, bytes: int) {.inline.} = @@ -199,11 +199,11 @@ proc decCurrMem(a: var TMemRegion, bytes: int) {.inline.} = dec(a.currMem, bytes) proc getMaxMem(a: var TMemRegion): int = - # Since we update maxPagesCount only when freeing pages, + # Since we update maxPagesCount only when freeing pages, # maxPagesCount may not be up to date. Thus we use the # maximum of these both values here: result = max(a.currMem, a.maxMem) - + proc llAlloc(a: var TMemRegion, size: int): pointer = # *low-level* alloc for the memory managers data structures. Deallocation # is done at he end of the allocator's life time. @@ -251,15 +251,15 @@ proc llDeallocAll(a: var TMemRegion) = var next = it.next osDeallocPages(it, PageSize) it = next - -proc intSetGet(t: TIntSet, key: int): PTrunk = + +proc intSetGet(t: TIntSet, key: int): PTrunk = var it = t.data[key and high(t.data)] - while it != nil: + while it != nil: if it.key == key: return it it = it.next result = nil -proc intSetPut(a: var TMemRegion, t: var TIntSet, key: int): PTrunk = +proc intSetPut(a: var TMemRegion, t: var TIntSet, key: int): PTrunk = result = intSetGet(t, key) if result == nil: result = cast[PTrunk](llAlloc(a, sizeof(result[]))) @@ -267,20 +267,20 @@ proc intSetPut(a: var TMemRegion, t: var TIntSet, key: int): PTrunk = t.data[key and high(t.data)] = result result.key = key -proc contains(s: TIntSet, key: int): bool = +proc contains(s: TIntSet, key: int): bool = var t = intSetGet(s, key shr TrunkShift) - if t != nil: + if t != nil: var u = key and TrunkMask result = (t.bits[u shr IntShift] and (1 shl (u and IntMask))) != 0 - else: + else: result = false - -proc incl(a: var TMemRegion, s: var TIntSet, key: int) = + +proc incl(a: var TMemRegion, s: var TIntSet, key: int) = var t = intSetPut(a, s, key shr TrunkShift) var u = key and TrunkMask t.bits[u shr IntShift] = t.bits[u shr IntShift] or (1 shl (u and IntMask)) -proc excl(s: var TIntSet, key: int) = +proc excl(s: var TIntSet, key: int) = var t = intSetGet(s, key shr TrunkShift) if t != nil: var u = key and TrunkMask @@ -304,11 +304,11 @@ iterator elements(t: TIntSet): int {.inline.} = w = w shr 1 inc(i) r = r.next - -proc isSmallChunk(c: PChunk): bool {.inline.} = + +proc isSmallChunk(c: PChunk): bool {.inline.} = return c.size <= SmallChunkSize-smallChunkOverhead() - -proc chunkUnused(c: PChunk): bool {.inline.} = + +proc chunkUnused(c: PChunk): bool {.inline.} = result = not c.used iterator allObjects(m: TMemRegion): pointer {.inline.} = @@ -319,7 +319,7 @@ iterator allObjects(m: TMemRegion): pointer {.inline.} = if not chunkUnused(c): if isSmallChunk(c): var c = cast[PSmallChunk](c) - + let size = c.size var a = cast[ByteAddress](addr(c.data)) let limit = a + c.acc @@ -334,17 +334,17 @@ proc isCell(p: pointer): bool {.inline.} = result = cast[ptr TFreeCell](p).zeroField >% 1 # ------------- chunk management ---------------------------------------------- -proc pageIndex(c: PChunk): int {.inline.} = +proc pageIndex(c: PChunk): int {.inline.} = result = cast[ByteAddress](c) shr PageShift -proc pageIndex(p: pointer): int {.inline.} = +proc pageIndex(p: pointer): int {.inline.} = result = cast[ByteAddress](p) shr PageShift -proc pageAddr(p: pointer): PChunk {.inline.} = +proc pageAddr(p: pointer): PChunk {.inline.} = result = cast[PChunk](cast[ByteAddress](p) and not PageMask) #sysAssert(Contains(allocator.chunkStarts, pageIndex(result))) -proc requestOsChunks(a: var TMemRegion, size: int): PBigChunk = +proc requestOsChunks(a: var TMemRegion, size: int): PBigChunk = incCurrMem(a, size) inc(a.freeMem, size) result = cast[PBigChunk](osAllocPages(size)) @@ -373,7 +373,7 @@ proc requestOsChunks(a: var TMemRegion, size: int): PBigChunk = result.prevSize = 0 # unknown a.lastSize = size # for next request -proc freeOsChunks(a: var TMemRegion, p: pointer, size: int) = +proc freeOsChunks(a: var TMemRegion, p: pointer, size: int) = # update next.prevSize: var c = cast[PChunk](p) var nxt = cast[ByteAddress](p) +% c.size @@ -387,36 +387,36 @@ proc freeOsChunks(a: var TMemRegion, p: pointer, size: int) = dec(a.freeMem, size) #c_fprintf(c_stdout, "[Alloc] back to OS: %ld\n", size) -proc isAccessible(a: TMemRegion, p: pointer): bool {.inline.} = +proc isAccessible(a: TMemRegion, p: pointer): bool {.inline.} = result = contains(a.chunkStarts, pageIndex(p)) -proc contains[T](list, x: T): bool = +proc contains[T](list, x: T): bool = var it = list while it != nil: if it == x: return true it = it.next - + proc writeFreeList(a: TMemRegion) = var it = a.freeChunksList c_fprintf(c_stdout, "freeChunksList: %p\n", it) - while it != nil: - c_fprintf(c_stdout, "it: %p, next: %p, prev: %p\n", + while it != nil: + c_fprintf(c_stdout, "it: %p, next: %p, prev: %p\n", it, it.next, it.prev) it = it.next -proc listAdd[T](head: var T, c: T) {.inline.} = +proc listAdd[T](head: var T, c: T) {.inline.} = sysAssert(c notin head, "listAdd 1") sysAssert c.prev == nil, "listAdd 2" sysAssert c.next == nil, "listAdd 3" c.next = head - if head != nil: + if head != nil: sysAssert head.prev == nil, "listAdd 4" head.prev = c head = c proc listRemove[T](head: var T, c: T) {.inline.} = sysAssert(c in head, "listRemove") - if c == head: + if c == head: head = c.next sysAssert c.prev == nil, "listRemove 2" if head != nil: head.prev = nil @@ -426,15 +426,15 @@ proc listRemove[T](head: var T, c: T) {.inline.} = if c.next != nil: c.next.prev = c.prev c.next = nil c.prev = nil - -proc updatePrevSize(a: var TMemRegion, c: PBigChunk, - prevSize: int) {.inline.} = + +proc updatePrevSize(a: var TMemRegion, c: PBigChunk, + prevSize: int) {.inline.} = var ri = cast[PChunk](cast[ByteAddress](c) +% c.size) sysAssert((cast[ByteAddress](ri) and PageMask) == 0, "updatePrevSize") if isAccessible(a, ri): ri.prevSize = prevSize - -proc freeBigChunk(a: var TMemRegion, c: PBigChunk) = + +proc freeBigChunk(a: var TMemRegion, c: PBigChunk) = var c = c sysAssert(c.size >= PageSize, "freeBigChunk") inc(a.freeMem, c.size) @@ -448,7 +448,7 @@ proc freeBigChunk(a: var TMemRegion, c: PBigChunk) = inc(c.size, ri.size) excl(a.chunkStarts, pageIndex(ri)) when coalescLeft: - if c.prevSize != 0: + if c.prevSize != 0: var le = cast[PChunk](cast[ByteAddress](c) -% c.prevSize) sysAssert((cast[ByteAddress](le) and PageMask) == 0, "freeBigChunk 4") if isAccessible(a, le) and chunkUnused(le): @@ -467,7 +467,7 @@ proc freeBigChunk(a: var TMemRegion, c: PBigChunk) = else: freeOsChunks(a, c, c.size) -proc splitChunk(a: var TMemRegion, c: PBigChunk, size: int) = +proc splitChunk(a: var TMemRegion, c: PBigChunk, size: int) = var rest = cast[PBigChunk](cast[ByteAddress](c) +% size) sysAssert(rest notin a.freeChunksList, "splitChunk") rest.size = c.size - size @@ -480,7 +480,7 @@ proc splitChunk(a: var TMemRegion, c: PBigChunk, size: int) = incl(a, a.chunkStarts, pageIndex(rest)) listAdd(a.freeChunksList, rest) -proc getBigChunk(a: var TMemRegion, size: int): PBigChunk = +proc getBigChunk(a: var TMemRegion, size: int): PBigChunk = # use first fit for now: sysAssert((size and PageMask) == 0, "getBigChunk 1") sysAssert(size > 0, "getBigChunk 2") @@ -488,7 +488,7 @@ proc getBigChunk(a: var TMemRegion, size: int): PBigChunk = block search: while result != nil: sysAssert chunkUnused(result), "getBigChunk 3" - if result.size == size: + if result.size == size: listRemove(a.freeChunksList, result) break search elif result.size > size: @@ -497,7 +497,7 @@ proc getBigChunk(a: var TMemRegion, size: int): PBigChunk = break search result = result.next sysAssert result != a.freeChunksList, "getBigChunk 4" - if size < InitialMemoryRequest: + if size < InitialMemoryRequest: result = requestOsChunks(a, InitialMemoryRequest) splitChunk(a, result, size) else: @@ -507,7 +507,7 @@ proc getBigChunk(a: var TMemRegion, size: int): PBigChunk = incl(a, a.chunkStarts, pageIndex(result)) dec(a.freeMem, size) -proc getSmallChunk(a: var TMemRegion): PSmallChunk = +proc getSmallChunk(a: var TMemRegion): PSmallChunk = var res = getBigChunk(a, PageSize) sysAssert res.prev == nil, "getSmallChunk 1" sysAssert res.next == nil, "getSmallChunk 2" @@ -521,15 +521,15 @@ proc allocInv(a: TMemRegion): bool = for s in low(a.freeSmallChunks)..high(a.freeSmallChunks): var c = a.freeSmallChunks[s] while c != nil: - if c.next == c: + if c.next == c: echo "[SYSASSERT] c.next == c" return false - if c.size != s * MemAlign: + if c.size != s * MemAlign: echo "[SYSASSERT] c.size != s * MemAlign" return false var it = c.freeList while it != nil: - if it.zeroField != 0: + if it.zeroField != 0: echo "[SYSASSERT] it.zeroField != 0" c_printf("%ld %p\n", it.zeroField, it) return false @@ -539,16 +539,16 @@ proc allocInv(a: TMemRegion): bool = proc rawAlloc(a: var TMemRegion, requestedSize: int): pointer = sysAssert(allocInv(a), "rawAlloc: begin") - sysAssert(roundup(65, 8) == 72, "rawAlloc 1") - sysAssert requestedSize >= sizeof(TFreeCell), "rawAlloc 2" + sysAssert(roundup(65, 8) == 72, "rawAlloc: roundup broken") + sysAssert(requestedSize >= sizeof(TFreeCell), "rawAlloc: requested size too small") var size = roundup(requestedSize, MemAlign) sysAssert(size >= requestedSize, "insufficient allocated size!") #c_fprintf(c_stdout, "alloc; size: %ld; %ld\n", requestedSize, size) - if size <= SmallChunkSize-smallChunkOverhead(): + if size <= SmallChunkSize-smallChunkOverhead(): # allocate a small block: for small chunks, we use only its next pointer var s = size div MemAlign var c = a.freeSmallChunks[s] - if c == nil: + if c == nil: c = getSmallChunk(a) c.freeList = nil sysAssert c.size == PageSize, "rawAlloc 3" @@ -567,7 +567,7 @@ proc rawAlloc(a: var TMemRegion, requestedSize: int): pointer = # c_fprintf(c_stdout, "csize: %lld; size %lld\n", c.size, size) sysAssert c.size == size, "rawAlloc 6" if c.freeList == nil: - sysAssert(c.acc + smallChunkOverhead() + size <= SmallChunkSize, + sysAssert(c.acc + smallChunkOverhead() + size <= SmallChunkSize, "rawAlloc 7") result = cast[pointer](cast[ByteAddress](addr(c.data)) +% c.acc) inc(c.acc, size) @@ -621,9 +621,9 @@ proc rawDealloc(a: var TMemRegion, p: pointer) = f.zeroField = 0 f.next = c.freeList c.freeList = f - when overwriteFree: + when overwriteFree: # set to 0xff to check for usage after free bugs: - c_memset(cast[pointer](cast[int](p) +% sizeof(TFreeCell)), -1'i32, + c_memset(cast[pointer](cast[int](p) +% sizeof(TFreeCell)), -1'i32, s -% sizeof(TFreeCell)) # check if it is not in the freeSmallChunks[s] list: if c.free < s: @@ -649,13 +649,13 @@ proc rawDealloc(a: var TMemRegion, p: pointer) = sysAssert(allocInv(a), "rawDealloc: end") when logAlloc: cprintf("rawDealloc: %p\n", p) -proc isAllocatedPtr(a: TMemRegion, p: pointer): bool = +proc isAllocatedPtr(a: TMemRegion, p: pointer): bool = if isAccessible(a, p): var c = pageAddr(p) if not chunkUnused(c): if isSmallChunk(c): var c = cast[PSmallChunk](c) - var offset = (cast[ByteAddress](p) and (PageSize-1)) -% + var offset = (cast[ByteAddress](p) and (PageSize-1)) -% smallChunkOverhead() result = (c.acc >% offset) and (offset %% c.size == 0) and (cast[ptr TFreeCell](p).zeroField >% 1) @@ -673,12 +673,12 @@ proc interiorAllocatedPtr(a: TMemRegion, p: pointer): pointer = if not chunkUnused(c): if isSmallChunk(c): var c = cast[PSmallChunk](c) - var offset = (cast[ByteAddress](p) and (PageSize-1)) -% + var offset = (cast[ByteAddress](p) and (PageSize-1)) -% smallChunkOverhead() if c.acc >% offset: sysAssert(cast[ByteAddress](addr(c.data)) +% offset == cast[ByteAddress](p), "offset is not what you think it is") - var d = cast[ptr TFreeCell](cast[ByteAddress](addr(c.data)) +% + var d = cast[ptr TFreeCell](cast[ByteAddress](addr(c.data)) +% offset -% (offset %% c.size)) if d.zeroField >% 1: result = d @@ -711,13 +711,13 @@ proc ptrSize(p: pointer): int = if not isSmallChunk(c): dec result, bigChunkOverhead() -proc alloc(allocator: var TMemRegion, size: int): pointer = +proc alloc(allocator: var TMemRegion, size: Natural): pointer = result = rawAlloc(allocator, size+sizeof(TFreeCell)) cast[ptr TFreeCell](result).zeroField = 1 # mark it as used sysAssert(not isAllocatedPtr(allocator, result), "alloc") result = cast[pointer](cast[ByteAddress](result) +% sizeof(TFreeCell)) -proc alloc0(allocator: var TMemRegion, size: int): pointer = +proc alloc0(allocator: var TMemRegion, size: Natural): pointer = result = alloc(allocator, size) zeroMem(result, size) @@ -730,7 +730,7 @@ proc dealloc(allocator: var TMemRegion, p: pointer) = rawDealloc(allocator, x) sysAssert(not isAllocatedPtr(allocator, x), "dealloc 3") -proc realloc(allocator: var TMemRegion, p: pointer, newsize: int): pointer = +proc realloc(allocator: var TMemRegion, p: pointer, newsize: Natural): pointer = if newsize > 0: result = alloc0(allocator, newsize) if p != nil: @@ -758,7 +758,7 @@ proc deallocOsPages(a: var TMemRegion) = proc getFreeMem(a: TMemRegion): int {.inline.} = result = a.freeMem proc getTotalMem(a: TMemRegion): int {.inline.} = result = a.currMem -proc getOccupiedMem(a: TMemRegion): int {.inline.} = +proc getOccupiedMem(a: TMemRegion): int {.inline.} = result = a.currMem - a.freeMem # ---------------------- thread memory region ------------------------------- @@ -774,16 +774,16 @@ template instantiateForRegion(allocator: expr) = proc deallocOsPages = deallocOsPages(allocator) - proc alloc(size: int): pointer = + proc alloc(size: Natural): pointer = result = alloc(allocator, size) - proc alloc0(size: int): pointer = + proc alloc0(size: Natural): pointer = result = alloc0(allocator, size) proc dealloc(p: pointer) = dealloc(allocator, p) - proc realloc(p: pointer, newsize: int): pointer = + proc realloc(p: pointer, newsize: Natural): pointer = result = realloc(allocator, p, newSize) when false: @@ -794,7 +794,7 @@ template instantiateForRegion(allocator: expr) = inc(result, it.size) it = it.next - proc getFreeMem(): int = + proc getFreeMem(): int = result = allocator.freeMem #sysAssert(result == countFreeMem()) @@ -807,7 +807,7 @@ template instantiateForRegion(allocator: expr) = var heapLock: TSysLock initSysLock(heapLock) - proc allocShared(size: int): pointer = + proc allocShared(size: Natural): pointer = when hasThreadSupport: acquireSys(heapLock) result = alloc(sharedHeap, size) @@ -815,20 +815,20 @@ template instantiateForRegion(allocator: expr) = else: result = alloc(size) - proc allocShared0(size: int): pointer = + proc allocShared0(size: Natural): pointer = result = allocShared(size) zeroMem(result, size) proc deallocShared(p: pointer) = - when hasThreadSupport: + when hasThreadSupport: acquireSys(heapLock) dealloc(sharedHeap, p) releaseSys(heapLock) else: dealloc(p) - proc reallocShared(p: pointer, newsize: int): pointer = - when hasThreadSupport: + proc reallocShared(p: pointer, newsize: Natural): pointer = + when hasThreadSupport: acquireSys(heapLock) result = realloc(sharedHeap, p, newsize) releaseSys(heapLock) diff --git a/lib/system/atomics.nim b/lib/system/atomics.nim index ac30bd8dd..c97d2fc7f 100644 --- a/lib/system/atomics.nim +++ b/lib/system/atomics.nim @@ -21,19 +21,19 @@ when someGcc and hasThreadSupport: ## synchronization with another thread. var ATOMIC_ACQUIRE* {.importc: "__ATOMIC_ACQUIRE", nodecl.}: AtomMemModel ## Barrier to hoisting of code and synchronizes with - ## release (or stronger) + ## release (or stronger) ## semantic stores from another thread. var ATOMIC_RELEASE* {.importc: "__ATOMIC_RELEASE", nodecl.}: AtomMemModel ## Barrier to sinking of code and synchronizes with - ## acquire (or stronger) - ## semantic loads from another thread. + ## acquire (or stronger) + ## semantic loads from another thread. var ATOMIC_ACQ_REL* {.importc: "__ATOMIC_ACQ_REL", nodecl.}: AtomMemModel ## Full barrier in both directions and synchronizes - ## with acquire loads + ## with acquire loads ## and release stores in another thread. var ATOMIC_SEQ_CST* {.importc: "__ATOMIC_SEQ_CST", nodecl.}: AtomMemModel ## Full barrier in both directions and synchronizes - ## with acquire loads + ## with acquire loads ## and release stores in all threads. type @@ -46,11 +46,11 @@ when someGcc and hasThreadSupport: ## ATOMIC_RELAXED, ATOMIC_SEQ_CST, ATOMIC_ACQUIRE, ATOMIC_CONSUME. proc atomicLoad*[T: TAtomType](p, ret: ptr T, mem: AtomMemModel) {. - importc: "__atomic_load", nodecl.} + importc: "__atomic_load", nodecl.} ## This is the generic version of an atomic load. It returns the contents at p in ret. proc atomicStoreN*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel) {. - importc: "__atomic_store_n", nodecl.} + importc: "__atomic_store_n", nodecl.} ## This proc implements an atomic store operation. It writes val at p. ## ATOMIC_RELAXED, ATOMIC_SEQ_CST, and ATOMIC_RELEASE. @@ -60,39 +60,39 @@ when someGcc and hasThreadSupport: proc atomicExchangeN*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. importc: "__atomic_exchange_n", nodecl.} - ## This proc implements an atomic exchange operation. It writes val at p, + ## This proc implements an atomic exchange operation. It writes val at p, ## and returns the previous contents at p. ## ATOMIC_RELAXED, ATOMIC_SEQ_CST, ATOMIC_ACQUIRE, ATOMIC_RELEASE, ATOMIC_ACQ_REL proc atomicExchange*[T: TAtomType](p, val, ret: ptr T, mem: AtomMemModel) {. importc: "__atomic_exchange", nodecl.} - ## This is the generic version of an atomic exchange. It stores the contents at val at p. + ## This is the generic version of an atomic exchange. It stores the contents at val at p. ## The original value at p is copied into ret. proc atomicCompareExchangeN*[T: TAtomType](p, expected: ptr T, desired: T, weak: bool, success_memmodel: AtomMemModel, failure_memmodel: AtomMemModel): bool {. - importc: "__atomic_compare_exchange_n ", nodecl.} + importc: "__atomic_compare_exchange_n ", nodecl.} ## This proc implements an atomic compare and exchange operation. This compares the - ## contents at p with the contents at expected and if equal, writes desired at p. - ## If they are not equal, the current contents at p is written into expected. - ## Weak is true for weak compare_exchange, and false for the strong variation. - ## Many targets only offer the strong variation and ignore the parameter. + ## contents at p with the contents at expected and if equal, writes desired at p. + ## If they are not equal, the current contents at p is written into expected. + ## Weak is true for weak compare_exchange, and false for the strong variation. + ## Many targets only offer the strong variation and ignore the parameter. ## When in doubt, use the strong variation. - ## True is returned if desired is written at p and the execution is considered - ## to conform to the memory model specified by success_memmodel. There are no - ## restrictions on what memory model can be used here. False is returned otherwise, - ## and the execution is considered to conform to failure_memmodel. This memory model - ## cannot be __ATOMIC_RELEASE nor __ATOMIC_ACQ_REL. It also cannot be a stronger model + ## True is returned if desired is written at p and the execution is considered + ## to conform to the memory model specified by success_memmodel. There are no + ## restrictions on what memory model can be used here. False is returned otherwise, + ## and the execution is considered to conform to failure_memmodel. This memory model + ## cannot be __ATOMIC_RELEASE nor __ATOMIC_ACQ_REL. It also cannot be a stronger model ## than that specified by success_memmodel. proc atomicCompareExchange*[T: TAtomType](p, expected, desired: ptr T, weak: bool, success_memmodel: AtomMemModel, failure_memmodel: AtomMemModel): bool {. - importc: "__atomic_compare_exchange_n ", nodecl.} - ## This proc implements the generic version of atomic_compare_exchange. - ## The proc is virtually identical to atomic_compare_exchange_n, except the desired - ## value is also a pointer. + importc: "__atomic_compare_exchange", nodecl.} + ## This proc implements the generic version of atomic_compare_exchange. + ## The proc is virtually identical to atomic_compare_exchange_n, except the desired + ## value is also a pointer. - ## Perform the operation return the new value, all memory models are valid + ## Perform the operation return the new value, all memory models are valid proc atomicAddFetch*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. importc: "__atomic_add_fetch", nodecl.} proc atomicSubFetch*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. @@ -101,64 +101,64 @@ when someGcc and hasThreadSupport: importc: "__atomic_or_fetch ", nodecl.} proc atomicAndFetch*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. importc: "__atomic_and_fetch", nodecl.} - proc atomicXorFetch*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. + proc atomicXorFetch*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. importc: "__atomic_xor_fetch", nodecl.} - proc atomicNandFetch*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. - importc: "__atomic_nand_fetch ", nodecl.} + proc atomicNandFetch*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. + importc: "__atomic_nand_fetch ", nodecl.} - ## Perform the operation return the old value, all memory models are valid + ## Perform the operation return the old value, all memory models are valid proc atomicFetchAdd*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. importc: "__atomic_fetch_add", nodecl.} - proc atomicFetchSub*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. + proc atomicFetchSub*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. importc: "__atomic_fetch_sub", nodecl.} - proc atomicFetchOr*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. + proc atomicFetchOr*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. importc: "__atomic_fetch_or", nodecl.} - proc atomicFetchAnd*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. + proc atomicFetchAnd*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. importc: "__atomic_fetch_and", nodecl.} - proc atomicFetchXor*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. + proc atomicFetchXor*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. importc: "__atomic_fetch_xor", nodecl.} - proc atomicFetchNand*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. - importc: "__atomic_fetch_nand", nodecl.} + proc atomicFetchNand*[T: TAtomType](p: ptr T, val: T, mem: AtomMemModel): T {. + importc: "__atomic_fetch_nand", nodecl.} - proc atomicTestAndSet*(p: pointer, mem: AtomMemModel): bool {. - importc: "__atomic_test_and_set", nodecl.} - ## This built-in function performs an atomic test-and-set operation on the byte at p. + proc atomicTestAndSet*(p: pointer, mem: AtomMemModel): bool {. + importc: "__atomic_test_and_set", nodecl.} + ## This built-in function performs an atomic test-and-set operation on the byte at p. ## The byte is set to some implementation defined nonzero “set” value and the return ## value is true if and only if the previous contents were “set”. ## All memory models are valid. - proc atomicClear*(p: pointer, mem: AtomMemModel) {. + proc atomicClear*(p: pointer, mem: AtomMemModel) {. importc: "__atomic_clear", nodecl.} - ## This built-in function performs an atomic clear operation at p. + ## This built-in function performs an atomic clear operation at p. ## After the operation, at p contains 0. ## ATOMIC_RELAXED, ATOMIC_SEQ_CST, ATOMIC_RELEASE - proc atomicThreadFence*(mem: AtomMemModel) {. + proc atomicThreadFence*(mem: AtomMemModel) {. importc: "__atomic_thread_fence", nodecl.} - ## This built-in function acts as a synchronization fence between threads based + ## This built-in function acts as a synchronization fence between threads based ## on the specified memory model. All memory orders are valid. - proc atomicSignalFence*(mem: AtomMemModel) {. + proc atomicSignalFence*(mem: AtomMemModel) {. importc: "__atomic_signal_fence", nodecl.} - ## This built-in function acts as a synchronization fence between a thread and + ## This built-in function acts as a synchronization fence between a thread and ## signal handlers based in the same thread. All memory orders are valid. - proc atomicAlwaysLockFree*(size: int, p: pointer): bool {. + proc atomicAlwaysLockFree*(size: int, p: pointer): bool {. importc: "__atomic_always_lock_free", nodecl.} - ## This built-in function returns true if objects of size bytes always generate - ## lock free atomic instructions for the target architecture. size must resolve + ## This built-in function returns true if objects of size bytes always generate + ## lock free atomic instructions for the target architecture. size must resolve ## to a compile-time constant and the result also resolves to a compile-time constant. - ## ptr is an optional pointer to the object that may be used to determine alignment. - ## A value of 0 indicates typical alignment should be used. The compiler may also + ## ptr is an optional pointer to the object that may be used to determine alignment. + ## A value of 0 indicates typical alignment should be used. The compiler may also ## ignore this parameter. - proc atomicIsLockFree*(size: int, p: pointer): bool {. + proc atomicIsLockFree*(size: int, p: pointer): bool {. importc: "__atomic_is_lock_free", nodecl.} - ## This built-in function returns true if objects of size bytes always generate - ## lock free atomic instructions for the target architecture. If it is not known + ## This built-in function returns true if objects of size bytes always generate + ## lock free atomic instructions for the target architecture. If it is not known ## to be lock free a call is made to a runtime routine named __atomic_is_lock_free. - ## ptr is an optional pointer to the object that may be used to determine alignment. - ## A value of 0 indicates typical alignment should be used. The compiler may also + ## ptr is an optional pointer to the object that may be used to determine alignment. + ## A value of 0 indicates typical alignment should be used. The compiler may also ## ignore this parameter. template fence*() = atomicThreadFence(ATOMIC_SEQ_CST) @@ -178,7 +178,7 @@ proc atomicInc*(memLoc: var int, x: int = 1): int = else: inc(memLoc, x) result = memLoc - + proc atomicDec*(memLoc: var int, x: int = 1): int = when someGcc and hasThreadSupport: when declared(atomic_sub_fetch): @@ -206,6 +206,9 @@ else: when (defined(x86) or defined(amd64)) and someGcc: proc cpuRelax* {.inline.} = {.emit: """asm volatile("pause" ::: "memory");""".} +elif someGcc: + proc cpuRelax* {.inline.} = + {.emit: """asm volatile("" ::: "memory");""".} elif (defined(x86) or defined(amd64)) and defined(vcc): proc cpuRelax* {.importc: "YieldProcessor", header: "<windows.h>".} elif defined(icl): diff --git a/lib/system/gc_ms.nim b/lib/system/gc_ms.nim index 12eb97b1e..e287bf5d9 100644 --- a/lib/system/gc_ms.nim +++ b/lib/system/gc_ms.nim @@ -165,7 +165,7 @@ proc initGC() = init(gch.tempStack) init(gch.additionalRoots) when withBitvectors: - Init(gch.allocated) + init(gch.allocated) init(gch.marked) var diff --git a/lib/system/mmdisp.nim b/lib/system/mmdisp.nim index 84e532049..a378f86e7 100644 --- a/lib/system/mmdisp.nim +++ b/lib/system/mmdisp.nim @@ -109,24 +109,24 @@ when defined(boehmgc): when not defined(useNimRtl): - proc alloc(size: int): pointer = + proc alloc(size: Natural): pointer = result = boehmAlloc(size) if result == nil: raiseOutOfMem() - proc alloc0(size: int): pointer = + proc alloc0(size: Natural): pointer = result = alloc(size) zeroMem(result, size) - proc realloc(p: pointer, newsize: int): pointer = + proc realloc(p: pointer, newsize: Natural): pointer = result = boehmRealloc(p, newsize) if result == nil: raiseOutOfMem() proc dealloc(p: pointer) = boehmDealloc(p) - proc allocShared(size: int): pointer = + proc allocShared(size: Natural): pointer = result = boehmAlloc(size) if result == nil: raiseOutOfMem() - proc allocShared0(size: int): pointer = + proc allocShared0(size: Natural): pointer = result = alloc(size) zeroMem(result, size) - proc reallocShared(p: pointer, newsize: int): pointer = + proc reallocShared(p: pointer, newsize: Natural): pointer = result = boehmRealloc(p, newsize) if result == nil: raiseOutOfMem() proc deallocShared(p: pointer) = boehmDealloc(p) @@ -196,24 +196,24 @@ when defined(boehmgc): elif defined(nogc) and defined(useMalloc): when not defined(useNimRtl): - proc alloc(size: int): pointer = + proc alloc(size: Natural): pointer = result = cmalloc(size) if result == nil: raiseOutOfMem() - proc alloc0(size: int): pointer = + proc alloc0(size: Natural): pointer = result = alloc(size) zeroMem(result, size) - proc realloc(p: pointer, newsize: int): pointer = + proc realloc(p: pointer, newsize: Natural): pointer = result = crealloc(p, newsize) if result == nil: raiseOutOfMem() proc dealloc(p: pointer) = cfree(p) - proc allocShared(size: int): pointer = + proc allocShared(size: Natural): pointer = result = cmalloc(size) if result == nil: raiseOutOfMem() - proc allocShared0(size: int): pointer = + proc allocShared0(size: Natural): pointer = result = alloc(size) zeroMem(result, size) - proc reallocShared(p: pointer, newsize: int): pointer = + proc reallocShared(p: pointer, newsize: Natural): pointer = result = crealloc(p, newsize) if result == nil: raiseOutOfMem() proc deallocShared(p: pointer) = cfree(p) diff --git a/lib/system/sysio.nim b/lib/system/sysio.nim index 468af1713..3f860655e 100644 --- a/lib/system/sysio.nim +++ b/lib/system/sysio.nim @@ -16,7 +16,7 @@ # of the standard library! -proc fputs(c: cstring, f: File) {.importc: "fputs", header: "<stdio.h>", +proc fputs(c: cstring, f: File) {.importc: "fputs", header: "<stdio.h>", tags: [WriteIOEffect].} proc fgets(c: cstring, n: int, f: File): cstring {. importc: "fgets", header: "<stdio.h>", tags: [ReadIOEffect].} @@ -26,11 +26,30 @@ proc ungetc(c: cint, f: File) {.importc: "ungetc", header: "<stdio.h>", tags: [].} proc putc(c: char, stream: File) {.importc: "putc", header: "<stdio.h>", tags: [WriteIOEffect].} -proc fprintf(f: File, frmt: cstring) {.importc: "fprintf", +proc fprintf(f: File, frmt: cstring) {.importc: "fprintf", header: "<stdio.h>", varargs, tags: [WriteIOEffect].} proc strlen(c: cstring): int {. importc: "strlen", header: "<string.h>", tags: [].} +when defined(posix): + proc getc_unlocked(stream: File): cint {.importc: "getc_unlocked", + header: "<stdio.h>", tags: [ReadIOEffect].} + + proc flockfile(stream: File) {.importc: "flockfile", header: "<stdio.h>", + tags: [ReadIOEffect].} + + proc funlockfile(stream: File) {.importc: "funlockfile", header: "<stdio.h>", + tags: [ReadIOEffect].} +elif false: + # doesn't work on Windows yet: + proc getc_unlocked(stream: File): cint {.importc: "_fgetc_nolock", + header: "<stdio.h>", tags: [ReadIOEffect].} + + proc flockfile(stream: File) {.importc: "_lock_file", header: "<stdio.h>", + tags: [ReadIOEffect].} + + proc funlockfile(stream: File) {.importc: "_unlock_file", header: "<stdio.h>", + tags: [ReadIOEffect].} # C routine that is used here: proc fread(buf: pointer, size, n: int, f: File): int {. @@ -67,39 +86,57 @@ const proc raiseEIO(msg: string) {.noinline, noreturn.} = sysFatal(IOError, msg) -proc readLine(f: File, line: var TaintedString): bool = - # of course this could be optimized a bit; but IO is slow anyway... - # and it was difficult to get this CORRECT with Ansi C's methods - setLen(line.string, 0) # reuse the buffer! - while true: - var c = fgetc(f) - if c < 0'i32: - if line.len > 0: break - else: return false - if c == 10'i32: break # LF - if c == 13'i32: # CR - c = fgetc(f) # is the next char LF? - if c != 10'i32: ungetc(c, f) # no, put the character back - break - add line.string, chr(int(c)) - result = true +when declared(getc_unlocked): + proc readLine(f: File, line: var TaintedString): bool = + setLen(line.string, 0) # reuse the buffer! + flockfile(f) + while true: + var c = getc_unlocked(f) + if c < 0'i32: + if line.len > 0: break + else: return false + if c == 10'i32: break # LF + if c == 13'i32: # CR + c = getc_unlocked(f) # is the next char LF? + if c != 10'i32: ungetc(c, f) # no, put the character back + break + add line.string, chr(int(c)) + result = true + funlockfile(f) +else: + proc readLine(f: File, line: var TaintedString): bool = + # of course this could be optimized a bit; but IO is slow anyway... + # and it was difficult to get this CORRECT with Ansi C's methods + setLen(line.string, 0) # reuse the buffer! + while true: + var c = fgetc(f) + if c < 0'i32: + if line.len > 0: break + else: return false + if c == 10'i32: break # LF + if c == 13'i32: # CR + c = fgetc(f) # is the next char LF? + if c != 10'i32: ungetc(c, f) # no, put the character back + break + add line.string, chr(int(c)) + result = true proc readLine(f: File): TaintedString = result = TaintedString(newStringOfCap(80)) if not readLine(f, result): raiseEIO("EOF reached") -proc write(f: File, i: int) = +proc write(f: File, i: int) = when sizeof(int) == 8: fprintf(f, "%lld", i) else: fprintf(f, "%ld", i) -proc write(f: File, i: BiggestInt) = +proc write(f: File, i: BiggestInt) = when sizeof(BiggestInt) == 8: fprintf(f, "%lld", i) else: fprintf(f, "%ld", i) - + proc write(f: File, b: bool) = if b: write(f, "true") else: write(f, "false") @@ -110,7 +147,7 @@ proc write(f: File, c: char) = putc(c, f) proc write(f: File, a: varargs[string, `$`]) = for x in items(a): write(f, x) -proc readAllBuffer(file: File): string = +proc readAllBuffer(file: File): string = # This proc is for File we want to read but don't know how many # bytes we need to read before the buffer is empty. result = "" @@ -123,8 +160,8 @@ proc readAllBuffer(file: File): string = buffer.setLen(bytesRead) result.add(buffer) break - -proc rawFileSize(file: File): int = + +proc rawFileSize(file: File): int = # this does not raise an error opposed to `getFileSize` var oldPos = ftell(file) discard fseek(file, 0, 2) # seek the end of the file @@ -141,8 +178,8 @@ proc readAllFile(file: File, len: int): string = proc readAllFile(file: File): string = var len = rawFileSize(file) result = readAllFile(file, len) - -proc readAll(file: File): TaintedString = + +proc readAll(file: File): TaintedString = # Separate handling needed because we need to buffer when we # don't know the overall length of the File. let len = if file != stdin: rawFileSize(file) else: -1 @@ -150,7 +187,7 @@ proc readAll(file: File): TaintedString = result = readAllFile(file, len).TaintedString else: result = readAllBuffer(file).TaintedString - + proc readFile(filename: string): TaintedString = var f = open(filename) try: @@ -229,7 +266,7 @@ proc open(f: var File, filename: string, elif bufSize == 0: discard setvbuf(f, nil, IONBF, 0) -proc reopen(f: File, filename: string, mode: FileMode = fmRead): bool = +proc reopen(f: File, filename: string, mode: FileMode = fmRead): bool = var p: pointer = freopen(filename, FormatOpen[mode], f) result = p != nil @@ -243,23 +280,23 @@ proc open(f: var File, filehandle: FileHandle, mode: FileMode): bool = proc fwrite(buf: pointer, size, n: int, f: File): int {. importc: "fwrite", noDecl.} -proc readBuffer(f: File, buffer: pointer, len: int): int = +proc readBuffer(f: File, buffer: pointer, len: Natural): int = result = fread(buffer, 1, len, f) -proc readBytes(f: File, a: var openArray[int8|uint8], start, len: int): int = +proc readBytes(f: File, a: var openArray[int8|uint8], start, len: Natural): int = result = readBuffer(f, addr(a[start]), len) -proc readChars(f: File, a: var openArray[char], start, len: int): int = +proc readChars(f: File, a: var openArray[char], start, len: Natural): int = result = readBuffer(f, addr(a[start]), len) {.push stackTrace:off, profiler:off.} -proc writeBytes(f: File, a: openArray[int8|uint8], start, len: int): int = +proc writeBytes(f: File, a: openArray[int8|uint8], start, len: Natural): int = var x = cast[ptr array[0..1000_000_000, int8]](a) result = writeBuffer(f, addr(x[start]), len) -proc writeChars(f: File, a: openArray[char], start, len: int): int = +proc writeChars(f: File, a: openArray[char], start, len: Natural): int = var x = cast[ptr array[0..1000_000_000, int8]](a) result = writeBuffer(f, addr(x[start]), len) -proc writeBuffer(f: File, buffer: pointer, len: int): int = +proc writeBuffer(f: File, buffer: pointer, len: Natural): int = result = fwrite(buffer, 1, len, f) proc write(f: File, s: string) = diff --git a/lib/windows/windows.nim b/lib/windows/windows.nim index 43c595a64..b76dea6c5 100644 --- a/lib/windows/windows.nim +++ b/lib/windows/windows.nim @@ -11,7 +11,7 @@ ## Unicode version. {.deadCodeElim: on.} - +{.push gcsafe.} type WideChar* = uint16 PWideChar* = ptr uint16 @@ -23481,7 +23481,7 @@ proc ListView_EnsureVisible(hwndLV: HWND, i, fPartialOK: int32): LRESULT = MAKELPARAM(fPartialOK, 0)) proc ListView_FindItem(wnd: HWND, iStart: int32, lvfi: var LV_FINDINFO): int32 = - result = SendMessage(wnd, LVM_FINDITEM, WPARAM(iStart), + result = SendMessage(wnd, LVM_FINDITEM, WPARAM(iStart), cast[LPARAM](addr(lvfi))).int32 proc ListView_GetBkColor(wnd: HWND): LRESULT = @@ -23615,9 +23615,9 @@ proc ListView_SetTextBkColor(wnd: HWND, clrTextBk: COLORREF): LRESULT = proc ListView_SetTextColor(wnd: HWND, clrText: COLORREF): LRESULT = result = SendMessage(wnd, LVM_SETTEXTCOLOR, 0, LPARAM(clrText)) -proc ListView_SortItems(hwndLV: HWND, pfnCompare: PFNLVCOMPARE, +proc ListView_SortItems(hwndLV: HWND, pfnCompare: PFNLVCOMPARE, lPrm: LPARAM): LRESULT = - result = SendMessage(hwndLV, LVM_SORTITEMS, WPARAM(lPrm), + result = SendMessage(hwndLV, LVM_SORTITEMS, WPARAM(lPrm), cast[LPARAM](pfnCompare)) proc ListView_Update(hwndLV: HWND, i: int32): LRESULT = @@ -23924,3 +23924,5 @@ proc LOCALE_NEUTRAL(): DWORD = proc LOCALE_INVARIANT(): DWORD = result = MAKELCID(MAKELANGID(toU16(LANG_INVARIANT), SUBLANG_NEUTRAL), SORT_DEFAULT) + +{.pop.} diff --git a/lib/wrappers/claro.nim b/lib/wrappers/claro.nim index d36b9f178..0fb0882bf 100644 --- a/lib/wrappers/claro.nim +++ b/lib/wrappers/claro.nim @@ -2710,7 +2710,7 @@ proc workspace_window_set_icon*(w: ptr TWorkspaceWindow, icon: ptr TImage){. claro_base_init() claro_graphics_init() -when isMainModule: +when not defined(testing) and isMainModule: var w = newWindow(nil, newBounds(100, 100, 230, 230), 0) window_set_title(w, "Hello, World!") diff --git a/lib/wrappers/iup.nim b/lib/wrappers/iup.nim index 27ab7d870..93e14cccd 100644 --- a/lib/wrappers/iup.nim +++ b/lib/wrappers/iup.nim @@ -1,13 +1,13 @@ # # Binding for the IUP GUI toolkit -# (c) 2012 Andreas Rumpf +# (c) 2012 Andreas Rumpf # C header files translated by hand # Licence of IUP follows: # **************************************************************************** # Copyright (C) 1994-2009 Tecgraf, PUC-Rio. -# +# # Permission is hereby granted, free of charge, to any person obtaining # a copy of this software and associated documentation files (the # "Software"), to deal in the Software without restriction, including @@ -30,12 +30,12 @@ {.deadCodeElim: on.} -when defined(windows): - const dllname = "iup(30|27|26|25|24).dll" +when defined(windows): + const dllname = "iup(|30|27|26|25|24).dll" elif defined(macosx): - const dllname = "libiup(3.0|2.7|2.6|2.5|2.4).dylib" -else: - const dllname = "libiup(3.0|2.7|2.6|2.5|2.4).so.1" + const dllname = "libiup(|3.0|2.7|2.6|2.5|2.4).dylib" +else: + const dllname = "libiup(|3.0|2.7|2.6|2.5|2.4).so(|.1)" const IUP_NAME* = "IUP - Portable User Interface" @@ -67,8 +67,8 @@ proc alarm*(title, msg, b1, b2, b3: cstring): cint {. importc: "IupAlarm", dynlib: dllname, cdecl.} proc scanf*(format: cstring): cint {. importc: "IupScanf", dynlib: dllname, cdecl, varargs.} -proc listDialog*(theType: cint, title: cstring, size: cint, - list: cstringArray, op, maxCol, maxLin: cint, +proc listDialog*(theType: cint, title: cstring, size: cint, + list: cstringArray, op, maxCol, maxLin: cint, marks: ptr cint): cint {. importc: "IupListDialog", dynlib: dllname, cdecl.} proc getText*(title, text: cstring): cint {. @@ -77,14 +77,14 @@ proc getColor*(x, y: cint, r, g, b: var byte): cint {. importc: "IupGetColor", dynlib: dllname, cdecl.} type - Iparamcb* = proc (dialog: PIhandle, paramIndex: cint, + Iparamcb* = proc (dialog: PIhandle, paramIndex: cint, userData: pointer): cint {.cdecl.} -proc getParam*(title: cstring, action: Iparamcb, userData: pointer, +proc getParam*(title: cstring, action: Iparamcb, userData: pointer, format: cstring): cint {. importc: "IupGetParam", cdecl, varargs, dynlib: dllname.} -proc getParamv*(title: cstring, action: Iparamcb, userData: pointer, - format: cstring, paramCount, paramExtra: cint, +proc getParamv*(title: cstring, action: Iparamcb, userData: pointer, + format: cstring, paramCount, paramExtra: cint, paramData: pointer): cint {. importc: "IupGetParamv", cdecl, dynlib: dllname.} @@ -96,11 +96,11 @@ proc open*(argc: ptr cint, argv: ptr cstringArray): cint {. proc close*() {.importc: "IupClose", cdecl, dynlib: dllname.} proc imageLibOpen*() {.importc: "IupImageLibOpen", cdecl, dynlib: dllname.} -proc mainLoop*(): cint {.importc: "IupMainLoop", cdecl, dynlib: dllname, +proc mainLoop*(): cint {.importc: "IupMainLoop", cdecl, dynlib: dllname, discardable.} proc loopStep*(): cint {.importc: "IupLoopStep", cdecl, dynlib: dllname, discardable.} -proc mainLoopLevel*(): cint {.importc: "IupMainLoopLevel", cdecl, +proc mainLoopLevel*(): cint {.importc: "IupMainLoopLevel", cdecl, dynlib: dllname, discardable.} proc flush*() {.importc: "IupFlush", cdecl, dynlib: dllname.} proc exitLoop*() {.importc: "IupExitLoop", cdecl, dynlib: dllname.} @@ -204,7 +204,7 @@ proc getCallback*(ih: PIhandle, name: cstring): Icallback {. importc: "IupGetCallback", cdecl, dynlib: dllname.} proc setCallback*(ih: PIhandle, name: cstring, fn: Icallback): Icallback {. importc: "IupSetCallback", cdecl, dynlib: dllname, discardable.} - + proc setCallbacks*(ih: PIhandle, name: cstring, fn: Icallback): PIhandle {. importc: "IupSetCallbacks", cdecl, dynlib: dllname, varargs, discardable.} @@ -235,7 +235,7 @@ proc getClassName*(ih: PIhandle): cstring {. importc: "IupGetClassName", cdecl, dynlib: dllname.} proc getClassType*(ih: PIhandle): cstring {. importc: "IupGetClassType", cdecl, dynlib: dllname.} -proc getClassAttributes*(classname: cstring, names: cstringArray, +proc getClassAttributes*(classname: cstring, names: cstringArray, n: cint): cint {. importc: "IupGetClassAttributes", cdecl, dynlib: dllname.} proc saveClassAttributes*(ih: PIhandle) {. @@ -378,12 +378,12 @@ const IUP_CONTINUE* = cint(-4) # IupPopup and IupShowXY Parameter Values - IUP_CENTER* = cint(0xFFFF) - IUP_LEFT* = cint(0xFFFE) - IUP_RIGHT* = cint(0xFFFD) - IUP_MOUSEPOS* = cint(0xFFFC) - IUP_CURRENT* = cint(0xFFFB) - IUP_CENTERPARENT* = cint(0xFFFA) + IUP_CENTER* = cint(0xFFFF) + IUP_LEFT* = cint(0xFFFE) + IUP_RIGHT* = cint(0xFFFD) + IUP_MOUSEPOS* = cint(0xFFFC) + IUP_CURRENT* = cint(0xFFFB) + IUP_CENTERPARENT* = cint(0xFFFA) IUP_TOP* = IUP_LEFT IUP_BOTTOM* = IUP_RIGHT @@ -397,10 +397,10 @@ const # SCROLL_CB Callback Values IUP_SBUP* = cint(0) IUP_SBDN* = cint(1) - IUP_SBPGUP* = cint(2) + IUP_SBPGUP* = cint(2) IUP_SBPGDN* = cint(3) IUP_SBPOSV* = cint(4) - IUP_SBDRAGV* = cint(5) + IUP_SBDRAGV* = cint(5) IUP_SBLEFT* = cint(6) IUP_SBRIGHT* = cint(7) IUP_SBPGLEFT* = cint(8) @@ -433,12 +433,12 @@ const IUP_MASK_EFLOAT* = "[+/-]?(/d+/.?/d*|/./d+)([eE][+/-]?/d+)?" IUP_MASK_INT* = "[+/-]?/d+" IUP_MASK_UINT* = "/d+" - + # from 32 to 126, all character sets are equal, # the key code i the same as the character code. const K_SP* = cint(ord(' ')) - K_exclam* = cint(ord('!')) + K_exclam* = cint(ord('!')) K_quotedbl* = cint(ord('\"')) K_numbersign* = cint(ord('#')) K_dollar* = cint(ord('$')) @@ -467,51 +467,51 @@ const K_semicolon* = cint(ord(';')) K_less* = cint(ord('<')) K_equal* = cint(ord('=')) - K_greater* = cint(ord('>')) - K_question* = cint(ord('?')) - K_at* = cint(ord('@')) - K_upperA* = cint(ord('A')) - K_upperB* = cint(ord('B')) - K_upperC* = cint(ord('C')) - K_upperD* = cint(ord('D')) - K_upperE* = cint(ord('E')) - K_upperF* = cint(ord('F')) - K_upperG* = cint(ord('G')) - K_upperH* = cint(ord('H')) - K_upperI* = cint(ord('I')) - K_upperJ* = cint(ord('J')) - K_upperK* = cint(ord('K')) - K_upperL* = cint(ord('L')) - K_upperM* = cint(ord('M')) - K_upperN* = cint(ord('N')) - K_upperO* = cint(ord('O')) - K_upperP* = cint(ord('P')) - K_upperQ* = cint(ord('Q')) - K_upperR* = cint(ord('R')) - K_upperS* = cint(ord('S')) - K_upperT* = cint(ord('T')) - K_upperU* = cint(ord('U')) - K_upperV* = cint(ord('V')) - K_upperW* = cint(ord('W')) - K_upperX* = cint(ord('X')) - K_upperY* = cint(ord('Y')) - K_upperZ* = cint(ord('Z')) - K_bracketleft* = cint(ord('[')) - K_backslash* = cint(ord('\\')) - K_bracketright* = cint(ord(']')) - K_circum* = cint(ord('^')) - K_underscore* = cint(ord('_')) - K_grave* = cint(ord('`')) - K_lowera* = cint(ord('a')) - K_lowerb* = cint(ord('b')) - K_lowerc* = cint(ord('c')) - K_lowerd* = cint(ord('d')) - K_lowere* = cint(ord('e')) - K_lowerf* = cint(ord('f')) + K_greater* = cint(ord('>')) + K_question* = cint(ord('?')) + K_at* = cint(ord('@')) + K_upperA* = cint(ord('A')) + K_upperB* = cint(ord('B')) + K_upperC* = cint(ord('C')) + K_upperD* = cint(ord('D')) + K_upperE* = cint(ord('E')) + K_upperF* = cint(ord('F')) + K_upperG* = cint(ord('G')) + K_upperH* = cint(ord('H')) + K_upperI* = cint(ord('I')) + K_upperJ* = cint(ord('J')) + K_upperK* = cint(ord('K')) + K_upperL* = cint(ord('L')) + K_upperM* = cint(ord('M')) + K_upperN* = cint(ord('N')) + K_upperO* = cint(ord('O')) + K_upperP* = cint(ord('P')) + K_upperQ* = cint(ord('Q')) + K_upperR* = cint(ord('R')) + K_upperS* = cint(ord('S')) + K_upperT* = cint(ord('T')) + K_upperU* = cint(ord('U')) + K_upperV* = cint(ord('V')) + K_upperW* = cint(ord('W')) + K_upperX* = cint(ord('X')) + K_upperY* = cint(ord('Y')) + K_upperZ* = cint(ord('Z')) + K_bracketleft* = cint(ord('[')) + K_backslash* = cint(ord('\\')) + K_bracketright* = cint(ord(']')) + K_circum* = cint(ord('^')) + K_underscore* = cint(ord('_')) + K_grave* = cint(ord('`')) + K_lowera* = cint(ord('a')) + K_lowerb* = cint(ord('b')) + K_lowerc* = cint(ord('c')) + K_lowerd* = cint(ord('d')) + K_lowere* = cint(ord('e')) + K_lowerf* = cint(ord('f')) K_lowerg* = cint(ord('g')) - K_lowerh* = cint(ord('h')) - K_loweri* = cint(ord('i')) - K_lowerj* = cint(ord('j')) + K_lowerh* = cint(ord('h')) + K_loweri* = cint(ord('i')) + K_lowerj* = cint(ord('j')) K_lowerk* = cint(ord('k')) K_lowerl* = cint(ord('l')) K_lowerm* = cint(ord('m')) @@ -553,19 +553,19 @@ proc isAltXkey*(c: cint): bool = return c > 768 and c < 1024 proc isSysXkey*(c: cint): bool = return c > 1024 and c < 1280 proc iUPxCODE*(c: cint): cint = return c + cint(128) # Normal (must be above 128) -proc iUPsxCODE*(c: cint): cint = +proc iUPsxCODE*(c: cint): cint = return c + cint(256) - # Shift (must have range to include the standard keys and the normal + # Shift (must have range to include the standard keys and the normal # extended keys, so must be above 256 proc iUPcxCODE*(c: cint): cint = return c + cint(512) # Ctrl proc iUPmxCODE*(c: cint): cint = return c + cint(768) # Alt -proc iUPyxCODE*(c: cint): cint = return c + cint(1024) # Sys (Win or Apple) +proc iUPyxCODE*(c: cint): cint = return c + cint(1024) # Sys (Win or Apple) const IUP_NUMMAXCODES* = 1280 ## 5*256=1280 Normal+Shift+Ctrl+Alt+Sys - K_HOME* = iUPxCODE(1) + K_HOME* = iUPxCODE(1) K_UP* = iUPxCODE(2) K_PGUP* = iUPxCODE(3) K_LEFT* = iUPxCODE(4) @@ -574,8 +574,8 @@ const K_END* = iUPxCODE(7) K_DOWN* = iUPxCODE(8) K_PGDN* = iUPxCODE(9) - K_INS* = iUPxCODE(10) - K_DEL* = iUPxCODE(11) + K_INS* = iUPxCODE(10) + K_DEL* = iUPxCODE(11) K_PAUSE* = iUPxCODE(12) K_ESC* = iUPxCODE(13) K_ccedilla* = iUPxCODE(14) @@ -728,13 +728,13 @@ const K_yPrint* = iUPyxCODE(K_Print) K_yMenu* = iUPyxCODE(K_Menu) - K_sPlus* = iUPsxCODE(K_plus) - K_sComma* = iUPsxCODE(K_comma) - K_sMinus* = iUPsxCODE(K_minus) - K_sPeriod* = iUPsxCODE(K_period) - K_sSlash* = iUPsxCODE(K_slash) + K_sPlus* = iUPsxCODE(K_plus) + K_sComma* = iUPsxCODE(K_comma) + K_sMinus* = iUPsxCODE(K_minus) + K_sPeriod* = iUPsxCODE(K_period) + K_sSlash* = iUPsxCODE(K_slash) K_sAsterisk* = iUPsxCODE(K_asterisk) - + K_cupperA* = iUPcxCODE(K_upperA) K_cupperB* = iUPcxCODE(K_upperB) K_cupperC* = iUPcxCODE(K_upperC) @@ -767,16 +767,16 @@ const K_c4* = iUPcxCODE(K_4) K_c5* = iUPcxCODE(K_5) K_c6* = iUPcxCODE(K_6) - K_c7* = iUPcxCODE(K_7) - K_c8* = iUPcxCODE(K_8) + K_c7* = iUPcxCODE(K_7) + K_c8* = iUPcxCODE(K_8) K_c9* = iUPcxCODE(K_9) K_c0* = iUPcxCODE(K_0) - K_cPlus* = iUPcxCODE(K_plus) - K_cComma* = iUPcxCODE(K_comma) - K_cMinus* = iUPcxCODE(K_minus) - K_cPeriod* = iUPcxCODE(K_period) - K_cSlash* = iUPcxCODE(K_slash) - K_cSemicolon* = iUPcxCODE(K_semicolon) + K_cPlus* = iUPcxCODE(K_plus) + K_cComma* = iUPcxCODE(K_comma) + K_cMinus* = iUPcxCODE(K_minus) + K_cPeriod* = iUPcxCODE(K_period) + K_cSlash* = iUPcxCODE(K_slash) + K_cSemicolon* = iUPcxCODE(K_semicolon) K_cEqual* = iUPcxCODE(K_equal) K_cBracketleft* = iUPcxCODE(K_bracketleft) K_cBracketright* = iUPcxCODE(K_bracketright) @@ -815,16 +815,16 @@ const K_m4* = iUPmxCODE(K_4) K_m5* = iUPmxCODE(K_5) K_m6* = iUPmxCODE(K_6) - K_m7* = iUPmxCODE(K_7) - K_m8* = iUPmxCODE(K_8) + K_m7* = iUPmxCODE(K_7) + K_m8* = iUPmxCODE(K_8) K_m9* = iUPmxCODE(K_9) K_m0* = iUPmxCODE(K_0) - K_mPlus* = iUPmxCODE(K_plus) - K_mComma* = iUPmxCODE(K_comma) - K_mMinus* = iUPmxCODE(K_minus) - K_mPeriod* = iUPmxCODE(K_period) - K_mSlash* = iUPmxCODE(K_slash) - K_mSemicolon* = iUPmxCODE(K_semicolon) + K_mPlus* = iUPmxCODE(K_plus) + K_mComma* = iUPmxCODE(K_comma) + K_mMinus* = iUPmxCODE(K_minus) + K_mPeriod* = iUPmxCODE(K_period) + K_mSlash* = iUPmxCODE(K_slash) + K_mSemicolon* = iUPmxCODE(K_semicolon) K_mEqual* = iUPmxCODE(K_equal) K_mBracketleft* = iUPmxCODE(K_bracketleft) K_mBracketright* = iUPmxCODE(K_bracketright) @@ -863,16 +863,16 @@ const K_y4* = iUPyxCODE(K_4) K_y5* = iUPyxCODE(K_5) K_y6* = iUPyxCODE(K_6) - K_y7* = iUPyxCODE(K_7) - K_y8* = iUPyxCODE(K_8) + K_y7* = iUPyxCODE(K_7) + K_y8* = iUPyxCODE(K_8) K_y9* = iUPyxCODE(K_9) K_y0* = iUPyxCODE(K_0) K_yPlus* = iUPyxCODE(K_plus) K_yComma* = iUPyxCODE(K_comma) - K_yMinus* = iUPyxCODE(K_minus) - K_yPeriod* = iUPyxCODE(K_period) - K_ySlash* = iUPyxCODE(K_slash) - K_ySemicolon* = iUPyxCODE(K_semicolon) + K_yMinus* = iUPyxCODE(K_minus) + K_yPeriod* = iUPyxCODE(K_period) + K_ySlash* = iUPyxCODE(K_slash) + K_ySemicolon* = iUPyxCODE(K_semicolon) K_yEqual* = iUPyxCODE(K_equal) K_yBracketleft* = iUPyxCODE(K_bracketleft) K_yBracketright* = iUPyxCODE(K_bracketright) @@ -893,11 +893,11 @@ proc dial*(theType: cstring): PIhandle {.cdecl, importc: "IupDial", dynlib: dlln proc matrix*(action: cstring): PIhandle {.cdecl, importc: "IupMatrix", dynlib: dllname.} # IupMatrix utilities -proc matSetAttribute*(ih: PIhandle, name: cstring, lin, col: cint, +proc matSetAttribute*(ih: PIhandle, name: cstring, lin, col: cint, value: cstring) {. cdecl, importc: "IupMatSetAttribute", dynlib: dllname.} -proc matStoreAttribute*(ih: PIhandle, name: cstring, lin, col: cint, - value: cstring) {.cdecl, +proc matStoreAttribute*(ih: PIhandle, name: cstring, lin, col: cint, + value: cstring) {.cdecl, importc: "IupMatStoreAttribute", dynlib: dllname.} proc matGetAttribute*(ih: PIhandle, name: cstring, lin, col: cint): cstring {. cdecl, importc: "IupMatGetAttribute", dynlib: dllname.} @@ -905,9 +905,9 @@ proc matGetInt*(ih: PIhandle, name: cstring, lin, col: cint): cint {. cdecl, importc: "IupMatGetInt", dynlib: dllname.} proc matGetFloat*(ih: PIhandle, name: cstring, lin, col: cint): cfloat {. cdecl, importc: "IupMatGetFloat", dynlib: dllname.} -proc matSetfAttribute*(ih: PIhandle, name: cstring, lin, col: cint, - format: cstring) {.cdecl, - importc: "IupMatSetfAttribute", +proc matSetfAttribute*(ih: PIhandle, name: cstring, lin, col: cint, + format: cstring) {.cdecl, + importc: "IupMatSetfAttribute", dynlib: dllname, varargs.} # Used by IupColorbar @@ -931,10 +931,10 @@ proc pPlotAddStr*(ih: PIhandle, x: cstring, y: cfloat) {. proc pPlotEnd*(ih: PIhandle): cint {. cdecl, importc: "IupPPlotEnd", dynlib: dllname.} -proc pPlotInsertStr*(ih: PIhandle, index, sampleIndex: cint, x: cstring, - y: cfloat) {.cdecl, importc: "IupPPlotInsertStr", +proc pPlotInsertStr*(ih: PIhandle, index, sampleIndex: cint, x: cstring, + y: cfloat) {.cdecl, importc: "IupPPlotInsertStr", dynlib: dllname.} -proc pPlotInsert*(ih: PIhandle, index, sampleIndex: cint, +proc pPlotInsert*(ih: PIhandle, index, sampleIndex: cint, x, y: cfloat) {. cdecl, importc: "IupPPlotInsert", dynlib: dllname.} diff --git a/lib/wrappers/pcre.nim b/lib/wrappers/pcre.nim index afa8f447a..67436f026 100644 --- a/lib/wrappers/pcre.nim +++ b/lib/wrappers/pcre.nim @@ -1,158 +1,190 @@ #************************************************ -# Perl-Compatible Regular Expressions * -#*********************************************** +# Perl-Compatible Regular Expressions * +#************************************************ # This is the public header file for the PCRE library, to be #included by -#applications that call the PCRE functions. +# applications that call the PCRE functions. # -# Copyright (c) 1997-2010 University of Cambridge +# Copyright (c) 1997-2014 University of Cambridge # #----------------------------------------------------------------------------- -#Redistribution and use in source and binary forms, with or without -#modification, are permitted provided that the following conditions are met: +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions are met: # -# Redistributions of source code must retain the above copyright notice, +# * Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # -# Redistributions in binary form must reproduce the above copyright +# * Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # -# Neither the name of the University of Cambridge nor the names of its +# * Neither the name of the University of Cambridge nor the names of its # contributors may be used to endorse or promote products derived from # this software without specific prior written permission. # -#THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -#AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -#IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -#ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE -#LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -#CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -#SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -#INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -#CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -#ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -#POSSIBILITY OF SUCH DAMAGE. +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +# POSSIBILITY OF SUCH DAMAGE. #----------------------------------------------------------------------------- -# -{.deadcodeElim: on.} - -when not defined(pcreDll): - when hostOS == "windows": - const pcreDll = "pcre.dll" - elif hostOS == "macosx": - const pcreDll = "libpcre(.3|.1|).dylib" - else: - const pcreDll = "libpcre.so(.3|.1|)" - {.pragma: pcreImport, dynlib: pcreDll.} -else: - {.pragma: pcreImport, header: "<pcre.h>".} +{.deadCodeElim: on.} -# The current PCRE version information. +# The current PCRE version information. -const - MAJOR* = 8 - MINOR* = 31 - PRERELEASE* = true - DATE* = "2012-07-06" +const + PCRE_MAJOR* = 8 + PCRE_MINOR* = 36 + PCRE_PRERELEASE* = true + PCRE_DATE* = "2014-09-26" # When an application links to a PCRE DLL in Windows, the symbols that are # imported have to be identified as such. When building PCRE, the appropriate # export setting is defined in pcre_internal.h, which includes this file. So we -# don't change existing definitions of PCRE_EXP_DECL and PCRECPP_EXP_DECL. - -# Have to include stdlib.h in order to ensure that size_t is defined; -# it is needed here for malloc. - -# Allow for C++ users - -# Options. Some are compile-time only, some are run-time only, and some are -# both, so we keep them all distinct. - -const - CASELESS* = 0x00000001 - MULTILINE* = 0x00000002 - DOTALL* = 0x00000004 - EXTENDED* = 0x00000008 - ANCHORED* = 0x00000010 - DOLLAR_ENDONLY* = 0x00000020 - EXTRA* = 0x00000040 - NOTBOL* = 0x00000080 - NOTEOL* = 0x00000100 - UNGREEDY* = 0x00000200 - NOTEMPTY* = 0x00000400 - UTF8* = 0x00000800 - NO_AUTO_CAPTURE* = 0x00001000 - NO_UTF8_CHECK* = 0x00002000 - AUTO_CALLOUT* = 0x00004000 - PARTIAL_SOFT* = 0x00008000 - PARTIAL* = 0x00008000 # Backwards compatible synonym - DFA_SHORTEST* = 0x00010000 - DFA_RESTART* = 0x00020000 - FIRSTLINE* = 0x00040000 - DUPNAMES* = 0x00080000 - NEWLINE_CR* = 0x00100000 - NEWLINE_LF* = 0x00200000 - NEWLINE_CRLF* = 0x00300000 - NEWLINE_ANY* = 0x00400000 - NEWLINE_ANYCRLF* = 0x00500000 - BSR_ANYCRLF* = 0x00800000 - BSR_UNICODE* = 0x01000000 - JAVASCRIPT_COMPAT* = 0x02000000 - NO_START_OPTIMIZE* = 0x04000000 - NO_START_OPTIMISE* = 0x04000000 - PARTIAL_HARD* = 0x08000000 - NOTEMPTY_ATSTART* = 0x10000000 - UCP* = 0x20000000 - -# Exec-time and get/set-time error codes - -const - ERROR_NOMATCH* = (- 1) - ERROR_NULL* = (- 2) - ERROR_BADOPTION* = (- 3) - ERROR_BADMAGIC* = (- 4) - ERROR_UNKNOWN_OPCODE* = (- 5) - ERROR_UNKNOWN_NODE* = (- 5) # For backward compatibility - ERROR_NOMEMORY* = (- 6) - ERROR_NOSUBSTRING* = (- 7) - ERROR_MATCHLIMIT* = (- 8) - ERROR_CALLOUT* = (- 9) # Never used by PCRE itself - ERROR_BADUTF8* = (- 10) - ERROR_BADUTF8_OFFSET* = (- 11) - ERROR_PARTIAL* = (- 12) - ERROR_BADPARTIAL* = (- 13) - ERROR_INTERNAL* = (- 14) - ERROR_BADCOUNT* = (- 15) - ERROR_DFA_UITEM* = (- 16) - ERROR_DFA_UCOND* = (- 17) - ERROR_DFA_UMLIMIT* = (- 18) - ERROR_DFA_WSSIZE* = (- 19) - ERROR_DFA_RECURSE* = (- 20) - ERROR_RECURSIONLIMIT* = (- 21) - ERROR_NULLWSLIMIT* = (- 22) # No longer actually used - ERROR_BADNEWLINE* = (- 23) - ERROR_BADOFFSET* = (- 24) - ERROR_SHORTUTF8* = (- 25) - ERROR_RECURSELOOP* = (- 26) - ERROR_JIT_STACKLIMIT* = (- 27) - ERROR_BADMODE* = (- 28) - ERROR_BADENDIANNESS* = (- 29) - ERROR_DFA_BADRESTART* = (- 30) - -# Specific error codes for UTF-8 validity checks +# don't change existing definitions of PCRE_EXP_DECL and PCRECPP_EXP_DECL. + +# By default, we use the standard "extern" declarations. + +# Allow for C++ users + +# Public options. Some are compile-time only, some are run-time only, and some +# are both. Most of the compile-time options are saved with the compiled regex +# so that they can be inspected during studying (and therefore JIT compiling). +# Note that pcre_study() has its own set of options. Originally, all the options +# defined here used distinct bits. However, almost all the bits in a 32-bit word +# are now used, so in order to conserve them, option bits that were previously +# only recognized at matching time (i.e. by pcre_exec() or pcre_dfa_exec()) may +# also be used for compile-time options that affect only compiling and are not +# relevant for studying or JIT compiling. +# +# Some options for pcre_compile() change its behaviour but do not affect the +# behaviour of the execution functions. Other options are passed through to the +# execution functions and affect their behaviour, with or without affecting the +# behaviour of pcre_compile(). +# +# Options that can be passed to pcre_compile() are tagged Cx below, with these +# variants: +# +# C1 Affects compile only +# C2 Does not affect compile; affects exec, dfa_exec +# C3 Affects compile, exec, dfa_exec +# C4 Affects compile, exec, dfa_exec, study +# C5 Affects compile, exec, study +# +# Options that can be set for pcre_exec() and/or pcre_dfa_exec() are flagged +# with E and D, respectively. They take precedence over C3, C4, and C5 settings +# passed from pcre_compile(). Those that are compatible with JIT execution are +# flagged with J. + +const + CASELESS* = 0x00000001 # C1 + MULTILINE* = 0x00000002 # C1 + DOTALL* = 0x00000004 # C1 + EXTENDED* = 0x00000008 # C1 + ANCHORED* = 0x00000010 # C4 E D + DOLLAR_ENDONLY* = 0x00000020 # C2 + EXTRA* = 0x00000040 # C1 + NOTBOL* = 0x00000080 # E D J + NOTEOL* = 0x00000100 # E D J + UNGREEDY* = 0x00000200 # C1 + NOTEMPTY* = 0x00000400 # E D J + UTF8* = 0x00000800 # C4 ) + UTF16* = 0x00000800 # C4 ) Synonyms + UTF32* = 0x00000800 # C4 ) + NO_AUTO_CAPTURE* = 0x00001000 # C1 + NO_UTF8_CHECK* = 0x00002000 # C1 E D J ) + NO_UTF16_CHECK* = 0x00002000 # C1 E D J ) Synonyms + NO_UTF32_CHECK* = 0x00002000 # C1 E D J ) + AUTO_CALLOUT* = 0x00004000 # C1 + PARTIAL_SOFT* = 0x00008000 # E D J ) Synonyms + PARTIAL* = 0x00008000 # E D J ) + +# This pair use the same bit. +const + NEVER_UTF* = 0x00010000 # C1 ) Overlaid + DFA_SHORTEST* = 0x00010000 # D ) Overlaid +# This pair use the same bit. const - UTF8_ERR0* = 0 - UTF8_ERR1* = 1 - UTF8_ERR2* = 2 - UTF8_ERR3* = 3 - UTF8_ERR4* = 4 - UTF8_ERR5* = 5 - UTF8_ERR6* = 6 - UTF8_ERR7* = 7 - UTF8_ERR8* = 8 - UTF8_ERR9* = 9 + NO_AUTO_POSSESS* = 0x00020000 # C1 ) Overlaid + DFA_RESTART* = 0x00020000 # D ) Overlaid + +const + FIRSTLINE* = 0x00040000 # C3 + DUPNAMES* = 0x00080000 # C1 + NEWLINE_CR* = 0x00100000 # C3 E D + NEWLINE_LF* = 0x00200000 # C3 E D + NEWLINE_CRLF* = 0x00300000 # C3 E D + NEWLINE_ANY* = 0x00400000 # C3 E D + NEWLINE_ANYCRLF* = 0x00500000 # C3 E D + BSR_ANYCRLF* = 0x00800000 # C3 E D + BSR_UNICODE* = 0x01000000 # C3 E D + JAVASCRIPT_COMPAT* = 0x02000000 # C5 + NO_START_OPTIMIZE* = 0x04000000 # C2 E D ) Synonyms + NO_START_OPTIMISE* = 0x04000000 # C2 E D ) + PARTIAL_HARD* = 0x08000000 # E D J + NOTEMPTY_ATSTART* = 0x10000000 # E D J + UCP* = 0x20000000 # C3 + +## Exec-time and get/set-time error codes +const + ERROR_NOMATCH* = -1 + ERROR_NULL* = -2 + ERROR_BADOPTION* = -3 + ERROR_BADMAGIC* = -4 + ERROR_UNKNOWN_OPCODE* = -5 + ERROR_UNKNOWN_NODE* = -5 ## For backward compatibility + ERROR_NOMEMORY* = -6 + ERROR_NOSUBSTRING* = -7 + ERROR_MATCHLIMIT* = -8 + ERROR_CALLOUT* = -9 ## Never used by PCRE itself + ERROR_BADUTF8* = -10 ## Same for 8/16/32 + ERROR_BADUTF16* = -10 ## Same for 8/16/32 + ERROR_BADUTF32* = -10 ## Same for 8/16/32 + ERROR_BADUTF8_OFFSET* = -11 ## Same for 8/16 + ERROR_BADUTF16_OFFSET* = -11 ## Same for 8/16 + ERROR_PARTIAL* = -12 + ERROR_BADPARTIAL* = -13 + ERROR_INTERNAL* = -14 + ERROR_BADCOUNT* = -15 + ERROR_DFA_UITEM* = -16 + ERROR_DFA_UCOND* = -17 + ERROR_DFA_UMLIMIT* = -18 + ERROR_DFA_WSSIZE* = -19 + ERROR_DFA_RECURSE* = -20 + ERROR_RECURSIONLIMIT* = -21 + ERROR_NULLWSLIMIT* = -22 ## No longer actually used + ERROR_BADNEWLINE* = -23 + ERROR_BADOFFSET* = -24 + ERROR_SHORTUTF8* = -25 + ERROR_SHORTUTF16* = -25 ## Same for 8/16 + ERROR_RECURSELOOP* = -26 + ERROR_JIT_STACKLIMIT* = -27 + ERROR_BADMODE* = -28 + ERROR_BADENDIANNESS* = -29 + ERROR_DFA_BADRESTART* = -30 + ERROR_JIT_BADOPTION* = -31 + ERROR_BADLENGTH* = -32 + ERROR_UNSET* = -33 + +## Specific error codes for UTF-8 validity checks +const + UTF8_ERR0* = 0 + UTF8_ERR1* = 1 + UTF8_ERR2* = 2 + UTF8_ERR3* = 3 + UTF8_ERR4* = 4 + UTF8_ERR5* = 5 + UTF8_ERR6* = 6 + UTF8_ERR7* = 7 + UTF8_ERR8* = 8 + UTF8_ERR9* = 9 UTF8_ERR10* = 10 UTF8_ERR11* = 11 UTF8_ERR12* = 12 @@ -165,193 +197,305 @@ const UTF8_ERR19* = 19 UTF8_ERR20* = 20 UTF8_ERR21* = 21 + UTF8_ERR22* = 22 # Unused (was non-character) -# Request types for pcre_fullinfo() - -const - INFO_OPTIONS* = 0 - INFO_SIZE* = 1 - INFO_CAPTURECOUNT* = 2 - INFO_BACKREFMAX* = 3 - INFO_FIRSTBYTE* = 4 - INFO_FIRSTCHAR* = 4 # For backwards compatibility - INFO_FIRSTTABLE* = 5 - INFO_LASTLITERAL* = 6 - INFO_NAMEENTRYSIZE* = 7 - INFO_NAMECOUNT* = 8 - INFO_NAMETABLE* = 9 - INFO_STUDYSIZE* = 10 - INFO_DEFAULT_TABLES* = 11 - INFO_OKPARTIAL* = 12 - INFO_JCHANGED* = 13 - INFO_HASCRORLF* = 14 - INFO_MINLENGTH* = 15 - INFO_JIT* = 16 - INFO_JITSIZE* = 17 - INFO_MAXLOOKBEHIND* = 18 - -# Request types for pcre_config(). Do not re-arrange, in order to remain -# compatible. - -const - CONFIG_UTF8* = 0 - CONFIG_NEWLINE* = 1 - CONFIG_LINK_SIZE* = 2 - CONFIG_POSIX_MALLOC_THRESHOLD* = 3 - CONFIG_MATCH_LIMIT* = 4 - CONFIG_STACKRECURSE* = 5 - CONFIG_UNICODE_PROPERTIES* = 6 - CONFIG_MATCH_LIMIT_RECURSION* = 7 - CONFIG_BSR* = 8 - CONFIG_JIT* = 9 - CONFIG_JITTARGET* = 11 - -# Request types for pcre_study(). Do not re-arrange, in order to remain -# compatible. +## Specific error codes for UTF-16 validity checks +const + UTF16_ERR0* = 0 + UTF16_ERR1* = 1 + UTF16_ERR2* = 2 + UTF16_ERR3* = 3 + UTF16_ERR4* = 4 # Unused (was non-character) +## Specific error codes for UTF-32 validity checks const - STUDY_JIT_COMPILE* = 0x00000001 - STUDY_JIT_PARTIAL_SOFT_COMPILE* = 0x00000002 - STUDY_JIT_PARTIAL_HARD_COMPILE* = 0x00000004 - -# Bit flags for the pcre_extra structure. Do not re-arrange or redefine -# these bits, just add new ones on the end, in order to remain compatible. - -const - EXTRA_STUDY_DATA* = 0x00000001 - EXTRA_MATCH_LIMIT* = 0x00000002 - EXTRA_CALLOUT_DATA* = 0x00000004 - EXTRA_TABLES* = 0x00000008 - EXTRA_MATCH_LIMIT_RECURSION* = 0x00000010 - EXTRA_MARK* = 0x00000020 - EXTRA_EXECUTABLE_JIT* = 0x00000040 - -# Types - -type - TPcre*{.pure, final.} = object - PPcre* = ptr TPcre - Tjit_stack*{.pure, final.} = object - Pjit_stack* = ptr Tjit_stack - -# When PCRE is compiled as a C++ library, the subject pointer type can be -# replaced with a custom type. For conventional use, the public interface is a -# const char *. - -# The structure for passing additional data to pcre_exec(). This is defined in -# such as way as to be extensible. Always add new fields at the end, in order to -# remain compatible. - -type - TExtra*{.pure, final.} = object - flags*: int ## Bits for which fields are set - study_data*: pointer ## Opaque data from pcre_study() - match_limit*: int ## Maximum number of calls to match() - callout_data*: pointer ## Data passed back in callouts - tables*: cstring ## Pointer to character tables - match_limit_recursion*: int ## Max recursive calls to match() - mark*: ptr cstring ## For passing back a mark pointer - executable_jit*: pointer ## Contains a pointer to a compiled jit code - - -# The structure for passing out data via the pcre_callout_function. We use a -# structure so that new fields can be added on the end in future versions, -# without changing the API of the function, thereby allowing old clients to work -# without modification. - -type - TCalloutBlock*{.pure, final.} = object - version*: cint ## Identifies version of block - callout_number*: cint ## Number compiled into pattern - offset_vector*: ptr cint ## The offset vector - subject*: cstring ## The subject being matched - subject_length*: cint ## The length of the subject - start_match*: cint ## Offset to start of this match attempt - current_position*: cint ## Where we currently are in the subject - capture_top*: cint ## Max current capture - capture_last*: cint ## Most recently closed capture - callout_data*: pointer ## Data passed in with the call - pattern_position*: cint ## Offset to next item in the pattern - next_item_length*: cint ## Length of next item in the pattern - mark*: cstring ## Pointer to current mark or NULL - -# Indirection for store get and free functions. These can be set to -#alternative malloc/free functions if required. Special ones are used in the -#non-recursive case for "frames". There is also an optional callout function -#that is triggered by the (?) regex item. For Virtual Pascal, these definitions -#have to take another form. - -# User defined callback which provides a stack just before the match starts. + UTF32_ERR0* = 0 + UTF32_ERR1* = 1 + UTF32_ERR2* = 2 # Unused (was non-character) + UTF32_ERR3* = 3 +## Request types for pcre_fullinfo() +const + INFO_OPTIONS* = 0 + INFO_SIZE* = 1 + INFO_CAPTURECOUNT* = 2 + INFO_BACKREFMAX* = 3 + INFO_FIRSTBYTE* = 4 + INFO_FIRSTCHAR* = 4 ## For backwards compatibility + INFO_FIRSTTABLE* = 5 + INFO_LASTLITERAL* = 6 + INFO_NAMEENTRYSIZE* = 7 + INFO_NAMECOUNT* = 8 + INFO_NAMETABLE* = 9 + INFO_STUDYSIZE* = 10 + INFO_DEFAULT_TABLES* = 11 + INFO_OKPARTIAL* = 12 + INFO_JCHANGED* = 13 + INFO_HASCRORLF* = 14 + INFO_MINLENGTH* = 15 + INFO_JIT* = 16 + INFO_JITSIZE* = 17 + INFO_MAXLOOKBEHIND* = 18 + INFO_FIRSTCHARACTER* = 19 + INFO_FIRSTCHARACTERFLAGS* = 20 + INFO_REQUIREDCHAR* = 21 + INFO_REQUIREDCHARFLAGS* = 22 + INFO_MATCHLIMIT* = 23 + INFO_RECURSIONLIMIT* = 24 + INFO_MATCH_EMPTY* = 25 + +## Request types for pcre_config(). Do not re-arrange, in order to remain +## compatible. +const + CONFIG_UTF8* = 0 + CONFIG_NEWLINE* = 1 + CONFIG_LINK_SIZE* = 2 + CONFIG_POSIX_MALLOC_THRESHOLD* = 3 + CONFIG_MATCH_LIMIT* = 4 + CONFIG_STACKRECURSE* = 5 + CONFIG_UNICODE_PROPERTIES* = 6 + CONFIG_MATCH_LIMIT_RECURSION* = 7 + CONFIG_BSR* = 8 + CONFIG_JIT* = 9 + CONFIG_UTF16* = 10 + CONFIG_JITTARGET* = 11 + CONFIG_UTF32* = 12 + CONFIG_PARENS_LIMIT* = 13 + +## Request types for pcre_study(). Do not re-arrange, in order to remain +## compatible. +const + STUDY_JIT_COMPILE* = 0x0001 + STUDY_JIT_PARTIAL_SOFT_COMPILE* = 0x0002 + STUDY_JIT_PARTIAL_HARD_COMPILE* = 0x0004 + STUDY_EXTRA_NEEDED* = 0x0008 + +## Bit flags for the pcre[16|32]_extra structure. Do not re-arrange or redefine +## these bits, just add new ones on the end, in order to remain compatible. +const + EXTRA_STUDY_DATA* = 0x0001 + EXTRA_MATCH_LIMIT* = 0x0002 + EXTRA_CALLOUT_DATA* = 0x0004 + EXTRA_TABLES* = 0x0008 + EXTRA_MATCH_LIMIT_RECURSION* = 0x0010 + EXTRA_MARK* = 0x0020 + EXTRA_EXECUTABLE_JIT* = 0x0040 + +## Types +type + Pcre* = object + Pcre16* = object + Pcre32* = object + JitStack* = object + JitStack16* = object + JitStack32* = object + + +## The structure for passing additional data to pcre_exec(). This is defined in +## such as way as to be extensible. Always add new fields at the end, in order +## to remain compatible. +type + ExtraData* = object + flags*: clong ## Bits for which fields are set + study_data*: pointer ## Opaque data from pcre_study() + match_limit*: clong ## Maximum number of calls to match() + callout_data*: pointer ## Data passed back in callouts + tables*: pointer ## Pointer to character tables + match_limit_recursion*: clong ## Max recursive calls to match() + mark*: pointer ## For passing back a mark pointer + executable_jit*: pointer ## Contains a pointer to a compiled jit code + +## The structure for passing out data via the pcre_callout_function. We use a +## structure so that new fields can be added on the end in future versions, +## without changing the API of the function, thereby allowing old clients to +## work without modification. type - TJitCallback* = proc(p: pointer): ptr Tjit_stack{.cdecl.} - -# Exported PCRE functions - -proc compile*(a2: cstring, a3: cint, a4: ptr cstring, a5: ptr cint, - a6: ptr char): ptr TPcre{.cdecl, importc: "pcre_compile", - pcreImport.} -proc compile2*(a2: cstring, a3: cint, a4: ptr cint, a5: ptr cstring, - a6: ptr cint, a7: ptr char): ptr TPcre{.cdecl, - importc: "pcre_compile2", pcreImport.} -proc config*(a2: cint, a3: pointer): cint{.cdecl, importc: "pcre_config", - pcreImport.} -proc copy_named_substring*(a2: ptr TPcre, a3: cstring, a4: ptr cint, a5: cint, - a6: cstring, a7: cstring, a8: cint): cint{.cdecl, - importc: "pcre_copy_named_substring", pcreImport.} -proc copy_substring*(a2: cstring, a3: ptr cint, a4: cint, a5: cint, - a6: cstring, - a7: cint): cint{.cdecl, importc: "pcre_copy_substring", - pcreImport.} -proc dfa_exec*(a2: ptr TPcre, a3: ptr TExtra, a4: cstring, a5: cint, - a6: cint, a7: cint, a8: ptr cint, a9: cint, a10: ptr cint, - a11: cint): cint{.cdecl, importc: "pcre_dfa_exec", - pcreImport.} -proc exec*(a2: ptr TPcre, a3: ptr TExtra, a4: cstring, a5: cint, a6: cint, - a7: cint, a8: ptr cint, a9: cint): cint {. - cdecl, importc: "pcre_exec", pcreImport.} -proc free_substring*(a2: cstring){.cdecl, importc: "pcre_free_substring", - pcreImport.} -proc free_substring_list*(a2: cstringArray){.cdecl, - importc: "pcre_free_substring_list", pcreImport.} -proc fullinfo*(a2: ptr TPcre, a3: ptr TExtra, a4: cint, a5: pointer): cint{. - cdecl, importc: "pcre_fullinfo", pcreImport.} -proc get_named_substring*(a2: ptr TPcre, a3: cstring, a4: ptr cint, a5: cint, - a6: cstring, a7: cstringArray): cint{.cdecl, - importc: "pcre_get_named_substring", pcreImport.} -proc get_stringnumber*(a2: ptr TPcre, a3: cstring): cint{.cdecl, - importc: "pcre_get_stringnumber", pcreImport.} -proc get_stringtable_entries*(a2: ptr TPcre, a3: cstring, a4: cstringArray, - a5: cstringArray): cint{.cdecl, - importc: "pcre_get_stringtable_entries", pcreImport.} -proc get_substring*(a2: cstring, a3: ptr cint, a4: cint, a5: cint, - a6: cstringArray): cint{.cdecl, - importc: "pcre_get_substring", pcreImport.} -proc get_substring_list*(a2: cstring, a3: ptr cint, a4: cint, - a5: ptr cstringArray): cint{.cdecl, - importc: "pcre_get_substring_list", pcreImport.} -proc maketables*(): ptr char{.cdecl, importc: "pcre_maketables", - pcreImport.} -proc refcount*(a2: ptr TPcre, a3: cint): cint{.cdecl, importc: "pcre_refcount", - pcreImport.} -proc study*(a2: ptr TPcre, a3: cint, a4: var cstring): ptr TExtra{.cdecl, - importc: "pcre_study", pcreImport.} -proc version*(): cstring{.cdecl, importc: "pcre_version", pcreImport.} + CalloutBlock* = object + version* : cint ## Identifies version of block + # ------------------------ Version 0 ------------------------------- + callout_number* : cint ## Number compiled into pattern + offset_vector* : ptr cint ## The offset vector + subject* : cstring ## The subject being matched + subject_length* : cint ## The length of the subject + start_match* : cint ## Offset to start of this match attempt + current_position*: cint ## Where we currently are in the subject + capture_top* : cint ## Max current capture + capture_last* : cint ## Most recently closed capture + callout_data* : pointer ## Data passed in with the call + # ------------------- Added for Version 1 -------------------------- + pattern_position*: cint ## Offset to next item in the pattern + next_item_length*: cint ## Length of next item in the pattern + # ------------------- Added for Version 2 -------------------------- + mark* : pointer ## Pointer to current mark or NULL + # ------------------------------------------------------------------ + + +## User defined callback which provides a stack just before the match starts. +type + JitCallback* = proc (a: pointer): ptr JitStack {.cdecl.} + + +when not defined(usePcreHeader): + when hostOS == "windows": + const pcreDll = "pcre.dll" + elif hostOS == "macosx": + const pcreDll = "libpcre(.3|.1|).dylib" + else: + const pcreDll = "libpcre.so(.3|.1|)" + {.push dynlib: pcreDll.} +else: + {.push header: "<pcre.h>".} + +{.push cdecl, importc: "pcre_$1".} + +# Exported PCRE functions + +proc compile*(pattern: cstring, + options: cint, + errptr: ptr cstring, + erroffset: ptr cint, + tableptr: pointer): ptr Pcre + +proc compile2*(pattern: cstring, + options: cint, + errorcodeptr: ptr cint, + errptr: ptr cstring, + erroffset: ptr cint, + tableptr: pointer): ptr Pcre + +proc config*(what: cint, + where: pointer): cint + +proc copy_named_substring*(code: ptr Pcre, + subject: cstring, + ovector: ptr cint, + stringcount: cint, + stringname: cstring, + buffer: cstring, + buffersize: cint): cint + +proc copy_substring*(subject: cstring, + ovector: ptr cint, + stringcount: cint, + stringnumber: cint, + buffer: cstring, + buffersize: cint): cint + +proc dfa_exec*(code: ptr Pcre, + extra: ptr ExtraData, + subject: cstring, + length: cint, + startoffset: cint, + options: cint, + ovector: ptr cint, + ovecsize: cint, + workspace: ptr cint, + wscount: cint): cint + +proc exec*(code: ptr Pcre, + extra: ptr ExtraData, + subject: cstring, + length: cint, + startoffset: cint, + options: cint, + ovector: ptr cint, + ovecsize: cint): cint + +proc jit_exec*(code: ptr Pcre, + extra: ptr ExtraData, + subject: cstring, + length: cint, + startoffset: cint, + options: cint, + ovector: ptr cint, + ovecsize: cint, + jstack: ptr JitStack): cint + +proc free_substring*(stringptr: cstring) + +proc free_substring_list*(stringptr: cstringArray) + +proc fullinfo*(code: ptr Pcre, + extra: ptr ExtraData, + what: cint, + where: pointer): cint + +proc get_named_substring*(code: ptr Pcre, + subject: cstring, + ovector: ptr cint, + stringcount: cint, + stringname: cstring, + stringptr: cstringArray): cint + +proc get_stringnumber*(code: ptr Pcre, + name: cstring): cint + +proc get_stringtable_entries*(code: ptr Pcre, + name: cstring, + first: cstringArray, + last: cstringArray): cint + +proc get_substring*(subject: cstring, + ovector: ptr cint, + stringcount: cint, + stringnumber: cint, + stringptr: cstringArray): cint + +proc get_substring_list*(subject: cstring, + ovector: ptr cint, + stringcount: cint, + listptr: ptr cstringArray): cint + +proc maketables*(): pointer + +proc refcount*(code: ptr Pcre, + adjust: cint): cint + +proc study*(code: ptr Pcre, + options: cint, + errptr: ptr cstring): ptr ExtraData + +proc free_study*(extra: ptr ExtraData) + +proc version*(): cstring # Utility functions for byte order swaps. -proc pattern_to_host_byte_order*(a2: ptr TPcre, a3: ptr TExtra, - a4: ptr char): cint{.cdecl, importc: "pcre_pattern_to_host_byte_order", - pcreImport.} +proc pattern_to_host_byte_order*(code: ptr Pcre, + extra: ptr ExtraData, + tables: pointer): cint # JIT compiler related functions. -proc jit_stack_alloc*(a2: cint, a3: cint): ptr Tjit_stack{.cdecl, - importc: "pcre_jit_stack_alloc", pcreImport.} -proc jit_stack_free*(a2: ptr Tjit_stack){.cdecl, importc: "pcre_jit_stack_free", - pcreImport.} -proc assign_jit_stack*(a2: ptr TExtra, a3: TJitCallback, a4: pointer){.cdecl, - importc: "pcre_assign_jit_stack", pcreImport.} +proc jit_stack_alloc*(startsize: cint, + maxsize: cint): ptr JitStack + +proc jit_stack_free*(stack: ptr JitStack) + +proc assign_jit_stack*(extra: ptr ExtraData, + callback: JitCallback, + data: pointer) + +proc jit_free_unused_memory*() + + +# There was an odd function with `var cstring` instead of `ptr` +proc study*(code: ptr Pcre, + options: cint, + errptr: var cstring): ptr ExtraData {.deprecated.} + +{.pop.} +{.pop.} + + +{.deprecated: [MAJOR: PCRE_MAJOR, MINOR: PCRE_MINOR, + PRERELEASE: PCRE_PRERELEASE, DATE: PCRE_DATE].} + +{.deprecated: [TPcre: Pcre, TJitStack: JitStack].} +type + PPcre* {.deprecated.} = ptr Pcre + PJitStack* {.deprecated.} = ptr JitStack -var - pcre_free*: proc (p: ptr TPcre) {.cdecl.} +{.deprecated: [TExtra: ExtraData].} +{.deprecated: [TCalloutBlock: CalloutBlock].} +{.deprecated: [TJitCallback: JitCallback].} diff --git a/tests/array/troof1.nim b/tests/array/troof1.nim new file mode 100644 index 000000000..96669a121 --- /dev/null +++ b/tests/array/troof1.nim @@ -0,0 +1,36 @@ +discard """ + output: '''@[2, 3, 4]321 +9.0 4.0 +(a: 1.0, b: 2.0, c: 8.0)2.0''' +""" + +proc foo[T](x, y: T): T = x + +var a = @[1, 2, 3, 4] +var b: array[3, array[2, float]] = [[1.0,2], [3.0,4], [8.0,9]] +echo a[1.. ^1], a[^2], a[^3], a[^4] +echo b[^1][^1], " ", (b[^2]).foo(b[^1])[^1] + +type + MyArray = object + a, b, c: float + +var + ma = MyArray(a: 1.0, b: 2.0, c: 3.0) + +proc len(x: MyArray): int = 3 + +proc `[]=`(x: var MyArray; idx: range[0..2]; val: float) = + case idx + of 0: x.a = val + of 1: x.b = val + of 2: x.c = val + +proc `[]`(x: var MyArray; idx: range[0..2]): float = + case idx + of 0: result = x.a + of 1: result = x.b + of 2: result = x.c + +ma[^1] = 8.0 +echo ma, ma[^2] diff --git a/tests/array/troof2.nim b/tests/array/troof2.nim new file mode 100644 index 000000000..d4c1a4982 --- /dev/null +++ b/tests/array/troof2.nim @@ -0,0 +1,10 @@ +discard """ + errormsg: "invalid context for '^' as 'foo()' has side effects" + line: "9" +""" + +proc foo(): seq[int] = + echo "ha" + +let f = foo()[^1] + diff --git a/tests/array/troof3.nim b/tests/array/troof3.nim new file mode 100644 index 000000000..4b6e22223 --- /dev/null +++ b/tests/array/troof3.nim @@ -0,0 +1,8 @@ +discard """ + errormsg: "invalid context for '^' as len!=high+1 for 'a'" + line: "8" +""" + +var a: array[1..3, string] + +echo a[^1] diff --git a/tests/array/troof4.nim b/tests/array/troof4.nim new file mode 100644 index 000000000..7a262d9de --- /dev/null +++ b/tests/array/troof4.nim @@ -0,0 +1,37 @@ +discard """ + errormsg: "no surrounding array access context for '^'" + line: "37" +""" + +proc foo[T](x, y: T): T = x + +var a = @[1, 2, 3, 4] +var b: array[3, array[2, float]] = [[1.0,2], [3.0,4], [8.0,9]] +echo a[1.. ^1], a[^2], a[^3], a[^4] +echo b[^1][^1], " ", (b[^2]).foo(b[^1])[^1] + +type + MyArray = object + a, b, c: float + +var + ma = MyArray(a: 1.0, b: 2.0, c: 3.0) + +proc len(x: MyArray): int = 3 + +proc `[]=`(x: var MyArray; idx: range[0..2]; val: float) = + case idx + of 0: x.a = val + of 1: x.b = val + of 2: x.c = val + +proc `[]`(x: var MyArray; idx: range[0..2]): float = + case idx + of 0: result = x.a + of 1: result = x.b + of 2: result = x.c + +ma[^1] = 8.0 +echo ma, ma[^2] + +echo(^1) diff --git a/tests/assert/tfailedassert.nim b/tests/assert/tfailedassert.nim index 729cdcac7..1e6764471 100644 --- a/tests/assert/tfailedassert.nim +++ b/tests/assert/tfailedassert.nim @@ -30,7 +30,7 @@ proc bar: int = # local overrides that are active only # in this proc onFailedAssert(msg): echo "WARNING: " & msg - + assert(false, "first assertion from bar") onFailedAssert(msg): diff --git a/tests/assign/moverload_asgn2.nim b/tests/assign/moverload_asgn2.nim new file mode 100644 index 000000000..6620adbeb --- /dev/null +++ b/tests/assign/moverload_asgn2.nim @@ -0,0 +1,10 @@ +type + Concrete* = object + a*, b*: string + rc*: int # refcount + +proc `=`(d: var Concrete; src: Concrete) = + shallowCopy(d.a, src.a) + shallowCopy(d.b, src.b) + dec d.rc + d.rc = src.rc + 1 diff --git a/tests/assign/toverload_asgn1.nim b/tests/assign/toverload_asgn1.nim new file mode 100644 index 000000000..dbc3a71c4 --- /dev/null +++ b/tests/assign/toverload_asgn1.nim @@ -0,0 +1,75 @@ +discard """ + output: '''Concrete '=' +Concrete '=' +Concrete '=' +Concrete '=' +Concrete '=' +GenericT[T] '=' int +GenericT[T] '=' float +GenericT[T] '=' float +GenericT[T] '=' float +GenericT[T] '=' string +GenericT[T] '=' int8 +GenericT[T] '=' bool +GenericT[T] '=' bool +GenericT[T] '=' bool +GenericT[T] '=' bool''' +""" + +import typetraits + +type + Concrete = object + a, b: string + +proc `=`(d: var Concrete; src: Concrete) = + shallowCopy(d.a, src.a) + shallowCopy(d.b, src.b) + echo "Concrete '='" + +var x, y: array[0..2, Concrete] +var cA, cB: Concrete + +var cATup, cBTup: tuple[x: int, ha: Concrete] + +x = y +cA = cB +cATup = cBTup + +type + GenericT[T] = object + a, b: T + +proc `=`[T](d: var GenericT[T]; src: GenericT[T]) = + shallowCopy(d.a, src.a) + shallowCopy(d.b, src.b) + echo "GenericT[T] '=' ", type(T).name + +var ag: GenericT[int] +var bg: GenericT[int] + +ag = bg + +var xg, yg: array[0..2, GenericT[float]] +var cAg, cBg: GenericT[string] + +var cATupg, cBTupg: tuple[x: int, ha: GenericT[int8]] + +xg = yg +cAg = cBg +cATupg = cBTupg + +var caSeqg, cbSeqg: seq[GenericT[bool]] +newSeq(cbSeqg, 4) +caSeqg = cbSeqg + +when false: + type + Foo = object + case b: bool + of false: xx: GenericT[int] + of true: yy: bool + + var + a, b: Foo + a = b diff --git a/tests/assign/toverload_asgn2.nim b/tests/assign/toverload_asgn2.nim new file mode 100644 index 000000000..243c90494 --- /dev/null +++ b/tests/assign/toverload_asgn2.nim @@ -0,0 +1,22 @@ +discard """ + output: '''i value 88 +2aa''' +""" + +import moverload_asgn2 + +proc passAround(i: int): Concrete = + echo "i value ", i + result = Concrete(a: "aa", b: "bb", rc: 0) + +proc main = + let + i = 88 + v = passAround(i) + z = v.a + var + x: Concrete + x = v + echo x.rc, z # 2aa + +main() diff --git a/tests/async/tasynctry.nim b/tests/async/tasynctry.nim index 99433b9d8..f77198e2e 100644 --- a/tests/async/tasynctry.nim +++ b/tests/async/tasynctry.nim @@ -82,6 +82,15 @@ proc test3(): Future[int] {.async.} = result = 2 return +proc test4(): Future[int] {.async.} = + try: + discard await foo() + raise newException(ValueError, "Test4") + except OSError: + result = 1 + except: + result = 2 + var x = test() assert x.read @@ -90,3 +99,6 @@ assert x.read var y = test3() assert y.read == 2 + +y = test4() +assert y.read == 2 diff --git a/tests/async/tasynctry2.nim b/tests/async/tasynctry2.nim new file mode 100644 index 000000000..444a058be --- /dev/null +++ b/tests/async/tasynctry2.nim @@ -0,0 +1,16 @@ +discard """ + file: "tasynctry2.nim" + errormsg: "\'yield\' cannot be used within \'try\' in a non-inlined iterator" + line: 15 +""" +import asyncdispatch + +proc foo(): Future[bool] {.async.} = discard + +proc test5(): Future[int] {.async.} = + try: + discard await foo() + raise newException(ValueError, "Test5") + except: + discard await foo() + result = 0 diff --git a/tests/bind/tnicerrorforsymchoice.nim b/tests/bind/tnicerrorforsymchoice.nim index bf6d92927..5145fdcff 100644 --- a/tests/bind/tnicerrorforsymchoice.nim +++ b/tests/bind/tnicerrorforsymchoice.nim @@ -1,17 +1,17 @@ discard """ line: 18 - errormsg: "type mismatch: got (proc (TScgi) | proc (AsyncSocket, StringTableRef, string)" + errormsg: "type mismatch: got (proc (s: TScgi) | proc (client: AsyncSocket, headers: StringTableRef, input: string){.gcsafe, locks: 0.}" """ #bug #442 import scgi, sockets, asyncio, strtabs proc handleSCGIRequest[TScgi: ScgiState | AsyncScgiState](s: TScgi) = discard -proc handleSCGIRequest(client: AsyncSocket, headers: StringTableRef, +proc handleSCGIRequest(client: AsyncSocket, headers: StringTableRef, input: string) = discard -proc test(handle: proc (client: AsyncSocket, headers: StringTableRef, +proc test(handle: proc (client: AsyncSocket, headers: StringTableRef, input: string), b: int) = discard diff --git a/tests/casestmt/tcomputedgoto.nim b/tests/casestmt/tcomputedgoto.nim index b21fc07a3..f567174af 100644 --- a/tests/casestmt/tcomputedgoto.nim +++ b/tests/casestmt/tcomputedgoto.nim @@ -15,7 +15,7 @@ yeah A enumB''' type MyEnum = enum - enumA, enumB, enumC, enumD, enumE + enumA, enumB, enumC, enumD, enumE, enumLast proc vm() = var instructions: array [0..100, MyEnum] @@ -42,6 +42,7 @@ proc vm() = echo "yeah B ", ra of enumE: break + of enumLast: discard inc(pc) - + vm() diff --git a/tests/ccgbugs/tarray_equality.nim b/tests/ccgbugs/tarray_equality.nim new file mode 100644 index 000000000..66a953439 --- /dev/null +++ b/tests/ccgbugs/tarray_equality.nim @@ -0,0 +1,15 @@ +discard """ + output: '''true +true''' +""" + +# bug #2489 + +let a = [1] +let b = [1] +echo a == b + +# bug #2498 +var x: array[0, int] +var y: array[0, int] +echo x == y diff --git a/tests/ccgbugs/trecursive_table.nim b/tests/ccgbugs/trecursive_table.nim new file mode 100644 index 000000000..3406a1c31 --- /dev/null +++ b/tests/ccgbugs/trecursive_table.nim @@ -0,0 +1,17 @@ + +# bug #1700 +import tables + +type + E* = enum + eX + eY + T* = object + case kind: E + of eX: + xVal: Table[string, T] + of eY: + nil + +proc p*(x: Table[string, T]) = + discard diff --git a/tests/closure/tinvalidclosure.nim b/tests/closure/tinvalidclosure.nim index 18968a6c6..c9136a736 100644 --- a/tests/closure/tinvalidclosure.nim +++ b/tests/closure/tinvalidclosure.nim @@ -1,6 +1,6 @@ discard """ line: 12 - errormsg: "type mismatch: got (proc (int){.closure, gcsafe, locks: 0.})" + errormsg: "type mismatch: got (proc (x: int){.closure, gcsafe, locks: 0.})" """ proc ugh[T](x: T) {.closure.} = diff --git a/tests/concepts/mvarconcept.nim b/tests/concepts/mvarconcept.nim new file mode 100644 index 000000000..0f9d0beff --- /dev/null +++ b/tests/concepts/mvarconcept.nim @@ -0,0 +1,13 @@ +type RNG* = concept var rng + rng.randomUint32() is uint32 + +type MersenneTwister* = object + +proc randomUint32*(self: var MersenneTwister): uint32 = 5 + +proc randomInt*(rng: var RNG; max: Positive): Natural = 5 + +var mersenneTwisterInst = MersenneTwister() + +proc randomInt*(max: Positive): Natural = + mersenneTwisterInst.randomInt(max) diff --git a/tests/concepts/tmanual.nim b/tests/concepts/tmanual.nim index 243992aed..7cf08af06 100644 --- a/tests/concepts/tmanual.nim +++ b/tests/concepts/tmanual.nim @@ -12,7 +12,6 @@ e s t ''' - disabled: "true" """ template accept(e: expr) = @@ -22,10 +21,10 @@ template reject(e: expr) = static: assert(not compiles(e)) type - Container[T] = generic C - C.len is Ordinal + Container[T] = concept c + c.len is Ordinal items(c) is iterator - for value in C: + for value in c: type(value) is T proc takesIntContainer(c: Container[int]) = diff --git a/tests/concepts/tswizzle.nim b/tests/concepts/tswizzle.nim index 9bbdb67e6..07205d454 100644 --- a/tests/concepts/tswizzle.nim +++ b/tests/concepts/tswizzle.nim @@ -40,7 +40,7 @@ proc isSwizzle(s: string): bool {.compileTime.} = return false type - StringIsSwizzle = generic value + StringIsSwizzle = concept value value.isSwizzle SwizzleStr = static[string] and StringIsSwizzle diff --git a/tests/concepts/tusertypeclasses.nim b/tests/concepts/tusertypeclasses.nim index 4e5e6221c..612556949 100644 --- a/tests/concepts/tusertypeclasses.nim +++ b/tests/concepts/tusertypeclasses.nim @@ -16,10 +16,10 @@ type TObj = object x: int - Sortable = generic x, y + Sortable = concept x, y (x < y) is bool - ObjectContainer = generic C + ObjectContainer = concept C C.len is Ordinal for v in items(C): v.type is tuple|object @@ -38,7 +38,7 @@ proc intval(x: int): int = 10 # check real and virtual fields type - TFoo = generic T + TFoo = concept T T.x y(T) intval T.y @@ -50,7 +50,7 @@ proc testFoo(x: TFoo) = discard testFoo(TObj(x: 10)) type - Matrix[Rows, Cols: static[int]; T] = generic M + Matrix[Rows, Cols: static[int]; T] = concept M M.M == Rows M.N == Cols M.T is T diff --git a/tests/concepts/tusertypeclasses2.nim b/tests/concepts/tusertypeclasses2.nim index 77c70d7a6..ae05540cd 100644 --- a/tests/concepts/tusertypeclasses2.nim +++ b/tests/concepts/tusertypeclasses2.nim @@ -1,5 +1,5 @@ type - hasFieldX = generic z + hasFieldX = concept z z.x is int obj_x = object @@ -7,7 +7,7 @@ type ref_obj_x = ref object x: int - + ref_to_obj_x = ref obj_x p_o_x = ptr obj_x diff --git a/tests/concepts/tvarconcept.nim b/tests/concepts/tvarconcept.nim new file mode 100644 index 000000000..203ef3cdc --- /dev/null +++ b/tests/concepts/tvarconcept.nim @@ -0,0 +1,9 @@ +discard """ + output: "5" +""" + +# bug #2346, bug #2404 + +import mvarconcept + +echo randomInt(5) diff --git a/tests/cpp/tget_subsystem.nim b/tests/cpp/tget_subsystem.nim new file mode 100644 index 000000000..461914739 --- /dev/null +++ b/tests/cpp/tget_subsystem.nim @@ -0,0 +1,23 @@ +discard """ + cmd: "nim cpp $file" +""" + +{.emit: """ + +namespace System { + struct Input {}; +} + +struct SystemManager { + template <class T> + static T* getSubsystem() { return new T; } +}; + +""".} + +type Input {.importcpp: "System::Input".} = object +proc getSubsystem*[T](): ptr T {. + importcpp: "SystemManager::getSubsystem<'*0>()", nodecl.} + +let input: ptr Input = getSubsystem[Input]() + diff --git a/tests/cpp/tstaticvar_via_typedesc.nim b/tests/cpp/tstaticvar_via_typedesc.nim new file mode 100644 index 000000000..7a9fa2afc --- /dev/null +++ b/tests/cpp/tstaticvar_via_typedesc.nim @@ -0,0 +1,20 @@ +discard """ + cmd: "nim cpp $file" + output: "42" +""" + +# bug #2324 + +static: assert defined(cpp), "compile in cpp mode" + +{.emit: """ +class Foo { +public: + static int x; +}; +int Foo::x = 42; +""".} + +type Foo {.importcpp:"Foo".} = object +proc x* (this: typedesc[Foo]): int {.importcpp:"Foo::x@", nodecl.} +echo Foo.x diff --git a/tests/cpp/tvector_iterator.nim b/tests/cpp/tvector_iterator.nim new file mode 100644 index 000000000..cb5ab33af --- /dev/null +++ b/tests/cpp/tvector_iterator.nim @@ -0,0 +1,19 @@ +discard """ + cmd: "nim cpp $file" +""" + +{.emit: """ + +template <class T> +struct Vector { + struct Iterator {}; +}; + +""".} + +type + Vector {.importcpp: "Vector".} [T] = object + VectorIterator {.importcpp: "Vector<'0>::Iterator".} [T] = object + +var x: VectorIterator[void] + diff --git a/tests/destructor/tdestructor.nim b/tests/destructor/tdestructor.nim index cbaba3154..639dba941 100644 --- a/tests/destructor/tdestructor.nim +++ b/tests/destructor/tdestructor.nim @@ -40,7 +40,7 @@ type x: A y: B z: C - + TObjKind = enum A, B, C, D TCaseObj = object @@ -57,14 +57,14 @@ type q: TMyGeneric3[TMyObj, int, int] r: string -proc destroy(o: var TMyObj) {.override.} = +proc `=destroy`(o: var TMyObj) = if o.p != nil: dealloc o.p echo "myobj destroyed" -proc destroy(o: var TMyGeneric1) {.override.} = +proc `=destroy`(o: var TMyGeneric1) = echo "mygeneric1 destroyed" -proc destroy[A, B](o: var TMyGeneric2[A, B]) {.override.} = +proc `=destroy`[A, B](o: var TMyGeneric2[A, B]) = echo "mygeneric2 destroyed" proc open: TMyObj = @@ -83,12 +83,12 @@ proc mygeneric1() = proc mygeneric2[T](val: T) = var a = open() - + var b = TMyGeneric2[int, T](x: 10, y: val) echo "mygeneric2 constructed" var c = TMyGeneric3[int, int, string](x: 10, y: 20, z: "test") - + proc mygeneric3 = var x = TMyGeneric3[int, string, TMyGeneric1[int]]( x: 10, y: "test", z: TMyGeneric1[int](x: 10)) @@ -111,11 +111,11 @@ proc caseobj = block: echo "----" var o1 = TCaseObj(kind: A, x: TMyGeneric1[int](x: 10)) - + block: echo "----" var o2 = TCaseObj(kind: B, y: open()) - + block: echo "----" var o3 = TCaseObj(kind: D, innerKind: B, r: "test", diff --git a/tests/destructor/tdestructor2.nim b/tests/destructor/tdestructor2.nim index 6f966d861..34fa466af 100644 --- a/tests/destructor/tdestructor2.nim +++ b/tests/destructor/tdestructor2.nim @@ -5,14 +5,14 @@ discard """ {.experimental.} -type +type TMyObj = object x, y: int p: pointer - -proc destroy(o: var TMyObj) {.override.} = + +proc `=destroy`(o: var TMyObj) = if o.p != nil: dealloc o.p - + proc open: TMyObj = result = TMyObj(x: 1, y: 2, p: alloc(3)) diff --git a/tests/effects/tgcsafe.nim b/tests/effects/tgcsafe.nim index 0d5109439..d146794b6 100644 --- a/tests/effects/tgcsafe.nim +++ b/tests/effects/tgcsafe.nim @@ -1,5 +1,5 @@ discard """ - line: 16 + line: 17 errormsg: "'mainUnsafe' is not GC-safe" cmd: "nim $target --hints:on --threads:on $options $file" """ diff --git a/tests/exception/texceptions.nim b/tests/exception/texceptions.nim index 69b2d0f6a..bdf338599 100644 --- a/tests/exception/texceptions.nim +++ b/tests/exception/texceptions.nim @@ -35,9 +35,9 @@ echo "" proc reraise_in_except = try: echo "BEFORE" - raise newException(EIO, "") + raise newException(IOError, "") - except EIO: + except IOError: echo "EXCEPT" raise @@ -52,7 +52,7 @@ echo "" proc return_in_except = try: echo "BEFORE" - raise newException(EIO, "") + raise newException(IOError, "") except: echo "EXCEPT" diff --git a/tests/exception/treraise.nim b/tests/exception/treraise.nim index cbd0b5f8a..b2a11d34f 100644 --- a/tests/exception/treraise.nim +++ b/tests/exception/treraise.nim @@ -4,8 +4,8 @@ discard """ exitcode: "1" """ type - ESomething = object of E_Base - ESomeOtherErr = object of E_Base + ESomething = object of Exception + ESomeOtherErr = object of Exception proc genErrors(s: string) = if s == "error!": diff --git a/tests/exprs/texprstmt.nim b/tests/exprs/texprstmt.nim index 355da2407..79323d82a 100644 --- a/tests/exprs/texprstmt.nim +++ b/tests/exprs/texprstmt.nim @@ -7,6 +7,6 @@ discard """ proc test: string = result = "blah" - result[1 .. -1] + result[1 .. ^1] echo test() diff --git a/tests/generics/tableref_is_nil.nim b/tests/generics/tableref_is_nil.nim new file mode 100644 index 000000000..1ad4b3b0c --- /dev/null +++ b/tests/generics/tableref_is_nil.nim @@ -0,0 +1,9 @@ +discard """ + output: "true" +""" + +# bug #2221 +import tables + +var tblo: TableRef[string, int] +echo tblo == nil diff --git a/tests/generics/tunique_type.nim b/tests/generics/tunique_type.nim index e78640caa..da2f9e4b2 100644 --- a/tests/generics/tunique_type.nim +++ b/tests/generics/tunique_type.nim @@ -27,7 +27,7 @@ proc refExpr(exprNode: NimNode): string {.compileTime.} = "expr" & $(exprNodes.len - 1) proc derefExpr(exprRef: string): NimNode {.compileTime.} = - exprNodes[parseInt(exprRef[4 .. -1])] + exprNodes[parseInt(exprRef[4 .. ^1])] #=============================================================================== # Define a type that allows a callable expression to be mapped onto elements diff --git a/tests/generics/twrong_generic_object.nim b/tests/generics/twrong_generic_object.nim new file mode 100644 index 000000000..00d90c55e --- /dev/null +++ b/tests/generics/twrong_generic_object.nim @@ -0,0 +1,21 @@ +discard """ + errormsg: "cannot instantiate: 'GenericNodeObj'" + line: 21 +""" +# bug #2509 +type + GenericNodeObj[T] = ref object + obj: T + + Node* = ref object + children*: seq[Node] + parent*: Node + + nodeObj*: GenericNodeObj # [int] + +proc newNode*(nodeObj: GenericNodeObj): Node = + result = Node(nodeObj: nodeObj) + newSeq(result.children, 10) + +var genericObj = GenericNodeObj[int]() +var myNode = newNode(genericObj) diff --git a/tests/js/test2.nim b/tests/js/test2.nim index 5a734358c..1a42fbfda 100644 --- a/tests/js/test2.nim +++ b/tests/js/test2.nim @@ -1,6 +1,7 @@ discard """ output: '''foo -js 3.14''' +js 3.14 +7''' """ # This file tests the JavaScript generator @@ -20,3 +21,11 @@ else: proc foo(val: float): string = "js " & $val echo foo(3.14) + +# #2495 +type C = concept x + +proc test(x: C, T: typedesc): T = + cast[T](x) + +echo 7.test(int8) diff --git a/tests/js/tstringitems.nim b/tests/js/tstringitems.nim new file mode 100644 index 000000000..f4ea02fec --- /dev/null +++ b/tests/js/tstringitems.nim @@ -0,0 +1,24 @@ +discard """ + output: '''Hello +Hello''' +""" + +# bug #2581 + +const someVars = [ "Hello" ] +var someVars2 = [ "Hello" ] + +proc getSomeVar: string = + for i in someVars: + if i == "Hello": + result = i + break + +proc getSomeVar2: string = + for i in someVars2: + if i == "Hello": + result = i + break + +echo getSomeVar() +echo getSomeVar2() diff --git a/tests/js/tunittests.nim b/tests/js/tunittests.nim index af38cd9b9..8a264a5e0 100644 --- a/tests/js/tunittests.nim +++ b/tests/js/tunittests.nim @@ -1,3 +1,10 @@ +discard """ + disabled: "true" +""" + +# Unittest uses lambdalifting at compile-time which we disable for the JS +# codegen! So this cannot and will not work for quite some time. + import unittest suite "Bacon": diff --git a/tests/macros/tlexerex.nim b/tests/macros/tlexerex.nim new file mode 100644 index 000000000..d348a4bcc --- /dev/null +++ b/tests/macros/tlexerex.nim @@ -0,0 +1,16 @@ + +import macros + +macro match*(s: cstring|string; pos: int; sections: untyped): untyped = + for sec in sections.children: + expectKind sec, nnkOfBranch + expectLen sec, 2 + result = newStmtList() + +when isMainModule: + var input = "the input" + var pos = 0 + match input, pos: + of r"[a-zA-Z_]\w+": echo "an identifier" + of r"\d+": echo "an integer" + of r".": echo "something else" diff --git a/tests/macros/ttryparseexpr.nim b/tests/macros/ttryparseexpr.nim index af932eb7d..c7bbc8e5b 100644 --- a/tests/macros/ttryparseexpr.nim +++ b/tests/macros/ttryparseexpr.nim @@ -15,5 +15,6 @@ const valid = 45 a = test("foo&&") b = test("valid") + c = test("\"") # bug #2504 echo a, " ", b diff --git a/tests/macros/typesapi2.nim b/tests/macros/typesapi2.nim new file mode 100644 index 000000000..2e59d2154 --- /dev/null +++ b/tests/macros/typesapi2.nim @@ -0,0 +1,49 @@ +# tests to see if a symbol returned from macros.getType() can +# be used as a type +import macros + +macro testTypesym (t:stmt): expr = + var ty = t.getType + if ty.typekind == ntyTypedesc: + # skip typedesc get to the real type + ty = ty[1].getType + + if ty.kind == nnkSym: return ty + assert ty.kind == nnkBracketExpr + assert ty[0].kind == nnkSym + result = ty[0] + return + +type TestFN = proc(a,b:int):int +var iii: testTypesym(TestFN) +static: assert iii is TestFN + +proc foo11 : testTypesym(void) = + echo "HI!" +static: assert foo11 is (proc():void {.nimcall.}) + +var sss: testTypesym(seq[int]) +static: assert sss is seq[int] +# very nice :> + +static: assert array[2,int] is testTypesym(array[2,int]) +static: assert(ref int is testTypesym(ref int)) +static: assert(void is testTypesym(void)) + + +macro tts2 (t:stmt, idx:int): expr = + var ty = t.getType + if ty.typekind == ntyTypedesc: + # skip typedesc get to the real type + ty = ty[1].getType + + if ty.kind == nnkSym: return ty + assert ty.kind == nnkBracketExpr + return ty[idx.intval.int] +type TestFN2 = proc(a:int,b:float):string +static: + assert(tts2(TestFN2, 0) is TestFN2) + assert(tts2(TestFN2, 1) is string) + assert(tts2(TestFN2, 2) is int) + assert(tts2(TestFN2, 3) is float) + diff --git a/tests/metatype/tautoproc.nim b/tests/metatype/tautoproc.nim index 562f508fc..ef5377096 100644 --- a/tests/metatype/tautoproc.nim +++ b/tests/metatype/tautoproc.nim @@ -1,11 +1,13 @@ discard """ - errormsg: "expression 'generate(builder)' has no type (or is ambiguous)" + output: "empty" """ # bug #898 +import typetraits + proc measureTime(e: auto) = - discard + echo e.type.name proc generate(a: int): void = discard diff --git a/tests/metatype/tstatic_overloading.nim b/tests/metatype/tstatic_overloading.nim new file mode 100644 index 000000000..ce51052b7 --- /dev/null +++ b/tests/metatype/tstatic_overloading.nim @@ -0,0 +1,10 @@ +# bug #2266 + +import macros + +proc impl(op: static[int]) = echo "impl 1 called" +proc impl(op: static[int], init: int) = echo "impl 2 called" + +macro wrapper2: stmt = newCall(bindSym"impl", newLit(0), newLit(0)) + +wrapper2() # Code generation for this fails. diff --git a/tests/metatype/ttypedesc2.nim b/tests/metatype/ttypedesc2.nim new file mode 100644 index 000000000..e576ec91a --- /dev/null +++ b/tests/metatype/ttypedesc2.nim @@ -0,0 +1,37 @@ +discard """ + output: "(x: a)" +""" + +type + Bar[T] = object + x: T + +proc infer(T: typeDesc): Bar[T] = Bar[T](x: 'a') + +let foo = infer(char) +echo foo + +when true: + # bug #1783 + + type + uoffset_t* = uint32 + FlatBufferBuilder* = object + + uarray* {.unchecked.} [T] = array [0..0, T] + Array* [T] = object + o*: uoffset_t + len*: int + data*: ptr uarray[T] + + proc ca* (fbb: ptr FlatBufferBuilder, T: typedesc, len: int): Array[T] {.noinit.} = + result.len = len + + var fbb: ptr FlatBufferBuilder + let boolarray = ca(fbb, bool, 2) + let boolarray2 = fbb.ca(bool, 2) + +# bug #1664 +type Point[T] = tuple[x, y: T] +proc origin(T: typedesc): Point[T] = discard +discard origin(int) diff --git a/tests/method/temptybody.nim b/tests/method/temptybody.nim new file mode 100644 index 000000000..26285d05b --- /dev/null +++ b/tests/method/temptybody.nim @@ -0,0 +1,11 @@ +# bug #2401 + +type MyClass = ref object of RootObj + +method HelloWorld*(obj: MyClass) = + when defined(myPragma): + echo("Hello World") + # discard # with this line enabled it works + +var obj = MyClass() +obj.HelloWorld() diff --git a/tests/misc/tcharinc.nim b/tests/misc/tcharinc.nim new file mode 100644 index 000000000..1b5d19c18 --- /dev/null +++ b/tests/misc/tcharinc.nim @@ -0,0 +1,10 @@ +discard """ + output: "1" +""" + +var c = '\0' +while true: + if c == '\xFF': break + inc c + +echo "1" diff --git a/tests/misc/tgtk.nim b/tests/misc/tgtk.nim deleted file mode 100644 index 82227689d..000000000 --- a/tests/misc/tgtk.nim +++ /dev/null @@ -1,53 +0,0 @@ -discard """ - disabled: true -""" -import - gtk2, glib2, atk, gdk2, gdk2pixbuf, libglade2, pango, - pangoutils - -proc hello(widget: PWidget, data: pointer) {.cdecl.} = - write(stdout, "Hello World\n") - -proc delete_event(widget: PWidget, event: PEvent, - data: pointer): bool {.cdecl.} = - # If you return FALSE in the "delete_event" signal handler, - # GTK will emit the "destroy" signal. Returning TRUE means - # you don't want the window to be destroyed. - # This is useful for popping up 'are you sure you want to quit?' - # type dialogs. - write(stdout, "delete event occurred\n") - # Change TRUE to FALSE and the main window will be destroyed with - # a "delete_event". - return false - -# Another callback -proc mydestroy(widget: PWidget, data: pointer) {.cdecl.} = - gtk2.main_quit() - -proc mymain() = - # GtkWidget is the storage type for widgets - gtk2.nimrod_init() - var window = window_new(gtk2.WINDOW_TOPLEVEL) - discard g_signal_connect(window, "delete_event", - Gcallback(delete_event), nil) - discard g_signal_connect(window, "destroy", Gcallback(mydestroy), nil) - # Sets the border width of the window. - set_border_width(window, 10) - - # Creates a new button with the label "Hello World". - var button = button_new("Hello World") - - discard g_signal_connect(button, "clicked", Gcallback(hello), nil) - - # This packs the button into the window (a gtk container). - add(window, button) - - # The final step is to display this newly created widget. - show(button) - - # and the window - show(window) - - gtk2.main() - -mymain() diff --git a/tests/misc/tlibs.nim b/tests/misc/tlibs.nim deleted file mode 100644 index e7a02c7fd..000000000 --- a/tests/misc/tlibs.nim +++ /dev/null @@ -1,28 +0,0 @@ -discard """ - disabled: true -""" - -# Test wether the bindings at least compile... - -import - unicode, cgi, terminal, libcurl, - parsexml, parseopt, parsecfg, - osproc, complex, - sdl, smpeg, sdl_gfx, sdl_net, sdl_mixer, sdl_ttf, - sdl_image, sdl_mixer_nosmpeg, - cursorfont, xatom, xf86vmode, xkb, xrandr, xshm, xvlib, keysym, xcms, xi, - xkblib, xrender, xutil, x, xf86dga, xinerama, xlib, xresource, xv, - gtk2, glib2, pango, gdk2, - cairowin32, cairoxlib, - odbcsql, - gl, glut, glu, glx, glext, wingl, - lua, lualib, lauxlib, mysql, sqlite3, python, tcl, - db_postgres, db_mysql, db_sqlite, ropes, sockets, browsers, httpserver, - httpclient, parseutils, unidecode, xmldom, xmldomparser, xmltree, xmlparser, - htmlparser, re, graphics, colors, pegs, subexes, dialogs - -when defined(linux): - import - zlib, zipfiles - -writeln(stdout, "test compilation of binding modules") diff --git a/tests/misc/tnewlibs.nim b/tests/misc/tnewlibs.nim deleted file mode 100644 index 3b74a9b63..000000000 --- a/tests/misc/tnewlibs.nim +++ /dev/null @@ -1,21 +0,0 @@ -discard """ - disabled: true -""" - -# Test wether the bindings at least compile... - -import - tcl, - sdl, smpeg, sdl_gfx, sdl_net, sdl_mixer, sdl_ttf, - sdl_image, sdl_mixer_nosmpeg, - gtk2, glib2, pango, gdk2, - unicode, cgi, terminal, libcurl, - parsexml, parseopt, parsecfg, - osproc, - cairowin32, cairoxlib, - gl, glut, glu, glx, glext, wingl, - lua, lualib, lauxlib, mysql, sqlite3, db_mongo, md5, asyncio, mimetypes, - cookies, events, ftpclient, scgi, irc - - -writeln(stdout, "test compilation of binding modules") diff --git a/tests/misc/trangechecks.nim b/tests/misc/trangechecks.nim new file mode 100644 index 000000000..2c6f0f66d --- /dev/null +++ b/tests/misc/trangechecks.nim @@ -0,0 +1,43 @@ +discard """ + output: '''10 +10 +1 +1 +true''' +""" + +# bug #1344 + +var expected: int +var x: range[1..10] = 10 + +try: + x += 1 + echo x +except OverflowError, RangeError: + expected += 1 + echo x + +try: + inc x + echo x +except OverflowError, RangeError: + expected += 1 + echo x + +x = 1 +try: + x -= 1 + echo x +except OverflowError, RangeError: + expected += 1 + echo x + +try: + dec x + echo x +except OverflowError, RangeError: + expected += 1 + echo x + +echo expected == 4 diff --git a/tests/misc/tslices.nim b/tests/misc/tslices.nim index 0de1171e3..388a46509 100644 --- a/tests/misc/tslices.nim +++ b/tests/misc/tslices.nim @@ -36,7 +36,7 @@ echo() var myseq = @[1, 2, 3, 4, 5, 6] -myseq[0..2] = myseq[-3.. -1] +myseq[0..2] = myseq[^3 .. ^1] for x in items(myseq): stdout.write(x) echo() @@ -46,7 +46,7 @@ echo mystr mystr[4..4] = "u" # test full replacement -mystr[.. -2] = "egerichtet" +mystr[.. ^2] = "egerichtet" echo mystr @@ -54,6 +54,6 @@ mystr[0..2] = "ve" echo mystr var s = "abcdef" -s[1 .. -2] = "xyz" +s[1 .. ^2] = "xyz" assert s == "axyzf" diff --git a/tests/misc/tunsigned64mod.nim b/tests/misc/tunsigned64mod.nim index 9ae0d535a..3007405a2 100644 --- a/tests/misc/tunsigned64mod.nim +++ b/tests/misc/tunsigned64mod.nim @@ -10,3 +10,17 @@ let t1 = v1 mod 2 # works let t2 = 7'u64 mod 2'u64 # works let t3 = v2 mod 2'u64 # Error: invalid type: 'range 0..1(uint64) let t4 = (v2 mod 2'u64).uint64 # works + +# bug #2550 + +var x: uint # doesn't work +echo x mod 2 == 0 + +var y: uint64 # doesn't work +echo y mod 2 == 0 + +var z: uint32 # works +echo z mod 2 == 0 + +var a: int # works +echo a mod 2 == 0 diff --git a/tests/misc/tunsignedinc.nim b/tests/misc/tunsignedinc.nim new file mode 100644 index 000000000..95622156f --- /dev/null +++ b/tests/misc/tunsignedinc.nim @@ -0,0 +1,14 @@ +discard """ + output: '''253''' +""" + +# bug #2427 + +import unsigned + +var x = 0'u8 +dec x # OverflowError +x -= 1 # OverflowError +x = x - 1 # No error + +echo x diff --git a/tests/notnil/tnotnil_in_objconstr.nim b/tests/notnil/tnotnil_in_objconstr.nim new file mode 100644 index 000000000..2110bda8f --- /dev/null +++ b/tests/notnil/tnotnil_in_objconstr.nim @@ -0,0 +1,14 @@ +discard """ + errormsg: "field not initialized: bar" + line: "13" +""" + +# bug #2355 +type + Foo = object + foo: string not nil + bar: string not nil + +# Create instance without initializaing the `bar` field +var f = Foo(foo: "foo") +echo f.bar.isNil # true diff --git a/tests/objects/tillegal_recursion.nim b/tests/objects/tillegal_recursion.nim new file mode 100644 index 000000000..171a04f87 --- /dev/null +++ b/tests/objects/tillegal_recursion.nim @@ -0,0 +1,7 @@ +discard """ + errormsg: "illegal recursion in type 'object'" + line: 7 +""" +# bug #1691 +type + Foo = ref object of Foo diff --git a/tests/objects/tobjloop.nim b/tests/objects/tobjloop.nim new file mode 100644 index 000000000..9fea1e2fb --- /dev/null +++ b/tests/objects/tobjloop.nim @@ -0,0 +1,15 @@ +discard """ + output: "is Nil false" +""" +# bug #1658 + +type + Loop* = ref object + onBeforeSelect*: proc (L: Loop) + +var L: Loop +new L +L.onBeforeSelect = proc (bar: Loop) = + echo "is Nil ", bar.isNil + +L.onBeforeSelect(L) diff --git a/tests/objects/trefobjsyntax2.nim b/tests/objects/trefobjsyntax2.nim new file mode 100644 index 000000000..8ee209cc7 --- /dev/null +++ b/tests/objects/trefobjsyntax2.nim @@ -0,0 +1,19 @@ +# bug #2508 + +type + GenericNodeObj[T] = ref object + obj: T + + Node* = ref object + children*: seq[Node] + parent*: Node + + nodeObj*: GenericNodeObj[int] + +proc newNode*(nodeObj: GenericNodeObj): Node = + result = Node(nodeObj: nodeObj) + newSeq(result.children, 10) + +var genericObj = GenericNodeObj[int]() + +var myNode = newNode(genericObj) diff --git a/tests/overload/tstmtoverload.nim b/tests/overload/tstmtoverload.nim new file mode 100644 index 000000000..f1944b637 --- /dev/null +++ b/tests/overload/tstmtoverload.nim @@ -0,0 +1,38 @@ + +# bug #2481 +import math + +template test(loopCount: int, extraI: int, testBody: stmt): stmt = + block: + for i in 0..loopCount-1: + testBody + echo "done extraI=", extraI + +template test(loopCount: int, extraF: float, testBody: stmt): stmt = + block: + test(loopCount, round(extraF), testBody) + +template test(loopCount: int, testBody: stmt): stmt = + block: + test(loopCount, 0, testBody) + echo "done extraI passed 0" + +when isMainModule: + var + loops = 0 + + test 0, 0: + loops += 1 + echo "test 0 complete, loops=", loops + + test 1, 1.0: + loops += 1 + echo "test 1.0 complete, loops=", loops + + when true: + # when true we get the following compile time error: + # b.nim(35, 6) Error: expression 'loops += 1' has no type (or is ambiguous) + loops = 0 + test 2: + loops += 1 + echo "test no extra complete, loops=", loops diff --git a/tests/overload/tsystemcmp.nim b/tests/overload/tsystemcmp.nim index 9bfca35d7..68cbf9fa7 100644 --- a/tests/overload/tsystemcmp.nim +++ b/tests/overload/tsystemcmp.nim @@ -16,3 +16,7 @@ proc cmp(a, b: MyType): int = cmp(a.x, b.x) var modulesB = @[MyType(x: "ho"), MyType(x: "ha")] sort(modulesB, cmp) + +# bug #2397 + +proc f(x: (proc(a,b: string): int) = system.cmp) = discard diff --git a/tests/parallel/tgc_unsafe2.nim b/tests/parallel/tgc_unsafe2.nim new file mode 100644 index 000000000..ec4605fe9 --- /dev/null +++ b/tests/parallel/tgc_unsafe2.nim @@ -0,0 +1,39 @@ +discard """ + line: 28 + nimout: '''tgc_unsafe2.nim(22, 5) Warning: 'trick' is not GC-safe as it accesses 'global' which is a global using GC'ed memory +tgc_unsafe2.nim(26, 5) Warning: 'track' is not GC-safe as it calls 'trick' +tgc_unsafe2.nim(28, 5) Error: 'consumer' is not GC-safe as it calls 'track' +''' + errormsg: "'consumer' is not GC-safe as it calls 'track'" +""" + +import threadpool + +type StringChannel = TChannel[string] +var channels: array[1..3, StringChannel] + +type + MyObject[T] = object + x: T + +var global: MyObject[string] +var globalB: MyObject[float] + +proc trick(ix: int) = + echo global.x + echo channels[ix].recv() + +proc track(ix: int) = trick(ix) + +proc consumer(ix: int) {.thread.} = + track(ix) + +proc main = + for ix in 1..3: channels[ix].open() + for ix in 1..3: spawn consumer(ix) + for ix in 1..3: channels[ix].send("test") + sync() + for ix in 1..3: channels[ix].close() + +when isMainModule: + main() diff --git a/tests/parallel/twrong_refcounts.nim b/tests/parallel/twrong_refcounts.nim new file mode 100644 index 000000000..db32a96d8 --- /dev/null +++ b/tests/parallel/twrong_refcounts.nim @@ -0,0 +1,53 @@ +discard """ + output: "Success" +""" + +import math, threadPool + +# --- + +type + Person = object + age: int + friend: ref Person + +var + people: seq[ref Person] = @[] + +proc newPerson(age:int): ref Person = + result.new() + result.age = age + +proc greet(p:Person) = + #echo p.age, ", ", p.friend.age + p.friend.age += 1 + +# --- + +proc setup = + for i in 0 .. <20: + people.add newPerson(i + 1) + for i in 0 .. <20: + people[i].friend = people[random(20)] + +proc update = + var countA: array[20, int] + var countB: array[20, int] + + for i, p in people: + countA[i] = getRefCount(p) + parallel: + for i in 0 .. people.high: + spawn greet(people[i][]) + for i, p in people: + countB[i] = getRefCount(p) + + for i in 0 .. <20: + doAssert countA[i] == countB[i] + echo "Success" + +# --- + +when isMainModule: + setup() + update() diff --git a/tests/parser/tcommand_as_expr.nim b/tests/parser/tcommand_as_expr.nim index 22c49ab3f..730e9cbb7 100644 --- a/tests/parser/tcommand_as_expr.nim +++ b/tests/parser/tcommand_as_expr.nim @@ -1,7 +1,8 @@ discard """ output: '''140 5-120-120 -359''' +359 +77''' """ #import math @@ -16,8 +17,10 @@ proc foo(x, y: int): int = x-y let x = optarg foo 7.foo let y = singlearg foo(1, foo 8) let z = singlearg 1.foo foo 8 - + echo x, y, z let a = [2,4,8].map do (d:int) -> int: d + 1 -echo a[0], a[1], a[2] \ No newline at end of file +echo a[0], a[1], a[2] + +echo(foo 8, foo 8) diff --git a/tests/parser/tproctype_pragmas.nim b/tests/parser/tproctype_pragmas.nim new file mode 100644 index 000000000..8c7acd0cf --- /dev/null +++ b/tests/parser/tproctype_pragmas.nim @@ -0,0 +1,19 @@ +discard """ + output: '''39 +40''' +""" + +# bug 1802 +# Ensure proc pragmas are attached properly: + +proc makeStdcall(s: string): (proc(i: int) {.stdcall.}) = + (proc (x: int) {.stdcall.} = echo x) + +proc makeNimcall(s: string): (proc(i: int)) {.stdcall.} = + (proc (x: int) {.nimcall.} = echo x) + +let stdc: proc (y: int) {.stdcall.} = makeStdcall("bu") +let nimc: proc (y: int) {.closure.} = makeNimcall("ba") + +stdc(39) +nimc(40) diff --git a/tests/parser/tstrongspaces.nim b/tests/parser/tstrongspaces.nim index 91506daf0..e70b91988 100644 --- a/tests/parser/tstrongspaces.nim +++ b/tests/parser/tstrongspaces.nim @@ -2,6 +2,12 @@ discard """ output: '''35 +true +true +4 +true +1 +false 77 (Field0: 1, Field1: 2, Field2: 2) ha @@ -9,11 +15,26 @@ true tester args all all args +19 +-3 +false +-2 ''' """ echo 2+5 * 5 +# Keyword operators +echo 1 + 16 shl 1 == 1 + (16 shl 1) +echo 2 and 1 in {0, 30} +echo 2+2 * 2 shr 1 +echo false or 2 and 1 in {0, 30} + +proc `^`(a, b: int): int = a + b div 2 +echo 19 mod 16 ^ 4 + 2 and 1 +echo 18 mod 16 ^ 4 > 0 + +# echo $foo gotcha let foo = 77 echo $foo @@ -27,7 +48,7 @@ when true: let b = 66 let c = 90 let bar = 8000 - if foo+4 * 4 == 8 and b&c | 9 ++ + if foo+4 * 4 == 8 and b&c | 9 ++ bar: echo "ho" else: @@ -50,3 +71,13 @@ const echo tester & " " & args|"all" echo "all" | tester & " " & args echo "all"|tester & " " & args + +# Test arrow like operators. See also tests/macros/tclosuremacro.nim +proc `+->`(a, b: int): int = a + b*4 +template `===>`(a, b: int): expr = a - b shr 1 + +echo 3 +-> 2 + 2 and 4 +var arrowed = 3+->2 + 2 and 4 # arrowed = 4 +echo arrowed ===> 15 +echo (2 * 3+->2) == (2*3 +-> 2) +echo arrowed ===> 2 + 3+->2 diff --git a/tests/parser/ttypeof.nim b/tests/parser/ttypeof.nim new file mode 100644 index 000000000..24f98059e --- /dev/null +++ b/tests/parser/ttypeof.nim @@ -0,0 +1,26 @@ +discard """ + output: '''12 +int +int +int''' +""" + +import typetraits + +# bug #1805 + +proc foob(x: int): string = "foo" +proc barb(x: string): int = 12 + +echo(foob(10).barb()) # works +echo(type(10).name()) # doesn't work + +echo(name(type(10))) # works +echo((type(10)).name()) # works + + +# test that 'addr' still works +proc poo(x, y: ptr int) = discard + +var someInt: int +poo(addr someInt, addr someInt) diff --git a/tests/stdlib/treloop.nim b/tests/stdlib/treloop.nim new file mode 100644 index 000000000..35236708c --- /dev/null +++ b/tests/stdlib/treloop.nim @@ -0,0 +1,9 @@ +discard """ + output: "@[(, +, 1, 2, )]" +""" + +import re + +let str = "(+ 1 2)" +var tokenRE = re"""[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)""" +echo str.findAll(tokenRE) diff --git a/tests/system/tsettostring.nim b/tests/system/tsettostring.nim new file mode 100644 index 000000000..c6846ee99 --- /dev/null +++ b/tests/system/tsettostring.nim @@ -0,0 +1,8 @@ +discard """ + output: "{a, b, c}" +""" + +# bug #2395 + +let alphaSet: set[char] = {'a'..'c'} +echo alphaSet diff --git a/tests/template/tstmt_semchecked_twice.nim b/tests/template/tstmt_semchecked_twice.nim new file mode 100644 index 000000000..05c16c3c9 --- /dev/null +++ b/tests/template/tstmt_semchecked_twice.nim @@ -0,0 +1,30 @@ + +# bug #2585 + +type + RenderPass = object + state: ref int + + RenderData* = object + fb: int + walls: seq[RenderPass] + + Mat2 = int + Vector2[T] = T + Pixels=int + +template use*(fb: int, st: stmt) : stmt = + echo "a ", $fb + st + echo "a ", $fb + +proc render(rdat: var RenderData; passes: var openarray[RenderPass]; proj: Mat2; + indexType = 1) = + for i in 0 .. <len(passes): + echo "blah ", repr(passes[i]) + + + +proc render2*(rdat: var RenderData; screenSz: Vector2[Pixels]; proj: Mat2) = + use rdat.fb: + render(rdat, rdat.walls, proj, 1) diff --git a/tests/template/ttempl2.nim b/tests/template/ttempl2.nim index 142bbb8c7..aaa2f1344 100644 --- a/tests/template/ttempl2.nim +++ b/tests/template/ttempl2.nim @@ -3,12 +3,12 @@ discard """ line: 18 errormsg: "undeclared identifier: \'b\'" """ -template declareInScope(x: expr, t: typeDesc): stmt {.immediate.} = +template declareInScope(x: untyped, t: typeDesc): untyped {.immediate.} = var x: t - -template declareInNewScope(x: expr, t: typeDesc): stmt {.immediate.} = + +template declareInNewScope(x: untyped, t: typeDesc): untyped {.immediate.} = # open a new scope: - block: + block: var x: t declareInScope(a, int) diff --git a/tests/testament/categories.nim b/tests/testament/categories.nim index cb3649a38..4476fccf2 100644 --- a/tests/testament/categories.nim +++ b/tests/testament/categories.nim @@ -22,35 +22,35 @@ proc delNimCache() = removeDir(nimcacheDir) except OSError: echo "[Warning] could not delete: ", nimcacheDir - + proc runRodFiles(r: var TResults, cat: Category, options: string) = template test(filename: expr): stmt = testSpec r, makeTest(rodfilesDir / filename, options, cat, actionRun) - + delNimCache() - + # test basic recompilation scheme: test "hallo" test "hallo" # test incremental type information: test "hallo2" delNimCache() - + # test type converters: test "aconv" test "bconv" delNimCache() - + # test G, A, B example from the documentation; test init sections: test "deada" test "deada2" delNimCache() - + # test method generation: test "bmethods" test "bmethods2" delNimCache() - + # test generics: test "tgeneric1" test "tgeneric2" @@ -79,8 +79,8 @@ proc runBasicDLLTest(c, r: var TResults, cat: Category, options: string) = options & " --app:lib -d:createNimRtl", cat) testSpec c, makeTest("tests/dll/server.nim", options & " --app:lib -d:useNimRtl", cat) - - when defined(Windows): + + when defined(Windows): # windows looks in the dir of the exe (yay!): var nimrtlDll = DynlibFormat % "nimrtl" safeCopyFile("lib" / nimrtlDll, "tests/dll" / nimrtlDll) @@ -91,14 +91,14 @@ proc runBasicDLLTest(c, r: var TResults, cat: Category, options: string) = putEnv("LD_LIBRARY_PATH", "lib:" & libpath) var serverDll = DynlibFormat % "server" safeCopyFile("tests/dll" / serverDll, "lib" / serverDll) - - testSpec r, makeTest("tests/dll/client.nim", options & " -d:useNimRtl", + + testSpec r, makeTest("tests/dll/client.nim", options & " -d:useNimRtl", cat, actionRun) proc dllTests(r: var TResults, cat: Category, options: string) = # dummy compile result: var c = initResults() - + runBasicDLLTest c, r, cat, options runBasicDLLTest c, r, cat, options & " -d:release" runBasicDLLTest c, r, cat, options & " --gc:boehm" @@ -134,7 +134,7 @@ proc gcTests(r: var TResults, cat: Category, options: string) = test "cycleleak" test "closureleak" testWithoutMs "refarrayleak" - + test "stackrefleak" test "cyclecollector" @@ -147,7 +147,7 @@ proc threadTests(r: var TResults, cat: Category, options: string) = " -d:release", cat, actionRun) testSpec r, makeTest("tests/threads" / filename, options & " --tlsEmulation:on", cat, actionRun) - + test "tactors" test "tactors2" test "threadex" @@ -182,7 +182,7 @@ proc jsTests(r: var TResults, cat: Category, options: string) = actionRun, targetJS) testSpec r, makeTest(filename, options & " -d:nodejs -d:release", cat, actionRun, targetJS) - + for t in os.walkFiles("tests/js/t*.nim"): test(t) for testfile in ["exception/texceptions", "exception/texcpt1", @@ -199,13 +199,13 @@ proc jsTests(r: var TResults, cat: Category, options: string) = proc findMainFile(dir: string): string = # finds the file belonging to ".nim.cfg"; if there is no such file - # it returns the some ".nim" file if there is only one: + # it returns the some ".nim" file if there is only one: const cfgExt = ".nim.cfg" result = "" var nimFiles = 0 for kind, file in os.walkDir(dir): if kind == pcFile: - if file.endsWith(cfgExt): return file[.. -(cfgExt.len+1)] & ".nim" + if file.endsWith(cfgExt): return file[.. ^(cfgExt.len+1)] & ".nim" elif file.endsWith(".nim"): if result.len == 0: result = file inc nimFiles @@ -236,7 +236,7 @@ type PackageFilter = enum pfExtraOnly pfAll -let +let nimbleExe = findExe("nimble") nimbleDir = getHomeDir() / ".nimble" packageDir = nimbleDir / "pkgs" diff --git a/tests/testament/specs.nim b/tests/testament/specs.nim index 2a8a4ea24..8bf1a4ad7 100644 --- a/tests/testament/specs.nim +++ b/tests/testament/specs.nim @@ -42,7 +42,8 @@ type action*: TTestAction file*, cmd*: string outp*: string - line*, exitCode*: int + line*, column*: int + exitCode*: int msg*: string ccodeCheck*: string err*: TResultEnum @@ -98,6 +99,8 @@ proc parseSpec*(filename: string): TSpec = result.nimout = "" result.ccodeCheck = "" result.cmd = cmdTemplate + result.line = 0 + result.column = 0 parseSpecAux: case normalize(e.key) of "action": @@ -108,6 +111,7 @@ proc parseSpec*(filename: string): TSpec = else: echo ignoreMsg(p, e) of "file": result.file = e.value of "line": discard parseInt(e.value, result.line) + of "column": discard parseInt(e.value, result.column) of "output": result.action = actionRun result.outp = e.value diff --git a/tests/testament/tester.nim b/tests/testament/tester.nim index 4c1173fe3..ed39109ad 100644 --- a/tests/testament/tester.nim +++ b/tests/testament/tester.nim @@ -50,7 +50,7 @@ type let pegLineError = - peg"{[^(]*} '(' {\d+} ', ' \d+ ') ' ('Error') ':' \s* {.*}" + peg"{[^(]*} '(' {\d+} ', ' {\d+} ') ' ('Error') ':' \s* {.*}" pegOtherError = peg"'Error:' \s* {.*}" pegSuccess = peg"'Hint: operation successful'.*" pegOfInterest = pegLineError / pegOtherError @@ -59,7 +59,7 @@ proc callCompiler(cmdTemplate, filename, options: string, target: TTarget): TSpec = let c = parseCmdLine(cmdTemplate % ["target", targetToCmd[target], "options", options, "file", filename.quoteShell]) - var p = startProcess(command=c[0], args=c[1.. -1], + var p = startProcess(command=c[0], args=c[1.. ^1], options={poStdErrToStdOut, poUseShell}) let outp = p.outputStream var suc = "" @@ -77,11 +77,13 @@ proc callCompiler(cmdTemplate, filename, options: string, result.msg = "" result.file = "" result.outp = "" - result.line = -1 + result.line = 0 + result.column = 0 if err =~ pegLineError: result.file = extractFilename(matches[0]) result.line = parseInt(matches[1]) - result.msg = matches[2] + result.column = parseInt(matches[2]) + result.msg = matches[3] elif err =~ pegOtherError: result.msg = matches[0] elif suc =~ pegSuccess: @@ -130,8 +132,11 @@ proc cmpMsgs(r: var TResults, expected, given: TSpec, test: TTest) = elif extractFilename(expected.file) != extractFilename(given.file) and "internal error:" notin expected.msg: r.addResult(test, expected.file, given.file, reFilesDiffer) - elif expected.line != given.line and expected.line != 0: - r.addResult(test, $expected.line, $given.line, reLinesDiffer) + elif expected.line != given.line and expected.line != 0 or + expected.column != given.column and expected.column != 0: + r.addResult(test, $expected.line & ':' & $expected.column, + $given.line & ':' & $given.column, + reLinesDiffer) else: r.addResult(test, expected.msg, given.msg, reSuccess) inc(r.passed) @@ -284,7 +289,7 @@ proc main() = let testsDir = "tests" & DirSep for kind, dir in walkDir(testsDir): assert testsDir.startsWith(testsDir) - let cat = dir[testsDir.len .. -1] + let cat = dir[testsDir.len .. ^1] if kind == pcDir and cat notin ["testament", "testdata", "nimcache"]: processCategory(r, Category(cat), p.cmdLineRest.string) for a in AdditionalCategories: diff --git a/tests/tuples/tgeneric_tuple2.nim b/tests/tuples/tgeneric_tuple2.nim new file mode 100644 index 000000000..c0c292388 --- /dev/null +++ b/tests/tuples/tgeneric_tuple2.nim @@ -0,0 +1,17 @@ + +# bug #2369 + +type HashedElem[T] = tuple[num: int, storedVal: ref T] + +proc append[T](tab: var seq[HashedElem[T]], n: int, val: ref T) = + #tab.add((num: n, storedVal: val)) + var he: HashedElem[T] = (num: n, storedVal: val) + #tab.add(he) + +var g: seq[HashedElem[int]] = @[] + +proc foo() = + var x: ref int + new(x) + x[] = 77 + g.append(44, x) diff --git a/tests/tuples/tuint_tuple.nim b/tests/tuples/tuint_tuple.nim new file mode 100644 index 000000000..24bcead5e --- /dev/null +++ b/tests/tuples/tuint_tuple.nim @@ -0,0 +1,10 @@ +# bug #1986 found by gdmoore + +proc test(): int64 = + return 0xdeadbeef.int64 + +const items = [ + (var1: test(), var2: 100'u32), + (var1: test(), var2: 192'u32) +] + diff --git a/tests/types/tisopr.nim b/tests/types/tisopr.nim index 8b7fe4e46..b9acfa5fb 100644 --- a/tests/types/tisopr.nim +++ b/tests/types/tisopr.nim @@ -1,5 +1,11 @@ discard """ - output: '''true true false yes''' + output: '''true true false yes +false +false +false +true +true +no''' """ proc IsVoid[T](): string = @@ -28,7 +34,7 @@ no s.items is iterator: float yes s.items is iterator: TNumber no s.items is iterator: object -type +type Iter[T] = iterator: T yes s.items is Iter[TNumber] @@ -51,3 +57,34 @@ yes Foo[4, int] is Bar[int] no Foo[4, int] is Baz[4] yes Foo[4, float] is Baz[4] + +# bug #2505 + +echo(8'i8 is int32) + +# bug #1853 +type SeqOrSet[E] = seq[E] or set[E] +type SeqOfInt = seq[int] +type SeqOrSetOfInt = SeqOrSet[int] + +# This prints "false", which seems less correct that (1) printing "true" or (2) +# raising a compiler error. +echo seq is SeqOrSet + +# This prints "false", as expected. +echo seq is SeqOrSetOfInt + +# This prints "true", as expected. +echo SeqOfInt is SeqOrSet + +# This causes an internal error (filename: compiler/semtypes.nim, line: 685). +echo SeqOfInt is SeqOrSetOfInt + +# bug #2522 +proc test[T](x: T) = + when T is typedesc: + echo "yes" + else: + echo "no" + +test(7) diff --git a/todo.txt b/todo.txt index b77c276b7..12e82331f 100644 --- a/todo.txt +++ b/todo.txt @@ -1,23 +1,33 @@ version 0.10.4 ============== -- improve GC-unsafety warnings -- make 'nil' work for 'add' and 'len' -- disallow negative indexing -- improve the parser; deal with echo $foo gotcha +- make 'nil' work for 'add': + - resizeString + - incrSeq + - addChar + + +version 0.10.6 (RC1?) +===================== + +- make '--implicitStatic:on' the default; then we can also clean up the + 'static[T]' mess in the compiler! +- finish 'parallel' or mark as experimental +- Deprecate ``immediate`` for templates and macros +- special case varargs[untyped] and varargs[typed] version 1.0 =========== +- macro support for '='; bind '=' to a memory region +- remove echo $foo gotcha +- add "all threads are blocked" detection to 'spawn' - figure out why C++ bootstrapping is so much slower - nimsuggest: auto-completion needs to work in 'class' macros -- improve the docs for inheritance - The bitwise 'not' operator will be renamed to 'bnot' to prevent 'not 4 == 5' from compiling. -> requires 'mixin' annotation for procs! - iterators always require a return type -- overloading of '=' - - make nimble part of the distribution - split docgen into separate tool - special rule for ``[]=``, items, pairs @@ -39,7 +49,6 @@ Low priority: Misc ---- -- make '--implicitStatic:on' the default - make tuple unpacking work in a non-var/let context - built-in 'getImpl' - prevent 'alloc(TypeWithGCedMemory)' @@ -53,6 +62,7 @@ Bugs - scopes are still broken for generic instantiation! - blocks can "export" an identifier but the CCG generates {} for them ... - ConcreteTypes in a 'case' means we don't check for duplicated case branches +- typedesc matches a generic type T! version 0.9.x diff --git a/web/news.txt b/web/news.txt index 7cf1ae28f..257591de7 100644 --- a/web/news.txt +++ b/web/news.txt @@ -11,8 +11,21 @@ News ----------------------------------------- - Parameter names are finally properly ``gensym``'ed. This can break - templates though that used to rely on the fact that they are not. However - we found none such beast in the wild. (Bug #1915.) + templates though that used to rely on the fact that they are not. + (Bug #1915.) This means this doesn't compile anymore: + + .. code-block:: nim + + template doIt(body: stmt) {.immediate.} = + # this used to inject the 'str' parameter: + proc res(str: string) = + body + + doIt: + echo str # Error: undeclared identifier: 'str' + + Declare the ``doIt`` template as ``immediate, dirty`` to get the old + behaviour. - Tuple field names are not ignored anymore, this caused too many problems in practice so now the behaviour as it was for version 0.9.6: If field names exist for the tuple type, they are checked. @@ -21,8 +34,54 @@ News should be used instead. - ``nim idetools`` has been replaced by a separate tool `nimsuggest`_. - *arrow like* operators are not right associative anymore. + - *arrow like* operators are now required to end with either ``->``, ``~>`` or + ``=>``, not just ``>``. Examples of operators still considered arrow like: + ``->``, ``==>``, ``+=>``. On the other hand, the following operators are now + considered regular operators again: ``|>``, ``-+>``, etc. - Typeless parameters are now only allowed in templates and macros. The old way turned out to be too error-prone. + - The 'addr' and 'type' operators are now parsed as unary function + application. This means ``type(x).name`` is now parsed as ``(type(x)).name`` + and not as ``type((x).name)``. Note that this also affects the AST + structure; for immediate macro parameters ``nkCall('addr', 'x')`` is + produced instead of ``nkAddr('x')``. + - ``concept`` is now a keyword and is used instead of ``generic``. + - The ``inc``, ``dec``, ``+=``, ``-=`` builtins now produce OverflowError + exceptions. This means code like the following: + + .. code-block:: nim + var x = low(T) + while x <= high(T): + echo x + inc x + + Needs to be replaced by something like this: + + .. code-block:: nim + var x = low(T).int + while x <= high(T).int: + echo x.T + inc x + + - **Negative indexing for slicing does not work anymore!** Instead + of ``a[0.. -1]`` you can + use ``a[0.. ^1]``. This also works with accessing a single + element ``a[^1]``. Note that we cannot detect this reliably as it is + determined at **runtime** whether negative indexing is used! + ``a[0.. -1]`` now produces the empty string/sequence. + - The compiler now warns about code like ``foo +=1`` which uses inconsistent + spacing around binary operators. Later versions of the language will parse + these as unary operators instead so that ``echo $foo`` finally can do what + people expect it to do. + - ``system.untyped`` and ``system.typed`` have been introduced as aliases + for ``expr`` and ``stmt``. The new names capture the semantics much better + and most likely ``expr`` and ``stmt`` will be deprecated in favor of the + new names. + - The ``split`` method in module ``re`` has changed. It now handles the case + of matches having a length of 0, and empty strings being yielded from the + iterator. A notable change might be that a pattern being matched at the + beginning and end of a string, will result in an empty string being produced + at the start and the end of the iterator. Language Additions ------------------ @@ -64,6 +123,12 @@ News varOrConst(x) # "var" varOrConst(45) # "const" + - Array and seq indexing can now use the builtin ``^`` operator to access + things from backwards: ``a[^1]`` is like Python's ``a[-1]``. + - A first version of the specification and implementation of the overloading + of the assignment operator has arrived! + - ``system.len`` for strings and sequences now returns 0 for nil. + Library additions ----------------- @@ -73,6 +138,10 @@ News with a ``newMultipartData`` proc. - Added `%*` operator for JSON. - The compiler is now available as Nimble package for c2nim. + - Added ``..^`` and ``..<`` templates to system so that the rather annoying + space between ``.. <`` and ``.. ^`` is not necessary anymore. + - Added ``system.xlen`` for strings and sequences to get back the old ``len`` + operation that doesn't check for ``nil`` for efficiency. Bugfixes |