diff options
Diffstat (limited to 'compiler')
130 files changed, 7468 insertions, 11554 deletions
diff --git a/compiler/aliases.nim b/compiler/aliases.nim index 40d6e272c..fa1167753 100644 --- a/compiler/aliases.nim +++ b/compiler/aliases.nim @@ -51,14 +51,16 @@ proc isPartOfAux(a, b: PType, marker: var IntSet): TAnalysisResult = if compareTypes(a, b, dcEqIgnoreDistinct): return arYes case a.kind of tyObject: - if a[0] != nil: - result = isPartOfAux(a[0].skipTypes(skipPtrs), b, marker) + if a.baseClass != nil: + result = isPartOfAux(a.baseClass.skipTypes(skipPtrs), b, marker) if result == arNo: result = isPartOfAux(a.n, b, marker) of tyGenericInst, tyDistinct, tyAlias, tySink: - result = isPartOfAux(lastSon(a), b, marker) - of tyArray, tySet, tyTuple: - for i in 0..<a.len: - result = isPartOfAux(a[i], b, marker) + result = isPartOfAux(skipModifier(a), b, marker) + of tySet, tyArray: + result = isPartOfAux(a.elementType, b, marker) + of tyTuple: + for aa in a.kids: + result = isPartOfAux(aa, b, marker) if result == arYes: return else: discard diff --git a/compiler/ast.nim b/compiler/ast.nim index e25ce42dd..a342e1ea7 100644 --- a/compiler/ast.nim +++ b/compiler/ast.nim @@ -20,6 +20,9 @@ when defined(nimPreviewSlimSystem): export int128 +import nodekinds +export nodekinds + type TCallingConvention* = enum ccNimCall = "nimcall" # nimcall, also the default @@ -33,207 +36,12 @@ type ccThisCall = "thiscall" # thiscall (parameters are pushed right-to-left) ccClosure = "closure" # proc has a closure ccNoConvention = "noconv" # needed for generating proper C procs sometimes - -type - TNodeKind* = enum # order is extremely important, because ranges are used - # to check whether a node belongs to a certain class - nkNone, # unknown node kind: indicates an error - # Expressions: - # Atoms: - nkEmpty, # the node is empty - nkIdent, # node is an identifier - nkSym, # node is a symbol - nkType, # node is used for its typ field - - nkCharLit, # a character literal '' - nkIntLit, # an integer literal - nkInt8Lit, - nkInt16Lit, - nkInt32Lit, - nkInt64Lit, - nkUIntLit, # an unsigned integer literal - nkUInt8Lit, - nkUInt16Lit, - nkUInt32Lit, - nkUInt64Lit, - nkFloatLit, # a floating point literal - nkFloat32Lit, - nkFloat64Lit, - nkFloat128Lit, - nkStrLit, # a string literal "" - nkRStrLit, # a raw string literal r"" - nkTripleStrLit, # a triple string literal """ - nkNilLit, # the nil literal - # end of atoms - nkComesFrom, # "comes from" template/macro information for - # better stack trace generation - nkDotCall, # used to temporarily flag a nkCall node; - # this is used - # for transforming ``s.len`` to ``len(s)`` - - nkCommand, # a call like ``p 2, 4`` without parenthesis - nkCall, # a call like p(x, y) or an operation like +(a, b) - nkCallStrLit, # a call with a string literal - # x"abc" has two sons: nkIdent, nkRStrLit - # x"""abc""" has two sons: nkIdent, nkTripleStrLit - nkInfix, # a call like (a + b) - nkPrefix, # a call like !a - nkPostfix, # something like a! (also used for visibility) - nkHiddenCallConv, # an implicit type conversion via a type converter - - nkExprEqExpr, # a named parameter with equals: ''expr = expr'' - nkExprColonExpr, # a named parameter with colon: ''expr: expr'' - nkIdentDefs, # a definition like `a, b: typeDesc = expr` - # either typeDesc or expr may be nil; used in - # formal parameters, var statements, etc. - nkVarTuple, # a ``var (a, b) = expr`` construct - nkPar, # syntactic (); may be a tuple constructor - nkObjConstr, # object constructor: T(a: 1, b: 2) - nkCurly, # syntactic {} - nkCurlyExpr, # an expression like a{i} - nkBracket, # syntactic [] - nkBracketExpr, # an expression like a[i..j, k] - nkPragmaExpr, # an expression like a{.pragmas.} - nkRange, # an expression like i..j - nkDotExpr, # a.b - nkCheckedFieldExpr, # a.b, but b is a field that needs to be checked - nkDerefExpr, # a^ - nkIfExpr, # if as an expression - nkElifExpr, - nkElseExpr, - nkLambda, # lambda expression - nkDo, # lambda block appering as trailing proc param - nkAccQuoted, # `a` as a node - - nkTableConstr, # a table constructor {expr: expr} - nkBind, # ``bind expr`` node - nkClosedSymChoice, # symbol choice node; a list of nkSyms (closed) - nkOpenSymChoice, # symbol choice node; a list of nkSyms (open) - nkHiddenStdConv, # an implicit standard type conversion - nkHiddenSubConv, # an implicit type conversion from a subtype - # to a supertype - nkConv, # a type conversion - nkCast, # a type cast - nkStaticExpr, # a static expr - nkAddr, # a addr expression - nkHiddenAddr, # implicit address operator - nkHiddenDeref, # implicit ^ operator - nkObjDownConv, # down conversion between object types - nkObjUpConv, # up conversion between object types - nkChckRangeF, # range check for floats - nkChckRange64, # range check for 64 bit ints - nkChckRange, # range check for ints - nkStringToCString, # string to cstring - nkCStringToString, # cstring to string - # end of expressions - - nkAsgn, # a = b - nkFastAsgn, # internal node for a fast ``a = b`` - # (no string copy) - nkGenericParams, # generic parameters - nkFormalParams, # formal parameters - nkOfInherit, # inherited from symbol - - nkImportAs, # a 'as' b in an import statement - nkProcDef, # a proc - nkMethodDef, # a method - nkConverterDef, # a converter - nkMacroDef, # a macro - nkTemplateDef, # a template - nkIteratorDef, # an iterator - - nkOfBranch, # used inside case statements - # for (cond, action)-pairs - nkElifBranch, # used in if statements - nkExceptBranch, # an except section - nkElse, # an else part - nkAsmStmt, # an assembler block - nkPragma, # a pragma statement - nkPragmaBlock, # a pragma with a block - nkIfStmt, # an if statement - nkWhenStmt, # a when expression or statement - nkForStmt, # a for statement - nkParForStmt, # a parallel for statement - nkWhileStmt, # a while statement - nkCaseStmt, # a case statement - nkTypeSection, # a type section (consists of type definitions) - nkVarSection, # a var section - nkLetSection, # a let section - nkConstSection, # a const section - nkConstDef, # a const definition - nkTypeDef, # a type definition - nkYieldStmt, # the yield statement as a tree - nkDefer, # the 'defer' statement - nkTryStmt, # a try statement - nkFinally, # a finally section - nkRaiseStmt, # a raise statement - nkReturnStmt, # a return statement - nkBreakStmt, # a break statement - nkContinueStmt, # a continue statement - nkBlockStmt, # a block statement - nkStaticStmt, # a static statement - nkDiscardStmt, # a discard statement - nkStmtList, # a list of statements - nkImportStmt, # an import statement - nkImportExceptStmt, # an import x except a statement - nkExportStmt, # an export statement - nkExportExceptStmt, # an 'export except' statement - nkFromStmt, # a from * import statement - nkIncludeStmt, # an include statement - nkBindStmt, # a bind statement - nkMixinStmt, # a mixin statement - nkUsingStmt, # an using statement - nkCommentStmt, # a comment statement - nkStmtListExpr, # a statement list followed by an expr; this is used - # to allow powerful multi-line templates - nkBlockExpr, # a statement block ending in an expr; this is used - # to allow powerful multi-line templates that open a - # temporary scope - nkStmtListType, # a statement list ending in a type; for macros - nkBlockType, # a statement block ending in a type; for macros - # types as syntactic trees: - - nkWith, # distinct with `foo` - nkWithout, # distinct without `foo` - - nkTypeOfExpr, # type(1+2) - nkObjectTy, # object body - nkTupleTy, # tuple body - nkTupleClassTy, # tuple type class - nkTypeClassTy, # user-defined type class - nkStaticTy, # ``static[T]`` - nkRecList, # list of object parts - nkRecCase, # case section of object - nkRecWhen, # when section of object - nkRefTy, # ``ref T`` - nkPtrTy, # ``ptr T`` - nkVarTy, # ``var T`` - nkConstTy, # ``const T`` - nkOutTy, # ``out T`` - nkDistinctTy, # distinct type - nkProcTy, # proc type - nkIteratorTy, # iterator type - nkSinkAsgn, # '=sink(x, y)' - nkEnumTy, # enum body - nkEnumFieldDef, # `ident = expr` in an enumeration - nkArgList, # argument list - nkPattern, # a special pattern; used for matching - nkHiddenTryStmt, # a hidden try statement - nkClosure, # (prc, env)-pair (internally used for code gen) - nkGotoState, # used for the state machine (for iterators) - nkState, # give a label to a code section (for iterators) - nkBreakState, # special break statement for easier code generation - nkFuncDef, # a func - nkTupleConstr # a tuple constructor - nkError # erroneous AST node - nkModuleRef # for .rod file support: A (moduleId, itemId) pair - nkReplayAction # for .rod file support: A replay action - nkNilRodNode # for .rod file support: a 'nil' PNode + ccMember = "member" # proc is a (cpp) member TNodeKinds* = set[TNodeKind] type - TSymFlag* = enum # 51 flags! + TSymFlag* = enum # 63 flags! sfUsed, # read access of sym (for warnings) or simply used sfExported, # symbol is exported from module sfFromGeneric, # symbol is instantiation of a generic; this is needed @@ -285,7 +93,7 @@ type sfNamedParamCall, # symbol needs named parameter call syntax in target # language; for interfacing with Objective C sfDiscardable, # returned value may be discarded implicitly - sfOverridden, # proc is overridden + sfOverridden, # proc is overridden sfCallsite # A flag for template symbols to tell the # compiler it should use line information from # the calling side of the macro, not from the @@ -318,24 +126,25 @@ type sfByCopy # param is marked as pass bycopy sfMember # proc is a C++ member of a type sfCodegenDecl # type, proc, global or proc param is marked as codegenDecl + sfWasGenSym # symbol was 'gensym'ed + sfForceLift # variable has to be lifted into closure environment + + sfDirty # template is not hygienic (old styled template) module, + # compiled from a dirty-buffer + sfCustomPragma # symbol is custom pragma template + sfBase, # a base method + sfGoto # var is used for 'goto' code generation + sfAnon, # symbol name that was generated by the compiler + # the compiler will avoid printing such names + # in user messages. + sfAllUntyped # macro or template is immediately expanded in a generic context + sfTemplateRedefinition # symbol is a redefinition of an earlier template TSymFlags* = set[TSymFlag] const sfNoInit* = sfMainModule # don't generate code to init the variable - sfAllUntyped* = sfVolatile # macro or template is immediately expanded \ - # in a generic context - - sfDirty* = sfPure - # template is not hygienic (old styled template) - # module, compiled from a dirty-buffer - - sfAnon* = sfDiscardable - # symbol name that was generated by the compiler - # the compiler will avoid printing such names - # in user messages. - sfNoForward* = sfRegister # forward declarations are not required (per module) sfReorder* = sfForward @@ -344,12 +153,8 @@ const sfCompileToCpp* = sfInfixCall # compile the module as C++ code sfCompileToObjc* = sfNamedParamCall # compile the module as Objective-C code sfExperimental* = sfOverridden # module uses the .experimental switch - sfGoto* = sfOverridden # var is used for 'goto' code generation sfWrittenTo* = sfBorrow # param is assigned to # currently unimplemented - sfBase* = sfDiscriminant - sfCustomPragma* = sfRegister # symbol is custom pragma template - sfTemplateRedefinition* = sfExportc # symbol is a redefinition of an earlier template sfCppMember* = { sfVirtual, sfMember, sfConstructor } # proc is a C++ member, meaning it will be attached to the type definition const @@ -409,7 +214,8 @@ type tyUncheckedArray # An array with boundaries [0,+∞] - tyProxy # used as errornous type (for idetools) + tyError # used as erroneous type (for idetools) + # as an erroneous node should match everything tyBuiltInTypeClass # Type such as the catch-all object, tuple, seq, etc @@ -434,9 +240,9 @@ type tyInferred # In the initial state `base` stores a type class constraining # the types that can be inferred. After a candidate type is - # selected, it's stored in `lastSon`. Between `base` and `lastSon` + # selected, it's stored in `last`. Between `base` and `last` # there may be 0, 2 or more types that were also considered as - # possible candidates in the inference process (i.e. lastSon will + # possible candidates in the inference process (i.e. last will # be updated to store a type best conforming to all candidates) tyAnd, tyOr, tyNot @@ -471,10 +277,6 @@ static: const tyPureObject* = tyTuple GcTypeKinds* = {tyRef, tySequence, tyString} - tyError* = tyProxy # as an errornous node should match everything - tyUnknown* = tyFromExpr - - tyUnknownTypes* = {tyError, tyFromExpr} tyTypeClasses* = {tyBuiltInTypeClass, tyCompositeTypeClass, tyUserTypeClass, tyUserTypeClassInst, @@ -520,6 +322,9 @@ type nfFirstWrite # this node is a first write nfHasComment # node has a comment nfSkipFieldChecking # node skips field visable checking + nfDisabledOpenSym # temporary: node should be nkOpenSym but cannot + # because openSym experimental switch is disabled + # gives warning instead TNodeFlags* = set[TNodeFlag] TTypeFlag* = enum # keep below 32 for efficiency reasons (now: 47) @@ -552,7 +357,7 @@ type tfIterator, # type is really an iterator, not a tyProc tfPartial, # type is declared as 'partial' tfNotNil, # type cannot be 'nil' - tfRequiresInit, # type constains a "not nil" constraint somewhere or + tfRequiresInit, # type contains a "not nil" constraint somewhere or # a `requiresInit` field, so the default zero init # is not appropriate tfNeedsFullInit, # object type marked with {.requiresInit.} @@ -640,6 +445,8 @@ const tfGcSafe* = tfThread tfObjHasKids* = tfEnumHasHoles tfReturnsNew* = tfInheritable + tfNonConstExpr* = tfExplicitCallConv + ## tyFromExpr where the expression shouldn't be evaluated as a static value skError* = skUnknown var @@ -679,7 +486,6 @@ type mUnaryPlusI, mBitnotI, mUnaryPlusF64, mUnaryMinusF64, mCharToStr, mBoolToStr, - mIntToStr, mInt64ToStr, mFloatToStr, # for compiling nimStdlibVersion < 1.5.1 (not bootstrapping) mCStrToStr, mStrToStr, mEnumToStr, mAnd, mOr, @@ -696,7 +502,7 @@ type mSwap, mIsNil, mArrToSeq, mOpenArrayToSeq, mNewString, mNewStringOfCap, mParseBiggestFloat, mMove, mEnsureMove, mWasMoved, mDup, mDestroy, mTrace, - mDefault, mUnown, mFinished, mIsolate, mAccessEnv, mAccessTypeField, mReset, + mDefault, mUnown, mFinished, mIsolate, mAccessEnv, mAccessTypeField, mArray, mOpenArray, mRange, mSet, mSeq, mVarargs, mRef, mPtr, mVar, mDistinct, mVoid, mTuple, mOrdinal, mIterableType, @@ -749,7 +555,6 @@ const mUnaryMinusI, mUnaryMinusI64, mAbsI, mNot, mUnaryPlusI, mBitnotI, mUnaryPlusF64, mUnaryMinusF64, mCharToStr, mBoolToStr, - mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, mStrToStr, mEnumToStr, mAnd, mOr, @@ -779,10 +584,6 @@ proc hash*(x: ItemId): Hash = type - TIdObj* {.acyclic.} = object of RootObj - itemId*: ItemId - PIdObj* = ref TIdObj - PNode* = ref TNode TNodeSeq* = seq[PNode] PType* = ref TType @@ -851,7 +652,7 @@ type storage*: TStorageLoc flags*: TLocFlags # location's flags lode*: PNode # Node where the location came from; can be faked - r*: Rope # rope value of location (code generators) + snippet*: Rope # C code snippet of location (code generators) # ---------------- end of backend information ------------------------------ @@ -885,7 +686,8 @@ type PScope* = ref TScope PLib* = ref TLib - TSym* {.acyclic.} = object of TIdObj # Keep in sync with PackedSym + TSym* {.acyclic.} = object # Keep in sync with PackedSym + itemId*: ItemId # proc and type instantiations are cached in the generic symbol case kind*: TSymKind of routineKinds: @@ -954,11 +756,12 @@ type attachedTrace, attachedDeepCopy - TType* {.acyclic.} = object of TIdObj # \ + TType* {.acyclic.} = object # \ # types are identical iff they have the # same id; there may be multiple copies of a type # in memory! # Keep in sync with PackedType + itemId*: ItemId kind*: TTypeKind # kind of type callConv*: TCallingConvention # for procs flags*: TTypeFlags # flags of the type @@ -990,24 +793,6 @@ type TPairSeq* = seq[TPair] - TIdPair* = object - key*: PIdObj - val*: RootRef - - TIdPairSeq* = seq[TIdPair] - TIdTable* = object # the same as table[PIdent] of PObject - counter*: int - data*: TIdPairSeq - - TIdNodePair* = object - key*: PIdObj - val*: PNode - - TIdNodePairSeq* = seq[TIdNodePair] - TIdNodeTable* = object # the same as table[PIdObj] of PNode - counter*: int - data*: TIdNodePairSeq - TNodePair* = object h*: Hash # because it is expensive to compute! key*: PNode @@ -1095,7 +880,8 @@ const nfIsRef, nfIsPtr, nfPreventCg, nfLL, nfFromTemplate, nfDefaultRefsParam, nfExecuteOnReload, nfLastRead, - nfFirstWrite, nfSkipFieldChecking} + nfFirstWrite, nfSkipFieldChecking, + nfDisabledOpenSym} namePos* = 0 patternPos* = 1 # empty except for term rewriting macros genericParamsPos* = 2 @@ -1108,10 +894,8 @@ const nfAllFieldsSet* = nfBase2 - nkCallKinds* = {nkCall, nkInfix, nkPrefix, nkPostfix, - nkCommand, nkCallStrLit, nkHiddenCallConv} nkIdentKinds* = {nkIdent, nkSym, nkAccQuoted, nkOpenSymChoice, - nkClosedSymChoice} + nkClosedSymChoice, nkOpenSym} nkPragmaCallKinds* = {nkExprColonExpr, nkCall, nkCallStrLit} nkLiterals* = {nkCharLit..nkTripleStrLit} @@ -1139,12 +923,13 @@ proc getPIdent*(a: PNode): PIdent {.inline.} = of nkSym: a.sym.name of nkIdent: a.ident of nkOpenSymChoice, nkClosedSymChoice: a.sons[0].sym.name + of nkOpenSym: getPIdent(a.sons[0]) else: nil const moduleShift = when defined(cpu32): 20 else: 24 -template id*(a: PIdObj): int = +template id*(a: PType | PSym): int = let x = a (x.itemId.module.int shl moduleShift) + x.itemId.item.int @@ -1196,9 +981,7 @@ proc isCallExpr*(n: PNode): bool = proc discardSons*(father: PNode) -type Indexable = PNode | PType - -proc len*(n: Indexable): int {.inline.} = +proc len*(n: PNode): int {.inline.} = result = n.sons.len proc safeLen*(n: PNode): int {.inline.} = @@ -1212,18 +995,31 @@ proc safeArrLen*(n: PNode): int {.inline.} = elif n.kind in {nkNone..nkFloat128Lit}: result = 0 else: result = n.len -proc add*(father, son: Indexable) = +proc add*(father, son: PNode) = + assert son != nil + father.sons.add(son) + +proc addAllowNil*(father, son: PNode) {.inline.} = + father.sons.add(son) + +template `[]`*(n: PNode, i: int): PNode = n.sons[i] +template `[]=`*(n: PNode, i: int; x: PNode) = n.sons[i] = x + +template `[]`*(n: PNode, i: BackwardsIndex): PNode = n[n.len - i.int] +template `[]=`*(n: PNode, i: BackwardsIndex; x: PNode) = n[n.len - i.int] = x + +proc add*(father, son: PType) = assert son != nil father.sons.add(son) -proc addAllowNil*(father, son: Indexable) {.inline.} = +proc addAllowNil*(father, son: PType) {.inline.} = father.sons.add(son) -template `[]`*(n: Indexable, i: int): Indexable = n.sons[i] -template `[]=`*(n: Indexable, i: int; x: Indexable) = n.sons[i] = x +template `[]`*(n: PType, i: int): PType = n.sons[i] +template `[]=`*(n: PType, i: int; x: PType) = n.sons[i] = x -template `[]`*(n: Indexable, i: BackwardsIndex): Indexable = n[n.len - i.int] -template `[]=`*(n: Indexable, i: BackwardsIndex; x: Indexable) = n[n.len - i.int] = x +template `[]`*(n: PType, i: BackwardsIndex): PType = n[n.len - i.int] +template `[]=`*(n: PType, i: BackwardsIndex; x: PType) = n[n.len - i.int] = x proc getDeclPragma*(n: PNode): PNode = ## return the `nkPragma` node for declaration `n`, or `nil` if no pragma was found. @@ -1261,8 +1057,11 @@ proc getDeclPragma*(n: PNode): PNode = proc extractPragma*(s: PSym): PNode = ## gets the pragma node of routine/type/var/let/const symbol `s` - if s.kind in routineKinds: - result = s.ast[pragmasPos] + if s.kind in routineKinds: # bug #24167 + if s.ast[pragmasPos] != nil and s.ast[pragmasPos].kind != nkEmpty: + result = s.ast[pragmasPos] + else: + result = nil elif s.kind in {skType, skVar, skLet, skConst}: if s.ast != nil and s.ast.len > 0: if s.ast[0].kind == nkPragmaExpr and s.ast[0].len > 1: @@ -1335,6 +1134,33 @@ proc newNodeIT*(kind: TNodeKind, info: TLineInfo, typ: PType): PNode = result.info = info result.typ = typ +proc newNode*(kind: TNodeKind, info: TLineInfo): PNode = + ## new node with line info, no type, and no children + newNodeImpl(info) + setIdMaybe() + +proc newAtom*(ident: PIdent, info: TLineInfo): PNode = + result = newNode(nkIdent, info) + result.ident = ident + +proc newAtom*(kind: TNodeKind, intVal: BiggestInt, info: TLineInfo): PNode = + result = newNode(kind, info) + result.intVal = intVal + +proc newAtom*(kind: TNodeKind, floatVal: BiggestFloat, info: TLineInfo): PNode = + result = newNode(kind, info) + result.floatVal = floatVal + +proc newAtom*(kind: TNodeKind; strVal: sink string; info: TLineInfo): PNode = + result = newNode(kind, info) + result.strVal = strVal + +proc newTree*(kind: TNodeKind; info: TLineInfo; children: varargs[PNode]): PNode = + result = newNodeI(kind, info) + if children.len > 0: + result.info = children[0].info + result.sons = @children + proc newTree*(kind: TNodeKind; children: varargs[PNode]): PNode = result = newNode(kind) if children.len > 0: @@ -1354,7 +1180,7 @@ proc newTreeIT*(kind: TNodeKind; info: TLineInfo; typ: PType; children: varargs[ result.sons = @children template previouslyInferred*(t: PType): PType = - if t.sons.len > 1: t.lastSon else: nil + if t.sons.len > 1: t.last else: nil when false: import tables, strutils @@ -1432,11 +1258,6 @@ proc copyStrTable*(dest: var TStrTable, src: TStrTable) = setLen(dest.data, src.data.len) for i in 0..high(src.data): dest.data[i] = src.data[i] -proc copyIdTable*(dest: var TIdTable, src: TIdTable) = - dest.counter = src.counter - newSeq(dest.data, src.data.len) - for i in 0..high(src.data): dest.data[i] = src.data[i] - proc copyObjectSet*(dest: var TObjectSet, src: TObjectSet) = dest.counter = src.counter setLen(dest.data, src.data.len) @@ -1466,6 +1287,9 @@ proc newSymNode*(sym: PSym, info: TLineInfo): PNode = result.typ = sym.typ result.info = info +proc newOpenSym*(n: PNode): PNode {.inline.} = + result = newTreeI(nkOpenSym, n.info, n) + proc newIntNode*(kind: TNodeKind, intVal: BiggestInt): PNode = result = newNode(kind) result.intVal = intVal @@ -1474,7 +1298,42 @@ proc newIntNode*(kind: TNodeKind, intVal: Int128): PNode = result = newNode(kind) result.intVal = castToInt64(intVal) -proc lastSon*(n: Indexable): Indexable = n.sons[^1] +proc lastSon*(n: PNode): PNode {.inline.} = n.sons[^1] +template setLastSon*(n: PNode, s: PNode) = n.sons[^1] = s + +template firstSon*(n: PNode): PNode = n.sons[0] +template secondSon*(n: PNode): PNode = n.sons[1] + +template hasSon*(n: PNode): bool = n.len > 0 +template has2Sons*(n: PNode): bool = n.len > 1 + +proc replaceFirstSon*(n, newson: PNode) {.inline.} = + n.sons[0] = newson + +proc replaceSon*(n: PNode; i: int; newson: PNode) {.inline.} = + n.sons[i] = newson + +proc last*(n: PType): PType {.inline.} = n.sons[^1] + +proc elementType*(n: PType): PType {.inline.} = n.sons[^1] +proc skipModifier*(n: PType): PType {.inline.} = n.sons[^1] + +proc indexType*(n: PType): PType {.inline.} = n.sons[0] +proc baseClass*(n: PType): PType {.inline.} = n.sons[0] + +proc base*(t: PType): PType {.inline.} = + result = t.sons[0] + +proc returnType*(n: PType): PType {.inline.} = n.sons[0] +proc setReturnType*(n, r: PType) {.inline.} = n.sons[0] = r +proc setIndexType*(n, idx: PType) {.inline.} = n.sons[0] = idx + +proc firstParamType*(n: PType): PType {.inline.} = n.sons[1] +proc firstGenericParam*(n: PType): PType {.inline.} = n.sons[1] + +proc typeBodyImpl*(n: PType): PType {.inline.} = n.sons[^1] + +proc genericHead*(n: PType): PType {.inline.} = n.sons[0] proc skipTypes*(t: PType, kinds: TTypeKinds): PType = ## Used throughout the compiler code to test whether a type tree contains or @@ -1482,7 +1341,7 @@ proc skipTypes*(t: PType, kinds: TTypeKinds): PType = ## last child nodes of a type tree need to be searched. This is a really hot ## path within the compiler! result = t - while result.kind in kinds: result = lastSon(result) + while result.kind in kinds: result = last(result) proc newIntTypeNode*(intVal: BiggestInt, typ: PType): PNode = let kind = skipTypes(typ, abstractVarRange).kind @@ -1541,42 +1400,140 @@ proc `$`*(s: PSym): string = else: result = "<nil>" -iterator items*(t: PType): PType = +when false: + iterator items*(t: PType): PType = + for i in 0..<t.sons.len: yield t.sons[i] + + iterator pairs*(n: PType): tuple[i: int, n: PType] = + for i in 0..<n.sons.len: yield (i, n.sons[i]) + +when true: + proc len*(n: PType): int {.inline.} = + result = n.sons.len + +proc sameTupleLengths*(a, b: PType): bool {.inline.} = + result = a.sons.len == b.sons.len + +iterator tupleTypePairs*(a, b: PType): (int, PType, PType) = + for i in 0 ..< a.sons.len: + yield (i, a.sons[i], b.sons[i]) + +iterator underspecifiedPairs*(a, b: PType; start = 0; without = 0): (PType, PType) = + # XXX Figure out with what typekinds this is called. + for i in start ..< min(a.sons.len, b.sons.len) + without: + yield (a.sons[i], b.sons[i]) + +proc signatureLen*(t: PType): int {.inline.} = + result = t.sons.len + +proc paramsLen*(t: PType): int {.inline.} = + result = t.sons.len - 1 + +proc genericParamsLen*(t: PType): int {.inline.} = + assert t.kind == tyGenericInst + result = t.sons.len - 2 # without 'head' and 'body' + +proc genericInvocationParamsLen*(t: PType): int {.inline.} = + assert t.kind == tyGenericInvocation + result = t.sons.len - 1 # without 'head' + +proc kidsLen*(t: PType): int {.inline.} = + result = t.sons.len + +proc genericParamHasConstraints*(t: PType): bool {.inline.} = t.sons.len > 0 + +proc hasElementType*(t: PType): bool {.inline.} = t.sons.len > 0 +proc isEmptyTupleType*(t: PType): bool {.inline.} = t.sons.len == 0 +proc isSingletonTupleType*(t: PType): bool {.inline.} = t.sons.len == 1 + +proc genericConstraint*(t: PType): PType {.inline.} = t.sons[0] + +iterator genericInstParams*(t: PType): (bool, PType) = + for i in 1..<t.sons.len-1: + yield (i!=1, t.sons[i]) + +iterator genericInstParamPairs*(a, b: PType): (int, PType, PType) = + for i in 1..<min(a.sons.len, b.sons.len)-1: + yield (i-1, a.sons[i], b.sons[i]) + +iterator genericInvocationParams*(t: PType): (bool, PType) = + for i in 1..<t.sons.len: + yield (i!=1, t.sons[i]) + +iterator genericInvocationAndBodyElements*(a, b: PType): (PType, PType) = + for i in 1..<a.sons.len: + yield (a.sons[i], b.sons[i-1]) + +iterator genericInvocationParamPairs*(a, b: PType): (bool, PType, PType) = + for i in 1..<a.sons.len: + if i >= b.sons.len: + yield (false, nil, nil) + else: + yield (true, a.sons[i], b.sons[i]) + +iterator genericBodyParams*(t: PType): (int, PType) = + for i in 0..<t.sons.len-1: + yield (i, t.sons[i]) + +iterator userTypeClassInstParams*(t: PType): (bool, PType) = + for i in 1..<t.sons.len-1: + yield (i!=1, t.sons[i]) + +iterator ikids*(t: PType): (int, PType) = + for i in 0..<t.sons.len: yield (i, t.sons[i]) + +const + FirstParamAt* = 1 + FirstGenericParamAt* = 1 + +iterator paramTypes*(t: PType): (int, PType) = + for i in FirstParamAt..<t.sons.len: yield (i, t.sons[i]) + +iterator paramTypePairs*(a, b: PType): (PType, PType) = + for i in FirstParamAt..<a.sons.len: yield (a.sons[i], b.sons[i]) + +template paramTypeToNodeIndex*(x: int): int = x + +iterator kids*(t: PType): PType = for i in 0..<t.sons.len: yield t.sons[i] -iterator pairs*(n: PType): tuple[i: int, n: PType] = - for i in 0..<n.sons.len: yield (i, n.sons[i]) +iterator signature*(t: PType): PType = + # yields return type + parameter types + for i in 0..<t.sons.len: yield t.sons[i] -proc newType*(kind: TTypeKind, idgen: IdGenerator; owner: PSym, sons: seq[PType] = @[]): PType = +proc newType*(kind: TTypeKind; idgen: IdGenerator; owner: PSym; son: sink PType = nil): PType = let id = nextTypeId idgen result = PType(kind: kind, owner: owner, size: defaultSize, align: defaultAlignment, itemId: id, - uniqueId: id, sons: sons) + uniqueId: id, sons: @[]) + if son != nil: result.sons.add son when false: if result.itemId.module == 55 and result.itemId.item == 2: echo "KNID ", kind writeStackTrace() -template newType*(kind: TTypeKind, id: IdGenerator; owner: PSym, parent: PType): PType = - newType(kind, id, owner, parent.sons) - -proc setSons*(dest: PType; sons: seq[PType]) {.inline.} = dest.sons = sons - -when false: - proc newType*(prev: PType, sons: seq[PType]): PType = - result = prev - result.sons = sons +proc setSons*(dest: PType; sons: sink seq[PType]) {.inline.} = dest.sons = sons +proc setSon*(dest: PType; son: sink PType) {.inline.} = dest.sons = @[son] +proc setSonsLen*(dest: PType; len: int) {.inline.} = setLen(dest.sons, len) proc mergeLoc(a: var TLoc, b: TLoc) = if a.k == low(typeof(a.k)): a.k = b.k if a.storage == low(typeof(a.storage)): a.storage = b.storage a.flags.incl b.flags if a.lode == nil: a.lode = b.lode - if a.r == "": a.r = b.r + if a.snippet == "": a.snippet = b.snippet + +proc newSons*(father: PNode, length: int) = + setLen(father.sons, length) -proc newSons*(father: Indexable, length: int) = +proc newSons*(father: PType, length: int) = setLen(father.sons, length) +proc truncateInferredTypeCandidates*(t: PType) {.inline.} = + assert t.kind == tyInferred + if t.sons.len > 1: + setLen(t.sons, 1) + proc assignType*(dest, src: PType) = dest.kind = src.kind dest.flags = src.flags @@ -1592,8 +1549,8 @@ proc assignType*(dest, src: PType) = mergeLoc(dest.sym.loc, src.sym.loc) else: dest.sym = src.sym - newSons(dest, src.len) - for i in 0..<src.len: dest[i] = src[i] + newSons(dest, src.sons.len) + for i in 0..<src.sons.len: dest[i] = src[i] proc copyType*(t: PType, idgen: IdGenerator, owner: PSym): PType = result = newType(t.kind, idgen, owner) @@ -1639,24 +1596,10 @@ proc initStrTable*(): TStrTable = result = TStrTable(counter: 0) newSeq(result.data, StartSize) -proc initIdTable*(): TIdTable = - result = TIdTable(counter: 0) - newSeq(result.data, StartSize) - -proc resetIdTable*(x: var TIdTable) = - x.counter = 0 - # clear and set to old initial size: - setLen(x.data, 0) - setLen(x.data, StartSize) - proc initObjectSet*(): TObjectSet = result = TObjectSet(counter: 0) newSeq(result.data, StartSize) -proc initIdNodeTable*(): TIdNodeTable = - result = TIdNodeTable(counter: 0) - newSeq(result.data, StartSize) - proc initNodeTable*(): TNodeTable = result = TNodeTable(counter: 0) newSeq(result.data, StartSize) @@ -1665,7 +1608,7 @@ proc skipTypes*(t: PType, kinds: TTypeKinds; maxIters: int): PType = result = t var i = maxIters while result.kind in kinds: - result = lastSon(result) + result = last(result) dec i if i == 0: return nil @@ -1673,8 +1616,8 @@ 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) + if result.sons.len == 0: return nil + result = last(result) proc isGCedMem*(t: PType): bool {.inline.} = result = t.kind in {tyString, tyRef, tySequence} or @@ -1941,13 +1884,15 @@ proc skipGenericOwner*(s: PSym): PSym = ## Generic instantiations are owned by their originating generic ## symbol. This proc skips such owners and goes straight to the owner ## of the generic itself (the module or the enclosing proc). - result = if s.kind in skProcKinds and sfFromGeneric in s.flags and s.owner.kind != skModule: + result = if s.kind == skModule: + s + elif s.kind in skProcKinds and sfFromGeneric in s.flags and s.owner.kind != skModule: s.owner.owner else: s.owner proc originatingModule*(s: PSym): PSym = - result = s.owner + result = s while result.kind != skModule: result = result.owner proc isRoutine*(s: PSym): bool {.inline.} = @@ -1993,23 +1938,21 @@ proc toVar*(typ: PType; kind: TTypeKind; idgen: IdGenerator): PType = ## returned. Otherwise ``typ`` is simply returned as-is. result = typ if typ.kind != kind: - result = newType(kind, idgen, typ.owner) - rawAddSon(result, typ) + result = newType(kind, idgen, typ.owner, typ) proc toRef*(typ: PType; idgen: IdGenerator): PType = ## If ``typ`` is a tyObject then it is converted into a `ref <typ>` and ## returned. Otherwise ``typ`` is simply returned as-is. result = typ if typ.skipTypes({tyAlias, tyGenericInst}).kind == tyObject: - result = newType(tyRef, idgen, typ.owner) - rawAddSon(result, typ) + result = newType(tyRef, idgen, typ.owner, typ) proc toObject*(typ: PType): PType = ## If ``typ`` is a tyRef then its immediate son is returned (which in many ## cases should be a ``tyObject``). ## Otherwise ``typ`` is simply returned as-is. let t = typ.skipTypes({tyAlias, tyGenericInst}) - if t.kind == tyRef: t.lastSon + if t.kind == tyRef: t.elementType else: typ proc toObjectFromRefPtrGeneric*(typ: PType): PType = @@ -2026,7 +1969,7 @@ proc toObjectFromRefPtrGeneric*(typ: PType): PType = result = typ while true: case result.kind - of tyGenericBody: result = result.lastSon + of tyGenericBody: result = result.last of tyRef, tyPtr, tyGenericInst, tyGenericInvocation, tyAlias: result = result[0] # automatic dereferencing is deep, refs #18298. else: break @@ -2039,11 +1982,7 @@ proc isImportedException*(t: PType; conf: ConfigRef): bool = return false let base = t.skipTypes({tyAlias, tyPtr, tyDistinct, tyGenericInst}) - - if base.sym != nil and {sfCompileToCpp, sfImportc} * base.sym.flags != {}: - result = true - else: - result = false + result = base.sym != nil and {sfCompileToCpp, sfImportc} * base.sym.flags != {} proc isInfixAs*(n: PNode): bool = return n.kind == nkInfix and n[0].kind == nkIdent and n[0].ident.id == ord(wAs) @@ -2058,7 +1997,7 @@ proc findUnresolvedStatic*(n: PNode): PNode = return n if n.typ != nil and n.typ.kind == tyTypeDesc: let t = skipTypes(n.typ, {tyTypeDesc}) - if t.kind == tyGenericParam and t.len == 0: + if t.kind == tyGenericParam and not t.genericParamHasConstraints: return n for son in n: let n = son.findUnresolvedStatic @@ -2119,7 +2058,7 @@ proc newProcType*(info: TLineInfo; idgen: IdGenerator; owner: PSym): PType = result.n.add newNodeI(nkEffectList, info) proc addParam*(procType: PType; param: PSym) = - param.position = procType.len-1 + param.position = procType.sons.len-1 procType.n.add newSymNode(param) rawAddSon(procType, param.typ) @@ -2181,3 +2120,16 @@ const proc isTrue*(n: PNode): bool = n.kind == nkSym and n.sym.kind == skEnumField and n.sym.position != 0 or n.kind == nkIntLit and n.intVal != 0 + +type + TypeMapping* = Table[ItemId, PType] + SymMapping* = Table[ItemId, PSym] + +template idTableGet*(tab: typed; key: PSym | PType): untyped = tab.getOrDefault(key.itemId) +template idTablePut*(tab: typed; key, val: PSym | PType) = tab[key.itemId] = val + +template initSymMapping*(): Table[ItemId, PSym] = initTable[ItemId, PSym]() +template initTypeMapping*(): Table[ItemId, PType] = initTable[ItemId, PType]() + +template resetIdTable*(tab: Table[ItemId, PSym]) = tab.clear() +template resetIdTable*(tab: Table[ItemId, PType]) = tab.clear() diff --git a/compiler/astalgo.nim b/compiler/astalgo.nim index cd772f0f1..7a9892f78 100644 --- a/compiler/astalgo.nim +++ b/compiler/astalgo.nim @@ -12,24 +12,18 @@ # the data structures here are used in various places of the compiler. import - ast, options, lineinfos, ropes, idents, rodutils, + ast, astyaml, options, lineinfos, idents, rodutils, msgs import std/[hashes, intsets] import std/strutils except addf +export astyaml.treeToYaml, astyaml.typeToYaml, astyaml.symToYaml, astyaml.lineInfoToStr + when defined(nimPreviewSlimSystem): import std/assertions proc hashNode*(p: RootRef): Hash -proc treeToYaml*(conf: ConfigRef; 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*(conf: ConfigRef; n: PType, indent: int = 0, maxRecDepth: int = - 1): Rope -proc symToYaml*(conf: ConfigRef; n: PSym, indent: int = 0, maxRecDepth: int = - 1): Rope -proc lineInfoToStr*(conf: ConfigRef; info: TLineInfo): Rope - # these are for debugging only: They are not really deprecated, but I want # the warning so that release versions do not contain debugging statements: @@ -37,15 +31,6 @@ proc debug*(n: PSym; conf: ConfigRef = nil) {.exportc: "debugSym", deprecated.} proc debug*(n: PType; conf: ConfigRef = nil) {.exportc: "debugType", deprecated.} proc debug*(n: PNode; conf: ConfigRef = nil) {.exportc: "debugNode", deprecated.} -proc typekinds*(t: PType) {.deprecated.} = - var t = t - var s = "" - while t != nil and t.len > 0: - s.add $t.kind - s.add " " - t = t.lastSon - echo s - template debug*(x: PSym|PType|PNode) {.deprecated.} = when compiles(c.config): debug(c.config, x) @@ -80,16 +65,6 @@ template mdbg*: bool {.deprecated.} = else: error() -# --------------------------- ident tables ---------------------------------- -proc idTableGet*(t: TIdTable, key: PIdObj): RootRef -proc idTableGet*(t: TIdTable, key: int): RootRef -proc idTablePut*(t: var TIdTable, key: PIdObj, val: RootRef) -proc idTableHasObjectAsKey*(t: TIdTable, key: PIdObj): bool - # checks if `t` contains the `key` (compared by the pointer value, not only - # `key`'s id) -proc idNodeTableGet*(t: TIdNodeTable, key: PIdObj): PNode -proc idNodeTablePut*(t: var TIdNodeTable, key: PIdObj, val: PNode) - # --------------------------------------------------------------------------- proc lookupInRecord*(n: PNode, field: PIdent): PSym @@ -245,170 +220,6 @@ proc mustRehash(length, counter: int): bool = assert(length > counter) result = (length * 2 < counter * 3) or (length - counter < 4) -proc rspaces(x: int): Rope = - # returns x spaces - result = rope(spaces(x)) - -proc toYamlChar(c: char): string = - case c - of '\0'..'\x1F', '\x7F'..'\xFF': result = "\\u" & strutils.toHex(ord(c), 4) - of '\'', '\"', '\\': result = '\\' & c - else: result = $c - -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 = "" - var res = "\"" - for i in 0..<s.len: - if (i + 1) mod MaxLineLength == 0: - res.add('\"') - res.add("\n") - result.add(rope(res)) - res = "\"" # reset - res.add(toYamlChar(s[i])) - res.add('\"') - result.add(rope(res)) - -proc flagsToStr[T](flags: set[T]): Rope = - if flags == {}: - result = rope("[]") - else: - result = "" - for x in items(flags): - if result != "": result.add(", ") - result.add(makeYamlString($x)) - result = "[" & result & "]" - -proc lineInfoToStr(conf: ConfigRef; info: TLineInfo): Rope = - result = "[$1, $2, $3]" % [makeYamlString(toFilename(conf, info)), - rope(toLinenumber(info)), - rope(toColumn(info))] - -proc treeToYamlAux(conf: ConfigRef; n: PNode, marker: var IntSet, - indent, maxRecDepth: int): Rope -proc symToYamlAux(conf: ConfigRef; n: PSym, marker: var IntSet, - indent, maxRecDepth: int): Rope -proc typeToYamlAux(conf: ConfigRef; n: PType, marker: var IntSet, - indent, maxRecDepth: int): Rope - -proc symToYamlAux(conf: ConfigRef; n: PSym, marker: var IntSet, indent: int, - maxRecDepth: int): Rope = - if n == nil: - result = rope("null") - elif containsOrIncl(marker, n.id): - result = "\"$1\"" % [rope(n.name.s)] - else: - var ast = treeToYamlAux(conf, n.ast, marker, indent + 2, maxRecDepth - 1) - #rope("typ"), typeToYamlAux(conf, n.typ, marker, - # indent + 2, maxRecDepth - 1), - let istr = rspaces(indent + 2) - result = rope("{") - result.addf("$N$1\"kind\": $2", [istr, makeYamlString($n.kind)]) - result.addf("$N$1\"name\": $2", [istr, makeYamlString(n.name.s)]) - result.addf("$N$1\"typ\": $2", [istr, typeToYamlAux(conf, n.typ, marker, indent + 2, maxRecDepth - 1)]) - if conf != nil: - # if we don't pass the config, we probably don't care about the line info - result.addf("$N$1\"info\": $2", [istr, lineInfoToStr(conf, n.info)]) - if card(n.flags) > 0: - result.addf("$N$1\"flags\": $2", [istr, flagsToStr(n.flags)]) - result.addf("$N$1\"magic\": $2", [istr, makeYamlString($n.magic)]) - result.addf("$N$1\"ast\": $2", [istr, ast]) - result.addf("$N$1\"options\": $2", [istr, flagsToStr(n.options)]) - result.addf("$N$1\"position\": $2", [istr, rope(n.position)]) - result.addf("$N$1\"k\": $2", [istr, makeYamlString($n.loc.k)]) - result.addf("$N$1\"storage\": $2", [istr, makeYamlString($n.loc.storage)]) - if card(n.loc.flags) > 0: - result.addf("$N$1\"flags\": $2", [istr, makeYamlString($n.loc.flags)]) - result.addf("$N$1\"r\": $2", [istr, n.loc.r]) - result.addf("$N$1\"lode\": $2", [istr, treeToYamlAux(conf, n.loc.lode, marker, indent + 2, maxRecDepth - 1)]) - result.addf("$N$1}", [rspaces(indent)]) - -proc typeToYamlAux(conf: ConfigRef; n: PType, marker: var IntSet, indent: int, - maxRecDepth: int): Rope = - var sonsRope: Rope - if n == nil: - result = "" - sonsRope = rope("null") - elif containsOrIncl(marker, n.id): - result = "" - sonsRope = "\"$1 @$2\"" % [rope($n.kind), rope( - strutils.toHex(cast[int](n), sizeof(n) * 2))] - else: - if n.len > 0: - sonsRope = rope("[") - for i in 0..<n.len: - if i > 0: sonsRope.add(",") - sonsRope.addf("$N$1$2", [rspaces(indent + 4), typeToYamlAux(conf, n[i], - marker, indent + 4, maxRecDepth - 1)]) - sonsRope.addf("$N$1]", [rspaces(indent + 2)]) - else: - sonsRope = rope("null") - - let istr = rspaces(indent + 2) - result = rope("{") - result.addf("$N$1\"kind\": $2", [istr, makeYamlString($n.kind)]) - result.addf("$N$1\"sym\": $2", [istr, symToYamlAux(conf, n.sym, marker, indent + 2, maxRecDepth - 1)]) - result.addf("$N$1\"n\": $2", [istr, treeToYamlAux(conf, n.n, marker, indent + 2, maxRecDepth - 1)]) - if card(n.flags) > 0: - result.addf("$N$1\"flags\": $2", [istr, flagsToStr(n.flags)]) - result.addf("$N$1\"callconv\": $2", [istr, makeYamlString($n.callConv)]) - result.addf("$N$1\"size\": $2", [istr, rope(n.size)]) - result.addf("$N$1\"align\": $2", [istr, rope(n.align)]) - result.addf("$N$1\"sons\": $2", [istr, sonsRope]) - -proc treeToYamlAux(conf: ConfigRef; n: PNode, marker: var IntSet, indent: int, - maxRecDepth: int): Rope = - if n == nil: - result = rope("null") - else: - var istr = rspaces(indent + 2) - result = "{$N$1\"kind\": $2" % [istr, makeYamlString($n.kind)] - if maxRecDepth != 0: - if conf != nil: - result.addf(",$N$1\"info\": $2", [istr, lineInfoToStr(conf, n.info)]) - case n.kind - of nkCharLit..nkUInt64Lit: - result.addf(",$N$1\"intVal\": $2", [istr, rope(n.intVal)]) - of nkFloatLit, nkFloat32Lit, nkFloat64Lit: - result.addf(",$N$1\"floatVal\": $2", - [istr, rope(n.floatVal.toStrMaxPrecision)]) - of nkStrLit..nkTripleStrLit: - result.addf(",$N$1\"strVal\": $2", [istr, makeYamlString(n.strVal)]) - of nkSym: - result.addf(",$N$1\"sym\": $2", - [istr, symToYamlAux(conf, n.sym, marker, indent + 2, maxRecDepth)]) - of nkIdent: - if n.ident != nil: - result.addf(",$N$1\"ident\": $2", [istr, makeYamlString(n.ident.s)]) - else: - result.addf(",$N$1\"ident\": null", [istr]) - else: - if n.len > 0: - result.addf(",$N$1\"sons\": [", [istr]) - for i in 0..<n.len: - if i > 0: result.add(",") - result.addf("$N$1$2", [rspaces(indent + 4), treeToYamlAux(conf, n[i], - marker, indent + 4, maxRecDepth - 1)]) - result.addf("$N$1]", [istr]) - result.addf(",$N$1\"typ\": $2", - [istr, typeToYamlAux(conf, n.typ, marker, indent + 2, maxRecDepth)]) - result.addf("$N$1}", [rspaces(indent)]) - -proc treeToYaml(conf: ConfigRef; n: PNode, indent: int = 0, maxRecDepth: int = - 1): Rope = - var marker = initIntSet() - result = treeToYamlAux(conf, n, marker, indent, maxRecDepth) - -proc typeToYaml(conf: ConfigRef; n: PType, indent: int = 0, maxRecDepth: int = - 1): Rope = - var marker = initIntSet() - result = typeToYamlAux(conf, n, marker, indent, maxRecDepth) - -proc symToYaml(conf: ConfigRef; n: PSym, indent: int = 0, maxRecDepth: int = - 1): Rope = - var marker = initIntSet() - result = symToYamlAux(conf, n, marker, indent, maxRecDepth) - import std/tables const backrefStyle = "\e[90m" @@ -573,14 +384,12 @@ proc value(this: var DebugPrinter; value: PType) = this.key "n" this.value value.n - if value.len > 0: - this.key "sons" - this.openBracket - for i in 0..<value.len: - this.value value[i] - if i != value.len - 1: - this.comma - this.closeBracket + this.key "sons" + this.openBracket + for i, a in value.ikids: + if i > 0: this.comma + this.value a + this.closeBracket if value.n != nil: this.key "n" @@ -649,30 +458,33 @@ proc value(this: var DebugPrinter; value: PNode) = proc debug(n: PSym; conf: ConfigRef) = - var this: DebugPrinter - this.visited = initTable[pointer, int]() - this.renderSymType = true - this.useColor = not defined(windows) + var this = DebugPrinter( + visited: initTable[pointer, int](), + renderSymType: true, + useColor: not defined(windows) + ) this.value(n) echo($this.res) proc debug(n: PType; conf: ConfigRef) = - var this: DebugPrinter - this.visited = initTable[pointer, int]() - this.renderSymType = true - this.useColor = not defined(windows) + var this = DebugPrinter( + visited: initTable[pointer, int](), + renderSymType: true, + useColor: not defined(windows) + ) this.value(n) echo($this.res) proc debug(n: PNode; conf: ConfigRef) = - var this: DebugPrinter - this.visited = initTable[pointer, int]() - #this.renderSymType = true - this.useColor = not defined(windows) + var this = DebugPrinter( + visited: initTable[pointer, int](), + renderSymType: false, + useColor: not defined(windows) + ) this.value(n) echo($this.res) -proc nextTry(h, maxHash: Hash): Hash = +proc nextTry(h, maxHash: Hash): Hash {.inline.} = 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 @@ -895,125 +707,12 @@ proc initTabIter*(ti: var TTabIter, tab: TStrTable): PSym = result = nextIter(ti, tab) iterator items*(tab: TStrTable): PSym = - var it: TTabIter + var it: TTabIter = default(TTabIter) var s = initTabIter(it, tab) while s != nil: yield s s = nextIter(it, tab) -proc hasEmptySlot(data: TIdPairSeq): bool = - for h in 0..high(data): - if data[h].key == nil: - return true - result = false - -proc idTableRawGet(t: TIdTable, key: int): int = - var h: Hash - h = key and high(t.data) # start with real hash value - 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 = - 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 = - var index = idTableRawGet(t, key.id) - if index >= 0: result = t.data[index].val - else: result = nil - -proc idTableGet(t: TIdTable, key: int): RootRef = - var index = idTableRawGet(t, key) - if index >= 0: result = t.data[index].val - else: result = nil - -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) = - var h: Hash - h = key.id and high(data) - 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 - index: int - n: TIdPairSeq - index = idTableRawGet(t, key.id) - if index >= 0: - assert(t.data[index].key != nil) - t.data[index].val = val - else: - if mustRehash(t.data.len, t.counter): - newSeq(n, t.data.len * GrowthFactor) - for i in 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) - idTableRawInsert(t.data, key, val) - inc(t.counter) - -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 = - var h: Hash - h = key.id and high(t.data) # start with real hash value - while t.data[h].key != nil: - if t.data[h].key.id == key.id: - return h - h = nextTry(h, high(t.data)) - result = - 1 - -proc idNodeTableGet(t: TIdNodeTable, key: PIdObj): PNode = - var index: int - index = idNodeTableRawGet(t, key) - if index >= 0: result = t.data[index].val - else: result = nil - -proc idNodeTableRawInsert(data: var TIdNodePairSeq, key: PIdObj, val: PNode) = - var h: Hash - h = key.id and high(data) - 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) = - var index = idNodeTableRawGet(t, key) - if index >= 0: - assert(t.data[index].key != nil) - t.data[index].val = val - else: - if mustRehash(t.data.len, t.counter): - var n: TIdNodePairSeq - newSeq(n, t.data.len * GrowthFactor) - for i in 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) - inc(t.counter) - -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) = x.counter = 0 newSeq(x.data, StartSize) @@ -1059,14 +758,6 @@ proc iiTablePut(t: var TIITable, key, val: int) = iiTableRawInsert(t.data, key, val) inc(t.counter) -proc isAddrNode*(n: PNode): bool = - case n.kind - of nkAddr, nkHiddenAddr: true - of nkCallKinds: - if n[0].kind == nkSym and n[0].sym.magic == mAddr: true - else: false - else: false - proc listSymbolNames*(symbols: openArray[PSym]): string = result = "" for sym in symbols: diff --git a/compiler/astmsgs.nim b/compiler/astmsgs.nim index a9027126a..aeeff1fd0 100644 --- a/compiler/astmsgs.nim +++ b/compiler/astmsgs.nim @@ -5,7 +5,7 @@ import options, ast, msgs proc typSym*(t: PType): PSym = result = t.sym if result == nil and t.kind == tyGenericInst: # this might need to be refined - result = t[0].sym + result = t.genericHead.sym proc addDeclaredLoc*(result: var string, conf: ConfigRef; sym: PSym) = result.add " [$1 declared in $2]" % [sym.kind.toHumanStr, toFileLineCol(conf, sym.info)] @@ -24,6 +24,12 @@ proc addDeclaredLoc*(result: var string, conf: ConfigRef; typ: PType) = result.add " declared in " & toFileLineCol(conf, typ.sym.info) result.add "]" +proc addTypeNodeDeclaredLoc*(result: var string, conf: ConfigRef; typ: PType) = + result.add " [$1" % typ.kind.toHumanStr + if typ.sym != nil: + result.add " declared in " & toFileLineCol(conf, typ.sym.info) + result.add "]" + proc addDeclaredLocMaybe*(result: var string, conf: ConfigRef; typ: PType) = if optDeclaredLocs in conf.globalOptions: addDeclaredLoc(result, conf, typ) diff --git a/compiler/astyaml.nim b/compiler/astyaml.nim new file mode 100644 index 000000000..b0fa2bfb2 --- /dev/null +++ b/compiler/astyaml.nim @@ -0,0 +1,154 @@ +# +# +# The Nim Compiler +# (c) Copyright 2012 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +# AST YAML printing + +import "."/[ast, lineinfos, msgs, options, rodutils] +import std/[intsets, strutils] + +proc addYamlString*(res: var string; s: string) = + res.add "\"" + for c in s: + case c + of '\0' .. '\x1F', '\x7F' .. '\xFF': + res.add("\\u" & strutils.toHex(ord(c), 4)) + of '\"', '\\': + res.add '\\' & c + else: + res.add c + + res.add('\"') + +proc makeYamlString(s: string): string = + result = "" + result.addYamlString(s) + +proc flagsToStr[T](flags: set[T]): string = + if flags == {}: + result = "[]" + else: + result = "" + for x in items(flags): + if result != "": + result.add(", ") + result.addYamlString($x) + result = "[" & result & "]" + +proc lineInfoToStr*(conf: ConfigRef; info: TLineInfo): string = + result = "[" + result.addYamlString(toFilename(conf, info)) + result.addf ", $1, $2]", [toLinenumber(info), toColumn(info)] + +proc treeToYamlAux(res: var string; conf: ConfigRef; n: PNode; marker: var IntSet; indent, maxRecDepth: int) +proc symToYamlAux(res: var string; conf: ConfigRef; n: PSym; marker: var IntSet; indent, maxRecDepth: int) +proc typeToYamlAux(res: var string; conf: ConfigRef; n: PType; marker: var IntSet; indent, maxRecDepth: int) + +proc symToYamlAux(res: var string; conf: ConfigRef; n: PSym; marker: var IntSet; indent: int; maxRecDepth: int) = + if n == nil: + res.add("null") + elif containsOrIncl(marker, n.id): + res.addYamlString(n.name.s) + else: + let istr = spaces(indent * 4) + + res.addf("kind: $1", [makeYamlString($n.kind)]) + res.addf("\n$1name: $2", [istr, makeYamlString(n.name.s)]) + res.addf("\n$1typ: ", [istr]) + res.typeToYamlAux(conf, n.typ, marker, indent + 1, maxRecDepth - 1) + if conf != nil: + # if we don't pass the config, we probably don't care about the line info + res.addf("\n$1info: $2", [istr, lineInfoToStr(conf, n.info)]) + if card(n.flags) > 0: + res.addf("\n$1flags: $2", [istr, flagsToStr(n.flags)]) + res.addf("\n$1magic: $2", [istr, makeYamlString($n.magic)]) + res.addf("\n$1ast: ", [istr]) + res.treeToYamlAux(conf, n.ast, marker, indent + 1, maxRecDepth - 1) + res.addf("\n$1options: $2", [istr, flagsToStr(n.options)]) + res.addf("\n$1position: $2", [istr, $n.position]) + res.addf("\n$1k: $2", [istr, makeYamlString($n.loc.k)]) + res.addf("\n$1storage: $2", [istr, makeYamlString($n.loc.storage)]) + if card(n.loc.flags) > 0: + res.addf("\n$1flags: $2", [istr, makeYamlString($n.loc.flags)]) + res.addf("\n$1snippet: $2", [istr, n.loc.snippet]) + res.addf("\n$1lode: $2", [istr]) + res.treeToYamlAux(conf, n.loc.lode, marker, indent + 1, maxRecDepth - 1) + +proc typeToYamlAux(res: var string; conf: ConfigRef; n: PType; marker: var IntSet; indent: int; maxRecDepth: int) = + if n == nil: + res.add("null") + elif containsOrIncl(marker, n.id): + res.addf "\"$1 @$2\"" % [$n.kind, strutils.toHex(cast[uint](n), sizeof(n) * 2)] + else: + let istr = spaces(indent * 4) + res.addf("kind: $2", [istr, makeYamlString($n.kind)]) + res.addf("\n$1sym: ") + res.symToYamlAux(conf, n.sym, marker, indent + 1, maxRecDepth - 1) + res.addf("\n$1n: ") + res.treeToYamlAux(conf, n.n, marker, indent + 1, maxRecDepth - 1) + if card(n.flags) > 0: + res.addf("\n$1flags: $2", [istr, flagsToStr(n.flags)]) + res.addf("\n$1callconv: $2", [istr, makeYamlString($n.callConv)]) + res.addf("\n$1size: $2", [istr, $(n.size)]) + res.addf("\n$1align: $2", [istr, $(n.align)]) + if n.hasElementType: + res.addf("\n$1sons:") + for a in n.kids: + res.addf("\n - ") + res.typeToYamlAux(conf, a, marker, indent + 1, maxRecDepth - 1) + +proc treeToYamlAux(res: var string; conf: ConfigRef; n: PNode; marker: var IntSet; indent: int; + maxRecDepth: int) = + if n == nil: + res.add("null") + else: + var istr = spaces(indent * 4) + res.addf("kind: $1" % [makeYamlString($n.kind)]) + + if maxRecDepth != 0: + if conf != nil: + res.addf("\n$1info: $2", [istr, lineInfoToStr(conf, n.info)]) + case n.kind + of nkCharLit .. nkInt64Lit: + res.addf("\n$1intVal: $2", [istr, $(n.intVal)]) + of nkFloatLit, nkFloat32Lit, nkFloat64Lit: + res.addf("\n$1floatVal: $2", [istr, n.floatVal.toStrMaxPrecision]) + of nkStrLit .. nkTripleStrLit: + res.addf("\n$1strVal: $2", [istr, makeYamlString(n.strVal)]) + of nkSym: + res.addf("\n$1sym: ", [istr]) + res.symToYamlAux(conf, n.sym, marker, indent + 1, maxRecDepth) + of nkIdent: + if n.ident != nil: + res.addf("\n$1ident: $2", [istr, makeYamlString(n.ident.s)]) + else: + res.addf("\n$1ident: null", [istr]) + else: + if n.len > 0: + res.addf("\n$1sons: ", [istr]) + for i in 0 ..< n.len: + res.addf("\n$1 - ", [istr]) + res.treeToYamlAux(conf, n[i], marker, indent + 1, maxRecDepth - 1) + if n.typ != nil: + res.addf("\n$1typ: ", [istr]) + res.typeToYamlAux(conf, n.typ, marker, indent + 1, maxRecDepth) + +proc treeToYaml*(conf: ConfigRef; n: PNode; indent: int = 0; maxRecDepth: int = -1): string = + var marker = initIntSet() + result = newStringOfCap(1024) + result.treeToYamlAux(conf, n, marker, indent, maxRecDepth) + +proc typeToYaml*(conf: ConfigRef; n: PType; indent: int = 0; maxRecDepth: int = -1): string = + var marker = initIntSet() + result = newStringOfCap(1024) + result.typeToYamlAux(conf, n, marker, indent, maxRecDepth) + +proc symToYaml*(conf: ConfigRef; n: PSym; indent: int = 0; maxRecDepth: int = -1): string = + var marker = initIntSet() + result = newStringOfCap(1024) + result.symToYamlAux(conf, n, marker, indent, maxRecDepth) diff --git a/compiler/backendpragmas.nim b/compiler/backendpragmas.nim deleted file mode 100644 index b18644810..000000000 --- a/compiler/backendpragmas.nim +++ /dev/null @@ -1,25 +0,0 @@ -import pragmas, options, ast, trees - -proc pushBackendOption(optionsStack: var seq[TOptions], options: var TOptions) = - optionsStack.add options - -proc popBackendOption(optionsStack: var seq[TOptions], options: var TOptions) = - options = optionsStack[^1] - optionsStack.setLen(optionsStack.len-1) - -proc processPushBackendOption*(optionsStack: var seq[TOptions], options: var TOptions, - n: PNode, start: int) = - pushBackendOption(optionsStack, options) - for i in start..<n.len: - let it = n[i] - if it.kind in nkPragmaCallKinds and it.len == 2 and it[1].kind == nkIntLit: - let sw = whichPragma(it[0]) - let opts = pragmaToOptions(sw) - if opts != {}: - if it[1].intVal != 0: - options.incl opts - else: - options.excl opts - -template processPopBackendOption*(optionsStack: var seq[TOptions], options: var TOptions) = - popBackendOption(optionsStack, options) diff --git a/compiler/cbuilder.nim b/compiler/cbuilder.nim new file mode 100644 index 000000000..bb1bdfe27 --- /dev/null +++ b/compiler/cbuilder.nim @@ -0,0 +1,174 @@ +type + Snippet = string + Builder = string + +template newBuilder(s: string): Builder = + s + +proc addField(obj: var Builder; name, typ: Snippet; isFlexArray: bool = false; initializer: Snippet = "") = + obj.add('\t') + obj.add(typ) + obj.add(" ") + obj.add(name) + if isFlexArray: + obj.add("[SEQ_DECL_SIZE]") + if initializer.len != 0: + obj.add(initializer) + obj.add(";\n") + +proc addField(obj: var Builder; field: PSym; name, typ: Snippet; isFlexArray: bool = false; initializer: Snippet = "") = + ## for fields based on an `skField` symbol + obj.add('\t') + if field.alignment > 0: + obj.add("NIM_ALIGN(") + obj.addInt(field.alignment) + obj.add(") ") + obj.add(typ) + if sfNoalias in field.flags: + obj.add(" NIM_NOALIAS") + obj.add(" ") + obj.add(name) + if isFlexArray: + obj.add("[SEQ_DECL_SIZE]") + if field.bitsize != 0: + obj.add(":") + obj.addInt(field.bitsize) + if initializer.len != 0: + obj.add(initializer) + obj.add(";\n") + +type + BaseClassKind = enum + bcNone, bcCppInherit, bcSupField, bcNoneRtti, bcNoneTinyRtti + StructBuilderInfo = object + baseKind: BaseClassKind + preFieldsLen: int + +proc structOrUnion(t: PType): Snippet = + let t = t.skipTypes({tyAlias, tySink}) + if tfUnion in t.flags: "union" + else: "struct" + +proc ptrType(t: Snippet): Snippet = + t & "*" + +proc startSimpleStruct(obj: var Builder; m: BModule; name: string; baseType: Snippet): StructBuilderInfo = + result = StructBuilderInfo(baseKind: bcNone) + obj.add("struct ") + obj.add(name) + if baseType.len != 0: + if m.compileToCpp: + result.baseKind = bcCppInherit + else: + result.baseKind = bcSupField + if result.baseKind == bcCppInherit: + obj.add(" : public ") + obj.add(baseType) + obj.add(" ") + obj.add("{\n") + result.preFieldsLen = obj.len + if result.baseKind == bcSupField: + obj.addField(name = "Sup", typ = baseType) + +proc finishSimpleStruct(obj: var Builder; m: BModule; info: StructBuilderInfo) = + if info.baseKind == bcNone and info.preFieldsLen == obj.len: + # no fields were added, add dummy field + obj.addField(name = "dummy", typ = "char") + obj.add("};\n") + +template addSimpleStruct(obj: var Builder; m: BModule; name: string; baseType: Snippet; body: typed) = + ## for independent structs, not directly based on a Nim type + let info = startSimpleStruct(obj, m, name, baseType) + body + finishSimpleStruct(obj, m, info) + +proc startStruct(obj: var Builder; m: BModule; t: PType; name: string; baseType: Snippet): StructBuilderInfo = + result = StructBuilderInfo(baseKind: bcNone) + if tfPacked in t.flags: + if hasAttribute in CC[m.config.cCompiler].props: + obj.add(structOrUnion(t)) + obj.add(" __attribute__((__packed__))") + else: + obj.add("#pragma pack(push, 1)\n") + obj.add(structOrUnion(t)) + else: + obj.add(structOrUnion(t)) + obj.add(" ") + obj.add(name) + if t.kind == tyObject: + if t.baseClass == nil: + if lacksMTypeField(t): + result.baseKind = bcNone + elif optTinyRtti in m.config.globalOptions: + result.baseKind = bcNoneTinyRtti + else: + result.baseKind = bcNoneRtti + elif m.compileToCpp: + result.baseKind = bcCppInherit + else: + result.baseKind = bcSupField + elif baseType.len != 0: + if m.compileToCpp: + result.baseKind = bcCppInherit + else: + result.baseKind = bcSupField + if result.baseKind == bcCppInherit: + obj.add(" : public ") + obj.add(baseType) + obj.add(" ") + obj.add("{\n") + result.preFieldsLen = obj.len + case result.baseKind + of bcNone: + # rest of the options add a field or don't need it due to inheritance, + # we need to add the dummy field for uncheckedarray ahead of time + # so that it remains trailing + if t.itemId notin m.g.graph.memberProcsPerType and + t.n != nil and t.n.len == 1 and t.n[0].kind == nkSym and + t.n[0].sym.typ.skipTypes(abstractInst).kind == tyUncheckedArray: + # only consists of flexible array field, add *initial* dummy field + obj.addField(name = "dummy", typ = "char") + of bcCppInherit: discard + of bcNoneRtti: + obj.addField(name = "m_type", typ = ptrType(cgsymValue(m, "TNimType"))) + of bcNoneTinyRtti: + obj.addField(name = "m_type", typ = ptrType(cgsymValue(m, "TNimTypeV2"))) + of bcSupField: + obj.addField(name = "Sup", typ = baseType) + +proc finishStruct(obj: var Builder; m: BModule; t: PType; info: StructBuilderInfo) = + if info.baseKind == bcNone and info.preFieldsLen == obj.len and + t.itemId notin m.g.graph.memberProcsPerType: + # no fields were added, add dummy field + obj.addField(name = "dummy", typ = "char") + obj.add("};\n") + if tfPacked in t.flags and hasAttribute notin CC[m.config.cCompiler].props: + obj.add("#pragma pack(pop)\n") + +template addStruct(obj: var Builder; m: BModule; typ: PType; name: string; baseType: Snippet; body: typed) = + ## for structs built directly from a Nim type + let info = startStruct(obj, m, typ, name, baseType) + body + finishStruct(obj, m, typ, info) + +template addFieldWithStructType(obj: var Builder; m: BModule; parentTyp: PType; fieldName: string, body: typed) = + ## adds a field with a `struct { ... }` type, building it according to `body` + obj.add('\t') + if tfPacked in parentTyp.flags: + if hasAttribute in CC[m.config.cCompiler].props: + obj.add("struct __attribute__((__packed__)) {\n") + else: + obj.add("#pragma pack(push, 1)\nstruct {") + else: + obj.add("struct {\n") + body + obj.add("} ") + obj.add(fieldName) + obj.add(";\n") + if tfPacked in parentTyp.flags and hasAttribute notin CC[m.config.cCompiler].props: + result.add("#pragma pack(pop)\n") + +template addAnonUnion(obj: var Builder; body: typed) = + obj.add "union{\n" + body + obj.add("};\n") diff --git a/compiler/ccgcalls.nim b/compiler/ccgcalls.nim index ad84be3f9..ac607e3ad 100644 --- a/compiler/ccgcalls.nim +++ b/compiler/ccgcalls.nim @@ -76,6 +76,23 @@ proc isHarmlessStore(p: BProc; canRaise: bool; d: TLoc): bool = else: result = false +proc cleanupTemp(p: BProc; returnType: PType, tmp: TLoc): bool = + if returnType.kind in {tyVar, tyLent}: + # we don't need to worry about var/lent return types + result = false + elif hasDestructor(returnType) and getAttachedOp(p.module.g.graph, returnType, attachedDestructor) != nil: + let dtor = getAttachedOp(p.module.g.graph, returnType, attachedDestructor) + var op = initLocExpr(p, newSymNode(dtor)) + var callee = rdLoc(op) + let destroy = if dtor.typ.firstParamType.kind == tyVar: + callee & "(&" & rdLoc(tmp) & ")" + else: + callee & "(" & rdLoc(tmp) & ")" + raiseExitCleanup(p, destroy) + result = true + else: + result = false + proc fixupCall(p: BProc, le, ri: PNode, d: var TLoc, callee, params: Rope) = let canRaise = p.config.exc == excGoto and canRaiseDisp(p, ri[0]) @@ -83,13 +100,17 @@ proc fixupCall(p: BProc, le, ri: PNode, d: var TLoc, var pl = callee & "(" & params # getUniqueType() is too expensive here: var typ = skipTypes(ri[0].typ, abstractInst) - if typ[0] != nil: + if typ.returnType != nil: + var flags: TAssignmentFlags = {} + if typ.returnType.kind in {tyOpenArray, tyVarargs}: + # perhaps generate no temp if the call doesn't have side effects + flags.incl needTempForOpenArray if isInvalidReturnType(p.config, typ): if params.len != 0: pl.add(", ") # beware of 'result = p(result)'. We may need to allocate a temporary: if d.k in {locTemp, locNone} or not preventNrvo(p, d.lode, le, ri): # Great, we can use 'd': - if d.k == locNone: d = getTemp(p, typ[0], needsInit=true) + if d.k == locNone: d = getTemp(p, typ.returnType, needsInit=true) elif d.k notin {locTemp} and not hasNoInit(ri): # reset before pass as 'result' var: discard "resetLoc(p, d)" @@ -97,7 +118,7 @@ proc fixupCall(p: BProc, le, ri: PNode, d: var TLoc, pl.add(");\n") line(p, cpsStmts, pl) else: - var tmp: TLoc = getTemp(p, typ[0], needsInit=true) + var tmp: TLoc = getTemp(p, typ.returnType, needsInit=true) pl.add(addrLoc(p.config, tmp)) pl.add(");\n") line(p, cpsStmts, pl) @@ -111,43 +132,56 @@ proc fixupCall(p: BProc, le, ri: PNode, d: var TLoc, # with them to prevent undefined behaviour and because the codegen # is free to emit expressions multiple times! d.k = locCall - d.r = pl + d.snippet = pl excl d.flags, lfSingleUse else: if d.k == locNone and p.splitDecls == 0: - d = getTempCpp(p, typ[0], pl) + d = getTempCpp(p, typ.returnType, pl) else: - if d.k == locNone: d = getTemp(p, typ[0]) + if d.k == locNone: d = getTemp(p, typ.returnType) var list = initLoc(locCall, d.lode, OnUnknown) - list.r = pl - genAssignment(p, d, list, {}) # no need for deep copying + list.snippet = pl + genAssignment(p, d, list, {needAssignCall}) # no need for deep copying if canRaise: raiseExit(p) elif isHarmlessStore(p, canRaise, d): - if d.k == locNone: d = getTemp(p, typ[0]) + var useTemp = false + if d.k == locNone: + useTemp = true + d = getTemp(p, typ.returnType) assert(d.t != nil) # generate an assignment to d: var list = initLoc(locCall, d.lode, OnUnknown) - list.r = pl - genAssignment(p, d, list, {}) # no need for deep copying - if canRaise: raiseExit(p) + list.snippet = pl + genAssignment(p, d, list, flags+{needAssignCall}) # no need for deep copying + if canRaise: + if not (useTemp and cleanupTemp(p, typ.returnType, d)): + raiseExit(p) else: - var tmp: TLoc = getTemp(p, typ[0], needsInit=true) + var tmp: TLoc = getTemp(p, typ.returnType, needsInit=true) var list = initLoc(locCall, d.lode, OnUnknown) - list.r = pl - genAssignment(p, tmp, list, {}) # no need for deep copying - if canRaise: raiseExit(p) + list.snippet = pl + genAssignment(p, tmp, list, flags+{needAssignCall}) # no need for deep copying + if canRaise: + if not cleanupTemp(p, typ.returnType, tmp): + raiseExit(p) genAssignment(p, d, tmp, {}) else: pl.add(");\n") line(p, cpsStmts, pl) if canRaise: raiseExit(p) -proc genBoundsCheck(p: BProc; arr, a, b: TLoc) +proc genBoundsCheck(p: BProc; arr, a, b: TLoc; arrTyp: PType) proc reifiedOpenArray(n: PNode): bool {.inline.} = var x = n - while x.kind in {nkAddr, nkHiddenAddr, nkHiddenStdConv, nkHiddenDeref}: - x = x[0] + while true: + case x.kind + of {nkAddr, nkHiddenAddr, nkHiddenDeref}: + x = x[0] + of nkHiddenStdConv: + x = x[1] + else: + break if x.kind == nkSym and x.sym.kind == skParam: result = false else: @@ -157,12 +191,15 @@ proc genOpenArraySlice(p: BProc; q: PNode; formalType, destType: PType; prepareF var a = initLocExpr(p, q[1]) var b = initLocExpr(p, q[2]) var c = initLocExpr(p, q[3]) + # bug #23321: In the function mapType, ptrs (tyPtr, tyVar, tyLent, tyRef) + # are mapped into ctPtrToArray, the dereference of which is skipped + # in the `genDeref`. We need to skip these ptrs here + let ty = skipTypes(a.t, abstractVar+{tyPtr, tyRef}) # but first produce the required index checks: if optBoundsCheck in p.options: - genBoundsCheck(p, a, b, c) + genBoundsCheck(p, a, b, c, ty) if prepareForMutation: linefmt(p, cpsStmts, "#nimPrepareStrMutationV2($1);$n", [byRefLoc(p, a)]) - let ty = skipTypes(a.t, abstractVar+{tyPtr}) let dest = getTypeDesc(p.module, destType) let lengthExpr = "($1)-($2)+1" % [rdLoc(c), rdLoc(b)] case ty.kind @@ -218,7 +255,7 @@ proc openArrayLoc(p: BProc, formalType: PType, n: PNode; result: var Rope) = for i in 0..<q.len-1: genStmts(p, q[i]) q = q.lastSon - let (x, y) = genOpenArraySlice(p, q, formalType, n.typ[0]) + let (x, y) = genOpenArraySlice(p, q, formalType, n.typ.elementType) result.add x & ", " & y else: var a = initLocExpr(p, if n.kind == nkHiddenStdConv: n[1] else: n) @@ -237,8 +274,7 @@ proc openArrayLoc(p: BProc, formalType: PType, n: PNode; result: var Rope) = optSeqDestructors in p.config.globalOptions: linefmt(p, cpsStmts, "#nimPrepareStrMutationV2($1);$n", [byRefLoc(p, a)]) if ntyp.kind in {tyVar} and not compileToCpp(p.module): - var t: TLoc - t.r = "(*$1)" % [a.rdLoc] + var t = TLoc(snippet: "(*$1)" % [a.rdLoc]) result.add "($4) ? ((*$1)$3) : NIM_NIL, $2" % [a.rdLoc, lenExpr(p, t), dataField(p), dataFieldAccessor(p, "*" & a.rdLoc)] @@ -248,15 +284,14 @@ proc openArrayLoc(p: BProc, formalType: PType, n: PNode; result: var Rope) = of tyArray: result.add "$1, $2" % [rdLoc(a), rope(lengthOrd(p.config, a.t))] of tyPtr, tyRef: - case lastSon(a.t).kind + case elementType(a.t).kind of tyString, tySequence: - var t: TLoc - t.r = "(*$1)" % [a.rdLoc] + var t = TLoc(snippet: "(*$1)" % [a.rdLoc]) result.add "($4) ? ((*$1)$3) : NIM_NIL, $2" % [a.rdLoc, lenExpr(p, t), dataField(p), dataFieldAccessor(p, "*" & a.rdLoc)] of tyArray: - result.add "$1, $2" % [rdLoc(a), rope(lengthOrd(p.config, lastSon(a.t)))] + result.add "$1, $2" % [rdLoc(a), rope(lengthOrd(p.config, elementType(a.t)))] else: internalError(p.config, "openArrayLoc: " & typeToString(a.t)) else: internalError(p.config, "openArrayLoc: " & typeToString(a.t)) @@ -287,7 +322,7 @@ proc genArg(p: BProc, n: PNode, param: PSym; call: PNode; result: var Rope; need elif skipTypes(param.typ, abstractVar).kind in {tyOpenArray, tyVarargs}: var n = if n.kind != nkHiddenAddr: n else: n[0] openArrayLoc(p, param.typ, n, result) - elif ccgIntroducedPtr(p.config, param, call[0].typ[0]) and + elif ccgIntroducedPtr(p.config, param, call[0].typ.returnType) and (optByRef notin param.options or not p.module.compileToCpp): a = initLocExpr(p, n) if n.kind in {nkCharLit..nkNilLit}: @@ -296,18 +331,33 @@ proc genArg(p: BProc, n: PNode, param: PSym; call: PNode; result: var Rope; need addAddrLoc(p.config, withTmpIfNeeded(p, a, needsTmp), result) elif p.module.compileToCpp and param.typ.kind in {tyVar} and n.kind == nkHiddenAddr: - a = initLocExprSingleUse(p, n[0]) + # bug #23748: we need to introduce a temporary here. The expression type + # will be a reference in C++ and we cannot create a temporary reference + # variable. Thus, we create a temporary pointer variable instead. + let needsIndirect = mapType(p.config, n[0].typ, mapTypeChooser(n[0]) == skParam) != ctArray + if needsIndirect: + n.typ = n.typ.exactReplica + n.typ.flags.incl tfVarIsPtr + a = initLocExprSingleUse(p, n) + a = withTmpIfNeeded(p, a, needsTmp) + if needsIndirect: a.flags.incl lfIndirect # if the proc is 'importc'ed but not 'importcpp'ed then 'var T' still # means '*T'. See posix.nim for lots of examples that do that in the wild. let callee = call[0] if callee.kind == nkSym and {sfImportc, sfInfixCall, sfCompilerProc} * callee.sym.flags == {sfImportc} and - {lfHeader, lfNoDecl} * callee.sym.loc.flags != {}: + {lfHeader, lfNoDecl} * callee.sym.loc.flags != {} and + needsIndirect: addAddrLoc(p.config, a, result) else: addRdLoc(a, result) else: a = initLocExprSingleUse(p, n) + if param.typ.kind in {tyVar, tyPtr, tyRef, tySink}: + let typ = skipTypes(param.typ, abstractPtrs) + if not sameBackendTypePickyAliases(typ, n.typ.skipTypes(abstractPtrs)): + a.snippet = "(($1) ($2))" % + [getTypeDesc(p.module, param.typ), rdCharLoc(a)] addRdLoc(withTmpIfNeeded(p, a, needsTmp), result) #assert result != nil @@ -352,7 +402,7 @@ proc getPotentialWrites(n: PNode; mutate: bool; result: var seq[PNode]) = of nkCallKinds: case n.getMagic: of mIncl, mExcl, mInc, mDec, mAppendStrCh, mAppendStrStr, mAppendSeqElem, - mAddr, mNew, mNewFinalize, mWasMoved, mDestroy, mReset: + mAddr, mNew, mNewFinalize, mWasMoved, mDestroy: getPotentialWrites(n[1], true, result) for i in 2..<n.len: getPotentialWrites(n[i], mutate, result) @@ -390,13 +440,15 @@ proc genParams(p: BProc, ri: PNode, typ: PType; result: var Rope) = if not needTmp[i - 1]: needTmp[i - 1] = potentialAlias(n, potentialWrites) getPotentialWrites(ri[i], false, potentialWrites) - if ri[i].kind in {nkHiddenAddr, nkAddr}: - # Optimization: don't use a temp, if we would only take the address anyway - needTmp[i - 1] = false + when false: + # this optimization is wrong, see bug #23748 + if ri[i].kind in {nkHiddenAddr, nkAddr}: + # Optimization: don't use a temp, if we would only take the address anyway + needTmp[i - 1] = false var oldLen = result.len for i in 1..<ri.len: - if i < typ.len: + if i < typ.n.len: assert(typ.n[i].kind == nkSym) let paramType = typ.n[i] if not paramType.typ.isCompileTimeOnly: @@ -421,7 +473,6 @@ proc genPrefixCall(p: BProc, le, ri: PNode, d: var TLoc) = # getUniqueType() is too expensive here: var typ = skipTypes(ri[0].typ, abstractInstOwned) assert(typ.kind == tyProc) - assert(typ.len == typ.n.len) var params = newRopeAppender() genParams(p, ri, typ, params) @@ -444,7 +495,6 @@ proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = # getUniqueType() is too expensive here: var typ = skipTypes(ri[0].typ, abstractInstOwned) assert(typ.kind == tyProc) - assert(typ.len == typ.n.len) var pl = newRopeAppender() genParams(p, ri, typ, pl) @@ -457,14 +507,14 @@ proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = let rawProc = getClosureType(p.module, typ, clHalf) let canRaise = p.config.exc == excGoto and canRaiseDisp(p, ri[0]) - if typ[0] != nil: + if typ.returnType != nil: if isInvalidReturnType(p.config, typ): if ri.len > 1: pl.add(", ") # beware of 'result = p(result)'. We may need to allocate a temporary: if d.k in {locTemp, locNone} or not preventNrvo(p, d.lode, le, ri): # Great, we can use 'd': if d.k == locNone: - d = getTemp(p, typ[0], needsInit=true) + d = getTemp(p, typ.returnType, needsInit=true) elif d.k notin {locTemp} and not hasNoInit(ri): # reset before pass as 'result' var: discard "resetLoc(p, d)" @@ -472,29 +522,29 @@ proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = genCallPattern() if canRaise: raiseExit(p) else: - var tmp: TLoc = getTemp(p, typ[0], needsInit=true) + var tmp: TLoc = getTemp(p, typ.returnType, needsInit=true) pl.add(addrLoc(p.config, tmp)) genCallPattern() if canRaise: raiseExit(p) genAssignment(p, d, tmp, {}) # no need for deep copying elif isHarmlessStore(p, canRaise, d): - if d.k == locNone: d = getTemp(p, typ[0]) + if d.k == locNone: d = getTemp(p, typ.returnType) assert(d.t != nil) # generate an assignment to d: var list: TLoc = initLoc(locCall, d.lode, OnUnknown) if tfIterator in typ.flags: - list.r = PatIter % [rdLoc(op), pl, pl.addComma, rawProc] + list.snippet = PatIter % [rdLoc(op), pl, pl.addComma, rawProc] else: - list.r = PatProc % [rdLoc(op), pl, pl.addComma, rawProc] + list.snippet = PatProc % [rdLoc(op), pl, pl.addComma, rawProc] genAssignment(p, d, list, {}) # no need for deep copying if canRaise: raiseExit(p) else: - var tmp: TLoc = getTemp(p, typ[0]) + var tmp: TLoc = getTemp(p, typ.returnType) assert(d.t != nil) # generate an assignment to d: var list: TLoc = initLoc(locCall, d.lode, OnUnknown) if tfIterator in typ.flags: - list.r = PatIter % [rdLoc(op), pl, pl.addComma, rawProc] + list.snippet = PatIter % [rdLoc(op), pl, pl.addComma, rawProc] else: - list.r = PatProc % [rdLoc(op), pl, pl.addComma, rawProc] + list.snippet = PatProc % [rdLoc(op), pl, pl.addComma, rawProc] genAssignment(p, tmp, list, {}) if canRaise: raiseExit(p) genAssignment(p, d, tmp, {}) @@ -504,14 +554,14 @@ proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = proc genOtherArg(p: BProc; ri: PNode; i: int; typ: PType; result: var Rope; argsCounter: var int) = - if i < typ.len: + if i < typ.n.len: # 'var T' is 'T&' in C++. This means we ignore the request of # any nkHiddenAddr when it's a 'var T'. let paramType = typ.n[i] assert(paramType.kind == nkSym) if paramType.typ.isCompileTimeOnly: discard - elif typ[i].kind in {tyVar} and ri[i].kind == nkHiddenAddr: + elif paramType.typ.kind in {tyVar} and ri[i].kind == nkHiddenAddr: if argsCounter > 0: result.add ", " genArgNoParam(p, ri[i][0], result) inc argsCounter @@ -586,7 +636,7 @@ proc genThisArg(p: BProc; ri: PNode; i: int; typ: PType; result: var 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. - internalAssert p.config, i < typ.len + internalAssert p.config, i < typ.n.len assert(typ.n[i].kind == nkSym) # if the parameter is lying (tyVar) and thus we required an additional deref, # skip the deref: @@ -676,28 +726,27 @@ proc genInfixCall(p: BProc, le, ri: PNode, d: var TLoc) = # getUniqueType() is too expensive here: var typ = skipTypes(ri[0].typ, abstractInst) assert(typ.kind == tyProc) - assert(typ.len == typ.n.len) # don't call '$' here for efficiency: - let pat = $ri[0].sym.loc.r + let pat = $ri[0].sym.loc.snippet internalAssert p.config, pat.len > 0 if pat.contains({'#', '(', '@', '\''}): var pl = newRopeAppender() genPatternCall(p, ri, pat, typ, pl) # simpler version of 'fixupCall' that works with the pl+params combination: var typ = skipTypes(ri[0].typ, abstractInst) - if typ[0] != nil: + if typ.returnType != nil: 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 # is free to emit expressions multiple times! d.k = locCall - d.r = pl + d.snippet = pl excl d.flags, lfSingleUse else: - if d.k == locNone: d = getTemp(p, typ[0]) + if d.k == locNone: d = getTemp(p, typ.returnType) assert(d.t != nil) # generate an assignment to d: var list: TLoc = initLoc(locCall, d.lode, OnUnknown) - list.r = pl + list.snippet = pl genAssignment(p, d, list, {}) # no need for deep copying else: pl.add(";\n") @@ -707,10 +756,9 @@ proc genInfixCall(p: BProc, le, ri: PNode, d: var TLoc) = var argsCounter = 0 if 1 < ri.len: genThisArg(p, ri, 1, typ, pl) - pl.add(op.r) + pl.add(op.snippet) var params = newRopeAppender() for i in 2..<ri.len: - assert(typ.len == typ.n.len) genOtherArg(p, ri, i, typ, params, argsCounter) fixupCall(p, le, ri, d, pl, params) @@ -721,15 +769,14 @@ proc genNamedParamCall(p: BProc, ri: PNode, d: var TLoc) = # getUniqueType() is too expensive here: var typ = skipTypes(ri[0].typ, abstractInst) assert(typ.kind == tyProc) - assert(typ.len == typ.n.len) # don't call '$' here for efficiency: - let pat = $ri[0].sym.loc.r + let pat = $ri[0].sym.loc.snippet internalAssert p.config, pat.len > 0 var start = 3 if ' ' in pat: start = 1 - pl.add(op.r) + pl.add(op.snippet) if ri.len > 1: pl.add(": ") genArg(p, ri[1], typ.n[1].sym, ri, pl) @@ -738,13 +785,12 @@ proc genNamedParamCall(p: BProc, ri: PNode, d: var TLoc) = if ri.len > 1: genArg(p, ri[1], typ.n[1].sym, ri, pl) pl.add(" ") - pl.add(op.r) + pl.add(op.snippet) if ri.len > 2: pl.add(": ") genArg(p, ri[2], typ.n[2].sym, ri, pl) for i in start..<ri.len: - assert(typ.len == typ.n.len) - if i >= typ.len: + if i >= typ.n.len: internalError(p.config, ri.info, "varargs for objective C method?") assert(typ.n[i].kind == nkSym) var param = typ.n[i].sym @@ -752,29 +798,29 @@ proc genNamedParamCall(p: BProc, ri: PNode, d: var TLoc) = pl.add(param.name.s) pl.add(": ") genArg(p, ri[i], param, ri, pl) - if typ[0] != nil: + if typ.returnType != nil: if isInvalidReturnType(p.config, typ): if ri.len > 1: pl.add(" ") # 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: d = getTemp(p, typ[0], needsInit=true) + if d.k == locNone: d = getTemp(p, typ.returnType, needsInit=true) pl.add("Result: ") pl.add(addrLoc(p.config, d)) pl.add("];\n") line(p, cpsStmts, pl) else: - var tmp: TLoc = getTemp(p, typ[0], needsInit=true) + var tmp: TLoc = getTemp(p, typ.returnType, needsInit=true) pl.add(addrLoc(p.config, tmp)) pl.add("];\n") line(p, cpsStmts, pl) genAssignment(p, d, tmp, {}) # no need for deep copying else: pl.add("]") - if d.k == locNone: d = getTemp(p, typ[0]) + if d.k == locNone: d = getTemp(p, typ.returnType) assert(d.t != nil) # generate an assignment to d: var list: TLoc = initLoc(locCall, ri, OnUnknown) - list.r = pl + list.snippet = pl genAssignment(p, d, list, {}) # no need for deep copying else: pl.add("];\n") diff --git a/compiler/ccgexprs.nim b/compiler/ccgexprs.nim index 2612c5c12..545d43ae8 100644 --- a/compiler/ccgexprs.nim +++ b/compiler/ccgexprs.nim @@ -221,10 +221,11 @@ proc asgnComplexity(n: PNode): int = proc optAsgnLoc(a: TLoc, t: PType, field: Rope): TLoc = assert field != "" - result.k = locField - result.storage = a.storage - result.lode = lodeTyp t - result.r = rdLoc(a) & "." & field + result = TLoc(k: locField, + storage: a.storage, + lode: lodeTyp t, + snippet: rdLoc(a) & "." & field + ) proc genOptAsgnTuple(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = let newflags = @@ -235,8 +236,7 @@ proc genOptAsgnTuple(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = else: flags let t = skipTypes(dest.t, abstractInst).getUniqueType() - for i in 0..<t.len: - let t = t[i] + for i, t in t.ikids: let field = "Field$1" % [i.rope] genAssignment(p, optAsgnLoc(dest, t, field), optAsgnLoc(src, t, field), newflags) @@ -254,9 +254,9 @@ proc genOptAsgnObject(p: BProc, dest, src: TLoc, flags: TAssignmentFlags, case t.kind of nkSym: let field = t.sym - if field.loc.r == "": fillObjectFields(p.module, typ) - genAssignment(p, optAsgnLoc(dest, field.typ, field.loc.r), - optAsgnLoc(src, field.typ, field.loc.r), newflags) + if field.loc.snippet == "": fillObjectFields(p.module, typ) + genAssignment(p, optAsgnLoc(dest, field.typ, field.loc.snippet), + optAsgnLoc(src, field.typ, field.loc.snippet), newflags) of nkRecList: for child in items(t): genOptAsgnObject(p, dest, src, newflags, child, typ) else: discard @@ -285,15 +285,22 @@ proc genGenericAsgn(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = linefmt(p, cpsStmts, "#genericAssign((void*)$1, (void*)$2, $3);$n", [addrLoc(p.config, dest), addrLoc(p.config, src), genTypeInfoV1(p.module, dest.t, dest.lode.info)]) -proc genOpenArrayConv(p: BProc; d: TLoc; a: TLoc) = +proc genOpenArrayConv(p: BProc; d: TLoc; a: TLoc; flags: TAssignmentFlags) = assert d.k != locNone # getTemp(p, d.t, d) case a.t.skipTypes(abstractVar).kind of tyOpenArray, tyVarargs: if reifiedOpenArray(a.lode): - linefmt(p, cpsStmts, "$1.Field0 = $2.Field0; $1.Field1 = $2.Field1;$n", - [rdLoc(d), a.rdLoc]) + if needTempForOpenArray in flags: + var tmp: TLoc = getTemp(p, a.t) + linefmt(p, cpsStmts, "$2 = $1; $n", + [a.rdLoc, tmp.rdLoc]) + linefmt(p, cpsStmts, "$1.Field0 = $2.Field0; $1.Field1 = $2.Field1;$n", + [rdLoc(d), tmp.rdLoc]) + else: + linefmt(p, cpsStmts, "$1.Field0 = $2.Field0; $1.Field1 = $2.Field1;$n", + [rdLoc(d), a.rdLoc]) else: linefmt(p, cpsStmts, "$1.Field0 = $2; $1.Field1 = $2Len_0;$n", [rdLoc(d), a.rdLoc]) @@ -336,7 +343,7 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = of tyString: if optSeqDestructors in p.config.globalOptions: genGenericAsgn(p, dest, src, flags) - elif (needToCopy notin flags and src.storage != OnStatic) or canMove(p, src.lode, dest): + elif ({needToCopy, needToCopySinkParam} * flags == {} and src.storage != OnStatic) or canMove(p, src.lode, dest): genRefAssign(p, dest, src) else: if (dest.storage == OnStack and p.config.selectedGC != gcGo) or not usesWriteBarrier(p.config): @@ -361,7 +368,7 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) of tyTuple: if containsGarbageCollectedRef(dest.t): - if dest.t.len <= 4: genOptAsgnTuple(p, dest, src, flags) + if dest.t.kidsLen <= 4: genOptAsgnTuple(p, dest, src, flags) else: genGenericAsgn(p, dest, src, flags) else: linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) @@ -372,7 +379,8 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = elif not isObjLackingTypeField(ty): genGenericAsgn(p, dest, src, flags) elif containsGarbageCollectedRef(ty): - if ty[0].isNil and asgnComplexity(ty.n) <= 4: + if ty[0].isNil and asgnComplexity(ty.n) <= 4 and + needAssignCall notin flags: # calls might contain side effects discard getTypeDesc(p.module, ty) internalAssert p.config, ty.n != nil genOptAsgnObject(p, dest, src, flags, ty.n, ty) @@ -391,7 +399,7 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = # open arrays are always on the stack - really? What if a sequence is # passed to an open array? if reifiedOpenArray(dest.lode): - genOpenArrayConv(p, dest, src) + genOpenArrayConv(p, dest, src, flags) elif containsGarbageCollectedRef(dest.t): linefmt(p, cpsStmts, # XXX: is this correct for arrays? "#genericAssignOpenArray((void*)$1, (void*)$2, $1Len_0, $3);$n", @@ -475,7 +483,7 @@ proc putDataIntoDest(p: BProc, d: var TLoc, n: PNode, r: Rope) = if d.k != locNone: var a: TLoc = initLoc(locData, n, OnStatic) # need to generate an assignment here - a.r = r + a.snippet = r if lfNoDeepCopy in d.flags: genAssignment(p, d, a, {}) else: genAssignment(p, d, a, {needToCopy}) else: @@ -483,13 +491,13 @@ proc putDataIntoDest(p: BProc, d: var TLoc, n: PNode, r: Rope) = # the flags field! d.k = locData d.lode = n - d.r = r + d.snippet = r proc putIntoDest(p: BProc, d: var TLoc, n: PNode, r: Rope; s=OnUnknown) = if d.k != locNone: # need to generate an assignment here var a: TLoc = initLoc(locExpr, n, s) - a.r = r + a.snippet = r if lfNoDeepCopy in d.flags: genAssignment(p, d, a, {}) else: genAssignment(p, d, a, {needToCopy}) else: @@ -497,7 +505,7 @@ proc putIntoDest(p: BProc, d: var TLoc, n: PNode, r: Rope; s=OnUnknown) = # the flags field! d.k = locExpr d.lode = n - d.r = r + d.snippet = r proc binaryStmt(p: BProc, e: PNode, d: var TLoc, op: string) = if d.k != locNone: internalError(p.config, e.info, "binaryStmt") @@ -582,7 +590,7 @@ proc binaryArithOverflow(p: BProc, e: PNode, d: var TLoc, m: TMagic) = # 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: + if optOverflowCheck notin p.options or (m in {mSucc, mPred} and t.kind in {tyUInt..tyUInt64}): let res = "($1)($2 $3 $4)" % [getTypeDesc(p.module, e.typ), rdLoc(a), rope(opr[m]), rdLoc(b)] putIntoDest(p, d, e, res) else: @@ -604,7 +612,7 @@ proc binaryArithOverflow(p: BProc, e: PNode, d: var TLoc, m: TMagic) = if t.kind == tyInt64: prc64[m] else: prc[m]) putIntoDest(p, d, e, "($#)($#)" % [getTypeDesc(p.module, e.typ), res]) else: - let res = "($1)($2 $3 $4)" % [getTypeDesc(p.module, e.typ), rdLoc(a), rope(opr[m]), rdLoc(b)] + let res = "($1)(($2) $3 ($4))" % [getTypeDesc(p.module, e.typ), rdLoc(a), rope(opr[m]), rdLoc(b)] putIntoDest(p, d, e, res) proc unaryArithOverflow(p: BProc, e: PNode, d: var TLoc, m: TMagic) = @@ -748,7 +756,7 @@ proc genDeref(p: BProc, e: PNode, d: var TLoc) = var a: TLoc var typ = e[0].typ if typ.kind in {tyUserTypeClass, tyUserTypeClassInst} and typ.isResolvedUserTypeClass: - typ = typ.lastSon + typ = typ.last typ = typ.skipTypes(abstractInstOwned) if typ.kind in {tyVar} and tfVarIsPtr notin typ.flags and p.module.compileToCpp and e[0].kind == nkHiddenAddr: d = initLocExprSingleUse(p, e[0][0]) @@ -801,10 +809,12 @@ proc genAddr(p: BProc, e: PNode, d: var TLoc) = # careful 'addr(myptrToArray)' needs to get the ampersand: if e[0].typ.skipTypes(abstractInstOwned).kind in {tyRef, tyPtr}: var a: TLoc = initLocExpr(p, e[0]) - putIntoDest(p, d, e, "&" & a.r, a.storage) + putIntoDest(p, d, e, "&" & a.snippet, a.storage) #Message(e.info, warnUser, "HERE NEW &") elif mapType(p.config, e[0].typ, mapTypeChooser(e[0]) == skParam) == ctArray or isCppRef(p, e.typ): expr(p, e[0], d) + # bug #19497 + d.lode = e else: var a: TLoc = initLocExpr(p, e[0]) putIntoDest(p, d, e, addrLoc(p.config, a), a.storage) @@ -853,7 +863,7 @@ proc genRecordField(p: BProc, e: PNode, d: var TLoc) = var a: TLoc = default(TLoc) if p.module.compileToCpp and e.kind == nkDotExpr and e[1].kind == nkSym and e[1].typ.kind == tyPtr: # special case for C++: we need to pull the type of the field as member and friends require the complete type. - let typ = e[1].typ[0] + let typ = e[1].typ.elementType if typ.itemId in p.module.g.graph.memberProcsPerType: discard getTypeDesc(p.module, typ) @@ -870,10 +880,10 @@ proc genRecordField(p: BProc, e: PNode, d: var TLoc) = else: var rtyp: PType = nil let field = lookupFieldAgain(p, ty, f, r, addr rtyp) - if field.loc.r == "" and rtyp != nil: fillObjectFields(p.module, rtyp) - if field.loc.r == "": internalError(p.config, e.info, "genRecordField 3 " & typeToString(ty)) + if field.loc.snippet == "" and rtyp != nil: fillObjectFields(p.module, rtyp) + if field.loc.snippet == "": internalError(p.config, e.info, "genRecordField 3 " & typeToString(ty)) r.add "." - r.add field.loc.r + r.add field.loc.snippet putIntoDest(p, d, e, r, a.storage) r.freeze @@ -892,10 +902,10 @@ proc genFieldCheck(p: BProc, e: PNode, obj: Rope, field: PSym) = test = initLoc(locNone, it, OnStack) u = initLocExpr(p, it[1]) v = initLoc(locExpr, disc, OnUnknown) - v.r = newRopeAppender() - v.r.add obj - v.r.add(".") - v.r.add(disc.sym.loc.r) + v.snippet = newRopeAppender() + v.snippet.add obj + v.snippet.add(".") + v.snippet.add(disc.sym.loc.snippet) genInExprAux(p, it, u, v, test) var msg = "" if optDeclaredLocs in p.config.globalOptions: @@ -953,12 +963,12 @@ proc genCheckedRecordField(p: BProc, e: PNode, d: var TLoc) = var r = rdLoc(a) let f = e[0][1].sym let field = lookupFieldAgain(p, ty, f, r) - if field.loc.r == "": fillObjectFields(p.module, ty) - if field.loc.r == "": + if field.loc.snippet == "": fillObjectFields(p.module, ty) + if field.loc.snippet == "": internalError(p.config, e.info, "genCheckedRecordField") # generate the checks: genFieldCheck(p, e, r, field) r.add(".") - r.add field.loc.r + r.add field.loc.snippet putIntoDest(p, d, e[0], r, a.storage) r.freeze else: @@ -1012,8 +1022,8 @@ proc genCStringElem(p: BProc, n, x, y: PNode, d: var TLoc) = putIntoDest(p, d, n, ropecg(p.module, "$1[$2]", [rdLoc(a), rdCharLoc(b)]), a.storage) -proc genBoundsCheck(p: BProc; arr, a, b: TLoc) = - let ty = skipTypes(arr.t, abstractVarRange) +proc genBoundsCheck(p: BProc; arr, a, b: TLoc; arrTyp: PType) = + let ty = arrTyp case ty.kind of tyOpenArray, tyVarargs: if reifiedOpenArray(arr.lode): @@ -1082,7 +1092,8 @@ proc genSeqElem(p: BProc, n, x, y: PNode, d: var TLoc) = var b = initLocExpr(p, y) var ty = skipTypes(a.t, abstractVarRange) if ty.kind in {tyRef, tyPtr}: - ty = skipTypes(ty.lastSon, abstractVarRange) # emit range check: + ty = skipTypes(ty.elementType, abstractVarRange) + # emit range check: if optBoundsCheck in p.options: linefmt(p, cpsStmts, "if ($1 < 0 || $1 >= $2){ #raiseIndexError2($1,$2-1); ", @@ -1092,7 +1103,7 @@ proc genSeqElem(p: BProc, n, x, y: PNode, d: var TLoc) = if d.k == locNone: d.storage = OnHeap if skipTypes(a.t, abstractVar).kind in {tyRef, tyPtr}: - a.r = ropecg(p.module, "(*$1)", [a.r]) + a.snippet = ropecg(p.module, "(*$1)", [a.snippet]) if lfPrepareForMutation in d.flags and ty.kind == tyString and optSeqDestructors in p.config.globalOptions: @@ -1102,7 +1113,7 @@ proc genSeqElem(p: BProc, n, x, y: PNode, d: var TLoc) = proc genBracketExpr(p: BProc; n: PNode; d: var TLoc) = var ty = skipTypes(n[0].typ, abstractVarRange + tyUserTypeClasses) - if ty.kind in {tyRef, tyPtr}: ty = skipTypes(ty.lastSon, abstractVarRange) + if ty.kind in {tyRef, tyPtr}: ty = skipTypes(ty.elementType, abstractVarRange) case ty.kind of tyUncheckedArray: genUncheckedArrayElem(p, n, n[0], n[1], d) of tyArray: genArrayElem(p, n, n[0], n[1], d) @@ -1158,9 +1169,9 @@ proc genAndOr(p: BProc, e: PNode, d: var TLoc, m: TMagic) = var tmpB = initLocExprSingleUse(p, e[2]) tmpB.k = locExpr if m == mOr: - tmpB.r = "((" & rdLoc(tmpA) & ")||(" & rdLoc(tmpB) & "))" + tmpB.snippet = "((" & rdLoc(tmpA) & ")||(" & rdLoc(tmpB) & "))" else: - tmpB.r = "((" & rdLoc(tmpA) & ")&&(" & rdLoc(tmpB) & "))" + tmpB.snippet = "((" & rdLoc(tmpA) & ")&&(" & rdLoc(tmpB) & "))" if d.k == locNone: d = tmpB else: @@ -1263,7 +1274,7 @@ proc genStrConcat(p: BProc, e: PNode, d: var TLoc) = lens.add(lenExpr(p, a)) lens.add(" + ") appends.add(ropecg(p.module, "#appendString($1, $2);$n", [strLoc(p, tmp), rdLoc(a)])) - linefmt(p, cpsStmts, "$1 = #rawNewString($2$3);$n", [tmp.r, lens, L]) + linefmt(p, cpsStmts, "$1 = #rawNewString($2$3);$n", [tmp.snippet, lens, L]) p.s(cpsStmts).add appends if d.k == locNone: d = tmp @@ -1309,7 +1320,7 @@ proc genStrAppend(p: BProc, e: PNode, d: var TLoc) = [byRefLoc(p, dest), lens, L]) else: call = initLoc(locCall, e, OnHeap) - call.r = ropecg(p.module, "#resizeString($1, $2$3)", [rdLoc(dest), lens, L]) + call.snippet = ropecg(p.module, "#resizeString($1, $2$3)", [rdLoc(dest), lens, L]) genAssignment(p, dest, call, {}) gcUsage(p.config, e) p.s(cpsStmts).add appends @@ -1324,12 +1335,12 @@ proc genSeqElemAppend(p: BProc, e: PNode, d: var TLoc) = var call = initLoc(locCall, e, OnHeap) if not p.module.compileToCpp: const seqAppendPattern = "($2) #incrSeqV3((TGenericSeq*)($1), $3)" - call.r = ropecg(p.module, seqAppendPattern, [rdLoc(a), + call.snippet = ropecg(p.module, seqAppendPattern, [rdLoc(a), getTypeDesc(p.module, e[1].typ), genTypeInfoV1(p.module, seqType, e.info)]) else: const seqAppendPattern = "($2) #incrSeqV3($1, $3)" - call.r = ropecg(p.module, seqAppendPattern, [rdLoc(a), + call.snippet = ropecg(p.module, seqAppendPattern, [rdLoc(a), getTypeDesc(p.module, e[1].typ), genTypeInfoV1(p.module, seqType, e.info)]) # emit the write barrier if required, but we can always move here, so @@ -1339,19 +1350,11 @@ proc genSeqElemAppend(p: BProc, e: PNode, d: var TLoc) = # echo "YES ", e.info, " new: ", typeToString(bt), " old: ", typeToString(b.t) var dest = initLoc(locExpr, e[2], OnHeap) var tmpL = getIntTemp(p) - lineCg(p, cpsStmts, "$1 = $2->$3++;$n", [tmpL.r, rdLoc(a), lenField(p)]) - dest.r = ropecg(p.module, "$1$3[$2]", [rdLoc(a), tmpL.r, dataField(p)]) + lineCg(p, cpsStmts, "$1 = $2->$3++;$n", [tmpL.snippet, rdLoc(a), lenField(p)]) + dest.snippet = ropecg(p.module, "$1$3[$2]", [rdLoc(a), tmpL.snippet, dataField(p)]) genAssignment(p, dest, b, {needToCopy}) gcUsage(p.config, e) -proc genReset(p: BProc, n: PNode) = - var a: TLoc = initLocExpr(p, n[1]) - specializeReset(p, a) - when false: - linefmt(p, cpsStmts, "#genericReset((void*)$1, $2);$n", - [addrLoc(p.config, a), - genTypeInfoV1(p.module, skipTypes(a.t, {tyVar}), n.info)]) - proc genDefault(p: BProc; n: PNode; d: var TLoc) = if d.k == locNone: d = getTemp(p, n.typ, needsInit=true) else: resetLoc(p, d) @@ -1362,16 +1365,16 @@ proc rawGenNew(p: BProc, a: var TLoc, sizeExpr: Rope; needsInit: bool) = var b: TLoc = initLoc(locExpr, a.lode, OnHeap) let refType = typ.skipTypes(abstractInstOwned) assert refType.kind == tyRef - let bt = refType.lastSon + let bt = refType.elementType if sizeExpr == "": sizeExpr = "sizeof($1)" % [getTypeDesc(p.module, bt)] if optTinyRtti in p.config.globalOptions: if needsInit: - b.r = ropecg(p.module, "($1) #nimNewObj($2, NIM_ALIGNOF($3))", + b.snippet = ropecg(p.module, "($1) #nimNewObj($2, NIM_ALIGNOF($3))", [getTypeDesc(p.module, typ), sizeExpr, getTypeDesc(p.module, bt)]) else: - b.r = ropecg(p.module, "($1) #nimNewObjUninit($2, NIM_ALIGNOF($3))", + b.snippet = ropecg(p.module, "($1) #nimNewObjUninit($2, NIM_ALIGNOF($3))", [getTypeDesc(p.module, typ), sizeExpr, getTypeDesc(p.module, bt)]) genAssignment(p, a, b, {}) else: @@ -1396,15 +1399,15 @@ proc rawGenNew(p: BProc, a: var TLoc, sizeExpr: Rope; needsInit: bool) = if p.config.selectedGC == gcGo: # newObjRC1() would clash with unsureAsgnRef() - which is used by gcGo to # implement the write barrier - b.r = ropecg(p.module, "($1) #newObj($2, $3)", [getTypeDesc(p.module, typ), ti, sizeExpr]) + b.snippet = ropecg(p.module, "($1) #newObj($2, $3)", [getTypeDesc(p.module, typ), ti, sizeExpr]) linefmt(p, cpsStmts, "#unsureAsgnRef((void**) $1, $2);$n", [addrLoc(p.config, a), b.rdLoc]) else: # use newObjRC1 as an optimization - b.r = ropecg(p.module, "($1) #newObjRC1($2, $3)", [getTypeDesc(p.module, typ), ti, sizeExpr]) + b.snippet = ropecg(p.module, "($1) #newObjRC1($2, $3)", [getTypeDesc(p.module, typ), ti, sizeExpr]) linefmt(p, cpsStmts, "$1 = $2;$n", [a.rdLoc, b.rdLoc]) else: - b.r = ropecg(p.module, "($1) #newObj($2, $3)", [getTypeDesc(p.module, typ), ti, sizeExpr]) + b.snippet = ropecg(p.module, "($1) #newObj($2, $3)", [getTypeDesc(p.module, typ), ti, sizeExpr]) genAssignment(p, a, b, {}) # set the object type: genObjectInit(p, cpsStmts, bt, a, constructRefObj) @@ -1430,18 +1433,18 @@ proc genNewSeqAux(p: BProc, dest: TLoc, length: Rope; lenIsZero: bool) = if not lenIsZero: if p.config.selectedGC == gcGo: # we need the write barrier - call.r = ropecg(p.module, "($1) #newSeq($2, $3)", [getTypeDesc(p.module, seqtype), + call.snippet = ropecg(p.module, "($1) #newSeq($2, $3)", [getTypeDesc(p.module, seqtype), genTypeInfoV1(p.module, seqtype, dest.lode.info), length]) linefmt(p, cpsStmts, "#unsureAsgnRef((void**) $1, $2);$n", [addrLoc(p.config, dest), call.rdLoc]) else: - call.r = ropecg(p.module, "($1) #newSeqRC1($2, $3)", [getTypeDesc(p.module, seqtype), + call.snippet = ropecg(p.module, "($1) #newSeqRC1($2, $3)", [getTypeDesc(p.module, seqtype), genTypeInfoV1(p.module, seqtype, dest.lode.info), length]) linefmt(p, cpsStmts, "$1 = $2;$n", [dest.rdLoc, call.rdLoc]) else: if lenIsZero: - call.r = rope"NIM_NIL" + call.snippet = rope"NIM_NIL" else: - call.r = ropecg(p.module, "($1) #newSeq($2, $3)", [getTypeDesc(p.module, seqtype), + call.snippet = ropecg(p.module, "($1) #newSeq($2, $3)", [getTypeDesc(p.module, seqtype), genTypeInfoV1(p.module, seqtype, dest.lode.info), length]) genAssignment(p, dest, call, {}) @@ -1452,7 +1455,7 @@ proc genNewSeq(p: BProc, e: PNode) = let seqtype = skipTypes(e[1].typ, abstractVarRange) linefmt(p, cpsStmts, "$1.len = $2; $1.p = ($4*) #newSeqPayload($2, sizeof($3), NIM_ALIGNOF($3));$n", [a.rdLoc, b.rdLoc, - getTypeDesc(p.module, seqtype.lastSon), + getTypeDesc(p.module, seqtype.elementType), getSeqPayloadType(p.module, seqtype)]) else: let lenIsZero = e[2].kind == nkIntLit and e[2].intVal == 0 @@ -1465,7 +1468,7 @@ proc genNewSeqOfCap(p: BProc; e: PNode; d: var TLoc) = if optSeqDestructors in p.config.globalOptions: if d.k == locNone: d = getTemp(p, e.typ, needsInit=false) linefmt(p, cpsStmts, "$1.len = 0; $1.p = ($4*) #newSeqPayloadUninit($2, sizeof($3), NIM_ALIGNOF($3));$n", - [d.rdLoc, a.rdLoc, getTypeDesc(p.module, seqtype.lastSon), + [d.rdLoc, a.rdLoc, getTypeDesc(p.module, seqtype.elementType), getSeqPayloadType(p.module, seqtype), ]) else: @@ -1484,9 +1487,13 @@ proc rawConstExpr(p: BProc, n: PNode; d: var TLoc) = if id == p.module.labels: # expression not found in the cache: inc(p.module.labels) - p.module.s[cfsData].addf("static NIM_CONST $1 $2 = ", [getTypeDesc(p.module, t), d.r]) - genBracedInit(p, n, isConst = true, t, p.module.s[cfsData]) - p.module.s[cfsData].addf(";$n", []) + var data = "static NIM_CONST $1 $2 = " % [getTypeDesc(p.module, t), d.snippet] + # bug #23627; when generating const object fields, it's likely that + # we need to generate type infos for the object, which may be an object with + # custom hooks. We need to generate potential consts in the hooks first. + genBracedInit(p, n, isConst = true, t, data) + data.addf(";$n", []) + p.module.s[cfsData].add data proc handleConstExpr(p: BProc, n: PNode, d: var TLoc): bool = if d.k == locNone and n.len > ord(n.kind == nkObjConstr) and n.isDeepConstExpr: @@ -1497,15 +1504,14 @@ proc handleConstExpr(p: BProc, n: PNode, d: var TLoc): bool = proc genFieldObjConstr(p: BProc; ty: PType; useTemp, isRef: bool; nField, val, check: PNode; d: var TLoc; r: Rope; info: TLineInfo) = - var tmp2: TLoc = default(TLoc) - tmp2.r = r - let field = lookupFieldAgain(p, ty, nField.sym, tmp2.r) - if field.loc.r == "": fillObjectFields(p.module, ty) - if field.loc.r == "": internalError(p.config, info, "genFieldObjConstr") + var tmp2 = TLoc(snippet: r) + let field = lookupFieldAgain(p, ty, nField.sym, tmp2.snippet) + if field.loc.snippet == "": fillObjectFields(p.module, ty) + if field.loc.snippet == "": internalError(p.config, info, "genFieldObjConstr") if check != nil and optFieldCheck in p.options: genFieldCheck(p, check, r, field) - tmp2.r.add(".") - tmp2.r.add(field.loc.r) + tmp2.snippet.add(".") + tmp2.snippet.add(field.loc.snippet) if useTemp: tmp2.k = locTemp tmp2.storage = if isRef: OnHeap else: OnStack @@ -1513,7 +1519,12 @@ proc genFieldObjConstr(p: BProc; ty: PType; useTemp, isRef: bool; nField, val, c tmp2.k = d.k tmp2.storage = if isRef: OnHeap else: d.storage tmp2.lode = val - expr(p, val, tmp2) + if nField.typ.skipTypes(abstractVar).kind in {tyOpenArray, tyVarargs}: + var tmp3 = getTemp(p, val.typ) + expr(p, val, tmp3) + genOpenArrayConv(p, tmp2, tmp3, {}) + else: + expr(p, val, tmp2) proc genObjConstr(p: BProc, e: PNode, d: var TLoc) = # inheritance in C++ does not allow struct initialization so @@ -1544,7 +1555,7 @@ proc genObjConstr(p: BProc, e: PNode, d: var TLoc) = r = rdLoc(tmp) if isRef: rawGenNew(p, tmp, "", needsInit = nfAllFieldsSet notin e.flags) - t = t.lastSon.skipTypes(abstractInstOwned) + t = t.elementType.skipTypes(abstractInstOwned) r = "(*$1)" % [r] gcUsage(p.config, e) elif needsZeroMem: @@ -1590,7 +1601,7 @@ proc genSeqConstr(p: BProc, n: PNode, d: var TLoc) = if optSeqDestructors in p.config.globalOptions: let seqtype = n.typ linefmt(p, cpsStmts, "$1.len = $2; $1.p = ($4*) #newSeqPayload($2, sizeof($3), NIM_ALIGNOF($3));$n", - [rdLoc dest[], lit, getTypeDesc(p.module, seqtype.lastSon), + [rdLoc dest[], lit, getTypeDesc(p.module, seqtype.elementType), getSeqPayloadType(p.module, seqtype)]) else: # generate call to newSeq before adding the elements per hand: @@ -1599,7 +1610,7 @@ proc genSeqConstr(p: BProc, n: PNode, d: var TLoc) = arr = initLoc(locExpr, n[i], OnHeap) var lit = newRopeAppender() intLiteral(i, lit) - arr.r = ropecg(p.module, "$1$3[$2]", [rdLoc(dest[]), lit, dataField(p)]) + arr.snippet = ropecg(p.module, "$1$3[$2]", [rdLoc(dest[]), lit, dataField(p)]) arr.storage = OnHeap # we know that sequences are on the heap expr(p, n[i], arr) gcUsage(p.config, n) @@ -1623,7 +1634,7 @@ proc genArrToSeq(p: BProc, n: PNode, d: var TLoc) = if optSeqDestructors in p.config.globalOptions: let seqtype = n.typ linefmt(p, cpsStmts, "$1.len = $2; $1.p = ($4*) #newSeqPayload($2, sizeof($3), NIM_ALIGNOF($3));$n", - [rdLoc d, L, getTypeDesc(p.module, seqtype.lastSon), + [rdLoc d, L, getTypeDesc(p.module, seqtype.elementType), getSeqPayloadType(p.module, seqtype)]) else: var lit = newRopeAppender() @@ -1635,19 +1646,19 @@ proc genArrToSeq(p: BProc, n: PNode, d: var TLoc) = elem = initLoc(locExpr, lodeTyp elemType(skipTypes(n.typ, abstractInst)), OnHeap) var lit = newRopeAppender() intLiteral(i, lit) - elem.r = ropecg(p.module, "$1$3[$2]", [rdLoc(d), lit, dataField(p)]) + elem.snippet = ropecg(p.module, "$1$3[$2]", [rdLoc(d), lit, dataField(p)]) elem.storage = OnHeap # we know that sequences are on the heap arr = initLoc(locExpr, lodeTyp elemType(skipTypes(n[1].typ, abstractInst)), a.storage) - arr.r = ropecg(p.module, "$1[$2]", [rdLoc(a), lit]) + arr.snippet = ropecg(p.module, "$1[$2]", [rdLoc(a), lit]) genAssignment(p, elem, arr, {needToCopy}) else: var i: TLoc = getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt)) - linefmt(p, cpsStmts, "for ($1 = 0; $1 < $2; $1++) {$n", [i.r, L]) + linefmt(p, cpsStmts, "for ($1 = 0; $1 < $2; $1++) {$n", [i.snippet, L]) elem = initLoc(locExpr, lodeTyp elemType(skipTypes(n.typ, abstractInst)), OnHeap) - elem.r = ropecg(p.module, "$1$3[$2]", [rdLoc(d), rdLoc(i), dataField(p)]) + elem.snippet = ropecg(p.module, "$1$3[$2]", [rdLoc(d), rdLoc(i), dataField(p)]) elem.storage = OnHeap # we know that sequences are on the heap arr = initLoc(locExpr, lodeTyp elemType(skipTypes(n[1].typ, abstractInst)), a.storage) - arr.r = ropecg(p.module, "$1[$2]", [rdLoc(a), rdLoc(i)]) + arr.snippet = ropecg(p.module, "$1[$2]", [rdLoc(a), rdLoc(i)]) genAssignment(p, elem, arr, {needToCopy}) lineF(p, cpsStmts, "}$n", []) @@ -1663,11 +1674,11 @@ proc genNewFinalize(p: BProc, e: PNode) = b = initLoc(locExpr, a.lode, OnHeap) ti = genTypeInfo(p.config, p.module, refType, e.info) p.module.s[cfsTypeInit3].addf("$1->finalizer = (void*)$2;$n", [ti, rdLoc(f)]) - b.r = ropecg(p.module, "($1) #newObj($2, sizeof($3))", [ + b.snippet = ropecg(p.module, "($1) #newObj($2, sizeof($3))", [ getTypeDesc(p.module, refType), - ti, getTypeDesc(p.module, skipTypes(refType.lastSon, abstractRange))]) + ti, getTypeDesc(p.module, skipTypes(refType.elementType, abstractRange))]) genAssignment(p, a, b, {}) # set the object type: - bt = skipTypes(refType.lastSon, abstractRange) + bt = skipTypes(refType.elementType, abstractRange) genObjectInit(p, cpsStmts, bt, a, constructRefObj) gcUsage(p.config, e) @@ -1699,12 +1710,12 @@ proc genOf(p: BProc, x: PNode, typ: PType, d: var TLoc) = if t.kind notin {tyVar, tyLent}: nilCheck = r if t.kind notin {tyVar, tyLent} or not p.module.compileToCpp: r = ropecg(p.module, "(*$1)", [r]) - t = skipTypes(t.lastSon, typedescInst+{tyOwned}) + t = skipTypes(t.elementType, typedescInst+{tyOwned}) discard getTypeDesc(p.module, t) if not p.module.compileToCpp: - while t.kind == tyObject and t[0] != nil: + while t.kind == tyObject and t.baseClass != nil: r.add(".Sup") - t = skipTypes(t[0], skipPtrs) + t = skipTypes(t.baseClass, skipPtrs) if isObjLackingTypeField(t): globalError(p.config, x.info, "no 'of' operator available for pure objects") @@ -1788,13 +1799,13 @@ proc rdMType(p: BProc; a: TLoc; nilCheck: var Rope; result: var Rope; enforceV1 if t.kind notin {tyVar, tyLent}: nilCheck = derefs if t.kind notin {tyVar, tyLent} or not p.module.compileToCpp: derefs = "(*$1)" % [derefs] - t = skipTypes(t.lastSon, abstractInst) + t = skipTypes(t.elementType, abstractInst) result.add derefs discard getTypeDesc(p.module, t) if not p.module.compileToCpp: - while t.kind == tyObject and t[0] != nil: + while t.kind == tyObject and t.baseClass != nil: result.add(".Sup") - t = skipTypes(t[0], skipPtrs) + t = skipTypes(t.baseClass, skipPtrs) result.add ".m_type" if optTinyRtti in p.config.globalOptions and enforceV1: result.add "->typeInfoV1" @@ -1828,7 +1839,7 @@ proc genAccessTypeField(p: BProc; e: PNode; d: var TLoc) = template genDollar(p: BProc, n: PNode, d: var TLoc, frmt: string) = var a: TLoc = initLocExpr(p, n[1]) - a.r = ropecg(p.module, frmt, [rdLoc(a)]) + a.snippet = ropecg(p.module, frmt, [rdLoc(a)]) a.flags.excl lfIndirect # this flag should not be propagated here (not just for HCR) if d.k == locNone: d = getTemp(p, n.typ) genAssignment(p, d, a, {}) @@ -1847,11 +1858,11 @@ proc genArrayLen(p: BProc, e: PNode, d: var TLoc, op: TMagic) = var b = initLocExpr(p, a[2]) var c = initLocExpr(p, a[3]) if optBoundsCheck in p.options: - genBoundsCheck(p, m, b, c) + genBoundsCheck(p, m, b, c, skipTypes(m.t, abstractVarRange)) if op == mHigh: - putIntoDest(p, d, e, ropecg(p.module, "($2)-($1)", [rdLoc(b), rdLoc(c)])) + putIntoDest(p, d, e, ropecg(p.module, "(($2)-($1))", [rdLoc(b), rdLoc(c)])) else: - putIntoDest(p, d, e, ropecg(p.module, "($2)-($1)+1", [rdLoc(b), rdLoc(c)])) + putIntoDest(p, d, e, ropecg(p.module, "(($2)-($1)+1)", [rdLoc(b), rdLoc(c)])) else: if not reifiedOpenArray(a): if op == mHigh: unaryExpr(p, e, d, "($1Len_0-1)") @@ -1882,8 +1893,8 @@ proc genArrayLen(p: BProc, e: PNode, d: var TLoc, op: TMagic) = var a = initLocExpr(p, e[1]) var x = lenExpr(p, a) if op == mHigh: x = "($1-1)" % [x] - lineCg(p, cpsStmts, "$1 = $2;$n", [tmp.r, x]) - putIntoDest(p, d, e, tmp.r) + lineCg(p, cpsStmts, "$1 = $2;$n", [tmp.snippet, x]) + putIntoDest(p, d, e, tmp.snippet) of tyArray: # YYY: length(sideeffect) is optimized away incorrectly? if op == mHigh: putIntoDest(p, d, e, rope(lastOrd(p.config, typ))) @@ -1905,13 +1916,13 @@ proc genSetLengthSeq(p: BProc, e: PNode, d: var TLoc) = var call = initLoc(locCall, e, OnHeap) if not p.module.compileToCpp: const setLenPattern = "($3) #setLengthSeqV2(($1)?&($1)->Sup:NIM_NIL, $4, $2)" - call.r = ropecg(p.module, setLenPattern, [ + call.snippet = ropecg(p.module, setLenPattern, [ rdLoc(a), rdLoc(b), getTypeDesc(p.module, t), genTypeInfoV1(p.module, t.skipTypes(abstractInst), e.info)]) else: const setLenPattern = "($3) #setLengthSeqV2($1, $4, $2)" - call.r = ropecg(p.module, setLenPattern, [ + call.snippet = ropecg(p.module, setLenPattern, [ rdLoc(a), rdLoc(b), getTypeDesc(p.module, t), genTypeInfoV1(p.module, t.skipTypes(abstractInst), e.info)]) @@ -1927,7 +1938,7 @@ proc genSetLengthStr(p: BProc, e: PNode, d: var TLoc) = var b = initLocExpr(p, e[2]) var call = initLoc(locCall, e, OnHeap) - call.r = ropecg(p.module, "#setLengthStr($1, $2)", [ + call.snippet = ropecg(p.module, "#setLengthStr($1, $2)", [ rdLoc(a), rdLoc(b)]) genAssignment(p, a, call, {}) gcUsage(p.config, e) @@ -2004,23 +2015,23 @@ proc genInOp(p: BProc, e: PNode, d: var TLoc) = a = initLocExpr(p, ea) b = initLoc(locExpr, e, OnUnknown) if e[1].len > 0: - b.r = rope("(") + b.snippet = rope("(") for i in 0..<e[1].len: let it = e[1][i] if it.kind == nkRange: x = initLocExpr(p, it[0]) y = initLocExpr(p, it[1]) - b.r.addf("$1 >= $2 && $1 <= $3", + b.snippet.addf("$1 >= $2 && $1 <= $3", [rdCharLoc(a), rdCharLoc(x), rdCharLoc(y)]) else: x = initLocExpr(p, it) - b.r.addf("$1 == $2", [rdCharLoc(a), rdCharLoc(x)]) - if i < e[1].len - 1: b.r.add(" || ") - b.r.add(")") + b.snippet.addf("$1 == $2", [rdCharLoc(a), rdCharLoc(x)]) + if i < e[1].len - 1: b.snippet.add(" || ") + b.snippet.add(")") else: # handle the case of an empty set - b.r = rope("0") - putIntoDest(p, d, e, b.r) + b.snippet = rope("0") + putIntoDest(p, d, e, b.snippet) else: assert(e[1].typ != nil) assert(e[2].typ != nil) @@ -2080,7 +2091,7 @@ proc genSetOp(p: BProc, e: PNode, d: var TLoc, op: TMagic) = of mExcl: binaryStmtInExcl(p, e, d, "$1[(NU)($2)>>3] &= ~(1U<<($2&7U));$n") of mCard: var a: TLoc = initLocExpr(p, e[1]) - putIntoDest(p, d, e, ropecg(p.module, "#cardSet($1, $2)", [addrLoc(p.config, a), size])) + putIntoDest(p, d, e, ropecg(p.module, "#cardSet($1, $2)", [rdCharLoc(a), size])) of mLtSet, mLeSet: i = getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt)) # our counter a = initLocExpr(p, e[1]) @@ -2158,7 +2169,7 @@ proc genCast(p: BProc, e: PNode, d: var TLoc) = inc(p.labels) var lbl = p.labels.rope var tmp: TLoc = default(TLoc) - tmp.r = "LOC$1.source" % [lbl] + tmp.snippet = "LOC$1.source" % [lbl] let destsize = getSize(p.config, destt) let srcsize = getSize(p.config, srct) @@ -2223,12 +2234,16 @@ proc genRangeChck(p: BProc, n: PNode, d: var TLoc) = raiseInstr(p, p.s(cpsStmts)) linefmt p, cpsStmts, "}$n", [] - putIntoDest(p, d, n, "(($1) ($2))" % + if sameBackendTypeIgnoreRange(dest, n[0].typ): + # don't cast so an address can be taken for `var` conversions + putIntoDest(p, d, n, "($1)" % [rdCharLoc(a)], a.storage) + else: + putIntoDest(p, d, n, "(($1) ($2))" % [getTypeDesc(p.module, dest), rdCharLoc(a)], a.storage) proc genConv(p: BProc, e: PNode, d: var TLoc) = let destType = e.typ.skipTypes({tyVar, tyLent, tyGenericInst, tyAlias, tySink}) - if sameBackendType(destType, e[1].typ): + if sameBackendTypeIgnoreRange(destType, e[1].typ): expr(p, e[1], d) else: genSomeCast(p, e, d) @@ -2242,9 +2257,15 @@ proc convStrToCStr(p: BProc, n: PNode, d: var TLoc) = proc convCStrToStr(p: BProc, n: PNode, d: var TLoc) = var a: TLoc = initLocExpr(p, n[0]) - putIntoDest(p, d, n, - ropecg(p.module, "#cstrToNimstr($1)", [rdLoc(a)]), - a.storage) + if p.module.compileToCpp: + # fixes for const qualifier; bug #12703; bug #19588 + putIntoDest(p, d, n, + ropecg(p.module, "#cstrToNimstr((NCSTRING) $1)", [rdLoc(a)]), + a.storage) + else: + putIntoDest(p, d, n, + ropecg(p.module, "#cstrToNimstr($1)", [rdLoc(a)]), + a.storage) gcUsage(p.config, n) proc genStrEquals(p: BProc, e: PNode, d: var TLoc) = @@ -2331,8 +2352,13 @@ proc genMove(p: BProc; n: PNode; d: var TLoc) = else: linefmt(p, cpsStmts, "$1($2);$n", [rdLoc(b), byRefLoc(p, a)]) else: - let flags = if not canMove(p, n[1], d): {needToCopy} else: {} - genAssignment(p, d, a, flags) + if n[1].kind == nkSym and isSinkParam(n[1].sym): + var tmp = getTemp(p, n[1].typ.skipTypes({tySink})) + genAssignment(p, tmp, a, {needToCopySinkParam}) + genAssignment(p, d, tmp, {}) + resetLoc(p, tmp) + else: + genAssignment(p, d, a, {}) resetLoc(p, a) proc genDestroy(p: BProc; n: PNode) = @@ -2355,7 +2381,7 @@ proc genDestroy(p: BProc; n: PNode) = linefmt(p, cpsStmts, "if ($1.p && !($1.p->cap & NIM_STRLIT_FLAG)) {$n" & " #alignedDealloc($1.p, NIM_ALIGNOF($2));$n" & "}$n", - [rdLoc(a), getTypeDesc(p.module, t.lastSon)]) + [rdLoc(a), getTypeDesc(p.module, t.elementType)]) else: discard "nothing to do" else: let t = n[1].typ.skipTypes(abstractVar) @@ -2366,7 +2392,7 @@ proc genDestroy(p: BProc; n: PNode) = proc genDispose(p: BProc; n: PNode) = when false: - let elemType = n[1].typ.skipTypes(abstractVar).lastSon + let elemType = n[1].typ.skipTypes(abstractVar).elementType var a: TLoc = initLocExpr(p, n[1].skipAddr) @@ -2381,7 +2407,7 @@ proc genDispose(p: BProc; n: PNode) = lineCg(p, cpsStmts, ["#nimDestroyAndDispose($#)", rdLoc(a)]) proc genSlice(p: BProc; e: PNode; d: var TLoc) = - let (x, y) = genOpenArraySlice(p, e, e.typ, e.typ.lastSon, + let (x, y) = genOpenArraySlice(p, e, e.typ, e.typ.elementType, prepareForMutation = e[1].kind == nkHiddenDeref and e[1].typ.skipTypes(abstractInst).kind == tyString and p.config.selectedGC in {gcArc, gcAtomicArc, gcOrc}) @@ -2440,7 +2466,7 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = var call = initLoc(locCall, e, OnHeap) var dest = initLocExpr(p, e[1]) var b = initLocExpr(p, e[2]) - call.r = ropecg(p.module, "#addChar($1, $2)", [rdLoc(dest), rdLoc(b)]) + call.snippet = ropecg(p.module, "#addChar($1, $2)", [rdLoc(dest), rdLoc(b)]) genAssignment(p, dest, call, {}) of mAppendStrStr: genStrAppend(p, e, d) of mAppendSeqElem: @@ -2453,16 +2479,14 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = of mLeStr: binaryExpr(p, e, d, "(#cmpStrings($1, $2) <= 0)") of mLtStr: binaryExpr(p, e, d, "(#cmpStrings($1, $2) < 0)") of mIsNil: genIsNil(p, e, d) - of mIntToStr: genDollar(p, e, d, "#nimIntToStr($1)") - of mInt64ToStr: genDollar(p, e, d, "#nimInt64ToStr($1)") of mBoolToStr: genDollar(p, e, d, "#nimBoolToStr($1)") of mCharToStr: genDollar(p, e, d, "#nimCharToStr($1)") - of mFloatToStr: - if e[1].typ.skipTypes(abstractInst).kind == tyFloat32: - genDollar(p, e, d, "#nimFloat32ToStr($1)") + of mCStrToStr: + if p.module.compileToCpp: + # fixes for const qualifier; bug #12703; bug #19588 + genDollar(p, e, d, "#cstrToNimstr((NCSTRING) $1)") else: - genDollar(p, e, d, "#nimFloatToStr($1)") - of mCStrToStr: genDollar(p, e, d, "#cstrToNimstr($1)") + genDollar(p, e, d, "#cstrToNimstr($1)") of mStrToStr, mUnown: expr(p, e[1], d) of generatedMagics: genCall(p, e, d) of mEnumToStr: @@ -2506,7 +2530,7 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = let member = if t.kind == tyTuple: "Field" & rope(dotExpr[1].sym.position) - else: dotExpr[1].sym.loc.r + else: dotExpr[1].sym.loc.snippet putIntoDest(p,d,e, "((NI)offsetof($1, $2))" % [tname, member]) of mChr: genSomeCast(p, e, d) of mOrd: genOrd(p, e, d) @@ -2529,8 +2553,8 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = # - not sure, and it wouldn't work if the symbol behind the magic isn't # somehow forward-declared from some other usage, but it is *possible* if lfNoDecl notin opr.loc.flags: - let prc = magicsys.getCompilerProc(p.module.g.graph, $opr.loc.r) - assert prc != nil, $opr.loc.r + let prc = magicsys.getCompilerProc(p.module.g.graph, $opr.loc.snippet) + assert prc != nil, $opr.loc.snippet # HACK: # Explicitly add this proc as declared here so the cgsym call doesn't # add a forward declaration - without this we could end up with the same @@ -2543,14 +2567,13 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = let wasDeclared = containsOrIncl(p.module.declaredProtos, prc.id) # Make the function behind the magic get actually generated - this will # not lead to a forward declaration! The genCall will lead to one. - cgsym(p.module, $opr.loc.r) + cgsym(p.module, $opr.loc.snippet) # make sure we have pointer-initialising code for hot code reloading if not wasDeclared and p.hcrOn: p.module.s[cfsDynLibInit].addf("\t$1 = ($2) hcrGetProc($3, \"$1\");$n", [mangleDynLibProc(prc), getTypeDesc(p.module, prc.loc.t), getModuleDllPath(p.module, prc)]) genCall(p, e, d) of mDefault, mZeroDefault: genDefault(p, e, d) - of mReset: genReset(p, e) of mEcho: genEcho(p, e[1].skipConv) of mArrToSeq: genArrToSeq(p, e, d) of mNLen..mNError, mSlurp..mQuoteAst: @@ -2586,6 +2609,8 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = of mTrace: discard "no code to generate" of mEnsureMove: expr(p, e[1], d) + of mDup: + expr(p, e[1], d) else: when defined(debugMagics): echo p.prc.name.s, " ", p.prc.id, " ", p.prc.flags, " ", p.prc.ast[genericParamsPos].kind @@ -2671,7 +2696,7 @@ proc genTupleConstr(p: BProc, n: PNode, d: var TLoc) = var it = n[i] if it.kind == nkExprColonExpr: it = it[1] rec = initLoc(locExpr, it, dest[].storage) - rec.r = "$1.Field$2" % [rdLoc(dest[]), rope(i)] + rec.snippet = "$1.Field$2" % [rdLoc(dest[]), rope(i)] rec.flags.incl(lfEnforceDeref) expr(p, it, rec) @@ -2721,12 +2746,12 @@ proc genArrayConstr(p: BProc, n: PNode, d: var TLoc) = arr = initLoc(locExpr, lodeTyp elemType(skipTypes(n.typ, abstractInst)), d.storage) var lit = newRopeAppender() intLiteral(i, lit) - arr.r = "$1[$2]" % [rdLoc(d), lit] + arr.snippet = "$1[$2]" % [rdLoc(d), lit] expr(p, n[i], arr) proc genComplexConst(p: BProc, sym: PSym, d: var TLoc) = requestConstImpl(p, sym) - assert((sym.loc.r != "") and (sym.loc.t != nil)) + assert((sym.loc.snippet != "") and (sym.loc.t != nil)) putLocIntoDest(p, d, sym.loc) template genStmtListExprImpl(exprOrStmt) {.dirty.} = @@ -2858,24 +2883,24 @@ proc genConstSetup(p: BProc; sym: PSym): bool = result = lfNoDecl notin sym.loc.flags proc genConstHeader(m, q: BModule; p: BProc, sym: PSym) = - if sym.loc.r == "": + if sym.loc.snippet == "": if not genConstSetup(p, sym): return - assert(sym.loc.r != "", $sym.name.s & $sym.itemId) + assert(sym.loc.snippet != "", $sym.name.s & $sym.itemId) if m.hcrOn: - m.s[cfsVars].addf("static $1* $2;$n", [getTypeDesc(m, sym.loc.t, dkVar), sym.loc.r]); + m.s[cfsVars].addf("static $1* $2;$n", [getTypeDesc(m, sym.loc.t, dkVar), sym.loc.snippet]); m.initProc.procSec(cpsLocals).addf( - "\t$1 = ($2*)hcrGetGlobal($3, \"$1\");$n", [sym.loc.r, + "\t$1 = ($2*)hcrGetGlobal($3, \"$1\");$n", [sym.loc.snippet, getTypeDesc(m, sym.loc.t, dkVar), getModuleDllPath(q, sym)]) else: let headerDecl = "extern NIM_CONST $1 $2;$n" % - [getTypeDesc(m, sym.loc.t, dkVar), sym.loc.r] + [getTypeDesc(m, sym.loc.t, dkVar), sym.loc.snippet] m.s[cfsData].add(headerDecl) if sfExportc in sym.flags and p.module.g.generatedHeader != nil: p.module.g.generatedHeader.s[cfsData].add(headerDecl) proc genConstDefinition(q: BModule; p: BProc; sym: PSym) = # add a suffix for hcr - will later init the global pointer with this data - let actualConstName = if q.hcrOn: sym.loc.r & "_const" else: sym.loc.r + let actualConstName = if q.hcrOn: sym.loc.snippet & "_const" else: sym.loc.snippet var data = newRopeAppender() data.addf("N_LIB_PRIVATE NIM_CONST $1 $2 = ", [getTypeDesc(q, sym.typ), actualConstName]) @@ -2884,16 +2909,16 @@ proc genConstDefinition(q: BModule; p: BProc; sym: PSym) = q.s[cfsData].add data if q.hcrOn: # generate the global pointer with the real name - q.s[cfsVars].addf("static $1* $2;$n", [getTypeDesc(q, sym.loc.t, dkVar), sym.loc.r]) + q.s[cfsVars].addf("static $1* $2;$n", [getTypeDesc(q, sym.loc.t, dkVar), sym.loc.snippet]) # register it (but ignore the boolean result of hcrRegisterGlobal) q.initProc.procSec(cpsLocals).addf( "\thcrRegisterGlobal($1, \"$2\", sizeof($3), NULL, (void**)&$2);$n", - [getModuleDllPath(q, sym), sym.loc.r, rdLoc(sym.loc)]) + [getModuleDllPath(q, sym), sym.loc.snippet, rdLoc(sym.loc)]) # always copy over the contents of the actual constant with the _const # suffix ==> this means that the constant is reloadable & updatable! q.initProc.procSec(cpsLocals).add(ropecg(q, "\t#nimCopyMem((void*)$1, (NIM_CONST void*)&$2, sizeof($3));$n", - [sym.loc.r, actualConstName, rdLoc(sym.loc)])) + [sym.loc.snippet, actualConstName, rdLoc(sym.loc)])) proc genConstStmt(p: BProc, n: PNode) = # This code is only used in the new DCE implementation. @@ -2933,7 +2958,7 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = genProcPrototype(p.module, sym) else: genProc(p.module, sym) - if sym.loc.r == "" or sym.loc.lode == nil: + if sym.loc.snippet == "" or sym.loc.lode == nil: internalError(p.config, n.info, "expr: proc not init " & sym.name.s) putLocIntoDest(p, d, sym.loc) of skConst: @@ -2943,7 +2968,7 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = putIntoDest(p, d, n, lit, OnStatic) elif useAliveDataFromDce in p.module.flags: genConstHeader(p.module, p.module, p, sym) - assert((sym.loc.r != "") and (sym.loc.t != nil)) + assert((sym.loc.snippet != "") and (sym.loc.t != nil)) putLocIntoDest(p, d, sym.loc) else: genComplexConst(p, sym, d) @@ -2958,14 +2983,14 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = if sfCompileTime in sym.flags: genSingleVar(p, sym, n, astdef(sym)) - if sym.loc.r == "" or sym.loc.t == nil: + if sym.loc.snippet == "" or sym.loc.t == nil: #echo "FAILED FOR PRCO ", p.prc.name.s #echo renderTree(p.prc.ast, {renderIds}) internalError p.config, n.info, "expr: var not init " & sym.name.s & "_" & $sym.id if sfThread in sym.flags: accessThreadLocalVar(p, sym) if emulatedThreadVars(p.config): - putIntoDest(p, d, sym.loc.lode, "NimTV_->" & sym.loc.r) + putIntoDest(p, d, sym.loc.lode, "NimTV_->" & sym.loc.snippet) else: putLocIntoDest(p, d, sym.loc) else: @@ -2973,17 +2998,17 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = of skTemp: when false: # this is more harmful than helpful. - if sym.loc.r == "": + if sym.loc.snippet == "": # we now support undeclared 'skTemp' variables for easier # transformations in other parts of the compiler: assignLocalVar(p, n) - if sym.loc.r == "" or sym.loc.t == nil: + if sym.loc.snippet == "" or sym.loc.t == nil: #echo "FAILED FOR PRCO ", p.prc.name.s #echo renderTree(p.prc.ast, {renderIds}) internalError(p.config, n.info, "expr: temp not init " & sym.name.s & "_" & $sym.id) putLocIntoDest(p, d, sym.loc) of skParam: - if sym.loc.r == "" or sym.loc.t == nil: + if sym.loc.snippet == "" or sym.loc.t == nil: # echo "FAILED FOR PRCO ", p.prc.name.s # debug p.prc.typ.n # echo renderTree(p.prc.ast, {renderIds}) @@ -3073,7 +3098,7 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = of nkLambdaKinds: var sym = n[namePos].sym genProc(p.module, sym) - if sym.loc.r == "" or sym.loc.lode == nil: + if sym.loc.snippet == "" or sym.loc.lode == nil: internalError(p.config, n.info, "expr: proc not init " & sym.name.s) putLocIntoDest(p, d, sym.loc) of nkClosure: genClosure(p, n, d) @@ -3104,7 +3129,7 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = if ex.kind != nkEmpty: genLineDir(p, n) var a: TLoc = initLocExprSingleUse(p, ex) - line(p, cpsStmts, "(void)(" & a.r & ");\L") + line(p, cpsStmts, "(void)(" & a.snippet & ");\L") of nkAsmStmt: genAsmStmt(p, n) of nkTryStmt, nkHiddenTryStmt: case p.config.exc @@ -3191,17 +3216,17 @@ proc getDefaultValue(p: BProc; typ: PType; info: TLineInfo; result: var Rope) = result.add "}" of tyTuple: result.add "{" - if p.vccAndC and t.len == 0: + if p.vccAndC and t.isEmptyTupleType: result.add "0" - for i in 0..<t.len: + for i, a in t.ikids: if i > 0: result.add ", " - getDefaultValue(p, t[i], info, result) + getDefaultValue(p, a, info, result) result.add "}" of tyArray: result.add "{" - for i in 0..<toInt(lengthOrd(p.config, t[0])): + for i in 0..<toInt(lengthOrd(p.config, t.indexType)): if i > 0: result.add ", " - getDefaultValue(p, t[1], info, result) + getDefaultValue(p, t.elementType, info, result) result.add "}" #result = rope"{}" of tyOpenArray, tyVarargs: @@ -3226,7 +3251,8 @@ proc getNullValueAux(p: BProc; t: PType; obj, constOrNil: PNode, getNullValueAux(p, t, it, constOrNil, result, count, isConst, info) of nkRecCase: getNullValueAux(p, t, obj[0], constOrNil, result, count, isConst, info) - if count > 0: result.add ", " + var res = "" + if count > 0: res.add ", " var branch = Zero if constOrNil != nil: ## find kind value, default is zero if not specified @@ -3240,18 +3266,21 @@ proc getNullValueAux(p: BProc; t: PType; obj, constOrNil: PNode, break let selectedBranch = caseObjDefaultBranch(obj, branch) - result.add "{" + res.add "{" var countB = 0 let b = lastSon(obj[selectedBranch]) # designated initilization is the only way to init non first element of unions # branches are allowed to have no members (b.len == 0), in this case they don't need initializer if b.kind == nkRecList and not isEmptyCaseObjectBranch(b): - result.add "._" & mangleRecFieldName(p.module, obj[0].sym) & "_" & $selectedBranch & " = {" - getNullValueAux(p, t, b, constOrNil, result, countB, isConst, info) - result.add "}" + res.add "._" & mangleRecFieldName(p.module, obj[0].sym) & "_" & $selectedBranch & " = {" + getNullValueAux(p, t, b, constOrNil, res, countB, isConst, info) + res.add "}" elif b.kind == nkSym: - result.add "." & mangleRecFieldName(p.module, b.sym) & " = " - getNullValueAux(p, t, b, constOrNil, result, countB, isConst, info) + res.add "." & mangleRecFieldName(p.module, b.sym) & " = " + getNullValueAux(p, t, b, constOrNil, res, countB, isConst, info) + else: + return + result.add res result.add "}" of nkSym: @@ -3276,7 +3305,7 @@ proc getNullValueAux(p: BProc; t: PType; obj, constOrNil: PNode, proc getNullValueAuxT(p: BProc; orig, t: PType; obj, constOrNil: PNode, result: var Rope; count: var int; isConst: bool, info: TLineInfo) = - var base = t[0] + var base = t.baseClass let oldRes = result let oldcount = count if base != nil: @@ -3308,7 +3337,7 @@ proc genConstObjConstr(p: BProc; n: PNode; isConst: bool; result: var Rope) = proc genConstSimpleList(p: BProc, n: PNode; isConst: bool; result: var Rope) = result.add "{" if p.vccAndC and n.len == 0 and n.typ.kind == tyArray: - getDefaultValue(p, n.typ[1], n.info, result) + getDefaultValue(p, n.typ.elementType, n.info, result) for i in 0..<n.len: let it = n[i] if i > 0: result.add ",\n" @@ -3425,7 +3454,7 @@ proc genBracedInit(p: BProc, n: PNode; isConst: bool; optionalType: PType; resul genConstSimpleList(p, n, isConst, data) let payload = getTempName(p.module) - let ctype = getTypeDesc(p.module, typ[0]) + let ctype = getTypeDesc(p.module, typ.elementType) let arrLen = n.len appcg(p.module, cfsStrData, "static $5 $1 $3[$2] = $4;$n", [ diff --git a/compiler/ccgreset.nim b/compiler/ccgreset.nim index 47b6a1e15..6caeb8084 100644 --- a/compiler/ccgreset.nim +++ b/compiler/ccgreset.nim @@ -24,10 +24,10 @@ proc specializeResetN(p: BProc, accessor: Rope, n: PNode; of nkRecCase: if (n[0].kind != nkSym): internalError(p.config, n.info, "specializeResetN") let disc = n[0].sym - if disc.loc.r == "": fillObjectFields(p.module, typ) + if disc.loc.snippet == "": fillObjectFields(p.module, typ) if disc.loc.t == nil: internalError(p.config, n.info, "specializeResetN()") - lineF(p, cpsStmts, "switch ($1.$2) {$n", [accessor, disc.loc.r]) + lineF(p, cpsStmts, "switch ($1.$2) {$n", [accessor, disc.loc.snippet]) for i in 1..<n.len: let branch = n[i] assert branch.kind in {nkOfBranch, nkElse} @@ -38,14 +38,14 @@ proc specializeResetN(p: BProc, accessor: Rope, n: PNode; specializeResetN(p, accessor, lastSon(branch), typ) lineF(p, cpsStmts, "break;$n", []) lineF(p, cpsStmts, "} $n", []) - specializeResetT(p, "$1.$2" % [accessor, disc.loc.r], disc.loc.t) + specializeResetT(p, "$1.$2" % [accessor, disc.loc.snippet], disc.loc.t) of nkSym: let field = n.sym if field.typ.kind == tyVoid: return - if field.loc.r == "": fillObjectFields(p.module, typ) + if field.loc.snippet == "": fillObjectFields(p.module, typ) if field.loc.t == nil: internalError(p.config, n.info, "specializeResetN()") - specializeResetT(p, "$1.$2" % [accessor, field.loc.r], field.loc.t) + specializeResetT(p, "$1.$2" % [accessor, field.loc.snippet], field.loc.t) else: internalError(p.config, n.info, "specializeResetN()") proc specializeResetT(p: BProc, accessor: Rope, typ: PType) = @@ -54,24 +54,23 @@ proc specializeResetT(p: BProc, accessor: Rope, typ: PType) = case typ.kind of tyGenericInst, tyGenericBody, tyTypeDesc, tyAlias, tyDistinct, tyInferred, tySink, tyOwned: - specializeResetT(p, accessor, lastSon(typ)) + specializeResetT(p, accessor, skipModifier(typ)) of tyArray: - let arraySize = lengthOrd(p.config, typ[0]) + let arraySize = lengthOrd(p.config, typ.indexType) var i: TLoc = getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt)) linefmt(p, cpsStmts, "for ($1 = 0; $1 < $2; $1++) {$n", - [i.r, arraySize]) - specializeResetT(p, ropecg(p.module, "$1[$2]", [accessor, i.r]), typ[1]) + [i.snippet, arraySize]) + specializeResetT(p, ropecg(p.module, "$1[$2]", [accessor, i.snippet]), typ.elementType) lineF(p, cpsStmts, "}$n", []) of tyObject: - for i in 0..<typ.len: - var x = typ[i] - if x != nil: x = x.skipTypes(skipPtrs) - specializeResetT(p, accessor.parentObj(p.module), x) + var x = typ.baseClass + if x != nil: x = x.skipTypes(skipPtrs) + specializeResetT(p, accessor.parentObj(p.module), x) if typ.n != nil: specializeResetN(p, accessor, typ.n, typ) of tyTuple: let typ = getUniqueType(typ) - for i in 0..<typ.len: - specializeResetT(p, ropecg(p.module, "$1.Field$2", [accessor, i]), typ[i]) + for i, a in typ.ikids: + specializeResetT(p, ropecg(p.module, "$1.Field$2", [accessor, i]), a) of tyString, tyRef, tySequence: lineCg(p, cpsStmts, "#unsureAsgnRef((void**)&$1, NIM_NIL);$n", [accessor]) @@ -82,7 +81,7 @@ proc specializeResetT(p: BProc, accessor: Rope, typ: PType) = lineCg(p, cpsStmts, "$1.ClP_0 = NIM_NIL;$n", [accessor]) else: lineCg(p, cpsStmts, "$1 = NIM_NIL;$n", [accessor]) - of tyChar, tyBool, tyEnum, tyInt..tyUInt64: + of tyChar, tyBool, tyEnum, tyRange, tyInt..tyUInt64: lineCg(p, cpsStmts, "$1 = 0;$n", [accessor]) of tyCstring, tyPointer, tyPtr, tyVar, tyLent: lineCg(p, cpsStmts, "$1 = NIM_NIL;$n", [accessor]) @@ -96,8 +95,8 @@ proc specializeResetT(p: BProc, accessor: Rope, typ: PType) = else: raiseAssert "unexpected set type kind" of tyNone, tyEmpty, tyNil, tyUntyped, tyTyped, tyGenericInvocation, - tyGenericParam, tyOrdinal, tyRange, tyOpenArray, tyForward, tyVarargs, - tyUncheckedArray, tyProxy, tyBuiltInTypeClass, tyUserTypeClass, + tyGenericParam, tyOrdinal, tyOpenArray, tyForward, tyVarargs, + tyUncheckedArray, tyError, tyBuiltInTypeClass, tyUserTypeClass, tyUserTypeClassInst, tyCompositeTypeClass, tyAnd, tyOr, tyNot, tyAnything, tyStatic, tyFromExpr, tyConcept, tyVoid, tyIterable: discard diff --git a/compiler/ccgstmts.nim b/compiler/ccgstmts.nim index c3d44c1d3..883108f2c 100644 --- a/compiler/ccgstmts.nim +++ b/compiler/ccgstmts.nim @@ -110,10 +110,10 @@ proc genVarTuple(p: BProc, n: PNode) = initLocalVar(p, v, immediateAsgn=isAssignedImmediately(p.config, n[^1])) var field = initLoc(locExpr, vn, tup.storage) if t.kind == tyTuple: - field.r = "$1.Field$2" % [rdLoc(tup), rope(i)] + field.snippet = "$1.Field$2" % [rdLoc(tup), rope(i)] else: if t.n[i].kind != nkSym: internalError(p.config, n.info, "genVarTuple") - field.r = "$1.$2" % [rdLoc(tup), mangleRecFieldName(p.module, t.n[i].sym)] + field.snippet = "$1.$2" % [rdLoc(tup), mangleRecFieldName(p.module, t.n[i].sym)] putLocIntoDest(p, v.loc, field) if forHcr or isGlobalInBlock: hcrGlobals.add((loc: v.loc, tp: "NULL")) @@ -128,7 +128,7 @@ proc genVarTuple(p: BProc, n: PNode) = lineCg(p, cpsLocals, "NIM_BOOL $1 = NIM_FALSE;$n", [hcrCond]) for curr in hcrGlobals: lineCg(p, cpsLocals, "$1 |= hcrRegisterGlobal($4, \"$2\", sizeof($3), $5, (void**)&$2);$N", - [hcrCond, curr.loc.r, rdLoc(curr.loc), getModuleDllPath(p.module, n[0].sym), curr.tp]) + [hcrCond, curr.loc.snippet, rdLoc(curr.loc), getModuleDllPath(p.module, n[0].sym), curr.tp]) proc loadInto(p: BProc, le, ri: PNode, a: var TLoc) {.inline.} = @@ -267,11 +267,11 @@ proc genBreakState(p: BProc, n: PNode, d: var TLoc) = if n[0].kind == nkClosure: a = initLocExpr(p, n[0][1]) - d.r = "(((NI*) $1)[1] < 0)" % [rdLoc(a)] + d.snippet = "(((NI*) $1)[1] < 0)" % [rdLoc(a)] else: a = initLocExpr(p, n[0]) # the environment is guaranteed to contain the 'state' field at offset 1: - d.r = "((((NI*) $1.ClE_0)[1]) < 0)" % [rdLoc(a)] + d.snippet = "((((NI*) $1.ClE_0)[1]) < 0)" % [rdLoc(a)] proc genGotoVar(p: BProc; value: PNode) = if value.kind notin {nkCharLit..nkUInt64Lit}: @@ -289,22 +289,32 @@ proc potentialValueInit(p: BProc; v: PSym; value: PNode; result: var Rope) = #echo "New code produced for ", v.name.s, " ", p.config $ value.info genBracedInit(p, value, isConst = false, v.typ, result) -proc genCppParamsForCtor(p: BProc; call: PNode): string = +proc genCppParamsForCtor(p: BProc; call: PNode; didGenTemp: var bool): string = result = "" var argsCounter = 0 let typ = skipTypes(call[0].typ, abstractInst) assert(typ.kind == tyProc) for i in 1..<call.len: - assert(typ.len == typ.n.len) #if it's a type we can just generate here another initializer as we are in an initializer context if call[i].kind == nkCall and call[i][0].kind == nkSym and call[i][0].sym.kind == skType: if argsCounter > 0: result.add "," - result.add genCppInitializer(p.module, p, call[i][0].sym.typ) + result.add genCppInitializer(p.module, p, call[i][0].sym.typ, didGenTemp) else: + #We need to test for temp in globals, see: #23657 + let param = + if typ[i].kind in {tyVar} and call[i].kind == nkHiddenAddr: + call[i][0] + else: + call[i] + if param.kind != nkBracketExpr or param.typ.kind in + {tyRef, tyPtr, tyUncheckedArray, tyArray, tyOpenArray, + tyVarargs, tySequence, tyString, tyCstring, tyTuple}: + let tempLoc = initLocExprSingleUse(p, param) + didGenTemp = didGenTemp or tempLoc.k == locTemp genOtherArg(p, call, i, typ, result, argsCounter) -proc genCppVarForCtor(p: BProc; call: PNode; decl: var Rope) = - let params = genCppParamsForCtor(p, call) +proc genCppVarForCtor(p: BProc; call: PNode; decl: var Rope, didGenTemp: var bool) = + let params = genCppParamsForCtor(p, call, didGenTemp) if params.len == 0: decl = runtimeFormat("$#;\n", [decl]) else: @@ -331,7 +341,14 @@ proc genSingleVar(p: BProc, v: PSym; vn, value: PNode) = # v.owner.kind != skModule: targetProc = p.module.preInitProc if isCppCtorCall and not containsHiddenPointer(v.typ): - callGlobalVarCppCtor(targetProc, v, vn, value) + var didGenTemp = false + callGlobalVarCppCtor(targetProc, v, vn, value, didGenTemp) + if didGenTemp: + message(p.config, vn.info, warnGlobalVarConstructorTemporary, vn.sym.name.s) + #We fail to call the constructor in the global scope so we do the call inside the main proc + assignGlobalVar(targetProc, vn, valueAsRope) + var loc = initLocExprSingleUse(targetProc, value) + genAssignment(targetProc, v.loc, loc, {}) else: assignGlobalVar(targetProc, vn, valueAsRope) @@ -366,11 +383,15 @@ proc genSingleVar(p: BProc, v: PSym; vn, value: PNode) = var decl = localVarDecl(p, vn) var tmp: TLoc if isCppCtorCall: - genCppVarForCtor(p, value, decl) + var didGenTemp = false + genCppVarForCtor(p, value, decl, didGenTemp) line(p, cpsStmts, decl) else: tmp = initLocExprSingleUse(p, value) - lineF(p, cpsStmts, "$# = $#;\n", [decl, tmp.rdLoc]) + if value.kind == nkEmpty: + lineF(p, cpsStmts, "$#;\n", [decl]) + else: + lineF(p, cpsStmts, "$# = $#;\n", [decl, tmp.rdLoc]) return assignLocalVar(p, vn) initLocalVar(p, v, imm) @@ -384,7 +405,7 @@ proc genSingleVar(p: BProc, v: PSym; vn, value: PNode) = # put it in the locals section - mainly because of loops which # use the var in a call to resetLoc() in the statements section lineCg(targetProc, cpsLocals, "hcrRegisterGlobal($3, \"$1\", sizeof($2), $4, (void**)&$1);$n", - [v.loc.r, rdLoc(v.loc), getModuleDllPath(p.module, v), traverseProc]) + [v.loc.snippet, rdLoc(v.loc), getModuleDllPath(p.module, v), traverseProc]) # nothing special left to do later on - let's avoid closing and reopening blocks forHcr = false @@ -393,7 +414,7 @@ proc genSingleVar(p: BProc, v: PSym; vn, value: PNode) = # be able to re-run it but without the top level code - just the init of globals if forHcr: lineCg(targetProc, cpsStmts, "if (hcrRegisterGlobal($3, \"$1\", sizeof($2), $4, (void**)&$1))$N", - [v.loc.r, rdLoc(v.loc), getModuleDllPath(p.module, v), traverseProc]) + [v.loc.snippet, rdLoc(v.loc), getModuleDllPath(p.module, v), traverseProc]) startBlock(targetProc) if value.kind != nkEmpty and valueAsRope.len == 0: genLineDir(targetProc, vn) @@ -734,6 +755,18 @@ proc raiseExit(p: BProc) = lineCg(p, cpsStmts, "if (NIM_UNLIKELY(*nimErr_)) goto LA$1_;$n", [p.nestedTryStmts[^1].label]) +proc raiseExitCleanup(p: BProc, destroy: string) = + assert p.config.exc == excGoto + if nimErrorFlagDisabled notin p.flags: + p.flags.incl nimErrorFlagAccessed + if p.nestedTryStmts.len == 0: + p.flags.incl beforeRetNeeded + # easy case, simply goto 'ret': + lineCg(p, cpsStmts, "if (NIM_UNLIKELY(*nimErr_)) {$1; goto BeforeRet_;}$n", [destroy]) + else: + lineCg(p, cpsStmts, "if (NIM_UNLIKELY(*nimErr_)) {$2; goto LA$1_;}$n", + [p.nestedTryStmts[^1].label, destroy]) + proc finallyActions(p: BProc) = if p.config.exc != excGoto and p.nestedTryStmts.len > 0 and p.nestedTryStmts[^1].inExcept: # if the current try stmt have a finally block, @@ -763,10 +796,14 @@ proc genRaiseStmt(p: BProc, t: PNode) = var e = rdLoc(a) discard getTypeDesc(p.module, t[0].typ) var typ = skipTypes(t[0].typ, abstractPtrs) - # XXX For reasons that currently escape me, this is only required by the new - # C++ based exception handling: - if p.config.exc == excCpp: + case p.config.exc + of excCpp: blockLeaveActions(p, howManyTrys = 0, howManyExcepts = p.inExceptBlockLen) + of excGoto: + blockLeaveActions(p, howManyTrys = 0, + howManyExcepts = (if p.nestedTryStmts.len > 0 and p.nestedTryStmts[^1].inExcept: 1 else: 0)) + else: + discard genLineDir(p, t) if isImportedException(typ, p.config): lineF(p, cpsStmts, "throw $1;$n", [e]) @@ -1038,8 +1075,8 @@ proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = inc(p.labels, 2) let etmp = p.labels - - lineCg(p, cpsStmts, "std::exception_ptr T$1_;$n", [etmp]) + #init on locals, fixes #23306 + lineCg(p, cpsLocals, "std::exception_ptr T$1_;$n", [etmp]) let fin = if t[^1].kind == nkFinally: t[^1] else: nil p.nestedTryStmts.add((fin, false, 0.Natural)) @@ -1508,7 +1545,7 @@ proc genAsmOrEmitStmt(p: BProc, t: PNode, isAsmStmt=false; result: var Rope) = else: discard getTypeDesc(p.module, skipTypes(sym.typ, abstractPtrs)) fillBackendName(p.module, sym) - res.add($sym.loc.r) + res.add($sym.loc.snippet) of nkTypeOfExpr: res.add($getTypeDesc(p.module, it.typ)) else: @@ -1538,6 +1575,21 @@ proc genAsmStmt(p: BProc, t: PNode) = assert(t.kind == nkAsmStmt) genLineDir(p, t) var s = newRopeAppender() + + var asmSyntax = "" + if (let p = t[0]; p.kind == nkPragma): + for i in p: + if whichPragma(i) == wAsmSyntax: + asmSyntax = i[1].strVal + + if asmSyntax != "" and + not ( + asmSyntax == "gcc" and hasGnuAsm in CC[p.config.cCompiler].props or + asmSyntax == "vcc" and hasGnuAsm notin CC[p.config.cCompiler].props): + localError( + p.config, t.info, + "Your compiler does not support the specified inline assembler") + genAsmOrEmitStmt(p, t, isAsmStmt=true, s) # 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 @@ -1575,9 +1627,9 @@ proc genPragma(p: BProc, n: PNode) = case whichPragma(it) of wEmit: genEmit(p, it) of wPush: - processPushBackendOption(p.optionsStack, p.options, n, i+1) + processPushBackendOption(p.config, p.optionsStack, p.options, n, i+1) of wPop: - processPopBackendOption(p.optionsStack, p.options) + processPopBackendOption(p.config, p.optionsStack, p.options) else: discard diff --git a/compiler/ccgthreadvars.nim b/compiler/ccgthreadvars.nim index abf830b57..1f551f022 100644 --- a/compiler/ccgthreadvars.nim +++ b/compiler/ccgthreadvars.nim @@ -30,7 +30,7 @@ proc declareThreadVar(m: BModule, s: PSym, isExtern: bool) = # allocator for it :-( if not containsOrIncl(m.g.nimtvDeclared, s.id): m.g.nimtvDeps.add(s.loc.t) - m.g.nimtv.addf("$1 $2;$n", [getTypeDesc(m, s.loc.t), s.loc.r]) + m.g.nimtv.addf("$1 $2;$n", [getTypeDesc(m, s.loc.t), s.loc.snippet]) else: if isExtern: m.s[cfsVars].add("extern ") elif lfExportLib in s.loc.flags: m.s[cfsVars].add("N_LIB_EXPORT_VAR ") @@ -41,7 +41,7 @@ proc declareThreadVar(m: BModule, s: PSym, isExtern: bool) = m.s[cfsVars].add("NIM_THREAD_LOCAL ") else: m.s[cfsVars].add("NIM_THREADVAR ") m.s[cfsVars].add(getTypeDesc(m, s.loc.t)) - m.s[cfsVars].addf(" $1;$n", [s.loc.r]) + m.s[cfsVars].addf(" $1;$n", [s.loc.snippet]) proc generateThreadLocalStorage(m: BModule) = if m.g.nimtv != "" and (usesThreadVars in m.flags or sfMainModule in m.module.flags): diff --git a/compiler/ccgtrav.nim b/compiler/ccgtrav.nim index adad9df3e..ed4c79d9a 100644 --- a/compiler/ccgtrav.nim +++ b/compiler/ccgtrav.nim @@ -34,10 +34,10 @@ proc genTraverseProc(c: TTraversalClosure, accessor: Rope, n: PNode; if (n[0].kind != nkSym): internalError(c.p.config, n.info, "genTraverseProc") var p = c.p let disc = n[0].sym - if disc.loc.r == "": fillObjectFields(c.p.module, typ) + if disc.loc.snippet == "": fillObjectFields(c.p.module, typ) if disc.loc.t == nil: internalError(c.p.config, n.info, "genTraverseProc()") - lineF(p, cpsStmts, "switch ($1.$2) {$n", [accessor, disc.loc.r]) + lineF(p, cpsStmts, "switch ($1.$2) {$n", [accessor, disc.loc.snippet]) for i in 1..<n.len: let branch = n[i] assert branch.kind in {nkOfBranch, nkElse} @@ -51,10 +51,10 @@ proc genTraverseProc(c: TTraversalClosure, accessor: Rope, n: PNode; of nkSym: let field = n.sym if field.typ.kind == tyVoid: return - if field.loc.r == "": fillObjectFields(c.p.module, typ) + if field.loc.snippet == "": fillObjectFields(c.p.module, typ) if field.loc.t == nil: internalError(c.p.config, n.info, "genTraverseProc()") - genTraverseProc(c, "$1.$2" % [accessor, field.loc.r], field.loc.t) + genTraverseProc(c, "$1.$2" % [accessor, field.loc.snippet], field.loc.t) else: internalError(c.p.config, n.info, "genTraverseProc()") proc parentObj(accessor: Rope; m: BModule): Rope {.inline.} = @@ -71,37 +71,36 @@ proc genTraverseProc(c: TTraversalClosure, accessor: Rope, typ: PType) = case typ.kind of tyGenericInst, tyGenericBody, tyTypeDesc, tyAlias, tyDistinct, tyInferred, tySink, tyOwned: - genTraverseProc(c, accessor, lastSon(typ)) + genTraverseProc(c, accessor, skipModifier(typ)) of tyArray: - let arraySize = lengthOrd(c.p.config, typ[0]) + let arraySize = lengthOrd(c.p.config, typ.indexType) var i: TLoc = getTemp(p, getSysType(c.p.module.g.graph, unknownLineInfo, tyInt)) var oldCode = p.s(cpsStmts) freeze oldCode linefmt(p, cpsStmts, "for ($1 = 0; $1 < $2; $1++) {$n", - [i.r, arraySize]) + [i.snippet, arraySize]) let oldLen = p.s(cpsStmts).len - genTraverseProc(c, ropecg(c.p.module, "$1[$2]", [accessor, i.r]), typ[1]) + genTraverseProc(c, ropecg(c.p.module, "$1[$2]", [accessor, i.snippet]), typ.elementType) if p.s(cpsStmts).len == oldLen: # do not emit dummy long loops for faster debug builds: p.s(cpsStmts) = oldCode else: lineF(p, cpsStmts, "}$n", []) of tyObject: - for i in 0..<typ.len: - var x = typ[i] - if x != nil: x = x.skipTypes(skipPtrs) - genTraverseProc(c, accessor.parentObj(c.p.module), x) + var x = typ.baseClass + if x != nil: x = x.skipTypes(skipPtrs) + genTraverseProc(c, accessor.parentObj(c.p.module), x) if typ.n != nil: genTraverseProc(c, accessor, typ.n, typ) of tyTuple: let typ = getUniqueType(typ) - for i in 0..<typ.len: - genTraverseProc(c, ropecg(c.p.module, "$1.Field$2", [accessor, i]), typ[i]) + for i, a in typ.ikids: + genTraverseProc(c, ropecg(c.p.module, "$1.Field$2", [accessor, i]), a) of tyRef: lineCg(p, cpsStmts, visitorFrmt, [accessor, c.visitorFrmt]) of tySequence: if optSeqDestructors notin c.p.module.config.globalOptions: lineCg(p, cpsStmts, visitorFrmt, [accessor, c.visitorFrmt]) - elif containsGarbageCollectedRef(typ.lastSon): + elif containsGarbageCollectedRef(typ.elementType): # destructor based seqs are themselves not traced but their data is, if # they contain a GC'ed type: lineCg(p, cpsStmts, "#nimGCvisitSeq((void*)$1, $2);$n", [accessor, c.visitorFrmt]) @@ -118,15 +117,15 @@ proc genTraverseProc(c: TTraversalClosure, accessor: Rope, typ: PType) = proc genTraverseProcSeq(c: TTraversalClosure, accessor: Rope, typ: PType) = var p = c.p assert typ.kind == tySequence - var i: TLoc = getTemp(p, getSysType(c.p.module.g.graph, unknownLineInfo, tyInt)) + var i = getTemp(p, getSysType(c.p.module.g.graph, unknownLineInfo, tyInt)) var oldCode = p.s(cpsStmts) freeze oldCode - var a: TLoc = TLoc(r: accessor) + var a = TLoc(snippet: accessor) lineF(p, cpsStmts, "for ($1 = 0; $1 < $2; $1++) {$n", - [i.r, lenExpr(c.p, a)]) + [i.snippet, lenExpr(c.p, a)]) let oldLen = p.s(cpsStmts).len - genTraverseProc(c, "$1$3[$2]" % [accessor, i.r, dataField(c.p)], typ[0]) + genTraverseProc(c, "$1$3[$2]" % [accessor, i.snippet, dataField(c.p)], typ.elementType) if p.s(cpsStmts).len == oldLen: # do not emit dummy long loops for faster debug builds: p.s(cpsStmts) = oldCode @@ -134,7 +133,6 @@ proc genTraverseProcSeq(c: TTraversalClosure, accessor: Rope, typ: PType) = lineF(p, cpsStmts, "}$n", []) proc genTraverseProc(m: BModule, origTyp: PType; sig: SigHash): Rope = - var c: TTraversalClosure var p = newProc(nil, m) result = "Marker_" & getTypeName(m, origTyp, sig) let @@ -147,18 +145,19 @@ proc genTraverseProc(m: BModule, origTyp: PType; sig: SigHash): Rope = lineF(p, cpsLocals, "$1 a;$n", [t]) lineF(p, cpsInit, "a = ($1)p;$n", [t]) - c.p = p - c.visitorFrmt = "op" # "#nimGCvisit((void*)$1, op);$n" + var c = TTraversalClosure(p: p, + visitorFrmt: "op" # "#nimGCvisit((void*)$1, op);$n" + ) assert typ.kind != tyTypeDesc if typ.kind == tySequence: genTraverseProcSeq(c, "a".rope, typ) else: - if skipTypes(typ[0], typedescInst+{tyOwned}).kind == tyArray: + if skipTypes(typ.elementType, typedescInst+{tyOwned}).kind == tyArray: # C's arrays are broken beyond repair: - genTraverseProc(c, "a".rope, typ[0]) + genTraverseProc(c, "a".rope, typ.elementType) else: - genTraverseProc(c, "(*a)".rope, typ[0]) + genTraverseProc(c, "(*a)".rope, typ.elementType) let generatedProc = "$1 {$n$2$3$4}\n" % [header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)] @@ -174,7 +173,6 @@ proc genTraverseProc(m: BModule, origTyp: PType; sig: SigHash): Rope = proc genTraverseProcForGlobal(m: BModule, s: PSym; info: TLineInfo): Rope = discard genTypeInfoV1(m, s.loc.t, info) - var c: TTraversalClosure var p = newProc(nil, m) var sLoc = rdLoc(s.loc) result = getTempName(m) @@ -183,8 +181,10 @@ proc genTraverseProcForGlobal(m: BModule, s: PSym; info: TLineInfo): Rope = accessThreadLocalVar(p, s) sLoc = "NimTV_->" & sLoc - c.visitorFrmt = "0" # "#nimGCvisit((void*)$1, 0);$n" - c.p = p + var c = TTraversalClosure(p: p, + visitorFrmt: "0" # "#nimGCvisit((void*)$1, 0);$n" + ) + let header = "static N_NIMCALL(void, $1)(void)" % [result] genTraverseProc(c, sLoc, s.loc.t) diff --git a/compiler/ccgtypes.nim b/compiler/ccgtypes.nim index 462b08a43..2c2556336 100644 --- a/compiler/ccgtypes.nim +++ b/compiler/ccgtypes.nim @@ -55,24 +55,38 @@ proc mangleField(m: BModule; name: PIdent): string = if isKeyword(name): result.add "_0" +proc mangleProc(m: BModule; s: PSym; makeUnique: bool): string = + result = "_Z" # Common prefix in Itanium ABI + result.add encodeSym(m, s, makeUnique) + if s.typ.len > 1: #we dont care about the return param + for i in 1..<s.typ.len: + if s.typ[i].isNil: continue + result.add encodeType(m, s.typ[i]) + + if result in m.g.mangledPrcs: + result = mangleProc(m, s, true) + else: + m.g.mangledPrcs.incl(result) + proc fillBackendName(m: BModule; s: PSym) = - if s.loc.r == "": - var result = s.name.s.mangle.rope - result.add "__" - result.add m.g.graph.ifaces[s.itemId.module].uniqueName - result.add "_u" - result.addInt s.itemId.item # s.disamb # + if s.loc.snippet == "": + var result: Rope + if not m.compileToCpp and s.kind in routineKinds and optCDebug in m.g.config.globalOptions and + m.g.config.symbolFiles == disabledSf: + result = mangleProc(m, s, false).rope + else: + result = s.name.s.mangle.rope + result.add mangleProcNameExt(m.g.graph, s) if m.hcrOn: result.add '_' result.add(idOrSig(s, m.module.name.s.mangle, m.sigConflicts, m.config)) - s.loc.r = result + s.loc.snippet = result writeMangledName(m.ndi, s, m.config) proc fillParamName(m: BModule; s: PSym) = - if s.loc.r == "": + if s.loc.snippet == "": var res = s.name.s.mangle - res.add "_p" - res.addInt s.position + res.add mangleParamExt(s) #res.add idOrSig(s, res, m.sigConflicts, m.config) # Take into account if HCR is on because of the following scenario: # if a module gets imported and it has some more importc symbols in it, @@ -90,13 +104,13 @@ proc fillParamName(m: BModule; s: PSym) = # and a function called in main or proxy uses `socket` as a parameter name. # That would lead to either needing to reload `proxy` or to overwrite the # executable file for the main module, which is running (or both!) -> error. - s.loc.r = res.rope + s.loc.snippet = res.rope writeMangledName(m.ndi, s, m.config) proc fillLocalName(p: BProc; s: PSym) = assert s.kind in skLocalVars+{skTemp} #assert sfGlobal notin s.flags - if s.loc.r == "": + if s.loc.snippet == "": var key = s.name.s.mangle let counter = p.sigConflicts.getOrDefault(key) var result = key.rope @@ -106,7 +120,7 @@ proc fillLocalName(p: BProc; s: PSym) = elif counter != 0 or isKeyword(s.name) or p.module.g.config.cppDefines.contains(key): result.add "_" & rope(counter+1) p.sigConflicts.inc(key) - s.loc.r = result + s.loc.snippet = result if s.kind != skTemp: writeMangledName(p.module.ndi, s, p.config) proc scopeMangledParam(p: BProc; param: PSym) = @@ -133,23 +147,23 @@ proc getTypeName(m: BModule; typ: PType; sig: SigHash): Rope = var t = typ while true: if t.sym != nil and {sfImportc, sfExportc} * t.sym.flags != {}: - return t.sym.loc.r + return t.sym.loc.snippet if t.kind in irrelevantForBackend: - t = t.lastSon + t = t.skipModifier else: break - let typ = if typ.kind in {tyAlias, tySink, tyOwned}: typ.lastSon else: typ - if typ.loc.r == "": - typ.typeName(typ.loc.r) - typ.loc.r.add $sig + let typ = if typ.kind in {tyAlias, tySink, tyOwned}: typ.elementType else: typ + if typ.loc.snippet == "": + typ.typeName(typ.loc.snippet) + typ.loc.snippet.add $sig else: when defined(debugSigHashes): # check consistency: var tn = newRopeAppender() typ.typeName(tn) - assert($typ.loc.r == $(tn & $sig)) - result = typ.loc.r + assert($typ.loc.snippet == $(tn & $sig)) + result = typ.loc.snippet if result == "": internalError(m.config, "getTypeName: " & $typ.kind) proc mapSetType(conf: ConfigRef; typ: PType): TCTypeKind = @@ -175,10 +189,10 @@ proc mapType(conf: ConfigRef; typ: PType; isParam: bool): TCTypeKind = of tyObject, tyTuple: result = ctStruct of tyUserTypeClasses: doAssert typ.isResolvedUserTypeClass - return mapType(conf, typ.lastSon, isParam) + result = mapType(conf, typ.skipModifier, isParam) of tyGenericBody, tyGenericInst, tyGenericParam, tyDistinct, tyOrdinal, tyTypeDesc, tyAlias, tySink, tyInferred, tyOwned: - result = mapType(conf, lastSon(typ), isParam) + result = mapType(conf, skipModifier(typ), isParam) of tyEnum: if firstOrd(conf, typ) < 0: result = ctInt32 @@ -189,9 +203,9 @@ proc mapType(conf: ConfigRef; typ: PType; isParam: bool): TCTypeKind = of 4: result = ctInt32 of 8: result = ctInt64 else: result = ctInt32 - of tyRange: result = mapType(conf, typ[0], isParam) + of tyRange: result = mapType(conf, typ.elementType, isParam) of tyPtr, tyVar, tyLent, tyRef: - var base = skipTypes(typ.lastSon, typedescInst) + var base = skipTypes(typ.elementType, typedescInst) case base.kind of tyOpenArray, tyArray, tyVarargs, tyUncheckedArray: result = ctPtrToArray of tySet: @@ -206,7 +220,7 @@ proc mapType(conf: ConfigRef; typ: PType; isParam: bool): TCTypeKind = of tyInt..tyUInt64: result = TCTypeKind(ord(typ.kind) - ord(tyInt) + ord(ctInt)) of tyStatic: - if typ.n != nil: result = mapType(conf, lastSon typ, isParam) + if typ.n != nil: result = mapType(conf, typ.skipModifier, isParam) else: result = ctVoid doAssert(false, "mapType: " & $typ.kind) @@ -231,11 +245,14 @@ proc isImportedCppType(t: PType): bool = proc isOrHasImportedCppType(typ: PType): bool = searchTypeFor(typ.skipTypes({tyRef}), isImportedCppType) +proc hasNoInit(t: PType): bool = + result = t.sym != nil and sfNoInit in t.sym.flags + proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDescKind): Rope proc isObjLackingTypeField(typ: PType): bool {.inline.} = result = (typ.kind == tyObject) and ((tfFinal in typ.flags) and - (typ[0] == nil) or isPureObject(typ)) + (typ.baseClass == nil) or isPureObject(typ)) proc isInvalidReturnType(conf: ConfigRef; typ: PType, isProc = true): bool = # Arrays and sets cannot be returned by a C procedure, because C is @@ -257,9 +274,15 @@ proc isInvalidReturnType(conf: ConfigRef; typ: PType, isProc = true): bool = {tyVar, tyLent, tyRef, tyPtr}) of ctStruct: let t = skipTypes(rettype, typedescInst) - if rettype.isImportedCppType or t.isImportedCppType: return false - result = containsGarbageCollectedRef(t) or - (t.kind == tyObject and not isObjLackingTypeField(t)) + if rettype.isImportedCppType or t.isImportedCppType or + (typ.callConv == ccCDecl and conf.selectedGC in {gcArc, gcAtomicArc, gcOrc}): + # prevents nrvo for cdecl procs; # bug #23401 + result = false + else: + result = containsGarbageCollectedRef(t) or + (t.kind == tyObject and not isObjLackingTypeField(t)) or + (getSize(conf, rettype) == szUnknownSize and (t.sym == nil or sfImportc notin t.sym.flags)) + else: result = false const @@ -267,7 +290,9 @@ const "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 - "N_INLINE", "N_NOINLINE", "N_FASTCALL", "N_THISCALL", "N_CLOSURE", "N_NOCONV"] + "N_INLINE", "N_NOINLINE", "N_FASTCALL", "N_THISCALL", "N_CLOSURE", "N_NOCONV", + "N_NOCONV" #ccMember is N_NOCONV + ] proc cacheGetType(tab: TypeCache; sig: SigHash): Rope = # returns nil if we need to declare this type @@ -296,7 +321,7 @@ proc fillResult(conf: ConfigRef; param: PNode, proctype: PType) = proc typeNameOrLiteral(m: BModule; t: PType, literal: string): Rope = if t.sym != nil and sfImportc in t.sym.flags and t.sym.magic == mNone: useHeader(m, t.sym) - result = t.sym.loc.r + result = t.sym.loc.snippet else: result = rope(literal) @@ -324,14 +349,14 @@ proc getSimpleTypeDesc(m: BModule; typ: PType): Rope = of tyNil: result = typeNameOrLiteral(m, typ, "void*") of tyInt..tyUInt64: result = typeNameOrLiteral(m, typ, NumericalTypeToStr[typ.kind]) - of tyDistinct, tyRange, tyOrdinal: result = getSimpleTypeDesc(m, typ[0]) + of tyDistinct, tyRange, tyOrdinal: result = getSimpleTypeDesc(m, typ.skipModifier) of tyStatic: - if typ.n != nil: result = getSimpleTypeDesc(m, lastSon typ) + if typ.n != nil: result = getSimpleTypeDesc(m, skipModifier typ) else: result = "" internalError(m.config, "tyStatic for getSimpleTypeDesc") of tyGenericInst, tyAlias, tySink, tyOwned: - result = getSimpleTypeDesc(m, lastSon typ) + result = getSimpleTypeDesc(m, skipModifier typ) else: result = "" if result != "" and typ.isImportedType(): @@ -351,13 +376,6 @@ proc getTypePre(m: BModule; typ: PType; sig: SigHash): Rope = result = getSimpleTypeDesc(m, typ) if result == "": result = cacheGetType(m.typeCache, sig) -proc structOrUnion(t: PType): Rope = - let cachedUnion = rope("union") - let cachedStruct = rope("struct") - let t = t.skipTypes({tyAlias, tySink}) - if tfUnion in t.flags: cachedUnion - else: cachedStruct - proc addForwardStructFormat(m: BModule; structOrUnion: Rope, typename: Rope) = if m.compileToCpp: m.s[cfsForwardTypes].addf "$1 $2;$n", [structOrUnion, typename] @@ -456,8 +474,8 @@ macro unrollChars(x: static openArray[char], name, body: untyped) = copy body ))) -proc multiFormat*(frmt: var string, chars : static openArray[char], args: openArray[seq[string]]) = - var res : string +proc multiFormat*(frmt: var string, chars: static openArray[char], args: openArray[seq[string]]) = + var res: string unrollChars(chars, c): res = "" let arg = args[find(chars, c)] @@ -499,15 +517,16 @@ proc genMemberProcParams(m: BModule; prc: PSym, superCall, rettype, name, params weakDep=false;) = let t = prc.typ let isCtor = sfConstructor in prc.flags - if isCtor or (name[0] == '~' and sfMember in prc.flags): #destructors cant have void + if isCtor or (name[0] == '~' and sfMember in prc.flags): + # destructors can't have void rettype = "" - elif t[0] == nil or isInvalidReturnType(m.config, t): + elif t.returnType == nil or isInvalidReturnType(m.config, t): rettype = "void" else: if rettype == "": - rettype = getTypeDescAux(m, t[0], check, dkResult) + rettype = getTypeDescAux(m, t.returnType, check, dkResult) else: - rettype = runtimeFormat(rettype.replace("'0", "$1"), [getTypeDescAux(m, t[0], check, dkResult)]) + rettype = runtimeFormat(rettype.replace("'0", "$1"), [getTypeDescAux(m, t.returnType, check, dkResult)]) var types, names, args: seq[string] = @[] if not isCtor: var this = t.n[1].sym @@ -515,10 +534,10 @@ proc genMemberProcParams(m: BModule; prc: PSym, superCall, rettype, name, params fillLoc(this.loc, locParam, t.n[1], this.paramStorageLoc) if this.typ.kind == tyPtr: - this.loc.r = "this" + this.loc.snippet = "this" else: - this.loc.r = "(*this)" - names.add this.loc.r + this.loc.snippet = "(*this)" + names.add this.loc.snippet types.add getTypeDescWeak(m, this.typ, check, dkParam) let firstParam = if isCtor: 1 else: 2 @@ -531,11 +550,11 @@ proc genMemberProcParams(m: BModule; prc: PSym, superCall, rettype, name, params descKind = dkRefGenericParam else: descKind = dkRefParam - var typ, name : string + var typ, name: string fillParamName(m, param) fillLoc(param.loc, locParam, t.n[i], param.paramStorageLoc) - if ccgIntroducedPtr(m.config, param, t[0]) and descKind == dkParam: + if ccgIntroducedPtr(m.config, param, t.returnType) and descKind == dkParam: typ = getTypeDescWeak(m, param.typ, check, descKind) & "*" incl(param.loc.flags, lfIndirect) param.loc.storage = OnUnknown @@ -546,7 +565,7 @@ proc genMemberProcParams(m: BModule; prc: PSym, superCall, rettype, name, params if sfNoalias in param.flags: typ.add("NIM_NOALIAS ") - name = param.loc.r + name = param.loc.snippet types.add typ names.add name if sfCodegenDecl notin param.flags: @@ -573,10 +592,10 @@ proc genProcParams(m: BModule; t: PType, rettype, params: var Rope, check: var IntSet, declareEnvironment=true; weakDep=false;) = params = "(" - if t[0] == nil or isInvalidReturnType(m.config, t): + if t.returnType == nil or isInvalidReturnType(m.config, t): rettype = "void" else: - rettype = getTypeDescAux(m, t[0], check, dkResult) + rettype = getTypeDescAux(m, t.returnType, check, dkResult) for i in 1..<t.n.len: if t.n[i].kind != nkSym: internalError(m.config, t.n.info, "genProcParams") var param = t.n[i].sym @@ -592,7 +611,7 @@ proc genProcParams(m: BModule; t: PType, rettype, params: var Rope, fillLoc(param.loc, locParam, t.n[i], param.paramStorageLoc) var typ: Rope - if ccgIntroducedPtr(m.config, param, t[0]) and descKind == dkParam: + if ccgIntroducedPtr(m.config, param, t.returnType) and descKind == dkParam: typ = (getTypeDescWeak(m, param.typ, check, descKind)) typ.add("*") incl(param.loc.flags, lfIndirect) @@ -606,24 +625,24 @@ proc genProcParams(m: BModule; t: PType, rettype, params: var Rope, typ.add("NIM_NOALIAS ") if sfCodegenDecl notin param.flags: params.add(typ) - params.add(param.loc.r) + params.add(param.loc.snippet) else: - params.add runtimeFormat(param.cgDeclFrmt, [typ, param.loc.r]) + params.add runtimeFormat(param.cgDeclFrmt, [typ, param.loc.snippet]) # declare the len field for open arrays: var arr = param.typ.skipTypes({tyGenericInst}) - if arr.kind in {tyVar, tyLent, tySink}: arr = arr.lastSon + if arr.kind in {tyVar, tyLent, tySink}: arr = arr.elementType var j = 0 while arr.kind in {tyOpenArray, tyVarargs}: # this fixes the 'sort' bug: if param.typ.kind in {tyVar, tyLent}: param.loc.storage = OnUnknown # need to pass hidden parameter: - params.addf(", NI $1Len_$2", [param.loc.r, j.rope]) + params.addf(", NI $1Len_$2", [param.loc.snippet, j.rope]) inc(j) arr = arr[0].skipTypes({tySink}) - if t[0] != nil and isInvalidReturnType(m.config, t): - var arr = t[0] + if t.returnType != nil and isInvalidReturnType(m.config, t): + var arr = t.returnType if params != "(": params.add(", ") - if mapReturnType(m.config, t[0]) != ctArray: + if mapReturnType(m.config, arr) != ctArray: if isHeaderFile in m.flags: # still generates types for `--header` params.add(getTypeDescAux(m, arr, check, dkResult)) @@ -645,7 +664,7 @@ proc genProcParams(m: BModule; t: PType, rettype, params: var Rope, proc mangleRecFieldName(m: BModule; field: PSym): Rope = if {sfImportc, sfExportc} * field.flags != {}: - result = field.loc.r + result = field.loc.snippet else: result = rope(mangleField(m, field.name)) if result == "": internalError(m.config, field.info, "mangleRecFieldName") @@ -657,9 +676,9 @@ proc hasCppCtor(m: BModule; typ: PType): bool = if sfConstructor in prc.flags: return true -proc genCppParamsForCtor(p: BProc; call: PNode): string +proc genCppParamsForCtor(p: BProc; call: PNode; didGenTemp: var bool): string -proc genCppInitializer(m: BModule, prc: BProc; typ: PType): string = +proc genCppInitializer(m: BModule, prc: BProc; typ: PType; didGenTemp: var bool): string = #To avoid creating a BProc per test when called inside a struct nil BProc is allowed result = "{}" if typ.itemId in m.g.graph.initializersPerType: @@ -668,13 +687,13 @@ proc genCppInitializer(m: BModule, prc: BProc; typ: PType): string = var p = prc if p == nil: p = BProc(module: m) - result = "{" & genCppParamsForCtor(p, call) & "}" + result = "{" & genCppParamsForCtor(p, call, didGenTemp) & "}" if prc == nil: assert p.blocks.len == 0, "BProc belongs to a struct doesnt have blocks" proc genRecordFieldsAux(m: BModule; n: PNode, rectype: PType, - check: var IntSet; result: var Rope; unionPrefix = "") = + check: var IntSet; result: var Builder; unionPrefix = "") = case n.kind of nkRecList: for i in 0..<n.len: @@ -691,63 +710,51 @@ proc genRecordFieldsAux(m: BModule; n: PNode, let k = lastSon(n[i]) if k.kind != nkSym: let structName = "_" & mangleRecFieldName(m, n[0].sym) & "_" & $i - var a = newRopeAppender() + var a = newBuilder("") genRecordFieldsAux(m, k, rectype, check, a, unionPrefix & $structName & ".") - if a != "": - if tfPacked notin rectype.flags: - unionBody.add("struct {") - else: - if hasAttribute in CC[m.config.cCompiler].props: - unionBody.add("struct __attribute__((__packed__)){") - else: - unionBody.addf("#pragma pack(push, 1)$nstruct{", []) - unionBody.add(a) - unionBody.addf("} $1;$n", [structName]) - if tfPacked in rectype.flags and hasAttribute notin CC[m.config.cCompiler].props: - unionBody.addf("#pragma pack(pop)$n", []) + if a.len != 0: + unionBody.addFieldWithStructType(m, rectype, structName): + unionBody.add(a) else: genRecordFieldsAux(m, k, rectype, check, unionBody, unionPrefix) else: internalError(m.config, "genRecordFieldsAux(record case branch)") - if unionBody != "": - result.addf("union{\n$1};$n", [unionBody]) + if unionBody.len != 0: + result.addAnonUnion: + result.add(unionBody) of nkSym: let field = n.sym if field.typ.kind == tyVoid: return #assert(field.ast == nil) let sname = mangleRecFieldName(m, field) fillLoc(field.loc, locField, n, unionPrefix & sname, OnUnknown) - if field.alignment > 0: - result.addf "NIM_ALIGN($1) ", [rope(field.alignment)] # for importcpp'ed objects, we only need to set field.loc, but don't # have to recurse via 'getTypeDescAux'. And not doing so prevents problems # with heavily templatized C++ code: if not isImportedCppType(rectype): - let noAlias = if sfNoalias in field.flags: " NIM_NOALIAS" else: "" - let fieldType = field.loc.lode.typ.skipTypes(abstractInst) + var typ: Rope = "" + var isFlexArray = false + var initializer = "" if fieldType.kind == tyUncheckedArray: - result.addf("\t$1 $2[SEQ_DECL_SIZE];$n", - [getTypeDescAux(m, fieldType.elemType, check, dkField), sname]) + typ = getTypeDescAux(m, fieldType.elemType, check, dkField) + isFlexArray = true elif fieldType.kind == tySequence: # we need to use a weak dependency here for trecursive_table. - result.addf("\t$1$3 $2;$n", [getTypeDescWeak(m, field.loc.t, check, dkField), sname, noAlias]) - elif field.bitsize != 0: - result.addf("\t$1$4 $2:$3;$n", [getTypeDescAux(m, field.loc.t, check, dkField), sname, rope($field.bitsize), noAlias]) + typ = getTypeDescWeak(m, field.loc.t, check, dkField) else: + typ = getTypeDescAux(m, field.loc.t, check, dkField) # don't use fieldType here because we need the # tyGenericInst for C++ template support let noInit = sfNoInit in field.flags or (field.typ.sym != nil and sfNoInit in field.typ.sym.flags) if not noInit and (fieldType.isOrHasImportedCppType() or hasCppCtor(m, field.owner.typ)): - var initializer = genCppInitializer(m, nil, fieldType) - result.addf("\t$1$3 $2$4;$n", [getTypeDescAux(m, field.loc.t, check, dkField), sname, noAlias, initializer]) - else: - result.addf("\t$1$3 $2;$n", [getTypeDescAux(m, field.loc.t, check, dkField), sname, noAlias]) + var didGenTemp = false + initializer = genCppInitializer(m, nil, fieldType, didGenTemp) + result.addField(field, sname, typ, isFlexArray, initializer) else: internalError(m.config, n.info, "genRecordFieldsAux()") proc genMemberProcHeader(m: BModule; prc: PSym; result: var Rope; asPtr: bool = false, isFwdDecl:bool = false) -proc getRecordFields(m: BModule; typ: PType, check: var IntSet): Rope = - result = newRopeAppender() +proc addRecordFields(result: var Builder; m: BModule; typ: PType, check: var IntSet) = genRecordFieldsAux(m, typ.n, typ, check, result) if typ.itemId in m.g.graph.memberProcsPerType: let procs = m.g.graph.memberProcsPerType[typ.itemId] @@ -762,95 +769,41 @@ proc getRecordFields(m: BModule; typ: PType, check: var IntSet): Rope = genMemberProcHeader(m, prc, header, false, true) result.addf "$1;$n", [header] if isCtorGen and not isDefaultCtorGen: - var ch: IntSet + var ch: IntSet = default(IntSet) result.addf "$1() = default;$n", [getTypeDescAux(m, typ, ch, dkOther)] proc fillObjectFields*(m: BModule; typ: PType) = # sometimes generic objects are not consistently merged. We patch over # this fact here. var check = initIntSet() - discard getRecordFields(m, typ, check) + var ignored = newBuilder("") + addRecordFields(ignored, m, typ, check) proc mangleDynLibProc(sym: PSym): Rope -proc getRecordDescAux(m: BModule; typ: PType, name, baseType: Rope, - check: var IntSet, hasField:var bool): Rope = - result = "" - if typ.kind == tyObject: - if typ[0] == nil: - if lacksMTypeField(typ): - appcg(m, result, " {$n", []) - else: - if optTinyRtti in m.config.globalOptions: - appcg(m, result, " {$n#TNimTypeV2* m_type;$n", []) - else: - appcg(m, result, " {$n#TNimType* m_type;$n", []) - hasField = true - elif m.compileToCpp: - appcg(m, result, " : public $1 {$n", [baseType]) - if typ.isException and m.config.exc == excCpp: - when false: - appcg(m, result, "virtual void raise() { throw *this; }$n", []) # required for polymorphic exceptions - if typ.sym.magic == mException: - # Add cleanup destructor to Exception base class - appcg(m, result, "~$1();$n", [name]) - # define it out of the class body and into the procs section so we don't have to - # artificially forward-declare popCurrentExceptionEx (very VERY troublesome for HCR) - appcg(m, cfsProcs, "inline $1::~$1() {if(this->raiseId) #popCurrentExceptionEx(this->raiseId);}$n", [name]) - hasField = true - else: - appcg(m, result, " {$n $1 Sup;$n", [baseType]) - hasField = true - else: - result.addf(" {$n", [name]) - proc getRecordDesc(m: BModule; typ: PType, name: Rope, check: var IntSet): Rope = # declare the record: - var hasField = false - var structOrUnion: string - if tfPacked in typ.flags: - if hasAttribute in CC[m.config.cCompiler].props: - structOrUnion = structOrUnion(typ) & " __attribute__((__packed__))" - else: - structOrUnion = "#pragma pack(push, 1)\L" & structOrUnion(typ) - else: - structOrUnion = structOrUnion(typ) var baseType: string = "" - if typ[0] != nil: - baseType = getTypeDescAux(m, typ[0].skipTypes(skipPtrs), check, dkField) + if typ.baseClass != nil: + baseType = getTypeDescAux(m, typ.baseClass.skipTypes(skipPtrs), check, dkField) if typ.sym == nil or sfCodegenDecl notin typ.sym.flags: - result = structOrUnion & " " & name - result.add(getRecordDescAux(m, typ, name, baseType, check, hasField)) - let desc = getRecordFields(m, typ, check) - if not hasField and typ.itemId notin m.g.graph.memberProcsPerType: - if desc == "": - result.add("\tchar dummy;\n") - elif typ.len == 1 and typ.n[0].kind == nkSym: - let field = typ.n[0].sym - let fieldType = field.typ.skipTypes(abstractInst) - if fieldType.kind == tyUncheckedArray: - result.add("\tchar dummy;\n") - result.add(desc) - else: - result.add(desc) - result.add("};\L") + result = newBuilder("") + result.addStruct(m, typ, name, baseType): + result.addRecordFields(m, typ, check) else: - let desc = getRecordFields(m, typ, check) + var desc = newBuilder("") + desc.addRecordFields(m, typ, check) result = runtimeFormat(typ.sym.cgDeclFrmt, [name, desc, baseType]) - if tfPacked in typ.flags and hasAttribute notin CC[m.config.cCompiler].props: - result.add "#pragma pack(pop)\L" proc getTupleDesc(m: BModule; typ: PType, name: Rope, check: var IntSet): Rope = - result = "$1 $2 {$n" % [structOrUnion(typ), name] - var desc: Rope = "" - for i in 0..<typ.len: - desc.addf("$1 Field$2;$n", - [getTypeDescAux(m, typ[i], check, dkField), rope(i)]) - if desc == "": result.add("char dummy;\L") - else: result.add(desc) - result.add("};\L") + result = newBuilder("") + result.addStruct(m, typ, name, ""): + for i, a in typ.ikids: + result.addField( + name = "Field" & $i, + typ = getTypeDescAux(m, a, check, dkField)) proc scanCppGenericSlot(pat: string, cursor, outIdx, outStars: var int): bool = # A helper proc for handling cppimport patterns, involving numeric @@ -872,25 +825,25 @@ proc scanCppGenericSlot(pat: string, cursor, outIdx, outStars: var int): bool = proc resolveStarsInCppType(typ: PType, idx, stars: int): PType = # Make sure the index refers to one of the generic params of the type. # XXX: we should catch this earlier and report it as a semantic error. - if idx >= typ.len: + if idx >= typ.kidsLen: raiseAssert "invalid apostrophe type parameter index" result = typ[idx] for i in 1..stars: - if result != nil and result.len > 0: - result = if result.kind == tyGenericInst: result[1] + if result != nil and result.kidsLen > 0: + result = if result.kind == tyGenericInst: result[FirstGenericParamAt] else: result.elemType proc getOpenArrayDesc(m: BModule; t: PType, check: var IntSet; kind: TypeDescKind): Rope = let sig = hashType(t, m.config) if kind == dkParam: - result = getTypeDescWeak(m, t[0], check, kind) & "*" + result = getTypeDescWeak(m, t.elementType, check, kind) & "*" else: result = cacheGetType(m.typeCache, sig) if result == "": result = getTypeName(m, t, sig) m.typeCache[sig] = result - let elemType = getTypeDescWeak(m, t[0], check, kind) + let elemType = getTypeDescWeak(m, t.elementType, check, kind) m.s[cfsTypes].addf("typedef struct {$n$2* Field0;$nNI Field1;$n} $1;$n", [result, elemType]) @@ -907,12 +860,11 @@ proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDes if t != origTyp and origTyp.sym != nil: useHeader(m, origTyp.sym) let sig = hashType(origTyp, m.config) - result = "" # todo move `result = getTypePre(m, t, sig)` here ? + result = getTypePre(m, t, sig) defer: # defer is the simplest in this case if isImportedType(t) and not m.typeABICache.containsOrIncl(sig): addAbiCheck(m, t, result) - result = getTypePre(m, t, sig) if result != "" and t.kind != tyOpenArray: excl(check, t.id) if kind == dkRefParam or kind == dkRefGenericParam and origTyp.kind == tyGenericInst: @@ -922,7 +874,7 @@ proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDes of tyRef, tyPtr, tyVar, tyLent: var star = if t.kind in {tyVar} and tfVarIsPtr notin origTyp.flags and compileToCpp(m): "&" else: "*" - var et = origTyp.skipTypes(abstractInst).lastSon + var et = origTyp.skipTypes(abstractInst).elementType var etB = et.skipTypes(abstractInst) if mapType(m.config, t, kind == dkParam) == ctPtrToArray and (etB.kind != tyOpenArray or kind == dkParam): if etB.kind == tySet: @@ -1014,19 +966,15 @@ proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDes assert(cacheGetType(m.typeCache, sig) == "") m.typeCache[sig] = result & seqStar(m) if not isImportedType(t): - if skipTypes(t[0], typedescInst).kind != tyEmpty: - const - cppSeq = "struct $2 : #TGenericSeq {$n" - cSeq = "struct $2 {$n" & - " #TGenericSeq Sup;$n" - if m.compileToCpp: - appcg(m, m.s[cfsSeqTypes], - cppSeq & " $1 data[SEQ_DECL_SIZE];$n" & - "};$n", [getTypeDescAux(m, t[0], check, kind), result]) - else: - appcg(m, m.s[cfsSeqTypes], - cSeq & " $1 data[SEQ_DECL_SIZE];$n" & - "};$n", [getTypeDescAux(m, t[0], check, kind), result]) + if skipTypes(t.elementType, typedescInst).kind != tyEmpty: + var struct = newBuilder("") + let baseType = cgsymValue(m, "TGenericSeq") + struct.addSimpleStruct(m, name = result, baseType = baseType): + struct.addField( + name = "data", + typ = getTypeDescAux(m, t.elementType, check, kind), + isFlexArray = true) + m.s[cfsSeqTypes].add struct else: result = rope("TGenericSeq") result.add(seqStar(m)) @@ -1034,7 +982,7 @@ proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDes result = getTypeName(m, origTyp, sig) m.typeCache[sig] = result if not isImportedType(t): - let foo = getTypeDescAux(m, t[0], check, kind) + let foo = getTypeDescAux(m, t.elementType, check, kind) m.s[cfsTypes].addf("typedef $1 $2[1];$n", [foo, result]) of tyArray: var n: BiggestInt = toInt64(lengthOrd(m.config, t)) @@ -1042,9 +990,9 @@ proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDes result = getTypeName(m, origTyp, sig) m.typeCache[sig] = result if not isImportedType(t): - let foo = getTypeDescAux(m, t[1], check, kind) + let e = getTypeDescAux(m, t.elementType, check, kind) m.s[cfsTypes].addf("typedef $1 $2[$3];$n", - [foo, result, rope(n)]) + [e, result, rope(n)]) of tyObject, tyTuple: let tt = origTyp.skipTypes({tyDistinct}) if isImportedCppType(t) and tt.kind == tyGenericInst: @@ -1079,9 +1027,9 @@ proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDes result.add cppName.substr(chunkStart) else: result = cppNameAsRope & "<" - for i in 1..<tt.len-1: - if i > 1: result.add(" COMMA ") - addResultType(tt[i]) + for needsComma, a in tt.genericInstParams: + if needsComma: result.add(" COMMA ") + addResultType(a) result.add("> ") # always call for sideeffects: assert t.kind != tyTuple @@ -1112,8 +1060,8 @@ proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDes of tySet: # Don't use the imported name as it may be scoped: 'Foo::SomeKind' result = rope("tySet_") - t.lastSon.typeName(result) - result.add $t.lastSon.hashType(m.config) + t.elementType.typeName(result) + result.add $t.elementType.hashType(m.config) m.typeCache[sig] = result if not isImportedType(t): let s = int(getSize(m.config, t)) @@ -1123,7 +1071,7 @@ proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDes [result, rope(getSize(m.config, t))]) of tyGenericInst, tyDistinct, tyOrdinal, tyTypeDesc, tyAlias, tySink, tyOwned, tyUserTypeClass, tyUserTypeClassInst, tyInferred: - result = getTypeDescAux(m, lastSon(t), check, kind) + result = getTypeDescAux(m, skipModifier(t), check, kind) else: internalError(m.config, "getTypeDescAux(" & $t.kind & ')') result = "" @@ -1175,12 +1123,15 @@ proc isReloadable(m: BModule; prc: PSym): bool = proc isNonReloadable(m: BModule; prc: PSym): bool = return m.hcrOn and sfNonReloadable in prc.flags -proc parseVFunctionDecl(val: string; name, params, retType, superCall: var string; isFnConst, isOverride, isMemberVirtual: var bool; isCtor: bool, isFunctor=false) = +proc parseVFunctionDecl(val: string; name, params, retType, superCall: var string; isFnConst, isOverride, isMemberVirtual, isStatic: var bool; isCtor: bool, isFunctor=false) = var afterParams: string = "" if scanf(val, "$*($*)$s$*", name, params, afterParams): if name.strip() == "operator" and params == "": #isFunctor? - parseVFunctionDecl(afterParams, name, params, retType, superCall, isFnConst, isOverride, isMemberVirtual, isCtor, true) + parseVFunctionDecl(afterParams, name, params, retType, superCall, isFnConst, isOverride, isMemberVirtual, isStatic, isCtor, true) return + if name.find("static ") > -1: + isStatic = true + name = name.replace("static ", "") isFnConst = afterParams.find("const") > -1 isOverride = afterParams.find("override") > -1 isMemberVirtual = name.find("virtual ") > -1 @@ -1195,7 +1146,7 @@ proc parseVFunctionDecl(val: string; name, params, retType, superCall: var strin params = "(" & params & ")" -proc genMemberProcHeader(m: BModule; prc: PSym; result: var Rope; asPtr: bool = false, isFwdDecl : bool = false) = +proc genMemberProcHeader(m: BModule; prc: PSym; result: var Rope; asPtr: bool = false, isFwdDecl: bool = false) = assert sfCppMember * prc.flags != {} let isCtor = sfConstructor in prc.flags var check = initIntSet() @@ -1204,17 +1155,17 @@ proc genMemberProcHeader(m: BModule; prc: PSym; result: var Rope; asPtr: bool = var memberOp = "#." #only virtual var typ: PType if isCtor: - typ = prc.typ[0] + typ = prc.typ.returnType else: - typ = prc.typ[1] + typ = prc.typ.firstParamType if typ.kind == tyPtr: - typ = typ[0] + typ = typ.elementType memberOp = "#->" var typDesc = getTypeDescWeak(m, typ, check, dkParam) let asPtrStr = rope(if asPtr: "_PTR" else: "") var name, params, rettype, superCall: string = "" - var isFnConst, isOverride, isMemberVirtual: bool = false - parseVFunctionDecl(prc.constraint.strVal, name, params, rettype, superCall, isFnConst, isOverride, isMemberVirtual, isCtor) + var isFnConst, isOverride, isMemberVirtual, isStatic: bool = false + parseVFunctionDecl(prc.constraint.strVal, name, params, rettype, superCall, isFnConst, isOverride, isMemberVirtual, isStatic, isCtor) genMemberProcParams(m, prc, superCall, rettype, name, params, check, true, false) let isVirtual = sfVirtual in prc.flags or isMemberVirtual var fnConst, override: string = "" @@ -1223,6 +1174,8 @@ proc genMemberProcHeader(m: BModule; prc: PSym; result: var Rope; asPtr: bool = if isFnConst: fnConst = " const" if isFwdDecl: + if isStatic: + result.add "static " if isVirtual: rettype = "virtual " & rettype if isOverride: @@ -1230,7 +1183,7 @@ proc genMemberProcHeader(m: BModule; prc: PSym; result: var Rope; asPtr: bool = superCall = "" else: if not isCtor: - prc.loc.r = "$1$2(@)" % [memberOp, name] + prc.loc.snippet = "$1$2(@)" % [memberOp, name] elif superCall != "": superCall = " : " & superCall @@ -1251,7 +1204,7 @@ proc genProcHeader(m: BModule; prc: PSym; result: var Rope; asPtr: bool = false) # handle the 2 options for hotcodereloading codegen - function pointer # (instead of forward declaration) or header for function body with "_actual" postfix let asPtrStr = rope(if asPtr: "_PTR" else: "") - var name = prc.loc.r + var name = prc.loc.snippet if not asPtr and isReloadable(m, prc): name.add("_actual") # careful here! don't access ``prc.ast`` as that could reload large parts of @@ -1333,8 +1286,8 @@ proc genTypeInfoAuxBase(m: BModule; typ, origType: PType; proc genTypeInfoAux(m: BModule; typ, origType: PType, name: Rope; info: TLineInfo) = var base: Rope - if typ.len > 0 and typ.lastSon != nil: - var x = typ.lastSon + if typ.hasElementType and typ.last != nil: + var x = typ.last if typ.kind == tyObject: x = x.skipTypes(skipPtrs) if typ.kind == tyPtr and x.kind == tyObject and incompleteType(x): base = rope("0") @@ -1391,13 +1344,13 @@ proc genObjectFields(m: BModule; typ, origType: PType, n: PNode, expr: Rope; var tmp = discriminatorTableName(m, typ, field) var L = lengthOrd(m.config, field.typ) assert L > 0 - if field.loc.r == "": fillObjectFields(m, typ) + if field.loc.snippet == "": fillObjectFields(m, typ) if field.loc.t == nil: internalError(m.config, n.info, "genObjectFields") m.s[cfsTypeInit3].addf("$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, origType, dkVar), field.loc.r, + "$1.len = $7;$n", [expr, getTypeDesc(m, origType, dkVar), field.loc.snippet, genTypeInfoV1(m, field.typ, info), makeCString(field.name.s), tmp, rope(L)]) @@ -1429,41 +1382,38 @@ proc genObjectFields(m: BModule; typ, origType: PType, n: PNode, expr: Rope; # Do not produce code for void types if isEmptyType(field.typ): return if field.bitsize == 0: - if field.loc.r == "": fillObjectFields(m, typ) + if field.loc.snippet == "": fillObjectFields(m, typ) if field.loc.t == nil: internalError(m.config, n.info, "genObjectFields") m.s[cfsTypeInit3].addf("$1.kind = 1;$n" & "$1.offset = offsetof($2, $3);$n" & "$1.typ = $4;$n" & "$1.name = $5;$n", [expr, getTypeDesc(m, origType, dkVar), - field.loc.r, genTypeInfoV1(m, field.typ, info), makeCString(field.name.s)]) + field.loc.snippet, genTypeInfoV1(m, field.typ, info), makeCString(field.name.s)]) else: internalError(m.config, n.info, "genObjectFields") proc genObjectInfo(m: BModule; typ, origType: PType, name: Rope; info: TLineInfo) = - if typ.kind == tyObject: - if incompleteType(typ): - localError(m.config, info, "request for RTTI generation for incomplete object: " & - typeToString(typ)) - genTypeInfoAux(m, typ, origType, name, info) - else: - genTypeInfoAuxBase(m, typ, origType, name, rope("0"), info) + assert typ.kind == tyObject + if incompleteType(typ): + localError(m.config, info, "request for RTTI generation for incomplete object: " & + typeToString(typ)) + genTypeInfoAux(m, typ, origType, name, info) var tmp = getNimNode(m) - if not isImportedType(typ): + if (not isImportedType(typ)) or tfCompleteStruct in typ.flags: genObjectFields(m, typ, origType, typ.n, tmp, info) m.s[cfsTypeInit3].addf("$1.node = &$2;$n", [tiNameForHcr(m, name), tmp]) - var t = typ[0] + var t = typ.baseClass while t != nil: t = t.skipTypes(skipPtrs) t.flags.incl tfObjHasKids - t = t[0] + t = t.baseClass proc genTupleInfo(m: BModule; typ, origType: PType, name: Rope; info: TLineInfo) = genTypeInfoAuxBase(m, typ, typ, name, rope("0"), info) var expr = getNimNode(m) - if typ.len > 0: - var tmp = getTempName(m) & "_" & $typ.len - genTNimNodeArray(m, tmp, rope(typ.len)) - for i in 0..<typ.len: - var a = typ[i] + if not typ.isEmptyTupleType: + var tmp = getTempName(m) & "_" & $typ.kidsLen + genTNimNodeArray(m, tmp, rope(typ.kidsLen)) + for i, a in typ.ikids: var tmp2 = getNimNode(m) m.s[cfsTypeInit3].addf("$1[$2] = &$3;$n", [tmp, rope(i), tmp2]) m.s[cfsTypeInit3].addf("$1.kind = 1;$n" & @@ -1472,10 +1422,10 @@ proc genTupleInfo(m: BModule; typ, origType: PType, name: Rope; info: TLineInfo) "$1.name = \"Field$3\";$n", [tmp2, getTypeDesc(m, origType, dkVar), rope(i), genTypeInfoV1(m, a, info)]) m.s[cfsTypeInit3].addf("$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n", - [expr, rope(typ.len), tmp]) + [expr, rope(typ.kidsLen), tmp]) else: m.s[cfsTypeInit3].addf("$1.len = $2; $1.kind = 2;$n", - [expr, rope(typ.len)]) + [expr, rope(typ.kidsLen)]) m.s[cfsTypeInit3].addf("$1.node = &$2;$n", [tiNameForHcr(m, name), expr]) proc genEnumInfo(m: BModule; typ: PType, name: Rope; info: TLineInfo) = @@ -1520,14 +1470,14 @@ proc genEnumInfo(m: BModule; typ: PType, name: Rope; info: TLineInfo) = m.s[cfsTypeInit3].addf("$1.flags = 1<<2;$n", [tiNameForHcr(m, name)]) proc genSetInfo(m: BModule; typ: PType, name: Rope; info: TLineInfo) = - assert(typ[0] != nil) + assert(typ.elementType != nil) genTypeInfoAux(m, typ, typ, name, info) var tmp = getNimNode(m) m.s[cfsTypeInit3].addf("$1.len = $2; $1.kind = 0;$n$3.node = &$1;$n", [tmp, rope(firstOrd(m.config, typ)), tiNameForHcr(m, name)]) proc genArrayInfo(m: BModule; typ: PType, name: Rope; info: TLineInfo) = - genTypeInfoAuxBase(m, typ, typ, name, genTypeInfoV1(m, typ[1], info), info) + genTypeInfoAuxBase(m, typ, typ, name, genTypeInfoV1(m, typ.elementType, info), info) proc fakeClosureType(m: BModule; owner: PSym): PType = # we generate the same RTTI as for a tuple[pointer, ref tuple[]] @@ -1543,7 +1493,7 @@ include ccgtrav proc genDeepCopyProc(m: BModule; s: PSym; result: Rope) = genProc(m, s) m.s[cfsTypeInit3].addf("$1.deepcopy =(void* (N_RAW_NIMCALL*)(void*))$2;$n", - [result, s.loc.r]) + [result, s.loc.snippet]) proc declareNimType(m: BModule; name: string; str: Rope, module: int) = let nr = rope(name) @@ -1596,14 +1546,14 @@ proc generateRttiDestructor(g: ModuleGraph; typ: PType; owner: PSym; kind: TType n[paramsPos] = result.typ.n let body = newNodeI(nkStmtList, info) let castType = makePtrType(typ, idgen) - if theProc.typ[1].kind != tyVar: + if theProc.typ.firstParamType.kind != tyVar: body.add newTreeI(nkCall, info, newSymNode(theProc), newDeref(newTreeIT( nkCast, info, castType, newNodeIT(nkType, info, castType), newSymNode(dest) )) ) else: - let addrOf = newNodeIT(nkAddr, info, theProc.typ[1]) + let addrOf = newNodeIT(nkHiddenAddr, info, theProc.typ.firstParamType) addrOf.add newDeref(newTreeIT( nkCast, info, castType, newNodeIT(nkType, info, castType), newSymNode(dest) @@ -1631,10 +1581,10 @@ proc genHook(m: BModule; t: PType; info: TLineInfo; op: TTypeAttachedOp; result: let wrapper = generateRttiDestructor(m.g.graph, t, theProc.owner, attachedDestructor, theProc.info, m.idgen, theProc) genProc(m, wrapper) - result.add wrapper.loc.r + result.add wrapper.loc.snippet else: genProc(m, theProc) - result.add theProc.loc.r + result.add theProc.loc.snippet when false: if not canFormAcycle(m.g.graph, t) and op == attachedTrace: @@ -1682,7 +1632,7 @@ proc genVTable(seqs: seq[PSym]): string = result = "{" for i in 0..<seqs.len: if i > 0: result.add ", " - result.add "(void *) " & seqs[i].loc.r + result.add "(void *) " & seqs[i].loc.snippet result.add "}" proc genTypeInfoV2OldImpl(m: BModule; t, origType: PType, name: Rope; info: TLineInfo) = @@ -1731,7 +1681,7 @@ proc genTypeInfoV2OldImpl(m: BModule; t, origType: PType, name: Rope; info: TLin m.s[cfsTypeInit3].add typeEntry - if t.kind == tyObject and t.len > 0 and t[0] != nil and optEnableDeepCopy in m.config.globalOptions: + if t.kind == tyObject and t.baseClass != nil and optEnableDeepCopy in m.config.globalOptions: discard genTypeInfoV1(m, t, info) proc genTypeInfoV2Impl(m: BModule; t, origType: PType, name: Rope; info: TLineInfo) = @@ -1781,7 +1731,7 @@ proc genTypeInfoV2Impl(m: BModule; t, origType: PType, name: Rope; info: TLineIn addf(typeEntry, ", .flags = $1};$n", [rope(flags)]) m.s[cfsVars].add typeEntry - if t.kind == tyObject and t.len > 0 and t[0] != nil and optEnableDeepCopy in m.config.globalOptions: + if t.kind == tyObject and t.baseClass != nil and optEnableDeepCopy in m.config.globalOptions: discard genTypeInfoV1(m, t, info) proc genTypeInfoV2(m: BModule; t: PType; info: TLineInfo): Rope = @@ -1827,7 +1777,7 @@ proc openArrayToTuple(m: BModule; t: PType): PType = result = newType(tyTuple, m.idgen, t.owner) let p = newType(tyPtr, m.idgen, t.owner) let a = newType(tyUncheckedArray, m.idgen, t.owner) - a.add t.lastSon + a.add t.elementType p.add a result.add p result.add getSysType(m.g.graph, t.owner.info, tyInt) @@ -1837,8 +1787,7 @@ proc typeToC(t: PType): string = ## to be unique. let s = typeToString(t) result = newStringOfCap(s.len) - for i in 0..<s.len: - let c = s[i] + for c in s: case c of 'a'..'z': result.add c @@ -1909,11 +1858,11 @@ proc genTypeInfoV1(m: BModule; t: PType; info: TLineInfo): Rope = of tyPointer, tyBool, tyChar, tyCstring, tyString, tyInt..tyUInt64, tyVar, tyLent: genTypeInfoAuxBase(m, t, t, result, rope"0", info) of tyStatic: - if t.n != nil: result = genTypeInfoV1(m, lastSon t, info) + if t.n != nil: result = genTypeInfoV1(m, skipModifier t, info) else: internalError(m.config, "genTypeInfoV1(" & $t.kind & ')') of tyUserTypeClasses: internalAssert m.config, t.isResolvedUserTypeClass - return genTypeInfoV1(m, t.lastSon, info) + return genTypeInfoV1(m, t.skipModifier, info) of tyProc: if t.callConv != ccClosure: genTypeInfoAuxBase(m, t, t, result, rope"0", info) @@ -1972,8 +1921,11 @@ proc genTypeSection(m: BModule, n: PNode) = if len(n[i]) == 0: continue if n[i][0].kind != nkPragmaExpr: continue for p in 0..<n[i][0].len: - if (n[i][0][p].kind != nkSym): continue - if sfExportc in n[i][0][p].sym.flags: - discard getTypeDescAux(m, n[i][0][p].typ, intSet, descKindFromSymKind(n[i][0][p].sym.kind)) + if (n[i][0][p].kind notin {nkSym, nkPostfix}): continue + var s = n[i][0][p] + if s.kind == nkPostfix: + s = n[i][0][p][1] + if {sfExportc, sfCompilerProc} * s.sym.flags == {sfExportc}: + discard getTypeDescAux(m, s.typ, intSet, descKindFromSymKind(s.sym.kind)) if m.g.generatedHeader != nil: - discard getTypeDescAux(m.g.generatedHeader, n[i][0][p].typ, intSet, descKindFromSymKind(n[i][0][p].sym.kind)) + discard getTypeDescAux(m.g.generatedHeader, s.typ, intSet, descKindFromSymKind(s.sym.kind)) diff --git a/compiler/ccgutils.nim b/compiler/ccgutils.nim index bfb429f82..c0e574186 100644 --- a/compiler/ccgutils.nim +++ b/compiler/ccgutils.nim @@ -11,9 +11,9 @@ import ast, types, msgs, wordrecg, - platform, trees, options, cgendata + platform, trees, options, cgendata, mangleutils -import std/[hashes, strutils] +import std/[hashes, strutils, formatfloat] when defined(nimPreviewSlimSystem): import std/assertions @@ -68,53 +68,6 @@ proc makeSingleLineCString*(s: string): string = c.toCChar(result) result.add('\"') -proc mangle*(name: string): string = - result = newStringOfCap(name.len) - var start = 0 - if name[0] in Digits: - result.add("X" & name[0]) - start = 1 - var requiresUnderscore = false - template special(x) = - result.add x - requiresUnderscore = true - for i in start..<name.len: - let c = name[i] - case c - of 'a'..'z', '0'..'9', 'A'..'Z': - result.add(c) - of '_': - # we generate names like 'foo_9' for scope disambiguations and so - # disallow this here: - if i > 0 and i < name.len-1 and name[i+1] in Digits: - discard - else: - result.add(c) - of '$': special "dollar" - of '%': special "percent" - of '&': special "amp" - of '^': special "roof" - of '!': special "emark" - of '?': special "qmark" - of '*': special "star" - of '+': special "plus" - of '-': special "minus" - of '/': special "slash" - of '\\': special "backslash" - of '=': special "eq" - of '<': special "lt" - of '>': special "gt" - of '~': special "tilde" - of ':': special "colon" - of '.': special "dot" - of '@': special "at" - of '|': special "bar" - else: - result.add("X" & toHex(ord(c), 2)) - requiresUnderscore = true - if requiresUnderscore: - result.add "_" - proc mapSetType(conf: ConfigRef; typ: PType): TCTypeKind = case int(getSize(conf, typ)) of 1: result = ctInt8 @@ -126,10 +79,10 @@ proc mapSetType(conf: ConfigRef; typ: PType): TCTypeKind = proc ccgIntroducedPtr*(conf: ConfigRef; s: PSym, retType: PType): bool = var pt = skipTypes(s.typ, typedescInst) assert skResult != s.kind - + #note precedence: params override types if optByRef in s.options: return true - elif sfByCopy in s.flags: return false + elif sfByCopy in s.flags: return false elif tfByRef in pt.flags: return true elif tfByCopy in pt.flags: return false case pt.kind @@ -137,6 +90,9 @@ proc ccgIntroducedPtr*(conf: ConfigRef; s: PSym, retType: PType): bool = if s.typ.sym != nil and sfForward in s.typ.sym.flags: # forwarded objects are *always* passed by pointers for consistency! result = true + elif s.typ.kind == tySink and conf.selectedGC notin {gcArc, gcAtomicArc, gcOrc, gcHooks}: + # bug #23354: + result = false elif (optByRef in s.options) or (getSize(conf, pt) > conf.target.floatSize * 3): result = true # requested anyway elif (tfFinal in pt.flags) and (pt[0] == nil): @@ -153,3 +109,62 @@ proc ccgIntroducedPtr*(conf: ConfigRef; s: PSym, retType: PType): bool = result = not (pt.kind in {tyVar, tyArray, tyOpenArray, tyVarargs, tyRef, tyPtr, tyPointer} or pt.kind == tySet and mapSetType(conf, pt) == ctArray) +proc encodeName*(name: string): string = + result = mangle(name) + result = $result.len & result + +proc makeUnique(m: BModule; s: PSym, name: string = ""): string = + result = if name == "": s.name.s else: name + result.add "__" + result.add m.g.graph.ifaces[s.itemId.module].uniqueName + result.add "_u" + result.add $s.itemId.item + +proc encodeSym*(m: BModule; s: PSym; makeUnique: bool = false): string = + #Module::Type + var name = s.name.s + if makeUnique: + name = makeUnique(m, s, name) + "N" & encodeName(s.skipGenericOwner.name.s) & encodeName(name) & "E" + +proc encodeType*(m: BModule; t: PType): string = + result = "" + var kindName = ($t.kind)[2..^1] + kindName[0] = toLower($kindName[0])[0] + case t.kind + of tyObject, tyEnum, tyDistinct, tyUserTypeClass, tyGenericParam: + result = encodeSym(m, t.sym) + of tyGenericInst, tyUserTypeClassInst, tyGenericBody: + result = encodeName(t[0].sym.name.s) + result.add "I" + for i in 1..<t.len - 1: + result.add encodeType(m, t[i]) + result.add "E" + of tySequence, tyOpenArray, tyArray, tyVarargs, tyTuple, tyProc, tySet, tyTypeDesc, + tyPtr, tyRef, tyVar, tyLent, tySink, tyStatic, tyUncheckedArray, tyOr, tyAnd, tyBuiltInTypeClass: + result = + case t.kind: + of tySequence: encodeName("seq") + else: encodeName(kindName) + result.add "I" + for i in 0..<t.len: + let s = t[i] + if s.isNil: continue + result.add encodeType(m, s) + result.add "E" + of tyRange: + var val = "range_" + if t.n[0].typ.kind in {tyFloat..tyFloat128}: + val.addFloat t.n[0].floatVal + val.add "_" + val.addFloat t.n[1].floatVal + else: + val.add $t.n[0].intVal & "_" & $t.n[1].intVal + result = encodeName(val) + of tyString..tyUInt64, tyPointer, tyBool, tyChar, tyVoid, tyAnything, tyNil, tyEmpty: + result = encodeName(kindName) + of tyAlias, tyInferred, tyOwned: + result = encodeType(m, t.elementType) + else: + assert false, "encodeType " & $t.kind + diff --git a/compiler/cgen.nim b/compiler/cgen.nim index d22a6bdc2..091f5c842 100644 --- a/compiler/cgen.nim +++ b/compiler/cgen.nim @@ -15,7 +15,8 @@ import ccgutils, ropes, wordrecg, treetab, cgmeth, rodutils, renderer, cgendata, aliases, lowerings, ndi, lineinfos, pathutils, transf, - injectdestructors, astmsgs, modulepaths, backendpragmas + injectdestructors, astmsgs, modulepaths, pushpoppragmas, + mangleutils from expanddefaults import caseObjDefaultBranch @@ -32,6 +33,12 @@ import std/strutils except `%`, addf # collides with ropes.`%` from ic / ic import ModuleBackendFlag import std/[dynlib, math, tables, sets, os, intsets, hashes] +const + # we use some ASCII control characters to insert directives that will be converted to real code in a postprocessing pass + postprocessDirStart = '\1' + postprocessDirSep = '\31' + postprocessDirEnd = '\23' + when not declared(dynlib.libCandidates): proc libCandidates(s: string, dest: var seq[string]) = ## given a library name pattern `s` write possible library names to `dest`. @@ -65,8 +72,7 @@ proc findPendingModule(m: BModule, s: PSym): BModule = proc initLoc(k: TLocKind, lode: PNode, s: TStorageLoc, flags: TLocFlags = {}): TLoc = result = TLoc(k: k, storage: s, lode: lode, - r: "", flags: flags - ) + snippet: "", flags: flags) proc fillLoc(a: var TLoc, k: TLocKind, lode: PNode, r: Rope, s: TStorageLoc) {.inline.} = # fills the loc if it is not already initialized @@ -74,7 +80,7 @@ proc fillLoc(a: var TLoc, k: TLocKind, lode: PNode, r: Rope, s: TStorageLoc) {.i a.k = k a.lode = lode a.storage = s - if a.r == "": a.r = r + if a.snippet == "": a.snippet = r proc fillLoc(a: var TLoc, k: TLocKind, lode: PNode, s: TStorageLoc) {.inline.} = # fills the loc if it is not already initialized @@ -266,24 +272,28 @@ proc safeLineNm(info: TLineInfo): int = result = toLinenumber(info) if result < 0: result = 0 # negative numbers are not allowed in #line -proc genCLineDir(r: var Rope, filename: string, line: int; conf: ConfigRef) = +proc genPostprocessDir(field1, field2, field3: string): string = + result = postprocessDirStart & field1 & postprocessDirSep & field2 & postprocessDirSep & field3 & postprocessDirEnd + +proc genCLineDir(r: var Rope, fileIdx: FileIndex, line: int; conf: ConfigRef) = assert line >= 0 if optLineDir in conf.options and line > 0: - r.addf("\n#line $2 $1\n", - [rope(makeSingleLineCString(filename)), rope(line)]) + if fileIdx == InvalidFileIdx: + r.add(rope("\n#line " & $line & " \"generated_not_to_break_here\"\n")) + else: + r.add(rope("\n#line " & $line & " FX_" & $fileIdx.int32 & "\n")) -proc genCLineDir(r: var Rope, filename: string, line: int; p: BProc; info: TLineInfo; lastFileIndex: FileIndex) = +proc genCLineDir(r: var Rope, fileIdx: FileIndex, line: int; p: BProc; info: TLineInfo; lastFileIndex: FileIndex) = assert line >= 0 if optLineDir in p.config.options and line > 0: - if lastFileIndex == info.fileIndex: - r.addf("\n#line $1\n", [rope(line)]) + if fileIdx == InvalidFileIdx: + r.add(rope("\n#line " & $line & " \"generated_not_to_break_here\"\n")) else: - r.addf("\n#line $2 $1\n", - [rope(makeSingleLineCString(filename)), rope(line)]) + r.add(rope("\n#line " & $line & " FX_" & $fileIdx.int32 & "\n")) proc genCLineDir(r: var Rope, info: TLineInfo; conf: ConfigRef) = if optLineDir in conf.options: - genCLineDir(r, toFullPath(conf, info), info.safeLineNm, conf) + genCLineDir(r, info.fileIndex, info.safeLineNm, conf) proc freshLineInfo(p: BProc; info: TLineInfo): bool = if p.lastLineInfo.line != info.line or @@ -298,7 +308,7 @@ proc genCLineDir(r: var Rope, p: BProc, info: TLineInfo; conf: ConfigRef) = if optLineDir in conf.options: let lastFileIndex = p.lastLineInfo.fileIndex if freshLineInfo(p, info): - genCLineDir(r, toFullPath(conf, info), info.safeLineNm, p, info, lastFileIndex) + genCLineDir(r, info.fileIndex, info.safeLineNm, p, info, lastFileIndex) proc genLineDir(p: BProc, t: PNode) = if p == p.module.preInitProc: return @@ -309,16 +319,11 @@ proc genLineDir(p: BProc, t: PNode) = let lastFileIndex = p.lastLineInfo.fileIndex let freshLine = freshLineInfo(p, t.info) if freshLine: - genCLineDir(p.s(cpsStmts), toFullPath(p.config, t.info), line, p, t.info, lastFileIndex) + genCLineDir(p.s(cpsStmts), t.info.fileIndex, line, p, t.info, lastFileIndex) if ({optLineTrace, optStackTrace} * p.options == {optLineTrace, optStackTrace}) and (p.prc == nil or sfPure notin p.prc.flags) and t.info.fileIndex != InvalidFileIdx: if freshLine: - if lastFileIndex == t.info.fileIndex: - linefmt(p, cpsStmts, "nimln_($1);", - [line]) - else: - linefmt(p, cpsStmts, "nimlf_($1, $2);", - [line, quotedFilename(p.config, t.info)]) + line(p, cpsStmts, genPostprocessDir("nimln", $line, $t.info.fileIndex.int32)) proc accessThreadLocalVar(p: BProc, s: PSym) proc emulatedThreadVars(conf: ConfigRef): bool {.inline.} @@ -335,15 +340,15 @@ proc getTempName(m: BModule): Rope = proc rdLoc(a: TLoc): Rope = # 'read' location (deref if indirect) if lfIndirect in a.flags: - result = "(*" & a.r & ")" + result = "(*" & a.snippet & ")" else: - result = a.r + result = a.snippet proc addRdLoc(a: TLoc; result: var Rope) = if lfIndirect in a.flags: - result.add "(*" & a.r & ")" + result.add "(*" & a.snippet & ")" else: - result.add a.r + result.add a.snippet proc lenField(p: BProc): Rope {.inline.} = result = rope(if p.module.compileToCpp: "len" else: "Sup.len") @@ -368,6 +373,7 @@ proc dataField(p: BProc): Rope = proc genProcPrototype(m: BModule, sym: PSym) +include cbuilder include ccgliterals include ccgtypes @@ -380,22 +386,22 @@ template mapTypeChooser(a: TLoc): TSymKind = mapTypeChooser(a.lode) proc addAddrLoc(conf: ConfigRef; a: TLoc; result: var Rope) = if lfIndirect notin a.flags and mapType(conf, a.t, mapTypeChooser(a) == skParam) != ctArray: - result.add "(&" & a.r & ")" + result.add "(&" & a.snippet & ")" else: - result.add a.r + result.add a.snippet proc addrLoc(conf: ConfigRef; a: TLoc): Rope = if lfIndirect notin a.flags and mapType(conf, a.t, mapTypeChooser(a) == skParam) != ctArray: - result = "(&" & a.r & ")" + result = "(&" & a.snippet & ")" else: - result = a.r + result = a.snippet proc byRefLoc(p: BProc; a: TLoc): Rope = if lfIndirect notin a.flags and mapType(p.config, a.t, mapTypeChooser(a) == skParam) != ctArray and not p.module.compileToCpp: - result = "(&" & a.r & ")" + result = "(&" & a.snippet & ")" else: - result = a.r + result = a.snippet proc rdCharLoc(a: TLoc): Rope = # read a location that may need a char-cast: @@ -406,6 +412,9 @@ proc rdCharLoc(a: TLoc): Rope = type TAssignmentFlag = enum needToCopy + needToCopySinkParam + needTempForOpenArray + needAssignCall TAssignmentFlags = set[TAssignmentFlag] proc genObjConstr(p: BProc, e: PNode, d: var TLoc) @@ -474,9 +483,12 @@ include ccgreset proc resetLoc(p: BProc, loc: var TLoc) = let containsGcRef = optSeqDestructors notin p.config.globalOptions and containsGarbageCollectedRef(loc.t) let typ = skipTypes(loc.t, abstractVarRange) - if isImportedCppType(typ): return + if isImportedCppType(typ): + var didGenTemp = false + linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(loc), genCppInitializer(p.module, p, typ, didGenTemp)]) + return if optSeqDestructors in p.config.globalOptions and typ.kind in {tyString, tySequence}: - assert loc.r != "" + assert loc.snippet != "" let atyp = skipTypes(loc.t, abstractInst) if atyp.kind in {tyVar, tyLent}: @@ -486,7 +498,7 @@ proc resetLoc(p: BProc, loc: var TLoc) = elif not isComplexValueType(typ): if containsGcRef: var nilLoc: TLoc = initLoc(locTemp, loc.lode, OnStack) - nilLoc.r = rope("NIM_NIL") + nilLoc.snippet = rope("NIM_NIL") genRefAssign(p, loc, nilLoc) else: linefmt(p, cpsStmts, "$1 = 0;$n", [rdLoc(loc)]) @@ -524,13 +536,13 @@ proc constructLoc(p: BProc, loc: var TLoc, isTemp = false) = elif not isComplexValueType(typ): if containsGarbageCollectedRef(loc.t): var nilLoc: TLoc = initLoc(locTemp, loc.lode, OnStack) - nilLoc.r = rope("NIM_NIL") + nilLoc.snippet = rope("NIM_NIL") genRefAssign(p, loc, nilLoc) else: linefmt(p, cpsStmts, "$1 = ($2)0;$n", [rdLoc(loc), getTypeDesc(p.module, typ, descKindFromSymKind mapTypeChooser(loc))]) else: - if not isTemp or containsGarbageCollectedRef(loc.t): + if (not isTemp or containsGarbageCollectedRef(loc.t)) and not hasNoInit(loc.t): # don't use nimZeroMem for temporary values for performance if we can # avoid it: if not isOrHasImportedCppType(typ): @@ -552,13 +564,14 @@ proc initLocalVar(p: BProc, v: PSym, immediateAsgn: bool) = proc getTemp(p: BProc, t: PType, needsInit=false): TLoc = inc(p.labels) - result = TLoc(r: "T" & rope(p.labels) & "_", k: locTemp, lode: lodeTyp t, + result = TLoc(snippet: "T" & rope(p.labels) & "_", k: locTemp, lode: lodeTyp t, storage: OnStack, flags: {}) if p.module.compileToCpp and isOrHasImportedCppType(t): - linefmt(p, cpsLocals, "$1 $2$3;$n", [getTypeDesc(p.module, t, dkVar), result.r, - genCppInitializer(p.module, p, t)]) + var didGenTemp = false + linefmt(p, cpsLocals, "$1 $2$3;$n", [getTypeDesc(p.module, t, dkVar), result.snippet, + genCppInitializer(p.module, p, t, didGenTemp)]) else: - linefmt(p, cpsLocals, "$1 $2;$n", [getTypeDesc(p.module, t, dkVar), result.r]) + linefmt(p, cpsLocals, "$1 $2;$n", [getTypeDesc(p.module, t, dkVar), result.snippet]) constructLoc(p, result, not needsInit) when false: # XXX Introduce a compiler switch in order to detect these easily. @@ -571,16 +584,16 @@ proc getTemp(p: BProc, t: PType, needsInit=false): TLoc = proc getTempCpp(p: BProc, t: PType, value: Rope): TLoc = inc(p.labels) - result = TLoc(r: "T" & rope(p.labels) & "_", k: locTemp, lode: lodeTyp t, + result = TLoc(snippet: "T" & rope(p.labels) & "_", k: locTemp, lode: lodeTyp t, storage: OnStack, flags: {}) - linefmt(p, cpsStmts, "$1 $2 = $3;$n", [getTypeDesc(p.module, t, dkVar), result.r, value]) + linefmt(p, cpsStmts, "auto $1 = $2;$n", [result.snippet, value]) proc getIntTemp(p: BProc): TLoc = inc(p.labels) - result = TLoc(r: "T" & rope(p.labels) & "_", k: locTemp, + result = TLoc(snippet: "T" & rope(p.labels) & "_", k: locTemp, storage: OnStack, lode: lodeTyp getSysType(p.module.g.graph, unknownLineInfo, tyInt), flags: {}) - linefmt(p, cpsLocals, "NI $1;$n", [result.r]) + linefmt(p, cpsLocals, "NI $1;$n", [result.snippet]) proc localVarDecl(p: BProc; n: PNode): Rope = result = "" @@ -602,9 +615,9 @@ proc localVarDecl(p: BProc; n: PNode): Rope = if sfVolatile in s.flags: result.add(" volatile") if sfNoalias in s.flags: result.add(" NIM_NOALIAS") result.add(" ") - result.add(s.loc.r) + result.add(s.loc.snippet) else: - result = runtimeFormat(s.cgDeclFrmt, [result, s.loc.r]) + result = runtimeFormat(s.cgDeclFrmt, [result, s.loc.snippet]) proc assignLocalVar(p: BProc, n: PNode) = #assert(s.loc.k == locNone) # not yet assigned @@ -613,7 +626,8 @@ proc assignLocalVar(p: BProc, n: PNode) = let nl = if optLineDir in p.config.options: "" else: "\n" var decl = localVarDecl(p, n) if p.module.compileToCpp and isOrHasImportedCppType(n.typ): - decl.add genCppInitializer(p.module, p, n.typ) + var didGenTemp = false + decl.add genCppInitializer(p.module, p, n.typ, didGenTemp) decl.add ";" & nl line(p, cpsLocals, decl) @@ -644,22 +658,11 @@ proc genGlobalVarDecl(p: BProc, n: PNode; td, value: Rope; decl: var Rope) = if sfNoalias in s.flags: decl.add(" NIM_NOALIAS") else: if value != "": - decl = runtimeFormat(s.cgDeclFrmt & " = $#;$n", [td, s.loc.r, value]) + decl = runtimeFormat(s.cgDeclFrmt & " = $#;$n", [td, s.loc.snippet, value]) else: - decl = runtimeFormat(s.cgDeclFrmt & ";$n", [td, s.loc.r]) - -proc genCppVarForCtor(p: BProc; call: PNode; decl: var Rope) + decl = runtimeFormat(s.cgDeclFrmt & ";$n", [td, s.loc.snippet]) -proc callGlobalVarCppCtor(p: BProc; v: PSym; vn, value: PNode) = - let s = vn.sym - fillBackendName(p.module, s) - fillLoc(s.loc, locGlobalVar, vn, OnHeap) - var decl: Rope = "" - let td = getTypeDesc(p.module, vn.sym.typ, dkVar) - genGlobalVarDecl(p, vn, td, "", decl) - decl.add " " & $s.loc.r - genCppVarForCtor(p, value, decl) - p.module.s[cfsVars].add decl +proc genCppVarForCtor(p: BProc; call: PNode; decl: var Rope; didGenTemp: var bool) proc assignGlobalVar(p: BProc, n: PNode; value: Rope) = let s = n.sym @@ -673,7 +676,7 @@ proc assignGlobalVar(p: BProc, n: PNode; value: Rope) = if q != nil and not containsOrIncl(q.declaredThings, s.id): varInDynamicLib(q, s) else: - s.loc.r = mangleDynLibProc(s) + s.loc.snippet = mangleDynLibProc(s) if value != "": internalError(p.config, n.info, ".dynlib variables cannot have a value") return @@ -704,19 +707,31 @@ proc assignGlobalVar(p: BProc, n: PNode; value: Rope) = # [^0]: https://en.cppreference.com/w/cpp/language/aggregate_initialization # [^1]: https://cplusplus.github.io/CWG/issues/1518.html # [^2]: https://eel.is/c++draft/over.match.ctor - decl.addf(" $1;$n", [s.loc.r]) + decl.addf(" $1;$n", [s.loc.snippet]) else: - decl.addf(" $1 = $2;$n", [s.loc.r, value]) + decl.addf(" $1 = $2;$n", [s.loc.snippet, value]) else: - decl.addf(" $1;$n", [s.loc.r]) + decl.addf(" $1;$n", [s.loc.snippet]) p.module.s[cfsVars].add(decl) if p.withinLoop > 0 and value == "": # fixes tests/run/tzeroarray: resetLoc(p, s.loc) +proc callGlobalVarCppCtor(p: BProc; v: PSym; vn, value: PNode; didGenTemp: var bool) = + let s = vn.sym + fillBackendName(p.module, s) + fillLoc(s.loc, locGlobalVar, vn, OnHeap) + var decl: Rope = "" + let td = getTypeDesc(p.module, vn.sym.typ, dkVar) + genGlobalVarDecl(p, vn, td, "", decl) + decl.add " " & $s.loc.snippet + genCppVarForCtor(p, value, decl, didGenTemp) + if didGenTemp: return # generated in the caller + p.module.s[cfsVars].add decl + proc assignParam(p: BProc, s: PSym, retType: PType) = - assert(s.loc.r != "") + assert(s.loc.snippet != "") scopeMangledParam(p, s) proc fillProcLoc(m: BModule; n: PNode) = @@ -742,6 +757,7 @@ proc intLiteral(i: BiggestInt; result: var Rope) proc genLiteral(p: BProc, n: PNode; result: var Rope) proc genOtherArg(p: BProc; ri: PNode; i: int; typ: PType; result: var Rope; argsCounter: var int) proc raiseExit(p: BProc) +proc raiseExitCleanup(p: BProc, destroy: string) proc initLocExpr(p: BProc, e: PNode, flags: TLocFlags = {}): TLoc = result = initLoc(locNone, e, OnUnknown, flags) @@ -768,15 +784,11 @@ $1define nimfr_(proc, file) \ TFrame FR_; \ FR_.procname = proc; FR_.filename = file; FR_.line = 0; FR_.len = 0; #nimFrame(&FR_); - $1define nimfrs_(proc, file, slots, length) \ - struct {TFrame* prev;NCSTRING procname;NI line;NCSTRING filename;NI len;VarSlot s[slots];} FR_; \ - FR_.procname = proc; FR_.filename = file; FR_.line = 0; FR_.len = length; #nimFrame((TFrame*)&FR_); - - $1define nimln_(n) \ - FR_.line = n; +$1define nimln_(n) \ + FR_.line = n; - $1define nimlf_(n, file) \ - FR_.line = n; FR_.filename = file; +$1define nimlf_(n, file) \ + FR_.line = n; FR_.filename = file; """ if p.module.s[cfsFrameDefines].len == 0: @@ -840,7 +852,7 @@ proc loadDynamicLib(m: BModule, lib: PLib) = p.options.excl optStackTrace p.flags.incl nimErrorFlagDisabled var dest: TLoc = initLoc(locTemp, lib.path, OnStack) - dest.r = getTempName(m) + dest.snippet = getTempName(m) appcg(m, m.s[cfsDynLibInit],"$1 $2;$n", [getTypeDesc(m, lib.path.typ, dkVar), rdLoc(dest)]) expr(p, lib.path, dest) @@ -858,7 +870,7 @@ proc mangleDynLibProc(sym: PSym): Rope = # we have to build this as a single rope in order not to trip the # optimization in genInfixCall, see test tests/cpp/t8241.nim if sfCompilerProc in sym.flags: - # NOTE: sym.loc.r is the external name! + # NOTE: sym.loc.snippet is the external name! result = rope(sym.name.s) else: result = rope(strutils.`%`("Dl_$1_", $sym.id)) @@ -866,10 +878,10 @@ proc mangleDynLibProc(sym: PSym): Rope = proc symInDynamicLib(m: BModule, sym: PSym) = var lib = sym.annex let isCall = isGetProcAddr(lib) - var extname = sym.loc.r + var extname = sym.loc.snippet if not isCall: loadDynamicLib(m, lib) var tmp = mangleDynLibProc(sym) - sym.loc.r = tmp # from now on we only need the internal name + sym.loc.snippet = tmp # from now on we only need the internal name sym.typ.sym = nil # generate a new name inc(m.labels, 2) if isCall: @@ -896,24 +908,24 @@ proc symInDynamicLib(m: BModule, sym: PSym) = appcg(m, m.s[cfsDynLibInit], "\t$1 = ($2) #nimGetProcAddr($3, $4);$n", [tmp, getTypeDesc(m, sym.typ, dkVar), lib.name, makeCString($extname)]) - m.s[cfsVars].addf("$2 $1;$n", [sym.loc.r, getTypeDesc(m, sym.loc.t, dkVar)]) + m.s[cfsVars].addf("$2 $1;$n", [sym.loc.snippet, getTypeDesc(m, sym.loc.t, dkVar)]) proc varInDynamicLib(m: BModule, sym: PSym) = var lib = sym.annex - var extname = sym.loc.r + var extname = sym.loc.snippet loadDynamicLib(m, lib) incl(sym.loc.flags, lfIndirect) var tmp = mangleDynLibProc(sym) - sym.loc.r = tmp # from now on we only need the internal name + sym.loc.snippet = 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, dkVar), lib.name, makeCString($extname)]) m.s[cfsVars].addf("$2* $1;$n", - [sym.loc.r, getTypeDesc(m, sym.loc.t, dkVar)]) + [sym.loc.snippet, getTypeDesc(m, sym.loc.t, dkVar)]) proc symInDynamicLibPartial(m: BModule, sym: PSym) = - sym.loc.r = mangleDynLibProc(sym) + sym.loc.snippet = mangleDynLibProc(sym) sym.typ.sym = nil # generate a new name proc cgsymImpl(m: BModule; sym: PSym) {.inline.} = @@ -936,7 +948,7 @@ proc cgsymValue(m: BModule, name: string): Rope = cgsymImpl m, sym else: rawMessage(m.config, errGenerated, "system module needs: " & name) - result = sym.loc.r + result = sym.loc.snippet if m.hcrOn and sym != nil and sym.kind in {skProc..skIterator}: result.addActualSuffixForHCR(m.module, sym) @@ -1032,7 +1044,7 @@ proc easyResultAsgn(n: PNode): PNode = type InitResultEnum = enum Unknown, InitSkippable, InitRequired -proc allPathsAsgnResult(n: PNode): InitResultEnum = +proc allPathsAsgnResult(p: BProc; n: PNode): InitResultEnum = # Exceptions coming from calls don't have not be considered here: # # proc bar(): string = raise newException(...) @@ -1047,7 +1059,7 @@ proc allPathsAsgnResult(n: PNode): InitResultEnum = # echo "a was not written to" # template allPathsInBranch(it) = - let a = allPathsAsgnResult(it) + let a = allPathsAsgnResult(p, it) case a of InitRequired: return InitRequired of InitSkippable: discard @@ -1059,14 +1071,20 @@ proc allPathsAsgnResult(n: PNode): InitResultEnum = case n.kind of nkStmtList, nkStmtListExpr: for it in n: - result = allPathsAsgnResult(it) + result = allPathsAsgnResult(p, it) if result != Unknown: return result of nkAsgn, nkFastAsgn, nkSinkAsgn: if n[0].kind == nkSym and n[0].sym.kind == skResult: - if not containsResult(n[1]): result = InitSkippable + if not containsResult(n[1]): + if allPathsAsgnResult(p, n[1]) == InitRequired: + result = InitRequired + else: + result = InitSkippable else: result = InitRequired elif containsResult(n): result = InitRequired + else: + result = allPathsAsgnResult(p, n[1]) of nkReturnStmt: if n.len > 0: if n[0].kind == nkEmpty and result != InitSkippable: @@ -1075,7 +1093,7 @@ proc allPathsAsgnResult(n: PNode): InitResultEnum = # initialized. This avoids cases like #9286 where this heuristic lead to # wrong code being generated. result = InitRequired - else: result = allPathsAsgnResult(n[0]) + else: result = allPathsAsgnResult(p, n[0]) of nkIfStmt, nkIfExpr: var exhaustive = false result = InitSkippable @@ -1101,9 +1119,9 @@ proc allPathsAsgnResult(n: PNode): InitResultEnum = of nkWhileStmt: # some dubious code can assign the result in the 'while' # condition and that would be fine. Everything else isn't: - result = allPathsAsgnResult(n[0]) + result = allPathsAsgnResult(p, n[0]) if result == Unknown: - result = allPathsAsgnResult(n[1]) + result = allPathsAsgnResult(p, n[1]) # we cannot assume that the 'while' loop is really executed at least once: if result == InitSkippable: result = Unknown of harmless: @@ -1128,9 +1146,21 @@ proc allPathsAsgnResult(n: PNode): InitResultEnum = allPathsInBranch(n[0]) for i in 1..<n.len: if n[i].kind == nkFinally: - result = allPathsAsgnResult(n[i].lastSon) + result = allPathsAsgnResult(p, n[i].lastSon) else: allPathsInBranch(n[i].lastSon) + of nkCallKinds: + if canRaiseDisp(p, n[0]): + result = InitRequired + else: + for i in 0..<n.safeLen: + allPathsInBranch(n[i]) + of nkRaiseStmt: + result = InitRequired + of nkChckRangeF, nkChckRange64, nkChckRange: + # TODO: more checks might need to be covered like overflow, indexDefect etc. + # bug #22852 + result = InitRequired else: for i in 0..<n.safeLen: allPathsInBranch(n[i]) @@ -1171,7 +1201,7 @@ proc genProcAux*(m: BModule, prc: PSym) = let tmpInfo = prc.info discard freshLineInfo(p, prc.info) - if sfPure notin prc.flags and prc.typ[0] != nil: + if sfPure notin prc.flags and prc.typ.returnType != nil: if resultPos >= prc.ast.len: internalError(m.config, prc.info, "proc has no result symbol") let resNode = prc.ast[resultPos] @@ -1185,9 +1215,9 @@ proc genProcAux*(m: BModule, prc: PSym) = else: # declare the result symbol: assignLocalVar(p, resNode) - assert(res.loc.r != "") + assert(res.loc.snippet != "") if p.config.selectedGC in {gcArc, gcAtomicArc, gcOrc} and - allPathsAsgnResult(procBody) == InitSkippable: + allPathsAsgnResult(p, procBody) == InitSkippable: # In an ideal world the codegen could rely on injectdestructors doing its job properly # and then the analysis step would not be required. discard "result init optimized out" @@ -1197,9 +1227,10 @@ proc genProcAux*(m: BModule, prc: PSym) = elif sfConstructor in prc.flags: resNode.sym.loc.flags.incl lfIndirect fillLoc(resNode.sym.loc, locParam, resNode, "this", OnHeap) + prc.loc.snippet = getTypeDesc(m, resNode.sym.loc.t, dkVar) else: fillResult(p.config, resNode, prc.typ) - assignParam(p, res, prc.typ[0]) + assignParam(p, res, prc.typ.returnType) # We simplify 'unsureAsgn(result, nil); unsureAsgn(result, x)' # to 'unsureAsgn(result, x)' # Sketch why this is correct: If 'result' points to a stack location @@ -1207,7 +1238,7 @@ proc genProcAux*(m: BModule, prc: PSym) = # global is either 'nil' or points to valid memory and so the RC operation # succeeds without touching not-initialized memory. if sfNoInit in prc.flags: discard - elif allPathsAsgnResult(procBody) == InitSkippable: discard + elif allPathsAsgnResult(p, procBody) == InitSkippable: discard else: resetLoc(p, res.loc) if skipTypes(res.typ, abstractInst).kind == tyArray: @@ -1217,7 +1248,7 @@ proc genProcAux*(m: BModule, prc: PSym) = for i in 1..<prc.typ.n.len: let param = prc.typ.n[i].sym if param.typ.isCompileTimeOnly: continue - assignParam(p, param, prc.typ[0]) + assignParam(p, param, prc.typ.returnType) closureSetup(p, prc) genProcBody(p, procBody) @@ -1261,7 +1292,7 @@ proc genProcAux*(m: BModule, prc: PSym) = m.s[cfsProcs].add(generatedProc) if isReloadable(m, prc): m.s[cfsDynLibInit].addf("\t$1 = ($3) hcrRegisterProc($4, \"$1\", (void*)$2);$n", - [prc.loc.r, prc.loc.r & "_actual", getProcTypeCast(m, prc), getModuleDllPath(m, prc)]) + [prc.loc.snippet, prc.loc.snippet & "_actual", getProcTypeCast(m, prc), getModuleDllPath(m, prc)]) proc requiresExternC(m: BModule; sym: PSym): bool {.inline.} = result = (sfCompileToCpp in m.module.flags and @@ -1321,7 +1352,7 @@ proc genProcNoForward(m: BModule, prc: PSym) = # the hcr dynlib (also put it in the DynLibInit section - right after it gets loaded) if isReloadable(q, prc): q.s[cfsDynLibInit].addf("\t$1 = ($2) hcrRegisterProc($3, \"$1\", (void*)$1);$n", - [prc.loc.r, getTypeDesc(q, prc.loc.t), getModuleDllPath(m, q.module)]) + [prc.loc.snippet, getTypeDesc(q, prc.loc.t), getModuleDllPath(m, q.module)]) else: symInDynamicLibPartial(m, prc) elif prc.typ.callConv == ccInline: @@ -1338,8 +1369,8 @@ proc genProcNoForward(m: BModule, prc: PSym) = #elif {sfExportc, sfImportc} * prc.flags == {}: # # reset name to restore consistency in case of hashing collisions: # echo "resetting ", prc.id, " by ", m.module.name.s - # prc.loc.r = nil - # prc.loc.r = mangleName(m, prc) + # prc.loc.snippet = nil + # prc.loc.snippet = mangleName(m, prc) genProcPrototype(m, prc) genProcAux(m, prc) elif sfImportc notin prc.flags: @@ -1351,7 +1382,7 @@ proc genProcNoForward(m: BModule, prc: PSym) = if isReloadable(m, prc) and prc.id notin m.declaredProtos and q != nil and q.module.id != m.module.id: m.s[cfsDynLibInit].addf("\t$1 = ($2) hcrGetProc($3, \"$1\");$n", - [prc.loc.r, getProcTypeCast(m, prc), getModuleDllPath(m, prc)]) + [prc.loc.snippet, getProcTypeCast(m, prc), getModuleDllPath(m, prc)]) genProcPrototype(m, prc) if q != nil and not containsOrIncl(q.declaredThings, prc.id): # make sure there is a "prototype" in the external module @@ -1404,7 +1435,7 @@ proc genVarPrototype(m: BModule, n: PNode) = return if sym.owner.id != m.module.id: # else we already have the symbol generated! - assert(sym.loc.r != "") + assert(sym.loc.snippet != "") incl(m.declaredThings, sym.id) if sfThread in sym.flags: declareThreadVar(m, sym, true) @@ -1418,9 +1449,9 @@ proc genVarPrototype(m: BModule, n: PNode) = if sfRegister in sym.flags: m.s[cfsVars].add(" register") if sfVolatile in sym.flags: m.s[cfsVars].add(" volatile") if sfNoalias in sym.flags: m.s[cfsVars].add(" NIM_NOALIAS") - m.s[cfsVars].addf(" $1;$n", [sym.loc.r]) + m.s[cfsVars].addf(" $1;$n", [sym.loc.snippet]) if m.hcrOn: m.initProc.procSec(cpsLocals).addf( - "\t$1 = ($2*)hcrGetGlobal($3, \"$1\");$n", [sym.loc.r, + "\t$1 = ($2*)hcrGetGlobal($3, \"$1\");$n", [sym.loc.snippet, getTypeDesc(m, sym.loc.t, dkVar), getModuleDllPath(m, sym)]) proc addNimDefines(result: var Rope; conf: ConfigRef) {.inline.} = @@ -1453,15 +1484,13 @@ proc getFileHeader(conf: ConfigRef; cfile: Cfile): Rope = proc getSomeNameForModule(conf: ConfigRef, filename: AbsoluteFile): Rope = ## Returns a mangled module name. - result = "" - result.add mangleModuleName(conf, filename).mangle + result = mangleModuleName(conf, filename).mangle proc getSomeNameForModule(m: BModule): Rope = ## Returns a mangled module name. assert m.module.kind == skModule assert m.module.owner.kind == skPackage - result = "" - result.add mangleModuleName(m.g.config, m.filename).mangle + result = mangleModuleName(m.g.config, m.filename).mangle proc getSomeInitName(m: BModule, suffix: string): Rope = if not m.hcrOn: @@ -1797,7 +1826,7 @@ proc genDatInitCode(m: BModule) = # we don't want to break into such init code - could happen if a line # directive from a function written by the user spills after itself - genCLineDir(prc, "generated_not_to_break_here", 999999, m.config) + genCLineDir(prc, InvalidFileIdx, 999999, m.config) for i in cfsTypeInit1..cfsDynLibInit: if m.s[i].len != 0: @@ -1819,11 +1848,11 @@ proc hcrGetProcLoadCode(m: BModule, sym, prefix, handle, getProcFunc: string): R var extname = prefix & sym var tmp = mangleDynLibProc(prc) - prc.loc.r = tmp + prc.loc.snippet = tmp prc.typ.sym = nil if not containsOrIncl(m.declaredThings, prc.id): - m.s[cfsVars].addf("static $2 $1;$n", [prc.loc.r, getTypeDesc(m, prc.loc.t, dkVar)]) + m.s[cfsVars].addf("static $2 $1;$n", [prc.loc.snippet, getTypeDesc(m, prc.loc.t, dkVar)]) result = "\t$1 = ($2) $3($4, $5);$n" % [tmp, getTypeDesc(m, prc.typ, dkVar), getProcFunc.rope, handle.rope, makeCString(prefix & sym)] @@ -1838,7 +1867,7 @@ proc genInitCode(m: BModule) = [rope(if m.hcrOn: "N_LIB_EXPORT" else: "N_LIB_PRIVATE"), initname] # we don't want to break into such init code - could happen if a line # directive from a function written by the user spills after itself - genCLineDir(prc, "generated_not_to_break_here", 999999, m.config) + genCLineDir(prc, InvalidFileIdx, 999999, m.config) if m.typeNodes > 0: if m.hcrOn: appcg(m, m.s[cfsTypeInit1], "\t#TNimNode* $1;$N", [m.typeNodesName]) @@ -1908,9 +1937,6 @@ proc genInitCode(m: BModule) = if optStackTrace in m.initProc.options and preventStackTrace notin m.flags: prc.add(deinitFrame(m.initProc)) - elif m.config.exc == excGoto: - if getCompilerProc(m.g.graph, "nimTestErrorFlag") != nil: - m.appcg(prc, "\t#nimTestErrorFlag();$n", []) prc.addf("}$N", []) @@ -1953,6 +1979,40 @@ proc genInitCode(m: BModule) = registerModuleToMain(m.g, m) +proc postprocessCode(conf: ConfigRef, r: var Rope) = + # find the first directive + var f = r.find(postprocessDirStart) + if f == -1: + return + + var + nimlnDirLastF = "" + + var res: Rope = r.substr(0, f - 1) + while f != -1: + var + e = r.find(postprocessDirEnd, f + 1) + dir = r.substr(f + 1, e - 1).split(postprocessDirSep) + case dir[0] + of "nimln": + if dir[2] == nimlnDirLastF: + res.add("nimln_(" & dir[1] & ");") + else: + res.add("nimlf_(" & dir[1] & ", " & quotedFilename(conf, dir[2].parseInt.FileIndex) & ");") + nimlnDirLastF = dir[2] + else: + raiseAssert "unexpected postprocess directive" + + # find the next directive + f = r.find(postprocessDirStart, e + 1) + # copy the code until the next directive + if f != -1: + res.add(r.substr(e + 1, f - 1)) + else: + res.add(r.substr(e + 1)) + + r = res + proc genModule(m: BModule, cfile: Cfile): Rope = var moduleIsEmpty = true @@ -1981,9 +2041,17 @@ proc genModule(m: BModule, cfile: Cfile): Rope = if m.config.cppCustomNamespace.len > 0: closeNamespaceNim(result) + if optLineDir in m.config.options: + var srcFileDefs = "" + for fi in 0..m.config.m.fileInfos.high: + srcFileDefs.add("#define FX_" & $fi & " " & makeSingleLineCString(toFullPath(m.config, fi.FileIndex)) & "\n") + result = srcFileDefs & result + if moduleIsEmpty: result = "" + postprocessCode(m.config, result) + proc initProcOptions(m: BModule): TOptions = let opts = m.config.options if sfSystemModule in m.module.flags: opts-{optStackTrace} else: opts @@ -2183,6 +2251,22 @@ proc updateCachedModule(m: BModule) = cf.flags = {CfileFlag.Cached} addFileToCompile(m.config, cf) +proc generateLibraryDestroyGlobals(graph: ModuleGraph; m: BModule; body: PNode; isDynlib: bool): PSym = + let procname = getIdent(graph.cache, "NimDestroyGlobals") + result = newSym(skProc, procname, m.idgen, m.module.owner, m.module.info) + result.typ = newProcType(m.module.info, m.idgen, m.module.owner) + result.typ.callConv = ccCDecl + incl result.flags, sfExportc + result.loc.snippet = "NimDestroyGlobals" + if isDynlib: + incl(result.loc.flags, lfExportLib) + + let theProc = newNodeI(nkProcDef, m.module.info, bodyPos+1) + for i in 0..<theProc.len: theProc[i] = newNodeI(nkEmpty, m.module.info) + theProc[namePos] = newSymNode(result) + theProc[bodyPos] = body + result.ast = theProc + proc finalCodegenActions*(graph: ModuleGraph; m: BModule; n: PNode) = ## Also called from IC. if sfMainModule in m.module.flags: @@ -2194,6 +2278,13 @@ proc finalCodegenActions*(graph: ModuleGraph; m: BModule; n: PNode) = if {optGenStaticLib, optGenDynLib, optNoMain} * m.config.globalOptions == {}: for i in countdown(high(graph.globalDestructors), 0): n.add graph.globalDestructors[i] + else: + var body = newNodeI(nkStmtList, m.module.info) + for i in countdown(high(graph.globalDestructors), 0): + body.add graph.globalDestructors[i] + body.flags.incl nfTransf # should not be further transformed + let dtor = generateLibraryDestroyGlobals(graph, m, body, optGenDynLib in m.config.globalOptions) + genProcAux(m, dtor) if pipelineutils.skipCodegen(m.config, n): return if moduleHasChanged(graph, m.module): # if the module is cached, we don't regenerate the main proc diff --git a/compiler/cgendata.nim b/compiler/cgendata.nim index 30d778bc2..5368e9dc7 100644 --- a/compiler/cgendata.nim +++ b/compiler/cgendata.nim @@ -88,7 +88,7 @@ type options*: TOptions # options that should be used for code # generation; this is the same as prc.options # unless prc == nil - optionsStack*: seq[TOptions] + optionsStack*: seq[(TOptions, TNoteKinds)] module*: BModule # used to prevent excessive parameter passing withinLoop*: int # > 0 if we are within a loop splitDecls*: int # > 0 if we are in some context for C++ that @@ -137,6 +137,7 @@ type # unconditionally... # nimtvDeps is VERY hard to cache because it's # not a list of IDs nor can it be made to be one. + mangledPrcs*: HashSet[string] TCGen = object of PPassContext # represents a C source file s*: TCFileSections # sections of the C file @@ -150,7 +151,7 @@ type typeABICache*: HashSet[SigHash] # cache for ABI checks; reusing typeCache # would be ideal but for some reason enums # don't seem to get cached so it'd generate - # 1 ABI check per occurence in code + # 1 ABI check per occurrence in code forwTypeCache*: TypeCache # cache for forward declarations of types declaredThings*: IntSet # things we have declared in this .c file declaredProtos*: IntSet # prototypes we have declared in this .c file diff --git a/compiler/cgmeth.nim b/compiler/cgmeth.nim index 833bb6fe5..ca97d0494 100644 --- a/compiler/cgmeth.nim +++ b/compiler/cgmeth.nim @@ -69,21 +69,23 @@ type proc sameMethodBucket(a, b: PSym; multiMethods: bool): MethodResult = result = No if a.name.id != b.name.id: return - if a.typ.len != b.typ.len: + if a.typ.signatureLen != b.typ.signatureLen: return - for i in 1..<a.typ.len: - var aa = a.typ[i] - var bb = b.typ[i] + var i = 0 + for x, y in paramTypePairs(a.typ, b.typ): + inc i + var aa = x + var bb = y while true: aa = skipTypes(aa, {tyGenericInst, tyAlias}) bb = skipTypes(bb, {tyGenericInst, tyAlias}) if aa.kind == bb.kind and aa.kind in {tyVar, tyPtr, tyRef, tyLent, tySink}: - aa = aa.lastSon - bb = bb.lastSon + aa = aa.elementType + bb = bb.elementType else: break - if sameType(a.typ[i], b.typ[i]): + if sameType(x, y): if aa.kind == tyObject and result != Invalid: result = Yes elif aa.kind == tyObject and bb.kind == tyObject and (i == 1 or multiMethods): @@ -102,10 +104,10 @@ proc sameMethodBucket(a, b: PSym; multiMethods: bool): MethodResult = if result == Yes: # check for return type: # ignore flags of return types; # bug #22673 - if not sameTypeOrNil(a.typ[0], b.typ[0], {IgnoreFlags}): - if b.typ[0] != nil and b.typ[0].kind == tyUntyped: + if not sameTypeOrNil(a.typ.returnType, b.typ.returnType, {IgnoreFlags}): + if b.typ.returnType != nil and b.typ.returnType.kind == tyUntyped: # infer 'auto' from the base to make it consistent: - b.typ[0] = a.typ[0] + b.typ.setReturnType a.typ.returnType else: return No @@ -131,8 +133,8 @@ proc createDispatcher(s: PSym; g: ModuleGraph; idgen: IdGenerator): PSym = if disp.typ.callConv == ccInline: disp.typ.callConv = ccNimCall disp.ast = copyTree(s.ast) disp.ast[bodyPos] = newNodeI(nkEmpty, s.info) - disp.loc.r = "" - if s.typ[0] != nil: + disp.loc.snippet = "" + if s.typ.returnType != nil: if disp.ast.len > resultPos: disp.ast[resultPos].sym = copySym(s.ast[resultPos].sym, idgen) else: @@ -157,9 +159,14 @@ proc fixupDispatcher(meth, disp: PSym; conf: ConfigRef) = proc methodDef*(g: ModuleGraph; idgen: IdGenerator; s: PSym) = var witness: PSym = nil - if s.typ[1].owner.getModule != s.getModule and vtables in g.config.features and not g.config.isDefined("nimInternalNonVtablesTesting"): + if s.typ.firstParamType.owner.getModule != s.getModule and vtables in g.config.features and not + g.config.isDefined("nimInternalNonVtablesTesting"): localError(g.config, s.info, errGenerated, "method `" & s.name.s & - "` can be defined only in the same module with its type (" & s.typ[1].typeToString() & ")") + "` can be defined only in the same module with its type (" & s.typ.firstParamType.typeToString() & ")") + if sfImportc in s.flags: + localError(g.config, s.info, errGenerated, "method `" & s.name.s & + "` is not allowed to have 'importc' pragmas") + for i in 0..<g.methods.len: let disp = g.methods[i].dispatcher case sameMethodBucket(disp, s, multimethods = optMultiMethods in g.config.globalOptions) @@ -179,10 +186,10 @@ proc methodDef*(g: ModuleGraph; idgen: IdGenerator; s: PSym) = if witness.isNil: witness = g.methods[i].methods[0] # create a new dispatcher: # stores the id and the position - if s.typ[1].skipTypes(skipPtrs).itemId notin g.bucketTable: - g.bucketTable[s.typ[1].skipTypes(skipPtrs).itemId] = 1 + if s.typ.firstParamType.skipTypes(skipPtrs).itemId notin g.bucketTable: + g.bucketTable[s.typ.firstParamType.skipTypes(skipPtrs).itemId] = 1 else: - g.bucketTable.inc(s.typ[1].skipTypes(skipPtrs).itemId) + g.bucketTable.inc(s.typ.firstParamType.skipTypes(skipPtrs).itemId) g.methods.add((methods: @[s], dispatcher: createDispatcher(s, g, idgen))) #echo "adding ", s.info if witness != nil: @@ -203,7 +210,7 @@ proc relevantCol*(methods: seq[PSym], col: int): bool = proc cmpSignatures(a, b: PSym, relevantCols: IntSet): int = result = 0 - for col in 1..<a.typ.len: + for col in FirstParamAt..<a.typ.signatureLen: if contains(relevantCols, col): var aa = skipTypes(a.typ[col], skipPtrs) var bb = skipTypes(b.typ[col], skipPtrs) @@ -233,13 +240,13 @@ proc sortBucket*(a: var seq[PSym], relevantCols: IntSet) = proc genIfDispatcher*(g: ModuleGraph; methods: seq[PSym], relevantCols: IntSet; idgen: IdGenerator): PSym = var base = methods[0].ast[dispatcherPos].sym result = base - var paramLen = base.typ.len + var paramLen = base.typ.signatureLen var nilchecks = newNodeI(nkStmtList, base.info) var disp = newNodeI(nkIfStmt, base.info) var ands = getSysMagic(g, unknownLineInfo, "and", mAnd) var iss = getSysMagic(g, unknownLineInfo, "of", mOf) let boolType = getSysType(g, unknownLineInfo, tyBool) - for col in 1..<paramLen: + for col in FirstParamAt..<paramLen: if contains(relevantCols, col): let param = base.typ.n[col].sym if param.typ.skipTypes(abstractInst).kind in {tyRef, tyPtr}: @@ -248,7 +255,7 @@ proc genIfDispatcher*(g: ModuleGraph; methods: seq[PSym], relevantCols: IntSet; for meth in 0..high(methods): var curr = methods[meth] # generate condition: var cond: PNode = nil - for col in 1..<paramLen: + for col in FirstParamAt..<paramLen: if contains(relevantCols, col): var isn = newNodeIT(nkCall, base.info, boolType) isn.add newSymNode(iss) @@ -263,7 +270,7 @@ proc genIfDispatcher*(g: ModuleGraph; methods: seq[PSym], relevantCols: IntSet; cond = a else: cond = isn - let retTyp = base.typ[0] + let retTyp = base.typ.returnType let call = newNodeIT(nkCall, base.info, retTyp) call.add newSymNode(curr) for col in 1..<paramLen: @@ -292,7 +299,7 @@ proc genIfDispatcher*(g: ModuleGraph; methods: seq[PSym], relevantCols: IntSet; proc generateIfMethodDispatchers*(g: ModuleGraph, idgen: IdGenerator) = for bucket in 0..<g.methods.len: var relevantCols = initIntSet() - for col in 1..<g.methods[bucket].methods[0].typ.len: + for col in FirstParamAt..<g.methods[bucket].methods[0].typ.signatureLen: if relevantCol(g.methods[bucket].methods, col): incl(relevantCols, col) if optMultiMethods notin g.config.globalOptions: # if multi-methods are not enabled, we are interested only in the first field diff --git a/compiler/closureiters.nim b/compiler/closureiters.nim index 4e4523601..8bdd04ca7 100644 --- a/compiler/closureiters.nim +++ b/compiler/closureiters.nim @@ -18,7 +18,8 @@ # dec a # # Should be transformed to: -# STATE0: +# case :state +# of 0: # if a > 0: # echo "hi" # :state = 1 # Next state @@ -26,19 +27,14 @@ # else: # :state = 2 # Next state # break :stateLoop # Proceed to the next state -# STATE1: +# of 1: # dec a # :state = 0 # Next state # break :stateLoop # Proceed to the next state -# STATE2: +# of 2: # :state = -1 # End of execution - -# The transformation should play well with lambdalifting, however depending -# on situation, it can be called either before or after lambdalifting -# transformation. As such we behave slightly differently, when accessing -# iterator state, or using temp variables. If lambdalifting did not happen, -# we just create local variables, so that they will be lifted further on. -# Otherwise, we utilize existing env, created by lambdalifting. +# else: +# return # Lambdalifting treats :state variable specially, it should always end up # as the first field in env. Currently C codegen depends on this behavior. @@ -104,12 +100,13 @@ # Is transformed to (yields are left in place for example simplicity, # in reality the code is subdivided even more, as described above): # -# STATE0: # Try +# case :state +# of 0: # Try # yield 0 # raise ... # :state = 2 # What would happen should we not raise # break :stateLoop -# STATE1: # Except +# of 1: # Except # yield 1 # :tmpResult = 3 # Return # :unrollFinally = true # Return @@ -117,7 +114,7 @@ # break :stateLoop # :state = 2 # What would happen should we not return # break :stateLoop -# STATE2: # Finally +# of 2: # Finally # yield 2 # if :unrollFinally: # This node is created by `newEndFinallyNode` # if :curExc.isNil: @@ -130,6 +127,8 @@ # raise # state = -1 # Goto next state. In this case we just exit # break :stateLoop +# else: +# return import ast, msgs, idents, @@ -145,12 +144,11 @@ type Ctx = object g: ModuleGraph fn: PSym - stateVarSym: PSym # :state variable. nil if env already introduced by lambdalifting tmpResultSym: PSym # Used when we return, but finally has to interfere unrollFinallySym: PSym # Indicates that we're unrolling finally states (either exception happened or premature return) curExcSym: PSym # Current exception - states: seq[PNode] # The resulting states. Every state is an nkState node. + states: seq[tuple[label: int, body: PNode]] # The resulting states. blockLevel: int # Temp used to transform break and continue stmts stateLoopLabel: PSym # Label to break on, when jumping between states. exitStateIdx: int # index of the last state @@ -162,15 +160,23 @@ type nearestFinally: int # Index of the nearest finally block. For try/except it # is their finally. For finally it is parent finally. Otherwise -1 idgen: IdGenerator + varStates: Table[ItemId, int] # Used to detect if local variable belongs to multiple states + stateVarSym: PSym # :state variable. nil if env already introduced by lambdalifting + # remove if -d:nimOptIters is default, treating it as always nil + nimOptItersEnabled: bool # tracks if -d:nimOptIters is enabled + # should be default when issues are fixed, see #24094 const nkSkip = {nkEmpty..nkNilLit, nkTemplateDef, nkTypeSection, nkStaticStmt, nkCommentStmt, nkMixinStmt, nkBindStmt} + procDefs + emptyStateLabel = -1 + localNotSeen = -1 + localRequiresLifting = -2 proc newStateAccess(ctx: var Ctx): PNode = if ctx.stateVarSym.isNil: result = rawIndirectAccess(newSymNode(getEnvParam(ctx.fn)), - getStateField(ctx.g, ctx.fn), ctx.fn.info) + getStateField(ctx.g, ctx.fn), ctx.fn.info) else: result = newSymNode(ctx.stateVarSym) @@ -187,7 +193,8 @@ proc newStateAssgn(ctx: var Ctx, stateNo: int = -2): PNode = proc newEnvVar(ctx: var Ctx, name: string, typ: PType): PSym = result = newSym(skVar, getIdent(ctx.g.cache, name), ctx.idgen, ctx.fn, ctx.fn.info) result.typ = typ - assert(not typ.isNil) + result.flags.incl sfNoInit + assert(not typ.isNil, "Env var needs a type") if not ctx.stateVarSym.isNil: # We haven't gone through labmda lifting yet, so just create a local var, @@ -198,7 +205,7 @@ proc newEnvVar(ctx: var Ctx, name: string, typ: PType): PSym = else: let envParam = getEnvParam(ctx.fn) # let obj = envParam.typ.lastSon - result = addUniqueField(envParam.typ.lastSon, result, ctx.g.cache, ctx.idgen) + result = addUniqueField(envParam.typ.elementType, result, ctx.g.cache, ctx.idgen) proc newEnvVarAccess(ctx: Ctx, s: PSym): PNode = if ctx.stateVarSym.isNil: @@ -206,9 +213,12 @@ proc newEnvVarAccess(ctx: Ctx, s: PSym): PNode = else: result = newSymNode(s) +proc newTempVarAccess(ctx: Ctx, s: PSym): PNode = + result = newSymNode(s, ctx.fn.info) + proc newTmpResultAccess(ctx: var Ctx): PNode = if ctx.tmpResultSym.isNil: - ctx.tmpResultSym = ctx.newEnvVar(":tmpResult", ctx.fn.typ[0]) + ctx.tmpResultSym = ctx.newEnvVar(":tmpResult", ctx.fn.typ.returnType) ctx.newEnvVarAccess(ctx.tmpResultSym) proc newUnrollFinallyAccess(ctx: var Ctx, info: TLineInfo): PNode = @@ -228,10 +238,7 @@ proc newState(ctx: var Ctx, n, gotoOut: PNode): int = result = ctx.states.len let resLit = ctx.g.newIntLit(n.info, result) - let s = newNodeI(nkState, n.info) - s.add(resLit) - s.add(n) - ctx.states.add(s) + ctx.states.add((result, n)) ctx.exceptionTable.add(ctx.curExcHandlingState) if not gotoOut.isNil: @@ -250,9 +257,26 @@ proc addGotoOut(n: PNode, gotoOut: PNode): PNode = if result.len == 0 or result[^1].kind != nkGotoState: result.add(gotoOut) -proc newTempVar(ctx: var Ctx, typ: PType): PSym = - result = ctx.newEnvVar(":tmpSlLower" & $ctx.tempVarId, typ) +proc newTempVarDef(ctx: Ctx, s: PSym, initialValue: PNode): PNode = + var v = initialValue + if v == nil: + v = ctx.g.emptyNode + newTree(nkVarSection, newTree(nkIdentDefs, newSymNode(s), ctx.g.emptyNode, v)) + +proc newEnvVarAsgn(ctx: Ctx, s: PSym, v: PNode): PNode + +proc newTempVar(ctx: var Ctx, typ: PType, parent: PNode, initialValue: PNode = nil): PSym = + if ctx.nimOptItersEnabled: + result = newSym(skVar, getIdent(ctx.g.cache, ":tmpSlLower" & $ctx.tempVarId), ctx.idgen, ctx.fn, ctx.fn.info) + else: + result = ctx.newEnvVar(":tmpSlLower" & $ctx.tempVarId, typ) inc ctx.tempVarId + result.typ = typ + assert(not typ.isNil, "Temp var needs a type") + if ctx.nimOptItersEnabled: + parent.add(ctx.newTempVarDef(result, initialValue)) + elif initialValue != nil: + parent.add(ctx.newEnvVarAsgn(result, initialValue)) proc hasYields(n: PNode): bool = # TODO: This is very inefficient. It traverses the node, looking for nkYieldStmt. @@ -263,8 +287,8 @@ proc hasYields(n: PNode): bool = result = false else: result = false - for c in n: - if c.hasYields: + for i in ord(n.kind == nkCast)..<n.len: + if n[i].hasYields: result = true break @@ -413,7 +437,7 @@ proc hasYieldsInExpressions(n: PNode): bool = proc exprToStmtList(n: PNode): tuple[s, res: PNode] = assert(n.kind == nkStmtListExpr) - result.s = newNodeI(nkStmtList, n.info) + result = (newNodeI(nkStmtList, n.info), nil) result.s.sons = @[] var n = n @@ -424,8 +448,15 @@ proc exprToStmtList(n: PNode): tuple[s, res: PNode] = result.res = n +proc newTempVarAsgn(ctx: Ctx, s: PSym, v: PNode): PNode = + if isEmptyType(v.typ): + result = v + else: + result = newTree(nkFastAsgn, ctx.newTempVarAccess(s), v) + result.info = v.info proc newEnvVarAsgn(ctx: Ctx, s: PSym, v: PNode): PNode = + # unused with -d:nimOptIters if isEmptyType(v.typ): result = v else: @@ -433,10 +464,13 @@ proc newEnvVarAsgn(ctx: Ctx, s: PSym, v: PNode): PNode = result.info = v.info proc addExprAssgn(ctx: Ctx, output, input: PNode, sym: PSym) = + var input = input if input.kind == nkStmtListExpr: let (st, res) = exprToStmtList(input) output.add(st) - output.add(ctx.newEnvVarAsgn(sym, res)) + input = res + if ctx.nimOptItersEnabled: + output.add(ctx.newTempVarAsgn(sym, input)) else: output.add(ctx.newEnvVarAsgn(sym, input)) @@ -448,6 +482,16 @@ proc newNotCall(g: ModuleGraph; e: PNode): PNode = result = newTree(nkCall, newSymNode(g.getSysMagic(e.info, "not", mNot), e.info), e) result.typ = g.getSysType(e.info, tyBool) +proc boolLit(g: ModuleGraph; info: TLineInfo; value: bool): PNode = + result = newIntLit(g, info, ord value) + result.typ = getSysType(g, info, tyBool) + +proc captureVar(c: var Ctx, s: PSym) = + if c.varStates.getOrDefault(s.itemId) != localRequiresLifting: + c.varStates[s.itemId] = localRequiresLifting # Mark this variable for lifting + let e = getEnvParam(c.fn) + discard addField(e.typ.elementType, s, c.g.cache, c.idgen) + proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = result = n case n.kind @@ -504,9 +548,9 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = var tmp: PSym = nil let isExpr = not isEmptyType(n.typ) if isExpr: - tmp = ctx.newTempVar(n.typ) result = newNodeI(nkStmtListExpr, n.info) result.typ = n.typ + tmp = ctx.newTempVar(n.typ, result) else: result = newNodeI(nkStmtList, n.info) @@ -557,7 +601,11 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = else: internalError(ctx.g.config, "lowerStmtListExpr(nkIf): " & $branch.kind) - if isExpr: result.add(ctx.newEnvVarAccess(tmp)) + if isExpr: + if ctx.nimOptItersEnabled: + result.add(ctx.newTempVarAccess(tmp)) + else: + result.add(ctx.newEnvVarAccess(tmp)) of nkTryStmt, nkHiddenTryStmt: var ns = false @@ -571,7 +619,7 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = if isExpr: result = newNodeI(nkStmtListExpr, n.info) result.typ = n.typ - let tmp = ctx.newTempVar(n.typ) + let tmp = ctx.newTempVar(n.typ, result) n[0] = ctx.convertExprBodyToAsgn(n[0], tmp) for i in 1..<n.len: @@ -587,7 +635,10 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = else: internalError(ctx.g.config, "lowerStmtListExpr(nkTryStmt): " & $branch.kind) result.add(n) - result.add(ctx.newEnvVarAccess(tmp)) + if ctx.nimOptItersEnabled: + result.add(ctx.newTempVarAccess(tmp)) + else: + result.add(ctx.newEnvVarAccess(tmp)) of nkCaseStmt: var ns = false @@ -600,9 +651,9 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = let isExpr = not isEmptyType(n.typ) if isExpr: - let tmp = ctx.newTempVar(n.typ) result = newNodeI(nkStmtListExpr, n.info) result.typ = n.typ + let tmp = ctx.newTempVar(n.typ, result) if n[0].kind == nkStmtListExpr: let (st, ex) = exprToStmtList(n[0]) @@ -619,7 +670,10 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = else: internalError(ctx.g.config, "lowerStmtListExpr(nkCaseStmt): " & $branch.kind) result.add(n) - result.add(ctx.newEnvVarAccess(tmp)) + if ctx.nimOptItersEnabled: + result.add(ctx.newTempVarAccess(tmp)) + else: + result.add(ctx.newEnvVarAccess(tmp)) elif n[0].kind == nkStmtListExpr: result = newNodeI(nkStmtList, n.info) let (st, ex) = exprToStmtList(n[0]) @@ -649,10 +703,14 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = result.add(st) cond = ex - let tmp = ctx.newTempVar(cond.typ) - result.add(ctx.newEnvVarAsgn(tmp, cond)) + let tmp = ctx.newTempVar(cond.typ, result, cond) + # result.add(ctx.newTempVarAsgn(tmp, cond)) - var check = ctx.newEnvVarAccess(tmp) + var check: PNode + if ctx.nimOptItersEnabled: + check = ctx.newTempVarAccess(tmp) + else: + check = ctx.newEnvVarAccess(tmp) if n[0].sym.magic == mOr: check = ctx.g.newNotCall(check) @@ -662,12 +720,18 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = let (st, ex) = exprToStmtList(cond) ifBody.add(st) cond = ex - ifBody.add(ctx.newEnvVarAsgn(tmp, cond)) + if ctx.nimOptItersEnabled: + ifBody.add(ctx.newTempVarAsgn(tmp, cond)) + else: + ifBody.add(ctx.newEnvVarAsgn(tmp, cond)) let ifBranch = newTree(nkElifBranch, check, ifBody) let ifNode = newTree(nkIfStmt, ifBranch) result.add(ifNode) - result.add(ctx.newEnvVarAccess(tmp)) + if ctx.nimOptItersEnabled: + result.add(ctx.newTempVarAccess(tmp)) + else: + result.add(ctx.newEnvVarAccess(tmp)) else: for i in 0..<n.len: if n[i].kind == nkStmtListExpr: @@ -676,9 +740,12 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = n[i] = ex if n[i].kind in nkCallKinds: # XXX: This should better be some sort of side effect tracking - let tmp = ctx.newTempVar(n[i].typ) - result.add(ctx.newEnvVarAsgn(tmp, n[i])) - n[i] = ctx.newEnvVarAccess(tmp) + let tmp = ctx.newTempVar(n[i].typ, result, n[i]) + # result.add(ctx.newTempVarAsgn(tmp, n[i])) + if ctx.nimOptItersEnabled: + n[i] = ctx.newTempVarAccess(tmp) + else: + n[i] = ctx.newEnvVarAccess(tmp) result.add(n) @@ -694,6 +761,12 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = let (st, ex) = exprToStmtList(c[^1]) result.add(st) c[^1] = ex + for i in 0 .. c.len - 3: + if c[i].kind == nkSym: + let s = c[i].sym + if sfForceLift in s.flags: + ctx.captureVar(s) + result.add(varSect) of nkDiscardStmt, nkReturnStmt, nkRaiseStmt: @@ -779,7 +852,7 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = let check = newTree(nkIfStmt, branch) let newBody = newTree(nkStmtList, st, check, n[1]) - n[0] = newSymNode(ctx.g.getSysSym(n[0].info, "true")) + n[0] = ctx.g.boolLit(n[0].info, true) n[1] = newBody of nkDotExpr, nkCheckedFieldExpr: @@ -831,7 +904,7 @@ proc newEndFinallyNode(ctx: var Ctx, info: TLineInfo): PNode = let retStmt = if ctx.nearestFinally == 0: # last finally, we can return - let retValue = if ctx.fn.typ[0].isNil: + let retValue = if ctx.fn.typ.returnType.isNil: ctx.g.emptyNode else: newTree(nkFastAsgn, @@ -1133,10 +1206,10 @@ proc skipEmptyStates(ctx: Ctx, stateIdx: int): int = let label = stateIdx if label == ctx.exitStateIdx: break var newLabel = label - if label == -1: + if label == emptyStateLabel: newLabel = ctx.exitStateIdx else: - let fs = skipStmtList(ctx, ctx.states[label][1]) + let fs = skipStmtList(ctx, ctx.states[label].body) if fs.kind == nkGotoState: newLabel = fs[0].intVal.int if label == newLabel: break @@ -1145,7 +1218,7 @@ proc skipEmptyStates(ctx: Ctx, stateIdx: int): int = if maxJumps == 0: assert(false, "Internal error") - result = ctx.states[stateIdx][0].intVal.int + result = ctx.states[stateIdx].label proc skipThroughEmptyStates(ctx: var Ctx, n: PNode): PNode= result = n @@ -1263,11 +1336,10 @@ proc wrapIntoTryExcept(ctx: var Ctx, n: PNode): PNode {.inline.} = proc wrapIntoStateLoop(ctx: var Ctx, n: PNode): PNode = # while true: # block :stateLoop: - # gotoState :state # local vars decl (if needed) # body # Might get wrapped in try-except let loopBody = newNodeI(nkStmtList, n.info) - result = newTree(nkWhileStmt, newSymNode(ctx.g.getSysSym(n.info, "true")), loopBody) + result = newTree(nkWhileStmt, ctx.g.boolLit(n.info, true), loopBody) result.info = n.info let localVars = newNodeI(nkStmtList, n.info) @@ -1282,11 +1354,7 @@ proc wrapIntoStateLoop(ctx: var Ctx, n: PNode): PNode = let blockStmt = newNodeI(nkBlockStmt, n.info) blockStmt.add(newSymNode(ctx.stateLoopLabel)) - let gs = newNodeI(nkGotoState, n.info) - gs.add(ctx.newStateAccess()) - gs.add(ctx.g.newIntLit(n.info, ctx.states.len - 1)) - - var blockBody = newTree(nkStmtList, gs, localVars, n) + var blockBody = newTree(nkStmtList, localVars, n) if ctx.hasExceptions: blockBody = ctx.wrapIntoTryExcept(blockBody) @@ -1299,29 +1367,28 @@ proc deleteEmptyStates(ctx: var Ctx) = # Apply new state indexes and mark unused states with -1 var iValid = 0 - for i, s in ctx.states: - let body = skipStmtList(ctx, s[1]) + for i, s in ctx.states.mpairs: + let body = skipStmtList(ctx, s.body) if body.kind == nkGotoState and i != ctx.states.len - 1 and i != 0: # This is an empty state. Mark with -1. - s[0].intVal = -1 + s.label = emptyStateLabel else: - s[0].intVal = iValid + s.label = iValid inc iValid for i, s in ctx.states: - let body = skipStmtList(ctx, s[1]) + let body = skipStmtList(ctx, s.body) if body.kind != nkGotoState or i == 0: - discard ctx.skipThroughEmptyStates(s) + discard ctx.skipThroughEmptyStates(s.body) let excHandlState = ctx.exceptionTable[i] if excHandlState < 0: ctx.exceptionTable[i] = -ctx.skipEmptyStates(-excHandlState) elif excHandlState != 0: ctx.exceptionTable[i] = ctx.skipEmptyStates(excHandlState) - var i = 0 + var i = 1 # ignore the entry and the exit while i < ctx.states.len - 1: - let fs = skipStmtList(ctx, ctx.states[i][1]) - if fs.kind == nkGotoState and i != 0: + if ctx.states[i].label == emptyStateLabel: ctx.states.delete(i) ctx.exceptionTable.delete(i) else: @@ -1430,18 +1497,77 @@ proc preprocess(c: var PreprocessContext; n: PNode): PNode = for i in 0 ..< n.len: result[i] = preprocess(c, n[i]) +proc detectCapturedVars(c: var Ctx, n: PNode, stateIdx: int) = + case n.kind + of nkSym: + let s = n.sym + if s.kind in {skResult, skVar, skLet, skForVar, skTemp} and sfGlobal notin s.flags and s.owner == c.fn: + let vs = c.varStates.getOrDefault(s.itemId, localNotSeen) + if vs == localNotSeen: # First seing this variable + c.varStates[s.itemId] = stateIdx + elif vs == localRequiresLifting: + discard # Sym already marked + elif vs != stateIdx: + c.captureVar(s) + of nkReturnStmt: + if n[0].kind in {nkAsgn, nkFastAsgn, nkSinkAsgn}: + # we have a `result = result` expression produced by the closure + # transform, let's not touch the LHS in order to make the lifting pass + # correct when `result` is lifted + detectCapturedVars(c, n[0][1], stateIdx) + else: + detectCapturedVars(c, n[0], stateIdx) + else: + for i in 0 ..< n.safeLen: + detectCapturedVars(c, n[i], stateIdx) + +proc detectCapturedVars(c: var Ctx) = + for i, s in c.states: + detectCapturedVars(c, s.body, i) + +proc liftLocals(c: var Ctx, n: PNode): PNode = + result = n + case n.kind + of nkSym: + let s = n.sym + if c.varStates.getOrDefault(s.itemId) == localRequiresLifting: + # lift + let e = getEnvParam(c.fn) + let field = getFieldFromObj(e.typ.elementType, s) + assert(field != nil) + result = rawIndirectAccess(newSymNode(e), field, n.info) + # elif c.varStates.getOrDefault(s.itemId, localNotSeen) != localNotSeen: + # echo "Not lifting ", s.name.s + + of nkReturnStmt: + if n[0].kind in {nkAsgn, nkFastAsgn, nkSinkAsgn}: + # we have a `result = result` expression produced by the closure + # transform, let's not touch the LHS in order to make the lifting pass + # correct when `result` is lifted + n[0][1] = liftLocals(c, n[0][1]) + else: + n[0] = liftLocals(c, n[0]) + else: + for i in 0 ..< n.safeLen: + n[i] = liftLocals(c, n[i]) + proc transformClosureIterator*(g: ModuleGraph; idgen: IdGenerator; fn: PSym, n: PNode): PNode = - var ctx: Ctx - ctx.g = g - ctx.fn = fn - ctx.idgen = idgen + var ctx = Ctx(g: g, fn: fn, idgen: idgen, + # should be default when issues are fixed, see #24094: + nimOptItersEnabled: isDefined(g.config, "nimOptIters")) if getEnvParam(fn).isNil: - # Lambda lifting was not done yet. Use temporary :state sym, which will - # be handled specially by lambda lifting. Local temp vars (if needed) - # should follow the same logic. - ctx.stateVarSym = newSym(skVar, getIdent(ctx.g.cache, ":state"), idgen, fn, fn.info) - ctx.stateVarSym.typ = g.createClosureIterStateType(fn, idgen) + if ctx.nimOptItersEnabled: + # The transformation should always happen after at least partial lambdalifting + # is performed, so that the closure iter environment is always created upfront. + doAssert(false, "Env param not created before iter transformation") + else: + # Lambda lifting was not done yet. Use temporary :state sym, which will + # be handled specially by lambda lifting. Local temp vars (if needed) + # should follow the same logic. + ctx.stateVarSym = newSym(skVar, getIdent(ctx.g.cache, ":state"), idgen, fn, fn.info) + ctx.stateVarSym.typ = g.createClosureIterStateType(fn, idgen) + ctx.stateLoopLabel = newSym(skLabel, getIdent(ctx.g.cache, ":stateLoop"), idgen, fn, fn.info) var pc = PreprocessContext(finallys: @[], config: g.config, idgen: idgen) var n = preprocess(pc, n.toStmtList) @@ -1463,17 +1589,23 @@ proc transformClosureIterator*(g: ModuleGraph; idgen: IdGenerator; fn: PSym, n: # Optimize empty states away ctx.deleteEmptyStates() - # Make new body by concatenating the list of states - result = newNodeI(nkStmtList, n.info) + let caseDispatcher = newTreeI(nkCaseStmt, n.info, + ctx.newStateAccess()) + + if ctx.nimOptItersEnabled: + # Lamdalifting will not touch our locals, it is our responsibility to lift those that + # need it. + detectCapturedVars(ctx) + for s in ctx.states: - assert(s.len == 2) - let body = s[1] - s.sons.del(1) - result.add(s) - result.add(body) + let body = ctx.transformStateAssignments(s.body) + caseDispatcher.add newTreeI(nkOfBranch, body.info, g.newIntLit(body.info, s.label), body) + + caseDispatcher.add newTreeI(nkElse, n.info, newTreeI(nkReturnStmt, n.info, g.emptyNode)) - result = ctx.transformStateAssignments(result) - result = ctx.wrapIntoStateLoop(result) + result = wrapIntoStateLoop(ctx, caseDispatcher) + if ctx.nimOptItersEnabled: + result = liftLocals(ctx, result) when false: echo "TRANSFORM TO STATES: " @@ -1482,3 +1614,5 @@ proc transformClosureIterator*(g: ModuleGraph; idgen: IdGenerator; fn: PSym, n: echo "exception table:" for i, e in ctx.exceptionTable: echo i, " -> ", e + + echo "ENV: ", renderTree(getEnvParam(fn).typ.elementType.n) diff --git a/compiler/cmdlinehelper.nim b/compiler/cmdlinehelper.nim index 031ad755e..e51248639 100644 --- a/compiler/cmdlinehelper.nim +++ b/compiler/cmdlinehelper.nim @@ -57,6 +57,11 @@ proc loadConfigsAndProcessCmdLine*(self: NimProg, cache: IdentCache; conf: Confi if conf.cmd == cmdNimscript: incl(conf.globalOptions, optWasNimscript) loadConfigs(DefaultConfig, cache, conf, graph.idgen) # load all config files + # restores `conf.notes` after loading config files + # because it has overwrites the notes when compiling the system module which + # is a foreign module compared to the project + if conf.cmd in cmdBackends: + conf.notes = conf.mainPackageNotes if not self.suggestMode: let scriptFile = conf.projectFull.changeFileExt("nims") diff --git a/compiler/commands.nim b/compiler/commands.nim index 176b73044..cbf915ca6 100644 --- a/compiler/commands.nim +++ b/compiler/commands.nim @@ -24,7 +24,7 @@ bootSwitch(usedMarkAndSweep, defined(gcmarkandsweep), "--gc:markAndSweep") bootSwitch(usedGoGC, defined(gogc), "--gc:go") bootSwitch(usedNoGC, defined(nogc), "--gc:none") -import std/[setutils, os, strutils, parseutils, parseopt, sequtils, strtabs] +import std/[setutils, os, strutils, parseutils, parseopt, sequtils, strtabs, enumutils] import msgs, options, nversion, condsyms, extccomp, platform, wordrecg, nimblecmd, lineinfos, pathutils @@ -248,6 +248,7 @@ const errNoneSpeedOrSizeExpectedButXFound = "'none', 'speed' or 'size' expected, but '$1' found" errGuiConsoleOrLibExpectedButXFound = "'gui', 'console', 'lib' or 'staticlib' expected, but '$1' found" errInvalidExceptionSystem = "'goto', 'setjmp', 'cpp' or 'quirky' expected, but '$1' found" + errInvalidFeatureButXFound = Feature.toSeq.map(proc(val:Feature): string = "'$1'" % $val).join(", ") & " expected, but '$1' found" template warningOptionNoop(switch: string) = warningDeprecated(conf, info, "'$#' is deprecated, now a noop" % switch) @@ -303,6 +304,12 @@ proc testCompileOptionArg*(conf: ConfigRef; switch, arg: string, info: TLineInfo else: result = false localError(conf, info, errInvalidExceptionSystem % arg) + of "experimental": + try: + result = conf.features.contains parseEnum[Feature](arg) + except ValueError: + result = false + localError(conf, info, errInvalidFeatureButXFound % arg) else: result = false invalidCmdLineOption(conf, passCmd1, switch, info) @@ -462,7 +469,6 @@ proc handleCmdInput*(conf: ConfigRef) = proc parseCommand*(command: string): Command = case command.normalize of "c", "cc", "compile", "compiletoc": cmdCompileToC - of "nir": cmdCompileToNir of "cpp", "compiletocpp": cmdCompileToCpp of "objc", "compiletooc": cmdCompileToOC of "js", "compiletojs": cmdCompileToJS @@ -500,7 +506,6 @@ proc setCmd*(conf: ConfigRef, cmd: Command) = of cmdCompileToCpp: conf.backend = backendCpp of cmdCompileToOC: conf.backend = backendObjc of cmdCompileToJS: conf.backend = backendJs - of cmdCompileToNir: conf.backend = backendNir else: discard proc setCommandEarly*(conf: ConfigRef, command: string) = diff --git a/compiler/concepts.nim b/compiler/concepts.nim index 037060417..d48bacdc5 100644 --- a/compiler/concepts.nim +++ b/compiler/concepts.nim @@ -96,7 +96,7 @@ proc matchType(c: PContext; f, a: PType; m: var MatchCon): bool = ignorableForArgType = {tyVar, tySink, tyLent, tyOwned, tyGenericInst, tyAlias, tyInferred} case f.kind of tyAlias: - result = matchType(c, f.lastSon, a, m) + result = matchType(c, f.skipModifier, a, m) of tyTypeDesc: if isSelf(f): #let oldLen = m.inferred.len @@ -105,18 +105,19 @@ proc matchType(c: PContext; f, a: PType; m: var MatchCon): bool = #m.inferred.setLen oldLen #echo "A for ", result, " to ", typeToString(a), " to ", typeToString(m.potentialImplementation) else: - if a.kind == tyTypeDesc and f.len == a.len: - for i in 0..<a.len: - if not matchType(c, f[i], a[i], m): return false - return true + if a.kind == tyTypeDesc and f.hasElementType == a.hasElementType: + if f.hasElementType: + result = matchType(c, f.elementType, a.elementType, m) + else: + result = true # both lack it else: result = false of tyGenericInvocation: result = false - if a.kind == tyGenericInst and a[0].kind == tyGenericBody: - if sameType(f[0], a[0]) and f.len == a.len-1: - for i in 1 ..< f.len: + if a.kind == tyGenericInst and a.genericHead.kind == tyGenericBody: + if sameType(f.genericHead, a.genericHead) and f.kidsLen == a.kidsLen-1: + for i in FirstGenericParamAt ..< f.kidsLen: if not matchType(c, f[i], a[i], m): return false return true of tyGenericParam: @@ -126,17 +127,17 @@ proc matchType(c: PContext; f, a: PType; m: var MatchCon): bool = else: let old = existingBinding(m, f) if old == nil: - if f.len > 0 and f[0].kind != tyNone: + if f.hasElementType and f.elementType.kind != tyNone: # also check the generic's constraints: let oldLen = m.inferred.len - result = matchType(c, f[0], a, m) + result = matchType(c, f.elementType, a, m) m.inferred.setLen oldLen if result: when logBindings: echo "A adding ", f, " ", ak m.inferred.add((f, ak)) elif m.magic == mArrGet and ak.kind in {tyArray, tyOpenArray, tySequence, tyVarargs, tyCstring, tyString}: when logBindings: echo "B adding ", f, " ", lastSon ak - m.inferred.add((f, lastSon ak)) + m.inferred.add((f, last ak)) result = true else: when logBindings: echo "C adding ", f, " ", ak @@ -155,9 +156,9 @@ proc matchType(c: PContext; f, a: PType; m: var MatchCon): bool = # modifiers in the concept must be there in the actual implementation # too but not vice versa. if a.kind == f.kind: - result = matchType(c, f[0], a[0], m) + result = matchType(c, f.elementType, a.elementType, m) elif m.magic == mArrPut: - result = matchType(c, f[0], a, m) + result = matchType(c, f.elementType, a, m) else: result = false of tyEnum, tyObject, tyDistinct: @@ -167,7 +168,7 @@ proc matchType(c: PContext; f, a: PType; m: var MatchCon): bool = of tyBool, tyChar, tyInt..tyUInt64: let ak = a.skipTypes(ignorableForArgType) result = ak.kind == f.kind or ak.kind == tyOrdinal or - (ak.kind == tyGenericParam and ak.len > 0 and ak[0].kind == tyOrdinal) + (ak.kind == tyGenericParam and ak.hasElementType and ak.elementType.kind == tyOrdinal) of tyConcept: let oldLen = m.inferred.len let oldPotentialImplementation = m.potentialImplementation @@ -178,10 +179,11 @@ proc matchType(c: PContext; f, a: PType; m: var MatchCon): bool = m.inferred.setLen oldLen of tyArray, tyTuple, tyVarargs, tyOpenArray, tyRange, tySequence, tyRef, tyPtr, tyGenericInst: + # ^ XXX Rewrite this logic, it's more complex than it needs to be. result = false let ak = a.skipTypes(ignorableForArgType - {f.kind}) - if ak.kind == f.kind and f.len == ak.len: - for i in 0..<ak.len: + if ak.kind == f.kind and f.kidsLen == ak.kidsLen: + for i in 0..<ak.kidsLen: if not matchType(c, f[i], ak[i], m): return false return true of tyOr: @@ -190,30 +192,30 @@ proc matchType(c: PContext; f, a: PType; m: var MatchCon): bool = # say the concept requires 'int|float|string' if the potentialImplementation # says 'int|string' that is good enough. var covered = 0 - for i in 0..<f.len: - for j in 0..<a.len: + for ff in f.kids: + for aa in a.kids: let oldLenB = m.inferred.len - let r = matchType(c, f[i], a[j], m) + let r = matchType(c, ff, aa, m) if r: inc covered break m.inferred.setLen oldLenB - result = covered >= a.len + result = covered >= a.kidsLen if not result: m.inferred.setLen oldLen else: result = false - for i in 0..<f.len: - result = matchType(c, f[i], a, m) + for ff in f.kids: + result = matchType(c, ff, a, m) if result: break # and remember the binding! m.inferred.setLen oldLen of tyNot: if a.kind == tyNot: - result = matchType(c, f[0], a[0], m) + result = matchType(c, f.elementType, a.elementType, m) else: let oldLen = m.inferred.len - result = not matchType(c, f[0], a, m) + result = not matchType(c, f.elementType, a, m) m.inferred.setLen oldLen of tyAnything: result = true @@ -252,7 +254,7 @@ proc matchSym(c: PContext; candidate: PSym, n: PNode; m: var MatchCon): bool = m.inferred.setLen oldLen return false - if not matchReturnType(c, n[0].sym.typ[0], candidate.typ[0], m): + if not matchReturnType(c, n[0].sym.typ.returnType, candidate.typ.returnType, m): m.inferred.setLen oldLen return false @@ -307,9 +309,9 @@ proc conceptMatchNode(c: PContext; n: PNode; m: var MatchCon): bool = # error was reported earlier. result = false -proc conceptMatch*(c: PContext; concpt, arg: PType; bindings: var TIdTable; invocation: PType): bool = +proc conceptMatch*(c: PContext; concpt, arg: PType; bindings: var TypeMapping; invocation: PType): bool = ## Entry point from sigmatch. 'concpt' is the concept we try to match (here still a PType but - ## we extract its AST via 'concpt.n.lastSon'). 'arg' is the type that might fullfill the + ## we extract its AST via 'concpt.n.lastSon'). 'arg' is the type that might fulfill the ## concept's requirements. If so, we return true and fill the 'bindings' with pairs of ## (typeVar, instance) pairs. ('typeVar' is usually simply written as a generic 'T'.) ## 'invocation' can be nil for atomic concepts. For non-atomic concepts, it contains the @@ -334,8 +336,8 @@ proc conceptMatch*(c: PContext; concpt, arg: PType; bindings: var TIdTable; invo # we have a match, so bind 'arg' itself to 'concpt': bindings.idTablePut(concpt, arg) # invocation != nil means we have a non-atomic concept: - if invocation != nil and arg.kind == tyGenericInst and invocation.len == arg.len-1: + if invocation != nil and arg.kind == tyGenericInst and invocation.kidsLen == arg.kidsLen-1: # bind even more generic parameters assert invocation.kind == tyGenericInvocation - for i in 1 ..< invocation.len: + for i in FirstGenericParamAt ..< invocation.kidsLen: bindings.idTablePut(invocation[i], arg[i]) diff --git a/compiler/condsyms.nim b/compiler/condsyms.nim index 5865e5310..5043fc5d4 100644 --- a/compiler/condsyms.nim +++ b/compiler/condsyms.nim @@ -157,6 +157,7 @@ proc initDefines*(symbols: StringTableRef) = defineSymbol("nimAllowNonVarDestructor") defineSymbol("nimHasQuirky") defineSymbol("nimHasEnsureMove") + defineSymbol("nimHasNoReturnError") defineSymbol("nimUseStrictDefs") defineSymbol("nimHasNolineTooLong") @@ -165,3 +166,6 @@ proc initDefines*(symbols: StringTableRef) = defineSymbol("nimHasWarnStdPrefix") defineSymbol("nimHasVtables") + defineSymbol("nimHasGenericsOpenSym2") + defineSymbol("nimHasGenericsOpenSym3") + defineSymbol("nimHasJsNoLambdaLifting") diff --git a/compiler/dfa.nim b/compiler/dfa.nim index 1511628dd..5534d07e7 100644 --- a/compiler/dfa.nim +++ b/compiler/dfa.nim @@ -46,10 +46,10 @@ type case isTryBlock: bool of false: label: PSym - breakFixups: seq[(TPosition, seq[PNode])] #Contains the gotos for the breaks along with their pending finales + breakFixups: seq[(TPosition, seq[PNode])] # Contains the gotos for the breaks along with their pending finales of true: finale: PNode - raiseFixups: seq[TPosition] #Contains the gotos for the raises + raiseFixups: seq[TPosition] # Contains the gotos for the raises Con = object code: ControlFlowGraph @@ -181,14 +181,6 @@ proc genIf(c: var Con, n: PNode) = goto Lend3 L3: D - goto Lend3 # not eliminated to simplify the join generation - Lend3: - join F3 - Lend2: - join F2 - Lend: - join F1 - ]# var endings: seq[TPosition] = @[] let oldInteresting = c.interestingInstructions @@ -213,7 +205,6 @@ proc genAndOr(c: var Con; n: PNode) = # fork lab1 # asgn dest, b # lab1: - # join F1 c.gen(n[1]) forkT: c.gen(n[2]) @@ -324,7 +315,7 @@ proc genRaise(c: var Con; n: PNode) = if c.blocks[i].isTryBlock: genBreakOrRaiseAux(c, i, n) return - assert false #Unreachable + assert false # Unreachable else: genNoReturn(c) @@ -380,7 +371,7 @@ proc genCall(c: var Con; n: PNode) = if t != nil: t = t.skipTypes(abstractInst) for i in 1..<n.len: gen(c, n[i]) - if t != nil and i < t.len and isOutParam(t[i]): + if t != nil and i < t.signatureLen and isOutParam(t[i]): # Pass by 'out' is a 'must def'. Good enough for a move optimizer. genDef(c, n[i]) # every call can potentially raise: @@ -390,7 +381,6 @@ proc genCall(c: var Con; n: PNode) = # fork lab1 # goto exceptionHandler (except or finally) # lab1: - # join F1 forkT: for i in countdown(c.blocks.high, 0): if c.blocks[i].isTryBlock: diff --git a/compiler/docgen.nim b/compiler/docgen.nim index 29eeced9b..8e5f5e4e7 100644 --- a/compiler/docgen.nim +++ b/compiler/docgen.nim @@ -289,7 +289,7 @@ template declareClosures(currentFilename: AbsoluteFile, destFile: string) = let outDirPath: RelativeFile = presentationPath(conf, AbsoluteFile(basedir / targetRelPath)) # use presentationPath because `..` path can be be mangled to `_._` - result.targetPath = string(conf.outDir / outDirPath) + result = (string(conf.outDir / outDirPath), "") if not fileExists(result.targetPath): # this can happen if targetRelPath goes to parent directory `OUTDIR/..`. # Trying it, this may cause ambiguities, but allows us to insert @@ -831,7 +831,7 @@ proc getName(n: PNode): string = result = "`" for i in 0..<n.len: result.add(getName(n[i])) result = "`" - of nkOpenSymChoice, nkClosedSymChoice: + of nkOpenSymChoice, nkClosedSymChoice, nkOpenSym: result = getName(n[0]) else: result = "" @@ -849,7 +849,7 @@ proc getNameIdent(cache: IdentCache; n: PNode): PIdent = var r = "" for i in 0..<n.len: r.add(getNameIdent(cache, n[i]).s) result = getIdent(cache, r) - of nkOpenSymChoice, nkClosedSymChoice: + of nkOpenSymChoice, nkClosedSymChoice, nkOpenSym: result = getNameIdent(cache, n[0]) else: result = nil @@ -863,7 +863,7 @@ proc getRstName(n: PNode): PRstNode = of nkAccQuoted: result = getRstName(n[0]) for i in 1..<n.len: result.text.add(getRstName(n[i]).text) - of nkOpenSymChoice, nkClosedSymChoice: + of nkOpenSymChoice, nkClosedSymChoice, nkOpenSym: result = getRstName(n[0]) else: result = nil @@ -1000,8 +1000,9 @@ proc getTypeKind(n: PNode): string = proc toLangSymbol(k: TSymKind, n: PNode, baseName: string): LangSymbol = ## Converts symbol info (names/types/parameters) in `n` into format ## `LangSymbol` convenient for ``rst.nim``/``dochelpers.nim``. - result.name = baseName.nimIdentNormalize - result.symKind = k.toHumanStr + result = LangSymbol(name: baseName.nimIdentNormalize, + symKind: k.toHumanStr + ) if k in routineKinds: var paramTypes: seq[string] = @[] @@ -1030,7 +1031,7 @@ proc toLangSymbol(k: TSymKind, n: PNode, baseName: string): LangSymbol = if genNode != nil: var literal = "" var r: TSrcGen = initTokRender(genNode, {renderNoBody, renderNoComments, - renderNoPragmas, renderNoProcDefs, renderExpandUsing}) + renderNoPragmas, renderNoProcDefs, renderExpandUsing, renderNoPostfix}) var kind = tkEof while true: getNextTok(r, kind, literal) @@ -1058,7 +1059,7 @@ proc genItem(d: PDoc, n, nameNode: PNode, k: TSymKind, docFlags: DocFlags, nonEx # Obtain the plain rendered string for hyperlink titles. var r: TSrcGen = initTokRender(n, {renderNoBody, renderNoComments, renderDocComments, - renderNoPragmas, renderNoProcDefs, renderExpandUsing}) + renderNoPragmas, renderNoProcDefs, renderExpandUsing, renderNoPostfix}) while true: getNextTok(r, kind, literal) if kind == tkEof: @@ -1085,6 +1086,9 @@ proc genItem(d: PDoc, n, nameNode: PNode, k: TSymKind, docFlags: DocFlags, nonEx symbolOrIdEnc = encodeUrl(symbolOrId, usePlus = false) deprecationMsg = genDeprecationMsg(d, pragmaNode) rstLangSymbol = toLangSymbol(k, n, cleanPlainSymbol) + symNameNode = + if nameNode.kind == nkPostfix: nameNode[1] + else: nameNode # we generate anchors automatically for subsequent use in doc comments let lineinfo = rstast.TLineInfo( @@ -1095,10 +1099,10 @@ proc genItem(d: PDoc, n, nameNode: PNode, k: TSymKind, docFlags: DocFlags, nonEx priority = symbolPriority(k), info = lineinfo, module = addRstFileIndex(d, FileIndex d.module.position)) - let renderFlags = - if nonExports: {renderNoBody, renderNoComments, renderDocComments, renderSyms, - renderExpandUsing, renderNonExportedFields} - else: {renderNoBody, renderNoComments, renderDocComments, renderSyms, renderExpandUsing} + var renderFlags = {renderNoBody, renderNoComments, renderDocComments, + renderSyms, renderExpandUsing, renderNoPostfix} + if nonExports: + renderFlags.incl renderNonExportedFields nodeToHighlightedHtml(d, n, result, renderFlags, symbolOrIdEnc) let seeSrc = genSeeSrc(d, toFullPath(d.conf, n.info), n.info.line.int) @@ -1121,18 +1125,19 @@ proc genItem(d: PDoc, n, nameNode: PNode, k: TSymKind, docFlags: DocFlags, nonEx let external = d.destFile.AbsoluteFile.relativeTo(d.conf.outDir, '/').changeFileExt(HtmlExt).string var attype = "" - if k in routineKinds and nameNode.kind == nkSym: + if k in routineKinds and symNameNode.kind == nkSym: let att = attachToType(d, nameNode.sym) if att != nil: attype = esc(d.target, att.name.s) - elif k == skType and nameNode.kind == nkSym and nameNode.sym.typ.kind in {tyEnum, tyBool}: - let etyp = nameNode.sym.typ + elif k == skType and symNameNode.kind == nkSym and + symNameNode.sym.typ.kind in {tyEnum, tyBool}: + let etyp = symNameNode.sym.typ for e in etyp.n: if e.sym.kind != skEnumField: continue let plain = renderPlainSymbolName(e) let symbolOrId = d.newUniquePlainSymbol(plain) setIndexTerm(d[], ieNim, htmlFile = external, id = symbolOrId, - term = plain, linkTitle = nameNode.sym.name.s & '.' & plain, + term = plain, linkTitle = symNameNode.sym.name.s & '.' & plain, linkDesc = xmltree.escape(getPlainDocstring(e).docstringSummary), line = n.info.line.int) @@ -1153,8 +1158,8 @@ proc genItem(d: PDoc, n, nameNode: PNode, k: TSymKind, docFlags: DocFlags, nonEx linkTitle = detailedName, linkDesc = xmltree.escape(plainDocstring.docstringSummary), line = n.info.line.int) - if k == skType and nameNode.kind == nkSym: - d.types.strTableAdd nameNode.sym + if k == skType and symNameNode.kind == nkSym: + d.types.strTableAdd symNameNode.sym proc genJsonItem(d: PDoc, n, nameNode: PNode, k: TSymKind, nonExports = false): JsonItem = if not isVisible(d, nameNode): return @@ -1162,12 +1167,14 @@ proc genJsonItem(d: PDoc, n, nameNode: PNode, k: TSymKind, nonExports = false): name = getNameEsc(d, nameNode) comm = genRecComment(d, n) r: TSrcGen - renderFlags = {renderNoBody, renderNoComments, renderDocComments, renderExpandUsing} + renderFlags = {renderNoBody, renderNoComments, renderDocComments, + renderExpandUsing, renderNoPostfix} if nonExports: renderFlags.incl renderNonExportedFields r = initTokRender(n, renderFlags) - result.json = %{ "name": %name, "type": %($k), "line": %n.info.line.int, + result = JsonItem(json: %{ "name": %name, "type": %($k), "line": %n.info.line.int, "col": %n.info.col} + ) if comm != nil: result.rst = comm result.rstField = "description" @@ -1199,8 +1206,7 @@ proc genJsonItem(d: PDoc, n, nameNode: PNode, k: TSymKind, nonExports = false): var param = %{"name": %($genericParam)} if genericParam.sym.typ.len > 0: param["types"] = newJArray() - for kind in genericParam.sym.typ: - param["types"].add %($kind) + param["types"] = %($genericParam.sym.typ.elementType) result.json["signature"]["genericParams"].add param if optGenIndex in d.conf.globalOptions: genItem(d, n, nameNode, k, kForceExport) @@ -1400,7 +1406,8 @@ proc generateDoc*(d: PDoc, n, orig: PNode, config: ConfigRef, docFlags: DocFlags for it in n: traceDeps(d, it) of nkExportStmt: for it in n: - if it.kind == nkSym: + # bug #23051; don't generate documentation for exported symbols again + if it.kind == nkSym and sfExported notin it.sym.flags: if d.module != nil and d.module == it.sym.owner: generateDoc(d, it.sym.ast, orig, config, kForceExport) elif it.sym.ast != nil: diff --git a/compiler/enumtostr.nim b/compiler/enumtostr.nim index b8d0480c7..dc516d2e5 100644 --- a/compiler/enumtostr.nim +++ b/compiler/enumtostr.nim @@ -63,8 +63,8 @@ proc searchObjCaseImpl(obj: PNode; field: PSym): PNode = proc searchObjCase(t: PType; field: PSym): PNode = result = searchObjCaseImpl(t.n, field) - if result == nil and t.len > 0: - result = searchObjCase(t[0].skipTypes({tyAlias, tyGenericInst, tyRef, tyPtr}), field) + if result == nil and t.baseClass != nil: + result = searchObjCase(t.baseClass.skipTypes({tyAlias, tyGenericInst, tyRef, tyPtr}), field) doAssert result != nil proc genCaseObjDiscMapping*(t: PType; field: PSym; info: TLineInfo; g: ModuleGraph; idgen: IdGenerator): PSym = diff --git a/compiler/evalffi.nim b/compiler/evalffi.nim index ab26ca1bb..9871c81af 100644 --- a/compiler/evalffi.nim +++ b/compiler/evalffi.nim @@ -99,7 +99,7 @@ proc mapType(conf: ConfigRef, t: ast.PType): ptr libffi.Type = tyTyped, tyTypeDesc, tyProc, tyArray, tyStatic, tyNil: result = addr libffi.type_pointer of tyDistinct, tyAlias, tySink: - result = mapType(conf, t[0]) + result = mapType(conf, t.skipModifier) else: result = nil # too risky: @@ -126,16 +126,16 @@ proc packSize(conf: ConfigRef, v: PNode, typ: PType): int = if v.kind in {nkNilLit, nkPtrLit}: result = sizeof(pointer) else: - result = sizeof(pointer) + packSize(conf, v[0], typ.lastSon) + result = sizeof(pointer) + packSize(conf, v[0], typ.elementType) of tyDistinct, tyGenericInst, tyAlias, tySink: - result = packSize(conf, v, typ[0]) + result = packSize(conf, v, typ.skipModifier) of tyArray: # 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(conf, v[0], typ[1]) + result = v.len * packSize(conf, v[0], typ.elementType) else: result = 0 else: @@ -234,19 +234,19 @@ proc pack(conf: ConfigRef, v: PNode, typ: PType, res: pointer) = packRecCheck = 0 globalError(conf, v.info, "cannot map value to FFI " & typeToString(v.typ)) inc packRecCheck - pack(conf, v[0], typ.lastSon, res +! sizeof(pointer)) + pack(conf, v[0], typ.elementType, res +! sizeof(pointer)) dec packRecCheck awr(pointer, res +! sizeof(pointer)) of tyArray: - let baseSize = getSize(conf, typ[1]) + let baseSize = getSize(conf, typ.elementType) for i in 0..<v.len: - pack(conf, v[i], typ[1], res +! i * baseSize) + pack(conf, v[i], typ.elementType, res +! i * baseSize) of tyObject, tyTuple: packObject(conf, v, typ, res) of tyNil: discard of tyDistinct, tyGenericInst, tyAlias, tySink: - pack(conf, v, typ[0], res) + pack(conf, v, typ.skipModifier, res) else: globalError(conf, v.info, "cannot map value to FFI " & typeToString(v.typ)) @@ -304,9 +304,9 @@ proc unpackArray(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = result = n if result.kind != nkBracket: globalError(conf, n.info, "cannot map value from FFI") - let baseSize = getSize(conf, typ[1]) + let baseSize = getSize(conf, typ.elementType) for i in 0..<result.len: - result[i] = unpack(conf, x +! i * baseSize, typ[1], result[i]) + result[i] = unpack(conf, x +! i * baseSize, typ.elementType, result[i]) proc canonNodeKind(k: TNodeKind): TNodeKind = case k @@ -387,7 +387,7 @@ proc unpack(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = awi(nkPtrLit, cast[int](p)) elif n != nil and n.len == 1: internalAssert(conf, n.kind == nkRefTy) - n[0] = unpack(conf, p, typ.lastSon, n[0]) + n[0] = unpack(conf, p, typ.elementType, n[0]) result = n else: result = nil @@ -405,7 +405,7 @@ proc unpack(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = of tyNil: setNil() of tyDistinct, tyGenericInst, tyAlias, tySink: - result = unpack(conf, x, typ.lastSon, n) + result = unpack(conf, x, typ.skipModifier, n) else: # XXX what to do with 'array' here? result = nil @@ -434,7 +434,7 @@ proc fficast*(conf: ConfigRef, x: PNode, destTyp: PType): PNode = proc callForeignFunction*(conf: ConfigRef, call: PNode): PNode = internalAssert conf, call[0].kind == nkPtrLit - var cif: TCif + var cif: TCif = default(TCif) var sig: ParamList = default(ParamList) # use the arguments' types for varargs support: for i in 1..<call.len: @@ -444,7 +444,7 @@ proc callForeignFunction*(conf: ConfigRef, call: PNode): PNode = let typ = call[0].typ if prep_cif(cif, mapCallConv(conf, typ.callConv, call.info), cuint(call.len-1), - mapType(conf, typ[0]), sig) != OK: + mapType(conf, typ.returnType), sig) != OK: globalError(conf, call.info, "error in FFI call") var args: ArgList = default(ArgList) @@ -453,15 +453,15 @@ proc callForeignFunction*(conf: ConfigRef, call: PNode): PNode = var t = call[i].typ args[i-1] = alloc0(packSize(conf, call[i], t)) pack(conf, call[i], t, args[i-1]) - let retVal = if isEmptyType(typ[0]): pointer(nil) - else: alloc(getSize(conf, typ[0]).int) + let retVal = if isEmptyType(typ.returnType): pointer(nil) + else: alloc(getSize(conf, typ.returnType).int) libffi.call(cif, fn, retVal, args) if retVal.isNil: result = newNode(nkEmpty) else: - result = unpack(conf, retVal, typ[0], nil) + result = unpack(conf, retVal, typ.returnType, nil) result.info = call.info if retVal != nil: dealloc retVal @@ -474,7 +474,7 @@ proc callForeignFunction*(conf: ConfigRef, fn: PNode, fntyp: PType, info: TLineInfo): PNode = internalAssert conf, fn.kind == nkPtrLit - var cif: TCif + var cif: TCif = default(TCif) var sig: ParamList = default(ParamList) for i in 0..len-1: var aTyp = args[i+start].typ diff --git a/compiler/evaltempl.nim b/compiler/evaltempl.nim index 5ebb4fa55..77c136d63 100644 --- a/compiler/evaltempl.nim +++ b/compiler/evaltempl.nim @@ -17,8 +17,8 @@ type owner, genSymOwner: PSym instLines: bool # use the instantiation lines numbers isDeclarative: bool - mapping: TIdTable # every gensym'ed symbol needs to be mapped to some - # new symbol + mapping: SymMapping # every gensym'ed symbol needs to be mapped to some + # new symbol config: ConfigRef ic: IdentCache instID: int @@ -33,6 +33,19 @@ proc evalTemplateAux(templ, actual: PNode, c: var TemplCtx, result: PNode) = let x = param if x.kind == nkArgList: for y in items(x): result.add(y) + elif nfDefaultRefsParam in x.flags: + # value of default param needs to be evaluated like template body + # if it contains other template params + var res: PNode + if isAtom(x): + res = newNodeI(nkPar, x.info) + evalTemplateAux(x, actual, c, res) + if res.len == 1: res = res[0] + else: + res = copyNode(x) + for i in 0..<x.safeLen: + evalTemplateAux(x[i], actual, c, res) + result.add res else: result.add copyTree(x) @@ -44,10 +57,10 @@ proc evalTemplateAux(templ, actual: PNode, c: var TemplCtx, result: PNode) = handleParam actual[s.position] elif (s.owner != nil) and (s.kind == skGenericParam or s.kind == skType and s.typ != nil and s.typ.kind == tyGenericParam): - handleParam actual[s.owner.typ.len + s.position - 1] + handleParam actual[s.owner.typ.signatureLen + s.position - 1] else: internalAssert c.config, sfGenSym in s.flags or s.kind == skType - var x = PSym(idTableGet(c.mapping, s)) + var x = idTableGet(c.mapping, s) if x == nil: x = copySym(s, c.idgen) # sem'check needs to set the owner properly later, see bug #9476 @@ -56,6 +69,7 @@ proc evalTemplateAux(templ, actual: PNode, c: var TemplCtx, result: PNode) = # internalAssert c.config, false idTablePut(c.mapping, s, x) if sfGenSym in s.flags: + # TODO: getIdent(c.ic, "`" & x.name.s & "`gensym" & $c.instID) result.add newIdentNode(getIdent(c.ic, x.name.s & "`gensym" & $c.instID), if c.instLines: actual.info else: templ.info) else: @@ -116,7 +130,7 @@ proc evalTemplateArgs(n: PNode, s: PSym; conf: ConfigRef; fromHlo: bool): PNode # now that we have working untyped parameters. genericParams = if fromHlo: 0 else: s.ast[genericParamsPos].len - expectedRegularParams = s.typ.len-1 + expectedRegularParams = s.typ.paramsLen givenRegularParams = totalParams - genericParams if givenRegularParams < 0: givenRegularParams = 0 @@ -182,14 +196,14 @@ proc evalTemplate*(n: PNode, tmpl, genSymOwner: PSym; # replace each param by the corresponding node: var args = evalTemplateArgs(n, tmpl, conf, fromHlo) - var ctx: TemplCtx - ctx.owner = tmpl - ctx.genSymOwner = genSymOwner - ctx.config = conf - ctx.ic = ic - ctx.mapping = initIdTable() - ctx.instID = instID[] - ctx.idgen = idgen + var ctx = TemplCtx(owner: tmpl, + genSymOwner: genSymOwner, + config: conf, + ic: ic, + mapping: initSymMapping(), + instID: instID[], + idgen: idgen + ) let body = tmpl.ast[bodyPos] #echo "instantion of ", renderTree(body, {renderIds}) diff --git a/compiler/expanddefaults.nim b/compiler/expanddefaults.nim index 988433278..c520d8849 100644 --- a/compiler/expanddefaults.nim +++ b/compiler/expanddefaults.nim @@ -55,8 +55,8 @@ proc expandDefaultN(n: PNode; info: TLineInfo; res: PNode) = discard proc expandDefaultObj(t: PType; info: TLineInfo; res: PNode) = - if t[0] != nil: - expandDefaultObj(t[0], info, res) + if t.baseClass != nil: + expandDefaultObj(t.baseClass, info, res) expandDefaultN(t.n, info, res) proc expandDefault(t: PType; info: TLineInfo): PNode = @@ -82,13 +82,13 @@ proc expandDefault(t: PType; info: TLineInfo): PNode = result = newZero(t, info, nkIntLit) of tyRange: # Could use low(T) here to finally fix old language quirks - result = expandDefault(t[0], info) + result = expandDefault(skipModifier t, info) of tyVoid: result = newZero(t, info, nkEmpty) of tySink, tyGenericInst, tyDistinct, tyAlias, tyOwned: - result = expandDefault(t.lastSon, info) + result = expandDefault(t.skipModifier, info) of tyOrdinal, tyGenericBody, tyGenericParam, tyInferred, tyStatic: - if t.len > 0: - result = expandDefault(t.lastSon, info) + if t.hasElementType: + result = expandDefault(t.skipModifier, info) else: result = newZero(t, info, nkEmpty) of tyFromExpr: @@ -100,16 +100,16 @@ proc expandDefault(t: PType; info: TLineInfo): PNode = result = newZero(t, info, nkBracket) let n = toInt64(lengthOrd(nil, t)) for i in 0..<n: - result.add expandDefault(t[1], info) + result.add expandDefault(t.elementType, info) of tyPtr, tyRef, tyProc, tyPointer, tyCstring: result = newZero(t, info, nkNilLit) of tyVar, tyLent: - let e = t.lastSon + let e = t.elementType if e.skipTypes(abstractInst).kind in {tyOpenArray, tyVarargs}: # skip the modifier, `var openArray` is a (ptr, len) pair too: result = expandDefault(e, info) else: - result = newZero(t.lastSon, info, nkNilLit) + result = newZero(e, info, nkNilLit) of tySet: result = newZero(t, info, nkCurly) of tyObject: @@ -118,14 +118,14 @@ proc expandDefault(t: PType; info: TLineInfo): PNode = expandDefaultObj(t, info, result) of tyTuple: result = newZero(t, info, nkTupleConstr) - for it in t: + for it in t.kids: result.add expandDefault(it, info) of tyVarargs, tyOpenArray, tySequence, tyUncheckedArray: result = newZero(t, info, nkBracket) of tyString: result = newZero(t, info, nkStrLit) of tyNone, tyEmpty, tyUntyped, tyTyped, tyTypeDesc, - tyNil, tyGenericInvocation, tyProxy, tyBuiltInTypeClass, + tyNil, tyGenericInvocation, tyError, tyBuiltInTypeClass, tyUserTypeClass, tyUserTypeClassInst, tyCompositeTypeClass, tyAnd, tyOr, tyNot, tyAnything, tyConcept, tyIterable, tyForward: result = newZero(t, info, nkEmpty) # bug indicator diff --git a/compiler/extccomp.nim b/compiler/extccomp.nim index 3deab0b74..ce25da773 100644 --- a/compiler/extccomp.nim +++ b/compiler/extccomp.nim @@ -19,7 +19,7 @@ import std/[os, osproc, streams, sequtils, times, strtabs, json, jsonutils, suga import std / strutils except addf when defined(nimPreviewSlimSystem): - import std/syncio + import std/[syncio, assertions] import ../dist/checksums/src/checksums/sha1 @@ -172,6 +172,22 @@ compiler vcc: cppXsupport: "", props: {hasCpp, hasAssume, hasDeclspec}) +# Nvidia CUDA NVCC Compiler +compiler nvcc: + result = gcc() + result.name = "nvcc" + result.compilerExe = "nvcc" + result.cppCompiler = "nvcc" + result.compileTmpl = "-c -x cu -Xcompiler=\"$options\" $include -o $objfile $file" + result.linkTmpl = "$buildgui $builddll -o $exefile $objfiles -Xcompiler=\"$options\"" + +# AMD HIPCC Compiler (rocm/cuda) +compiler hipcc: + result = clang() + result.name = "hipcc" + result.compilerExe = "hipcc" + result.cppCompiler = "hipcc" + compiler clangcl: result = vcc() result.name = "clang_cl" @@ -285,7 +301,9 @@ const envcc(), icl(), icc(), - clangcl()] + clangcl(), + hipcc(), + nvcc()] hExt* = ".h" @@ -319,7 +337,7 @@ proc getConfigVar(conf: ConfigRef; c: TSystemCC, suffix: string): string = var fullSuffix = suffix case conf.backend of backendCpp, backendJs, backendObjc: fullSuffix = "." & $conf.backend & suffix - of backendC, backendNir: discard + of backendC: discard of backendInvalid: # during parsing of cfg files; we don't know the backend yet, no point in # guessing wrong thing @@ -982,10 +1000,11 @@ proc jsonBuildInstructionsFile*(conf: ConfigRef): AbsoluteFile = # works out of the box with `hashMainCompilationParams`. result = getNimcacheDir(conf) / conf.outFile.changeFileExt("json") -const cacheVersion = "D20210525T193831" # update when `BuildCache` spec changes +const cacheVersion = "D20240927T193831" # update when `BuildCache` spec changes type BuildCache = object cacheVersion: string outputFile: string + outputLastModificationTime: string compile: seq[(string, string)] link: seq[string] linkcmd: string @@ -999,7 +1018,7 @@ type BuildCache = object depfiles: seq[(string, string)] nimexe: string -proc writeJsonBuildInstructions*(conf: ConfigRef) = +proc writeJsonBuildInstructions*(conf: ConfigRef; deps: StringTableRef) = var linkFiles = collect(for it in conf.externalToLink: var it = it if conf.noAbsolutePaths: it = it.extractFilename @@ -1020,11 +1039,17 @@ proc writeJsonBuildInstructions*(conf: ConfigRef) = currentDir: getCurrentDir()) if optRun in conf.globalOptions or isDefined(conf, "nimBetterRun"): bcache.cmdline = conf.commandLine - bcache.depfiles = collect(for it in conf.m.fileInfos: + for it in conf.m.fileInfos: let path = it.fullPath.string if isAbsolute(path): # TODO: else? - (path, $secureHashFile(path))) + if path in deps: + bcache.depfiles.add (path, deps[path]) + else: # backup for configs etc. + bcache.depfiles.add (path, $secureHashFile(path)) + bcache.nimexe = hashNimExe() + if fileExists(bcache.outputFile): + bcache.outputLastModificationTime = $getLastModificationTime(bcache.outputFile) conf.jsonBuildFile = conf.jsonBuildInstructionsFile conf.jsonBuildFile.string.writeFile(bcache.toJson.pretty) @@ -1045,6 +1070,8 @@ proc changeDetectedViaJsonBuildInstructions*(conf: ConfigRef; jsonFile: Absolute # xxx optimize by returning false if stdin input was the same for (file, hash) in bcache.depfiles: if $secureHashFile(file) != hash: return true + if bcache.outputLastModificationTime != $getLastModificationTime(bcache.outputFile): + return true proc runJsonBuildInstructions*(conf: ConfigRef; jsonFile: AbsoluteFile) = var bcache: BuildCache = default(BuildCache) @@ -1061,7 +1088,7 @@ proc runJsonBuildInstructions*(conf: ConfigRef; jsonFile: AbsoluteFile) = "jsonscript command outputFile '$1' must match '$2' which was specified during --compileOnly, see \"outputFile\" entry in '$3' " % [outputCurrent, output, jsonFile.string]) var cmds: TStringSeq = default(TStringSeq) - var prettyCmds: TStringSeq= default(TStringSeq) + var prettyCmds: TStringSeq = default(TStringSeq) let prettyCb = proc (idx: int) = writePrettyCmdsStderr(prettyCmds[idx]) for (name, cmd) in bcache.compile: cmds.add cmd diff --git a/compiler/guards.nim b/compiler/guards.nim index 87dbfdf6f..bbb239867 100644 --- a/compiler/guards.nim +++ b/compiler/guards.nim @@ -1063,7 +1063,7 @@ proc pleViaModel(model: TModel; aa, bb: PNode): TImplication = let b = fact[2] if a.kind == nkSym: replacements.add((a,b)) else: replacements.add((b,a)) - var m: TModel + var m = TModel() var a = aa var b = bb if replacements.len > 0: diff --git a/compiler/ic/ic.nim b/compiler/ic/ic.nim index 0085ea748..8e81633ef 100644 --- a/compiler/ic/ic.nim +++ b/compiler/ic/ic.nim @@ -16,7 +16,7 @@ from std/os import removeFile, isAbsolute import ../../dist/checksums/src/checksums/sha1 -import ".." / nir / nirlineinfos +import iclineinfos when defined(nimPreviewSlimSystem): import std/[syncio, assertions, formatfloat] @@ -59,8 +59,8 @@ type emittedTypeInfo*: seq[string] backendFlags*: set[ModuleBackendFlag] - syms*: seq[PackedSym] - types*: seq[PackedType] + syms*: OrderedTable[int32, PackedSym] + types*: OrderedTable[int32, PackedType] strings*: BiTable[string] # we could share these between modules. numbers*: BiTable[BiggestInt] # we also store floats in here so # that we can assure that every bit is kept @@ -362,15 +362,15 @@ proc storeType(t: PType; c: var PackedEncoder; m: var PackedModule): PackedItemI result = PackedItemId(module: toLitId(t.uniqueId.module.FileIndex, c, m), item: t.uniqueId.item) if t.uniqueId.module == c.thisModule and not c.typeMarker.containsOrIncl(t.uniqueId.item): - if t.uniqueId.item >= m.types.len: - setLen m.types, t.uniqueId.item+1 + #if t.uniqueId.item >= m.types.len: + # setLen m.types, t.uniqueId.item+1 - var p = PackedType(kind: t.kind, flags: t.flags, callConv: t.callConv, + var p = PackedType(id: t.uniqueId.item, kind: t.kind, flags: t.flags, callConv: t.callConv, size: t.size, align: t.align, nonUniqueId: t.itemId.item, paddingAtEnd: t.paddingAtEnd) storeNode(p, t, n) p.typeInst = t.typeInst.storeType(c, m) - for kid in items t: + for kid in kids t: p.types.add kid.storeType(c, m) c.addMissing t.sym p.sym = t.sym.safeItemId(c, m) @@ -383,10 +383,9 @@ proc storeType(t: PType; c: var PackedEncoder; m: var PackedModule): PackedItemI proc toPackedLib(l: PLib; c: var PackedEncoder; m: var PackedModule): PackedLib = ## the plib hangs off the psym via the .annex field if l.isNil: return - result.kind = l.kind - result.generated = l.generated - result.isOverridden = l.isOverridden - result.name = toLitId($l.name, m) + result = PackedLib(kind: l.kind, generated: l.generated, + isOverridden: l.isOverridden, name: toLitId($l.name, m) + ) storeNode(result, l, path) proc storeSym*(s: PSym; c: var PackedEncoder; m: var PackedModule): PackedItemId = @@ -397,12 +396,12 @@ proc storeSym*(s: PSym; c: var PackedEncoder; m: var PackedModule): PackedItemId result = PackedItemId(module: toLitId(s.itemId.module.FileIndex, c, m), item: s.itemId.item) if s.itemId.module == c.thisModule and not c.symMarker.containsOrIncl(s.itemId.item): - if s.itemId.item >= m.syms.len: - setLen m.syms, s.itemId.item+1 + #if s.itemId.item >= m.syms.len: + # setLen m.syms, s.itemId.item+1 assert sfForward notin s.flags - var p = PackedSym(kind: s.kind, flags: s.flags, info: s.info.toPackedInfo(c, m), magic: s.magic, + var p = PackedSym(id: s.itemId.item, kind: s.kind, flags: s.flags, info: s.info.toPackedInfo(c, m), magic: s.magic, position: s.position, offset: s.offset, disamb: s.disamb, options: s.options, name: s.name.s.toLitId(m)) @@ -415,7 +414,7 @@ proc storeSym*(s: PSym; c: var PackedEncoder; m: var PackedModule): PackedItemId p.bitsize = s.bitsize p.alignment = s.alignment - p.externalName = toLitId(s.loc.r, m) + p.externalName = toLitId(s.loc.snippet, m) p.locFlags = s.loc.flags c.addMissing s.typ p.typ = s.typ.storeType(c, m) @@ -434,11 +433,11 @@ proc addModuleRef(n: PNode; ir: var PackedTree; c: var PackedEncoder; m: var Pac let info = n.info.toPackedInfo(c, m) if n.typ != n.sym.typ: ir.addNode(kind = nkModuleRef, operand = 3.int32, # spans 3 nodes in total - info = info, + info = info, flags = n.flags, typeId = storeTypeLater(n.typ, c, m)) else: ir.addNode(kind = nkModuleRef, operand = 3.int32, # spans 3 nodes in total - info = info) + info = info, flags = n.flags) ir.addNode(kind = nkNone, info = info, operand = toLitId(n.sym.itemId.module.FileIndex, c, m).int32) ir.addNode(kind = nkNone, info = info, @@ -614,6 +613,10 @@ proc loadRodFile*(filename: AbsoluteFile; m: var PackedModule; config: ConfigRef f.loadSection section f.loadSeq data + template loadTableSection(section, data) {.dirty.} = + f.loadSection section + f.loadOrderedTable data + template loadTabSection(section, data) {.dirty.} = f.loadSection section f.load data @@ -646,8 +649,8 @@ proc loadRodFile*(filename: AbsoluteFile; m: var PackedModule; config: ConfigRef loadTabSection topLevelSection, m.topLevel loadTabSection bodiesSection, m.bodies - loadSeqSection symsSection, m.syms - loadSeqSection typesSection, m.types + loadTableSection symsSection, m.syms + loadTableSection typesSection, m.types loadSeqSection typeInstCacheSection, m.typeInstCache loadSeqSection procInstCacheSection, m.procInstCache @@ -692,6 +695,10 @@ proc saveRodFile*(filename: AbsoluteFile; encoder: var PackedEncoder; m: var Pac f.storeSection section f.store data + template storeTableSection(section, data) {.dirty.} = + f.storeSection section + f.storeOrderedTable data + storeTabSection stringsSection, m.strings storeSeqSection checkSumsSection, m.includes @@ -715,9 +722,9 @@ proc saveRodFile*(filename: AbsoluteFile; encoder: var PackedEncoder; m: var Pac storeTabSection topLevelSection, m.topLevel storeTabSection bodiesSection, m.bodies - storeSeqSection symsSection, m.syms + storeTableSection symsSection, m.syms - storeSeqSection typesSection, m.types + storeTableSection typesSection, m.types storeSeqSection typeInstCacheSection, m.typeInstCache storeSeqSection procInstCacheSection, m.procInstCache @@ -768,8 +775,8 @@ type status*: ModuleStatus symsInit, typesInit, loadedButAliveSetChanged*: bool fromDisk*: PackedModule - syms: seq[PSym] # indexed by itemId - types: seq[PType] + syms: OrderedTable[int32, PSym] # indexed by itemId + types: OrderedTable[int32, PType] module*: PSym # the one true module symbol. iface, ifaceHidden: Table[PIdent, seq[PackedItemId]] # PackedItemId so that it works with reexported symbols too @@ -830,7 +837,8 @@ proc loadNodes*(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; result.ident = getIdent(c.cache, g[thisModule].fromDisk.strings[n.litId]) of nkSym: result.sym = loadSym(c, g, thisModule, PackedItemId(module: LitId(0), item: tree[n].soperand)) - if result.typ == nil: result.typ = result.sym.typ + if result.typ == nil: + result.typ = result.sym.typ of externIntLit: result.intVal = g[thisModule].fromDisk.numbers[n.litId] of nkStrLit..nkTripleStrLit: @@ -843,7 +851,8 @@ proc loadNodes*(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; assert n2.kind == nkNone transitionNoneToSym(result) result.sym = loadSym(c, g, thisModule, PackedItemId(module: n1.litId, item: tree[n2].soperand)) - if result.typ == nil: result.typ = result.sym.typ + if result.typ == nil: + result.typ = result.sym.typ else: for n0 in sonsReadonly(tree, n): result.addAllowNil loadNodes(c, g, thisModule, tree, n0) @@ -936,7 +945,7 @@ proc symBodyFromPacked(c: var PackedDecoder; g: var PackedModuleGraph; result.owner = loadSym(c, g, si, s.owner) let externalName = g[si].fromDisk.strings[s.externalName] if externalName != "": - result.loc.r = rope externalName + result.loc.snippet = externalName result.loc.flags = s.locFlags result.instantiatedFrom = loadSym(c, g, si, s.instantiatedFrom) @@ -960,11 +969,11 @@ proc loadSym(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; s: loadToReplayNodes(g, c.config, c.cache, m, g[int m]) assert g[si].status in {loaded, storing, stored} - if not g[si].symsInit: - g[si].symsInit = true - setLen g[si].syms, g[si].fromDisk.syms.len + #if not g[si].symsInit: + # g[si].symsInit = true + # setLen g[si].syms, g[si].fromDisk.syms.len - if g[si].syms[s.item] == nil: + if g[si].syms.getOrDefault(s.item) == nil: if g[si].fromDisk.syms[s.item].kind != skModule: result = symHeaderFromPacked(c, g, g[si].fromDisk.syms[s.item], si, s.item) # store it here early on, so that recursions work properly: @@ -1011,11 +1020,11 @@ proc loadType(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; t assert g[si].status in {loaded, storing, stored} assert t.item > 0 - if not g[si].typesInit: - g[si].typesInit = true - setLen g[si].types, g[si].fromDisk.types.len + #if not g[si].typesInit: + # g[si].typesInit = true + # setLen g[si].types, g[si].fromDisk.types.len - if g[si].types[t.item] == nil: + if g[si].types.getOrDefault(t.item) == nil: result = typeHeaderFromPacked(c, g, g[si].fromDisk.types[t.item], si, t.item) # store it here early on, so that recursions work properly: g[si].types[t.item] = result @@ -1154,10 +1163,7 @@ proc loadProcBody*(config: ConfigRef, cache: IdentCache; proc loadTypeFromId*(config: ConfigRef, cache: IdentCache; g: var PackedModuleGraph; module: int; id: PackedItemId): PType = bench g.loadType: - if id.item < g[module].types.len: - result = g[module].types[id.item] - else: - result = nil + result = g[module].types.getOrDefault(id.item) if result == nil: var decoder = PackedDecoder( lastModule: int32(-1), @@ -1170,10 +1176,7 @@ proc loadTypeFromId*(config: ConfigRef, cache: IdentCache; proc loadSymFromId*(config: ConfigRef, cache: IdentCache; g: var PackedModuleGraph; module: int; id: PackedItemId): PSym = bench g.loadSym: - if id.item < g[module].syms.len: - result = g[module].syms[id.item] - else: - result = nil + result = g[module].syms.getOrDefault(id.item) if result == nil: var decoder = PackedDecoder( lastModule: int32(-1), @@ -1189,19 +1192,6 @@ proc translateId*(id: PackedItemId; g: PackedModuleGraph; thisModule: int; confi else: ItemId(module: toFileIndex(id.module, g[thisModule].fromDisk, config).int32, item: id.item) -proc checkForHoles(m: PackedModule; config: ConfigRef; moduleId: int) = - var bugs = 0 - for i in 1 .. high(m.syms): - if m.syms[i].kind == skUnknown: - echo "EMPTY ID ", i, " module ", moduleId, " ", toFullPath(config, FileIndex(moduleId)) - inc bugs - assert bugs == 0 - when false: - var nones = 0 - for i in 1 .. high(m.types): - inc nones, m.types[i].kind == tyNone - assert nones < 1 - proc simulateLoadedModule*(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCache; moduleSym: PSym; m: PackedModule) = # For now only used for heavy debugging. In the future we could use this to reduce the diff --git a/compiler/nir/nirlineinfos.nim b/compiler/ic/iclineinfos.nim index f11ef7c42..74a7d971b 100644 --- a/compiler/nir/nirlineinfos.nim +++ b/compiler/ic/iclineinfos.nim @@ -1,7 +1,7 @@ # # # The Nim Compiler -# (c) Copyright 2023 Andreas Rumpf +# (c) Copyright 2024 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. diff --git a/compiler/ic/integrity.nim b/compiler/ic/integrity.nim index d78e56847..3e8ea2503 100644 --- a/compiler/ic/integrity.nim +++ b/compiler/ic/integrity.nim @@ -10,7 +10,7 @@ ## Integrity checking for a set of .rod files. ## The set must cover a complete Nim project. -import std/sets +import std/[sets, tables] when defined(nimPreviewSlimSystem): import std/assertions @@ -108,18 +108,18 @@ proc checkModule(c: var CheckedContext; m: PackedModule) = # We check that: # - Every symbol references existing types and symbols. # - Every tree node references existing types and symbols. - for i in 0..high(m.syms): - checkLocalSym c, int32(i) + for _, v in pairs(m.syms): + checkLocalSym c, v.id checkTree c, m.toReplay checkTree c, m.topLevel for e in m.exports: - assert e[1] >= 0 and e[1] < m.syms.len + #assert e[1] >= 0 and e[1] < m.syms.len assert e[0] == m.syms[e[1]].name for e in m.compilerProcs: - assert e[1] >= 0 and e[1] < m.syms.len + #assert e[1] >= 0 and e[1] < m.syms.len assert e[0] == m.syms[e[1]].name checkLocalSymIds c, m, m.converters diff --git a/compiler/ic/navigator.nim b/compiler/ic/navigator.nim index da8e7e597..39037b94f 100644 --- a/compiler/ic/navigator.nim +++ b/compiler/ic/navigator.nim @@ -11,7 +11,7 @@ ## IDE-like features. It uses the set of .rod files to accomplish ## its task. The set must cover a complete Nim project. -import std/sets +import std/[sets, tables] from std/os import nil from std/private/miscdollars import toLocation @@ -20,7 +20,7 @@ when defined(nimPreviewSlimSystem): import std/assertions import ".." / [ast, modulegraphs, msgs, options] -import ".." / nir / nirlineinfos +import iclineinfos import packed_ast, bitabs, ic type diff --git a/compiler/ic/packed_ast.nim b/compiler/ic/packed_ast.nim index 8971d72be..a39bb7adf 100644 --- a/compiler/ic/packed_ast.nim +++ b/compiler/ic/packed_ast.nim @@ -16,7 +16,7 @@ import std/[hashes, tables, strtabs] import bitabs, rodfiles import ".." / [ast, options] -import ".." / nir / nirlineinfos +import iclineinfos when defined(nimPreviewSlimSystem): import std/assertions @@ -47,6 +47,7 @@ type path*: NodeId PackedSym* = object + id*: int32 kind*: TSymKind name*: LitId typ*: PackedItemId @@ -71,6 +72,7 @@ type instantiatedFrom*: PackedItemId PackedType* = object + id*: int32 kind*: TTypeKind callConv*: TCallingConvention #nodekind*: TNodeKind @@ -124,7 +126,7 @@ proc `==`*(a, b: NodePos): bool {.borrow.} proc `==`*(a, b: NodeId): bool {.borrow.} proc newTreeFrom*(old: PackedTree): PackedTree = - result.nodes = @[] + result = PackedTree(nodes: @[]) when false: result.sh = old.sh proc addIdent*(tree: var PackedTree; s: LitId; info: PackedLineInfo) = diff --git a/compiler/ic/rodfiles.nim b/compiler/ic/rodfiles.nim index 5eef3874a..ac995dd2e 100644 --- a/compiler/ic/rodfiles.nim +++ b/compiler/ic/rodfiles.nim @@ -19,6 +19,8 @@ from std/typetraits import supportsCopyMem when defined(nimPreviewSlimSystem): import std/[syncio, assertions] +import std / tables + ## Overview ## ======== ## `RodFile` represents a Rod File (versioned binary format), and the @@ -170,6 +172,18 @@ proc storeSeq*[T](f: var RodFile; s: seq[T]) = for i in 0..<s.len: storePrim(f, s[i]) +proc storeOrderedTable*[K, T](f: var RodFile; s: OrderedTable[K, T]) = + if f.err != ok: return + if s.len >= high(int32): + setError f, tooBig + return + var lenPrefix = int32(s.len) + if writeBuffer(f.f, addr lenPrefix, sizeof(lenPrefix)) != sizeof(lenPrefix): + setError f, ioFailure + else: + for _, v in s: + storePrim(f, v) + proc loadPrim*(f: var RodFile; s: var string) = ## Read a string, the length was stored as a prefix if f.err != ok: return @@ -211,6 +225,19 @@ proc loadSeq*[T](f: var RodFile; s: var seq[T]) = for i in 0..<lenPrefix: loadPrim(f, s[i]) +proc loadOrderedTable*[K, T](f: var RodFile; s: var OrderedTable[K, T]) = + ## `T` must be compatible with `copyMem`, see `loadPrim` + if f.err != ok: return + var lenPrefix = int32(0) + if readBuffer(f.f, addr lenPrefix, sizeof(lenPrefix)) != sizeof(lenPrefix): + setError f, ioFailure + else: + s = initOrderedTable[K, T](lenPrefix) + for i in 0..<lenPrefix: + var x = default T + loadPrim(f, x) + s[x.id] = x + proc storeHeader*(f: var RodFile; cookie = defaultCookie) = ## stores the header which is described by `cookie`. if f.err != ok: return diff --git a/compiler/importer.nim b/compiler/importer.nim index a8de1e8bc..ffb7e0305 100644 --- a/compiler/importer.nim +++ b/compiler/importer.nim @@ -144,7 +144,7 @@ proc importSymbol(c: PContext, n: PNode, fromMod: PSym; importSet: var IntSet) = # for an enumeration we have to add all identifiers if multiImport: # for a overloadable syms add all overloaded routines - var it: ModuleIter + var it: ModuleIter = default(ModuleIter) var e = initModuleIter(it, c.graph, fromMod, s.name) while e != nil: if e.name.id != s.name.id: internalError(c.config, n.info, "importSymbol: 3") @@ -246,12 +246,14 @@ proc importModuleAs(c: PContext; n: PNode, realModule: PSym, importHidden: bool) result = createModuleAliasImpl(realModule.name) if importHidden: result.options.incl optImportHidden - c.unusedImports.add((result, n.info)) + let moduleIdent = if n.kind == nkInfix: n[^1] else: n + c.unusedImports.add((result, moduleIdent.info)) c.importModuleMap[result.id] = realModule.id c.importModuleLookup.mgetOrPut(result.name.id, @[]).addUnique realModule.id proc transformImportAs(c: PContext; n: PNode): tuple[node: PNode, importHidden: bool] = - var ret: typeof(result) + result = (nil, false) + var ret = default(typeof(result)) proc processPragma(n2: PNode): PNode = let (result2, kws) = splitPragmas(c, n2) result = result2 @@ -306,7 +308,15 @@ proc myImportModule(c: PContext, n: var PNode, importStmtResult: PNode): PSym = if belongsToStdlib(c.graph, result) and not startsWith(moduleName, stdPrefix) and not startsWith(moduleName, "system/") and not startsWith(moduleName, "packages/"): message(c.config, n.info, warnStdPrefix, realModule.name.s) - suggestSym(c.graph, n.info, result, c.graph.usageSym, false) + + proc suggestMod(n: PNode; s: PSym) = + if n.kind == nkImportAs: + suggestMod(n[0], realModule) + elif n.kind == nkInfix: + suggestMod(n[2], s) + else: + suggestSym(c.graph, n.info, s, c.graph.usageSym, false) + suggestMod(n, result) importStmtResult.add newSymNode(result, n.info) #newStrNode(toFullPath(c.config, f), n.info) else: diff --git a/compiler/injectdestructors.nim b/compiler/injectdestructors.nim index 7a64790c2..3dcc364a3 100644 --- a/compiler/injectdestructors.nim +++ b/compiler/injectdestructors.nim @@ -163,7 +163,8 @@ proc isLastReadImpl(n: PNode; c: var Con; scope: var Scope): bool = result = false proc isLastRead(n: PNode; c: var Con; s: var Scope): bool = - if not hasDestructor(c, n.typ): return true + # bug #23354; an object type could have a non-trival assignements when it is passed to a sink parameter + if not hasDestructor(c, n.typ) and (n.typ.kind != tyObject or isTrival(getAttachedOp(c.graph, n.typ, attachedAsgn))): return true let m = skipConvDfa(n) result = (m.kind == nkSym and sfSingleUsedTemp in m.sym.flags) or @@ -221,7 +222,7 @@ proc makePtrType(c: var Con, baseType: PType): PType = proc genOp(c: var Con; op: PSym; dest: PNode): PNode = var addrExp: PNode - if op.typ != nil and op.typ.len > 1 and op.typ[1].kind != tyVar: + if op.typ != nil and op.typ.signatureLen > 1 and op.typ.firstParamType.kind != tyVar: addrExp = dest else: addrExp = newNodeIT(nkHiddenAddr, dest.info, makePtrType(c, dest.typ)) @@ -299,7 +300,7 @@ proc genSink(c: var Con; s: var Scope; dest, ri: PNode; flags: set[MoveOrCopyFla proc isCriticalLink(dest: PNode): bool {.inline.} = #[ Lins's idea that only "critical" links can introduce a cycle. This is - critical for the performance gurantees that we strive for: If you + critical for the performance guarantees that we strive for: If you traverse a data structure, no tracing will be performed at all. ORC is about this promise: The GC only touches the memory that the mutator touches too. @@ -316,9 +317,10 @@ proc isCriticalLink(dest: PNode): bool {.inline.} = ]# result = dest.kind != nkSym -proc finishCopy(c: var Con; result, dest: PNode; isFromSink: bool) = - if c.graph.config.selectedGC == gcOrc: - let t = dest.typ.skipTypes({tyGenericInst, tyAlias, tySink, tyDistinct}) +proc finishCopy(c: var Con; result, dest: PNode; flags: set[MoveOrCopyFlag]; isFromSink: bool) = + if c.graph.config.selectedGC == gcOrc and IsExplicitSink notin flags: + # add cyclic flag, but not to sink calls, which IsExplicitSink generates + let t = dest.typ.skipTypes(tyUserTypeClasses + {tyGenericInst, tyAlias, tySink, tyDistinct}) if cyclicType(c.graph, t): result.add boolLit(c.graph, result.info, isFromSink or isCriticalLink(dest)) @@ -411,7 +413,10 @@ proc genDefaultCall(t: PType; c: Con; info: TLineInfo): PNode = proc destructiveMoveVar(n: PNode; c: var Con; s: var Scope): PNode = # generate: (let tmp = v; reset(v); tmp) if (not hasDestructor(c, n.typ)) and c.inEnsureMove == 0: - assert n.kind != nkSym or not hasDestructor(c, n.sym.typ) + assert n.kind != nkSym or not hasDestructor(c, n.sym.typ) or + (n.typ.kind == tyPtr and n.sym.typ.kind == tyRef) + # bug #23505; transformed by `transf`: addr (deref ref) -> ptr + # we know it's really a pointer; so here we assign it directly result = copyTree(n) else: result = newNodeIT(nkStmtListExpr, n.info, n.typ) @@ -442,24 +447,25 @@ proc isCapturedVar(n: PNode): bool = proc passCopyToSink(n: PNode; c: var Con; s: var Scope): PNode = result = newNodeIT(nkStmtListExpr, n.info, n.typ) - let tmp = c.getTemp(s, n.typ, n.info) - if hasDestructor(c, n.typ): - let typ = n.typ.skipTypes({tyGenericInst, tyAlias, tySink}) + let nTyp = n.typ.skipTypes(tyUserTypeClasses) + let tmp = c.getTemp(s, nTyp, n.info) + if hasDestructor(c, nTyp): + let typ = nTyp.skipTypes({tyGenericInst, tyAlias, tySink}) let op = getAttachedOp(c.graph, typ, attachedDup) if op != nil and tfHasOwned notin typ.flags: if sfError in op.flags: - c.checkForErrorPragma(n.typ, n, "=dup") + c.checkForErrorPragma(nTyp, n, "=dup") else: let copyOp = getAttachedOp(c.graph, typ, attachedAsgn) if copyOp != nil and sfError in copyOp.flags and sfOverridden notin op.flags: - c.checkForErrorPragma(n.typ, n, "=dup", inferredFromCopy = true) + c.checkForErrorPragma(nTyp, n, "=dup", inferredFromCopy = true) let src = p(n, c, s, normal) var newCall = newTreeIT(nkCall, src.info, src.typ, newSymNode(op), src) - c.finishCopy(newCall, n, isFromSink = true) + c.finishCopy(newCall, n, {}, isFromSink = true) result.add newTreeI(nkFastAsgn, src.info, tmp, newCall @@ -468,9 +474,9 @@ proc passCopyToSink(n: PNode; c: var Con; s: var Scope): PNode = result.add c.genWasMoved(tmp) var m = c.genCopy(tmp, n, {}) m.add p(n, c, s, normal) - c.finishCopy(m, n, isFromSink = true) + c.finishCopy(m, n, {}, isFromSink = true) result.add m - if isLValue(n) and not isCapturedVar(n) and n.typ.skipTypes(abstractInst).kind != tyRef and c.inSpawn == 0: + if isLValue(n) and not isCapturedVar(n) and nTyp.skipTypes(abstractInst).kind != tyRef and c.inSpawn == 0: message(c.graph.config, n.info, hintPerformance, ("passing '$1' to a sink parameter introduces an implicit copy; " & "if possible, rearrange your program's control flow to prevent it") % $n) @@ -479,8 +485,8 @@ proc passCopyToSink(n: PNode; c: var Con; s: var Scope): PNode = ("cannot move '$1', passing '$1' to a sink parameter introduces an implicit copy") % $n) else: if c.graph.config.selectedGC in {gcArc, gcOrc, gcAtomicArc}: - assert(not containsManagedMemory(n.typ)) - if n.typ.skipTypes(abstractInst).kind in {tyOpenArray, tyVarargs}: + assert(not containsManagedMemory(nTyp)) + if nTyp.skipTypes(abstractInst).kind in {tyOpenArray, tyVarargs}: localError(c.graph.config, n.info, "cannot create an implicit openArray copy to be passed to a sink parameter") result.add newTree(nkAsgn, tmp, p(n, c, s, normal)) # Since we know somebody will take over the produced copy, there is @@ -489,14 +495,14 @@ proc passCopyToSink(n: PNode; c: var Con; s: var Scope): PNode = proc isDangerousSeq(t: PType): bool {.inline.} = let t = t.skipTypes(abstractInst) - result = t.kind == tySequence and tfHasOwned notin t[0].flags + result = t.kind == tySequence and tfHasOwned notin t.elementType.flags proc containsConstSeq(n: PNode): bool = if n.kind == nkBracket and n.len > 0 and n.typ != nil and isDangerousSeq(n.typ): return true result = false case n.kind - of nkExprEqExpr, nkExprColonExpr, nkHiddenStdConv, nkHiddenSubConv: + of nkExprEqExpr, nkExprColonExpr, nkHiddenStdConv, nkHiddenSubConv, nkCast: result = containsConstSeq(n[1]) of nkObjConstr, nkClosure: for i in 1..<n.len: @@ -594,7 +600,9 @@ template processScopeExpr(c: var Con; s: var Scope; ret: PNode, processCall: unt # tricky because you would have to intercept moveOrCopy at a certain point let tmp = c.getTemp(s.parent[], ret.typ, ret.info) tmp.sym.flags = tmpFlags - let cpy = if hasDestructor(c, ret.typ): + let cpy = if hasDestructor(c, ret.typ) and + ret.typ.kind notin {tyOpenArray, tyVarargs}: + # bug #23247 we don't own the data, so it's harmful to destroy it s.parent[].final.add c.genDestroy(tmp) moveOrCopy(tmp, ret, c, s, {IsDecl}) else: @@ -646,7 +654,7 @@ template handleNestedTempl(n, processCall: untyped, willProduceStmt = false, for j in 0 ..< it.len-1: branch[j] = copyTree(it[j]) var ofScope = nestedScope(s, it.lastSon) - branch[^1] = if it[^1].typ.isEmptyType or willProduceStmt: + branch[^1] = if n.typ.isEmptyType or it[^1].typ.isEmptyType or willProduceStmt: processScope(c, ofScope, maybeVoid(it[^1], ofScope)) else: processScopeExpr(c, ofScope, it[^1], processCall, tmpFlags) @@ -694,7 +702,7 @@ template handleNestedTempl(n, processCall: untyped, willProduceStmt = false, #Condition needs to be destroyed outside of the condition/branch scope branch[0] = p(it[0], c, s, normal) - branch[^1] = if it[^1].typ.isEmptyType or willProduceStmt: + branch[^1] = if n.typ.isEmptyType or it[^1].typ.isEmptyType or willProduceStmt: processScope(c, branchScope, maybeVoid(it[^1], branchScope)) else: processScopeExpr(c, branchScope, it[^1], processCall, tmpFlags) @@ -754,7 +762,7 @@ proc pRaiseStmt(n: PNode, c: var Con; s: var Scope): PNode = let tmp = c.getTemp(s, n[0].typ, n.info) var m = c.genCopyNoCheck(tmp, n[0], attachedAsgn) m.add p(n[0], c, s, normal) - c.finishCopy(m, n[0], isFromSink = false) + c.finishCopy(m, n[0], {}, isFromSink = false) result = newTree(nkStmtList, c.genWasMoved(tmp), m) var toDisarm = n[0] if toDisarm.kind == nkStmtListExpr: toDisarm = toDisarm.lastSon @@ -769,6 +777,18 @@ proc pRaiseStmt(n: PNode, c: var Con; s: var Scope): PNode = result.add copyNode(n[0]) s.needsTry = true +template isCustomDestructor(c: Con, t: PType): bool = + hasDestructor(c, t) and + getAttachedOp(c.graph, t, attachedDestructor) != nil and + sfOverridden in getAttachedOp(c.graph, t, attachedDestructor).flags + +proc hasCustomDestructor(c: Con, t: PType): bool = + result = isCustomDestructor(c, t) + var obj = t + while obj.baseClass != nil: + obj = skipTypes(obj.baseClass, abstractPtrs) + result = result or isCustomDestructor(c, obj) + proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode; tmpFlags = {sfSingleUsedTemp}; inReturn = false): PNode = if n.kind in {nkStmtList, nkStmtListExpr, nkBlockStmt, nkBlockExpr, nkIfStmt, nkIfExpr, nkCaseStmt, nkWhen, nkWhileStmt, nkParForStmt, nkTryStmt, nkPragmaBlock}: @@ -810,6 +830,9 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode; tmpFlags = {sfSing elif n.kind in {nkObjDownConv, nkObjUpConv}: result = copyTree(n) result[0] = p(n[0], c, s, sinkArg) + elif n.kind == nkCast and n.typ.skipTypes(abstractInst).kind in {tyString, tySequence}: + result = copyTree(n) + result[1] = p(n[1], c, s, sinkArg) elif n.typ == nil: # 'raise X' can be part of a 'case' expression. Deal with it here: result = p(n, c, s, normal) @@ -853,15 +876,14 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode; tmpFlags = {sfSing for i in 1..<n.len: if n[i].kind == nkExprColonExpr: let field = lookupFieldAgain(t, n[i][0].sym) - if field != nil and sfCursor in field.flags: + if field != nil and (sfCursor in field.flags or field.typ.kind in {tyOpenArray, tyVarargs}): + # don't sink fields with openarray types result[i][1] = p(n[i][1], c, s, normal) else: result[i][1] = p(n[i][1], c, s, m) else: result[i] = p(n[i], c, s, m) - if mode == normal and (isRefConstr or (hasDestructor(c, t) and - getAttachedOp(c.graph, t, attachedDestructor) != nil and - sfOverridden in getAttachedOp(c.graph, t, attachedDestructor).flags)): + if mode == normal and (isRefConstr or hasCustomDestructor(c, t)): result = ensureDestruction(result, n, c, s) of nkCallKinds: if n[0].kind == nkSym and n[0].sym.magic == mEnsureMove: @@ -876,8 +898,9 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode; tmpFlags = {sfSing elif c.inSpawn > 0: c.inSpawn.dec - let parameters = n[0].typ - let L = if parameters != nil: parameters.len else: 0 + # bug #23907; skips tyGenericInst for generic callbacks + let parameters = if n[0].typ != nil: n[0].typ.skipTypes(abstractInst) else: n[0].typ + let L = if parameters != nil: parameters.signatureLen else: 0 when false: var isDangerous = false @@ -907,7 +930,10 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode; tmpFlags = {sfSing result[0] = p(n[0], c, s, normal) if canRaise(n[0]): s.needsTry = true if mode == normal: - result = ensureDestruction(result, n, c, s) + if result.typ != nil and result.typ.kind notin {tyOpenArray, tyVarargs}: + # Returns of openarray types shouldn't be destroyed + # bug #19435; # bug #23247 + result = ensureDestruction(result, n, c, s) of nkDiscardStmt: # Small optimization result = shallowCopy(n) if n[0].kind != nkEmpty: @@ -1148,7 +1174,7 @@ proc moveOrCopy(dest, ri: PNode; c: var Con; s: var Scope, flags: set[MoveOrCopy result = c.genCopy(dest, ri, flags) dec c.inEnsureMove, isEnsureMove result.add p(ri, c, s, consumed) - c.finishCopy(result, dest, isFromSink = false) + c.finishCopy(result, dest, flags, isFromSink = false) of nkBracket: # array constructor if ri.len > 0 and isDangerousSeq(ri.typ): @@ -1156,7 +1182,7 @@ proc moveOrCopy(dest, ri: PNode; c: var Con; s: var Scope, flags: set[MoveOrCopy result = c.genCopy(dest, ri, flags) dec c.inEnsureMove, isEnsureMove result.add p(ri, c, s, consumed) - c.finishCopy(result, dest, isFromSink = false) + c.finishCopy(result, dest, flags, isFromSink = false) else: result = c.genSink(s, dest, p(ri, c, s, consumed), flags) of nkObjConstr, nkTupleConstr, nkClosure, nkCharLit..nkNilLit: @@ -1166,9 +1192,9 @@ proc moveOrCopy(dest, ri: PNode; c: var Con; s: var Scope, flags: set[MoveOrCopy # Rule 3: `=sink`(x, z); wasMoved(z) let snk = c.genSink(s, dest, ri, flags) result = newTree(nkStmtList, snk, c.genWasMoved(ri)) - elif ri.sym.kind != skParam and ri.sym.owner == c.owner and - isLastRead(ri, c, s) and canBeMoved(c, dest.typ) and not isCursor(ri) and - not ({sfGlobal, sfPure} <= ri.sym.flags): + elif ri.sym.kind != skParam and + isAnalysableFieldAccess(ri, c.owner) and + isLastRead(ri, c, s) and canBeMoved(c, dest.typ): # Rule 3: `=sink`(x, z); wasMoved(z) let snk = c.genSink(s, dest, ri, flags) result = newTree(nkStmtList, snk, c.genWasMoved(ri)) @@ -1177,7 +1203,7 @@ proc moveOrCopy(dest, ri: PNode; c: var Con; s: var Scope, flags: set[MoveOrCopy result = c.genCopy(dest, ri, flags) dec c.inEnsureMove, isEnsureMove result.add p(ri, c, s, consumed) - c.finishCopy(result, dest, isFromSink = false) + c.finishCopy(result, dest, flags, isFromSink = false) of nkHiddenSubConv, nkHiddenStdConv, nkConv, nkObjDownConv, nkObjUpConv, nkCast: result = c.genSink(s, dest, p(ri, c, s, sinkArg), flags) of nkStmtListExpr, nkBlockExpr, nkIfExpr, nkCaseStmt, nkTryStmt: @@ -1197,7 +1223,7 @@ proc moveOrCopy(dest, ri: PNode; c: var Con; s: var Scope, flags: set[MoveOrCopy result = c.genCopy(dest, ri, flags) dec c.inEnsureMove, isEnsureMove result.add p(ri, c, s, consumed) - c.finishCopy(result, dest, isFromSink = false) + c.finishCopy(result, dest, flags, isFromSink = false) when false: proc computeUninit(c: var Con) = diff --git a/compiler/installer.ini b/compiler/installer.ini index d12127bde..54a35dbee 100644 --- a/compiler/installer.ini +++ b/compiler/installer.ini @@ -6,11 +6,11 @@ Name: "Nim" Version: "$version" Platforms: """ windows: i386;amd64 - linux: i386;hppa;ia64;alpha;amd64;powerpc64;arm;sparc;sparc64;m68k;mips;mipsel;mips64;mips64el;powerpc;powerpc64el;arm64;riscv32;riscv64 + linux: i386;hppa;ia64;alpha;amd64;powerpc64;arm;sparc;sparc64;m68k;mips;mipsel;mips64;mips64el;powerpc;powerpc64el;arm64;riscv32;riscv64;loongarch64 macosx: i386;amd64;powerpc64;arm64 solaris: i386;amd64;sparc;sparc64 freebsd: i386;amd64;powerpc64;arm;arm64;riscv64;sparc64;mips;mipsel;mips64;mips64el;powerpc;powerpc64el - netbsd: i386;amd64 + netbsd: i386;amd64;arm64 openbsd: i386;amd64;arm;arm64 dragonfly: i386;amd64 crossos: amd64 @@ -147,4 +147,4 @@ licenses: "bin/nim,MIT;lib/*,MIT;" [nimble] pkgName: "nim" -pkgFiles: "compiler/*;doc/basicopt.txt;doc/advopt.txt;doc/nimdoc.css" +pkgFiles: "compiler/*;doc/basicopt.txt;doc/advopt.txt;doc/nimdoc.css;doc/nimdoc.cls" diff --git a/compiler/int128.nim b/compiler/int128.nim index ca06a3a97..74e581cd5 100644 --- a/compiler/int128.nim +++ b/compiler/int128.nim @@ -34,6 +34,7 @@ proc `$`*(a: Int128): string proc toInt128*[T: SomeInteger | bool](arg: T): Int128 = {.noSideEffect.}: + result = Zero when T is bool: result.sdata(0) = int32(arg) elif T is SomeUnsignedInt: when sizeof(arg) <= 4: @@ -208,30 +209,35 @@ proc `==`*(a, b: Int128): bool = return true proc bitnot*(a: Int128): Int128 = + result = Zero result.udata[0] = not a.udata[0] result.udata[1] = not a.udata[1] result.udata[2] = not a.udata[2] result.udata[3] = not a.udata[3] proc bitand*(a, b: Int128): Int128 = + result = Zero result.udata[0] = a.udata[0] and b.udata[0] result.udata[1] = a.udata[1] and b.udata[1] result.udata[2] = a.udata[2] and b.udata[2] result.udata[3] = a.udata[3] and b.udata[3] proc bitor*(a, b: Int128): Int128 = + result = Zero result.udata[0] = a.udata[0] or b.udata[0] result.udata[1] = a.udata[1] or b.udata[1] result.udata[2] = a.udata[2] or b.udata[2] result.udata[3] = a.udata[3] or b.udata[3] proc bitxor*(a, b: Int128): Int128 = + result = Zero result.udata[0] = a.udata[0] xor b.udata[0] result.udata[1] = a.udata[1] xor b.udata[1] result.udata[2] = a.udata[2] xor b.udata[2] result.udata[3] = a.udata[3] xor b.udata[3] proc `shr`*(a: Int128, b: int): Int128 = + result = Zero let b = b and 127 if b < 32: result.sdata(3) = a.sdata(3) shr b @@ -258,6 +264,7 @@ proc `shr`*(a: Int128, b: int): Int128 = result.sdata(0) = a.sdata(3) shr (b and 31) proc `shl`*(a: Int128, b: int): Int128 = + result = Zero let b = b and 127 if b < 32: result.udata[0] = a.udata[0] shl b @@ -281,6 +288,7 @@ proc `shl`*(a: Int128, b: int): Int128 = result.udata[3] = a.udata[0] shl (b and 31) proc `+`*(a, b: Int128): Int128 = + result = Zero let tmp0 = uint64(a.udata[0]) + uint64(b.udata[0]) result.udata[0] = cast[uint32](tmp0) let tmp1 = uint64(a.udata[1]) + uint64(b.udata[1]) + (tmp0 shr 32) @@ -313,6 +321,7 @@ proc abs(a: int32): int = if a < 0: -a else: a proc `*`(a: Int128, b: uint32): Int128 = + result = Zero let tmp0 = uint64(a.udata[0]) * uint64(b) let tmp1 = uint64(a.udata[1]) * uint64(b) let tmp2 = uint64(a.udata[2]) * uint64(b) @@ -335,6 +344,7 @@ proc `*=`(a: var Int128, b: int32) = a = a * b proc makeInt128(high, low: uint64): Int128 = + result = Zero result.udata[0] = cast[uint32](low) result.udata[1] = cast[uint32](low shr 32) result.udata[2] = cast[uint32](high) @@ -373,6 +383,8 @@ proc fastLog2*(a: Int128): int = proc divMod*(dividend, divisor: Int128): tuple[quotient, remainder: Int128] = assert(divisor != Zero) + result = (Zero, Zero) + let isNegativeA = isNegative(dividend) let isNegativeB = isNegative(divisor) @@ -539,24 +551,28 @@ proc toInt128*(arg: float64): Int128 = return res proc maskUInt64*(arg: Int128): Int128 {.noinit, inline.} = + result = Zero result.udata[0] = arg.udata[0] result.udata[1] = arg.udata[1] result.udata[2] = 0 result.udata[3] = 0 proc maskUInt32*(arg: Int128): Int128 {.noinit, inline.} = + result = Zero result.udata[0] = arg.udata[0] result.udata[1] = 0 result.udata[2] = 0 result.udata[3] = 0 proc maskUInt16*(arg: Int128): Int128 {.noinit, inline.} = + result = Zero result.udata[0] = arg.udata[0] and 0xffff result.udata[1] = 0 result.udata[2] = 0 result.udata[3] = 0 proc maskUInt8*(arg: Int128): Int128 {.noinit, inline.} = + result = Zero result.udata[0] = arg.udata[0] and 0xff result.udata[1] = 0 result.udata[2] = 0 diff --git a/compiler/isolation_check.nim b/compiler/isolation_check.nim index b11d64a6b..17fbde29e 100644 --- a/compiler/isolation_check.nim +++ b/compiler/isolation_check.nim @@ -54,18 +54,18 @@ proc canAlias(arg, ret: PType; marker: var IntSet): bool = of tyObject: if isFinal(ret): result = canAliasN(arg, ret.n, marker) - if not result and ret.len > 0 and ret[0] != nil: - result = canAlias(arg, ret[0], marker) + if not result and ret.baseClass != nil: + result = canAlias(arg, ret.baseClass, marker) else: result = true of tyTuple: result = false - for i in 0..<ret.len: - result = canAlias(arg, ret[i], marker) + for r in ret.kids: + result = canAlias(arg, r, marker) if result: break of tyArray, tySequence, tyDistinct, tyGenericInst, tyAlias, tyInferred, tySink, tyLent, tyOwned, tyRef: - result = canAlias(arg, ret.lastSon, marker) + result = canAlias(arg, ret.skipModifier, marker) of tyProc: result = ret.callConv == ccClosure else: @@ -119,14 +119,16 @@ proc containsDangerousRefAux(t: PType; marker: var IntSet): SearchResult = if result != NotFound: return result case t.kind of tyObject: - if t[0] != nil: - result = containsDangerousRefAux(t[0].skipTypes(skipPtrs), marker) + if t.baseClass != nil: + result = containsDangerousRefAux(t.baseClass.skipTypes(skipPtrs), marker) if result == NotFound: result = containsDangerousRefAux(t.n, marker) of tyGenericInst, tyDistinct, tyAlias, tySink: - result = containsDangerousRefAux(lastSon(t), marker) - of tyArray, tySet, tyTuple, tySequence: - for i in 0..<t.len: - result = containsDangerousRefAux(t[i], marker) + result = containsDangerousRefAux(skipModifier(t), marker) + of tyArray, tySet, tySequence: + result = containsDangerousRefAux(t.elementType, marker) + of tyTuple: + for a in t.kids: + result = containsDangerousRefAux(a, marker) if result == Found: return result else: discard diff --git a/compiler/jsgen.nim b/compiler/jsgen.nim index 7c636af8b..713944def 100644 --- a/compiler/jsgen.nim +++ b/compiler/jsgen.nim @@ -31,9 +31,10 @@ implements the required case distinction. import ast, trees, magicsys, options, nversion, msgs, idents, types, - ropes, ccgutils, wordrecg, renderer, + ropes, wordrecg, renderer, cgmeth, lowerings, sighashes, modulegraphs, lineinfos, - transf, injectdestructors, sourcemap, astmsgs, backendpragmas + transf, injectdestructors, sourcemap, astmsgs, pushpoppragmas, + mangleutils import pipelineutils @@ -102,29 +103,33 @@ type prc: PSym globals, locals, body: Rope options: TOptions - optionsStack: seq[TOptions] + optionsStack: seq[(TOptions, TNoteKinds)] module: BModule g: PGlobals - generatedParamCopies: IntSet beforeRetNeeded: bool unique: int # for temp identifier generation blocks: seq[TBlock] extraIndent: int - up: PProc # up the call chain; required for closure support - declaredGlobals: IntSet previousFileName: string # For frameInfo inside templates. + # legacy: generatedParamCopies and up fields are used for jsNoLambdaLifting + generatedParamCopies: IntSet + up: PProc # up the call chain; required for closure support template config*(p: PProc): ConfigRef = p.module.config proc indentLine(p: PProc, r: Rope): Rope = var p = p - var ind = 0 - while true: - inc ind, p.blocks.len + p.extraIndent - if p.up == nil or p.up.prc != p.prc.owner: - break - p = p.up - result = repeat(' ', ind*2) & r + if jsNoLambdaLifting in p.config.legacyFeatures: + var ind = 0 + while true: + inc ind, p.blocks.len + p.extraIndent + if p.up == nil or p.up.prc != p.prc.owner: + break + p = p.up + result = repeat(' ', ind*2) & r + else: + let ind = p.blocks.len + p.extraIndent + result = repeat(' ', ind*2) & r template line(p: PProc, added: string) = p.body.add(indentLine(p, rope(added))) @@ -175,10 +180,6 @@ proc initProcOptions(module: BModule): TOptions = proc newInitProc(globals: PGlobals, module: BModule): PProc = result = newProc(globals, module, nil, initProcOptions(module)) -proc declareGlobal(p: PProc; id: int; r: Rope) = - if p.prc != nil and not p.declaredGlobals.containsOrIncl(id): - p.locals.addf("global $1;$n", [r]) - const MappedToObject = {tyObject, tyArray, tyTuple, tyOpenArray, tySet, tyVarargs} @@ -187,16 +188,16 @@ proc mapType(typ: PType): TJSTypeKind = let t = skipTypes(typ, abstractInst) case t.kind of tyVar, tyRef, tyPtr: - if skipTypes(t.lastSon, abstractInst).kind in MappedToObject: + if skipTypes(t.elementType, abstractInst).kind in MappedToObject: result = etyObject else: result = etyBaseIndex of tyPointer: # treat a tyPointer like a typed pointer to an array of bytes result = etyBaseIndex - of tyRange, tyDistinct, tyOrdinal, tyProxy, tyLent: + of tyRange, tyDistinct, tyOrdinal, tyError, tyLent: # tyLent is no-op as JS has pass-by-reference semantics - result = mapType(t[0]) + result = mapType(skipModifier t) of tyInt..tyInt64, tyUInt..tyUInt64, tyEnum, tyChar: result = etyInt of tyBool: result = etyBool of tyFloat..tyFloat128: result = etyFloat @@ -212,9 +213,9 @@ proc mapType(typ: PType): TJSTypeKind = result = etyNone of tyGenericInst, tyInferred, tyAlias, tyUserTypeClass, tyUserTypeClassInst, tySink, tyOwned: - result = mapType(typ.lastSon) + result = mapType(typ.skipModifier) of tyStatic: - if t.n != nil: result = mapType(lastSon t) + if t.n != nil: result = mapType(skipModifier t) else: result = etyNone of tyProc: result = etyProc of tyCstring: result = etyString @@ -245,7 +246,7 @@ proc mangleName(m: BModule, s: PSym): Rope = for chr in name: if chr notin {'A'..'Z','a'..'z','_','$','0'..'9'}: return false - result = s.loc.r + result = s.loc.snippet if result == "": if s.kind == skField and s.name.s.validJsName: result = rope(s.name.s) @@ -269,10 +270,14 @@ proc mangleName(m: BModule, s: PSym): Rope = # When hot reloading is enabled, we must ensure that the names # of functions and types will be preserved across rebuilds: result.add(idOrSig(s, m.module.name.s, m.sigConflicts, m.config)) + elif s.kind == skParam: + result.add mangleParamExt(s) + elif s.kind in routineKinds: + result.add mangleProcNameExt(m.graph, s) else: result.add("_") result.add(rope(s.id)) - s.loc.r = result + s.loc.snippet = result proc escapeJSString(s: string): string = result = newStringOfCap(s.len + s.len shr 2) @@ -464,9 +469,6 @@ const # magic checked op; magic unchecked op; mUnaryMinusF64: ["", ""], mCharToStr: ["nimCharToStr", "nimCharToStr"], mBoolToStr: ["nimBoolToStr", "nimBoolToStr"], - mIntToStr: ["cstrToNimstr", "cstrToNimstr"], - mInt64ToStr: ["cstrToNimstr", "cstrToNimstr"], - mFloatToStr: ["cstrToNimstr", "cstrToNimstr"], mCStrToStr: ["cstrToNimstr", "cstrToNimstr"], mStrToStr: ["", ""]] @@ -516,7 +518,7 @@ proc maybeMakeTempAssignable(p: PProc, n: PNode; x: TCompRes): tuple[a, tmp: Rop let (m1, tmp1) = maybeMakeTemp(p, n[0], address) let typ = skipTypes(n[0].typ, abstractPtrs) if typ.kind == tyArray: - first = firstOrd(p.config, typ[0]) + first = firstOrd(p.config, typ.indexType) if optBoundsCheck in p.options: useMagic(p, "chckIndx") if first == 0: # save a couple chars @@ -609,6 +611,17 @@ template unaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = r.res = frmt % [a, tmp] r.kind = resExpr +proc genBreakState(p: PProc, n: PNode, r: var TCompRes) = + var a: TCompRes = default(TCompRes) + # mangle `:state` properly somehow + if n.kind == nkClosure: + gen(p, n[1], a) + r.res = "(($1).HEX3Astate < 0)" % [rdLoc(a)] + else: + gen(p, n, a) + r.res = "((($1.ClE_0).HEX3Astate) < 0)" % [rdLoc(a)] + r.kind = resExpr + proc arithAux(p: PProc, n: PNode, r: var TCompRes, op: TMagic) = var x, y: TCompRes = default(TCompRes) @@ -788,7 +801,13 @@ proc arithAux(p: PProc, n: PNode, r: var TCompRes, op: TMagic) = of mEqProc: applyFormat("($1 == $2)", "($1 == $2)") of mUnaryMinusI: applyFormat("negInt($1)", "-($1)") of mUnaryMinusI64: applyFormat("negInt64($1)", "-($1)") - of mAbsI: applyFormat("absInt($1)", "Math.abs($1)") + of mAbsI: + let typ = n[1].typ.skipTypes(abstractVarRange) + if typ.kind == tyInt64 and optJsBigInt64 in p.config.globalOptions: + useMagic(p, "absInt64") + applyFormat("absInt64($1)", "absInt64($1)") + else: + applyFormat("absInt($1)", "Math.abs($1)") of mNot: applyFormat("!($1)", "!($1)") of mUnaryPlusI: applyFormat("+($1)", "+($1)") of mBitnotI: @@ -805,8 +824,6 @@ proc arithAux(p: PProc, n: PNode, r: var TCompRes, op: TMagic) = of mUnaryMinusF64: applyFormat("-($1)", "-($1)") of mCharToStr: applyFormat("nimCharToStr($1)", "nimCharToStr($1)") of mBoolToStr: applyFormat("nimBoolToStr($1)", "nimBoolToStr($1)") - of mIntToStr: applyFormat("cstrToNimstr(($1) + \"\")", "cstrToNimstr(($1) + \"\")") - of mInt64ToStr: applyFormat("cstrToNimstr(($1) + \"\")", "cstrToNimstr(($1) + \"\")") of mCStrToStr: applyFormat("cstrToNimstr($1)", "cstrToNimstr($1)") of mStrToStr, mUnown, mIsolate, mFinished: applyFormat("$1", "$1") else: @@ -827,7 +844,7 @@ proc arith(p: PProc, n: PNode, r: var TCompRes, op: TMagic) = arithAux(p, n, r, op) of mModI: arithAux(p, n, r, op) - of mCharToStr, mBoolToStr, mIntToStr, mInt64ToStr, mCStrToStr, mStrToStr, mEnumToStr: + of mCharToStr, mBoolToStr, mCStrToStr, mStrToStr, mEnumToStr: arithAux(p, n, r, op) of mEqRef: if mapType(n[1].typ) != etyBaseIndex: @@ -837,6 +854,11 @@ proc arith(p: PProc, n: PNode, r: var TCompRes, op: TMagic) = gen(p, n[1], x) gen(p, n[2], y) r.res = "($# == $# && $# == $#)" % [x.address, y.address, x.res, y.res] + of mEqProc: + if skipTypes(n[1].typ, abstractInst).callConv == ccClosure: + binaryExpr(p, n, r, "cmpClosures", "cmpClosures($1, $2)") + else: + arithAux(p, n, r, op) else: arithAux(p, n, r, op) r.kind = resExpr @@ -926,7 +948,7 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = p.body.add("++excHandler;\L") var tmpFramePtr = rope"F" lineF(p, "try {$n", []) - var a: TCompRes + var a: TCompRes = default(TCompRes) gen(p, n[0], a) moveInto(p, a, r) var generalCatchBranchExists = false @@ -970,7 +992,7 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = # if isJsObject(throwObj.typ): if isImportedException(throwObj.typ, p.config): orExpr.addf("lastJSError instanceof $1", - [throwObj.typ.sym.loc.r]) + [throwObj.typ.sym.loc.snippet]) else: orExpr.addf("isObj(lastJSError.m_type, $1)", [genTypeInfo(p, throwObj.typ)]) @@ -980,8 +1002,8 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = # If some branch requires a local alias introduce it here. This is needed # since JS cannot do ``catch x as y``. if excAlias != nil: - excAlias.sym.loc.r = mangleName(p.module, excAlias.sym) - lineF(p, "var $1 = lastJSError;$n", excAlias.sym.loc.r) + excAlias.sym.loc.snippet = mangleName(p.module, excAlias.sym) + lineF(p, "var $1 = lastJSError;$n", excAlias.sym.loc.snippet) gen(p, n[i][^1], a) moveInto(p, a, r) lineF(p, "}$n", []) @@ -1019,7 +1041,7 @@ proc genCaseJS(p: PProc, n: PNode, r: var TCompRes) = a, b, cond, stmt: TCompRes = default(TCompRes) genLineDir(p, n) gen(p, n[0], cond) - let typeKind = skipTypes(n[0].typ, abstractVar).kind + let typeKind = skipTypes(n[0].typ, abstractVar+{tyRange}).kind var transferRange = false let anyString = typeKind in {tyString, tyCstring} case typeKind @@ -1087,14 +1109,19 @@ proc genCaseJS(p: PProc, n: PNode, r: var TCompRes) = lineF(p, "break;$n", []) of nkElse: if transferRange: - lineF(p, "else{$n", []) + if n.len == 2: # a dangling else for a case statement + transferRange = false + lineF(p, "switch ($1) {$n", [cond.rdLoc]) + lineF(p, "default: $n", []) + else: + lineF(p, "else{$n", []) else: lineF(p, "default: $n", []) p.nested: gen(p, it[0], stmt) moveInto(p, stmt, r) if transferRange: - lineF(p, "}$n", []) + lineF(p, "}$n", []) else: lineF(p, "break;$n", []) else: internalError(p.config, it.info, "jsgen.genCaseStmt") @@ -1136,10 +1163,14 @@ proc genBreakStmt(p: PProc, n: PNode) = p.blocks[idx].id = abs(p.blocks[idx].id) # label is used lineF(p, "break Label$1;$n", [rope(p.blocks[idx].id)]) -proc genAsmOrEmitStmt(p: PProc, n: PNode) = +proc genAsmOrEmitStmt(p: PProc, n: PNode; isAsmStmt = false) = genLineDir(p, n) p.body.add p.indentLine("") - for i in 0..<n.len: + let offset = + if isAsmStmt: 1 # first son is pragmas + else: 0 + + for i in offset..<n.len: let it = n[i] case it.kind of nkStrLit..nkTripleStrLit: @@ -1194,8 +1225,17 @@ proc genIf(p: PProc, n: PNode, r: var TCompRes) = lineF(p, "}$n", []) line(p, repeat('}', toClose) & "\L") -proc generateHeader(p: PProc, typ: PType): Rope = +proc generateHeader(p: PProc, prc: PSym): Rope = result = "" + let typ = prc.typ + if jsNoLambdaLifting notin p.config.legacyFeatures: + if typ.callConv == ccClosure: + # we treat Env as the `this` parameter of the function + # to keep it simple + let env = prc.ast[paramsPos].lastSon + assert env.kind == nkSym, "env is missing" + env.sym.loc.snippet = "this" + for i in 1..<typ.n.len: assert(typ.n[i].kind == nkSym) var param = typ.n[i].sym @@ -1228,9 +1268,10 @@ const proc needsNoCopy(p: PProc; y: PNode): bool = return y.kind in nodeKindsNeedNoCopy or - ((mapType(y.typ) != etyBaseIndex or (y.kind == nkSym and y.sym.kind == skParam)) and + ((mapType(y.typ) != etyBaseIndex or + (jsNoLambdaLifting in p.config.legacyFeatures and y.kind == nkSym and y.sym.kind == skParam)) and (skipTypes(y.typ, abstractInst).kind in - {tyRef, tyPtr, tyLent, tyVar, tyCstring, tyProc, tyOwned} + IntegralTypes)) + {tyRef, tyPtr, tyLent, tyVar, tyCstring, tyProc, tyOwned, tyOpenArray} + IntegralTypes)) proc genAsgnAux(p: PProc, x, y: PNode, noCopyNeeded: bool) = var a, b: TCompRes = default(TCompRes) @@ -1257,7 +1298,7 @@ proc genAsgnAux(p: PProc, x, y: PNode, noCopyNeeded: bool) = lineF(p, "$1 = nimCopy(null, $2, $3);$n", [a.rdLoc, b.res, genTypeInfo(p, y.typ)]) of etyObject: - if x.typ.kind in {tyVar, tyLent} or (needsNoCopy(p, y) and needsNoCopy(p, x)) or noCopyNeeded: + if x.typ.kind in {tyVar, tyLent, tyOpenArray, tyVarargs} or (needsNoCopy(p, y) and needsNoCopy(p, x)) or noCopyNeeded: lineF(p, "$1 = $2;$n", [a.rdLoc, b.rdLoc]) else: useMagic(p, "nimCopy") @@ -1312,19 +1353,10 @@ proc genFastAsgn(p: PProc, n: PNode) = genAsgnAux(p, n[0], n[1], noCopyNeeded=noCopy) proc genSwap(p: PProc, n: PNode) = - var a, b: TCompRes = default(TCompRes) - gen(p, n[1], a) - gen(p, n[2], b) - var tmp = p.getTemp(false) - if mapType(p, skipTypes(n[1].typ, abstractVar)) == etyBaseIndex: - let tmp2 = p.getTemp(false) - if a.typ != etyBaseIndex or b.typ != etyBaseIndex: - internalError(p.config, n.info, "genSwap") - lineF(p, "var $1 = $2; $2 = $3; $3 = $1;$n", - [tmp, a.address, b.address]) - tmp = tmp2 - lineF(p, "var $1 = $2; $2 = $3; $3 = $1;", - [tmp, a.res, b.res]) + let stmtList = lowerSwap(p.module.graph, n, p.module.idgen, if p.prc != nil: p.prc else: p.module.module) + assert stmtList.kind == nkStmtList + for i in 0..<stmtList.len: + genStmt(p, stmtList[i]) proc getFieldPosition(p: PProc; f: PNode): int = case f.kind @@ -1344,8 +1376,8 @@ proc genFieldAddr(p: PProc, n: PNode, r: var TCompRes) = else: if b[1].kind != nkSym: internalError(p.config, b[1].info, "genFieldAddr") var f = b[1].sym - if f.loc.r == "": f.loc.r = mangleName(p.module, f) - r.res = makeJSString($f.loc.r) + if f.loc.snippet == "": f.loc.snippet = mangleName(p.module, f) + r.res = makeJSString($f.loc.snippet) internalAssert p.config, a.typ != etyBaseIndex r.address = a.res r.kind = resExpr @@ -1372,8 +1404,8 @@ proc genFieldAccess(p: PProc, n: PNode, r: var TCompRes) = else: if n[1].kind != nkSym: internalError(p.config, n[1].info, "genFieldAccess") var f = n[1].sym - if f.loc.r == "": f.loc.r = mangleName(p.module, f) - r.res = "$1.$2" % [r.res, f.loc.r] + if f.loc.snippet == "": f.loc.snippet = mangleName(p.module, f) + r.res = "$1.$2" % [r.res, f.loc.snippet] mkTemp(1) r.kind = resExpr @@ -1393,11 +1425,11 @@ proc genCheckedFieldOp(p: PProc, n: PNode, addrTyp: PType, r: var TCompRes) = # Field symbol var field = accessExpr[1].sym internalAssert p.config, field.kind == skField - if field.loc.r == "": field.loc.r = mangleName(p.module, field) + if field.loc.snippet == "": field.loc.snippet = mangleName(p.module, field) # Discriminant symbol let disc = checkExpr[2].sym internalAssert p.config, disc.kind == skField - if disc.loc.r == "": disc.loc.r = mangleName(p.module, disc) + if disc.loc.snippet == "": disc.loc.snippet = mangleName(p.module, disc) var setx: TCompRes = default(TCompRes) gen(p, checkExpr[1], setx) @@ -1414,16 +1446,16 @@ proc genCheckedFieldOp(p: PProc, n: PNode, addrTyp: PType, r: var TCompRes) = useMagic(p, "reprDiscriminant") # no need to offset by firstOrd unlike for cgen let msg = genFieldDefect(p.config, field.name.s, disc) lineF(p, "if ($1[$2.$3]$4undefined) { raiseFieldError2(makeNimstrLit($5), reprDiscriminant($2.$3, $6)); }$n", - setx.res, tmp, disc.loc.r, if negCheck: "!==" else: "===", + setx.res, tmp, disc.loc.snippet, if negCheck: "!==" else: "===", makeJSString(msg), genTypeInfo(p, disc.typ)) if addrTyp != nil and mapType(p, addrTyp) == etyBaseIndex: r.typ = etyBaseIndex - r.res = makeJSString($field.loc.r) + r.res = makeJSString($field.loc.snippet) r.address = tmp else: r.typ = etyNone - r.res = "$1.$2" % [tmp, field.loc.r] + r.res = "$1.$2" % [tmp, field.loc.snippet] r.kind = resExpr proc genArrayAddr(p: PProc, n: PNode, r: var TCompRes) = @@ -1439,7 +1471,7 @@ proc genArrayAddr(p: PProc, n: PNode, r: var TCompRes) = r.address = x var typ = skipTypes(m[0].typ, abstractPtrs) if typ.kind == tyArray: - first = firstOrd(p.config, typ[0]) + first = firstOrd(p.config, typ.indexType) if optBoundsCheck in p.options: useMagic(p, "chckIndx") if first == 0: # save a couple chars @@ -1454,8 +1486,8 @@ proc genArrayAddr(p: PProc, n: PNode, r: var TCompRes) = r.kind = resExpr proc genArrayAccess(p: PProc, n: PNode, r: var TCompRes) = - var ty = skipTypes(n[0].typ, abstractVarRange) - if ty.kind in {tyRef, tyPtr, tyLent, tyOwned}: ty = skipTypes(ty.lastSon, abstractVarRange) + var ty = skipTypes(n[0].typ, abstractVarRange+tyUserTypeClasses) + if ty.kind in {tyRef, tyPtr, tyLent, tyOwned}: ty = skipTypes(ty.elementType, abstractVarRange) case ty.kind of tyArray, tyOpenArray, tySequence, tyString, tyCstring, tyVarargs: genArrayAddr(p, n, r) @@ -1490,10 +1522,10 @@ template isIndirect(x: PSym): bool = proc genSymAddr(p: PProc, n: PNode, typ: PType, r: var TCompRes) = let s = n.sym - if s.loc.r == "": internalError(p.config, n.info, "genAddr: 3") + if s.loc.snippet == "": internalError(p.config, n.info, "genAddr: 3") case s.kind of skParam: - r.res = s.loc.r + r.res = s.loc.snippet r.address = "" r.typ = etyNone of skVar, skLet, skResult: @@ -1507,15 +1539,15 @@ proc genSymAddr(p: PProc, n: PNode, typ: PType, r: var TCompRes) = # make addr() a no-op: r.typ = etyNone if isIndirect(s): - r.res = s.loc.r & "[0]" + r.res = s.loc.snippet & "[0]" else: - r.res = s.loc.r + r.res = s.loc.snippet r.address = "" 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.address = s.loc.snippet r.res = rope("0") else: # 'var openArray' for instance produces an 'addr' but this is harmless: @@ -1542,7 +1574,7 @@ proc genAddr(p: PProc, n: PNode, r: var TCompRes) = if ty.kind in MappedToObject: gen(p, n[0], r) else: - let kindOfIndexedExpr = skipTypes(n[0][0].typ, abstractVarRange).kind + let kindOfIndexedExpr = skipTypes(n[0][0].typ, abstractVarRange+tyUserTypeClasses).kind case kindOfIndexedExpr of tyArray, tyOpenArray, tySequence, tyString, tyCstring, tyVarargs: genArrayAddr(p, n[0], r) @@ -1588,12 +1620,15 @@ proc attachProc(p: PProc; s: PSym) = proc genProcForSymIfNeeded(p: PProc, s: PSym) = if not p.g.generatedSyms.containsOrIncl(s.id): - let newp = genProc(p, s) - var owner = p - while owner != nil and owner.prc != s.owner: - owner = owner.up - if owner != nil: owner.locals.add(newp) - else: attachProc(p, newp, s) + if jsNoLambdaLifting in p.config.legacyFeatures: + let newp = genProc(p, s) + var owner = p + while owner != nil and owner.prc != s.owner: + owner = owner.up + if owner != nil: owner.locals.add(newp) + else: attachProc(p, newp, s) + else: + attachProc(p, s) proc genCopyForParamIfNeeded(p: PProc, n: PNode) = let s = n.sym @@ -1605,7 +1640,7 @@ proc genCopyForParamIfNeeded(p: PProc, n: PNode) = internalError(p.config, n.info, "couldn't find the owner proc of the closed over param: " & s.name.s) if owner.prc == s.owner: if not owner.generatedParamCopies.containsOrIncl(s.id): - let copy = "$1 = nimCopy(null, $1, $2);$n" % [s.loc.r, genTypeInfo(p, s.typ)] + let copy = "$1 = nimCopy(null, $1, $2);$n" % [s.loc.snippet, genTypeInfo(p, s.typ)] owner.locals.add(owner.indentLine(copy)) return owner = owner.up @@ -1616,40 +1651,40 @@ proc genSym(p: PProc, n: PNode, r: var TCompRes) = var s = n.sym case s.kind of skVar, skLet, skParam, skTemp, skResult, skForVar: - if s.loc.r == "": + if s.loc.snippet == "": internalError(p.config, n.info, "symbol has no generated name: " & s.name.s) if sfCompileTime in s.flags: genVarInit(p, s, if s.astdef != nil: s.astdef else: newNodeI(nkEmpty, s.info)) - if s.kind == skParam: + if jsNoLambdaLifting in p.config.legacyFeatures and s.kind == skParam: genCopyForParamIfNeeded(p, n) let k = mapType(p, s.typ) if k == etyBaseIndex: r.typ = etyBaseIndex if {sfAddrTaken, sfGlobal} * s.flags != {}: if isIndirect(s): - r.address = "$1[0][0]" % [s.loc.r] - r.res = "$1[0][1]" % [s.loc.r] + r.address = "$1[0][0]" % [s.loc.snippet] + r.res = "$1[0][1]" % [s.loc.snippet] else: - r.address = "$1[0]" % [s.loc.r] - r.res = "$1[1]" % [s.loc.r] + r.address = "$1[0]" % [s.loc.snippet] + r.res = "$1[1]" % [s.loc.snippet] else: - r.address = s.loc.r - r.res = s.loc.r & "_Idx" + r.address = s.loc.snippet + r.res = s.loc.snippet & "_Idx" elif isIndirect(s): - r.res = "$1[0]" % [s.loc.r] + r.res = "$1[0]" % [s.loc.snippet] else: - r.res = s.loc.r + r.res = s.loc.snippet of skConst: genConstant(p, s) - if s.loc.r == "": + if s.loc.snippet == "": internalError(p.config, n.info, "symbol has no generated name: " & s.name.s) - r.res = s.loc.r - of skProc, skFunc, skConverter, skMethod: + r.res = s.loc.snippet + of skProc, skFunc, skConverter, skMethod, skIterator: if sfCompileTime in s.flags: localError(p.config, n.info, "request to generate code for .compileTime proc: " & s.name.s) discard mangleName(p.module, s) - r.res = s.loc.r + r.res = s.loc.snippet if lfNoDecl in s.loc.flags or s.magic notin generatedMagics or {sfImportc, sfInfixCall} * s.flags != {}: discard @@ -1661,13 +1696,13 @@ proc genSym(p: PProc, n: PNode, r: var TCompRes) = else: genProcForSymIfNeeded(p, s) else: - if s.loc.r == "": + if s.loc.snippet == "": internalError(p.config, n.info, "symbol has no generated name: " & s.name.s) if mapType(p, s.typ) == etyBaseIndex: - r.address = s.loc.r - r.res = s.loc.r & "_Idx" + r.address = s.loc.snippet + r.res = s.loc.snippet & "_Idx" else: - r.res = s.loc.r + r.res = s.loc.snippet r.kind = resVal proc genDeref(p: PProc, n: PNode, r: var TCompRes) = @@ -1809,9 +1844,9 @@ proc genPatternCall(p: PProc; n: PNode; pat: string; typ: PType; proc genInfixCall(p: PProc, n: PNode, r: var TCompRes) = # don't call '$' here for efficiency: let f = n[0].sym - if f.loc.r == "": f.loc.r = mangleName(p.module, f) + if f.loc.snippet == "": f.loc.snippet = mangleName(p.module, f) if sfInfixCall in f.flags: - let pat = $n[0].sym.loc.r + let pat = $n[0].sym.loc.snippet internalAssert p.config, pat.len > 0 if pat.contains({'#', '(', '@'}): var typ = skipTypes(n[0].typ, abstractInst) @@ -1889,7 +1924,7 @@ proc createObjInitList(p: PProc, typ: PType, excludedFieldIDs: IntSet, output: v while t != nil: t = t.skipTypes(skipPtrs) createRecordVarAux(p, t.n, excludedFieldIDs, output) - t = t[0] + t = t.baseClass proc arrayTypeForElemType(conf: ConfigRef; typ: PType): string = let typ = typ.skipTypes(abstractRange) @@ -1926,7 +1961,7 @@ proc createVar(p: PProc, typ: PType, indirect: bool): Rope = of tyInt8..tyInt32, tyUInt8..tyUInt32, tyEnum, tyChar: result = putToSeq("0", indirect) of tyInt, tyUInt: - if $t.sym.loc.r == "bigint": + if $t.sym.loc.snippet == "bigint": result = putToSeq("0n", indirect) else: result = putToSeq("0", indirect) @@ -1938,7 +1973,7 @@ proc createVar(p: PProc, typ: PType, indirect: bool): Rope = of tyFloat..tyFloat128: result = putToSeq("0.0", indirect) of tyRange, tyGenericInst, tyAlias, tySink, tyOwned, tyLent: - result = createVar(p, lastSon(typ), indirect) + result = createVar(p, skipModifier(typ), indirect) of tySet: result = putToSeq("{}", indirect) of tyBool: @@ -1986,11 +2021,11 @@ proc createVar(p: PProc, typ: PType, indirect: bool): Rope = result = putToSeq("null", indirect) of tySequence, tyString: result = putToSeq("[]", indirect) - of tyCstring, tyProc: + of tyCstring, tyProc, tyOpenArray: result = putToSeq("null", indirect) of tyStatic: if t.n != nil: - result = createVar(p, lastSon t, indirect) + result = createVar(p, skipModifier t, indirect) else: internalError(p.config, "createVar: " & $t.kind) result = "" @@ -2038,7 +2073,7 @@ proc genVarInit(p: PProc, v: PSym, n: PNode) = gen(p, n, a) case mapType(p, v.typ) of etyObject, etySeq: - if needsNoCopy(p, n): + if v.typ.kind in {tyOpenArray, tyVarargs} or needsNoCopy(p, n): s = a.res else: useMagic(p, "nimCopy") @@ -2048,33 +2083,44 @@ proc genVarInit(p: PProc, v: PSym, n: PNode) = if a.typ == etyBaseIndex: if targetBaseIndex: line(p, runtimeFormat(varCode & " = $3, $2_Idx = $4;$n", - [returnType, v.loc.r, a.address, a.res])) + [returnType, v.loc.snippet, a.address, a.res])) else: if isIndirect(v): line(p, runtimeFormat(varCode & " = [[$3, $4]];$n", - [returnType, v.loc.r, a.address, a.res])) + [returnType, v.loc.snippet, a.address, a.res])) else: line(p, runtimeFormat(varCode & " = [$3, $4];$n", - [returnType, v.loc.r, a.address, a.res])) + [returnType, v.loc.snippet, a.address, a.res])) else: if targetBaseIndex: let tmp = p.getTemp lineF(p, "var $1 = $2, $3 = $1[0], $3_Idx = $1[1];$n", - [tmp, a.res, v.loc.r]) + [tmp, a.res, v.loc.snippet]) else: - line(p, runtimeFormat(varCode & " = $3;$n", [returnType, v.loc.r, a.res])) + line(p, runtimeFormat(varCode & " = $3;$n", [returnType, v.loc.snippet, a.res])) return else: s = a.res if isIndirect(v): - line(p, runtimeFormat(varCode & " = [$3];$n", [returnType, v.loc.r, s])) + line(p, runtimeFormat(varCode & " = [$3];$n", [returnType, v.loc.snippet, s])) else: - line(p, runtimeFormat(varCode & " = $3;$n", [returnType, v.loc.r, s])) + line(p, runtimeFormat(varCode & " = $3;$n", [returnType, v.loc.snippet, s])) if useReloadingGuard or useGlobalPragmas: dec p.extraIndent lineF(p, "}$n") +proc genClosureVar(p: PProc, n: PNode) = + # assert n[2].kind != nkEmpty + # TODO: fixme transform `var env.x` into `var env.x = default()` after + # the order of transf and lambdalifting is fixed + if n[2].kind != nkEmpty: + genAsgnAux(p, n[0], n[2], false) + else: + var a: TCompRes = default(TCompRes) + gen(p, n[0], a) + line(p, runtimeFormat("$1 = $2;$n", [rdLoc(a), createVar(p, n[0].typ, false)])) + proc genVarStmt(p: PProc, n: PNode) = for i in 0..<n.len: var a = n[i] @@ -2084,15 +2130,17 @@ proc genVarStmt(p: PProc, n: PNode) = genStmt(p, unpacked) else: assert(a.kind == nkIdentDefs) - assert(a[0].kind == nkSym) - var v = a[0].sym - if lfNoDecl notin v.loc.flags and sfImportc notin v.flags: - genLineDir(p, a) - if sfCompileTime notin v.flags: - genVarInit(p, v, a[2]) - else: - # lazy emit, done when it's actually used. - if v.ast == nil: v.ast = a[2] + if a[0].kind == nkSym: + var v = a[0].sym + if lfNoDecl notin v.loc.flags and sfImportc notin v.flags: + genLineDir(p, a) + if sfCompileTime notin v.flags: + genVarInit(p, v, a[2]) + else: + # lazy emit, done when it's actually used. + if v.ast == nil: v.ast = a[2] + else: # closure + genClosureVar(p, a) proc genConstant(p: PProc, c: PSym) = if lfNoDecl notin c.loc.flags and not p.g.generatedSyms.containsOrIncl(c.id): @@ -2139,20 +2187,20 @@ proc genConStrStr(p: PProc, n: PNode, r: var TCompRes) = if skipTypes(n[1].typ, abstractVarRange).kind == tyChar: r.res.add("[$1].concat(" % [a.res]) else: - r.res.add("($1 || []).concat(" % [a.res]) + r.res.add("($1).concat(" % [a.res]) for i in 2..<n.len - 1: gen(p, n[i], a) if skipTypes(n[i].typ, abstractVarRange).kind == tyChar: r.res.add("[$1]," % [a.res]) else: - r.res.add("$1 || []," % [a.res]) + r.res.add("$1," % [a.res]) gen(p, n[^1], a) if skipTypes(n[^1].typ, abstractVarRange).kind == tyChar: r.res.add("[$1])" % [a.res]) else: - r.res.add("$1 || [])" % [a.res]) + r.res.add("$1)" % [a.res]) proc genReprAux(p: PProc, n: PNode, r: var TCompRes, magic: string, typ: Rope = "") = useMagic(p, magic) @@ -2219,16 +2267,17 @@ proc genDefault(p: PProc, n: PNode; r: var TCompRes) = r.res = createVar(p, n.typ, indirect = false) r.kind = resExpr -proc genReset(p: PProc, n: PNode) = +proc genWasMoved(p: PProc, n: PNode) = + # TODO: it should be done by nir var x: TCompRes = default(TCompRes) - useMagic(p, "genericReset") gen(p, n[1], x) if x.typ == etyBaseIndex: lineF(p, "$1 = null, $2 = 0;$n", [x.address, x.res]) else: - let (a, tmp) = maybeMakeTempAssignable(p, n[1], x) - lineF(p, "$1 = genericReset($3, $2);$n", [a, - genTypeInfo(p, n[1].typ), tmp]) + var y: TCompRes = default(TCompRes) + genDefault(p, n[1], y) + let (a, _) = maybeMakeTempAssignable(p, n[1], x) + lineF(p, "$1 = $2;$n", [a, y.rdLoc]) proc genMove(p: PProc; n: PNode; r: var TCompRes) = var a: TCompRes = default(TCompRes) @@ -2236,7 +2285,7 @@ proc genMove(p: PProc; n: PNode; r: var TCompRes) = r.res = p.getTemp() gen(p, n[1], a) lineF(p, "$1 = $2;$n", [r.rdLoc, a.rdLoc]) - genReset(p, n) + genWasMoved(p, n) #lineF(p, "$1 = $2;$n", [dest.rdLoc, src.rdLoc]) proc genDup(p: PProc; n: PNode; r: var TCompRes) = @@ -2417,7 +2466,7 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = of mNewSeqOfCap: unaryExpr(p, n, r, "", "[]") of mOf: genOf(p, n, r) of mDefault, mZeroDefault: genDefault(p, n, r) - of mReset, mWasMoved: genReset(p, n) + of mWasMoved: genWasMoved(p, n) of mEcho: genEcho(p, n, r) of mNLen..mNError, mSlurp, mStaticExec: localError(p.config, n.info, errXMustBeCompileTime % n[0].sym.name.s) @@ -2530,17 +2579,17 @@ proc genObjConstr(p: PProc, n: PNode, r: var TCompRes) = let val = it[1] gen(p, val, a) var f = it[0].sym - if f.loc.r == "": f.loc.r = mangleName(p.module, f) + if f.loc.snippet == "": f.loc.snippet = mangleName(p.module, f) fieldIDs.incl(lookupFieldAgain(n.typ.skipTypes({tyDistinct}), f).id) let typ = val.typ.skipTypes(abstractInst) if a.typ == etyBaseIndex: - initList.addf("$#: [$#, $#]", [f.loc.r, a.address, a.res]) + initList.addf("$#: [$#, $#]", [f.loc.snippet, a.address, a.res]) else: if not needsNoCopy(p, val): useMagic(p, "nimCopy") a.res = "nimCopy(null, $1, $2)" % [a.rdLoc, genTypeInfo(p, typ)] - initList.addf("$#: $#", [f.loc.r, a.res]) + initList.addf("$#: $#", [f.loc.snippet, a.res]) let t = skipTypes(n.typ, abstractInst + skipPtrs) createObjInitList(p, t, fieldIDs, initList) r.res = ("{$1}") % [initList] @@ -2599,7 +2648,13 @@ proc genRangeChck(p: PProc, n: PNode, r: var TCompRes, magic: string) = let src = skipTypes(n[0].typ, abstractVarRange) let dest = skipTypes(n.typ, abstractVarRange) if optRangeCheck notin p.options: - return + if optJsBigInt64 in p.config.globalOptions and + dest.kind in {tyUInt..tyUInt32, tyInt..tyInt32} and + src.kind in {tyInt64, tyUInt64}: + # conversions to Number are kept + r.res = "Number($1)" % [r.res] + else: + discard elif dest.kind in {tyUInt..tyUInt64} and checkUnsignedConversions notin p.config.legacyFeatures: if src.kind in {tyInt64, tyUInt64} and optJsBigInt64 in p.config.globalOptions: r.res = "BigInt.asUintN($1, $2)" % [$(dest.size * 8), r.res] @@ -2698,8 +2753,8 @@ proc genProc(oldProc: PProc, prc: PSym): Rope = var returnStmt: Rope = "" var resultAsgn: Rope = "" var name = mangleName(p.module, prc) - let header = generateHeader(p, prc.typ) - if prc.typ[0] != nil and sfPure notin prc.flags: + let header = generateHeader(p, prc) + if prc.typ.returnType != nil and sfPure notin prc.flags: resultSym = prc.ast[resultPos].sym let mname = mangleName(p.module, resultSym) # otherwise uses "fat pointers" @@ -2780,9 +2835,9 @@ proc genPragma(p: PProc, n: PNode) = case whichPragma(it) of wEmit: genAsmOrEmitStmt(p, it[1]) of wPush: - processPushBackendOption(p.optionsStack, p.options, n, i+1) + processPushBackendOption(p.config, p.optionsStack, p.options, n, i+1) of wPop: - processPopBackendOption(p.optionsStack, p.options) + processPopBackendOption(p.config, p.optionsStack, p.options) else: discard proc genCast(p: PProc, n: PNode, r: var TCompRes) = @@ -2917,7 +2972,18 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = genInfixCall(p, n, r) else: genCall(p, n, r) - of nkClosure: gen(p, n[0], r) + of nkClosure: + if jsNoLambdaLifting in p.config.legacyFeatures: + gen(p, n[0], r) + else: + let tmp = getTemp(p) + var a: TCompRes = default(TCompRes) + var b: TCompRes = default(TCompRes) + gen(p, n[0], a) + gen(p, n[1], b) + lineF(p, "$1 = $2.bind($3); $1.ClP_0 = $2; $1.ClE_0 = $3;$n", [tmp, a.rdLoc, b.rdLoc]) + r.res = tmp + r.kind = resVal of nkCurly: genSetConstr(p, n, r) of nkBracket: genArrayConstr(p, n, r) of nkPar, nkTupleConstr: genTupleConstr(p, n, r) @@ -2948,7 +3014,7 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = of nkLambdaKinds: let s = n[namePos].sym discard mangleName(p.module, s) - r.res = s.loc.r + r.res = s.loc.snippet if lfNoDecl in s.loc.flags or s.magic notin generatedMagics: discard elif not p.g.generatedSyms.containsOrIncl(s.id): p.locals.add(genProc(p, s)) @@ -2980,17 +3046,16 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = if n[0].kind != nkEmpty: genLineDir(p, n) gen(p, n[0], r) - r.res = "var _ = " & r.res - of nkAsmStmt: genAsmOrEmitStmt(p, n) + r.res = "(" & r.res & ")" + of nkAsmStmt: + warningDeprecated(p.config, n.info, "'asm' for the JS target is deprecated, use the 'emit' pragma") + genAsmOrEmitStmt(p, n, true) of nkTryStmt, nkHiddenTryStmt: genTry(p, n, r) of nkRaiseStmt: genRaiseStmt(p, n) of nkTypeSection, nkCommentStmt, nkIncludeStmt, nkImportStmt, nkImportExceptStmt, nkExportStmt, nkExportExceptStmt, - nkFromStmt, nkTemplateDef, nkMacroDef, nkStaticStmt, + nkFromStmt, nkTemplateDef, nkMacroDef, nkIteratorDef, nkStaticStmt, nkMixinStmt, nkBindStmt: discard - of nkIteratorDef: - if n[0].sym.typ.callConv == TCallingConvention.ccClosure: - globalError(p.config, n.info, "Closure iterators are not supported by JS backend!") of nkPragma: genPragma(p, n) of nkProcDef, nkFuncDef, nkMethodDef, nkConverterDef: var s = n[namePos].sym @@ -2998,7 +3063,9 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = genSym(p, n[namePos], r) r.res = "" of nkGotoState, nkState: - globalError(p.config, n.info, "First class iterators not implemented") + globalError(p.config, n.info, "not implemented") + of nkBreakState: + genBreakState(p, n[0], r) of nkPragmaBlock: gen(p, n.lastSon, r) of nkComesFrom: discard "XXX to implement for better stack traces" @@ -3105,15 +3172,6 @@ proc wholeCode(graph: ModuleGraph; m: BModule): Rope = result = globals.typeInfo & globals.constants & globals.code -proc getClassName(t: PType): Rope = - var s = t.sym - if s.isNil or sfAnon in s.flags: - s = skipTypes(t, abstractPtrs).sym - if s.isNil or sfAnon in s.flags: - doAssert(false, "cannot retrieve class name") - if s.loc.r != "": result = s.loc.r - else: result = rope(s.name.s) - proc finalJSCodeGen*(graph: ModuleGraph; b: PPassContext, n: PNode): PNode = ## Finalize JS code generation of a Nim module. ## Param `n` may contain nodes returned from the last module close call. diff --git a/compiler/jstypes.nim b/compiler/jstypes.nim index 4b4ca9fe7..d980f9989 100644 --- a/compiler/jstypes.nim +++ b/compiler/jstypes.nim @@ -69,7 +69,7 @@ proc genObjectFields(p: PProc, typ: PType, n: PNode): Rope = else: internalError(p.config, n.info, "genObjectFields") proc objHasTypeField(t: PType): bool {.inline.} = - tfInheritable in t.flags or t[0] != nil + tfInheritable in t.flags or t.baseClass != nil proc genObjectInfo(p: PProc, typ: PType, name: Rope) = let kind = if objHasTypeField(typ): tyObject else: tyTuple @@ -79,9 +79,9 @@ proc genObjectInfo(p: PProc, typ: PType, name: Rope) = p.g.typeInfo.addf("var NNI$1 = $2;$n", [rope(typ.id), genObjectFields(p, typ, typ.n)]) p.g.typeInfo.addf("$1.node = NNI$2;$n", [name, rope(typ.id)]) - if (typ.kind == tyObject) and (typ[0] != nil): + if (typ.kind == tyObject) and (typ.baseClass != nil): p.g.typeInfo.addf("$1.base = $2;$n", - [name, genTypeInfo(p, typ[0].skipTypes(skipPtrs))]) + [name, genTypeInfo(p, typ.baseClass.skipTypes(skipPtrs))]) proc genTupleFields(p: PProc, typ: PType): Rope = var s: Rope = "" @@ -117,9 +117,9 @@ proc genEnumInfo(p: PProc, typ: PType, name: Rope) = prepend(p.g.typeInfo, s) p.g.typeInfo.add(n) p.g.typeInfo.addf("$1.node = NNI$2;$n", [name, rope(typ.id)]) - if typ[0] != nil: + if typ.baseClass != nil: p.g.typeInfo.addf("$1.base = $2;$n", - [name, genTypeInfo(p, typ[0])]) + [name, genTypeInfo(p, typ.baseClass)]) proc genTypeInfo(p: PProc, typ: PType): Rope = let t = typ.skipTypes({tyGenericInst, tyDistinct, tyAlias, tySink, tyOwned}) @@ -127,7 +127,7 @@ proc genTypeInfo(p: PProc, typ: PType): Rope = if containsOrIncl(p.g.typeInfoGenerated, t.id): return case t.kind of tyDistinct: - result = genTypeInfo(p, t[0]) + result = genTypeInfo(p, t.skipModifier) of tyPointer, tyProc, tyBool, tyChar, tyCstring, tyString, tyInt..tyUInt64: var s = "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n" % @@ -139,18 +139,18 @@ proc genTypeInfo(p: PProc, typ: PType): Rope = [result, rope(ord(t.kind))] prepend(p.g.typeInfo, s) p.g.typeInfo.addf("$1.base = $2;$n", - [result, genTypeInfo(p, t.lastSon)]) + [result, genTypeInfo(p, t.elementType)]) of 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) p.g.typeInfo.addf("$1.base = $2;$n", - [result, genTypeInfo(p, t[1])]) + [result, genTypeInfo(p, t.elementType)]) of tyEnum: genEnumInfo(p, t, result) of tyObject: genObjectInfo(p, t, result) of tyTuple: genTupleInfo(p, t, result) of tyStatic: - if t.n != nil: result = genTypeInfo(p, lastSon t) + if t.n != nil: result = genTypeInfo(p, skipModifier t) else: internalError(p.config, "genTypeInfo(" & $t.kind & ')') else: internalError(p.config, "genTypeInfo(" & $t.kind & ')') diff --git a/compiler/lambdalifting.nim b/compiler/lambdalifting.nim index 9345ac114..54cdfc5bc 100644 --- a/compiler/lambdalifting.nim +++ b/compiler/lambdalifting.nim @@ -145,11 +145,13 @@ proc createStateField(g: ModuleGraph; iter: PSym; idgen: IdGenerator): PSym = result = newSym(skField, getIdent(g.cache, ":state"), idgen, iter, iter.info) result.typ = createClosureIterStateType(g, iter, idgen) +template isIterator*(owner: PSym): bool = + owner.kind == skIterator and owner.typ.callConv == ccClosure + proc createEnvObj(g: ModuleGraph; idgen: IdGenerator; owner: PSym; info: TLineInfo): PType = - # YYY meh, just add the state field for every closure for now, it's too - # hard to figure out if it comes from a closure iterator: result = createObj(g, idgen, owner, info, final=false) - rawAddField(result, createStateField(g, owner, idgen)) + if owner.isIterator or not isDefined(g.config, "nimOptIters"): + rawAddField(result, createStateField(g, owner, idgen)) proc getClosureIterResult*(g: ModuleGraph; iter: PSym; idgen: IdGenerator): PSym = if resultPos < iter.ast.len: @@ -157,7 +159,7 @@ proc getClosureIterResult*(g: ModuleGraph; iter: PSym; idgen: IdGenerator): PSym else: # XXX a bit hacky: result = newSym(skResult, getIdent(g.cache, ":result"), idgen, iter, iter.info, {}) - result.typ = iter.typ[0] + result.typ = iter.typ.returnType incl(result.flags, sfUsed) iter.ast.add newSymNode(result) @@ -172,26 +174,22 @@ proc addHiddenParam(routine: PSym, param: PSym) = assert sfFromGeneric in param.flags #echo "produced environment: ", param.id, " for ", routine.id -proc getHiddenParam(g: ModuleGraph; routine: PSym): PSym = +proc getEnvParam*(routine: PSym): PSym = let params = routine.ast[paramsPos] let hidden = lastSon(params) if hidden.kind == nkSym and hidden.sym.kind == skParam and hidden.sym.name.s == paramName: result = hidden.sym assert sfFromGeneric in result.flags else: + result = nil + +proc getHiddenParam(g: ModuleGraph; routine: PSym): PSym = + result = getEnvParam(routine) + if result.isNil: # writeStackTrace() localError(g.config, routine.info, "internal error: could not find env param for " & routine.name.s) result = routine -proc getEnvParam*(routine: PSym): PSym = - let params = routine.ast[paramsPos] - let hidden = lastSon(params) - if hidden.kind == nkSym and hidden.sym.name.s == paramName: - result = hidden.sym - assert sfFromGeneric in result.flags - else: - result = nil - proc interestingVar(s: PSym): bool {.inline.} = result = s.kind in {skVar, skLet, skTemp, skForVar, skParam, skResult} and sfGlobal notin s.flags and @@ -231,22 +229,20 @@ proc makeClosure*(g: ModuleGraph; idgen: IdGenerator; prc: PSym; env: PNode; inf prc.flags.incl sfInjectDestructors proc interestingIterVar(s: PSym): bool {.inline.} = + # unused with -d:nimOptIters # XXX optimization: Only lift the variable if it lives across # yield/return boundaries! This can potentially speed up # closure iterators quite a bit. result = s.kind in {skResult, skVar, skLet, skTemp, skForVar} and sfGlobal notin s.flags -template isIterator*(owner: PSym): bool = - owner.kind == skIterator and owner.typ.callConv == ccClosure - -proc liftingHarmful(conf: ConfigRef; owner: PSym): bool {.inline.} = +template liftingHarmful(conf: ConfigRef; owner: PSym): bool = ## lambda lifting can be harmful for JS-like code generators. let isCompileTime = sfCompileTime in owner.flags or owner.kind == skMacro - result = conf.backend == backendJs and not isCompileTime + jsNoLambdaLifting in conf.legacyFeatures and conf.backend == backendJs and not isCompileTime proc createTypeBoundOpsLL(g: ModuleGraph; refType: PType; info: TLineInfo; idgen: IdGenerator; owner: PSym) = if owner.kind != skMacro: - createTypeBoundOps(g, nil, refType.lastSon, info, idgen) + createTypeBoundOps(g, nil, refType.elementType, info, idgen) createTypeBoundOps(g, nil, refType, info, idgen) if tfHasAsgn in refType.flags or optSeqDestructors in g.config.globalOptions: owner.flags.incl sfInjectDestructors @@ -264,8 +260,7 @@ proc liftIterSym*(g: ModuleGraph; n: PNode; idgen: IdGenerator; owner: PSym): PN let iter = n.sym assert iter.isIterator - result = newNodeIT(nkStmtListExpr, n.info, n.typ) - + result = newNodeIT(nkStmtListExpr, n.info, iter.typ) let hp = getHiddenParam(g, iter) var env: PNode if owner.isIterator: @@ -287,6 +282,7 @@ proc liftIterSym*(g: ModuleGraph; n: PNode; idgen: IdGenerator; owner: PSym): PN result.add makeClosure(g, idgen, iter, env, n.info) proc freshVarForClosureIter*(g: ModuleGraph; s: PSym; idgen: IdGenerator; owner: PSym): PNode = + # unused with -d:nimOptIters let envParam = getHiddenParam(g, owner) let obj = envParam.typ.skipTypes({tyOwned, tyRef, tyPtr}) let field = addField(obj, s, g.cache, idgen) @@ -304,8 +300,8 @@ proc markAsClosure(g: ModuleGraph; owner: PSym; n: PNode) = localError(g.config, n.info, ("'$1' is of type <$2> which cannot be captured as it would violate memory" & " safety, declared here: $3; using '-d:nimNoLentIterators' helps in some cases." & - " Consider using a <ref $2> which can be captured.") % - [s.name.s, typeToString(s.typ), g.config$s.info]) + " Consider using a <ref T> which can be captured.") % + [s.name.s, typeToString(s.typ.skipTypes({tyVar})), g.config$s.info]) elif not (owner.typ.isClosure or owner.isNimcall and not owner.isExplicitCallConv or isEnv): localError(g.config, n.info, "illegal capture '$1' because '$2' has the calling convention: <$3>" % [s.name.s, owner.name.s, $owner.typ.callConv]) @@ -342,9 +338,13 @@ proc getEnvTypeForOwner(c: var DetectionPass; owner: PSym; info: TLineInfo): PType = result = c.ownerToType.getOrDefault(owner.id) if result.isNil: - result = newType(tyRef, c.idgen, owner) - let obj = createEnvObj(c.graph, c.idgen, owner, info) - rawAddSon(result, obj) + let env = getEnvParam(owner) + if env.isNil or not owner.isIterator or not isDefined(c.graph.config, "nimOptIters"): + result = newType(tyRef, c.idgen, owner) + let obj = createEnvObj(c.graph, c.idgen, owner, info) + rawAddSon(result, obj) + else: + result = env.typ c.ownerToType[owner.id] = result proc asOwnedRef(c: var DetectionPass; t: PType): PType = @@ -460,13 +460,14 @@ proc detectCapturedVars(n: PNode; owner: PSym; c: var DetectionPass) = if owner.isIterator: c.somethingToDo = true addClosureParam(c, owner, n.info) - if interestingIterVar(s): + if not isDefined(c.graph.config, "nimOptIters") and interestingIterVar(s): if not c.capturedVars.contains(s.id): if not c.inTypeOf: c.capturedVars.incl(s.id) let obj = getHiddenParam(c.graph, owner).typ.skipTypes({tyOwned, tyRef, tyPtr}) #let obj = c.getEnvTypeForOwner(s.owner).skipTypes({tyOwned, tyRef, tyPtr}) if s.name.id == getIdent(c.graph.cache, ":state").id: + obj.n[0].sym.flags.incl sfNoInit obj.n[0].sym.itemId = ItemId(module: s.itemId.module, item: -s.itemId.item) else: discard addField(obj, s, c.graph.cache, c.idgen) @@ -551,8 +552,8 @@ proc accessViaEnvParam(g: ModuleGraph; n: PNode; owner: PSym): PNode = let envParam = getHiddenParam(g, owner) if not envParam.isNil: var access = newSymNode(envParam) + var obj = access.typ.elementType while true: - let obj = access.typ[0] assert obj.kind == tyObject let field = getFieldFromObj(obj, s) if field != nil: @@ -560,6 +561,7 @@ proc accessViaEnvParam(g: ModuleGraph; n: PNode; owner: PSym): PNode = let upField = lookupInRecord(obj.n, getIdent(g.cache, upName)) if upField == nil: break access = rawIndirectAccess(access, upField, n.info) + obj = access.typ.baseClass localError(g.config, n.info, "internal error: environment misses: " & s.name.s) result = n @@ -571,7 +573,7 @@ proc newEnvVar(cache: IdentCache; owner: PSym; typ: PType; info: TLineInfo; idge when false: if owner.kind == skIterator and owner.typ.callConv == ccClosure: let it = getHiddenParam(owner) - addUniqueField(it.typ[0], v) + addUniqueField(it.typ.elementType, v) result = indirectAccess(newSymNode(it), v, v.info) else: result = newSymNode(v) @@ -772,7 +774,7 @@ proc liftCapturedVars(n: PNode; owner: PSym; d: var DetectionPass; elif s.id in d.capturedVars: if s.owner != owner: result = accessViaEnvParam(d.graph, n, owner) - elif owner.isIterator and interestingIterVar(s): + elif owner.isIterator and not isDefined(d.graph.config, "nimOptIters") and interestingIterVar(s): result = accessViaEnvParam(d.graph, n, owner) else: result = accessViaEnvVar(n, owner, d, c) @@ -882,19 +884,18 @@ proc liftIterToProc*(g: ModuleGraph; fn: PSym; body: PNode; ptrType: PType; proc liftLambdas*(g: ModuleGraph; fn: PSym, body: PNode; tooEarly: var bool; idgen: IdGenerator; flags: TransformFlags): PNode = - # XXX backend == backendJs does not suffice! The compiletime stuff needs - # the transformation even when compiling to JS ... - - # However we can do lifting for the stuff which is *only* compiletime. let isCompileTime = sfCompileTime in fn.flags or fn.kind == skMacro - if body.kind == nkEmpty or ( + if body.kind == nkEmpty or (jsNoLambdaLifting in g.config.legacyFeatures and g.config.backend == backendJs and not isCompileTime) or (fn.skipGenericOwner.kind != skModule and force notin flags): # ignore forward declaration: result = body tooEarly = true + if fn.isIterator and isDefined(g.config, "nimOptIters"): + var d = initDetectionPass(g, fn, idgen) + addClosureParam(d, fn, body.info) else: var d = initDetectionPass(g, fn, idgen) detectCapturedVars(body, fn, d) @@ -993,12 +994,15 @@ proc liftForLoop*(g: ModuleGraph; body: PNode; idgen: IdGenerator; owner: PSym): # gather vars in a tuple: var v2 = newNodeI(nkLetSection, body.info) var vpart = newNodeI(if body.len == 3: nkIdentDefs else: nkVarTuple, body.info) - for i in 0..<body.len-2: - if body[i].kind == nkSym: - body[i].sym.transitionToLet() - vpart.add body[i] + if body.len == 3 and body[0].kind == nkVarTuple: + vpart = body[0] # fixes for (i,j) in walk() # bug #15924 + else: + for i in 0..<body.len-2: + if body[i].kind == nkSym: + body[i].sym.transitionToLet() + vpart.add body[i] - vpart.add newNodeI(nkEmpty, body.info) # no explicit type + vpart.add newNodeI(nkEmpty, body.info) # no explicit type if not env.isNil: call[0] = makeClosure(g, idgen, call[0].sym, env.newSymNode, body.info) vpart.add call diff --git a/compiler/layouter.nim b/compiler/layouter.nim index 7cff98b11..0121b1185 100644 --- a/compiler/layouter.nim +++ b/compiler/layouter.nim @@ -9,7 +9,7 @@ ## Layouter for nimpretty. -import idents, lexer, lineinfos, llstream, options, msgs, strutils, pathutils +import idents, lexer, ast, lineinfos, llstream, options, msgs, strutils, pathutils const MinLineLen = 15 @@ -243,23 +243,28 @@ proc renderTokens*(em: var Emitter): string = return content -proc writeOut*(em: Emitter, content: string) = +type + FinalCheck = proc (content: string; origAst: PNode): bool {.nimcall.} + +proc writeOut*(em: Emitter; content: string; origAst: PNode; check: FinalCheck) = ## Write to disk let outFile = em.config.absOutFile if fileExists(outFile) and readFile(outFile.string) == content: discard "do nothing, see #9499" return - var f = llStreamOpen(outFile, fmWrite) - if f == nil: - rawMessage(em.config, errGenerated, "cannot open file: " & outFile.string) - return - f.llStreamWrite content - llStreamClose(f) -proc closeEmitter*(em: var Emitter) = + if check(content, origAst): + var f = llStreamOpen(outFile, fmWrite) + if f == nil: + rawMessage(em.config, errGenerated, "cannot open file: " & outFile.string) + return + f.llStreamWrite content + llStreamClose(f) + +proc closeEmitter*(em: var Emitter; origAst: PNode; check: FinalCheck) = ## Renders emitter tokens and write to a file let content = renderTokens(em) - em.writeOut(content) + em.writeOut(content, origAst, check) proc wr(em: var Emitter; x: string; lt: LayoutToken) = em.tokens.add x diff --git a/compiler/lexer.nim b/compiler/lexer.nim index 1ef0ce879..ad5dd560c 100644 --- a/compiler/lexer.nim +++ b/compiler/lexer.nim @@ -300,8 +300,7 @@ proc getNumber(L: var Lexer, result: var Token) = # Used to get slightly human friendlier err messages. const literalishChars = {'A'..'Z', 'a'..'z', '0'..'9', '_', '.', '\''} var msgPos = L.bufpos - var t: Token - t.literal = "" + var t = Token(literal: "") L.bufpos = startpos # Use L.bufpos as pos because of matchChars matchChars(L, t, literalishChars) # We must verify +/- specifically so that we're not past the literal diff --git a/compiler/liftdestructors.nim b/compiler/liftdestructors.nim index 36d9d5b1a..9ff5c0a9d 100644 --- a/compiler/liftdestructors.nim +++ b/compiler/liftdestructors.nim @@ -40,7 +40,7 @@ template asink*(t: PType): PSym = getAttachedOp(c.g, t, attachedSink) proc fillBody(c: var TLiftCtx; t: PType; body, x, y: PNode) proc produceSym(g: ModuleGraph; c: PContext; typ: PType; kind: TTypeAttachedOp; - info: TLineInfo; idgen: IdGenerator): PSym + info: TLineInfo; idgen: IdGenerator; isDistinct = false): PSym proc createTypeBoundOps*(g: ModuleGraph; c: PContext; orig: PType; info: TLineInfo; idgen: IdGenerator) @@ -56,10 +56,10 @@ proc destructorOverridden(g: ModuleGraph; t: PType): bool = op != nil and sfOverridden in op.flags proc fillBodyTup(c: var TLiftCtx; t: PType; body, x, y: PNode) = - for i in 0..<t.len: + for i, a in t.ikids: let lit = lowerings.newIntLit(c.g, x.info, i) - let b = if c.kind == attachedTrace: y else: y.at(lit, t[i]) - fillBody(c, t[i], body, x.at(lit, t[i]), b) + let b = if c.kind == attachedTrace: y else: y.at(lit, a) + fillBody(c, a, body, x.at(lit, a), b) proc dotField(x: PNode, f: PSym): PNode = result = newNodeI(nkDotExpr, x.info, 2) @@ -139,9 +139,9 @@ proc genContainerOf(c: var TLiftCtx; objType: PType, field, x: PSym): PNode = result.add minusExpr proc destructorCall(c: var TLiftCtx; op: PSym; x: PNode): PNode = - var destroy = newNodeIT(nkCall, x.info, op.typ[0]) + var destroy = newNodeIT(nkCall, x.info, op.typ.returnType) destroy.add(newSymNode(op)) - if op.typ[1].kind != tyVar: + if op.typ.firstParamType.kind != tyVar: destroy.add x else: destroy.add genAddr(c, x) @@ -153,11 +153,11 @@ proc destructorCall(c: var TLiftCtx; op: PSym; x: PNode): PNode = result = destroy proc genWasMovedCall(c: var TLiftCtx; op: PSym; x: PNode): PNode = - result = newNodeIT(nkCall, x.info, op.typ[0]) + result = newNodeIT(nkCall, x.info, op.typ.returnType) result.add(newSymNode(op)) result.add genAddr(c, x) -proc fillBodyObj(c: var TLiftCtx; n, body, x, y: PNode; enforceDefaultOp: bool) = +proc fillBodyObj(c: var TLiftCtx; n, body, x, y: PNode; enforceDefaultOp: bool, enforceWasMoved = false) = case n.kind of nkSym: if c.filterDiscriminator != nil: return @@ -167,6 +167,8 @@ proc fillBodyObj(c: var TLiftCtx; n, body, x, y: PNode; enforceDefaultOp: bool) enforceDefaultOp: defaultOp(c, f.typ, body, x.dotField(f), b) else: + if enforceWasMoved: + body.add genBuiltin(c, mWasMoved, "`=wasMoved`", x.dotField(f)) fillBody(c, f.typ, body, x.dotField(f), b) of nkNilLit: discard of nkRecCase: @@ -205,7 +207,7 @@ proc fillBodyObj(c: var TLiftCtx; n, body, x, y: PNode; enforceDefaultOp: bool) branch[^1] = newNodeI(nkStmtList, c.info) fillBodyObj(c, n[i].lastSon, branch[^1], x, y, - enforceDefaultOp = localEnforceDefaultOp) + enforceDefaultOp = localEnforceDefaultOp, enforceWasMoved = c.kind == attachedAsgn) if branch[^1].len == 0: inc emptyBranches caseStmt.add(branch) if emptyBranches != n.len-1: @@ -216,20 +218,29 @@ proc fillBodyObj(c: var TLiftCtx; n, body, x, y: PNode; enforceDefaultOp: bool) fillBodyObj(c, n[0], body, x, y, enforceDefaultOp = false) c.filterDiscriminator = oldfilterDiscriminator of nkRecList: - for t in items(n): fillBodyObj(c, t, body, x, y, enforceDefaultOp) + for t in items(n): fillBodyObj(c, t, body, x, y, enforceDefaultOp, enforceWasMoved) else: illFormedAstLocal(n, c.g.config) proc fillBodyObjTImpl(c: var TLiftCtx; t: PType, body, x, y: PNode) = - if t.len > 0 and t[0] != nil: - fillBody(c, skipTypes(t[0], abstractPtrs), body, x, y) + if t.baseClass != nil: + let dest = newNodeIT(nkHiddenSubConv, c.info, t.baseClass) + dest.add newNodeI(nkEmpty, c.info) + dest.add x + var src = y + if c.kind in {attachedAsgn, attachedDeepCopy, attachedSink}: + src = newNodeIT(nkHiddenSubConv, c.info, t.baseClass) + src.add newNodeI(nkEmpty, c.info) + src.add y + + fillBody(c, skipTypes(t.baseClass, abstractPtrs), body, dest, src) fillBodyObj(c, t.n, body, x, y, enforceDefaultOp = false) proc fillBodyObjT(c: var TLiftCtx; t: PType, body, x, y: PNode) = var hasCase = isCaseObj(t.n) var obj = t - while obj.len > 0 and obj[0] != nil: - obj = skipTypes(obj[0], abstractPtrs) + while obj.baseClass != nil: + obj = skipTypes(obj.baseClass, abstractPtrs) hasCase = hasCase or isCaseObj(obj.n) if hasCase and c.kind in {attachedAsgn, attachedDeepCopy}: @@ -279,6 +290,7 @@ proc fillBodyObjT(c: var TLiftCtx; t: PType, body, x, y: PNode) = c.kind = attachedDestructor fillBodyObjTImpl(c, t, body, blob, y) c.kind = prevKind + else: fillBodyObjTImpl(c, t, body, x, y) @@ -288,7 +300,7 @@ proc boolLit*(g: ModuleGraph; info: TLineInfo; value: bool): PNode = proc getCycleParam(c: TLiftCtx): PNode = assert c.kind in {attachedAsgn, attachedDup} - if c.fn.typ.len == 4: + if c.fn.typ.len == 3 + ord(c.kind == attachedAsgn): result = c.fn.typ.n.lastSon assert result.kind == nkSym assert result.sym.name.s == "cyclic" @@ -302,27 +314,35 @@ proc newHookCall(c: var TLiftCtx; op: PSym; x, y: PNode): PNode = result.add newSymNode(op) if sfNeverRaises notin op.flags: c.canRaise = true - if op.typ[1].kind == tyVar: + if op.typ.firstParamType.kind == tyVar: result.add genAddr(c, x) else: result.add x if y != nil: result.add y - if op.typ.len == 4: + if op.typ.signatureLen == 4: assert y != nil - if c.fn.typ.len == 4: + if c.fn.typ.signatureLen == 4: result.add getCycleParam(c) else: # assume the worst: A cycle is created: result.add boolLit(c.g, y.info, true) proc newOpCall(c: var TLiftCtx; op: PSym; x: PNode): PNode = - result = newNodeIT(nkCall, x.info, op.typ[0]) + result = newNodeIT(nkCall, x.info, op.typ.returnType) result.add(newSymNode(op)) result.add x if sfNeverRaises notin op.flags: c.canRaise = true + if c.kind == attachedDup and op.typ.len == 3: + assert x != nil + if c.fn.typ.len == 3: + result.add getCycleParam(c) + else: + # assume the worst: A cycle is created: + result.add boolLit(c.g, x.info, true) + proc newDeepCopyCall(c: var TLiftCtx; op: PSym; x, y: PNode): PNode = result = newAsgnStmt(x, newOpCall(c, op, y)) @@ -545,7 +565,7 @@ proc forallElements(c: var TLiftCtx; t: PType; body, x, y: PNode) = let counterIdx = body.len let i = declareCounter(c, body, toInt64(firstOrd(c.g.config, t))) let whileLoop = genWhileLoop(c, i, x) - let elemType = t.lastSon + let elemType = t.elementType let b = if c.kind == attachedTrace: y else: y.at(i, elemType) fillBody(c, elemType, whileLoop[1], x.at(i, elemType), b) if whileLoop[1].len > 0: @@ -656,7 +676,7 @@ proc fillStrOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = proc cyclicType*(g: ModuleGraph, t: PType): bool = case t.kind - of tyRef: result = types.canFormAcycle(g, t.lastSon) + of tyRef: result = types.canFormAcycle(g, t.elementType) of tyProc: result = t.callConv == ccClosure else: result = false @@ -681,7 +701,7 @@ proc atomicRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = ]# var actions = newNodeI(nkStmtList, c.info) - let elemType = t.lastSon + let elemType = t.elementType createTypeBoundOps(c.g, c.c, elemType, c.info, c.idgen) let isCyclic = c.g.config.selectedGC == gcOrc and types.canFormAcycle(c.g, elemType) @@ -851,7 +871,7 @@ proc weakrefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = proc ownedRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = var actions = newNodeI(nkStmtList, c.info) - let elemType = t.lastSon + let elemType = t.skipModifier #fillBody(c, elemType, actions, genDeref(x), genDeref(y)) #var disposeCall = genBuiltin(c, mDispose, "dispose", x) @@ -1017,7 +1037,7 @@ proc fillBody(c: var TLiftCtx; t: PType; body, x, y: PNode) = fillBodyObjT(c, t, body, x, y) of tyDistinct: if not considerUserDefinedOp(c, t, body, x, y): - fillBody(c, t[0], body, x, y) + fillBody(c, t.elementType, body, x, y) of tyTuple: fillBodyTup(c, t, body, x, y) of tyVarargs, tyOpenArray: @@ -1026,7 +1046,7 @@ proc fillBody(c: var TLiftCtx; t: PType; body, x, y: PNode) = else: discard "cannot copy openArray" - of tyFromExpr, tyProxy, tyBuiltInTypeClass, tyUserTypeClass, + of tyFromExpr, tyError, tyBuiltInTypeClass, tyUserTypeClass, tyUserTypeClassInst, tyCompositeTypeClass, tyAnd, tyOr, tyNot, tyAnything, tyGenericParam, tyGenericBody, tyNil, tyUntyped, tyTyped, tyTypeDesc, tyGenericInvocation, tyForward, tyStatic: @@ -1034,16 +1054,18 @@ proc fillBody(c: var TLiftCtx; t: PType; body, x, y: PNode) = discard of tyOrdinal, tyRange, tyInferred, tyGenericInst, tyAlias, tySink: - fillBody(c, lastSon(t), body, x, y) + fillBody(c, skipModifier(t), body, x, y) of tyConcept, tyIterable: raiseAssert "unreachable" proc produceSymDistinctType(g: ModuleGraph; c: PContext; typ: PType; kind: TTypeAttachedOp; info: TLineInfo; idgen: IdGenerator): PSym = assert typ.kind == tyDistinct - let baseType = typ[0] + let baseType = typ.elementType if getAttachedOp(g, baseType, kind) == nil: - discard produceSym(g, c, baseType, kind, info, idgen) + # TODO: fixme `isDistinct` is a fix for #23552; remove it after + # `-d:nimPreviewNonVarDestructor` becomes the default + discard produceSym(g, c, baseType, kind, info, idgen, isDistinct = true) result = getAttachedOp(g, baseType, kind) setAttachedOp(g, idgen.module, typ, kind, result) @@ -1082,7 +1104,7 @@ proc symDupPrototype(g: ModuleGraph; typ: PType; owner: PSym; kind: TTypeAttache incl result.flags, sfGeneratedOp proc symPrototype(g: ModuleGraph; typ: PType; owner: PSym; kind: TTypeAttachedOp; - info: TLineInfo; idgen: IdGenerator; isDiscriminant = false): PSym = + info: TLineInfo; idgen: IdGenerator; isDiscriminant = false; isDistinct = false): PSym = if kind == attachedDup: return symDupPrototype(g, typ, owner, kind, info, idgen) @@ -1093,7 +1115,7 @@ proc symPrototype(g: ModuleGraph; typ: PType; owner: PSym; kind: TTypeAttachedOp idgen, result, info) if kind == attachedDestructor and g.config.selectedGC in {gcArc, gcOrc, gcAtomicArc} and - ((g.config.isDefined("nimPreviewNonVarDestructor") and not isDiscriminant) or typ.kind in {tyRef, tyString, tySequence}): + ((g.config.isDefined("nimPreviewNonVarDestructor") and not isDiscriminant) or (typ.kind in {tyRef, tyString, tySequence} and not isDistinct)): dest.typ = typ else: dest.typ = makeVarType(typ.owner, typ, idgen) @@ -1135,19 +1157,19 @@ proc genTypeFieldCopy(c: var TLiftCtx; t: PType; body, x, y: PNode) = body.add newAsgnStmt(xx, yy) proc produceSym(g: ModuleGraph; c: PContext; typ: PType; kind: TTypeAttachedOp; - info: TLineInfo; idgen: IdGenerator): PSym = + info: TLineInfo; idgen: IdGenerator; isDistinct = false): PSym = if typ.kind == tyDistinct: return produceSymDistinctType(g, c, typ, kind, info, idgen) result = getAttachedOp(g, typ, kind) if result == nil: - result = symPrototype(g, typ, typ.owner, kind, info, idgen) + result = symPrototype(g, typ, typ.owner, kind, info, idgen, isDistinct = isDistinct) var a = TLiftCtx(info: info, g: g, kind: kind, c: c, asgnForType: typ, idgen: idgen, fn: result) let dest = if kind == attachedDup: result.ast[resultPos].sym else: result.typ.n[1].sym - let d = if result.typ[1].kind == tyVar: newDeref(newSymNode(dest)) else: newSymNode(dest) + let d = if result.typ.firstParamType.kind == tyVar: newDeref(newSymNode(dest)) else: newSymNode(dest) let src = case kind of {attachedDestructor, attachedWasMoved}: newNodeIT(nkSym, info, getSysType(g, info, tyPointer)) of attachedDup: newSymNode(result.typ.n[1].sym) @@ -1160,7 +1182,7 @@ proc produceSym(g: ModuleGraph; c: PContext; typ: PType; kind: TTypeAttachedOp; ## compiler can use a combination of `=destroy` and memCopy for sink op dest.flags.incl sfCursor let op = getAttachedOp(g, typ, attachedDestructor) - result.ast[bodyPos].add newOpCall(a, op, if op.typ[1].kind == tyVar: d[0] else: d) + result.ast[bodyPos].add newOpCall(a, op, if op.typ.firstParamType.kind == tyVar: d[0] else: d) result.ast[bodyPos].add newAsgnStmt(d, src) else: var tk: TTypeKind @@ -1179,7 +1201,12 @@ proc produceSym(g: ModuleGraph; c: PContext; typ: PType; kind: TTypeAttachedOp; # bug #19205: Do not forget to also copy the hidden type field: genTypeFieldCopy(a, typ, result.ast[bodyPos], d, src) - if not a.canRaise: incl result.flags, sfNeverRaises + if not a.canRaise: + incl result.flags, sfNeverRaises + result.ast[pragmasPos] = newNodeI(nkPragma, info) + result.ast[pragmasPos].add newTree(nkExprColonExpr, + newIdentNode(g.cache.getIdent("raises"), info), newNodeI(nkBracket, info)) + completePartialOp(g, idgen.module, typ, kind, result) @@ -1239,7 +1266,7 @@ proc inst(g: ModuleGraph; c: PContext; t: PType; kind: TTypeAttachedOp; idgen: I else: localError(g.config, info, "unresolved generic parameter") -proc isTrival(s: PSym): bool {.inline.} = +proc isTrival*(s: PSym): bool {.inline.} = s == nil or (s.ast != nil and s.ast[bodyPos].len == 0) proc createTypeBoundOps(g: ModuleGraph; c: PContext; orig: PType; info: TLineInfo; diff --git a/compiler/lineinfos.nim b/compiler/lineinfos.nim index d21825be7..94a483299 100644 --- a/compiler/lineinfos.nim +++ b/compiler/lineinfos.nim @@ -92,8 +92,10 @@ type warnStmtListLambda = "StmtListLambda", warnBareExcept = "BareExcept", warnImplicitDefaultValue = "ImplicitDefaultValue", + warnIgnoredSymbolInjection = "IgnoredSymbolInjection", warnStdPrefix = "StdPrefix" warnUser = "User", + warnGlobalVarConstructorTemporary = "GlobalVarConstructorTemporary", # hints hintSuccess = "Success", hintSuccessX = "SuccessX", hintCC = "CC", @@ -196,8 +198,10 @@ const warnStmtListLambda: "statement list expression assumed to be anonymous proc; this is deprecated, use `do (): ...` or `proc () = ...` instead", warnBareExcept: "$1", warnImplicitDefaultValue: "$1", + warnIgnoredSymbolInjection: "$1", warnStdPrefix: "$1 needs the 'std' prefix", warnUser: "$1", + warnGlobalVarConstructorTemporary: "global variable '$1' initialization requires a temporary variable", hintSuccess: "operation successful: $#", # keep in sync with `testament.isSuccess` hintSuccessX: "$build\n$loc lines; ${sec}s; $mem; proj: $project; out: $output", @@ -264,6 +268,7 @@ const NotesVerbosity* = computeNotesVerbosity() errXMustBeCompileTime* = "'$1' can only be used in compile-time context" errArgsNeedRunOption* = "arguments can only be given if the '--run' option is selected" + errFloatToString* = "cannot convert '$1' to '$2'" type TFileInfo* = object diff --git a/compiler/llstream.nim b/compiler/llstream.nim index fa223b373..cc8148483 100644 --- a/compiler/llstream.nim +++ b/compiler/llstream.nim @@ -68,6 +68,7 @@ when not declared(readLineFromStdin): # fallback implementation: proc readLineFromStdin(prompt: string, line: var string): bool = stdout.write(prompt) + stdout.flushFile() result = readLine(stdin, line) if not result: stdout.write("\n") diff --git a/compiler/lookups.nim b/compiler/lookups.nim index 1a60de7e5..d8fcf73e0 100644 --- a/compiler/lookups.nim +++ b/compiler/lookups.nim @@ -50,7 +50,7 @@ proc considerQuotedIdent*(c: PContext; n: PNode, origin: PNode = nil): PIdent = case x.kind of nkIdent: id.add(x.ident.s) of nkSym: id.add(x.sym.name.s) - of nkSymChoices: + of nkSymChoices, nkOpenSym: if x[0].kind == nkSym: id.add(x[0].sym.name.s) else: @@ -63,6 +63,8 @@ proc considerQuotedIdent*(c: PContext; n: PNode, origin: PNode = nil): PIdent = result = n[0].sym.name else: handleError(n, origin) + of nkOpenSym: + result = considerQuotedIdent(c, n[0], origin) else: handleError(n, origin) @@ -137,7 +139,7 @@ proc nextIdentIter(ti: var ModuleIter; marked: var IntSet; im: ImportedModule; return result iterator symbols(im: ImportedModule; marked: var IntSet; name: PIdent; g: ModuleGraph): PSym = - var ti: ModuleIter + var ti: ModuleIter = default(ModuleIter) var candidate = initIdentIter(ti, marked, im, name, g) while candidate != nil: yield candidate @@ -150,7 +152,7 @@ iterator importedItems*(c: PContext; name: PIdent): PSym = yield s proc allPureEnumFields(c: PContext; name: PIdent): seq[PSym] = - var ti: TIdentIter + var ti: TIdentIter = default(TIdentIter) result = @[] var res = initIdentIter(ti, c.pureEnumFields, name) while res != nil: @@ -222,7 +224,7 @@ proc debugScopes*(c: PContext; limit=0, max = int.high) {.deprecated.} = proc searchInScopesAllCandidatesFilterBy*(c: PContext, s: PIdent, filter: TSymKinds): seq[PSym] = result = @[] for scope in allScopes(c.currentScope): - var ti: TIdentIter + var ti: TIdentIter = default(TIdentIter) var candidate = initIdentIter(ti, scope.symbols, s) while candidate != nil: if candidate.kind in filter: @@ -240,7 +242,7 @@ proc searchInScopesFilterBy*(c: PContext, s: PIdent, filter: TSymKinds): seq[PSy result = @[] block outer: for scope in allScopes(c.currentScope): - var ti: TIdentIter + var ti: TIdentIter = default(TIdentIter) var candidate = initIdentIter(ti, scope.symbols, s) while candidate != nil: if candidate.kind in filter: @@ -256,11 +258,23 @@ proc searchInScopesFilterBy*(c: PContext, s: PIdent, filter: TSymKinds): seq[PSy if s.kind in filter: result.add s +proc cmpScopes*(ctx: PContext, s: PSym): int = + # Do not return a negative number + if s.originatingModule == ctx.module: + result = 2 + var owner = s + while true: + owner = owner.skipGenericOwner + if owner.kind == skModule: break + inc result + else: + result = 1 + proc isAmbiguous*(c: PContext, s: PIdent, filter: TSymKinds, sym: var PSym): bool = result = false block outer: for scope in allScopes(c.currentScope): - var ti: TIdentIter + var ti: TIdentIter = default(TIdentIter) var candidate = initIdentIter(ti, scope.symbols, s) var scopeHasCandidate = false while candidate != nil: @@ -291,8 +305,16 @@ proc isAmbiguous*(c: PContext, s: PIdent, filter: TSymKinds, sym: var PSym): boo # imports had a candidate but wasn't ambiguous return false -proc errorSym*(c: PContext, n: PNode): PSym = +proc errorSym*(c: PContext, ident: PIdent, info: TLineInfo): PSym = ## creates an error symbol to avoid cascading errors (for IDE support) + result = newSym(skError, ident, c.idgen, getCurrOwner(c), info, {}) + result.typ = errorType(c) + incl(result.flags, sfDiscardable) + # pretend it's from the top level scope to prevent cascading errors: + if c.config.cmd != cmdInteractive and c.compilesContextId == 0: + c.moduleScope.addSym(result) + +proc errorSym*(c: PContext, n: PNode): PSym = var m = n # ensure that 'considerQuotedIdent' can't fail: if m.kind == nkDotExpr: m = m[1] @@ -300,12 +322,7 @@ proc errorSym*(c: PContext, n: PNode): PSym = considerQuotedIdent(c, m) else: getIdent(c.cache, "err:" & renderTree(m)) - result = newSym(skError, ident, c.idgen, getCurrOwner(c), n.info, {}) - result.typ = errorType(c) - incl(result.flags, sfDiscardable) - # pretend it's from the top level scope to prevent cascading errors: - if c.config.cmd != cmdInteractive and c.compilesContextId == 0: - c.moduleScope.addSym(result) + result = errorSym(c, ident, n.info) type TOverloadIterMode* = enum @@ -332,7 +349,7 @@ proc getSymRepr*(conf: ConfigRef; s: PSym, getDeclarationPath = true): string = proc ensureNoMissingOrUnusedSymbols(c: PContext; scope: PScope) = # check if all symbols have been used and defined: - var it: TTabIter + var it: TTabIter = default(TTabIter) var s = initTabIter(it, scope.symbols) var missingImpls = 0 var unusedSyms: seq[tuple[sym: PSym, key: string]] = @[] @@ -487,7 +504,7 @@ proc mustFixSpelling(c: PContext): bool {.inline.} = result = c.config.spellSuggestMax != 0 and c.compilesContextId == 0 # don't slowdown inside compiles() -proc fixSpelling(c: PContext, n: PNode, ident: PIdent, result: var string) = +proc fixSpelling(c: PContext, ident: PIdent, result: var string) = ## when we cannot find the identifier, suggest nearby spellings var list = initHeapQueue[SpellCandidate]() let name0 = ident.s.nimIdentNormalize @@ -543,33 +560,47 @@ proc errorUseQualifier(c: PContext; info: TLineInfo; s: PSym; amb: var bool): PS amb = false proc errorUseQualifier*(c: PContext; info: TLineInfo; s: PSym) = - var amb: bool + var amb: bool = false discard errorUseQualifier(c, info, s, amb) -proc errorUseQualifier(c: PContext; info: TLineInfo; candidates: seq[PSym]; prefix = "use one of") = - var err = "ambiguous identifier: '" & candidates[0].name.s & "'" +proc ambiguousIdentifierMsg*(candidates: seq[PSym], prefix = "use one of", indent = 0): string = + result = "" + for i in 0 ..< indent: + result.add(' ') + result.add "ambiguous identifier: '" & candidates[0].name.s & "'" var i = 0 for candidate in candidates: - if i == 0: err.add " -- $1 the following:\n" % prefix - else: err.add "\n" - err.add " " & candidate.owner.name.s & "." & candidate.name.s - err.add ": " & typeToString(candidate.typ) + if i == 0: result.add " -- $1 the following:\n" % prefix + else: result.add "\n" + for i in 0 ..< indent: + result.add(' ') + result.add " " & candidate.owner.name.s & "." & candidate.name.s + result.add ": " & typeToString(candidate.typ) inc i - localError(c.config, info, errGenerated, err) -proc errorUseQualifier*(c: PContext; info:TLineInfo; choices: PNode) = +proc errorUseQualifier*(c: PContext; info: TLineInfo; candidates: seq[PSym]) = + localError(c.config, info, errGenerated, ambiguousIdentifierMsg(candidates)) + +proc ambiguousIdentifierMsg*(choices: PNode, indent = 0): string = var candidates = newSeq[PSym](choices.len) let prefix = if choices[0].typ.kind != tyProc: "use one of" else: "you need a helper proc to disambiguate" for i, n in choices: candidates[i] = n.sym - errorUseQualifier(c, info, candidates, prefix) + result = ambiguousIdentifierMsg(candidates, prefix, indent) + +proc errorUseQualifier*(c: PContext; info:TLineInfo; choices: PNode) = + localError(c.config, info, errGenerated, ambiguousIdentifierMsg(choices)) proc errorUndeclaredIdentifier*(c: PContext; info: TLineInfo; name: string, extra = "") = var err: string if name == "_": err = "the special identifier '_' is ignored in declarations and cannot be used" else: - err = "undeclared identifier: '" & name & "'" & extra + err = "undeclared identifier: '" & name & "'" + if "`gensym" in name: + err.add "; if declared in a template, this identifier may be inconsistently marked inject or gensym" + if extra.len != 0: + err.add extra if c.recursiveDep.len > 0: err.add "\nThis might be caused by a recursive module dependency:\n" err.add c.recursiveDep @@ -577,11 +608,11 @@ proc errorUndeclaredIdentifier*(c: PContext; info: TLineInfo; name: string, extr c.recursiveDep = "" localError(c.config, info, errGenerated, err) -proc errorUndeclaredIdentifierHint*(c: PContext; n: PNode, ident: PIdent): PSym = +proc errorUndeclaredIdentifierHint*(c: PContext; ident: PIdent; info: TLineInfo): PSym = var extra = "" - if c.mustFixSpelling: fixSpelling(c, n, ident, extra) - errorUndeclaredIdentifier(c, n.info, ident.s, extra) - result = errorSym(c, n) + if c.mustFixSpelling: fixSpelling(c, ident, extra) + errorUndeclaredIdentifier(c, info, ident.s, extra) + result = errorSym(c, ident, info) proc lookUp*(c: PContext, n: PNode): PSym = # Looks up a symbol. Generates an error in case of nil. @@ -589,13 +620,13 @@ proc lookUp*(c: PContext, n: PNode): PSym = case n.kind of nkIdent: result = searchInScopes(c, n.ident, amb) - if result == nil: result = errorUndeclaredIdentifierHint(c, n, n.ident) + if result == nil: result = errorUndeclaredIdentifierHint(c, n.ident, n.info) of nkSym: result = n.sym of nkAccQuoted: var ident = considerQuotedIdent(c, n) result = searchInScopes(c, ident, amb) - if result == nil: result = errorUndeclaredIdentifierHint(c, n, ident) + if result == nil: result = errorUndeclaredIdentifierHint(c, ident, n.info) else: internalError(c.config, n.info, "lookUp") return nil @@ -609,16 +640,30 @@ type TLookupFlag* = enum checkAmbiguity, checkUndeclared, checkModule, checkPureEnumFields +const allExceptModule = {low(TSymKind)..high(TSymKind)} - {skModule, skPackage} + +proc lookUpCandidates*(c: PContext, ident: PIdent, filter: set[TSymKind], + includePureEnum = false): seq[PSym] = + result = searchInScopesFilterBy(c, ident, filter) + if skEnumField in filter and (result.len == 0 or includePureEnum): + result.add allPureEnumFields(c, ident) + proc qualifiedLookUp*(c: PContext, n: PNode, flags: set[TLookupFlag]): PSym = - const allExceptModule = {low(TSymKind)..high(TSymKind)} - {skModule, skPackage} case n.kind of nkIdent, nkAccQuoted: var amb = false var ident = considerQuotedIdent(c, n) if checkModule in flags: result = searchInScopes(c, ident, amb) + if result == nil: + let candidates = allPureEnumFields(c, ident) + if candidates.len > 0: + result = candidates[0] + amb = candidates.len > 1 + if amb and checkAmbiguity in flags: + errorUseQualifier(c, n.info, candidates) else: - let candidates = searchInScopesFilterBy(c, ident, allExceptModule) + let candidates = lookUpCandidates(c, ident, allExceptModule) if candidates.len > 0: result = candidates[0] amb = candidates.len > 1 @@ -626,46 +671,47 @@ proc qualifiedLookUp*(c: PContext, n: PNode, flags: set[TLookupFlag]): PSym = errorUseQualifier(c, n.info, candidates) else: result = nil - if result == nil: - let candidates = allPureEnumFields(c, ident) - if candidates.len > 0: - result = candidates[0] - amb = candidates.len > 1 - if amb and checkAmbiguity in flags: - errorUseQualifier(c, n.info, candidates) - if result == nil and checkUndeclared in flags: - result = errorUndeclaredIdentifierHint(c, n, ident) + result = errorUndeclaredIdentifierHint(c, ident, n.info) elif checkAmbiguity in flags and result != nil and amb: result = errorUseQualifier(c, n.info, result, amb) c.isAmbiguous = amb of nkSym: result = n.sym + of nkOpenSym: + result = qualifiedLookUp(c, n[0], flags) of nkDotExpr: result = nil var m = qualifiedLookUp(c, n[0], (flags * {checkUndeclared}) + {checkModule}) if m != nil and m.kind == skModule: var ident: PIdent = nil - if n[1].kind == nkIdent: - ident = n[1].ident - elif n[1].kind == nkAccQuoted: + if n[1].kind == nkAccQuoted: ident = considerQuotedIdent(c, n[1]) + else: + # this includes sym and symchoice nodes, but since we are looking in + # a module, it shouldn't matter what was captured + ident = n[1].getPIdent if ident != nil: if m == c.module: - result = strTableGet(c.topLevelScope.symbols, ident) + var ti: TIdentIter = default(TIdentIter) + result = initIdentIter(ti, c.topLevelScope.symbols, ident) + if result != nil and nextIdentIter(ti, c.topLevelScope.symbols) != nil: + # another symbol exists with same name + c.isAmbiguous = true else: + var amb: bool = false if c.importModuleLookup.getOrDefault(m.name.id).len > 1: - var amb: bool result = errorUseQualifier(c, n.info, m, amb) else: - result = someSym(c.graph, m, ident) + result = someSymAmb(c.graph, m, ident, amb) + if amb: c.isAmbiguous = true if result == nil and checkUndeclared in flags: - result = errorUndeclaredIdentifierHint(c, n[1], ident) + result = errorUndeclaredIdentifierHint(c, ident, n[1].info) elif n[1].kind == nkSym: result = n[1].sym if result.owner != nil and result.owner != m and checkUndeclared in flags: # dotExpr in templates can end up here - result = errorUndeclaredIdentifierHint(c, n[1], considerQuotedIdent(c, n[1])) + result = errorUndeclaredIdentifierHint(c, result.name, n[1].info) elif checkUndeclared in flags and n[1].kind notin {nkOpenSymChoice, nkClosedSymChoice}: localError(c.config, n[1].info, "identifier expected, but got: " & @@ -677,6 +723,10 @@ proc qualifiedLookUp*(c: PContext, n: PNode, flags: set[TLookupFlag]): PSym = if result != nil and result.kind == skStub: loadStub(result) proc initOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = + if n.kind == nkOpenSym: + # maybe the logic in semexprs should be mirrored here instead + # for now it only seems this is called for `pickSym` in `getTypeIdent` + return initOverloadIter(o, c, n[0]) o.importIdx = -1 o.marked = initIntSet() case n.kind diff --git a/compiler/lowerings.nim b/compiler/lowerings.nim index f8ae67f41..2c9c4cb32 100644 --- a/compiler/lowerings.nim +++ b/compiler/lowerings.nim @@ -19,7 +19,7 @@ when defined(nimPreviewSlimSystem): import std/assertions proc newDeref*(n: PNode): PNode {.inline.} = - result = newNodeIT(nkHiddenDeref, n.info, n.typ[0]) + result = newNodeIT(nkHiddenDeref, n.info, n.typ.elementType) result.add n proc newTupleAccess*(g: ModuleGraph; tup: PNode, i: int): PNode = @@ -255,14 +255,14 @@ proc newDotExpr*(obj, b: PSym): PNode = proc indirectAccess*(a: PNode, b: ItemId, info: TLineInfo): PNode = # returns a[].b as a node var deref = newNodeI(nkHiddenDeref, info) - deref.typ = a.typ.skipTypes(abstractInst)[0] + deref.typ = a.typ.skipTypes(abstractInst).elementType var t = deref.typ.skipTypes(abstractInst) var field: PSym while true: assert t.kind == tyObject field = lookupInRecord(t.n, b) if field != nil: break - t = t[0] + t = t.baseClass if t == nil: break t = t.skipTypes(skipPtrs) #if field == nil: @@ -278,7 +278,7 @@ proc indirectAccess*(a: PNode, b: ItemId, info: TLineInfo): PNode = proc indirectAccess*(a: PNode, b: string, info: TLineInfo; cache: IdentCache): PNode = # returns a[].b as a node var deref = newNodeI(nkHiddenDeref, info) - deref.typ = a.typ.skipTypes(abstractInst)[0] + deref.typ = a.typ.skipTypes(abstractInst).elementType var t = deref.typ.skipTypes(abstractInst) var field: PSym let bb = getIdent(cache, b) @@ -286,7 +286,7 @@ proc indirectAccess*(a: PNode, b: string, info: TLineInfo; cache: IdentCache): P assert t.kind == tyObject field = getSymFromList(t.n, bb) if field != nil: break - t = t[0] + t = t.baseClass if t == nil: break t = t.skipTypes(skipPtrs) #if field == nil: @@ -306,7 +306,7 @@ proc getFieldFromObj*(t: PType; v: PSym): PSym = assert t.kind == tyObject result = lookupInRecord(t.n, v.itemId) if result != nil: break - t = t[0] + t = t.baseClass if t == nil: break t = t.skipTypes(skipPtrs) @@ -325,7 +325,7 @@ proc genAddrOf*(n: PNode; idgen: IdGenerator; typeKind = tyPtr): PNode = proc genDeref*(n: PNode; k = nkHiddenDeref): PNode = result = newNodeIT(k, n.info, - n.typ.skipTypes(abstractInst)[0]) + n.typ.skipTypes(abstractInst).elementType) result.add n proc callCodegenProc*(g: ModuleGraph; name: string; @@ -344,7 +344,7 @@ proc callCodegenProc*(g: ModuleGraph; name: string; if optionalArgs != nil: for i in 1..<optionalArgs.len-2: result.add optionalArgs[i] - result.typ = sym.typ[0] + result.typ = sym.typ.returnType proc newIntLit*(g: ModuleGraph; info: TLineInfo; value: BiggestInt): PNode = result = nkIntLit.newIntNode(value) diff --git a/compiler/magicsys.nim b/compiler/magicsys.nim index b365a3a19..1ec6b9a69 100644 --- a/compiler/magicsys.nim +++ b/compiler/magicsys.nim @@ -35,7 +35,7 @@ proc getSysMagic*(g: ModuleGraph; info: TLineInfo; name: string, m: TMagic): PSy for r in systemModuleSyms(g, id): if r.magic == m: # prefer the tyInt variant: - if r.typ[0] != nil and r.typ[0].kind == tyInt: return r + if r.typ.returnType != nil and r.typ.returnType.kind == tyInt: return r result = r if result != nil: return result localError(g.config, info, "system module needs: " & name) diff --git a/compiler/main.nim b/compiler/main.nim index 742530c07..4c52317cf 100644 --- a/compiler/main.nim +++ b/compiler/main.nim @@ -22,8 +22,6 @@ import modules, modulegraphs, lineinfos, pathutils, vmprofiler -# ensure NIR compiles: -import nir / nir when defined(nimPreviewSlimSystem): import std/[syncio, assertions] @@ -48,9 +46,6 @@ proc writeDepsFile(g: ModuleGraph) = f.writeLine(toFullPath(g.config, k)) f.close() -proc writeNinjaFile(g: ModuleGraph) = - discard "to implement" - proc writeCMakeDepsFile(conf: ConfigRef) = ## write a list of C files for build systems like CMake. ## only updated when the C file list changes. @@ -155,32 +150,12 @@ proc commandCompileToC(graph: ModuleGraph) = extccomp.callCCompiler(conf) # for now we do not support writing out a .json file with the build instructions when HCR is on if not conf.hcrOn: - extccomp.writeJsonBuildInstructions(conf) + extccomp.writeJsonBuildInstructions(conf, graph.cachedFiles) if optGenScript in graph.config.globalOptions: writeDepsFile(graph) if optGenCDeps in graph.config.globalOptions: writeCMakeDepsFile(conf) -proc commandCompileToNir(graph: ModuleGraph) = - let conf = graph.config - extccomp.initVars(conf) - if conf.symbolFiles == disabledSf: - if {optRun, optForceFullMake} * conf.globalOptions == {optRun}: - if not changeDetectedViaJsonBuildInstructions(conf, conf.jsonBuildInstructionsFile): - # nothing changed - graph.config.notes = graph.config.mainPackageNotes - return - - if not extccomp.ccHasSaneOverflow(conf): - conf.symbols.defineSymbol("nimEmulateOverflowChecks") - - if conf.symbolFiles == disabledSf: - setPipeLinePass(graph, NirPass) - else: - setPipeLinePass(graph, SemPass) - compilePipelineProject(graph) - writeNinjaFile(graph) - proc commandJsonScript(graph: ModuleGraph) = extccomp.runJsonBuildInstructions(graph.config, graph.config.jsonBuildInstructionsFile) @@ -197,16 +172,13 @@ proc commandCompileToJS(graph: ModuleGraph) = if optGenScript in conf.globalOptions: writeDepsFile(graph) -proc commandInteractive(graph: ModuleGraph; useNir: bool) = +proc commandInteractive(graph: ModuleGraph) = graph.config.setErrorMaxHighMaybe initDefines(graph.config.symbols) - if useNir: - defineSymbol(graph.config.symbols, "noSignalHandler") - else: - defineSymbol(graph.config.symbols, "nimscript") + defineSymbol(graph.config.symbols, "nimscript") # note: seems redundant with -d:nimHasLibFFI when hasFFI: defineSymbol(graph.config.symbols, "nimffi") - setPipeLinePass(graph, if useNir: NirReplPass else: InterpreterPass) + setPipeLinePass(graph, InterpreterPass) compilePipelineSystemModule(graph) if graph.config.commandArgs.len > 0: discard graph.compilePipelineModule(fileInfoIdx(graph.config, graph.config.projectFull), {}) @@ -222,7 +194,7 @@ proc commandScan(cache: IdentCache, config: ConfigRef) = var stream = llStreamOpen(f, fmRead) if stream != nil: var - L: Lexer + L: Lexer = default(Lexer) tok: Token = default(Token) openLexer(L, f, stream, cache, config) while true: @@ -293,8 +265,6 @@ proc mainCommand*(graph: ModuleGraph) = # and it has added this define implictly, so we must undo that here. # A better solution might be to fix system.nim undefSymbol(conf.symbols, "useNimRtl") - of backendNir: - if conf.exc == excNone: conf.exc = excGoto of backendInvalid: raiseAssert "unreachable" proc compileToBackend() = @@ -305,7 +275,6 @@ proc mainCommand*(graph: ModuleGraph) = of backendCpp: commandCompileToC(graph) of backendObjc: commandCompileToC(graph) of backendJs: commandCompileToJS(graph) - of backendNir: commandCompileToNir(graph) of backendInvalid: raiseAssert "unreachable" template docLikeCmd(body) = @@ -326,7 +295,8 @@ proc mainCommand*(graph: ModuleGraph) = # so by default should not end up in $PWD nor in $projectPath. var ret = if optUseNimcache in conf.globalOptions: getNimcacheDir(conf) else: conf.projectPath - doAssert ret.string.isAbsolute # `AbsoluteDir` is not a real guarantee + if not ret.string.isAbsolute: # `AbsoluteDir` is not a real guarantee + rawMessage(conf, errCannotOpenFile, ret.string & "/") if conf.cmd in cmdDocLike + {cmdRst2html, cmdRst2tex, cmdMd2html, cmdMd2tex}: ret = ret / htmldocsDir conf.outDir = ret @@ -443,7 +413,7 @@ proc mainCommand*(graph: ModuleGraph) = wantMainModule(conf) commandView(graph) #msgWriteln(conf, "Beware: Indentation tokens depend on the parser's state!") - of cmdInteractive: commandInteractive(graph, isDefined(conf, "nir")) + of cmdInteractive: commandInteractive(graph) of cmdNimscript: if conf.projectIsCmd or conf.projectIsStdin: discard elif not fileExists(conf.projectFull): diff --git a/compiler/mangleutils.nim b/compiler/mangleutils.nim new file mode 100644 index 000000000..2ae954518 --- /dev/null +++ b/compiler/mangleutils.nim @@ -0,0 +1,59 @@ +import std/strutils +import ast, modulegraphs + +proc mangle*(name: string): string = + result = newStringOfCap(name.len) + var start = 0 + if name[0] in Digits: + result.add("X" & name[0]) + start = 1 + var requiresUnderscore = false + template special(x) = + result.add x + requiresUnderscore = true + for i in start..<name.len: + let c = name[i] + case c + of 'a'..'z', '0'..'9', 'A'..'Z': + result.add(c) + of '_': + # we generate names like 'foo_9' for scope disambiguations and so + # disallow this here: + if i > 0 and i < name.len-1 and name[i+1] in Digits: + discard + else: + result.add(c) + of '$': special "dollar" + of '%': special "percent" + of '&': special "amp" + of '^': special "roof" + of '!': special "emark" + of '?': special "qmark" + of '*': special "star" + of '+': special "plus" + of '-': special "minus" + of '/': special "slash" + of '\\': special "backslash" + of '=': special "eq" + of '<': special "lt" + of '>': special "gt" + of '~': special "tilde" + of ':': special "colon" + of '.': special "dot" + of '@': special "at" + of '|': special "bar" + else: + result.add("X" & toHex(ord(c), 2)) + requiresUnderscore = true + if requiresUnderscore: + result.add "_" + +proc mangleParamExt*(s: PSym): string = + result = "_p" + result.addInt s.position + +proc mangleProcNameExt*(graph: ModuleGraph, s: PSym): string = + result = "__" + result.add graph.ifaces[s.itemId.module].uniqueName + result.add "_u" + result.addInt s.itemId.item # s.disamb # diff --git a/compiler/modulegraphs.nim b/compiler/modulegraphs.nim index 95fa193dc..77762d23a 100644 --- a/compiler/modulegraphs.nim +++ b/compiler/modulegraphs.nim @@ -11,9 +11,9 @@ ## represents a complete Nim project. Single modules can either be kept in RAM ## or stored in a rod-file. -import std/[intsets, tables, hashes] +import std/[intsets, tables, hashes, strtabs, algorithm, os, strutils, parseutils] import ../dist/checksums/src/checksums/md5 -import ast, astalgo, options, lineinfos,idents, btrees, ropes, msgs, pathutils, packages +import ast, astalgo, options, lineinfos,idents, btrees, ropes, msgs, pathutils, packages, suggestsymdb import ic / [packed_ast, ic] @@ -55,11 +55,6 @@ type concreteTypes*: seq[FullId] inst*: PInstantiation - SymInfoPair* = object - sym*: PSym - info*: TLineInfo - isDecl*: bool - PipelinePass* = enum NonePass SemPass @@ -67,8 +62,6 @@ type CgenPass EvalPass InterpreterPass - NirPass - NirReplPass GenDependPass Docgen2TexPass Docgen2JsonPass @@ -108,7 +101,7 @@ type doStopCompile*: proc(): bool {.closure.} usageSym*: PSym # for nimsuggest owners*: seq[PSym] - suggestSymbols*: Table[FileIndex, seq[SymInfoPair]] + suggestSymbols*: SuggestSymbolDatabase suggestErrors*: Table[FileIndex, seq[Suggest]] methods*: seq[tuple[methods: seq[PSym], dispatcher: PSym]] # needs serialization! bucketTable*: CountTable[ItemId] @@ -140,6 +133,8 @@ type idgen*: IdGenerator operators*: Operators + cachedFiles*: StringTableRef + TPassContext* = object of RootObj # the pass's context idgen*: IdGenerator PPassContext* = ref TPassContext @@ -262,7 +257,7 @@ proc nextModuleIter*(mi: var ModuleIter; g: ModuleGraph): PSym = iterator allSyms*(g: ModuleGraph; m: PSym): PSym = let importHidden = optImportHidden in m.options if isCachedModule(g, m): - var rodIt: RodIter + var rodIt: RodIter = default(RodIter) var r = initRodIterAllSyms(rodIt, g.config, g.cache, g.packed, FileIndex m.position, importHidden) while r != nil: yield r @@ -279,11 +274,30 @@ proc someSym*(g: ModuleGraph; m: PSym; name: PIdent): PSym = else: result = strTableGet(g.ifaces[m.position].interfSelect(importHidden), name) +proc someSymAmb*(g: ModuleGraph; m: PSym; name: PIdent; amb: var bool): PSym = + let importHidden = optImportHidden in m.options + if isCachedModule(g, m): + result = nil + for s in interfaceSymbols(g.config, g.cache, g.packed, FileIndex(m.position), name, importHidden): + if result == nil: + # set result to the first symbol + result = s + else: + # another symbol found + amb = true + break + else: + var ti: TIdentIter = default(TIdentIter) + result = initIdentIter(ti, g.ifaces[m.position].interfSelect(importHidden), name) + if result != nil and nextIdentIter(ti, g.ifaces[m.position].interfSelect(importHidden)) != nil: + # another symbol exists with same name + amb = true + proc systemModuleSym*(g: ModuleGraph; name: PIdent): PSym = result = someSym(g, g.systemModule, name) iterator systemModuleSyms*(g: ModuleGraph; name: PIdent): PSym = - var mi: ModuleIter + var mi: ModuleIter = default(ModuleIter) var r = initModuleIter(mi, g, g.systemModule, name) while r != nil: yield r @@ -314,7 +328,7 @@ proc resolveInst(g: ModuleGraph; t: var LazyInstantiation): PInstantiation = t.inst = result assert result != nil -proc resolveAttachedOp(g: ModuleGraph; t: var LazySym): PSym = +proc resolveAttachedOp*(g: ModuleGraph; t: var LazySym): PSym = result = t.sym if result == nil: result = loadSymFromId(g.config, g.cache, g.packed, t.id.module, t.id.packed) @@ -457,6 +471,49 @@ proc createMagic*(g: ModuleGraph; idgen: IdGenerator; name: string, m: TMagic): proc createMagic(g: ModuleGraph; name: string, m: TMagic): PSym = result = createMagic(g, g.idgen, name, m) +proc uniqueModuleName*(conf: ConfigRef; m: PSym): string = + ## The unique module name is guaranteed to only contain {'A'..'Z', 'a'..'z', '0'..'9', '_'} + ## so that it is useful as a C identifier snippet. + let fid = FileIndex(m.position) + let path = AbsoluteFile toFullPath(conf, fid) + var isLib = false + var rel = "" + if path.string.startsWith(conf.libpath.string): + isLib = true + rel = relativeTo(path, conf.libpath).string + else: + rel = relativeTo(path, conf.projectPath).string + + if not isLib and not belongsToProjectPackage(conf, m): + # special handlings for nimble packages + when DirSep == '\\': + let rel2 = replace(rel, '\\', '/') + else: + let rel2 = rel + const pkgs2 = "pkgs2/" + var start = rel2.find(pkgs2) + if start >= 0: + start += pkgs2.len + start += skipUntil(rel2, {'/'}, start) + if start+1 < rel2.len: + rel = "pkg/" & rel2[start+1..<rel.len] # strips paths + + let trunc = if rel.endsWith(".nim"): rel.len - len(".nim") else: rel.len + result = newStringOfCap(trunc) + for i in 0..<trunc: + let c = rel[i] + case c + of 'a'..'z', '0'..'9': + result.add c + of {os.DirSep, os.AltSep}: + result.add 'Z' # because it looks a bit like '/' + of '.': + result.add 'O' # a circle + else: + # We mangle upper letters too so that there cannot + # be clashes with our special meanings of 'Z' and 'O' + result.addInt ord(c) + proc registerModule*(g: ModuleGraph; m: PSym) = assert m != nil assert m.kind == skModule @@ -468,7 +525,7 @@ proc registerModule*(g: ModuleGraph; m: PSym) = setLen(g.packed.pm, m.position + 1) g.ifaces[m.position] = Iface(module: m, converters: @[], patterns: @[], - uniqueName: rope(uniqueModuleName(g.config, FileIndex(m.position)))) + uniqueName: rope(uniqueModuleName(g.config, m))) initStrTables(g, m) proc registerModuleById*(g: ModuleGraph; m: FileIndex) = @@ -477,19 +534,21 @@ proc registerModuleById*(g: ModuleGraph; m: FileIndex) = proc initOperators*(g: ModuleGraph): Operators = # These are safe for IC. # Public because it's used by DrNim. - result.opLe = createMagic(g, "<=", mLeI) - result.opLt = createMagic(g, "<", mLtI) - result.opAnd = createMagic(g, "and", mAnd) - result.opOr = createMagic(g, "or", mOr) - result.opIsNil = createMagic(g, "isnil", mIsNil) - result.opEq = createMagic(g, "==", mEqI) - result.opAdd = createMagic(g, "+", mAddI) - result.opSub = createMagic(g, "-", mSubI) - result.opMul = createMagic(g, "*", mMulI) - result.opDiv = createMagic(g, "div", mDivI) - result.opLen = createMagic(g, "len", mLengthSeq) - result.opNot = createMagic(g, "not", mNot) - result.opContains = createMagic(g, "contains", mInSet) + result = Operators( + opLe: createMagic(g, "<=", mLeI), + opLt: createMagic(g, "<", mLtI), + opAnd: createMagic(g, "and", mAnd), + opOr: createMagic(g, "or", mOr), + opIsNil: createMagic(g, "isnil", mIsNil), + opEq: createMagic(g, "==", mEqI), + opAdd: createMagic(g, "+", mAddI), + opSub: createMagic(g, "-", mSubI), + opMul: createMagic(g, "*", mMulI), + opDiv: createMagic(g, "div", mDivI), + opLen: createMagic(g, "len", mLengthSeq), + opNot: createMagic(g, "not", mNot), + opContains: createMagic(g, "contains", mInSet) + ) proc initModuleGraphFields(result: ModuleGraph) = # A module ID of -1 means that the symbol is not attached to a module at all, @@ -502,7 +561,7 @@ proc initModuleGraphFields(result: ModuleGraph) = result.importStack = @[] result.inclToMod = initTable[FileIndex, FileIndex]() result.owners = @[] - result.suggestSymbols = initTable[FileIndex, seq[SymInfoPair]]() + result.suggestSymbols = initTable[FileIndex, SuggestFileSymbolDatabase]() result.suggestErrors = initTable[FileIndex, seq[Suggest]]() result.methods = @[] result.compilerprocs = initStrTable() @@ -516,6 +575,7 @@ proc initModuleGraphFields(result: ModuleGraph) = result.symBodyHashes = initTable[int, SigHash]() result.operators = initOperators(result) result.emittedTypeInfo = initTable[string, FileIndex]() + result.cachedFiles = newStringTable() proc newModuleGraph*(cache: IdentCache; config: ConfigRef): ModuleGraph = result = ModuleGraph() @@ -617,7 +677,6 @@ proc markDirty*(g: ModuleGraph; fileIdx: FileIndex) = if m != nil: g.suggestSymbols.del(fileIdx) g.suggestErrors.del(fileIdx) - g.resetForBackend incl m.flags, sfDirty proc unmarkAllDirty*(g: ModuleGraph) = @@ -680,8 +739,6 @@ proc moduleFromRodFile*(g: ModuleGraph; fileIdx: FileIndex; proc configComplete*(g: ModuleGraph) = rememberStartupConfig(g.startupPackedConfig, g.config) -from std/strutils import repeat, `%` - proc onProcessing*(graph: ModuleGraph, fileIdx: FileIndex, moduleStatus: string, fromModule: PSym, ) = let conf = graph.config let isNimscript = conf.isDefined("nimscript") @@ -707,16 +764,14 @@ func belongsToStdlib*(graph: ModuleGraph, sym: PSym): bool = ## Check if symbol belongs to the 'stdlib' package. sym.getPackageSymbol.getPackageId == graph.systemModule.getPackageId -proc `==`*(a, b: SymInfoPair): bool = - result = a.sym == b.sym and a.info.exactEquals(b.info) - -proc fileSymbols*(graph: ModuleGraph, fileIdx: FileIndex): seq[SymInfoPair] = - result = graph.suggestSymbols.getOrDefault(fileIdx, @[]) +proc fileSymbols*(graph: ModuleGraph, fileIdx: FileIndex): SuggestFileSymbolDatabase = + result = graph.suggestSymbols.getOrDefault(fileIdx, newSuggestFileSymbolDatabase(fileIdx, optIdeExceptionInlayHints in graph.config.globalOptions)) + doAssert(result.fileIndex == fileIdx) iterator suggestSymbolsIter*(g: ModuleGraph): SymInfoPair = for xs in g.suggestSymbols.values: - for x in xs: - yield x + for i in xs.lineInfo.low..xs.lineInfo.high: + yield xs.getSymInfoPair(i) iterator suggestErrorsIter*(g: ModuleGraph): Suggest = for xs in g.suggestErrors.values: diff --git a/compiler/modulepaths.nim b/compiler/modulepaths.nim index c29ed6793..c9e6060e5 100644 --- a/compiler/modulepaths.nim +++ b/compiler/modulepaths.nim @@ -38,11 +38,18 @@ proc getModuleName*(conf: ConfigRef; n: PNode): string = localError(n.info, "only '/' supported with $package notation") result = "" else: - let modname = getModuleName(conf, n[2]) - # hacky way to implement 'x / y /../ z': - result = getModuleName(conf, n1) - result.add renderTree(n0, {renderNoComments}).replace(" ") - result.add modname + if n0.kind in nkIdentKinds: + let ident = n0.getPIdent + if ident != nil and ident.s[0] == '/': + let modname = getModuleName(conf, n[2]) + # hacky way to implement 'x / y /../ z': + result = getModuleName(conf, n1) + result.add renderTree(n0, {renderNoComments}).replace(" ") + result.add modname + else: + result = "" + else: + result = "" of nkPrefix: when false: if n[0].kind == nkIdent and n[0].ident.s == "$": diff --git a/compiler/modules.nim b/compiler/modules.nim index 0aa1c8930..6e2af8bcc 100644 --- a/compiler/modules.nim +++ b/compiler/modules.nim @@ -14,6 +14,9 @@ import idents, lexer, syntaxes, modulegraphs, lineinfos, pathutils +import ../dist/checksums/src/checksums/sha1 +import std/strtabs + proc resetSystemArtifacts*(g: ModuleGraph) = magicsys.resetSysTypes(g) @@ -42,6 +45,8 @@ proc includeModule*(graph: ModuleGraph; s: PSym, fileIdx: FileIndex): PNode = result = syntaxes.parseFile(fileIdx, graph.cache, graph.config) graph.addDep(s, fileIdx) graph.addIncludeDep(s.position.FileIndex, fileIdx) + let path = toFullPath(graph.config, fileIdx) + graph.cachedFiles[path] = $secureHashFile(path) proc wantMainModule*(conf: ConfigRef) = if conf.projectFull.isEmpty: diff --git a/compiler/msgs.nim b/compiler/msgs.nim index 5c30acff3..c49ca8c9b 100644 --- a/compiler/msgs.nim +++ b/compiler/msgs.nim @@ -61,14 +61,12 @@ proc makeCString*(s: string): Rope = result.add('\"') proc newFileInfo(fullPath: AbsoluteFile, projPath: RelativeFile): TFileInfo = - result.fullPath = fullPath - #shallow(result.fullPath) - result.projPath = projPath - #shallow(result.projPath) - result.shortName = fullPath.extractFilename + result = TFileInfo(fullPath: fullPath, projPath: projPath, + shortName: fullPath.extractFilename, + quotedFullName: fullPath.string.makeCString, + lines: @[] + ) result.quotedName = result.shortName.makeCString - result.quotedFullName = fullPath.string.makeCString - result.lines = @[] when defined(nimpretty): if not result.fullPath.isEmpty: try: @@ -125,18 +123,18 @@ proc fileInfoIdx*(conf: ConfigRef; filename: AbsoluteFile; isKnownFile: var bool conf.m.filenameToIndexTbl[canon2] = result proc fileInfoIdx*(conf: ConfigRef; filename: AbsoluteFile): FileIndex = - var dummy: bool + var dummy: bool = false result = fileInfoIdx(conf, filename, dummy) proc fileInfoIdx*(conf: ConfigRef; filename: RelativeFile; isKnownFile: var bool): FileIndex = fileInfoIdx(conf, AbsoluteFile expandFilename(filename.string), isKnownFile) proc fileInfoIdx*(conf: ConfigRef; filename: RelativeFile): FileIndex = - var dummy: bool + var dummy: bool = false fileInfoIdx(conf, AbsoluteFile expandFilename(filename.string), dummy) proc newLineInfo*(fileInfoIdx: FileIndex, line, col: int): TLineInfo = - result.fileIndex = fileInfoIdx + result = TLineInfo(fileIndex: fileInfoIdx) if line < int high(uint16): result.line = uint16(line) else: @@ -431,7 +429,8 @@ To create a stacktrace, rerun compilation with './koch temp $1 <file>', see $2 f proc handleError(conf: ConfigRef; msg: TMsgKind, eh: TErrorHandling, s: string, ignoreMsg: bool) = if msg in fatalMsgs: if conf.cmd == cmdIdeTools: log(s) - quit(conf, msg) + if conf.cmd != cmdIdeTools or msg != errFatal: + quit(conf, msg) if msg >= errMin and msg <= errMax or (msg in warnMin..hintMax and msg in conf.warningAsErrors and not ignoreMsg): inc(conf.errorCounter) @@ -439,7 +438,11 @@ proc handleError(conf: ConfigRef; msg: TMsgKind, eh: TErrorHandling, s: string, if conf.errorCounter >= conf.errorMax: # only really quit when we're not in the new 'nim check --def' mode: if conf.ideCmd == ideNone: - quit(conf, msg) + when defined(nimsuggest): + #we need to inform the user that something went wrong when initializing NimSuggest + raiseRecoverableError(s) + else: + quit(conf, msg) elif eh == doAbort and conf.cmd != cmdIdeTools: quit(conf, msg) elif eh == doRaise: @@ -557,9 +560,10 @@ proc liMessage*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg: string, ignoreMsg = not conf.hasHint(msg) if not ignoreMsg and msg in conf.warningAsErrors: title = ErrorTitle + color = ErrorColor else: title = HintTitle - color = HintColor + color = HintColor inc(conf.hintCounter) let s = if isRaw: arg else: getMessageStr(msg, arg) @@ -625,7 +629,7 @@ proc warningDeprecated*(conf: ConfigRef, info: TLineInfo = gCmdLineInfo, msg = " message(conf, info, warnDeprecated, msg) proc internalErrorImpl(conf: ConfigRef; info: TLineInfo, errMsg: string, info2: InstantiationInfo) = - if conf.cmd == cmdIdeTools and conf.structuredErrorHook.isNil: return + if conf.cmd in {cmdIdeTools, cmdCheck} and conf.structuredErrorHook.isNil: return writeContext(conf, info) liMessage(conf, info, errInternal, errMsg, doAbort, info2) @@ -647,13 +651,16 @@ template lintReport*(conf: ConfigRef; info: TLineInfo, beau, got: string, extraM let msg = if optStyleError in conf.globalOptions: errGenerated else: hintName liMessage(conf, info, msg, m, doNothing, instLoc()) -proc quotedFilename*(conf: ConfigRef; i: TLineInfo): Rope = - if i.fileIndex.int32 < 0: +proc quotedFilename*(conf: ConfigRef; fi: FileIndex): Rope = + if fi.int32 < 0: result = makeCString "???" elif optExcessiveStackTrace in conf.globalOptions: - result = conf.m.fileInfos[i.fileIndex.int32].quotedFullName + result = conf.m.fileInfos[fi.int32].quotedFullName else: - result = conf.m.fileInfos[i.fileIndex.int32].quotedName + result = conf.m.fileInfos[fi.int32].quotedName + +proc quotedFilename*(conf: ConfigRef; i: TLineInfo): Rope = + quotedFilename(conf, i.fileIndex) template listMsg(title, r) = msgWriteln(conf, title, {msgNoUnitSep}) @@ -662,31 +669,6 @@ template listMsg(title, r) = proc listWarnings*(conf: ConfigRef) = listMsg("Warnings:", warnMin..warnMax) proc listHints*(conf: ConfigRef) = listMsg("Hints:", hintMin..hintMax) -proc uniqueModuleName*(conf: ConfigRef; fid: FileIndex): string = - ## The unique module name is guaranteed to only contain {'A'..'Z', 'a'..'z', '0'..'9', '_'} - ## so that it is useful as a C identifier snippet. - let path = AbsoluteFile toFullPath(conf, fid) - let rel = - if path.string.startsWith(conf.libpath.string): - relativeTo(path, conf.libpath).string - else: - relativeTo(path, conf.projectPath).string - let trunc = if rel.endsWith(".nim"): rel.len - len(".nim") else: rel.len - result = newStringOfCap(trunc) - for i in 0..<trunc: - let c = rel[i] - case c - of 'a'..'z': - result.add c - of {os.DirSep, os.AltSep}: - result.add 'Z' # because it looks a bit like '/' - of '.': - result.add 'O' # a circle - else: - # We mangle upper letters and digits too so that there cannot - # be clashes with our special meanings of 'Z' and 'O' - result.addInt ord(c) - proc genSuccessX*(conf: ConfigRef) = let mem = when declared(system.getMaxMem): formatSize(getMaxMem()) & " peakmem" diff --git a/compiler/ndi.nim b/compiler/ndi.nim index a9d9cfe79..cc18ab39f 100644 --- a/compiler/ndi.nim +++ b/compiler/ndi.nim @@ -29,7 +29,7 @@ proc doWrite(f: var NdiFile; s: PSym; conf: ConfigRef) = f.buf.add "\t" f.buf.addInt s.info.col.int f.f.write(s.name.s, "\t") - f.f.writeRope(s.loc.r) + f.f.writeRope(s.loc.snippet) f.f.writeLine("\t", toFullPath(conf, s.info), "\t", f.buf) template writeMangledName*(f: NdiFile; s: PSym; conf: ConfigRef) = diff --git a/compiler/nilcheck.nim b/compiler/nilcheck.nim index 2a6de8733..7e0efc34b 100644 --- a/compiler/nilcheck.nim +++ b/compiler/nilcheck.nim @@ -498,7 +498,7 @@ proc checkCall(n, ctx, map): Check = # check args and handle possible mutations var isNew = false - result.map = map + result = Check(map: map) for i, child in n: discard check(child, ctx, map) @@ -507,7 +507,7 @@ proc checkCall(n, ctx, map): Check = # as it might have been mutated # TODO similar for normal refs and fields: find dependent exprs: brackets - if child.kind == nkHiddenAddr and not child.typ.isNil and child.typ.kind == tyVar and child.typ[0].kind == tyRef: + if child.kind == nkHiddenAddr and not child.typ.isNil and child.typ.kind == tyVar and child.typ.elementType.kind == tyRef: if not isNew: result.map = newNilMap(map) isNew = true @@ -753,6 +753,7 @@ proc checkReturn(n, ctx, map): Check = proc checkIf(n, ctx, map): Check = ## check branches based on condition + result = default(Check) var mapIf: NilMap = map # first visit the condition @@ -825,7 +826,7 @@ proc checkFor(n, ctx, map): Check = var check2 = check(n.sons[2], ctx, m) var map2 = check2.map - result.map = ctx.union(map0, m) + result = Check(map: ctx.union(map0, m)) result.map = ctx.union(result.map, map2) result.nilability = Safe @@ -853,7 +854,7 @@ proc checkWhile(n, ctx, map): Check = var check2 = check(n.sons[1], ctx, m) var map2 = check2.map - result.map = ctx.union(map0, map1) + result = Check(map: ctx.union(map0, map1)) result.map = ctx.union(result.map, map2) result.nilability = Safe @@ -899,7 +900,7 @@ proc checkInfix(n, ctx, map): Check = proc checkIsNil(n, ctx, map; isElse: bool = false): Check = ## check isNil calls ## update the map depending on if it is not isNil or isNil - result.map = newNilMap(map) + result = Check(map: newNilMap(map)) let value = n[1] result.map.store(ctx, ctx.index(n[1]), if not isElse: Nil else: Safe, TArg, n.info, n) @@ -947,7 +948,7 @@ proc checkCase(n, ctx, map): Check = # c2 # also a == true is a , a == false is not a let base = n[0] - result.map = map.copyMap() + result = Check(map: map.copyMap()) result.nilability = Safe var a: PNode = nil for child in n: @@ -1219,7 +1220,7 @@ proc check(n: PNode, ctx: NilCheckerContext, map: NilMap): Check = result = check(n.sons[1], ctx, map) of nkStmtList, nkStmtListExpr, nkChckRangeF, nkChckRange64, nkChckRange, nkBracket, nkCurly, nkPar, nkTupleConstr, nkClosure, nkObjConstr, nkElse: - result.map = map + result = Check(map: map) if n.kind in {nkObjConstr, nkTupleConstr}: # TODO deeper nested elements? # A(field: B()) # @@ -1246,10 +1247,10 @@ proc check(n: PNode, ctx: NilCheckerContext, map: NilMap): Check = result = checkIf(n, ctx, map) of nkAsgn, nkFastAsgn, nkSinkAsgn: result = checkAsgn(n[0], n[1], ctx, map) - of nkVarSection: - result.map = map + of nkVarSection, nkLetSection: + result = Check(map: map) for child in n: - result = checkAsgn(child[0], child[2], ctx, result.map) + result = checkAsgn(child[0].skipPragmaExpr, child[2], ctx, result.map) of nkForStmt: result = checkFor(n, ctx, map) of nkCaseStmt: @@ -1273,8 +1274,7 @@ proc check(n: PNode, ctx: NilCheckerContext, map: NilMap): Check = else: var elementMap = map.copyMap() - var elementCheck: Check - elementCheck.map = elementMap + var elementCheck = Check(map: elementMap) for element in n: elementCheck = check(element, ctx, elementCheck.map) @@ -1367,7 +1367,7 @@ proc checkNil*(s: PSym; body: PNode; conf: ConfigRef, idgen: IdGenerator) = continue map.store(context, context.index(child), typeNilability(child.typ), TArg, child.info, child) - map.store(context, resultExprIndex, if not s.typ[0].isNil and s.typ[0].kind == tyRef: Nil else: Safe, TResult, s.ast.info) + map.store(context, resultExprIndex, if not s.typ.returnType.isNil and s.typ.returnType.kind == tyRef: Nil else: Safe, TResult, s.ast.info) # echo "checking ", s.name.s, " ", filename @@ -1383,5 +1383,5 @@ proc checkNil*(s: PSym; body: PNode; conf: ConfigRef, idgen: IdGenerator) = # (ANotNil, BNotNil) : # do we check on asgn nilability at all? - if not s.typ[0].isNil and s.typ[0].kind == tyRef and tfNotNil in s.typ[0].flags: + if not s.typ.returnType.isNil and s.typ.returnType.kind == tyRef and tfNotNil in s.typ.returnType.flags: checkResult(s.ast, context, res.map) diff --git a/compiler/nim.nim b/compiler/nim.nim index 184303f8e..005f11a58 100644 --- a/compiler/nim.nim +++ b/compiler/nim.nim @@ -116,8 +116,9 @@ proc handleCmdLine(cache: IdentCache; conf: ConfigRef) = conf.backend = backendC if conf.selectedGC == gcUnselected: - if conf.backend in {backendC, backendCpp, backendObjc, backendNir} or - (conf.cmd == cmdInteractive and isDefined(conf, "nir")): + if conf.backend in {backendC, backendCpp, backendObjc} or + (conf.cmd in cmdDocLike and conf.backend != backendJs) or + conf.cmd == cmdGendepend: initOrcDefines(conf) mainCommand(graph) diff --git a/compiler/nimblecmd.nim b/compiler/nimblecmd.nim index 4b6e22bc9..a5324ea76 100644 --- a/compiler/nimblecmd.nim +++ b/compiler/nimblecmd.nim @@ -79,6 +79,8 @@ proc getPathVersionChecksum*(p: string): tuple[name, version, checksum: string] ## ``/home/user/.nimble/pkgs/package-0.1-febadeaea2345e777f0f6f8433f7f0a52edd5d1b`` into ## ``("/home/user/.nimble/pkgs/package", "0.1", "febadeaea2345e777f0f6f8433f7f0a52edd5d1b")`` + result = ("", "", "") + const checksumSeparator = '-' const versionSeparator = '-' const specialVersionSepartator = "-#" diff --git a/compiler/nimconf.nim b/compiler/nimconf.nim index 1e7d62b4d..5417cd1e9 100644 --- a/compiler/nimconf.nim +++ b/compiler/nimconf.nim @@ -223,7 +223,7 @@ proc readConfigFile*(filename: AbsoluteFile; cache: IdentCache; stream = llStreamOpen(filename, fmRead) if stream != nil: openLexer(L, filename, stream, cache, config) - tok.tokType = tkEof # to avoid a pointless warning + tok = Token(tokType: tkEof) # to avoid a pointless warning var condStack: seq[bool] = @[] confTok(L, tok, config, condStack) # read in the first token while tok.tokType != tkEof: parseAssignment(L, tok, config, filename, condStack) diff --git a/compiler/nimeval.nim b/compiler/nimeval.nim index e98de7e62..0833cfeb3 100644 --- a/compiler/nimeval.nim +++ b/compiler/nimeval.nim @@ -11,8 +11,8 @@ import ast, modules, condsyms, options, llstream, lineinfos, vm, - vmdef, modulegraphs, idents, os, pathutils, - scriptconfig, std/[compilesettings, tables] + vmdef, modulegraphs, idents, pathutils, + scriptconfig, std/[compilesettings, tables, os] import pipelines @@ -40,7 +40,7 @@ proc selectUniqueSymbol*(i: Interpreter; name: string; assert i != nil assert i.mainModule != nil, "no main module selected" let n = getIdent(i.graph.cache, name) - var it: ModuleIter + var it: ModuleIter = default(ModuleIter) var s = initModuleIter(it, i.graph, i.mainModule, n) result = nil while s != nil: diff --git a/compiler/nimsets.nim b/compiler/nimsets.nim index 59a542a85..7edf55278 100644 --- a/compiler/nimsets.nim +++ b/compiler/nimsets.nim @@ -65,7 +65,7 @@ proc toBitSet*(conf: ConfigRef; s: PNode): TBitSet = result = @[] var first: Int128 = Zero var j: Int128 = Zero - first = firstOrd(conf, s.typ[0]) + first = firstOrd(conf, s.typ.elementType) bitSetInit(result, int(getSize(conf, s.typ))) for i in 0..<s.len: if s[i].kind == nkRange: diff --git a/compiler/nir/ast2ir.nim b/compiler/nir/ast2ir.nim deleted file mode 100644 index 51dfcdb09..000000000 --- a/compiler/nir/ast2ir.nim +++ /dev/null @@ -1,2645 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2023 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import std / [assertions, tables, sets] -import ".." / [ast, astalgo, types, options, lineinfos, msgs, magicsys, - modulegraphs, renderer, transf, bitsets, trees, nimsets, - expanddefaults] -from ".." / lowerings import lowerSwap, lowerTupleUnpacking -from ".." / pathutils import customPath -import .. / ic / bitabs - -import nirtypes, nirinsts, nirlineinfos, nirslots, types2ir, nirfiles - -when defined(nimCompilerStacktraceHints): - import std/stackframes - -type - ModuleCon* = ref object - nirm*: ref NirModule - types: TypesCon - module*: PSym - graph*: ModuleGraph - nativeIntId, nativeUIntId: TypeId - strPayloadId: (TypeId, TypeId) - idgen: IdGenerator - processedProcs, pendingProcsAsSet: HashSet[ItemId] - pendingProcs: seq[PSym] # procs we still need to generate code for - pendingVarsAsSet: HashSet[ItemId] - pendingVars: seq[PSym] - noModularity*: bool - inProc: int - toSymId: Table[ItemId, SymId] - symIdCounter: int32 - - ProcCon* = object - config*: ConfigRef - lit: Literals - lastFileKey: FileIndex - lastFileVal: LitId - labelGen: int - exitLabel: LabelId - #code*: Tree - blocks: seq[(PSym, LabelId)] - sm: SlotManager - idgen: IdGenerator - m: ModuleCon - prc: PSym - options: TOptions - -template code(c: ProcCon): Tree = c.m.nirm.code - -proc initModuleCon*(graph: ModuleGraph; config: ConfigRef; idgen: IdGenerator; module: PSym; - nirm: ref NirModule): ModuleCon = - #let lit = Literals() # must be shared - result = ModuleCon(graph: graph, types: initTypesCon(config), nirm: nirm, - idgen: idgen, module: module) - case config.target.intSize - of 2: - result.nativeIntId = Int16Id - result.nativeUIntId = UInt16Id - of 4: - result.nativeIntId = Int32Id - result.nativeUIntId = UInt16Id - else: - result.nativeIntId = Int64Id - result.nativeUIntId = UInt16Id - result.strPayloadId = strPayloadPtrType(result.types, result.nirm.types) - nirm.namespace = nirm.lit.strings.getOrIncl(customPath(toFullPath(config, module.info))) - nirm.intbits = uint32(config.target.intSize * 8) - -proc initProcCon*(m: ModuleCon; prc: PSym; config: ConfigRef): ProcCon = - result = ProcCon(m: m, sm: initSlotManager({}), prc: prc, config: config, - lit: m.nirm.lit, idgen: m.idgen, - options: if prc != nil: prc.options - else: config.options) - result.exitLabel = newLabel(result.labelGen) - -proc toLineInfo(c: var ProcCon; i: TLineInfo): PackedLineInfo = - var val: LitId - if c.lastFileKey == i.fileIndex: - val = c.lastFileVal - else: - val = c.lit.strings.getOrIncl(toFullPath(c.config, i.fileIndex)) - # remember the entry: - c.lastFileKey = i.fileIndex - c.lastFileVal = val - result = pack(c.m.nirm.man, val, int32 i.line, int32 i.col) - -proc bestEffort(c: ProcCon): TLineInfo = - if c.prc != nil: - c.prc.info - else: - c.m.module.info - -proc popBlock(c: var ProcCon; oldLen: int) = - c.blocks.setLen(oldLen) - -template withBlock(labl: PSym; info: PackedLineInfo; asmLabl: LabelId; body: untyped) {.dirty.} = - var oldLen {.gensym.} = c.blocks.len - c.blocks.add (labl, asmLabl) - body - popBlock(c, oldLen) - -type - GenFlag = enum - gfAddrOf # load the address of the expression - gfToOutParam # the expression is passed to an `out` parameter - GenFlags = set[GenFlag] - -proc gen(c: var ProcCon; n: PNode; d: var Value; flags: GenFlags = {}) - -proc genScope(c: var ProcCon; n: PNode; d: var Value; flags: GenFlags = {}) = - openScope c.sm - gen c, n, d, flags - closeScope c.sm - -proc freeTemp(c: var ProcCon; tmp: Value) = - let s = extractTemp(tmp) - if s != SymId(-1): - freeTemp(c.sm, s) - -proc freeTemps(c: var ProcCon; tmps: openArray[Value]) = - for t in tmps: freeTemp(c, t) - -proc typeToIr(m: ModuleCon; t: PType): TypeId = - typeToIr(m.types, m.nirm.types, t) - -proc allocTemp(c: var ProcCon; t: TypeId): SymId = - if c.m.noModularity: - result = allocTemp(c.sm, t, c.m.symIdCounter) - else: - result = allocTemp(c.sm, t, c.idgen.symId) - -const - ListSymId = -1 - -proc toSymId(c: var ProcCon; s: PSym): SymId = - if c.m.noModularity: - result = c.m.toSymId.getOrDefault(s.itemId, SymId(-1)) - if result.int < 0: - inc c.m.symIdCounter - result = SymId(c.m.symIdCounter) - c.m.toSymId[s.itemId] = result - when ListSymId != -1: - if result.int == ListSymId or s.name.s == "echoBinSafe": - echo result.int, " is ", s.name.s, " ", c.m.graph.config $ s.info, " ", s.flags - writeStackTrace() - else: - result = SymId(s.itemId.item) - -proc getTemp(c: var ProcCon; n: PNode): Value = - let info = toLineInfo(c, n.info) - let t = typeToIr(c.m, n.typ) - let tmp = allocTemp(c, t) - c.code.addSummon info, tmp, t - result = localToValue(info, tmp) - -proc getTemp(c: var ProcCon; t: TypeId; info: PackedLineInfo): Value = - let tmp = allocTemp(c, t) - c.code.addSummon info, tmp, t - result = localToValue(info, tmp) - -proc gen(c: var ProcCon; n: PNode; flags: GenFlags = {}) = - var tmp = default(Value) - gen(c, n, tmp, flags) - freeTemp c, tmp - -proc genScope(c: var ProcCon; n: PNode; flags: GenFlags = {}) = - openScope c.sm - gen c, n, flags - closeScope c.sm - -proc genx(c: var ProcCon; n: PNode; flags: GenFlags = {}): Value = - result = default(Value) - gen(c, n, result, flags) - assert Tree(result).len > 0, $n - -proc clearDest(c: var ProcCon; n: PNode; d: var Value) {.inline.} = - when false: - if n.typ.isNil or n.typ.kind == tyVoid: - let s = extractTemp(d) - if s != SymId(-1): - freeLoc(c.sm, s) - -proc isNotOpr(n: PNode): bool = - n.kind in nkCallKinds and n[0].kind == nkSym and n[0].sym.magic == mNot - -proc jmpBack(c: var ProcCon; n: PNode; lab: LabelId) = - c.code.gotoLabel toLineInfo(c, n.info), GotoLoop, lab - -type - JmpKind = enum opcFJmp, opcTJmp - -proc xjmp(c: var ProcCon; n: PNode; jk: JmpKind; v: Value): LabelId = - result = newLabel(c.labelGen) - let info = toLineInfo(c, n.info) - buildTyped c.code, info, Select, Bool8Id: - c.code.copyTree Tree(v) - build c.code, info, SelectPair: - build c.code, info, SelectValue: - c.code.boolVal(c.lit.numbers, info, jk == opcTJmp) - c.code.gotoLabel info, Goto, result - -proc patch(c: var ProcCon; n: PNode; L: LabelId) = - addLabel c.code, toLineInfo(c, n.info), Label, L - -proc genWhile(c: var ProcCon; n: PNode) = - # lab1: - # cond, tmp - # fjmp tmp, lab2 - # body - # jmp lab1 - # lab2: - let info = toLineInfo(c, n.info) - let lab1 = c.code.addNewLabel(c.labelGen, info, LoopLabel) - withBlock(nil, info, lab1): - if isTrue(n[0]): - c.gen(n[1]) - c.jmpBack(n, lab1) - elif isNotOpr(n[0]): - var tmp = c.genx(n[0][1]) - let lab2 = c.xjmp(n, opcTJmp, tmp) - c.freeTemp(tmp) - c.gen(n[1]) - c.jmpBack(n, lab1) - c.patch(n, lab2) - else: - var tmp = c.genx(n[0]) - let lab2 = c.xjmp(n, opcFJmp, tmp) - c.freeTemp(tmp) - c.gen(n[1]) - c.jmpBack(n, lab1) - c.patch(n, lab2) - -proc genBlock(c: var ProcCon; n: PNode; d: var Value) = - openScope c.sm - let info = toLineInfo(c, n.info) - let lab1 = newLabel(c.labelGen) - - withBlock(n[0].sym, info, lab1): - c.gen(n[1], d) - - c.code.addLabel(info, Label, lab1) - closeScope c.sm - c.clearDest(n, d) - -proc jumpTo(c: var ProcCon; n: PNode; L: LabelId) = - c.code.addLabel(toLineInfo(c, n.info), Goto, L) - -proc genBreak(c: var ProcCon; n: PNode) = - if n[0].kind == nkSym: - for i in countdown(c.blocks.len-1, 0): - if c.blocks[i][0] == n[0].sym: - c.jumpTo n, c.blocks[i][1] - return - localError(c.config, n.info, "NIR problem: cannot find 'break' target") - else: - c.jumpTo n, c.blocks[c.blocks.high][1] - -proc genIf(c: var ProcCon; n: PNode; d: var Value) = - # if (!expr1) goto lab1; - # thenPart - # goto LEnd - # lab1: - # if (!expr2) goto lab2; - # thenPart2 - # goto LEnd - # lab2: - # elsePart - # Lend: - if isEmpty(d) and not isEmptyType(n.typ): d = getTemp(c, n) - var ending = newLabel(c.labelGen) - for i in 0..<n.len: - var it = n[i] - if it.len == 2: - let info = toLineInfo(c, it[0].info) - var elsePos: LabelId - if isNotOpr(it[0]): - let tmp = c.genx(it[0][1]) - elsePos = c.xjmp(it[0][1], opcTJmp, tmp) # if true - c.freeTemp tmp - else: - let tmp = c.genx(it[0]) - elsePos = c.xjmp(it[0], opcFJmp, tmp) # if false - c.freeTemp tmp - c.clearDest(n, d) - if isEmptyType(it[1].typ): # maybe noreturn call, don't touch `d` - c.genScope(it[1]) - else: - c.genScope(it[1], d) # then part - if i < n.len-1: - c.jumpTo it[1], ending - c.patch(it, elsePos) - else: - c.clearDest(n, d) - if isEmptyType(it[0].typ): # maybe noreturn call, don't touch `d` - c.genScope(it[0]) - else: - c.genScope(it[0], d) - c.patch(n, ending) - c.clearDest(n, d) - -proc tempToDest(c: var ProcCon; n: PNode; d: var Value; tmp: Value) = - if isEmpty(d): - d = tmp - else: - let info = toLineInfo(c, n.info) - buildTyped c.code, info, Asgn, typeToIr(c.m, n.typ): - c.code.copyTree d - c.code.copyTree tmp - freeTemp(c, tmp) - -proc genAndOr(c: var ProcCon; n: PNode; opc: JmpKind; d: var Value) = - # asgn d, a - # tjmp|fjmp lab1 - # asgn d, b - # lab1: - var tmp = getTemp(c, n) - c.gen(n[1], tmp) - let lab1 = c.xjmp(n, opc, tmp) - c.gen(n[2], tmp) - c.patch(n, lab1) - tempToDest c, n, d, tmp - -proc unused(c: var ProcCon; n: PNode; x: Value) {.inline.} = - if hasValue(x): - #debug(n) - localError(c.config, n.info, "not unused") - -proc caseValue(c: var ProcCon; n: PNode) = - let info = toLineInfo(c, n.info) - build c.code, info, SelectValue: - let x = genx(c, n) - c.code.copyTree x - freeTemp(c, x) - -proc caseRange(c: var ProcCon; n: PNode) = - let info = toLineInfo(c, n.info) - build c.code, info, SelectRange: - let x = genx(c, n[0]) - let y = genx(c, n[1]) - c.code.copyTree x - c.code.copyTree y - freeTemp(c, y) - freeTemp(c, x) - -proc addUseCodegenProc(c: var ProcCon; dest: var Tree; name: string; info: PackedLineInfo) = - let cp = getCompilerProc(c.m.graph, name) - let theProc = c.genx newSymNode(cp) - copyTree c.code, theProc - -template buildCond(useNegation: bool; cond: typed; body: untyped) = - let lab = newLabel(c.labelGen) - buildTyped c.code, info, Select, Bool8Id: - c.code.copyTree cond - build c.code, info, SelectPair: - build c.code, info, SelectValue: - c.code.boolVal(c.lit.numbers, info, useNegation) - c.code.gotoLabel info, Goto, lab - - body - c.code.addLabel info, Label, lab - -template buildIf(cond: typed; body: untyped) = - buildCond false, cond, body - -template buildIfNot(cond: typed; body: untyped) = - buildCond true, cond, body - -template buildIfThenElse(cond: typed; then, otherwise: untyped) = - let lelse = newLabel(c.labelGen) - let lend = newLabel(c.labelGen) - buildTyped c.code, info, Select, Bool8Id: - c.code.copyTree cond - build c.code, info, SelectPair: - build c.code, info, SelectValue: - c.code.boolVal(c.lit.numbers, info, false) - c.code.gotoLabel info, Goto, lelse - - then() - c.code.gotoLabel info, Goto, lend - c.code.addLabel info, Label, lelse - otherwise() - c.code.addLabel info, Label, lend - -include stringcases - -proc genCase(c: var ProcCon; n: PNode; d: var Value) = - if not isEmptyType(n.typ): - if isEmpty(d): d = getTemp(c, n) - else: - unused(c, n, d) - - if n[0].typ.skipTypes(abstractInst).kind == tyString: - genStringCase(c, n, d) - return - - var sections = newSeqOfCap[LabelId](n.len-1) - let ending = newLabel(c.labelGen) - let info = toLineInfo(c, n.info) - let tmp = c.genx(n[0]) - buildTyped c.code, info, Select, typeToIr(c.m, n[0].typ): - c.code.copyTree tmp - for i in 1..<n.len: - let section = newLabel(c.labelGen) - sections.add section - let it = n[i] - let itinfo = toLineInfo(c, it.info) - build c.code, itinfo, SelectPair: - build c.code, itinfo, SelectList: - for j in 0..<it.len-1: - if it[j].kind == nkRange: - caseRange c, it[j] - else: - caseValue c, it[j] - c.code.addLabel itinfo, Goto, section - c.freeTemp tmp - for i in 1..<n.len: - let it = n[i] - let itinfo = toLineInfo(c, it.info) - c.code.addLabel itinfo, Label, sections[i-1] - c.gen it.lastSon - if i != n.len-1: - c.code.addLabel itinfo, Goto, ending - c.code.addLabel info, Label, ending - -proc rawCall(c: var ProcCon; info: PackedLineInfo; opc: Opcode; t: TypeId; args: var openArray[Value]) = - buildTyped c.code, info, opc, t: - if opc in {CheckedCall, CheckedIndirectCall}: - c.code.addLabel info, CheckedGoto, c.exitLabel - for a in mitems(args): - c.code.copyTree a - freeTemp c, a - -proc canRaiseDisp(c: ProcCon; n: PNode): bool = - # we assume things like sysFatal cannot raise themselves - if n.kind == nkSym and {sfNeverRaises, sfImportc, sfCompilerProc} * n.sym.flags != {}: - result = false - elif optPanics in c.config.globalOptions or - (n.kind == nkSym and sfSystemModule in getModule(n.sym).flags and - sfSystemRaisesDefect notin n.sym.flags): - # we know we can be strict: - result = canRaise(n) - else: - # we have to be *very* conservative: - result = canRaiseConservative(n) - -proc genCall(c: var ProcCon; n: PNode; d: var Value) = - let canRaise = canRaiseDisp(c, n[0]) - - let opc = if n[0].kind == nkSym and n[0].sym.kind in routineKinds: - (if canRaise: CheckedCall else: Call) - else: - (if canRaise: CheckedIndirectCall else: IndirectCall) - let info = toLineInfo(c, n.info) - - # In the IR we cannot nest calls. Thus we use two passes: - var args: seq[Value] = @[] - var t = n[0].typ - if t != nil: t = t.skipTypes(abstractInst) - args.add genx(c, n[0]) - for i in 1..<n.len: - if t != nil and i < t.len: - if isCompileTimeOnly(t[i]): discard - elif isOutParam(t[i]): args.add genx(c, n[i], {gfToOutParam}) - else: args.add genx(c, n[i]) - else: - args.add genx(c, n[i]) - - let tb = typeToIr(c.m, n.typ) - if not isEmptyType(n.typ): - if isEmpty(d): d = getTemp(c, n) - # XXX Handle problematic aliasing here: `a = f_canRaise(a)`. - buildTyped c.code, info, Asgn, tb: - c.code.copyTree d - rawCall c, info, opc, tb, args - else: - rawCall c, info, opc, tb, args - freeTemps c, args - -proc genRaise(c: var ProcCon; n: PNode) = - let info = toLineInfo(c, n.info) - let tb = typeToIr(c.m, n[0].typ) - - let d = genx(c, n[0]) - buildTyped c.code, info, SetExc, tb: - c.code.copyTree d - c.freeTemp(d) - c.code.addLabel info, Goto, c.exitLabel - -proc genReturn(c: var ProcCon; n: PNode) = - if n[0].kind != nkEmpty: - gen(c, n[0]) - # XXX Block leave actions? - let info = toLineInfo(c, n.info) - c.code.addLabel info, Goto, c.exitLabel - -proc genTry(c: var ProcCon; n: PNode; d: var Value) = - if isEmpty(d) and not isEmptyType(n.typ): d = getTemp(c, n) - var endings: seq[LabelId] = @[] - let ehPos = newLabel(c.labelGen) - let oldExitLab = c.exitLabel - c.exitLabel = ehPos - if isEmptyType(n[0].typ): # maybe noreturn call, don't touch `d` - c.gen(n[0]) - else: - c.gen(n[0], d) - c.clearDest(n, d) - - # Add a jump past the exception handling code - let jumpToFinally = newLabel(c.labelGen) - c.jumpTo n, jumpToFinally - # This signals where the body ends and where the exception handling begins - c.patch(n, ehPos) - c.exitLabel = oldExitLab - for i in 1..<n.len: - let it = n[i] - if it.kind != nkFinally: - # first opcExcept contains the end label of the 'except' block: - let endExcept = newLabel(c.labelGen) - for j in 0..<it.len - 1: - assert(it[j].kind == nkType) - let typ = it[j].typ.skipTypes(abstractPtrs-{tyTypeDesc}) - let itinfo = toLineInfo(c, it[j].info) - build c.code, itinfo, TestExc: - c.code.addTyped itinfo, typeToIr(c.m, typ) - if it.len == 1: - let itinfo = toLineInfo(c, it.info) - build c.code, itinfo, TestExc: - c.code.addTyped itinfo, VoidId - let body = it.lastSon - if isEmptyType(body.typ): # maybe noreturn call, don't touch `d` - c.gen(body) - else: - c.gen(body, d) - c.clearDest(n, d) - if i < n.len: - endings.add newLabel(c.labelGen) - c.patch(it, endExcept) - let fin = lastSon(n) - # we always generate an 'opcFinally' as that pops the safepoint - # from the stack if no exception is raised in the body. - c.patch(fin, jumpToFinally) - #c.gABx(fin, opcFinally, 0, 0) - for endPos in endings: c.patch(n, endPos) - if fin.kind == nkFinally: - c.gen(fin[0]) - c.clearDest(n, d) - #c.gABx(fin, opcFinallyEnd, 0, 0) - -template isGlobal(s: PSym): bool = sfGlobal in s.flags and s.kind != skForVar -proc isGlobal(n: PNode): bool = n.kind == nkSym and isGlobal(n.sym) - -proc genField(c: var ProcCon; n: PNode; d: var Value) = - var pos: int - if n.kind != nkSym or n.sym.kind != skField: - localError(c.config, n.info, "no field symbol") - pos = 0 - else: - pos = n.sym.position - d.addImmediateVal toLineInfo(c, n.info), pos - -proc genIndex(c: var ProcCon; n: PNode; arr: PType; d: var Value) = - let info = toLineInfo(c, n.info) - if arr.skipTypes(abstractInst).kind == tyArray and - (let offset = firstOrd(c.config, arr); offset != Zero): - let x = c.genx(n) - buildTyped d, info, Sub, c.m.nativeIntId: - copyTree d.Tree, x - d.addImmediateVal toLineInfo(c, n.info), toInt(offset) - else: - c.gen(n, d) - if optBoundsCheck in c.options: - let idx = move d - build d, info, CheckedIndex: - d.Tree.addLabel info, CheckedGoto, c.exitLabel - copyTree d.Tree, idx - let x = toInt64 lengthOrd(c.config, arr) - d.addIntVal c.lit.numbers, info, c.m.nativeIntId, x - -proc rawGenNew(c: var ProcCon; d: Value; refType: PType; ninfo: TLineInfo; needsInit: bool) = - assert refType.kind == tyRef - let baseType = refType.lastSon - - let info = toLineInfo(c, ninfo) - let codegenProc = magicsys.getCompilerProc(c.m.graph, - if needsInit: "nimNewObj" else: "nimNewObjUninit") - let refTypeIr = typeToIr(c.m, refType) - buildTyped c.code, info, Asgn, refTypeIr: - copyTree c.code, d - buildTyped c.code, info, Cast, refTypeIr: - buildTyped c.code, info, Call, VoidPtrId: - let theProc = c.genx newSymNode(codegenProc, ninfo) - copyTree c.code, theProc - c.code.addImmediateVal info, int(getSize(c.config, baseType)) - c.code.addImmediateVal info, int(getAlign(c.config, baseType)) - -proc genNew(c: var ProcCon; n: PNode; needsInit: bool) = - # If in doubt, always follow the blueprint of the C code generator for `mm:orc`. - let refType = n[1].typ.skipTypes(abstractInstOwned) - let d = genx(c, n[1]) - rawGenNew c, d, refType, n.info, needsInit - freeTemp c, d - -proc genNewSeqOfCap(c: var ProcCon; n: PNode; d: var Value) = - let info = toLineInfo(c, n.info) - let seqtype = skipTypes(n.typ, abstractVarRange) - let baseType = seqtype.lastSon - var a = c.genx(n[1]) - if isEmpty(d): d = getTemp(c, n) - # $1.len = 0 - buildTyped c.code, info, Asgn, c.m.nativeIntId: - buildTyped c.code, info, FieldAt, typeToIr(c.m, seqtype): - copyTree c.code, d - c.code.addImmediateVal info, 0 - c.code.addImmediateVal info, 0 - # $1.p = ($4*) #newSeqPayloadUninit($2, sizeof($3), NIM_ALIGNOF($3)) - let payloadPtr = seqPayloadPtrType(c.m.types, c.m.nirm.types, seqtype)[0] - buildTyped c.code, info, Asgn, payloadPtr: - # $1.p - buildTyped c.code, info, FieldAt, typeToIr(c.m, seqtype): - copyTree c.code, d - c.code.addImmediateVal info, 1 - # ($4*) #newSeqPayloadUninit($2, sizeof($3), NIM_ALIGNOF($3)) - buildTyped c.code, info, Cast, payloadPtr: - buildTyped c.code, info, Call, VoidPtrId: - let codegenProc = magicsys.getCompilerProc(c.m.graph, "newSeqPayloadUninit") - let theProc = c.genx newSymNode(codegenProc, n.info) - copyTree c.code, theProc - copyTree c.code, a - c.code.addImmediateVal info, int(getSize(c.config, baseType)) - c.code.addImmediateVal info, int(getAlign(c.config, baseType)) - freeTemp c, a - -proc genNewSeqPayload(c: var ProcCon; info: PackedLineInfo; d, b: Value; seqtype: PType) = - let baseType = seqtype.lastSon - # $1.p = ($4*) #newSeqPayload($2, sizeof($3), NIM_ALIGNOF($3)) - let payloadPtr = seqPayloadPtrType(c.m.types, c.m.nirm.types, seqtype)[0] - - # $1.len = $2 - buildTyped c.code, info, Asgn, c.m.nativeIntId: - buildTyped c.code, info, FieldAt, typeToIr(c.m, seqtype): - copyTree c.code, d - c.code.addImmediateVal info, 0 - copyTree c.code, b - - buildTyped c.code, info, Asgn, payloadPtr: - # $1.p - buildTyped c.code, info, FieldAt, typeToIr(c.m, seqtype): - copyTree c.code, d - c.code.addImmediateVal info, 1 - # ($4*) #newSeqPayload($2, sizeof($3), NIM_ALIGNOF($3)) - buildTyped c.code, info, Cast, payloadPtr: - buildTyped c.code, info, Call, VoidPtrId: - let codegenProc = magicsys.getCompilerProc(c.m.graph, "newSeqPayload") - let theProc = c.genx newSymNode(codegenProc) - copyTree c.code, theProc - copyTree c.code, b - c.code.addImmediateVal info, int(getSize(c.config, baseType)) - c.code.addImmediateVal info, int(getAlign(c.config, baseType)) - -proc genNewSeq(c: var ProcCon; n: PNode) = - let info = toLineInfo(c, n.info) - let seqtype = skipTypes(n[1].typ, abstractVarRange) - var d = c.genx(n[1]) - var b = c.genx(n[2]) - - genNewSeqPayload(c, info, d, b, seqtype) - - freeTemp c, b - freeTemp c, d - -template intoDest*(d: var Value; info: PackedLineInfo; typ: TypeId; body: untyped) = - if typ == VoidId: - body(c.code) - elif isEmpty(d): - body(Tree(d)) - else: - buildTyped c.code, info, Asgn, typ: - copyTree c.code, d - body(c.code) - -template valueIntoDest(c: var ProcCon; info: PackedLineInfo; d: var Value; typ: PType; body: untyped) = - if isEmpty(d): - body(Tree d) - else: - buildTyped c.code, info, Asgn, typeToIr(c.m, typ): - copyTree c.code, d - body(c.code) - -template constrIntoDest(c: var ProcCon; info: PackedLineInfo; d: var Value; typ: PType; body: untyped) = - var tmp = default(Value) - body(Tree tmp) - if isEmpty(d): - d = tmp - else: - buildTyped c.code, info, Asgn, typeToIr(c.m, typ): - copyTree c.code, d - copyTree c.code, tmp - -proc genBinaryOp(c: var ProcCon; n: PNode; d: var Value; opc: Opcode) = - let info = toLineInfo(c, n.info) - let tmp = c.genx(n[1]) - let tmp2 = c.genx(n[2]) - let t = typeToIr(c.m, n.typ) - template body(target) = - buildTyped target, info, opc, t: - if opc in {CheckedAdd, CheckedSub, CheckedMul, CheckedDiv, CheckedMod}: - target.addLabel info, CheckedGoto, c.exitLabel - copyTree target, tmp - copyTree target, tmp2 - intoDest d, info, t, body - c.freeTemp(tmp) - c.freeTemp(tmp2) - -proc genCmpOp(c: var ProcCon; n: PNode; d: var Value; opc: Opcode) = - let info = toLineInfo(c, n.info) - let tmp = c.genx(n[1]) - let tmp2 = c.genx(n[2]) - let t = typeToIr(c.m, n[1].typ) - template body(target) = - buildTyped target, info, opc, t: - copyTree target, tmp - copyTree target, tmp2 - intoDest d, info, Bool8Id, body - c.freeTemp(tmp) - c.freeTemp(tmp2) - -proc genUnaryOp(c: var ProcCon; n: PNode; d: var Value; opc: Opcode) = - let info = toLineInfo(c, n.info) - let tmp = c.genx(n[1]) - let t = typeToIr(c.m, n.typ) - template body(target) = - buildTyped target, info, opc, t: - copyTree target, tmp - intoDest d, info, t, body - c.freeTemp(tmp) - -proc genIncDec(c: var ProcCon; n: PNode; opc: Opcode) = - let info = toLineInfo(c, n.info) - let t = typeToIr(c.m, skipTypes(n[1].typ, abstractVar)) - - let d = c.genx(n[1]) - let tmp = c.genx(n[2]) - # we produce code like: i = i + 1 - buildTyped c.code, info, Asgn, t: - copyTree c.code, d - buildTyped c.code, info, opc, t: - if opc in {CheckedAdd, CheckedSub}: - c.code.addLabel info, CheckedGoto, c.exitLabel - copyTree c.code, d - copyTree c.code, tmp - c.freeTemp(tmp) - #c.genNarrow(n[1], d) - c.freeTemp(d) - -proc genArrayLen(c: var ProcCon; n: PNode; d: var Value) = - #echo c.m.graph.config $ n.info, " ", n - let info = toLineInfo(c, n.info) - var a = n[1] - #if a.kind == nkHiddenAddr: a = a[0] - var typ = skipTypes(a.typ, abstractVar + tyUserTypeClasses) - case typ.kind - of tyOpenArray, tyVarargs: - let xa = c.genx(a) - template body(target) = - buildTyped target, info, FieldAt, typeToIr(c.m, typ): - copyTree target, xa - target.addImmediateVal info, 1 # (p, len)-pair so len is at index 1 - intoDest d, info, c.m.nativeIntId, body - - of tyCstring: - let xa = c.genx(a) - if isEmpty(d): d = getTemp(c, n) - buildTyped c.code, info, Call, c.m.nativeIntId: - let codegenProc = magicsys.getCompilerProc(c.m.graph, "nimCStrLen") - assert codegenProc != nil - let theProc = c.genx newSymNode(codegenProc, n.info) - copyTree c.code, theProc - copyTree c.code, xa - - of tyString, tySequence: - let xa = c.genx(a) - - if typ.kind == tySequence: - # we go through a temporary here because people write bullshit code. - if isEmpty(d): d = getTemp(c, n) - - template body(target) = - buildTyped target, info, FieldAt, typeToIr(c.m, typ): - copyTree target, xa - target.addImmediateVal info, 0 # (len, p)-pair so len is at index 0 - intoDest d, info, c.m.nativeIntId, body - - of tyArray: - template body(target) = - target.addIntVal(c.lit.numbers, info, c.m.nativeIntId, toInt lengthOrd(c.config, typ)) - intoDest d, info, c.m.nativeIntId, body - else: internalError(c.config, n.info, "genArrayLen()") - -proc genUnaryMinus(c: var ProcCon; n: PNode; d: var Value) = - let info = toLineInfo(c, n.info) - let tmp = c.genx(n[1]) - let t = typeToIr(c.m, n.typ) - template body(target) = - buildTyped target, info, Sub, t: - # Little hack: This works because we know that `0.0` is all 0 bits: - target.addIntVal(c.lit.numbers, info, t, 0) - copyTree target, tmp - intoDest d, info, t, body - c.freeTemp(tmp) - -proc genHigh(c: var ProcCon; n: PNode; d: var Value) = - let info = toLineInfo(c, n.info) - let t = typeToIr(c.m, n.typ) - var x = default(Value) - genArrayLen(c, n, x) - template body(target) = - buildTyped target, info, Sub, t: - copyTree target, x - target.addIntVal(c.lit.numbers, info, t, 1) - intoDest d, info, t, body - c.freeTemp x - -proc genBinaryCp(c: var ProcCon; n: PNode; d: var Value; compilerProc: string) = - let info = toLineInfo(c, n.info) - let xa = c.genx(n[1]) - let xb = c.genx(n[2]) - if isEmpty(d) and not isEmptyType(n.typ): d = getTemp(c, n) - - let t = typeToIr(c.m, n.typ) - template body(target) = - buildTyped target, info, Call, t: - let codegenProc = magicsys.getCompilerProc(c.m.graph, compilerProc) - #assert codegenProc != nil, $n & " " & (c.m.graph.config $ n.info) - let theProc = c.genx newSymNode(codegenProc, n.info) - copyTree target, theProc - copyTree target, xa - copyTree target, xb - - intoDest d, info, t, body - c.freeTemp xb - c.freeTemp xa - -proc genUnaryCp(c: var ProcCon; n: PNode; d: var Value; compilerProc: string; argAt = 1) = - let info = toLineInfo(c, n.info) - let xa = c.genx(n[argAt]) - if isEmpty(d) and not isEmptyType(n.typ): d = getTemp(c, n) - - let t = typeToIr(c.m, n.typ) - template body(target) = - buildTyped target, info, Call, t: - let codegenProc = magicsys.getCompilerProc(c.m.graph, compilerProc) - let theProc = c.genx newSymNode(codegenProc, n.info) - copyTree target, theProc - copyTree target, xa - - intoDest d, info, t, body - c.freeTemp xa - -proc genEnumToStr(c: var ProcCon; n: PNode; d: var Value) = - let t = n[1].typ.skipTypes(abstractInst+{tyRange}) - let toStrProc = getToStringProc(c.m.graph, t) - # XXX need to modify this logic for IC. - var nb = copyTree(n) - nb[0] = newSymNode(toStrProc) - gen(c, nb, d) - -proc genOf(c: var ProcCon; n: PNode; d: var Value) = - genUnaryOp c, n, d, TestOf - -template sizeOfLikeMsg(name): string = - "'" & name & "' requires '.importc' types to be '.completeStruct'" - -proc genIsNil(c: var ProcCon; n: PNode; d: var Value) = - let info = toLineInfo(c, n.info) - let tmp = c.genx(n[1]) - let t = typeToIr(c.m, n[1].typ) - template body(target) = - buildTyped target, info, Eq, t: - copyTree target, tmp - addNilVal target, info, t - intoDest d, info, Bool8Id, body - c.freeTemp(tmp) - -proc fewCmps(conf: ConfigRef; s: PNode): bool = - # this function estimates whether it is better to emit code - # for constructing the set or generating a bunch of comparisons directly - if s.kind != nkCurly: - result = false - elif (getSize(conf, s.typ) <= conf.target.intSize) and (nfAllConst in s.flags): - result = false # it is better to emit the set generation code - elif elemType(s.typ).kind in {tyInt, tyInt16..tyInt64}: - result = true # better not emit the set if int is basetype! - else: - result = s.len <= 8 # 8 seems to be a good value - -proc genInBitset(c: var ProcCon; n: PNode; d: var Value) = - let info = toLineInfo(c, n.info) - let a = c.genx(n[1]) - let b = c.genx(n[2]) - - let t = bitsetBasetype(c.m.types, c.m.nirm.types, n[1].typ) - let setType = typeToIr(c.m, n[1].typ) - let mask = - case t - of UInt8Id: 7 - of UInt16Id: 15 - of UInt32Id: 31 - else: 63 - let expansion = if t == UInt64Id: UInt64Id else: c.m.nativeUIntId - # "(($1 &(1U<<((NU)($2)&7U)))!=0)" - or - - # "(($1[(NU)($2)>>3] &(1U<<((NU)($2)&7U)))!=0)" - - template body(target) = - buildTyped target, info, BoolNot, Bool8Id: - buildTyped target, info, Eq, t: - buildTyped target, info, BitAnd, t: - if c.m.nirm.types[setType].kind != ArrayTy: - copyTree target, a - else: - buildTyped target, info, ArrayAt, setType: - copyTree target, a - buildTyped target, info, BitShr, t: - buildTyped target, info, Cast, expansion: - copyTree target, b - addIntVal target, c.lit.numbers, info, expansion, 3 - - buildTyped target, info, BitShl, t: - addIntVal target, c.lit.numbers, info, t, 1 - buildTyped target, info, BitAnd, t: - buildTyped target, info, Cast, expansion: - copyTree target, b - addIntVal target, c.lit.numbers, info, expansion, mask - addIntVal target, c.lit.numbers, info, t, 0 - intoDest d, info, t, body - - c.freeTemp(b) - c.freeTemp(a) - -proc genInSet(c: var ProcCon; n: PNode; d: var Value) = - let g {.cursor.} = c.m.graph - if n[1].kind == nkCurly and fewCmps(g.config, n[1]): - # a set constructor but not a constant set: - # do not emit the set, but generate a bunch of comparisons; and if we do - # so, we skip the unnecessary range check: This is a semantical extension - # that code now relies on. :-/ XXX - let elem = if n[2].kind in {nkChckRange, nkChckRange64}: n[2][0] - else: n[2] - let curly = n[1] - var ex: PNode = nil - for it in curly: - var test: PNode - if it.kind == nkRange: - test = newTree(nkCall, g.operators.opAnd.newSymNode, - newTree(nkCall, g.operators.opLe.newSymNode, it[0], elem), # a <= elem - newTree(nkCall, g.operators.opLe.newSymNode, elem, it[1]) - ) - else: - test = newTree(nkCall, g.operators.opEq.newSymNode, elem, it) - test.typ = getSysType(g, it.info, tyBool) - - if ex == nil: ex = test - else: ex = newTree(nkCall, g.operators.opOr.newSymNode, ex, test) - - if ex == nil: - let info = toLineInfo(c, n.info) - template body(target) = - boolVal target, c.lit.numbers, info, false - intoDest d, info, Bool8Id, body - else: - gen c, ex, d - else: - genInBitset c, n, d - -proc genCard(c: var ProcCon; n: PNode; d: var Value) = - let info = toLineInfo(c, n.info) - let a = c.genx(n[1]) - let t = typeToIr(c.m, n.typ) - - let setType = typeToIr(c.m, n[1].typ) - if isEmpty(d): d = getTemp(c, n) - - buildTyped c.code, info, Asgn, t: - copyTree c.code, d - buildTyped c.code, info, Call, t: - if c.m.nirm.types[setType].kind == ArrayTy: - let codegenProc = magicsys.getCompilerProc(c.m.graph, "cardSet") - let theProc = c.genx newSymNode(codegenProc, n.info) - copyTree c.code, theProc - buildTyped c.code, info, AddrOf, ptrTypeOf(c.m.nirm.types, setType): - copyTree c.code, a - c.code.addImmediateVal info, int(getSize(c.config, n[1].typ)) - elif t == UInt64Id: - let codegenProc = magicsys.getCompilerProc(c.m.graph, "countBits64") - let theProc = c.genx newSymNode(codegenProc, n.info) - copyTree c.code, theProc - copyTree c.code, a - else: - let codegenProc = magicsys.getCompilerProc(c.m.graph, "countBits32") - let theProc = c.genx newSymNode(codegenProc, n.info) - copyTree c.code, theProc - buildTyped c.code, info, Cast, UInt32Id: - copyTree c.code, a - freeTemp c, a - -proc genEqSet(c: var ProcCon; n: PNode; d: var Value) = - let info = toLineInfo(c, n.info) - let a = c.genx(n[1]) - let b = c.genx(n[2]) - let t = typeToIr(c.m, n.typ) - - let setType = typeToIr(c.m, n[1].typ) - - if c.m.nirm.types[setType].kind == ArrayTy: - if isEmpty(d): d = getTemp(c, n) - - buildTyped c.code, info, Asgn, t: - copyTree c.code, d - buildTyped c.code, info, Eq, t: - buildTyped c.code, info, Call, t: - let codegenProc = magicsys.getCompilerProc(c.m.graph, "nimCmpMem") - let theProc = c.genx newSymNode(codegenProc, n.info) - copyTree c.code, theProc - buildTyped c.code, info, AddrOf, ptrTypeOf(c.m.nirm.types, setType): - copyTree c.code, a - buildTyped c.code, info, AddrOf, ptrTypeOf(c.m.nirm.types, setType): - copyTree c.code, b - c.code.addImmediateVal info, int(getSize(c.config, n[1].typ)) - c.code.addIntVal c.lit.numbers, info, c.m.nativeIntId, 0 - - else: - template body(target) = - buildTyped target, info, Eq, setType: - copyTree target, a - copyTree target, b - intoDest d, info, Bool8Id, body - - freeTemp c, b - freeTemp c, a - -proc beginCountLoop(c: var ProcCon; info: PackedLineInfo; first, last: int): (SymId, LabelId, LabelId) = - let tmp = allocTemp(c, c.m.nativeIntId) - c.code.addSummon info, tmp, c.m.nativeIntId - buildTyped c.code, info, Asgn, c.m.nativeIntId: - c.code.addSymUse info, tmp - c.code.addIntVal c.lit.numbers, info, c.m.nativeIntId, first - let lab1 = c.code.addNewLabel(c.labelGen, info, LoopLabel) - result = (tmp, lab1, newLabel(c.labelGen)) - - buildTyped c.code, info, Select, Bool8Id: - buildTyped c.code, info, Lt, c.m.nativeIntId: - c.code.addSymUse info, tmp - c.code.addIntVal c.lit.numbers, info, c.m.nativeIntId, last - build c.code, info, SelectPair: - build c.code, info, SelectValue: - c.code.boolVal(c.lit.numbers, info, false) - c.code.gotoLabel info, Goto, result[2] - -proc beginCountLoop(c: var ProcCon; info: PackedLineInfo; first, last: Value): (SymId, LabelId, LabelId) = - let tmp = allocTemp(c, c.m.nativeIntId) - c.code.addSummon info, tmp, c.m.nativeIntId - buildTyped c.code, info, Asgn, c.m.nativeIntId: - c.code.addSymUse info, tmp - copyTree c.code, first - let lab1 = c.code.addNewLabel(c.labelGen, info, LoopLabel) - result = (tmp, lab1, newLabel(c.labelGen)) - - buildTyped c.code, info, Select, Bool8Id: - buildTyped c.code, info, Le, c.m.nativeIntId: - c.code.addSymUse info, tmp - copyTree c.code, last - build c.code, info, SelectPair: - build c.code, info, SelectValue: - c.code.boolVal(c.lit.numbers, info, false) - c.code.gotoLabel info, Goto, result[2] - -proc endLoop(c: var ProcCon; info: PackedLineInfo; s: SymId; back, exit: LabelId) = - buildTyped c.code, info, Asgn, c.m.nativeIntId: - c.code.addSymUse info, s - buildTyped c.code, info, Add, c.m.nativeIntId: - c.code.addSymUse info, s - c.code.addIntVal c.lit.numbers, info, c.m.nativeIntId, 1 - c.code.addLabel info, GotoLoop, back - c.code.addLabel info, Label, exit - freeTemp(c.sm, s) - -proc genLeSet(c: var ProcCon; n: PNode; d: var Value) = - let info = toLineInfo(c, n.info) - let a = c.genx(n[1]) - let b = c.genx(n[2]) - let t = typeToIr(c.m, n.typ) - - let setType = typeToIr(c.m, n[1].typ) - - if c.m.nirm.types[setType].kind == ArrayTy: - let elemType = bitsetBasetype(c.m.types, c.m.nirm.types, n[1].typ) - if isEmpty(d): d = getTemp(c, n) - # "for ($1 = 0; $1 < $2; $1++):" - # " $3 = (($4[$1] & ~ $5[$1]) == 0)" - # " if (!$3) break;" - let (idx, backLabel, endLabel) = beginCountLoop(c, info, 0, int(getSize(c.config, n[1].typ))) - buildTyped c.code, info, Asgn, Bool8Id: - copyTree c.code, d - buildTyped c.code, info, Eq, elemType: - buildTyped c.code, info, BitAnd, elemType: - buildTyped c.code, info, ArrayAt, setType: - copyTree c.code, a - c.code.addSymUse info, idx - buildTyped c.code, info, BitNot, elemType: - buildTyped c.code, info, ArrayAt, setType: - copyTree c.code, b - c.code.addSymUse info, idx - c.code.addIntVal c.lit.numbers, info, elemType, 0 - - # if !$3: break - buildTyped c.code, info, Select, Bool8Id: - c.code.copyTree d - build c.code, info, SelectPair: - build c.code, info, SelectValue: - c.code.boolVal(c.lit.numbers, info, false) - c.code.gotoLabel info, Goto, endLabel - - endLoop(c, info, idx, backLabel, endLabel) - else: - # "(($1 & ~ $2)==0)" - template body(target) = - buildTyped target, info, Eq, setType: - buildTyped target, info, BitAnd, setType: - copyTree target, a - buildTyped target, info, BitNot, setType: - copyTree target, b - target.addIntVal c.lit.numbers, info, setType, 0 - - intoDest d, info, Bool8Id, body - - freeTemp c, b - freeTemp c, a - -proc genLtSet(c: var ProcCon; n: PNode; d: var Value) = - localError(c.m.graph.config, n.info, "`<` for sets not implemented") - -proc genBinarySet(c: var ProcCon; n: PNode; d: var Value; m: TMagic) = - let info = toLineInfo(c, n.info) - let a = c.genx(n[1]) - let b = c.genx(n[2]) - let t = typeToIr(c.m, n.typ) - - let setType = typeToIr(c.m, n[1].typ) - - if c.m.nirm.types[setType].kind == ArrayTy: - let elemType = bitsetBasetype(c.m.types, c.m.nirm.types, n[1].typ) - if isEmpty(d): d = getTemp(c, n) - # "for ($1 = 0; $1 < $2; $1++):" - # " $3 = (($4[$1] & ~ $5[$1]) == 0)" - # " if (!$3) break;" - let (idx, backLabel, endLabel) = beginCountLoop(c, info, 0, int(getSize(c.config, n[1].typ))) - buildTyped c.code, info, Asgn, elemType: - buildTyped c.code, info, ArrayAt, setType: - copyTree c.code, d - c.code.addSymUse info, idx - buildTyped c.code, info, (if m == mPlusSet: BitOr else: BitAnd), elemType: - buildTyped c.code, info, ArrayAt, setType: - copyTree c.code, a - c.code.addSymUse info, idx - if m == mMinusSet: - buildTyped c.code, info, BitNot, elemType: - buildTyped c.code, info, ArrayAt, setType: - copyTree c.code, b - c.code.addSymUse info, idx - else: - buildTyped c.code, info, ArrayAt, setType: - copyTree c.code, b - c.code.addSymUse info, idx - - endLoop(c, info, idx, backLabel, endLabel) - else: - # "(($1 & ~ $2)==0)" - template body(target) = - buildTyped target, info, (if m == mPlusSet: BitOr else: BitAnd), setType: - copyTree target, a - if m == mMinusSet: - buildTyped target, info, BitNot, setType: - copyTree target, b - else: - copyTree target, b - - intoDest d, info, setType, body - - freeTemp c, b - freeTemp c, a - -proc genInclExcl(c: var ProcCon; n: PNode; m: TMagic) = - let info = toLineInfo(c, n.info) - let a = c.genx(n[1]) - let b = c.genx(n[2]) - - let setType = typeToIr(c.m, n[1].typ) - - let t = bitsetBasetype(c.m.types, c.m.nirm.types, n[1].typ) - let mask = - case t - of UInt8Id: 7 - of UInt16Id: 15 - of UInt32Id: 31 - else: 63 - - buildTyped c.code, info, Asgn, setType: - if c.m.nirm.types[setType].kind == ArrayTy: - if m == mIncl: - # $1[(NU)($2)>>3] |=(1U<<($2&7U)) - buildTyped c.code, info, ArrayAt, setType: - copyTree c.code, a - buildTyped c.code, info, BitShr, t: - buildTyped c.code, info, Cast, c.m.nativeUIntId: - copyTree c.code, b - addIntVal c.code, c.lit.numbers, info, c.m.nativeUIntId, 3 - buildTyped c.code, info, BitOr, t: - buildTyped c.code, info, ArrayAt, setType: - copyTree c.code, a - buildTyped c.code, info, BitShr, t: - buildTyped c.code, info, Cast, c.m.nativeUIntId: - copyTree c.code, b - addIntVal c.code, c.lit.numbers, info, c.m.nativeUIntId, 3 - buildTyped c.code, info, BitShl, t: - c.code.addIntVal c.lit.numbers, info, t, 1 - buildTyped c.code, info, BitAnd, t: - copyTree c.code, b - c.code.addIntVal c.lit.numbers, info, t, 7 - else: - # $1[(NU)($2)>>3] &= ~(1U<<($2&7U)) - buildTyped c.code, info, ArrayAt, setType: - copyTree c.code, a - buildTyped c.code, info, BitShr, t: - buildTyped c.code, info, Cast, c.m.nativeUIntId: - copyTree c.code, b - addIntVal c.code, c.lit.numbers, info, c.m.nativeUIntId, 3 - buildTyped c.code, info, BitAnd, t: - buildTyped c.code, info, ArrayAt, setType: - copyTree c.code, a - buildTyped c.code, info, BitShr, t: - buildTyped c.code, info, Cast, c.m.nativeUIntId: - copyTree c.code, b - addIntVal c.code, c.lit.numbers, info, c.m.nativeUIntId, 3 - buildTyped c.code, info, BitNot, t: - buildTyped c.code, info, BitShl, t: - c.code.addIntVal c.lit.numbers, info, t, 1 - buildTyped c.code, info, BitAnd, t: - copyTree c.code, b - c.code.addIntVal c.lit.numbers, info, t, 7 - - else: - copyTree c.code, a - if m == mIncl: - # $1 |= ((NU8)1)<<(($2) & 7) - buildTyped c.code, info, BitOr, setType: - copyTree c.code, a - buildTyped c.code, info, BitShl, t: - c.code.addIntVal c.lit.numbers, info, t, 1 - buildTyped c.code, info, BitAnd, t: - copyTree c.code, b - c.code.addIntVal c.lit.numbers, info, t, mask - else: - # $1 &= ~(((NU8)1) << (($2) & 7)) - buildTyped c.code, info, BitAnd, setType: - copyTree c.code, a - buildTyped c.code, info, BitNot, t: - buildTyped c.code, info, BitShl, t: - c.code.addIntVal c.lit.numbers, info, t, 1 - buildTyped c.code, info, BitAnd, t: - copyTree c.code, b - c.code.addIntVal c.lit.numbers, info, t, mask - freeTemp c, b - freeTemp c, a - -proc genSetConstrDyn(c: var ProcCon; n: PNode; d: var Value) = - # example: { a..b, c, d, e, f..g } - # we have to emit an expression of the form: - # nimZeroMem(tmp, sizeof(tmp)); inclRange(tmp, a, b); incl(tmp, c); - # incl(tmp, d); incl(tmp, e); inclRange(tmp, f, g); - let info = toLineInfo(c, n.info) - let setType = typeToIr(c.m, n.typ) - let size = int(getSize(c.config, n.typ)) - let t = bitsetBasetype(c.m.types, c.m.nirm.types, n.typ) - let mask = - case t - of UInt8Id: 7 - of UInt16Id: 15 - of UInt32Id: 31 - else: 63 - - if isEmpty(d): d = getTemp(c, n) - if c.m.nirm.types[setType].kind != ArrayTy: - buildTyped c.code, info, Asgn, setType: - copyTree c.code, d - c.code.addIntVal c.lit.numbers, info, t, 0 - - for it in n: - if it.kind == nkRange: - let a = genx(c, it[0]) - let b = genx(c, it[1]) - let (idx, backLabel, endLabel) = beginCountLoop(c, info, a, b) - buildTyped c.code, info, Asgn, setType: - copyTree c.code, d - buildTyped c.code, info, BitAnd, setType: - copyTree c.code, d - buildTyped c.code, info, BitNot, t: - buildTyped c.code, info, BitShl, t: - c.code.addIntVal c.lit.numbers, info, t, 1 - buildTyped c.code, info, BitAnd, t: - c.code.addSymUse info, idx - c.code.addIntVal c.lit.numbers, info, t, mask - - endLoop(c, info, idx, backLabel, endLabel) - freeTemp c, b - freeTemp c, a - - else: - let a = genx(c, it) - buildTyped c.code, info, Asgn, setType: - copyTree c.code, d - buildTyped c.code, info, BitAnd, setType: - copyTree c.code, d - buildTyped c.code, info, BitNot, t: - buildTyped c.code, info, BitShl, t: - c.code.addIntVal c.lit.numbers, info, t, 1 - buildTyped c.code, info, BitAnd, t: - copyTree c.code, a - c.code.addIntVal c.lit.numbers, info, t, mask - freeTemp c, a - - else: - # init loop: - let (idx, backLabel, endLabel) = beginCountLoop(c, info, 0, size) - buildTyped c.code, info, Asgn, t: - copyTree c.code, d - c.code.addIntVal c.lit.numbers, info, t, 0 - endLoop(c, info, idx, backLabel, endLabel) - - # incl elements: - for it in n: - if it.kind == nkRange: - let a = genx(c, it[0]) - let b = genx(c, it[1]) - let (idx, backLabel, endLabel) = beginCountLoop(c, info, a, b) - - buildTyped c.code, info, Asgn, t: - buildTyped c.code, info, ArrayAt, setType: - copyTree c.code, d - buildTyped c.code, info, BitShr, t: - buildTyped c.code, info, Cast, c.m.nativeUIntId: - c.code.addSymUse info, idx - addIntVal c.code, c.lit.numbers, info, c.m.nativeUIntId, 3 - buildTyped c.code, info, BitOr, t: - buildTyped c.code, info, ArrayAt, setType: - copyTree c.code, d - buildTyped c.code, info, BitShr, t: - buildTyped c.code, info, Cast, c.m.nativeUIntId: - c.code.addSymUse info, idx - addIntVal c.code, c.lit.numbers, info, c.m.nativeUIntId, 3 - buildTyped c.code, info, BitShl, t: - c.code.addIntVal c.lit.numbers, info, t, 1 - buildTyped c.code, info, BitAnd, t: - c.code.addSymUse info, idx - c.code.addIntVal c.lit.numbers, info, t, 7 - - endLoop(c, info, idx, backLabel, endLabel) - freeTemp c, b - freeTemp c, a - - else: - let a = genx(c, it) - # $1[(NU)($2)>>3] |=(1U<<($2&7U)) - buildTyped c.code, info, Asgn, t: - buildTyped c.code, info, ArrayAt, setType: - copyTree c.code, d - buildTyped c.code, info, BitShr, t: - buildTyped c.code, info, Cast, c.m.nativeUIntId: - copyTree c.code, a - addIntVal c.code, c.lit.numbers, info, c.m.nativeUIntId, 3 - buildTyped c.code, info, BitOr, t: - buildTyped c.code, info, ArrayAt, setType: - copyTree c.code, d - buildTyped c.code, info, BitShr, t: - buildTyped c.code, info, Cast, c.m.nativeUIntId: - copyTree c.code, a - addIntVal c.code, c.lit.numbers, info, c.m.nativeUIntId, 3 - buildTyped c.code, info, BitShl, t: - c.code.addIntVal c.lit.numbers, info, t, 1 - buildTyped c.code, info, BitAnd, t: - copyTree c.code, a - c.code.addIntVal c.lit.numbers, info, t, 7 - freeTemp c, a - -proc genSetConstr(c: var ProcCon; n: PNode; d: var Value) = - if isDeepConstExpr(n): - let info = toLineInfo(c, n.info) - let setType = typeToIr(c.m, n.typ) - let size = int(getSize(c.config, n.typ)) - let cs = toBitSet(c.config, n) - - if c.m.nirm.types[setType].kind != ArrayTy: - template body(target) = - target.addIntVal c.lit.numbers, info, setType, cast[BiggestInt](bitSetToWord(cs, size)) - intoDest d, info, setType, body - else: - let t = bitsetBasetype(c.m.types, c.m.nirm.types, n.typ) - template body(target) = - buildTyped target, info, ArrayConstr, setType: - for i in 0..high(cs): - target.addIntVal c.lit.numbers, info, t, int64 cs[i] - intoDest d, info, setType, body - else: - genSetConstrDyn c, n, d - -proc genStrConcat(c: var ProcCon; n: PNode; d: var Value) = - let info = toLineInfo(c, n.info) - # <Nim code> - # s = "Hello " & name & ", how do you feel?" & 'z' - # - # <generated code> - # { - # string tmp0; - # ... - # tmp0 = rawNewString(6 + 17 + 1 + s2->len); - # // we cannot generate s = rawNewString(...) here, because - # // ``s`` may be used on the right side of the expression - # appendString(tmp0, strlit_1); - # appendString(tmp0, name); - # appendString(tmp0, strlit_2); - # appendChar(tmp0, 'z'); - # asgn(s, tmp0); - # } - var args: seq[Value] = @[] - var argsRuntimeLen: seq[Value] = @[] - - var precomputedLen = 0 - for i in 1 ..< n.len: - let it = n[i] - args.add genx(c, it) - if skipTypes(it.typ, abstractVarRange).kind == tyChar: - inc precomputedLen - elif it.kind in {nkStrLit..nkTripleStrLit}: - inc precomputedLen, it.strVal.len - else: - argsRuntimeLen.add args[^1] - - # generate length computation: - var tmpLen = allocTemp(c, c.m.nativeIntId) - buildTyped c.code, info, Asgn, c.m.nativeIntId: - c.code.addSymUse info, tmpLen - c.code.addIntVal c.lit.numbers, info, c.m.nativeIntId, precomputedLen - for a in mitems(argsRuntimeLen): - buildTyped c.code, info, Asgn, c.m.nativeIntId: - c.code.addSymUse info, tmpLen - buildTyped c.code, info, CheckedAdd, c.m.nativeIntId: - c.code.addLabel info, CheckedGoto, c.exitLabel - c.code.addSymUse info, tmpLen - buildTyped c.code, info, FieldAt, typeToIr(c.m, n.typ): - copyTree c.code, a - c.code.addImmediateVal info, 0 # (len, p)-pair so len is at index 0 - - var tmpStr = getTemp(c, n) - # ^ because of aliasing, we always go through a temporary - let t = typeToIr(c.m, n.typ) - buildTyped c.code, info, Asgn, t: - copyTree c.code, tmpStr - buildTyped c.code, info, Call, t: - let codegenProc = magicsys.getCompilerProc(c.m.graph, "rawNewString") - #assert codegenProc != nil, $n & " " & (c.m.graph.config $ n.info) - let theProc = c.genx newSymNode(codegenProc, n.info) - copyTree c.code, theProc - c.code.addSymUse info, tmpLen - freeTemp c.sm, tmpLen - - for i in 1 ..< n.len: - let it = n[i] - let isChar = skipTypes(it.typ, abstractVarRange).kind == tyChar - buildTyped c.code, info, Call, VoidId: - let codegenProc = magicsys.getCompilerProc(c.m.graph, - (if isChar: "appendChar" else: "appendString")) - #assert codegenProc != nil, $n & " " & (c.m.graph.config $ n.info) - let theProc = c.genx newSymNode(codegenProc, n.info) - copyTree c.code, theProc - buildTyped c.code, info, AddrOf, ptrTypeOf(c.m.nirm.types, t): - copyTree c.code, tmpStr - copyTree c.code, args[i-1] - freeTemp c, args[i-1] - - if isEmpty(d): - d = tmpStr - else: - # XXX Test that this does not cause memory leaks! - buildTyped c.code, info, Asgn, t: - copyTree c.code, d - copyTree c.code, tmpStr - -proc genDefault(c: var ProcCon; n: PNode; d: var Value) = - let m = expandDefault(n.typ, n.info) - gen c, m, d - -proc genWasMoved(c: var ProcCon; n: PNode) = - let n1 = n[1].skipAddr - # XXX We need a way to replicate this logic or better yet a better - # solution for injectdestructors.nim: - #if c.withinBlockLeaveActions > 0 and notYetAlive(n1): - var d = c.genx(n1) - assert not isEmpty(d) - let m = expandDefault(n1.typ, n1.info) - gen c, m, d - -proc genMove(c: var ProcCon; n: PNode; d: var Value) = - let info = toLineInfo(c, n.info) - let n1 = n[1].skipAddr - var a = c.genx(n1) - if n.len == 4: - # generated by liftdestructors: - let src = c.genx(n[2]) - # if ($1.p == $2.p) goto lab1 - let lab1 = newLabel(c.labelGen) - - let n1t = typeToIr(c.m, n1.typ) - let payloadType = seqPayloadPtrType(c.m.types, c.m.nirm.types, n1.typ)[0] - buildTyped c.code, info, Select, Bool8Id: - buildTyped c.code, info, Eq, payloadType: - buildTyped c.code, info, FieldAt, n1t: - copyTree c.code, a - c.code.addImmediateVal info, 1 # (len, p)-pair - buildTyped c.code, info, FieldAt, n1t: - copyTree c.code, src - c.code.addImmediateVal info, 1 # (len, p)-pair - - build c.code, info, SelectPair: - build c.code, info, SelectValue: - c.code.boolVal(c.lit.numbers, info, true) - c.code.gotoLabel info, Goto, lab1 - - gen(c, n[3]) - c.patch n, lab1 - - buildTyped c.code, info, Asgn, typeToIr(c.m, n1.typ): - copyTree c.code, a - copyTree c.code, src - - else: - if isEmpty(d): d = getTemp(c, n) - buildTyped c.code, info, Asgn, typeToIr(c.m, n1.typ): - copyTree c.code, d - copyTree c.code, a - var op = getAttachedOp(c.m.graph, n.typ, attachedWasMoved) - if op == nil or skipTypes(n1.typ, abstractVar+{tyStatic}).kind in {tyOpenArray, tyVarargs}: - let m = expandDefault(n1.typ, n1.info) - gen c, m, a - else: - var opB = c.genx(newSymNode(op)) - buildTyped c.code, info, Call, typeToIr(c.m, n.typ): - copyTree c.code, opB - buildTyped c.code, info, AddrOf, ptrTypeOf(c.m.nirm.types, typeToIr(c.m, n1.typ)): - copyTree c.code, a - -template fieldAt(x: Value; i: int; t: TypeId): Tree = - var result = default(Tree) - buildTyped result, info, FieldAt, t: - copyTree result, x - result.addImmediateVal info, i - result - -template eqNil(x: Tree; t: TypeId): Tree = - var result = default(Tree) - buildTyped result, info, Eq, t: - copyTree result, x - result.addNilVal info, t - result - -template eqZero(x: Tree): Tree = - var result = default(Tree) - buildTyped result, info, Eq, c.m.nativeIntId: - copyTree result, x - result.addIntVal c.lit.numbers, info, c.m.nativeIntId, 0 - result - -template bitOp(x: Tree; opc: Opcode; y: int): Tree = - var result = default(Tree) - buildTyped result, info, opc, c.m.nativeIntId: - copyTree result, x - result.addIntVal c.lit.numbers, info, c.m.nativeIntId, y - result - -proc genDestroySeq(c: var ProcCon; n: PNode; t: PType) = - let info = toLineInfo(c, n.info) - let strLitFlag = 1 shl (c.m.graph.config.target.intSize * 8 - 2) # see also NIM_STRLIT_FLAG - - let x = c.genx(n[1]) - let baseType = t.lastSon - - let seqType = typeToIr(c.m, t) - let p = fieldAt(x, 0, seqType) - - # if $1.p != nil and ($1.p.cap and NIM_STRLIT_FLAG) == 0: - # alignedDealloc($1.p, NIM_ALIGNOF($2)) - buildIfNot p.eqNil(seqType): - buildIf fieldAt(Value(p), 0, seqPayloadPtrType(c.m.types, c.m.nirm.types, t)[0]).bitOp(BitAnd, 0).eqZero(): - let codegenProc = getCompilerProc(c.m.graph, "alignedDealloc") - buildTyped c.code, info, Call, VoidId: - let theProc = c.genx newSymNode(codegenProc, n.info) - copyTree c.code, theProc - copyTree c.code, p - c.code.addImmediateVal info, int(getAlign(c.config, baseType)) - - freeTemp c, x - -proc genDestroy(c: var ProcCon; n: PNode) = - let t = n[1].typ.skipTypes(abstractInst) - case t.kind - of tyString: - var unused = default(Value) - genUnaryCp(c, n, unused, "nimDestroyStrV1") - of tySequence: - genDestroySeq(c, n, t) - else: discard "nothing to do" - -type - IndexFor = enum - ForSeq, ForStr, ForOpenArray, ForArray - -proc genIndexCheck(c: var ProcCon; n: PNode; a: Value; kind: IndexFor; arr: PType): Value = - if optBoundsCheck in c.options: - let info = toLineInfo(c, n.info) - result = default(Value) - let idx = genx(c, n) - build result, info, CheckedIndex: - result.Tree.addLabel info, CheckedGoto, c.exitLabel - copyTree result.Tree, idx - case kind - of ForSeq, ForStr: - buildTyped result, info, FieldAt, typeToIr(c.m, arr): - copyTree result.Tree, a - result.addImmediateVal info, 0 # (len, p)-pair - of ForOpenArray: - buildTyped result, info, FieldAt, typeToIr(c.m, arr): - copyTree result.Tree, a - result.addImmediateVal info, 1 # (p, len)-pair - of ForArray: - let x = toInt64 lengthOrd(c.config, arr) - result.addIntVal c.lit.numbers, info, c.m.nativeIntId, x - freeTemp c, idx - else: - result = genx(c, n) - -proc addSliceFields(c: var ProcCon; target: var Tree; info: PackedLineInfo; - x: Value; n: PNode; arrType: PType) = - let elemType = arrayPtrTypeOf(c.m.nirm.types, typeToIr(c.m, arrType.lastSon)) - case arrType.kind - of tyString, tySequence: - let checkKind = if arrType.kind == tyString: ForStr else: ForSeq - let pay = if checkKind == ForStr: c.m.strPayloadId - else: seqPayloadPtrType(c.m.types, c.m.nirm.types, arrType) - - let y = genIndexCheck(c, n[2], x, checkKind, arrType) - let z = genIndexCheck(c, n[3], x, checkKind, arrType) - - buildTyped target, info, ObjConstr, typeToIr(c.m, n.typ): - target.addImmediateVal info, 0 - buildTyped target, info, AddrOf, elemType: - buildTyped target, info, DerefArrayAt, pay[1]: - buildTyped target, info, FieldAt, typeToIr(c.m, arrType): - copyTree target, x - target.addImmediateVal info, 1 # (len, p)-pair - copyTree target, y - - # len: - target.addImmediateVal info, 1 - buildTyped target, info, Add, c.m.nativeIntId: - buildTyped target, info, Sub, c.m.nativeIntId: - copyTree target, z - copyTree target, y - target.addIntVal c.lit.numbers, info, c.m.nativeIntId, 1 - - freeTemp c, z - freeTemp c, y - of tyArray: - # XXX This evaluates the index check for `y` twice. - # This check is also still insufficient for non-zero based arrays. - let y = genIndexCheck(c, n[2], x, ForArray, arrType) - let z = genIndexCheck(c, n[3], x, ForArray, arrType) - - buildTyped target, info, ObjConstr, typeToIr(c.m, n.typ): - target.addImmediateVal info, 0 - buildTyped target, info, AddrOf, elemType: - buildTyped target, info, ArrayAt, typeToIr(c.m, arrType): - copyTree target, x - copyTree target, y - - target.addImmediateVal info, 1 - buildTyped target, info, Add, c.m.nativeIntId: - buildTyped target, info, Sub, c.m.nativeIntId: - copyTree target, z - copyTree target, y - target.addIntVal c.lit.numbers, info, c.m.nativeIntId, 1 - - freeTemp c, z - freeTemp c, y - of tyOpenArray: - # XXX This evaluates the index check for `y` twice. - let y = genIndexCheck(c, n[2], x, ForOpenArray, arrType) - let z = genIndexCheck(c, n[3], x, ForOpenArray, arrType) - let pay = openArrayPayloadType(c.m.types, c.m.nirm.types, arrType) - - buildTyped target, info, ObjConstr, typeToIr(c.m, n.typ): - target.addImmediateVal info, 0 - buildTyped target, info, AddrOf, elemType: - buildTyped target, info, DerefArrayAt, pay: - buildTyped target, info, FieldAt, typeToIr(c.m, arrType): - copyTree target, x - target.addImmediateVal info, 0 # (p, len)-pair - copyTree target, y - - target.addImmediateVal info, 1 - buildTyped target, info, Add, c.m.nativeIntId: - buildTyped target, info, Sub, c.m.nativeIntId: - copyTree target, z - copyTree target, y - target.addIntVal c.lit.numbers, info, c.m.nativeIntId, 1 - - freeTemp c, z - freeTemp c, y - else: - raiseAssert "addSliceFields: " & typeToString(arrType) - -proc genSlice(c: var ProcCon; n: PNode; d: var Value) = - let info = toLineInfo(c, n.info) - - let x = c.genx(n[1]) - - let arrType = n[1].typ.skipTypes(abstractVar) - - template body(target) = - c.addSliceFields target, info, x, n, arrType - - valueIntoDest c, info, d, arrType, body - freeTemp c, x - -proc genMagic(c: var ProcCon; n: PNode; d: var Value; m: TMagic) = - case m - of mAnd: c.genAndOr(n, opcFJmp, d) - of mOr: c.genAndOr(n, opcTJmp, d) - of mPred, mSubI: c.genBinaryOp(n, d, if optOverflowCheck in c.options: CheckedSub else: Sub) - of mSucc, mAddI: c.genBinaryOp(n, d, if optOverflowCheck in c.options: CheckedAdd else: Add) - of mInc: - unused(c, n, d) - c.genIncDec(n, if optOverflowCheck in c.options: CheckedAdd else: Add) - of mDec: - unused(c, n, d) - c.genIncDec(n, if optOverflowCheck in c.options: CheckedSub else: Sub) - of mOrd, mChr, mUnown: - c.gen(n[1], d) - of generatedMagics: - genCall(c, n, d) - of mNew, mNewFinalize: - unused(c, n, d) - c.genNew(n, needsInit = true) - of mNewSeq: - unused(c, n, d) - c.genNewSeq(n) - of mNewSeqOfCap: c.genNewSeqOfCap(n, d) - of mNewString, mNewStringOfCap, mExit: c.genCall(n, d) - of mLengthOpenArray, mLengthArray, mLengthSeq, mLengthStr: - genArrayLen(c, n, d) - of mMulI: genBinaryOp(c, n, d, if optOverflowCheck in c.options: CheckedMul else: Mul) - of mDivI: genBinaryOp(c, n, d, if optOverflowCheck in c.options: CheckedDiv else: Div) - of mModI: genBinaryOp(c, n, d, if optOverflowCheck in c.options: CheckedMod else: Mod) - of mAddF64: genBinaryOp(c, n, d, Add) - of mSubF64: genBinaryOp(c, n, d, Sub) - of mMulF64: genBinaryOp(c, n, d, Mul) - of mDivF64: genBinaryOp(c, n, d, Div) - of mShrI: genBinaryOp(c, n, d, BitShr) - of mShlI: genBinaryOp(c, n, d, BitShl) - of mAshrI: genBinaryOp(c, n, d, BitShr) - of mBitandI: genBinaryOp(c, n, d, BitAnd) - of mBitorI: genBinaryOp(c, n, d, BitOr) - of mBitxorI: genBinaryOp(c, n, d, BitXor) - of mAddU: genBinaryOp(c, n, d, Add) - of mSubU: genBinaryOp(c, n, d, Sub) - of mMulU: genBinaryOp(c, n, d, Mul) - of mDivU: genBinaryOp(c, n, d, Div) - of mModU: genBinaryOp(c, n, d, Mod) - of mEqI, mEqB, mEqEnum, mEqCh: - genCmpOp(c, n, d, Eq) - of mLeI, mLeEnum, mLeCh, mLeB: - genCmpOp(c, n, d, Le) - of mLtI, mLtEnum, mLtCh, mLtB: - genCmpOp(c, n, d, Lt) - of mEqF64: genCmpOp(c, n, d, Eq) - of mLeF64: genCmpOp(c, n, d, Le) - of mLtF64: genCmpOp(c, n, d, Lt) - of mLePtr, mLeU: genCmpOp(c, n, d, Le) - of mLtPtr, mLtU: genCmpOp(c, n, d, Lt) - of mEqProc, mEqRef: - genCmpOp(c, n, d, Eq) - of mXor: genBinaryOp(c, n, d, BitXor) - of mNot: genUnaryOp(c, n, d, BoolNot) - of mUnaryMinusI, mUnaryMinusI64: - genUnaryMinus(c, n, d) - #genNarrow(c, n, d) - of mUnaryMinusF64: genUnaryMinus(c, n, d) - of mUnaryPlusI, mUnaryPlusF64: gen(c, n[1], d) - of mBitnotI: - genUnaryOp(c, n, d, BitNot) - when false: - # XXX genNarrowU modified, do not narrow signed types - let t = skipTypes(n.typ, abstractVar-{tyTypeDesc}) - let size = getSize(c.config, t) - if t.kind in {tyUInt8..tyUInt32} or (t.kind == tyUInt and size < 8): - c.gABC(n, opcNarrowU, d, TRegister(size*8)) - of mStrToStr, mEnsureMove: c.gen n[1], d - of mIntToStr: genUnaryCp(c, n, d, "nimIntToStr") - of mInt64ToStr: genUnaryCp(c, n, d, "nimInt64ToStr") - of mBoolToStr: genUnaryCp(c, n, d, "nimBoolToStr") - of mCharToStr: genUnaryCp(c, n, d, "nimCharToStr") - of mFloatToStr: - if n[1].typ.skipTypes(abstractInst).kind == tyFloat32: - genUnaryCp(c, n, d, "nimFloat32ToStr") - else: - genUnaryCp(c, n, d, "nimFloatToStr") - of mCStrToStr: genUnaryCp(c, n, d, "cstrToNimstr") - of mEnumToStr: genEnumToStr(c, n, d) - - of mEqStr: genBinaryCp(c, n, d, "eqStrings") - of mEqCString: genCall(c, n, d) - of mLeStr: genBinaryCp(c, n, d, "leStrings") - of mLtStr: genBinaryCp(c, n, d, "ltStrings") - - of mSetLengthStr: - unused(c, n, d) - let nb = copyTree(n) - nb[1] = makeAddr(nb[1], c.m.idgen) - genBinaryCp(c, nb, d, "setLengthStrV2") - - of mSetLengthSeq: - unused(c, n, d) - let nb = copyTree(n) - nb[1] = makeAddr(nb[1], c.m.idgen) - genCall(c, nb, d) - - of mSwap: - unused(c, n, d) - c.gen(lowerSwap(c.m.graph, n, c.m.idgen, - if c.prc == nil: c.m.module else: c.prc), d) - of mParseBiggestFloat: - genCall c, n, d - of mHigh: - c.genHigh n, d - - of mEcho: - unused(c, n, d) - genUnaryCp c, n, d, "echoBinSafe" - - of mAppendStrCh: - unused(c, n, d) - let nb = copyTree(n) - nb[1] = makeAddr(nb[1], c.m.idgen) - genBinaryCp(c, nb, d, "nimAddCharV1") - of mMinI, mMaxI, mAbsI, mDotDot: - c.genCall(n, d) - of mSizeOf: - localError(c.config, n.info, sizeOfLikeMsg("sizeof")) - of mAlignOf: - localError(c.config, n.info, sizeOfLikeMsg("alignof")) - of mOffsetOf: - localError(c.config, n.info, sizeOfLikeMsg("offsetof")) - of mRunnableExamples: - discard "just ignore any call to runnableExamples" - of mOf: genOf(c, n, d) - of mAppendStrStr: - unused(c, n, d) - let nb = copyTree(n) - nb[1] = makeAddr(nb[1], c.m.idgen) - genBinaryCp(c, nb, d, "nimAddStrV1") - of mAppendSeqElem: - unused(c, n, d) - let nb = copyTree(n) - nb[1] = makeAddr(nb[1], c.m.idgen) - genCall(c, nb, d) - of mIsNil: genIsNil(c, n, d) - of mInSet: genInSet(c, n, d) - of mCard: genCard(c, n, d) - of mEqSet: genEqSet(c, n, d) - of mLeSet: genLeSet(c, n, d) - of mLtSet: genLtSet(c, n, d) - of mMulSet: genBinarySet(c, n, d, m) - of mPlusSet: genBinarySet(c, n, d, m) - of mMinusSet: genBinarySet(c, n, d, m) - of mIncl, mExcl: - unused(c, n, d) - genInclExcl(c, n, m) - of mConStrStr: genStrConcat(c, n, d) - of mDefault, mZeroDefault: - genDefault c, n, d - of mMove: genMove(c, n, d) - of mWasMoved, mReset: - unused(c, n, d) - genWasMoved(c, n) - of mDestroy: genDestroy(c, n) - #of mAccessEnv: unaryExpr(d, n, d, "$1.ClE_0") - #of mAccessTypeField: genAccessTypeField(c, n, d) - of mSlice: genSlice(c, n, d) - of mTrace: discard "no code to generate" - else: - # mGCref, mGCunref: unused by ORC - globalError(c.config, n.info, "cannot generate code for: " & $m) - -proc canElimAddr(n: PNode; idgen: IdGenerator): PNode = - result = nil - case n[0].kind - of nkObjUpConv, nkObjDownConv, nkChckRange, nkChckRangeF, nkChckRange64: - var m = n[0][0] - if m.kind in {nkDerefExpr, nkHiddenDeref}: - # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) - result = copyNode(n[0]) - result.add m[0] - if n.typ.skipTypes(abstractVar).kind != tyOpenArray: - result.typ = n.typ - elif n.typ.skipTypes(abstractInst).kind in {tyVar}: - result.typ = toVar(result.typ, n.typ.skipTypes(abstractInst).kind, idgen) - of nkHiddenStdConv, nkHiddenSubConv, nkConv: - var m = n[0][1] - if m.kind in {nkDerefExpr, nkHiddenDeref}: - # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) - result = copyNode(n[0]) - result.add n[0][0] - result.add m[0] - if n.typ.skipTypes(abstractVar).kind != tyOpenArray: - result.typ = n.typ - elif n.typ.skipTypes(abstractInst).kind in {tyVar}: - result.typ = toVar(result.typ, n.typ.skipTypes(abstractInst).kind, idgen) - else: - if n[0].kind in {nkDerefExpr, nkHiddenDeref}: - # addr ( deref ( x )) --> x - result = n[0][0] - -proc genAddr(c: var ProcCon; n: PNode; d: var Value, flags: GenFlags) = - if (let m = canElimAddr(n, c.m.idgen); m != nil): - gen(c, m, d, flags) - return - - let info = toLineInfo(c, n.info) - let tmp = c.genx(n[0], flags) - template body(target) = - buildTyped target, info, AddrOf, typeToIr(c.m, n.typ): - copyTree target, tmp - - valueIntoDest c, info, d, n.typ, body - freeTemp c, tmp - -proc genDeref(c: var ProcCon; n: PNode; d: var Value; flags: GenFlags) = - let info = toLineInfo(c, n.info) - let tmp = c.genx(n[0], flags) - template body(target) = - buildTyped target, info, Load, typeToIr(c.m, n.typ): - copyTree target, tmp - - valueIntoDest c, info, d, n.typ, body - freeTemp c, tmp - -proc addAddrOfFirstElem(c: var ProcCon; target: var Tree; info: PackedLineInfo; tmp: Value; typ: PType) = - let arrType = typ.skipTypes(abstractVar) - let elemType = arrayPtrTypeOf(c.m.nirm.types, typeToIr(c.m, arrType.lastSon)) - case arrType.kind - of tyString: - let t = typeToIr(c.m, typ) - target.addImmediateVal info, 0 - buildTyped target, info, AddrOf, elemType: - buildTyped target, info, DerefArrayAt, c.m.strPayloadId[1]: - buildTyped target, info, FieldAt, typeToIr(c.m, arrType): - copyTree target, tmp - target.addImmediateVal info, 1 # (len, p)-pair - target.addIntVal c.lit.numbers, info, c.m.nativeIntId, 0 - # len: - target.addImmediateVal info, 1 - buildTyped target, info, FieldAt, typeToIr(c.m, arrType): - copyTree target, tmp - target.addImmediateVal info, 0 # (len, p)-pair so len is at index 0 - - of tySequence: - let t = typeToIr(c.m, typ) - target.addImmediateVal info, 0 - buildTyped target, info, AddrOf, elemType: - buildTyped target, info, DerefArrayAt, seqPayloadPtrType(c.m.types, c.m.nirm.types, typ)[1]: - buildTyped target, info, FieldAt, typeToIr(c.m, arrType): - copyTree target, tmp - target.addImmediateVal info, 1 # (len, p)-pair - target.addIntVal c.lit.numbers, info, c.m.nativeIntId, 0 - # len: - target.addImmediateVal info, 1 - buildTyped target, info, FieldAt, typeToIr(c.m, arrType): - copyTree target, tmp - target.addImmediateVal info, 0 # (len, p)-pair so len is at index 0 - - of tyArray: - let t = typeToIr(c.m, arrType) - target.addImmediateVal info, 0 - buildTyped target, info, AddrOf, elemType: - buildTyped target, info, ArrayAt, t: - copyTree target, tmp - target.addIntVal c.lit.numbers, info, c.m.nativeIntId, 0 - target.addImmediateVal info, 1 - target.addIntVal(c.lit.numbers, info, c.m.nativeIntId, toInt lengthOrd(c.config, arrType)) - else: - raiseAssert "addAddrOfFirstElem: " & typeToString(typ) - -proc genToOpenArrayConv(c: var ProcCon; arg: PNode; d: var Value; flags: GenFlags; destType: PType) = - let info = toLineInfo(c, arg.info) - let tmp = c.genx(arg, flags) - let arrType = destType.skipTypes(abstractVar) - template body(target) = - buildTyped target, info, ObjConstr, typeToIr(c.m, arrType): - c.addAddrOfFirstElem target, info, tmp, arg.typ - - valueIntoDest c, info, d, arrType, body - freeTemp c, tmp - -proc genConv(c: var ProcCon; n, arg: PNode; d: var Value; flags: GenFlags; opc: Opcode) = - let targetType = n.typ.skipTypes({tyDistinct}) - let argType = arg.typ.skipTypes({tyDistinct}) - - if sameBackendType(targetType, argType) or ( - argType.kind == tyProc and targetType.kind == argType.kind): - # don't do anything for lambda lifting conversions: - gen c, arg, d - return - - if opc != Cast and targetType.skipTypes({tyVar, tyLent}).kind in {tyOpenArray, tyVarargs} and - argType.skipTypes({tyVar, tyLent}).kind notin {tyOpenArray, tyVarargs}: - genToOpenArrayConv c, arg, d, flags, n.typ - return - - let info = toLineInfo(c, n.info) - let tmp = c.genx(arg, flags) - template body(target) = - buildTyped target, info, opc, typeToIr(c.m, n.typ): - if opc == CheckedObjConv: - target.addLabel info, CheckedGoto, c.exitLabel - copyTree target, tmp - - valueIntoDest c, info, d, n.typ, body - freeTemp c, tmp - -proc genObjOrTupleConstr(c: var ProcCon; n: PNode; d: var Value; t: PType) = - # XXX x = (x.old, 22) produces wrong code ... stupid self assignments - let info = toLineInfo(c, n.info) - template body(target) = - buildTyped target, info, ObjConstr, typeToIr(c.m, t): - for i in ord(n.kind == nkObjConstr)..<n.len: - let it = n[i] - if it.kind == nkExprColonExpr: - genField(c, it[0], Value target) - let tmp = c.genx(it[1]) - copyTree target, tmp - c.freeTemp(tmp) - else: - let tmp = c.genx(it) - target.addImmediateVal info, i - copyTree target, tmp - c.freeTemp(tmp) - - if isException(t): - target.addImmediateVal info, 1 # "name" field is at position after the "parent". See system.nim - target.addStrVal c.lit.strings, info, t.skipTypes(abstractInst).sym.name.s - - constrIntoDest c, info, d, t, body - -proc genRefObjConstr(c: var ProcCon; n: PNode; d: var Value) = - if isEmpty(d): d = getTemp(c, n) - let info = toLineInfo(c, n.info) - let refType = n.typ.skipTypes(abstractInstOwned) - let objType = refType.lastSon - - rawGenNew(c, d, refType, n.info, needsInit = nfAllFieldsSet notin n.flags) - var deref = default(Value) - deref.buildTyped info, Load, typeToIr(c.m, objType): - deref.Tree.copyTree d - genObjOrTupleConstr c, n, deref, objType - -proc genSeqConstr(c: var ProcCon; n: PNode; d: var Value) = - if isEmpty(d): d = getTemp(c, n) - - let info = toLineInfo(c, n.info) - let seqtype = skipTypes(n.typ, abstractVarRange) - let baseType = seqtype.lastSon - - var b = default(Value) - b.addIntVal c.lit.numbers, info, c.m.nativeIntId, n.len - - genNewSeqPayload(c, info, d, b, seqtype) - - for i in 0..<n.len: - var dd = default(Value) - buildTyped dd, info, DerefArrayAt, seqPayloadPtrType(c.m.types, c.m.nirm.types, seqtype)[1]: - buildTyped dd, info, FieldAt, typeToIr(c.m, seqtype): - copyTree Tree(dd), d - dd.addImmediateVal info, 1 # (len, p)-pair - dd.addIntVal c.lit.numbers, info, c.m.nativeIntId, i - gen(c, n[i], dd) - - freeTemp c, d - -proc genArrayConstr(c: var ProcCon; n: PNode, d: var Value) = - let seqType = n.typ.skipTypes(abstractVar-{tyTypeDesc}) - if seqType.kind == tySequence: - genSeqConstr(c, n, d) - return - - let info = toLineInfo(c, n.info) - template body(target) = - buildTyped target, info, ArrayConstr, typeToIr(c.m, n.typ): - for i in 0..<n.len: - let tmp = c.genx(n[i]) - copyTree target, tmp - c.freeTemp(tmp) - - constrIntoDest c, info, d, n.typ, body - -proc genAsgn2(c: var ProcCon; a, b: PNode) = - assert a != nil - assert b != nil - var d = c.genx(a) - c.gen b, d - -proc irModule(c: var ProcCon; owner: PSym): string = - #if owner == c.m.module: "" else: - customPath(toFullPath(c.config, owner.info)) - -proc fromForeignModule(c: ProcCon; s: PSym): bool {.inline.} = - result = ast.originatingModule(s) != c.m.module and not c.m.noModularity - -proc genForeignVar(c: var ProcCon; s: PSym) = - var opc: Opcode - if s.kind == skConst: - opc = SummonConst - elif sfThread in s.flags: - opc = SummonThreadLocal - else: - assert sfGlobal in s.flags - opc = SummonGlobal - let t = typeToIr(c.m, s.typ) - let info = toLineInfo(c, s.info) - build c.code, info, ForeignDecl: - buildTyped c.code, info, opc, t: - build c.code, info, ModuleSymUse: - c.code.addStrVal c.lit.strings, info, irModule(c, ast.originatingModule(s)) - c.code.addImmediateVal info, s.itemId.item.int - -proc genVarSection(c: var ProcCon; n: PNode) = - for a in n: - if a.kind == nkCommentStmt: continue - #assert(a[0].kind == nkSym) can happen for transformed vars - if a.kind == nkVarTuple: - c.gen(lowerTupleUnpacking(c.m.graph, a, c.m.idgen, c.prc)) - else: - var vn = a[0] - if vn.kind == nkPragmaExpr: vn = vn[0] - if vn.kind == nkSym: - let s = vn.sym - if s.kind == skConst: - if dontInlineConstant(n, s.astdef): - let symId = toSymId(c, s) - c.m.nirm.symnames[symId] = c.lit.strings.getOrIncl(s.name.s) - let val = c.genx(s.astdef) - let info = toLineInfo(c, a.info) - buildTyped c.code, info, SummonConst, typeToIr(c.m, s.typ): - c.code.addSymDef info, symId - c.code.copyTree val - freeTemp c, val - else: - var opc: Opcode - if sfThread in s.flags: - opc = SummonThreadLocal - elif sfGlobal in s.flags: - opc = SummonGlobal - else: - opc = Summon - #assert t.int >= 0, typeToString(s.typ) & (c.config $ n.info) - let symId = toSymId(c, s) - c.code.addSummon toLineInfo(c, a.info), symId, typeToIr(c.m, s.typ), opc - c.m.nirm.symnames[symId] = c.lit.strings.getOrIncl(s.name.s) - if a[2].kind != nkEmpty: - genAsgn2(c, vn, a[2]) - else: - if a[2].kind == nkEmpty: - genAsgn2(c, vn, expandDefault(vn.typ, vn.info)) - else: - genAsgn2(c, vn, a[2]) - -proc genAsgn(c: var ProcCon; n: PNode) = - var d = c.genx(n[0]) - c.gen n[1], d - -proc convStrToCStr(c: var ProcCon; n: PNode; d: var Value) = - genUnaryCp(c, n, d, "nimToCStringConv", argAt = 0) - -proc convCStrToStr(c: var ProcCon; n: PNode; d: var Value) = - genUnaryCp(c, n, d, "cstrToNimstr", argAt = 0) - -proc genRdVar(c: var ProcCon; n: PNode; d: var Value; flags: GenFlags) = - let info = toLineInfo(c, n.info) - let s = n.sym - if fromForeignModule(c, s): - if s.kind in {skVar, skConst, skLet} and not c.m.pendingVarsAsSet.containsOrIncl(s.itemId): - c.m.pendingVars.add s - - template body(target) = - build target, info, ModuleSymUse: - target.addStrVal c.lit.strings, info, irModule(c, ast.originatingModule(s)) - target.addImmediateVal info, s.itemId.item.int - - valueIntoDest c, info, d, s.typ, body - else: - template body(target) = - target.addSymUse info, toSymId(c, s) - valueIntoDest c, info, d, s.typ, body - -proc genSym(c: var ProcCon; n: PNode; d: var Value; flags: GenFlags = {}) = - let s = n.sym - case s.kind - of skConst: - if dontInlineConstant(n, s.astdef): - genRdVar(c, n, d, flags) - else: - gen(c, s.astdef, d, flags) - of skVar, skForVar, skTemp, skLet, skResult, skParam: - genRdVar(c, n, d, flags) - of skProc, skFunc, skConverter, skMethod, skIterator: - if not c.m.noModularity: - # anon and generic procs have no AST so we need to remember not to forget - # to emit these: - if not c.m.processedProcs.contains(s.itemId): - if not c.m.pendingProcsAsSet.containsOrIncl(s.itemId): - c.m.pendingProcs.add s - genRdVar(c, n, d, flags) - of skEnumField: - let info = toLineInfo(c, n.info) - template body(target) = - target.addIntVal c.lit.numbers, info, typeToIr(c.m, n.typ), s.position - valueIntoDest c, info, d, n.typ, body - else: - localError(c.config, n.info, "cannot generate code for: " & s.name.s) - -proc genNumericLit(c: var ProcCon; n: PNode; d: var Value; bits: int64) = - let info = toLineInfo(c, n.info) - template body(target) = - target.addIntVal c.lit.numbers, info, typeToIr(c.m, n.typ), bits - valueIntoDest c, info, d, n.typ, body - -proc genStringLit(c: var ProcCon; n: PNode; d: var Value) = - let info = toLineInfo(c, n.info) - template body(target) = - target.addStrVal c.lit.strings, info, n.strVal - valueIntoDest c, info, d, n.typ, body - -proc genNilLit(c: var ProcCon; n: PNode; d: var Value) = - let info = toLineInfo(c, n.info) - template body(target) = - target.addNilVal info, typeToIr(c.m, n.typ) - valueIntoDest c, info, d, n.typ, body - -proc genRangeCheck(c: var ProcCon; n: PNode; d: var Value) = - if optRangeCheck in c.options: - let info = toLineInfo(c, n.info) - let tmp = c.genx n[0] - let a = c.genx n[1] - let b = c.genx n[2] - template body(target) = - buildTyped target, info, CheckedRange, typeToIr(c.m, n.typ): - target.addLabel info, CheckedGoto, c.exitLabel - copyTree target, tmp - copyTree target, a - copyTree target, b - valueIntoDest c, info, d, n.typ, body - freeTemp c, tmp - freeTemp c, a - freeTemp c, b - else: - gen c, n[0], d - -proc genArrAccess(c: var ProcCon; n: PNode; d: var Value; flags: GenFlags) = - let arrayType = n[0].typ.skipTypes(abstractVarRange-{tyTypeDesc}) - let arrayKind = arrayType.kind - let info = toLineInfo(c, n.info) - case arrayKind - of tyString: - let a = genx(c, n[0], flags) - let b = genIndexCheck(c, n[1], a, ForStr, arrayType) - let t = typeToIr(c.m, n.typ) - template body(target) = - buildTyped target, info, DerefArrayAt, c.m.strPayloadId[1]: - buildTyped target, info, FieldAt, typeToIr(c.m, arrayType): - copyTree target, a - target.addImmediateVal info, 1 # (len, p)-pair - copyTree target, b - intoDest d, info, t, body - freeTemp c, b - freeTemp c, a - - of tyCstring, tyPtr, tyUncheckedArray: - let a = genx(c, n[0], flags) - let b = genx(c, n[1]) - template body(target) = - buildTyped target, info, DerefArrayAt, typeToIr(c.m, arrayType): - copyTree target, a - copyTree target, b - valueIntoDest c, info, d, n.typ, body - - freeTemp c, b - freeTemp c, a - of tyTuple: - let a = genx(c, n[0], flags) - let b = int n[1].intVal - template body(target) = - buildTyped target, info, FieldAt, typeToIr(c.m, arrayType): - copyTree target, a - target.addImmediateVal info, b - valueIntoDest c, info, d, n.typ, body - - freeTemp c, a - of tyOpenArray, tyVarargs: - let a = genx(c, n[0], flags) - let b = genIndexCheck(c, n[1], a, ForOpenArray, arrayType) - let t = typeToIr(c.m, n.typ) - template body(target) = - buildTyped target, info, DerefArrayAt, openArrayPayloadType(c.m.types, c.m.nirm.types, n[0].typ): - buildTyped target, info, FieldAt, typeToIr(c.m, arrayType): - copyTree target, a - target.addImmediateVal info, 0 # (p, len)-pair - copyTree target, b - intoDest d, info, t, body - - freeTemp c, b - freeTemp c, a - of tyArray: - let a = genx(c, n[0], flags) - var b = default(Value) - genIndex(c, n[1], n[0].typ, b) - - template body(target) = - buildTyped target, info, ArrayAt, typeToIr(c.m, arrayType): - copyTree target, a - copyTree target, b - valueIntoDest c, info, d, n.typ, body - freeTemp c, b - freeTemp c, a - of tySequence: - let a = genx(c, n[0], flags) - let b = genIndexCheck(c, n[1], a, ForSeq, arrayType) - let t = typeToIr(c.m, n.typ) - template body(target) = - buildTyped target, info, DerefArrayAt, seqPayloadPtrType(c.m.types, c.m.nirm.types, n[0].typ)[1]: - buildTyped target, info, FieldAt, t: - copyTree target, a - target.addImmediateVal info, 1 # (len, p)-pair - copyTree target, b - intoDest d, info, t, body - freeTemp c, b - freeTemp c, a - else: - localError c.config, n.info, "invalid type for nkBracketExpr: " & $arrayKind - -proc genObjAccess(c: var ProcCon; n: PNode; d: var Value; flags: GenFlags) = - let info = toLineInfo(c, n.info) - - var n0 = n[0] - var opc = FieldAt - if n0.kind == nkDotExpr: - # obj[].a --> DerefFieldAt instead of FieldAt: - n0 = n[0] - opc = DerefFieldAt - - let a = genx(c, n0, flags) - - template body(target) = - buildTyped target, info, opc, typeToIr(c.m, n0.typ): - copyTree target, a - genField c, n[1], Value(target) - - valueIntoDest c, info, d, n.typ, body - freeTemp c, a - -proc genParams(c: var ProcCon; params: PNode; prc: PSym): PSym = - result = nil - if params.len > 0 and resultPos < prc.ast.len: - let resNode = prc.ast[resultPos] - result = resNode.sym # get result symbol - c.code.addSummon toLineInfo(c, result.info), toSymId(c, result), - typeToIr(c.m, result.typ), SummonResult - elif prc.typ.len > 0 and not isEmptyType(prc.typ[0]) and not isCompileTimeOnly(prc.typ[0]): - # happens for procs without bodies: - let t = typeToIr(c.m, prc.typ[0]) - let tmp = allocTemp(c, t) - c.code.addSummon toLineInfo(c, params.info), tmp, t, SummonResult - - for i in 1..<params.len: - let s = params[i].sym - if not isCompileTimeOnly(s.typ): - let t = typeToIr(c.m, s.typ) - assert t.int != -1, typeToString(s.typ) - let symId = toSymId(c, s) - c.code.addSummon toLineInfo(c, params[i].info), symId, t, SummonParam - c.m.nirm.symnames[symId] = c.lit.strings.getOrIncl(s.name.s) - -proc addCallConv(c: var ProcCon; info: PackedLineInfo; callConv: TCallingConvention) = - template ann(s: untyped) = c.code.addPragmaId info, s - case callConv - of ccNimCall, ccFastCall, ccClosure: ann FastCall - of ccStdCall: ann StdCall - of ccCDecl: ann CDeclCall - of ccSafeCall: ann SafeCall - of ccSysCall: ann SysCall - of ccInline: ann InlineCall - of ccNoInline: ann NoinlineCall - of ccThisCall: ann ThisCall - of ccNoConvention: ann NoCall - -proc genProc(cOuter: var ProcCon; prc: PSym) = - if prc.magic notin generatedMagics: return - if cOuter.m.processedProcs.containsOrIncl(prc.itemId): - return - #assert cOuter.m.inProc == 0, " in nested proc! " & prc.name.s - if cOuter.m.inProc > 0: - if not cOuter.m.pendingProcsAsSet.containsOrIncl(prc.itemId): - cOuter.m.pendingProcs.add prc - return - inc cOuter.m.inProc - - var c = initProcCon(cOuter.m, prc, cOuter.m.graph.config) - let body = - if not fromForeignModule(c, prc): - transformBody(c.m.graph, c.m.idgen, prc, {useCache, keepOpenArrayConversions}) - else: - nil - - let info = toLineInfo(c, prc.info) - build c.code, info, (if body != nil: ProcDecl else: ForeignProcDecl): - if body != nil: - let symId = toSymId(c, prc) - addSymDef c.code, info, symId - c.m.nirm.symnames[symId] = c.lit.strings.getOrIncl(prc.name.s) - else: - build c.code, info, ModuleSymUse: - c.code.addStrVal c.lit.strings, info, irModule(c, ast.originatingModule(prc)) - c.code.addImmediateVal info, prc.itemId.item.int - addCallConv c, info, prc.typ.callConv - if sfCompilerProc in prc.flags: - build c.code, info, PragmaPair: - c.code.addPragmaId info, CoreName - c.code.addStrVal c.lit.strings, info, prc.name.s - if {sfImportc, sfExportc} * prc.flags != {}: - build c.code, info, PragmaPair: - c.code.addPragmaId info, ExternName - c.code.addStrVal c.lit.strings, info, prc.loc.r - if sfImportc in prc.flags: - if lfHeader in prc. loc.flags: - assert(prc. annex != nil) - let str = getStr(prc. annex.path) - build c.code, info, PragmaPair: - c.code.addPragmaId info, HeaderImport - c.code.addStrVal c.lit.strings, info, str - elif lfDynamicLib in prc. loc.flags: - assert(prc. annex != nil) - let str = getStr(prc. annex.path) - build c.code, info, PragmaPair: - c.code.addPragmaId info, DllImport - c.code.addStrVal c.lit.strings, info, str - elif sfExportc in prc.flags: - if lfDynamicLib in prc. loc.flags: - c.code.addPragmaId info, DllExport - else: - c.code.addPragmaId info, ObjExport - - let resultSym = genParams(c, prc.typ.n, prc) - if body != nil: - gen(c, body) - patch c, body, c.exitLabel - if resultSym != nil: - build c.code, info, Ret: - c.code.addSymUse info, toSymId(c, resultSym) - else: - build c.code, info, Ret: - c.code.addNop info - - #copyTree cOuter.code, c.code - dec cOuter.m.inProc - -proc genProc(cOuter: var ProcCon; n: PNode) = - if n.len == 0 or n[namePos].kind != nkSym: return - let prc = n[namePos].sym - if isGenericRoutineStrict(prc) or isCompileTimeProc(prc) or sfForward in prc.flags: return - genProc cOuter, prc - -proc genClosureCall(c: var ProcCon; n: PNode; d: var Value) = - let typ = skipTypes(n[0].typ, abstractInstOwned) - if tfIterator in typ.flags: - const PatIter = "$1.ClP_0($3, $1.ClE_0)" # we know the env exists - - else: - const PatProc = "$1.ClE_0? $1.ClP_0($3, $1.ClE_0):(($4)($1.ClP_0))($2)" - - -proc genComplexCall(c: var ProcCon; n: PNode; d: var Value) = - if n[0].typ != nil and n[0].typ.skipTypes({tyGenericInst, tyAlias, tySink, tyOwned}).callConv == ccClosure: - # XXX genClosureCall p, n, d - genCall c, n, d - else: - genCall c, n, d - -proc gen(c: var ProcCon; n: PNode; d: var Value; flags: GenFlags = {}) = - when defined(nimCompilerStacktraceHints): - setFrameMsg c.config$n.info & " " & $n.kind & " " & $flags - case n.kind - of nkSym: genSym(c, n, d, flags) - of nkCallKinds: - if n[0].kind == nkSym: - let s = n[0].sym - if s.magic != mNone: - genMagic(c, n, d, s.magic) - elif s.kind == skMethod: - localError(c.config, n.info, "cannot call method " & s.name.s & - " at compile time") - else: - genComplexCall(c, n, d) - else: - genComplexCall(c, n, d) - of nkCharLit..nkInt64Lit, nkUIntLit..nkUInt64Lit: - genNumericLit(c, n, d, n.intVal) - of nkFloatLit..nkFloat128Lit: - genNumericLit(c, n, d, cast[int64](n.floatVal)) - of nkStrLit..nkTripleStrLit: - genStringLit(c, n, d) - of nkNilLit: - if not n.typ.isEmptyType: genNilLit(c, n, d) - else: unused(c, n, d) - of nkAsgn, nkFastAsgn, nkSinkAsgn: - unused(c, n, d) - genAsgn(c, n) - of nkDotExpr: genObjAccess(c, n, d, flags) - of nkCheckedFieldExpr: genObjAccess(c, n[0], d, flags) - of nkBracketExpr: genArrAccess(c, n, d, flags) - of nkDerefExpr, nkHiddenDeref: genDeref(c, n, d, flags) - of nkAddr, nkHiddenAddr: genAddr(c, n, d, flags) - of nkIfStmt, nkIfExpr: genIf(c, n, d) - of nkWhenStmt: - # This is "when nimvm" node. Chose the first branch. - gen(c, n[0][1], d) - of nkCaseStmt: genCase(c, n, d) - of nkWhileStmt: - unused(c, n, d) - genWhile(c, n) - of nkBlockExpr, nkBlockStmt: genBlock(c, n, d) - of nkReturnStmt: genReturn(c, n) - of nkRaiseStmt: genRaise(c, n) - of nkBreakStmt: genBreak(c, n) - of nkTryStmt, nkHiddenTryStmt: genTry(c, n, d) - of nkStmtList: - #unused(c, n, d) - # XXX Fix this bug properly, lexim triggers it - for x in n: gen(c, x) - of nkStmtListExpr: - for i in 0..<n.len-1: gen(c, n[i]) - gen(c, n[^1], d, flags) - of nkPragmaBlock: - gen(c, n.lastSon, d, flags) - of nkDiscardStmt: - unused(c, n, d) - gen(c, n[0], d) - of nkHiddenStdConv, nkHiddenSubConv, nkConv: - genConv(c, n, n[1], d, flags, NumberConv) # misnomer? - of nkObjDownConv: - genConv(c, n, n[0], d, flags, ObjConv) - of nkObjUpConv: - genConv(c, n, n[0], d, flags, CheckedObjConv) - of nkVarSection, nkLetSection, nkConstSection: - unused(c, n, d) - genVarSection(c, n) - of nkLambdaKinds: - #let s = n[namePos].sym - #discard genProc(c, s) - gen(c, newSymNode(n[namePos].sym), d) - of nkChckRangeF, nkChckRange64, nkChckRange: - genRangeCheck(c, n, d) - of declarativeDefs - {nkIteratorDef}: - unused(c, n, d) - genProc(c, n) - of nkEmpty, nkCommentStmt, nkTypeSection, nkPragma, - nkTemplateDef, nkIncludeStmt, nkImportStmt, nkFromStmt, nkExportStmt, - nkMixinStmt, nkBindStmt, nkMacroDef, nkIteratorDef: - unused(c, n, d) - of nkStringToCString: convStrToCStr(c, n, d) - of nkCStringToString: convCStrToStr(c, n, d) - of nkBracket: genArrayConstr(c, n, d) - of nkCurly: genSetConstr(c, n, d) - of nkObjConstr: - if n.typ.skipTypes(abstractInstOwned).kind == tyRef: - genRefObjConstr(c, n, d) - else: - genObjOrTupleConstr(c, n, d, n.typ) - of nkPar, nkClosure, nkTupleConstr: - genObjOrTupleConstr(c, n, d, n.typ) - of nkCast: - genConv(c, n, n[1], d, flags, Cast) - of nkComesFrom: - discard "XXX to implement for better stack traces" - #of nkState: genState(c, n) - #of nkGotoState: genGotoState(c, n) - #of nkBreakState: genBreakState(c, n, d) - else: - localError(c.config, n.info, "cannot generate IR code for " & $n) - -proc genPendingProcs(c: var ProcCon) = - while c.m.pendingProcs.len > 0 or c.m.pendingVars.len > 0: - let procs = move(c.m.pendingProcs) - for v in procs: - genProc(c, v) - let vars = move(c.m.pendingVars) - for v in vars: - genForeignVar(c, v) - -proc genStmt*(c: var ProcCon; n: PNode): NodePos = - result = NodePos c.code.len - var d = default(Value) - c.gen(n, d) - unused c, n, d - genPendingProcs c - -proc genExpr*(c: var ProcCon; n: PNode, requiresValue = true): int = - result = c.code.len - var d = default(Value) - c.gen(n, d) - genPendingProcs c - if isEmpty d: - if requiresValue: - globalError(c.config, n.info, "VM problem: d register is not set") diff --git a/compiler/nir/cir.nim b/compiler/nir/cir.nim deleted file mode 100644 index 01f9c4c9a..000000000 --- a/compiler/nir/cir.nim +++ /dev/null @@ -1,983 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2023 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# We produce C code as a list of tokens. - -import std / [assertions, syncio, tables, intsets, formatfloat] -from std / strutils import toOctal -import .. / ic / [bitabs, rodfiles] -import nirtypes, nirinsts, nirfiles -import ../../dist/checksums/src/checksums/md5 - -type - Token = LitId # indexing into the tokens BiTable[string] - - PredefinedToken = enum - IgnoreMe = "<unused>" - EmptyToken = "" - CurlyLe = "{" - CurlyRi = "}" - ParLe = "(" - ParRi = ")" - BracketLe = "[" - BracketRi = "]" - NewLine = "\n" - Semicolon = ";" - Comma = ", " - Space = " " - Colon = ": " - Dot = "." - Arrow = "->" - Star = "*" - Amp = "&" - AsgnOpr = " = " - ScopeOpr = "::" - ConstKeyword = "const " - StaticKeyword = "static " - ExternKeyword = "extern " - WhileKeyword = "while " - IfKeyword = "if (" - ElseKeyword = "else " - SwitchKeyword = "switch " - CaseKeyword = "case " - DefaultKeyword = "default:" - BreakKeyword = "break" - NullPtr = "nullptr" - IfNot = "if (!(" - ReturnKeyword = "return " - TypedefStruct = "typedef struct " - TypedefUnion = "typedef union " - IncludeKeyword = "#include " - -proc fillTokenTable(tab: var BiTable[string]) = - for e in EmptyToken..high(PredefinedToken): - let id = tab.getOrIncl $e - assert id == LitId(e), $(id, " ", ord(e)) - -type - GeneratedCode* = object - m: NirModule - includes: seq[LitId] - includedHeaders: IntSet - data: seq[LitId] - protos: seq[LitId] - code: seq[LitId] - init: seq[LitId] - tokens: BiTable[string] - emittedStrings: IntSet - needsPrefix: IntSet - generatedTypes: IntSet - mangledModules: Table[LitId, LitId] - -proc initGeneratedCode*(m: sink NirModule): GeneratedCode = - result = GeneratedCode(m: m, code: @[], tokens: initBiTable[string]()) - fillTokenTable(result.tokens) - -proc add*(g: var GeneratedCode; t: PredefinedToken) {.inline.} = - g.code.add Token(t) - -proc add*(g: var GeneratedCode; s: string) {.inline.} = - g.code.add g.tokens.getOrIncl(s) - -proc mangleModuleName(c: var GeneratedCode; key: LitId): LitId = - result = c.mangledModules.getOrDefault(key, LitId(0)) - if result == LitId(0): - let u {.cursor.} = c.m.lit.strings[key] - var last = u.len - len(".nim") - 1 - var start = last - while start >= 0 and u[start] != '/': dec start - var sum = getMD5(u) - sum.setLen(8) - let dest = u.substr(start+1, last) & sum - result = c.tokens.getOrIncl(dest) - c.mangledModules[key] = result - -type - CppFile = object - f: File - -proc write(f: var CppFile; s: string) = write(f.f, s) -proc write(f: var CppFile; c: char) = write(f.f, c) - -proc writeTokenSeq(f: var CppFile; s: seq[Token]; c: GeneratedCode) = - var indent = 0 - for i in 0..<s.len: - let x = s[i] - case x - of Token(CurlyLe): - inc indent - write f, c.tokens[x] - write f, "\n" - for i in 1..indent*2: write f, ' ' - of Token(CurlyRi): - dec indent - write f, c.tokens[x] - if i+1 < s.len and s[i+1] == Token(CurlyRi): - discard - else: - write f, "\n" - for i in 1..indent*2: write f, ' ' - of Token(Semicolon): - write f, c.tokens[x] - if i+1 < s.len and s[i+1] == Token(CurlyRi): - discard "no newline before }" - else: - write f, "\n" - for i in 1..indent*2: write f, ' ' - of Token(NewLine): - write f, c.tokens[x] - for i in 1..indent*2: write f, ' ' - else: - write f, c.tokens[x] - - -# Type graph - -type - TypeList = object - processed: IntSet - s: seq[(TypeId, PredefinedToken)] - -proc add(dest: var TypeList; elem: TypeId; decl: PredefinedToken) = - if not containsOrIncl(dest.processed, int(elem)): - dest.s.add (elem, decl) - -type - TypeOrder = object - forwardedDecls, ordered: TypeList - typeImpls: Table[string, TypeId] - lookedAt: IntSet - -proc traverseObject(types: TypeGraph; lit: Literals; c: var TypeOrder; t: TypeId) - -proc recordDependency(types: TypeGraph; lit: Literals; c: var TypeOrder; parent, child: TypeId) = - var ch = child - var viaPointer = false - while true: - case types[ch].kind - of APtrTy, UPtrTy, AArrayPtrTy, UArrayPtrTy: - viaPointer = true - ch = elementType(types, ch) - of LastArrayTy: - ch = elementType(types, ch) - else: - break - - case types[ch].kind - of ObjectTy, UnionTy: - let decl = if types[ch].kind == ObjectTy: TypedefStruct else: TypedefUnion - let obj = c.typeImpls.getOrDefault(lit.strings[types[ch].litId]) - if viaPointer: - c.forwardedDecls.add obj, decl - else: - if not containsOrIncl(c.lookedAt, obj.int): - traverseObject(types, lit, c, obj) - c.ordered.add obj, decl - of ArrayTy: - if viaPointer: - c.forwardedDecls.add ch, TypedefStruct - else: - if not containsOrIncl(c.lookedAt, ch.int): - traverseObject(types, lit, c, ch) - c.ordered.add ch, TypedefStruct - else: - discard "uninteresting type as we only focus on the required struct declarations" - -proc traverseObject(types: TypeGraph; lit: Literals; c: var TypeOrder; t: TypeId) = - for x in sons(types, t): - case types[x].kind - of FieldDecl: - recordDependency types, lit, c, t, x.firstSon - of ObjectTy: - # inheritance - recordDependency types, lit, c, t, x - else: discard - -proc traverseTypes(types: TypeGraph; lit: Literals; c: var TypeOrder) = - for t in allTypes(types): - if types[t].kind in {ObjectDecl, UnionDecl}: - assert types[t.firstSon].kind == NameVal - c.typeImpls[lit.strings[types[t.firstSon].litId]] = t - - for t in allTypesIncludingInner(types): - case types[t].kind - of ObjectDecl, UnionDecl: - traverseObject types, lit, c, t - let decl = if types[t].kind == ObjectDecl: TypedefStruct else: TypedefUnion - c.ordered.add t, decl - of ArrayTy: - traverseObject types, lit, c, t - c.ordered.add t, TypedefStruct - else: discard - -when false: - template emitType(s: string) = c.types.add c.tokens.getOrIncl(s) - template emitType(t: Token) = c.types.add t - template emitType(t: PredefinedToken) = c.types.add Token(t) - -proc genType(g: var GeneratedCode; types: TypeGraph; lit: Literals; t: TypeId; name = "") = - template maybeAddName = - if name != "": - g.add Space - g.add name - - template atom(s: string) = - g.add s - maybeAddName() - case types[t].kind - of VoidTy: atom "void" - of IntTy: atom "NI" & $types[t].integralBits - of UIntTy: atom "NU" & $types[t].integralBits - of FloatTy: atom "NF" & $types[t].integralBits - of BoolTy: atom "NB" & $types[t].integralBits - of CharTy: atom "NC" & $types[t].integralBits - of ObjectTy, UnionTy, NameVal, AnnotationVal: - atom lit.strings[types[t].litId] - of VarargsTy: - g.add "..." - of APtrTy, UPtrTy, AArrayPtrTy, UArrayPtrTy: - genType g, types, lit, elementType(types, t) - g.add Star - maybeAddName() - of ArrayTy: - genType g, types, lit, arrayName(types, t) - maybeAddName() - of LastArrayTy: - genType g, types, lit, elementType(types, t) - maybeAddName() - g.add BracketLe - g.add BracketRi - of ProcTy: - let (retType, callConv) = returnType(types, t) - genType g, types, lit, retType - g.add Space - g.add ParLe - genType g, types, lit, callConv - g.add Star # "(*fn)" - maybeAddName() - g.add ParRi - g.add ParLe - var i = 0 - for ch in params(types, t): - if i > 0: g.add Comma - genType g, types, lit, ch - inc i - g.add ParRi - of ObjectDecl, UnionDecl: - atom lit.strings[types[t.firstSon].litId] - of IntVal, SizeVal, AlignVal, OffsetVal, FieldDecl: - #raiseAssert "did not expect: " & $types[t].kind - g.add "BUG " - atom $types[t].kind - -proc generateTypes(g: var GeneratedCode; types: TypeGraph; lit: Literals; c: TypeOrder) = - for (t, declKeyword) in c.forwardedDecls.s: - let name = if types[t].kind == ArrayTy: arrayName(types, t) else: t.firstSon - let s {.cursor.} = lit.strings[types[name].litId] - g.add declKeyword - g.add s - g.add Space - g.add s - g.add Semicolon - - for (t, declKeyword) in c.ordered.s: - let name = if types[t].kind == ArrayTy: arrayName(types, t) else: t.firstSon - let litId = types[name].litId - if not g.generatedTypes.containsOrIncl(litId.int): - let s {.cursor.} = lit.strings[litId] - g.add declKeyword - g.add CurlyLe - if types[t].kind == ArrayTy: - genType g, types, lit, elementType(types, t), "a" - g.add BracketLe - g.add $arrayLen(types, t) - g.add BracketRi - g.add Semicolon - else: - var i = 0 - for x in sons(types, t): - case types[x].kind - of FieldDecl: - genType g, types, lit, x.firstSon, "F" & $i - g.add Semicolon - inc i - of ObjectTy: - genType g, types, lit, x, "P" - g.add Semicolon - else: discard - g.add CurlyRi - g.add s - g.add Semicolon - -# Procs - -proc toCChar*(c: char; result: var string) {.inline.} = - case c - of '\0'..'\x1F', '\x7F'..'\xFF': - result.add '\\' - result.add toOctal(c) - of '\'', '\"', '\\', '?': - result.add '\\' - result.add c - else: - result.add c - -proc makeCString(s: string): string = - result = newStringOfCap(s.len + 10) - result.add('"') - for c in s: toCChar(c, result) - result.add('"') - -template emitData(s: string) = c.data.add c.tokens.getOrIncl(s) -template emitData(t: Token) = c.data.add t -template emitData(t: PredefinedToken) = c.data.add Token(t) - -proc genStrLit(c: var GeneratedCode; lit: Literals; litId: LitId): Token = - result = Token(c.tokens.getOrIncl "QStr" & $litId) - if not containsOrIncl(c.emittedStrings, int(litId)): - let s {.cursor.} = lit.strings[litId] - emitData "static const struct " - emitData CurlyLe - emitData "NI cap" - emitData Semicolon - emitData "NC8 data" - emitData BracketLe - emitData $s.len - emitData "+1" - emitData BracketRi - emitData Semicolon - emitData CurlyRi - emitData result - emitData AsgnOpr - emitData CurlyLe - emitData $s.len - emitData " | NIM_STRLIT_FLAG" - emitData Comma - emitData makeCString(s) - emitData CurlyRi - emitData Semicolon - -proc genIntLit(c: var GeneratedCode; lit: Literals; litId: LitId) = - let i = lit.numbers[litId] - if i > low(int32) and i <= high(int32): - c.add $i - elif i == low(int32): - # Nim has the same bug for the same reasons :-) - c.add "(-2147483647 -1)" - elif i > low(int64): - c.add "IL64(" - c.add $i - c.add ")" - else: - c.add "(IL64(-9223372036854775807) - IL64(1))" - -proc gen(c: var GeneratedCode; t: Tree; n: NodePos) - -proc genDisplayName(c: var GeneratedCode; symId: SymId) = - let displayName = c.m.symnames[symId] - if displayName != LitId(0): - c.add "/*" - c.add c.m.lit.strings[displayName] - c.add "*/" - -proc genSymDef(c: var GeneratedCode; t: Tree; n: NodePos) = - if t[n].kind == SymDef: - let symId = t[n].symId - c.needsPrefix.incl symId.int - genDisplayName c, symId - gen c, t, n - -proc genGlobal(c: var GeneratedCode; t: Tree; name, typ: NodePos; annotation: string) = - c.add annotation - let m: string - if t[name].kind == SymDef: - let symId = t[name].symId - m = c.tokens[mangleModuleName(c, c.m.namespace)] & "__" & $symId - genDisplayName c, symId - else: - assert t[name].kind == ModuleSymUse - let (x, y) = sons2(t, name) - m = c.tokens[mangleModuleName(c, t[x].litId)] & "__" & $t[y].immediateVal - genType c, c.m.types, c.m.lit, t[typ].typeId, m - -proc genLocal(c: var GeneratedCode; t: Tree; name, typ: NodePos; annotation: string) = - assert t[name].kind == SymDef - c.add annotation - let symId = t[name].symId - genType c, c.m.types, c.m.lit, t[typ].typeId, "q" & $symId - genDisplayName c, symId - -proc genProcDecl(c: var GeneratedCode; t: Tree; n: NodePos; isExtern: bool) = - let signatureBegin = c.code.len - let name = n.firstSon - - var prc = n.firstSon - next t, prc - - while true: - case t[prc].kind - of PragmaPair: - let (x, y) = sons2(t, prc) - let key = cast[PragmaKey](t[x].rawOperand) - case key - of HeaderImport: - let lit = t[y].litId - let headerAsStr {.cursor.} = c.m.lit.strings[lit] - let header = c.tokens.getOrIncl(headerAsStr) - # headerAsStr can be empty, this has the semantics of the `nodecl` pragma: - if headerAsStr.len > 0 and not c.includedHeaders.containsOrIncl(int header): - if headerAsStr[0] == '#': - discard "skip the #include" - else: - c.includes.add Token(IncludeKeyword) - c.includes.add header - c.includes.add Token NewLine - # do not generate code for importc'ed procs: - return - of DllImport: - let lit = t[y].litId - raiseAssert "cannot eval: " & c.m.lit.strings[lit] - else: discard - of PragmaId: discard - else: break - next t, prc - - var resultDeclPos = NodePos(-1) - if t[prc].kind == SummonResult: - resultDeclPos = prc - gen c, t, prc.firstSon - next t, prc - else: - c.add "void" - c.add Space - genSymDef c, t, name - c.add ParLe - var params = 0 - while t[prc].kind == SummonParam: - if params > 0: c.add Comma - let (typ, sym) = sons2(t, prc) - genLocal c, t, sym, typ, "" - next t, prc - inc params - if params == 0: - c.add "void" - c.add ParRi - - for i in signatureBegin ..< c.code.len: - c.protos.add c.code[i] - c.protos.add Token Semicolon - - if isExtern: - c.code.setLen signatureBegin - else: - c.add CurlyLe - if resultDeclPos.int >= 0: - gen c, t, resultDeclPos - for ch in sonsRest(t, n, prc): - gen c, t, ch - c.add CurlyRi - -template triop(opr) = - let (typ, a, b) = sons3(t, n) - c.add ParLe - c.add ParLe - gen c, t, typ - c.add ParRi - gen c, t, a - c.add opr - gen c, t, b - c.add ParRi - -template cmpop(opr) = - let (_, a, b) = sons3(t, n) - c.add ParLe - gen c, t, a - c.add opr - gen c, t, b - c.add ParRi - -template binaryop(opr) = - let (typ, a) = sons2(t, n) - c.add ParLe - c.add ParLe - gen c, t, typ - c.add ParRi - c.add opr - gen c, t, a - c.add ParRi - -template checkedBinaryop(opr) = - let (typ, labIdx, a, b) = sons4(t, n) - let bits = integralBits(c.m.types[t[typ].typeId]) - let lab = t[labIdx].label - - c.add (opr & $bits) - c.add ParLe - c.gen t, a - c.add Comma - c.gen t, b - c.add Comma - c.add "L" & $lab.int - c.add ParRi - -proc genNumberConv(c: var GeneratedCode; t: Tree; n: NodePos) = - let (typ, arg) = sons2(t, n) - if t[arg].kind == IntVal: - let litId = t[arg].litId - c.add ParLe - c.add ParLe - gen c, t, typ - c.add ParRi - case c.m.types[t[typ].typeId].kind - of UIntTy: - let x = cast[uint64](c.m.lit.numbers[litId]) - c.add $x - of FloatTy: - let x = cast[float64](c.m.lit.numbers[litId]) - c.add $x - else: - gen c, t, arg - c.add ParRi - else: - binaryop "" - -template moveToDataSection(body: untyped) = - let oldLen = c.code.len - body - for i in oldLen ..< c.code.len: - c.data.add c.code[i] - setLen c.code, oldLen - -proc gen(c: var GeneratedCode; t: Tree; n: NodePos) = - case t[n].kind - of Nop: - discard "nothing to emit" - of ImmediateVal: - c.add $t[n].immediateVal - of IntVal: - genIntLit c, c.m.lit, t[n].litId - of StrVal: - c.code.add genStrLit(c, c.m.lit, t[n].litId) - of Typed: - genType c, c.m.types, c.m.lit, t[n].typeId - of SymDef, SymUse: - let s = t[n].symId - if c.needsPrefix.contains(s.int): - c.code.add mangleModuleName(c, c.m.namespace) - c.add "__" - c.add $s - else: - # XXX Use proper names here - c.add "q" - c.add $s - - of ModuleSymUse: - let (x, y) = sons2(t, n) - let u = mangleModuleName(c, t[x].litId) - let s = t[y].immediateVal - c.code.add u - c.add "__" - c.add $s - - of NilVal: - c.add NullPtr - of LoopLabel: - c.add WhileKeyword - c.add ParLe - c.add "1" - c.add ParRi - c.add CurlyLe - of GotoLoop: - c.add CurlyRi - of Label: - let lab = t[n].label - c.add "L" - c.add $lab.int - c.add Colon - c.add Semicolon - of Goto: - let lab = t[n].label - c.add "goto L" - c.add $lab.int - c.add Semicolon - of CheckedGoto: - discard "XXX todo" - of ArrayConstr: - c.add CurlyLe - c.add ".a = " - c.add CurlyLe - var i = 0 - for ch in sonsFrom1(t, n): - if i > 0: c.add Comma - c.gen t, ch - inc i - c.add CurlyRi - c.add CurlyRi - of ObjConstr: - c.add CurlyLe - var i = 0 - for ch in sonsFrom1(t, n): - if i mod 2 == 0: - if i > 0: c.add Comma - c.add ".F" & $t[ch].immediateVal - c.add AsgnOpr - else: - c.gen t, ch - inc i - c.add CurlyRi - of Ret: - c.add ReturnKeyword - c.gen t, n.firstSon - c.add Semicolon - of Select: - c.add SwitchKeyword - c.add ParLe - let (_, selector) = sons2(t, n) - c.gen t, selector - c.add ParRi - c.add CurlyLe - for ch in sonsFromN(t, n, 2): - c.gen t, ch - c.add CurlyRi - of SelectPair: - let (le, ri) = sons2(t, n) - c.gen t, le - c.gen t, ri - of SelectList: - for ch in sons(t, n): - c.gen t, ch - of SelectValue: - c.add CaseKeyword - c.gen t, n.firstSon - c.add Colon - of SelectRange: - let (le, ri) = sons2(t, n) - c.add CaseKeyword - c.gen t, le - c.add " ... " - c.gen t, ri - c.add Colon - of ForeignDecl: - c.data.add LitId(ExternKeyword) - c.gen t, n.firstSon - of SummonGlobal: - moveToDataSection: - let (typ, sym) = sons2(t, n) - c.genGlobal t, sym, typ, "" - c.add Semicolon - of SummonThreadLocal: - moveToDataSection: - let (typ, sym) = sons2(t, n) - c.genGlobal t, sym, typ, "__thread " - c.add Semicolon - of SummonConst: - moveToDataSection: - let (typ, sym, val) = sons3(t, n) - c.genGlobal t, sym, typ, "const " - c.add AsgnOpr - c.gen t, val - c.add Semicolon - of Summon, SummonResult: - let (typ, sym) = sons2(t, n) - c.genLocal t, sym, typ, "" - c.add Semicolon - - of SummonParam: - raiseAssert "SummonParam should have been handled in genProc" - of Kill: - discard "we don't care about Kill instructions" - of AddrOf: - let (_, arg) = sons2(t, n) - c.add "&" - gen c, t, arg - of DerefArrayAt: - let (_, a, i) = sons3(t, n) - gen c, t, a - c.add BracketLe - gen c, t, i - c.add BracketRi - of ArrayAt: - let (_, a, i) = sons3(t, n) - gen c, t, a - c.add Dot - c.add "a" - c.add BracketLe - gen c, t, i - c.add BracketRi - of FieldAt: - let (_, a, b) = sons3(t, n) - gen c, t, a - let field = t[b].immediateVal - c.add Dot - c.add "F" & $field - of DerefFieldAt: - let (_, a, b) = sons3(t, n) - gen c, t, a - let field = t[b].immediateVal - c.add Arrow - c.add "F" & $field - of Load: - let (_, arg) = sons2(t, n) - c.add ParLe - c.add "*" - gen c, t, arg - c.add ParRi - of Store: - raiseAssert "Assumption was that Store is unused!" - of Asgn: - let (_, dest, src) = sons3(t, n) - gen c, t, dest - c.add AsgnOpr - gen c, t, src - c.add Semicolon - of CheckedRange: - c.add "nimCheckRange" - c.add ParLe - let (_, gotoInstr, x, a, b) = sons5(t, n) - gen c, t, x - c.add Comma - gen c, t, a - c.add Comma - gen c, t, b - c.add Comma - c.add "L" & $t[gotoInstr].label.int - c.add ParRi - of CheckedIndex: - c.add "nimCheckIndex" - c.add ParLe - let (gotoInstr, x, a) = sons3(t, n) - gen c, t, x - c.add Comma - gen c, t, a - c.add Comma - c.add "L" & $t[gotoInstr].label.int - c.add ParRi - of Call, IndirectCall: - let (typ, fn) = sons2(t, n) - gen c, t, fn - c.add ParLe - var i = 0 - for ch in sonsFromN(t, n, 2): - if i > 0: c.add Comma - gen c, t, ch - inc i - c.add ParRi - if c.m.types[t[typ].typeId].kind == VoidTy: - c.add Semicolon - of CheckedCall, CheckedIndirectCall: - let (typ, gotoInstr, fn) = sons3(t, n) - gen c, t, fn - c.add ParLe - var i = 0 - for ch in sonsFromN(t, n, 3): - if i > 0: c.add Comma - gen c, t, ch - inc i - c.add ParRi - if c.m.types[t[typ].typeId].kind == VoidTy: - c.add Semicolon - - of CheckedAdd: checkedBinaryop "nimAddInt" - of CheckedSub: checkedBinaryop "nimSubInt" - of CheckedMul: checkedBinaryop "nimMulInt" - of CheckedDiv: checkedBinaryop "nimDivInt" - of CheckedMod: checkedBinaryop "nimModInt" - of Add: triop " + " - of Sub: triop " - " - of Mul: triop " * " - of Div: triop " / " - of Mod: triop " % " - of BitShl: triop " << " - of BitShr: triop " >> " - of BitAnd: triop " & " - of BitOr: triop " | " - of BitXor: triop " ^ " - of BitNot: binaryop " ~ " - of BoolNot: binaryop " !" - of Eq: cmpop " == " - of Le: cmpop " <= " - of Lt: cmpop " < " - of Cast: binaryop "" - of NumberConv: genNumberConv c, t, n - of CheckedObjConv: binaryop "" - of ObjConv: binaryop "" - of Emit: raiseAssert "cannot interpret: Emit" - of ProcDecl: genProcDecl c, t, n, false - of ForeignProcDecl: genProcDecl c, t, n, true - of PragmaPair, PragmaId, TestOf, Yld, SetExc, TestExc: - c.add "cannot interpret: " & $t[n].kind - -const - Prelude = """ -/* GENERATED CODE. DO NOT EDIT. */ - -#ifdef __cplusplus -#define NB8 bool -#elif (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901) -// see #13798: to avoid conflicts for code emitting `#include <stdbool.h>` -#define NB8 _Bool -#else -typedef unsigned char NB8; // best effort -#endif - -typedef unsigned char NC8; - -typedef float NF32; -typedef double NF64; -#if defined(__BORLANDC__) || defined(_MSC_VER) -typedef signed char NI8; -typedef signed short int NI16; -typedef signed int NI32; -typedef __int64 NI64; -/* XXX: Float128? */ -typedef unsigned char NU8; -typedef unsigned short int NU16; -typedef unsigned int NU32; -typedef unsigned __int64 NU64; -#elif defined(HAVE_STDINT_H) -#ifndef USE_NIM_NAMESPACE -# include <stdint.h> -#endif -typedef int8_t NI8; -typedef int16_t NI16; -typedef int32_t NI32; -typedef int64_t NI64; -typedef uint8_t NU8; -typedef uint16_t NU16; -typedef uint32_t NU32; -typedef uint64_t NU64; -#elif defined(HAVE_CSTDINT) -#ifndef USE_NIM_NAMESPACE -# include <cstdint> -#endif -typedef std::int8_t NI8; -typedef std::int16_t NI16; -typedef std::int32_t NI32; -typedef std::int64_t NI64; -typedef std::uint8_t NU8; -typedef std::uint16_t NU16; -typedef std::uint32_t NU32; -typedef std::uint64_t NU64; -#else -/* Unknown compiler/version, do our best */ -#ifdef __INT8_TYPE__ -typedef __INT8_TYPE__ NI8; -#else -typedef signed char NI8; -#endif -#ifdef __INT16_TYPE__ -typedef __INT16_TYPE__ NI16; -#else -typedef signed short int NI16; -#endif -#ifdef __INT32_TYPE__ -typedef __INT32_TYPE__ NI32; -#else -typedef signed int NI32; -#endif -#ifdef __INT64_TYPE__ -typedef __INT64_TYPE__ NI64; -#else -typedef long long int NI64; -#endif -/* XXX: Float128? */ -#ifdef __UINT8_TYPE__ -typedef __UINT8_TYPE__ NU8; -#else -typedef unsigned char NU8; -#endif -#ifdef __UINT16_TYPE__ -typedef __UINT16_TYPE__ NU16; -#else -typedef unsigned short int NU16; -#endif -#ifdef __UINT32_TYPE__ -typedef __UINT32_TYPE__ NU32; -#else -typedef unsigned int NU32; -#endif -#ifdef __UINT64_TYPE__ -typedef __UINT64_TYPE__ NU64; -#else -typedef unsigned long long int NU64; -#endif -#endif - -#ifdef NIM_INTBITS -# if NIM_INTBITS == 64 -typedef NI64 NI; -typedef NU64 NU; -# elif NIM_INTBITS == 32 -typedef NI32 NI; -typedef NU32 NU; -# elif NIM_INTBITS == 16 -typedef NI16 NI; -typedef NU16 NU; -# elif NIM_INTBITS == 8 -typedef NI8 NI; -typedef NU8 NU; -# else -# error "invalid bit width for int" -# endif -#endif - -#define NIM_STRLIT_FLAG ((NU)(1) << ((NIM_INTBITS) - 2)) /* This has to be the same as system.strlitFlag! */ - -#define nimAddInt64(a, b, L) ({long long int res; if(__builtin_saddll_overflow(a, b, &res)) goto L; res}) -#define nimSubInt64(a, b, L) ({long long int res; if(__builtin_ssubll_overflow(a, b, &res)) goto L; res}) -#define nimMulInt64(a, b, L) ({long long int res; if(__builtin_smulll_overflow(a, b, &res)) goto L; res}) - -#define nimAddInt32(a, b, L) ({long int res; if(__builtin_sadd_overflow(a, b, &res)) goto L; res}) -#define nimSubInt32(a, b, L) ({long int res; if(__builtin_ssub_overflow(a, b, &res)) goto L; res}) -#define nimMulInt32(a, b, L) ({long int res; if(__builtin_smul_overflow(a, b, &res)) goto L; res}) - -#define nimCheckRange(x, a, b, L) ({if (x < a || x > b) goto L; x}) -#define nimCheckIndex(x, a, L) ({if (x >= a) goto L; x}) - -""" - -proc traverseCode(c: var GeneratedCode) = - const AllowedInToplevelC = {SummonConst, SummonGlobal, SummonThreadLocal, - ProcDecl, ForeignDecl, ForeignProcDecl} - var i = NodePos(0) - while i.int < c.m.code.len: - let oldLen = c.code.len - let moveToInitSection = c.m.code[NodePos(i)].kind notin AllowedInToplevelC - - gen c, c.m.code, NodePos(i) - next c.m.code, i - - if moveToInitSection: - for i in oldLen ..< c.code.len: - c.init.add c.code[i] - setLen c.code, oldLen - -proc generateCode*(inp, outp: string) = - var c = initGeneratedCode(load(inp)) - - var co = TypeOrder() - traverseTypes(c.m.types, c.m.lit, co) - - generateTypes(c, c.m.types, c.m.lit, co) - let typeDecls = move c.code - - traverseCode c - var f = CppFile(f: open(outp, fmWrite)) - f.write "#define NIM_INTBITS " & $c.m.intbits & "\n" - f.write Prelude - writeTokenSeq f, c.includes, c - writeTokenSeq f, typeDecls, c - writeTokenSeq f, c.data, c - writeTokenSeq f, c.protos, c - writeTokenSeq f, c.code, c - if c.init.len > 0: - f.write "void __attribute__((constructor)) init(void) {" - writeTokenSeq f, c.init, c - f.write "}\n\n" - f.f.close diff --git a/compiler/nir/nir.nim b/compiler/nir/nir.nim deleted file mode 100644 index 6f7077fb0..000000000 --- a/compiler/nir/nir.nim +++ /dev/null @@ -1,105 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2023 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Nim Intermediate Representation, designed to capture all of Nim's semantics without losing too much -## precious information. Can easily be translated into C. And to JavaScript, hopefully. - -from std/os import addFileExt, `/`, createDir - -import std / assertions -import ".." / [ast, modulegraphs, renderer, transf, options, msgs, lineinfos] -import nirtypes, nirinsts, ast2ir, nirlineinfos, nirfiles, nirvm - -import ".." / ic / [rodfiles, bitabs] - -type - PCtx* = ref object of TPassContext - m: ModuleCon - c: ProcCon - oldErrorCount: int - bytecode: Bytecode - -proc newCtx*(module: PSym; g: ModuleGraph; idgen: IdGenerator): PCtx = - var lit = Literals() - var nirm = (ref NirModule)(types: initTypeGraph(lit), lit: lit) - var m = initModuleCon(g, g.config, idgen, module, nirm) - m.noModularity = true - PCtx(m: m, c: initProcCon(m, nil, g.config), idgen: idgen, bytecode: initBytecode(nirm)) - -proc refresh*(c: PCtx; module: PSym; idgen: IdGenerator) = - #c.m = initModuleCon(c.m.graph, c.m.graph.config, idgen, module, c.m.nirm) - #c.m.noModularity = true - c.c = initProcCon(c.m, nil, c.m.graph.config) - c.idgen = idgen - -proc setupGlobalCtx*(module: PSym; graph: ModuleGraph; idgen: IdGenerator) = - if graph.repl.isNil: - graph.repl = newCtx(module, graph, idgen) - #registerAdditionalOps(PCtx graph.repl) - else: - refresh(PCtx graph.repl, module, idgen) - -proc setupNirReplGen*(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = - setupGlobalCtx(module, graph, idgen) - result = PCtx graph.repl - -proc evalStmt(c: PCtx; n: PNode) = - let n = transformExpr(c.m.graph, c.idgen, c.m.module, n) - let pc = genStmt(c.c, n) - #var res = "" - #toString c.m.nirm.code, NodePos(pc), c.m.nirm.lit.strings, c.m.nirm.lit.numbers, c.m.symnames, res - #res.add "\n--------------------------\n" - #toString res, c.m.types.g - if pc.int < c.m.nirm.code.len: - c.bytecode.interactive = c.m.graph.interactive - execCode c.bytecode, c.m.nirm.code, pc - #echo res - -proc runCode*(c: PPassContext; n: PNode): PNode = - let c = PCtx(c) - # don't eval errornous code: - if c.oldErrorCount == c.m.graph.config.errorCounter: - evalStmt(c, n) - result = newNodeI(nkEmpty, n.info) - else: - result = n - c.oldErrorCount = c.m.graph.config.errorCounter - -type - NirPassContext* = ref object of TPassContext - m: ModuleCon - c: ProcCon - -proc openNirBackend*(g: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = - var lit = Literals() - var nirm = (ref NirModule)(types: initTypeGraph(lit), lit: lit) - let m = initModuleCon(g, g.config, idgen, module, nirm) - NirPassContext(m: m, c: initProcCon(m, nil, g.config), idgen: idgen) - -proc gen(c: NirPassContext; n: PNode) = - let n = transformExpr(c.m.graph, c.idgen, c.m.module, n) - let pc = genStmt(c.c, n) - -proc nirBackend*(c: PPassContext; n: PNode): PNode = - gen(NirPassContext(c), n) - result = n - -proc closeNirBackend*(c: PPassContext; finalNode: PNode) = - discard nirBackend(c, finalNode) - - let c = NirPassContext(c) - let nimcache = getNimcacheDir(c.c.config).string - createDir nimcache - let outp = nimcache / c.m.module.name.s.addFileExt("nir") - #c.m.nirm.code = move c.c.code - try: - store c.m.nirm[], outp - echo "created: ", outp - except IOError: - rawMessage(c.c.config, errFatal, "serialization failed: " & outp) diff --git a/compiler/nir/nirc.nim b/compiler/nir/nirc.nim deleted file mode 100644 index a2cf69988..000000000 --- a/compiler/nir/nirc.nim +++ /dev/null @@ -1,52 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2023 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Nir Compiler. - -import ".." / ic / [bitabs, rodfiles] -import nirinsts, nirtypes, nirlineinfos, nirfiles, cir - -proc view(filename: string) = - let m = load(filename) - var res = "" - allTreesToString m.code, m.lit.strings, m.lit.numbers, m.symnames, res - res.add "\n# TYPES\n" - nirtypes.toString res, m.types - echo res - -import std / [syncio, parseopt] - -proc writeHelp = - echo """Usage: nirc view|c <file.nir>""" - quit 0 - -proc main = - var inp = "" - var cmd = "" - for kind, key, val in getopt(): - case kind - of cmdArgument: - if cmd.len == 0: cmd = key - elif inp.len == 0: inp = key - else: quit "Error: too many arguments" - of cmdLongOption, cmdShortOption: - case key - of "help", "h": writeHelp() - of "version", "v": stdout.write "1.0\n" - of cmdEnd: discard - if inp.len == 0: - quit "Error: no input file specified" - case cmd - of "", "view": - view inp - of "c": - let outp = inp & ".c" - cir.generateCode inp, outp - -main() diff --git a/compiler/nir/nirfiles.nim b/compiler/nir/nirfiles.nim deleted file mode 100644 index cd5a79f06..000000000 --- a/compiler/nir/nirfiles.nim +++ /dev/null @@ -1,83 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2023 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import ".." / ic / [bitabs, rodfiles] -import nirinsts, nirtypes, nirlineinfos - -type - NirModule* = object - code*: Tree - man*: LineInfoManager - types*: TypeGraph - lit*: Literals - namespace*: LitId - intbits*: uint32 - symnames*: SymNames - -proc load*(filename: string): NirModule = - let lit = Literals() - result = NirModule(lit: lit, types: initTypeGraph(lit)) - var r = rodfiles.open(filename) - try: - r.loadHeader(nirCookie) - r.loadSection stringsSection - r.load result.lit.strings - - r.loadSection numbersSection - r.load result.lit.numbers - - r.loadSection bodiesSection - r.load result.code - - r.loadSection typesSection - r.load result.types - - r.loadSection sideChannelSection - r.load result.man - - r.loadSection namespaceSection - r.loadPrim result.namespace - r.loadPrim result.intbits - - r.loadSection symnamesSection - r.load result.symnames - - finally: - r.close() - -proc store*(m: NirModule; outp: string) = - var r = rodfiles.create(outp) - try: - r.storeHeader(nirCookie) - r.storeSection stringsSection - r.store m.lit.strings - - r.storeSection numbersSection - r.store m.lit.numbers - - r.storeSection bodiesSection - r.store m.code - - r.storeSection typesSection - r.store m.types - - r.storeSection sideChannelSection - r.store m.man - - r.storeSection namespaceSection - r.storePrim m.namespace - r.storePrim m.intbits - - r.storeSection symnamesSection - r.store m.symnames - - finally: - r.close() - if r.err != ok: - raise newException(IOError, "could store into: " & outp) diff --git a/compiler/nir/nirinsts.nim b/compiler/nir/nirinsts.nim deleted file mode 100644 index 6cffc1a89..000000000 --- a/compiler/nir/nirinsts.nim +++ /dev/null @@ -1,582 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2023 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## NIR instructions. Somewhat inspired by LLVM's instructions. - -import std / [assertions, hashes] -import .. / ic / [bitabs, rodfiles] -import nirlineinfos, nirtypes - -const - NirVersion = 1 - nirCookie* = [byte(0), byte('N'), byte('I'), byte('R'), - byte(sizeof(int)*8), byte(system.cpuEndian), byte(0), byte(NirVersion)] - -type - SymId* = distinct int - -proc `$`*(s: SymId): string {.borrow.} -proc hash*(s: SymId): Hash {.borrow.} -proc `==`*(a, b: SymId): bool {.borrow.} - -type - Opcode* = enum - Nop, - ImmediateVal, - IntVal, - StrVal, - SymDef, - SymUse, - Typed, # with type ID - PragmaId, # with Pragma ID, possible values: see PragmaKey enum - NilVal, - Label, - Goto, - CheckedGoto, - LoopLabel, - GotoLoop, # last atom - - ModuleSymUse, # `"module".x` - - ArrayConstr, - ObjConstr, - Ret, - Yld, - - Select, - SelectPair, # ((values...), Label) - SelectList, # (values...) - SelectValue, # (value) - SelectRange, # (valueA..valueB) - ForeignDecl, # Can wrap SummonGlobal, SummonThreadLocal, SummonConst - SummonGlobal, - SummonThreadLocal, - Summon, # x = Summon Typed <Type ID>; x begins to live - SummonResult, - SummonParam, - SummonConst, - Kill, # `Kill x`: scope end for `x` - - AddrOf, - ArrayAt, # a[i] - DerefArrayAt, # a[i] where `a` is a PtrArray; `a[][i]` - FieldAt, # obj.field - DerefFieldAt, # obj[].field - - Load, # a[] - Store, # a[] = b - Asgn, # a = b - SetExc, - TestExc, - - CheckedRange, - CheckedIndex, - - Call, - IndirectCall, - CheckedCall, # call that can raise - CheckedIndirectCall, # call that can raise - CheckedAdd, # with overflow checking etc. - CheckedSub, - CheckedMul, - CheckedDiv, - CheckedMod, - Add, - Sub, - Mul, - Div, - Mod, - BitShl, - BitShr, - BitAnd, - BitOr, - BitXor, - BitNot, - BoolNot, - Eq, - Le, - Lt, - Cast, - NumberConv, - CheckedObjConv, - ObjConv, - TestOf, - Emit, - ProcDecl, - ForeignProcDecl, - PragmaPair - -type - PragmaKey* = enum - FastCall, StdCall, CDeclCall, SafeCall, SysCall, InlineCall, NoinlineCall, ThisCall, NoCall, - CoreName, - ExternName, - HeaderImport, - DllImport, - DllExport, - ObjExport - -const - LastAtomicValue = GotoLoop - - OpcodeBits = 8'u32 - OpcodeMask = (1'u32 shl OpcodeBits) - 1'u32 - - ValueProducingAtoms = {ImmediateVal, IntVal, StrVal, SymUse, NilVal} - - ValueProducing* = { - ImmediateVal, - IntVal, - StrVal, - SymUse, - NilVal, - ModuleSymUse, - ArrayConstr, - ObjConstr, - CheckedAdd, - CheckedSub, - CheckedMul, - CheckedDiv, - CheckedMod, - Add, - Sub, - Mul, - Div, - Mod, - BitShl, - BitShr, - BitAnd, - BitOr, - BitXor, - BitNot, - BoolNot, - Eq, - Le, - Lt, - Cast, - NumberConv, - CheckedObjConv, - ObjConv, - AddrOf, - Load, - ArrayAt, - DerefArrayAt, - FieldAt, - DerefFieldAt, - TestOf - } - -type - Instr* = object # 8 bytes - x: uint32 - info*: PackedLineInfo - -template kind*(n: Instr): Opcode = Opcode(n.x and OpcodeMask) -template operand(n: Instr): uint32 = (n.x shr OpcodeBits) - -template rawOperand*(n: Instr): uint32 = (n.x shr OpcodeBits) - -template toX(k: Opcode; operand: uint32): uint32 = - uint32(k) or (operand shl OpcodeBits) - -template toX(k: Opcode; operand: LitId): uint32 = - uint32(k) or (operand.uint32 shl OpcodeBits) - -type - Tree* = object - nodes: seq[Instr] - - Values* = object - numbers: BiTable[int64] - strings: BiTable[string] - -type - PatchPos* = distinct int - NodePos* = distinct int - -const - InvalidPatchPos* = PatchPos(-1) - -proc isValid(p: PatchPos): bool {.inline.} = p.int != -1 - -proc prepare*(tree: var Tree; info: PackedLineInfo; kind: Opcode): PatchPos = - result = PatchPos tree.nodes.len - tree.nodes.add Instr(x: toX(kind, 1'u32), info: info) - -proc isAtom(tree: Tree; pos: int): bool {.inline.} = tree.nodes[pos].kind <= LastAtomicValue -proc isAtom(tree: Tree; pos: NodePos): bool {.inline.} = tree.nodes[pos.int].kind <= LastAtomicValue - -proc patch*(tree: var Tree; pos: PatchPos) = - let pos = pos.int - let k = tree.nodes[pos].kind - assert k > LastAtomicValue - let distance = int32(tree.nodes.len - pos) - assert distance > 0 - tree.nodes[pos].x = toX(k, cast[uint32](distance)) - -template build*(tree: var Tree; info: PackedLineInfo; kind: Opcode; body: untyped) = - let pos = prepare(tree, info, kind) - body - patch(tree, pos) - -template buildTyped*(tree: var Tree; info: PackedLineInfo; kind: Opcode; typ: TypeId; body: untyped) = - let pos = prepare(tree, info, kind) - tree.addTyped info, typ - body - patch(tree, pos) - -proc len*(tree: Tree): int {.inline.} = tree.nodes.len - -template rawSpan(n: Instr): int = int(operand(n)) - -proc nextChild(tree: Tree; pos: var int) {.inline.} = - if tree.nodes[pos].kind > LastAtomicValue: - assert tree.nodes[pos].operand > 0'u32 - inc pos, tree.nodes[pos].rawSpan - else: - inc pos - -proc next*(tree: Tree; pos: var NodePos) {.inline.} = nextChild tree, int(pos) - -template firstSon*(n: NodePos): NodePos = NodePos(n.int+1) - -template skipTyped*(n: NodePos): NodePos = NodePos(n.int+2) - -iterator sons*(tree: Tree; n: NodePos): NodePos = - var pos = n.int - assert tree.nodes[pos].kind > LastAtomicValue - let last = pos + tree.nodes[pos].rawSpan - inc pos - while pos < last: - yield NodePos pos - nextChild tree, pos - -iterator sonsFrom1*(tree: Tree; n: NodePos): NodePos = - var pos = n.int - assert tree.nodes[pos].kind > LastAtomicValue - let last = pos + tree.nodes[pos].rawSpan - inc pos - nextChild tree, pos - while pos < last: - yield NodePos pos - nextChild tree, pos - -iterator sonsFromN*(tree: Tree; n: NodePos; toSkip = 2): NodePos = - var pos = n.int - assert tree.nodes[pos].kind > LastAtomicValue - let last = pos + tree.nodes[pos].rawSpan - inc pos - for i in 1..toSkip: - nextChild tree, pos - while pos < last: - yield NodePos pos - nextChild tree, pos - -template `[]`*(t: Tree; n: NodePos): Instr = t.nodes[n.int] - -iterator sonsRest*(tree: Tree; parent, n: NodePos): NodePos = - var pos = n.int - assert tree[parent].kind > LastAtomicValue - let last = parent.int + tree[parent].rawSpan - while pos < last: - yield NodePos pos - nextChild tree, pos - -proc span(tree: Tree; pos: int): int {.inline.} = - if tree.nodes[pos].kind <= LastAtomicValue: 1 else: int(tree.nodes[pos].operand) - -proc copyTree*(dest: var Tree; src: Tree) = - let pos = 0 - let L = span(src, pos) - let d = dest.nodes.len - dest.nodes.setLen(d + L) - assert L > 0 - for i in 0..<L: - dest.nodes[d+i] = src.nodes[pos+i] - -proc sons2*(tree: Tree; n: NodePos): (NodePos, NodePos) {.inline.} = - assert(not isAtom(tree, n.int)) - let a = n.int+1 - let b = a + span(tree, a) - result = (NodePos a, NodePos b) - -proc sons3*(tree: Tree; n: NodePos): (NodePos, NodePos, NodePos) {.inline.} = - assert(not isAtom(tree, n.int)) - let a = n.int+1 - let b = a + span(tree, a) - let c = b + span(tree, b) - result = (NodePos a, NodePos b, NodePos c) - -proc sons4*(tree: Tree; n: NodePos): (NodePos, NodePos, NodePos, NodePos) {.inline.} = - assert(not isAtom(tree, n.int)) - let a = n.int+1 - let b = a + span(tree, a) - let c = b + span(tree, b) - let d = c + span(tree, c) - result = (NodePos a, NodePos b, NodePos c, NodePos d) - -proc sons5*(tree: Tree; n: NodePos): (NodePos, NodePos, NodePos, NodePos, NodePos) {.inline.} = - assert(not isAtom(tree, n.int)) - let a = n.int+1 - let b = a + span(tree, a) - let c = b + span(tree, b) - let d = c + span(tree, c) - let e = d + span(tree, d) - result = (NodePos a, NodePos b, NodePos c, NodePos d, NodePos e) - -proc typeId*(ins: Instr): TypeId {.inline.} = - assert ins.kind == Typed - result = TypeId(ins.operand) - -proc symId*(ins: Instr): SymId {.inline.} = - assert ins.kind in {SymUse, SymDef} - result = SymId(ins.operand) - -proc immediateVal*(ins: Instr): int {.inline.} = - assert ins.kind == ImmediateVal - result = cast[int](ins.operand) - -proc litId*(ins: Instr): LitId {.inline.} = - assert ins.kind in {StrVal, IntVal} - result = LitId(ins.operand) - - -type - LabelId* = distinct int - -proc `==`*(a, b: LabelId): bool {.borrow.} -proc hash*(a: LabelId): Hash {.borrow.} - -proc label*(ins: Instr): LabelId {.inline.} = - assert ins.kind in {Label, LoopLabel, Goto, GotoLoop, CheckedGoto} - result = LabelId(ins.operand) - -proc newLabel*(labelGen: var int): LabelId {.inline.} = - result = LabelId labelGen - inc labelGen - -proc newLabels*(labelGen: var int; n: int): LabelId {.inline.} = - result = LabelId labelGen - inc labelGen, n - -proc addNewLabel*(t: var Tree; labelGen: var int; info: PackedLineInfo; k: Opcode): LabelId = - assert k in {Label, LoopLabel} - result = LabelId labelGen - t.nodes.add Instr(x: toX(k, uint32(result)), info: info) - inc labelGen - -proc gotoLabel*(t: var Tree; info: PackedLineInfo; k: Opcode; L: LabelId) = - assert k in {Goto, GotoLoop, CheckedGoto} - t.nodes.add Instr(x: toX(k, uint32(L)), info: info) - -proc addLabel*(t: var Tree; info: PackedLineInfo; k: Opcode; L: LabelId) {.inline.} = - assert k in {Label, LoopLabel, Goto, GotoLoop, CheckedGoto} - t.nodes.add Instr(x: toX(k, uint32(L)), info: info) - -proc addSymUse*(t: var Tree; info: PackedLineInfo; s: SymId) {.inline.} = - t.nodes.add Instr(x: toX(SymUse, uint32(s)), info: info) - -proc addSymDef*(t: var Tree; info: PackedLineInfo; s: SymId) {.inline.} = - t.nodes.add Instr(x: toX(SymDef, uint32(s)), info: info) - -proc addNop*(t: var Tree; info: PackedLineInfo) {.inline.} = - t.nodes.add Instr(x: toX(Nop, 0'u32), info: info) - -proc addTyped*(t: var Tree; info: PackedLineInfo; typ: TypeId) {.inline.} = - assert typ.int >= 0 - t.nodes.add Instr(x: toX(Typed, uint32(typ)), info: info) - -proc addSummon*(t: var Tree; info: PackedLineInfo; s: SymId; typ: TypeId; opc = Summon) {.inline.} = - assert typ.int >= 0 - assert opc in {Summon, SummonConst, SummonGlobal, SummonThreadLocal, SummonParam, SummonResult} - let x = prepare(t, info, opc) - t.nodes.add Instr(x: toX(Typed, uint32(typ)), info: info) - t.nodes.add Instr(x: toX(SymDef, uint32(s)), info: info) - patch t, x - -proc addImmediateVal*(t: var Tree; info: PackedLineInfo; x: int) = - assert x >= 0 and x < ((1 shl 32) - OpcodeBits.int) - t.nodes.add Instr(x: toX(ImmediateVal, uint32(x)), info: info) - -proc addPragmaId*(t: var Tree; info: PackedLineInfo; x: PragmaKey) = - t.nodes.add Instr(x: toX(PragmaId, uint32(x)), info: info) - -proc addIntVal*(t: var Tree; integers: var BiTable[int64]; info: PackedLineInfo; typ: TypeId; x: int64) = - buildTyped t, info, NumberConv, typ: - t.nodes.add Instr(x: toX(IntVal, uint32(integers.getOrIncl(x))), info: info) - -proc boolVal*(t: var Tree; integers: var BiTable[int64]; info: PackedLineInfo; b: bool) = - buildTyped t, info, NumberConv, Bool8Id: - t.nodes.add Instr(x: toX(IntVal, uint32(integers.getOrIncl(ord b))), info: info) - -proc addStrVal*(t: var Tree; strings: var BiTable[string]; info: PackedLineInfo; s: string) = - t.nodes.add Instr(x: toX(StrVal, uint32(strings.getOrIncl(s))), info: info) - -proc addStrLit*(t: var Tree; info: PackedLineInfo; s: LitId) = - t.nodes.add Instr(x: toX(StrVal, uint32(s)), info: info) - -proc addNilVal*(t: var Tree; info: PackedLineInfo; typ: TypeId) = - buildTyped t, info, NumberConv, typ: - t.nodes.add Instr(x: toX(NilVal, uint32(0)), info: info) - -proc store*(r: var RodFile; t: Tree) = storeSeq r, t.nodes -proc load*(r: var RodFile; t: var Tree) = loadSeq r, t.nodes - -proc escapeToNimLit*(s: string; result: var string) = - result.add '"' - for c in items s: - if c < ' ' or int(c) >= 128: - result.add '\\' - result.addInt int(c) - elif c == '\\': - result.add r"\\" - elif c == '\n': - result.add r"\n" - elif c == '\r': - result.add r"\r" - elif c == '\t': - result.add r"\t" - else: - result.add c - result.add '"' - -type - SymNames* = object - s: seq[LitId] - -proc `[]=`*(t: var SymNames; key: SymId; val: LitId) = - let k = int(key) - if k >= t.s.len: t.s.setLen k+1 - t.s[k] = val - -proc `[]`*(t: SymNames; key: SymId): LitId = - let k = int(key) - if k < t.s.len: result = t.s[k] - else: result = LitId(0) - -template localName(s: SymId): string = - let name = names[s] - if name != LitId(0): - strings[name] - else: - $s.int - -proc store*(r: var RodFile; t: SymNames) = storeSeq(r, t.s) -proc load*(r: var RodFile; t: var SymNames) = loadSeq(r, t.s) - -proc toString*(t: Tree; pos: NodePos; strings: BiTable[string]; integers: BiTable[int64]; - names: SymNames; - r: var string; nesting = 0) = - if r.len > 0 and r[r.len-1] notin {' ', '\n', '(', '[', '{'}: - r.add ' ' - - case t[pos].kind - of Nop: r.add "Nop" - of ImmediateVal: - r.add $t[pos].operand - of IntVal: - r.add "IntVal " - r.add $integers[LitId t[pos].operand] - of StrVal: - escapeToNimLit(strings[LitId t[pos].operand], r) - of SymDef: - r.add "SymDef " - r.add localName(SymId t[pos].operand) - of SymUse: - r.add "SymUse " - r.add localName(SymId t[pos].operand) - of PragmaId: - r.add $cast[PragmaKey](t[pos].operand) - of Typed: - r.add "T<" - r.add $t[pos].operand - r.add ">" - of NilVal: - r.add "NilVal" - of Label: - # undo the nesting: - var spaces = r.len-1 - while spaces >= 0 and r[spaces] == ' ': dec spaces - r.setLen spaces+1 - r.add "\n L" - r.add $t[pos].operand - of Goto, CheckedGoto, LoopLabel, GotoLoop: - r.add $t[pos].kind - r.add " L" - r.add $t[pos].operand - else: - r.add $t[pos].kind - r.add "{\n" - for i in 0..<(nesting+1)*2: r.add ' ' - for p in sons(t, pos): - toString t, p, strings, integers, names, r, nesting+1 - r.add "\n" - for i in 0..<nesting*2: r.add ' ' - r.add "}" - -proc allTreesToString*(t: Tree; strings: BiTable[string]; integers: BiTable[int64]; - names: SymNames; - r: var string) = - var i = 0 - while i < t.len: - toString t, NodePos(i), strings, integers, names, r - nextChild t, i - -type - Value* = distinct Tree - -proc prepare*(dest: var Value; info: PackedLineInfo; k: Opcode): PatchPos {.inline.} = - assert k in ValueProducing - ValueProducingAtoms - result = prepare(Tree(dest), info, k) - -proc patch*(dest: var Value; pos: PatchPos) {.inline.} = - patch(Tree(dest), pos) - -proc localToValue*(info: PackedLineInfo; s: SymId): Value = - result = Value(Tree()) - Tree(result).addSymUse info, s - -proc hasValue*(v: Value): bool {.inline.} = Tree(v).len > 0 - -proc isEmpty*(v: Value): bool {.inline.} = Tree(v).len == 0 - -proc extractTemp*(v: Value): SymId = - if hasValue(v) and Tree(v)[NodePos 0].kind == SymUse: - result = SymId(Tree(v)[NodePos 0].operand) - else: - result = SymId(-1) - -proc copyTree*(dest: var Tree; src: Value) = copyTree dest, Tree(src) - -proc addImmediateVal*(t: var Value; info: PackedLineInfo; x: int) = - assert x >= 0 and x < ((1 shl 32) - OpcodeBits.int) - Tree(t).nodes.add Instr(x: toX(ImmediateVal, uint32(x)), info: info) - -template build*(tree: var Value; info: PackedLineInfo; kind: Opcode; body: untyped) = - let pos = prepare(Tree(tree), info, kind) - body - patch(tree, pos) - -proc addTyped*(t: var Value; info: PackedLineInfo; typ: TypeId) {.inline.} = - addTyped(Tree(t), info, typ) - -template buildTyped*(tree: var Value; info: PackedLineInfo; kind: Opcode; typ: TypeId; body: untyped) = - let pos = prepare(tree, info, kind) - tree.addTyped info, typ - body - patch(tree, pos) - -proc addStrVal*(t: var Value; strings: var BiTable[string]; info: PackedLineInfo; s: string) = - addStrVal(Tree(t), strings, info, s) - -proc addNilVal*(t: var Value; info: PackedLineInfo; typ: TypeId) = - addNilVal Tree(t), info, typ - -proc addIntVal*(t: var Value; integers: var BiTable[int64]; info: PackedLineInfo; typ: TypeId; x: int64) = - addIntVal Tree(t), integers, info, typ, x diff --git a/compiler/nir/nirslots.nim b/compiler/nir/nirslots.nim deleted file mode 100644 index a01e7a633..000000000 --- a/compiler/nir/nirslots.nim +++ /dev/null @@ -1,104 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2023 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Management of slots. Similar to "register allocation" -## in lower level languages. - -import std / [assertions, tables] -import nirtypes, nirinsts - -type - SlotManagerFlag* = enum - ReuseTemps, - ReuseVars - SlotKind* = enum - Temp, Perm - SlotManager* = object # "register allocator" - live: Table[SymId, (SlotKind, TypeId)] - dead: Table[TypeId, seq[SymId]] - flags: set[SlotManagerFlag] - inScope: seq[SymId] - -proc initSlotManager*(flags: set[SlotManagerFlag]): SlotManager {.inline.} = - SlotManager(flags: flags) - -proc allocRaw(m: var SlotManager; t: TypeId; f: SlotManagerFlag; k: SlotKind; - symIdgen: var int32): SymId {.inline.} = - if f in m.flags and m.dead.hasKey(t) and m.dead[t].len > 0: - result = m.dead[t].pop() - else: - inc symIdgen - result = SymId(symIdgen) - m.inScope.add result - m.live[result] = (k, t) - -proc allocTemp*(m: var SlotManager; t: TypeId; symIdgen: var int32): SymId {.inline.} = - result = allocRaw(m, t, ReuseTemps, Temp, symIdgen) - -proc allocVar*(m: var SlotManager; t: TypeId; symIdgen: var int32): SymId {.inline.} = - result = allocRaw(m, t, ReuseVars, Perm, symIdgen) - -proc freeLoc*(m: var SlotManager; s: SymId) = - let t = m.live.getOrDefault(s) - assert t[1].int != 0 - m.live.del s - m.dead.mgetOrPut(t[1], @[]).add s - -proc freeTemp*(m: var SlotManager; s: SymId) = - let t = m.live.getOrDefault(s) - if t[1].int != 0 and t[0] == Temp: - m.live.del s - m.dead.mgetOrPut(t[1], @[]).add s - -iterator stillAlive*(m: SlotManager): (SymId, TypeId) = - for k, v in pairs(m.live): - yield (k, v[1]) - -proc getType*(m: SlotManager; s: SymId): TypeId {.inline.} = m.live[s][1] - -proc openScope*(m: var SlotManager) = - m.inScope.add SymId(-1) # add marker - -proc closeScope*(m: var SlotManager) = - var i = m.inScope.len - 1 - while i >= 0: - if m.inScope[i] == SymId(-1): - m.inScope.setLen i - break - dec i - -when isMainModule: - var symIdgen: int32 - var m = initSlotManager({ReuseTemps}) - - var g = initTypeGraph(Literals()) - - let a = g.openType ArrayTy - g.addBuiltinType Int8Id - g.addArrayLen 5 - let finalArrayType = finishType(g, a) - - let obj = g.openType ObjectDecl - g.addName "MyType" - - g.addField "p", finalArrayType, 0 - let objB = finishType(g, obj) - - let x = m.allocTemp(objB, symIdgen) - assert x.int == 0 - - let y = m.allocTemp(objB, symIdgen) - assert y.int == 1 - - let z = m.allocTemp(Int8Id, symIdgen) - assert z.int == 2 - - m.freeLoc y - let y2 = m.allocTemp(objB, symIdgen) - assert y2.int == 1 diff --git a/compiler/nir/nirtypes.nim b/compiler/nir/nirtypes.nim deleted file mode 100644 index a79bf6d01..000000000 --- a/compiler/nir/nirtypes.nim +++ /dev/null @@ -1,475 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2023 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Type system for NIR. Close to C's type system but without its quirks. - -import std / [assertions, hashes] -import .. / ic / [bitabs, rodfiles] - -type - NirTypeKind* = enum - VoidTy, IntTy, UIntTy, FloatTy, BoolTy, CharTy, NameVal, - IntVal, SizeVal, AlignVal, OffsetVal, - AnnotationVal, - ObjectTy, - UnionTy, - VarargsTy, # the `...` in a C prototype; also the last "atom" - APtrTy, # pointer to aliasable memory - UPtrTy, # pointer to unique/unaliasable memory - AArrayPtrTy, # pointer to array of aliasable memory - UArrayPtrTy, # pointer to array of unique/unaliasable memory - ArrayTy, - LastArrayTy, # array of unspecified size as a last field inside an object - ProcTy, - ObjectDecl, - UnionDecl, - FieldDecl - -const - TypeKindBits = 8'u32 - TypeKindMask = (1'u32 shl TypeKindBits) - 1'u32 - -type - TypeNode* = object # 4 bytes - x: uint32 - -template kind*(n: TypeNode): NirTypeKind = NirTypeKind(n.x and TypeKindMask) -template operand(n: TypeNode): uint32 = (n.x shr TypeKindBits) - -proc integralBits*(n: TypeNode): int {.inline.} = - # Number of bits in the IntTy, etc. Only valid for integral types. - assert n.kind in {IntTy, UIntTy, FloatTy, BoolTy, CharTy} - result = int(n.operand) - -template toX(k: NirTypeKind; operand: uint32): uint32 = - uint32(k) or (operand shl TypeKindBits) - -template toX(k: NirTypeKind; operand: LitId): uint32 = - uint32(k) or (operand.uint32 shl TypeKindBits) - -type - TypeId* = distinct int - -proc `==`*(a, b: TypeId): bool {.borrow.} -proc hash*(a: TypeId): Hash {.borrow.} - -type - Literals* = ref object - strings*: BiTable[string] - numbers*: BiTable[int64] - - TypeGraph* = object - nodes: seq[TypeNode] - lit: Literals - -const - VoidId* = TypeId 0 - Bool8Id* = TypeId 1 - Char8Id* = TypeId 2 - Int8Id* = TypeId 3 - Int16Id* = TypeId 4 - Int32Id* = TypeId 5 - Int64Id* = TypeId 6 - UInt8Id* = TypeId 7 - UInt16Id* = TypeId 8 - UInt32Id* = TypeId 9 - UInt64Id* = TypeId 10 - Float32Id* = TypeId 11 - Float64Id* = TypeId 12 - VoidPtrId* = TypeId 13 - LastBuiltinId* = 13 - -proc initTypeGraph*(lit: Literals): TypeGraph = - result = TypeGraph(nodes: @[ - TypeNode(x: toX(VoidTy, 0'u32)), - TypeNode(x: toX(BoolTy, 8'u32)), - TypeNode(x: toX(CharTy, 8'u32)), - TypeNode(x: toX(IntTy, 8'u32)), - TypeNode(x: toX(IntTy, 16'u32)), - TypeNode(x: toX(IntTy, 32'u32)), - TypeNode(x: toX(IntTy, 64'u32)), - TypeNode(x: toX(UIntTy, 8'u32)), - TypeNode(x: toX(UIntTy, 16'u32)), - TypeNode(x: toX(UIntTy, 32'u32)), - TypeNode(x: toX(UIntTy, 64'u32)), - TypeNode(x: toX(FloatTy, 32'u32)), - TypeNode(x: toX(FloatTy, 64'u32)), - TypeNode(x: toX(APtrTy, 2'u32)), - TypeNode(x: toX(VoidTy, 0'u32)) - ], lit: lit) - assert result.nodes.len == LastBuiltinId+2 - -type - TypePatchPos* = distinct int - -const - InvalidTypePatchPos* = TypePatchPos(-1) - LastAtomicValue = VarargsTy - -proc isValid(p: TypePatchPos): bool {.inline.} = p.int != -1 - -proc prepare(tree: var TypeGraph; kind: NirTypeKind): TypePatchPos = - result = TypePatchPos tree.nodes.len - tree.nodes.add TypeNode(x: toX(kind, 1'u32)) - -proc isAtom(tree: TypeGraph; pos: int): bool {.inline.} = tree.nodes[pos].kind <= LastAtomicValue -proc isAtom(tree: TypeGraph; pos: TypeId): bool {.inline.} = tree.nodes[pos.int].kind <= LastAtomicValue - -proc patch(tree: var TypeGraph; pos: TypePatchPos) = - let pos = pos.int - let k = tree.nodes[pos].kind - assert k > LastAtomicValue - let distance = int32(tree.nodes.len - pos) - assert distance > 0 - tree.nodes[pos].x = toX(k, cast[uint32](distance)) - -proc len*(tree: TypeGraph): int {.inline.} = tree.nodes.len - -template rawSpan(n: TypeNode): int = int(operand(n)) - -proc nextChild(tree: TypeGraph; pos: var int) {.inline.} = - if tree.nodes[pos].kind > LastAtomicValue: - assert tree.nodes[pos].operand > 0'u32 - inc pos, tree.nodes[pos].rawSpan - else: - inc pos - -iterator sons*(tree: TypeGraph; n: TypeId): TypeId = - var pos = n.int - assert tree.nodes[pos].kind > LastAtomicValue - let last = pos + tree.nodes[pos].rawSpan - inc pos - while pos < last: - yield TypeId pos - nextChild tree, pos - -template `[]`*(t: TypeGraph; n: TypeId): TypeNode = t.nodes[n.int] - -proc elementType*(tree: TypeGraph; n: TypeId): TypeId {.inline.} = - assert tree[n].kind in {APtrTy, UPtrTy, AArrayPtrTy, UArrayPtrTy, ArrayTy, LastArrayTy} - result = TypeId(n.int+1) - -proc litId*(n: TypeNode): LitId {.inline.} = - assert n.kind in {NameVal, IntVal, SizeVal, AlignVal, OffsetVal, AnnotationVal, ObjectTy, UnionTy} - result = LitId(n.operand) - -proc kind*(tree: TypeGraph; n: TypeId): NirTypeKind {.inline.} = tree[n].kind - -proc span(tree: TypeGraph; pos: int): int {.inline.} = - if tree.nodes[pos].kind <= LastAtomicValue: 1 else: int(tree.nodes[pos].operand) - -proc sons2(tree: TypeGraph; n: TypeId): (TypeId, TypeId) = - assert(not isAtom(tree, n.int)) - let a = n.int+1 - let b = a + span(tree, a) - result = (TypeId a, TypeId b) - -proc sons3(tree: TypeGraph; n: TypeId): (TypeId, TypeId, TypeId) = - assert(not isAtom(tree, n.int)) - let a = n.int+1 - let b = a + span(tree, a) - let c = b + span(tree, b) - result = (TypeId a, TypeId b, TypeId c) - -proc arrayName*(tree: TypeGraph; n: TypeId): TypeId {.inline.} = - assert tree[n].kind == ArrayTy - let (_, _, c) = sons3(tree, n) - result = c - -proc arrayLen*(tree: TypeGraph; n: TypeId): BiggestInt = - assert tree[n].kind == ArrayTy - let (_, b) = sons2(tree, n) - result = tree.lit.numbers[LitId tree[b].operand] - -proc returnType*(tree: TypeGraph; n: TypeId): (TypeId, TypeId) = - # Returns the positions of the return type + calling convention. - var pos = n.int - assert tree.nodes[pos].kind == ProcTy - let a = n.int+1 - let b = a + span(tree, a) - result = (TypeId b, TypeId a) # not a typo, order is reversed - -iterator params*(tree: TypeGraph; n: TypeId): TypeId = - var pos = n.int - assert tree.nodes[pos].kind == ProcTy - let last = pos + tree.nodes[pos].rawSpan - inc pos - nextChild tree, pos - nextChild tree, pos - while pos < last: - yield TypeId pos - nextChild tree, pos - -proc openType*(tree: var TypeGraph; kind: NirTypeKind): TypePatchPos = - assert kind in {APtrTy, UPtrTy, AArrayPtrTy, UArrayPtrTy, - ArrayTy, LastArrayTy, ProcTy, ObjectDecl, UnionDecl, - FieldDecl} - result = prepare(tree, kind) - -template typeInvariant(p: TypePatchPos) = - when false: - if tree[TypeId(p)].kind == FieldDecl: - var k = 0 - for ch in sons(tree, TypeId(p)): - inc k - assert k > 2, "damn! " & $k - -proc sealType*(tree: var TypeGraph; p: TypePatchPos) = - patch tree, p - typeInvariant(p) - -proc finishType*(tree: var TypeGraph; p: TypePatchPos): TypeId = - # Search for an existing instance of this type in - # order to reduce memory consumption: - patch tree, p - typeInvariant(p) - - let s = span(tree, p.int) - var i = 0 - while i < p.int: - if tree.nodes[i].x == tree.nodes[p.int].x: - var isMatch = true - for j in 1..<s: - if tree.nodes[j+i].x == tree.nodes[j+p.int].x: - discard "still a match" - else: - isMatch = false - break - if isMatch: - if p.int+s == tree.len: - setLen tree.nodes, p.int - return TypeId(i) - nextChild tree, i - result = TypeId(p) - -proc nominalType*(tree: var TypeGraph; kind: NirTypeKind; name: string): TypeId = - assert kind in {ObjectTy, UnionTy} - let content = TypeNode(x: toX(kind, tree.lit.strings.getOrIncl(name))) - for i in 0..<tree.len: - if tree.nodes[i].x == content.x: - return TypeId(i) - result = TypeId tree.nodes.len - tree.nodes.add content - -proc addNominalType*(tree: var TypeGraph; kind: NirTypeKind; name: string) = - assert kind in {ObjectTy, UnionTy} - tree.nodes.add TypeNode(x: toX(kind, tree.lit.strings.getOrIncl(name))) - -proc getTypeTag*(tree: TypeGraph; t: TypeId): string = - assert tree[t].kind in {ObjectTy, UnionTy} - result = tree.lit.strings[LitId tree[t].operand] - -proc addVarargs*(tree: var TypeGraph) = - tree.nodes.add TypeNode(x: toX(VarargsTy, 0'u32)) - -proc getFloat128Type*(tree: var TypeGraph): TypeId = - result = TypeId tree.nodes.len - tree.nodes.add TypeNode(x: toX(FloatTy, 128'u32)) - -proc addBuiltinType*(g: var TypeGraph; id: TypeId) = - g.nodes.add g[id] - -template firstSon*(n: TypeId): TypeId = TypeId(n.int+1) - -proc addType*(g: var TypeGraph; t: TypeId) = - # We cannot simply copy `*Decl` nodes. We have to introduce `*Ty` nodes instead: - if g[t].kind in {ObjectDecl, UnionDecl}: - assert g[t.firstSon].kind == NameVal - let name = LitId g[t.firstSon].operand - if g[t].kind == ObjectDecl: - g.nodes.add TypeNode(x: toX(ObjectTy, name)) - else: - g.nodes.add TypeNode(x: toX(UnionTy, name)) - else: - let pos = t.int - let L = span(g, pos) - let d = g.nodes.len - g.nodes.setLen(d + L) - assert L > 0 - for i in 0..<L: - g.nodes[d+i] = g.nodes[pos+i] - -proc addArrayLen*(g: var TypeGraph; len: int64) = - g.nodes.add TypeNode(x: toX(IntVal, g.lit.numbers.getOrIncl(len))) - -proc addSize*(g: var TypeGraph; s: int64) = - g.nodes.add TypeNode(x: toX(SizeVal, g.lit.numbers.getOrIncl(s))) - -proc addOffset*(g: var TypeGraph; offset: int64) = - g.nodes.add TypeNode(x: toX(OffsetVal, g.lit.numbers.getOrIncl(offset))) - -proc addAlign*(g: var TypeGraph; a: int64) = - g.nodes.add TypeNode(x: toX(AlignVal, g.lit.numbers.getOrIncl(a))) - -proc addName*(g: var TypeGraph; name: string) = - g.nodes.add TypeNode(x: toX(NameVal, g.lit.strings.getOrIncl(name))) - -proc addAnnotation*(g: var TypeGraph; name: string) = - g.nodes.add TypeNode(x: toX(NameVal, g.lit.strings.getOrIncl(name))) - -proc addField*(g: var TypeGraph; name: string; typ: TypeId; offset: int64) = - let f = g.openType FieldDecl - g.addType typ - g.addOffset offset - g.addName name - sealType(g, f) - -proc ptrTypeOf*(g: var TypeGraph; t: TypeId): TypeId = - let f = g.openType APtrTy - g.addType t - result = finishType(g, f) - -proc arrayPtrTypeOf*(g: var TypeGraph; t: TypeId): TypeId = - let f = g.openType AArrayPtrTy - g.addType t - result = finishType(g, f) - -proc store*(r: var RodFile; g: TypeGraph) = - storeSeq r, g.nodes - -proc load*(r: var RodFile; g: var TypeGraph) = - loadSeq r, g.nodes - -proc toString*(dest: var string; g: TypeGraph; i: TypeId) = - case g[i].kind - of VoidTy: dest.add "void" - of IntTy: - dest.add "i" - dest.addInt g[i].operand - of UIntTy: - dest.add "u" - dest.addInt g[i].operand - of FloatTy: - dest.add "f" - dest.addInt g[i].operand - of BoolTy: - dest.add "b" - dest.addInt g[i].operand - of CharTy: - dest.add "c" - dest.addInt g[i].operand - of NameVal, AnnotationVal: - dest.add g.lit.strings[LitId g[i].operand] - of IntVal, SizeVal, AlignVal, OffsetVal: - dest.add $g[i].kind - dest.add ' ' - dest.add $g.lit.numbers[LitId g[i].operand] - of VarargsTy: - dest.add "..." - of APtrTy: - dest.add "aptr[" - toString(dest, g, g.elementType(i)) - dest.add "]" - of UPtrTy: - dest.add "uptr[" - toString(dest, g, g.elementType(i)) - dest.add "]" - of AArrayPtrTy: - dest.add "aArrayPtr[" - toString(dest, g, g.elementType(i)) - dest.add "]" - of UArrayPtrTy: - dest.add "uArrayPtr[" - toString(dest, g, g.elementType(i)) - dest.add "]" - of ArrayTy: - dest.add "Array[" - let (elems, len, name) = g.sons3(i) - toString(dest, g, elems) - dest.add ", " - toString(dest, g, len) - dest.add ", " - toString(dest, g, name) - dest.add "]" - of LastArrayTy: - # array of unspecified size as a last field inside an object - dest.add "LastArrayTy[" - toString(dest, g, g.elementType(i)) - dest.add "]" - of ObjectTy: - dest.add "object " - dest.add g.lit.strings[LitId g[i].operand] - of UnionTy: - dest.add "union " - dest.add g.lit.strings[LitId g[i].operand] - of ProcTy: - dest.add "proc[" - for t in sons(g, i): - dest.add ' ' - toString(dest, g, t) - dest.add "]" - of ObjectDecl: - dest.add "object[" - for t in sons(g, i): - toString(dest, g, t) - dest.add '\n' - dest.add "]" - of UnionDecl: - dest.add "union[" - for t in sons(g, i): - toString(dest, g, t) - dest.add '\n' - dest.add "]" - of FieldDecl: - dest.add "field[" - for t in sons(g, i): - toString(dest, g, t) - dest.add ' ' - dest.add "]" - - when false: - let (typ, offset, name) = g.sons3(i) - toString(dest, g, typ) - dest.add ' ' - toString(dest, g, offset) - dest.add ' ' - toString(dest, g, name) - -proc toString*(dest: var string; g: TypeGraph) = - var i = 0 - while i < g.len: - dest.add "T<" - dest.addInt i - dest.add "> " - toString(dest, g, TypeId i) - dest.add '\n' - nextChild g, i - -iterator allTypes*(g: TypeGraph; start = 0): TypeId = - var i = start - while i < g.len: - yield TypeId i - nextChild g, i - -iterator allTypesIncludingInner*(g: TypeGraph; start = 0): TypeId = - var i = start - while i < g.len: - yield TypeId i - inc i - -proc `$`(g: TypeGraph): string = - result = "" - toString(result, g) - -when isMainModule: - var g = initTypeGraph(Literals()) - - let a = g.openType ArrayTy - g.addBuiltinType Int8Id - g.addArrayLen 5 - g.addName "SomeArray" - let finalArrayType = finishType(g, a) - - let obj = g.openType ObjectDecl - g.nodes.add TypeNode(x: toX(NameVal, g.lit.strings.getOrIncl("MyType"))) - - g.addField "p", finalArrayType, 0 - sealType(g, obj) - - echo g diff --git a/compiler/nir/nirvm.nim b/compiler/nir/nirvm.nim deleted file mode 100644 index faa7a1fb7..000000000 --- a/compiler/nir/nirvm.nim +++ /dev/null @@ -1,1175 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2023 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -##[ NIR is a little too high level to interpret it efficiently. Thus -we compute `addresses` for SymIds, labels and offsets for object fields -in a preprocessing step. - -We also split the instruction stream into separate (code, debug) seqs while -we're at it. -]## - -import std / [syncio, assertions, tables, intsets] -import ".." / ic / bitabs -import nirinsts, nirtypes, nirfiles, nirlineinfos - -type - OpcodeM = enum - ImmediateValM, - IntValM, - StrValM, - LoadLocalM, # with local ID - LoadGlobalM, - LoadProcM, - TypedM, # with type ID - PragmaIdM, # with Pragma ID, possible values: see PragmaKey enum - NilValM, - AllocLocals, - SummonParamM, - GotoM, - CheckedGotoM, # last atom - - ArrayConstrM, - ObjConstrM, - RetM, - YldM, - - SelectM, - SelectPairM, # ((values...), Label) - SelectListM, # (values...) - SelectValueM, # (value) - SelectRangeM, # (valueA..valueB) - - AddrOfM, - ArrayAtM, # (elemSize, addr(a), i) - DerefArrayAtM, - FieldAtM, # addr(obj.field) - DerefFieldAtM, - - LoadM, # a[] - AsgnM, # a = b - StoreM, # a[] = b - SetExcM, - TestExcM, - - CheckedRangeM, - CheckedIndexM, - - CallM, - CheckedAddM, # with overflow checking etc. - CheckedSubM, - CheckedMulM, - CheckedDivM, - CheckedModM, - AddM, - SubM, - MulM, - DivM, - ModM, - BitShlM, - BitShrM, - BitAndM, - BitOrM, - BitXorM, - BitNotM, - BoolNotM, - EqM, - LeM, - LtM, - CastM, - NumberConvM, - CheckedObjConvM, - ObjConvM, - TestOfM, - ProcDeclM, - PragmaPairM - -const - LastAtomicValue = CheckedGotoM - - OpcodeBits = 8'u32 - OpcodeMask = (1'u32 shl OpcodeBits) - 1'u32 - -type - Instr = distinct uint32 - -template kind(n: Instr): OpcodeM = OpcodeM(n.uint32 and OpcodeMask) -template operand(n: Instr): uint32 = (n.uint32 shr OpcodeBits) - -template toIns(k: OpcodeM; operand: uint32): Instr = - Instr(uint32(k) or (operand shl OpcodeBits)) - -template toIns(k: OpcodeM; operand: LitId): Instr = - Instr(uint32(k) or (operand.uint32 shl OpcodeBits)) - -type - NimStrPayloadVM = object - cap: int - data: UncheckedArray[char] - NimStringVM = object - len: int - p: ptr NimStrPayloadVM - -const - GlobalsSize = 1024*24 - -type - PatchPos = distinct int - CodePos = distinct int - - Bytecode* = object - code: seq[Instr] - debug: seq[PackedLineInfo] - m: ref NirModule - procs: Table[SymId, CodePos] - globals: Table[SymId, (uint32, int)] - strings: Table[LitId, NimStringVM] - globalData: pointer - globalsAddr: uint32 - typeImpls: Table[string, TypeId] - offsets: Table[TypeId, seq[(int, TypeId)]] - sizes: Table[TypeId, (int, int)] # (size, alignment) - oldTypeLen: int - procUsagesToPatch: Table[SymId, seq[CodePos]] - interactive*: bool - - Universe* = object ## all units: For interpretation we need that - units: seq[Bytecode] - unitNames: Table[string, int] - current: int - -proc initBytecode*(m: ref NirModule): Bytecode = Bytecode(m: m, globalData: alloc0(GlobalsSize)) - -proc debug(bc: Bytecode; t: TypeId) = - var buf = "" - toString buf, bc.m.types, t - echo buf - -proc debug(bc: Bytecode; info: PackedLineInfo) = - let (litId, line, col) = bc.m.man.unpack(info) - echo bc.m.lit.strings[litId], ":", line, ":", col - -proc debug(bc: Bytecode; t: Tree; n: NodePos) = - var buf = "" - toString(t, n, bc.m.lit.strings, bc.m.lit.numbers, bc.m.symnames, buf) - echo buf - -template `[]`(t: seq[Instr]; n: CodePos): Instr = t[n.int] - -proc traverseObject(b: var Bytecode; t, offsetKey: TypeId) = - var size = -1 - var align = -1 - for x in sons(b.m.types, t): - case b.m.types[x].kind - of FieldDecl: - var offset = -1 - for y in sons(b.m.types, x): - if b.m.types[y].kind == OffsetVal: - offset = int(b.m.lit.numbers[b.m.types[y].litId]) - break - b.offsets.mgetOrPut(offsetKey, @[]).add (offset, x.firstSon) - of SizeVal: - size = int(b.m.lit.numbers[b.m.types[x].litId]) - of AlignVal: - align = int(b.m.lit.numbers[b.m.types[x].litId]) - of ObjectTy: - # inheritance - let impl = b.typeImpls.getOrDefault(b.m.lit.strings[b.m.types[x].litId]) - assert impl.int > 0 - traverseObject b, impl, offsetKey - else: discard - if t == offsetKey: - b.sizes[t] = (size, align) - -proc computeSize(b: var Bytecode; t: TypeId): (int, int) = - case b.m.types[t].kind - of ObjectDecl, UnionDecl: - result = b.sizes[t] - of ObjectTy, UnionTy: - let impl = b.typeImpls[b.m.lit.strings[b.m.types[t].litId]] - result = computeSize(b, impl) - of IntTy, UIntTy, FloatTy, BoolTy, CharTy: - let s = b.m.types[t].integralBits div 8 - result = (s, s) - of APtrTy, UPtrTy, AArrayPtrTy, UArrayPtrTy, ProcTy: - result = (sizeof(pointer), sizeof(pointer)) - of ArrayTy: - let e = elementType(b.m.types, t) - let n = arrayLen(b.m.types, t) - let inner = computeSize(b, e) - result = (inner[0] * n.int, inner[1]) - else: - result = (0, 0) - -proc computeElemSize(b: var Bytecode; t: TypeId): int = - case b.m.types[t].kind - of ArrayTy, APtrTy, UPtrTy, AArrayPtrTy, UArrayPtrTy, LastArrayTy: - result = computeSize(b, elementType(b.m.types, t))[0] - else: - raiseAssert "not an array type" - -proc traverseTypes(b: var Bytecode) = - for t in allTypes(b.m.types, b.oldTypeLen): - if b.m.types[t].kind in {ObjectDecl, UnionDecl}: - assert b.m.types[t.firstSon].kind == NameVal - b.typeImpls[b.m.lit.strings[b.m.types[t.firstSon].litId]] = t - - for t in allTypes(b.m.types, b.oldTypeLen): - if b.m.types[t].kind in {ObjectDecl, UnionDecl}: - assert b.m.types[t.firstSon].kind == NameVal - traverseObject b, t, t - b.oldTypeLen = b.m.types.len - -const - InvalidPatchPos* = PatchPos(-1) - -proc isValid(p: PatchPos): bool {.inline.} = p.int != -1 - -proc prepare(bc: var Bytecode; info: PackedLineInfo; kind: OpcodeM): PatchPos = - result = PatchPos bc.code.len - bc.code.add toIns(kind, 1'u32) - bc.debug.add info - -proc add(bc: var Bytecode; info: PackedLineInfo; kind: OpcodeM; raw: uint32) = - bc.code.add toIns(kind, raw) - bc.debug.add info - -proc add(bc: var Bytecode; info: PackedLineInfo; kind: OpcodeM; lit: LitId) = - add bc, info, kind, uint32(lit) - -proc isAtom(bc: Bytecode; pos: int): bool {.inline.} = bc.code[pos].kind <= LastAtomicValue -proc isAtom(bc: Bytecode; pos: CodePos): bool {.inline.} = bc.code[pos.int].kind <= LastAtomicValue - -proc patch(bc: var Bytecode; pos: PatchPos) = - let pos = pos.int - let k = bc.code[pos].kind - assert k > LastAtomicValue - let distance = int32(bc.code.len - pos) - assert distance > 0 - bc.code[pos] = toIns(k, cast[uint32](distance)) - -template build(bc: var Bytecode; info: PackedLineInfo; kind: OpcodeM; body: untyped) = - let pos = prepare(bc, info, kind) - body - patch(bc, pos) - -proc len*(bc: Bytecode): int {.inline.} = bc.code.len - -template rawSpan(n: Instr): int = int(operand(n)) - -proc nextChild(bc: Bytecode; pos: var int) {.inline.} = - if bc.code[pos].kind > LastAtomicValue: - assert bc.code[pos].operand > 0'u32 - inc pos, bc.code[pos].rawSpan - else: - inc pos - -proc next(bc: Bytecode; pos: var CodePos) {.inline.} = nextChild bc, int(pos) - -iterator sons(bc: Bytecode; n: CodePos): CodePos = - var pos = n.int - assert bc.code[pos].kind > LastAtomicValue - let last = pos + bc.code[pos].rawSpan - inc pos - while pos < last: - yield CodePos pos - nextChild bc, pos - -iterator sonsFrom1(bc: Bytecode; n: CodePos): CodePos = - var pos = n.int - assert bc.code[pos].kind > LastAtomicValue - let last = pos + bc.code[pos].rawSpan - inc pos - nextChild bc, pos - while pos < last: - yield CodePos pos - nextChild bc, pos - -iterator sonsFrom2(bc: Bytecode; n: CodePos): CodePos = - var pos = n.int - assert bc.code[pos].kind > LastAtomicValue - let last = pos + bc.code[pos].rawSpan - inc pos - nextChild bc, pos - nextChild bc, pos - while pos < last: - yield CodePos pos - nextChild bc, pos - -template firstSon(n: CodePos): CodePos = CodePos(n.int+1) - -template `[]`(t: Bytecode; n: CodePos): Instr = t.code[n.int] - -proc span(bc: Bytecode; pos: int): int {.inline.} = - if bc.code[pos].kind <= LastAtomicValue: 1 else: int(bc.code[pos].operand) - -iterator triples*(bc: Bytecode; n: CodePos): (uint32, int, CodePos) = - var pos = n.int - assert bc.code[pos].kind > LastAtomicValue - let last = pos + bc.code[pos].rawSpan - inc pos - while pos < last: - let offset = bc.code[pos].operand - nextChild bc, pos - let size = bc.code[pos].operand.int - nextChild bc, pos - let val = CodePos pos - yield (offset, size, val) - nextChild bc, pos - -proc toString*(t: Bytecode; pos: CodePos; - r: var string; nesting = 0) = - if r.len > 0 and r[r.len-1] notin {' ', '\n', '(', '[', '{'}: - r.add ' ' - - case t[pos].kind - of ImmediateValM: - r.add $t[pos].operand - of IntValM: - r.add "IntVal " - r.add $t.m.lit.numbers[LitId t[pos].operand] - of StrValM: - escapeToNimLit(t.m.lit.strings[LitId t[pos].operand], r) - of LoadLocalM, LoadGlobalM, LoadProcM, AllocLocals, SummonParamM: - r.add $t[pos].kind - r.add ' ' - r.add $t[pos].operand - of PragmaIdM: - r.add $cast[PragmaKey](t[pos].operand) - of TypedM: - r.add "T<" - r.add $t[pos].operand - r.add ">" - of NilValM: - r.add "NilVal" - of GotoM, CheckedGotoM: - r.add $t[pos].kind - r.add " L" - r.add $t[pos].operand - else: - r.add $t[pos].kind - r.add "{\n" - for i in 0..<(nesting+1)*2: r.add ' ' - for p in sons(t, pos): - toString t, p, r, nesting+1 - r.add "\n" - for i in 0..<nesting*2: r.add ' ' - r.add "}" - -proc debug(b: Bytecode; pos: CodePos) = - var buf = "" - toString(b, pos, buf) - echo buf - -type - Preprocessing = object - u: ref Universe - known: Table[LabelId, CodePos] - toPatch: Table[LabelId, seq[CodePos]] - locals: Table[SymId, (uint32, int)] # address, size - thisModule: uint32 - localsAddr: uint32 - markedWithLabel: IntSet - -proc align(address, alignment: uint32): uint32 = - result = (address + (alignment - 1'u32)) and not (alignment - 1'u32) - -proc genGoto(c: var Preprocessing; bc: var Bytecode; info: PackedLineInfo; lab: LabelId; opc: OpcodeM) = - let dest = c.known.getOrDefault(lab, CodePos(-1)) - if dest.int >= 0: - bc.add info, opc, uint32 dest - else: - let here = CodePos(bc.code.len) - c.toPatch.mgetOrPut(lab, @[]).add here - bc.add info, opc, 1u32 # will be patched once we traversed the label - -type - AddrMode = enum - InDotExpr, WantAddr - -template maybeDeref(doDeref: bool; size: int; body: untyped) = - var pos = PatchPos(-1) - if doDeref: - pos = prepare(bc, info, LoadM) - bc.add info, ImmediateValM, uint32 size - body - if doDeref: - patch(bc, pos) - -proc toReadonlyString(s: string): NimStringVM = - if s.len == 0: - result = NimStringVM(len: 0, p: nil) - else: - result = NimStringVM(len: s.len, p: cast[ptr NimStrPayloadVM](alloc(s.len+1+sizeof(int)))) - copyMem(addr result.p.data[0], addr s[0], s.len+1) - result.p.cap = s.len or (1 shl (8 * 8 - 2)) # see also NIM_STRLIT_FLAG - -const - ForwardedProc = 10_000_000'u32 - -proc preprocess(c: var Preprocessing; bc: var Bytecode; t: Tree; n: NodePos; flags: set[AddrMode]) = - let info = t[n].info - - template recurse(opc) = - build bc, info, opc: - for ch in sons(t, n): preprocess(c, bc, t, ch, {WantAddr}) - - case t[n].kind - of Nop, ForeignDecl, ForeignProcDecl: - discard "don't use Nop" - of ImmediateVal: - bc.add info, ImmediateValM, t[n].rawOperand - of IntVal: - bc.add info, IntValM, t[n].rawOperand - of StrVal: - let litId = LitId t[n].rawOperand - if not bc.strings.hasKey(litId): - bc.strings[litId] = toReadonlyString(bc.m.lit.strings[litId]) - bc.add info, StrValM, t[n].rawOperand - of SymDef: - discard "happens for proc decls. Don't copy the node as we don't need it" - of SymUse: - let s = t[n].symId - if c.locals.hasKey(s): - let (address, size) = c.locals[s] - maybeDeref(WantAddr notin flags, size): - bc.add info, LoadLocalM, address - elif bc.procs.hasKey(s): - bc.add info, LoadProcM, uint32 bc.procs[s] - elif bc.globals.hasKey(s): - let (address, size) = bc.globals[s] - maybeDeref(WantAddr notin flags, size): - bc.add info, LoadGlobalM, address - else: - let here = CodePos(bc.code.len) - bc.add info, LoadProcM, ForwardedProc + uint32(s) - bc.procUsagesToPatch.mgetOrPut(s, @[]).add here - #raiseAssert "don't understand SymUse ID " & $int(s) - - of ModuleSymUse: - when false: - let (x, y) = sons2(t, n) - let unit = c.u.unitNames.getOrDefault(bc.m.lit.strings[t[x].litId], -1) - let s = t[y].symId - if c.u.units[unit].procs.hasKey(s): - bc.add info, LoadProcM, uint32 c.u.units[unit].procs[s] - elif bc.globals.hasKey(s): - maybeDeref(WantAddr notin flags): - build bc, info, LoadGlobalM: - bc.add info, ImmediateValM, uint32 unit - bc.add info, LoadLocalM, uint32 s - else: - raiseAssert "don't understand ModuleSymUse ID" - - raiseAssert "don't understand ModuleSymUse ID" - of Typed: - bc.add info, TypedM, t[n].rawOperand - of PragmaId: - bc.add info, PragmaIdM, t[n].rawOperand - of NilVal: - bc.add info, NilValM, t[n].rawOperand - of LoopLabel, Label: - let lab = t[n].label - let here = CodePos(bc.code.len) - c.known[lab] = here - var p: seq[CodePos] = @[] - if c.toPatch.take(lab, p): - for x in p: (bc.code[x]) = toIns(bc.code[x].kind, uint32 here) - c.markedWithLabel.incl here.int # for toString() - of Goto, GotoLoop: - c.genGoto(bc, info, t[n].label, GotoM) - of CheckedGoto: - c.genGoto(bc, info, t[n].label, CheckedGotoM) - of ArrayConstr: - let typ = t[n.firstSon].typeId - let s = computeElemSize(bc, typ) - build bc, info, ArrayConstrM: - bc.add info, ImmediateValM, uint32 s - for ch in sonsFrom1(t, n): - preprocess(c, bc, t, ch, {WantAddr}) - of ObjConstr: - #debug bc, t, n - var i = 0 - let typ = t[n.firstSon].typeId - build bc, info, ObjConstrM: - for ch in sons(t, n): - if i > 0: - if (i mod 2) == 1: - let (offset, typ) = bc.offsets[typ][t[ch].immediateVal] - let size = computeSize(bc, typ)[0] - bc.add info, ImmediateValM, uint32(offset) - bc.add info, ImmediateValM, uint32(size) - else: - preprocess(c, bc, t, ch, {WantAddr}) - inc i - of Ret: - recurse RetM - of Yld: - recurse YldM - of Select: - recurse SelectM - of SelectPair: - recurse SelectPairM - of SelectList: - recurse SelectListM - of SelectValue: - recurse SelectValueM - of SelectRange: - recurse SelectRangeM - of SummonGlobal, SummonThreadLocal, SummonConst: - let (typ, sym) = sons2(t, n) - - let s = t[sym].symId - let tid = t[typ].typeId - let (size, alignment) = computeSize(bc, tid) - - let global = align(bc.globalsAddr, uint32 alignment) - bc.globals[s] = (global, size) - bc.globalsAddr += uint32 size - assert bc.globalsAddr < GlobalsSize - - of Summon: - let (typ, sym) = sons2(t, n) - - let s = t[sym].symId - let tid = t[typ].typeId - let (size, alignment) = computeSize(bc, tid) - - let local = align(c.localsAddr, uint32 alignment) - c.locals[s] = (local, size) - c.localsAddr += uint32 size - # allocation is combined into the frame allocation so there is no - # instruction to emit - of SummonParam, SummonResult: - let (typ, sym) = sons2(t, n) - - let s = t[sym].symId - let tid = t[typ].typeId - let (size, alignment) = computeSize(bc, tid) - - let local = align(c.localsAddr, uint32 alignment) - c.locals[s] = (local, size) - c.localsAddr += uint32 size - bc.add info, SummonParamM, local - bc.add info, ImmediateValM, uint32 size - of Kill: - discard "we don't care about Kill instructions" - of AddrOf: - let (_, arg) = sons2(t, n) - preprocess(c, bc, t, arg, {WantAddr}) - # the address of x is what the VM works with all the time so there is - # nothing to compute. - of ArrayAt: - let (arrayType, a, i) = sons3(t, n) - let tid = t[arrayType].typeId - let size = uint32 computeElemSize(bc, tid) - build bc, info, ArrayAtM: - bc.add info, ImmediateValM, size - preprocess(c, bc, t, a, {WantAddr}) - preprocess(c, bc, t, i, {WantAddr}) - of DerefArrayAt: - let (arrayType, a, i) = sons3(t, n) - let tid = t[arrayType].typeId - let size = uint32 computeElemSize(bc, tid) - build bc, info, DerefArrayAtM: - bc.add info, ImmediateValM, size - preprocess(c, bc, t, a, {WantAddr}) - preprocess(c, bc, t, i, {WantAddr}) - of FieldAt: - let (typ, a, b) = sons3(t, n) - let offset = bc.offsets[t[typ].typeId][t[b].immediateVal][0] - build bc, info, FieldAtM: - preprocess(c, bc, t, a, flags+{WantAddr}) - bc.add info, ImmediateValM, uint32(offset) - of DerefFieldAt: - let (typ, a, b) = sons3(t, n) - let offset = bc.offsets[t[typ].typeId][t[b].immediateVal][0] - build bc, info, DerefFieldAtM: - preprocess(c, bc, t, a, flags+{WantAddr}) - bc.add info, ImmediateValM, uint32(offset) - of Load: - let (elemType, a) = sons2(t, n) - let tid = t[elemType].typeId - build bc, info, LoadM: - bc.add info, ImmediateValM, uint32 computeSize(bc, tid)[0] - preprocess(c, bc, t, a, {}) - - of Store: - raiseAssert "Assumption was that Store is unused!" - of Asgn: - let (elemType, dest, src) = sons3(t, n) - let tid = t[elemType].typeId - if t[src].kind in {Call, IndirectCall}: - # No support for return values, these are mapped to `var T` parameters! - build bc, info, CallM: - preprocess(c, bc, t, src.skipTyped, {WantAddr}) - preprocess(c, bc, t, dest, {WantAddr}) - for ch in sonsFromN(t, src, 2): preprocess(c, bc, t, ch, {WantAddr}) - elif t[src].kind in {CheckedCall, CheckedIndirectCall}: - let (_, gotoInstr, fn) = sons3(t, src) - build bc, info, CallM: - preprocess(c, bc, t, fn, {WantAddr}) - preprocess(c, bc, t, dest, {WantAddr}) - for ch in sonsFromN(t, src, 3): preprocess(c, bc, t, ch, {WantAddr}) - preprocess c, bc, t, gotoInstr, {} - elif t[dest].kind == Load: - let (typ, a) = sons2(t, dest) - let s = computeSize(bc, tid)[0] - build bc, info, StoreM: - bc.add info, ImmediateValM, uint32 s - preprocess(c, bc, t, a, {WantAddr}) - preprocess(c, bc, t, src, {}) - else: - let s = computeSize(bc, tid)[0] - build bc, info, AsgnM: - bc.add info, ImmediateValM, uint32 s - preprocess(c, bc, t, dest, {WantAddr}) - preprocess(c, bc, t, src, {}) - of SetExc: - recurse SetExcM - of TestExc: - recurse TestExcM - of CheckedRange: - recurse CheckedRangeM - of CheckedIndex: - recurse CheckedIndexM - of Call, IndirectCall: - # avoid the Typed thing at position 0: - build bc, info, CallM: - for ch in sonsFrom1(t, n): preprocess(c, bc, t, ch, {WantAddr}) - of CheckedCall, CheckedIndirectCall: - # avoid the Typed thing at position 0: - let (_, gotoInstr, fn) = sons3(t, n) - build bc, info, CallM: - preprocess(c, bc, t, fn, {WantAddr}) - for ch in sonsFromN(t, n, 3): preprocess(c, bc, t, ch, {WantAddr}) - preprocess c, bc, t, gotoInstr, {WantAddr} - of CheckedAdd: - recurse CheckedAddM - of CheckedSub: - recurse CheckedSubM - of CheckedMul: - recurse CheckedMulM - of CheckedDiv: - recurse CheckedDivM - of CheckedMod: - recurse CheckedModM - of Add: - recurse AddM - of Sub: - recurse SubM - of Mul: - recurse MulM - of Div: - recurse DivM - of Mod: - recurse ModM - of BitShl: - recurse BitShlM - of BitShr: - recurse BitShrM - of BitAnd: - recurse BitAndM - of BitOr: - recurse BitOrM - of BitXor: - recurse BitXorM - of BitNot: - recurse BitNotM - of BoolNot: - recurse BoolNotM - of Eq: - recurse EqM - of Le: - recurse LeM - of Lt: - recurse LtM - of Cast: - recurse CastM - of NumberConv: - recurse NumberConvM - of CheckedObjConv: - recurse CheckedObjConvM - of ObjConv: - recurse ObjConvM - of TestOf: - recurse TestOfM - of Emit: - raiseAssert "cannot interpret: Emit" - of ProcDecl: - var c2 = Preprocessing(u: c.u, thisModule: c.thisModule) - let sym = t[n.firstSon].symId - let here = CodePos(bc.len) - var p: seq[CodePos] = @[] - if bc.procUsagesToPatch.take(sym, p): - for x in p: (bc.code[x]) = toIns(bc.code[x].kind, uint32 here) - bc.procs[sym] = here - build bc, info, ProcDeclM: - let toPatch = bc.code.len - bc.add info, AllocLocals, 0'u32 - for ch in sons(t, n): preprocess(c2, bc, t, ch, {}) - bc.code[toPatch] = toIns(AllocLocals, c2.localsAddr) - when false: - if here.int == 39850: - debug bc, t, n - debug bc, here - - of PragmaPair: - recurse PragmaPairM - -const PayloadSize = 128 - -type - StackFrame = ref object - locals: pointer # usually points into `payload` if size is small enough, otherwise it's `alloc`'ed. - payload: array[PayloadSize, byte] - caller: StackFrame - returnAddr: CodePos - jumpTo: CodePos # exception handling - u: ref Universe - -proc newStackFrame(size: int; caller: StackFrame; returnAddr: CodePos): StackFrame = - result = StackFrame(caller: caller, returnAddr: returnAddr, u: caller.u) - if size <= PayloadSize: - result.locals = addr(result.payload) - else: - result.locals = alloc0(size) - -proc popStackFrame(s: StackFrame): StackFrame = - if s.locals != addr(s.payload): - dealloc s.locals - result = s.caller - -template `+!`(p: pointer; diff: uint): pointer = cast[pointer](cast[uint](p) + diff) - -proc isAtom(tree: seq[Instr]; pos: CodePos): bool {.inline.} = tree[pos.int].kind <= LastAtomicValue - -proc span(bc: seq[Instr]; pos: int): int {.inline.} = - if bc[pos].kind <= LastAtomicValue: 1 else: int(bc[pos].operand) - -proc sons2(tree: seq[Instr]; n: CodePos): (CodePos, CodePos) = - assert(not isAtom(tree, n)) - let a = n.int+1 - let b = a + span(tree, a) - result = (CodePos a, CodePos b) - -proc sons3(tree: seq[Instr]; n: CodePos): (CodePos, CodePos, CodePos) = - assert(not isAtom(tree, n)) - let a = n.int+1 - let b = a + span(tree, a) - let c = b + span(tree, b) - result = (CodePos a, CodePos b, CodePos c) - -proc sons4(tree: seq[Instr]; n: CodePos): (CodePos, CodePos, CodePos, CodePos) = - assert(not isAtom(tree, n)) - let a = n.int+1 - let b = a + span(tree, a) - let c = b + span(tree, b) - let d = c + span(tree, c) - result = (CodePos a, CodePos b, CodePos c, CodePos d) - -proc typeId*(ins: Instr): TypeId {.inline.} = - assert ins.kind == TypedM - result = TypeId(ins.operand) - -proc immediateVal*(ins: Instr): int {.inline.} = - assert ins.kind == ImmediateValM - result = cast[int](ins.operand) - -proc litId*(ins: Instr): LitId {.inline.} = - assert ins.kind in {StrValM, IntValM} - result = LitId(ins.operand) - -proc eval(c: Bytecode; pc: CodePos; s: StackFrame; result: pointer; size: int) - -proc evalAddr(c: Bytecode; pc: CodePos; s: StackFrame): pointer = - case c.code[pc].kind - of LoadLocalM: - result = s.locals +! c.code[pc].operand - of FieldAtM: - let (x, offset) = sons2(c.code, pc) - result = evalAddr(c, x, s) - result = result +! c.code[offset].operand - of DerefFieldAtM: - let (x, offset) = sons2(c.code, pc) - let p = evalAddr(c, x, s) - result = cast[ptr pointer](p)[] +! c.code[offset].operand - of ArrayAtM: - let (e, a, i) = sons3(c.code, pc) - let elemSize = c.code[e].operand - result = evalAddr(c, a, s) - var idx: int = 0 - eval(c, i, s, addr idx, sizeof(int)) - result = result +! (uint32(idx) * elemSize) - of DerefArrayAtM: - let (e, a, i) = sons3(c.code, pc) - let elemSize = c.code[e].operand - var p = evalAddr(c, a, s) - var idx: int = 0 - eval(c, i, s, addr idx, sizeof(int)) - result = cast[ptr pointer](p)[] +! (uint32(idx) * elemSize) - of LoadGlobalM: - result = c.globalData +! c.code[pc].operand - else: - raiseAssert("unimplemented addressing mode") - -proc `div`(x, y: float32): float32 {.inline.} = x / y -proc `div`(x, y: float64): float64 {.inline.} = x / y - -from std / math import `mod` - -template binop(opr) {.dirty.} = - template impl(typ) {.dirty.} = - var x = default(typ) - var y = default(typ) - eval c, a, s, addr x, sizeof(typ) - eval c, b, s, addr y, sizeof(typ) - cast[ptr typ](result)[] = opr(x, y) - - let (t, a, b) = sons3(c.code, pc) - let tid = TypeId c.code[t].operand - case tid - of Bool8Id, Char8Id, UInt8Id: impl uint8 - of Int8Id: impl int8 - of Int16Id: impl int16 - of Int32Id: impl int32 - of Int64Id: impl int64 - of UInt16Id: impl uint16 - of UInt32Id: impl uint32 - of UInt64Id: impl uint64 - of Float32Id: impl float32 - of Float64Id: impl float64 - else: discard - -template checkedBinop(opr) {.dirty.} = - template impl(typ) {.dirty.} = - var x = default(typ) - var y = default(typ) - eval c, a, s, addr x, sizeof(typ) - eval c, b, s, addr y, sizeof(typ) - try: - cast[ptr typ](result)[] = opr(x, y) - except OverflowDefect, DivByZeroDefect: - s.jumpTo = CodePos c.code[j].operand - - let (t, j, a, b) = sons4(c.code, pc) - let tid = TypeId c.code[t].operand - case tid - of Bool8Id, Char8Id, UInt8Id: impl uint8 - of Int8Id: impl int8 - of Int16Id: impl int16 - of Int32Id: impl int32 - of Int64Id: impl int64 - of UInt16Id: impl uint16 - of UInt32Id: impl uint32 - of UInt64Id: impl uint64 - of Float32Id: impl float32 - of Float64Id: impl float64 - else: discard - -template bitop(opr) {.dirty.} = - template impl(typ) {.dirty.} = - var x = default(typ) - var y = default(typ) - eval c, a, s, addr x, sizeof(typ) - eval c, b, s, addr y, sizeof(typ) - cast[ptr typ](result)[] = opr(x, y) - - let (t, a, b) = sons3(c.code, pc) - let tid = c.code[t].typeId - case tid - of Bool8Id, Char8Id, UInt8Id: impl uint8 - of Int8Id: impl int8 - of Int16Id: impl int16 - of Int32Id: impl int32 - of Int64Id: impl int64 - of UInt16Id: impl uint16 - of UInt32Id: impl uint32 - of UInt64Id: impl uint64 - else: discard - -template cmpop(opr) {.dirty.} = - template impl(typ) {.dirty.} = - var x = default(typ) - var y = default(typ) - eval c, a, s, addr x, sizeof(typ) - eval c, b, s, addr y, sizeof(typ) - cast[ptr bool](result)[] = opr(x, y) - - let (t, a, b) = sons3(c.code, pc) - let tid = c.code[t].typeId - case tid - of Bool8Id, Char8Id, UInt8Id: impl uint8 - of Int8Id: impl int8 - of Int16Id: impl int16 - of Int32Id: impl int32 - of Int64Id: impl int64 - of UInt16Id: impl uint16 - of UInt32Id: impl uint32 - of UInt64Id: impl uint64 - of Float32Id: impl float32 - of Float64Id: impl float64 - else: discard - -proc evalSelect(c: Bytecode; pc: CodePos; s: StackFrame): CodePos = - template impl(typ) {.dirty.} = - var selector = default(typ) - eval c, sel, s, addr selector, sizeof(typ) - for pair in sonsFrom2(c, pc): - assert c.code[pair].kind == SelectPairM - let (values, action) = sons2(c.code, pair) - if c.code[values].kind == SelectValueM: - var a = default(typ) - eval c, values.firstSon, s, addr a, sizeof(typ) - if selector == a: - return CodePos c.code[action].operand - else: - assert c.code[values].kind == SelectListM, $c.code[values].kind - for v in sons(c, values): - case c.code[v].kind - of SelectValueM: - var a = default(typ) - eval c, v.firstSon, s, addr a, sizeof(typ) - if selector == a: - return CodePos c.code[action].operand - of SelectRangeM: - let (va, vb) = sons2(c.code, v) - var a = default(typ) - eval c, va, s, addr a, sizeof(typ) - var b = default(typ) - eval c, vb, s, addr a, sizeof(typ) - if a <= selector and selector <= b: - return CodePos c.code[action].operand - else: raiseAssert "unreachable" - result = CodePos(-1) - - let (t, sel) = sons2(c.code, pc) - let tid = c.code[t].typeId - case tid - of Bool8Id, Char8Id, UInt8Id: impl uint8 - of Int8Id: impl int8 - of Int16Id: impl int16 - of Int32Id: impl int32 - of Int64Id: impl int64 - of UInt16Id: impl uint16 - of UInt32Id: impl uint32 - of UInt64Id: impl uint64 - else: raiseAssert "unreachable" - -proc eval(c: Bytecode; pc: CodePos; s: StackFrame; result: pointer; size: int) = - case c.code[pc].kind - of LoadLocalM: - let src = s.locals +! c.code[pc].operand - copyMem result, src, size - of FieldAtM, DerefFieldAtM, ArrayAtM, DerefArrayAtM, LoadGlobalM: - let src = evalAddr(c, pc, s) - copyMem result, src, size - of LoadProcM: - let procAddr = c.code[pc].operand - cast[ptr pointer](result)[] = cast[pointer](procAddr) - of LoadM: - let (_, arg) = sons2(c.code, pc) - let src = evalAddr(c, arg, s) - copyMem result, src, size - of CheckedAddM: checkedBinop `+` - of CheckedSubM: checkedBinop `-` - of CheckedMulM: checkedBinop `*` - of CheckedDivM: checkedBinop `div` - of CheckedModM: checkedBinop `mod` - of AddM: binop `+` - of SubM: binop `-` - of MulM: binop `*` - of DivM: binop `div` - of ModM: binop `mod` - of BitShlM: bitop `shl` - of BitShrM: bitop `shr` - of BitAndM: bitop `and` - of BitOrM: bitop `or` - of BitXorM: bitop `xor` - of EqM: cmpop `==` - of LeM: cmpop `<=` - of LtM: cmpop `<` - - of StrValM: - # binary compatible and no deep copy required: - copyMem(cast[ptr string](result), addr(c.strings[c[pc].litId]), sizeof(string)) - of ObjConstrM: - for offset, size, val in triples(c, pc): - eval c, val, s, result+!offset, size - of ArrayConstrM: - let elemSize = c.code[pc.firstSon].operand - var r = result - for ch in sonsFrom1(c, pc): - eval c, ch, s, r, elemSize.int - r = r+!elemSize # can even do strength reduction here! - of NumberConvM: - let (t, x) = sons2(c.code, pc) - let word = if c[x].kind == NilValM: 0'i64 else: c.m.lit.numbers[c[x].litId] - - template impl(typ: typedesc) {.dirty.} = - cast[ptr typ](result)[] = cast[typ](word) - - let tid = c.code[t].typeId - case tid - of Bool8Id, Char8Id, UInt8Id: impl uint8 - of Int8Id: impl int8 - of Int16Id: impl int16 - of Int32Id: impl int32 - of Int64Id: impl int64 - of UInt16Id: impl uint16 - of UInt32Id: impl uint32 - of UInt64Id: impl uint64 - of Float32Id: impl float32 - of Float64Id: impl float64 - else: - case c.m.types[tid].kind - of ProcTy, UPtrTy, APtrTy, AArrayPtrTy, UArrayPtrTy: - # the VM always uses 64 bit pointers: - impl uint64 - else: - raiseAssert "cannot happen: " & $c.m.types[tid].kind - else: - #debug c, c.debug[pc.int] - raiseAssert "cannot happen: " & $c.code[pc].kind - -proc evalProc(c: Bytecode; pc: CodePos; s: StackFrame): CodePos = - assert c.code[pc].kind == LoadProcM - let procSym = c[pc].operand - when false: - if procSym >= ForwardedProc: - for k, v in c.procUsagesToPatch: - if uint32(k) == procSym - ForwardedProc: - echo k.int, " ", v.len, " <-- this one" - else: - echo k.int, " ", v.len - - assert procSym < ForwardedProc - result = CodePos(procSym) - -proc echoImpl(c: Bytecode; pc: CodePos; frame: StackFrame) = - var s = default(NimStringVM) - for a in sonsFrom1(c, pc): - assert c[a].kind == ArrayConstrM - let elemSize = c.code[a.firstSon].operand.int - for ch in sonsFrom1(c, a): - eval c, ch, frame, addr s, elemSize - if s.len > 0: - discard stdout.writeBuffer(addr(s.p.data[0]), s.len) - stdout.write "\n" - stdout.flushFile() - -type - EvalBuiltinState = enum - DidNothing, DidEval, DidError - -proc evalBuiltin(c: Bytecode; pc: CodePos; s: StackFrame; prc: CodePos; state: var EvalBuiltinState): CodePos = - var prc = prc - while true: - case c[prc].kind - of PragmaPairM: - let (x, y) = sons2(c.code, prc) - let key = cast[PragmaKey](c[x].operand) - case key - of CoreName: - let lit = c[y].litId - case c.m.lit.strings[lit] - of "echoBinSafe": echoImpl(c, pc, s) - else: - raiseAssert "cannot eval: " & c.m.lit.strings[lit] - state = DidEval - of HeaderImport, DllImport: - let lit = c[y].litId - raiseAssert "cannot eval: " & c.m.lit.strings[lit] - else: discard - of PragmaIdM, AllocLocals: discard - else: break - next c, prc - result = prc - -proc exec(c: Bytecode; pc: CodePos; u: ref Universe) = - var pc = pc - var frame = StackFrame(u: u) - while pc.int < c.code.len: - when false: # c.interactive: - echo "running: ", pc.int - debug c, pc - - case c.code[pc].kind - of GotoM: - pc = CodePos(c.code[pc].operand) - of AsgnM: - let (sz, a, b) = sons3(c.code, pc) - let dest = evalAddr(c, a, frame) - eval(c, b, frame, dest, c.code[sz].operand.int) - next c, pc - of StoreM: - let (sz, a, b) = sons3(c.code, pc) - let destPtr = evalAddr(c, a, frame) - let dest = cast[ptr pointer](destPtr)[] - eval(c, b, frame, dest, c.code[sz].operand.int) - next c, pc - of CallM: - # No support for return values, these are mapped to `var T` parameters! - var prc = evalProc(c, pc.firstSon, frame) - assert c.code[prc.firstSon].kind == AllocLocals - let frameSize = int c.code[prc.firstSon].operand - # skip stupid stuff: - var evalState = DidNothing - prc = evalBuiltin(c, pc, frame, prc.firstSon, evalState) - if evalState != DidNothing: - next c, pc - if pc.int < c.code.len and c.code[pc].kind == CheckedGotoM: - if evalState == DidEval: - next c, pc - else: - pc = CodePos(c.code[pc].operand) - else: - # setup storage for the proc already: - let callInstr = pc - next c, pc - let s2 = newStackFrame(frameSize, frame, pc) - for a in sonsFrom1(c, callInstr): - assert c[prc].kind == SummonParamM - let paramAddr = c[prc].operand - next c, prc - assert c[prc].kind == ImmediateValM - let paramSize = c[prc].operand.int - next c, prc - eval(c, a, s2, s2.locals +! paramAddr, paramSize) - frame = s2 - pc = prc - of RetM: - pc = frame.returnAddr - if c.code[pc].kind == CheckedGotoM: - pc = frame.jumpTo - frame = popStackFrame(frame) - of SelectM: - let pc2 = evalSelect(c, pc, frame) - if pc2.int >= 0: - pc = pc2 - else: - next c, pc - of ProcDeclM: - next c, pc - else: - #debug c, c.debug[pc.int] - raiseAssert "unreachable: " & $c.code[pc].kind - -proc execCode*(bc: var Bytecode; t: Tree; n: NodePos) = - traverseTypes bc - var c = Preprocessing(u: nil, thisModule: 1'u32) - let start = CodePos(bc.code.len) - var pc = n - while pc.int < t.len: - #if bc.interactive: - # echo "RUnning: " - # debug bc, t, pc - preprocess c, bc, t, pc, {} - next t, pc - exec bc, start, nil diff --git a/compiler/nir/stringcases.nim b/compiler/nir/stringcases.nim deleted file mode 100644 index afdf8fda4..000000000 --- a/compiler/nir/stringcases.nim +++ /dev/null @@ -1,200 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2023 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## included from ast2ir.nim - -#[ - -case s -of "abc", "abbd": - echo 1 -of "hah": - echo 2 -of "gah": - echo 3 - -# we produce code like this: - -if s[0] <= 'a': - if s == "abc: goto L1 - elif s == "abbd": goto L1 -else: - if s[2] <= 'h': - if s == "hah": goto L2 - elif s == "gah": goto L3 -goto afterCase - -L1: - echo 1 - goto afterCase -L2: - echo 2 - goto afterCase -L3: - echo 3 - goto afterCase - -afterCase: ... - -]# - -# We split the set of strings into 2 sets of roughly the same size. -# The condition used for splitting is a (position, char) tuple. -# Every string of length > position for which s[position] <= char is in one -# set else it is in the other set. - -from std/sequtils import addUnique - -type - Key = (LitId, LabelId) - -proc splitValue(strings: BiTable[string]; a: openArray[Key]; position: int): (char, float) = - var cand: seq[char] = @[] - for t in items a: - let s = strings[t[0]] - if s.len > position: cand.addUnique s[position] - - result = ('\0', -1.0) - for disc in items cand: - var hits = 0 - for t in items a: - let s = strings[t[0]] - if s.len > position and s[position] <= disc: - inc hits - # the split is the better, the more `hits` is close to `a.len / 2`: - let grade = 100000.0 - abs(hits.float - a.len.float / 2.0) - if grade > result[1]: - result = (disc, grade) - -proc tryAllPositions(strings: BiTable[string]; a: openArray[Key]): (char, int) = - var m = 0 - for t in items a: - m = max(m, strings[t[0]].len) - - result = ('\0', -1) - var best = -1.0 - for i in 0 ..< m: - let current = splitValue(strings, a, i) - if current[1] > best: - best = current[1] - result = (current[0], i) - -type - SearchKind = enum - LinearSearch, SplitSearch - SearchResult* = object - case kind: SearchKind - of LinearSearch: - a: seq[Key] - of SplitSearch: - span: int - best: (char, int) - -proc emitLinearSearch(strings: BiTable[string]; a: openArray[Key]; dest: var seq[SearchResult]) = - var d = SearchResult(kind: LinearSearch, a: @[]) - for x in a: d.a.add x - dest.add d - -proc split(strings: BiTable[string]; a: openArray[Key]; dest: var seq[SearchResult]) = - if a.len <= 4: - emitLinearSearch strings, a, dest - else: - let best = tryAllPositions(strings, a) - var groupA: seq[Key] = @[] - var groupB: seq[Key] = @[] - for t in items a: - let s = strings[t[0]] - if s.len > best[1] and s[best[1]] <= best[0]: - groupA.add t - else: - groupB.add t - if groupA.len == 0 or groupB.len == 0: - emitLinearSearch strings, a, dest - else: - let toPatch = dest.len - dest.add SearchResult(kind: SplitSearch, span: 1, best: best) - split strings, groupA, dest - split strings, groupB, dest - let dist = dest.len - toPatch - assert dist > 0 - dest[toPatch].span = dist - -proc toProblemDescription(c: var ProcCon; n: PNode): (seq[Key], LabelId) = - result = (@[], newLabels(c.labelGen, n.len)) - assert n.kind == nkCaseStmt - for i in 1..<n.len: - let it = n[i] - let thisBranch = LabelId(result[1].int + i - 1) - if it.kind == nkOfBranch: - for j in 0..<it.len-1: - assert it[j].kind in {nkStrLit..nkTripleStrLit} - result[0].add (c.lit.strings.getOrIncl(it[j].strVal), thisBranch) - -proc decodeSolution(c: var ProcCon; dest: var Tree; s: seq[SearchResult]; i: int; - selector: Value; info: PackedLineInfo) = - case s[i].kind - of SplitSearch: - let thenA = i+1 - let elseA = thenA + (if s[thenA].kind == LinearSearch: 1 else: s[thenA].span) - let best = s[i].best - - let tmp = getTemp(c, Bool8Id, info) - buildTyped dest, info, Asgn, Bool8Id: - dest.copyTree tmp - buildTyped dest, info, Call, Bool8Id: - c.addUseCodegenProc dest, "nimStrAtLe", info - dest.copyTree selector - dest.addIntVal c.lit.numbers, info, c.m.nativeIntId, best[1] - dest.addIntVal c.lit.numbers, info, Char8Id, best[0].int - - template then() = - c.decodeSolution dest, s, thenA, selector, info - template otherwise() = - c.decodeSolution dest, s, elseA, selector, info - buildIfThenElse tmp, then, otherwise - freeTemp c, tmp - - of LinearSearch: - let tmp = getTemp(c, Bool8Id, info) - for x in s[i].a: - buildTyped dest, info, Asgn, Bool8Id: - dest.copyTree tmp - buildTyped dest, info, Call, Bool8Id: - c.addUseCodegenProc dest, "eqStrings", info - dest.copyTree selector - dest.addStrLit info, x[0] - buildIf tmp: - c.code.gotoLabel info, Goto, x[1] - freeTemp c, tmp - -proc genStringCase(c: var ProcCon; n: PNode; d: var Value) = - let (problem, firstBranch) = toProblemDescription(c, n) - var solution: seq[SearchResult] = @[] - split c.lit.strings, problem, solution - - # XXX Todo move complex case selector into a temporary. - let selector = c.genx(n[0]) - - let info = toLineInfo(c, n.info) - decodeSolution c, c.code, solution, 0, selector, info - - let lend = newLabel(c.labelGen) - c.code.addLabel info, Goto, lend - for i in 1..<n.len: - let it = n[i] - let thisBranch = LabelId(firstBranch.int + i - 1) - c.code.addLabel info, Label, thisBranch - if it.kind == nkOfBranch: - gen(c, it.lastSon, d) - c.code.addLabel info, Goto, lend - else: - gen(c, it.lastSon, d) - - c.code.addLabel info, Label, lend - freeTemp c, selector diff --git a/compiler/nir/types2ir.nim b/compiler/nir/types2ir.nim deleted file mode 100644 index 9c9513284..000000000 --- a/compiler/nir/types2ir.nim +++ /dev/null @@ -1,525 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2023 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import std / [assertions, tables, sets] -import ".." / [ast, types, options, sighashes, modulegraphs] -import nirtypes - -type - TypesCon* = object - processed: Table[ItemId, TypeId] - processedByName: Table[string, TypeId] - recursionCheck: HashSet[ItemId] - conf: ConfigRef - stringType: TypeId - -proc initTypesCon*(conf: ConfigRef): TypesCon = - TypesCon(conf: conf, stringType: TypeId(-1)) - -proc mangle(c: var TypesCon; t: PType): string = - result = $sighashes.hashType(t, c.conf) - -template cached(c: var TypesCon; t: PType; body: untyped) = - result = c.processed.getOrDefault(t.itemId) - if result.int == 0: - body - c.processed[t.itemId] = result - -template cachedByName(c: var TypesCon; t: PType; body: untyped) = - let key = mangle(c, t) - result = c.processedByName.getOrDefault(key) - if result.int == 0: - body - c.processedByName[key] = result - -proc typeToIr*(c: var TypesCon; g: var TypeGraph; t: PType): TypeId - -proc collectFieldTypes(c: var TypesCon; g: var TypeGraph; n: PNode; dest: var Table[ItemId, TypeId]) = - case n.kind - of nkRecList: - for i in 0..<n.len: - collectFieldTypes(c, g, n[i], dest) - of nkRecCase: - assert(n[0].kind == nkSym) - collectFieldTypes(c, g, n[0], dest) - for i in 1..<n.len: - case n[i].kind - of nkOfBranch, nkElse: - collectFieldTypes c, g, lastSon(n[i]), dest - else: discard - of nkSym: - dest[n.sym.itemId] = typeToIr(c, g, n.sym.typ) - else: - assert false, "unknown node kind: " & $n.kind - -proc objectToIr(c: var TypesCon; g: var TypeGraph; n: PNode; fieldTypes: Table[ItemId, TypeId]; unionId: var int) = - case n.kind - of nkRecList: - for i in 0..<n.len: - objectToIr(c, g, n[i], fieldTypes, unionId) - of nkRecCase: - assert(n[0].kind == nkSym) - objectToIr(c, g, n[0], fieldTypes, unionId) - let u = openType(g, UnionDecl) - g.addName "u_" & $unionId - inc unionId - for i in 1..<n.len: - case n[i].kind - of nkOfBranch, nkElse: - let subObj = openType(g, ObjectDecl) - g.addName "uo_" & $unionId & "_" & $i - objectToIr c, g, lastSon(n[i]), fieldTypes, unionId - sealType(g, subObj) - else: discard - sealType(g, u) - of nkSym: - g.addField n.sym.name.s & "_" & $n.sym.position, fieldTypes[n.sym.itemId], n.sym.offset - else: - assert false, "unknown node kind: " & $n.kind - -proc objectToIr(c: var TypesCon; g: var TypeGraph; t: PType): TypeId = - if t[0] != nil: - # ensure we emitted the base type: - discard typeToIr(c, g, t[0]) - - var unionId = 0 - var fieldTypes = initTable[ItemId, TypeId]() - collectFieldTypes c, g, t.n, fieldTypes - let obj = openType(g, ObjectDecl) - g.addName mangle(c, t) - g.addSize c.conf.getSize(t) - g.addAlign c.conf.getAlign(t) - - if t[0] != nil: - g.addNominalType(ObjectTy, mangle(c, t[0])) - else: - g.addBuiltinType VoidId # object does not inherit - if not lacksMTypeField(t): - let f2 = g.openType FieldDecl - let voidPtr = openType(g, APtrTy) - g.addBuiltinType(VoidId) - sealType(g, voidPtr) - g.addOffset 0 # type field is always at offset 0 - g.addName "m_type" - sealType(g, f2) # FieldDecl - - objectToIr c, g, t.n, fieldTypes, unionId - result = finishType(g, obj) - -proc objectHeaderToIr(c: var TypesCon; g: var TypeGraph; t: PType): TypeId = - result = g.nominalType(ObjectTy, mangle(c, t)) - -proc tupleToIr(c: var TypesCon; g: var TypeGraph; t: PType): TypeId = - var fieldTypes = newSeq[TypeId](t.len) - for i in 0..<t.len: - fieldTypes[i] = typeToIr(c, g, t[i]) - let obj = openType(g, ObjectDecl) - g.addName mangle(c, t) - g.addSize c.conf.getSize(t) - g.addAlign c.conf.getAlign(t) - - var accum = OffsetAccum(maxAlign: 1) - for i in 0..<t.len: - let child = t[i] - g.addField "f_" & $i, fieldTypes[i], accum.offset - - computeSizeAlign(c.conf, child) - accum.align(child.align) - accum.inc(int32(child.size)) - result = finishType(g, obj) - -proc procToIr(c: var TypesCon; g: var TypeGraph; t: PType; addEnv = false): TypeId = - var fieldTypes = newSeq[TypeId](0) - for i in 0..<t.len: - if t[i] == nil or not isCompileTimeOnly(t[i]): - fieldTypes.add typeToIr(c, g, t[i]) - let obj = openType(g, ProcTy) - - case t.callConv - of ccNimCall, ccFastCall, ccClosure: g.addAnnotation "__fastcall" - of ccStdCall: g.addAnnotation "__stdcall" - of ccCDecl: g.addAnnotation "__cdecl" - of ccSafeCall: g.addAnnotation "__safecall" - of ccSysCall: g.addAnnotation "__syscall" - of ccInline: g.addAnnotation "__inline" - of ccNoInline: g.addAnnotation "__noinline" - of ccThisCall: g.addAnnotation "__thiscall" - of ccNoConvention: g.addAnnotation "" - - for i in 0..<fieldTypes.len: - g.addType fieldTypes[i] - - if addEnv: - let a = openType(g, APtrTy) - g.addBuiltinType(VoidId) - sealType(g, a) - - if tfVarargs in t.flags: - g.addVarargs() - result = finishType(g, obj) - -proc nativeInt(c: TypesCon): TypeId = - case c.conf.target.intSize - of 2: result = Int16Id - of 4: result = Int32Id - else: result = Int64Id - -proc openArrayPayloadType*(c: var TypesCon; g: var TypeGraph; t: PType): TypeId = - let e = lastSon(t) - let elementType = typeToIr(c, g, e) - let arr = g.openType AArrayPtrTy - g.addType elementType - result = finishType(g, arr) # LastArrayTy - -proc openArrayToIr(c: var TypesCon; g: var TypeGraph; t: PType): TypeId = - # object (a: ArrayPtr[T], len: int) - let e = lastSon(t) - let mangledBase = mangle(c, e) - let typeName = "NimOpenArray" & mangledBase - - let elementType = typeToIr(c, g, e) - #assert elementType.int >= 0, typeToString(t) - - let p = openType(g, ObjectDecl) - g.addName typeName - g.addSize c.conf.target.ptrSize*2 - g.addAlign c.conf.target.ptrSize - - let f = g.openType FieldDecl - let arr = g.openType AArrayPtrTy - g.addType elementType - sealType(g, arr) # LastArrayTy - g.addOffset 0 - g.addName "data" - sealType(g, f) # FieldDecl - - g.addField "len", c.nativeInt, c.conf.target.ptrSize - - result = finishType(g, p) # ObjectDecl - -proc strPayloadType(c: var TypesCon; g: var TypeGraph): (string, TypeId) = - result = ("NimStrPayload", TypeId(-1)) - let p = openType(g, ObjectDecl) - g.addName result[0] - g.addSize c.conf.target.ptrSize*2 - g.addAlign c.conf.target.ptrSize - - g.addField "cap", c.nativeInt, 0 - - let f = g.openType FieldDecl - let arr = g.openType LastArrayTy - g.addBuiltinType Char8Id - result[1] = finishType(g, arr) # LastArrayTy - g.addOffset c.conf.target.ptrSize # comes after the len field - g.addName "data" - sealType(g, f) # FieldDecl - - sealType(g, p) - -proc strPayloadPtrType*(c: var TypesCon; g: var TypeGraph): (TypeId, TypeId) = - let (mangled, arrayType) = strPayloadType(c, g) - let ffp = g.openType APtrTy - g.addNominalType ObjectTy, mangled - result = (finishType(g, ffp), arrayType) # APtrTy - -proc stringToIr(c: var TypesCon; g: var TypeGraph): TypeId = - #[ - - NimStrPayload = object - cap: int - data: UncheckedArray[char] - - NimStringV2 = object - len: int - p: ptr NimStrPayload - - ]# - let payload = strPayloadType(c, g) - - let str = openType(g, ObjectDecl) - g.addName "NimStringV2" - g.addSize c.conf.target.ptrSize*2 - g.addAlign c.conf.target.ptrSize - - g.addField "len", c.nativeInt, 0 - - let fp = g.openType FieldDecl - let ffp = g.openType APtrTy - g.addNominalType ObjectTy, "NimStrPayload" - sealType(g, ffp) # APtrTy - g.addOffset c.conf.target.ptrSize # comes after 'len' field - g.addName "p" - sealType(g, fp) # FieldDecl - - result = finishType(g, str) # ObjectDecl - -proc seqPayloadType(c: var TypesCon; g: var TypeGraph; t: PType): (string, TypeId) = - #[ - NimSeqPayload[T] = object - cap: int - data: UncheckedArray[T] - ]# - let e = lastSon(t) - result = (mangle(c, e), TypeId(-1)) - let payloadName = "NimSeqPayload" & result[0] - - let elementType = typeToIr(c, g, e) - - let p = openType(g, ObjectDecl) - g.addName payloadName - g.addSize c.conf.target.intSize - g.addAlign c.conf.target.intSize - - g.addField "cap", c.nativeInt, 0 - - let f = g.openType FieldDecl - let arr = g.openType LastArrayTy - g.addType elementType - # DO NOT USE `finishType` here as it is an inner type. This is subtle and we - # probably need an even better API here. - sealType(g, arr) - result[1] = TypeId(arr) - - g.addOffset c.conf.target.ptrSize - g.addName "data" - sealType(g, f) # FieldDecl - - sealType(g, p) - -proc seqPayloadPtrType*(c: var TypesCon; g: var TypeGraph; t: PType): (TypeId, TypeId) = - let (mangledBase, arrayType) = seqPayloadType(c, g, t) - let ffp = g.openType APtrTy - g.addNominalType ObjectTy, "NimSeqPayload" & mangledBase - result = (finishType(g, ffp), arrayType) # APtrTy - -proc seqToIr(c: var TypesCon; g: var TypeGraph; t: PType): TypeId = - #[ - NimSeqV2*[T] = object - len: int - p: ptr NimSeqPayload[T] - ]# - let (mangledBase, _) = seqPayloadType(c, g, t) - - let sq = openType(g, ObjectDecl) - g.addName "NimSeqV2" & mangledBase - g.addSize c.conf.getSize(t) - g.addAlign c.conf.getAlign(t) - - g.addField "len", c.nativeInt, 0 - - let fp = g.openType FieldDecl - let ffp = g.openType APtrTy - g.addNominalType ObjectTy, "NimSeqPayload" & mangledBase - sealType(g, ffp) # APtrTy - g.addOffset c.conf.target.ptrSize - g.addName "p" - sealType(g, fp) # FieldDecl - - result = finishType(g, sq) # ObjectDecl - - -proc closureToIr(c: var TypesCon; g: var TypeGraph; t: PType): TypeId = - # struct {fn(args, void* env), env} - # typedef struct {$n" & - # "N_NIMCALL_PTR($2, ClP_0) $3;$n" & - # "void* ClE_0;$n} $1;$n" - let mangledBase = mangle(c, t) - let typeName = "NimClosure" & mangledBase - - let procType = procToIr(c, g, t, addEnv=true) - - let p = openType(g, ObjectDecl) - g.addName typeName - g.addSize c.conf.getSize(t) - g.addAlign c.conf.getAlign(t) - - let f = g.openType FieldDecl - g.addType procType - g.addOffset 0 - g.addName "ClP_0" - sealType(g, f) # FieldDecl - - let f2 = g.openType FieldDecl - let voidPtr = openType(g, APtrTy) - g.addBuiltinType(VoidId) - sealType(g, voidPtr) - - g.addOffset c.conf.target.ptrSize - g.addName "ClE_0" - sealType(g, f2) # FieldDecl - - result = finishType(g, p) # ObjectDecl - -proc bitsetBasetype*(c: var TypesCon; g: var TypeGraph; t: PType): TypeId = - let s = int(getSize(c.conf, t)) - case s - of 1: result = UInt8Id - of 2: result = UInt16Id - of 4: result = UInt32Id - of 8: result = UInt64Id - else: result = UInt8Id - -proc typeToIr*(c: var TypesCon; g: var TypeGraph; t: PType): TypeId = - if t == nil: return VoidId - case t.kind - of tyInt: - case int(getSize(c.conf, t)) - of 2: result = Int16Id - of 4: result = Int32Id - else: result = Int64Id - of tyInt8: result = Int8Id - of tyInt16: result = Int16Id - of tyInt32: result = Int32Id - of tyInt64: result = Int64Id - of tyFloat: - case int(getSize(c.conf, t)) - of 4: result = Float32Id - else: result = Float64Id - of tyFloat32: result = Float32Id - of tyFloat64: result = Float64Id - of tyFloat128: result = getFloat128Type(g) - of tyUInt: - case int(getSize(c.conf, t)) - of 2: result = UInt16Id - of 4: result = UInt32Id - else: result = UInt64Id - of tyUInt8: result = UInt8Id - of tyUInt16: result = UInt16Id - of tyUInt32: result = UInt32Id - of tyUInt64: result = UInt64Id - of tyBool: result = Bool8Id - of tyChar: result = Char8Id - of tyVoid: result = VoidId - of tySink, tyGenericInst, tyDistinct, tyAlias, tyOwned, tyRange: - result = typeToIr(c, g, t.lastSon) - of tyEnum: - if firstOrd(c.conf, t) < 0: - result = Int32Id - else: - case int(getSize(c.conf, t)) - of 1: result = UInt8Id - of 2: result = UInt16Id - of 4: result = Int32Id - of 8: result = Int64Id - else: result = Int32Id - of tyOrdinal, tyGenericBody, tyGenericParam, tyInferred, tyStatic: - if t.len > 0: - result = typeToIr(c, g, t.lastSon) - else: - result = TypeId(-1) - of tyFromExpr: - if t.n != nil and t.n.typ != nil: - result = typeToIr(c, g, t.n.typ) - else: - result = TypeId(-1) - of tyArray: - cached(c, t): - var n = toInt64(lengthOrd(c.conf, t)) - if n <= 0: n = 1 # make an array of at least one element - let elemType = typeToIr(c, g, t[1]) - let a = openType(g, ArrayTy) - g.addType(elemType) - g.addArrayLen n - g.addName mangle(c, t) - result = finishType(g, a) - of tyPtr, tyRef: - cached(c, t): - let e = t.lastSon - if e.kind == tyUncheckedArray: - let elemType = typeToIr(c, g, e.lastSon) - let a = openType(g, AArrayPtrTy) - g.addType(elemType) - result = finishType(g, a) - else: - let elemType = typeToIr(c, g, t.lastSon) - let a = openType(g, APtrTy) - g.addType(elemType) - result = finishType(g, a) - of tyVar, tyLent: - cached(c, t): - let e = t.lastSon - if e.skipTypes(abstractInst).kind in {tyOpenArray, tyVarargs}: - # skip the modifier, `var openArray` is a (ptr, len) pair too: - result = typeToIr(c, g, e) - else: - let elemType = typeToIr(c, g, e) - let a = openType(g, APtrTy) - g.addType(elemType) - result = finishType(g, a) - of tySet: - let s = int(getSize(c.conf, t)) - case s - of 1: result = UInt8Id - of 2: result = UInt16Id - of 4: result = UInt32Id - of 8: result = UInt64Id - else: - # array[U8, s] - cached(c, t): - let a = openType(g, ArrayTy) - g.addType(UInt8Id) - g.addArrayLen s - g.addName mangle(c, t) - result = finishType(g, a) - of tyPointer, tyNil: - # tyNil can happen for code like: `const CRAP = nil` which we have in posix.nim - let a = openType(g, APtrTy) - g.addBuiltinType(VoidId) - result = finishType(g, a) - of tyObject: - # Objects are special as they can be recursive in Nim. This is easily solvable. - # We check if we are already "processing" t. If so, we produce `ObjectTy` - # instead of `ObjectDecl`. - cached(c, t): - if not c.recursionCheck.containsOrIncl(t.itemId): - result = objectToIr(c, g, t) - else: - result = objectHeaderToIr(c, g, t) - of tyTuple: - cachedByName(c, t): - result = tupleToIr(c, g, t) - of tyProc: - cached(c, t): - if t.callConv == ccClosure: - result = closureToIr(c, g, t) - else: - result = procToIr(c, g, t) - of tyVarargs, tyOpenArray: - cached(c, t): - result = openArrayToIr(c, g, t) - of tyString: - if c.stringType.int < 0: - result = stringToIr(c, g) - c.stringType = result - else: - result = c.stringType - of tySequence: - cachedByName(c, t): - result = seqToIr(c, g, t) - of tyCstring: - cached(c, t): - let a = openType(g, AArrayPtrTy) - g.addBuiltinType Char8Id - result = finishType(g, a) - of tyUncheckedArray: - # We already handled the `ptr UncheckedArray` in a special way. - cached(c, t): - let elemType = typeToIr(c, g, t.lastSon) - let a = openType(g, LastArrayTy) - g.addType(elemType) - result = finishType(g, a) - of tyUntyped, tyTyped: - # this avoids a special case for system.echo which is not a generic but - # uses `varargs[typed]`: - result = VoidId - of tyNone, tyEmpty, tyTypeDesc, - tyGenericInvocation, tyProxy, tyBuiltInTypeClass, - tyUserTypeClass, tyUserTypeClassInst, tyCompositeTypeClass, - tyAnd, tyOr, tyNot, tyAnything, tyConcept, tyIterable, tyForward: - result = TypeId(-1) diff --git a/compiler/nodekinds.nim b/compiler/nodekinds.nim new file mode 100644 index 000000000..ccdbbd26d --- /dev/null +++ b/compiler/nodekinds.nim @@ -0,0 +1,211 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## NodeKind enum. + +type + TNodeKind* = enum # order is extremely important, because ranges are used + # to check whether a node belongs to a certain class + nkNone, # unknown node kind: indicates an error + # Expressions: + # Atoms: + nkEmpty, # the node is empty + nkIdent, # node is an identifier + nkSym, # node is a symbol + nkType, # node is used for its typ field + + nkCharLit, # a character literal '' + nkIntLit, # an integer literal + nkInt8Lit, + nkInt16Lit, + nkInt32Lit, + nkInt64Lit, + nkUIntLit, # an unsigned integer literal + nkUInt8Lit, + nkUInt16Lit, + nkUInt32Lit, + nkUInt64Lit, + nkFloatLit, # a floating point literal + nkFloat32Lit, + nkFloat64Lit, + nkFloat128Lit, + nkStrLit, # a string literal "" + nkRStrLit, # a raw string literal r"" + nkTripleStrLit, # a triple string literal """ + nkNilLit, # the nil literal + # end of atoms + nkComesFrom, # "comes from" template/macro information for + # better stack trace generation + nkDotCall, # used to temporarily flag a nkCall node; + # this is used + # for transforming ``s.len`` to ``len(s)`` + + nkCommand, # a call like ``p 2, 4`` without parenthesis + nkCall, # a call like p(x, y) or an operation like +(a, b) + nkCallStrLit, # a call with a string literal + # x"abc" has two sons: nkIdent, nkRStrLit + # x"""abc""" has two sons: nkIdent, nkTripleStrLit + nkInfix, # a call like (a + b) + nkPrefix, # a call like !a + nkPostfix, # something like a! (also used for visibility) + nkHiddenCallConv, # an implicit type conversion via a type converter + + nkExprEqExpr, # a named parameter with equals: ''expr = expr'' + nkExprColonExpr, # a named parameter with colon: ''expr: expr'' + nkIdentDefs, # a definition like `a, b: typeDesc = expr` + # either typeDesc or expr may be nil; used in + # formal parameters, var statements, etc. + nkVarTuple, # a ``var (a, b) = expr`` construct + nkPar, # syntactic (); may be a tuple constructor + nkObjConstr, # object constructor: T(a: 1, b: 2) + nkCurly, # syntactic {} + nkCurlyExpr, # an expression like a{i} + nkBracket, # syntactic [] + nkBracketExpr, # an expression like a[i..j, k] + nkPragmaExpr, # an expression like a{.pragmas.} + nkRange, # an expression like i..j + nkDotExpr, # a.b + nkCheckedFieldExpr, # a.b, but b is a field that needs to be checked + nkDerefExpr, # a^ + nkIfExpr, # if as an expression + nkElifExpr, + nkElseExpr, + nkLambda, # lambda expression + nkDo, # lambda block appering as trailing proc param + nkAccQuoted, # `a` as a node + + nkTableConstr, # a table constructor {expr: expr} + nkBind, # ``bind expr`` node + nkClosedSymChoice, # symbol choice node; a list of nkSyms (closed) + nkOpenSymChoice, # symbol choice node; a list of nkSyms (open) + nkHiddenStdConv, # an implicit standard type conversion + nkHiddenSubConv, # an implicit type conversion from a subtype + # to a supertype + nkConv, # a type conversion + nkCast, # a type cast + nkStaticExpr, # a static expr + nkAddr, # a addr expression + nkHiddenAddr, # implicit address operator + nkHiddenDeref, # implicit ^ operator + nkObjDownConv, # down conversion between object types + nkObjUpConv, # up conversion between object types + nkChckRangeF, # range check for floats + nkChckRange64, # range check for 64 bit ints + nkChckRange, # range check for ints + nkStringToCString, # string to cstring + nkCStringToString, # cstring to string + # end of expressions + + nkAsgn, # a = b + nkFastAsgn, # internal node for a fast ``a = b`` + # (no string copy) + nkGenericParams, # generic parameters + nkFormalParams, # formal parameters + nkOfInherit, # inherited from symbol + + nkImportAs, # a 'as' b in an import statement + nkProcDef, # a proc + nkMethodDef, # a method + nkConverterDef, # a converter + nkMacroDef, # a macro + nkTemplateDef, # a template + nkIteratorDef, # an iterator + + nkOfBranch, # used inside case statements + # for (cond, action)-pairs + nkElifBranch, # used in if statements + nkExceptBranch, # an except section + nkElse, # an else part + nkAsmStmt, # an assembler block + nkPragma, # a pragma statement + nkPragmaBlock, # a pragma with a block + nkIfStmt, # an if statement + nkWhenStmt, # a when expression or statement + nkForStmt, # a for statement + nkParForStmt, # a parallel for statement + nkWhileStmt, # a while statement + nkCaseStmt, # a case statement + nkTypeSection, # a type section (consists of type definitions) + nkVarSection, # a var section + nkLetSection, # a let section + nkConstSection, # a const section + nkConstDef, # a const definition + nkTypeDef, # a type definition + nkYieldStmt, # the yield statement as a tree + nkDefer, # the 'defer' statement + nkTryStmt, # a try statement + nkFinally, # a finally section + nkRaiseStmt, # a raise statement + nkReturnStmt, # a return statement + nkBreakStmt, # a break statement + nkContinueStmt, # a continue statement + nkBlockStmt, # a block statement + nkStaticStmt, # a static statement + nkDiscardStmt, # a discard statement + nkStmtList, # a list of statements + nkImportStmt, # an import statement + nkImportExceptStmt, # an import x except a statement + nkExportStmt, # an export statement + nkExportExceptStmt, # an 'export except' statement + nkFromStmt, # a from * import statement + nkIncludeStmt, # an include statement + nkBindStmt, # a bind statement + nkMixinStmt, # a mixin statement + nkUsingStmt, # an using statement + nkCommentStmt, # a comment statement + nkStmtListExpr, # a statement list followed by an expr; this is used + # to allow powerful multi-line templates + nkBlockExpr, # a statement block ending in an expr; this is used + # to allow powerful multi-line templates that open a + # temporary scope + nkStmtListType, # a statement list ending in a type; for macros + nkBlockType, # a statement block ending in a type; for macros + # types as syntactic trees: + + nkWith, # distinct with `foo` + nkWithout, # distinct without `foo` + + nkTypeOfExpr, # type(1+2) + nkObjectTy, # object body + nkTupleTy, # tuple body + nkTupleClassTy, # tuple type class + nkTypeClassTy, # user-defined type class + nkStaticTy, # ``static[T]`` + nkRecList, # list of object parts + nkRecCase, # case section of object + nkRecWhen, # when section of object + nkRefTy, # ``ref T`` + nkPtrTy, # ``ptr T`` + nkVarTy, # ``var T`` + nkConstTy, # ``const T`` + nkOutTy, # ``out T`` + nkDistinctTy, # distinct type + nkProcTy, # proc type + nkIteratorTy, # iterator type + nkSinkAsgn, # '=sink(x, y)' + nkEnumTy, # enum body + nkEnumFieldDef, # `ident = expr` in an enumeration + nkArgList, # argument list + nkPattern, # a special pattern; used for matching + nkHiddenTryStmt, # a hidden try statement + nkClosure, # (prc, env)-pair (internally used for code gen) + nkGotoState, # used for the state machine (for iterators) + nkState, # give a label to a code section (for iterators) + nkBreakState, # special break statement for easier code generation + nkFuncDef, # a func + nkTupleConstr # a tuple constructor + nkError # erroneous AST node + nkModuleRef # for .rod file support: A (moduleId, itemId) pair + nkReplayAction # for .rod file support: A replay action + nkNilRodNode # for .rod file support: a 'nil' PNode + nkOpenSym # container for captured sym that can be overriden by local symbols + +const + nkCallKinds* = {nkCall, nkInfix, nkPrefix, nkPostfix, + nkCommand, nkCallStrLit, nkHiddenCallConv} diff --git a/compiler/optimizer.nim b/compiler/optimizer.nim index d39d598ba..34e8ec80f 100644 --- a/compiler/optimizer.nim +++ b/compiler/optimizer.nim @@ -280,7 +280,7 @@ proc optimize*(n: PNode): PNode = Now assume 'use' raises, then we shouldn't do the 'wasMoved(s)' ]# var c: Con = Con() - var b: BasicBlock + var b: BasicBlock = default(BasicBlock) analyse(c, b, n) if c.somethingTodo: result = shallowCopy(n) diff --git a/compiler/options.nim b/compiler/options.nim index 45ed8c23e..b77bdd2a3 100644 --- a/compiler/options.nim +++ b/compiler/options.nim @@ -25,7 +25,7 @@ const useEffectSystem* = true useWriteTracking* = false hasFFI* = defined(nimHasLibFFI) - copyrightYear* = "2023" + copyrightYear* = "2024" nimEnableCovariance* = defined(nimEnableCovariance) @@ -86,6 +86,7 @@ type # please make sure we have under 32 options # also: generate header file optIdeDebug # idetools: debug mode optIdeTerse # idetools: use terse descriptions + optIdeExceptionInlayHints optExcessiveStackTrace # fully qualified module filenames optShowAllMismatches # show all overloading resolution candidates optWholeProject # for 'doc': output any dependency @@ -138,7 +139,6 @@ type backendCpp = "cpp" backendJs = "js" backendObjc = "objc" - backendNir = "nir" # backendNimscript = "nimscript" # this could actually work # backendLlvm = "llvm" # probably not well supported; was cmdCompileToLLVM @@ -146,7 +146,6 @@ type cmdNone # not yet processed command cmdUnknown # command unmapped cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, cmdCompileToJS, - cmdCompileToNir, cmdCrun # compile and run in nimache cmdTcc # run the project via TCC backend cmdCheck # semantic checking for whole project @@ -175,12 +174,11 @@ type const cmdBackends* = {cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, - cmdCompileToJS, cmdCrun, cmdCompileToNir} + cmdCompileToJS, cmdCrun} cmdDocLike* = {cmdDoc0, cmdDoc, cmdDoc2tex, cmdJsondoc0, cmdJsondoc, cmdCtags, cmdBuildindex} type - NimVer* = tuple[major: int, minor: int, patch: int] TStringSeq* = seq[string] TGCMode* = enum # the selected GC gcUnselected = "unselected" @@ -227,6 +225,9 @@ type strictDefs, strictCaseObjects, inferGenericTypes, + openSym, # remove nfDisabledOpenSym when this is default + # alternative to above: + genericsOpenSym vtables LegacyFeature* = enum @@ -244,13 +245,15 @@ type emitGenerics ## generics are emitted in the module that contains them. ## Useful for libraries that rely on local passC + jsNoLambdaLifting + ## Old transformation for closures in JS backend SymbolFilesOption* = enum disabledSf, writeOnlySf, readOnlySf, v2Sf, stressTest TSystemCC* = enum ccNone, ccGcc, ccNintendoSwitch, ccLLVM_Gcc, ccCLang, ccBcc, ccVcc, - ccTcc, ccEnv, ccIcl, ccIcc, ccClangCl + ccTcc, ccEnv, ccIcl, ccIcc, ccClangCl, ccHipcc, ccNvcc ExceptionSystem* = enum excNone, # no exception system selected yet @@ -297,6 +300,7 @@ type SuggestInlayHintKind* = enum sihkType = "Type", sihkParameter = "Parameter" + sihkException = "Exception" SuggestInlayHint* = ref object kind*: SuggestInlayHintKind @@ -365,7 +369,6 @@ type arguments*: string ## the arguments to be passed to the program that ## should be run ideCmd*: IdeCmd - oldNewlines*: bool cCompiler*: TSystemCC # the used compiler modifiedyNotes*: TNoteKinds # notes that have been set/unset from either cmdline/configs cmdlineNotes*: TNoteKinds # notes that have been set/unset from cmdline @@ -392,8 +395,7 @@ type outDir*: AbsoluteDir jsonBuildFile*: AbsoluteFile prefixDir*, libpath*, nimcacheDir*: AbsoluteDir - nimStdlibVersion*: NimVer - dllOverrides, moduleOverrides*, cfileSpecificOptions*: StringTableRef + dllOverrides*, moduleOverrides*, cfileSpecificOptions*: StringTableRef projectName*: string # holds a name like 'nim' projectPath*: AbsoluteDir # holds a path like /home/alice/projects/nim/compiler/ projectFull*: AbsoluteFile # projectPath/projectName @@ -405,7 +407,6 @@ type commandArgs*: seq[string] # any arguments after the main command commandLine*: string extraCmds*: seq[string] # for writeJsonBuildInstructions - keepComments*: bool # whether the parser needs to keep comments implicitImports*: seq[string] # modules that are to be implicitly imported implicitIncludes*: seq[string] # modules that are to be implicitly included docSeeSrcUrl*: string # if empty, no seeSrc will be generated. \ @@ -446,16 +447,6 @@ type clientProcessId*: int -proc parseNimVersion*(a: string): NimVer = - # could be moved somewhere reusable - result = default(NimVer) - if a.len > 0: - let b = a.split(".") - assert b.len == 3, a - template fn(i) = result[i] = b[i].parseInt # could be optimized if needed - fn(0) - fn(1) - fn(2) proc assignIfDefault*[T](result: var T, val: T, def = default(T)) = ## if `result` was already assigned to a value (that wasn't `def`), this is a noop. @@ -589,7 +580,6 @@ proc newConfigRef*(): ConfigRef = command: "", # the main command (e.g. cc, check, scan, etc) commandArgs: @[], # any arguments after the main command commandLine: "", - keepComments: true, # whether the parser needs to keep comments implicitImports: @[], # modules that are to be implicitly imported implicitIncludes: @[], # modules that are to be implicitly included docSeeSrcUrl: "", @@ -630,12 +620,6 @@ proc newPartialConfigRef*(): ConfigRef = proc cppDefine*(c: ConfigRef; define: string) = c.cppDefines.incl define -proc getStdlibVersion*(conf: ConfigRef): NimVer = - if conf.nimStdlibVersion == (0,0,0): - let s = conf.symbols.getOrDefault("nimVersion", "") - conf.nimStdlibVersion = s.parseNimVersion - result = conf.nimStdlibVersion - proc isDefined*(conf: ConfigRef; symbol: string): bool = if conf.symbols.hasKey(symbol): result = true diff --git a/compiler/parampatterns.nim b/compiler/parampatterns.nim index 84c2980c4..e8ec22fe1 100644 --- a/compiler/parampatterns.nim +++ b/compiler/parampatterns.nim @@ -266,7 +266,7 @@ proc isAssignable*(owner: PSym, n: PNode): TAssignableResult = if skipTypes(n.typ, abstractPtrs-{tyTypeDesc}).kind in {tyOpenArray, tyTuple, tyObject}: result = isAssignable(owner, n[1]) - elif compareTypes(n.typ, n[1].typ, dcEqIgnoreDistinct): + elif compareTypes(n.typ, n[1].typ, dcEqIgnoreDistinct, {IgnoreRangeShallow}): # types that are equal modulo distinction preserve l-value: result = isAssignable(owner, n[1]) of nkHiddenDeref: @@ -283,8 +283,15 @@ proc isAssignable*(owner: PSym, n: PNode): TAssignableResult = of nkObjUpConv, nkObjDownConv, nkCheckedFieldExpr: result = isAssignable(owner, n[0]) of nkCallKinds: - # builtin slice keeps lvalue-ness: - if getMagic(n) in {mArrGet, mSlice}: + let m = getMagic(n) + if m == mSlice: + # builtin slice keeps l-value-ness + # except for pointers because slice dereferences + if n[1].typ.kind == tyPtr: + result = arLValue + else: + result = isAssignable(owner, n[1]) + elif m == mArrGet: result = isAssignable(owner, n[1]) elif n.typ != nil: case n.typ.kind diff --git a/compiler/parser.nim b/compiler/parser.nim index 072540dba..747505097 100644 --- a/compiler/parser.nim +++ b/compiler/parser.nim @@ -49,9 +49,14 @@ when isMainModule or defined(nimTestGrammar): checkGrammarFile() import - llstream, lexer, idents, ast, msgs, options, lineinfos, + llstream, lexer, idents, msgs, options, lineinfos, pathutils +when not defined(nimCustomAst): + import ast +else: + import plugins / customast + import std/strutils when defined(nimpretty): @@ -73,7 +78,8 @@ type bufposPrevious*: int inPragma*: int # Pragma level inSemiStmtList*: int - emptyNode: PNode + when not defined(nimCustomAst): + emptyNode: PNode when defined(nimpretty): em*: Emitter @@ -83,6 +89,10 @@ type PrimaryMode = enum pmNormal, pmTypeDesc, pmTypeDef, pmTrySimple +when defined(nimCustomAst): + # For the `customast` version we cannot share nodes, not even empty nodes: + template emptyNode(p: Parser): PNode = newNode(nkEmpty) + # helpers for the other parsers proc isOperator*(tok: Token): bool proc getTok*(p: var Parser) @@ -91,7 +101,7 @@ proc skipComment*(p: var Parser, node: PNode) proc newNodeP*(kind: TNodeKind, p: Parser): PNode proc newIntNodeP*(kind: TNodeKind, intVal: BiggestInt, p: Parser): PNode proc newFloatNodeP*(kind: TNodeKind, floatVal: BiggestFloat, p: Parser): PNode -proc newStrNodeP*(kind: TNodeKind, strVal: string, p: Parser): PNode +proc newStrNodeP*(kind: TNodeKind, strVal: sink string, p: Parser): PNode proc newIdentNodeP*(ident: PIdent, p: Parser): PNode proc expectIdentOrKeyw*(p: Parser) proc expectIdent*(p: Parser) @@ -146,7 +156,8 @@ proc openParser*(p: var Parser, fileIdx: FileIndex, inputStream: PLLStream, openEmitter(p.em, cache, config, fileIdx) getTok(p) # read the first token p.firstTok = true - p.emptyNode = newNode(nkEmpty) + when not defined(nimCustomAst): + p.emptyNode = newNode(nkEmpty) proc openParser*(p: var Parser, filename: AbsoluteFile, inputStream: PLLStream, cache: IdentCache; config: ConfigRef) = @@ -155,8 +166,6 @@ proc openParser*(p: var Parser, filename: AbsoluteFile, inputStream: PLLStream, proc closeParser*(p: var Parser) = ## Close a parser, freeing up its resources. closeLexer(p.lex) - when defined(nimpretty): - closeEmitter(p.em) proc parMessage(p: Parser, msg: TMsgKind, arg = "") = ## Produce and emit the parser message `arg` to output. @@ -263,24 +272,20 @@ proc indAndComment(p: var Parser, n: PNode, maybeMissEquals = false) = skipComment(p, n) proc newNodeP(kind: TNodeKind, p: Parser): PNode = - result = newNodeI(kind, parLineInfo(p)) + result = newNode(kind, parLineInfo(p)) proc newIntNodeP(kind: TNodeKind, intVal: BiggestInt, p: Parser): PNode = - result = newNodeP(kind, p) - result.intVal = intVal + result = newAtom(kind, intVal, parLineInfo(p)) proc newFloatNodeP(kind: TNodeKind, floatVal: BiggestFloat, p: Parser): PNode = - result = newNodeP(kind, p) - result.floatVal = floatVal + result = newAtom(kind, floatVal, parLineInfo(p)) -proc newStrNodeP(kind: TNodeKind, strVal: string, p: Parser): PNode = - result = newNodeP(kind, p) - result.strVal = strVal +proc newStrNodeP(kind: TNodeKind, strVal: sink string, p: Parser): PNode = + result = newAtom(kind, strVal, parLineInfo(p)) proc newIdentNodeP(ident: PIdent, p: Parser): PNode = - result = newNodeP(nkIdent, p) - result.ident = ident + result = newAtom(ident, parLineInfo(p)) proc parseExpr(p: var Parser): PNode proc parseStmt(p: var Parser): PNode @@ -383,7 +388,7 @@ proc parseSymbol(p: var Parser, mode = smNormal): PNode = while true: case p.tok.tokType of tkAccent: - if result.len == 0: + if not result.hasSon: parMessage(p, errIdentifierExpected, p.tok) break of tkOpr, tkDot, tkDotDot, tkEquals, tkParLe..tkParDotRi: @@ -393,8 +398,7 @@ proc parseSymbol(p: var Parser, mode = smNormal): PNode = tkParLe..tkParDotRi}: accm.add($p.tok) getTok(p) - let node = newNodeI(nkIdent, lineinfo) - node.ident = p.lex.cache.getIdent(accm) + let node = newAtom(p.lex.cache.getIdent(accm), lineinfo) result.add(node) of tokKeywordLow..tokKeywordHigh, tkSymbol, tkIntLit..tkCustomLit: result.add(newIdentNodeP(p.lex.cache.getIdent($p.tok), p)) @@ -511,26 +515,26 @@ proc exprColonEqExprList(p: var Parser, kind: TNodeKind, proc dotExpr(p: var Parser, a: PNode): PNode = var info = p.parLineInfo getTok(p) - result = newNodeI(nkDotExpr, info) + result = newNode(nkDotExpr, info) optInd(p, result) result.add(a) result.add(parseSymbol(p, smAfterDot)) if p.tok.tokType == tkBracketLeColon and tsLeading notin p.tok.spacing: - var x = newNodeI(nkBracketExpr, p.parLineInfo) + var x = newNode(nkBracketExpr, p.parLineInfo) # rewrite 'x.y[:z]()' to 'y[z](x)' - x.add result[1] + x.add result.secondSon exprList(p, tkBracketRi, x) eat(p, tkBracketRi) - var y = newNodeI(nkCall, p.parLineInfo) + var y = newNode(nkCall, p.parLineInfo) y.add x - y.add result[0] + y.add result.firstSon if p.tok.tokType == tkParLe and tsLeading notin p.tok.spacing: exprColonEqExprListAux(p, tkParRi, y) result = y proc dotLikeExpr(p: var Parser, a: PNode): PNode = var info = p.parLineInfo - result = newNodeI(nkInfix, info) + result = newNode(nkInfix, info) optInd(p, result) var opNode = newIdentNodeP(p.tok.ident, p) getTok(p) @@ -586,12 +590,18 @@ proc parseCast(p: var Parser): PNode = eat(p, tkParRi) setEndInfo() +template setNodeFlag(n: PNode; f: untyped) = + when defined(nimCustomAst): + discard + else: + incl n.flags, f + proc setBaseFlags(n: PNode, base: NumericalBase) = case base of base10: discard - of base2: incl(n.flags, nfBase2) - of base8: incl(n.flags, nfBase8) - of base16: incl(n.flags, nfBase16) + of base2: setNodeFlag(n, nfBase2) + of base8: setNodeFlag(n, nfBase8) + of base16: setNodeFlag(n, nfBase16) proc parseGStrLit(p: var Parser, a: PNode): PNode = case p.tok.tokType @@ -887,7 +897,7 @@ proc primarySuffix(p: var Parser, r: PNode, result = commandExpr(p, result, mode) break result = namedParams(p, result, nkCall, tkParRi) - if result.len > 1 and result[1].kind == nkExprColonExpr: + if result.has2Sons and result.secondSon.kind == nkExprColonExpr: result.transitionSonsKind(nkObjConstr) of tkDot: # progress guaranteed @@ -1158,7 +1168,7 @@ proc parseParamList(p: var Parser, retColon = true): PNode = if hasRet and p.tok.indent < 0: getTok(p) optInd(p, result) - result[0] = parseTypeDesc(p) + result.replaceFirstSon parseTypeDesc(p) elif not retColon and not hasParLe: # Mark as "not there" in order to mark for deprecation in the semantic pass: result = p.emptyNode @@ -1203,9 +1213,9 @@ proc parseProcExpr(p: var Parser; isExpr: bool; kind: TNodeKind): PNode = params = params, name = p.emptyNode, pattern = p.emptyNode, genericParams = p.emptyNode, pragmas = pragmas, exceptions = p.emptyNode) skipComment(p, result) - result[bodyPos] = parseStmt(p) + result.replaceSon bodyPos, parseStmt(p) else: - result = newNodeI(if kind == nkIteratorDef: nkIteratorTy else: nkProcTy, info) + result = newNode(if kind == nkIteratorDef: nkIteratorTy else: nkProcTy, info) if hasSignature or pragmas.kind != nkEmpty: if hasSignature: result.add(params) @@ -1318,7 +1328,7 @@ proc parseExpr(p: var Parser): PNode = result = parseFor(p) of tkWhen: nimprettyDontTouch: - result = parseIfOrWhenExpr(p, nkWhenExpr) + result = parseIfOrWhenExpr(p, nkWhenStmt) of tkCase: # Currently we think nimpretty is good enough with case expressions, # so it is allowed to touch them: @@ -1391,7 +1401,7 @@ proc primary(p: var Parser, mode: PrimaryMode): PNode = result = primarySuffix(p, result, baseInd, mode) proc binaryNot(p: var Parser; a: PNode): PNode = - if p.tok.tokType == tkNot: + if p.tok.tokType == tkNot and p.tok.indent < 0: let notOpr = newIdentNodeP(p.tok.ident, p) getTok(p) optInd(p, notOpr) @@ -1429,7 +1439,7 @@ proc parseTypeDesc(p: var Parser, fullExpr = false): PNode = result = newNodeP(nkObjectTy, p) getTok(p) of tkConcept: - result = nil + result = p.emptyNode parMessage(p, "the 'concept' keyword is only valid in 'type' sections") of tkVar: result = parseTypeDescKAux(p, nkVarTy, pmTypeDesc) of tkOut: result = parseTypeDescKAux(p, nkOutTy, pmTypeDesc) @@ -1477,7 +1487,7 @@ proc makeCall(n: PNode): PNode = if n.kind in nkCallKinds: result = n else: - result = newNodeI(nkCall, n.info) + result = newNode(nkCall, n.info) result.add n proc postExprBlocks(p: var Parser, x: PNode): PNode = @@ -1508,9 +1518,9 @@ proc postExprBlocks(p: var Parser, x: PNode): PNode = var stmtList = newNodeP(nkStmtList, p) stmtList.add parseStmt(p) # to keep backwards compatibility (see tests/vm/tstringnil) - if stmtList[0].kind == nkStmtList: stmtList = stmtList[0] + if stmtList.firstSon.kind == nkStmtList: stmtList = stmtList.firstSon - stmtList.flags.incl nfBlockArg + setNodeFlag stmtList, nfBlockArg if openingParams.kind != nkEmpty or openingPragmas.kind != nkEmpty: if openingParams.kind == nkEmpty: openingParams = newNodeP(nkFormalParams, p) @@ -1554,7 +1564,7 @@ proc postExprBlocks(p: var Parser, x: PNode): PNode = eat(p, tkColon) nextBlock.add parseStmt(p) - nextBlock.flags.incl nfBlockArg + setNodeFlag nextBlock, nfBlockArg result.add nextBlock if nextBlock.kind in {nkElse, nkFinally}: break @@ -1580,7 +1590,7 @@ proc parseExprStmt(p: var Parser): PNode = # if an expression is starting here, a simplePrimary was parsed and # this is the start of a command if p.tok.indent < 0 and isExprStart(p): - result = newTreeI(nkCommand, a.info, a) + result = newTree(nkCommand, a.info, a) let baseIndent = p.currInd while true: result.add(commandParam(p, isFirstParam, pmNormal)) @@ -1971,13 +1981,13 @@ proc parseRoutine(p: var Parser, kind: TNodeKind): PNode = else: result.add(p.emptyNode) indAndComment(p, result, maybeMissEquals) - let body = result[^1] - if body.kind == nkStmtList and body.len > 0 and body[0].comment.len > 0 and body[0].kind != nkCommentStmt: + let body = result.lastSon + if body.kind == nkStmtList and body.hasSon and body.firstSon.comment.len > 0 and body.firstSon.kind != nkCommentStmt: if result.comment.len == 0: # proc fn*(a: int): int = a ## foo # => moves comment `foo` to `fn` - result.comment = body[0].comment - body[0].comment = "" + result.comment = body.firstSon.comment + body.firstSon.comment = "" #else: # assert false, p.lex.config$body.info # avoids hard to track bugs, fail early. # Yeah, that worked so well. There IS a bug in this logic, now what? @@ -2011,7 +2021,7 @@ proc parseSection(p: var Parser, kind: TNodeKind, else: parMessage(p, errIdentifierExpected, p.tok) break - if result.len == 0: parMessage(p, errIdentifierExpected, p.tok) + if not result.hasSon: 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 result.add(defparser(p)) @@ -2062,7 +2072,7 @@ proc parseEnum(p: var Parser): PNode = if p.tok.indent >= 0 and p.tok.indent <= p.currInd or p.tok.tokType == tkEof: break - if result.len <= 1: + if not result.has2Sons: parMessage(p, errIdentifierExpected, p.tok) setEndInfo() @@ -2191,7 +2201,8 @@ proc parseObject(p: var Parser): PNode = proc parseTypeClassParam(p: var Parser): PNode = let modifier = case p.tok.tokType - of tkOut, tkVar: nkVarTy + of tkVar: nkVarTy + of tkOut: nkOutTy of tkPtr: nkPtrTy of tkRef: nkRefTy of tkStatic: nkStaticTy @@ -2207,7 +2218,7 @@ proc parseTypeClassParam(p: var Parser): PNode = setEndInfo() proc parseTypeClass(p: var Parser): PNode = - #| conceptParam = ('var' | 'out')? symbol + #| conceptParam = ('var' | 'out' | 'ptr' | 'ref' | 'static' | 'type')? symbol #| conceptDecl = 'concept' conceptParam ^* ',' (pragma)? ('of' typeDesc ^* ',')? #| &IND{>} stmt result = newNodeP(nkTypeClassTy, p) @@ -2321,7 +2332,7 @@ proc parseVariable(p: var Parser): PNode = optInd(p, result) result.add(parseExpr(p)) else: result = parseIdentColonEquals(p, {withPragma, withDot}) - result[^1] = postExprBlocks(p, result[^1]) + result.setLastSon postExprBlocks(p, result.lastSon) indAndComment(p, result) setEndInfo() @@ -2340,8 +2351,8 @@ proc parseConstant(p: var Parser): PNode = eat(p, tkEquals) optInd(p, result) #add(result, parseStmtListExpr(p)) - result.add(parseExpr(p)) - result[^1] = postExprBlocks(p, result[^1]) + let a = parseExpr(p) + result.add postExprBlocks(p, a) indAndComment(p, result) setEndInfo() @@ -2366,7 +2377,7 @@ proc parseStmtPragma(p: var Parser): PNode = result = parsePragma(p) if p.tok.tokType == tkColon and p.tok.indent < 0: let a = result - result = newNodeI(nkPragmaBlock, a.info) + result = newNode(nkPragmaBlock, a.info) getTok(p) skipComment(p, result) result.add a @@ -2516,22 +2527,6 @@ proc parseStmt(p: var Parser): PNode = if err and p.tok.tokType == tkEof: break setEndInfo() -proc parseAll*(p: var Parser): PNode = - ## Parses the rest of the input stream held by the parser into a PNode. - result = newNodeP(nkStmtList, p) - while p.tok.tokType != tkEof: - p.hasProgress = false - var a = complexOrSimpleStmt(p) - if a.kind != nkEmpty and p.hasProgress: - result.add(a) - else: - parMessage(p, errExprExpected, p.tok) - # bugfix: consume a token here to prevent an endless loop: - getTok(p) - if p.tok.indent != 0: - parMessage(p, errInvalidIndentation) - setEndInfo() - proc checkFirstLineIndentation*(p: var Parser) = if p.tok.indent != 0 and tsLeading in p.tok.spacing: parMessage(p, errInvalidIndentation) @@ -2566,6 +2561,16 @@ proc parseTopLevelStmt*(p: var Parser): PNode = break setEndInfo() +proc parseAll*(p: var Parser): PNode = + ## Parses the rest of the input stream held by the parser into a PNode. + result = newNodeP(nkStmtList, p) + while true: + let nextStmt = p.parseTopLevelStmt() + if nextStmt.kind == nkEmpty: + break + result &= nextStmt + setEndInfo() + proc parseString*(s: string; cache: IdentCache; config: ConfigRef; filename: string = ""; line: int = 0; errorHandler: ErrorHandler = nil): PNode = @@ -2576,7 +2581,7 @@ proc parseString*(s: string; cache: IdentCache; config: ConfigRef; var stream = llStreamOpen(s) stream.lineOffset = line - var p: Parser + var p = Parser() p.lex.errorHandler = errorHandler openParser(p, AbsoluteFile filename, stream, cache, config) diff --git a/compiler/patterns.nim b/compiler/patterns.nim index 7b0d7e4fb..32ec7fb53 100644 --- a/compiler/patterns.nim +++ b/compiler/patterns.nim @@ -276,10 +276,7 @@ proc addToArgList(result, n: PNode) = proc applyRule*(c: PContext, s: PSym, n: PNode): PNode = ## returns a tree to semcheck if the rule triggered; nil otherwise - var ctx: TPatternContext - ctx.owner = s - ctx.c = c - ctx.formals = s.typ.len-1 + var ctx = TPatternContext(owner: s, c: c, formals: s.typ.paramsLen) var m = matchStmtList(ctx, s.ast[patternPos], n) if isNil(m): return nil # each parameter should have been bound; we simply setup a call and diff --git a/compiler/pipelines.nim b/compiler/pipelines.nim index 91f3428be..55e7fe892 100644 --- a/compiler/pipelines.nim +++ b/compiler/pipelines.nim @@ -5,13 +5,14 @@ import sem, cgen, modulegraphs, ast, llstream, parser, msgs, import pipelineutils +import ../dist/checksums/src/checksums/sha1 + when not defined(leanCompiler): import jsgen, docgen2 -import std/[syncio, objectdollar, assertions, tables, strutils] +import std/[syncio, objectdollar, assertions, tables, strutils, strtabs] import renderer import ic/replayer -import nir/nir proc setPipeLinePass*(graph: ModuleGraph; pass: PipelinePass) = graph.pipelinePass = pass @@ -43,10 +44,6 @@ proc processPipeline(graph: ModuleGraph; semNode: PNode; bModule: PPassContext): result = nil of EvalPass, InterpreterPass: result = interpreterCode(bModule, semNode) - of NirReplPass: - result = runCode(bModule, semNode) - of NirPass: - result = nirBackend(bModule, semNode) of NonePass: raiseAssert "use setPipeLinePass to set a proper PipelinePass" @@ -99,7 +96,7 @@ proc processPipelineModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator stream: PLLStream): bool = if graph.stopCompile(): return true var - p: Parser + p: Parser = default(Parser) s: PLLStream fileIdx = module.fileIdx @@ -109,8 +106,6 @@ proc processPipelineModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator case graph.pipelinePass of CgenPass: setupCgen(graph, module, idgen) - of NirPass: - openNirBackend(graph, module, idgen) of JSgenPass: when not defined(leanCompiler): setupJSgen(graph, module, idgen) @@ -118,8 +113,6 @@ proc processPipelineModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator nil of EvalPass, InterpreterPass: setupEvalGen(graph, module, idgen) - of NirReplPass: - setupNirReplGen(graph, module, idgen) of GenDependPass: setupDependPass(graph, module, idgen) of Docgen2Pass: @@ -196,7 +189,7 @@ proc processPipelineModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator if graph.dispatchers.len > 0: let ctx = preparePContext(graph, module, idgen) for disp in getDispatchers(graph): - let retTyp = disp.typ[0] + let retTyp = disp.typ.returnType if retTyp != nil: # TODO: properly semcheck the code of dispatcher? createTypeBoundOps(graph, ctx, retTyp, disp.ast.info, idgen) @@ -207,10 +200,6 @@ proc processPipelineModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator discard finalJSCodeGen(graph, bModule, finalNode) of EvalPass, InterpreterPass: discard interpreterCode(bModule, finalNode) - of NirReplPass: - discard runCode(bModule, finalNode) - of NirPass: - closeNirBackend(bModule, finalNode) of SemPass, GenDependPass: discard of Docgen2Pass, Docgen2TexPass: @@ -244,7 +233,10 @@ proc compilePipelineModule*(graph: ModuleGraph; fileIdx: FileIndex; flags: TSymF if result == nil: var cachedModules: seq[FileIndex] = @[] result = moduleFromRodFile(graph, fileIdx, cachedModules) - let filename = AbsoluteFile toFullPath(graph.config, fileIdx) + let path = toFullPath(graph.config, fileIdx) + let filename = AbsoluteFile path + if fileExists(filename): # it could be a stdinfile + graph.cachedFiles[path] = $secureHashFile(path) if result == nil: result = newModule(graph, fileIdx) result.flags.incl flags diff --git a/compiler/plugins/customast.nim b/compiler/plugins/customast.nim new file mode 100644 index 000000000..87461ae39 --- /dev/null +++ b/compiler/plugins/customast.nim @@ -0,0 +1,136 @@ +# This file exists to make it overridable via +# patchFile("plugins", "customast.nim", "customast.nim") + +## This also serves as a blueprint for a possible implementation. + +import "$nim" / compiler / [lineinfos, idents] + +when defined(nimPreviewSlimSystem): + import std/assertions + +import "$nim" / compiler / nodekinds +export nodekinds + +type + PNode* = ref TNode + TNode*{.final, acyclic.} = object + case kind*: TNodeKind + of nkCharLit..nkUInt64Lit: + intVal: BiggestInt + of nkFloatLit..nkFloat128Lit: + floatVal: BiggestFloat + of nkStrLit..nkTripleStrLit: + strVal: string + of nkSym: + discard + of nkIdent: + ident: PIdent + else: + son, next, last: PNode # linked structure instead of a `seq` + info*: TLineInfo + +const + bodyPos* = 6 + paramsPos* = 3 + +proc comment*(n: PNode): string = + result = "" + +proc `comment=`*(n: PNode, a: string) = + discard "XXX implement me" + +proc add*(father, son: PNode) = + assert son != nil + if father.son == nil: + father.son = son + father.last = son + else: + father.last.next = son + father.last = son + +template firstSon*(n: PNode): PNode = n.son +template secondSon*(n: PNode): PNode = n.son.next + +proc replaceFirstSon*(n, newson: PNode) {.inline.} = + let old = n.son + n.son = newson + newson.next = old + +proc replaceSon*(n: PNode; i: int; newson: PNode) = + assert i > 0 + assert newson.next == nil + var i = i + var it = n.son + while i > 0: + it = it.next + dec i + let old = it.next + it.next = newson + newson.next = old + +template newNodeImpl(info2) = + result = PNode(kind: kind, info: info2) + +proc newNode*(kind: TNodeKind): PNode = + ## new node with unknown line info, no type, and no children + newNodeImpl(unknownLineInfo) + +proc newNode*(kind: TNodeKind, info: TLineInfo): PNode = + ## new node with line info, no type, and no children + newNodeImpl(info) + +proc newTree*(kind: TNodeKind; info: TLineInfo; child: PNode): PNode = + result = newNode(kind, info) + result.son = child + +proc newAtom*(ident: PIdent, info: TLineInfo): PNode = + result = newNode(nkIdent) + result.ident = ident + result.info = info + +proc newAtom*(kind: TNodeKind, intVal: BiggestInt, info: TLineInfo): PNode = + result = newNode(kind, info) + result.intVal = intVal + +proc newAtom*(kind: TNodeKind, floatVal: BiggestFloat, info: TLineInfo): PNode = + result = newNode(kind, info) + result.floatVal = floatVal + +proc newAtom*(kind: TNodeKind; strVal: sink string; info: TLineInfo): PNode = + result = newNode(kind, info) + result.strVal = strVal + +proc lastSon*(n: PNode): PNode {.inline.} = n.last +proc setLastSon*(n: PNode, s: PNode) = + assert s.next == nil + n.last = s + if n.son == nil: n.son = s + +proc newProcNode*(kind: TNodeKind, info: TLineInfo, body: PNode, + params, + name, pattern, genericParams, + pragmas, exceptions: PNode): PNode = + result = newNode(kind, info) + result.add name + result.add pattern + result.add genericParams + result.add params + result.add pragmas + result.add exceptions + result.add body + +template transitionNodeKindCommon(k: TNodeKind) = + let obj {.inject.} = n[] + n[] = TNode(kind: k, info: obj.info) + # n.comment = obj.comment # shouldn't be needed, the address doesnt' change + +proc transitionSonsKind*(n: PNode, kind: range[nkComesFrom..nkTupleConstr]) = + transitionNodeKindCommon(kind) + n.son = obj.son + +template hasSon*(n: PNode): bool = n.son != nil +template has2Sons*(n: PNode): bool = n.son != nil and n.son.next != nil + +proc isNewStyleConcept*(n: PNode): bool {.inline.} = + assert n.kind == nkTypeClassTy + result = n.firstSon.kind == nkEmpty diff --git a/compiler/plugins/itersgen.nim b/compiler/plugins/itersgen.nim index c5e9dc853..e2c97bdc5 100644 --- a/compiler/plugins/itersgen.nim +++ b/compiler/plugins/itersgen.nim @@ -25,7 +25,7 @@ proc iterToProcImpl*(c: PContext, n: PNode): PNode = return let t = n[2].typ.skipTypes({tyTypeDesc, tyGenericInst}) - if t.kind notin {tyRef, tyPtr} or t.lastSon.kind != tyObject: + if t.kind notin {tyRef, tyPtr} or t.elementType.kind != tyObject: localError(c.config, n[2].info, "type must be a non-generic ref|ptr to object with state field") return diff --git a/compiler/plugins/plugins.nimble b/compiler/plugins/plugins.nimble new file mode 100644 index 000000000..e69de29bb --- /dev/null +++ b/compiler/plugins/plugins.nimble diff --git a/compiler/pragmas.nim b/compiler/pragmas.nim index 35b4d63c2..9a298cd90 100644 --- a/compiler/pragmas.nim +++ b/compiler/pragmas.nim @@ -81,14 +81,14 @@ const wRequiresInit, wNoalias, wAlign, wNoInit} - {wExportNims, wNodecl} # why exclude these? varPragmas* = declPragmas + {wVolatile, wRegister, wThreadVar, wMagic, wHeader, wCompilerProc, wCore, wDynlib, - wNoInit, wCompileTime, wGlobal, + wNoInit, wCompileTime, wGlobal, wLiftLocals, wGensym, wInject, wCodegenDecl, wGuard, wGoto, wCursor, wNoalias, wAlign} constPragmas* = declPragmas + {wHeader, wMagic, wGensym, wInject, wIntDefine, wStrDefine, wBoolDefine, wDefine, wCompilerProc, wCore} - paramPragmas* = {wNoalias, wInject, wGensym, wByRef, wByCopy, wCodegenDecl} + paramPragmas* = {wNoalias, wInject, wGensym, wByRef, wByCopy, wCodegenDecl, wExportc, wExportCpp} letPragmas* = varPragmas procTypePragmas* = {FirstCallConv..LastCallConv, wVarargs, wNoSideEffect, wThread, wRaises, wEffectsOf, wLocks, wTags, wForbids, wGcSafe, @@ -145,41 +145,27 @@ proc pragmaEnsures(c: PContext, n: PNode) = else: openScope(c) let o = getCurrOwner(c) - if o.kind in routineKinds and o.typ != nil and o.typ[0] != nil: + if o.kind in routineKinds and o.typ != nil and o.typ.returnType != nil: var s = newSym(skResult, getIdent(c.cache, "result"), c.idgen, o, n.info) - s.typ = o.typ[0] + s.typ = o.typ.returnType incl(s.flags, sfUsed) addDecl(c, s) n[1] = c.semExpr(c, n[1]) closeScope(c) -proc pragmaAsm*(c: PContext, n: PNode): char = - result = '\0' - if n != nil: - for i in 0..<n.len: - let it = n[i] - if it.kind in nkPragmaCallKinds and it.len == 2 and it[0].kind == nkIdent: - case whichKeyword(it[0].ident) - of wSubsChar: - if it[1].kind == nkCharLit: result = chr(int(it[1].intVal)) - else: invalidPragma(c, it) - else: invalidPragma(c, it) - else: - invalidPragma(c, it) - proc setExternName(c: PContext; s: PSym, extname: string, info: TLineInfo) = # special cases to improve performance: if extname == "$1": - s.loc.r = rope(s.name.s) + s.loc.snippet = rope(s.name.s) elif '$' notin extname: - s.loc.r = rope(extname) + s.loc.snippet = rope(extname) else: try: - s.loc.r = rope(extname % s.name.s) + s.loc.snippet = rope(extname % s.name.s) except ValueError: localError(c.config, info, "invalid extern name: '" & extname & "'. (Forgot to escape '$'?)") when hasFFI: - s.cname = $s.loc.r + s.cname = $s.loc.snippet proc makeExternImport(c: PContext; s: PSym, extname: string, info: TLineInfo) = @@ -255,7 +241,7 @@ proc processVirtual(c: PContext, n: PNode, s: PSym, flag: TSymFlag) = s.constraint.strVal = s.constraint.strVal % s.name.s s.flags.incl {flag, sfInfixCall, sfExportc, sfMangleCpp} - s.typ.callConv = ccNoConvention + s.typ.callConv = ccMember incl c.config.globalOptions, optMixedMode proc processCodegenDecl(c: PContext, n: PNode, sym: PSym) = @@ -307,6 +293,24 @@ proc pragmaNoForward*(c: PContext, n: PNode; flag=sfNoForward) = "use {.experimental: \"codeReordering\".} instead; " & (if flag == sfNoForward: "{.noForward.}" else: "{.reorder.}") & " is deprecated") +proc pragmaAsm*(c: PContext, n: PNode): char = + ## Checks asm pragmas and get's the asm subschar (default: '`'). + result = '\0' + if n != nil: + for i in 0..<n.len: + let it = n[i] + if it.kind in nkPragmaCallKinds and it.len == 2 and it[0].kind == nkIdent: + case whichKeyword(it[0].ident) + of wSubsChar: + if it[1].kind == nkCharLit: result = chr(int(it[1].intVal)) + else: invalidPragma(c, it) + of wAsmSyntax: + let s = expectStrLit(c, it) + if s notin ["gcc", "vcc"]: invalidPragma(c, it) + else: invalidPragma(c, it) + else: + invalidPragma(c, it) + proc processCallConv(c: PContext, n: PNode) = if n.kind in nkPragmaCallKinds and n.len == 2 and n[1].kind == nkIdent: let sw = whichKeyword(n[1].ident) @@ -366,7 +370,7 @@ proc processDynLib(c: PContext, n: PNode, sym: PSym) = proc processNote(c: PContext, n: PNode) = template handleNote(enumVals, notes) = let x = findStr(enumVals.a, enumVals.b, n[0][1].ident.s, errUnknown) - if x != errUnknown: + if x != errUnknown: nk = TNoteKind(x) let x = c.semConstBoolExpr(c, n[1]) n[1] = x @@ -476,6 +480,18 @@ proc processOption(c: PContext, n: PNode, resOptions: var TOptions) = # calling conventions (boring...): localError(c.config, n.info, "option expected") +proc checkPushedPragma(c: PContext, n: PNode) = + let keyDeep = n.kind in nkPragmaCallKinds and n.len > 1 + var key = if keyDeep: n[0] else: n + if key.kind in nkIdentKinds: + let ident = considerQuotedIdent(c, key) + var userPragma = strTableGet(c.userPragmas, ident) + if userPragma == nil: + let k = whichKeyword(ident) + # TODO: might as well make a list which is not accepted by `push`: emit, cast etc. + if k == wEmit: + localError(c.config, n.info, "an 'emit' pragma cannot be pushed") + proc processPush(c: PContext, n: PNode, start: int) = if n[start-1].kind in nkPragmaCallKinds: localError(c.config, n.info, "'push' cannot have arguments") @@ -483,6 +499,7 @@ proc processPush(c: PContext, n: PNode, start: int) = for i in start..<n.len: if not tryProcessOption(c, n[i], c.config.options): # simply store it somewhere: + checkPushedPragma(c, n[i]) if x.otherPragmas.isNil: x.otherPragmas = newNodeI(nkPragma, n.info) x.otherPragmas.add n[i] @@ -783,13 +800,14 @@ proc pragmaGuard(c: PContext; it: PNode; kind: TSymKind): PSym = proc semCustomPragma(c: PContext, n: PNode, sym: PSym): PNode = var callNode: PNode - if n.kind in {nkIdent, nkSym}: + case n.kind + of nkIdentKinds: # pragma -> pragma() callNode = newTree(nkCall, n) - elif n.kind == nkExprColonExpr: + of nkExprColonExpr: # pragma: arg -> pragma(arg) callNode = newTree(nkCall, n[0], n[1]) - elif n.kind in nkPragmaCallKinds: + of nkPragmaCallKinds - {nkExprColonExpr}: callNode = n else: invalidPragma(c, n) @@ -865,6 +883,7 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, # number of pragmas increase/decrease with user pragma expansion inc c.instCounter + defer: dec c.instCounter if c.instCounter > 100: globalError(c.config, it.info, "recursive dependency: " & userPragma.name.s) @@ -874,7 +893,6 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, pragma(c, sym, userPragma.ast, validPragmas, isStatement) n.sons[i..i] = userPragma.ast.sons # expand user pragma with its content i.inc(userPragma.ast.len - 1) # inc by -1 is ok, user pragmas was empty - dec c.instCounter else: let k = whichKeyword(ident) if k in validPragmas: @@ -997,7 +1015,7 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, incl(sym.loc.flags, lfHeader) incl(sym.loc.flags, lfNoDecl) # implies nodecl, because otherwise header would not make sense - if sym.loc.r == "": sym.loc.r = rope(sym.name.s) + if sym.loc.snippet == "": sym.loc.snippet = rope(sym.name.s) of wNoSideEffect: noVal(c, it) if sym != nil: @@ -1011,7 +1029,7 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, # Disable the 'noreturn' annotation when in the "Quirky Exceptions" mode! if c.config.exc != excQuirky: incl(sym.flags, sfNoReturn) - if sym.typ[0] != nil: + if sym.typ.returnType != nil: localError(c.config, sym.ast[paramsPos][0].info, ".noreturn with return type not allowed") of wNoDestroy: @@ -1125,13 +1143,20 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, of wFatal: fatal(c.config, it.info, expectStrLit(c, it)) of wDefine: processDefine(c, it, sym) of wUndef: processUndef(c, it) - of wCompile: processCompile(c, it) + of wCompile: + let m = sym.getModule() + incl(m.flags, sfUsed) + processCompile(c, it) of wLink: processLink(c, it) of wPassl: + let m = sym.getModule() + incl(m.flags, sfUsed) let s = expectStrLit(c, it) extccomp.addLinkOption(c.config, s) recordPragma(c, it, "passl", s) of wPassc: + let m = sym.getModule() + incl(m.flags, sfUsed) let s = expectStrLit(c, it) extccomp.addCompileOption(c.config, s) recordPragma(c, it, "passc", s) @@ -1284,7 +1309,8 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, noVal(c, it) if sym == nil: invalidPragma(c, it) else: sym.flags.incl sfUsed - of wLiftLocals: discard + of wLiftLocals: + sym.flags.incl(sfForceLift) of wRequires, wInvariant, wAssume, wAssert: pragmaProposition(c, it) of wEnsures: @@ -1318,6 +1344,16 @@ proc mergePragmas(n, pragmas: PNode) = else: for p in pragmas: n[pragmasPos].add p +proc mergeValidPragmas(n, pragmas: PNode, validPragmas: TSpecialWords) = + if n[pragmasPos].kind == nkEmpty: + n[pragmasPos] = newNodeI(nkPragma, n.info) + for p in pragmas: + let prag = whichPragma(p) + if prag in validPragmas: + let copy = copyTree(p) + overwriteLineInfo copy, n.info + n[pragmasPos].add copy + proc implicitPragmas*(c: PContext, sym: PSym, info: TLineInfo, validPragmas: TSpecialWords) = if sym != nil and sym.kind != skModule: @@ -1331,7 +1367,8 @@ proc implicitPragmas*(c: PContext, sym: PSym, info: TLineInfo, internalError(c.config, info, "implicitPragmas") inc i popInfoContext(c.config) - if sym.kind in routineKinds and sym.ast != nil: mergePragmas(sym.ast, o) + if sym.kind in routineKinds and sym.ast != nil: + mergeValidPragmas(sym.ast, o, validPragmas) if lfExportLib in sym.loc.flags and sfExportc notin sym.flags: localError(c.config, info, ".dynlib requires .exportc") @@ -1340,7 +1377,7 @@ proc implicitPragmas*(c: PContext, sym: PSym, info: TLineInfo, sfImportc in sym.flags and lib != nil: incl(sym.loc.flags, lfDynamicLib) addToLib(lib, sym) - if sym.loc.r == "": sym.loc.r = rope(sym.name.s) + if sym.loc.snippet == "": sym.loc.snippet = rope(sym.name.s) proc hasPragma*(n: PNode, pragma: TSpecialWord): bool = if n == nil: return false diff --git a/compiler/procfind.nim b/compiler/procfind.nim index 468879ba2..c2cc6e71f 100644 --- a/compiler/procfind.nim +++ b/compiler/procfind.nim @@ -33,7 +33,7 @@ proc equalGenericParams(procA, procB: PNode): bool = proc searchForProcAux(c: PContext, scope: PScope, fn: PSym): PSym = const flags = {ExactGenericParams, ExactTypeDescValues, ExactConstraints, IgnoreCC} - var it: TIdentIter + var it: TIdentIter = default(TIdentIter) result = initIdentIter(it, scope.symbols, fn.name) while result != nil: if result.kind == fn.kind: #and sameType(result.typ, fn.typ, flags): @@ -54,7 +54,7 @@ proc searchForProcAux(c: PContext, scope: PScope, fn: PSym): PSym = proc searchForProc*(c: PContext, scope: PScope, fn: PSym): tuple[proto: PSym, comesFromShadowScope: bool] = var scope = scope - result.proto = searchForProcAux(c, scope, fn) + result = (searchForProcAux(c, scope, fn), false) while result.proto == nil and scope.isShadowScope: scope = scope.parent result.proto = searchForProcAux(c, scope, fn) @@ -76,7 +76,7 @@ when false: proc searchForBorrowProc*(c: PContext, startScope: PScope, fn: PSym): PSym = # Searches for the fn in the symbol table. If the parameter lists are suitable # for borrowing the sym in the symbol table is returned, else nil. - var it: TIdentIter + var it: TIdentIter = default(TIdentIter) for scope in walkScopes(startScope): result = initIdentIter(it, scope.symbols, fn.Name) while result != nil: diff --git a/compiler/pushpoppragmas.nim b/compiler/pushpoppragmas.nim new file mode 100644 index 000000000..773e7013b --- /dev/null +++ b/compiler/pushpoppragmas.nim @@ -0,0 +1,54 @@ +import pragmas, options, ast, trees, lineinfos, idents, wordrecg +import std/assertions + +import renderer + + +proc processNote(config: ConfigRef, n: PNode) = + template handleNote(enumVals, notes) = + let x = findStr(enumVals.a, enumVals.b, n[0][1].ident.s, errUnknown) + assert x != errUnknown + assert n[1].kind == nkIntLit + + nk = TNoteKind(x) + if n[1].intVal != 0: incl(notes, nk) + else: excl(notes, nk) + + var nk: TNoteKind + case whichKeyword(n[0][0].ident) + of wHint: handleNote(hintMin .. hintMax, config.notes) + of wWarning: handleNote(warnMin .. warnMax, config.notes) + of wWarningAsError: handleNote(warnMin .. warnMax, config.warningAsErrors) + of wHintAsError: handleNote(hintMin .. hintMax, config.warningAsErrors) + else: discard + +proc pushBackendOption(optionsStack: var seq[(TOptions, TNoteKinds)], options: TOptions, notes: TNoteKinds) = + optionsStack.add (options, notes) + +proc popBackendOption(config: ConfigRef, optionsStack: var seq[(TOptions, TNoteKinds)], options: var TOptions) = + let entry = optionsStack[^1] + options = entry[0] + config.notes = entry[1] + optionsStack.setLen(optionsStack.len-1) + +proc processPushBackendOption*(config: ConfigRef, optionsStack: var seq[(TOptions, TNoteKinds)], options: var TOptions, + n: PNode, start: int) = + pushBackendOption(optionsStack, options, config.notes) + for i in start..<n.len: + let it = n[i] + if it.kind in nkPragmaCallKinds and it.len == 2: + if it[0].kind == nkBracketExpr and + it[0].len == 2 and + it[0][1].kind == nkIdent and it[0][0].kind == nkIdent: + processNote(config, it) + elif it[1].kind == nkIntLit: + let sw = whichPragma(it[0]) + let opts = pragmaToOptions(sw) + if opts != {}: + if it[1].intVal != 0: + options.incl opts + else: + options.excl opts + +template processPopBackendOption*(config: ConfigRef, optionsStack: var seq[(TOptions, TNoteKinds)], options: var TOptions) = + popBackendOption(config, optionsStack, options) diff --git a/compiler/renderer.nim b/compiler/renderer.nim index 2a586386b..cc07c0c2d 100644 --- a/compiler/renderer.nim +++ b/compiler/renderer.nim @@ -25,7 +25,7 @@ type TRenderFlag* = enum renderNone, renderNoBody, renderNoComments, renderDocComments, renderNoPragmas, renderIds, renderNoProcDefs, renderSyms, renderRunnableExamples, - renderIr, renderNonExportedFields, renderExpandUsing + renderIr, renderNonExportedFields, renderExpandUsing, renderNoPostfix TRenderFlags* = set[TRenderFlag] TRenderTok* = object @@ -366,7 +366,7 @@ proc litAux(g: TSrcGen; n: PNode, x: BiggestInt, size: int): string = result = t while result != nil and result.kind in {tyGenericInst, tyRange, tyVar, tyLent, tyDistinct, tyOrdinal, tyAlias, tySink}: - result = lastSon(result) + result = skipModifier(result) result = "" let typ = n.typ.skip @@ -442,6 +442,11 @@ proc atom(g: TSrcGen; n: PNode): string = result = $n.floatVal & "\'f64" else: result = litAux(g, n, (cast[ptr int64](addr(n.floatVal)))[], 8) & "\'f64" + of nkFloat128Lit: + if n.flags * {nfBase2, nfBase8, nfBase16} == {}: + result = $n.floatVal & "\'f128" + else: + result = litAux(g, n, (cast[ptr int64](addr(n.floatVal)))[], 8) & "\'f128" of nkNilLit: result = "nil" of nkType: if (n.typ != nil) and (n.typ.sym != nil): result = n.typ.sym.name.s @@ -514,6 +519,7 @@ proc lsub(g: TSrcGen; n: PNode): int = result = if n.len > 0: lcomma(g, n) + 2 else: len("{:}") of nkClosedSymChoice, nkOpenSymChoice: if n.len > 0: result += lsub(g, n[0]) + of nkOpenSym: result = lsub(g, n[0]) of nkTupleTy: result = lcomma(g, n) + len("tuple[]") of nkTupleClassTy: result = len("tuple") of nkDotExpr: result = lsons(g, n) + 1 @@ -546,7 +552,11 @@ proc lsub(g: TSrcGen; n: PNode): int = of nkInfix: result = lsons(g, n) + 2 of nkPrefix: result = lsons(g, n)+1+(if n.len > 0 and n[1].kind == nkInfix: 2 else: 0) - of nkPostfix: result = lsons(g, n) + of nkPostfix: + if renderNoPostfix notin g.flags: + result = lsons(g, n) + else: + result = lsub(g, n[1]) of nkCallStrLit: result = lsons(g, n) of nkPragmaExpr: result = lsub(g, n[0]) + lcomma(g, n, 1) of nkRange: result = lsons(g, n) + 2 @@ -1009,7 +1019,7 @@ proc bracketKind*(g: TSrcGen, n: PNode): BracketKind = proc skipHiddenNodes(n: PNode): PNode = result = n while result != nil: - if result.kind in {nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv} and result.len > 1: + if result.kind in {nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv, nkOpenSym} and result.len > 1: result = result[1] elif result.kind in {nkCheckedFieldExpr, nkHiddenAddr, nkHiddenDeref, nkStringToCString, nkCStringToString} and result.len > 0: @@ -1271,6 +1281,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext, fromStmtList = false) = put(g, tkParRi, if n.kind == nkOpenSymChoice: "|...)" else: ")") else: gsub(g, n, 0) + of nkOpenSym: gsub(g, n, 0) of nkPar, nkClosure: put(g, tkParLe, "(") gcomma(g, n, c) @@ -1330,14 +1341,20 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext, fromStmtList = false) = put(g, tkColon, ":") gsub(g, n, bodyPos) of nkIdentDefs: - # Skip if this is a property in a type and its not exported - # (While also not allowing rendering of non exported fields) - if ObjectDef in g.inside and (not n[0].isExported() and renderNonExportedFields notin g.flags): - return + var exclFlags: TRenderFlags = {} + if ObjectDef in g.inside: + if not n[0].isExported() and renderNonExportedFields notin g.flags: + # Skip if this is a property in a type and its not exported + # (While also not allowing rendering of non exported fields) + return + # render postfix for object fields: + exclFlags = g.flags * {renderNoPostfix} # We render the identDef without being inside the section incase we render something like # y: proc (x: string) # (We wouldn't want to check if x is exported) g.outside(ObjectDef): + g.flags.excl(exclFlags) gcomma(g, n, 0, -3) + g.flags.incl(exclFlags) if n.len >= 2 and n[^2].kind != nkEmpty: putWithSpace(g, tkColon, ":") gsub(g, n[^2], c) @@ -1416,7 +1433,8 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext, fromStmtList = false) = postStatements(g, n, i, fromStmtList) of nkPostfix: gsub(g, n, 1) - gsub(g, n, 0) + if renderNoPostfix notin g.flags: + gsub(g, n, 0) of nkRange: gsub(g, n, 0) put(g, tkDotDot, "..") @@ -1520,17 +1538,16 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext, fromStmtList = false) = gsub(g, n[0]) gsub(g, n[1]) gcoms(g) + indentNL(g) gsub(g, n[2]) + dedent(g) else: put(g, tkObject, "object") of nkRecList: - indentNL(g) for i in 0..<n.len: optNL(g) gsub(g, n[i], c) gcoms(g) - dedent(g) - putNL(g) of nkOfInherit: putWithSpace(g, tkOf, "of") gsub(g, n, 0) diff --git a/compiler/reorder.nim b/compiler/reorder.nim index f5ec0b2d3..2f7c04af1 100644 --- a/compiler/reorder.nim +++ b/compiler/reorder.nim @@ -322,6 +322,14 @@ proc intersects(s1, s2: IntSet): bool = if s2.contains(a): return true +proc hasPushOrPopPragma(n: DepN): bool = + # Checks if the tree node has some pragmas that do not + # play well with reordering, like the push/pop pragma + # no crossing for push/pop barrier + let a = n.pnode + result = a.kind == nkPragma and a[0].kind == nkIdent and + (a[0].ident.s == "push" or a[0].ident.s == "pop") + proc buildGraph(n: PNode, deps: seq[(IntSet, IntSet)]): DepG = # Build a dependency graph result = newSeqOfCap[DepN](deps.len) @@ -363,6 +371,13 @@ proc buildGraph(n: PNode, deps: seq[(IntSet, IntSet)]): DepG = for dep in deps[i][0]: if dep in declares: ni.expls.add "one declares \"" & idNames[dep] & "\" and the other defines it" + elif hasPushOrPopPragma(nj): + # Every node that comes after a push/pop pragma must + # depend on it; vice versa + if j < i: + ni.kids.add nj + else: + nj.kids.add ni else: for d in declares: if uses.contains(d): @@ -397,24 +412,13 @@ proc getStrongComponents(g: var DepG): seq[seq[DepN]] = ## Tarjan's algorithm. Performs a topological sort ## and detects strongly connected components. result = @[] - var s: seq[DepN] + var s: seq[DepN] = @[] var idx = 0 for v in g.mitems: if v.idx < 0: strongConnect(v, idx, s, result) -proc hasForbiddenPragma(n: PNode): bool = - # Checks if the tree node has some pragmas that do not - # play well with reordering, like the push/pop pragma - result = false - for a in n: - if a.kind == nkPragma and a[0].kind == nkIdent and - a[0].ident.s == "push": - return true - proc reorder*(graph: ModuleGraph, n: PNode, module: PSym): PNode = - if n.hasForbiddenPragma: - return n var includedFiles = initIntSet() let mpath = toFullPath(graph.config, module.fileIdx) let n = expandIncludes(graph, module, n, mpath, diff --git a/compiler/sem.nim b/compiler/sem.nim index 03e599753..2cf93d365 100644 --- a/compiler/sem.nim +++ b/compiler/sem.nim @@ -21,7 +21,7 @@ import extccomp import vtables -import std/[strtabs, math, tables, intsets, strutils] +import std/[strtabs, math, tables, intsets, strutils, packedsets] when not defined(leanCompiler): import spawn @@ -103,7 +103,7 @@ proc fitNode(c: PContext, formal: PType, arg: PNode; info: TLineInfo): PNode = result = nil for ch in arg: if sameType(ch.typ, formal): - return getConstExpr(c.module, ch, c.idgen, c.graph) + return ch typeMismatch(c.config, info, formal, arg.typ, arg) else: result = indexTypesMatch(c, formal, arg.typ, arg) @@ -144,7 +144,7 @@ proc commonType*(c: PContext; x, y: PType): PType = elif b.kind == tyTyped: result = b elif a.kind == tyTypeDesc: # turn any concrete typedesc into the abstract typedesc type - if a.len == 0: result = a + if not a.hasElementType: result = a else: result = newType(tyTypeDesc, c.idgen, a.owner) rawAddSon(result, newType(tyNone, c.idgen, a.owner)) @@ -153,17 +153,17 @@ proc commonType*(c: PContext; x, y: PType): PType = # check for seq[empty] vs. seq[int] let idx = ord(b.kind == tyArray) if a[idx].kind == tyEmpty: return y - elif a.kind == tyTuple and b.kind == tyTuple and a.len == b.len: + elif a.kind == tyTuple and b.kind == tyTuple and sameTupleLengths(a, b): var nt: PType = nil - for i in 0..<a.len: - let aEmpty = isEmptyContainer(a[i]) - let bEmpty = isEmptyContainer(b[i]) + for i, aa, bb in tupleTypePairs(a, b): + let aEmpty = isEmptyContainer(aa) + let bEmpty = isEmptyContainer(bb) if aEmpty != bEmpty: if nt.isNil: nt = copyType(a, c.idgen, a.owner) copyTypeProps(c.graph, c.idgen.module, nt, a) - nt[i] = if aEmpty: b[i] else: a[i] + nt[i] = if aEmpty: bb else: aa if not nt.isNil: result = nt #elif b[idx].kind == tyEmpty: return x elif a.kind == tyRange and b.kind == tyRange: @@ -196,8 +196,8 @@ proc commonType*(c: PContext; x, y: PType): PType = k = a.kind if b.kind != a.kind: return x # bug #7601, array construction of ptr generic - a = a.lastSon.skipTypes({tyGenericInst}) - b = b.lastSon.skipTypes({tyGenericInst}) + a = a.elementType.skipTypes({tyGenericInst}) + b = b.elementType.skipTypes({tyGenericInst}) if a.kind == tyObject and b.kind == tyObject: result = commonSuperclass(a, b) # this will trigger an error later: @@ -222,66 +222,7 @@ proc shouldCheckCaseCovered(caseTyp: PType): bool = else: discard -proc endsInNoReturn(n: PNode): bool = - ## check if expr ends the block like raising or call of noreturn procs do - result = false # assume it does return - - template checkBranch(branch) = - if not endsInNoReturn(branch): - # proved a branch returns - return false - - var it = n - # skip these beforehand, no special handling needed - while it.kind in {nkStmtList, nkStmtListExpr} and it.len > 0: - it = it.lastSon - - case it.kind - of nkIfStmt: - var hasElse = false - for branch in it: - checkBranch: - if branch.len == 2: - branch[1] - elif branch.len == 1: - hasElse = true - branch[0] - else: - raiseAssert "Malformed `if` statement during endsInNoReturn" - # none of the branches returned - result = hasElse # Only truly a no-return when it's exhaustive - of nkCaseStmt: - let caseTyp = skipTypes(it[0].typ, abstractVar-{tyTypeDesc}) - # semCase should already have checked for exhaustiveness in this case - # effectively the same as having an else - var hasElse = caseTyp.shouldCheckCaseCovered() - - # actual noreturn checks - for i in 1 ..< it.len: - let branch = it[i] - checkBranch: - case branch.kind - of nkOfBranch: - branch[^1] - of nkElifBranch: - branch[1] - of nkElse: - hasElse = true - branch[0] - else: - raiseAssert "Malformed `case` statement in endsInNoReturn" - # Can only guarantee a noreturn if there is an else or it's exhaustive - result = hasElse - of nkTryStmt: - checkBranch(it[0]) - for i in 1 ..< it.len: - let branch = it[i] - checkBranch(branch[^1]) - # none of the branches returned - result = true - else: - result = it.kind in nkLastBlockStmts or - it.kind in nkCallKinds and it[0].kind == nkSym and sfNoReturn in it[0].sym.flags +proc endsInNoReturn(n: PNode): bool proc commonType*(c: PContext; x: PType, y: PNode): PType = # ignore exception raising branches in case/if expressions @@ -313,6 +254,8 @@ proc newSymG*(kind: TSymKind, n: PNode, c: PContext): PSym = result.owner = getCurrOwner(c) else: result = newSym(kind, considerQuotedIdent(c, n), c.idgen, getCurrOwner(c), n.info) + if find(result.name.s, '`') >= 0: + result.flags.incl sfWasGenSym #if kind in {skForVar, skLet, skVar} and result.owner.kind == skModule: # incl(result.flags, sfGlobal) when defined(nimsuggest): @@ -322,7 +265,7 @@ proc semIdentVis(c: PContext, kind: TSymKind, n: PNode, allowed: TSymFlags): PSym # identifier with visibility proc semIdentWithPragma(c: PContext, kind: TSymKind, n: PNode, - allowed: TSymFlags): PSym + allowed: TSymFlags, fromTopLevel = false): PSym proc typeAllowedCheck(c: PContext; info: TLineInfo; typ: PType; kind: TSymKind; flags: TTypeAllowedFlags = {}) = @@ -498,15 +441,15 @@ proc semAfterMacroCall(c: PContext, call, macroResult: PNode, c.friendModules.add(s.owner.getModule) result = macroResult resetSemFlag result - if s.typ[0] == nil: + if s.typ.returnType == nil: result = semStmt(c, result, flags) else: - var retType = s.typ[0] + var retType = s.typ.returnType if retType.kind == tyTypeDesc and tfUnresolved in retType.flags and - retType.len == 1: + retType.hasElementType: # bug #11941: template fails(T: type X, v: auto): T # does not mean we expect a tyTypeDesc. - retType = retType[0] + retType = retType.skipModifier case retType.kind of tyUntyped, tyAnything: # Not expecting a type here allows templates like in ``tmodulealias.in``. @@ -530,7 +473,7 @@ proc semAfterMacroCall(c: PContext, call, macroResult: PNode, # e.g. template foo(T: typedesc): seq[T] # We will instantiate the return type here, because # we now know the supplied arguments - var paramTypes = initIdTable() + var paramTypes = initTypeMapping() for param, value in genericParamsInMacroCall(s, call): var givenType = value.typ # the sym nodes used for the supplied generic arguments for @@ -548,13 +491,12 @@ proc semAfterMacroCall(c: PContext, call, macroResult: PNode, else: result = semExpr(c, result, flags, expectedType) result = fitNode(c, retType, result, result.info) - #globalError(s.info, errInvalidParamKindX, typeToString(s.typ[0])) + #globalError(s.info, errInvalidParamKindX, typeToString(s.typ.returnType)) dec(c.config.evalTemplateCounter) discard c.friendModules.pop() const errMissingGenericParamsForTemplate = "'$1' has unspecified generic parameters" - errFloatToString = "cannot convert '$1' to '$2'" proc semMacroExpr(c: PContext, n, nOrig: PNode, sym: PSym, flags: TExprFlags = {}; expectedType: PType = nil): PNode = @@ -708,7 +650,8 @@ proc defaultFieldsForTheUninitialized(c: PContext, recNode: PNode, checkDefault: proc defaultNodeField(c: PContext, a: PNode, aTyp: PType, checkDefault: bool): PNode = let aTypSkip = aTyp.skipTypes(defaultFieldsSkipTypes) - if aTypSkip.kind == tyObject: + case aTypSkip.kind + of tyObject: let child = defaultFieldsForTheUninitialized(c, aTypSkip.n, checkDefault) if child.len > 0: var asgnExpr = newTree(nkObjConstr, newNodeIT(nkType, a.info, aTyp)) @@ -717,7 +660,7 @@ proc defaultNodeField(c: PContext, a: PNode, aTyp: PType, checkDefault: bool): P result = semExpr(c, asgnExpr) else: result = nil - elif aTypSkip.kind == tyArray: + of tyArray: let child = defaultNodeField(c, a, aTypSkip[1], checkDefault) if child != nil: @@ -730,7 +673,7 @@ proc defaultNodeField(c: PContext, a: PNode, aTyp: PType, checkDefault: bool): P result.typ = aTyp else: result = nil - elif aTypSkip.kind == tyTuple: + of tyTuple: var hasDefault = false if aTypSkip.n != nil: let children = defaultFieldsForTuple(c, aTypSkip.n, hasDefault, checkDefault) @@ -743,6 +686,11 @@ proc defaultNodeField(c: PContext, a: PNode, aTyp: PType, checkDefault: bool): P result = nil else: result = nil + of tyRange: + if c.graph.config.isDefined("nimPreviewRangeDefault"): + result = firstRange(c.config, aTypSkip) + else: + result = nil else: result = nil @@ -779,6 +727,7 @@ proc preparePContext*(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PCo result.semOverloadedCall = semOverloadedCall result.semInferredLambda = semInferredLambda result.semGenerateInstance = generateInstance + result.instantiateOnlyProcType = instantiateOnlyProcType result.semTypeNode = semTypeNode result.instTypeBoundOp = sigmatch.instTypeBoundOp result.hasUnresolvedArgs = hasUnresolvedArgs diff --git a/compiler/semcall.nim b/compiler/semcall.nim index 26a40b4dc..13f2273a9 100644 --- a/compiler/semcall.nim +++ b/compiler/semcall.nim @@ -58,10 +58,9 @@ proc initCandidateSymbols(c: PContext, headSymbol: PNode, ]# for paramSym in searchInScopesAllCandidatesFilterBy(c, symx.name, {skConst}): let paramTyp = paramSym.typ - if paramTyp.n.sym.kind in filter: + if paramTyp.n.kind == nkSym and paramTyp.n.sym.kind in filter: result.add((paramTyp.n.sym, o.lastOverloadScope)) - symx = nextOverloadIter(o, c, headSymbol) if result.len > 0: best = initCandidate(c, result[0].s, initialBinding, @@ -81,7 +80,7 @@ proc pickBestCandidate(c: PContext, headSymbol: PNode, # `matches` may find new symbols, so keep track of count var symCount = c.currentScope.symbols.counter - var o: TOverloadIter + var o: TOverloadIter = default(TOverloadIter) # https://github.com/nim-lang/Nim/issues/21272 # prevent mutation during iteration by storing them in a seq # luckily `initCandidateSymbols` does just that @@ -247,48 +246,151 @@ proc presentFailedCandidates(c: PContext, n: PNode, errors: CandidateErrors): candidates.add(getProcHeader(c.config, err.sym, prefer)) candidates.addDeclaredLocMaybe(c.config, err.sym) candidates.add("\n") - let nArg = if err.firstMismatch.arg < n.len: n[err.firstMismatch.arg] else: nil + const genericParamMismatches = {kGenericParamTypeMismatch, kExtraGenericParam, kMissingGenericParam} + let isGenericMismatch = err.firstMismatch.kind in genericParamMismatches + var argList = n + if isGenericMismatch and n[0].kind == nkBracketExpr: + argList = n[0] + let nArg = + if err.firstMismatch.arg < argList.len: + argList[err.firstMismatch.arg] + else: + nil let nameParam = if err.firstMismatch.formal != nil: err.firstMismatch.formal.name.s else: "" - if n.len > 1 and verboseTypeMismatch in c.config.legacyFeatures: - candidates.add(" first type mismatch at position: " & $err.firstMismatch.arg) - # candidates.add "\n reason: " & $err.firstMismatch.kind # for debugging - case err.firstMismatch.kind - of kUnknownNamedParam: - if nArg == nil: - candidates.add("\n unknown named parameter") - else: - candidates.add("\n unknown named parameter: " & $nArg[0]) - of kAlreadyGiven: candidates.add("\n named param already provided: " & $nArg[0]) - of kPositionalAlreadyGiven: candidates.add("\n positional param was already given as named param") - of kExtraArg: candidates.add("\n extra argument given") - of kMissingParam: candidates.add("\n missing parameter: " & nameParam) - of kTypeMismatch, kVarNeeded: - doAssert nArg != nil - let wanted = err.firstMismatch.formal.typ - doAssert err.firstMismatch.formal != nil - candidates.add("\n required type for " & nameParam & ": ") - candidates.addTypeDeclVerboseMaybe(c.config, wanted) - candidates.add "\n but expression '" - if err.firstMismatch.kind == kVarNeeded: + if n.len > 1: + if verboseTypeMismatch notin c.config.legacyFeatures: + case err.firstMismatch.kind + of kUnknownNamedParam: + if nArg == nil: + candidates.add(" unknown named parameter") + else: + candidates.add(" unknown named parameter: " & $nArg[0]) + candidates.add "\n" + of kAlreadyGiven: + candidates.add(" named param already provided: " & $nArg[0]) + candidates.add "\n" + of kPositionalAlreadyGiven: + candidates.add(" positional param was already given as named param") + candidates.add "\n" + of kExtraArg: + candidates.add(" extra argument given") + candidates.add "\n" + of kMissingParam: + candidates.add(" missing parameter: " & nameParam) + candidates.add "\n" + of kExtraGenericParam: + candidates.add(" extra generic param given") + candidates.add "\n" + of kMissingGenericParam: + candidates.add(" missing generic parameter: " & nameParam) + candidates.add "\n" + of kVarNeeded: + doAssert nArg != nil + doAssert err.firstMismatch.formal != nil + candidates.add " expression '" candidates.add renderNotLValue(nArg) candidates.add "' is immutable, not 'var'" - else: - candidates.add renderTree(nArg) - candidates.add "' is of type: " + candidates.add "\n" + of kTypeMismatch: + doAssert nArg != nil + if nArg.kind in nkSymChoices: + candidates.add ambiguousIdentifierMsg(nArg, indent = 2) + let wanted = err.firstMismatch.formal.typ + doAssert err.firstMismatch.formal != nil + doAssert wanted != nil let got = nArg.typ - candidates.addTypeDeclVerboseMaybe(c.config, got) + if got != nil and got.kind == tyProc and wanted.kind == tyProc: + # These are proc mismatches so, + # add the extra explict detail of the mismatch + candidates.add " expression '" + candidates.add renderTree(nArg) + candidates.add "' is of type: " + candidates.addTypeDeclVerboseMaybe(c.config, got) + candidates.addPragmaAndCallConvMismatch(wanted, got, c.config) + effectProblem(wanted, got, candidates, c) + candidates.add "\n" + of kGenericParamTypeMismatch: + let pos = err.firstMismatch.arg + doAssert n[0].kind == nkBracketExpr and pos < n[0].len + let arg = n[0][pos] + doAssert arg != nil + var wanted = err.firstMismatch.formal.typ + if wanted.kind == tyGenericParam and wanted.genericParamHasConstraints: + wanted = wanted.genericConstraint + let got = arg.typ.skipTypes({tyTypeDesc}) + doAssert err.firstMismatch.formal != nil doAssert wanted != nil + doAssert got != nil + candidates.add " generic parameter mismatch, expected " + candidates.addTypeDeclVerboseMaybe(c.config, wanted) + candidates.add " but got '" + candidates.add renderTree(arg) + candidates.add "' of type: " + candidates.addTypeDeclVerboseMaybe(c.config, got) + if nArg.kind in nkSymChoices: + candidates.add "\n" + candidates.add ambiguousIdentifierMsg(nArg, indent = 2) + if got != nil and got.kind == tyProc and wanted.kind == tyProc: + # These are proc mismatches so, + # add the extra explict detail of the mismatch + candidates.addPragmaAndCallConvMismatch(wanted, got, c.config) if got != nil: - if got.kind == tyProc and wanted.kind == tyProc: - # These are proc mismatches so, - # add the extra explict detail of the mismatch - candidates.addPragmaAndCallConvMismatch(wanted, got, c.config) effectProblem(wanted, got, candidates, c) - - of kUnknown: discard "do not break 'nim check'" - candidates.add "\n" - if err.firstMismatch.arg == 1 and nArg.kind == nkTupleConstr and - n.kind == nkCommand: + candidates.add "\n" + of kUnknown: discard "do not break 'nim check'" + else: + candidates.add(" first type mismatch at position: " & $err.firstMismatch.arg) + if err.firstMismatch.kind in genericParamMismatches: + candidates.add(" in generic parameters") + # candidates.add "\n reason: " & $err.firstMismatch.kind # for debugging + case err.firstMismatch.kind + of kUnknownNamedParam: + if nArg == nil: + candidates.add("\n unknown named parameter") + else: + candidates.add("\n unknown named parameter: " & $nArg[0]) + of kAlreadyGiven: candidates.add("\n named param already provided: " & $nArg[0]) + of kPositionalAlreadyGiven: candidates.add("\n positional param was already given as named param") + of kExtraArg: candidates.add("\n extra argument given") + of kMissingParam: candidates.add("\n missing parameter: " & nameParam) + of kExtraGenericParam: + candidates.add("\n extra generic param given") + of kMissingGenericParam: + candidates.add("\n missing generic parameter: " & nameParam) + of kTypeMismatch, kGenericParamTypeMismatch, kVarNeeded: + doAssert nArg != nil + var wanted = err.firstMismatch.formal.typ + if isGenericMismatch and wanted.kind == tyGenericParam and + wanted.genericParamHasConstraints: + wanted = wanted.genericConstraint + doAssert err.firstMismatch.formal != nil + candidates.add("\n required type for " & nameParam & ": ") + candidates.addTypeDeclVerboseMaybe(c.config, wanted) + candidates.add "\n but expression '" + if err.firstMismatch.kind == kVarNeeded: + candidates.add renderNotLValue(nArg) + candidates.add "' is immutable, not 'var'" + else: + candidates.add renderTree(nArg) + candidates.add "' is of type: " + var got = nArg.typ + if isGenericMismatch: got = got.skipTypes({tyTypeDesc}) + candidates.addTypeDeclVerboseMaybe(c.config, got) + if nArg.kind in nkSymChoices: + candidates.add "\n" + candidates.add ambiguousIdentifierMsg(nArg, indent = 2) + doAssert wanted != nil + if got != nil: + if got.kind == tyProc and wanted.kind == tyProc: + # These are proc mismatches so, + # add the extra explict detail of the mismatch + candidates.addPragmaAndCallConvMismatch(wanted, got, c.config) + effectProblem(wanted, got, candidates, c) + + of kUnknown: discard "do not break 'nim check'" + candidates.add "\n" + if err.firstMismatch.arg == 1 and nArg != nil and + nArg.kind == nkTupleConstr and n.kind == nkCommand: maybeWrongSpace = true for diag in err.diagnostics: candidates.add(diag & "\n") @@ -365,23 +467,6 @@ proc notFoundError*(c: PContext, n: PNode, errors: CandidateErrors) = result.add("\n" & errExpectedPosition & "\n" & candidates) localError(c.config, n.info, result) -proc bracketNotFoundError(c: PContext; n: PNode) = - var errors: CandidateErrors = @[] - var o: TOverloadIter - let headSymbol = n[0] - var symx = initOverloadIter(o, c, headSymbol) - while symx != nil: - if symx.kind in routineKinds: - errors.add(CandidateError(sym: symx, - firstMismatch: MismatchInfo(), - diagnostics: @[], - enabled: false)) - symx = nextOverloadIter(o, c, headSymbol) - if errors.len == 0: - localError(c.config, n.info, "could not resolve: " & $n) - else: - notFoundError(c, n, errors) - proc getMsgDiagnostic(c: PContext, flags: TExprFlags, n, f: PNode): string = result = "" if c.compilesContextId > 0: @@ -390,7 +475,7 @@ proc getMsgDiagnostic(c: PContext, flags: TExprFlags, n, f: PNode): string = # also avoid slowdowns in evaluating `compiles(expr)`. discard else: - var o: TOverloadIter + var o: TOverloadIter = default(TOverloadIter) var sym = initOverloadIter(o, c, f) while sym != nil: result &= "\n found $1" % [getSymRepr(c.config, sym)] @@ -435,7 +520,7 @@ proc resolveOverloads(c: PContext, n, orig: PNode, filter, result, alt, errors, efExplain in flags, errorsEnabled, flags) - var dummyErrors: CandidateErrors + var dummyErrors: CandidateErrors = @[] template pickSpecialOp(headSymbol) = pickBestCandidate(c, headSymbol, n, orig, initialBinding, filter, result, alt, dummyErrors, efExplain in flags, @@ -474,7 +559,8 @@ proc resolveOverloads(c: PContext, n, orig: PNode, if overloadsState == csEmpty and result.state == csEmpty: if efNoUndeclared notin flags: # for tests/pragmas/tcustom_pragma.nim result.state = csNoMatch - if efNoDiagnostics in flags: + if c.inGenericContext > 0 and nfExprCall in n.flags: + # untyped expression calls end up here, see #24099 return # xxx adapt/use errorUndeclaredIdentifierHint(c, n, f.ident) localError(c.config, n.info, getMsgDiagnostic(c, flags, n, f)) @@ -510,6 +596,39 @@ proc resolveOverloads(c: PContext, n, orig: PNode, getProcHeader(c.config, alt.calleeSym), args]) +proc bracketNotFoundError(c: PContext; n: PNode; flags: TExprFlags) = + var errors: CandidateErrors = @[] + let headSymbol = n[0] + block: + # we build a closed symchoice of all `[]` overloads for their errors, + # except add a custom error for the magics which always match + var choice = newNodeIT(nkClosedSymChoice, headSymbol.info, newTypeS(tyNone, c)) + var o: TOverloadIter = default(TOverloadIter) + var symx = initOverloadIter(o, c, headSymbol) + while symx != nil: + if symx.kind in routineKinds: + if symx.magic in {mArrGet, mArrPut}: + errors.add(CandidateError(sym: symx, + firstMismatch: MismatchInfo(), + diagnostics: @[], + enabled: false)) + else: + choice.add newSymNode(symx, headSymbol.info) + symx = nextOverloadIter(o, c, headSymbol) + n[0] = choice + # copied from semOverloadedCallAnalyzeEffects, might be overkill: + const baseFilter = {skProc, skFunc, skMethod, skConverter, skMacro, skTemplate} + let filter = + if flags*{efInTypeof, efWantIterator, efWantIterable} != {}: + baseFilter + {skIterator} + else: baseFilter + # this will add the errors: + var r = resolveOverloads(c, n, n, filter, flags, errors, true) + if errors.len == 0: + localError(c.config, n.info, "could not resolve: " & $n) + else: + notFoundError(c, n, errors) + proc instGenericConvertersArg*(c: PContext, a: PNode, x: TCandidate) = let a = if a.kind == nkHiddenDeref: a[0] else: a if a.kind == nkHiddenCallConv and a[0].kind == nkSym: @@ -518,7 +637,7 @@ proc instGenericConvertersArg*(c: PContext, a: PNode, x: TCandidate) = let finalCallee = generateInstance(c, s, x.bindings, a.info) a[0].sym = finalCallee a[0].typ = finalCallee.typ - #a.typ = finalCallee.typ[0] + #a.typ = finalCallee.typ.returnType proc instGenericConvertersSons*(c: PContext, n: PNode, x: TCandidate) = assert n.kind in nkCallKinds @@ -551,7 +670,7 @@ proc inferWithMetatype(c: PContext, formal: PType, result = copyTree(arg) result.typ = formal -proc updateDefaultParams(call: PNode) = +proc updateDefaultParams(c: PContext, call: PNode) = # In generic procs, the default parameter may be unique for each # instantiation (see tlateboundgenericparams). # After a call is resolved, we need to re-assign any default value @@ -561,8 +680,18 @@ proc updateDefaultParams(call: PNode) = let calleeParams = call[0].sym.typ.n for i in 1..<call.len: if nfDefaultParam in call[i].flags: - let def = calleeParams[i].sym.ast + let formal = calleeParams[i].sym + let def = formal.ast if nfDefaultRefsParam in def.flags: call.flags.incl nfDefaultRefsParam + # mirrored with sigmatch: + if def.kind == nkEmpty: + # The default param value is set to empty in `instantiateProcType` + # when the type of the default expression doesn't match the type + # of the instantiated proc param: + pushInfoContext(c.config, call.info, call[0].sym.detailedInfo) + typeMismatch(c.config, def.info, formal.typ, def.typ, formal.ast) + popInfoContext(c.config) + def.typ = errorType(c) call[i] = def proc getCallLineInfo(n: PNode): TLineInfo = @@ -581,7 +710,7 @@ proc inheritBindings(c: PContext, x: var TCandidate, expectedType: PType) = ## Helper proc to inherit bound generic parameters from expectedType into x. ## Does nothing if 'inferGenericTypes' isn't in c.features. if inferGenericTypes notin c.features: return - if expectedType == nil or x.callee[0] == nil: return # required for inference + if expectedType == nil or x.callee.returnType == nil: return # required for inference var flatUnbound: seq[PType] = @[] @@ -593,14 +722,14 @@ proc inheritBindings(c: PContext, x: var TCandidate, expectedType: PType) = ## skips types and puts the skipped version on stack # It might make sense to skip here one by one. It's not part of the main # type reduction because the right side normally won't be skipped - const toSkip = { tyVar, tyLent, tyStatic, tyCompositeTypeClass, tySink } + const toSkip = {tyVar, tyLent, tyStatic, tyCompositeTypeClass, tySink} let x = a.skipTypes(toSkip) y = if a.kind notin toSkip: b else: b.skipTypes(toSkip) typeStack.add((x, y)) - stackPut(x.callee[0], expectedType) + stackPut(x.callee.returnType, expectedType) while typeStack.len() > 0: let (t, u) = typeStack.pop() @@ -608,17 +737,18 @@ proc inheritBindings(c: PContext, x: var TCandidate, expectedType: PType) = continue case t.kind of ConcreteTypes, tyGenericInvocation, tyUncheckedArray: + # XXX This logic makes no sense for `tyUncheckedArray` # nested, add all the types to stack let startIdx = if u.kind in ConcreteTypes: 0 else: 1 - endIdx = min(u.len() - startIdx, t.len()) + endIdx = min(u.kidsLen() - startIdx, t.kidsLen()) for i in startIdx ..< endIdx: # early exit with current impl if t[i] == nil or u[i] == nil: return stackPut(t[i], u[i]) of tyGenericParam: - let prebound = x.bindings.idTableGet(t).PType + let prebound = x.bindings.idTableGet(t) if prebound != nil: continue # Skip param, already bound @@ -641,12 +771,12 @@ proc semResolvedCall(c: PContext, x: var TCandidate, markUsed(c, info, finalCallee) onUse(info, finalCallee) assert finalCallee.ast != nil - if x.hasFauxMatch: + if x.matchedErrorType: result = x.call result[0] = newSymNode(finalCallee, getCallLineInfo(result[0])) - if containsGenericType(result.typ) or x.fauxMatch == tyUnknown: - result.typ = newTypeS(x.fauxMatch, c) - if result.typ.kind == tyError: incl result.typ.flags, tfCheckedForDestructor + if containsGenericType(result.typ): + result.typ = newTypeS(tyError, c) + incl result.typ.flags, tfCheckedForDestructor return let gp = finalCallee.ast[genericParamsPos] if gp.isGenericParams: @@ -680,8 +810,9 @@ proc semResolvedCall(c: PContext, x: var TCandidate, result = x.call instGenericConvertersSons(c, result, x) result[0] = newSymNode(finalCallee, getCallLineInfo(result[0])) - result.typ = finalCallee.typ[0] - updateDefaultParams(result) + if finalCallee.magic notin {mArrGet, mArrPut}: + result.typ = finalCallee.typ.returnType + updateDefaultParams(c, result) proc canDeref(n: PNode): bool {.inline.} = result = n.len >= 2 and (let t = n[1].typ; @@ -706,7 +837,7 @@ proc semOverloadedCall(c: PContext, n, nOrig: PNode, candidates) result = semResolvedCall(c, r, n, flags, expectedType) else: - if efDetermineType in flags and c.inGenericContext > 0 and c.matchedConcept == nil: + if c.inGenericContext > 0 and c.matchedConcept == nil: result = semGenericStmt(c, n) result.typ = makeTypeFromExpr(c, result.copyTree) elif efExplain notin flags: @@ -724,21 +855,16 @@ proc explicitGenericInstError(c: PContext; n: PNode): PNode = result = n proc explicitGenericSym(c: PContext, n: PNode, s: PSym): PNode = + if s.kind in {skTemplate, skMacro}: + internalError c.config, n.info, "cannot get explicitly instantiated symbol of " & + (if s.kind == skTemplate: "template" else: "macro") # binding has to stay 'nil' for this to work! var m = newCandidate(c, s, nil) - - for i in 1..<n.len: - let formal = s.ast[genericParamsPos][i-1].typ - var arg = n[i].typ - # try transforming the argument into a static one before feeding it into - # typeRel - if formal.kind == tyStatic and arg.kind != tyStatic: - let evaluated = c.semTryConstExpr(c, n[i]) - if evaluated != nil: - arg = newTypeS(tyStatic, c, sons = @[evaluated.typ]) - arg.n = evaluated - let tm = typeRel(m, formal, arg) - if tm in {isNone, isConvertible}: return nil + matchGenericParams(m, n, s) + if m.state != csMatch: + # state is csMatch only if *all* generic params were matched, + # including implicit parameters + return nil var newInst = generateInstance(c, s, m.bindings, n.info) newInst.typ.flags.excl tfUnresolved let info = getCallLineInfo(n) @@ -746,10 +872,16 @@ proc explicitGenericSym(c: PContext, n: PNode, s: PSym): PNode = onUse(info, s) result = newSymNode(newInst, info) -proc setGenericParams(c: PContext, n: PNode) = +proc setGenericParams(c: PContext, n, expectedParams: PNode) = ## sems generic params in subscript expression for i in 1..<n.len: - let e = semExprWithType(c, n[i]) + let + constraint = + if expectedParams != nil and i <= expectedParams.len: + expectedParams[i - 1].typ + else: + nil + e = semExprWithType(c, n[i], expectedType = constraint) if e.typ == nil: n[i].typ = errorType(c) else: @@ -757,7 +889,7 @@ proc setGenericParams(c: PContext, n: PNode) = proc explicitGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = assert n.kind == nkBracketExpr - setGenericParams(c, n) + setGenericParams(c, n, s.ast[genericParamsPos]) var s = s var a = n[0] if a.kind == nkSym: @@ -821,7 +953,7 @@ proc searchForBorrowProc(c: PContext, startScope: PScope, fn: PSym): tuple[s: PS ]# t = skipTypes(param.typ, desiredTypes) isDistinct = t.kind == tyDistinct or param.typ.kind == tyDistinct - if t.kind == tyGenericInvocation and t[0].lastSon.kind == tyDistinct: + if t.kind == tyGenericInvocation and t.genericHead.last.kind == tyDistinct: result.state = bsGeneric return if isDistinct: hasDistinct = true @@ -840,7 +972,7 @@ proc searchForBorrowProc(c: PContext, startScope: PScope, fn: PSym): tuple[s: PS if resolved != nil: result.s = resolved[0].sym result.state = bsMatch - if not compareTypes(result.s.typ[0], fn.typ[0], dcEqIgnoreDistinct, {IgnoreFlags}): + if not compareTypes(result.s.typ.returnType, fn.typ.returnType, dcEqIgnoreDistinct, {IgnoreFlags}): result.state = bsReturnNotMatch elif result.s.magic in {mArrPut, mArrGet}: # cannot borrow these magics for now diff --git a/compiler/semdata.nim b/compiler/semdata.nim index b1ffbec49..ca35ddc53 100644 --- a/compiler/semdata.nim +++ b/compiler/semdata.nim @@ -41,7 +41,7 @@ type breakInLoop*: bool # whether we are in a loop without block next*: PProcCon # used for stacking procedure contexts mappingExists*: bool - mapping*: TIdTable + mapping*: Table[ItemId, PSym] caseContext*: seq[tuple[n: PNode, idx: int]] localBindStmts*: seq[PNode] @@ -73,9 +73,9 @@ type efNoUndeclared, efIsDotCall, efCannotBeDotCall, # Use this if undeclared identifiers should not raise an error during # overload resolution. - efNoDiagnostics, efTypeAllowed # typeAllowed will be called after efWantNoDefaults + efIgnoreDefaults # var statements without initialization efAllowSymChoice # symchoice node should not be resolved TExprFlags* = set[TExprFlag] @@ -122,8 +122,6 @@ type converters*: seq[PSym] patterns*: seq[PSym] # sequence of pattern matchers optionStack*: seq[POptionEntry] - symMapping*: TIdTable # every gensym'ed symbol needs to be mapped - # to some new symbol in a generic instantiation libs*: seq[PLib] # all libs used by this module semConstExpr*: proc (c: PContext, n: PNode; expectedType: PType = nil): PNode {.nimcall.} # for the pragmas semExpr*: proc (c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType = nil): PNode {.nimcall.} @@ -138,9 +136,12 @@ type semOverloadedCall*: proc (c: PContext, n, nOrig: PNode, filter: TSymKinds, flags: TExprFlags, expectedType: PType = nil): PNode {.nimcall.} semTypeNode*: proc(c: PContext, n: PNode, prev: PType): PType {.nimcall.} - semInferredLambda*: proc(c: PContext, pt: TIdTable, n: PNode): PNode - semGenerateInstance*: proc (c: PContext, fn: PSym, pt: TIdTable, + semInferredLambda*: proc(c: PContext, pt: Table[ItemId, PType], n: PNode): PNode + semGenerateInstance*: proc (c: PContext, fn: PSym, pt: Table[ItemId, PType], info: TLineInfo): PSym + instantiateOnlyProcType*: proc (c: PContext, pt: TypeMapping, + prc: PSym, info: TLineInfo): PType + # used by sigmatch for explicit generic instantiations includedFiles*: IntSet # used to detect recursive include files pureEnumFields*: TStrTable # pure enum fields that can be used unambiguously userPragmas*: TStrTable @@ -170,6 +171,7 @@ type inUncheckedAssignSection*: int importModuleLookup*: Table[int, seq[int]] # (module.ident.id, [module.id]) skipTypes*: seq[PNode] # used to skip types between passes in type section. So far only used for inheritance, sets and generic bodies. + inTypeofContext*: int TBorrowState* = enum bsNone, bsReturnNotMatch, bsNoDistinct, bsGeneric, bsNotSupported, bsMatch @@ -251,14 +253,14 @@ proc popProcCon*(c: PContext) {.inline.} = c.p = c.p.next proc put*(p: PProcCon; key, val: PSym) = if not p.mappingExists: - p.mapping = initIdTable() + p.mapping = initTable[ItemId, PSym]() p.mappingExists = true #echo "put into table ", key.info - p.mapping.idTablePut(key, val) + p.mapping[key.itemId] = val proc get*(p: PProcCon; key: PSym): PSym = if not p.mappingExists: return nil - result = PSym(p.mapping.idTableGet(key)) + result = p.mapping.getOrDefault(key.itemId) proc getGenSym*(c: PContext; s: PSym): PSym = if sfGenSym notin s.flags: return s @@ -396,12 +398,11 @@ proc addToLib*(lib: PLib, sym: PSym) = # LocalError(sym.info, errInvalidPragma) sym.annex = lib -proc newTypeS*(kind: TTypeKind, c: PContext, sons: seq[PType] = @[]): PType = - result = newType(kind, c.idgen, getCurrOwner(c), sons = sons) +proc newTypeS*(kind: TTypeKind; c: PContext; son: sink PType = nil): PType = + result = newType(kind, c.idgen, getCurrOwner(c), son = son) proc makePtrType*(owner: PSym, baseType: PType; idgen: IdGenerator): PType = - result = newType(tyPtr, idgen, owner) - addSonSkipIntLit(result, baseType, idgen) + result = newType(tyPtr, idgen, owner, skipIntLit(baseType, idgen)) proc makePtrType*(c: PContext, baseType: PType): PType = makePtrType(getCurrOwner(c), baseType, c.idgen) @@ -414,15 +415,13 @@ proc makeTypeWithModifier*(c: PContext, if modifier in {tyVar, tyLent, tyTypeDesc} and baseType.kind == modifier: result = baseType else: - result = newTypeS(modifier, c) - addSonSkipIntLit(result, baseType, c.idgen) + result = newTypeS(modifier, c, skipIntLit(baseType, c.idgen)) proc makeVarType*(c: PContext, baseType: PType; kind = tyVar): PType = if baseType.kind == kind: result = baseType else: - result = newTypeS(kind, c) - addSonSkipIntLit(result, baseType, c.idgen) + result = newTypeS(kind, c, skipIntLit(baseType, c.idgen)) proc makeTypeSymNode*(c: PContext, typ: PType, info: TLineInfo): PNode = let typedesc = newTypeS(tyTypeDesc, c) @@ -438,40 +437,40 @@ proc makeTypeFromExpr*(c: PContext, n: PNode): PType = assert n != nil result.n = n -proc newTypeWithSons*(owner: PSym, kind: TTypeKind, sons: seq[PType]; - idgen: IdGenerator): PType = - result = newType(kind, idgen, owner, sons = sons) +when false: + proc newTypeWithSons*(owner: PSym, kind: TTypeKind, sons: seq[PType]; + idgen: IdGenerator): PType = + result = newType(kind, idgen, owner, sons = sons) -proc newTypeWithSons*(c: PContext, kind: TTypeKind, - sons: seq[PType]): PType = - result = newType(kind, c.idgen, getCurrOwner(c), sons = sons) - -proc newTypeWithSons*(c: PContext, kind: TTypeKind, - parent: PType): PType = - result = newType(kind, c.idgen, getCurrOwner(c), parent = parent) + proc newTypeWithSons*(c: PContext, kind: TTypeKind, + sons: seq[PType]): PType = + result = newType(kind, c.idgen, getCurrOwner(c), sons = sons) proc makeStaticExpr*(c: PContext, n: PNode): PNode = result = newNodeI(nkStaticExpr, n.info) result.sons = @[n] result.typ = if n.typ != nil and n.typ.kind == tyStatic: n.typ - else: newTypeWithSons(c, tyStatic, @[n.typ]) + else: newTypeS(tyStatic, c, n.typ) proc makeAndType*(c: PContext, t1, t2: PType): PType = - result = newTypeS(tyAnd, c, sons = @[t1, t2]) + result = newTypeS(tyAnd, c) + result.rawAddSon t1 + result.rawAddSon t2 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 = - if t1.kind != tyOr and t2.kind != tyOr: - result = newTypeS(tyOr, c, sons = @[t1, t2]) + result = newTypeS(tyOr, c) + result.rawAddSon t1 + result.rawAddSon t2 else: result = newTypeS(tyOr, c) template addOr(t1) = if t1.kind == tyOr: - for x in t1: result.rawAddSon x + for x in t1.kids: result.rawAddSon x else: result.rawAddSon t1 addOr(t1) @@ -482,7 +481,7 @@ proc makeOrType*(c: PContext, t1, t2: PType): PType = result.flags.incl tfHasMeta proc makeNotType*(c: PContext, t1: PType): PType = - result = newTypeS(tyNot, c, sons = @[t1]) + result = newTypeS(tyNot, c, son = t1) propagateToOwner(result, t1) result.flags.incl(t1.flags * {tfHasStatic}) result.flags.incl tfHasMeta @@ -493,7 +492,7 @@ proc nMinusOne(c: PContext; n: PNode): PNode = # Remember to fix the procs below this one when you make changes! proc makeRangeWithStaticExpr*(c: PContext, n: PNode): PType = let intType = getSysType(c.graph, n.info, tyInt) - result = newTypeS(tyRange, c, sons = @[intType]) + result = newTypeS(tyRange, c, son = intType) if n.typ != nil and n.typ.n == nil: result.flags.incl tfUnresolved result.n = newTreeI(nkRange, n.info, newIntTypeNode(0, intType), @@ -553,9 +552,8 @@ proc makeTypeDesc*(c: PContext, typ: PType): PType = if typ.kind == tyTypeDesc and not isSelf(typ): result = typ else: - result = newTypeS(tyTypeDesc, c) + result = newTypeS(tyTypeDesc, c, skipIntLit(typ, c.idgen)) incl result.flags, tfCheckedForDestructor - result.addSonSkipIntLit(typ, c.idgen) proc symFromType*(c: PContext; t: PType, info: TLineInfo): PSym = if t.sym != nil: return t.sym diff --git a/compiler/semexprs.nim b/compiler/semexprs.nim index 82ff000a7..2885142a7 100644 --- a/compiler/semexprs.nim +++ b/compiler/semexprs.nim @@ -54,17 +54,6 @@ proc semOperand(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = # same as 'semExprWithType' but doesn't check for proc vars result = semExpr(c, n, flags + {efOperand, efAllowSymChoice}) if result.typ != nil: - # XXX tyGenericInst here? - if result.typ.kind == tyProc and hasUnresolvedParams(result, {efOperand}): - #and tfUnresolved in result.typ.flags: - let owner = result.typ.owner - let err = - # consistent error message with evaltempl/semMacroExpr - if owner != nil and owner.kind in {skTemplate, skMacro}: - errMissingGenericParamsForTemplate % n.renderTree - else: - errProcHasNoConcreteType % n.renderTree - localError(c.config, n.info, err) if result.typ.kind in {tyVar, tyLent}: result = newDeref(result) elif {efWantStmt, efAllowStmt} * flags != {}: result.typ = newTypeS(tyVoid, c) @@ -131,11 +120,13 @@ proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode proc isSymChoice(n: PNode): bool {.inline.} = result = n.kind in nkSymChoices -proc semSymChoice(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType = nil): PNode = - result = n +proc resolveSymChoice(c: PContext, n: var PNode, flags: TExprFlags = {}, expectedType: PType = nil) = + ## Attempts to resolve a symchoice `n`, `n` remains a symchoice if + ## it cannot be resolved (this is the case even when `n.len == 1`). if expectedType != nil: - result = fitNode(c, expectedType, result, n.info) - if isSymChoice(result) and efAllowSymChoice notin flags: + # resolve from type inference, see paramTypesMatch + n = fitNode(c, expectedType, n, n.info) + if isSymChoice(n) and efAllowSymChoice notin flags: # some contexts might want sym choices preserved for later disambiguation # in general though they are ambiguous let first = n[0].sym @@ -145,17 +136,88 @@ proc semSymChoice(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: P foundSym == first: # choose the first resolved enum field, i.e. the latest in scope # to mirror behavior before overloadable enums - result = n[0] - else: - var err = "ambiguous identifier '" & first.name.s & - "' -- use one of the following:\n" - for child in n: - let candidate = child.sym - err.add " " & candidate.owner.name.s & "." & candidate.name.s - err.add ": " & typeToString(candidate.typ) & "\n" - localError(c.config, n.info, err) - n.typ = errorType(c) - result = n + n = n[0] + +proc semOpenSym(c: PContext, n: PNode, flags: TExprFlags, expectedType: PType, + warnDisabled = false): PNode = + ## sem the child of an `nkOpenSym` node, that is, captured symbols that can be + ## replaced by newly injected symbols in generics. `s` must be the captured + ## symbol if the original node is an `nkSym` node; and `nil` if it is an + ## `nkOpenSymChoice`, in which case only non-overloadable injected symbols + ## will be considered. + let isSym = n.kind == nkSym + let ident = n.getPIdent + assert ident != nil + let id = newIdentNode(ident, n.info) + c.isAmbiguous = false + let s2 = qualifiedLookUp(c, id, {}) + # for `nkSym`, the first found symbol being different and unambiguous is + # enough to replace the original + # for `nkOpenSymChoice`, the first found symbol must be non-overloadable, + # since otherwise we have to use regular `nkOpenSymChoice` functionality + # but of the overloadable sym kinds, semExpr does not handle skModule, skMacro, skTemplate + # as overloaded in the case where `nkIdent` finds them first + if s2 != nil and not c.isAmbiguous and + ((isSym and s2 != n.sym) or + (not isSym and s2.kind notin OverloadableSyms-{skModule, skMacro, skTemplate})): + # only consider symbols defined under current proc: + var o = s2.owner + while o != nil: + if o == c.p.owner: + if not warnDisabled: + result = semExpr(c, id, flags, expectedType) + return + else: + var msg = + "a new symbol '" & ident.s & "' has been injected during " & + # msgContext should show what is being instantiated: + "template or generic instantiation, however " + if isSym: + msg.add( + getSymRepr(c.config, n.sym) & " captured at " & + "the proc declaration will be used instead; " & + "either enable --experimental:openSym to use the injected symbol, " & + "or `bind` this captured symbol explicitly") + else: + msg.add( + "overloads of " & ident.s & " will be used instead; " & + "either enable --experimental:openSym to use the injected symbol, " & + "or `bind` this symbol explicitly") + message(c.config, n.info, warnIgnoredSymbolInjection, msg) + break + o = o.owner + # nothing found + n.flags.excl nfDisabledOpenSym + if not warnDisabled and isSym: + result = semExpr(c, n, flags, expectedType) + else: + result = nil + if not isSym: + # set symchoice node type back to None + n.typ = newTypeS(tyNone, c) + +proc semSymChoice(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType = nil): PNode = + if n.kind == nkOpenSymChoice: + result = semOpenSym(c, n, flags, expectedType, + warnDisabled = nfDisabledOpenSym in n.flags and + genericsOpenSym notin c.features) + if result != nil: + return + result = n + resolveSymChoice(c, result, flags, expectedType) + if isSymChoice(result) and result.len == 1: + # resolveSymChoice can leave 1 sym + result = result[0] + if isSymChoice(result) and efAllowSymChoice notin flags: + var err = "ambiguous identifier: '" & result[0].sym.name.s & + "' -- use one of the following:\n" + for child in n: + let candidate = child.sym + err.add " " & candidate.owner.name.s & "." & candidate.name.s + err.add ": " & typeToString(candidate.typ) & "\n" + localError(c.config, n.info, err) + n.typ = errorType(c) + result = n if result.kind == nkSym: result = semSym(c, result, result.sym, flags) @@ -196,19 +258,19 @@ proc checkConvertible(c: PContext, targetTyp: PType, src: PNode): TConvStatus = var d = skipTypes(targetTyp, abstractVar) var s = srcTyp if s.kind in tyUserTypeClasses and s.isResolvedUserTypeClass: - s = s.lastSon + s = s.last s = skipTypes(s, abstractVar-{tyTypeDesc, tyOwned}) if s.kind == tyOwned and d.kind != tyOwned: - s = s.lastSon + s = s.skipModifier var pointers = 0 while (d != nil) and (d.kind in {tyPtr, tyRef, tyOwned}): if s.kind == tyOwned and d.kind != tyOwned: - s = s.lastSon + s = s.skipModifier elif d.kind != s.kind: break else: - d = d.lastSon - s = s.lastSon + d = d.elementType + s = s.elementType inc pointers let targetBaseTyp = skipTypes(targetTyp, abstractVarRange) @@ -220,14 +282,16 @@ proc checkConvertible(c: PContext, targetTyp: PType, src: PNode): TConvStatus = result = checkConversionBetweenObjects(d.skipTypes(abstractInst), s.skipTypes(abstractInst), pointers) elif (targetBaseTyp.kind in IntegralTypes) and (srcBaseTyp.kind in IntegralTypes): - if targetTyp.kind == tyEnum and srcBaseTyp.kind == tyEnum: + if targetTyp.kind == tyEnum and srcBaseTyp.kind == tyEnum and + not sameType(targetTyp, srcBaseTyp): message(c.config, src.info, warnSuspiciousEnumConv, "suspicious code: enum to enum conversion") # `elif` would be incorrect here if targetTyp.kind == tyBool: discard "convOk" elif targetTyp.isOrdinalType: if src.kind in nkCharLit..nkUInt64Lit and - src.getInt notin firstOrd(c.config, targetTyp)..lastOrd(c.config, targetTyp): + src.getInt notin firstOrd(c.config, targetTyp)..lastOrd(c.config, targetTyp) and + targetTyp.kind notin {tyUInt..tyUInt64}: result = convNotInRange elif src.kind in nkFloatLit..nkFloat64Lit and (classify(src.floatVal) in {fcNan, fcNegInf, fcInf} or @@ -345,7 +409,7 @@ proc semConv(c: PContext, n: PNode; flags: TExprFlags = {}, expectedType: PType if targetType.kind in {tySink, tyLent} or isOwnedSym(c, n[0]): let baseType = semTypeNode(c, n[1], nil).skipTypes({tyTypeDesc}) - let t = newTypeS(targetType.kind, c, @[baseType]) + let t = newTypeS(targetType.kind, c, baseType) if targetType.kind == tyOwned: t.flags.incl tfHasOwned result = newNodeI(nkType, n.info) @@ -442,7 +506,7 @@ proc semLowHigh(c: PContext, n: PNode, m: TMagic): PNode = of tySequence, tyString, tyCstring, tyOpenArray, tyVarargs: n.typ = getSysType(c.graph, n.info, tyInt) of tyArray: - n.typ = typ[0] # indextype + n.typ = typ.indexType if n.typ.kind == tyRange and emptyRange(n.typ.n[0], n.typ.n[1]): #Invalid range n.typ = getSysType(c.graph, n.info, tyInt) of tyInt..tyInt64, tyChar, tyBool, tyEnum, tyUInt..tyUInt64, tyFloat..tyFloat64: @@ -467,7 +531,7 @@ proc fixupStaticType(c: PContext, n: PNode) = # apply this measure only in code that is enlightened to work # with static types. if n.typ.kind != tyStatic: - n.typ = newTypeWithSons(getCurrOwner(c), tyStatic, @[n.typ], c.idgen) + n.typ = newTypeS(tyStatic, c, n.typ) n.typ.n = n # XXX: cycles like the one here look dangerous. # Consider using `n.copyTree` @@ -520,8 +584,9 @@ proc isOpImpl(c: PContext, n: PNode, flags: TExprFlags): PNode = result.typ = n.typ proc semIs(c: PContext, n: PNode, flags: TExprFlags): PNode = - if n.len != 3: + if n.len != 3 or n[2].kind == nkEmpty: localError(c.config, n.info, "'is' operator takes 2 arguments") + return errorNode(c, n) let boolType = getSysType(c.graph, n.info, tyBool) result = n @@ -555,15 +620,14 @@ proc semIs(c: PContext, n: PNode, flags: TExprFlags): PNode = n[1] = makeTypeSymNode(c, lhsType, n[1].info) lhsType = n[1].typ else: - if lhsType.base.kind == tyNone or - (c.inGenericContext > 0 and lhsType.base.containsGenericType): + if c.inGenericContext > 0 and lhsType.base.containsUnresolvedType: # BUGFIX: don't evaluate this too early: ``T is void`` return result = isOpImpl(c, n, flags) proc semOpAux(c: PContext, n: PNode) = - const flags = {efDetermineType} + const flags = {efDetermineType, efAllowSymChoice} for i in 1..<n.len: var a = n[i] if a.kind == nkExprEqExpr and a.len == 2: @@ -588,7 +652,14 @@ proc overloadedCallOpr(c: PContext, n: PNode): PNode = proc changeType(c: PContext; n: PNode, newType: PType, check: bool) = case n.kind - of nkCurly, nkBracket: + of nkCurly: + for i in 0..<n.len: + if n[i].kind == nkRange: + changeType(c, n[i][0], elemType(newType), check) + changeType(c, n[i][1], elemType(newType), check) + else: + changeType(c, n[i], elemType(newType), check) + of nkBracket: for i in 0..<n.len: changeType(c, n[i], elemType(newType), check) of nkPar, nkTupleConstr: @@ -621,14 +692,20 @@ proc changeType(c: PContext; n: PNode, newType: PType, check: bool) = a.add m changeType(m, tup[i], check) of nkCharLit..nkUInt64Lit: - if check and n.kind != nkUInt64Lit and not sameType(n.typ, newType): + if check and n.kind != nkUInt64Lit and not sameTypeOrNil(n.typ, newType): let value = n.intVal if value < firstOrd(c.config, newType) or value > lastOrd(c.config, newType): localError(c.config, n.info, "cannot convert " & $value & - " to " & typeToString(newType)) + " to " & typeNameAndDesc(newType)) of nkFloatLit..nkFloat64Lit: if check and not floatRangeCheck(n.floatVal, newType): - localError(c.config, n.info, errFloatToString % [$n.floatVal, typeToString(newType)]) + localError(c.config, n.info, errFloatToString % [$n.floatVal, typeNameAndDesc(newType)]) + of nkSym: + if check and n.sym.kind == skEnumField and not sameTypeOrNil(n.sym.typ, newType): + let value = n.sym.position + if value < firstOrd(c.config, newType) or value > lastOrd(c.config, newType): + localError(c.config, n.info, "cannot convert '" & n.sym.name.s & + "' to '" & typeNameAndDesc(newType) & "'") else: discard n.typ = newType @@ -640,34 +717,46 @@ proc arrayConstrType(c: PContext, n: PNode): PType = else: var t = skipTypes(n[0].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal, tyAlias, tySink}) addSonSkipIntLit(typ, t, c.idgen) - typ[0] = makeRangeType(c, 0, n.len - 1, n.info) + typ.setIndexType makeRangeType(c, 0, n.len - 1, n.info) result = typ proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode = result = newNodeI(nkBracket, n.info) - result.typ = newTypeS(tyArray, c) + # nkBracket nodes can also be produced by the VM as seq constant nodes + # in which case, we cannot produce a new array type for the node, + # as this might lose type info even when the node has array type + let constructType = n.typ.isNil var expectedElementType, expectedIndexType: PType = nil - if expectedType != nil: - let expected = expectedType.skipTypes(abstractRange-{tyDistinct}) - case expected.kind + var expectedBase: PType = nil + if constructType: + result.typ = newTypeS(tyArray, c) + rawAddSon(result.typ, nil) # index type + if expectedType != nil: + expectedBase = expectedType.skipTypes(abstractRange-{tyDistinct}) + else: + result.typ = n.typ + expectedBase = n.typ.skipTypes(abstractRange) # include tyDistinct this time + if expectedBase != nil: + case expectedBase.kind of tyArray: - expectedIndexType = expected[0] - expectedElementType = expected[1] - of tyOpenArray: - expectedElementType = expected[0] + expectedIndexType = expectedBase[0] + expectedElementType = expectedBase[1] + of tyOpenArray, tySequence: + # typed bracket expressions can also have seq type + expectedElementType = expectedBase[0] else: discard - rawAddSon(result.typ, nil) # index type var firstIndex, lastIndex: Int128 = Zero indexType = getSysType(c.graph, n.info, tyInt) lastValidIndex = lastOrd(c.config, indexType) if n.len == 0: - rawAddSon(result.typ, - if expectedElementType != nil and - typeAllowed(expectedElementType, skLet, c) == nil: - expectedElementType - else: - newTypeS(tyEmpty, c)) # needs an empty basetype! + if constructType: + rawAddSon(result.typ, + if expectedElementType != nil and + typeAllowed(expectedElementType, skLet, c) == nil: + expectedElementType + else: + newTypeS(tyEmpty, c)) # needs an empty basetype! lastIndex = toInt128(-1) else: var x = n[0] @@ -684,9 +773,13 @@ proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PTyp x = x[1] let yy = semExprWithType(c, x, {efTypeAllowed}, expectedElementType) - var typ = yy.typ - if expectedElementType == nil: - expectedElementType = typ + var typ: PType + if constructType: + typ = yy.typ + if expectedElementType == nil: + expectedElementType = typ + else: + typ = expectedElementType result.add yy #var typ = skipTypes(result[0].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal}) for i in 1..<n.len: @@ -706,15 +799,20 @@ proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PTyp let xx = semExprWithType(c, x, {efTypeAllowed}, expectedElementType) result.add xx - typ = commonType(c, typ, xx.typ) + if constructType: + typ = commonType(c, typ, xx.typ) #n[i] = semExprWithType(c, x, {}) #result.add fitNode(c, typ, n[i]) inc(lastIndex) - addSonSkipIntLit(result.typ, typ, c.idgen) + if constructType: + addSonSkipIntLit(result.typ, typ, c.idgen) for i in 0..<result.len: result[i] = fitNode(c, typ, result[i], result[i].info) - result.typ[0] = makeRangeType(c, toInt64(firstIndex), toInt64(lastIndex), n.info, - indexType) + if constructType: + result.typ.setIndexType( + makeRangeType(c, + toInt64(firstIndex), toInt64(lastIndex), + n.info, indexType)) proc fixAbstractType(c: PContext, n: PNode) = for i in 1..<n.len: @@ -739,7 +837,7 @@ proc isUnresolvedSym(s: PSym): bool = result = s.kind == skGenericParam if not result and s.typ != nil: result = tfInferrableStatic in s.typ.flags or - (s.kind == skParam and s.typ.isMetaType) or + (s.kind == skParam and (s.typ.isMetaType or sfTemplateParam in s.flags)) or (s.kind == skType and s.typ.flags * {tfGenericTypeParam, tfImplicitTypeParam} != {}) @@ -813,10 +911,13 @@ proc analyseIfAddressTaken(c: PContext, n: PNode, isOutParam: bool): PNode = proc analyseIfAddressTakenInCall(c: PContext, n: PNode, isConverter = false) = checkMinSonsLen(n, 1, c.config) + if n[0].typ == nil: + # n[0] might be erroring node in nimsuggest + return const FakeVarParams = {mNew, mNewFinalize, mInc, ast.mDec, mIncl, mExcl, mSetLengthStr, mSetLengthSeq, mAppendStrCh, mAppendStrStr, mSwap, - mAppendSeqElem, mNewSeq, mReset, mShallowCopy, mDeepCopy, mMove, + mAppendSeqElem, mNewSeq, mShallowCopy, mDeepCopy, mMove, mWasMoved} template checkIfConverterCalled(c: PContext, n: PNode) = @@ -901,7 +1002,7 @@ proc evalAtCompileTime(c: PContext, n: PNode): PNode = if n[i].typ.isNil or n[i].typ.kind != tyStatic or tfUnresolved notin n[i].typ.flags: break maybeLabelAsStatic - n.typ = newTypeWithSons(c, tyStatic, @[n.typ]) + n.typ = newTypeS(tyStatic, c, n.typ) n.typ.flags.incl tfUnresolved # optimization pass: not necessary for correctness of the semantic pass @@ -915,7 +1016,8 @@ proc evalAtCompileTime(c: PContext, n: PNode): PNode = if callee.magic notin ctfeWhitelist: return - if callee.kind notin {skProc, skFunc, skConverter, skConst} or callee.isGenericRoutine: + if callee.kind notin {skProc, skFunc, skConverter, skConst} or + callee.isGenericRoutineStrict: return if n.typ != nil and typeAllowed(n.typ, skConst, c) != nil: return @@ -972,7 +1074,7 @@ proc semOverloadedCallAnalyseEffects(c: PContext, n: PNode, nOrig: PNode, if result != nil: if result[0].kind != nkSym: - if not (efDetermineType in flags and c.inGenericContext > 0): + if not (c.inGenericContext > 0): # see generic context check in semOverloadedCall internalError(c.config, "semOverloadedCallAnalyseEffects") return let callee = result[0].sym @@ -996,13 +1098,33 @@ proc resolveIndirectCall(c: PContext; n, nOrig: PNode; result = initCandidate(c, t) matches(c, n, nOrig, result) -proc bracketedMacro(n: PNode): PSym = - if n.len >= 1 and n[0].kind == nkSym: - result = n[0].sym - if result.kind notin {skMacro, skTemplate}: - result = nil +proc finishOperand(c: PContext, a: PNode): PNode = + if a.typ.isNil: + result = c.semOperand(c, a, {efDetermineType}) else: - result = nil + result = a + # XXX tyGenericInst here? + if result.typ.kind == tyProc and hasUnresolvedParams(result, {efOperand}): + #and tfUnresolved in result.typ.flags: + let owner = result.typ.owner + let err = + # consistent error message with evaltempl/semMacroExpr + if owner != nil and owner.kind in {skTemplate, skMacro}: + errMissingGenericParamsForTemplate % a.renderTree + else: + errProcHasNoConcreteType % a.renderTree + localError(c.config, a.info, err) + considerGenSyms(c, result) + +proc semFinishOperands(c: PContext; n: PNode; isBracketExpr = false) = + # this needs to be called to ensure that after overloading resolution every + # argument has been sem'checked + + # skip the first argument for operands of `[]` since it may be an unresolved + # generic proc, which is handled in semMagic + let start = 1 + ord(isBracketExpr) + for i in start..<n.len: + n[i] = finishOperand(c, n[i]) proc afterCallActions(c: PContext; n, orig: PNode, flags: TExprFlags; expectedType: PType = nil): PNode = if efNoSemCheck notin flags and n.typ != nil and n.typ.kind == tyError: @@ -1024,7 +1146,7 @@ proc afterCallActions(c: PContext; n, orig: PNode, flags: TExprFlags; expectedTy of skMacro: result = semMacroExpr(c, result, orig, callee, flags, expectedType) of skTemplate: result = semTemplateExpr(c, result, callee, flags, expectedType) else: - semFinishOperands(c, result) + semFinishOperands(c, result, isBracketExpr = callee.magic in {mArrGet, mArrPut}) activate(c, result) fixAbstractType(c, result) analyseIfAddressTakenInCall(c, result) @@ -1032,10 +1154,11 @@ proc afterCallActions(c: PContext; n, orig: PNode, flags: TExprFlags; expectedTy result = magicsAfterOverloadResolution(c, result, flags, expectedType) when false: if result.typ != nil and - not (result.typ.kind == tySequence and result.typ[0].kind == tyEmpty): + not (result.typ.kind == tySequence and result.elementType.kind == tyEmpty): liftTypeBoundOps(c, result.typ, n.info) #result = patchResolvedTypeBoundOp(c, result) - if c.matchedConcept == nil: + if c.matchedConcept == nil and (c.inTypeofContext == 0 or callee.magic != mNone): + # don't fold calls in concepts and typeof result = evalAtCompileTime(c, result) proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode = @@ -1052,6 +1175,11 @@ proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType result.flags.incl nfExplicitCall for i in 1..<n.len: result.add n[i] return semExpr(c, result, flags, expectedType) + elif n0.typ.kind == tyFromExpr and c.inGenericContext > 0: + # don't make assumptions, entire expression needs to be tyFromExpr + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, result.copyTree) + return else: n[0] = n0 else: @@ -1059,11 +1187,6 @@ proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType let t = n[0].typ if t != nil and t.kind in {tyVar, tyLent}: n[0] = newDeref(n[0]) - elif n[0].kind == nkBracketExpr: - let s = bracketedMacro(n[0]) - if s != nil: - setGenericParams(c, n[0]) - return semDirectOp(c, n, flags, expectedType) elif isSymChoice(n[0]) and nfDotField notin n.flags: # overloaded generic procs e.g. newSeq[int] can end up here return semDirectOp(c, n, flags, expectedType) @@ -1263,7 +1386,7 @@ proc readTypeParameter(c: PContext, typ: PType, discard if typ.kind != tyUserTypeClass: - let ty = if typ.kind == tyCompositeTypeClass: typ[1].skipGenericAlias + let ty = if typ.kind == tyCompositeTypeClass: typ.firstGenericParam.skipGenericAlias else: typ.skipGenericAlias let tbody = ty[0] for s in 0..<tbody.len-1: @@ -1292,7 +1415,7 @@ proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode = onUse(n.info, s) let typ = skipTypes(s.typ, abstractInst-{tyTypeDesc}) case typ.kind - of tyNil, tyChar, tyInt..tyInt64, tyFloat..tyFloat128, + of tyNil, tyChar, tyInt..tyInt64, tyFloat..tyFloat128, tyTuple, tySet, tyUInt..tyUInt64: if s.magic == mNone: result = inlineConst(c, n, s) else: result = newSymNode(s, n.info) @@ -1392,20 +1515,34 @@ proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode = proc tryReadingGenericParam(c: PContext, n: PNode, i: PIdent, t: PType): PNode = case t.kind - of tyTypeParamsHolders: + of tyGenericInst: result = readTypeParameter(c, t, i, n.info) if result == c.graph.emptyNode: - result = n - n.typ = makeTypeFromExpr(c, n.copyTree) + if c.inGenericContext > 0: + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, result.copyTree) + else: + result = nil of tyUserTypeClasses: if t.isResolvedUserTypeClass: result = readTypeParameter(c, t, i, n.info) + elif c.inGenericContext > 0: + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, copyTree(result)) else: - n.typ = makeTypeFromExpr(c, copyTree(n)) - result = n - of tyGenericParam, tyAnything: - n.typ = makeTypeFromExpr(c, copyTree(n)) - result = n + result = nil + of tyGenericBody, tyCompositeTypeClass: + if c.inGenericContext > 0: + result = readTypeParameter(c, t, i, n.info) + if result != nil: + # generic parameter exists, stop here but delay until instantiation + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, copyTree(result)) + else: + result = nil + elif c.inGenericContext > 0 and t.containsUnresolvedType: + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, copyTree(result)) else: result = nil @@ -1433,7 +1570,7 @@ proc tryReadingTypeField(c: PContext, n: PNode, i: PIdent, ty: PType): PNode = n.typ = makeTypeDesc(c, field.typ) result = n of tyGenericInst: - result = tryReadingTypeField(c, n, i, ty.lastSon) + result = tryReadingTypeField(c, n, i, ty.skipModifier) if result == nil: result = tryReadingGenericParam(c, n, i, ty) else: @@ -1493,7 +1630,7 @@ proc builtinFieldAccess(c: PContext; n: PNode; flags: var TExprFlags): PNode = return nil if ty.kind in tyUserTypeClasses and ty.isResolvedUserTypeClass: - ty = ty.lastSon + ty = ty.last ty = skipTypes(ty, {tyGenericInst, tyVar, tyLent, tyPtr, tyRef, tyOwned, tyAlias, tySink, tyStatic}) while tfBorrowDot in ty.flags: ty = ty.skipTypes({tyDistinct, tyGenericInst, tyAlias}) var check: PNode = nil @@ -1569,18 +1706,20 @@ proc buildOverloadedSubscripts(n: PNode, ident: PIdent): PNode = result.add(newIdentNode(ident, n.info)) for s in n: result.add s -proc semDeref(c: PContext, n: PNode): PNode = +proc semDeref(c: PContext, n: PNode, flags: TExprFlags): PNode = checkSonsLen(n, 1, c.config) n[0] = semExprWithType(c, n[0]) let a = getConstExpr(c.module, n[0], c.idgen, c.graph) if a != nil: - if a.kind == nkNilLit: + if a.kind == nkNilLit and efInTypeof notin flags: localError(c.config, n.info, "nil dereference is not allowed") n[0] = a result = n var t = skipTypes(n[0].typ, {tyGenericInst, tyVar, tyLent, tyAlias, tySink, tyOwned}) case t.kind - of tyRef, tyPtr: n.typ = t.lastSon + of tyRef, tyPtr: n.typ = t.elementType + of tyMetaTypes, tyFromExpr: + n.typ = makeTypeFromExpr(c, n.copyTree) else: result = nil #GlobalError(n[0].info, errCircumNeedsPointer) @@ -1603,16 +1742,17 @@ proc maybeInstantiateGeneric(c: PContext, n: PNode, s: PSym): PNode = result = explicitGenericInstantiation(c, n, s) if result == n: n[0] = copyTree(result[0]) - else: - n[0] = result 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 result = nil if n.len == 1: - let x = semDeref(c, n) + let x = semDeref(c, n, flags) if x == nil: return nil + if x.typ.kind == tyFromExpr: + # depends on generic type + return x result = newNodeIT(nkDerefExpr, x.info, x.typ) result.add(x[0]) return @@ -1677,7 +1817,7 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = result = nil else: let s = if n[0].kind == nkSym: n[0].sym - elif n[0].kind in nkSymChoices: n[0][0].sym + elif n[0].kind in nkSymChoices + {nkOpenSym}: n[0][0].sym else: nil if s != nil: case s.kind @@ -1758,6 +1898,8 @@ proc takeImplicitAddr(c: PContext, n: PNode; isLent: bool): PNode = else: localError(c.config, n.info, errExprHasNoAddress) result = newNodeIT(nkHiddenAddr, n.info, if n.typ.kind in {tyVar, tyLent}: n.typ else: makePtrType(c, n.typ)) + if n.typ.kind in {tyVar, tyLent}: + n.typ = n.typ.elementType result.add(n) proc asgnToResultVar(c: PContext, n, le, ri: PNode) {.inline.} = @@ -1884,7 +2026,7 @@ proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode = result = buildOverloadedSubscripts(n[0], getIdent(c.cache, "[]=")) result.add(n[1]) if mode == noOverloadedSubscript: - bracketNotFoundError(c, result) + bracketNotFoundError(c, result, {}) return errorNode(c, n) else: result = semExprNoType(c, result) @@ -1929,16 +2071,16 @@ proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode = if c.p.owner.kind != skMacro and resultTypeIsInferrable(lhs.sym.typ): var rhsTyp = rhs.typ if rhsTyp.kind in tyUserTypeClasses and rhsTyp.isResolvedUserTypeClass: - rhsTyp = rhsTyp.lastSon + rhsTyp = rhsTyp.last if lhs.sym.typ.kind == tyAnything: - rhsTyp = rhsTyp.skipIntLit(c.idgen) + rhsTyp = rhsTyp.skipTypes({tySink}).skipIntLit(c.idgen) if cmpTypes(c, lhs.typ, rhsTyp) in {isGeneric, isEqual}: internalAssert c.config, c.p.resultSym != nil # Make sure the type is valid for the result variable typeAllowedCheck(c, n.info, rhsTyp, skResult) lhs.typ = rhsTyp c.p.resultSym.typ = rhsTyp - c.p.owner.typ[0] = rhsTyp + c.p.owner.typ.setReturnType rhsTyp else: typeMismatch(c.config, n.info, lhs.typ, rhsTyp, rhs) borrowCheck(c, n, lhs, rhs) @@ -2004,12 +2146,12 @@ proc semProcBody(c: PContext, n: PNode; expectedType: PType = nil): PNode = if isEmptyType(result.typ): # we inferred a 'void' return type: c.p.resultSym.typ = errorType(c) - c.p.owner.typ[0] = nil + c.p.owner.typ.setReturnType nil else: localError(c.config, c.p.resultSym.info, errCannotInferReturnType % c.p.owner.name.s) - if isIterator(c.p.owner.typ) and c.p.owner.typ[0] != nil and - c.p.owner.typ[0].kind == tyAnything: + if isIterator(c.p.owner.typ) and c.p.owner.typ.returnType != nil and + c.p.owner.typ.returnType.kind == tyAnything: localError(c.config, c.p.owner.info, errCannotInferReturnType % c.p.owner.name.s) closeScope(c) @@ -2049,12 +2191,10 @@ proc semYield(c: PContext, n: PNode): PNode = if c.p.owner == nil or c.p.owner.kind != skIterator: localError(c.config, n.info, errYieldNotAllowedHere) elif n[0].kind != nkEmpty: - n[0] = semExprWithType(c, n[0]) # check for type compatibility: var iterType = c.p.owner.typ let restype = iterType[0] + n[0] = semExprWithType(c, n[0], {}, restype) # check for type compatibility: if restype != nil: - if restype.kind != tyUntyped: - n[0] = fitNode(c, restype, n[0], n.info) if n[0].typ == nil: internalError(c.config, n.info, "semYield") if resultTypeIsInferrable(restype): @@ -2062,11 +2202,13 @@ proc semYield(c: PContext, n: PNode): PNode = iterType[0] = inferred if c.p.resultSym != nil: c.p.resultSym.typ = inferred + else: + n[0] = fitNode(c, restype, n[0], n.info) semYieldVarResult(c, n, restype) else: localError(c.config, n.info, errCannotReturnExpr) - elif c.p.owner.typ[0] != nil: + elif c.p.owner.typ.returnType != nil: localError(c.config, n.info, errGenerated, "yield statement must yield a value") proc considerQuotedIdentOrDot(c: PContext, n: PNode, origin: PNode = nil): PIdent = @@ -2113,6 +2255,8 @@ proc lookUpForDeclared(c: PContext, n: PNode, onlyCurrentScope: bool): PSym = result = n.sym of nkOpenSymChoice, nkClosedSymChoice: result = n[0].sym + of nkOpenSym: + result = lookUpForDeclared(c, n[0], onlyCurrentScope) else: localError(c.config, n.info, "identifier expected, but got: " & renderTree(n)) result = nil @@ -2173,7 +2317,7 @@ proc semExpandToAst(c: PContext, n: PNode): PNode = let headSymbol = macroCall[0] var cands = 0 var cand: PSym = nil - var o: TOverloadIter + var o: TOverloadIter = default(TOverloadIter) var symx = initOverloadIter(o, c, headSymbol) while symx != nil: if symx.kind in {skTemplate, skMacro} and symx.typ.len == macroCall.len: @@ -2393,14 +2537,14 @@ proc instantiateCreateFlowVarCall(c: PContext; t: PType; let sym = magicsys.getCompilerProc(c.graph, "nimCreateFlowVar") if sym == nil: localError(c.config, info, "system needs: nimCreateFlowVar") - var bindings: TIdTable = initIdTable() + var bindings = initTypeMapping() bindings.idTablePut(sym.ast[genericParamsPos][0].typ, t) result = c.semGenerateInstance(c, sym, bindings, info) # since it's an instantiation, we unmark it as a compilerproc. Otherwise # codegen would fail: if sfCompilerProc in result.flags: result.flags.excl {sfCompilerProc, sfExportc, sfImportc} - result.loc.r = "" + result.loc.snippet = "" proc setMs(n: PNode, s: PSym): PNode = result = n @@ -2423,9 +2567,7 @@ proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags; expectedType: P of mAddr: markUsed(c, n.info, s) checkSonsLen(n, 2, c.config) - result[0] = newSymNode(s, n[0].info) - result[1] = semAddrArg(c, n[1]) - result.typ = makePtrType(c, result[1].typ) + result = semAddr(c, n[1]) of mTypeOf: markUsed(c, n.info, s) result = semTypeOf(c, n) @@ -2552,9 +2694,10 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = # If semCheck is set to false, ``when`` will return the verbatim AST of # the correct branch. Otherwise the AST will be passed through semStmt. result = nil + let flags = if semCheck: {efWantStmt} else: {} template setResult(e: untyped) = - if semCheck: result = semExpr(c, e) # do not open a new scope! + if semCheck: result = semExpr(c, e, flags) # do not open a new scope! else: result = e # Check if the node is "when nimvm" @@ -2566,13 +2709,16 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = var typ = commonTypeBegin if n.len in 1..2 and n[0].kind == nkElifBranch and ( n.len == 1 or n[1].kind == nkElse): - let exprNode = n[0][0] + var exprNode = n[0][0] + if exprNode.kind == nkOpenSym: + exprNode = exprNode[0] if exprNode.kind == nkIdent: whenNimvm = lookUp(c, exprNode).magic == mNimvm elif exprNode.kind == nkSym: whenNimvm = exprNode.sym.magic == mNimvm if whenNimvm: n.flags.incl nfLL + var cannotResolve = false for i in 0..<n.len: var it = n[i] case it.kind @@ -2580,9 +2726,22 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = checkSonsLen(it, 2, c.config) if whenNimvm: if semCheck: - it[1] = semExpr(c, it[1]) + it[1] = semExpr(c, it[1], flags) typ = commonType(c, typ, it[1].typ) result = n # when nimvm is not elimited until codegen + elif c.inGenericContext > 0: + let e = semExprWithType(c, it[0]) + if e.typ.kind == tyFromExpr: + it[0] = makeStaticExpr(c, e) + cannotResolve = true + else: + it[0] = forceBool(c, e) + let val = getConstExpr(c.module, it[0], c.idgen, c.graph) + if val == nil or val.kind != nkIntLit: + cannotResolve = true + elif not cannotResolve and val.intVal != 0 and result == nil: + setResult(it[1]) + return # we're not in nimvm and we already have a result else: let e = forceBool(c, semConstExpr(c, it[0])) if e.kind != nkIntLit: @@ -2594,13 +2753,21 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = return # we're not in nimvm and we already have a result of nkElse, nkElseExpr: checkSonsLen(it, 1, c.config) - if result == nil or whenNimvm: + if cannotResolve: + discard + elif result == nil or whenNimvm: if semCheck: - it[0] = semExpr(c, it[0]) + it[0] = semExpr(c, it[0], flags) typ = commonType(c, typ, it[0].typ) + if typ != nil and typ.kind != tyUntyped: + it[0] = fitNode(c, typ, it[0], it[0].info) if result == nil: result = it[0] else: illFormedAst(n, c.config) + if cannotResolve: + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, result.copyTree) + return if result == nil: result = newNodeI(nkEmpty, n.info) if whenNimvm: @@ -2742,13 +2909,19 @@ proc semTupleFieldsConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType # can check if field name matches expected type here let expectedElemType = if expected != nil: expected[i] else: nil n[i][1] = semExprWithType(c, n[i][1], {}, expectedElemType) + if expectedElemType != nil and + (expectedElemType.kind != tyNil and not hasEmpty(expectedElemType)): + # hasEmpty/nil check is to not break existing code like + # `const foo = [(1, {}), (2, {false})]`, + # `const foo = if true: (0, nil) else: (1, new(int))` + n[i][1] = fitNode(c, expectedElemType, n[i][1], n[i][1].info) if n[i][1].typ.kind == tyTypeDesc: localError(c.config, n[i][1].info, "typedesc not allowed as tuple field.") n[i][1].typ = errorType(c) var f = newSymS(skField, n[i][0], c) - f.typ = skipIntLit(n[i][1].typ, c.idgen) + f.typ = skipIntLit(n[i][1].typ.skipTypes({tySink}), c.idgen) f.position = i rawAddSon(typ, f.typ) typ.n.add newSymNode(f) @@ -2768,7 +2941,13 @@ proc semTuplePositionsConstr(c: PContext, n: PNode, flags: TExprFlags; expectedT for i in 0..<n.len: let expectedElemType = if expected != nil: expected[i] else: nil n[i] = semExprWithType(c, n[i], {}, expectedElemType) - addSonSkipIntLit(typ, n[i].typ, c.idgen) + if expectedElemType != nil and + (expectedElemType.kind != tyNil and not hasEmpty(expectedElemType)): + # hasEmpty/nil check is to not break existing code like + # `const foo = [(1, {}), (2, {false})]`, + # `const foo = if true: (0, nil) else: (1, new(int))` + n[i] = fitNode(c, expectedElemType, n[i], n[i].info) + addSonSkipIntLit(typ, n[i].typ.skipTypes({tySink}), c.idgen) result.typ = typ include semobjconstr @@ -2823,7 +3002,7 @@ proc semExport(c: PContext, n: PNode): PNode = result = newNodeI(nkExportStmt, n.info) for i in 0..<n.len: let a = n[i] - var o: TOverloadIter + var o: TOverloadIter = default(TOverloadIter) var s = initOverloadIter(o, c, a) if s == nil: localError(c.config, a.info, errGenerated, "cannot export: " & renderTree(a)) @@ -2873,19 +3052,42 @@ proc semTupleConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PTyp else: result = tupexp -proc shouldBeBracketExpr(n: PNode): bool = - result = false +proc isExplicitGenericCall(c: PContext, n: PNode): bool = + ## checks if a call node `n` is a routine call with explicit generic params + ## + ## the callee node needs to be either an nkBracketExpr or a call to a + ## symchoice of `[]` in which case it will be transformed into nkBracketExpr + ## + ## the LHS of the bracket expr has to either be a symchoice or resolve to + ## a routine symbol + template checkCallee(n: PNode) = + # check subscript LHS, `n` must be mutable + if isSymChoice(n): + result = true + else: + let s = qualifiedLookUp(c, n, {}) + if s != nil and s.kind in routineKinds: + result = true + n = semSymGenericInstantiation(c, n, s) assert n.kind in nkCallKinds + result = false let a = n[0] - if a.kind in nkCallKinds: + case a.kind + of nkBracketExpr: + checkCallee(a[0]) + of nkCallKinds: let b = a[0] if b.kind in nkSymChoices: - for i in 0..<b.len: - if b[i].kind == nkSym and b[i].sym.magic == mArrGet: - let be = newNodeI(nkBracketExpr, n.info) + let name = b.getPIdent + if name != nil and name.s == "[]": + checkCallee(a[1]) + if result: + # transform callee into normal bracket expr, only on success + let be = newNodeI(nkBracketExpr, a.info) for i in 1..<a.len: be.add(a[i]) n[0] = be - return true + else: + result = false proc asBracketExpr(c: PContext; n: PNode): PNode = proc isGeneric(c: PContext; n: PNode): bool = @@ -2906,6 +3108,18 @@ proc asBracketExpr(c: PContext; n: PNode): PNode = return result return nil +proc isOpenArraySym(x: PNode): bool = + var x = x + while true: + case x.kind + of {nkAddr, nkHiddenAddr}: + x = x[0] + of {nkHiddenStdConv, nkHiddenDeref}: + x = x[1] + else: + break + result = x.kind == nkSym + proc hoistParamsUsedInDefault(c: PContext, call, letSection, defExpr: var PNode) = # This takes care of complicated signatures such as: # proc foo(a: int, b = a) @@ -2923,10 +3137,17 @@ proc hoistParamsUsedInDefault(c: PContext, call, letSection, defExpr: var PNode) # duty is activated by returning a non-nil value. The caller is responsible # for replacing the input to the function with the returned non-nil value. # (which is the hoisted symbol) - if defExpr.kind == nkSym and defExpr.sym.kind == skParam and defExpr.sym.owner == call[0].sym: + if defExpr.kind == nkSym and defExpr.sym.kind == skParam and + (defExpr.sym.owner == call[0].sym or + # symbol was resolved before proc was instantiated: + (sfFromGeneric in call[0].sym.flags and + defExpr.sym.owner == call[0].sym.instantiatedFrom)): let paramPos = defExpr.sym.position + 1 - if call[paramPos].skipAddr.kind != nkSym: + if call[paramPos].skipAddr.kind != nkSym and not ( + skipTypes(call[paramPos].typ, abstractVar).kind in {tyOpenArray, tyVarargs} and + isOpenArraySym(call[paramPos]) + ): let hoistedVarSym = newSym(skLet, getIdent(c.graph.cache, genPrefix), c.idgen, c.p.owner, letSection.info, c.p.owner.options) hoistedVarSym.typ = call[paramPos].typ @@ -2952,8 +3173,8 @@ proc getNilType(c: PContext): PType = result.align = c.config.target.ptrSize.int16 c.nilTypeCache = result -proc enumFieldSymChoice(c: PContext, n: PNode, s: PSym): PNode = - var o: TOverloadIter +proc enumFieldSymChoice(c: PContext, n: PNode, s: PSym; flags: TExprFlags): PNode = + var o: TOverloadIter = default(TOverloadIter) var i = 0 var a = initOverloadIter(o, c, n) while a != nil: @@ -2965,7 +3186,7 @@ proc enumFieldSymChoice(c: PContext, n: PNode, s: PSym): PNode = if i <= 1: if sfGenSym notin s.flags: result = newSymNode(s, info) - markUsed(c, info, s) + markUsed(c, info, s, efInCall notin flags) onUse(info, s) else: result = n @@ -2986,6 +3207,55 @@ proc semPragmaStmt(c: PContext; n: PNode) = else: pragma(c, c.p.owner, n, stmtPragmas, true) +proc resolveIdentToSym(c: PContext, n: PNode, resultNode: var PNode, + flags: TExprFlags, expectedType: PType): PSym = + # result is nil on error or if a node that can't produce a sym is resolved + let ident = considerQuotedIdent(c, n) + var filter = {low(TSymKind)..high(TSymKind)} + if efNoEvaluateGeneric in flags or expectedType != nil: + # `a[...]` where `a` is a module or package is not possible + filter.excl {skModule, skPackage} + let includePureEnum = expectedType != nil and + expectedType.skipTypes(abstractRange-{tyDistinct}).kind == tyEnum + let candidates = lookUpCandidates(c, ident, filter, + includePureEnum = includePureEnum) + if candidates.len == 0: + result = errorUndeclaredIdentifierHint(c, ident, n.info) + elif candidates.len == 1 or {efNoEvaluateGeneric, efInCall} * flags != {}: + # unambiguous, or we don't care about ambiguity + result = candidates[0] + else: + # ambiguous symbols have 1 last chance as a symchoice + var choice = newNodeIT(nkClosedSymChoice, n.info, newTypeS(tyNone, c)) + for cand in candidates: + case cand.kind + of skModule, skPackage: + discard + of skType: + choice.add newSymNodeTypeDesc(cand, c.idgen, n.info) + else: + choice.add newSymNode(cand, n.info) + if choice.len == 0: + # we know candidates.len > 1, we just couldn't put any in a symchoice + errorUseQualifier(c, n.info, candidates) + return nil + resolveSymChoice(c, choice, flags, expectedType) + # choice.len == 1 can be true here but as long as it's a symchoice + # it's still not resolved + if isSymChoice(choice): + result = nil + if efAllowSymChoice in flags: + resultNode = choice + else: + errorUseQualifier(c, n.info, candidates) + else: + if choice.kind == nkSym: + result = choice.sym + else: + # resolution could have generated nkHiddenStdConv etc + resultNode = semExpr(c, choice, flags, expectedType) + result = nil + proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType = nil): PNode = when defined(nimCompilerStacktraceHints): setFrameMsg c.config$n.info & " " & $n.kind @@ -3023,25 +3293,10 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType if nfSem in n.flags: return case n.kind of nkIdent, nkAccQuoted: - var s: PSym = nil - if expectedType != nil and ( - let expected = expectedType.skipTypes(abstractRange-{tyDistinct}); - expected.kind == tyEnum): - let nameId = considerQuotedIdent(c, n).id - for f in expected.n: - if f.kind == nkSym and f.sym.name.id == nameId: - s = f.sym - break + let s = resolveIdentToSym(c, n, result, flags, expectedType) if s == nil: - let checks = if efNoEvaluateGeneric in flags: - {checkUndeclared, checkPureEnumFields} - elif efInCall in flags: - {checkUndeclared, checkModule, checkPureEnumFields} - else: - {checkUndeclared, checkModule, checkAmbiguity, checkPureEnumFields} - s = qualifiedLookUp(c, n, checks) - if s == nil: - return + # resolveIdentToSym either errored or gave a result node + return if c.matchedConcept == nil: semCaptureSym(s, c.p.owner) case s.kind of skProc, skFunc, skMethod, skConverter, skIterator: @@ -3055,23 +3310,35 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType if optOwnedRefs in c.config.globalOptions: result.typ = makeVarType(c, result.typ, tyOwned) of skEnumField: - result = enumFieldSymChoice(c, n, s) + result = enumFieldSymChoice(c, n, s, flags) else: result = semSym(c, n, s, flags) if isSymChoice(result): result = semSymChoice(c, result, flags, expectedType) of nkClosedSymChoice, nkOpenSymChoice: - result = semSymChoice(c, result, flags, expectedType) + result = semSymChoice(c, n, flags, expectedType) of nkSym: + let s = n.sym + if nfDisabledOpenSym in n.flags: + let override = genericsOpenSym in c.features + let res = semOpenSym(c, n, flags, expectedType, + warnDisabled = not override) + if res != nil: + assert override + return res # because of the changed symbol binding, this does not mean that we # don't have to check the symbol for semantics here again! - result = semSym(c, n, n.sym, flags) + result = semSym(c, n, s, flags) + of nkOpenSym: + assert n.len == 1 + let inner = n[0] + result = semOpenSym(c, inner, flags, expectedType) of nkEmpty, nkNone, nkCommentStmt, nkType: discard of nkNilLit: if result.typ == nil: result.typ = getNilType(c) - if expectedType != nil: + if expectedType != nil and expectedType.kind notin {tyUntyped, tyTyped}: var m = newCandidate(c, result.typ) if typeRel(m, expectedType, result.typ) >= isSubtype: result.typ = expectedType @@ -3083,7 +3350,6 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType expected.kind in {tyInt..tyInt64, tyUInt..tyUInt64, tyFloat..tyFloat128}): - result.typ = expected if expected.kind in {tyFloat..tyFloat128}: n.transitionIntToFloatKind(nkFloatLit) changeType(c, result, expectedType, check=true) @@ -3132,7 +3398,7 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType let modifier = n.modifierTypeKindOfNode if modifier != tyNone: var baseType = semExpr(c, n[0]).typ.skipTypes({tyTypeDesc}) - result.typ = c.makeTypeDesc(c.newTypeWithSons(modifier, @[baseType])) + result.typ = c.makeTypeDesc(newTypeS(modifier, c, baseType)) return var typ = semTypeNode(c, n, nil).skipTypes({tyTypeDesc}) result.typ = makeTypeDesc(c, typ) @@ -3154,12 +3420,13 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType of skType: # XXX think about this more (``set`` procs) let ambig = c.isAmbiguous - if not (n[0].kind in {nkClosedSymChoice, nkOpenSymChoice, nkIdent} and ambig) and n.len == 2: + if not (n[0].kind in nkSymChoices + {nkIdent, nkDotExpr} and ambig) and n.len == 2: result = semConv(c, n, flags, expectedType) - elif ambig and n.len == 1: - errorUseQualifier(c, n.info, s) elif n.len == 1: - result = semObjConstr(c, n, flags, expectedType) + if ambig: + errorUseQualifier(c, n.info, s) + else: + result = semObjConstr(c, n, flags, expectedType) elif s.magic == mNone: result = semDirectOp(c, n, flags, expectedType) else: result = semMagic(c, n, s, flags, expectedType) of skProc, skFunc, skMethod, skConverter, skIterator: @@ -3168,11 +3435,7 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType else: #liMessage(n.info, warnUser, renderTree(n)); result = semIndirectOp(c, n, flags, expectedType) - elif (n[0].kind == nkBracketExpr or shouldBeBracketExpr(n)) and - isSymChoice(n[0][0]): - # indirectOp can deal with explicit instantiations; the fixes - # the 'newSeq[T](x)' bug - setGenericParams(c, n[0]) + elif isExplicitGenericCall(c, n): # this modifies `n` if true result = semDirectOp(c, n, flags, expectedType) elif nfDotField in n.flags: result = semDirectOp(c, n, flags, expectedType) @@ -3237,12 +3500,11 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType result = semArrayConstr(c, n, flags, expectedType) of nkObjConstr: result = semObjConstr(c, n, flags, expectedType) of nkLambdaKinds: result = semProcAux(c, n, skProc, lambdaPragmas, flags) - of nkDerefExpr: result = semDeref(c, n) + of nkDerefExpr: result = semDeref(c, n, flags) of nkAddr: result = n checkSonsLen(n, 1, c.config) - result[0] = semAddrArg(c, n[0]) - result.typ = makePtrType(c, result[0].typ) + result = semAddr(c, n[0]) of nkHiddenAddr, nkHiddenDeref: checkSonsLen(n, 1, c.config) n[0] = semExpr(c, n[0], flags, expectedType) diff --git a/compiler/semfields.nim b/compiler/semfields.nim index 5f3172f81..874055cdc 100644 --- a/compiler/semfields.nim +++ b/compiler/semfields.nim @@ -64,10 +64,12 @@ type proc semForObjectFields(c: TFieldsCtx, typ, forLoop, father: PNode) = case typ.kind of nkSym: - var fc: TFieldInstCtx # either 'tup[i]' or 'field' is valid - fc.c = c.c - fc.field = typ.sym - fc.replaceByFieldName = c.m == mFieldPairs + # either 'tup[i]' or 'field' is valid + var fc = TFieldInstCtx( + c: c.c, + field: typ.sym, + replaceByFieldName: c.m == mFieldPairs + ) openScope(c.c) inc c.c.inUnrolledContext let body = instFieldLoopBody(fc, lastSon(forLoop), forLoop) @@ -139,25 +141,24 @@ proc semForFields(c: PContext, n: PNode, m: TMagic): PNode = var loopBody = n[^1] for i in 0..<tupleTypeA.len: openScope(c) - var fc: TFieldInstCtx - fc.tupleType = tupleTypeA - fc.tupleIndex = i - fc.c = c - fc.replaceByFieldName = m == mFieldPairs + var fc = TFieldInstCtx( + tupleType: tupleTypeA, + tupleIndex: i, + c: c, + replaceByFieldName: m == mFieldPairs + ) var body = instFieldLoopBody(fc, loopBody, n) inc c.inUnrolledContext stmts.add(semStmt(c, body, {})) dec c.inUnrolledContext closeScope(c) else: - var fc: TFieldsCtx - fc.m = m - fc.c = c + var fc = TFieldsCtx(m: m, c: c) var t = tupleTypeA while t.kind == tyObject: semForObjectFields(fc, t.n, n, stmts) - if t[0] == nil: break - t = skipTypes(t[0], skipPtrs) + if t.baseClass == nil: break + t = skipTypes(t.baseClass, skipPtrs) c.p.breakInLoop = oldBreakInLoop dec(c.p.nestedLoopCounter) # for TR macros this 'while true: ...; break' loop is pretty bad, so diff --git a/compiler/semfold.nim b/compiler/semfold.nim index faa609584..80144ccc0 100644 --- a/compiler/semfold.nim +++ b/compiler/semfold.nim @@ -122,10 +122,10 @@ proc ordinalValToString*(a: PNode; g: ModuleGraph): string = result = $x proc isFloatRange(t: PType): bool {.inline.} = - result = t.kind == tyRange and t[0].kind in {tyFloat..tyFloat128} + result = t.kind == tyRange and t.elementType.kind in {tyFloat..tyFloat128} proc isIntRange(t: PType): bool {.inline.} = - result = t.kind == tyRange and t[0].kind in { + result = t.kind == tyRange and t.elementType.kind in { tyInt..tyInt64, tyUInt8..tyUInt32} proc pickIntRange(a, b: PType): PType = @@ -307,11 +307,9 @@ proc evalOp(m: TMagic, n, a, b, c: PNode; idgen: IdGenerator; g: ModuleGraph): P of mRepr: # BUGFIX: we cannot eval mRepr here for reasons that I forgot. discard - of mIntToStr, mInt64ToStr: result = newStrNodeT($(getOrdValue(a)), n, g) of mBoolToStr: if getOrdValue(a) == 0: result = newStrNodeT("false", n, g) else: result = newStrNodeT("true", n, g) - of mFloatToStr: result = newStrNodeT($getFloat(a), n, g) of mCStrToStr, mCharToStr: result = newStrNodeT(getStrOrChar(a), n, g) of mStrToStr: result = newStrNodeT(getStrOrChar(a), n, g) @@ -422,14 +420,17 @@ proc foldConv(n, a: PNode; idgen: IdGenerator; g: ModuleGraph; check = false): P result = newIntNodeT(toInt128(getFloat(a)), n, idgen, g) of tyChar, tyUInt..tyUInt64, tyInt..tyInt64: var val = a.getOrdValue - if check: rangeCheck(n, val, g) - result = newIntNodeT(val, n, idgen, g) if dstTyp.kind in {tyUInt..tyUInt64}: + result = newIntNodeT(maskBytes(val, int getSize(g.config, dstTyp)), n, idgen, g) result.transitionIntKind(nkUIntLit) + else: + if check: rangeCheck(n, val, g) + result = newIntNodeT(val, n, idgen, g) else: result = a result.typ = n.typ - if check and result.kind in {nkCharLit..nkUInt64Lit}: + if check and result.kind in {nkCharLit..nkUInt64Lit} and + dstTyp.kind notin {tyUInt..tyUInt64}: rangeCheck(n, getInt(result), g) of tyFloat..tyFloat64: case srcTyp.kind @@ -703,10 +704,7 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode except DivByZeroDefect: localError(g.config, n.info, "division by zero") of nkAddr: - var a = getConstExpr(m, n[0], idgen, g) - if a != nil: - result = n - n[0] = a + result = nil # don't fold paths containing nkAddr of nkBracket, nkCurly: result = copyNode(n) for son in n.items: @@ -752,6 +750,8 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode if leValueConv(n[1], a) and leValueConv(a, n[2]): result = a # a <= x and x <= b result.typ = n.typ + elif n.typ.kind in {tyUInt..tyUInt64}: + discard "don't check uints" else: localError(g.config, n.info, "conversion from $1 to $2 is invalid" % @@ -773,7 +773,8 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode of nkCast: var a = getConstExpr(m, n[1], idgen, g) if a == nil: return - if n.typ != nil and n.typ.kind in NilableTypes: + if n.typ != nil and n.typ.kind in NilableTypes and + not (n.typ.kind == tyProc and a.typ.kind == tyProc): # we allow compile-time 'cast' for pointer types: result = a result.typ = n.typ diff --git a/compiler/semgnrc.nim b/compiler/semgnrc.nim index eebf11c0a..2639aba6c 100644 --- a/compiler/semgnrc.nim +++ b/compiler/semgnrc.nim @@ -56,8 +56,12 @@ template isMixedIn(sym): bool = s.magic == mNone and s.kind in OverloadableSyms) +template canOpenSym(s): bool = + {withinMixin, withinConcept} * flags == {withinMixin} and s.id notin ctx.toBind + proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, ctx: var GenericCtx; flags: TSemGenericFlags, + isAmbiguous: bool, fromDotExpr=false): PNode = result = nil semIdeForTemplateOrGenericCheck(c.config, n, ctx.cursorInBody) @@ -69,6 +73,15 @@ proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, result.transitionSonsKind(nkClosedSymChoice) else: result = symChoice(c, n, s, scOpen) + if canOpenSym(s): + if openSym in c.features: + if result.kind == nkSym: + result = newOpenSym(result) + else: + result.typ = nil + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil case s.kind of skUnknown: # Introduced in this pass! Leave it as an identifier. @@ -92,10 +105,28 @@ proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, if s.typ != nil and s.typ.kind == tyStatic: if s.typ.n != nil: result = s.typ.n + elif c.inGenericContext > 0 and withinConcept notin flags: + # don't leave generic param as identifier node in generic type, + # sigmatch will try to instantiate generic type AST without all params + # fine to give a symbol node a generic type here since + # we are in a generic context and `prepareNode` will be called + result = newSymNodeTypeDesc(s, c.idgen, n.info) + if canOpenSym(result.sym): + if openSym in c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil else: result = n else: result = newSymNodeTypeDesc(s, c.idgen, n.info) + if canOpenSym(result.sym): + if openSym in c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil onUse(n.info, s) of skParam: result = n @@ -103,12 +134,41 @@ proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, of skType: if (s.typ != nil) and (s.typ.flags * {tfGenericTypeParam, tfImplicitTypeParam} == {}): + if isAmbiguous: + # ambiguous types should be symchoices since lookup behaves + # differently for them in regular expressions + maybeDotChoice(c, n, s, fromDotExpr) + return result = newSymNodeTypeDesc(s, c.idgen, n.info) + if canOpenSym(result.sym): + if openSym in c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil + elif c.inGenericContext > 0 and withinConcept notin flags: + # don't leave generic param as identifier node in generic type, + # sigmatch will try to instantiate generic type AST without all params + # fine to give a symbol node a generic type here since + # we are in a generic context and `prepareNode` will be called + result = newSymNodeTypeDesc(s, c.idgen, n.info) + if canOpenSym(result.sym): + if openSym in c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil else: result = n onUse(n.info, s) else: result = newSymNode(s, n.info) + if canOpenSym(result.sym): + if openSym in c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil onUse(n.info, s) proc lookup(c: PContext, n: PNode, flags: TSemGenericFlags, @@ -130,7 +190,7 @@ proc lookup(c: PContext, n: PNode, flags: TSemGenericFlags, elif s.isMixedIn: result = symChoice(c, n, s, scForceOpen) else: - result = semGenericStmtSymbol(c, n, s, ctx, flags) + result = semGenericStmtSymbol(c, n, s, ctx, flags, amb) # else: leave as nkIdent proc newDot(n, b: PNode): PNode = @@ -146,9 +206,11 @@ proc fuzzyLookup(c: PContext, n: PNode, flags: TSemGenericFlags, let luf = if withinMixin notin flags: {checkUndeclared, checkModule} else: {checkModule} + c.isAmbiguous = false var s = qualifiedLookUp(c, n, luf) if s != nil: - result = semGenericStmtSymbol(c, n, s, ctx, flags) + isMacro = s.kind in {skTemplate, skMacro} + result = semGenericStmtSymbol(c, n, s, ctx, flags, c.isAmbiguous) else: n[0] = semGenericStmt(c, n[0], flags, ctx) result = n @@ -162,24 +224,21 @@ proc fuzzyLookup(c: PContext, n: PNode, flags: TSemGenericFlags, isMacro = s.kind in {skTemplate, skMacro} if withinBind in flags or s.id in ctx.toBind: if s.kind == skType: # don't put types in sym choice - result = newDot(result, semGenericStmtSymbol(c, n, s, ctx, flags, fromDotExpr=true)) + var ambig = false + if candidates.len > 1: + let s2 = searchInScopes(c, ident, ambig) + result = newDot(result, semGenericStmtSymbol(c, n, s, ctx, flags, + isAmbiguous = ambig, fromDotExpr = true)) else: result = newDot(result, symChoice(c, n, s, scClosed)) elif s.isMixedIn: result = newDot(result, symChoice(c, n, s, scForceOpen)) else: + var ambig = false if s.kind == skType and candidates.len > 1: - var ambig = false - let s2 = searchInScopes(c, ident, ambig) - if ambig: - # this is a type conversion like a.T where T is ambiguous with - # other types or routines - # in regular code, this never considers a type conversion and - # skips to routine overloading - # so symchoices are used which behave similarly with type symbols - result = newDot(result, symChoice(c, n, s, scForceOpen)) - return - let syms = semGenericStmtSymbol(c, n, s, ctx, flags, fromDotExpr=true) + discard searchInScopes(c, ident, ambig) + let syms = semGenericStmtSymbol(c, n, s, ctx, flags, + isAmbiguous = ambig, fromDotExpr = true) result = newDot(result, syms) proc addTempDecl(c: PContext; n: PNode; kind: TSymKind) = @@ -221,7 +280,7 @@ proc semGenericStmt(c: PContext, n: PNode, #var s = qualifiedLookUp(c, n, luf) #if s != nil: result = semGenericStmtSymbol(c, n, s) # XXX for example: ``result.add`` -- ``add`` needs to be looked up here... - var dummy: bool + var dummy: bool = false result = fuzzyLookup(c, n, flags, ctx, dummy) of nkSym: let a = n.sym @@ -246,7 +305,9 @@ proc semGenericStmt(c: PContext, n: PNode, # check if it is an expression macro: checkMinSonsLen(n, 1, c.config) let fn = n[0] + c.isAmbiguous = false var s = qualifiedLookUp(c, fn, {}) + let ambig = c.isAmbiguous if s == nil and {withinMixin, withinConcept}*flags == {} and fn.kind in {nkIdent, nkAccQuoted} and @@ -299,7 +360,12 @@ proc semGenericStmt(c: PContext, n: PNode, of skType: # bad hack for generics: if (s.typ != nil) and (s.typ.kind != tyGenericParam): - result[0] = newSymNodeTypeDesc(s, c.idgen, fn.info) + if ambig: + # ambiguous types should be symchoices since lookup behaves + # differently for them in regular expressions + result[0] = sc + else: + result[0] = newSymNodeTypeDesc(s, c.idgen, fn.info) onUse(fn.info, s) first = 1 else: @@ -547,7 +613,8 @@ proc semGenericStmt(c: PContext, n: PNode, else: body = getBody(c.graph, s) else: body = n[bodyPos] - n[bodyPos] = semGenericStmtScope(c, body, flags, ctx) + let bodyFlags = if n.kind == nkTemplateDef: flags + {withinMixin} else: flags + n[bodyPos] = semGenericStmtScope(c, body, bodyFlags, ctx) closeScope(c) of nkPragma, nkPragmaExpr: discard of nkExprColonExpr, nkExprEqExpr: @@ -575,16 +642,18 @@ proc semGenericStmt(c: PContext, n: PNode, if withinTypeDesc in flags: dec c.inTypeContext proc semGenericStmt(c: PContext, n: PNode): PNode = - var ctx: GenericCtx - ctx.toMixin = initIntSet() - ctx.toBind = initIntSet() + var ctx = GenericCtx( + toMixin: initIntSet(), + toBind: initIntSet() + ) result = semGenericStmt(c, n, {}, ctx) semIdeForTemplateOrGeneric(c, result, ctx.cursorInBody) proc semConceptBody(c: PContext, n: PNode): PNode = - var ctx: GenericCtx - ctx.toMixin = initIntSet() - ctx.toBind = initIntSet() + var ctx = GenericCtx( + toMixin: initIntSet(), + toBind: initIntSet() + ) result = semGenericStmt(c, n, {withinConcept}, ctx) semIdeForTemplateOrGeneric(c, result, ctx.cursorInBody) diff --git a/compiler/seminst.nim b/compiler/seminst.nim index 085769bdd..1bc6d31a2 100644 --- a/compiler/seminst.nim +++ b/compiler/seminst.nim @@ -34,7 +34,7 @@ proc pushProcCon*(c: PContext; owner: PSym) = const errCannotInstantiateX = "cannot instantiate: '$1'" -iterator instantiateGenericParamList(c: PContext, n: PNode, pt: TIdTable): PSym = +iterator instantiateGenericParamList(c: PContext, n: PNode, pt: TypeMapping): PSym = internalAssert c.config, n.kind == nkGenericParams for a in n.items: internalAssert c.config, a.kind == nkSym @@ -43,7 +43,7 @@ iterator instantiateGenericParamList(c: PContext, n: PNode, pt: TIdTable): PSym let symKind = if q.typ.kind == tyStatic: skConst else: skType var s = newSym(symKind, q.name, c.idgen, getCurrOwner(c), q.info) s.flags.incl {sfUsed, sfFromGeneric} - var t = PType(idTableGet(pt, q.typ)) + var t = idTableGet(pt, q.typ) if t == nil: if tfRetType in q.typ.flags: # keep the generic type and allow the return type to be bound @@ -53,7 +53,16 @@ iterator instantiateGenericParamList(c: PContext, n: PNode, pt: TIdTable): PSym if q.typ.kind != tyCompositeTypeClass: localError(c.config, a.info, errCannotInstantiateX % s.name.s) t = errorType(c) - elif t.kind in {tyGenericParam, tyConcept}: + elif t.kind in {tyGenericParam, tyConcept, tyFromExpr}: + localError(c.config, a.info, errCannotInstantiateX % q.name.s) + t = errorType(c) + elif isUnresolvedStatic(t) and (q.typ.kind == tyStatic or + (q.typ.kind == tyGenericParam and + q.typ.genericParamHasConstraints and + q.typ.genericConstraint.kind == tyStatic)) and + c.inGenericContext == 0 and c.matchedConcept == nil: + # generic/concept type bodies will try to instantiate static values but + # won't actually use them localError(c.config, a.info, errCannotInstantiateX % q.name.s) t = errorType(c) elif t.kind == tyGenericInvocation: @@ -86,7 +95,7 @@ when false: proc `$`(x: PSym): string = result = x.name.s & " " & " id " & $x.id -proc freshGenSyms(c: PContext; n: PNode, owner, orig: PSym, symMap: var TIdTable) = +proc freshGenSyms(c: PContext; n: PNode, owner, orig: PSym, symMap: var SymMapping) = # we need to create a fresh set of gensym'ed symbols: #if n.kind == nkSym and sfGenSym in n.sym.flags: # if n.sym.owner != orig: @@ -94,7 +103,7 @@ proc freshGenSyms(c: PContext; n: PNode, owner, orig: PSym, symMap: var TIdTable if n.kind == nkSym and sfGenSym in n.sym.flags: # and # (n.sym.owner == orig or n.sym.owner.kind in {skPackage}): let s = n.sym - var x = PSym(idTableGet(symMap, s)) + var x = idTableGet(symMap, s) if x != nil: n.sym = x elif s.owner == nil or s.owner.kind == skPackage: @@ -118,7 +127,7 @@ proc instantiateBody(c: PContext, n, params: PNode, result, orig: PSym) = inc c.inGenericInst # add it here, so that recursive generic procs are possible: var b = n[bodyPos] - var symMap: TIdTable = initIdTable() + var symMap = initSymMapping() if params != nil: for i in 1..<params.len: let param = params[i].sym @@ -133,7 +142,7 @@ proc instantiateBody(c: PContext, n, params: PNode, result, orig: PSym) = if result.kind == skMacro: sysTypeFromName(c.graph, n.info, "NimNode") elif not isInlineIterator(result.typ): - result.typ[0] + result.typ.returnType else: nil b = semProcBody(c, b, resultType) @@ -168,12 +177,12 @@ proc instGenericContainer(c: PContext, info: TLineInfo, header: PType, allowMetaTypes = false): PType = internalAssert c.config, header.kind == tyGenericInvocation - var cl: TReplTypeVars = TReplTypeVars(symMap: initIdTable(), - localCache: initIdTable(), typeMap: LayeredIdTable(), + var cl: TReplTypeVars = TReplTypeVars(symMap: initSymMapping(), + localCache: initTypeMapping(), typeMap: LayeredIdTable(), info: info, c: c, allowMetaTypes: allowMetaTypes ) - cl.typeMap.topLayer = initIdTable() + cl.typeMap.topLayer = initTypeMapping() # We must add all generic params in scope, because the generic body # may include tyFromExpr nodes depending on these generic params. @@ -181,8 +190,7 @@ proc instGenericContainer(c: PContext, info: TLineInfo, header: PType, # perhaps the code can be extracted in a shared function. openScope(c) let genericTyp = header.base - for i in 0..<genericTyp.len - 1: - let genParam = genericTyp[i] + for i, genParam in genericBodyParams(genericTyp): var param: PSym template paramSym(kind): untyped = @@ -212,7 +220,7 @@ proc referencesAnotherParam(n: PNode, p: PSym): bool = if referencesAnotherParam(n[i], p): return true return false -proc instantiateProcType(c: PContext, pt: TIdTable, +proc instantiateProcType(c: PContext, pt: TypeMapping, prc: PSym, info: TLineInfo) = # XXX: Instantiates a generic proc signature, while at the same # time adding the instantiated proc params into the current scope. @@ -234,20 +242,26 @@ proc instantiateProcType(c: PContext, pt: TIdTable, var result = instCopyType(cl, prc.typ) let originalParams = result.n result.n = originalParams.shallowCopy - for i in 1..<result.len: + for i, resulti in paramTypes(result): # twrong_field_caching requires these 'resetIdTable' calls: - if i > 1: + if i > FirstParamAt: resetIdTable(cl.symMap) resetIdTable(cl.localCache) # take a note of the original type. If't a free type or static parameter # we'll need to keep it unbound for the `fitNode` operation below... - var typeToFit = result[i] + var typeToFit = resulti - let needsStaticSkipping = result[i].kind == tyFromExpr - result[i] = replaceTypeVarsT(cl, result[i]) + let needsStaticSkipping = resulti.kind == tyFromExpr + let needsTypeDescSkipping = resulti.kind == tyTypeDesc and tfUnresolved in resulti.flags + if resulti.kind == tyFromExpr: + resulti.flags.incl tfNonConstExpr + result[i] = replaceTypeVarsT(cl, resulti) if needsStaticSkipping: result[i] = result[i].skipTypes({tyStatic}) + if needsTypeDescSkipping: + result[i] = result[i].skipTypes({tyTypeDesc}) + typeToFit = result[i] # ...otherwise, we use the instantiated type in `fitNode` if (typeToFit.kind != tyTypeDesc or typeToFit.base.kind != tyNone) and @@ -265,9 +279,10 @@ proc instantiateProcType(c: PContext, pt: TIdTable, # call head symbol, because this leads to infinite recursion. if oldParam.ast != nil: var def = oldParam.ast.copyTree - if def.kind in nkCallKinds: - for i in 1..<def.len: - def[i] = replaceTypeVarsN(cl, def[i], 1) + if def.typ.kind == tyFromExpr: + def.typ.flags.incl tfNonConstExpr + if not isIntLit(def.typ): + def = prepareNode(cl, def) # allow symchoice since node will be fit later # although expectedType should cover it @@ -284,6 +299,8 @@ proc instantiateProcType(c: PContext, pt: TIdTable, # the user calls an explicit instantiation of the proc (this is # the only way the default value might be inserted). param.ast = errorNode(c, def) + # we know the node is empty, we need the actual type for error message + param.ast.typ = def.typ else: param.ast = fitNodePostMatch(c, typeToFit, converted) param.typ = result[i] @@ -295,7 +312,7 @@ proc instantiateProcType(c: PContext, pt: TIdTable, resetIdTable(cl.symMap) resetIdTable(cl.localCache) cl.isReturnType = true - result[0] = replaceTypeVarsT(cl, result[0]) + result.setReturnType replaceTypeVarsT(cl, result.returnType) cl.isReturnType = false result.n[0] = originalParams[0].copyTree if result[0] != nil: @@ -307,6 +324,22 @@ proc instantiateProcType(c: PContext, pt: TIdTable, prc.typ = result popInfoContext(c.config) +proc instantiateOnlyProcType(c: PContext, pt: TypeMapping, prc: PSym, info: TLineInfo): PType = + # instantiates only the type of a given proc symbol + # used by sigmatch for explicit generics + # wouldn't be needed if sigmatch could handle complex cases, + # examples are in texplicitgenerics + # might be buggy, see rest of generateInstance if problems occur + let fakeSym = copySym(prc, c.idgen) + incl(fakeSym.flags, sfFromGeneric) + fakeSym.instantiatedFrom = prc + openScope(c) + for s in instantiateGenericParamList(c, prc.ast[genericParamsPos], pt): + addDecl(c, s) + instantiateProcType(c, pt, fakeSym, info) + closeScope(c) + result = fakeSym.typ + proc fillMixinScope(c: PContext) = var p = c.p while p != nil: @@ -315,8 +348,9 @@ proc fillMixinScope(c: PContext) = addSym(c.currentScope, n.sym) p = p.next -proc getLocalPassC(c: PContext, s: PSym): string = - if s.ast == nil or s.ast.len == 0: return "" +proc getLocalPassC(c: PContext, s: PSym): string = + when defined(nimsuggest): return "" + if s.ast == nil or s.ast.len == 0: return "" result = "" template extractPassc(p: PNode) = if p.kind == nkPragma and p[0][0].ident == c.cache.getIdent"localpassc": @@ -325,8 +359,8 @@ proc getLocalPassC(c: PContext, s: PSym): string = for n in s.ast: for p in n: extractPassc(p) - -proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, + +proc generateInstance(c: PContext, fn: PSym, pt: TypeMapping, info: TLineInfo): PSym = ## Generates a new instance of a generic procedure. ## The `pt` parameter is a type-unsafe mapping table used to link generic @@ -336,7 +370,8 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, # generates an instantiated proc if c.instCounter > 50: globalError(c.config, info, "generic instantiation too nested") - inc(c.instCounter) + inc c.instCounter + defer: dec c.instCounter # careful! we copy the whole AST including the possibly nil body! var n = copyTree(fn.ast) # NOTE: for access of private fields within generics from a different module @@ -354,7 +389,7 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, let passc = getLocalPassC(c, producer) if passc != "": #pass the local compiler options to the consumer module too extccomp.addLocalCompileOption(c.config, passc, toFullPathConsiderDirty(c.config, c.module.info.fileIndex)) - result.owner = c.module + result.owner = c.module else: result.owner = fn result.ast = n @@ -377,16 +412,20 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, # generic[void](), generic[int]() # see ttypeor.nim test. var i = 0 - newSeq(entry.concreteTypes, fn.typ.len+gp.len-1) + newSeq(entry.concreteTypes, fn.typ.paramsLen+gp.len) + # let param instantiation know we are in a concept for unresolved statics: + c.matchedConcept = oldMatchedConcept for s in instantiateGenericParamList(c, gp, pt): addDecl(c, s) entry.concreteTypes[i] = s.typ inc i + c.matchedConcept = nil pushProcCon(c, result) instantiateProcType(c, pt, result, info) - for j in 1..<result.typ.len: - entry.concreteTypes[i] = result.typ[j] + for _, param in paramTypes(result.typ): + entry.concreteTypes[i] = param inc i + #echo "INSTAN ", fn.name.s, " ", typeToString(result.typ), " ", entry.concreteTypes.len if tfTriggersCompileTime in result.typ.flags: incl(result.flags, sfCompileTime) n[genericParamsPos] = c.graph.emptyNode @@ -415,7 +454,9 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, if result.magic notin {mSlice, mTypeOf}: # 'toOpenArray' is special and it is allowed to return 'openArray': paramsTypeCheck(c, result.typ) + #echo "INSTAN ", fn.name.s, " ", typeToString(result.typ), " <-- NEW PROC!", " ", entry.concreteTypes.len else: + #echo "INSTAN ", fn.name.s, " ", typeToString(result.typ), " <-- CACHED! ", typeToString(oldPrc.typ), " ", entry.concreteTypes.len result = oldPrc popProcCon(c) popInfoContext(c.config) @@ -424,7 +465,6 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, popOwner(c) c.currentScope = oldScope discard c.friendModules.pop() - dec(c.instCounter) c.matchedConcept = oldMatchedConcept if result.kind == skMethod: finishMethod(c, result) diff --git a/compiler/semmacrosanity.nim b/compiler/semmacrosanity.nim index 12d7d32e0..727f36470 100644 --- a/compiler/semmacrosanity.nim +++ b/compiler/semmacrosanity.nim @@ -35,12 +35,12 @@ proc ithField(n: PNode, field: var int): PSym = else: discard proc ithField(t: PType, field: var int): PSym = - var base = t[0] + var base = t.baseClass while base != nil: let b = skipTypes(base, skipPtrs) result = ithField(b.n, field) if result != nil: return result - base = b[0] + base = b.baseClass result = ithField(t.n, field) proc annotateType*(n: PNode, t: PType; conf: ConfigRef) = @@ -51,6 +51,7 @@ proc annotateType*(n: PNode, t: PType; conf: ConfigRef) = of nkObjConstr: let x = t.skipTypes(abstractPtrs) n.typ = t + n[0].typ = t for i in 1..<n.len: var j = i-1 let field = x.ithField(j) @@ -63,7 +64,7 @@ proc annotateType*(n: PNode, t: PType; conf: ConfigRef) = if x.kind == tyTuple: n.typ = t for i in 0..<n.len: - if i >= x.len: globalError conf, n.info, "invalid field at index " & $i + if i >= x.kidsLen: globalError conf, n.info, "invalid field at index " & $i else: annotateType(n[i], x[i], conf) elif x.kind == tyProc and x.callConv == ccClosure: n.typ = t @@ -78,11 +79,11 @@ proc annotateType*(n: PNode, t: PType; conf: ConfigRef) = of nkStrKinds: for i in left..right: bracketExpr.add newIntNode(nkCharLit, BiggestInt n[0].strVal[i]) - annotateType(bracketExpr[^1], t[0], conf) + annotateType(bracketExpr[^1], x.elementType, conf) of nkBracket: for i in left..right: bracketExpr.add n[0][i] - annotateType(bracketExpr[^1], t[0], conf) + annotateType(bracketExpr[^1], x.elementType, conf) else: globalError(conf, n.info, "Incorrectly generated tuple constr") n[] = bracketExpr[] diff --git a/compiler/semmagic.nim b/compiler/semmagic.nim index 548b922fe..a12e933e7 100644 --- a/compiler/semmagic.nim +++ b/compiler/semmagic.nim @@ -22,7 +22,7 @@ proc addDefaultFieldForNew(c: PContext, n: PNode): PNode = var t = typ.skipTypes({tyGenericInst, tyAlias, tySink})[0] while true: asgnExpr.sons.add defaultFieldsForTheUninitialized(c, t.n, false) - let base = t[0] + let base = t.baseClass if base == nil: break t = skipTypes(base, skipPtrs) @@ -30,13 +30,15 @@ proc addDefaultFieldForNew(c: PContext, n: PNode): PNode = if asgnExpr.sons.len > 1: result = newTree(nkAsgn, result[1], asgnExpr) -proc semAddrArg(c: PContext; n: PNode): PNode = +proc semAddr(c: PContext; n: PNode): PNode = + result = newNodeI(nkAddr, n.info) let x = semExprWithType(c, n) if x.kind == nkSym: x.sym.flags.incl(sfAddrTaken) if isAssignable(c, x) notin {arLValue, arLocalLValue, arAddressableConst, arLentValue}: localError(c.config, n.info, errExprHasNoAddress) - result = x + result.add x + result.typ = makePtrType(c, x.typ) proc semTypeOf(c: PContext; n: PNode): PNode = var m = BiggestInt 1 # typeOfIter @@ -47,8 +49,12 @@ proc semTypeOf(c: PContext; n: PNode): PNode = else: m = mode.intVal result = newNodeI(nkTypeOfExpr, n.info) + inc c.inTypeofContext + defer: dec c.inTypeofContext # compiles can raise an exception let typExpr = semExprWithType(c, n[1], if m == 1: {efInTypeof} else: {}) result.add typExpr + if typExpr.typ.kind == tyFromExpr: + typExpr.typ.flags.incl tfNonConstExpr result.typ = makeTypeDesc(c, typExpr.typ) type @@ -64,14 +70,23 @@ proc semArrGet(c: PContext; n: PNode; flags: TExprFlags): PNode = if result.isNil: let x = copyTree(n) x[0] = newIdentNode(getIdent(c.cache, "[]"), n.info) - bracketNotFoundError(c, x) + if c.inGenericContext > 0: + for i in 0..<n.len: + let a = n[i] + if a.typ != nil and a.typ.kind in {tyGenericParam, tyFromExpr}: + # expression is compiled early in a generic body + result = semGenericStmt(c, x) + result.typ = makeTypeFromExpr(c, copyTree(result)) + result.typ.flags.incl tfNonConstExpr + return + bracketNotFoundError(c, x, flags) #localError(c.config, n.info, "could not resolve: " & $n) result = errorNode(c, n) proc semArrPut(c: PContext; n: PNode; flags: TExprFlags): PNode = # rewrite `[]=`(a, i, x) back to ``a[i] = x``. let b = newNodeI(nkBracketExpr, n.info) - b.add(n[1].skipAddr) + b.add(n[1].skipHiddenAddr) for i in 2..<n.len-1: b.add(n[i]) result = newNodeI(nkAsgn, n.info, 2) result[0] = b @@ -132,7 +147,7 @@ proc uninstantiate(t: PType): PType = result = case t.kind of tyMagicGenerics: t of tyUserDefinedGenerics: t.base - of tyCompositeTypeClass: uninstantiate t[1] + of tyCompositeTypeClass: uninstantiate t.firstGenericParam else: t proc getTypeDescNode(c: PContext; typ: PType, sym: PSym, info: TLineInfo): PNode = @@ -140,6 +155,14 @@ proc getTypeDescNode(c: PContext; typ: PType, sym: PSym, info: TLineInfo): PNode rawAddSon(resType, typ) result = toNode(resType, info) +proc buildBinaryPredicate(kind: TTypeKind; c: PContext; context: PSym; a, b: sink PType): PType = + result = newType(kind, c.idgen, context) + result.rawAddSon a + result.rawAddSon b + +proc buildNotPredicate(c: PContext; context: PSym; a: sink PType): PType = + result = newType(tyNot, c.idgen, context, a) + proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym): PNode = const skippedTypes = {tyTypeDesc, tyAlias, tySink} let trait = traitCall[0] @@ -149,20 +172,17 @@ proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym) template operand2: PType = traitCall[2].typ.skipTypes({tyTypeDesc}) - template typeWithSonsResult(kind, sons): PNode = - newTypeWithSons(context, kind, sons, c.idgen).toNode(traitCall.info) - if operand.kind == tyGenericParam or (traitCall.len > 2 and operand2.kind == tyGenericParam): return traitCall ## too early to evaluate let s = trait.sym.name.s case s of "or", "|": - return typeWithSonsResult(tyOr, @[operand, operand2]) + return buildBinaryPredicate(tyOr, c, context, operand, operand2).toNode(traitCall.info) of "and": - return typeWithSonsResult(tyAnd, @[operand, operand2]) + return buildBinaryPredicate(tyAnd, c, context, operand, operand2).toNode(traitCall.info) of "not": - return typeWithSonsResult(tyNot, @[operand]) + return buildNotPredicate(c, context, operand).toNode(traitCall.info) of "typeToString": var prefer = preferTypeName if traitCall.len >= 2: @@ -217,8 +237,9 @@ proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym) of "rangeBase": # return the base type of a range type var arg = operand.skipTypes({tyGenericInst}) - assert arg.kind == tyRange - result = getTypeDescNode(c, arg.base, operand.owner, traitCall.info) + if arg.kind == tyRange: + arg = arg.base + result = getTypeDescNode(c, arg, operand.owner, traitCall.info) of "isCyclic": var operand = operand.skipTypes({tyGenericInst}) let isCyclic = canFormAcycle(c.graph, operand) @@ -230,7 +251,7 @@ proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym) proc semTypeTraits(c: PContext, n: PNode): PNode = checkMinSonsLen(n, 2, c.config) let t = n[1].typ - internalAssert c.config, t != nil and t.kind == tyTypeDesc + internalAssert c.config, t != nil and t.skipTypes({tyAlias}).kind == tyTypeDesc if t.len > 0: # This is either a type known to sem or a typedesc # param to a regular proc (again, known at instantiation) @@ -393,7 +414,7 @@ proc semUnown(c: PContext; n: PNode): PNode = for e in elems: result.rawAddSon(e) else: result = t - of tyOwned: result = t[0] + of tyOwned: result = t.elementType of tySequence, tyOpenArray, tyArray, tyVarargs, tyVar, tyLent, tyGenericInst, tyAlias: let b = unownedType(c, t[^1]) @@ -433,7 +454,7 @@ proc turnFinalizerIntoDestructor(c: PContext; orig: PSym; info: TLineInfo): PSym result.info = info result.flags.incl sfFromGeneric result.owner = orig - let origParamType = orig.typ[1] + let origParamType = orig.typ.firstParamType let newParamType = makeVarType(result, origParamType.skipTypes(abstractPtrs), c.idgen) let oldParam = orig.typ.n[1].sym let newParam = newSym(skParam, oldParam.name, c.idgen, result, result.info) @@ -497,7 +518,7 @@ proc semNewFinalize(c: PContext; n: PNode): PNode = localError(c.config, n.info, "finalizer must be a direct reference to a proc") # check if we converted this finalizer into a destructor already: - let t = whereToBindTypeHook(c, fin.typ[1].skipTypes(abstractInst+{tyRef})) + let t = whereToBindTypeHook(c, fin.typ.firstParamType.skipTypes(abstractInst+{tyRef})) if t != nil and getAttachedOp(c.graph, t, attachedDestructor) != nil and getAttachedOp(c.graph, t, attachedDestructor).owner == fin: discard "already turned this one into a finalizer" @@ -506,13 +527,13 @@ proc semNewFinalize(c: PContext; n: PNode): PNode = fin.owner = fin.instantiatedFrom let wrapperSym = newSym(skProc, getIdent(c.graph.cache, fin.name.s & "FinalizerWrapper"), c.idgen, fin.owner, fin.info) let selfSymNode = newSymNode(copySym(fin.ast[paramsPos][1][0].sym, c.idgen)) - selfSymNode.typ = fin.typ[1] + selfSymNode.typ = fin.typ.firstParamType wrapperSym.flags.incl sfUsed let wrapper = c.semExpr(c, newProcNode(nkProcDef, fin.info, body = newTree(nkCall, newSymNode(fin), selfSymNode), params = nkFormalParams.newTree(c.graph.emptyNode, newTree(nkIdentDefs, selfSymNode, newNodeIT(nkType, - fin.ast[paramsPos][1][1].info, fin.typ[1]), c.graph.emptyNode) + fin.ast[paramsPos][1][1].info, fin.typ.firstParamType), c.graph.emptyNode) ), name = newSymNode(wrapperSym), pattern = fin.ast[patternPos], genericParams = fin.ast[genericParamsPos], pragmas = fin.ast[pragmasPos], exceptions = fin.ast[miscPos]), {}) @@ -532,7 +553,7 @@ proc semNewFinalize(c: PContext; n: PNode): PNode = result = addDefaultFieldForNew(c, n) proc semPrivateAccess(c: PContext, n: PNode): PNode = - let t = n[1].typ[0].toObjectFromRefPtrGeneric + let t = n[1].typ.elementType.toObjectFromRefPtrGeneric if t.kind == tyObject: assert t.sym != nil c.currentScope.allowPrivateAccess.add t.sym @@ -556,9 +577,7 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, case n[0].sym.magic of mAddr: checkSonsLen(n, 2, c.config) - result = n - result[1] = semAddrArg(c, n[1]) - result.typ = makePtrType(c, result[1].typ) + result = semAddr(c, n[1]) of mTypeOf: result = semTypeOf(c, n) of mSizeOf: @@ -618,8 +637,7 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, let op = getAttachedOp(c.graph, t, attachedDestructor) if op != nil: result[0] = newSymNode(op) - - if op.typ != nil and op.typ.len == 2 and op.typ[1].kind != tyVar: + if op.typ != nil and op.typ.len == 2 and op.typ.firstParamType.kind != tyVar: if n[1].kind == nkSym and n[1].sym.kind == skParam and n[1].typ.kind == tyVar: result[1] = genDeref(n[1]) @@ -631,6 +649,16 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, let op = getAttachedOp(c.graph, t, attachedTrace) if op != nil: result[0] = newSymNode(op) + of mDup: + result = n + let t = n[1].typ.skipTypes(abstractVar) + let op = getAttachedOp(c.graph, t, attachedDup) + if op != nil: + result[0] = newSymNode(op) + if op.typ.len == 3: + let boolLit = newIntLit(c.graph, n.info, 1) + boolLit.typ = getSysType(c.graph, n.info, tyBool) + result.add boolLit of mWasMoved: result = n let t = n[1].typ.skipTypes(abstractVar) @@ -669,7 +697,8 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, result = semPrivateAccess(c, n) of mArrToSeq: result = n - if result.typ != nil and expectedType != nil and result.typ.kind == tySequence and expectedType.kind == tySequence and result.typ[0].kind == tyEmpty: + if result.typ != nil and expectedType != nil and result.typ.kind == tySequence and + expectedType.kind == tySequence and result.typ.elementType.kind == tyEmpty: result.typ = expectedType # type inference for empty sequence # bug #21377 of mEnsureMove: result = n diff --git a/compiler/semobjconstr.nim b/compiler/semobjconstr.nim index 37c939bcd..048053115 100644 --- a/compiler/semobjconstr.nim +++ b/compiler/semobjconstr.nim @@ -387,10 +387,13 @@ proc semConstructFields(c: PContext, n: PNode, constrCtx: var ObjConstrContext, if e != nil: result.status = initFull elif field.ast != nil: - result.status = initUnknown - result.defaults.add newTree(nkExprColonExpr, n, field.ast) + if efIgnoreDefaults notin flags: + result.status = initUnknown + result.defaults.add newTree(nkExprColonExpr, n, field.ast) + else: + result.status = initNone else: - if efWantNoDefaults notin flags: # cannot compute defaults at the typeRightPass + if {efWantNoDefaults, efIgnoreDefaults} * flags == {}: # cannot compute defaults at the typeRightPass let defaultExpr = defaultNodeField(c, n, constrCtx.checkDefault) if defaultExpr != nil: result.status = initUnknown @@ -405,7 +408,7 @@ proc semConstructFields(c: PContext, n: PNode, constrCtx: var ObjConstrContext, proc semConstructTypeAux(c: PContext, constrCtx: var ObjConstrContext, flags: TExprFlags): tuple[status: InitStatus, defaults: seq[PNode]] = - result.status = initUnknown + result = (initUnknown, @[]) var t = constrCtx.typ while true: let (status, defaults) = semConstructFields(c, t.n, constrCtx, flags) @@ -413,10 +416,10 @@ proc semConstructTypeAux(c: PContext, result.defaults.add defaults if status in {initPartial, initNone, initUnknown}: discard collectMissingFields(c, t.n, constrCtx, result.defaults) - let base = t[0] + let base = t.baseClass if base == nil or base.id == t.id or - base.kind in {tyRef, tyPtr} and base[0].id == t.id: - break + base.kind in {tyRef, tyPtr} and base.elementType.id == t.id: + break t = skipTypes(base, skipPtrs) if t.kind != tyObject: # XXX: This is not supposed to happen, but apparently @@ -439,11 +442,11 @@ proc computeRequiresInit(c: PContext, t: PType): bool = proc defaultConstructionError(c: PContext, t: PType, info: TLineInfo) = var objType = t while objType.kind notin {tyObject, tyDistinct}: - objType = objType.lastSon + objType = objType.last assert objType != nil if objType.kind == tyObject: var constrCtx = initConstrContext(objType, newNodeI(nkObjConstr, info)) - let initResult = semConstructTypeAux(c, constrCtx, {efWantNoDefaults}) + let initResult = semConstructTypeAux(c, constrCtx, {efIgnoreDefaults}) if constrCtx.missingFields.len > 0: localError(c.config, info, "The $1 type doesn't have a default value. The following fields must be initialized: $2." % [typeToString(t), listSymbolNames(constrCtx.missingFields)]) @@ -470,7 +473,7 @@ proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType t = skipTypes(t, {tyGenericInst, tyAlias, tySink, tyOwned}) if t.kind == tyRef: - t = skipTypes(t[0], {tyGenericInst, tyAlias, tySink, tyOwned}) + t = skipTypes(t.elementType, {tyGenericInst, tyAlias, tySink, tyOwned}) if optOwnedRefs in c.config.globalOptions: result.typ = makeVarType(c, result.typ, tyOwned) # we have to watch out, there are also 'owned proc' types that can be used @@ -478,7 +481,7 @@ proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType result.typ.flags.incl tfHasOwned if t.kind != tyObject: return localErrorNode(c, result, if t.kind != tyGenericBody: - "object constructor needs an object type".dup(addDeclaredLoc(c.config, t)) + "object constructor needs an object type".dup(addTypeNodeDeclaredLoc(c.config, t)) else: "cannot instantiate: '" & typeToString(t, preferDesc) & "'; the object's generic parameters cannot be inferred and must be explicitly given" diff --git a/compiler/semparallel.nim b/compiler/semparallel.nim index d5fc72760..23a8e6362 100644 --- a/compiler/semparallel.nim +++ b/compiler/semparallel.nim @@ -77,12 +77,12 @@ type graph: ModuleGraph proc initAnalysisCtx(g: ModuleGraph): AnalysisCtx = - result.locals = @[] - result.slices = @[] - result.args = @[] + result = AnalysisCtx(locals: @[], + slices: @[], + args: @[], + graph: g) result.guards.s = @[] result.guards.g = g - result.graph = g proc lookupSlot(c: AnalysisCtx; s: PSym): int = for i in 0..<c.locals.len: @@ -406,7 +406,7 @@ proc transformSlices(g: ModuleGraph; idgen: IdGenerator; n: PNode): PNode = if op.name.s == "[]" and op.fromSystem: result = copyNode(n) var typ = newType(tyOpenArray, idgen, result.typ.owner) - typ.add result.typ[0] + typ.add result.typ.elementType result.typ = typ let opSlice = newSymNode(createMagic(g, idgen, "slice", mSlice)) opSlice.typ = getSysType(g, n.info, tyInt) @@ -441,7 +441,7 @@ proc transformSpawn(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n, barrier: if result.isNil: result = newNodeI(nkStmtList, n.info) result.add n - let t = b[1][0].typ[0] + let t = b[1][0].typ.returnType if spawnResult(t, true) == srByVar: result.add wrapProcForSpawn(g, idgen, owner, m, b.typ, barrier, it[0]) it[^1] = newNodeI(nkEmpty, it.info) @@ -450,7 +450,7 @@ proc transformSpawn(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n, barrier: if result.isNil: result = n of nkAsgn, nkFastAsgn, nkSinkAsgn: let b = n[1] - if getMagic(b) == mSpawn and (let t = b[1][0].typ[0]; + if getMagic(b) == mSpawn and (let t = b[1][0].typ.returnType; spawnResult(t, true) == srByVar): let m = transformSlices(g, idgen, b) return wrapProcForSpawn(g, idgen, owner, m, b.typ, barrier, n[0]) diff --git a/compiler/sempass2.nim b/compiler/sempass2.nim index e010bf179..0a160897f 100644 --- a/compiler/sempass2.nim +++ b/compiler/sempass2.nim @@ -11,9 +11,9 @@ import ast, astalgo, msgs, renderer, magicsys, types, idents, trees, wordrecg, options, guards, lineinfos, semfold, semdata, modulegraphs, varpartitions, typeallowed, nilcheck, errorhandling, - semstrictfuncs + semstrictfuncs, suggestsymdb, pushpoppragmas -import std/[tables, intsets, strutils] +import std/[tables, intsets, strutils, sequtils] when defined(nimPreviewSlimSystem): import std/assertions @@ -24,9 +24,6 @@ when defined(useDfa): import liftdestructors include sinkparameter_inference - -import std/options as opt - #[ Second semantic checking pass over the AST. Necessary because the old way had some inherent problems. Performs: @@ -69,8 +66,12 @@ discard """ """ type + CaughtExceptionsStack = object + nodes: seq[seq[PType]] TEffects = object exc: PNode # stack of exceptions + when defined(nimsuggest): + caughtExceptions: CaughtExceptionsStack tags: PNode # list of tags forbids: PNode # list of tags bottom, inTryStmt, inExceptOrFinallyStmt, leftPartOfAsgn, inIfStmt, currentBlock: int @@ -84,6 +85,7 @@ type isInnerProc: bool inEnforcedNoSideEffects: bool currOptions: TOptions + optionsStack: seq[(TOptions, TNoteKinds)] config: ConfigRef graph: ModuleGraph c: PContext @@ -94,29 +96,26 @@ const errXCannotBeAssignedTo = "'$1' cannot be assigned to" errLetNeedsInit = "'let' symbol requires an initialization" -proc getObjDepth(t: PType): Option[tuple[depth: int, root: ItemId]] = +proc getObjDepth(t: PType): (int, ItemId) = var x = t - var res: tuple[depth: int, root: ItemId] - res.depth = -1 + result = (-1, default(ItemId)) var stack = newSeq[ItemId]() while x != nil: x = skipTypes(x, skipPtrs) if x.kind != tyObject: - return none(tuple[depth: int, root: ItemId]) + return (-3, default(ItemId)) stack.add x.itemId - x = x[0] - inc(res.depth) - res.root = stack[^2] - result = some(res) + x = x.baseClass + inc(result[0]) + result[1] = stack[^2] proc collectObjectTree(graph: ModuleGraph, n: PNode) = for section in n: - if section.kind == nkTypeDef and section[^1].kind in {nkObjectTy, nkRefTy, nkPtrTy}: + if section.kind == nkTypeDef and section[^1].kind in {nkObjectTy, nkRefTy, nkPtrTy} and section[^1].typ != nil: let typ = section[^1].typ.skipTypes(skipPtrs) - if typ.len > 0 and typ[0] != nil: - let depthItem = getObjDepth(typ) - if isSome(depthItem): - let (depthLevel, root) = depthItem.unsafeGet + if typ.kind == tyObject and typ.baseClass != nil: + let (depthLevel, root) = getObjDepth(typ) + if depthLevel != -3: if depthLevel == 1: graph.objectTree[root] = @[] else: @@ -417,7 +416,7 @@ proc throws(tracked, n, orig: PNode) = else: tracked.add n -proc getEbase(g: ModuleGraph; info: TLineInfo): PType = +proc getEbase*(g: ModuleGraph; info: TLineInfo): PType = result = g.sysTypeFromName(info, "Exception") proc excType(g: ModuleGraph; n: PNode): PType = @@ -498,6 +497,18 @@ proc catchesAll(tracked: PEffects) = if tracked.exc.len > 0: setLen(tracked.exc.sons, tracked.bottom) +proc push(s: var CaughtExceptionsStack) = + s.nodes.add(@[]) + +proc pop(s: var CaughtExceptionsStack) = + s.nodes.del(high(s.nodes)) + +proc addCatch(s: var CaughtExceptionsStack, e: PType) = + s.nodes[high(s.nodes)].add(e) + +proc addCatchAll(s: var CaughtExceptionsStack) = + s.nodes[high(s.nodes)].add(nil) + proc track(tracked: PEffects, n: PNode) proc trackTryStmt(tracked: PEffects, n: PNode) = let oldBottom = tracked.bottom @@ -506,12 +517,33 @@ proc trackTryStmt(tracked: PEffects, n: PNode) = let oldState = tracked.init.len var inter: TIntersection = @[] + when defined(nimsuggest): + tracked.caughtExceptions.push + for i in 1..<n.len: + let b = n[i] + if b.kind == nkExceptBranch: + if b.len == 1: + tracked.caughtExceptions.addCatchAll + else: + for j in 0..<b.len - 1: + if b[j].isInfixAs(): + assert(b[j][1].kind == nkType) + tracked.caughtExceptions.addCatch(b[j][1].typ) + else: + assert(b[j].kind == nkType) + tracked.caughtExceptions.addCatch(b[j].typ) + else: + assert b.kind == nkFinally + inc tracked.inTryStmt track(tracked, n[0]) dec tracked.inTryStmt for i in oldState..<tracked.init.len: addToIntersection(inter, tracked.init[i], bsNone) + when defined(nimsuggest): + tracked.caughtExceptions.pop + var branches = 1 var hasFinally = false inc tracked.inExceptOrFinallyStmt @@ -584,9 +616,16 @@ proc trackPragmaStmt(tracked: PEffects, n: PNode) = for i in 0..<n.len: var it = n[i] let pragma = whichPragma(it) - if pragma == wEffects: + case pragma + of wEffects: # list the computed effects up to here: listEffects(tracked) + of wPush: + processPushBackendOption(tracked.c.config, tracked.optionsStack, tracked.currOptions, n, i+1) + of wPop: + processPopBackendOption(tracked.c.config, tracked.optionsStack, tracked.currOptions) + else: + discard template notGcSafe(t): untyped = {tfGcSafe, tfNoSideEffect} * t.flags == {} @@ -625,7 +664,7 @@ proc notNilCheck(tracked: PEffects, n: PNode, paramType: PType) = if paramType != nil and tfNotNil in paramType.flags and n.typ != nil: let ntyp = n.typ.skipTypesOrNil({tyVar, tyLent, tySink}) if ntyp != nil and tfNotNil notin ntyp.flags: - if isAddrNode(n): + if n.kind in {nkAddr, nkHiddenAddr}: # addr(x[]) can't be proven, but addr(x) can: if not containsNode(n, {nkDerefExpr, nkHiddenDeref}): return elif (n.kind == nkSym and n.sym.kind in routineKinds) or @@ -666,7 +705,7 @@ proc isTrival(caller: PNode): bool {.inline.} = proc trackOperandForIndirectCall(tracked: PEffects, n: PNode, formals: PType; argIndex: int; caller: PNode) = let a = skipConvCastAndClosure(n) let op = a.typ - let param = if formals != nil and argIndex < formals.len and formals.n != nil: formals.n[argIndex].sym else: nil + let param = if formals != nil and formals.n != nil and argIndex < formals.n.len: formals.n[argIndex].sym else: nil # assume indirect calls are taken here: if op != nil and op.kind == tyProc and n.skipConv.kind != nkNilLit and not isTrival(caller) and @@ -701,7 +740,7 @@ proc trackOperandForIndirectCall(tracked: PEffects, n: PNode, formals: PType; ar markGcUnsafe(tracked, a) elif tfNoSideEffect notin op.flags: markSideEffect(tracked, a, n.info) - let paramType = if formals != nil and argIndex < formals.len: formals[argIndex] else: nil + let paramType = if formals != nil and argIndex < formals.signatureLen: formals[argIndex] else: nil if paramType != nil and paramType.kind in {tyVar}: invalidateFacts(tracked.guards, n) if n.kind == nkSym and isLocalSym(tracked, n.sym): @@ -757,7 +796,7 @@ proc addIdToIntersection(tracked: PEffects, inter: var TIntersection, resCounter template hasResultSym(s: PSym): bool = s != nil and s.kind in {skProc, skFunc, skConverter, skMethod} and - not isEmptyType(s.typ[0]) + not isEmptyType(s.typ.returnType) proc trackCase(tracked: PEffects, n: PNode) = track(tracked, n[0]) @@ -923,6 +962,19 @@ proc checkForSink(tracked: PEffects; n: PNode) = if tracked.inIfStmt == 0 and optSinkInference in tracked.config.options: checkForSink(tracked.config, tracked.c.idgen, tracked.owner, n) +proc markCaughtExceptions(tracked: PEffects; g: ModuleGraph; info: TLineInfo; s: PSym; usageSym: var PSym) = + when defined(nimsuggest): + proc internalMarkCaughtExceptions(tracked: PEffects; q: var SuggestFileSymbolDatabase; info: TLineInfo) = + var si = q.findSymInfoIndex(info) + if si != -1: + q.caughtExceptionsSet[si] = true + for w1 in tracked.caughtExceptions.nodes: + for w2 in w1: + q.caughtExceptions[si].add(w2) + + if optIdeExceptionInlayHints in tracked.config.globalOptions: + internalMarkCaughtExceptions(tracked, g.suggestSymbols.mgetOrPut(info.fileIndex, newSuggestFileSymbolDatabase(info.fileIndex, true)), info) + proc trackCall(tracked: PEffects; n: PNode) = template gcsafeAndSideeffectCheck() = if notGcSafe(op) and not importedFromC(a): @@ -943,6 +995,13 @@ proc trackCall(tracked: PEffects; n: PNode) = if tracked.owner.kind != skMacro and n.typ.skipTypes(abstractVar).kind != tyOpenArray: createTypeBoundOps(tracked, n.typ, n.info) + when defined(nimsuggest): + var actualLoc = a.info + if n.kind == nkHiddenCallConv: + actualLoc = n.info + if a.kind == nkSym: + markCaughtExceptions(tracked, tracked.graph, actualLoc, a.sym, tracked.graph.usageSym) + let notConstExpr = getConstExpr(tracked.ownerModule, n, tracked.c.idgen, tracked.graph) == nil if notConstExpr: if a.kind == nkCast and a[1].typ.kind == tyProc: @@ -985,7 +1044,7 @@ proc trackCall(tracked: PEffects; n: PNode) = # may not look like an assignment, but it is: let arg = n[1] initVarViaNew(tracked, arg) - if arg.typ.len != 0 and {tfRequiresInit} * arg.typ.lastSon.flags != {}: + if arg.typ.hasElementType and {tfRequiresInit} * arg.typ.elementType.flags != {}: if a.sym.magic == mNewSeq and n[2].kind in {nkCharLit..nkUInt64Lit} and n[2].intVal == 0: # var s: seq[notnil]; newSeq(s, 0) is a special case! @@ -994,8 +1053,8 @@ proc trackCall(tracked: PEffects; n: PNode) = message(tracked.config, arg.info, warnProveInit, $arg) # check required for 'nim check': - if n[1].typ.len > 0: - createTypeBoundOps(tracked, n[1].typ.lastSon, n.info) + if n[1].typ.hasElementType: + createTypeBoundOps(tracked, n[1].typ.elementType, n.info) createTypeBoundOps(tracked, n[1].typ, n.info) # new(x, finalizer): Problem: how to move finalizer into 'createTypeBoundOps'? @@ -1018,11 +1077,11 @@ proc trackCall(tracked: PEffects; n: PNode) = n[0].sym = op if op != nil and op.kind == tyProc: - for i in 1..<min(n.safeLen, op.len): + for i in 1..<min(n.safeLen, op.signatureLen): let paramType = op[i] case paramType.kind of tySink: - createTypeBoundOps(tracked, paramType[0], n.info) + createTypeBoundOps(tracked, paramType.elementType, n.info) checkForSink(tracked, n[i]) of tyVar: if isOutParam(paramType): @@ -1151,9 +1210,10 @@ proc track(tracked: PEffects, n: PNode) = if n.sym.typ != nil and tfHasAsgn in n.sym.typ.flags: tracked.owner.flags.incl sfInjectDestructors # bug #15038: ensure consistency - if not hasDestructor(n.typ) and sameType(n.typ, n.sym.typ): n.typ = n.sym.typ + if n.typ == nil or (not hasDestructor(n.typ) and sameType(n.typ, n.sym.typ)): n.typ = n.sym.typ of nkHiddenAddr, nkAddr: - if n[0].kind == nkSym and isLocalSym(tracked, n[0].sym): + if n[0].kind == nkSym and isLocalSym(tracked, n[0].sym) and + n.typ.kind notin {tyVar, tyLent}: useVarNoInitCheck(tracked, n[0], n[0].sym) else: track(tracked, n[0]) @@ -1174,7 +1234,10 @@ proc track(tracked: PEffects, n: PNode) = trackCall(tracked, n) of nkDotExpr: guardDotAccess(tracked, n) + let oldLeftPartOfAsgn = tracked.leftPartOfAsgn + tracked.leftPartOfAsgn = 0 for i in 0..<n.len: track(tracked, n[i]) + tracked.leftPartOfAsgn = oldLeftPartOfAsgn of nkCheckedFieldExpr: track(tracked, n[0]) if tracked.config.hasWarn(warnProveField) or strictCaseObjects in tracked.c.features: @@ -1322,7 +1385,7 @@ proc track(tracked: PEffects, n: PNode) = if tracked.owner.kind != skMacro: # XXX n.typ can be nil in runnableExamples, we need to do something about it. if n.typ != nil and n.typ.skipTypes(abstractInst).kind == tyRef: - createTypeBoundOps(tracked, n.typ.lastSon, n.info) + createTypeBoundOps(tracked, n.typ.elementType, n.info) createTypeBoundOps(tracked, n.typ, n.info) of nkTupleConstr: for i in 0..<n.len: @@ -1427,7 +1490,7 @@ proc track(tracked: PEffects, n: PNode) = proc subtypeRelation(g: ModuleGraph; spec, real: PNode): bool = if spec.typ.kind == tyOr: result = false - for t in spec.typ: + for t in spec.typ.kids: if safeInheritanceDiff(g.excType(real), t) <= 0: return true else: @@ -1539,7 +1602,7 @@ proc initEffects(g: ModuleGraph; effects: PNode; s: PSym; c: PContext): TEffects result = TEffects(exc: effects[exceptionEffects], tags: effects[tagEffects], forbids: effects[forbiddenEffects], owner: s, ownerModule: s.getModule, init: @[], locked: @[], graph: g, config: g.config, c: c, - currentBlock: 1 + currentBlock: 1, optionsStack: @[(g.config.options, g.config.notes)] ) result.guards.s = @[] result.guards.g = g @@ -1571,7 +1634,7 @@ proc trackProc*(c: PContext; s: PSym, body: PNode) = var t: TEffects = initEffects(g, inferredEffects, s, c) rawInitEffects g, effects - if not isEmptyType(s.typ[0]) and + if not isEmptyType(s.typ.returnType) and s.kind in {skProc, skFunc, skConverter, skMethod}: var res = s.ast[resultPos].sym # get result symbol t.scopes[res.id] = t.currentBlock @@ -1590,13 +1653,13 @@ proc trackProc*(c: PContext; s: PSym, body: PNode) = if isOutParam(typ) and param.id notin t.init: message(g.config, param.info, warnProveInit, param.name.s) - if not isEmptyType(s.typ[0]) and - (s.typ[0].requiresInit or s.typ[0].skipTypes(abstractInst).kind == tyVar or + if not isEmptyType(s.typ.returnType) and + (s.typ.returnType.requiresInit or s.typ.returnType.skipTypes(abstractInst).kind == tyVar or strictDefs in c.features) and s.kind in {skProc, skFunc, skConverter, skMethod} and s.magic == mNone: var res = s.ast[resultPos].sym # get result symbol if res.id notin t.init and breaksBlock(body) != bsNoReturn: - if tfRequiresInit in s.typ[0].flags: + if tfRequiresInit in s.typ.returnType.flags: localError(g.config, body.info, "'$1' requires explicit initialization" % "result") else: message(g.config, body.info, warnProveInit, "result") @@ -1670,7 +1733,7 @@ proc trackProc*(c: PContext; s: PSym, body: PNode) = dataflowAnalysis(s, body) when false: trackWrites(s, body) - if strictNotNil in c.features and s.kind == skProc: + if strictNotNil in c.features and s.kind in {skProc, skFunc, skMethod, skConverter}: checkNil(s, body, g.config, c.idgen) proc trackStmt*(c: PContext; module: PSym; n: PNode, isTopLevel: bool) = diff --git a/compiler/semstmts.nim b/compiler/semstmts.nim index 70818bb67..f5f8fea0c 100644 --- a/compiler/semstmts.nim +++ b/compiler/semstmts.nim @@ -42,10 +42,10 @@ proc implicitlyDiscardable(n: PNode): bool proc hasEmpty(typ: PType): bool = if typ.kind in {tySequence, tyArray, tySet}: - result = typ.lastSon.kind == tyEmpty + result = typ.elementType.kind == tyEmpty elif typ.kind == tyTuple: result = false - for s in typ: + for s in typ.kids: result = result or hasEmpty(s) else: result = false @@ -132,17 +132,141 @@ proc semExprBranchScope(c: PContext, n: PNode; expectedType: PType = nil): PNode closeScope(c) const - skipForDiscardable = {nkIfStmt, nkIfExpr, nkCaseStmt, nkOfBranch, - nkElse, nkStmtListExpr, nkTryStmt, nkFinally, nkExceptBranch, + skipForDiscardable = {nkStmtList, nkStmtListExpr, + nkOfBranch, nkElse, nkFinally, nkExceptBranch, nkElifBranch, nkElifExpr, nkElseExpr, nkBlockStmt, nkBlockExpr, - nkHiddenStdConv, nkHiddenDeref} + nkHiddenStdConv, nkHiddenSubConv, nkHiddenDeref} proc implicitlyDiscardable(n: PNode): bool = - var n = n - while n.kind in skipForDiscardable: n = n.lastSon - result = n.kind in nkLastBlockStmts or - (isCallExpr(n) and n[0].kind == nkSym and - sfDiscardable in n[0].sym.flags) + # same traversal as endsInNoReturn + template checkBranch(branch) = + if not implicitlyDiscardable(branch): + return false + + var it = n + # skip these beforehand, no special handling needed + while it.kind in skipForDiscardable and it.len > 0: + it = it.lastSon + + case it.kind + of nkIfExpr, nkIfStmt: + for branch in it: + checkBranch: + if branch.len == 2: + branch[1] + elif branch.len == 1: + branch[0] + else: + raiseAssert "Malformed `if` statement during implicitlyDiscardable" + # all branches are discardable + result = true + of nkCaseStmt: + for i in 1 ..< it.len: + let branch = it[i] + checkBranch: + case branch.kind + of nkOfBranch: + branch[^1] + of nkElifBranch: + branch[1] + of nkElse: + branch[0] + else: + raiseAssert "Malformed `case` statement in implicitlyDiscardable" + # all branches are discardable + result = true + of nkTryStmt: + checkBranch(it[0]) + for i in 1 ..< it.len: + let branch = it[i] + if branch.kind != nkFinally: + checkBranch(branch[^1]) + # all branches are discardable + result = true + of nkCallKinds: + result = it[0].kind == nkSym and {sfDiscardable, sfNoReturn} * it[0].sym.flags != {} + of nkLastBlockStmts: + result = true + else: + result = false + +proc endsInNoReturn(n: PNode, returningNode: var PNode; discardableCheck = false): bool = + ## check if expr ends the block like raising or call of noreturn procs do + result = false # assume it does return + + template checkBranch(branch) = + if not endsInNoReturn(branch, returningNode, discardableCheck): + # proved a branch returns + return false + + var it = n + # skip these beforehand, no special handling needed + let skips = if discardableCheck: skipForDiscardable else: skipForDiscardable-{nkBlockExpr, nkBlockStmt} + while it.kind in skips and it.len > 0: + it = it.lastSon + + case it.kind + of nkIfExpr, nkIfStmt: + var hasElse = false + for branch in it: + checkBranch: + if branch.len == 2: + branch[1] + elif branch.len == 1: + hasElse = true + branch[0] + else: + raiseAssert "Malformed `if` statement during endsInNoReturn" + # none of the branches returned + result = hasElse # Only truly a no-return when it's exhaustive + of nkCaseStmt: + let caseTyp = skipTypes(it[0].typ, abstractVar-{tyTypeDesc}) + # semCase should already have checked for exhaustiveness in this case + # effectively the same as having an else + var hasElse = caseTyp.shouldCheckCaseCovered() + + # actual noreturn checks + for i in 1 ..< it.len: + let branch = it[i] + checkBranch: + case branch.kind + of nkOfBranch: + branch[^1] + of nkElifBranch: + branch[1] + of nkElse: + hasElse = true + branch[0] + else: + raiseAssert "Malformed `case` statement in endsInNoReturn" + # Can only guarantee a noreturn if there is an else or it's exhaustive + result = hasElse + of nkTryStmt: + checkBranch(it[0]) + var lastIndex = it.len - 1 + if it[lastIndex].kind == nkFinally: + # if finally is noreturn, then the entire statement is noreturn + if endsInNoReturn(it[lastIndex][^1], returningNode, discardableCheck): + return true + dec lastIndex + for i in 1 .. lastIndex: + let branch = it[i] + checkBranch(branch[^1]) + # none of the branches returned + result = true + of nkLastBlockStmts: + result = true + of nkCallKinds: + result = it[0].kind == nkSym and sfNoReturn in it[0].sym.flags + if not result: + returningNode = it + else: + result = false + returningNode = it + +proc endsInNoReturn(n: PNode): bool = + var dummy: PNode = nil + result = endsInNoReturn(n, dummy) proc fixNilType(c: PContext; n: PNode) = if isAtom(n): @@ -160,15 +284,17 @@ proc discardCheck(c: PContext, result: PNode, flags: TExprFlags) = if implicitlyDiscardable(result): var n = newNodeI(nkDiscardStmt, result.info, 1) n[0] = result + # notes that it doesn't transform nodes into discard statements elif result.typ.kind != tyError and c.config.cmd != cmdInteractive: if result.typ.kind == tyNone: localError(c.config, result.info, "expression has no type: " & renderTree(result, {renderNoComments})) else: + # Ignore noreturn procs since they don't have a type var n = result - while n.kind in skipForDiscardable: - if n.kind == nkTryStmt: n = n[0] - else: n = n.lastSon + if result.endsInNoReturn(n, discardableCheck = true): + return + var s = "expression '" & $n & "' is of type '" & result.typ.typeToString & "' and has to be used (or discarded)" if result.info.line != n.info.line or @@ -334,6 +460,8 @@ proc fitRemoveHiddenConv(c: PContext, typ: PType, n: PNode): PNode = result.typ = typ if not floatRangeCheck(result.floatVal, typ): localError(c.config, n.info, errFloatToString % [$result.floatVal, typeToString(typ)]) + elif r1.kind == nkSym and typ.skipTypes(abstractRange).kind == tyCstring: + discard "keep nkHiddenStdConv for cstring conversions" else: changeType(c, r1, typ, check=true) result = r1 @@ -354,7 +482,7 @@ proc identWithin(n: PNode, s: PIdent): bool = proc semIdentDef(c: PContext, n: PNode, kind: TSymKind, reportToNimsuggest = true): PSym = if isTopLevel(c): - result = semIdentWithPragma(c, kind, n, {sfExported}) + result = semIdentWithPragma(c, kind, n, {sfExported}, fromTopLevel = true) incl(result.flags, sfGlobal) #if kind in {skVar, skLet}: # echo "global variable here ", n.info, " ", result.name.s @@ -451,16 +579,16 @@ proc hasUnresolvedParams(n: PNode; flags: TExprFlags): bool = proc makeDeref(n: PNode): PNode = var t = n.typ if t.kind in tyUserTypeClasses and t.isResolvedUserTypeClass: - t = t.lastSon + t = t.last t = skipTypes(t, {tyGenericInst, tyAlias, tySink, tyOwned}) result = n if t.kind in {tyVar, tyLent}: - result = newNodeIT(nkHiddenDeref, n.info, t[0]) + result = newNodeIT(nkHiddenDeref, n.info, t.elementType) result.add n - t = skipTypes(t[0], {tyGenericInst, tyAlias, tySink, tyOwned}) + t = skipTypes(t.elementType, {tyGenericInst, tyAlias, tySink, tyOwned}) while t.kind in {tyPtr, tyRef}: var a = result - let baseTyp = t.lastSon + let baseTyp = t.elementType result = newNodeIT(nkHiddenDeref, n.info, baseTyp) result.add a t = skipTypes(baseTyp, {tyGenericInst, tyAlias, tySink, tyOwned}) @@ -494,15 +622,15 @@ proc setVarType(c: PContext; v: PSym, typ: PType) = proc isPossibleMacroPragma(c: PContext, it: PNode, key: PNode): bool = # make sure it's not a normal pragma, and calls an identifier # considerQuotedIdent below will fail on non-identifiers - result = whichPragma(it) == wInvalid and key.kind in nkIdentKinds + result = whichPragma(it) == wInvalid and key.kind in nkIdentKinds+{nkDotExpr} if result: # make sure it's not a user pragma - let ident = considerQuotedIdent(c, key) - result = strTableGet(c.userPragmas, ident) == nil + if key.kind != nkDotExpr: + let ident = considerQuotedIdent(c, key) + result = strTableGet(c.userPragmas, ident) == nil if result: # make sure it's not a custom pragma - var amb = false - let sym = searchInScopes(c, ident, amb) + let sym = qualifiedLookUp(c, key, {}) result = sym == nil or sfCustomPragma notin sym.flags proc copyExcept(n: PNode, i: int): PNode = @@ -662,6 +790,24 @@ proc makeVarTupleSection(c: PContext, n, a, def: PNode, typ: PType, symkind: TSy proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = var b: PNode result = copyNode(n) + + # transform var x, y = 12 into var x = 12; var y = 12 + # bug #18104; transformation should be finished before templates expansion + # TODO: move warnings for tuple here + var transformed = copyNode(n) + for i in 0..<n.len: + var a = n[i] + if a.kind == nkIdentDefs and a.len > 3 and a[^1].kind != nkEmpty: + for j in 0..<a.len-2: + var b = newNodeI(nkIdentDefs, a.info) + b.add a[j] + b.add a[^2] + b.add copyTree(a[^1]) + transformed.add b + else: + transformed.add a + let n = transformed + for i in 0..<n.len: var a = n[i] if c.config.cmd == cmdIdeTools: suggestStmt(c, a) @@ -683,6 +829,11 @@ proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = var typFlags: TTypeAllowedFlags = {} var def: PNode = c.graph.emptyNode + if typ != nil and typ.kind == tyRange and + c.graph.config.isDefined("nimPreviewRangeDefault") and + a[^1].kind == nkEmpty: + a[^1] = firstRange(c.config, typ) + if a[^1].kind != nkEmpty: def = semExprWithType(c, a[^1], {efTypeAllowed}, typ) @@ -703,7 +854,7 @@ proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = else: typ = def.typ.skipTypes({tyStatic, tySink}).skipIntLit(c.idgen) if typ.kind in tyUserTypeClasses and typ.isResolvedUserTypeClass: - typ = typ.lastSon + typ = typ.last if hasEmpty(typ): localError(c.config, def.info, errCannotInferTypeOfTheLiteral % typ.kind.toHumanStr) elif typ.kind == tyProc and def.kind == nkSym and isGenericRoutine(def.sym.ast): @@ -834,6 +985,7 @@ proc semConst(c: PContext, n: PNode): PNode = var typFlags: TTypeAllowedFlags = {} # don't evaluate here since the type compatibility check below may add a converter + openScope(c) var def = semExprWithType(c, a[^1], {efTypeAllowed}, typ) if def.kind == nkSym and def.sym.kind in {skTemplate, skMacro}: @@ -860,6 +1012,7 @@ proc semConst(c: PContext, n: PNode): PNode = if c.matchedConcept != nil: typFlags.incl taConcept typeAllowedCheck(c, a.info, typ, skConst, typFlags) + closeScope(c) if a.kind == nkVarTuple: # generate new section from tuple unpacking and embed it into this one @@ -925,7 +1078,10 @@ proc semForVars(c: PContext, n: PNode; flags: TExprFlags): PNode = if iterAfterVarLent.kind != tyTuple or n.len == 3: if n.len == 3: if n[0].kind == nkVarTuple: - if n[0].len-1 != iterAfterVarLent.len: + if iterAfterVarLent.kind != tyTuple: + return localErrorNode(c, n, n[0].info, errTupleUnpackingTupleExpected % + [typeToString(n[1].typ, preferDesc)]) + elif n[0].len-1 != iterAfterVarLent.len: return localErrorNode(c, n, n[0].info, errWrongNumberOfVariables) for i in 0..<n[0].len-1: @@ -1038,12 +1194,12 @@ proc handleStmtMacro(c: PContext; n, selector: PNode; magicType: string; if maType == nil: return let headSymbol = selector[0] - var o: TOverloadIter + var o: TOverloadIter = default(TOverloadIter) var match: PSym = nil var symx = initOverloadIter(o, c, headSymbol) while symx != nil: if symx.kind in {skTemplate, skMacro}: - if symx.typ.len == 2 and symx.typ[1] == maType.typ: + if symx.typ.len == 2 and symx.typ.firstParamType == maType.typ: if match == nil: match = symx else: @@ -1074,8 +1230,8 @@ proc handleCaseStmtMacro(c: PContext; n: PNode; flags: TExprFlags): PNode = toResolve.add newIdentNode(getIdent(c.cache, "case"), n.info) toResolve.add n[0] - var errors: CandidateErrors - var r = resolveOverloads(c, toResolve, toResolve, {skTemplate, skMacro}, {efNoDiagnostics}, + var errors: CandidateErrors = @[] + var r = resolveOverloads(c, toResolve, toResolve, {skTemplate, skMacro}, {efNoUndeclared}, errors, false) if r.state == csMatch: var match = r.calleeSym @@ -1089,8 +1245,6 @@ proc handleCaseStmtMacro(c: PContext; n: PNode; flags: TExprFlags): PNode = of skMacro: result = semMacroExpr(c, toExpand, toExpand, match, flags) of skTemplate: result = semTemplateExpr(c, toExpand, match, flags) else: result = errorNode(c, n[0]) - elif r.state == csNoMatch: - result = errorNode(c, n[0]) else: result = errorNode(c, n[0]) if result.kind == nkEmpty: @@ -1238,7 +1392,7 @@ proc semRaise(c: PContext, n: PNode): PNode = typ = typ.skipTypes({tyAlias, tyGenericInst, tyOwned}) if typ.kind != tyRef: localError(c.config, n.info, errExprCannotBeRaised) - if typ.len > 0 and not isException(typ.lastSon): + if typ.len > 0 and not isException(typ.elementType): localError(c.config, n.info, "raised object of type $1 does not inherit from Exception" % typeToString(typ)) proc addGenericParamListToScope(c: PContext, n: PNode) = @@ -1254,6 +1408,9 @@ proc typeSectionTypeName(c: PContext; n: PNode): PNode = result = n[0] else: result = n + if result.kind == nkPostfix: + if result.len != 2: illFormedAst(n, c.config) + result = result[1] if result.kind != nkSym: illFormedAst(n, c.config) proc typeDefLeftSidePass(c: PContext, typeSection: PNode, i: int) = @@ -1321,9 +1478,15 @@ proc typeDefLeftSidePass(c: PContext, typeSection: PNode, i: int) = elif s.owner == nil: s.owner = getCurrOwner(c) if name.kind == nkPragmaExpr: - typeDef[0][0] = newSymNode(s) + if name[0].kind == nkPostfix: + typeDef[0][0][1] = newSymNode(s) + else: + typeDef[0][0] = newSymNode(s) else: - typeDef[0] = newSymNode(s) + if name.kind == nkPostfix: + typeDef[0][1] = newSymNode(s) + else: + typeDef[0] = newSymNode(s) proc typeSectionLeftSidePass(c: PContext, n: PNode) = # process the symbols on the left side for the whole type section, before @@ -1343,7 +1506,7 @@ proc typeSectionLeftSidePass(c: PContext, n: PNode) = inc i proc checkCovariantParamsUsages(c: PContext; genericType: PType) = - var body = genericType[^1] + var body = genericType.typeBodyImpl proc traverseSubTypes(c: PContext; t: PType): bool = template error(msg) = localError(c.config, genericType.sym.info, msg) @@ -1360,17 +1523,17 @@ proc checkCovariantParamsUsages(c: PContext; genericType: PType) = for field in t.n: subresult traverseSubTypes(c, field.typ) of tyArray: - return traverseSubTypes(c, t[1]) + return traverseSubTypes(c, t.elementType) of tyProc: - for subType in t: + for subType in t.signature: if subType != nil: subresult traverseSubTypes(c, subType) if result: error("non-invariant type param used in a proc type: " & $t) of tySequence: - return traverseSubTypes(c, t[0]) + return traverseSubTypes(c, t.elementType) of tyGenericInvocation: - let targetBody = t[0] + let targetBody = t.genericHead for i in 1..<t.len: let param = t[i] if param.kind == tyGenericParam: @@ -1395,13 +1558,13 @@ proc checkCovariantParamsUsages(c: PContext; genericType: PType) = of tyUserTypeClass, tyUserTypeClassInst: error("non-invariant type parameters are not supported in concepts") of tyTuple: - for fieldType in t: + for fieldType in t.kids: subresult traverseSubTypes(c, fieldType) of tyPtr, tyRef, tyVar, tyLent: - if t.base.kind == tyGenericParam: return true - return traverseSubTypes(c, t.base) + if t.elementType.kind == tyGenericParam: return true + return traverseSubTypes(c, t.elementType) of tyDistinct, tyAlias, tySink, tyOwned: - return traverseSubTypes(c, t.lastSon) + return traverseSubTypes(c, t.skipModifier) of tyGenericInst: internalAssert c.config, false else: @@ -1439,7 +1602,11 @@ proc typeSectionRightSidePass(c: PContext, n: PNode) = # we fill it out later. For magic generics like 'seq', it won't be filled # so we use tyNone instead of nil to not crash for strange conversions # like: mydata.seq - rawAddSon(s.typ, newTypeS(tyNone, c)) + if s.typ.kind in {tyOpenArray, tyVarargs} and s.typ.len == 1: + # XXX investigate why `tySequence` cannot be added here for now. + discard + else: + rawAddSon(s.typ, newTypeS(tyNone, c)) s.ast = a inc c.inGenericContext var body = semTypeNode(c, a[2], s.typ) @@ -1466,7 +1633,7 @@ proc typeSectionRightSidePass(c: PContext, n: PNode) = # possibilities such as instantiating C++ generic types with # garbage collected Nim types. if sfImportc in s.flags: - var body = s.typ.lastSon + var body = s.typ.last if body.kind == tyObject: # erases all declared fields body.n.sons = @[] @@ -1509,11 +1676,11 @@ proc typeSectionRightSidePass(c: PContext, n: PNode) = aa[0].kind == nkObjectTy: # give anonymous object a dummy symbol: var st = s.typ - if st.kind == tyGenericBody: st = st.lastSon + if st.kind == tyGenericBody: st = st.typeBodyImpl internalAssert c.config, st.kind in {tyPtr, tyRef} - internalAssert c.config, st.lastSon.sym == nil + internalAssert c.config, st.last.sym == nil incl st.flags, tfRefsAnonObj - let objTy = st.lastSon + let objTy = st.last # add flags for `ref object` etc to underlying `object` incl(objTy.flags, oldFlags) # {.inheritable, final.} is already disallowed, but @@ -1526,12 +1693,19 @@ proc typeSectionRightSidePass(c: PContext, n: PNode) = let symNode = newSymNode(obj) obj.ast = a.shallowCopy case a[0].kind - of nkSym: obj.ast[0] = symNode - of nkPragmaExpr: - obj.ast[0] = a[0].shallowCopy + of nkSym: obj.ast[0] = symNode + of nkPragmaExpr: + obj.ast[0] = a[0].shallowCopy + if a[0][0].kind == nkPostfix: + obj.ast[0][0] = a[0][0].shallowCopy + obj.ast[0][0][1] = symNode + else: obj.ast[0][0] = symNode - obj.ast[0][1] = a[0][1] - else: assert(false) + obj.ast[0][1] = a[0][1] + of nkPostfix: + obj.ast[0] = a[0].shallowCopy + obj.ast[0][1] = symNode + else: assert(false) obj.ast[1] = a[1] obj.ast[2] = a[2][0] if sfPure in s.flags: @@ -1541,21 +1715,27 @@ proc typeSectionRightSidePass(c: PContext, n: PNode) = for sk in c.skipTypes: discard semTypeNode(c, sk, nil) c.skipTypes = @[] -proc checkForMetaFields(c: PContext; n: PNode) = - proc checkMeta(c: PContext; n: PNode; t: PType) = - if t != nil and t.isMetaType and tfGenericTypeParam notin t.flags: - if t.kind == tyBuiltInTypeClass and t.len == 1 and t[0].kind == tyProc: + +proc checkForMetaFields(c: PContext; n: PNode; hasError: var bool) = + proc checkMeta(c: PContext; n: PNode; t: PType; hasError: var bool; parent: PType) = + if t != nil and (t.isMetaType or t.kind == tyNone) and tfGenericTypeParam notin t.flags: + if t.kind == tyBuiltInTypeClass and t.len == 1 and t.elementType.kind == tyProc: localError(c.config, n.info, ("'$1' is not a concrete type; " & "for a callback without parameters use 'proc()'") % t.typeToString) + elif t.kind == tyNone and parent != nil: + # TODO: openarray has the `tfGenericTypeParam` flag & generics + # TODO: handle special cases (sink etc.) and views + localError(c.config, n.info, errTIsNotAConcreteType % parent.typeToString) else: localError(c.config, n.info, errTIsNotAConcreteType % t.typeToString) + hasError = true if n.isNil: return case n.kind of nkRecList, nkRecCase: - for s in n: checkForMetaFields(c, s) + for s in n: checkForMetaFields(c, s, hasError) of nkOfBranch, nkElse: - checkForMetaFields(c, n.lastSon) + checkForMetaFields(c, n.lastSon, hasError) of nkSym: let t = n.sym.typ case t.kind @@ -1563,9 +1743,9 @@ proc checkForMetaFields(c: PContext; n: PNode) = tyProc, tyGenericInvocation, tyGenericInst, tyAlias, tySink, tyOwned: let start = ord(t.kind in {tyGenericInvocation, tyGenericInst}) for i in start..<t.len: - checkMeta(c, n, t[i]) + checkMeta(c, n, t[i], hasError, t) else: - checkMeta(c, n, t) + checkMeta(c, n, t, hasError, nil) else: internalAssert c.config, false @@ -1600,13 +1780,16 @@ proc typeSectionFinalPass(c: PContext, n: PNode) = assert s.typ != nil assignType(s.typ, t) s.typ.itemId = t.itemId # same id - checkConstructedType(c.config, s.info, s.typ) - if s.typ.kind in {tyObject, tyTuple} and not s.typ.n.isNil: - checkForMetaFields(c, s.typ.n) - - # fix bug #5170, bug #17162, bug #15526: ensure locally scoped types get a unique name: - if s.typ.kind in {tyEnum, tyRef, tyObject} and not isTopLevel(c): - incl(s.flags, sfGenSym) + var hasError = false + let baseType = s.typ.safeSkipTypes(abstractPtrs) + if baseType.kind in {tyObject, tyTuple} and not baseType.n.isNil and + (x.kind in {nkObjectTy, nkTupleTy} or + (x.kind in {nkRefTy, nkPtrTy} and x.len == 1 and + x[0].kind in {nkObjectTy, nkTupleTy}) + ): + checkForMetaFields(c, baseType.n, hasError) + if not hasError: + checkConstructedType(c.config, s.info, s.typ) #instAllTypeBoundOp(c, n.info) @@ -1682,25 +1865,25 @@ proc semBorrow(c: PContext, n: PNode, s: PSym) = # search for the correct alias: var (b, state) = searchForBorrowProc(c, c.currentScope.parent, s) case state - of bsMatch: - # store the alias: - n[bodyPos] = newSymNode(b) - # Carry over the original symbol magic, this is necessary in order to ensure - # the semantic pass is correct - s.magic = b.magic - if b.typ != nil and b.typ.len > 0: - s.typ.n[0] = b.typ.n[0] - s.typ.flags = b.typ.flags - of bsNoDistinct: - localError(c.config, n.info, "borrow proc without distinct type parameter is meaningless") - of bsReturnNotMatch: - localError(c.config, n.info, "borrow from proc return type mismatch: '$1'" % typeToString(b.typ[0])) - of bsGeneric: - localError(c.config, n.info, "borrow with generic parameter is not supported") - of bsNotSupported: - localError(c.config, n.info, "borrow from '$1' is not supported" % $b.name.s) - else: - localError(c.config, n.info, errNoSymbolToBorrowFromFound) + of bsMatch: + # store the alias: + n[bodyPos] = newSymNode(b) + # Carry over the original symbol magic, this is necessary in order to ensure + # the semantic pass is correct + s.magic = b.magic + if b.typ != nil and b.typ.len > 0: + s.typ.n[0] = b.typ.n[0] + s.typ.flags = b.typ.flags + of bsNoDistinct: + localError(c.config, n.info, "borrow proc without distinct type parameter is meaningless") + of bsReturnNotMatch: + localError(c.config, n.info, "borrow from proc return type mismatch: '$1'" % typeToString(b.typ.returnType)) + of bsGeneric: + localError(c.config, n.info, "borrow with generic parameter is not supported") + of bsNotSupported: + localError(c.config, n.info, "borrow from '$1' is not supported" % $b.name.s) + else: + localError(c.config, n.info, errNoSymbolToBorrowFromFound) proc swapResult(n: PNode, sRes: PSym, dNode: PNode) = ## Swap nodes that are (skResult) symbols to d(estination)Node. @@ -1786,7 +1969,7 @@ proc semProcAnnotation(c: PContext, prc: PNode; return result -proc semInferredLambda(c: PContext, pt: TIdTable, n: PNode): PNode = +proc semInferredLambda(c: PContext, pt: TypeMapping, n: PNode): PNode = ## used for resolving 'auto' in lambdas based on their callsite var n = n let original = n[namePos].sym @@ -1801,7 +1984,6 @@ proc semInferredLambda(c: PContext, pt: TIdTable, n: PNode): PNode = n[genericParamsPos] = c.graph.emptyNode # for LL we need to avoid wrong aliasing let params = copyTree n.typ.n - n[paramsPos] = params s.typ = n.typ for i in 1..<params.len: if params[i].typ.kind in {tyTypeDesc, tyGenericParam, @@ -1813,8 +1995,8 @@ proc semInferredLambda(c: PContext, pt: TIdTable, n: PNode): PNode = pushOwner(c, s) addParams(c, params, skProc) pushProcCon(c, s) - addResult(c, n, n.typ[0], skProc) - s.ast[bodyPos] = hloBody(c, semProcBody(c, n[bodyPos], n.typ[0])) + addResult(c, n, n.typ.returnType, skProc) + s.ast[bodyPos] = hloBody(c, semProcBody(c, n[bodyPos], n.typ.returnType)) trackProc(c, s, s.ast[bodyPos]) popProcCon(c) popOwner(c) @@ -1844,8 +2026,8 @@ proc maybeAddResult(c: PContext, s: PSym, n: PNode) = if s.kind == skMacro: let resultType = sysTypeFromName(c.graph, n.info, "NimNode") addResult(c, n, resultType, s.kind) - elif s.typ[0] != nil and not isInlineIterator(s.typ): - addResult(c, n, s.typ[0], s.kind) + elif s.typ.returnType != nil and not isInlineIterator(s.typ): + addResult(c, n, s.typ.returnType, s.kind) proc canonType(c: PContext, t: PType): PType = if t.kind == tySequence: @@ -1864,7 +2046,7 @@ proc prevDestructor(c: PContext; prevOp: PSym; obj: PType; info: TLineInfo) = proc whereToBindTypeHook(c: PContext; t: PType): PType = result = t while true: - if result.kind in {tyGenericBody, tyGenericInst}: result = result.lastSon + if result.kind in {tyGenericBody, tyGenericInst}: result = result.skipModifier elif result.kind == tyGenericInvocation: result = result[0] else: break if result.kind in {tyObject, tyDistinct, tySequence, tyString}: @@ -1873,20 +2055,20 @@ proc whereToBindTypeHook(c: PContext; t: PType): PType = proc bindDupHook(c: PContext; s: PSym; n: PNode; op: TTypeAttachedOp) = let t = s.typ var noError = false - let cond = t.len == 2 and t[0] != nil + let cond = t.len == 2 and t.returnType != nil if cond: - var obj = t[1] + var obj = t.firstParamType while true: incl(obj.flags, tfHasAsgn) - if obj.kind in {tyGenericBody, tyGenericInst}: obj = obj.lastSon - elif obj.kind == tyGenericInvocation: obj = obj[0] + if obj.kind in {tyGenericBody, tyGenericInst}: obj = obj.skipModifier + elif obj.kind == tyGenericInvocation: obj = obj.genericHead else: break - var res = t[0] + var res = t.returnType while true: - if res.kind in {tyGenericBody, tyGenericInst}: res = res.lastSon - elif res.kind == tyGenericInvocation: res = res[0] + if res.kind in {tyGenericBody, tyGenericInst}: res = res.skipModifier + elif res.kind == tyGenericInvocation: res = res.genericHead else: break if obj.kind in {tyObject, tyDistinct, tySequence, tyString} and sameType(obj, res): @@ -1915,21 +2097,27 @@ proc bindTypeHook(c: PContext; s: PSym; n: PNode; op: TTypeAttachedOp; suppressV var noError = false let cond = case op of attachedWasMoved: - t.len == 2 and t[0] == nil and t[1].kind == tyVar + t.len == 2 and t.returnType == nil and t.firstParamType.kind == tyVar of attachedTrace: - t.len == 3 and t[0] == nil and t[1].kind == tyVar and t[2].kind == tyPointer + t.len == 3 and t.returnType == nil and t.firstParamType.kind == tyVar and t[2].kind == tyPointer + of attachedDestructor: + if c.config.selectedGC in {gcArc, gcAtomicArc, gcOrc}: + t.len == 2 and t.returnType == nil + else: + t.len == 2 and t.returnType == nil and t.firstParamType.kind == tyVar else: - t.len >= 2 and t[0] == nil + t.len >= 2 and t.returnType == nil if cond: - var obj = t[1].skipTypes({tyVar}) + var obj = t.firstParamType.skipTypes({tyVar}) while true: incl(obj.flags, tfHasAsgn) - if obj.kind in {tyGenericBody, tyGenericInst}: obj = obj.lastSon - elif obj.kind == tyGenericInvocation: obj = obj[0] + if obj.kind in {tyGenericBody, tyGenericInst}: obj = obj.skipModifier + elif obj.kind == tyGenericInvocation: obj = obj.genericHead else: break if obj.kind in {tyObject, tyDistinct, tySequence, tyString}: - if (not suppressVarDestructorWarning) and op == attachedDestructor and t[1].kind == tyVar: + if (not suppressVarDestructorWarning) and op == attachedDestructor and t.firstParamType.kind == tyVar and + c.config.selectedGC in {gcArc, gcAtomicArc, gcOrc}: message(c.config, n.info, warnDeprecated, "A custom '=destroy' hook which takes a 'var T' parameter is deprecated; it should take a 'T' parameter") obj = canonType(c, obj) let ao = getAttachedOp(c.graph, obj, op) @@ -1949,8 +2137,12 @@ proc bindTypeHook(c: PContext; s: PSym; n: PNode; op: TTypeAttachedOp; suppressV localError(c.config, n.info, errGenerated, "signature for '=trace' must be proc[T: object](x: var T; env: pointer)") of attachedDestructor: - localError(c.config, n.info, errGenerated, - "signature for '=destroy' must be proc[T: object](x: var T) or proc[T: object](x: T)") + if c.config.selectedGC in {gcArc, gcAtomicArc, gcOrc}: + localError(c.config, n.info, errGenerated, + "signature for '=destroy' must be proc[T: object](x: var T) or proc[T: object](x: T)") + else: + localError(c.config, n.info, errGenerated, + "signature for '=destroy' must be proc[T: object](x: var T)") else: localError(c.config, n.info, errGenerated, "signature for '" & s.name.s & "' must be proc[T: object](x: var T)") @@ -1969,14 +2161,14 @@ proc semOverride(c: PContext, s: PSym, n: PNode) = newIdentNode(c.cache.getIdent("raises"), s.info), newNodeI(nkBracket, s.info)) of "deepcopy", "=deepcopy": if s.typ.len == 2 and - s.typ[1].skipTypes(abstractInst).kind in {tyRef, tyPtr} and - sameType(s.typ[1], s.typ[0]): + s.typ.firstParamType.skipTypes(abstractInst).kind in {tyRef, tyPtr} and + sameType(s.typ.firstParamType, s.typ.returnType): # Note: we store the deepCopy in the base of the pointer to mitigate # the problem that pointers are structural types: - var t = s.typ[1].skipTypes(abstractInst).lastSon.skipTypes(abstractInst) + var t = s.typ.firstParamType.skipTypes(abstractInst).elementType.skipTypes(abstractInst) while true: - if t.kind == tyGenericBody: t = t.lastSon - elif t.kind == tyGenericInvocation: t = t[0] + if t.kind == tyGenericBody: t = t.typeBodyImpl + elif t.kind == tyGenericInvocation: t = t.genericHead else: break if t.kind in {tyObject, tyDistinct, tyEnum, tySequence, tyString}: if getAttachedOp(c.graph, t, attachedDeepCopy).isNil: @@ -2004,18 +2196,18 @@ proc semOverride(c: PContext, s: PSym, n: PNode) = if name == "=": message(c.config, n.info, warnDeprecated, "Overriding `=` hook is deprecated; Override `=copy` hook instead") let t = s.typ - if t.len == 3 and t[0] == nil and t[1].kind == tyVar: - var obj = t[1][0] + if t.len == 3 and t.returnType == nil and t.firstParamType.kind == tyVar: + var obj = t.firstParamType.elementType while true: incl(obj.flags, tfHasAsgn) - if obj.kind == tyGenericBody: obj = obj.lastSon - elif obj.kind == tyGenericInvocation: obj = obj[0] + if obj.kind == tyGenericBody: obj = obj.skipModifier + elif obj.kind == tyGenericInvocation: obj = obj.genericHead else: break var objB = t[2] while true: - if objB.kind == tyGenericBody: objB = objB.lastSon + if objB.kind == tyGenericBody: objB = objB.skipModifier elif objB.kind in {tyGenericInvocation, tyGenericInst}: - objB = objB[0] + objB = objB.genericHead else: break if obj.kind in {tyObject, tyDistinct, tySequence, tyString} and sameType(obj, objB): # attach these ops to the canonical tySequence @@ -2082,20 +2274,20 @@ proc semCppMember(c: PContext; s: PSym; n: PNode) = if c.config.backend == backendCpp: if s.typ.len < 2 and not isCtor: localError(c.config, n.info, pragmaName & " must have at least one parameter") - for son in s.typ: + for son in s.typ.signature: if son!=nil and son.isMetaType: localError(c.config, n.info, pragmaName & " unsupported for generic routine") var typ: PType if isCtor: - typ = s.typ[0] + typ = s.typ.returnType if typ == nil or typ.kind != tyObject: localError(c.config, n.info, "constructor must return an object") if sfImportc in typ.sym.flags: localError(c.config, n.info, "constructor in an imported type needs importcpp pragma") else: - typ = s.typ[1] + typ = s.typ.firstParamType if typ.kind == tyPtr and not isCtor: - typ = typ[0] + typ = typ.elementType if typ.kind != tyObject: localError(c.config, n.info, pragmaName & " must be either ptr to object or object type.") if typ.owner.id == s.owner.id and c.module.id == s.owner.id: @@ -2106,7 +2298,7 @@ proc semCppMember(c: PContext; s: PSym; n: PNode) = else: localError(c.config, n.info, pragmaName & " procs are only supported in C++") else: - var typ = s.typ[0] + var typ = s.typ.returnType if typ != nil and typ.kind == tyObject and typ.itemId notin c.graph.initializersPerType: var initializerCall = newTree(nkCall, newSymNode(s)) var isInitializer = n[paramsPos].len > 1 @@ -2132,7 +2324,7 @@ proc semMethodPrototype(c: PContext; s: PSym; n: PNode) = for col in 1..<tt.len: let t = tt[col] if t != nil and t.kind == tyGenericInvocation: - var x = skipTypes(t[0], {tyVar, tyLent, tyPtr, tyRef, tyGenericInst, + var x = skipTypes(t.genericHead, {tyVar, tyLent, tyPtr, tyRef, tyGenericInst, tyGenericInvocation, tyGenericBody, tyAlias, tySink, tyOwned}) if x.kind == tyObject and t.len-1 == n[genericParamsPos].len: @@ -2345,7 +2537,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if sfBorrow in s.flags and c.config.cmd notin cmdDocLike: result[bodyPos] = c.graph.emptyNode - if sfCppMember * s.flags != {}: + if sfCppMember * s.flags != {} and sfWasForwarded notin s.flags: semCppMember(c, s, n) if n[bodyPos].kind != nkEmpty and sfError notin s.flags: @@ -2360,8 +2552,8 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, # absolutely no generics (empty) or a single generic return type are # allowed, everything else, including a nullary generic is an error. pushProcCon(c, s) - addResult(c, n, s.typ[0], skProc) - s.ast[bodyPos] = hloBody(c, semProcBody(c, n[bodyPos], s.typ[0])) + addResult(c, n, s.typ.returnType, skProc) + s.ast[bodyPos] = hloBody(c, semProcBody(c, n[bodyPos], s.typ.returnType)) trackProc(c, s, s.ast[bodyPos]) popProcCon(c) elif efOperand notin flags: @@ -2377,7 +2569,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if s.kind == skMacro: sysTypeFromName(c.graph, n.info, "NimNode") elif not isInlineIterator(s.typ): - s.typ[0] + s.typ.returnType else: nil # semantic checking also needed with importc in case used in VM @@ -2386,7 +2578,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, # context as it may even be evaluated in 'system.compiles': trackProc(c, s, s.ast[bodyPos]) else: - if (s.typ[0] != nil and s.kind != skIterator): + if (s.typ.returnType != nil and s.kind != skIterator): addDecl(c, newSym(skUnknown, getIdent(c.cache, "result"), c.idgen, s, n.info)) openScope(c) @@ -2401,7 +2593,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if hasProto: localError(c.config, n.info, errImplOfXexpected % proto.name.s) if {sfImportc, sfBorrow, sfError} * s.flags == {} and s.magic == mNone: # this is a forward declaration and we're building the prototype - if s.kind in {skProc, skFunc} and s.typ[0] != nil and s.typ[0].kind == tyAnything: + if s.kind in {skProc, skFunc} and s.typ.returnType != nil and s.typ.returnType.kind == tyAnything: localError(c.config, n[paramsPos][0].info, "return type 'auto' cannot be used in forward declarations") incl(s.flags, sfForward) @@ -2446,7 +2638,7 @@ proc semIterator(c: PContext, n: PNode): PNode = if result.kind != n.kind: return var s = result[namePos].sym var t = s.typ - if t[0] == nil and s.typ.callConv != ccClosure: + if t.returnType == nil and s.typ.callConv != ccClosure: localError(c.config, n.info, "iterator needs a return type") # iterators are either 'inline' or 'closure'; for backwards compatibility, # we require first class iterators to be marked with 'closure' explicitly @@ -2483,9 +2675,9 @@ proc semMethod(c: PContext, n: PNode): PNode = # test case): let disp = getDispatcher(s) # auto return type? - if disp != nil and disp.typ[0] != nil and disp.typ[0].kind == tyUntyped: - let ret = s.typ[0] - disp.typ[0] = ret + if disp != nil and disp.typ.returnType != nil and disp.typ.returnType.kind == tyUntyped: + let ret = s.typ.returnType + disp.typ.setReturnType ret if disp.ast[resultPos].kind == nkSym: if isEmptyType(ret): disp.ast[resultPos] = c.graph.emptyNode else: disp.ast[resultPos].sym.typ = ret @@ -2501,7 +2693,7 @@ proc semConverterDef(c: PContext, n: PNode): PNode = if result.kind != nkConverterDef: return var s = result[namePos].sym var t = s.typ - if t[0] == nil: localError(c.config, n.info, errXNeedsReturnType % "converter") + if t.returnType == nil: localError(c.config, n.info, errXNeedsReturnType % "converter") if t.len != 2: localError(c.config, n.info, "a converter takes exactly one argument") addConverterDef(c, LazySym(sym: s)) @@ -2543,20 +2735,23 @@ proc incMod(c: PContext, n: PNode, it: PNode, includeStmtResult: PNode) = proc evalInclude(c: PContext, n: PNode): PNode = result = newNodeI(nkStmtList, n.info) result.add n + template checkAs(it: PNode) = + if it.kind == nkInfix and it.len == 3: + let op = it[0].getPIdent + if op != nil and op.id == ord(wAs): + localError(c.config, it.info, "Cannot use '" & it[0].renderTree & "' in 'include'.") for i in 0..<n.len: - var imp: PNode let it = n[i] - if it.kind == nkInfix and it.len == 3 and it[0].ident.s != "/": - localError(c.config, it.info, "Cannot use '" & it[0].ident.s & "' in 'include'.") - if it.kind == nkInfix and it.len == 3 and it[2].kind == nkBracket: - let sep = it[0] - let dir = it[1] - imp = newNodeI(nkInfix, it.info) - imp.add sep - imp.add dir - imp.add sep # dummy entry, replaced in the loop - for x in it[2]: - imp[2] = x + checkAs(it) + if it.kind in {nkInfix, nkPrefix} and it[^1].kind == nkBracket: + let lastPos = it.len - 1 + var imp = copyNode(it) + newSons(imp, it.len) + for i in 0 ..< lastPos: imp[i] = it[i] + imp[lastPos] = imp[0] # dummy entry, replaced in the loop + for x in it[lastPos]: + checkAs(x) + imp[lastPos] = x incMod(c, n, imp, result) else: incMod(c, n, it, result) @@ -2667,7 +2862,7 @@ proc semStmtList(c: PContext, n: PNode, flags: TExprFlags, expectedType: PType = let verdict = semConstExpr(c, n[i]) if verdict == nil or verdict.kind != nkIntLit or verdict.intVal == 0: localError(c.config, result.info, "concept predicate failed") - of tyUnknown: continue + of tyFromExpr: continue else: discard if n[i].typ == c.enforceVoidContext: #or usesResult(n[i]): voidContext = true diff --git a/compiler/semtempl.nim b/compiler/semtempl.nim index 3256b8d85..817cb6249 100644 --- a/compiler/semtempl.nim +++ b/compiler/semtempl.nim @@ -52,7 +52,7 @@ proc symChoice(c: PContext, n: PNode, s: PSym, r: TSymChoiceRule; isField = false): PNode = var a: PSym - o: TOverloadIter + o: TOverloadIter = default(TOverloadIter) var i = 0 a = initOverloadIter(o, c, n) while a != nil: @@ -218,63 +218,98 @@ proc addLocalDecl(c: var TemplCtx, n: var PNode, k: TSymKind) = if k == skParam and c.inTemplateHeader > 0: local.flags.incl sfTemplateParam -proc semTemplSymbol(c: PContext, n: PNode, s: PSym; isField: bool): PNode = +proc semTemplSymbol(c: var TemplCtx, n: PNode, s: PSym; isField, isAmbiguous: bool): PNode = incl(s.flags, sfUsed) # bug #12885; ideally sem'checking is performed again afterwards marking # the symbol as used properly, but the nfSem mechanism currently prevents # that from happening, so we mark the module as used here already: - markOwnerModuleAsUsed(c, s) + markOwnerModuleAsUsed(c.c, s) # we do not call onUse here, as the identifier is not really # resolved here. We will fixup the used identifiers later. case s.kind of skUnknown: # Introduced in this pass! Leave it as an identifier. result = n - of OverloadableSyms-{skTemplate,skMacro}: - result = symChoice(c, n, s, scOpen, isField) - of skTemplate, skMacro: - result = symChoice(c, n, s, scOpen, isField) - if result.kind == nkSym: - # template/macro symbols might need to be semchecked again - # prepareOperand etc don't do this without setting the type to nil - result.typ = nil + of OverloadableSyms: + result = symChoice(c.c, n, s, scOpen, isField) + if not isField and result.kind in {nkSym, nkOpenSymChoice}: + if openSym in c.c.features: + if result.kind == nkSym: + result = newOpenSym(result) + else: + result.typ = nil + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil of skGenericParam: if isField and sfGenSym in s.flags: result = n - else: result = newSymNodeTypeDesc(s, c.idgen, n.info) + else: + result = newSymNodeTypeDesc(s, c.c.idgen, n.info) + if not isField and s.owner != c.owner: + if openSym in c.c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil of skParam: result = n of skType: if isField and sfGenSym in s.flags: result = n - else: result = newSymNodeTypeDesc(s, c.idgen, n.info) + else: + if isAmbiguous: + # ambiguous types should be symchoices since lookup behaves + # differently for them in regular expressions + result = symChoice(c.c, n, s, scOpen, isField) + else: result = newSymNodeTypeDesc(s, c.c.idgen, n.info) + if not isField and not (s.owner == c.owner and + s.typ != nil and s.typ.kind == tyGenericParam) and + result.kind in {nkSym, nkOpenSymChoice}: + if openSym in c.c.features: + if result.kind == nkSym: + result = newOpenSym(result) + else: + result.typ = nil + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil else: if isField and sfGenSym in s.flags: result = n - else: result = newSymNode(s, n.info) + else: + result = newSymNode(s, n.info) + if not isField: + if openSym in c.c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil # Issue #12832 when defined(nimsuggest): - suggestSym(c.graph, n.info, s, c.graph.usageSym, false) + suggestSym(c.c.graph, n.info, s, c.c.graph.usageSym, false) # field access (dot expr) will be handled by builtinFieldAccess if not isField: - styleCheckUse(c, n.info, s) + styleCheckUse(c.c, n.info, s) -proc semRoutineInTemplName(c: var TemplCtx, n: PNode): PNode = +proc semRoutineInTemplName(c: var TemplCtx, n: PNode, explicitInject: bool): PNode = result = n if n.kind == nkIdent: let s = qualifiedLookUp(c.c, n, {}) if s != nil: - if s.owner == c.owner and (s.kind == skParam or sfGenSym in s.flags): + if s.owner == c.owner and (s.kind == skParam or + (sfGenSym in s.flags and not explicitInject)): incl(s.flags, sfUsed) result = newSymNode(s, n.info) onUse(n.info, s) else: for i in 0..<n.safeLen: - result[i] = semRoutineInTemplName(c, n[i]) + result[i] = semRoutineInTemplName(c, n[i], explicitInject) proc semRoutineInTemplBody(c: var TemplCtx, n: PNode, k: TSymKind): PNode = result = n checkSonsLen(n, bodyPos + 1, c.c.config) if n.kind notin nkLambdaKinds: # routines default to 'inject': - if symBinding(n[pragmasPos]) == spGenSym: + let binding = symBinding(n[pragmasPos]) + if binding == spGenSym: let (ident, hasParam) = getIdentReplaceParams(c, n[namePos]) if not hasParam: var s = newGenSym(k, ident, c) @@ -286,7 +321,7 @@ proc semRoutineInTemplBody(c: var TemplCtx, n: PNode, k: TSymKind): PNode = else: n[namePos] = ident else: - n[namePos] = semRoutineInTemplName(c, n[namePos]) + n[namePos] = semRoutineInTemplName(c, n[namePos], binding == spInject) # open scope for parameters openScope(c) for i in patternPos..paramsPos-1: @@ -343,6 +378,7 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = case n.kind of nkIdent: if n.ident.id in c.toInject: return n + c.c.isAmbiguous = false let s = qualifiedLookUp(c.c, n, {}) if s != nil: if s.owner == c.owner and s.kind == skParam and sfTemplateParam in s.flags: @@ -360,9 +396,9 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = result = newSymNode(s, n.info) onUse(n.info, s) else: - if s.kind in {skType, skVar, skLet, skConst}: + if s.kind in {skVar, skLet, skConst}: discard qualifiedLookUp(c.c, n, {checkAmbiguity, checkModule}) - result = semTemplSymbol(c.c, n, s, c.noGenSym > 0) + result = semTemplSymbol(c, n, s, c.noGenSym > 0, c.c.isAmbiguous) of nkBind: result = semTemplBody(c, n[0]) of nkBindStmt: @@ -507,14 +543,21 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = if x.kind == nkExprColonExpr: x[1] = semTemplBody(c, x[1]) of nkBracketExpr: - result = newNodeI(nkCall, n.info) - result.add newIdentNode(getIdent(c.c.cache, "[]"), n.info) - for i in 0..<n.len: result.add(n[i]) + if n.typ == nil: + # if a[b] is nested inside a typed expression, don't convert it + # back to `[]`(a, b), prepareOperand will not typecheck it again + # and so `[]` will not be resolved + # checking if a[b] is typed should be enough to cover this case + result = newNodeI(nkCall, n.info) + result.add newIdentNode(getIdent(c.c.cache, "[]"), n.info) + for i in 0..<n.len: result.add(n[i]) result = semTemplBodySons(c, result) of nkCurlyExpr: - result = newNodeI(nkCall, n.info) - result.add newIdentNode(getIdent(c.c.cache, "{}"), n.info) - for i in 0..<n.len: result.add(n[i]) + if n.typ == nil: + # see nkBracketExpr case for explanation + result = newNodeI(nkCall, n.info) + result.add newIdentNode(getIdent(c.c.cache, "{}"), n.info) + for i in 0..<n.len: result.add(n[i]) result = semTemplBodySons(c, result) of nkAsgn, nkFastAsgn, nkSinkAsgn: checkSonsLen(n, 2, c.c.config) @@ -524,17 +567,21 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = let k = a.kind case k of nkBracketExpr: - result = newNodeI(nkCall, n.info) - result.add newIdentNode(getIdent(c.c.cache, "[]="), n.info) - for i in 0..<a.len: result.add(a[i]) - result.add(b) + if a.typ == nil: + # see nkBracketExpr case above for explanation + result = newNodeI(nkCall, n.info) + result.add newIdentNode(getIdent(c.c.cache, "[]="), n.info) + for i in 0..<a.len: result.add(a[i]) + result.add(b) let a0 = semTemplBody(c, a[0]) result = semTemplBodySons(c, result) of nkCurlyExpr: - result = newNodeI(nkCall, n.info) - result.add newIdentNode(getIdent(c.c.cache, "{}="), n.info) - for i in 0..<a.len: result.add(a[i]) - result.add(b) + if a.typ == nil: + # see nkBracketExpr case above for explanation + result = newNodeI(nkCall, n.info) + result.add newIdentNode(getIdent(c.c.cache, "{}="), n.info) + for i in 0..<a.len: result.add(a[i]) + result.add(b) result = semTemplBodySons(c, result) else: result = semTemplBodySons(c, n) @@ -545,6 +592,7 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = of nkDotExpr, nkAccQuoted: # dotExpr is ambiguous: note that we explicitly allow 'x.TemplateParam', # so we use the generic code for nkDotExpr too + c.c.isAmbiguous = false let s = qualifiedLookUp(c.c, n, {}) if s != nil: # mirror the nkIdent case @@ -559,9 +607,9 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = elif contains(c.toMixin, s.name.id): return symChoice(c.c, n, s, scForceOpen, c.noGenSym > 0) else: - if s.kind in {skType, skVar, skLet, skConst}: + if s.kind in {skVar, skLet, skConst}: discard qualifiedLookUp(c.c, n, {checkAmbiguity, checkModule}) - return semTemplSymbol(c.c, n, s, c.noGenSym > 0) + return semTemplSymbol(c, n, s, c.noGenSym > 0, c.c.isAmbiguous) if n.kind == nkDotExpr: result = n result[0] = semTemplBody(c, n[0]) @@ -645,6 +693,7 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = pushOwner(c, s) openScope(c) n[namePos] = newSymNode(s) + s.ast = n # for implicitPragmas to use pragmaCallable(c, s, n, templatePragmas) implicitPragmas(c, s, n.info, templatePragmas) @@ -657,7 +706,7 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = # a template's parameters are not gensym'ed even if that was originally the # case as we determine whether it's a template parameter in the template # body by the absence of the sfGenSym flag: - let retType = s.typ[0] + let retType = s.typ.returnType if retType != nil and retType.kind != tyUntyped: allUntyped = false for i in 1..<s.typ.n.len: @@ -673,7 +722,7 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = # XXX why do we need tyTyped as a return type again? s.typ.n = newNodeI(nkFormalParams, n.info) rawAddSon(s.typ, newTypeS(tyTyped, c)) - s.typ.n.add newNodeIT(nkType, n.info, s.typ[0]) + s.typ.n.add newNodeIT(nkType, n.info, s.typ.returnType) if n[genericParamsPos].safeLen == 0: # restore original generic type params as no explicit or implicit were found n[genericParamsPos] = n[miscPos][1] @@ -688,12 +737,24 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = if n[patternPos].kind != nkEmpty: n[patternPos] = semPattern(c, n[patternPos], s) - var ctx: TemplCtx - ctx.toBind = initIntSet() - ctx.toMixin = initIntSet() - ctx.toInject = initIntSet() - ctx.c = c - ctx.owner = s + var ctx = TemplCtx( + toBind: initIntSet(), + toMixin: initIntSet(), + toInject: initIntSet(), + c: c, + owner: s + ) + # handle default params: + for i in 1..<s.typ.n.len: + let param = s.typ.n[i].sym + if param.ast != nil: + # param default values need to be treated like template body: + if sfDirty in s.flags: + param.ast = semTemplBodyDirty(ctx, param.ast) + else: + param.ast = semTemplBody(ctx, param.ast) + if param.ast.referencesAnotherParam(s): + param.ast.flags.incl nfDefaultRefsParam if sfDirty in s.flags: n[bodyPos] = semTemplBodyDirty(ctx, n[bodyPos]) else: @@ -703,11 +764,6 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = closeScope(c) popOwner(c) - # set the symbol AST after pragmas, at least. This stops pragma that have - # been pushed (implicit) to be explicitly added to the template definition - # and misapplied to the body. see #18113 - s.ast = n - if sfCustomPragma in s.flags: if n[bodyPos].kind != nkEmpty: localError(c.config, n[bodyPos].info, errImplOfXNotAllowed % s.name.s) @@ -844,12 +900,13 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = proc semPattern(c: PContext, n: PNode; s: PSym): PNode = openScope(c) - var ctx: TemplCtx - ctx.toBind = initIntSet() - ctx.toMixin = initIntSet() - ctx.toInject = initIntSet() - ctx.c = c - ctx.owner = getCurrOwner(c) + var ctx = TemplCtx( + toBind: initIntSet(), + toMixin: initIntSet(), + toInject: initIntSet(), + c: c, + owner: getCurrOwner(c) + ) result = flattenStmts(semPatternBody(ctx, n)) if result.kind in {nkStmtList, nkStmtListExpr}: if result.len == 1: diff --git a/compiler/semtypes.nim b/compiler/semtypes.nim index 7968122ed..113946fef 100644 --- a/compiler/semtypes.nim +++ b/compiler/semtypes.nim @@ -15,7 +15,7 @@ const errStringLiteralExpected = "string literal expected" errIntLiteralExpected = "integer literal expected" errWrongNumberOfVariables = "wrong number of variables" - errInvalidOrderInEnumX = "invalid order in enum '$1'" + errDuplicateAliasInEnumX = "duplicate value in enum '$1'" errOverflowInEnumX = "The enum '$1' exceeds its maximum value ($2)" errOrdinalTypeExpected = "ordinal type expected; given: $1" errSetTooBig = "set is too large; use `std/sets` for ordinal types with more than 2^16 elements" @@ -38,12 +38,12 @@ const errNoGenericParamsAllowedForX = "no generic parameters allowed for $1" errInOutFlagNotExtern = "the '$1' modifier can be used only with imported types" -proc newOrPrevType(kind: TTypeKind, prev: PType, c: PContext, sons: seq[PType]): PType = +proc newOrPrevType(kind: TTypeKind, prev: PType, c: PContext, son: sink PType): PType = if prev == nil or prev.kind == tyGenericBody: - result = newTypeS(kind, c, sons = sons) + result = newTypeS(kind, c, son) else: result = prev - result.setSons(sons) + result.setSon(son) if result.kind == tyForward: result.kind = kind #if kind == tyError: result.flags.incl tfCheckedForDestructor @@ -69,6 +69,7 @@ proc semEnum(c: PContext, n: PNode, prev: PType): PType = e: PSym = nil base: PType = nil identToReplace: ptr PNode = nil + counterSet = initPackedSet[BiggestInt]() counter = 0 base = nil result = newOrPrevType(tyEnum, prev, c) @@ -85,6 +86,7 @@ proc semEnum(c: PContext, n: PNode, prev: PType): PType = var hasNull = false for i in 1..<n.len: if n[i].kind == nkEmpty: continue + var useAutoCounter = false case n[i].kind of nkEnumFieldDef: if n[i][0].kind == nkPragmaExpr: @@ -112,6 +114,7 @@ proc semEnum(c: PContext, n: PNode, prev: PType): PType = of tyString, tyCstring: strVal = v x = counter + useAutoCounter = true else: if isOrdinalType(v.typ, allowEnumWithHoles=true): x = toInt64(getOrdValue(v)) @@ -120,22 +123,30 @@ proc semEnum(c: PContext, n: PNode, prev: PType): PType = localError(c.config, v.info, errOrdinalTypeExpected % typeToString(v.typ, preferDesc)) if i != 1: if x != counter: incl(result.flags, tfEnumHasHoles) - if x < counter: - localError(c.config, n[i].info, errInvalidOrderInEnumX % e.name.s) - x = counter e.ast = strVal # might be nil counter = x of nkSym: e = n[i].sym + useAutoCounter = true of nkIdent, nkAccQuoted: e = newSymS(skEnumField, n[i], c) identToReplace = addr n[i] + useAutoCounter = true of nkPragmaExpr: e = newSymS(skEnumField, n[i][0], c) pragma(c, e, n[i][1], enumFieldPragmas) identToReplace = addr n[i][0] + useAutoCounter = true else: illFormedAst(n[i], c.config) + + if useAutoCounter: + while counter in counterSet and counter != high(typeof(counter)): + inc counter + counterSet.incl counter + elif counterSet.containsOrIncl(counter): + localError(c.config, n[i].info, errDuplicateAliasInEnumX % e.name.s) + e.typ = result e.position = int(counter) let symNode = newSymNode(e) @@ -173,7 +184,7 @@ proc semSet(c: PContext, n: PNode, prev: PType): PType = if n.len == 2 and n[1].kind != nkEmpty: var base = semTypeNode(c, n[1], nil) addSonSkipIntLit(result, base, c.idgen) - if base.kind in {tyGenericInst, tyAlias, tySink}: base = lastSon(base) + if base.kind in {tyGenericInst, tyAlias, tySink}: base = skipModifier(base) if base.kind notin {tyGenericParam, tyGenericInvocation}: if base.kind == tyForward: c.skipTypes.add n @@ -232,7 +243,7 @@ proc isRecursiveType(t: PType, cycleDetector: var IntSet): bool = return true case t.kind of tyAlias, tyGenericInst, tyDistinct: - return isRecursiveType(t.lastSon, cycleDetector) + return isRecursiveType(t.skipModifier, cycleDetector) else: return false @@ -379,11 +390,11 @@ proc semArrayIndex(c: PContext, n: PNode): PType = localError(c.config, n.info, "Array length can't be negative, but was " & $e.intVal) result = makeRangeType(c, 0, e.intVal-1, n.info, e.typ) - elif e.kind == nkSym and (e.typ.kind == tyStatic or e.typ.kind == tyTypeDesc) : + elif e.kind == nkSym and (e.typ.kind == tyStatic or e.typ.kind == tyTypeDesc): if e.typ.kind == tyStatic: if e.sym.ast != nil: return semArrayIndex(c, e.sym.ast) - if e.typ.lastSon.kind != tyGenericParam and not isOrdinalType(e.typ.lastSon): + if e.typ.skipModifier.kind != tyGenericParam and not isOrdinalType(e.typ.skipModifier): let info = if n.safeLen > 1: n[1].info else: n.info localError(c.config, info, errOrdinalTypeExpected % typeToString(e.typ, preferDesc)) result = makeRangeWithStaticExpr(c, e) @@ -412,21 +423,24 @@ proc semArray(c: PContext, n: PNode, prev: PType): PType = # 3 = length(array indx base) let indx = semArrayIndex(c, n[1]) var indxB = indx - if indxB.kind in {tyGenericInst, tyAlias, tySink}: indxB = lastSon(indxB) + if indxB.kind in {tyGenericInst, tyAlias, tySink}: indxB = skipModifier(indxB) if indxB.kind notin {tyGenericParam, tyStatic, tyFromExpr} and tfUnresolved notin indxB.flags: - if indxB.skipTypes({tyRange}).kind in {tyUInt, tyUInt64}: - discard - elif not isOrdinalType(indxB): + if not isOrdinalType(indxB): localError(c.config, n[1].info, errOrdinalTypeExpected % typeToString(indxB, preferDesc)) elif enumHasHoles(indxB): localError(c.config, n[1].info, "enum '$1' has holes" % typeToString(indxB.skipTypes({tyRange}))) + elif indxB.kind != tyRange and + lengthOrd(c.config, indxB) > high(uint16).int: + # assume range type is intentional + localError(c.config, n[1].info, + "index type '$1' for array is too large" % typeToString(indxB)) base = semTypeNode(c, n[2], nil) # ensure we only construct a tyArray when there was no error (bug #3048): # bug #6682: Do not propagate initialization requirements etc for the # index type: - result = newOrPrevType(tyArray, prev, c, @[indx]) + result = newOrPrevType(tyArray, prev, c, indx) addSonSkipIntLit(result, base, c.idgen) else: localError(c.config, n.info, errArrayExpectsTwoTypeParams) @@ -461,6 +475,13 @@ proc semAnonTuple(c: PContext, n: PNode, prev: PType): PType = let t = semTypeNode(c, it, nil) addSonSkipIntLitChecked(c, result, t, it, c.idgen) +proc firstRange(config: ConfigRef, t: PType): PNode = + if t.skipModifier().kind in tyFloat..tyFloat64: + result = newFloatNode(nkFloatLit, firstFloat(t)) + else: + result = newIntNode(nkIntLit, firstOrd(config, t)) + result.typ = t + proc semTuple(c: PContext, n: PNode, prev: PType): PType = var typ: PType result = newOrPrevType(tyTuple, prev, c) @@ -477,8 +498,7 @@ proc semTuple(c: PContext, n: PNode, prev: PType): PType = elif a[^2].kind != nkEmpty: typ = semTypeNode(c, a[^2], nil) if c.graph.config.isDefined("nimPreviewRangeDefault") and typ.skipTypes(abstractInst).kind == tyRange: - a[^1] = newIntNode(nkIntLit, firstOrd(c.config, typ)) - a[^1].typ = typ + a[^1] = firstRange(c.config, typ) hasDefaultField = true else: localError(c.config, a.info, errTypeExpected) @@ -526,7 +546,7 @@ proc semIdentVis(c: PContext, kind: TSymKind, n: PNode, result = newSymG(kind, n, c) proc semIdentWithPragma(c: PContext, kind: TSymKind, n: PNode, - allowed: TSymFlags): PSym = + allowed: TSymFlags, fromTopLevel = false): PSym = if n.kind == nkPragmaExpr: checkSonsLen(n, 2, c.config) result = semIdentVis(c, kind, n[0], allowed) @@ -541,11 +561,15 @@ proc semIdentWithPragma(c: PContext, kind: TSymKind, n: PNode, else: discard else: result = semIdentVis(c, kind, n, allowed) + let invalidPragmasForPush = if fromTopLevel and sfWasGenSym notin result.flags: + {} + else: + {wExportc, wExportCpp, wDynlib} case kind of skField: implicitPragmas(c, result, n.info, fieldPragmas) - of skVar: implicitPragmas(c, result, n.info, varPragmas) - of skLet: implicitPragmas(c, result, n.info, letPragmas) - of skConst: implicitPragmas(c, result, n.info, constPragmas) + of skVar: implicitPragmas(c, result, n.info, varPragmas-invalidPragmasForPush) + of skLet: implicitPragmas(c, result, n.info, letPragmas-invalidPragmasForPush) + of skConst: implicitPragmas(c, result, n.info, constPragmas-invalidPragmasForPush) else: discard proc checkForOverlap(c: PContext, t: PNode, currentEx, branchIndex: int) = @@ -556,15 +580,20 @@ proc checkForOverlap(c: PContext, t: PNode, currentEx, branchIndex: int) = if overlap(t[i][j].skipConv, ex): localError(c.config, ex.info, errDuplicateCaseLabel) -proc semBranchRange(c: PContext, t, a, b: PNode, covered: var Int128): PNode = - checkMinSonsLen(t, 1, c.config) +proc semBranchRange(c: PContext, n, a, b: PNode, covered: var Int128): PNode = + checkMinSonsLen(n, 1, c.config) let ac = semConstExpr(c, a) let bc = semConstExpr(c, b) if ac.kind in {nkStrLit..nkTripleStrLit} or bc.kind in {nkStrLit..nkTripleStrLit}: localError(c.config, b.info, "range of string is invalid") - let at = fitNode(c, t[0].typ, ac, ac.info).skipConvTakeType - let bt = fitNode(c, t[0].typ, bc, bc.info).skipConvTakeType - + var at = fitNode(c, n[0].typ, ac, ac.info).skipConvTakeType + var bt = fitNode(c, n[0].typ, bc, bc.info).skipConvTakeType + # the calls to fitNode may introduce calls to converters + # mirrored with semCaseBranch for single elements + if at.kind in {nkHiddenCallConv, nkHiddenStdConv, nkHiddenSubConv}: + at = semConstExpr(c, at) + if bt.kind in {nkHiddenCallConv, nkHiddenStdConv, nkHiddenSubConv}: + bt = semConstExpr(c, bt) result = newNodeI(nkRange, a.info) result.add(at) result.add(bt) @@ -576,42 +605,44 @@ proc semCaseBranchRange(c: PContext, t, b: PNode, checkSonsLen(b, 3, c.config) result = semBranchRange(c, t, b[1], b[2], covered) -proc semCaseBranchSetElem(c: PContext, t, b: PNode, +proc semCaseBranchSetElem(c: PContext, n, b: PNode, covered: var Int128): PNode = if isRange(b): checkSonsLen(b, 3, c.config) - result = semBranchRange(c, t, b[1], b[2], covered) + result = semBranchRange(c, n, b[1], b[2], covered) elif b.kind == nkRange: checkSonsLen(b, 2, c.config) - result = semBranchRange(c, t, b[0], b[1], covered) + result = semBranchRange(c, n, b[0], b[1], covered) else: - result = fitNode(c, t[0].typ, b, b.info) + result = fitNode(c, n[0].typ, b, b.info) inc(covered) -proc semCaseBranch(c: PContext, t, branch: PNode, branchIndex: int, +proc semCaseBranch(c: PContext, n, branch: PNode, branchIndex: int, covered: var Int128) = let lastIndex = branch.len - 2 for i in 0..lastIndex: var b = branch[i] if b.kind == nkRange: branch[i] = b + # same check as in semBranchRange for exhaustiveness + covered = covered + getOrdValue(b[1]) + 1 - getOrdValue(b[0]) elif isRange(b): - branch[i] = semCaseBranchRange(c, t, b, covered) + branch[i] = semCaseBranchRange(c, n, b, covered) else: # constant sets and arrays are allowed: # set expected type to selector type for type inference # even if it can be a different type like a set or array - var r = semConstExpr(c, b, expectedType = t[0].typ) + var r = semConstExpr(c, b, expectedType = n[0].typ) if r.kind in {nkCurly, nkBracket} and r.len == 0 and branch.len == 2: # discarding ``{}`` and ``[]`` branches silently delSon(branch, 0) return elif r.kind notin {nkCurly, nkBracket} or r.len == 0: - checkMinSonsLen(t, 1, c.config) - var tmp = fitNode(c, t[0].typ, r, r.info) + checkMinSonsLen(n, 1, c.config) + var tmp = fitNode(c, n[0].typ, r, r.info) # the call to fitNode may introduce a call to a converter - if tmp.kind == nkHiddenCallConv or - (tmp.kind == nkHiddenStdConv and t[0].typ.kind == tyCstring): + # mirrored with semBranchRange + if tmp.kind in {nkHiddenCallConv, nkHiddenStdConv, nkHiddenSubConv}: tmp = semConstExpr(c, tmp) branch[i] = skipConv(tmp) inc(covered) @@ -620,18 +651,18 @@ proc semCaseBranch(c: PContext, t, branch: PNode, branchIndex: int, r = deduplicate(c.config, r) # first element is special and will overwrite: branch[i]: - branch[i] = semCaseBranchSetElem(c, t, r[0], covered) + branch[i] = semCaseBranchSetElem(c, n, r[0], covered) # other elements have to be added to ``branch`` for j in 1..<r.len: - branch.add(semCaseBranchSetElem(c, t, r[j], covered)) + branch.add(semCaseBranchSetElem(c, n, r[j], covered)) # caution! last son of branch must be the actions to execute: swap(branch[^2], branch[^1]) - checkForOverlap(c, t, i, branchIndex) + checkForOverlap(c, n, i, branchIndex) # Elements added above needs to be checked for overlaps. for i in lastIndex.succ..<branch.len - 1: - checkForOverlap(c, t, i, branchIndex) + checkForOverlap(c, n, i, branchIndex) proc toCover(c: PContext, t: PType): Int128 = let t2 = skipTypes(t, abstractVarRange-{tyTypeDesc}) @@ -723,7 +754,7 @@ proc semRecordCase(c: PContext, n: PNode, check: var IntSet, pos: var int, of tyFloat..tyFloat128, tyError: discard of tyRange: - if skipTypes(typ[0], abstractInst).kind in shouldChckCovered: + if skipTypes(typ.elementType, abstractInst).kind in shouldChckCovered: chckCovered = true of tyForward: errorUndeclaredIdentifier(c, n[0].info, typ.sym.name.s) @@ -765,6 +796,7 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, of nkRecWhen: var a = copyTree(n) var branch: PNode = nil # the branch to take + var cannotResolve = false # no branch should be taken for i in 0..<a.len: var it = a[i] if it == nil: illFormedAst(n, c.config) @@ -782,24 +814,30 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, let e = semExprWithType(c, it[0], {efDetermineType}) if e.typ.kind == tyFromExpr: it[0] = makeStaticExpr(c, e) + cannotResolve = true else: it[0] = forceBool(c, e) + let val = getConstExpr(c.module, it[0], c.idgen, c.graph) + if val == nil or val.kind != nkIntLit: + cannotResolve = true + elif not cannotResolve and val.intVal != 0 and branch == nil: + branch = it[1] of nkElse: checkSonsLen(it, 1, c.config) - if branch == nil: branch = it[0] + if branch == nil and not cannotResolve: branch = it[0] idx = 0 else: illFormedAst(n, c.config) - if c.inGenericContext > 0: + if c.inGenericContext > 0 and cannotResolve: # use a new check intset here for each branch: var newCheck: IntSet = check var newPos = pos var newf = newNodeI(nkRecList, n.info) semRecordNodeAux(c, it[idx], newCheck, newPos, newf, rectype, hasCaseFields) it[idx] = if newf.len == 1: newf[0] else: newf - if c.inGenericContext > 0: - father.add a - elif branch != nil: + if branch != nil: semRecordNodeAux(c, branch, check, pos, father, rectype, hasCaseFields) + elif cannotResolve: + father.add a elif father.kind in {nkElse, nkOfBranch}: father.add newNodeI(nkRecList, n.info) of nkRecCase: @@ -828,8 +866,7 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, else: typ = semTypeNode(c, n[^2], nil) if c.graph.config.isDefined("nimPreviewRangeDefault") and typ.skipTypes(abstractInst).kind == tyRange: - n[^1] = newIntNode(nkIntLit, firstOrd(c.config, typ)) - n[^1].typ = typ + n[^1] = firstRange(c.config, typ) hasDefaultField = true propagateToOwner(rectype, typ) var fieldOwner = if c.inGenericContext > 0: c.getCurrOwner @@ -846,8 +883,8 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, f.options = c.config.options if fieldOwner != nil and {sfImportc, sfExportc} * fieldOwner.flags != {} and - not hasCaseFields and f.loc.r == "": - f.loc.r = rope(f.name.s) + not hasCaseFields and f.loc.snippet == "": + f.loc.snippet = rope(f.name.s) f.flags.incl {sfImportc, sfExportc} * fieldOwner.flags inc(pos) if containsOrIncl(check, f.name.id): @@ -897,7 +934,7 @@ proc skipGenericInvocation(t: PType): PType {.inline.} = if result.kind == tyGenericInvocation: result = result[0] while result.kind in {tyGenericInst, tyGenericBody, tyRef, tyPtr, tyAlias, tySink, tyOwned}: - result = lastSon(result) + result = skipModifier(result) proc tryAddInheritedFields(c: PContext, check: var IntSet, pos: var int, obj: PType, n: PNode, isPartial = false, innerObj: PType = nil): bool = @@ -1013,16 +1050,16 @@ proc semAnyRef(c: PContext; n: PNode; kind: TTypeKind; prev: PType): PType = addSonSkipIntLit(result, region, c.idgen) addSonSkipIntLit(result, t, c.idgen) if tfPartial in result.flags: - if result.lastSon.kind == tyObject: incl(result.lastSon.flags, tfPartial) + if result.elementType.kind == tyObject: incl(result.elementType.flags, tfPartial) # if not isNilable: result.flags.incl tfNotNil case wrapperKind of tyOwned: if optOwnedRefs in c.config.globalOptions: - let t = newTypeS(tyOwned, c, @[result]) + let t = newTypeS(tyOwned, c, result) t.flags.incl tfHasOwned result = t of tySink: - let t = newTypeS(tySink, c, @[result]) + let t = newTypeS(tySink, c, result) result = t else: discard if result.kind == tyRef and c.config.selectedGC in {gcArc, gcOrc, gcAtomicArc}: @@ -1036,7 +1073,7 @@ proc findEnforcedStaticType(t: PType): PType = if t == nil: return nil if t.kind == tyStatic: return t if t.kind == tyAnd: - for s in t: + for s in t.kids: let t = findEnforcedStaticType(s) if t != nil: return t @@ -1117,7 +1154,7 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, let base = (if lifted != nil: lifted else: paramType.base) if base.isMetaType and procKind == skMacro: localError(c.config, info, errMacroBodyDependsOnGenericTypes % paramName) - result = addImplicitGeneric(c, c.newTypeWithSons(tyStatic, @[base]), + result = addImplicitGeneric(c, newTypeS(tyStatic, c, base), paramTypId, info, genericParams, paramName) if result != nil: result.flags.incl({tfHasStatic, tfUnresolved}) @@ -1129,7 +1166,7 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, paramTypId.id == getIdent(c.cache, "type").id): # XXX Why doesn't this check for tyTypeDesc instead? paramTypId = nil - let t = c.newTypeWithSons(tyTypeDesc, @[paramType.base]) + let t = newTypeS(tyTypeDesc, c, paramType.base) incl t.flags, tfCheckedForDestructor result = addImplicitGeneric(c, t, paramTypId, info, genericParams, paramName) else: @@ -1148,20 +1185,20 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, paramType[i] = t result = paramType - of tyAlias, tyOwned, tySink: + of tyAlias, tyOwned: result = recurse(paramType.base) of tySequence, tySet, tyArray, tyOpenArray, - tyVar, tyLent, tyPtr, tyRef, tyProc: + tyVar, tyLent, tyPtr, tyRef, tyProc, tySink: # XXX: this is a bit strange, but proc(s: seq) # produces tySequence(tyGenericParam, tyNone). # This also seems to be true when creating aliases # like: type myseq = distinct seq. # Maybe there is another better place to associate # the seq type class with the seq identifier. - if paramType.kind == tySequence and paramType.lastSon.kind == tyNone: - let typ = c.newTypeWithSons(tyBuiltInTypeClass, - @[newTypeS(paramType.kind, c)]) + if paramType.kind == tySequence and paramType.elementType.kind == tyNone: + let typ = newTypeS(tyBuiltInTypeClass, c, + newTypeS(paramType.kind, c)) result = addImplicitGeneric(c, typ, paramTypId, info, genericParams, paramName) else: result = nil @@ -1185,21 +1222,21 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, else: result.rawAddSon newTypeS(tyAnything, c) - if paramType.lastSon.kind == tyUserTypeClass: + if paramType.typeBodyImpl.kind == tyUserTypeClass: result.kind = tyUserTypeClassInst - result.rawAddSon paramType.lastSon + result.rawAddSon paramType.typeBodyImpl return addImplicitGeneric(c, result, paramTypId, info, genericParams, paramName) let x = instGenericContainer(c, paramType.sym.info, result, allowMetaTypes = true) - result = newTypeWithSons(c, tyCompositeTypeClass, @[paramType, x]) - #result = newTypeS(tyCompositeTypeClass, c) - #for i in 0..<x.len: result.rawAddSon(x[i]) + result = newTypeS(tyCompositeTypeClass, c) + result.rawAddSon paramType + result.rawAddSon x result = addImplicitGeneric(c, result, paramTypId, info, genericParams, paramName) of tyGenericInst: result = nil - if paramType.lastSon.kind == tyUserTypeClass: + if paramType.skipModifier.kind == tyUserTypeClass: var cp = copyType(paramType, c.idgen, getCurrOwner(c)) copyTypeProps(c.graph, c.idgen.module, cp, paramType) @@ -1211,9 +1248,9 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, if lifted != nil: paramType[i] = lifted result = paramType - result.lastSon.shouldHaveMeta + result.last.shouldHaveMeta - let liftBody = recurse(paramType.lastSon, true) + let liftBody = recurse(paramType.skipModifier, true) if liftBody != nil: result = liftBody result.flags.incl tfHasMeta @@ -1232,7 +1269,7 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, # before one of its param types return - if body.lastSon.kind == tyUserTypeClass: + if body.last.kind == tyUserTypeClass: let expanded = instGenericContainer(c, info, paramType, allowMetaTypes = true) result = recurse(expanded, true) @@ -1259,7 +1296,7 @@ proc semParamType(c: PContext, n: PNode, constraint: var PNode): PType = result = semTypeNode(c, n[0], nil) constraint = semNodeKindConstraints(n, c.config, 1) elif n.kind == nkCall and - n[0].kind in {nkIdent, nkSym, nkOpenSymChoice, nkClosedSymChoice} and + n[0].kind in {nkIdent, nkSym, nkOpenSymChoice, nkClosedSymChoice, nkOpenSym} and considerQuotedIdent(c, n[0]).s == "{}": result = semTypeNode(c, n[1], nil) constraint = semNodeKindConstraints(n, c.config, 2) @@ -1289,6 +1326,9 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, result = newProcType(c, n.info, prev) var check = initIntSet() var counter = 0 + template isCurrentlyGeneric: bool = + # genericParams might update as implicit generic params are added + genericParams != nil and genericParams.len > 0 for i in 1..<n.len: var a = n[i] @@ -1309,7 +1349,10 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, hasDefault = a[^1].kind != nkEmpty if hasType: + let isGeneric = isCurrentlyGeneric() + inc c.inGenericContext, ord(isGeneric) typ = semParamType(c, a[^2], constraint) + dec c.inGenericContext, ord(isGeneric) # TODO: Disallow typed/untyped in procs in the compiler/stdlib if kind in {skProc, skFunc} and (typ.kind == tyTyped or typ.kind == tyUntyped): if not isMagic(getCurrOwner(c)): @@ -1329,15 +1372,26 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, "either use ';' (semicolon) or explicitly write each default value") message(c.config, a.info, warnImplicitDefaultValue, msg) block determineType: - var defTyp = typ - if genericParams != nil and genericParams.len > 0: - defTyp = nil - def = semGenericStmt(c, def) - if hasUnresolvedArgs(c, def): + var canBeVoid = false + if kind == skTemplate: + if typ != nil and typ.kind == tyUntyped: + # don't do any typechecking or assign a type for + # `untyped` parameter default value + break determineType + elif hasUnresolvedArgs(c, def): + # template default value depends on other parameter + # don't do any typechecking def.typ = makeTypeFromExpr(c, def.copyTree) break determineType - - def = semExprWithType(c, def, {efDetermineType, efAllowSymChoice}, defTyp) + elif typ != nil and typ.kind == tyTyped: + canBeVoid = true + let isGeneric = isCurrentlyGeneric() + inc c.inGenericContext, ord(isGeneric) + if canBeVoid: + def = semExpr(c, def, {efDetermineType, efAllowSymChoice}, typ) + else: + def = semExprWithType(c, def, {efDetermineType, efAllowSymChoice}, typ) + dec c.inGenericContext, ord(isGeneric) if def.referencesAnotherParam(getCurrOwner(c)): def.flags.incl nfDefaultRefsParam @@ -1353,10 +1407,10 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, # which will prevent other types from matching - clearly a very # surprising behavior. We must instead fix the expected type of # the proc to be the unbound typedesc type: - typ = newTypeWithSons(c, tyTypeDesc, @[newTypeS(tyNone, c)]) + typ = newTypeS(tyTypeDesc, c, newTypeS(tyNone, c)) typ.flags.incl tfCheckedForDestructor - else: + elif def.typ != nil and def.typ.kind != tyFromExpr: # def.typ can be void # if def.typ != nil and def.typ.kind != tyNone: # example code that triggers it: # proc sort[T](cmp: proc(a, b: T): int = cmp) @@ -1409,11 +1463,12 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, onDef(a[j].info, arg) a[j] = newSymNode(arg) - var r: PType = - if n[0].kind != nkEmpty: - semTypeNode(c, n[0], nil) - else: - nil + var r: PType = nil + if n[0].kind != nkEmpty: + let isGeneric = isCurrentlyGeneric() + inc c.inGenericContext, ord(isGeneric) + r = semTypeNode(c, n[0], nil) + dec c.inGenericContext, ord(isGeneric) if r != nil and kind in {skMacro, skTemplate} and r.kind == tyTyped: # XXX: To implement the proposed change in the warning, just @@ -1436,7 +1491,8 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, "' is only valid for macros and templates") # 'auto' as a return type does not imply a generic: elif r.kind == tyAnything: - discard + r = copyType(r, c.idgen, r.owner) + r.flags.incl tfRetType elif r.kind == tyStatic: # type allowed should forbid this type discard @@ -1465,7 +1521,7 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, result.flags.excl tfHasMeta result.n.typ = r - if genericParams != nil and genericParams.len > 0: + if isCurrentlyGeneric(): for n in genericParams: if {sfUsed, sfAnon} * n.sym.flags == {}: result.flags.incl tfUnresolved @@ -1509,7 +1565,7 @@ proc trySemObjectTypeForInheritedGenericInst(c: PContext, n: PNode, t: PType): b check = initIntSet() pos = 0 let - realBase = t[0] + realBase = t.baseClass base = skipTypesOrNil(realBase, skipPtrs) result = true if base.isNil: @@ -1622,7 +1678,8 @@ proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = recomputeFieldPositions(tx, tx.n, position) proc maybeAliasType(c: PContext; typeExpr, prev: PType): PType = - if typeExpr.kind in {tyObject, tyEnum, tyDistinct, tyForward, tyGenericBody} and prev != nil: + if prev != nil and (prev.kind == tyGenericBody or + typeExpr.kind in {tyObject, tyEnum, tyDistinct, tyForward, tyGenericBody}): result = newTypeS(tyAlias, c) result.rawAddSon typeExpr result.sym = prev.sym @@ -1660,6 +1717,10 @@ proc semTypeExpr(c: PContext, n: PNode; prev: PType): PType = # unnecessary new type creation let alias = maybeAliasType(c, result, prev) if alias != nil: result = alias + elif n.typ.kind == tyFromExpr and c.inGenericContext > 0: + # sometimes not possible to distinguish type from value in generic body, + # for example `T.Foo`, so both are handled under `tyFromExpr` + result = n.typ else: localError(c.config, n.info, "expected type, but got: " & n.renderTree) result = errorType(c) @@ -1693,8 +1754,8 @@ proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = inherited = n[2] var owner = getCurrOwner(c) - var candidateTypeSlot = newTypeWithSons(owner, tyAlias, @[c.errorType], c.idgen) - result = newOrPrevType(tyUserTypeClass, prev, c, sons = @[candidateTypeSlot]) + var candidateTypeSlot = newTypeS(tyAlias, c, c.errorType) + result = newOrPrevType(tyUserTypeClass, prev, c, son = candidateTypeSlot) result.flags.incl tfCheckedForDestructor result.n = n @@ -1745,12 +1806,15 @@ proc applyTypeSectionPragmas(c: PContext; pragmas, operand: PNode): PNode = discard "builtin pragma" else: trySuggestPragmas(c, key) - let ident = considerQuotedIdent(c, key) - if strTableGet(c.userPragmas, ident) != nil: + let ident = + if key.kind in nkIdentKinds: + considerQuotedIdent(c, key) + else: + nil + if ident != nil and strTableGet(c.userPragmas, ident) != nil: discard "User-defined pragma" else: - var amb = false - let sym = searchInScopes(c, ident, amb) + let sym = qualifiedLookUp(c, key, {}) # XXX: What to do here if amb is true? if sym != nil and sfCustomPragma in sym.flags: discard "Custom user pragma" @@ -1817,10 +1881,14 @@ proc semStaticType(c: PContext, childNode: PNode, prev: PType): PType = proc semTypeOf(c: PContext; n: PNode; prev: PType): PType = openScope(c) + inc c.inTypeofContext + defer: dec c.inTypeofContext # compiles can raise an exception let t = semExprWithType(c, n, {efInTypeof}) closeScope(c) fixupTypeOf(c, prev, t) result = t.typ + if result.kind == tyFromExpr: + result.flags.incl tfNonConstExpr proc semTypeOf2(c: PContext; n: PNode; prev: PType): PType = openScope(c) @@ -1831,10 +1899,14 @@ proc semTypeOf2(c: PContext; n: PNode; prev: PType): PType = localError(c.config, n.info, "typeof: cannot evaluate 'mode' parameter at compile-time") else: m = mode.intVal + inc c.inTypeofContext + defer: dec c.inTypeofContext # compiles can raise an exception let t = semExprWithType(c, n[1], if m == 1: {efInTypeof} else: {}) closeScope(c) fixupTypeOf(c, prev, t) result = t.typ + if result.kind == tyFromExpr: + result.flags.incl tfNonConstExpr proc semTypeIdent(c: PContext, n: PNode): PSym = if n.kind == nkSym: @@ -1857,7 +1929,7 @@ proc semTypeIdent(c: PContext, n: PNode): PSym = # it's not bound when it's used multiple times in the # proc signature for example if c.inGenericInst > 0: - let bound = result.typ[0].sym + let bound = result.typ.elementType.sym if bound != nil: return bound return result if result.typ.sym == nil: @@ -1879,7 +1951,7 @@ proc semTypeIdent(c: PContext, n: PNode): PSym = return errorSym(c, n) if result.kind != skType and result.magic notin {mStatic, mType, mTypeOf}: # this implements the wanted ``var v: V, x: V`` feature ... - var ov: TOverloadIter + var ov: TOverloadIter = default(TOverloadIter) var amb = initOverloadIter(ov, c, n) while amb != nil and amb.kind != skType: amb = nextOverloadIter(ov, c, n) @@ -1922,11 +1994,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = of nkTupleConstr: result = semAnonTuple(c, n, prev) of nkCallKinds: let x = n[0] - let ident = case x.kind - of nkIdent: x.ident - of nkSym: x.sym.name - of nkClosedSymChoice, nkOpenSymChoice: x[0].sym.name - else: nil + let ident = x.getPIdent if ident != nil and ident.s == "[]": let b = newNodeI(nkBracketExpr, n.info) for i in 1..<n.len: b.add(n[i]) @@ -2016,20 +2084,21 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = elif op.id == ord(wType): checkSonsLen(n, 2, c.config) result = semTypeOf(c, n[1], prev) - elif op.s == "typeof" and n[0].kind == nkSym and n[0].sym.magic == mTypeOf: + elif op.s == "typeof" and ( + (n[0].kind == nkSym and n[0].sym.magic == mTypeOf) or + (n[0].kind == nkOpenSym and n[0][0].sym.magic == mTypeOf)): result = semTypeOf2(c, n, prev) elif op.s == "owned" and optOwnedRefs notin c.config.globalOptions and n.len == 2: result = semTypeExpr(c, n[1], prev) else: - if c.inGenericContext > 0 and n.kind == nkCall: - let n = semGenericStmt(c, n) - result = makeTypeFromExpr(c, n.copyTree) - else: - result = semTypeExpr(c, n, prev) + result = semTypeExpr(c, n, prev) of nkWhenStmt: var whenResult = semWhen(c, n, false) if whenResult.kind == nkStmtList: whenResult.transitionSonsKind(nkStmtListType) - result = semTypeNode(c, whenResult, prev) + if whenResult.kind == nkWhenStmt: + result = whenResult.typ + else: + result = semTypeNode(c, whenResult, prev) of nkBracketExpr: checkMinSonsLen(n, 2, c.config) var head = n[0] @@ -2074,6 +2143,12 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = of mRef: result = semAnyRef(c, n, tyRef, prev) of mPtr: result = semAnyRef(c, n, tyPtr, prev) of mTuple: result = semTuple(c, n, prev) + of mBuiltinType: + case s.name.s + of "lent": result = semAnyRef(c, n, tyLent, prev) + of "sink": result = semAnyRef(c, n, tySink, prev) + of "owned": result = semAnyRef(c, n, tyOwned, prev) + else: result = semGeneric(c, n, s, prev) else: result = semGeneric(c, n, s, prev) of nkDotExpr: let typeExpr = semExpr(c, n) @@ -2103,7 +2178,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = if s.kind != skError: localError(c.config, n.info, errTypeExpected) result = newOrPrevType(tyError, prev, c) elif s.kind == skParam and s.typ.kind == tyTypeDesc: - internalAssert c.config, s.typ.base.kind != tyNone and prev == nil + internalAssert c.config, s.typ.base.kind != tyNone result = s.typ.base elif prev == nil: result = s.typ @@ -2127,7 +2202,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = if s.kind == skType: s.typ else: - internalAssert c.config, s.typ.base.kind != tyNone and prev == nil + internalAssert c.config, s.typ.base.kind != tyNone s.typ.base let alias = maybeAliasType(c, t, prev) if alias != nil: @@ -2176,6 +2251,10 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = else: let symKind = if n.kind == nkIteratorTy: skIterator else: skProc result = semProcTypeWithScope(c, n, prev, symKind) + if result == nil: + localError(c.config, n.info, "type expected, but got: " & renderTree(n)) + result = newOrPrevType(tyError, prev, c) + if n.kind == nkIteratorTy and result.kind == tyProc: result.flags.incl(tfIterator) if result.callConv == ccClosure and c.config.selectedGC in {gcArc, gcOrc, gcAtomicArc}: @@ -2184,6 +2263,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = of nkType: result = n.typ of nkStmtListType: result = semStmtListType(c, n, prev) of nkBlockType: result = semBlockType(c, n, prev) + of nkOpenSym: result = semTypeNode(c, n[0], prev) else: result = semTypeExpr(c, n, prev) when false: @@ -2296,7 +2376,7 @@ proc processMagicType(c: PContext, m: PSym) = else: localError(c.config, m.info, errTypeExpected) proc semGenericConstraints(c: PContext, x: PType): PType = - result = newTypeWithSons(c, tyGenericParam, @[x]) + result = newTypeS(tyGenericParam, c, x) proc semGenericParamList(c: PContext, n: PNode, father: PType = nil): PNode = @@ -2322,8 +2402,8 @@ proc semGenericParamList(c: PContext, n: PNode, father: PType = nil): PNode = typ = semTypeNode(c, constraint, nil) if typ.kind != tyStatic or typ.len == 0: if typ.kind == tyTypeDesc: - if typ[0].kind == tyNone: - typ = newTypeWithSons(c, tyTypeDesc, @[newTypeS(tyNone, c)]) + if typ.elementType.kind == tyNone: + typ = newTypeS(tyTypeDesc, c, newTypeS(tyNone, c)) incl typ.flags, tfCheckedForDestructor else: typ = semGenericConstraints(c, typ) @@ -2332,7 +2412,7 @@ proc semGenericParamList(c: PContext, n: PNode, father: PType = nil): PNode = def = semConstExpr(c, def) if typ == nil: if def.typ.kind != tyTypeDesc: - typ = newTypeWithSons(c, tyStatic, @[def.typ]) + typ = newTypeS(tyStatic, c, def.typ) else: # the following line fixes ``TV2*[T:SomeNumber=TR] = array[0..1, T]`` # from manyloc/named_argument_bug/triengine: diff --git a/compiler/semtypinst.nim b/compiler/semtypinst.nim index bb664c71f..759e8e6ab 100644 --- a/compiler/semtypinst.nim +++ b/compiler/semtypinst.nim @@ -9,6 +9,8 @@ # This module does the instantiation of generic types. +import std / tables + import ast, astalgo, msgs, types, magicsys, semdata, renderer, options, lineinfos, modulegraphs @@ -18,20 +20,16 @@ when defined(nimPreviewSlimSystem): const tfInstClearedFlags = {tfHasMeta, tfUnresolved} proc checkPartialConstructedType(conf: ConfigRef; info: TLineInfo, t: PType) = - if t.kind in {tyVar, tyLent} and t[0].kind in {tyVar, tyLent}: + if t.kind in {tyVar, tyLent} and t.elementType.kind in {tyVar, tyLent}: localError(conf, info, "type 'var var' is not allowed") proc checkConstructedType*(conf: ConfigRef; info: TLineInfo, typ: PType) = var t = typ.skipTypes({tyDistinct}) if t.kind in tyTypeClasses: discard - elif t.kind in {tyVar, tyLent} and t[0].kind in {tyVar, tyLent}: + elif t.kind in {tyVar, tyLent} and t.elementType.kind in {tyVar, tyLent}: localError(conf, info, "type 'var var' is not allowed") elif computeSize(conf, t) == szIllegalRecursion or isTupleRecursive(t): localError(conf, info, "illegal recursion in type '" & typeToString(t) & "'") - when false: - if t.kind == tyObject and t[0] != nil: - if t[0].kind != tyObject or tfFinal in t[0].flags: - localError(info, errInheritanceOnlyWithNonFinalObjects) proc searchInstTypes*(g: ModuleGraph; key: PType): PType = result = nil @@ -41,7 +39,7 @@ proc searchInstTypes*(g: ModuleGraph; key: PType): PType = for inst in typeInstCacheItems(g, genericTyp.sym): if inst.id == key.id: return inst - if inst.len < key.len: + if inst.kidsLen < key.kidsLen: # XXX: This happens for prematurely cached # types such as Channel[empty]. Why? # See the notes for PActor in handleGenericInvocation @@ -51,7 +49,7 @@ proc searchInstTypes*(g: ModuleGraph; key: PType): PType = continue block matchType: - for j in 1..<len(key): + for j in FirstGenericParamAt..<key.kidsLen: # XXX sameType is not really correct for nested generics? if not compareTypes(inst[j], key[j], flags = {ExactGenericParams, PickyCAliases}): @@ -61,21 +59,21 @@ proc searchInstTypes*(g: ModuleGraph; key: PType): PType = proc cacheTypeInst(c: PContext; inst: PType) = let gt = inst[0] - let t = if gt.kind == tyGenericBody: gt.lastSon else: gt + let t = if gt.kind == tyGenericBody: gt.typeBodyImpl else: gt if t.kind in {tyStatic, tyError, tyGenericParam} + tyTypeClasses: return addToGenericCache(c, gt.sym, inst) type LayeredIdTable* {.acyclic.} = ref object - topLayer*: TIdTable + topLayer*: TypeMapping nextLayer*: LayeredIdTable TReplTypeVars* = object c*: PContext typeMap*: LayeredIdTable # map PType to PType - symMap*: TIdTable # map PSym to PSym - localCache*: TIdTable # local cache for remembering already replaced + symMap*: SymMapping # map PSym to PSym + localCache*: TypeMapping # local cache for remembering already replaced # types during instantiation of meta types # (they are not stored in the global cache) info*: TLineInfo @@ -87,26 +85,26 @@ type recursionLimit: int proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType -proc replaceTypeVarsS(cl: var TReplTypeVars, s: PSym): PSym +proc replaceTypeVarsS(cl: var TReplTypeVars, s: PSym, t: PType): PSym proc replaceTypeVarsN*(cl: var TReplTypeVars, n: PNode; start=0; expectedType: PType = nil): PNode -proc initLayeredTypeMap*(pt: TIdTable): LayeredIdTable = +proc initLayeredTypeMap*(pt: sink TypeMapping): LayeredIdTable = result = LayeredIdTable() - copyIdTable(result.topLayer, pt) + result.topLayer = pt proc newTypeMapLayer*(cl: var TReplTypeVars): LayeredIdTable = - result = LayeredIdTable(nextLayer: cl.typeMap, topLayer: initIdTable()) + result = LayeredIdTable(nextLayer: cl.typeMap, topLayer: initTable[ItemId, PType]()) proc lookup(typeMap: LayeredIdTable, key: PType): PType = result = nil var tm = typeMap while tm != nil: - result = PType(idTableGet(tm.topLayer, key)) + result = getOrDefault(tm.topLayer, key.itemId) if result != nil: return tm = tm.nextLayer template put(typeMap: LayeredIdTable, key, value: PType) = - idTablePut(typeMap.topLayer, key, value) + typeMap.topLayer[key.itemId] = value template checkMetaInvariants(cl: TReplTypeVars, t: PType) = # noop code when false: @@ -120,19 +118,86 @@ proc replaceTypeVarsT*(cl: var TReplTypeVars, t: PType): PType = result = replaceTypeVarsTAux(cl, t) checkMetaInvariants(cl, result) -proc prepareNode(cl: var TReplTypeVars, n: PNode): PNode = +proc prepareNode*(cl: var TReplTypeVars, n: PNode): PNode = + ## instantiates a given generic expression, not a type node + if n.kind == nkSym and n.sym.kind == skType and + n.sym.typ != nil and n.sym.typ.kind == tyGenericBody: + # generic body types are allowed as user expressions, see #24090 + return n let t = replaceTypeVarsT(cl, n.typ) if t != nil and t.kind == tyStatic and t.n != nil: return if tfUnresolved in t.flags: prepareNode(cl, t.n) else: t.n result = copyNode(n) result.typ = t - if result.kind == nkSym: result.sym = replaceTypeVarsS(cl, n.sym) - let isCall = result.kind in nkCallKinds - for i in 0..<n.safeLen: - # XXX HACK: ``f(a, b)``, avoid to instantiate `f` - if isCall and i == 0: result.add(n[i]) - else: result.add(prepareNode(cl, n[i])) + if result.kind == nkSym: + result.sym = + if n.typ != nil and n.typ == n.sym.typ: + replaceTypeVarsS(cl, n.sym, result.typ) + else: + replaceTypeVarsS(cl, n.sym, replaceTypeVarsT(cl, n.sym.typ)) + # we need to avoid trying to instantiate nodes that can have uninstantiated + # types, like generic proc symbols or raw generic type symbols + case n.kind + of nkSymChoices: + # don't try to instantiate symchoice symbols, they can be + # generic procs which the compiler will think are uninstantiated + # because their type will contain uninstantiated params + for i in 0..<n.len: + result.add(n[i]) + of nkCallKinds: + # don't try to instantiate call names since they may be generic proc syms + # also bracket expressions can turn into calls with symchoice [] and + # we need to not instantiate the Generic in Generic[int] + # exception exists for the call name being a dot expression since + # dot expressions need their LHS instantiated + assert n.len != 0 + # avoid instantiating generic proc symbols, refine condition if needed: + let ignoreFirst = n[0].kind notin {nkDotExpr, nkBracketExpr} + nkCallKinds + let name = n[0].getPIdent + let ignoreSecond = name != nil and name.s == "[]" and n.len > 1 and + # generic type instantiation: + ((n[1].typ != nil and n[1].typ.kind == tyTypeDesc) or + # generic proc instantiation: + (n[1].kind == nkSym and n[1].sym.isGenericRoutineStrict)) + if ignoreFirst: + result.add(n[0]) + else: + result.add(prepareNode(cl, n[0])) + if n.len > 1: + if ignoreSecond: + result.add(n[1]) + else: + result.add(prepareNode(cl, n[1])) + for i in 2..<n.len: + result.add(prepareNode(cl, n[i])) + of nkBracketExpr: + # don't instantiate Generic body type in expression like Generic[T] + # exception exists for the call name being a dot expression since + # dot expressions need their LHS instantiated + assert n.len != 0 + let ignoreFirst = n[0].kind != nkDotExpr and + # generic type instantiation: + ((n[0].typ != nil and n[0].typ.kind == tyTypeDesc) or + # generic proc instantiation: + (n[0].kind == nkSym and n[0].sym.isGenericRoutineStrict)) + if ignoreFirst: + result.add(n[0]) + else: + result.add(prepareNode(cl, n[0])) + for i in 1..<n.len: + result.add(prepareNode(cl, n[i])) + of nkDotExpr: + # don't try to instantiate RHS of dot expression, it can outright be + # undeclared, but definitely instantiate LHS + assert n.len >= 2 + result.add(prepareNode(cl, n[0])) + result.add(n[1]) + for i in 2..<n.len: + result.add(prepareNode(cl, n[i])) + else: + for i in 0..<n.safeLen: + result.add(prepareNode(cl, n[i])) proc isTypeParam(n: PNode): bool = # XXX: generic params should use skGenericParam instead of skType @@ -215,6 +280,9 @@ proc replaceTypeVarsN(cl: var TReplTypeVars, n: PNode; start=0; expectedType: PT if n == nil: return result = copyNode(n) if n.typ != nil: + if n.typ.kind == tyFromExpr: + # type of node should not be evaluated as a static value + n.typ.flags.incl tfNonConstExpr result.typ = replaceTypeVarsT(cl, n.typ) checkMetaInvariants(cl, result.typ) case n.kind @@ -222,8 +290,13 @@ proc replaceTypeVarsN(cl: var TReplTypeVars, n: PNode; start=0; expectedType: PT discard of nkOpenSymChoice, nkClosedSymChoice: result = n of nkSym: - result.sym = replaceTypeVarsS(cl, n.sym) - if result.sym.typ.kind == tyVoid: + result.sym = + if n.typ != nil and n.typ == n.sym.typ: + replaceTypeVarsS(cl, n.sym, result.typ) + else: + replaceTypeVarsS(cl, n.sym, replaceTypeVarsT(cl, n.sym.typ)) + # sym type can be nil if was gensym created by macro, see #24048 + if result.sym.typ != nil and result.sym.typ.kind == tyVoid: # don't add the 'void' field result = newNodeI(nkRecList, n.info) of nkRecWhen: @@ -264,7 +337,7 @@ proc replaceTypeVarsN(cl: var TReplTypeVars, n: PNode; start=0; expectedType: PT for i in start..<n.len: result[i] = replaceTypeVarsN(cl, n[i]) -proc replaceTypeVarsS(cl: var TReplTypeVars, s: PSym): PSym = +proc replaceTypeVarsS(cl: var TReplTypeVars, s: PSym, t: PType): PSym = if s == nil: return nil # symbol is not our business: if cl.owner != nil and s.owner != cl.owner: @@ -305,11 +378,14 @@ proc replaceTypeVarsS(cl: var TReplTypeVars, s: PSym): PSym = incl(result.flags, sfFromGeneric) #idTablePut(cl.symMap, s, result) result.owner = s.owner - result.typ = replaceTypeVarsT(cl, s.typ) + result.typ = t if result.kind != skType: result.ast = replaceTypeVarsN(cl, s.ast) proc lookupTypeVar(cl: var TReplTypeVars, t: PType): PType = + if tfRetType in t.flags and t.kind == tyAnything: + # don't bind `auto` return type to a previous binding of `auto` + return nil result = cl.typeMap.lookup(t) if result == nil: if cl.allowMetaTypes or tfRetType in t.flags: return @@ -347,13 +423,13 @@ proc instCopyType*(cl: var TReplTypeVars, t: PType): PType = proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = # tyGenericInvocation[A, tyGenericInvocation[A, B]] # is difficult to handle: - var body = t[0] + var body = t.genericHead if body.kind != tyGenericBody: internalError(cl.c.config, cl.info, "no generic body") var header = t # search for some instantiation here: if cl.allowMetaTypes: - result = PType(idTableGet(cl.localCache, t)) + result = getOrDefault(cl.localCache, t.itemId) else: result = searchInstTypes(cl.c.graph, t) @@ -361,7 +437,7 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = when defined(reportCacheHits): echo "Generic instantiation cached ", typeToString(result), " for ", typeToString(t) return - for i in 1..<t.len: + for i in FirstGenericParamAt..<t.kidsLen: var x = t[i] if x.kind in {tyGenericParam}: x = lookupTypeVar(cl, x) @@ -383,7 +459,7 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = else: header = instCopyType(cl, t) - result = newType(tyGenericInst, cl.c.idgen, t[0].owner, sons = @[header[0]]) + result = newType(tyGenericInst, cl.c.idgen, t.genericHead.owner, son = header.genericHead) result.flags = header.flags # be careful not to propagate unnecessary flags here (don't use rawAddSon) # ugh need another pass for deeply recursive generic types (e.g. PActor) @@ -392,14 +468,14 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = if not cl.allowMetaTypes: cacheTypeInst(cl.c, result) else: - idTablePut(cl.localCache, t, result) + cl.localCache[t.itemId] = result let oldSkipTypedesc = cl.skipTypedesc cl.skipTypedesc = true cl.typeMap = newTypeMapLayer(cl) - for i in 1..<t.len: + for i in FirstGenericParamAt..<t.kidsLen: var x = replaceTypeVarsT(cl): if header[i].kind == tyGenericInst: t[i] @@ -410,7 +486,7 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = propagateToOwner(header, x) cl.typeMap.put(body[i-1], x) - for i in 1..<t.len: + for i in FirstGenericParamAt..<t.kidsLen: # if one of the params is not concrete, we cannot do anything # but we already raised an error! rawAddSon(result, header[i], propagateHasAsgn = false) @@ -418,7 +494,7 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = if body.kind == tyError: return - let bbody = lastSon body + let bbody = last body var newbody = replaceTypeVarsT(cl, bbody) cl.skipTypedesc = oldSkipTypedesc newbody.flags = newbody.flags + (t.flags + body.flags - tfInstClearedFlags) @@ -449,11 +525,11 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = # can come here for tyGenericInst too, see tests/metatype/ttypeor.nim # need to look into this issue later assert newbody.kind in {tyRef, tyPtr} - if newbody.lastSon.typeInst != nil: + if newbody.last.typeInst != nil: #internalError(cl.c.config, cl.info, "ref already has a 'typeInst' field") discard else: - newbody.lastSon.typeInst = result + newbody.last.typeInst = result # DESTROY: adding object|opt for opt[topttree.Tree] # sigmatch: Formal opt[=destroy.T] real opt[topttree.Tree] # adding myseq for myseq[system.int] @@ -473,14 +549,14 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = proc eraseVoidParams*(t: PType) = # transform '(): void' into '()' because old parts of the compiler really # don't deal with '(): void': - if t[0] != nil and t[0].kind == tyVoid: - t[0] = nil + if t.returnType != nil and t.returnType.kind == tyVoid: + t.setReturnType nil - for i in 1..<t.len: + for i in FirstParamAt..<t.signatureLen: # don't touch any memory unless necessary if t[i].kind == tyVoid: var pos = i - for j in i+1..<t.len: + for j in i+1..<t.signatureLen: if t[j].kind != tyVoid: t[pos] = t[j] t.n[pos] = t.n[j] @@ -490,8 +566,7 @@ proc eraseVoidParams*(t: PType) = break proc skipIntLiteralParams*(t: PType; idgen: IdGenerator) = - for i in 0..<t.len: - let p = t[i] + for i, p in t.ikids: if p == nil: continue let skipped = p.skipIntLit(idgen) if skipped != p: @@ -500,8 +575,8 @@ proc skipIntLiteralParams*(t: PType; idgen: IdGenerator) = # when the typeof operator is used on a static input # param, the results gets infected with static as well: - if t[0] != nil and t[0].kind == tyStatic: - t[0] = t[0].base + if t.returnType != nil and t.returnType.kind == tyStatic: + t.setReturnType t.returnType.skipModifier proc propagateFieldFlags(t: PType, n: PNode) = # This is meant for objects and tuples @@ -540,24 +615,27 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = # type # Vector[N: static[int]] = array[N, float64] # TwoVectors[Na, Nb: static[int]] = (Vector[Na], Vector[Nb]) - result = PType(idTableGet(cl.localCache, t)) + result = getOrDefault(cl.localCache, t.itemId) if result != nil: return result inc cl.recursionLimit result = t if t == nil: return - if t.kind in {tyStatic, tyGenericParam, tyConcept} + tyTypeClasses: + const lookupMetas = {tyStatic, tyGenericParam, tyConcept} + tyTypeClasses - {tyAnything} + if t.kind in lookupMetas or + (t.kind == tyAnything and tfRetType notin t.flags): let lookup = cl.typeMap.lookup(t) if lookup != nil: return lookup case t.kind of tyGenericInvocation: result = handleGenericInvocation(cl, t) - if result.lastSon.kind == tyUserTypeClass: + if result.last.kind == tyUserTypeClass: result.kind = tyUserTypeClassInst of tyGenericBody: + if cl.allowMetaTypes: return localError( cl.c.config, cl.info, @@ -576,20 +654,25 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = assert t.n.typ != t var n = prepareNode(cl, t.n) if n.kind != nkEmpty: - n = cl.c.semConstExpr(cl.c, n) + if tfNonConstExpr in t.flags: + n = cl.c.semExprWithType(cl.c, n, flags = {efInTypeof}) + else: + n = cl.c.semConstExpr(cl.c, n) if n.typ.kind == tyTypeDesc: # XXX: sometimes, chained typedescs enter here. # It may be worth investigating why this is happening, # because it may cause other bugs elsewhere. result = n.typ.skipTypes({tyTypeDesc}) # result = n.typ.base + elif tfNonConstExpr in t.flags: + result = n.typ else: if n.typ.kind != tyStatic and n.kind != nkType: # XXX: In the future, semConstExpr should # return tyStatic values to let anyone make # use of this knowledge. The patching here # won't be necessary then. - result = newTypeS(tyStatic, cl.c, sons = @[n.typ]) + result = newTypeS(tyStatic, cl.c, son = n.typ) result.n = n else: result = n.typ @@ -605,19 +688,42 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = result = makeTypeDesc(cl.c, result) elif tfUnresolved in t.flags or cl.skipTypedesc: result = result.base - elif t[0].kind != tyNone: - result = makeTypeDesc(cl.c, replaceTypeVarsT(cl, t[0])) + elif t.elementType.kind != tyNone: + result = makeTypeDesc(cl.c, replaceTypeVarsT(cl, t.elementType)) - of tyUserTypeClass, tyStatic: + of tyUserTypeClass: result = t + + of tyStatic: + if cl.c.matchedConcept != nil: + # allow concepts to not instantiate statics for now + # they can't always infer them + return + if not containsGenericType(t) and (t.n == nil or t.n.kind in nkLiterals): + # no need to instantiate + return + bailout() + result = instCopyType(cl, t) + cl.localCache[t.itemId] = result + for i in FirstGenericParamAt..<result.kidsLen: + var r = result[i] + if r != nil: + r = replaceTypeVarsT(cl, r) + result[i] = r + propagateToOwner(result, r) + result.n = replaceTypeVarsN(cl, result.n) + if not cl.allowMetaTypes and result.n != nil and + result.base.kind != tyNone: + result.n = cl.c.semConstExpr(cl.c, result.n) + result.n.typ = result.base of tyGenericInst, tyUserTypeClassInst: bailout() result = instCopyType(cl, t) - idTablePut(cl.localCache, t, result) - for i in 1..<result.len: + cl.localCache[t.itemId] = result + for i in FirstGenericParamAt..<result.kidsLen: result[i] = replaceTypeVarsT(cl, result[i]) - propagateToOwner(result, result.lastSon) + propagateToOwner(result, result.last) else: if containsGenericType(t): @@ -626,17 +732,17 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = result = instCopyType(cl, t) result.size = -1 # needs to be recomputed #if not cl.allowMetaTypes: - idTablePut(cl.localCache, t, result) + cl.localCache[t.itemId] = result - for i in 0..<result.len: - if result[i] != nil: - if result[i].kind == tyGenericBody: + for i, resulti in result.ikids: + if resulti != nil: + if resulti.kind == tyGenericBody and not cl.allowMetaTypes: localError(cl.c.config, if t.sym != nil: t.sym.info else: cl.info, "cannot instantiate '" & typeToString(result[i], preferDesc) & "' inside of type definition: '" & t.owner.name.s & "'; Maybe generic arguments are missing?") - var r = replaceTypeVarsT(cl, result[i]) + var r = replaceTypeVarsT(cl, resulti) if result.kind == tyObject: # carefully coded to not skip the precious tyGenericInst: let r2 = r.skipTypes({tyAlias, tySink, tyOwned}) @@ -649,7 +755,7 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = result.n = replaceTypeVarsN(cl, result.n, ord(result.kind==tyProc)) case result.kind of tyArray: - let idx = result[0] + let idx = result.indexType internalAssert cl.c.config, idx.kind != tyStatic of tyObject, tyTuple: @@ -662,7 +768,7 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = skipIntLiteralParams(result, cl.c.idgen) of tyRange: - result[0] = result[0].skipTypes({tyStatic, tyDistinct}) + result.setIndexType result.indexType.skipTypes({tyStatic, tyDistinct}) else: discard else: @@ -671,8 +777,8 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = result = t # Slow path, we have some work to do - if t.kind == tyRef and t.len > 0 and t[0].kind == tyObject and t[0].n != nil: - discard replaceObjBranches(cl, t[0].n) + if t.kind == tyRef and t.hasElementType and t.elementType.kind == tyObject and t.elementType.n != nil: + discard replaceObjBranches(cl, t.elementType.n) elif result.n != nil and t.kind == tyObject: # Invalidate the type size as we may alter its structure @@ -681,11 +787,11 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = proc initTypeVars*(p: PContext, typeMap: LayeredIdTable, info: TLineInfo; owner: PSym): TReplTypeVars = - result = TReplTypeVars(symMap: initIdTable(), - localCache: initIdTable(), typeMap: typeMap, + result = TReplTypeVars(symMap: initSymMapping(), + localCache: initTypeMapping(), typeMap: typeMap, info: info, c: p, owner: owner) -proc replaceTypesInBody*(p: PContext, pt: TIdTable, n: PNode; +proc replaceTypesInBody*(p: PContext, pt: TypeMapping, n: PNode; owner: PSym, allowMetaTypes = false, fromStaticExpr = false, expectedType: PType = nil): PNode = var typeMap = initLayeredTypeMap(pt) @@ -695,6 +801,14 @@ proc replaceTypesInBody*(p: PContext, pt: TIdTable, n: PNode; result = replaceTypeVarsN(cl, n, expectedType = expectedType) popInfoContext(p.config) +proc prepareTypesInBody*(p: PContext, pt: TypeMapping, n: PNode; + owner: PSym = nil): PNode = + var typeMap = initLayeredTypeMap(pt) + var cl = initTypeVars(p, typeMap, n.info, owner) + pushInfoContext(p.config, n.info) + result = prepareNode(cl, n) + popInfoContext(p.config) + when false: # deadcode proc replaceTypesForLambda*(p: PContext, pt: TIdTable, n: PNode; @@ -707,8 +821,8 @@ when false: popInfoContext(p.config) proc recomputeFieldPositions*(t: PType; obj: PNode; currPosition: var int) = - if t != nil and t.len > 0 and t[0] != nil: - let b = skipTypes(t[0], skipPtrs) + if t != nil and t.baseClass != nil: + let b = skipTypes(t.baseClass, skipPtrs) recomputeFieldPositions(b, b.n, currPosition) case obj.kind of nkRecList: @@ -722,7 +836,7 @@ proc recomputeFieldPositions*(t: PType; obj: PNode; currPosition: var int) = inc currPosition else: discard "cannot happen" -proc generateTypeInstance*(p: PContext, pt: TIdTable, info: TLineInfo, +proc generateTypeInstance*(p: PContext, pt: TypeMapping, info: TLineInfo, t: PType): PType = # Given `t` like Foo[T] # pt: Table with type mappings: T -> int @@ -738,7 +852,7 @@ proc generateTypeInstance*(p: PContext, pt: TIdTable, info: TLineInfo, var position = 0 recomputeFieldPositions(objType, objType.n, position) -proc prepareMetatypeForSigmatch*(p: PContext, pt: TIdTable, info: TLineInfo, +proc prepareMetatypeForSigmatch*(p: PContext, pt: TypeMapping, info: TLineInfo, t: PType): PType = var typeMap = initLayeredTypeMap(pt) var cl = initTypeVars(p, typeMap, info, nil) @@ -747,6 +861,6 @@ proc prepareMetatypeForSigmatch*(p: PContext, pt: TIdTable, info: TLineInfo, result = replaceTypeVarsT(cl, t) popInfoContext(p.config) -template generateTypeInstance*(p: PContext, pt: TIdTable, arg: PNode, +template generateTypeInstance*(p: PContext, pt: TypeMapping, arg: PNode, t: PType): untyped = generateTypeInstance(p, pt, arg.info, t) diff --git a/compiler/sighashes.nim b/compiler/sighashes.nim index 2f1a72fd6..d8dfe1828 100644 --- a/compiler/sighashes.nim +++ b/compiler/sighashes.nim @@ -55,6 +55,8 @@ proc hashSym(c: var MD5Context, s: PSym) = c &= it.name.s c &= "." it = it.owner + c &= "#" + c &= s.disamb proc hashTypeSym(c: var MD5Context, s: PSym; conf: ConfigRef) = if sfAnon in s.flags or s.kind == skGenericParam: @@ -69,6 +71,8 @@ proc hashTypeSym(c: var MD5Context, s: PSym; conf: ConfigRef) = c &= it.name.s c &= "." it = it.owner + c &= "#" + c &= s.disamb proc hashTree(c: var MD5Context, n: PNode; flags: set[ConsiderFlag]; conf: ConfigRef) = if n == nil: @@ -104,15 +108,15 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]; conf: Confi case t.kind of tyGenericInvocation: - for i in 0..<t.len: - c.hashType t[i], flags, conf + for a in t.kids: + c.hashType a, flags, conf of tyDistinct: if CoDistinct in flags: if t.sym != nil: c.hashSym(t.sym) if t.sym == nil or tfFromGeneric in t.flags: - c.hashType t.lastSon, flags, conf + c.hashType t.elementType, flags, conf elif CoType in flags or t.sym == nil: - c.hashType t.lastSon, flags, conf + c.hashType t.elementType, flags, conf else: c.hashSym(t.sym) of tyGenericInst: @@ -121,16 +125,17 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]; conf: Confi # We cannot trust the `lastSon` to hold a properly populated and unique # value for each instantiation, so we hash the generic parameters here: let normalizedType = t.skipGenericAlias - for i in 0..<normalizedType.len - 1: - c.hashType t[i], flags, conf + c.hashType normalizedType.genericHead, flags, conf + for _, a in normalizedType.genericInstParams: + c.hashType a, flags, conf else: - c.hashType t.lastSon, flags, conf + c.hashType t.skipModifier, flags, conf of tyAlias, tySink, tyUserTypeClasses, tyInferred: - c.hashType t.lastSon, flags, conf + c.hashType t.skipModifier, flags, conf of tyOwned: if CoConsiderOwned in flags: c &= char(t.kind) - c.hashType t.lastSon, flags, conf + c.hashType t.skipModifier, flags, conf of tyBool, tyChar, tyInt..tyUInt64: # no canonicalization for integral types, so that e.g. ``pid_t`` is # produced instead of ``NI``: @@ -143,8 +148,9 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]; conf: Confi let inst = t.typeInst t.typeInst = nil assert inst.kind == tyGenericInst - for i in 0..<inst.len - 1: - c.hashType inst[i], flags, conf + c.hashType inst.genericHead, flags, conf + for _, a in inst.genericInstParams: + c.hashType a, flags, conf t.typeInst = inst return c &= char(t.kind) @@ -152,9 +158,9 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]; conf: Confi # is actually safe without an infinite recursion check: if t.sym != nil: if {sfCompilerProc} * t.sym.flags != {}: - doAssert t.sym.loc.r != "" + doAssert t.sym.loc.snippet != "" # The user has set a specific name for this type - c &= t.sym.loc.r + c &= t.sym.loc.snippet elif CoOwnerSig in flags: c.hashTypeSym(t.sym, conf) else: @@ -184,37 +190,40 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]; conf: Confi c &= ".empty" else: c &= t.id - if t.len > 0 and t[0] != nil: - hashType c, t[0], flags, conf - of tyRef, tyPtr, tyGenericBody, tyVar: + if t.hasElementType and t.baseClass != nil: + hashType c, t.baseClass, flags, conf + of tyRef, tyPtr, tyVar: c &= char(t.kind) - if t.len > 0: - c.hashType t.lastSon, flags, conf + if t.hasElementType: + c.hashType t.elementType, flags, conf if tfVarIsPtr in t.flags: c &= ".varisptr" + of tyGenericBody: + c &= char(t.kind) + if t.hasElementType: + c.hashType t.typeBodyImpl, flags, conf of tyFromExpr: c &= char(t.kind) c.hashTree(t.n, {}, conf) of tyTuple: c &= char(t.kind) if t.n != nil and CoType notin flags: - assert(t.n.len == t.len) for i in 0..<t.n.len: assert(t.n[i].kind == nkSym) c &= t.n[i].sym.name.s c &= ':' - c.hashType(t[i], flags+{CoIgnoreRange}, conf) + c.hashType(t.n[i].sym.typ, flags+{CoIgnoreRange}, conf) c &= ',' else: - for i in 0..<t.len: c.hashType t[i], flags+{CoIgnoreRange}, conf + for a in t.kids: c.hashType a, flags+{CoIgnoreRange}, conf of tyRange: if CoIgnoreRange notin flags: c &= char(t.kind) c.hashTree(t.n, {}, conf) - c.hashType(t[0], flags, conf) + c.hashType(t.elementType, flags, conf) of tyStatic: c &= char(t.kind) c.hashTree(t.n, {}, conf) - c.hashType(t[0], flags, conf) + c.hashType(t.skipModifier, flags, conf) of tyProc: c &= char(t.kind) c &= (if tfIterator in t.flags: "iterator " else: "proc ") @@ -226,9 +235,9 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]; conf: Confi c &= ':' c.hashType(param.typ, flags, conf) c &= ',' - c.hashType(t[0], flags, conf) + c.hashType(t.returnType, flags, conf) else: - for i in 0..<t.len: c.hashType(t[i], flags, conf) + for a in t.signature: c.hashType(a, flags, conf) c &= char(t.callConv) # purity of functions doesn't have to affect the mangling (which is in fact # problematic for HCR - someone could have cached a pointer to another @@ -240,10 +249,11 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]; conf: Confi if tfVarargs in t.flags: c &= ".varargs" of tyArray: c &= char(t.kind) - for i in 0..<t.len: c.hashType(t[i], flags-{CoIgnoreRange}, conf) + c.hashType(t.indexType, flags-{CoIgnoreRange}, conf) + c.hashType(t.elementType, flags-{CoIgnoreRange}, conf) else: c &= char(t.kind) - for i in 0..<t.len: c.hashType(t[i], flags, conf) + for a in t.kids: c.hashType(a, flags, conf) if tfNotNil in t.flags and CoType notin flags: c &= "not nil" when defined(debugSigHashes): @@ -262,7 +272,7 @@ when defined(debugSigHashes): proc hashType*(t: PType; conf: ConfigRef; flags: set[ConsiderFlag] = {CoType}): SigHash = result = default(SigHash) - var c: MD5Context + var c: MD5Context = default(MD5Context) md5Init c hashType c, t, flags+{CoOwnerSig}, conf md5Final c, result.MD5Digest @@ -272,7 +282,7 @@ proc hashType*(t: PType; conf: ConfigRef; flags: set[ConsiderFlag] = {CoType}): proc hashProc(s: PSym; conf: ConfigRef): SigHash = result = default(SigHash) - var c: MD5Context + var c: MD5Context = default(MD5Context) md5Init c hashType c, s.typ, {CoProc}, conf @@ -293,7 +303,7 @@ proc hashProc(s: PSym; conf: ConfigRef): SigHash = proc hashNonProc*(s: PSym): SigHash = result = default(SigHash) - var c: MD5Context + var c: MD5Context = default(MD5Context) md5Init c hashSym(c, s) var it = s @@ -310,7 +320,7 @@ proc hashNonProc*(s: PSym): SigHash = proc hashOwner*(s: PSym): SigHash = result = default(SigHash) - var c: MD5Context + var c: MD5Context = default(MD5Context) md5Init c var m = s while m.kind != skModule: m = m.owner @@ -383,7 +393,7 @@ proc symBodyDigest*(graph: ModuleGraph, sym: PSym): SigHash = graph.symBodyHashes.withValue(sym.id, value): return value[] - var c: MD5Context + var c: MD5Context = default(MD5Context) md5Init(c) c.hashType(sym.typ, {CoProc}, graph.config) c &= char(sym.kind) diff --git a/compiler/sigmatch.nim b/compiler/sigmatch.nim index aa7a72dd9..6ea2c7bb5 100644 --- a/compiler/sigmatch.nim +++ b/compiler/sigmatch.nim @@ -15,7 +15,7 @@ import magicsys, idents, lexer, options, parampatterns, trees, linter, lineinfos, lowerings, modulegraphs, concepts -import std/[intsets, strutils] +import std/[intsets, strutils, tables] when defined(nimPreviewSlimSystem): import std/assertions @@ -23,7 +23,8 @@ when defined(nimPreviewSlimSystem): type MismatchKind* = enum kUnknown, kAlreadyGiven, kUnknownNamedParam, kTypeMismatch, kVarNeeded, - kMissingParam, kExtraArg, kPositionalAlreadyGiven + kMissingParam, kExtraArg, kPositionalAlreadyGiven, + kGenericParamTypeMismatch, kMissingGenericParam, kExtraGenericParam MismatchInfo* = object kind*: MismatchKind # reason for mismatch @@ -55,12 +56,12 @@ type calleeScope*: int # scope depth: # is this a top-level symbol or a nested proc? call*: PNode # modified call - bindings*: TIdTable # maps types to types + bindings*: TypeMapping # maps types to types magic*: TMagic # magic of operation baseTypeMatch: bool # needed for conversions from T to openarray[T] # for example - fauxMatch*: TTypeKind # the match was successful only due to the use - # of error or wildcard (unknown) types. + matchedErrorType*: bool # match is considered successful after matching + # error type to avoid cascading errors # this is used to prevent instantiations. genericConverter*: bool # true if a generic converter needs to # be instantiated @@ -80,7 +81,8 @@ type # or when the explain pragma is used. may be # triggered with an idetools command in the # future. - inheritancePenalty: int # to prefer closest father object type + # to prefer closest father object type + inheritancePenalty: int firstMismatch*: MismatchInfo # mismatch info for better error messages diagnosticsEnabled*: bool @@ -95,32 +97,31 @@ type const isNilConversion = isConvertible # maybe 'isIntConv' fits better? + maxInheritancePenalty = high(int) div 2 -proc markUsed*(c: PContext; info: TLineInfo, s: PSym) +proc markUsed*(c: PContext; info: TLineInfo, s: PSym; checkStyle = true) proc markOwnerModuleAsUsed*(c: PContext; s: PSym) -template hasFauxMatch*(c: TCandidate): bool = c.fauxMatch != tyNone - proc initCandidateAux(ctx: PContext, callee: PType): TCandidate {.inline.} = result = TCandidate(c: ctx, exactMatches: 0, subtypeMatches: 0, convMatches: 0, intConvMatches: 0, genericMatches: 0, state: csEmpty, firstMismatch: MismatchInfo(), callee: callee, call: nil, baseTypeMatch: false, - genericConverter: false, inheritancePenalty: 0 + genericConverter: false, inheritancePenalty: -1 ) proc initCandidate*(ctx: PContext, callee: PType): TCandidate = result = initCandidateAux(ctx, callee) result.calleeSym = nil - result.bindings = initIdTable() + result.bindings = initTypeMapping() proc put(c: var TCandidate, key, val: PType) {.inline.} = ## Given: proc foo[T](x: T); foo(4) ## key: 'T' ## val: 'int' (typeof(4)) when false: - let old = PType(idTableGet(c.bindings, key)) + let old = idTableGet(c.bindings, key) if old != nil: echo "Putting ", typeToString(key), " ", typeToString(val), " and old is ", typeToString(old) if typeToString(old) == "float32": @@ -129,39 +130,138 @@ proc put(c: var TCandidate, key, val: PType) {.inline.} = echo "binding ", key, " -> ", val idTablePut(c.bindings, key, val.skipIntLit(c.c.idgen)) +proc typeRel*(c: var TCandidate, f, aOrig: PType, + flags: TTypeRelFlags = {}): TTypeRelation + +proc matchGenericParam(m: var TCandidate, formal: PType, n: PNode) = + var arg = n.typ + if m.c.inGenericContext > 0: + # don't match yet-unresolved generic instantiations + while arg != nil and arg.kind == tyGenericParam: + arg = idTableGet(m.bindings, arg) + if arg == nil or arg.containsUnresolvedType: + m.state = csNoMatch + return + # fix up the type to get ready to match formal: + var formalBase = formal + while formalBase.kind == tyGenericParam and + formalBase.genericParamHasConstraints: + formalBase = formalBase.genericConstraint + if formalBase.kind == tyStatic and arg.kind != tyStatic: + # maybe call `paramTypesMatch` here, for now be conservative + if n.kind in nkSymChoices: n.flags.excl nfSem + let evaluated = m.c.semTryConstExpr(m.c, n, formalBase.skipTypes({tyStatic})) + if evaluated != nil: + arg = newTypeS(tyStatic, m.c, son = evaluated.typ) + arg.n = evaluated + elif formalBase.kind == tyTypeDesc: + if arg.kind != tyTypeDesc: + arg = makeTypeDesc(m.c, arg) + else: + arg = arg.skipTypes({tyTypeDesc}) + let tm = typeRel(m, formal, arg) + if tm in {isNone, isConvertible}: + m.state = csNoMatch + m.firstMismatch.kind = kGenericParamTypeMismatch + return + +proc matchGenericParams*(m: var TCandidate, binding: PNode, callee: PSym) = + ## matches explicit generic instantiation `binding` against generic params of + ## proc symbol `callee` + ## state is set to `csMatch` if all generic params match, `csEmpty` if + ## implicit generic parameters are missing (matches but cannot instantiate), + ## `csNoMatch` if a constraint fails or param count doesn't match + let c = m.c + let typeParams = callee.ast[genericParamsPos] + let paramCount = typeParams.len + let bindingCount = binding.len-1 + if bindingCount > paramCount: + m.state = csNoMatch + m.firstMismatch.kind = kExtraGenericParam + m.firstMismatch.arg = paramCount + 1 + return + for i in 1..bindingCount: + matchGenericParam(m, typeParams[i-1].typ, binding[i]) + if m.state == csNoMatch: + m.firstMismatch.arg = i + m.firstMismatch.formal = typeParams[i-1].sym + return + # not enough generic params given, check if remaining have defaults: + for i in bindingCount ..< paramCount: + let param = typeParams[i] + assert param.kind == nkSym + let paramSym = param.sym + if paramSym.ast != nil: + matchGenericParam(m, param.typ, paramSym.ast) + if m.state == csNoMatch: + m.firstMismatch.arg = i + 1 + m.firstMismatch.formal = paramSym + return + elif tfImplicitTypeParam in paramSym.typ.flags: + # not a mismatch, but can't create sym + m.state = csEmpty + return + else: + m.state = csNoMatch + m.firstMismatch.kind = kMissingGenericParam + m.firstMismatch.arg = i + 1 + m.firstMismatch.formal = paramSym + return + m.state = csMatch + +proc copyingEraseVoidParams(m: TCandidate, t: var PType) = + ## if `t` is a proc type with void parameters, copies it and erases them + assert t.kind == tyProc + let original = t + var copied = false + for i in 1 ..< original.len: + var f = original[i] + var isVoidParam = f.kind == tyVoid + if not isVoidParam: + let prev = idTableGet(m.bindings, f) + if prev != nil: f = prev + isVoidParam = f.kind == tyVoid + if isVoidParam: + if not copied: + # keep first i children + t = copyType(original, m.c.idgen, t.owner) + t.setSonsLen(i) + t.n = copyNode(original.n) + t.n.sons = original.n.sons + t.n.sons.setLen(i) + copied = true + elif copied: + t.add(f) + t.n.add(original.n[i]) + proc initCandidate*(ctx: PContext, callee: PSym, binding: PNode, calleeScope = -1, diagnosticsEnabled = false): TCandidate = result = initCandidateAux(ctx, callee.typ) result.calleeSym = callee if callee.kind in skProcKinds and calleeScope == -1: - if callee.originatingModule == ctx.module: - result.calleeScope = 2 - var owner = callee - while true: - owner = owner.skipGenericOwner - if owner.kind == skModule: break - inc result.calleeScope - else: - result.calleeScope = 1 + result.calleeScope = cmpScopes(ctx, callee) else: result.calleeScope = calleeScope result.diagnostics = @[] # if diagnosticsEnabled: @[] else: nil result.diagnosticsEnabled = diagnosticsEnabled result.magic = result.calleeSym.magic - result.bindings = initIdTable() + result.bindings = initTypeMapping() if binding != nil and callee.kind in routineKinds: - var typeParams = callee.ast[genericParamsPos] - for i in 1..min(typeParams.len, binding.len-1): - var formalTypeParam = typeParams[i-1].typ - var bound = binding[i].typ - if bound != nil: - if formalTypeParam.kind == tyTypeDesc: - if bound.kind != tyTypeDesc: - bound = makeTypeDesc(ctx, bound) - else: - bound = bound.skipTypes({tyTypeDesc}) - put(result, formalTypeParam, bound) + matchGenericParams(result, binding, callee) + let genericMatch = result.state + if genericMatch != csNoMatch: + result.state = csEmpty + if genericMatch == csMatch: # csEmpty if not fully instantiated + # instantiate the type, emulates old compiler behavior + # wouldn't be needed if sigmatch could handle complex cases, + # examples are in texplicitgenerics + # might be buggy, see rest of generateInstance if problems occur + let typ = ctx.instantiateOnlyProcType(ctx, result.bindings, callee, binding.info) + result.callee = typ + else: + # createThread[void] requires this if the above branch is removed: + copyingEraseVoidParams(result, result.callee) proc newCandidate*(ctx: PContext, callee: PSym, binding: PNode, calleeScope = -1): TCandidate = @@ -170,37 +270,34 @@ proc newCandidate*(ctx: PContext, callee: PSym, proc newCandidate*(ctx: PContext, callee: PType): TCandidate = result = initCandidate(ctx, callee) -proc copyCandidate(a: var TCandidate, b: TCandidate) = - a.c = b.c - a.exactMatches = b.exactMatches - a.subtypeMatches = b.subtypeMatches - a.convMatches = b.convMatches - a.intConvMatches = b.intConvMatches - a.genericMatches = b.genericMatches - a.state = b.state - a.callee = b.callee - a.calleeSym = b.calleeSym - a.call = copyTree(b.call) - a.baseTypeMatch = b.baseTypeMatch - copyIdTable(a.bindings, b.bindings) - -proc typeRel*(c: var TCandidate, f, aOrig: PType, - flags: TTypeRelFlags = {}): TTypeRelation +proc copyCandidate(dest: var TCandidate, src: TCandidate) = + dest.c = src.c + dest.exactMatches = src.exactMatches + dest.subtypeMatches = src.subtypeMatches + dest.convMatches = src.convMatches + dest.intConvMatches = src.intConvMatches + dest.genericMatches = src.genericMatches + dest.state = src.state + dest.callee = src.callee + dest.calleeSym = src.calleeSym + dest.call = copyTree(src.call) + dest.baseTypeMatch = src.baseTypeMatch + dest.bindings = src.bindings proc checkGeneric(a, b: TCandidate): int = let c = a.c let aa = a.callee let bb = b.callee var winner = 0 - for i in 1..<min(aa.len, bb.len): - var ma = newCandidate(c, bb[i]) - let tra = typeRel(ma, bb[i], aa[i], {trDontBind}) - var mb = newCandidate(c, aa[i]) - let trb = typeRel(mb, aa[i], bb[i], {trDontBind}) - if tra == isGeneric and trb == isNone: + for aai, bbi in underspecifiedPairs(aa, bb, 1): + var ma = newCandidate(c, bbi) + let tra = typeRel(ma, bbi, aai, {trDontBind}) + var mb = newCandidate(c, aai) + let trb = typeRel(mb, aai, bbi, {trDontBind}) + if tra == isGeneric and trb in {isNone, isInferred, isInferredConvertible}: if winner == -1: return 0 winner = 1 - if trb == isGeneric and tra == isNone: + if trb == isGeneric and tra in {isNone, isInferred, isInferredConvertible}: if winner == 1: return 0 winner = -1 result = winner @@ -211,54 +308,63 @@ proc sumGeneric(t: PType): int = # specific than Foo[T]. result = 0 var t = t - var isvar = 0 while true: case t.kind - of tyGenericInst, tyArray, tyRef, tyPtr, tyDistinct, tyUncheckedArray, - tyOpenArray, tyVarargs, tySet, tyRange, tySequence, tyGenericBody, - tyLent, tyOwned: - t = t.lastSon + of tyAlias, tySink, tyNot: t = t.skipModifier + of tyArray, tyRef, tyPtr, tyDistinct, tyUncheckedArray, + tyOpenArray, tyVarargs, tySet, tyRange, tySequence, + tyLent, tyOwned, tyVar: + t = t.elementType + inc result + of tyBool, tyChar, tyEnum, tyObject, tyPointer, tyVoid, + tyString, tyCstring, tyInt..tyInt64, tyFloat..tyFloat128, + tyUInt..tyUInt64, tyCompositeTypeClass, tyBuiltInTypeClass: + inc result + break + of tyGenericBody: + t = t.typeBodyImpl + of tyGenericInst, tyStatic: + t = t.skipModifier inc result of tyOr: var maxBranch = 0 - for branch in t: + for branch in t.kids: let branchSum = sumGeneric(branch) if branchSum > maxBranch: maxBranch = branchSum inc result, maxBranch break - of tyVar: - t = t[0] - inc result - inc isvar of tyTypeDesc: - t = t.lastSon + t = t.elementType if t.kind == tyEmpty: break inc result - of tyGenericInvocation, tyTuple, tyProc, tyAnd: - result += ord(t.kind in {tyGenericInvocation, tyAnd}) - for i in 0..<t.len: - if t[i] != nil: - result += sumGeneric(t[i]) + of tyGenericParam: + if t.len > 0: + t = t.skipModifier + else: + inc result + break + of tyUntyped, tyTyped: break + of tyGenericInvocation, tyTuple, tyAnd: + result += ord(t.kind == tyAnd) + for a in t.kids: + if a != nil: + result += sumGeneric(a) + break + of tyProc: + if t.returnType != nil: + result += sumGeneric(t.returnType) + for _, a in t.paramTypes: + result += sumGeneric(a) break - of tyStatic: - return sumGeneric(t[0]) + 1 - of tyGenericParam, tyUntyped, tyTyped: break - of tyAlias, tySink: t = t.lastSon - of tyBool, tyChar, tyEnum, tyObject, tyPointer, - tyString, tyCstring, tyInt..tyInt64, tyFloat..tyFloat128, - tyUInt..tyUInt64, tyCompositeTypeClass: - return isvar + 1 - of tyBuiltInTypeClass: - return isvar else: - return 0 + break proc complexDisambiguation(a, b: PType): int = # 'a' matches better if *every* argument matches better or equal than 'b'. var winner = 0 - for i in 1..<min(a.len, b.len): - let x = a[i].sumGeneric - let y = b[i].sumGeneric + for ai, bi in underspecifiedPairs(a, b, 1): + let x = ai.sumGeneric + let y = bi.sumGeneric if x != y: if winner == 0: if x > y: winner = 1 @@ -273,8 +379,8 @@ proc complexDisambiguation(a, b: PType): int = result = winner when false: var x, y: int - for i in 1..<a.len: x += a[i].sumGeneric - for i in 1..<b.len: y += b[i].sumGeneric + for i in 1..<a.len: x += ai.sumGeneric + for i in 1..<b.len: y += bi.sumGeneric result = x - y proc writeMatches*(c: TCandidate) = @@ -286,7 +392,16 @@ proc writeMatches*(c: TCandidate) = echo " conv matches: ", c.convMatches echo " inheritance: ", c.inheritancePenalty -proc cmpCandidates*(a, b: TCandidate): int = +proc cmpInheritancePenalty(a, b: int): int = + var eb = b + var ea = a + if b < 0: + eb = maxInheritancePenalty # defacto max penalty + if a < 0: + ea = maxInheritancePenalty + eb - ea + +proc cmpCandidates*(a, b: TCandidate, isFormal=true): int = result = a.exactMatches - b.exactMatches if result != 0: return result = a.genericMatches - b.genericMatches @@ -297,16 +412,16 @@ proc cmpCandidates*(a, b: TCandidate): int = if result != 0: return result = a.convMatches - b.convMatches if result != 0: return - # the other way round because of other semantics: - result = b.inheritancePenalty - a.inheritancePenalty + result = cmpInheritancePenalty(a.inheritancePenalty, b.inheritancePenalty) if result != 0: return - # check for generic subclass relation - result = checkGeneric(a, b) + if isFormal: + # check for generic subclass relation + result = checkGeneric(a, b) + if result != 0: return + # prefer more specialized generic over more general generic: + result = complexDisambiguation(a.callee, b.callee) if result != 0: return - # prefer more specialized generic over more general generic: - result = complexDisambiguation(a.callee, b.callee) # only as a last resort, consider scoping: - if result != 0: return result = a.calleeScope - b.calleeScope proc argTypeToString(arg: PNode; prefer: TPreferedDesc): string = @@ -326,16 +441,27 @@ template describeArgImpl(c: PContext, n: PNode, i: int, startIdx = 1; prefer = p result.add renderTree(n[i][0]) result.add ": " if arg.typ.isNil and arg.kind notin {nkStmtList, nkDo}: - # XXX we really need to 'tryExpr' here! - arg = c.semOperand(c, n[i][1]) - n[i].typ = arg.typ - n[i][1] = arg + arg = c.semTryExpr(c, n[i][1]) + if arg == nil: + arg = n[i][1] + arg.typ = newTypeS(tyUntyped, c) + else: + if arg.typ == nil: + arg.typ = newTypeS(tyVoid, c) + n[i].typ = arg.typ + n[i][1] = arg else: if arg.typ.isNil and arg.kind notin {nkStmtList, nkDo, nkElse, nkOfBranch, nkElifBranch, nkExceptBranch}: - arg = c.semOperand(c, n[i]) - n[i] = arg + arg = c.semTryExpr(c, n[i]) + if arg == nil: + arg = n[i] + arg.typ = newTypeS(tyUntyped, c) + else: + if arg.typ == nil: + arg.typ = newTypeS(tyVoid, c) + n[i] = arg if arg.typ != nil and arg.typ.kind == tyError: return result.add argTypeToString(arg, prefer) @@ -355,12 +481,13 @@ proc concreteType(c: TCandidate, t: PType; f: PType = nil): PType = if c.isNoCall: result = t else: result = nil of tySequence, tySet: - if t[0].kind == tyEmpty: result = nil + if t.elementType.kind == tyEmpty: result = nil else: result = t of tyGenericParam, tyAnything, tyConcept: result = t + if c.isNoCall: return while true: - result = PType(idTableGet(c.bindings, t)) + result = idTableGet(c.bindings, t) if result == nil: break # it's ok, no match # example code that triggers it: @@ -371,8 +498,8 @@ proc concreteType(c: TCandidate, t: PType; f: PType = nil): PType = of tyOwned: # bug #11257: the comparison system.`==`[T: proc](x, y: T) works # better without the 'owned' type: - if f != nil and f.len > 0 and f[0].skipTypes({tyBuiltInTypeClass, tyOr}).kind == tyProc: - result = t.lastSon + if f != nil and f.hasElementType and f.elementType.skipTypes({tyBuiltInTypeClass, tyOr}).kind == tyProc: + result = t.skipModifier else: result = t else: @@ -386,9 +513,16 @@ proc handleRange(c: PContext, f, a: PType, min, max: TTypeKind): TTypeRelation = let k = ab.kind let nf = c.config.normalizeKind(f.kind) let na = c.config.normalizeKind(k) - if k == f.kind: result = isSubrange - elif k == tyInt and f.kind in {tyRange, tyInt..tyInt64, - tyUInt..tyUInt64} and + if k == f.kind: + # `a` is a range type matching its base type + # see very bottom for range types matching different types + if isIntLit(ab): + # range type can only give isFromIntLit for base type + result = isFromIntLit + else: + result = isSubrange + elif a.kind == tyInt and f.kind in {tyRange, tyInt..tyInt64, + tyUInt..tyUInt64} and isIntLit(ab) and getInt(ab.n) >= firstOrd(nil, f) and getInt(ab.n) <= lastOrd(nil, f): # passing 'nil' to firstOrd/lastOrd here as type checking rules should @@ -455,43 +589,50 @@ proc handleFloatRange(f, a: PType): TTypeRelation = else: result = isIntConv else: result = isNone -proc getObjectTypeOrNil(f: PType): PType = +proc reduceToBase(f: PType): PType = #[ - Returns a type that is f's effective typeclass. This is usually just one level deeper - in the hierarchy of generality for a type. `object`, `ref object`, `enum` and user defined - tyObjects are common return values. + Returns the lowest order (most general) type that that is compatible with the input. + E.g. + A[T] = ptr object ... A -> ptr object + A[N: static[int]] = array[N, int] ... A -> array ]# - if f == nil: return nil case f.kind: - of tyGenericInvocation, tyCompositeTypeClass, tyAlias: - if f.len <= 0 or f[0] == nil: - result = nil + of tyGenericParam: + if f.len <= 0 or f.skipModifier == nil: + result = f + else: + result = reduceToBase(f.skipModifier) + of tyGenericInvocation: + result = reduceToBase(f.baseClass) + of tyCompositeTypeClass, tyAlias: + if not f.hasElementType or f.elementType == nil: + result = f else: - result = getObjectTypeOrNil(f[0]) - of tyGenericBody, tyGenericInst: - result = getObjectTypeOrNil(f.lastSon) + result = reduceToBase(f.elementType) + of tyGenericInst: + result = reduceToBase(f.skipModifier) + of tyGenericBody: + result = reduceToBase(f.typeBodyImpl) of tyUserTypeClass: if f.isResolvedUserTypeClass: result = f.base # ?? idk if this is right else: - result = f.lastSon + result = f.skipModifier of tyStatic, tyOwned, tyVar, tyLent, tySink: - result = getObjectTypeOrNil(f.base) + result = reduceToBase(f.base) of tyInferred: # This is not true "After a candidate type is selected" - result = getObjectTypeOrNil(f.base) - of tyTyped, tyUntyped, tyFromExpr: - result = nil + result = reduceToBase(f.base) of tyRange: - result = f.lastSon + result = f.elementType else: result = f proc genericParamPut(c: var TCandidate; last, fGenericOrigin: PType) = if fGenericOrigin != nil and last.kind == tyGenericInst and - last.len-1 == fGenericOrigin.len: - for i in 1..<fGenericOrigin.len: - let x = PType(idTableGet(c.bindings, fGenericOrigin[i])) + last.kidsLen-1 == fGenericOrigin.kidsLen: + for i in FirstGenericParamAt..<fGenericOrigin.kidsLen: + let x = idTableGet(c.bindings, fGenericOrigin[i]) if x == nil: put(c, fGenericOrigin[i], last[i]) @@ -503,7 +644,7 @@ proc isObjectSubtype(c: var TCandidate; a, f, fGenericOrigin: PType): int = while t != nil and not sameObjectTypes(f, t): if t.kind != tyObject: # avoid entering generic params etc return -1 - t = t[0] + t = t.baseClass if t == nil: break last = t t = skipTypes(t, skipPtrs) @@ -524,17 +665,19 @@ proc skipToObject(t: PType; skipped: var SkippedPtr): PType = while r != nil: case r.kind of tyGenericInvocation: - r = r[0] + r = r.genericHead of tyRef: inc ptrs skipped = skippedRef - r = r.lastSon + r = r.elementType of tyPtr: inc ptrs skipped = skippedPtr - r = r.lastSon - of tyGenericBody, tyGenericInst, tyAlias, tySink, tyOwned: - r = r.lastSon + r = r.elementType + of tyGenericInst, tyAlias, tySink, tyOwned: + r = r.elementType + of tyGenericBody: + r = r.typeBodyImpl else: break if r.kind == tyObject and ptrs <= 1: result = r @@ -552,7 +695,7 @@ proc isGenericSubtype(c: var TCandidate; a, f: PType, d: var int, fGenericOrigin # XXX sameObjectType can return false here. Need to investigate # why that is but sameObjectType does way too much work here anyway. while t != nil and r.sym != t.sym and askip == fskip: - t = t[0] + t = t.baseClass if t == nil: break last = t t = t.skipToObject(askip) @@ -568,17 +711,22 @@ proc minRel(a, b: TTypeRelation): TTypeRelation = if a <= b: result = a else: result = b -proc recordRel(c: var TCandidate, f, a: PType): TTypeRelation = +proc recordRel(c: var TCandidate, f, a: PType, flags: TTypeRelFlags): TTypeRelation = result = isNone if sameType(f, a): result = isEqual - elif a.len == f.len: + elif sameTupleLengths(a, f): result = isEqual let firstField = if f.kind == tyTuple: 0 else: 1 - for i in firstField..<f.len: - var m = typeRel(c, f[i], a[i]) + for _, ff, aa in tupleTypePairs(f, a): + var m = typeRel(c, ff, aa, flags) if m < isSubtype: return isNone + if m == isSubtype and aa.kind != tyNil and c.inheritancePenalty > -1: + # we can't process individual element type conversions from a + # type conversion for the whole tuple + # subtype relations need type conversions when inheritance is used + return isNone result = minRel(result, m) if f.n != nil and a.n != nil: for i in 0..<f.n.len: @@ -588,7 +736,7 @@ proc recordRel(c: var TCandidate, f, a: PType): TTypeRelation = else: var x = f.n[i].sym var y = a.n[i].sym - if f.kind == tyObject and typeRel(c, x.typ, y.typ) < isSubtype: + if f.kind == tyObject and typeRel(c, x.typ, y.typ, flags) < isSubtype: return isNone if x.name.id != y.name.id: return isNone @@ -600,7 +748,7 @@ proc inconsistentVarTypes(f, a: PType): bool {.inline.} = (f.kind in {tyVar, tyLent, tySink} or a.kind in {tyVar, tyLent, tySink})) or isOutParam(f) != isOutParam(a) -proc procParamTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = +proc procParamTypeRel(c: var TCandidate; f, a: PType): TTypeRelation = ## For example we have: ## ```nim ## proc myMap[T,S](sIn: seq[T], f: proc(x: T): S): seq[S] = ... @@ -622,7 +770,7 @@ proc procParamTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = a = a if a.isMetaType: - let aResolved = PType(idTableGet(c.bindings, a)) + let aResolved = idTableGet(c.bindings, a) if aResolved != nil: a = aResolved if a.isMetaType: @@ -660,7 +808,9 @@ proc procParamTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = proc procTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = case a.kind of tyProc: - if f.len != a.len: return + var f = f + copyingEraseVoidParams(c, f) + if f.signatureLen != a.signatureLen: return result = isEqual # start with maximum; also correct for no # params at all @@ -718,7 +868,7 @@ proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = c = m.c typeClass = ff.skipTypes({tyUserTypeClassInst}) body = typeClass.n[3] - matchedConceptContext: TMatchedConcept + matchedConceptContext = TMatchedConcept() prevMatchedConcept = c.matchedConcept prevCandidateType = typeClass[0][0] @@ -746,7 +896,7 @@ proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = typeParamName = ff.base[i-1].sym.name typ = ff[i] param: PSym = nil - alreadyBound = PType(idTableGet(m.bindings, typ)) + alreadyBound = idTableGet(m.bindings, typ) if alreadyBound != nil: typ = alreadyBound @@ -769,14 +919,14 @@ proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = param.typ.flags.incl tfInferrableStatic else: param.ast = typ.n - of tyUnknown: + of tyFromExpr: param = paramSym skVar param.typ = typ.exactReplica #copyType(typ, c.idgen, typ.owner) else: param = paramSym skType param.typ = if typ.isMetaType: - c.newTypeWithSons(tyInferred, @[typ]) + newTypeS(tyInferred, c, typ) else: makeTypeDesc(c, typ) @@ -848,6 +998,7 @@ proc maybeSkipDistinct(m: TCandidate; t: PType, callee: PSym): PType = proc tryResolvingStaticExpr(c: var TCandidate, n: PNode, allowUnresolved = false, + allowCalls = false, expectedType: PType = nil): PNode = # Consider this example: # type Value[N: static[int]] = object @@ -857,7 +1008,7 @@ proc tryResolvingStaticExpr(c: var TCandidate, n: PNode, # This proc is used to evaluate such static expressions. let instantiated = replaceTypesInBody(c.c, c.bindings, n, nil, allowMetaTypes = allowUnresolved) - if instantiated.kind in nkCallKinds: + if not allowCalls and instantiated.kind in nkCallKinds: return nil result = c.c.semExpr(c.c, instantiated) @@ -929,8 +1080,9 @@ proc inferStaticParam*(c: var TCandidate, lhs: PNode, rhs: BiggestInt): bool = else: discard - elif lhs.kind == nkSym and lhs.typ.kind == tyStatic and lhs.typ.n == nil: - var inferred = newTypeWithSons(c.c, tyStatic, lhs.typ) + elif lhs.kind == nkSym and lhs.typ.kind == tyStatic and + (lhs.typ.n == nil or idTableGet(c.bindings, lhs.typ) == nil): + var inferred = newTypeS(tyStatic, c.c, lhs.typ.elementType) inferred.n = newIntNode(nkIntLit, rhs) put(c, lhs.typ, inferred) if c.c.matchedConcept != nil: @@ -973,9 +1125,21 @@ proc inferStaticsInRange(c: var TCandidate, doInferStatic(lowerBound, getInt(upperBound) + 1 - lengthOrd(c.c.config, concrete)) template subtypeCheck() = - if result <= isSubrange and f.lastSon.skipTypes(abstractInst).kind in { - tyRef, tyPtr, tyVar, tyLent, tyOwned}: + case result + of isIntConv: result = isNone + of isSubrange: + discard # XXX should be isNone with preview define, warnings + of isConvertible: + if f.last.skipTypes(abstractInst).kind != tyOpenArray: + # exclude var openarray which compiler supports + result = isNone + of isSubtype: + if f.last.skipTypes(abstractInst).kind in { + tyRef, tyPtr, tyVar, tyLent, tyOwned}: + # compiler can't handle subtype conversions with pointer indirection + result = isNone + else: discard proc isCovariantPtr(c: var TCandidate, f, a: PType): bool = # this proc is always called for a pair of matching types @@ -1073,7 +1237,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, case f.kind of tyGenericParam: - var prev = PType(idTableGet(c.bindings, f)) + var prev = idTableGet(c.bindings, f) if prev != nil: candidate = prev of tyFromExpr: let computedType = tryResolvingStaticExpr(c, f.n).typ @@ -1105,16 +1269,16 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # situation when nkDotExpr are rotated to nkDotCalls if aOrig.kind in {tyAlias, tySink}: - return typeRel(c, f, lastSon(aOrig), flags) + return typeRel(c, f, skipModifier(aOrig), flags) if a.kind == tyGenericInst and skipTypes(f, {tyStatic, tyVar, tyLent, tySink}).kind notin { tyGenericBody, tyGenericInvocation, tyGenericInst, tyGenericParam} + tyTypeClasses: - return typeRel(c, f, lastSon(a), flags) + return typeRel(c, f, skipModifier(a), flags) if a.isResolvedUserTypeClass: - return typeRel(c, f, a.lastSon, flags) + return typeRel(c, f, a.skipModifier, flags) template bindingRet(res) = if doBind: @@ -1123,10 +1287,15 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, return res template considerPreviousT(body: untyped) = - var prev = PType(idTableGet(c.bindings, f)) + var prev = idTableGet(c.bindings, f) if prev == nil: body else: return typeRel(c, prev, a, flags) + if c.c.inGenericContext > 0 and not c.isNoCall and + (tfUnresolved in a.flags or a.kind in tyTypeClasses): + # cheap check for unresolved arg, not nested + return isNone + case a.kind of tyOr: # XXX: deal with the current dual meaning of tyGenericParam @@ -1135,23 +1304,21 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # both int and string must match against number # but ensure that '[T: A|A]' matches as good as '[T: A]' (bug #2219): result = isGeneric - for branch in a: + for branch in a.kids: let x = typeRel(c, f, branch, flags + {trDontBind}) if x == isNone: return isNone if x < result: result = x return result - of tyAnd: # XXX: deal with the current dual meaning of tyGenericParam c.typedescMatched = true # seq[Sortable and Iterable] vs seq[Sortable] # only one match is enough - for branch in a: + for branch in a.kids: let x = typeRel(c, f, branch, flags + {trDontBind}) if x != isNone: return if x >= isGeneric: isGeneric else: x return isNone - of tyIterable: if f.kind != tyIterable: return isNone of tyNot: @@ -1161,18 +1328,16 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # seq[float] matches the first, but not the second # we must turn the problem around: # is number a subset of int? - return typeRel(c, a.lastSon, f.lastSon, flags) + return typeRel(c, a.elementType, f.elementType, flags) else: # negative type classes are essentially infinite, # so only the `any` type class is their superset return if f.kind == tyAnything: isGeneric else: isNone - of tyAnything: if f.kind == tyAnything: return isGeneric else: return isNone - of tyUserTypeClass, tyUserTypeClassInst: if c.c.matchedConcept != nil and c.c.matchedConcept.depth <= 4: # consider this: 'var g: Node' *within* a concept where 'Node' @@ -1181,14 +1346,19 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, let x = typeRel(c, a, f, flags + {trDontBind}) if x >= isGeneric: return isGeneric - of tyFromExpr: if c.c.inGenericContext > 0: - # generic type bodies can sometimes compile call expressions - # prevent expressions with unresolved types from - # being passed as parameters - return isNone + if not c.isNoCall: + # generic type bodies can sometimes compile call expressions + # prevent expressions with unresolved types from + # being passed as parameters + return isNone + else: + # Foo[templateCall(T)] shouldn't fail early if Foo has a constraint + # and we can't evaluate `templateCall(T)` yet + return isGeneric else: discard + case f.kind of tyEnum: if a.kind == f.kind and sameEnumTypes(f, a): result = isEqual @@ -1246,14 +1416,16 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, result = typeRel(c, f.base, aOrig, flags + {trNoCovariance}) subtypeCheck() of tyArray: - case a.kind - of tyArray: - var fRange = f[0] - var aRange = a[0] + a = reduceToBase(a) + if a.kind == tyArray: + var fRange = f.indexType + var aRange = a.indexType if fRange.kind in {tyGenericParam, tyAnything}: - var prev = PType(idTableGet(c.bindings, fRange)) + var prev = idTableGet(c.bindings, fRange) if prev == nil: - put(c, fRange, a[0]) + if typeRel(c, fRange, aRange) == isNone: + return isNone + put(c, fRange, a.indexType) fRange = a else: fRange = prev @@ -1261,11 +1433,10 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # This typeDesc rule is wrong, see bug #7331 let aa = a[1] #.skipTypes({tyTypeDesc}) - if f[0].kind != tyGenericParam and aa.kind == tyEmpty: + if f.indexType.kind != tyGenericParam and aa.kind == tyEmpty: result = isGeneric else: result = typeRel(c, ff, aa, flags) - if result < isGeneric: if nimEnableCovariance and trNoCovariance notin flags and @@ -1276,6 +1447,8 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, return isNone if fRange.rangeHasUnresolvedStatic: + if aRange.kind in {tyGenericParam} and aRange.reduceToBase() == aRange: + return return inferStaticsInRange(c, fRange, a) elif c.c.matchedConcept != nil and aRange.rangeHasUnresolvedStatic: return inferStaticsInRange(c, aRange, f) @@ -1284,18 +1457,12 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, else: if lengthOrd(c.c.config, fRange) != lengthOrd(c.c.config, aRange): result = isNone - else: discard - of tyUncheckedArray: - if a.kind == tyUncheckedArray: - result = typeRel(c, base(f), base(a), flags) - if result < isGeneric: result = isNone - else: discard of tyOpenArray, tyVarargs: # varargs[untyped] is special too but handled earlier. So we only need to # handle varargs[typed]: if f.kind == tyVarargs: if tfVarargs in a.flags: - return typeRel(c, f.base, a.lastSon, flags) + return typeRel(c, f.base, a.elementType, flags) if f[0].kind == tyTyped: return template matchArrayOrSeq(aBase: PType) = @@ -1315,13 +1482,13 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, result = typeRel(c, base(f), base(a), flags) if result < isGeneric: result = isNone of tyArray: - if (f[0].kind != tyGenericParam) and (a[1].kind == tyEmpty): + if (f[0].kind != tyGenericParam) and (a.elementType.kind == tyEmpty): return isSubtype - matchArrayOrSeq(a[1]) + matchArrayOrSeq(a.elementType) of tySequence: - if (f[0].kind != tyGenericParam) and (a[0].kind == tyEmpty): + if (f[0].kind != tyGenericParam) and (a.elementType.kind == tyEmpty): return isConvertible - matchArrayOrSeq(a[0]) + matchArrayOrSeq(a.elementType) of tyString: if f.kind == tyOpenArray: if f[0].kind == tyChar: @@ -1330,14 +1497,13 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, typeRel(c, base(f), base(a), flags) >= isGeneric: result = isConvertible else: discard - of tySequence: - case a.kind - of tySequence: - if (f[0].kind != tyGenericParam) and (a[0].kind == tyEmpty): + of tySequence, tyUncheckedArray: + if a.kind == f.kind: + if (f[0].kind != tyGenericParam) and (a.elementType.kind == tyEmpty): result = isSubtype else: let ff = f[0] - let aa = a[0] + let aa = a.elementType result = typeRel(c, ff, aa, flags) if result < isGeneric: if nimEnableCovariance and @@ -1347,11 +1513,11 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, result = isSubtype else: result = isNone - of tyNil: result = isNone - else: discard + elif a.kind == tyNil: + result = isNone of tyOrdinal: if isOrdinalType(a): - var x = if a.kind == tyOrdinal: a[0] else: a + var x = if a.kind == tyOrdinal: a.elementType else: a if f[0].kind == tyNone: result = isGeneric else: @@ -1366,21 +1532,20 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, skipOwned(a) if a.kind == f.kind: result = isEqual of tyTuple: - if a.kind == tyTuple: result = recordRel(c, f, a) + if a.kind == tyTuple: result = recordRel(c, f, a, flags) of tyObject: let effectiveArgType = if useTypeLoweringRuleInTypeClass: a else: - getObjectTypeOrNil(a) - if effectiveArgType == nil: return isNone + reduceToBase(a) if effectiveArgType.kind == tyObject: if sameObjectTypes(f, effectiveArgType): + c.inheritancePenalty = if tfFinal in f.flags: -1 else: 0 result = isEqual # elif tfHasMeta in f.flags: result = recordRel(c, f, a) elif trIsOutParam notin flags: - var depth = isObjectSubtype(c, effectiveArgType, f, nil) - if depth > 0: - inc(c.inheritancePenalty, depth) + c.inheritancePenalty = isObjectSubtype(c, effectiveArgType, f, nil) + if c.inheritancePenalty > 0: result = isSubtype of tyDistinct: a = a.skipTypes({tyOwned, tyGenericInst, tyRange}) @@ -1396,20 +1561,20 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, else: result = typeRel(c, f[0], a[0], flags) if result < isGeneric: - if result <= isConvertible: - result = isNone - elif tfIsConstructor notin a.flags: - # set constructors are a bit special... + if tfIsConstructor notin a.flags: + # set['a'..'z'] and set[char] have different representations result = isNone - + else: + # but we can convert individual elements of the constructor + result = isConvertible of tyPtr, tyRef: - skipOwned(a) + a = reduceToBase(a) if a.kind == f.kind: # ptr[R, T] can be passed to ptr[T], but not the other way round: if a.len < f.len: return isNone for i in 0..<f.len-1: if typeRel(c, f[i], a[i], flags) == isNone: return isNone - result = typeRel(c, f.lastSon, a.lastSon, flags + {trNoCovariance}) + result = typeRel(c, f.elementType, a.elementType, flags + {trNoCovariance}) subtypeCheck() if result <= isIntConv: result = isNone elif tfNotNil in f.flags and tfNotNil notin a.flags: @@ -1424,7 +1589,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, of tyOwned: case a.kind of tyOwned: - result = typeRel(c, lastSon(f), lastSon(a), flags) + result = typeRel(c, skipModifier(f), skipModifier(a), flags) of tyNil: result = f.allowsNil else: discard of tyPointer: @@ -1476,24 +1641,21 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, pointsTo[1].kind == tyChar: result = isConvertible else: discard - of tyEmpty, tyVoid: if a.kind == f.kind: result = isEqual - of tyAlias, tySink: - result = typeRel(c, lastSon(f), a, flags) - + result = typeRel(c, skipModifier(f), a, flags) of tyIterable: if a.kind == tyIterable: if f.len == 1: - result = typeRel(c, lastSon(f), lastSon(a), flags) + result = typeRel(c, skipModifier(f), skipModifier(a), flags) else: # f.len = 3, for some reason result = isGeneric else: result = isNone of tyGenericInst: - var prev = PType(idTableGet(c.bindings, f)) + var prev = idTableGet(c.bindings, f) let origF = f var f = if prev == nil: f else: prev @@ -1534,13 +1696,13 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, return isNone if prev == nil: put(c, f, a) else: - let fKind = rootf.lastSon.kind + let fKind = rootf.last.kind if fKind in {tyAnd, tyOr}: - result = typeRel(c, lastSon(f), a, flags) + result = typeRel(c, last(f), a, flags) if result != isNone: put(c, f, a) return - var aAsObject = roota.lastSon + var aAsObject = roota.last if fKind in {tyRef, tyPtr}: if aAsObject.kind == tyObject: @@ -1553,34 +1715,32 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, if aAsObject.kind == tyObject and trIsOutParam notin flags: let baseType = aAsObject.base if baseType != nil: - c.inheritancePenalty += 1 + inc c.inheritancePenalty, 1 + int(c.inheritancePenalty < 0) let ret = typeRel(c, f, baseType, flags) return if ret in {isEqual,isGeneric}: isSubtype else: ret result = isNone else: - assert lastSon(origF) != nil - result = typeRel(c, lastSon(origF), a, flags) + assert last(origF) != nil + result = typeRel(c, last(origF), a, flags) if result != isNone and a.kind != tyNil: put(c, f, a) - of tyGenericBody: considerPreviousT: if a == f or a.kind == tyGenericInst and a.skipGenericAlias[0] == f: bindingRet isGeneric - let ff = lastSon(f) + let ff = last(f) if ff != nil: result = typeRel(c, ff, a, flags) - of tyGenericInvocation: var x = a.skipGenericAlias if x.kind == tyGenericParam and x.len > 0: - x = x.lastSon + x = x.last let concpt = f[0].skipTypes({tyGenericBody}) var preventHack = concpt.kind == tyConcept if x.kind == tyOwned and f[0].kind != tyOwned: preventHack = true - x = x.lastSon + x = x.last # XXX: This is very hacky. It should be moved back into liftTypeParam if x.kind in {tyGenericInst, tyArray} and c.calleeSym != nil and @@ -1613,7 +1773,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, var askip = skippedNone var fskip = skippedNone let aobj = x.skipToObject(askip) - let fobj = genericBody.lastSon.skipToObject(fskip) + let fobj = genericBody.last.skipToObject(fskip) result = typeRel(c, genericBody, x, flags) if result != isNone: # see tests/generics/tgeneric3.nim for an example that triggers this @@ -1627,14 +1787,14 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # # we steal the generic parameters from the tyGenericBody: for i in 1..<f.len: - let x = PType(idTableGet(c.bindings, genericBody[i-1])) + let x = idTableGet(c.bindings, genericBody[i-1]) if x == nil: discard "maybe fine (for e.g. a==tyNil)" elif x.kind in {tyGenericInvocation, tyGenericParam}: internalError(c.c.graph.config, "wrong instantiated type!") else: let key = f[i] - let old = PType(idTableGet(c.bindings, key)) + let old = idTableGet(c.bindings, key) if old == nil: put(c, key, x) elif typeRel(c, old, x, flags + {trDontBind}) == isNone: @@ -1652,60 +1812,56 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, depth = -1 if depth >= 0: - c.inheritancePenalty += depth + inc c.inheritancePenalty, depth + int(c.inheritancePenalty < 0) # bug #4863: We still need to bind generic alias crap, so # we cannot return immediately: result = if depth == 0: isGeneric else: isSubtype of tyAnd: considerPreviousT: result = isEqual - for branch in f: + for branch in f.kids: let x = typeRel(c, branch, aOrig, flags) if x < isSubtype: return isNone # 'and' implies minimum matching result: if x < result: result = x if result > isGeneric: result = isGeneric bindingRet result - of tyOr: considerPreviousT: result = isNone let oldInheritancePenalty = c.inheritancePenalty - var maxInheritance = 0 - for branch in f: - c.inheritancePenalty = 0 + var minInheritance = maxInheritancePenalty + for branch in f.kids: + c.inheritancePenalty = -1 let x = typeRel(c, branch, aOrig, flags) - maxInheritance = max(maxInheritance, c.inheritancePenalty) - # 'or' implies maximum matching result: - if x > result: result = x + if x >= result: + if c.inheritancePenalty > -1: + minInheritance = min(minInheritance, c.inheritancePenalty) + result = x if result >= isIntConv: + if minInheritance < maxInheritancePenalty: + c.inheritancePenalty = oldInheritancePenalty + minInheritance if result > isGeneric: result = isGeneric bindingRet result else: result = isNone - c.inheritancePenalty = oldInheritancePenalty + maxInheritance - of tyNot: considerPreviousT: - for branch in f: - if typeRel(c, branch, aOrig, flags) != isNone: - return isNone + if typeRel(c, f.elementType, aOrig, flags) != isNone: + return isNone bindingRet isGeneric - of tyAnything: considerPreviousT: var concrete = concreteType(c, a) if concrete != nil and doBind: put(c, f, concrete) return isGeneric - of tyBuiltInTypeClass: considerPreviousT: - let target = f[0] + let target = f.genericHead let targetKind = target.kind - var effectiveArgType = a.getObjectTypeOrNil() - if effectiveArgType == nil: return isNone + var effectiveArgType = reduceToBase(a) effectiveArgType = effectiveArgType.skipTypes({tyBuiltInTypeClass}) if targetKind == effectiveArgType.kind: if effectiveArgType.isEmptyContainer: @@ -1716,14 +1872,13 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, if tfExplicitCallConv in target.flags and target.callConv != effectiveArgType.callConv: return isNone - put(c, f, a) + if doBind: put(c, f, a) return isGeneric else: return isNone - of tyUserTypeClassInst, tyUserTypeClass: if f.isResolvedUserTypeClass: - result = typeRel(c, f.lastSon, a, flags) + result = typeRel(c, f.last, a, flags) else: considerPreviousT: if aOrig == f: return isEqual @@ -1732,7 +1887,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, bindConcreteTypeToUserTypeClass(matched, a) if doBind: put(c, f, matched) result = isGeneric - elif a.len > 0 and a.lastSon == f: + elif a.len > 0 and a.last == f: # Needed for checking `Y` == `Addable` in the following #[ type @@ -1743,15 +1898,13 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, result = isGeneric else: result = isNone - of tyConcept: result = if concepts.conceptMatch(c.c, f, a, c.bindings, nil): isGeneric else: isNone - of tyCompositeTypeClass: considerPreviousT: let roota = a.skipGenericAlias - let rootf = f.lastSon.skipGenericAlias + let rootf = f.last.skipGenericAlias if a.kind == tyGenericInst and roota.base == rootf.base: for i in 1..<rootf.len-1: let ff = rootf[i] @@ -1760,14 +1913,13 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, if result == isNone: return if ff.kind == tyRange and result != isEqual: return isNone else: - result = typeRel(c, rootf.lastSon, a, flags) + result = typeRel(c, rootf.last, a, flags) if result != isNone: put(c, f, a) result = isGeneric - of tyGenericParam: let doBindGP = doBind or trBindGenericParam in flags - var x = PType(idTableGet(c.bindings, f)) + var x = idTableGet(c.bindings, f) if x == nil: if c.callee.kind == tyGenericBody and not c.typedescMatched: # XXX: The fact that generic types currently use tyGenericParam for @@ -1785,7 +1937,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, c.typedescMatched = true var aa = a while aa.kind in {tyTypeDesc, tyGenericParam} and aa.len > 0: - aa = lastSon(aa) + aa = last(aa) if aa.kind in {tyGenericParam} + tyTypeClasses: # If the constraint is a genericParam or typeClass this isGeneric return isGeneric @@ -1802,18 +1954,12 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, else: # check if 'T' has a constraint as in 'proc p[T: Constraint](x: T)' if f.len > 0 and f[0].kind != tyNone: - let oldInheritancePenalty = c.inheritancePenalty - result = typeRel(c, f[0], a, flags + {trDontBind,trBindGenericParam}) + result = typeRel(c, f[0], a, flags + {trDontBind, trBindGenericParam}) if doBindGP and result notin {isNone, isGeneric}: let concrete = concreteType(c, a, f) if concrete == nil: return isNone put(c, f, concrete) - # bug #6526 if result in {isEqual, isSubtype}: - # 'T: Class' is a *better* match than just 'T' - # but 'T: Subclass' is even better: - c.inheritancePenalty = oldInheritancePenalty - c.inheritancePenalty - - 100 * ord(result == isEqual) result = isGeneric elif a.kind == tyTypeDesc: # somewhat special typing rule, the following is illegal: @@ -1829,10 +1975,11 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, a.sym.transitionGenericParamToType() a.flags.excl tfWildcard elif doBind: - # The mechanics of `doBind` being a flag that also denotes sig cmp via - # negation is potentially problematic. `IsNone` is appropriate for - # preventing illegal bindings, but it is not necessarily appropriate - # before the bindings have been finalized. + # careful: `trDontDont` (set by `checkGeneric`) is not always respected in this call graph. + # typRel having two different modes (binding and non-binding) can make things harder to + # reason about and maintain. Refactoring typeRel to not be responsible for setting, or + # at least validating, bindings can have multiple benefits. This is debatable. I'm not 100% sure. + # A design that allows a proper complexity analysis of types like `tyOr` would be ideal. concrete = concreteType(c, a, f) if concrete == nil: return isNone @@ -1845,21 +1992,34 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, elif x.kind == tyGenericParam: result = isGeneric else: + # This is the bound type - can't benifit from these tallies + let + inheritancePenaltyOld = c.inheritancePenalty result = typeRel(c, x, a, flags) # check if it fits + c.inheritancePenalty = inheritancePenaltyOld if result > isGeneric: result = isGeneric of tyStatic: - let prev = PType(idTableGet(c.bindings, f)) + let prev = idTableGet(c.bindings, f) if prev == nil: if aOrig.kind == tyStatic: - if f.base.kind notin {tyNone, tyGenericParam}: + if c.c.inGenericContext > 0 and aOrig.n == nil and not c.isNoCall: + # don't match unresolved static value to static param to avoid + # faulty instantiations in calls in generic bodies + # but not for generic invocations as they only check constraints + result = isNone + elif f.base.kind notin {tyNone, tyGenericParam}: result = typeRel(c, f.base, a, flags) if result != isNone and f.n != nil: - if not exprStructuralEquivalent(f.n, aOrig.n): + var r = tryResolvingStaticExpr(c, f.n) + if r == nil: r = f.n + if not exprStructuralEquivalent(r, aOrig.n) and + not (aOrig.n != nil and aOrig.n.kind == nkIntLit and + inferStaticParam(c, r, aOrig.n.intVal)): result = isNone elif f.base.kind == tyGenericParam: # Handling things like `type A[T; Y: static T] = object` if f.base.len > 0: # There is a constraint, handle it - result = typeRel(c, f.base.lastSon, a, flags) + result = typeRel(c, f.base.last, a, flags) else: # No constraint if tfGenericTypeParam in f.flags: @@ -1872,17 +2032,17 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, if result != isNone: put(c, f, aOrig) elif aOrig.n != nil and aOrig.n.typ != nil: result = if f.base.kind != tyNone: - typeRel(c, f.lastSon, aOrig.n.typ, flags) + typeRel(c, f.last, aOrig.n.typ, flags) else: isGeneric if result != isNone: - var boundType = newTypeWithSons(c.c, tyStatic, @[aOrig.n.typ]) + var boundType = newTypeS(tyStatic, c.c, aOrig.n.typ) boundType.n = aOrig.n put(c, f, boundType) else: result = isNone elif prev.kind == tyStatic: if aOrig.kind == tyStatic: - result = typeRel(c, prev.lastSon, a, flags) + result = typeRel(c, prev.last, a, flags) if result != isNone and prev.n != nil: if not exprStructuralEquivalent(prev.n, aOrig.n): result = isNone @@ -1891,7 +2051,6 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # XXX endless recursion? #result = typeRel(c, prev, aOrig, flags) result = isNone - of tyInferred: let prev = f.previouslyInferred if prev != nil: @@ -1901,15 +2060,13 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, if result != isNone: c.inferredTypes.add f f.add a - of tyTypeDesc: - var prev = PType(idTableGet(c.bindings, f)) + var prev = idTableGet(c.bindings, f) if prev == nil: # proc foo(T: typedesc, x: T) # when `f` is an unresolved typedesc, `a` could be any # type, so we should not perform this check earlier - if c.c.inGenericContext > 0 and - a.skipTypes({tyTypeDesc}).kind == tyGenericParam: + if c.c.inGenericContext > 0 and a.containsUnresolvedType: # generic type bodies can sometimes compile call expressions # prevent unresolved generic parameters from being passed to procs as # typedesc parameters @@ -1934,35 +2091,40 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, result = typeRel(c, prev.base, a.base, flags) else: result = isNone - of tyTyped: if aOrig != nil: put(c, f, aOrig) result = isGeneric - - of tyProxy: + of tyError: result = isEqual - of tyFromExpr: # fix the expression, so it contains the already instantiated types if f.n == nil or f.n.kind == nkEmpty: return isGeneric - let reevaluated = tryResolvingStaticExpr(c, f.n) - if reevaluated == nil: + if c.c.inGenericContext > 0: + # need to delay until instantiation + # also prevent infinite recursion below + return isNone + inc c.c.inGenericContext # to generate tyFromExpr again if unresolved + # use prepareNode for consistency with other tyFromExpr in semtypinst: + let instantiated = prepareTypesInBody(c.c, c.bindings, f.n) + let reevaluated = c.c.semExpr(c.c, instantiated).typ + dec c.c.inGenericContext + case reevaluated.kind + of tyFromExpr: + # not resolved result = isNone - return - case reevaluated.typ.kind of tyTypeDesc: - result = typeRel(c, a, reevaluated.typ.base, flags) + result = typeRel(c, reevaluated.base, a, flags) of tyStatic: - result = typeRel(c, a, reevaluated.typ.base, flags) - if result != isNone and reevaluated.typ.n != nil: - if not exprStructuralEquivalent(aOrig.n, reevaluated.typ.n): + result = typeRel(c, reevaluated.base, a, flags) + if result != isNone and reevaluated.n != nil: + if not exprStructuralEquivalent(aOrig.n, reevaluated.n): result = isNone else: # bug #14136: other types are just like 'tyStatic' here: - result = typeRel(c, a, reevaluated.typ, flags) - if result != isNone and reevaluated.typ.n != nil: - if not exprStructuralEquivalent(aOrig.n, reevaluated.typ.n): + result = typeRel(c, reevaluated, a, flags) + if result != isNone and reevaluated.n != nil: + if not exprStructuralEquivalent(aOrig.n, reevaluated.n): result = isNone of tyNone: if a.kind == tyNone: result = isEqual @@ -1990,7 +2152,7 @@ proc cmpTypes*(c: PContext, f, a: PType): TTypeRelation = proc getInstantiatedType(c: PContext, arg: PNode, m: TCandidate, f: PType): PType = - result = PType(idTableGet(m.bindings, f)) + result = idTableGet(m.bindings, f) if result == nil: result = generateTypeInstance(c, m.bindings, arg, f) if result == nil: @@ -2001,7 +2163,7 @@ proc implicitConv(kind: TNodeKind, f: PType, arg: PNode, m: TCandidate, c: PContext): PNode = result = newNodeI(kind, arg.info) if containsGenericType(f): - if not m.hasFauxMatch: + if not m.matchedErrorType: result.typ = getInstantiatedType(c, arg, m, f).skipTypes({tySink}) else: result.typ = errorType(c) @@ -2016,12 +2178,87 @@ proc implicitConv(kind: TNodeKind, f: PType, arg: PNode, m: TCandidate, if result.typ == nil: internalError(c.graph.config, arg.info, "implicitConv") result.add c.graph.emptyNode if arg.typ != nil and arg.typ.kind == tyLent: - let a = newNodeIT(nkHiddenDeref, arg.info, arg.typ[0]) + let a = newNodeIT(nkHiddenDeref, arg.info, arg.typ.elementType) a.add arg result.add a else: result.add arg +proc convertLiteral(kind: TNodeKind, c: PContext, m: TCandidate; n: PNode, newType: PType): PNode = + # based off changeType but generates implicit conversions instead + template addConsiderNil(s, node) = + let val = node + if val.isNil: return nil + s.add(val) + case n.kind + of nkCurly: + result = copyNode(n) + for i in 0..<n.len: + if n[i].kind == nkRange: + var x = copyNode(n[i]) + x.addConsiderNil convertLiteral(kind, c, m, n[i][0], elemType(newType)) + x.addConsiderNil convertLiteral(kind, c, m, n[i][1], elemType(newType)) + result.add x + else: + result.addConsiderNil convertLiteral(kind, c, m, n[i], elemType(newType)) + result.typ = newType + return + of nkBracket: + result = copyNode(n) + for i in 0..<n.len: + result.addConsiderNil convertLiteral(kind, c, m, n[i], elemType(newType)) + result.typ = newType + return + of nkPar, nkTupleConstr: + let tup = newType.skipTypes({tyGenericInst, tyAlias, tySink, tyDistinct}) + if tup.kind == tyTuple: + result = copyNode(n) + if n.len > 0 and n[0].kind == nkExprColonExpr: + # named tuple? + for i in 0..<n.len: + var name = n[i][0] + if name.kind != nkSym: + #globalError(c.config, name.info, "invalid tuple constructor") + return nil + if tup.n != nil: + var f = getSymFromList(tup.n, name.sym.name) + if f == nil: + #globalError(c.config, name.info, "unknown identifier: " & name.sym.name.s) + return nil + result.addConsiderNil convertLiteral(kind, c, m, n[i][1], f.typ) + else: + result.addConsiderNil convertLiteral(kind, c, m, n[i][1], tup[i]) + else: + for i in 0..<n.len: + result.addConsiderNil convertLiteral(kind, c, m, n[i], tup[i]) + result.typ = newType + return + of nkCharLit..nkUInt64Lit: + if n.kind != nkUInt64Lit and not sameTypeOrNil(n.typ, newType) and isOrdinalType(newType): + let value = n.intVal + if value < firstOrd(c.config, newType) or value > lastOrd(c.config, newType): + return nil + result = copyNode(n) + result.typ = newType + return + of nkFloatLit..nkFloat64Lit: + if newType.skipTypes(abstractVarRange-{tyTypeDesc}).kind == tyFloat: + if not floatRangeCheck(n.floatVal, newType): + return nil + result = copyNode(n) + result.typ = newType + return + of nkSym: + if n.sym.kind == skEnumField and not sameTypeOrNil(n.sym.typ, newType) and isOrdinalType(newType): + let value = n.sym.position + if value < firstOrd(c.config, newType) or value > lastOrd(c.config, newType): + return nil + result = copyNode(n) + result.typ = newType + return + else: discard + return implicitConv(kind, newType, n, m, c) + proc isLValue(c: PContext; n: PNode, isOutParam = false): bool {.inline.} = let aa = isAssignable(nil, n) case aa @@ -2039,8 +2276,8 @@ proc userConvMatch(c: PContext, m: var TCandidate, f, a: PType, arg: PNode): PNode = result = nil for i in 0..<c.converters.len: - var src = c.converters[i].typ[1] - var dest = c.converters[i].typ[0] + var src = c.converters[i].typ.firstParamType + var dest = c.converters[i].typ.returnType # for generic type converters we need to check 'src <- a' before # 'f <- dest' in order to not break the unification: # see tests/tgenericconverter: @@ -2073,7 +2310,7 @@ proc userConvMatch(c: PContext, m: var TCandidate, f, a: PType, param = implicitConv(nkHiddenSubConv, src, copyTree(arg), m, c) elif src.kind in {tyVar}: # Analyse the converter return type. - param = newNodeIT(nkHiddenAddr, arg.info, s.typ[1]) + param = newNodeIT(nkHiddenAddr, arg.info, s.typ.firstParamType) param.add copyTree(arg) else: param = copyTree(arg) @@ -2129,11 +2366,12 @@ proc incMatches(m: var TCandidate; r: TTypeRelation; convMatch = 1) = of isNone: discard template matchesVoidProc(t: PType): bool = - (t.kind == tyProc and t.len == 1 and t[0] == nil) or - (t.kind == tyBuiltInTypeClass and t[0].kind == tyProc) + (t.kind == tyProc and t.len == 1 and t.returnType == nil) or + (t.kind == tyBuiltInTypeClass and t.elementType.kind == tyProc) proc paramTypesMatchAux(m: var TCandidate, f, a: PType, argSemantized, argOrig: PNode): PNode = + result = nil var fMaybeStatic = f.skipTypes({tyDistinct}) arg = argSemantized @@ -2158,12 +2396,15 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, a.n == nil and tfGenericTypeParam notin a.flags: return newNodeIT(nkType, argOrig.info, makeTypeFromExpr(c, arg)) + elif a.kind == tyFromExpr and c.inGenericContext > 0: + # don't try to evaluate + discard elif arg.kind != nkEmpty: var evaluated = c.semTryConstExpr(c, arg) if evaluated != nil: # Don't build the type in-place because `evaluated` and `arg` may point # to the same object and we'd end up creating recursive types (#9255) - let typ = newTypeS(tyStatic, c, sons = @[evaluated.typ]) + let typ = newTypeS(tyStatic, c, son = evaluated.typ) typ.n = evaluated arg = copyTree(arg) # fix #12864 arg.typ = typ @@ -2196,35 +2437,53 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, else: return argSemantized # argOrig - # If r == isBothMetaConvertible then we rerun typeRel. - # bothMetaCounter is for safety to avoid any infinite loop, - # I don't have any example when it is needed. - # lastBindingsLenth is used to check whether m.bindings remains the same, - # because in that case there is no point in continuing. - var bothMetaCounter = 0 - var lastBindingsLength = -1 - while r == isBothMetaConvertible and - lastBindingsLength != m.bindings.counter and - bothMetaCounter < 100: - lastBindingsLength = m.bindings.counter - inc(bothMetaCounter) - if arg.kind in {nkProcDef, nkFuncDef, nkIteratorDef} + nkLambdaKinds: - result = c.semInferredLambda(c, m.bindings, arg) - elif arg.kind != nkSym: - return nil - else: - let inferred = c.semGenerateInstance(c, arg.sym, m.bindings, arg.info) - result = newSymNode(inferred, arg.info) - inc(m.convMatches) - arg = result - r = typeRel(m, f, arg.typ) + block instantiateGenericRoutine: + # In the case where the matched value is a generic proc, we need to + # fully instantiate it and then rerun typeRel to make sure it matches. + # instantiationCounter is for safety to avoid any infinite loop, + # I don't have any example when it is needed. + # lastBindingCount is used to check whether m.bindings remains the same, + # because in that case there is no point in continuing. + var instantiationCounter = 0 + var lastBindingCount = -1 + while r in {isBothMetaConvertible, isInferred, isInferredConvertible} and + lastBindingCount != m.bindings.len and + instantiationCounter < 100: + lastBindingCount = m.bindings.len + inc(instantiationCounter) + if arg.kind in {nkProcDef, nkFuncDef, nkIteratorDef} + nkLambdaKinds: + result = c.semInferredLambda(c, m.bindings, arg) + elif arg.kind != nkSym: + return nil + elif arg.sym.kind in {skMacro, skTemplate}: + return nil + else: + if arg.sym.ast == nil: + return nil + let inferred = c.semGenerateInstance(c, arg.sym, m.bindings, arg.info) + result = newSymNode(inferred, arg.info) + arg = result + r = typeRel(m, f, arg.typ) case r of isConvertible: if f.skipTypes({tyRange}).kind in {tyInt, tyUInt}: inc(m.convMatches) inc(m.convMatches) - result = implicitConv(nkHiddenStdConv, f, arg, m, c) + if skipTypes(f, abstractVar-{tyTypeDesc}).kind == tySet: + if tfIsConstructor in a.flags and arg.kind == nkCurly: + # we marked the set as convertible only because the arg is a literal + # in which case we individually convert each element + let t = + if containsGenericType(f): + getInstantiatedType(c, arg, m, f).skipTypes({tySink}) + else: + f.skipTypes({tySink}) + result = convertLiteral(nkHiddenStdConv, c, m, arg, t) + else: + result = nil + else: + result = implicitConv(nkHiddenStdConv, f, arg, m, c) of isIntConv: # I'm too lazy to introduce another ``*matches`` field, so we conflate # ``isIntConv`` and ``isIntLit`` here: @@ -2244,29 +2503,20 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, result = arg else: result = implicitConv(nkHiddenStdConv, f, arg, m, c) - of isInferred, isInferredConvertible: - if arg.kind in {nkProcDef, nkFuncDef, nkIteratorDef} + nkLambdaKinds: - result = c.semInferredLambda(c, m.bindings, arg) - elif arg.kind != nkSym: - return nil - elif arg.sym.kind in {skMacro, skTemplate}: - return nil - else: - if arg.sym.ast == nil: - return nil - let inferred = c.semGenerateInstance(c, arg.sym, m.bindings, arg.info) - result = newSymNode(inferred, arg.info) - if r == isInferredConvertible: - inc(m.convMatches) - result = implicitConv(nkHiddenStdConv, f, result, m, c) - else: - inc(m.genericMatches) + of isInferred: + # result should be set in above while loop: + assert result != nil + inc(m.genericMatches) + of isInferredConvertible: + # result should be set in above while loop: + assert result != nil + inc(m.convMatches) + result = implicitConv(nkHiddenStdConv, f, result, m, c) of isGeneric: inc(m.genericMatches) if arg.typ == nil: result = arg - elif skipTypes(arg.typ, abstractVar-{tyTypeDesc}).kind == tyTuple or - m.inheritancePenalty > oldInheritancePenalty: + elif skipTypes(arg.typ, abstractVar-{tyTypeDesc}).kind == tyTuple or cmpInheritancePenalty(oldInheritancePenalty, m.inheritancePenalty) > 0: result = implicitConv(nkHiddenSubConv, f, arg, m, c) elif arg.typ.isEmptyContainer: result = arg.copyTree @@ -2274,8 +2524,10 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, else: result = arg of isBothMetaConvertible: - # This is the result for the 101th time. - result = nil + # result should be set in above while loop: + assert result != nil + inc(m.convMatches) + result = arg of isFromIntLit: # too lazy to introduce another ``*matches`` field, so we conflate # ``isIntConv`` and ``isIntLit`` here: @@ -2290,13 +2542,10 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, result = implicitConv(nkHiddenSubConv, f, arg, m, c) of isNone: # do not do this in ``typeRel`` as it then can't infer T in ``ref T``: - if a.kind in {tyProxy, tyUnknown}: - if a.kind == tyUnknown and c.inGenericContext > 0: - # don't bother with fauxMatch mechanism in generic type, - # reject match, typechecking will be delayed to instantiation - return nil + if a.kind == tyFromExpr: return nil + elif a.kind == tyError: inc(m.genericMatches) - m.fauxMatch = a.kind + m.matchedErrorType = true return arg elif a.kind == tyVoid and f.matchesVoidProc and argOrig.kind == nkStmtList: # lift do blocks without params to lambdas @@ -2318,6 +2567,9 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, if f.n != nil: # Forward to the varargs converter result = localConvMatch(c, m, f, a, arg) + elif f[0].kind == tyTyped: + inc m.genericMatches + result = arg else: r = typeRel(m, base(f), a) case r @@ -2345,61 +2597,103 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, result = userConvMatch(c, m, base(f), a, arg) if result != nil: m.baseTypeMatch = true +proc staticAwareTypeRel(m: var TCandidate, f: PType, arg: var PNode): TTypeRelation = + if f.kind == tyStatic and f.base.kind == tyProc: + # The ast of the type does not point to the symbol. + # Without this we will never resolve a `static proc` with overloads + let copiedNode = copyNode(arg) + copiedNode.typ = exactReplica(copiedNode.typ) + copiedNode.typ.n = arg + arg = copiedNode + typeRel(m, f, arg.typ) + + proc paramTypesMatch*(m: var TCandidate, f, a: PType, arg, argOrig: PNode): PNode = if arg == nil or arg.kind notin nkSymChoices: result = paramTypesMatchAux(m, f, a, arg, argOrig) else: - # CAUTION: The order depends on the used hashing scheme. Thus it is - # incorrect to simply use the first fitting match. However, to implement - # this correctly is inefficient. We have to copy `m` here to be able to - # roll back the side effects of the unification algorithm. - let c = m.c - var - x = newCandidate(c, m.callee) - y = newCandidate(c, m.callee) - z = newCandidate(c, m.callee) - x.calleeSym = m.calleeSym - y.calleeSym = m.calleeSym - z.calleeSym = m.calleeSym + # symbol kinds that don't participate in symchoice type disambiguation: + let matchSet = {low(TSymKind)..high(TSymKind)} - {skModule, skPackage} + var best = -1 - for i in 0..<arg.len: - if arg[i].sym.kind in {skProc, skFunc, skMethod, skConverter, - skIterator, skMacro, skTemplate, skEnumField}: - copyCandidate(z, m) - z.callee = arg[i].typ - if tfUnresolved in z.callee.flags: continue - z.calleeSym = arg[i].sym - # 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[i].typ) - incMatches(z, r, 2) - if r != isNone: - z.state = csMatch - case x.state - of csEmpty, csNoMatch: - x = z + result = arg + + var actingF = f + if f.kind == tyVarargs: + if m.calleeSym.kind in {skTemplate, skMacro}: + actingF = f[0] + if actingF.kind in {tyTyped, tyUntyped}: + var + bestScope = -1 + counts = 0 + for i in 0..<arg.len: + if arg[i].sym.kind in matchSet: + let thisScope = cmpScopes(m.c, arg[i].sym) + if thisScope > bestScope: best = i - of csMatch: - let cmp = cmpCandidates(x, z) - if cmp < 0: - best = i - x = z - elif cmp == 0: - y = z # z is as good as x - - if x.state == csEmpty: - result = nil - elif y.state == csMatch and cmpCandidates(x, y) == 0: - if x.state != csMatch: - internalError(m.c.graph.config, arg.info, "x.state is not csMatch") - # ambiguous: more than one symbol fits! - # See tsymchoice_for_expr as an example. 'f.kind == tyUntyped' should match - # anyway: - if f.kind in {tyUntyped, tyTyped}: result = arg - else: result = nil + bestScope = thisScope + counts = 0 + elif thisScope == bestScope: + inc counts + if best == -1: + result = nil + elif counts > 0: + m.genericMatches = 1 + best = -1 else: + # CAUTION: The order depends on the used hashing scheme. Thus it is + # incorrect to simply use the first fitting match. However, to implement + # this correctly is inefficient. We have to copy `m` here to be able to + # roll back the side effects of the unification algorithm. + let c = m.c + var + x = newCandidate(c, m.callee) # potential "best" + y = newCandidate(c, m.callee) # potential competitor with x + z = newCandidate(c, m.callee) # buffer for copies of m + x.calleeSym = m.calleeSym + y.calleeSym = m.calleeSym + z.calleeSym = m.calleeSym + + for i in 0..<arg.len: + if arg[i].sym.kind in matchSet: + copyCandidate(z, m) + z.callee = arg[i].typ + if arg[i].sym.kind == skType and z.callee.kind != tyTypeDesc: + # creating the symchoice with the type sym having typedesc type + # breaks a lot of stuff, so we make the typedesc type here + # mirrored from `newSymNodeTypeDesc` + z.callee = newType(tyTypeDesc, c.idgen, arg[i].sym.owner) + z.callee.addSonSkipIntLit(arg[i].sym.typ, c.idgen) + if tfUnresolved in z.callee.flags: continue + z.calleeSym = arg[i].sym + z.calleeScope = cmpScopes(m.c, arg[i].sym) + # 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 = staticAwareTypeRel(z, f, arg[i]) + incMatches(z, r, 2) + if r != isNone: + z.state = csMatch + case x.state + of csEmpty, csNoMatch: + x = z + best = i + of csMatch: + let cmp = cmpCandidates(x, z, isFormal=false) + if cmp < 0: + best = i + x = z + elif cmp == 0: + y = z # z is as good as x + + if x.state == csEmpty: + result = nil + elif y.state == csMatch and cmpCandidates(x, y, isFormal=false) == 0: + if x.state != csMatch: + internalError(m.c.graph.config, arg.info, "x.state is not csMatch") + result = nil + if best > -1 and result != nil: # only one valid interpretation found: markUsed(m.c, arg.info, arg[best].sym) onUse(arg.info, arg[best].sym) @@ -2421,7 +2715,7 @@ proc setSon(father: PNode, at: int, son: PNode) = # we are allowed to modify the calling node in the 'prepare*' procs: proc prepareOperand(c: PContext; formal: PType; a: PNode): PNode = if formal.kind == tyUntyped and formal.len != 1: - # {tyTypeDesc, tyUntyped, tyTyped, tyProxy}: + # {tyTypeDesc, tyUntyped, tyTyped, tyError}: # a.typ == nil is valid result = a elif a.typ.isNil: @@ -2459,7 +2753,7 @@ proc arrayConstr(c: PContext, n: PNode): PType = result = newTypeS(tyArray, c) rawAddSon(result, makeRangeType(c, 0, 0, n.info)) addSonSkipIntLit(result, skipTypes(n.typ, - {tyGenericInst, tyVar, tyLent, tyOrdinal}), c.idgen) + {tyVar, tyLent, tyOrdinal}), c.idgen) proc arrayConstr(c: PContext, info: TLineInfo): PType = result = newTypeS(tyArray, c) @@ -2468,11 +2762,14 @@ proc arrayConstr(c: PContext, info: TLineInfo): PType = proc incrIndexType(t: PType) = assert t.kind == tyArray - inc t[0].n[1].intVal + inc t.indexType.n[1].intVal template isVarargsUntyped(x): untyped = x.kind == tyVarargs and x[0].kind == tyUntyped +template isVarargsTyped(x): untyped = + x.kind == tyVarargs and x[0].kind == tyTyped + proc findFirstArgBlock(m: var TCandidate, n: PNode): int = # see https://github.com/nim-lang/RFCs/issues/405 result = int.high @@ -2647,7 +2944,15 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int n[a], nOrig[a]) if arg == nil: noMatch() - if m.baseTypeMatch: + if formal.typ.isVarargsTyped and m.calleeSym.kind in {skTemplate, skMacro}: + if container.isNil: + container = newNodeIT(nkBracket, n[a].info, arrayConstr(c, n.info)) + setSon(m.call, formal.position + 1, implicitConv(nkHiddenStdConv, formal.typ, container, m, c)) + else: + incrIndexType(container.typ) + container.add n[a] + f = max(f, formalLen - n.len + a + 1) + elif m.baseTypeMatch: assert formal.typ.kind == tyVarargs #assert(container == nil) if container.isNil: @@ -2687,12 +2992,6 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int m.firstMismatch.arg = a m.firstMismatch.formal = formal -proc semFinishOperands*(c: PContext, n: PNode) = - # this needs to be called to ensure that after overloading resolution every - # argument has been sem'checked: - for i in 1..<n.len: - n[i] = prepareOperand(c, n[i]) - proc partialMatch*(c: PContext, n, nOrig: PNode, m: var TCandidate) = # for 'suggest' support: var marker = initIntSet() @@ -2708,6 +3007,8 @@ proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = inc m.genericMatches inc m.exactMatches return + # initCandidate may have given csNoMatch if generic params didn't match: + if m.state == csNoMatch: return var marker = initIntSet() matchesAux(c, n, nOrig, m, marker) if m.state == csNoMatch: return @@ -2730,14 +3031,16 @@ proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = m.firstMismatch.formal = formal break else: + # mirrored with updateDefaultParams: if formal.ast.kind == nkEmpty: # The default param value is set to empty in `instantiateProcType` # when the type of the default expression doesn't match the type # of the instantiated proc param: - localError(c.config, m.call.info, - ("The default parameter '$1' has incompatible type " & - "with the explicitly requested proc instantiation") % - formal.name.s) + pushInfoContext(c.config, m.call.info, + if m.calleeSym != nil: m.calleeSym.detailedInfo else: "") + typeMismatch(c.config, formal.ast.info, formal.typ, formal.ast.typ, formal.ast) + popInfoContext(c.config) + formal.ast.typ = errorType(c) if nfDefaultRefsParam in formal.ast.flags: m.call.flags.incl nfDefaultRefsParam var defaultValue = copyTree(formal.ast) @@ -2746,7 +3049,7 @@ proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = # proc foo(x: T = 0.0) # foo() if {tfImplicitTypeParam, tfGenericTypeParam} * formal.typ.flags != {}: - let existing = PType(idTableGet(m.bindings, formal.typ)) + let existing = idTableGet(m.bindings, formal.typ) if existing == nil or existing.kind == tyTypeDesc: # see bug #11600: put(m, formal.typ, defaultValue.typ) @@ -2779,9 +3082,9 @@ proc instTypeBoundOp*(c: PContext; dc: PSym; t: PType; info: TLineInfo; var f = dc.typ[col] if op == attachedDeepCopy: - if f.kind in {tyRef, tyPtr}: f = f.lastSon + if f.kind in {tyRef, tyPtr}: f = f.elementType else: - if f.kind in {tyVar}: f = f.lastSon + if f.kind in {tyVar}: f = f.elementType if typeRel(m, f, t) == isNone: result = nil localError(c.config, info, "cannot instantiate: '" & dc.name.s & "'") diff --git a/compiler/sizealignoffsetimpl.nim b/compiler/sizealignoffsetimpl.nim index 9e5a9ab90..1dd481ec0 100644 --- a/compiler/sizealignoffsetimpl.nim +++ b/compiler/sizealignoffsetimpl.nim @@ -248,7 +248,7 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = typ.size = conf.target.ptrSize typ.align = int16(conf.target.ptrSize) of tyCstring, tySequence, tyPtr, tyRef, tyVar, tyLent: - let base = typ.lastSon + let base = typ.last if base == typ: # this is not the correct location to detect ``type A = ptr A`` typ.size = szIllegalRecursion @@ -262,9 +262,9 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = typ.size = conf.target.ptrSize of tyArray: - computeSizeAlign(conf, typ[1]) - let elemSize = typ[1].size - let len = lengthOrd(conf, typ[0]) + computeSizeAlign(conf, typ.elementType) + let elemSize = typ.elementType.size + let len = lengthOrd(conf, typ.indexType) if elemSize < 0: typ.size = elemSize typ.align = int16(elemSize) @@ -273,10 +273,10 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = typ.align = szUnknownSize else: typ.size = toInt64Checked(len * int32(elemSize), szTooBigSize) - typ.align = typ[1].align + typ.align = typ.elementType.align of tyUncheckedArray: - let base = typ.lastSon + let base = typ.last computeSizeAlign(conf, base) typ.size = 0 typ.align = base.align @@ -300,11 +300,11 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = typ.size = 8 typ.align = int16(conf.floatInt64Align) of tySet: - if typ[0].kind == tyGenericParam: + if typ.elementType.kind == tyGenericParam: typ.size = szUncomputedSize typ.align = szUncomputedSize else: - let length = toInt64(lengthOrd(conf, typ[0])) + let length = toInt64(lengthOrd(conf, typ.elementType)) if length <= 8: typ.size = 1 typ.align = 1 @@ -324,16 +324,15 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = typ.size = align(length, 8) div 8 + 1 typ.align = 1 of tyRange: - computeSizeAlign(conf, typ[0]) - typ.size = typ[0].size - typ.align = typ[0].align - typ.paddingAtEnd = typ[0].paddingAtEnd + computeSizeAlign(conf, typ.elementType) + typ.size = typ.elementType.size + typ.align = typ.elementType.align + typ.paddingAtEnd = typ.elementType.paddingAtEnd of tyTuple: try: var accum = OffsetAccum(maxAlign: 1) - for i in 0..<typ.len: - let child = typ[i] + for i, child in typ.ikids: computeSizeAlign(conf, child) accum.align(child.align) if typ.n != nil: # is named tuple (has field symbols)? @@ -351,11 +350,11 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = of tyObject: try: var accum = - if typ[0] != nil: + if typ.baseClass != nil: # compute header size - var st = typ[0] + var st = typ.baseClass while st.kind in skipPtrs: - st = st[^1] + st = st.skipModifier computeSizeAlign(conf, st) if conf.backend == backendCpp: OffsetAccum( @@ -386,6 +385,13 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = accum.maxAlign = 1 computeObjectOffsetsFoldFunction(conf, typ.n, true, accum) else: + if typ.baseClass == nil and lacksMTypeField(typ) and typ.n.len == 1 and + typ.n[0].kind == nkSym and + typ.n[0].sym.typ.skipTypes(abstractInst).kind == tyUncheckedArray: + # a dummy field is generated for an object with a single field + # with an UncheckedArray type + assert accum.offset == 0 + accum.offset = 1 computeObjectOffsetsFoldFunction(conf, typ.n, false, accum) let paddingAtEnd = int16(accum.finish()) if typ.sym != nil and @@ -403,24 +409,24 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = typ.align = szIllegalRecursion typ.paddingAtEnd = szIllegalRecursion of tyInferred: - if typ.len > 1: - computeSizeAlign(conf, typ.lastSon) - typ.size = typ.lastSon.size - typ.align = typ.lastSon.align - typ.paddingAtEnd = typ.lastSon.paddingAtEnd + if typ.hasElementType: + computeSizeAlign(conf, typ.last) + typ.size = typ.last.size + typ.align = typ.last.align + typ.paddingAtEnd = typ.last.paddingAtEnd of tyGenericInst, tyDistinct, tyGenericBody, tyAlias, tySink, tyOwned: - computeSizeAlign(conf, typ.lastSon) - typ.size = typ.lastSon.size - typ.align = typ.lastSon.align - typ.paddingAtEnd = typ.lastSon.paddingAtEnd + computeSizeAlign(conf, typ.skipModifier) + typ.size = typ.skipModifier.size + typ.align = typ.skipModifier.align + typ.paddingAtEnd = typ.last.paddingAtEnd of tyTypeClasses: if typ.isResolvedUserTypeClass: - computeSizeAlign(conf, typ.lastSon) - typ.size = typ.lastSon.size - typ.align = typ.lastSon.align - typ.paddingAtEnd = typ.lastSon.paddingAtEnd + computeSizeAlign(conf, typ.last) + typ.size = typ.last.size + typ.align = typ.last.align + typ.paddingAtEnd = typ.last.paddingAtEnd else: typ.size = szUnknownSize typ.align = szUnknownSize @@ -439,10 +445,10 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = of tyStatic: if typ.n != nil: - computeSizeAlign(conf, typ.lastSon) - typ.size = typ.lastSon.size - typ.align = typ.lastSon.align - typ.paddingAtEnd = typ.lastSon.paddingAtEnd + computeSizeAlign(conf, typ.last) + typ.size = typ.last.size + typ.align = typ.last.align + typ.paddingAtEnd = typ.last.paddingAtEnd else: typ.size = szUnknownSize typ.align = szUnknownSize diff --git a/compiler/sourcemap.nim b/compiler/sourcemap.nim index b0b6fea2e..1395168cd 100644 --- a/compiler/sourcemap.nim +++ b/compiler/sourcemap.nim @@ -11,7 +11,7 @@ type Mapping = object ## Mapping refers to a line in the JS output. ## It is made up of segments which refer to the tokens in the line - case inSource: bool # Whether the line in JS has Nim equivilant + case inSource: bool # Whether the line in JS has Nim equivalent of true: file: int # Index into files list line: int # 0 indexed line of code in the Nim source @@ -160,10 +160,7 @@ func parse*(source: string): SourceInfo = func toSourceMap*(info: SourceInfo, file: string): SourceMap {.raises: [].} = ## Convert from high level SourceInfo into the required SourceMap object # Add basic info - result.version = 3 - result.file = file - result.sources = info.files - result.names = info.names + result = SourceMap(version: 3, file: file, sources: info.files, names: info.names) # Convert nodes into mappings. # Mappings are split into blocks where each block referes to a line in the outputted JS. # Blocks can be separated into statements which refere to tokens on the line. diff --git a/compiler/spawn.nim b/compiler/spawn.nim index bfcdd78ea..58d5a4928 100644 --- a/compiler/spawn.nim +++ b/compiler/spawn.nim @@ -16,7 +16,7 @@ from trees import getMagic, getRoot proc callProc(a: PNode): PNode = result = newNodeI(nkCall, a.info) result.add a - result.typ = a.typ[0] + result.typ = a.typ.returnType # we have 4 cases to consider: # - a void proc --> nothing to do @@ -50,7 +50,7 @@ proc typeNeedsNoDeepCopy(t: PType): bool = # note that seq[T] is fine, but 'var seq[T]' is not, so we need to skip 'var' # for the stricter check and likewise we can skip 'seq' for a less # strict check: - if t.kind in {tyVar, tyLent, tySequence}: t = t.lastSon + if t.kind in {tyVar, tyLent, tySequence}: t = t.elementType result = not containsGarbageCollectedRef(t) proc addLocalVar(g: ModuleGraph; varSection, varInit: PNode; idgen: IdGenerator; owner: PSym; typ: PType; @@ -109,6 +109,16 @@ stmtList: """ +proc castToVoidPointer(g: ModuleGraph, n: PNode, fvField: PNode): PNode = + if g.config.backend == backendCpp: + result = fvField + else: + let ptrType = getSysType(g, n.info, tyPointer) + result = newNodeI(nkCast, fvField.info) + result.add newNodeI(nkEmpty, fvField.info) + result.add fvField + result.typ = ptrType + proc createWrapperProc(g: ModuleGraph; f: PNode; threadParam, argsParam: PSym; varSection, varInit, call, barrier, fv: PNode; idgen: IdGenerator; @@ -141,10 +151,10 @@ proc createWrapperProc(g: ModuleGraph; f: PNode; threadParam, argsParam: PSym; if spawnKind == srByVar: body.add newAsgnStmt(genDeref(threadLocalProm.newSymNode), call) elif fv != nil: - let fk = flowVarKind(g.config, fv.typ[1]) + let fk = flowVarKind(g.config, fv.typ.firstGenericParam) if fk == fvInvalid: localError(g.config, f.info, "cannot create a flowVar of type: " & - typeToString(fv.typ[1])) + typeToString(fv.typ.firstGenericParam)) body.add newAsgnStmt(indirectAccess(threadLocalProm.newSymNode, if fk == fvGC: "data" else: "blob", fv.info, g.cache), call) if fk == fvGC: @@ -156,8 +166,9 @@ proc createWrapperProc(g: ModuleGraph; f: PNode; threadParam, argsParam: PSym; if barrier == nil: # by now 'fv' is shared and thus might have beeen overwritten! we need # to use the thread-local view instead: + let castExpr = castToVoidPointer(g, f, threadLocalProm.newSymNode) body.add callCodegenProc(g, "nimFlowVarSignal", threadLocalProm.info, - threadLocalProm.newSymNode) + castExpr) else: body.add call if barrier != nil: @@ -193,7 +204,7 @@ proc createCastExpr(argsParam: PSym; objType: PType; idgen: IdGenerator): PNode result.typ.rawAddSon(objType) template checkMagicProcs(g: ModuleGraph, n: PNode, formal: PNode) = - if (formal.typ.kind == tyVarargs and formal.typ[0].kind in {tyTyped, tyUntyped}) or + if (formal.typ.kind == tyVarargs and formal.typ.elementType.kind in {tyTyped, tyUntyped}) or formal.typ.kind in {tyTyped, tyUntyped}: localError(g.config, n.info, "'spawn'ed function cannot have a 'typed' or 'untyped' parameter") @@ -413,7 +424,8 @@ proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExp # create flowVar: result.add newFastAsgnStmt(fvField, callProc(spawnExpr[^1])) if barrier == nil: - result.add callCodegenProc(g, "nimFlowVarCreateSemaphore", fvField.info, fvField) + let castExpr = castToVoidPointer(g, n, fvField) + result.add callCodegenProc(g, "nimFlowVarCreateSemaphore", fvField.info, castExpr) elif spawnKind == srByVar: var field = newSym(skField, getIdent(g.cache, "fv"), idgen, owner, n.info, g.config.options) diff --git a/compiler/suggest.nim b/compiler/suggest.nim index 802da1c3e..a5213086b 100644 --- a/compiler/suggest.nim +++ b/compiler/suggest.nim @@ -32,13 +32,13 @@ # included from sigmatch.nim -import prefixmatches +import prefixmatches, suggestsymdb from wordrecg import wDeprecated, wError, wAddr, wYield import std/[algorithm, sets, parseutils, tables] when defined(nimsuggest): - import std/tables, pathutils # importer + import pathutils # importer const sep = '\t' @@ -85,7 +85,16 @@ proc cmpSuggestions(a, b: Suggest): int = # independent of hashing order: result = cmp(a.name[], b.name[]) -proc getTokenLenFromSource(conf: ConfigRef; ident: string; info: TLineInfo): int = +proc scanForTrailingAsterisk(line: string, start: int): int = + result = 0 + while start+result < line.len and line[start+result] in {' ', '\t'}: + inc result + if start+result < line.len and line[start+result] == '*': + inc result + else: + result = 0 + +proc getTokenLenFromSource(conf: ConfigRef; ident: string; info: TLineInfo; skipTrailingAsterisk: bool = false): int = let line = sourceLine(conf, info) column = toColumn(info) @@ -105,10 +114,16 @@ proc getTokenLenFromSource(conf: ConfigRef; ident: string; info: TLineInfo): int result = skipUntil(line, '`', column) if cmpIgnoreStyle(line[column..column + result - 1], ident) != 0: result = 0 + elif column >= 0 and line[column] == '`' and isOpeningBacktick(column): + result = skipUntil(line, '`', column + 1) + 2 + if cmpIgnoreStyle(line[column + 1..column + result - 2], ident) != 0: + result = 0 elif ident[0] in linter.Letters and ident[^1] != '=': result = identLen(line, column) if cmpIgnoreStyle(line[column..column + result - 1], ident[0..min(result-1,len(ident)-1)]) != 0: result = 0 + if skipTrailingAsterisk and result > 0: + result += scanForTrailingAsterisk(line, column + result) else: var sourceIdent: string = "" result = parseWhile(line, sourceIdent, @@ -161,7 +176,7 @@ proc symToSuggest*(g: ModuleGraph; s: PSym, isLocal: bool, section: IdeCmd, info if section == ideInlayHints: result.forth = typeToString(s.typ, preferInlayHint) else: - result.forth = typeToString(s.typ) + result.forth = typeToString(s.typ, preferInferredEffects) else: result.forth = "" when defined(nimsuggest) and not defined(noDocgen) and not defined(leanCompiler): @@ -184,7 +199,7 @@ proc symToSuggest*(g: ModuleGraph; s: PSym, isLocal: bool, section: IdeCmd, info result.tokenLen = if section notin {ideHighlight, ideInlayHints}: s.name.s.len else: - getTokenLenFromSource(g.config, s.name.s, infox) + getTokenLenFromSource(g.config, s.name.s, infox, section == ideInlayHints) result.version = g.config.suggestVersion result.endLine = endLine result.endCol = endCol @@ -254,7 +269,7 @@ proc `$`*(suggest: Suggest): string = result.add(sep) result.add($suggest.endCol) -proc suggestToSuggestInlayHint*(sug: Suggest): SuggestInlayHint = +proc suggestToSuggestInlayTypeHint*(sug: Suggest): SuggestInlayHint = SuggestInlayHint( kind: sihkType, line: sug.line, @@ -266,6 +281,30 @@ proc suggestToSuggestInlayHint*(sug: Suggest): SuggestInlayHint = tooltip: "" ) +proc suggestToSuggestInlayExceptionHintLeft*(sug: Suggest, propagatedExceptions: seq[PType]): SuggestInlayHint = + SuggestInlayHint( + kind: sihkException, + line: sug.line, + column: sug.column, + label: "try ", + paddingLeft: false, + paddingRight: false, + allowInsert: false, + tooltip: "propagated exceptions: " & $propagatedExceptions + ) + +proc suggestToSuggestInlayExceptionHintRight*(sug: Suggest, propagatedExceptions: seq[PType]): SuggestInlayHint = + SuggestInlayHint( + kind: sihkException, + line: sug.line, + column: sug.column + sug.tokenLen, + label: "!", + paddingLeft: false, + paddingRight: false, + allowInsert: false, + tooltip: "propagated exceptions: " & $propagatedExceptions + ) + proc suggestResult*(conf: ConfigRef; s: Suggest) = if not isNil(conf.suggestionResultHook): conf.suggestionResultHook(s) @@ -326,8 +365,8 @@ proc fieldVisible*(c: PContext, f: PSym): bool {.inline.} = proc getQuality(s: PSym): range[0..100] = result = 100 - if s.typ != nil and s.typ.len > 1: - var exp = s.typ[1].skipTypes({tyGenericInst, tyVar, tyLent, tyAlias, tySink}) + if s.typ != nil and s.typ.paramsLen > 0: + var exp = s.typ.firstParamType.skipTypes({tyGenericInst, tyVar, tyLent, tyAlias, tySink}) if exp.kind == tyVarargs: exp = elemType(exp) if exp.kind in {tyUntyped, tyTyped, tyGenericParam, tyAnything}: result = 50 @@ -396,17 +435,17 @@ proc suggestVar(c: PContext, n: PNode, outputs: var Suggestions) = wholeSymTab(nameFits(c, it, n), ideCon) proc typeFits(c: PContext, s: PSym, firstArg: PType): bool {.inline.} = - if s.typ != nil and s.typ.len > 1 and s.typ[1] != nil: + if s.typ != nil and s.typ.paramsLen > 0 and s.typ.firstParamType != nil: # special rule: if system and some weird generic match via 'tyUntyped' # or 'tyGenericParam' we won't list it either to reduce the noise (nobody # wants 'system.`-|` as suggestion let m = s.getModule() if m != nil and sfSystemModule in m.flags: if s.kind == skType: return - var exp = s.typ[1].skipTypes({tyGenericInst, tyVar, tyLent, tyAlias, tySink}) + var exp = s.typ.firstParamType.skipTypes({tyGenericInst, tyVar, tyLent, tyAlias, tySink}) if exp.kind == tyVarargs: exp = elemType(exp) if exp.kind in {tyUntyped, tyTyped, tyGenericParam, tyAnything}: return - result = sigmatch.argtypeMatches(c, s.typ[1], firstArg) + result = sigmatch.argtypeMatches(c, s.typ.firstParamType, firstArg) else: result = false @@ -476,13 +515,13 @@ proc suggestFieldAccess(c: PContext, n, field: PNode, outputs: var Suggestions) var t = typ while t != nil: suggestSymList(c, t.n, field, n.info, outputs) - t = t[0] + t = t.baseClass elif typ.kind == tyObject: var t = typ while true: suggestObject(c, t.n, field, n.info, outputs) - if t[0] == nil: break - t = skipTypes(t[0], skipPtrs) + if t.baseClass == nil: break + t = skipTypes(t.baseClass, skipPtrs) elif typ.kind == tyTuple and typ.n != nil: # All tuple fields are in scope # So go through each field and add it to the suggestions (If it passes the filter) @@ -523,6 +562,16 @@ proc isTracked*(current, trackPos: TLineInfo, tokenLen: int): bool = else: result = false +proc isTracked*(current, trackPos: TinyLineInfo, tokenLen: int): bool = + if current.line==trackPos.line: + let col = trackPos.col + if col >= current.col and col <= current.col+tokenLen-1: + result = true + else: + result = false + else: + result = false + when defined(nimsuggest): # Since TLineInfo defined a == operator that doesn't include the column, # we map TLineInfo to a unique int here for this lookup table: @@ -573,7 +622,7 @@ proc suggestSym*(g: ModuleGraph; info: TLineInfo; s: PSym; usageSym: var PSym; i ## misnamed: should be 'symDeclared' let conf = g.config when defined(nimsuggest): - g.suggestSymbols.mgetOrPut(info.fileIndex, @[]).add SymInfoPair(sym: s, info: info, isDecl: isDecl) + g.suggestSymbols.add SymInfoPair(sym: s, info: info, isDecl: isDecl), optIdeExceptionInlayHints in g.config.globalOptions if conf.suggestVersion == 0: if s.allUsages.len == 0: @@ -647,7 +696,7 @@ proc markOwnerModuleAsUsed(c: PContext; s: PSym) = else: inc i -proc markUsed(c: PContext; info: TLineInfo; s: PSym) = +proc markUsed(c: PContext; info: TLineInfo; s: PSym; checkStyle = true) = let conf = c.config incl(s.flags, sfUsed) if s.kind == skEnumField and s.owner != nil: @@ -664,7 +713,8 @@ proc markUsed(c: PContext; info: TLineInfo; s: PSym) = if sfError in s.flags: userError(conf, info, s) when defined(nimsuggest): suggestSym(c.graph, info, s, c.graph.usageSym, false) - styleCheckUse(c, info, s) + if checkStyle: + styleCheckUse(c, info, s) markOwnerModuleAsUsed(c, s) proc safeSemExpr*(c: PContext, n: PNode): PNode = @@ -761,11 +811,11 @@ proc suggestPragmas*(c: PContext, n: PNode) = # Now show suggestions for user pragmas for pragma in c.userPragmas: - var pm = default(PrefixMatch) - if filterSym(pragma, n, pm): - outputs &= symToSuggest(c.graph, pragma, isLocal=true, ideSug, info, - pragma.getQuality, pm, c.inTypeContext > 0, 0, - extractDocs=false) + var pm = default(PrefixMatch) + if filterSym(pragma, n, pm): + outputs &= symToSuggest(c.graph, pragma, isLocal=true, ideSug, info, + pragma.getQuality, pm, c.inTypeContext > 0, 0, + extractDocs=false) produceOutput(outputs, c.config) if outputs.len > 0: diff --git a/compiler/suggestsymdb.nim b/compiler/suggestsymdb.nim new file mode 100644 index 000000000..e1e67afbe --- /dev/null +++ b/compiler/suggestsymdb.nim @@ -0,0 +1,212 @@ +import std/[intsets, tables, algorithm, assertions] +import ast, lineinfos, msgs + +type + PackedBoolArray* = object + s: IntSet + len: int + + TinyLineInfo* = object + line*: uint16 + col*: int16 + + SymInfoPair* = object + sym*: PSym + info*: TLineInfo + caughtExceptions*: seq[PType] + caughtExceptionsSet*: bool + isDecl*: bool + + SuggestFileSymbolDatabase* = object + lineInfo*: seq[TinyLineInfo] + sym*: seq[PSym] + caughtExceptions*: seq[seq[PType]] + caughtExceptionsSet*: PackedBoolArray + isDecl*: PackedBoolArray + fileIndex*: FileIndex + trackCaughtExceptions*: bool + isSorted*: bool + + SuggestSymbolDatabase* = Table[FileIndex, SuggestFileSymbolDatabase] + + +func newPackedBoolArray*(): PackedBoolArray = + PackedBoolArray( + s: initIntSet(), + len: 0 + ) + +func low*(s: PackedBoolArray): int = + 0 + +func high*(s: PackedBoolArray): int = + s.len - 1 + +func `[]`*(s: PackedBoolArray; idx: int): bool = + s.s.contains(idx) + +proc `[]=`*(s: var PackedBoolArray; idx: int; v: bool) = + if v: + s.s.incl(idx) + else: + s.s.excl(idx) + +proc add*(s: var PackedBoolArray; v: bool) = + inc(s.len) + if v: + s.s.incl(s.len - 1) + +proc reverse*(s: var PackedBoolArray) = + var + reversedSet = initIntSet() + for i in 0..s.high: + if s.s.contains(i): + reversedSet.incl(s.high - i) + s.s = reversedSet + +proc getSymInfoPair*(s: SuggestFileSymbolDatabase; idx: int): SymInfoPair = + SymInfoPair( + sym: s.sym[idx], + info: TLineInfo( + line: s.lineInfo[idx].line, + col: s.lineInfo[idx].col, + fileIndex: s.fileIndex + ), + caughtExceptions: + if s.trackCaughtExceptions: + s.caughtExceptions[idx] + else: + @[], + caughtExceptionsSet: + if s.trackCaughtExceptions: + s.caughtExceptionsSet[idx] + else: + false, + isDecl: s.isDecl[idx] + ) + +proc reverse*(s: var SuggestFileSymbolDatabase) = + s.lineInfo.reverse() + s.sym.reverse() + s.caughtExceptions.reverse() + s.caughtExceptionsSet.reverse() + s.isDecl.reverse() + +proc newSuggestFileSymbolDatabase*(aFileIndex: FileIndex; aTrackCaughtExceptions: bool): SuggestFileSymbolDatabase = + SuggestFileSymbolDatabase( + lineInfo: @[], + sym: @[], + caughtExceptions: @[], + caughtExceptionsSet: newPackedBoolArray(), + isDecl: newPackedBoolArray(), + fileIndex: aFileIndex, + trackCaughtExceptions: aTrackCaughtExceptions, + isSorted: true + ) + +proc exactEquals*(a, b: TinyLineInfo): bool = + result = a.line == b.line and a.col == b.col + +proc `==`*(a, b: SymInfoPair): bool = + result = a.sym == b.sym and a.info.exactEquals(b.info) + +func cmp*(a: TinyLineInfo; b: TinyLineInfo): int = + result = cmp(a.line, b.line) + if result == 0: + result = cmp(a.col, b.col) + +func compare*(s: var SuggestFileSymbolDatabase; i, j: int): int = + result = cmp(s.lineInfo[i], s.lineInfo[j]) + if result == 0: + result = cmp(s.isDecl[i], s.isDecl[j]) + +proc exchange(s: var SuggestFileSymbolDatabase; i, j: int) = + if i == j: + return + var tmp1 = s.lineInfo[i] + s.lineInfo[i] = s.lineInfo[j] + s.lineInfo[j] = tmp1 + if s.trackCaughtExceptions: + var tmp2 = s.caughtExceptions[i] + s.caughtExceptions[i] = s.caughtExceptions[j] + s.caughtExceptions[j] = tmp2 + var tmp3 = s.caughtExceptionsSet[i] + s.caughtExceptionsSet[i] = s.caughtExceptionsSet[j] + s.caughtExceptionsSet[j] = tmp3 + var tmp4 = s.isDecl[i] + s.isDecl[i] = s.isDecl[j] + s.isDecl[j] = tmp4 + var tmp5 = s.sym[i] + s.sym[i] = s.sym[j] + s.sym[j] = tmp5 + +proc quickSort(s: var SuggestFileSymbolDatabase; ll, rr: int) = + var + i, j, pivotIdx: int + l = ll + r = rr + while true: + i = l + j = r + pivotIdx = l + ((r - l) shr 1) + while true: + while (i < pivotIdx) and (s.compare(pivotIdx, i) > 0): + inc i + while (j > pivotIdx) and (s.compare(pivotIdx, j) < 0): + dec j + if i < j: + s.exchange(i, j) + if pivotIdx == i: + pivotIdx = j + inc i + elif pivotIdx == j: + pivotIdx = i + dec j + else: + inc i + dec j + else: + break + if (pivotIdx - l) < (r - pivotIdx): + if (l + 1) < pivotIdx: + s.quickSort(l, pivotIdx - 1) + l = pivotIdx + 1 + else: + if (pivotIdx + 1) < r: + s.quickSort(pivotIdx + 1, r) + if (l + 1) < pivotIdx: + r = pivotIdx - 1 + else: + break + if l >= r: + break + +proc sort*(s: var SuggestFileSymbolDatabase) = + s.quickSort(s.lineInfo.low, s.lineInfo.high) + s.isSorted = true + +proc add*(s: var SuggestFileSymbolDatabase; v: SymInfoPair) = + doAssert(v.info.fileIndex == s.fileIndex) + s.lineInfo.add(TinyLineInfo( + line: v.info.line, + col: v.info.col + )) + s.sym.add(v.sym) + s.isDecl.add(v.isDecl) + if s.trackCaughtExceptions: + s.caughtExceptions.add(v.caughtExceptions) + s.caughtExceptionsSet.add(v.caughtExceptionsSet) + s.isSorted = false + +proc add*(s: var SuggestSymbolDatabase; v: SymInfoPair; trackCaughtExceptions: bool) = + s.mgetOrPut(v.info.fileIndex, newSuggestFileSymbolDatabase(v.info.fileIndex, trackCaughtExceptions)).add(v) + +proc findSymInfoIndex*(s: var SuggestFileSymbolDatabase; li: TLineInfo): int = + doAssert(li.fileIndex == s.fileIndex) + if not s.isSorted: + s.sort() + var q = TinyLineInfo( + line: li.line, + col: li.col + ) + result = binarySearch(s.lineInfo, q, cmp) diff --git a/compiler/syntaxes.nim b/compiler/syntaxes.nim index ef6b1da58..6b325c77f 100644 --- a/compiler/syntaxes.nim +++ b/compiler/syntaxes.nim @@ -60,7 +60,7 @@ proc parsePipe(filename: AbsoluteFile, inputStream: PLLStream; cache: IdentCache else: inc(i, 2) while i < line.len and line[i] in Whitespace: inc(i) - var p: Parser + var p: Parser = default(Parser) openParser(p, filename, llStreamOpen(substr(line, i)), cache, config) result = parseAll(p) closeParser(p) diff --git a/compiler/transf.nim b/compiler/transf.nim index edae6b847..8dd24e090 100644 --- a/compiler/transf.nim +++ b/compiler/transf.nim @@ -18,6 +18,8 @@ # * performs lambda lifting for closure support # * transforms 'defer' into a 'try finally' statement +import std / tables + import options, ast, astalgo, trees, msgs, idents, renderer, types, semfold, magicsys, cgmeth, @@ -38,7 +40,7 @@ import closureiters, lambdalifting type PTransCon = ref object # part of TContext; stackable - mapping: TIdNodeTable # mapping from symbols to nodes + mapping: Table[ItemId, PNode] # mapping from symbols to nodes owner: PSym # current owner forStmt: PNode # current for stmt forLoopBody: PNode # transformed for loop body @@ -54,6 +56,7 @@ type contSyms, breakSyms: seq[PSym] # to transform 'continue' and 'break' deferDetected, tooEarly: bool isIntroducingNewLocalVars: bool # true if we are in `introducingNewLocalVars` (don't transform yields) + inAddr: bool flags: TransformFlags graph: ModuleGraph idgen: IdGenerator @@ -76,7 +79,7 @@ proc newTransNode(kind: TNodeKind, n: PNode, proc newTransCon(owner: PSym): PTransCon = assert owner != nil - result = PTransCon(mapping: initIdNodeTable(), owner: owner) + result = PTransCon(mapping: initTable[ItemId, PNode](), owner: owner) proc pushTransCon(c: PTransf, t: PTransCon) = t.next = c.transCon @@ -95,7 +98,7 @@ proc newTemp(c: PTransf, typ: PType, info: TLineInfo): PNode = r.typ = typ #skipTypes(typ, {tyGenericInst, tyAlias, tySink}) incl(r.flags, sfFromGeneric) let owner = getCurrOwner(c) - if owner.isIterator and not c.tooEarly: + if owner.isIterator and not c.tooEarly and not isDefined(c.graph.config, "nimOptIters"): result = freshVarForClosureIter(c.graph, r, c.idgen, owner) else: result = newSymNode(r) @@ -159,7 +162,7 @@ proc transformSymAux(c: PTransf, n: PNode): PNode = else: b = n while tc != nil: - result = idNodeTableGet(tc.mapping, b.sym) + result = getOrDefault(tc.mapping, b.sym.itemId) if result != nil: # this slightly convoluted way ensures the line info stays correct: if result.kind == nkSym: @@ -174,7 +177,7 @@ proc transformSym(c: PTransf, n: PNode): PNode = proc freshVar(c: PTransf; v: PSym): PNode = let owner = getCurrOwner(c) - if owner.isIterator and not c.tooEarly: + if owner.isIterator and not c.tooEarly and not isDefined(c.graph.config, "nimOptIters"): result = freshVarForClosureIter(c.graph, v, c.idgen, owner) else: var newVar = copySym(v, c.idgen) @@ -194,7 +197,7 @@ proc transformVarSection(c: PTransf, v: PNode): PNode = if vn.kind == nkSym: internalAssert(c.graph.config, it.len == 3) let x = freshVar(c, vn.sym) - idNodeTablePut(c.transCon.mapping, vn.sym, x) + c.transCon.mapping[vn.sym.itemId] = x var defs = newTransNode(nkIdentDefs, it.info, 3) if importantComments(c.graph.config): # keep documentation information: @@ -215,7 +218,7 @@ proc transformVarSection(c: PTransf, v: PNode): PNode = for j in 0..<it.len-2: if it[j].kind == nkSym: let x = freshVar(c, it[j].sym) - idNodeTablePut(c.transCon.mapping, it[j].sym, x) + c.transCon.mapping[it[j].sym.itemId] = x defs[j] = x else: defs[j] = transform(c, it[j]) @@ -256,7 +259,7 @@ proc transformBlock(c: PTransf, n: PNode): PNode = var labl: PSym if c.inlining > 0: labl = newLabel(c, n[0]) - idNodeTablePut(c.transCon.mapping, n[0].sym, newSymNode(labl)) + c.transCon.mapping[n[0].sym.itemId] = newSymNode(labl) else: labl = if n[0].kind != nkEmpty: @@ -328,7 +331,7 @@ proc introduceNewLocalVars(c: PTransf, n: PNode): PNode = of nkProcDef: # todo optimize nosideeffects? result = newTransNode(n) let x = newSymNode(copySym(n[namePos].sym, c.idgen)) - idNodeTablePut(c.transCon.mapping, n[namePos].sym, x) + c.transCon.mapping[n[namePos].sym.itemId] = x result[namePos] = x # we have to copy proc definitions for iters for i in 1..<n.len: result[i] = introduceNewLocalVars(c, n[i]) @@ -413,9 +416,15 @@ proc transformYield(c: PTransf, n: PNode): PNode = result.add transform(c, v) for i in 0..<c.transCon.forStmt.len - 2: - let lhs = c.transCon.forStmt[i] - let rhs = transform(c, newTupleAccess(c.graph, tmp, i)) - result.add(asgnTo(lhs, rhs)) + if c.transCon.forStmt[i].kind == nkVarTuple: + for j in 0..<c.transCon.forStmt[i].len-1: + let lhs = c.transCon.forStmt[i][j] + let rhs = transform(c, newTupleAccess(c.graph, newTupleAccess(c.graph, tmp, i), j)) + result.add(asgnTo(lhs, rhs)) + else: + let lhs = c.transCon.forStmt[i] + let rhs = transform(c, newTupleAccess(c.graph, tmp, i)) + result.add(asgnTo(lhs, rhs)) else: for i in 0..<c.transCon.forStmt.len - 2: let lhs = c.transCon.forStmt[i] @@ -454,6 +463,14 @@ proc transformYield(c: PTransf, n: PNode): PNode = let rhs = transform(c, e) result.add(asgnTo(lhs, rhs)) + + # bug #23536; note that the info of forLoopBody should't change + for idx in 0 ..< result.len: + var changeNode = result[idx] + changeNode.info = c.transCon.forStmt.info + for i, child in changeNode: + child.info = changeNode.info + inc(c.transCon.yieldStmts) if c.transCon.yieldStmts <= 1: # common case @@ -464,15 +481,10 @@ proc transformYield(c: PTransf, n: PNode): PNode = result.add(introduceNewLocalVars(c, c.transCon.forLoopBody)) c.isIntroducingNewLocalVars = false - for idx in 0 ..< result.len: - var changeNode = result[idx] - changeNode.info = c.transCon.forStmt.info - for i, child in changeNode: - child.info = changeNode.info - proc transformAddrDeref(c: PTransf, n: PNode, kinds: TNodeKinds): PNode = result = transformSons(c, n) - if c.graph.config.backend == backendCpp or sfCompileToCpp in c.module.flags: return + # inlining of 'var openarray' iterators; bug #19977 + if n.typ.kind != tyOpenArray and (c.graph.config.backend == backendCpp or sfCompileToCpp in c.module.flags): return var n = result case n[0].kind of nkObjUpConv, nkObjDownConv, nkChckRange, nkChckRangeF, nkChckRange64: @@ -496,7 +508,15 @@ proc transformAddrDeref(c: PTransf, n: PNode, kinds: TNodeKinds): PNode = elif n.typ.skipTypes(abstractInst).kind in {tyVar}: result.typ = toVar(result.typ, n.typ.skipTypes(abstractInst).kind, c.idgen) else: - if n[0].kind in kinds: + if n[0].kind in kinds and + not (n[0][0].kind == nkSym and n[0][0].sym.kind == skForVar and + n[0][0].typ.skipTypes(abstractVar).kind == tyTuple + ) and not (n[0][0].kind == nkSym and n[0][0].sym.kind == skParam and + n.typ.kind == tyVar and + n.typ.skipTypes(abstractVar).kind == tyOpenArray and + n[0][0].typ.skipTypes(abstractVar).kind == tyString) + : # elimination is harmful to `for tuple unpack` because of newTupleAccess + # it is also harmful to openArrayLoc (var openArray) for strings # addr ( deref ( x )) --> x result = n[0][0] if n.typ.skipTypes(abstractVar).kind != tyOpenArray: @@ -508,7 +528,7 @@ proc generateThunk(c: PTransf; prc: PNode, dest: PType): PNode = # we cannot generate a proper thunk here for GC-safety reasons # (see internal documentation): - if c.graph.config.backend == backendJs: return prc + if jsNoLambdaLifting in c.graph.config.legacyFeatures and c.graph.config.backend == backendJs: return prc result = newNodeIT(nkClosure, prc.info, dest) var conv = newNodeIT(nkHiddenSubConv, prc.info, dest) conv.add(newNodeI(nkEmpty, prc.info)) @@ -632,9 +652,11 @@ proc putArgInto(arg: PNode, formal: PType): TPutArgInto = case arg.kind of nkEmpty..nkNilLit: result = paDirectMapping - of nkDotExpr, nkDerefExpr, nkHiddenDeref, nkAddr, nkHiddenAddr: + of nkDotExpr, nkDerefExpr, nkHiddenDeref: + result = putArgInto(arg[0], formal) + of nkAddr, nkHiddenAddr: result = putArgInto(arg[0], formal) - #if result == paViaIndirection: result = paFastAsgn + if result == paViaIndirection: result = paFastAsgn of nkCurly, nkBracket: for i in 0..<arg.len: if putArgInto(arg[i], formal) != paDirectMapping: @@ -758,7 +780,7 @@ proc transformFor(c: PTransf, n: PNode): PNode = let pa = putArgInto(arg, formal.typ) case pa of paDirectMapping: - idNodeTablePut(newC.mapping, formal, arg) + newC.mapping[formal.itemId] = arg of paFastAsgn, paFastAsgnTakeTypeFromArg: var t = formal.typ if pa == paFastAsgnTakeTypeFromArg: @@ -772,10 +794,10 @@ proc transformFor(c: PTransf, n: PNode): PNode = #incl(temp.sym.flags, sfCursor) addVar(v, temp) stmtList.add(newAsgnStmt(c, nkFastAsgn, temp, arg, true)) - idNodeTablePut(newC.mapping, formal, temp) + newC.mapping[formal.itemId] = temp of paVarAsgn: assert(skipTypes(formal.typ, abstractInst).kind in {tyVar, tyLent}) - idNodeTablePut(newC.mapping, formal, arg) + newC.mapping[formal.itemId] = arg # XXX BUG still not correct if the arg has a side effect! of paViaIndirection: let t = formal.typ @@ -786,13 +808,13 @@ proc transformFor(c: PTransf, n: PNode): PNode = var addrExp = newNodeIT(nkHiddenAddr, formal.info, makeVarType(t.owner, t, c.idgen, tyPtr)) addrExp.add(arg) stmtList.add(newAsgnStmt(c, nkFastAsgn, temp, addrExp, true)) - idNodeTablePut(newC.mapping, formal, newDeref(temp)) + newC.mapping[formal.itemId] = newDeref(temp) of paComplexOpenarray: # arrays will deep copy here (pretty bad). var temp = newTemp(c, arg.typ, formal.info) addVar(v, temp) stmtList.add(newAsgnStmt(c, nkFastAsgn, temp, arg, true)) - idNodeTablePut(newC.mapping, formal, temp) + newC.mapping[formal.itemId] = temp let body = transformBody(c.graph, c.idgen, iter, {useCache}+c.flags) pushInfoContext(c.graph.config, n.info) @@ -894,10 +916,6 @@ proc transformCall(c: PTransf, n: PNode): PNode = inc(j) result.add(a) if result.len == 2: result = result[1] - elif magic == mAddr: - result = newTransNode(nkAddr, n, 1) - result[0] = n[1] - result = transformAddrDeref(c, result, {nkDerefExpr, nkHiddenDeref}) elif magic in {mNBindSym, mTypeOf, mRunnableExamples}: # for bindSym(myconst) we MUST NOT perform constant folding: result = n @@ -1061,7 +1079,10 @@ proc transform(c: PTransf, n: PNode): PNode = of nkHiddenAddr: result = transformAddrDeref(c, n, {nkHiddenDeref}) of nkAddr: + let oldInAddr = c.inAddr + c.inAddr = true result = transformAddrDeref(c, n, {nkDerefExpr, nkHiddenDeref}) + c.inAddr = oldInAddr of nkDerefExpr: result = transformAddrDeref(c, n, {nkAddr, nkHiddenAddr}) of nkHiddenDeref: @@ -1141,7 +1162,7 @@ proc transform(c: PTransf, n: PNode): PNode = let exprIsPointerCast = n.kind in {nkCast, nkConv, nkHiddenStdConv} and n.typ != nil and n.typ.kind == tyPointer - if not exprIsPointerCast: + if not exprIsPointerCast and not c.inAddr: var cnst = getConstExpr(c.module, result, c.idgen, c.graph) # we inline constants if they are not complex constants: if cnst != nil and not dontInlineConstant(n, cnst): diff --git a/compiler/trees.nim b/compiler/trees.nim index e39cbafe6..41b54eb09 100644 --- a/compiler/trees.nim +++ b/compiler/trees.nim @@ -116,7 +116,7 @@ proc isDeepConstExpr*(n: PNode; preventInheritance = false): bool = let t = n.typ.skipTypes({tyGenericInst, tyDistinct, tyAlias, tySink, tyOwned}) if t.kind in {tyRef, tyPtr} or tfUnion in t.flags: return false if t.kind == tyObject: - if preventInheritance and t[0] != nil: + if preventInheritance and t.baseClass != nil: result = false elif isCaseObj(t.n): result = false @@ -226,8 +226,7 @@ proc stupidStmtListExpr*(n: PNode): bool = proc dontInlineConstant*(orig, cnst: PNode): bool {.inline.} = # symbols that expand to a complex constant (array, etc.) should not be # inlined, unless it's the empty array: - result = orig.kind != cnst.kind and - cnst.kind in {nkCurly, nkPar, nkTupleConstr, nkBracket, nkObjConstr} and + result = cnst.kind in {nkCurly, nkPar, nkTupleConstr, nkBracket, nkObjConstr} and cnst.len > ord(cnst.kind == nkObjConstr) proc isRunnableExamples*(n: PNode): bool = diff --git a/compiler/typeallowed.nim b/compiler/typeallowed.nim index 483e55bc9..39193a42d 100644 --- a/compiler/typeallowed.nim +++ b/compiler/typeallowed.nim @@ -27,6 +27,7 @@ type taProcContextIsNotMacro taIsCastable taIsDefaultField + taVoid # only allow direct void fields of objects/tuples TTypeAllowedFlags* = set[TTypeAllowedFlag] @@ -60,6 +61,8 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, if typ == nil: return nil if containsOrIncl(marker, typ.id): return nil var t = skipTypes(typ, abstractInst-{tyTypeDesc, tySink}) + + let flags = if t.kind == tyVoid: flags else: flags-{taVoid} case t.kind of tyVar, tyLent: if kind in {skProc, skFunc, skConst} and (views notin c.features): @@ -73,7 +76,7 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, elif isOutParam(t) and kind != skParam: result = t else: - var t2 = skipTypes(t[0], abstractInst-{tyTypeDesc, tySink}) + var t2 = skipTypes(t.elementType, abstractInst-{tyTypeDesc, tySink}) case t2.kind of tyVar, tyLent: if taHeap notin flags: result = t2 # ``var var`` is illegal on the heap @@ -96,11 +99,11 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, # only closure iterators may be assigned to anything. result = t let f = if kind in {skProc, skFunc}: flags+{taNoUntyped} else: flags - for i in 1..<t.len: + for _, a in t.paramTypes: if result != nil: break - result = typeAllowedAux(marker, t[i], skParam, c, f-{taIsOpenArray}) - if result.isNil and t[0] != nil: - result = typeAllowedAux(marker, t[0], skResult, c, flags) + result = typeAllowedAux(marker, a, skParam, c, f-{taIsOpenArray}) + if result.isNil and t.returnType != nil: + result = typeAllowedAux(marker, t.returnType, skResult, c, flags) of tyTypeDesc: if kind in {skVar, skLet, skConst} and taProcContextIsNotMacro in flags: result = t @@ -115,12 +118,12 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, of tyStatic: if kind notin {skParam}: result = t of tyVoid: - if taField notin flags: result = t + if taVoid notin flags: result = t of tyTypeClasses: if tfGenericTypeParam in t.flags or taConcept in flags: #or taField notin flags: discard elif t.isResolvedUserTypeClass: - result = typeAllowedAux(marker, t.lastSon, kind, c, flags) + result = typeAllowedAux(marker, t.last, kind, c, flags) elif kind notin {skParam, skResult}: result = t of tyGenericBody, tyGenericParam, tyGenericInvocation, @@ -133,74 +136,77 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, of tyOrdinal: if kind != skParam: result = t of tyGenericInst, tyDistinct, tyAlias, tyInferred: - result = typeAllowedAux(marker, lastSon(t), kind, c, flags) + result = typeAllowedAux(marker, skipModifier(t), kind, c, flags) of tyRange: - if skipTypes(t[0], abstractInst-{tyTypeDesc}).kind notin + if skipTypes(t.elementType, abstractInst-{tyTypeDesc}).kind notin {tyChar, tyEnum, tyInt..tyFloat128, tyInt..tyUInt64, tyRange}: result = t of tyOpenArray: # you cannot nest openArrays/sinks/etc. if (kind != skParam or taIsOpenArray in flags) and views notin c.features: result = t else: - result = typeAllowedAux(marker, t[0], kind, c, flags+{taIsOpenArray}) + result = typeAllowedAux(marker, t.elementType, kind, c, flags+{taIsOpenArray}) of tyVarargs: # you cannot nest openArrays/sinks/etc. if kind != skParam or taIsOpenArray in flags: result = t else: - result = typeAllowedAux(marker, t[0], kind, c, flags+{taIsOpenArray}) + result = typeAllowedAux(marker, t.elementType, kind, c, flags+{taIsOpenArray}) of tySink: # you cannot nest openArrays/sinks/etc. - if kind != skParam or taIsOpenArray in flags or t[0].kind in {tySink, tyLent, tyVar}: + if kind != skParam or taIsOpenArray in flags or t.elementType.kind in {tySink, tyLent, tyVar}: result = t else: - result = typeAllowedAux(marker, t[0], kind, c, flags) + result = typeAllowedAux(marker, t.elementType, kind, c, flags) of tyUncheckedArray: if kind != skParam and taHeap notin flags: result = t else: - result = typeAllowedAux(marker, lastSon(t), kind, c, flags-{taHeap}) + result = typeAllowedAux(marker, elementType(t), kind, c, flags-{taHeap}) of tySequence: - if t[0].kind != tyEmpty: - result = typeAllowedAux(marker, t[0], kind, c, flags+{taHeap}) + if t.elementType.kind != tyEmpty: + result = typeAllowedAux(marker, t.elementType, kind, c, flags+{taHeap}) elif kind in {skVar, skLet}: - result = t[0] + result = t.elementType of tyArray: - if t[1].kind == tyTypeDesc: - result = t[1] - elif t[1].kind != tyEmpty: - result = typeAllowedAux(marker, t[1], kind, c, flags) + if t.elementType.kind == tyTypeDesc: + result = t.elementType + elif t.elementType.kind != tyEmpty: + result = typeAllowedAux(marker, t.elementType, kind, c, flags) elif kind in {skVar, skLet}: - result = t[1] + result = t.elementType of tyRef: if kind == skConst and taIsDefaultField notin flags: result = t - else: result = typeAllowedAux(marker, t.lastSon, kind, c, flags+{taHeap}) + else: result = typeAllowedAux(marker, t.elementType, kind, c, flags+{taHeap}) of tyPtr: - result = typeAllowedAux(marker, t.lastSon, kind, c, flags+{taHeap}) + result = typeAllowedAux(marker, t.elementType, kind, c, flags+{taHeap}) of tySet: - for i in 0..<t.len: - result = typeAllowedAux(marker, t[i], kind, c, flags) - if result != nil: break - of tyObject, tyTuple: + result = typeAllowedAux(marker, t.elementType, kind, c, flags) + of tyObject: if kind in {skProc, skFunc, skConst} and - t.kind == tyObject and t[0] != nil and taIsDefaultField notin flags: + t.baseClass != nil and taIsDefaultField notin flags: result = t else: - let flags = flags+{taField} - for i in 0..<t.len: - result = typeAllowedAux(marker, t[i], kind, c, flags) - if result != nil: break + let flags = flags+{taField, taVoid} + result = typeAllowedAux(marker, t.baseClass, kind, c, flags) if result.isNil and t.n != nil: result = typeAllowedNode(marker, t.n, kind, c, flags) + of tyTuple: + let flags = flags+{taField, taVoid} + for a in t.kids: + result = typeAllowedAux(marker, a, kind, c, flags) + if result != nil: break + if result.isNil and t.n != nil: + result = typeAllowedNode(marker, t.n, kind, c, flags) of tyEmpty: if kind in {skVar, skLet}: result = t - of tyProxy: + of tyError: # for now same as error node; we say it's a valid type as it should # prevent cascading errors: result = nil of tyOwned: - if t.len == 1 and t[0].skipTypes(abstractInst).kind in {tyRef, tyPtr, tyProc}: - result = typeAllowedAux(marker, t.lastSon, kind, c, flags+{taHeap}) + if t.hasElementType and t.skipModifier.skipTypes(abstractInst).kind in {tyRef, tyPtr, tyProc}: + result = typeAllowedAux(marker, t.skipModifier, kind, c, flags+{taHeap}) else: result = t of tyConcept: @@ -247,23 +253,23 @@ proc classifyViewTypeAux(marker: var IntSet, t: PType): ViewTypeKind = result = immutableView of tyGenericInst, tyDistinct, tyAlias, tyInferred, tySink, tyOwned, tyUncheckedArray, tySequence, tyArray, tyRef, tyStatic: - result = classifyViewTypeAux(marker, lastSon(t)) + result = classifyViewTypeAux(marker, skipModifier(t)) of tyFromExpr: - if t.len > 0: - result = classifyViewTypeAux(marker, lastSon(t)) + if t.hasElementType: + result = classifyViewTypeAux(marker, skipModifier(t)) else: result = noView of tyTuple: result = noView - for i in 0..<t.len: - result.combine classifyViewTypeAux(marker, t[i]) + for a in t.kids: + result.combine classifyViewTypeAux(marker, a) if result == mutableView: break of tyObject: result = noView if t.n != nil: result = classifyViewTypeNode(marker, t.n) - if t[0] != nil: - result.combine classifyViewTypeAux(marker, t[0]) + if t.baseClass != nil: + result.combine classifyViewTypeAux(marker, t.baseClass) else: # it doesn't matter what these types contain, 'ptr openArray' is not a # view type! @@ -281,7 +287,7 @@ proc directViewType*(t: PType): ViewTypeKind = of tyLent, tyOpenArray: result = immutableView of abstractInst-{tyTypeDesc}: - result = directViewType(t.lastSon) + result = directViewType(t.skipModifier) else: result = noView diff --git a/compiler/types.nim b/compiler/types.nim index f10d5aa86..a441b0ea2 100644 --- a/compiler/types.nim +++ b/compiler/types.nim @@ -31,6 +31,7 @@ type # most useful, shows: symbol + resolved symbols if it differs, e.g.: # tuple[a: MyInt{int}, b: float] preferInlayHint, + preferInferredEffects, TTypeRelation* = enum # order is important! isNone, isConvertible, @@ -65,19 +66,13 @@ proc addTypeDeclVerboseMaybe*(result: var string, conf: ConfigRef; typ: PType) = template `$`*(typ: PType): string = typeToString(typ) -proc base*(t: PType): PType = - result = t[0] - # ------------------- type iterator: ---------------------------------------- type TTypeIter* = proc (t: PType, closure: RootRef): bool {.nimcall.} # true if iteration should stop - TTypeMutator* = proc (t: PType, closure: RootRef): PType {.nimcall.} # copy t and mutate it TTypePredicate* = proc (t: PType): bool {.nimcall.} proc iterOverType*(t: PType, iter: TTypeIter, closure: RootRef): bool # Returns result of `iter`. -proc mutateType*(t: PType, iter: TTypeMutator, closure: RootRef): PType - # Returns result of `iter`. type TParamsEquality* = enum # they are equal, but their @@ -109,18 +104,18 @@ const typedescInst* = abstractInst + {tyTypeDesc, tyOwned, tyUserTypeClass} proc invalidGenericInst*(f: PType): bool = - result = f.kind == tyGenericInst and lastSon(f) == nil + result = f.kind == tyGenericInst and skipModifier(f) == nil proc isPureObject*(typ: PType): bool = var t = typ - while t.kind == tyObject and t[0] != nil: - t = t[0].skipTypes(skipPtrs) + while t.kind == tyObject and t.baseClass != nil: + t = t.baseClass.skipTypes(skipPtrs) result = t.sym != nil and sfPure in t.sym.flags proc isUnsigned*(t: PType): bool = t.skipTypes(abstractInst).kind in {tyChar, tyUInt..tyUInt64} -proc getOrdValue*(n: PNode; onError = high(Int128)): Int128 = +proc getOrdValueAux*(n: PNode, err: var bool): Int128 = var k = n.kind if n.typ != nil and n.typ.skipTypes(abstractInst).kind in {tyChar, tyUInt..tyUInt64}: k = nkUIntLit @@ -136,13 +131,22 @@ proc getOrdValue*(n: PNode; onError = high(Int128)): Int128 = toInt128(n.intVal) of nkNilLit: int128.Zero - of nkHiddenStdConv: getOrdValue(n[1], onError) + of nkHiddenStdConv: + getOrdValueAux(n[1], err) else: - # XXX: The idea behind the introduction of int128 was to finally - # have all calculations numerically far away from any - # overflows. This command just introduces such overflows and - # should therefore really be revisited. - onError + err = true + int128.Zero + +proc getOrdValue*(n: PNode): Int128 = + var err: bool = false + result = getOrdValueAux(n, err) + #assert err == false + +proc getOrdValue*(n: PNode, onError: Int128): Int128 = + var err = false + result = getOrdValueAux(n, err) + if err: + result = onError proc getFloatValue*(n: PNode): BiggestFloat = case n.kind @@ -184,10 +188,10 @@ proc getProcHeader*(conf: ConfigRef; sym: PSym; prefer: TPreferedDesc = preferNa proc elemType*(t: PType): PType = assert(t != nil) case t.kind - of tyGenericInst, tyDistinct, tyAlias, tySink: result = elemType(lastSon(t)) - of tyArray: result = t[1] + of tyGenericInst, tyDistinct, tyAlias, tySink: result = elemType(skipModifier(t)) + of tyArray: result = t.elementType of tyError: result = t - else: result = t.lastSon + else: result = t.elementType assert(result != nil) proc enumHasHoles*(t: PType): bool = @@ -200,7 +204,7 @@ proc isOrdinalType*(t: PType, allowEnumWithHoles: bool = false): bool = baseKinds = {tyChar, tyInt..tyInt64, tyUInt..tyUInt64, tyBool, tyEnum} parentKinds = {tyRange, tyOrdinal, tyGenericInst, tyAlias, tySink, tyDistinct} result = (t.kind in baseKinds and (not t.enumHasHoles or allowEnumWithHoles)) or - (t.kind in parentKinds and isOrdinalType(t.lastSon, allowEnumWithHoles)) + (t.kind in parentKinds and isOrdinalType(t.skipModifier, allowEnumWithHoles)) proc iterOverTypeAux(marker: var IntSet, t: PType, iter: TTypeIter, closure: RootRef): bool @@ -228,11 +232,15 @@ proc iterOverTypeAux(marker: var IntSet, t: PType, iter: TTypeIter, if result: return if not containsOrIncl(marker, t.id): case t.kind - of tyGenericInst, tyGenericBody, tyAlias, tySink, tyInferred: - result = iterOverTypeAux(marker, lastSon(t), iter, closure) + of tyGenericBody: + # treat as atomic, containsUnresolvedType wants always false, + # containsGenericType always gives true + discard + of tyGenericInst, tyAlias, tySink, tyInferred: + result = iterOverTypeAux(marker, skipModifier(t), iter, closure) else: - for i in 0..<t.len: - result = iterOverTypeAux(marker, t[i], iter, closure) + for a in t.kids: + result = iterOverTypeAux(marker, a, iter, closure) if result: return if t.n != nil and t.kind != tyProc: result = iterOverNode(marker, t.n, iter, closure) @@ -275,14 +283,14 @@ proc searchTypeForAux(t: PType, predicate: TTypePredicate, if result: return case t.kind of tyObject: - if t[0] != nil: - result = searchTypeForAux(t[0].skipTypes(skipPtrs), predicate, marker) + if t.baseClass != nil: + result = searchTypeForAux(t.baseClass.skipTypes(skipPtrs), predicate, marker) if not result: result = searchTypeNodeForAux(t.n, predicate, marker) of tyGenericInst, tyDistinct, tyAlias, tySink: - result = searchTypeForAux(lastSon(t), predicate, marker) + result = searchTypeForAux(skipModifier(t), predicate, marker) of tyArray, tySet, tyTuple: - for i in 0..<t.len: - result = searchTypeForAux(t[i], predicate, marker) + for a in t.kids: + result = searchTypeForAux(a, predicate, marker) if result: return else: discard @@ -298,7 +306,7 @@ proc containsObject*(t: PType): bool = result = searchTypeFor(t, isObjectPredicate) proc isObjectWithTypeFieldPredicate(t: PType): bool = - result = t.kind == tyObject and t[0] == nil and + result = t.kind == tyObject and t.baseClass == nil and not (t.sym != nil and {sfPure, sfInfixCall} * t.sym.flags != {}) and tfFinal notin t.flags @@ -310,7 +318,6 @@ type proc analyseObjectWithTypeFieldAux(t: PType, marker: var IntSet): TTypeFieldResult = - var res: TTypeFieldResult result = frNone if t == nil: return case t.kind @@ -318,20 +325,19 @@ proc analyseObjectWithTypeFieldAux(t: PType, if t.n != nil: if searchTypeNodeForAux(t.n, isObjectWithTypeFieldPredicate, marker): return frEmbedded - for i in 0..<t.len: - var x = t[i] - if x != nil: x = x.skipTypes(skipPtrs) - res = analyseObjectWithTypeFieldAux(x, marker) - if res == frEmbedded: - return frEmbedded - if res == frHeader: result = frHeader + var x = t.baseClass + if x != nil: x = x.skipTypes(skipPtrs) + let res = analyseObjectWithTypeFieldAux(x, marker) + if res == frEmbedded: + return frEmbedded + if res == frHeader: result = frHeader if result == frNone: if isObjectWithTypeFieldPredicate(t): result = frHeader of tyGenericInst, tyDistinct, tyAlias, tySink: - result = analyseObjectWithTypeFieldAux(lastSon(t), marker) + result = analyseObjectWithTypeFieldAux(skipModifier(t), marker) of tyArray, tyTuple: - for i in 0..<t.len: - res = analyseObjectWithTypeFieldAux(t[i], marker) + for a in t.kids: + let res = analyseObjectWithTypeFieldAux(a, marker) if res != frNone: return frEmbedded else: @@ -408,9 +414,7 @@ proc canFormAcycleAux(g: ModuleGraph, marker: var IntSet, typ: PType, orig: PTyp if withRef and sameBackendType(t, orig): result = true elif not containsOrIncl(marker, t.id): - for i in 0..<t.len: - result = canFormAcycleAux(g, marker, t[i], orig, withRef or t.kind != tyUncheckedArray, hasTrace) - if result: return + result = canFormAcycleAux(g, marker, t.elementType, orig, withRef or t.kind != tyUncheckedArray, hasTrace) of tyObject: if withRef and sameBackendType(t, orig): result = true @@ -419,8 +423,8 @@ proc canFormAcycleAux(g: ModuleGraph, marker: var IntSet, typ: PType, orig: PTyp let op = getAttachedOp(g, t.skipTypes({tyRef}), attachedTrace) if op != nil and sfOverridden in op.flags: hasTrace = true - for i in 0..<t.len: - result = canFormAcycleAux(g, marker, t[i], orig, withRef, hasTrace) + if t.baseClass != nil: + result = canFormAcycleAux(g, marker, t.baseClass, orig, withRef, hasTrace) if result: return if t.n != nil: result = canFormAcycleNode(g, marker, t.n, orig, withRef, hasTrace) # Inheritance can introduce cyclic types, however this is not relevant @@ -429,13 +433,18 @@ proc canFormAcycleAux(g: ModuleGraph, marker: var IntSet, typ: PType, orig: PTyp if tfFinal notin t.flags: # damn inheritance may introduce cycles: result = true - of tyTuple, tySequence, tyArray, tyOpenArray, tyVarargs: + of tyTuple: if withRef and sameBackendType(t, orig): result = true elif not containsOrIncl(marker, t.id): - for i in 0..<t.len: - result = canFormAcycleAux(g, marker, t[i], orig, withRef, hasTrace) + for a in t.kids: + result = canFormAcycleAux(g, marker, a, orig, withRef, hasTrace) if result: return + of tySequence, tyArray, tyOpenArray, tyVarargs: + if withRef and sameBackendType(t, orig): + result = true + elif not containsOrIncl(marker, t.id): + result = canFormAcycleAux(g, marker, t.elementType, orig, withRef, hasTrace) of tyProc: result = typ.callConv == ccClosure else: discard @@ -448,37 +457,6 @@ proc canFormAcycle*(g: ModuleGraph, typ: PType): bool = let t = skipTypes(typ, abstractInst+{tyOwned}-{tyTypeDesc}) result = canFormAcycleAux(g, marker, t, t, false, false) -proc mutateTypeAux(marker: var IntSet, t: PType, iter: TTypeMutator, - closure: RootRef): PType -proc mutateNode(marker: var IntSet, n: PNode, iter: TTypeMutator, - closure: RootRef): PNode = - result = nil - if n != nil: - result = copyNode(n) - result.typ = mutateTypeAux(marker, n.typ, iter, closure) - case n.kind - of nkNone..nkNilLit: - # a leaf - discard - else: - for i in 0..<n.len: - result.add mutateNode(marker, n[i], iter, closure) - -proc mutateTypeAux(marker: var IntSet, t: PType, iter: TTypeMutator, - closure: RootRef): PType = - result = nil - if t == nil: return - result = iter(t, closure) - if not containsOrIncl(marker, t.id): - for i in 0..<t.len: - result[i] = mutateTypeAux(marker, result[i], iter, closure) - if t.n != nil: result.n = mutateNode(marker, t.n, iter, closure) - assert(result != nil) - -proc mutateType(t: PType, iter: TTypeMutator, closure: RootRef): PType = - var marker = initIntSet() - result = mutateTypeAux(marker, t, iter, closure) - proc valueToString(a: PNode): string = case a.kind of nkCharLit, nkUIntLit..nkUInt64Lit: @@ -513,7 +491,7 @@ const "void", "iterable"] const preferToResolveSymbols = {preferName, preferTypeName, preferModuleInfo, - preferGenericArg, preferResolved, preferMixed, preferInlayHint} + preferGenericArg, preferResolved, preferMixed, preferInlayHint, preferInferredEffects} template bindConcreteTypeToUserTypeClass*(tc, concrete: PType) = tc.add concrete @@ -521,7 +499,7 @@ template bindConcreteTypeToUserTypeClass*(tc, concrete: PType) = # TODO: It would be a good idea to kill the special state of a resolved # concept by switching to tyAlias within the instantiated procs. -# Currently, tyAlias is always skipped with lastSon, which means that +# Currently, tyAlias is always skipped with skipModifier, which means that # we can store information about the matched concept in another position. # Then builtInFieldAccess can be modified to properly read the derived # consts and types stored within the concept. @@ -551,31 +529,27 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = result = t.sym.name.s else: result = t.sym.name.s & " literal(" & $t.n.intVal & ")" - elif t.kind == tyAlias and t[0].kind != tyAlias: - result = typeToString(t[0]) + elif t.kind == tyAlias and t.elementType.kind != tyAlias: + result = typeToString(t.elementType) elif prefer in {preferResolved, preferMixed}: case t.kind of IntegralTypes + {tyFloat..tyFloat128} + {tyString, tyCstring}: result = typeToStr[t.kind] of tyGenericBody: - result = typeToString(t.lastSon) + result = typeToString(t.last) of tyCompositeTypeClass: # avoids showing `A[any]` in `proc fun(a: A)` with `A = object[T]` - result = typeToString(t.lastSon.lastSon) + result = typeToString(t.last.last) else: result = t.sym.name.s if prefer == preferMixed and result != t.sym.name.s: result = t.sym.name.s & "{" & result & "}" - elif prefer in {preferName, preferTypeName, preferInlayHint} or t.sym.owner.isNil: + elif prefer in {preferName, preferTypeName, preferInlayHint, preferInferredEffects} or t.sym.owner.isNil: # note: should probably be: {preferName, preferTypeName, preferGenericArg} result = t.sym.name.s - if t.kind == tyGenericParam and t.len > 0: + if t.kind == tyGenericParam and t.genericParamHasConstraints: result.add ": " - var first = true - for son in t: - if not first: result.add " or " - result.add son.typeToString - first = false + result.add t.elementType.typeToString else: result = t.sym.owner.name.s & '.' & t.sym.name.s result.addTypeFlags(t) @@ -592,35 +566,42 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = result = "int" else: result = "int literal(" & $t.n.intVal & ")" - of tyGenericInst, tyGenericInvocation: - result = typeToString(t[0]) & '[' - for i in 1..<t.len-ord(t.kind != tyGenericInvocation): - if i > 1: result.add(", ") - result.add(typeToString(t[i], preferGenericArg)) + of tyGenericInst: + result = typeToString(t.genericHead) & '[' + for needsComma, a in t.genericInstParams: + if needsComma: result.add(", ") + result.add(typeToString(a, preferGenericArg)) + result.add(']') + of tyGenericInvocation: + result = typeToString(t.genericHead) & '[' + for needsComma, a in t.genericInvocationParams: + if needsComma: result.add(", ") + result.add(typeToString(a, preferGenericArg)) result.add(']') of tyGenericBody: - result = typeToString(t.lastSon) & '[' - for i in 0..<t.len-1: + result = typeToString(t.typeBodyImpl) & '[' + for i, a in t.genericBodyParams: if i > 0: result.add(", ") - result.add(typeToString(t[i], preferTypeName)) + result.add(typeToString(a, preferTypeName)) result.add(']') of tyTypeDesc: - if t[0].kind == tyNone: result = "typedesc" - else: result = "typedesc[" & typeToString(t[0]) & "]" + if t.elementType.kind == tyNone: result = "typedesc" + else: result = "typedesc[" & typeToString(t.elementType) & "]" of tyStatic: if prefer == preferGenericArg and t.n != nil: result = t.n.renderTree else: - result = "static[" & (if t.len > 0: typeToString(t[0]) else: "") & "]" + result = "static[" & (if t.hasElementType: typeToString(t.skipModifier) else: "") & "]" if t.n != nil: result.add "(" & renderTree(t.n) & ")" of tyUserTypeClass: if t.sym != nil and t.sym.owner != nil: - if t.isResolvedUserTypeClass: return typeToString(t.lastSon) + if t.isResolvedUserTypeClass: return typeToString(t.last) return t.sym.owner.name.s else: result = "<invalid tyUserTypeClass>" of tyBuiltInTypeClass: - result = case t.base.kind + result = + case t.base.kind of tyVar: "var" of tyRef: "ref" of tyPtr: "ptr" @@ -641,22 +622,20 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = of tyUserTypeClassInst: let body = t.base result = body.sym.name.s & "[" - for i in 1..<t.len - 1: - if i > 1: result.add(", ") - result.add(typeToString(t[i])) + for needsComma, a in t.userTypeClassInstParams: + if needsComma: result.add(", ") + result.add(typeToString(a)) result.add "]" of tyAnd: - for i, son in t: + for i, son in t.ikids: + if i > 0: result.add(" and ") result.add(typeToString(son)) - if i < t.len - 1: - result.add(" and ") of tyOr: - for i, son in t: + for i, son in t.ikids: + if i > 0: result.add(" or ") result.add(typeToString(son)) - if i < t.len - 1: - result.add(" or ") of tyNot: - result = "not " & typeToString(t[0]) + result = "not " & typeToString(t.elementType) of tyUntyped: #internalAssert t.len == 0 result = "untyped" @@ -667,80 +646,75 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = result = "typeof(" & renderTree(t.n) & ")" of tyArray: result = "array" - if t.len > 0: - if t[0].kind == tyRange: - result &= "[" & rangeToStr(t[0].n) & ", " & - typeToString(t[1]) & ']' + if t.hasElementType: + if t.indexType.kind == tyRange: + result &= "[" & rangeToStr(t.indexType.n) & ", " & + typeToString(t.elementType) & ']' else: - result &= "[" & typeToString(t[0]) & ", " & - typeToString(t[1]) & ']' + result &= "[" & typeToString(t.indexType) & ", " & + typeToString(t.elementType) & ']' of tyUncheckedArray: result = "UncheckedArray" - if t.len > 0: - result &= "[" & typeToString(t[0]) & ']' + if t.hasElementType: + result &= "[" & typeToString(t.elementType) & ']' of tySequence: if t.sym != nil and prefer != preferResolved: result = t.sym.name.s else: result = "seq" - if t.len > 0: - result &= "[" & typeToString(t[0]) & ']' + if t.hasElementType: + result &= "[" & typeToString(t.elementType) & ']' of tyOrdinal: result = "ordinal" - if t.len > 0: - result &= "[" & typeToString(t[0]) & ']' + if t.hasElementType: + result &= "[" & typeToString(t.skipModifier) & ']' of tySet: result = "set" - if t.len > 0: - result &= "[" & typeToString(t[0]) & ']' + if t.hasElementType: + result &= "[" & typeToString(t.elementType) & ']' of tyOpenArray: result = "openArray" - if t.len > 0: - result &= "[" & typeToString(t[0]) & ']' + if t.hasElementType: + result &= "[" & typeToString(t.elementType) & ']' of tyDistinct: - result = "distinct " & typeToString(t[0], + result = "distinct " & typeToString(t.elementType, if prefer == preferModuleInfo: preferModuleInfo else: preferTypeName) of tyIterable: # xxx factor this pattern result = "iterable" - if t.len > 0: - result &= "[" & typeToString(t[0]) & ']' + if t.hasElementType: + result &= "[" & typeToString(t.skipModifier) & ']' of tyTuple: # we iterate over t.sons here, because t.n may be nil if t.n != nil: result = "tuple[" - assert(t.n.len == t.len) for i in 0..<t.n.len: assert(t.n[i].kind == nkSym) - result.add(t.n[i].sym.name.s & ": " & typeToString(t[i])) + result.add(t.n[i].sym.name.s & ": " & typeToString(t.n[i].sym.typ)) if i < t.n.len - 1: result.add(", ") result.add(']') - elif t.len == 0: + elif t.isEmptyTupleType: result = "tuple[]" + elif t.isSingletonTupleType: + result = "(" + for son in t.kids: + result.add(typeToString(son)) + result.add(",)") else: result = "(" - for i in 0..<t.len: - result.add(typeToString(t[i])) - if i < t.len - 1: result.add(", ") - elif t.len == 1: result.add(",") + for i, son in t.ikids: + if i > 0: result.add ", " + result.add(typeToString(son)) result.add(')') of tyPtr, tyRef, tyVar, tyLent: result = if isOutParam(t): "out " else: typeToStr[t.kind] - if t.len >= 2: - setLen(result, result.len-1) - result.add '[' - for i in 0..<t.len: - result.add(typeToString(t[i])) - if i < t.len - 1: result.add(", ") - result.add ']' - else: - result.add typeToString(t[0]) + result.add typeToString(t.elementType) of tyRange: result = "range " if t.n != nil and t.n.kind == nkRange: result.add rangeToStr(t.n) if prefer != preferExported: - result.add("(" & typeToString(t[0]) & ")") + result.add("(" & typeToString(t.elementType) & ")") of tyProc: result = if tfIterator in t.flags: "iterator " elif t.owner != nil: @@ -753,15 +727,17 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = "proc " if tfUnresolved in t.flags: result.add "[*missing parameters*]" result.add "(" - for i in 1..<t.len: - if t.n != nil and i < t.n.len and t.n[i].kind == nkSym: - result.add(t.n[i].sym.name.s) + for i, a in t.paramTypes: + if i > FirstParamAt: result.add(", ") + let j = paramTypeToNodeIndex(i) + if t.n != nil and j < t.n.len and t.n[j].kind == nkSym: + result.add(t.n[j].sym.name.s) result.add(": ") - result.add(typeToString(t[i])) - if i < t.len - 1: result.add(", ") + result.add(typeToString(a)) result.add(')') - if t.len > 0 and t[0] != nil: result.add(": " & typeToString(t[0])) + if t.returnType != nil: result.add(": " & typeToString(t.returnType)) var prag = if t.callConv == ccNimCall and tfExplicitCallConv notin t.flags: "" else: $t.callConv + var hasImplicitRaises = false if not isNil(t.owner) and not isNil(t.owner.ast) and (t.owner.ast.len - 1) >= pragmasPos: let pragmasNode = t.owner.ast[pragmasPos] let raisesSpec = effectSpec(pragmasNode, wRaises) @@ -769,20 +745,44 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = addSep(prag) prag.add("raises: ") prag.add($raisesSpec) - + hasImplicitRaises = true if tfNoSideEffect in t.flags: addSep(prag) prag.add("noSideEffect") if tfThread in t.flags: addSep(prag) prag.add("gcsafe") + var effectsOfStr = "" + for i, a in t.paramTypes: + let j = paramTypeToNodeIndex(i) + if t.n != nil and j < t.n.len and t.n[j].kind == nkSym and t.n[j].sym.kind == skParam and sfEffectsDelayed in t.n[j].sym.flags: + addSep(effectsOfStr) + effectsOfStr.add(t.n[j].sym.name.s) + if effectsOfStr != "": + addSep(prag) + prag.add("effectsOf: ") + prag.add(effectsOfStr) + if not hasImplicitRaises and prefer == preferInferredEffects and not isNil(t.owner) and not isNil(t.owner.typ) and not isNil(t.owner.typ.n) and (t.owner.typ.n.len > 0): + let effects = t.owner.typ.n[0] + if effects.kind == nkEffectList and effects.len == effectListLen: + var inferredRaisesStr = "" + let effs = effects[exceptionEffects] + if not isNil(effs): + for eff in items(effs): + if not isNil(eff): + addSep(inferredRaisesStr) + inferredRaisesStr.add($eff.typ) + addSep(prag) + prag.add("raises: <inferred> [") + prag.add(inferredRaisesStr) + prag.add("]") if prag.len != 0: result.add("{." & prag & ".}") of tyVarargs: - result = typeToStr[t.kind] % typeToString(t[0]) + result = typeToStr[t.kind] % typeToString(t.elementType) of tySink: - result = "sink " & typeToString(t[0]) + result = "sink " & typeToString(t.skipModifier) of tyOwned: - result = "owned " & typeToString(t[0]) + result = "owned " & typeToString(t.elementType) else: result = typeToStr[t.kind] result.addTypeFlags(t) @@ -790,10 +790,10 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = proc firstOrd*(conf: ConfigRef; t: PType): Int128 = case t.kind - of tyBool, tyChar, tySequence, tyOpenArray, tyString, tyVarargs, tyProxy: + of tyBool, tyChar, tySequence, tyOpenArray, tyString, tyVarargs, tyError: result = Zero - of tySet, tyVar: result = firstOrd(conf, t[0]) - of tyArray: result = firstOrd(conf, t[0]) + of tySet, tyVar: result = firstOrd(conf, t.elementType) + of tyArray: result = firstOrd(conf, t.indexType) of tyRange: assert(t.n != nil) # range directly given: assert(t.n.kind == nkRange) @@ -815,8 +815,8 @@ proc firstOrd*(conf: ConfigRef; t: PType): Int128 = of tyUInt..tyUInt64: result = Zero of tyEnum: # if basetype <> nil then return firstOrd of basetype - if t.len > 0 and t[0] != nil: - result = firstOrd(conf, t[0]) + if t.baseClass != nil: + result = firstOrd(conf, t.baseClass) else: if t.n.len > 0: assert(t.n[0].kind == nkSym) @@ -824,18 +824,20 @@ proc firstOrd*(conf: ConfigRef; t: PType): Int128 = else: result = Zero of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tySink, - tyStatic, tyInferred, tyUserTypeClasses, tyLent: - result = firstOrd(conf, lastSon(t)) + tyStatic, tyInferred, tyLent: + result = firstOrd(conf, skipModifier(t)) + of tyUserTypeClasses: + result = firstOrd(conf, last(t)) of tyOrdinal: - if t.len > 0: result = firstOrd(conf, lastSon(t)) + if t.hasElementType: result = firstOrd(conf, skipModifier(t)) else: result = Zero - internalError(conf, "invalid kind for firstOrd(" & $t.kind & ')') + fatal(conf, unknownLineInfo, "invalid kind for firstOrd(" & $t.kind & ')') of tyUncheckedArray, tyCstring: result = Zero else: result = Zero - internalError(conf, "invalid kind for firstOrd(" & $t.kind & ')') + fatal(conf, unknownLineInfo, "invalid kind for firstOrd(" & $t.kind & ')') proc firstFloat*(t: PType): BiggestFloat = case t.kind @@ -844,10 +846,12 @@ proc firstFloat*(t: PType): BiggestFloat = assert(t.n != nil) # range directly given: assert(t.n.kind == nkRange) getFloatValue(t.n[0]) - of tyVar: firstFloat(t[0]) + of tyVar: firstFloat(t.elementType) of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tySink, - tyStatic, tyInferred, tyUserTypeClasses: - firstFloat(lastSon(t)) + tyStatic, tyInferred: + firstFloat(skipModifier(t)) + of tyUserTypeClasses: + firstFloat(last(t)) else: internalError(newPartialConfigRef(), "invalid kind for firstFloat(" & $t.kind & ')') NaN @@ -879,8 +883,8 @@ proc lastOrd*(conf: ConfigRef; t: PType): Int128 = case t.kind of tyBool: result = toInt128(1'u) of tyChar: result = toInt128(255'u) - of tySet, tyVar: result = lastOrd(conf, t[0]) - of tyArray: result = lastOrd(conf, t[0]) + of tySet, tyVar: result = lastOrd(conf, t.elementType) + of tyArray: result = lastOrd(conf, t.indexType) of tyRange: assert(t.n != nil) # range directly given: assert(t.n.kind == nkRange) @@ -915,31 +919,35 @@ proc lastOrd*(conf: ConfigRef; t: PType): Int128 = else: result = Zero of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tySink, - tyStatic, tyInferred, tyUserTypeClasses, tyLent: - result = lastOrd(conf, lastSon(t)) - of tyProxy: result = Zero + tyStatic, tyInferred, tyLent: + result = lastOrd(conf, skipModifier(t)) + of tyUserTypeClasses: + result = lastOrd(conf, last(t)) + of tyError: result = Zero of tyOrdinal: - if t.len > 0: result = lastOrd(conf, lastSon(t)) + if t.hasElementType: result = lastOrd(conf, skipModifier(t)) else: result = Zero - internalError(conf, "invalid kind for lastOrd(" & $t.kind & ')') + fatal(conf, unknownLineInfo, "invalid kind for lastOrd(" & $t.kind & ')') of tyUncheckedArray: result = Zero else: result = Zero - internalError(conf, "invalid kind for lastOrd(" & $t.kind & ')') + fatal(conf, unknownLineInfo, "invalid kind for lastOrd(" & $t.kind & ')') proc lastFloat*(t: PType): BiggestFloat = case t.kind of tyFloat..tyFloat128: Inf - of tyVar: lastFloat(t[0]) + of tyVar: lastFloat(t.elementType) of tyRange: assert(t.n != nil) # range directly given: assert(t.n.kind == nkRange) getFloatValue(t.n[1]) of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tySink, - tyStatic, tyInferred, tyUserTypeClasses: - lastFloat(lastSon(t)) + tyStatic, tyInferred: + lastFloat(skipModifier(t)) + of tyUserTypeClasses: + lastFloat(last(t)) else: internalError(newPartialConfigRef(), "invalid kind for lastFloat(" & $t.kind & ')') NaN @@ -953,17 +961,19 @@ proc floatRangeCheck*(x: BiggestFloat, t: PType): bool = of tyRange: x in firstFloat(t)..lastFloat(t) of tyVar: - floatRangeCheck(x, t[0]) + floatRangeCheck(x, t.elementType) of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tySink, - tyStatic, tyInferred, tyUserTypeClasses: - floatRangeCheck(x, lastSon(t)) + tyStatic, tyInferred: + floatRangeCheck(x, skipModifier(t)) + of tyUserTypeClasses: + floatRangeCheck(x, last(t)) else: internalError(newPartialConfigRef(), "invalid kind for floatRangeCheck:" & $t.kind) false proc lengthOrd*(conf: ConfigRef; t: PType): Int128 = if t.skipTypes(tyUserTypeClasses).kind == tyDistinct: - result = lengthOrd(conf, t[0]) + result = lengthOrd(conf, t.skipModifier) else: let last = lastOrd(conf, t) let first = firstOrd(conf, t) @@ -988,6 +998,8 @@ type AllowCommonBase PickyCAliases # be picky about the distinction between 'cint' and 'int32' IgnoreFlags # used for borrowed functions and methods; ignores the tfVarIsPtr flag + PickyBackendAliases # be picky about different aliases + IgnoreRangeShallow TTypeCmpFlags* = set[TTypeCmpFlag] @@ -1085,11 +1097,11 @@ proc sameTuple(a, b: PType, c: var TSameTypeClosure): bool = # two tuples are equivalent iff the names, types and positions are the same; # however, both types may not have any field names (t.n may be nil) which # complicates the matter a bit. - if a.len == b.len: + if sameTupleLengths(a, b): result = true - for i in 0..<a.len: - var x = a[i] - var y = b[i] + for i, aa, bb in tupleTypePairs(a, b): + var x = aa + var y = bb if IgnoreTupleFields in c.flags: x = skipTypes(x, {tyRange, tyGenericInst, tyAlias}) y = skipTypes(y, {tyRange, tyGenericInst, tyAlias}) @@ -1176,32 +1188,30 @@ proc sameObjectTree(a, b: PNode, c: var TSameTypeClosure): bool = result = false proc sameObjectStructures(a, b: PType, c: var TSameTypeClosure): bool = - # check base types: - if a.len != b.len: return - for i in 0..<a.len: - if not sameTypeOrNilAux(a[i], b[i], c): return - if not sameObjectTree(a.n, b.n, c): return + if not sameTypeOrNilAux(a.baseClass, b.baseClass, c): return false + if not sameObjectTree(a.n, b.n, c): return false result = true proc sameChildrenAux(a, b: PType, c: var TSameTypeClosure): bool = - if a.len != b.len: return false + if not sameTupleLengths(a, b): return false + # XXX This is not tuple specific. result = true - for i in 0..<a.len: - result = sameTypeOrNilAux(a[i], b[i], c) + for _, x, y in tupleTypePairs(a, b): + result = sameTypeOrNilAux(x, y, c) if not result: return proc isGenericAlias*(t: PType): bool = - return t.kind == tyGenericInst and t.lastSon.kind == tyGenericInst + return t.kind == tyGenericInst and t.skipModifier.kind == tyGenericInst proc genericAliasDepth*(t: PType): int = result = 0 var it = t while it.isGenericAlias: - it = it.lastSon + it = it.skipModifier inc result proc skipGenericAlias*(t: PType): PType = - return if t.isGenericAlias: t.lastSon else: t + return if t.isGenericAlias: t.skipModifier else: t proc sameFlags*(a, b: PType): bool {.inline.} = result = eqTypeFlags*a.flags == eqTypeFlags*b.flags @@ -1218,26 +1228,40 @@ proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool = inc c.recCheck else: if containsOrIncl(c, a, b): return true + template maybeSkipRange(x: set[TTypeKind]): set[TTypeKind] = + if IgnoreRangeShallow in c.flags: + x + {tyRange} + else: + x + + template withoutShallowFlags(body) = + let oldFlags = c.flags + c.flags.excl IgnoreRangeShallow + body + c.flags = oldFlags if x == y: return true - var a = skipTypes(x, {tyAlias}) + let aliasSkipSet = maybeSkipRange({tyAlias}) + var a = skipTypes(x, aliasSkipSet) while a.kind == tyUserTypeClass and tfResolved in a.flags: - a = skipTypes(a[^1], {tyAlias}) - var b = skipTypes(y, {tyAlias}) + a = skipTypes(a.last, aliasSkipSet) + var b = skipTypes(y, aliasSkipSet) while b.kind == tyUserTypeClass and tfResolved in b.flags: - b = skipTypes(b[^1], {tyAlias}) + b = skipTypes(b.last, aliasSkipSet) assert(a != nil) assert(b != nil) - if a.kind != b.kind: - case c.cmp - of dcEq: return false - of dcEqIgnoreDistinct: - a = a.skipTypes({tyDistinct, tyGenericInst}) - b = b.skipTypes({tyDistinct, tyGenericInst}) - if a.kind != b.kind: return false - of dcEqOrDistinctOf: - a = a.skipTypes({tyDistinct, tyGenericInst}) - if a.kind != b.kind: return false + case c.cmp + of dcEq: + if a.kind != b.kind: return false + of dcEqIgnoreDistinct: + let distinctSkipSet = maybeSkipRange({tyDistinct, tyGenericInst}) + a = a.skipTypes(distinctSkipSet) + b = b.skipTypes(distinctSkipSet) + if a.kind != b.kind: return false + of dcEqOrDistinctOf: + let distinctSkipSet = maybeSkipRange({tyDistinct, tyGenericInst}) + a = a.skipTypes(distinctSkipSet) + if a.kind != b.kind: return false #[ The following code should not run in the case either side is an generic alias, @@ -1245,16 +1269,16 @@ proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool = objects ie `type A[T] = SomeObject` ]# # this is required by tunique_type but makes no sense really: - if tyDistinct notin {x.kind, y.kind} and x.kind == tyGenericInst and IgnoreTupleFields notin c.flags: + if c.cmp == dcEq and x.kind == tyGenericInst and + IgnoreTupleFields notin c.flags and tyDistinct != y.kind: let lhs = x.skipGenericAlias rhs = y.skipGenericAlias - if rhs.kind != tyGenericInst or lhs.base != rhs.base: + if rhs.kind != tyGenericInst or lhs.base != rhs.base or rhs.kidsLen != lhs.kidsLen: return false - for i in 1..<lhs.len - 1: - let ff = rhs[i] - let aa = lhs[i] - if not sameTypeAux(ff, aa, c): return false + withoutShallowFlags: + for ff, aa in underspecifiedPairs(rhs, lhs, 1, -1): + if not sameTypeAux(ff, aa, c): return false return true case a.kind @@ -1268,32 +1292,39 @@ proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool = let symFlagsB = if b.sym != nil: b.sym.flags else: {} if (symFlagsA+symFlagsB) * {sfImportc, sfExportc} != {}: result = symFlagsA == symFlagsB + elif result and PickyBackendAliases in c.flags: + let symFlagsA = if a.sym != nil: a.sym.flags else: {} + let symFlagsB = if b.sym != nil: b.sym.flags else: {} + if (symFlagsA+symFlagsB) * {sfImportc, sfExportc} != {}: + result = a.id == b.id of tyStatic, tyFromExpr: result = exprStructuralEquivalent(a.n, b.n) and sameFlags(a, b) - if result and a.len == b.len and a.len == 1: + if result and sameTupleLengths(a, b) and a.hasElementType: cycleCheck() - result = sameTypeAux(a[0], b[0], c) + result = sameTypeAux(a.skipModifier, b.skipModifier, c) of tyObject: - ifFastObjectTypeCheckFailed(a, b): - cycleCheck() - result = sameObjectStructures(a, b, c) and sameFlags(a, b) + withoutShallowFlags: + ifFastObjectTypeCheckFailed(a, b): + cycleCheck() + result = sameObjectStructures(a, b, c) and sameFlags(a, b) of tyDistinct: cycleCheck() if c.cmp == dcEq: if sameFlags(a, b): ifFastObjectTypeCheckFailed(a, b): - result = sameTypeAux(a[0], b[0], c) + result = sameTypeAux(a.elementType, b.elementType, c) else: - result = sameTypeAux(a[0], b[0], c) and sameFlags(a, b) + result = sameTypeAux(a.elementType, b.elementType, c) and sameFlags(a, b) of tyEnum, tyForward: # XXX generic enums do not make much sense, but require structural checking result = a.id == b.id and sameFlags(a, b) of tyError: result = b.kind == tyError of tyTuple: - cycleCheck() - result = sameTuple(a, b, c) and sameFlags(a, b) + withoutShallowFlags: + cycleCheck() + result = sameTuple(a, b, c) and sameFlags(a, b) of tyTypeDesc: if c.cmp == dcEqIgnoreDistinct: result = false elif ExactTypeDescValues in c.flags: @@ -1306,22 +1337,19 @@ proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool = if result and {ExactGenericParams, ExactTypeDescValues} * c.flags != {}: result = a.sym.position == b.sym.position of tyBuiltInTypeClass: - assert a.len == 1 - assert a[0].len == 0 - assert b.len == 1 - assert b[0].len == 0 - result = a[0].kind == b[0].kind and sameFlags(a[0], b[0]) - if result and a[0].kind == tyProc and IgnoreCC notin c.flags: - let ecc = a[0].flags * {tfExplicitCallConv} - result = ecc == b[0].flags * {tfExplicitCallConv} and - (ecc == {} or a[0].callConv == b[0].callConv) + result = a.elementType.kind == b.elementType.kind and sameFlags(a.elementType, b.elementType) + if result and a.elementType.kind == tyProc and IgnoreCC notin c.flags: + let ecc = a.elementType.flags * {tfExplicitCallConv} + result = ecc == b.elementType.flags * {tfExplicitCallConv} and + (ecc == {} or a.elementType.callConv == b.elementType.callConv) of tyGenericInvocation, tyGenericBody, tySequence, tyOpenArray, tySet, tyRef, tyPtr, tyVar, tyLent, tySink, tyUncheckedArray, tyArray, tyProc, tyVarargs, tyOrdinal, tyCompositeTypeClass, tyUserTypeClass, tyUserTypeClassInst, tyAnd, tyOr, tyNot, tyAnything, tyOwned: cycleCheck() if a.kind == tyUserTypeClass and a.n != nil: return a.n == b.n - result = sameChildrenAux(a, b, c) + withoutShallowFlags: + result = sameChildrenAux(a, b, c) if result and IgnoreFlags notin c.flags: if IgnoreTupleFields in c.flags: result = a.flags * {tfVarIsPtr, tfIsOutParam} == b.flags * {tfVarIsPtr, tfIsOutParam} @@ -1334,12 +1362,22 @@ proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool = ((ExactConstraints notin c.flags) or sameConstraints(a.n, b.n)) of tyRange: cycleCheck() - result = sameTypeOrNilAux(a[0], b[0], c) and - sameValue(a.n[0], b.n[0]) and + result = sameTypeOrNilAux(a.elementType, b.elementType, c) + if result and IgnoreRangeShallow notin c.flags: + result = sameValue(a.n[0], b.n[0]) and sameValue(a.n[1], b.n[1]) - of tyGenericInst, tyAlias, tyInferred, tyIterable: + of tyAlias, tyInferred, tyIterable: cycleCheck() - result = sameTypeAux(a.lastSon, b.lastSon, c) + result = sameTypeAux(a.skipModifier, b.skipModifier, c) + of tyGenericInst: + # BUG #23445 + # The type system must distinguish between `T[int] = object #[empty]#` + # and `T[float] = object #[empty]#`! + cycleCheck() + withoutShallowFlags: + for ff, aa in underspecifiedPairs(a, b, 1, -1): + if not sameTypeAux(ff, aa, c): return false + result = sameTypeAux(a.skipModifier, b.skipModifier, c) of tyNone: result = false of tyConcept: result = exprStructuralEquivalent(a.n, b.n) @@ -1350,6 +1388,19 @@ proc sameBackendType*(x, y: PType): bool = c.cmp = dcEqIgnoreDistinct result = sameTypeAux(x, y, c) +proc sameBackendTypeIgnoreRange*(x, y: PType): bool = + var c = initSameTypeClosure() + c.flags.incl IgnoreTupleFields + c.flags.incl IgnoreRangeShallow + c.cmp = dcEqIgnoreDistinct + result = sameTypeAux(x, y, c) + +proc sameBackendTypePickyAliases*(x, y: PType): bool = + var c = initSameTypeClosure() + c.flags.incl {IgnoreTupleFields, PickyCAliases, PickyBackendAliases} + c.cmp = dcEqIgnoreDistinct + result = sameTypeAux(x, y, c) + proc compareTypes*(x, y: PType, cmp: TDistinctCompare = dcEq, flags: TTypeCmpFlags = {}): bool = @@ -1374,14 +1425,14 @@ proc inheritanceDiff*(a, b: PType): int = while x != nil: x = skipTypes(x, skipPtrs) if sameObjectTypes(x, b): return - x = x[0] + x = x.baseClass dec(result) var y = b result = 0 while y != nil: y = skipTypes(y, skipPtrs) if sameObjectTypes(y, a): return - y = y[0] + y = y.baseClass inc(result) result = high(int) @@ -1399,7 +1450,7 @@ proc commonSuperclass*(a, b: PType): PType = while x != nil: x = skipTypes(x, skipPtrs) ancestors.incl(x.id) - x = x[0] + x = x.baseClass var y = b while y != nil: var t = y # bug #7818, save type before skip @@ -1408,17 +1459,10 @@ proc commonSuperclass*(a, b: PType): PType = # bug #7818, defer the previous skipTypes if t.kind != tyGenericInst: t = y return t - y = y[0] - -proc matchType*(a: PType, pattern: openArray[tuple[k:TTypeKind, i:int]], - last: TTypeKind): bool = - var a = a - for k, i in pattern.items: - if a.kind != k: return false - if i >= a.len or a[i] == nil: return false - a = a[i] - result = a.kind == last + y = y.baseClass +proc lacksMTypeField*(typ: PType): bool {.inline.} = + (typ.sym != nil and sfPure in typ.sym.flags) or tfFinal in typ.flags include sizealignoffsetimpl @@ -1429,7 +1473,7 @@ proc computeSize*(conf: ConfigRef; typ: PType): BiggestInt = proc getReturnType*(s: PSym): PType = # Obtains the return type of a iterator/proc/macro/template assert s.kind in skProcKinds - result = s.typ[0] + result = s.typ.returnType proc getAlign*(conf: ConfigRef; typ: PType): BiggestInt = computeSizeAlign(conf, typ) @@ -1455,9 +1499,26 @@ proc containsGenericTypeIter(t: PType, closure: RootRef): bool = proc containsGenericType*(t: PType): bool = result = iterOverType(t, containsGenericTypeIter, nil) +proc containsUnresolvedTypeIter(t: PType, closure: RootRef): bool = + if tfUnresolved in t.flags: return true + case t.kind + of tyStatic: + return t.n == nil + of tyTypeDesc: + if t.base.kind == tyNone: return true + if containsUnresolvedTypeIter(t.base, closure): return true + return false + of tyGenericInvocation, tyGenericParam, tyFromExpr, tyAnything: + return true + else: + return false + +proc containsUnresolvedType*(t: PType): bool = + result = iterOverType(t, containsUnresolvedTypeIter, nil) + proc baseOfDistinct*(t: PType; g: ModuleGraph; idgen: IdGenerator): PType = if t.kind == tyDistinct: - result = t[0] + result = t.elementType else: result = copyType(t, idgen, t.owner) copyTypeProps(g, idgen.module, result, t) @@ -1465,7 +1526,7 @@ proc baseOfDistinct*(t: PType; g: ModuleGraph; idgen: IdGenerator): PType = var it = result while it.kind in {tyPtr, tyRef, tyOwned}: parent = it - it = it.lastSon + it = it.elementType if it.kind == tyDistinct and parent != nil: parent[0] = it[0] @@ -1570,8 +1631,8 @@ proc isCompileTimeOnly*(t: PType): bool {.inline.} = proc containsCompileTimeOnly*(t: PType): bool = if isCompileTimeOnly(t): return true - for i in 0..<t.len: - if t[i] != nil and isCompileTimeOnly(t[i]): + for a in t.kids: + if a != nil and isCompileTimeOnly(a): return true return false @@ -1580,7 +1641,7 @@ proc safeSkipTypes*(t: PType, kinds: TTypeKinds): PType = result = t var seen = initIntSet() while result.kind in kinds and not containsOrIncl(seen, result.id): - result = lastSon(result) + result = skipModifier(result) type OrdinalType* = enum @@ -1629,10 +1690,9 @@ proc skipConvTakeType*(n: PNode): PNode = proc isEmptyContainer*(t: PType): bool = case t.kind of tyUntyped, tyNil: result = true - of tyArray: result = t[1].kind == tyEmpty - of tySet, tySequence, tyOpenArray, tyVarargs: - result = t[0].kind == tyEmpty - of tyGenericInst, tyAlias, tySink: result = isEmptyContainer(t.lastSon) + of tyArray, tySet, tySequence, tyOpenArray, tyVarargs: + result = t.elementType.kind == tyEmpty + of tyGenericInst, tyAlias, tySink: result = isEmptyContainer(t.skipModifier) else: result = false proc takeType*(formal, arg: PType; g: ModuleGraph; idgen: IdGenerator): PType = @@ -1739,6 +1799,13 @@ proc processPragmaAndCallConvMismatch(msg: var string, formal, actual: PType, co of efTagsIllegal: msg.add "\n.notTag catched an illegal effect" +proc typeNameAndDesc*(t: PType): string = + result = typeToString(t) + let desc = typeToString(t, preferDesc) + if result != desc: + result.add(" = ") + result.add(desc) + proc typeMismatch*(conf: ConfigRef; info: TLineInfo, formal, actual: PType, n: PNode) = if formal.kind != tyError and actual.kind != tyError: let actualStr = typeToString(actual) @@ -1780,13 +1847,15 @@ proc isTupleRecursive(t: PType, cycleDetector: var IntSet): bool = of tyTuple: result = false var cycleDetectorCopy: IntSet - for i in 0..<t.len: + for a in t.kids: cycleDetectorCopy = cycleDetector - if isTupleRecursive(t[i], cycleDetectorCopy): + if isTupleRecursive(a, cycleDetectorCopy): return true - of tyAlias, tyRef, tyPtr, tyGenericInst, tyVar, tyLent, tySink, + of tyRef, tyPtr, tyVar, tyLent, tySink, tyArray, tyUncheckedArray, tySequence, tyDistinct: - return isTupleRecursive(t.lastSon, cycleDetector) + return isTupleRecursive(t.elementType, cycleDetector) + of tyAlias, tyGenericInst: + return isTupleRecursive(t.skipModifier, cycleDetector) else: return false @@ -1801,8 +1870,8 @@ proc isException*(t: PType): bool = var t = t.skipTypes(abstractInst) while t.kind == tyObject: if t.sym != nil and t.sym.magic == mException: return true - if t[0] == nil: break - t = skipTypes(t[0], abstractPtrs) + if t.baseClass == nil: break + t = skipTypes(t.baseClass, abstractPtrs) return false proc isDefectException*(t: PType): bool = @@ -1812,8 +1881,8 @@ proc isDefectException*(t: PType): bool = sfSystemModule in t.sym.owner.flags and t.sym.name.s == "Defect": return true - if t[0] == nil: break - t = skipTypes(t[0], abstractPtrs) + if t.baseClass == nil: break + t = skipTypes(t.baseClass, abstractPtrs) return false proc isDefectOrCatchableError*(t: PType): bool = @@ -1824,8 +1893,8 @@ proc isDefectOrCatchableError*(t: PType): bool = (t.sym.name.s == "Defect" or t.sym.name.s == "CatchableError"): return true - if t[0] == nil: break - t = skipTypes(t[0], abstractPtrs) + if t.baseClass == nil: break + t = skipTypes(t.baseClass, abstractPtrs) return false proc isSinkTypeForParam*(t: PType): bool = @@ -1847,25 +1916,22 @@ proc lookupFieldAgain*(ty: PType; field: PSym): PSym = assert(ty.kind in {tyTuple, tyObject}) result = lookupInRecord(ty.n, field.name) if result != nil: break - ty = ty[0] + ty = ty.baseClass if result == nil: result = field proc isCharArrayPtr*(t: PType; allowPointerToChar: bool): bool = let t = t.skipTypes(abstractInst) if t.kind == tyPtr: - let pointsTo = t[0].skipTypes(abstractInst) + let pointsTo = t.elementType.skipTypes(abstractInst) case pointsTo.kind of tyUncheckedArray: - result = pointsTo[0].kind == tyChar + result = pointsTo.elementType.kind == tyChar of tyArray: - result = pointsTo[1].kind == tyChar and firstOrd(nil, pointsTo[0]) == 0 and - skipTypes(pointsTo[0], {tyRange}).kind in {tyInt..tyInt64} + result = pointsTo.elementType.kind == tyChar and firstOrd(nil, pointsTo.indexType) == 0 and + skipTypes(pointsTo.indexType, {tyRange}).kind in {tyInt..tyInt64} of tyChar: result = allowPointerToChar else: result = false else: result = false - -proc lacksMTypeField*(typ: PType): bool {.inline.} = - (typ.sym != nil and sfPure in typ.sym.flags) or tfFinal in typ.flags diff --git a/compiler/varpartitions.nim b/compiler/varpartitions.nim index 957497bb6..1711fea46 100644 --- a/compiler/varpartitions.nim +++ b/compiler/varpartitions.nim @@ -106,6 +106,7 @@ type unanalysableMutation: bool inAsgnSource, inConstructor, inNoSideEffectSection: int inConditional, inLoop: int + inConvHasDestructor: int owner: PSym g: ModuleGraph @@ -400,15 +401,14 @@ proc allRoots(n: PNode; result: var seq[(PSym, int)]; level: int) = if typ != nil: typ = skipTypes(typ, abstractInst) if typ.kind != tyProc: typ = nil - else: assert(typ.len == typ.n.len) for i in 1 ..< n.len: let it = n[i] - if typ != nil and i < typ.len: + if typ != nil and i < typ.n.len: assert(typ.n[i].kind == nkSym) let paramType = typ.n[i].typ - if not paramType.isCompileTimeOnly and not typ[0].isEmptyType and - canAlias(paramType, typ[0]): + if not paramType.isCompileTimeOnly and not typ.returnType.isEmptyType and + canAlias(paramType, typ.returnType): allRoots(it, result, RootEscapes) else: allRoots(it, result, RootEscapes) @@ -428,16 +428,28 @@ proc destMightOwn(c: var Partitions; dest: var VarIndex; n: PNode) = # primitive literals including the empty are harmless: discard - of nkExprEqExpr, nkExprColonExpr, nkHiddenStdConv, nkHiddenSubConv, nkCast, nkConv: + of nkExprEqExpr, nkExprColonExpr, nkHiddenStdConv, nkHiddenSubConv, nkCast: destMightOwn(c, dest, n[1]) + of nkConv: + if hasDestructor(n.typ): + inc c.inConvHasDestructor + destMightOwn(c, dest, n[1]) + dec c.inConvHasDestructor + else: + destMightOwn(c, dest, n[1]) + of nkIfStmt, nkIfExpr: for i in 0..<n.len: + inc c.inConditional destMightOwn(c, dest, n[i].lastSon) + dec c.inConditional of nkCaseStmt: for i in 1..<n.len: + inc c.inConditional destMightOwn(c, dest, n[i].lastSon) + dec c.inConditional of nkStmtList, nkStmtListExpr: if n.len > 0: @@ -482,7 +494,7 @@ proc destMightOwn(c: var Partitions; dest: var VarIndex; n: PNode) = of nkCallKinds: if n.typ != nil: - if hasDestructor(n.typ): + if hasDestructor(n.typ) or c.inConvHasDestructor > 0: # calls do construct, what we construct must be destroyed, # so dest cannot be a cursor: dest.flags.incl ownsData @@ -490,8 +502,17 @@ proc destMightOwn(c: var Partitions; dest: var VarIndex; n: PNode) = # we know the result is derived from the first argument: var roots: seq[(PSym, int)] = @[] allRoots(n[1], roots, RootEscapes) - for r in roots: - connect(c, dest.sym, r[0], n[1].info) + if roots.len == 0 and c.inConditional > 0: + # when in a conditional expression, + # to ensure that the first argument isn't outlived + # by the lvalue, we need find the root, otherwise + # it is probably a local temporary + # (e.g. a return value from a call), + # we should prevent cursorfication + dest.flags.incl preventCursor + else: + for r in roots: + connect(c, dest.sym, r[0], n[1].info) else: let magic = if n[0].kind == nkSym: n[0].sym.magic else: mNone @@ -707,7 +728,7 @@ proc traverse(c: var Partitions; n: PNode) = for child in n: traverse(c, child) let parameters = n[0].typ - let L = if parameters != nil: parameters.len else: 0 + let L = if parameters != nil: parameters.signatureLen else: 0 let m = getMagic(n) if m == mEnsureMove and n[1].kind == nkSym: @@ -858,7 +879,7 @@ proc computeLiveRanges(c: var Partitions; n: PNode) = for child in n: computeLiveRanges(c, child) let parameters = n[0].typ - let L = if parameters != nil: parameters.len else: 0 + let L = if parameters != nil: parameters.signatureLen else: 0 for i in 1..<n.len: let it = n[i] @@ -986,7 +1007,9 @@ proc computeCursors*(s: PSym; n: PNode; g: ModuleGraph) = if v.flags * {ownsData, preventCursor, isConditionallyReassigned} == {} and v.sym.kind notin {skParam, skResult} and v.sym.flags * {sfThread, sfGlobal} == {} and hasDestructor(v.sym.typ) and - v.sym.typ.skipTypes({tyGenericInst, tyAlias}).kind != tyOwned: + v.sym.typ.skipTypes({tyGenericInst, tyAlias}).kind != tyOwned and + (getAttachedOp(g, v.sym.typ, attachedAsgn) == nil or + sfError notin getAttachedOp(g, v.sym.typ, attachedAsgn).flags): let rid = root(par, i) if par.s[rid].con.kind == isRootOf and dangerousMutation(par.graphs[par.s[rid].con.graphIndex], par.s[i]): discard "cannot cursor into a graph that is mutated" diff --git a/compiler/vm.nim b/compiler/vm.nim index 8824eca37..161b025a6 100644 --- a/compiler/vm.nim +++ b/compiler/vm.nim @@ -507,7 +507,7 @@ proc setLenSeq(c: PCtx; node: PNode; newLen: int; info: TLineInfo) = setLen(node.sons, newLen) if oldLen < newLen: for i in oldLen..<newLen: - node[i] = getNullValue(typ[0], info, c.config) + node[i] = getNullValue(c, typ.elementType, info, c.config) const errNilAccess = "attempt to access a nil address" @@ -527,7 +527,7 @@ template maybeHandlePtr(node2: PNode, reg: TFullReg, isAssign2: bool): bool = if nfIsPtr in node.flags or (typ != nil and typ.kind == tyPtr): assert node.kind == nkIntLit, $(node.kind) assert typ != nil - let typ2 = if typ.kind == tyPtr: typ[0] else: typ + let typ2 = if typ.kind == tyPtr: typ.elementType else: typ if not derefPtrToReg(node.intVal, typ2, reg, isAssign = isAssign2): # tyObject not supported in this context stackTrace(c, tos, pc, "deref unsupported ptr type: " & $(typeToString(typ), typ.kind)) @@ -609,7 +609,10 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcYldVal: assert false of opcAsgnInt: decodeB(rkInt) - regs[ra].intVal = regs[rb].intVal + if regs[rb].kind == rkInt: + regs[ra].intVal = regs[rb].intVal + else: + stackTrace(c, tos, pc, "opcAsgnInt: got " & $regs[rb].kind) of opcAsgnFloat: decodeB(rkFloat) regs[ra].floatVal = regs[rb].floatVal @@ -639,6 +642,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[ra].intVal = cast[int](regs[rb].node.intVal) of rkNodeAddr: regs[ra].intVal = cast[int](regs[rb].nodeAddr) + of rkRegisterAddr: + regs[ra].intVal = cast[int](regs[rb].regAddr) of rkInt: regs[ra].intVal = regs[rb].intVal else: @@ -674,16 +679,19 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = else: assert regs[rb].kind == rkNode let nb = regs[rb].node - case nb.kind - of nkCharLit..nkUInt64Lit: - ensureKind(rkInt) - regs[ra].intVal = nb.intVal - of nkFloatLit..nkFloat64Lit: - ensureKind(rkFloat) - regs[ra].floatVal = nb.floatVal + if nb == nil: + stackTrace(c, tos, pc, errNilAccess) else: - ensureKind(rkNode) - regs[ra].node = nb + case nb.kind + of nkCharLit..nkUInt64Lit: + ensureKind(rkInt) + regs[ra].intVal = nb.intVal + of nkFloatLit..nkFloat64Lit: + ensureKind(rkFloat) + regs[ra].floatVal = nb.floatVal + else: + ensureKind(rkNode) + regs[ra].node = nb of opcSlice: # A bodge, but this takes in `toOpenArray(rb, rc, rc)` and emits # nkTupleConstr(x, y, z) into the `regs[ra]`. These can later be used for calculating the slice we have taken. @@ -813,6 +821,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = # a[b] = c decodeBC(rkNode) let idx = regs[rb].intVal.int + assert regs[ra].kind == rkNode let arr = regs[ra].node case arr.kind of nkTupleConstr: # refer to `opcSlice` @@ -826,7 +835,11 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of nkStrKinds: src.strVal[int(realIndex)] = char(regs[rc].intVal) of nkBracket: - src[int(realIndex)] = regs[rc].node + if regs[rc].kind == rkInt: + src[int(realIndex)] = newIntNode(nkIntLit, regs[rc].intVal) + else: + assert regs[rc].kind == rkNode + src[int(realIndex)] = regs[rc].node else: stackTrace(c, tos, pc, "opcWrArr internal error") else: @@ -843,25 +856,30 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcLdObj: # a = b.c decodeBC(rkNode) - let src = if regs[rb].kind == rkNode: regs[rb].node else: regs[rb].nodeAddr[] - case src.kind - of nkEmpty..nkNilLit: - # for nkPtrLit, this could be supported in the future, use something like: - # derefPtrToReg(src.intVal + offsetof(src.typ, rc), typ_field, regs[ra], isAssign = false) - # where we compute the offset in bytes for field rc - stackTrace(c, tos, pc, errNilAccess & " " & $("kind", src.kind, "typ", typeToString(src.typ), "rc", rc)) - of nkObjConstr: - let n = src[rc + 1].skipColon - regs[ra].node = n - of nkTupleConstr: - let n = if src.typ != nil and tfTriggersCompileTime in src.typ.flags: - src[rc] - else: - src[rc].skipColon - regs[ra].node = n + if rb >= regs.len or regs[rb].kind == rkNone or + (regs[rb].kind == rkNode and regs[rb].node == nil) or + (regs[rb].kind == rkNodeAddr and regs[rb].nodeAddr[] == nil): + stackTrace(c, tos, pc, errNilAccess) else: - let n = src[rc] - regs[ra].node = n + let src = if regs[rb].kind == rkNode: regs[rb].node else: regs[rb].nodeAddr[] + case src.kind + of nkEmpty..nkNilLit: + # for nkPtrLit, this could be supported in the future, use something like: + # derefPtrToReg(src.intVal + offsetof(src.typ, rc), typ_field, regs[ra], isAssign = false) + # where we compute the offset in bytes for field rc + stackTrace(c, tos, pc, errNilAccess & " " & $("kind", src.kind, "typ", typeToString(src.typ), "rc", rc)) + of nkObjConstr: + let n = src[rc + 1].skipColon + regs[ra].node = n + of nkTupleConstr: + let n = if src.typ != nil and tfTriggersCompileTime in src.typ.flags: + src[rc] + else: + src[rc].skipColon + regs[ra].node = n + else: + let n = src[rc] + regs[ra].node = n of opcLdObjAddr: # a = addr(b.c) decodeBC(rkNodeAddr) @@ -887,8 +905,10 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = stackTrace(c, tos, pc, errNilAccess) elif dest[shiftedRb].kind == nkExprColonExpr: writeField(dest[shiftedRb][1], regs[rc]) + dest[shiftedRb][1].flags.incl nfSkipFieldChecking else: writeField(dest[shiftedRb], regs[rc]) + dest[shiftedRb].flags.incl nfSkipFieldChecking of opcWrStrIdx: decodeBC(rkNode) let idx = regs[rb].intVal.int @@ -1356,7 +1376,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = else: internalError(c.config, c.debug[pc], "opcParseFloat: Incorrectly created openarray") else: - regs[ra].intVal = parseBiggestFloat(regs[ra].node.strVal, rcAddr.floatVal) + regs[ra].intVal = parseBiggestFloat(regs[rb].node.strVal, rcAddr.floatVal) of opcRangeChck: let rb = instr.regB @@ -1371,7 +1391,11 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let rb = instr.regB let rc = instr.regC let bb = regs[rb].node + if bb.kind == nkNilLit: + stackTrace(c, tos, pc, "attempt to call nil closure") let isClosure = bb.kind == nkTupleConstr + if isClosure and bb[0].kind == nkNilLit: + stackTrace(c, tos, pc, "attempt to call nil closure") let prc = if not isClosure: bb.sym else: bb[0].sym if prc.offset < -1: # it's a callback: @@ -1410,8 +1434,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = #echo "new pc ", newPc, " calling: ", prc.name.s var newFrame = PStackFrame(prc: prc, comesFrom: pc, next: tos) newSeq(newFrame.slots, prc.offset+ord(isClosure)) - if not isEmptyType(prc.typ[0]): - putIntoReg(newFrame.slots[0], getNullValue(prc.typ[0], prc.info, c.config)) + if not isEmptyType(prc.typ.returnType): + putIntoReg(newFrame.slots[0], getNullValue(c, prc.typ.returnType, prc.info, c.config)) for i in 1..rc-1: newFrame.slots[i] = regs[rb+i] if isClosure: @@ -1544,7 +1568,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcNew: ensureKind(rkNode) let typ = c.types[instr.regBx - wordExcess] - regs[ra].node = getNullValue(typ, c.debug[pc], c.config) + regs[ra].node = getNullValue(c, typ, c.debug[pc], c.config) regs[ra].node.flags.incl nfIsRef of opcNewSeq: let typ = c.types[instr.regBx - wordExcess] @@ -1556,7 +1580,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[ra].node.typ = typ newSeq(regs[ra].node.sons, count) for i in 0..<count: - regs[ra].node[i] = getNullValue(typ[0], c.debug[pc], c.config) + regs[ra].node[i] = getNullValue(c, typ.elementType, c.debug[pc], c.config) of opcNewStr: decodeB(rkNode) regs[ra].node = newNodeI(nkStrLit, c.debug[pc]) @@ -1568,7 +1592,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcLdNull: ensureKind(rkNode) let typ = c.types[instr.regBx - wordExcess] - regs[ra].node = getNullValue(typ, c.debug[pc], c.config) + regs[ra].node = getNullValue(c, typ, c.debug[pc], c.config) # opcLdNull really is the gist of the VM's problems: should it load # a fresh null to regs[ra].node or to regs[ra].node[]? This really # depends on whether regs[ra] represents the variable itself or whether @@ -1618,7 +1642,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = node2.flags.incl nfIsPtr regs[ra].node = node2 elif not derefPtrToReg(node.intVal, typ, regs[ra], isAssign = false): - stackTrace(c, tos, pc, "opcLdDeref unsupported type: " & $(typeToString(typ), typ[0].kind)) + stackTrace(c, tos, pc, "opcLdDeref unsupported type: " & $(typeToString(typ), typ.elementType.kind)) of opcLdGlobalAddrDerefFFI: let rb = instr.regBx - wordExcess - 1 let node = c.globals[rb] @@ -1925,6 +1949,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = proc (conf: ConfigRef; info: TLineInfo; msg: TMsgKind; arg: string) = if error.len == 0 and msg <= errMax: error = formatMsg(conf, info, msg, arg)) + + regs[ra].node = newNode(nkEmpty) if error.len > 0: c.errorFlag = error elif ast.len != 1: @@ -1942,6 +1968,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = error = formatMsg(conf, info, msg, arg)) if error.len > 0: c.errorFlag = error + regs[ra].node = newNode(nkEmpty) else: regs[ra].node = ast of opcQueryErrorFlag: @@ -2264,7 +2291,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = decodeB(rkNode) var typ = regs[rb].node.typ internalAssert c.config, typ != nil - while typ.kind == tyTypeDesc and typ.len > 0: typ = typ[0] + while typ.kind == tyTypeDesc and typ.hasElementType: typ = typ.skipModifier createStr regs[ra] regs[ra].node.strVal = typ.typeToString(preferExported) @@ -2280,11 +2307,11 @@ proc execute(c: PCtx, start: int): PNode = proc execProc*(c: PCtx; sym: PSym; args: openArray[PNode]): PNode = c.loopIterations = c.config.maxLoopIterationsVM if sym.kind in routineKinds: - if sym.typ.len-1 != args.len: + if sym.typ.paramsLen != args.len: result = nil localError(c.config, sym.info, "NimScript: expected $# arguments, but got $#" % [ - $(sym.typ.len-1), $args.len]) + $(sym.typ.paramsLen), $args.len]) else: let start = genProc(c, sym) @@ -2293,11 +2320,11 @@ proc execProc*(c: PCtx; sym: PSym; args: openArray[PNode]): PNode = newSeq(tos.slots, maxSlots) # setup parameters: - if not isEmptyType(sym.typ[0]) or sym.kind == skMacro: - putIntoReg(tos.slots[0], getNullValue(sym.typ[0], sym.info, c.config)) + if not isEmptyType(sym.typ.returnType) or sym.kind == skMacro: + putIntoReg(tos.slots[0], getNullValue(c, sym.typ.returnType, sym.info, c.config)) # XXX We could perform some type checking here. - for i in 1..<sym.typ.len: - putIntoReg(tos.slots[i], args[i-1]) + for i in 0..<sym.typ.paramsLen: + putIntoReg(tos.slots[i+1], args[i]) result = rawExecute(c, start, tos).regToNode else: @@ -2435,7 +2462,7 @@ iterator genericParamsInMacroCall*(macroSym: PSym, call: PNode): (PSym, PNode) = let gp = macroSym.ast[genericParamsPos] for i in 0..<gp.len: let genericParam = gp[i].sym - let posInCall = macroSym.typ.len + i + let posInCall = macroSym.typ.signatureLen + i if posInCall < call.len: yield (genericParam, call[posInCall]) @@ -2458,9 +2485,10 @@ proc evalMacroCall*(module: PSym; idgen: IdGenerator; g: ModuleGraph; templInstC # immediate macros can bypass any type and arity checking so we check the # arity here too: - if sym.typ.len > n.safeLen and sym.typ.len > 1: + let sl = sym.typ.signatureLen + if sl > n.safeLen and sl > 1: globalError(g.config, n.info, "in call '$#' got $#, but expected $# argument(s)" % [ - n.renderTree, $(n.safeLen-1), $(sym.typ.len-1)]) + n.renderTree, $(n.safeLen-1), $(sym.typ.paramsLen)]) setupGlobalCtx(module, g, idgen) var c = PCtx g.vm @@ -2485,12 +2513,12 @@ proc evalMacroCall*(module: PSym; idgen: IdGenerator; g: ModuleGraph; templInstC tos.slots[0] = TFullReg(kind: rkNode, node: newNodeI(nkEmpty, n.info)) # setup parameters: - for i in 1..<sym.typ.len: - tos.slots[i] = setupMacroParam(n[i], sym.typ[i]) + for i, param in paramTypes(sym.typ): + tos.slots[i-FirstParamAt+1] = setupMacroParam(n[i-FirstParamAt+1], param) let gp = sym.ast[genericParamsPos] for i in 0..<gp.len: - let idx = sym.typ.len + i + let idx = sym.typ.signatureLen + i if idx < n.len: tos.slots[idx] = setupMacroParam(n[idx], gp[i].sym.typ) else: diff --git a/compiler/vmconv.nim b/compiler/vmconv.nim index 394fb838b..45d925df0 100644 --- a/compiler/vmconv.nim +++ b/compiler/vmconv.nim @@ -1,4 +1,5 @@ -import ast, idents, lineinfos, astalgo +import ast except elementType +import idents, lineinfos, astalgo import vmdef import std/times diff --git a/compiler/vmdeps.nim b/compiler/vmdeps.nim index ed3ca68ac..294aaaa79 100644 --- a/compiler/vmdeps.nim +++ b/compiler/vmdeps.nim @@ -49,13 +49,13 @@ proc mapTypeToBracketX(cache: IdentCache; name: string; m: TMagic; t: PType; inf inst=false): PNode = result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) result.add atomicTypeX(cache, name, m, t, info, idgen) - for i in 0..<t.len: - if t[i] == nil: + for a in t.kids: + if a == nil: let voidt = atomicTypeX(cache, "void", mVoid, t, info, idgen) voidt.typ = newType(tyVoid, idgen, t.owner) result.add voidt else: - result.add mapTypeToAstX(cache, t[i], info, idgen, inst) + result.add mapTypeToAstX(cache, a, info, idgen, inst) proc objectNode(cache: IdentCache; n: PNode; idgen: IdGenerator): PNode = if n.kind == nkSym: @@ -74,9 +74,9 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; var allowRecursion = allowRecursionX template atomicType(name, m): untyped = atomicTypeX(cache, name, m, t, info, idgen) template atomicType(s): untyped = atomicTypeX(s, info) - template mapTypeToAst(t,info): untyped = mapTypeToAstX(cache, t, info, idgen, inst) - template mapTypeToAstR(t,info): untyped = mapTypeToAstX(cache, t, info, idgen, inst, true) - template mapTypeToAst(t,i,info): untyped = + template mapTypeToAst(t, info): untyped = mapTypeToAstX(cache, t, info, idgen, inst) + template mapTypeToAstR(t, info): untyped = mapTypeToAstX(cache, t, info, idgen, inst, true) + template mapTypeToAst(t, i, info): untyped = if i<t.len and t[i]!=nil: mapTypeToAstX(cache, t[i], info, idgen, inst) else: newNodeI(nkEmpty, info) template mapTypeToBracket(name, m, t, info): untyped = @@ -107,19 +107,19 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; of tyUncheckedArray: result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) result.add atomicType("UncheckedArray", mUncheckedArray) - result.add mapTypeToAst(t[0], info) + result.add mapTypeToAst(t.elementType, info) of tyArray: result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) result.add atomicType("array", mArray) - if inst and t[0].kind == tyRange: + if inst and t.indexType.kind == tyRange: var rng = newNodeX(nkInfix) rng.add newIdentNode(getIdent(cache, ".."), info) - rng.add t[0].n[0].copyTree - rng.add t[0].n[1].copyTree + rng.add t.indexType.n[0].copyTree + rng.add t.indexType.n[1].copyTree result.add rng else: - result.add mapTypeToAst(t[0], info) - result.add mapTypeToAst(t[1], info) + result.add mapTypeToAst(t.indexType, info) + result.add mapTypeToAst(t.elementType, info) of tyTypeDesc: if t.base != nil: result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) @@ -129,37 +129,37 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; result = atomicType("typeDesc", mTypeDesc) of tyGenericInvocation: result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) - for i in 0..<t.len: - result.add mapTypeToAst(t[i], info) + for a in t.kids: + result.add mapTypeToAst(a, info) of tyGenericInst: if inst: if allowRecursion: - result = mapTypeToAstR(t.lastSon, info) + result = mapTypeToAstR(t.skipModifier, info) # keep original type info for getType calls on the output node: result.typ = t else: result = newNodeX(nkBracketExpr) - #result.add mapTypeToAst(t.lastSon, info) - result.add mapTypeToAst(t[0], info) - for i in 1..<t.len-1: - result.add mapTypeToAst(t[i], info) + #result.add mapTypeToAst(t.last, info) + result.add mapTypeToAst(t.genericHead, info) + for _, a in t.genericInstParams: + result.add mapTypeToAst(a, info) else: - result = mapTypeToAstX(cache, t.lastSon, info, idgen, inst, allowRecursion) + result = mapTypeToAstX(cache, t.skipModifier, info, idgen, inst, allowRecursion) # keep original type info for getType calls on the output node: result.typ = t of tyGenericBody: if inst: - result = mapTypeToAstR(t.lastSon, info) + result = mapTypeToAstR(t.typeBodyImpl, info) else: - result = mapTypeToAst(t.lastSon, info) + result = mapTypeToAst(t.typeBodyImpl, info) of tyAlias: - result = mapTypeToAstX(cache, t.lastSon, info, idgen, inst, allowRecursion) + result = mapTypeToAstX(cache, t.skipModifier, info, idgen, inst, allowRecursion) of tyOrdinal: - result = mapTypeToAst(t.lastSon, info) + result = mapTypeToAst(t.skipModifier, info) of tyDistinct: if inst: result = newNodeX(nkDistinctTy) - result.add mapTypeToAst(t[0], info) + result.add mapTypeToAst(t.skipModifier, info) else: if allowRecursion or t.sym == nil: result = mapTypeToBracket("distinct", mDistinct, t, info) @@ -174,11 +174,11 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; if objectDef.kind == nkRefTy: objectDef = objectDef[0] result.add objectDef[0].copyTree # copy object pragmas - if t[0] == nil: + if t.baseClass == nil: result.add newNodeI(nkEmpty, info) else: # handle parent object var nn = newNodeX(nkOfInherit) - nn.add mapTypeToAst(t[0], info) + nn.add mapTypeToAst(t.baseClass, info) result.add nn if t.n.len > 0: result.add objectNode(cache, t.n, idgen) @@ -188,10 +188,10 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; if allowRecursion or t.sym == nil: result = newNodeIT(nkObjectTy, if t.n.isNil: info else: t.n.info, t) result.add newNodeI(nkEmpty, info) - if t[0] == nil: + if t.baseClass == nil: result.add newNodeI(nkEmpty, info) else: - result.add mapTypeToAst(t[0], info) + result.add mapTypeToAst(t.baseClass, info) result.add copyTree(t.n) else: result = atomicType(t.sym) @@ -205,7 +205,7 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; # only named tuples have a node, unnamed tuples don't if t.n.isNil: result = newNodeX(nkTupleConstr) - for subType in t: + for subType in t.kids: result.add mapTypeToAst(subType, info) else: result = newNodeX(nkTupleTy) @@ -217,19 +217,19 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; of tyPtr: if inst: result = newNodeX(nkPtrTy) - result.add mapTypeToAst(t[0], info) + result.add mapTypeToAst(t.elementType, info) else: result = mapTypeToBracket("ptr", mPtr, t, info) of tyRef: if inst: result = newNodeX(nkRefTy) - result.add mapTypeToAst(t[0], info) + result.add mapTypeToAst(t.elementType, info) else: result = mapTypeToBracket("ref", mRef, t, info) of tyVar: if inst: result = newNodeX(nkVarTy) - result.add mapTypeToAst(t[0], info) + result.add mapTypeToAst(t.elementType, info) else: result = mapTypeToBracket("var", mVar, t, info) of tyLent: result = mapTypeToBracket("lent", mBuiltinType, t, info) @@ -237,17 +237,24 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; of tySequence: result = mapTypeToBracket("seq", mSeq, t, info) of tyProc: if inst: - result = newNodeX(nkProcTy) + result = newNodeX(if tfIterator in t.flags: nkIteratorTy else: nkProcTy) var fp = newNodeX(nkFormalParams) - if t[0] == nil: + if t.returnType == nil: fp.add newNodeI(nkEmpty, info) else: - fp.add mapTypeToAst(t[0], t.n[0].info) - for i in 1..<t.len: + fp.add mapTypeToAst(t.returnType, t.n[0].info) + for i in FirstParamAt..<t.kidsLen: fp.add newIdentDefs(t.n[i], t[i]) result.add fp - result.add if t.n[0].len > 0: t.n[0][pragmasEffects].copyTree - else: newNodeI(nkEmpty, info) + var prag = + if t.n[0].len > 0: + t.n[0][pragmasEffects].copyTree + else: + newNodeI(nkEmpty, info) + if t.callConv != ccClosure or tfExplicitCallConv in t.flags: + if prag.kind == nkEmpty: prag = newNodeI(nkPragma, info) + prag.add newIdentNode(getIdent(cache, $t.callConv), info) + result.add prag else: result = mapTypeToBracket("proc", mNone, t, info) of tyOpenArray: result = mapTypeToBracket("openArray", mOpenArray, t, info) @@ -282,12 +289,12 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; of tyUInt32: result = atomicType("uint32", mUInt32) of tyUInt64: result = atomicType("uint64", mUInt64) of tyVarargs: result = mapTypeToBracket("varargs", mVarargs, t, info) - of tyProxy: result = atomicType("error", mNone) + of tyError: result = atomicType("error", mNone) of tyBuiltInTypeClass: result = mapTypeToBracket("builtinTypeClass", mNone, t, info) of tyUserTypeClass, tyUserTypeClassInst: if t.isResolvedUserTypeClass: - result = mapTypeToAst(t.lastSon, info) + result = mapTypeToAst(t.last, info) else: result = mapTypeToBracket("concept", mNone, t, info) result.add t.n.copyTree @@ -298,7 +305,7 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; of tyNot: result = mapTypeToBracket("not", mNot, t, info) of tyIterable: result = mapTypeToBracket("iterable", mIterableType, t, info) of tyAnything: result = atomicType("anything", mNone) - of tyInferred: result = mapTypeToAstX(cache, t.lastSon, info, idgen, inst, allowRecursion) + of tyInferred: result = mapTypeToAstX(cache, t.skipModifier, info, idgen, inst, allowRecursion) of tyStatic, tyFromExpr: if inst: if t.n != nil: result = t.n.copyTree diff --git a/compiler/vmgen.nim b/compiler/vmgen.nim index 53b2974ba..0c7a49984 100644 --- a/compiler/vmgen.nim +++ b/compiler/vmgen.nim @@ -53,6 +53,7 @@ type gfNode # Affects how variables are loaded - always loads as rkNode gfNodeAddr # Affects how variables are loaded - always loads as rkNodeAddr gfIsParam # do not deepcopy parameters, they are immutable + gfIsSinkParam # deepcopy sink parameters TGenFlags = set[TGenFlag] proc debugInfo(c: PCtx; info: TLineInfo): string = @@ -245,7 +246,7 @@ proc getTemp(cc: PCtx; tt: PType): TRegister = proc freeTemp(c: PCtx; r: TRegister) = let c = c.prc - if c.regInfo[r].kind in {slotSomeTemp..slotTempComplex}: + if r < c.regInfo.len and c.regInfo[r].kind in {slotSomeTemp..slotTempComplex}: # this seems to cause https://github.com/nim-lang/Nim/issues/10647 c.regInfo[r].inUse = false @@ -357,12 +358,13 @@ proc genBlock(c: PCtx; n: PNode; dest: var TDest) = #if c.prc.regInfo[i].kind in {slotFixedVar, slotFixedLet}: if i != dest: when not defined(release): - if c.prc.regInfo[i].inUse and c.prc.regInfo[i].kind in {slotTempUnknown, - slotTempInt, - slotTempFloat, - slotTempStr, - slotTempComplex}: - raiseAssert "leaking temporary " & $i & " " & $c.prc.regInfo[i].kind + if c.config.cmd != cmdCheck: + if c.prc.regInfo[i].inUse and c.prc.regInfo[i].kind in {slotTempUnknown, + slotTempInt, + slotTempFloat, + slotTempStr, + slotTempComplex}: + raiseAssert "leaking temporary " & $i & " " & $c.prc.regInfo[i].kind c.prc.regInfo[i] = (inUse: false, kind: slotEmpty) c.clearDest(n, dest) @@ -619,10 +621,17 @@ proc genCall(c: PCtx; n: PNode; dest: var TDest) = let fntyp = skipTypes(n[0].typ, abstractInst) for i in 0..<n.len: var r: TRegister = x+i - c.gen(n[i], r, {gfIsParam}) - if i >= fntyp.len: + if i >= fntyp.signatureLen: + c.gen(n[i], r, {gfIsParam}) internalAssert c.config, tfVarargs in fntyp.flags c.gABx(n, opcSetType, r, c.genType(n[i].typ)) + else: + if fntyp[i] != nil and fntyp[i].kind == tySink and + fntyp[i].skipTypes({tySink}).kind in {tyObject, tyString, tySequence}: + c.gen(n[i], r, {gfIsSinkParam}) + else: + c.gen(n[i], r, {gfIsParam}) + if dest < 0: c.gABC(n, opcIndCall, 0, x, n.len) else: @@ -696,6 +705,9 @@ proc genAsgnPatch(c: PCtx; le: PNode, value: TRegister) = let dest = c.genx(le, {gfNodeAddr}) c.gABC(le, opcWrDeref, dest, 0, value) c.freeTemp(dest) + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + if sameBackendType(le.typ, le[1].typ): + genAsgnPatch(c, le[1], value) else: discard @@ -868,7 +880,7 @@ proc genAddSubInt(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = genBinaryABC(c, n, dest, opc) c.genNarrow(n, dest) -proc genConv(c: PCtx; n, arg: PNode; dest: var TDest; opc=opcConv) = +proc genConv(c: PCtx; n, arg: PNode; dest: var TDest, flags: TGenFlags = {}; opc=opcConv) = let t2 = n.typ.skipTypes({tyDistinct}) let targ2 = arg.typ.skipTypes({tyDistinct}) @@ -882,7 +894,7 @@ proc genConv(c: PCtx; n, arg: PNode; dest: var TDest; opc=opcConv) = result = false if implicitConv(): - gen(c, arg, dest) + gen(c, arg, dest, flags) return let tmp = c.genx(arg) @@ -900,9 +912,15 @@ proc genCard(c: PCtx; n: PNode; dest: var TDest) = c.freeTemp(tmp) proc genCastIntFloat(c: PCtx; n: PNode; dest: var TDest) = + template isSigned(typ: PType): bool {.dirty.} = + typ.kind == tyEnum and firstOrd(c.config, typ) < 0 or + typ.kind in {tyInt..tyInt64} + template isUnsigned(typ: PType): bool {.dirty.} = + typ.kind == tyEnum and firstOrd(c.config, typ) >= 0 or + typ.kind in {tyUInt..tyUInt64, tyChar, tyBool} + const allowedIntegers = {tyInt..tyInt64, tyUInt..tyUInt64, tyChar, tyEnum, tyBool} - var signedIntegers = {tyInt..tyInt64} - var unsignedIntegers = {tyUInt..tyUInt64, tyChar, tyEnum, tyBool} + let src = n[1].typ.skipTypes(abstractRange)#.kind let dst = n[0].typ.skipTypes(abstractRange)#.kind let srcSize = getSize(c.config, src) @@ -914,12 +932,12 @@ proc genCastIntFloat(c: PCtx; n: PNode; dest: var TDest) = if dest < 0: dest = c.getTemp(n[0].typ) c.gABC(n, opcAsgnInt, dest, tmp) if dstSize != sizeof(BiggestInt): # don't do anything on biggest int types - if dst.kind in signedIntegers: # we need to do sign extensions + if isSigned(dst): # we need to do sign extensions if dstSize <= srcSize: # Sign extension can be omitted when the size increases. c.gABC(n, opcSignExtend, dest, TRegister(dstSize*8)) - elif dst.kind in unsignedIntegers: - if src.kind in signedIntegers or dstSize < srcSize: + elif isUnsigned(dst): + if isSigned(src) or dstSize < srcSize: # Cast from signed to unsigned always needs narrowing. Cast # from unsigned to unsigned only needs narrowing when target # is smaller than source. @@ -947,7 +965,7 @@ proc genCastIntFloat(c: PCtx; n: PNode; dest: var TDest) = if dest < 0: dest = c.getTemp(n[0].typ) if src.kind == tyFloat32: c.gABC(n, opcCastFloatToInt32, dest, tmp) - if dst.kind in unsignedIntegers: + if isUnsigned(dst): # integers are sign extended by default. # since there is no opcCastFloatToUInt32, narrowing should do the trick. c.gABC(n, opcNarrowU, dest, TRegister(32)) @@ -1044,7 +1062,7 @@ proc whichAsgnOpc(n: PNode; requiresCopy = true): TOpcode = else: (if requiresCopy: opcAsgnComplex else: opcFastAsgnComplex) -proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = +proc genMagic(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}, m: TMagic) = case m of mAnd: c.genAndOr(n, opcFJmp, dest) of mOr: c.genAndOr(n, opcTJmp, dest) @@ -1182,8 +1200,8 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = let size = getSize(c.config, t) if t.kind in {tyUInt8..tyUInt32} or (t.kind == tyUInt and size < 8): c.gABC(n, opcNarrowU, dest, TRegister(size*8)) - of mCharToStr, mBoolToStr, mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, mStrToStr, mEnumToStr: - genConv(c, n, n[1], dest) + of mCharToStr, mBoolToStr, mCStrToStr, mStrToStr, mEnumToStr: + genConv(c, n, n[1], dest, flags) of mEqStr: genBinaryABC(c, n, dest, opcEqStr) of mEqCString: genBinaryABC(c, n, dest, opcEqCString) of mLeStr: genBinaryABC(c, n, dest, opcLeStr) @@ -1229,13 +1247,6 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = c.freeTemp(tmp1) c.genAsgnPatch(d2AsNode, d2) c.freeTemp(d2) - of mReset: - unused(c, n, dest) - var d = c.genx(n[1]) - # XXX use ldNullOpcode() here? - c.gABx(n, opcLdNull, d, c.genType(n[1].typ)) - c.gABC(n, opcNodeToReg, d, d) - c.genAsgnPatch(n[1], d) of mDefault, mZeroDefault: if dest < 0: dest = c.getTemp(n.typ) c.gABx(n, ldNullOpcode(n.typ), dest, c.genType(n.typ)) @@ -1530,7 +1541,11 @@ proc setSlot(c: PCtx; v: PSym) = if v.position == 0: v.position = getFreeRegister(c, if v.kind == skLet: slotFixedLet else: slotFixedVar, start = 1) -proc cannotEval(c: PCtx; n: PNode) {.noinline.} = +template cannotEval(c: PCtx; n: PNode) = + if c.config.cmd == cmdCheck: + localError(c.config, n.info, "cannot evaluate at compile time: " & + n.renderTree) + return globalError(c.config, n.info, "cannot evaluate at compile time: " & n.renderTree) @@ -1653,6 +1668,9 @@ proc genAsgn(c: PCtx; le, ri: PNode; requiresCopy: bool) = c.freeTemp(cc) else: gen(c, ri, dest) + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + if sameBackendType(le.typ, le[1].typ): + genAsgn(c, le[1], ri, requiresCopy) else: let dest = c.genx(le, {gfNodeAddr}) genAsgn(c, dest, ri, requiresCopy) @@ -1691,10 +1709,10 @@ proc importcSym(c: PCtx; info: TLineInfo; s: PSym) = localError(c.config, info, "cannot 'importc' variable at compile time; " & s.name.s) -proc getNullValue*(typ: PType, info: TLineInfo; conf: ConfigRef): PNode +proc getNullValue*(c: PCtx; typ: PType, info: TLineInfo; conf: ConfigRef): PNode proc genGlobalInit(c: PCtx; n: PNode; s: PSym) = - c.globals.add(getNullValue(s.typ, n.info, c.config)) + c.globals.add(getNullValue(c, s.typ, n.info, c.config)) s.position = c.globals.len # This is rather hard to support, due to the laziness of the VM code # generator. See tests/compile/tmacro2 for why this is necessary: @@ -1730,6 +1748,8 @@ proc genRdVar(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = c.gABx(n, opcLdGlobalAddr, dest, s.position) elif isImportcVar: c.gABx(n, opcLdGlobalDerefFFI, dest, s.position) + elif gfIsSinkParam in flags: + genAsgn(c, dest, n, requiresCopy = true) elif fitsRegister(s.typ) and gfNode notin flags: var cc = c.getTemp(n.typ) c.gABx(n, opcLdGlobal, cc, s.position) @@ -1743,7 +1763,7 @@ proc genRdVar(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = s.kind in {skParam, skResult}): if dest < 0: dest = s.position + ord(s.kind == skParam) - internalAssert(c.config, c.prc.regInfo[dest].kind < slotSomeTemp) + internalAssert(c.config, c.prc.regInfo.len > dest and c.prc.regInfo[dest].kind < slotSomeTemp) else: # we need to generate an assignment: let requiresCopy = c.prc.regInfo[dest].kind >= slotSomeTemp and @@ -1873,21 +1893,21 @@ proc genArrAccess(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = let opc = if gfNodeAddr in flags: opcLdArrAddr else: opcLdArr genArrAccessOpcode(c, n, dest, opc, flags) -proc getNullValueAux(t: PType; obj: PNode, result: PNode; conf: ConfigRef; currPosition: var int) = - if t != nil and t.len > 0 and t[0] != nil: - let b = skipTypes(t[0], skipPtrs) - getNullValueAux(b, b.n, result, conf, currPosition) +proc getNullValueAux(c: PCtx; t: PType; obj: PNode, result: PNode; conf: ConfigRef; currPosition: var int) = + if t != nil and t.baseClass != nil: + let b = skipTypes(t.baseClass, skipPtrs) + getNullValueAux(c, b, b.n, result, conf, currPosition) case obj.kind of nkRecList: - for i in 0..<obj.len: getNullValueAux(nil, obj[i], result, conf, currPosition) + for i in 0..<obj.len: getNullValueAux(c, nil, obj[i], result, conf, currPosition) of nkRecCase: - getNullValueAux(nil, obj[0], result, conf, currPosition) + getNullValueAux(c, nil, obj[0], result, conf, currPosition) for i in 1..<obj.len: - getNullValueAux(nil, lastSon(obj[i]), result, conf, currPosition) + getNullValueAux(c, nil, lastSon(obj[i]), result, conf, currPosition) of nkSym: let field = newNodeI(nkExprColonExpr, result.info) field.add(obj) - let value = getNullValue(obj.sym.typ, result.info, conf) + let value = getNullValue(c, obj.sym.typ, result.info, conf) value.flags.incl nfSkipFieldChecking field.add(value) result.add field @@ -1895,7 +1915,7 @@ proc getNullValueAux(t: PType; obj: PNode, result: PNode; conf: ConfigRef; currP inc currPosition else: globalError(conf, result.info, "cannot create null element for: " & $obj) -proc getNullValue(typ: PType, info: TLineInfo; conf: ConfigRef): PNode = +proc getNullValue(c: PCtx; typ: PType, info: TLineInfo; conf: ConfigRef): PNode = var t = skipTypes(typ, abstractRange+{tyStatic, tyOwned}-{tyTypeDesc}) case t.kind of tyBool, tyEnum, tyChar, tyInt..tyInt64: @@ -1915,22 +1935,22 @@ proc getNullValue(typ: PType, info: TLineInfo; conf: ConfigRef): PNode = result = newNodeIT(nkNilLit, info, t) else: result = newNodeIT(nkTupleConstr, info, t) - result.add(newNodeIT(nkNilLit, info, t)) - result.add(newNodeIT(nkNilLit, info, t)) + result.add(newNodeIT(nkNilLit, info, getSysType(c.graph, info, tyPointer))) + result.add(newNodeIT(nkNilLit, info, getSysType(c.graph, info, tyPointer))) of tyObject: result = newNodeIT(nkObjConstr, info, t) result.add(newNodeIT(nkEmpty, info, t)) # initialize inherited fields, and all in the correct order: var currPosition = 0 - getNullValueAux(t, t.n, result, conf, currPosition) + getNullValueAux(c, t, t.n, result, conf, currPosition) of tyArray: result = newNodeIT(nkBracket, info, t) for i in 0..<toInt(lengthOrd(conf, t)): - result.add getNullValue(elemType(t), info, conf) + result.add getNullValue(c, elemType(t), info, conf) of tyTuple: result = newNodeIT(nkTupleConstr, info, t) - for i in 0..<t.len: - result.add getNullValue(t[i], info, conf) + for a in t.kids: + result.add getNullValue(c, a, info, conf) of tySet: result = newNodeIT(nkCurly, info, t) of tySequence, tyOpenArray: @@ -1958,7 +1978,7 @@ proc genVarSection(c: PCtx; n: PNode) = if s.position == 0: if importcCond(c, s): c.importcSym(a.info, s) else: - let sa = getNullValue(s.typ, a.info, c.config) + let sa = getNullValue(c, s.typ, a.info, c.config) #if s.ast.isNil: getNullValue(s.typ, a.info) #else: s.ast assert sa.kind != nkCall @@ -1980,7 +2000,7 @@ proc genVarSection(c: PCtx; n: PNode) = # the problem is that closure types are tuples in VM, but the types of its children # shouldn't have the same type as closure types. let tmp = c.genx(a[0], {gfNodeAddr}) - let sa = getNullValue(s.typ, a.info, c.config) + let sa = getNullValue(c, s.typ, a.info, c.config) let val = c.genx(sa) c.genAdditionalCopy(sa, opcWrDeref, tmp, 0, val) c.freeTemp(val) @@ -2050,10 +2070,12 @@ proc genSetConstr(c: PCtx, n: PNode, dest: var TDest) = c.freeTemp(a) proc genObjConstr(c: PCtx, n: PNode, dest: var TDest) = + if tfUnion in n.typ.flags: # bug #22708 # bug #13481 + globalError(c.config, n.info, "object with '{.union.}' pragmas is not supported by VM") if dest < 0: dest = c.getTemp(n.typ) let t = n.typ.skipTypes(abstractRange+{tyOwned}-{tyTypeDesc}) if t.kind == tyRef: - c.gABx(n, opcNew, dest, c.genType(t[0])) + c.gABx(n, opcNew, dest, c.genType(t.elementType)) else: c.gABx(n, opcLdNull, dest, c.genType(n.typ)) for i in 1..<n.len: @@ -2124,7 +2146,7 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = genRdVar(c, n, dest, flags) of skParam: if s.typ.kind == tyTypeDesc: - genTypeLit(c, s.typ, dest) + genTypeLit(c, s.typ.skipTypes({tyTypeDesc}), dest) else: genRdVar(c, n, dest, flags) of skProc, skFunc, skConverter, skMacro, skTemplate, skMethod, skIterator: @@ -2163,7 +2185,7 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = if n[0].kind == nkSym: let s = n[0].sym if s.magic != mNone: - genMagic(c, n, dest, s.magic) + genMagic(c, n, dest, flags, s.magic) elif s.kind == skMethod: localError(c.config, n.info, "cannot call method " & s.name.s & " at compile time") @@ -2181,7 +2203,7 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = genLit(c, n, dest) of nkUIntLit..pred(nkNilLit): genLit(c, n, dest) of nkNilLit: - if not n.typ.isEmptyType: genLit(c, getNullValue(n.typ, n.info, c.config), dest) + if not n.typ.isEmptyType: genLit(c, getNullValue(c, n.typ, n.info, c.config), dest) else: unused(c, n, dest) of nkAsgn, nkFastAsgn, nkSinkAsgn: unused(c, n, dest) @@ -2220,11 +2242,11 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = unused(c, n, dest) gen(c, n[0]) of nkHiddenStdConv, nkHiddenSubConv, nkConv: - genConv(c, n, n[1], dest) + genConv(c, n, n[1], dest, flags) of nkObjDownConv: - genConv(c, n, n[0], dest) + genConv(c, n, n[0], dest, flags) of nkObjUpConv: - genConv(c, n, n[0], dest) + genConv(c, n, n[0], dest, flags) of nkVarSection, nkLetSection: unused(c, n, dest) genVarSection(c, n) @@ -2233,18 +2255,21 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = #discard genProc(c, s) genLit(c, newSymNode(n[namePos].sym), dest) of nkChckRangeF, nkChckRange64, nkChckRange: - let - tmp0 = c.genx(n[0]) - tmp1 = c.genx(n[1]) - tmp2 = c.genx(n[2]) - c.gABC(n, opcRangeChck, tmp0, tmp1, tmp2) - c.freeTemp(tmp1) - c.freeTemp(tmp2) - if dest >= 0: - gABC(c, n, whichAsgnOpc(n), dest, tmp0) - c.freeTemp(tmp0) + if skipTypes(n.typ, abstractVar).kind in {tyUInt..tyUInt64}: + genConv(c, n, n[0], dest, flags) else: - dest = tmp0 + let + tmp0 = c.genx(n[0]) + tmp1 = c.genx(n[1]) + tmp2 = c.genx(n[2]) + c.gABC(n, opcRangeChck, tmp0, tmp1, tmp2) + c.freeTemp(tmp1) + c.freeTemp(tmp2) + if dest >= 0: + gABC(c, n, whichAsgnOpc(n), dest, tmp0) + c.freeTemp(tmp0) + else: + dest = tmp0 of nkEmpty, nkCommentStmt, nkTypeSection, nkConstSection, nkPragma, nkTemplateDef, nkIncludeStmt, nkImportStmt, nkFromStmt, nkExportStmt, nkMixinStmt, nkBindStmt, declarativeDefs, nkMacroDef: @@ -2257,7 +2282,7 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = of nkPar, nkClosure, nkTupleConstr: genTupleConstr(c, n, dest) of nkCast: if allowCast in c.features: - genConv(c, n, n[1], dest, opcCast) + genConv(c, n, n[1], dest, flags, opcCast) else: genCastIntFloat(c, n, dest) of nkTypeOfExpr: diff --git a/compiler/vmmarshal.nim b/compiler/vmmarshal.nim index 8ce113369..0e67ededa 100644 --- a/compiler/vmmarshal.nim +++ b/compiler/vmmarshal.nim @@ -82,11 +82,11 @@ proc storeAny(s: var string; t: PType; a: PNode; stored: var IntSet; s.add("]") of tyTuple: s.add("{") - for i in 0..<t.len: + for i, ti in t.ikids: if i > 0: s.add(", ") s.add("\"Field" & $i) s.add("\": ") - storeAny(s, t[i], a[i].skipColon, stored, conf) + storeAny(s, ti, a[i].skipColon, stored, conf) s.add("}") of tyObject: s.add("{") @@ -98,17 +98,17 @@ proc storeAny(s: var string; t: PType; a: PNode; stored: var IntSet; if i > 0: s.add(", ") if a[i].kind == nkRange: var x = copyNode(a[i][0]) - storeAny(s, t.lastSon, x, stored, conf) + storeAny(s, t.elementType, x, stored, conf) inc x.intVal while x.intVal <= a[i][1].intVal: s.add(", ") - storeAny(s, t.lastSon, x, stored, conf) + storeAny(s, t.elementType, x, stored, conf) inc x.intVal else: - storeAny(s, t.lastSon, a[i], stored, conf) + storeAny(s, t.elementType, a[i], stored, conf) s.add("]") of tyRange, tyGenericInst, tyAlias, tySink: - storeAny(s, t.lastSon, a, stored, conf) + storeAny(s, t.skipModifier, a, stored, conf) of tyEnum: # we need a slow linear search because of enums with holes: for e in items(t.n): @@ -127,7 +127,7 @@ proc storeAny(s: var string; t: PType; a: PNode; stored: var IntSet; s.add("[") s.add($x.ptrToInt) s.add(", ") - storeAny(s, t.lastSon, a, stored, conf) + storeAny(s, t.elementType, a, stored, conf) s.add("]") of tyString, tyCstring: if a.kind == nkNilLit: s.add("null") @@ -208,11 +208,12 @@ proc loadAny(p: var JsonParser, t: PType, next(p) result = newNode(nkTupleConstr) var i = 0 + let tupleLen = t.kidsLen while p.kind != jsonObjectEnd and p.kind != jsonEof: if p.kind != jsonString: raiseParseErr(p, "string expected for a field name") next(p) - if i >= t.len: + if i >= tupleLen: raiseParseErr(p, "too many fields to tuple type " & typeToString(t)) result.add loadAny(p, t[i], tab, cache, conf, idgen) inc i @@ -245,7 +246,7 @@ proc loadAny(p: var JsonParser, t: PType, next(p) result = newNode(nkCurly) while p.kind != jsonArrayEnd and p.kind != jsonEof: - result.add loadAny(p, t.lastSon, tab, cache, conf, idgen) + result.add loadAny(p, t.elementType, tab, cache, conf, idgen) if p.kind == jsonArrayEnd: next(p) else: raiseParseErr(p, "']' end of array expected") of tyPtr, tyRef: @@ -264,7 +265,7 @@ proc loadAny(p: var JsonParser, t: PType, if p.kind == jsonInt: let idx = p.getInt next(p) - result = loadAny(p, t.lastSon, tab, cache, conf, idgen) + result = loadAny(p, t.elementType, tab, cache, conf, idgen) tab[idx] = result else: raiseParseErr(p, "index for ref type expected") if p.kind == jsonArrayEnd: next(p) @@ -300,14 +301,14 @@ proc loadAny(p: var JsonParser, t: PType, result = nil raiseParseErr(p, "float expected") of tyRange, tyGenericInst, tyAlias, tySink: - result = loadAny(p, t.lastSon, tab, cache, conf, idgen) + result = loadAny(p, t.skipModifier, tab, cache, conf, idgen) else: result = nil internalError conf, "cannot marshal at compile-time " & t.typeToString proc loadAny*(s: string; t: PType; cache: IdentCache; conf: ConfigRef; idgen: IdGenerator): PNode = var tab = initTable[BiggestInt, PNode]() - var p: JsonParser + var p: JsonParser = default(JsonParser) open(p, newStringStream(s), "unknown file") next(p) result = loadAny(p, t, tab, cache, conf, idgen) diff --git a/compiler/vmops.nim b/compiler/vmops.nim index 23b41fd2e..45194e633 100644 --- a/compiler/vmops.nim +++ b/compiler/vmops.nim @@ -27,6 +27,7 @@ from std/envvars import getEnv, existsEnv, delEnv, putEnv, envPairs from std/os import getAppFilename from std/private/oscommon import dirExists, fileExists from std/private/osdirs import walkDir, createDir +from std/private/ospaths2 import getCurrentDir from std/times import cpuTime from std/hashes import hash @@ -341,8 +342,8 @@ proc registerAdditionalOps*(c: PCtx) = ## reproducible builds and users need to understand that this runs at CT. ## Note that `staticExec` can already do equal amount of damage so it's more ## of a semantic issue than a security issue. - registerCallback c, "stdlib.os.getCurrentDir", proc (a: VmArgs) {.nimcall.} = - setResult(a, os.getCurrentDir()) + registerCallback c, "stdlib.ospaths2.getCurrentDir", proc (a: VmArgs) {.nimcall.} = + setResult(a, getCurrentDir()) registerCallback c, "stdlib.osproc.execCmdEx", proc (a: VmArgs) {.nimcall.} = let options = getNode(a, 1).fromLit(set[osproc.ProcessOption]) a.setResult osproc.execCmdEx(getString(a, 0), options).toLit diff --git a/compiler/vtables.nim b/compiler/vtables.nim index f57b59eae..928c64dd5 100644 --- a/compiler/vtables.nim +++ b/compiler/vtables.nim @@ -1,167 +1,167 @@ -import ast, modulegraphs, magicsys, lineinfos, options, cgmeth, types -import std/[algorithm, tables, intsets, assertions] - - - -proc genVTableDispatcher(g: ModuleGraph; methods: seq[PSym]; index: int): PSym = -#[ -proc dispatch(x: Base, params: ...) = - cast[proc bar(x: Base, params: ...)](x.vTable[index])(x, params) -]# - var base = methods[0].ast[dispatcherPos].sym - result = base - var paramLen = base.typ.len - var body = newNodeI(nkStmtList, base.info) - - var disp = newNodeI(nkIfStmt, base.info) - - var vTableAccess = newNodeIT(nkBracketExpr, base.info, base.typ) - let nimGetVTableSym = getCompilerProc(g, "nimGetVTable") - let ptrPNimType = nimGetVTableSym.typ.n[1].sym.typ - - var nTyp = base.typ.n[1].sym.typ - var dispatchObject = newSymNode(base.typ.n[1].sym) - if nTyp.kind == tyObject: - dispatchObject = newTree(nkAddr, dispatchObject) - else: - if g.config.backend != backendCpp: # TODO: maybe handle ptr? - if nTyp.kind == tyVar and nTyp.skipTypes({tyVar}).kind != tyObject: - dispatchObject = newTree(nkDerefExpr, dispatchObject) - - var getVTableCall = newTree(nkCall, - newSymNode(nimGetVTableSym), - dispatchObject, - newIntNode(nkIntLit, index) - ) - getVTableCall.typ = base.typ - var vTableCall = newNodeIT(nkCall, base.info, base.typ[0]) - var castNode = newTree(nkCast, - newNodeIT(nkType, base.info, base.typ), - getVTableCall) - - castNode.typ = base.typ - vTableCall.add castNode - for col in 1..<paramLen: - let param = base.typ.n[col].sym - vTableCall.add newSymNode(param) - - var ret: PNode - if base.typ[0] != nil: - var a = newNodeI(nkFastAsgn, base.info) - a.add newSymNode(base.ast[resultPos].sym) - a.add vTableCall - ret = newNodeI(nkReturnStmt, base.info) - ret.add a - else: - ret = vTableCall - - if base.typ.n[1].sym.typ.skipTypes(abstractInst).kind in {tyRef, tyPtr}: - let ifBranch = newNodeI(nkElifBranch, base.info) - let boolType = getSysType(g, unknownLineInfo, tyBool) - var isNil = getSysMagic(g, unknownLineInfo, "isNil", mIsNil) - let checkSelf = newNodeIT(nkCall, base.info, boolType) - checkSelf.add newSymNode(isNil) - checkSelf.add newSymNode(base.typ.n[1].sym) - ifBranch.add checkSelf - ifBranch.add newTree(nkCall, - newSymNode(getCompilerProc(g, "chckNilDisp")), newSymNode(base.typ.n[1].sym)) - let elseBranch = newTree(nkElifBranch, ret) - disp.add ifBranch - disp.add elseBranch - else: - disp = ret - - body.add disp - body.flags.incl nfTransf # should not be further transformed - result.ast[bodyPos] = body - -proc containGenerics(base: PType, s: seq[tuple[depth: int, value: PType]]): bool = - result = tfHasMeta in base.flags - for i in s: - if tfHasMeta in i.value.flags: - result = true - break - -proc collectVTableDispatchers*(g: ModuleGraph) = - var itemTable = initTable[ItemId, seq[LazySym]]() - var rootTypeSeq = newSeq[PType]() - var rootItemIdCount = initCountTable[ItemId]() - for bucket in 0..<g.methods.len: - var relevantCols = initIntSet() - if relevantCol(g.methods[bucket].methods, 1): incl(relevantCols, 1) - sortBucket(g.methods[bucket].methods, relevantCols) - let base = g.methods[bucket].methods[^1] - let baseType = base.typ[1].skipTypes(skipPtrs-{tyTypeDesc}) - if baseType.itemId in g.objectTree and not containGenerics(baseType, g.objectTree[baseType.itemId]): - let methodIndexLen = g.bucketTable[baseType.itemId] - if baseType.itemId notin itemTable: # once is enough - rootTypeSeq.add baseType - itemTable[baseType.itemId] = newSeq[LazySym](methodIndexLen) - - sort(g.objectTree[baseType.itemId], cmp = proc (x, y: tuple[depth: int, value: PType]): int = - if x.depth >= y.depth: 1 - else: -1 - ) - - for item in g.objectTree[baseType.itemId]: - if item.value.itemId notin itemTable: - itemTable[item.value.itemId] = newSeq[LazySym](methodIndexLen) - - var mIndex = 0 # here is the correpsonding index - if baseType.itemId notin rootItemIdCount: - rootItemIdCount[baseType.itemId] = 1 - else: - mIndex = rootItemIdCount[baseType.itemId] - rootItemIdCount.inc(baseType.itemId) - for idx in 0..<g.methods[bucket].methods.len: - let obj = g.methods[bucket].methods[idx].typ[1].skipTypes(skipPtrs) - itemTable[obj.itemId][mIndex] = LazySym(sym: g.methods[bucket].methods[idx]) - g.addDispatchers genVTableDispatcher(g, g.methods[bucket].methods, mIndex) - else: # if the base object doesn't have this method - g.addDispatchers genIfDispatcher(g, g.methods[bucket].methods, relevantCols, g.idgen) - -proc sortVTableDispatchers*(g: ModuleGraph) = - var itemTable = initTable[ItemId, seq[LazySym]]() - var rootTypeSeq = newSeq[ItemId]() - var rootItemIdCount = initCountTable[ItemId]() - for bucket in 0..<g.methods.len: - var relevantCols = initIntSet() - if relevantCol(g.methods[bucket].methods, 1): incl(relevantCols, 1) - sortBucket(g.methods[bucket].methods, relevantCols) - let base = g.methods[bucket].methods[^1] - let baseType = base.typ[1].skipTypes(skipPtrs-{tyTypeDesc}) - if baseType.itemId in g.objectTree and not containGenerics(baseType, g.objectTree[baseType.itemId]): - let methodIndexLen = g.bucketTable[baseType.itemId] - if baseType.itemId notin itemTable: # once is enough - rootTypeSeq.add baseType.itemId - itemTable[baseType.itemId] = newSeq[LazySym](methodIndexLen) - - sort(g.objectTree[baseType.itemId], cmp = proc (x, y: tuple[depth: int, value: PType]): int = - if x.depth >= y.depth: 1 - else: -1 - ) - - for item in g.objectTree[baseType.itemId]: - if item.value.itemId notin itemTable: - itemTable[item.value.itemId] = newSeq[LazySym](methodIndexLen) - - var mIndex = 0 # here is the correpsonding index - if baseType.itemId notin rootItemIdCount: - rootItemIdCount[baseType.itemId] = 1 - else: - mIndex = rootItemIdCount[baseType.itemId] - rootItemIdCount.inc(baseType.itemId) - for idx in 0..<g.methods[bucket].methods.len: - let obj = g.methods[bucket].methods[idx].typ[1].skipTypes(skipPtrs) - itemTable[obj.itemId][mIndex] = LazySym(sym: g.methods[bucket].methods[idx]) - - for baseType in rootTypeSeq: - g.setMethodsPerType(baseType, itemTable[baseType]) - for item in g.objectTree[baseType]: - let typ = item.value.skipTypes(skipPtrs) - let idx = typ.itemId - for mIndex in 0..<itemTable[idx].len: - if itemTable[idx][mIndex].sym == nil: - let parentIndex = typ[0].skipTypes(skipPtrs).itemId - itemTable[idx][mIndex] = itemTable[parentIndex][mIndex] - g.setMethodsPerType(idx, itemTable[idx]) +import ast, modulegraphs, magicsys, lineinfos, options, cgmeth, types +import std/[algorithm, tables, intsets, assertions] + + + +proc genVTableDispatcher(g: ModuleGraph; methods: seq[PSym]; index: int): PSym = +#[ +proc dispatch(x: Base, params: ...) = + cast[proc bar(x: Base, params: ...)](x.vTable[index])(x, params) +]# + var base = methods[0].ast[dispatcherPos].sym + result = base + var paramLen = base.typ.signatureLen + var body = newNodeI(nkStmtList, base.info) + + var disp = newNodeI(nkIfStmt, base.info) + + var vTableAccess = newNodeIT(nkBracketExpr, base.info, base.typ) + let nimGetVTableSym = getCompilerProc(g, "nimGetVTable") + let ptrPNimType = nimGetVTableSym.typ.n[1].sym.typ + + var nTyp = base.typ.n[1].sym.typ + var dispatchObject = newSymNode(base.typ.n[1].sym) + if nTyp.kind == tyObject: + dispatchObject = newTree(nkAddr, dispatchObject) + else: + if g.config.backend != backendCpp: # TODO: maybe handle ptr? + if nTyp.kind == tyVar and nTyp.skipTypes({tyVar}).kind != tyObject: + dispatchObject = newTree(nkDerefExpr, dispatchObject) + + var getVTableCall = newTree(nkCall, + newSymNode(nimGetVTableSym), + dispatchObject, + newIntNode(nkIntLit, index) + ) + getVTableCall.typ = base.typ + var vTableCall = newNodeIT(nkCall, base.info, base.typ.returnType) + var castNode = newTree(nkCast, + newNodeIT(nkType, base.info, base.typ), + getVTableCall) + + castNode.typ = base.typ + vTableCall.add castNode + for col in 1..<paramLen: + let param = base.typ.n[col].sym + vTableCall.add newSymNode(param) + + var ret: PNode + if base.typ.returnType != nil: + var a = newNodeI(nkFastAsgn, base.info) + a.add newSymNode(base.ast[resultPos].sym) + a.add vTableCall + ret = newNodeI(nkReturnStmt, base.info) + ret.add a + else: + ret = vTableCall + + if base.typ.n[1].sym.typ.skipTypes(abstractInst).kind in {tyRef, tyPtr}: + let ifBranch = newNodeI(nkElifBranch, base.info) + let boolType = getSysType(g, unknownLineInfo, tyBool) + var isNil = getSysMagic(g, unknownLineInfo, "isNil", mIsNil) + let checkSelf = newNodeIT(nkCall, base.info, boolType) + checkSelf.add newSymNode(isNil) + checkSelf.add newSymNode(base.typ.n[1].sym) + ifBranch.add checkSelf + ifBranch.add newTree(nkCall, + newSymNode(getCompilerProc(g, "chckNilDisp")), newSymNode(base.typ.n[1].sym)) + let elseBranch = newTree(nkElifBranch, ret) + disp.add ifBranch + disp.add elseBranch + else: + disp = ret + + body.add disp + body.flags.incl nfTransf # should not be further transformed + result.ast[bodyPos] = body + +proc containGenerics(base: PType, s: seq[tuple[depth: int, value: PType]]): bool = + result = tfHasMeta in base.flags + for i in s: + if tfHasMeta in i.value.flags: + result = true + break + +proc collectVTableDispatchers*(g: ModuleGraph) = + var itemTable = initTable[ItemId, seq[LazySym]]() + var rootTypeSeq = newSeq[PType]() + var rootItemIdCount = initCountTable[ItemId]() + for bucket in 0..<g.methods.len: + var relevantCols = initIntSet() + if relevantCol(g.methods[bucket].methods, 1): incl(relevantCols, 1) + sortBucket(g.methods[bucket].methods, relevantCols) + let base = g.methods[bucket].methods[^1] + let baseType = base.typ.firstParamType.skipTypes(skipPtrs-{tyTypeDesc}) + if baseType.itemId in g.objectTree and not containGenerics(baseType, g.objectTree[baseType.itemId]): + let methodIndexLen = g.bucketTable[baseType.itemId] + if baseType.itemId notin itemTable: # once is enough + rootTypeSeq.add baseType + itemTable[baseType.itemId] = newSeq[LazySym](methodIndexLen) + + sort(g.objectTree[baseType.itemId], cmp = proc (x, y: tuple[depth: int, value: PType]): int = + if x.depth >= y.depth: 1 + else: -1 + ) + + for item in g.objectTree[baseType.itemId]: + if item.value.itemId notin itemTable: + itemTable[item.value.itemId] = newSeq[LazySym](methodIndexLen) + + var mIndex = 0 # here is the correpsonding index + if baseType.itemId notin rootItemIdCount: + rootItemIdCount[baseType.itemId] = 1 + else: + mIndex = rootItemIdCount[baseType.itemId] + rootItemIdCount.inc(baseType.itemId) + for idx in 0..<g.methods[bucket].methods.len: + let obj = g.methods[bucket].methods[idx].typ.firstParamType.skipTypes(skipPtrs) + itemTable[obj.itemId][mIndex] = LazySym(sym: g.methods[bucket].methods[idx]) + g.addDispatchers genVTableDispatcher(g, g.methods[bucket].methods, mIndex) + else: # if the base object doesn't have this method + g.addDispatchers genIfDispatcher(g, g.methods[bucket].methods, relevantCols, g.idgen) + +proc sortVTableDispatchers*(g: ModuleGraph) = + var itemTable = initTable[ItemId, seq[LazySym]]() + var rootTypeSeq = newSeq[ItemId]() + var rootItemIdCount = initCountTable[ItemId]() + for bucket in 0..<g.methods.len: + var relevantCols = initIntSet() + if relevantCol(g.methods[bucket].methods, 1): incl(relevantCols, 1) + sortBucket(g.methods[bucket].methods, relevantCols) + let base = g.methods[bucket].methods[^1] + let baseType = base.typ.firstParamType.skipTypes(skipPtrs-{tyTypeDesc}) + if baseType.itemId in g.objectTree and not containGenerics(baseType, g.objectTree[baseType.itemId]): + let methodIndexLen = g.bucketTable[baseType.itemId] + if baseType.itemId notin itemTable: # once is enough + rootTypeSeq.add baseType.itemId + itemTable[baseType.itemId] = newSeq[LazySym](methodIndexLen) + + sort(g.objectTree[baseType.itemId], cmp = proc (x, y: tuple[depth: int, value: PType]): int = + if x.depth >= y.depth: 1 + else: -1 + ) + + for item in g.objectTree[baseType.itemId]: + if item.value.itemId notin itemTable: + itemTable[item.value.itemId] = newSeq[LazySym](methodIndexLen) + + var mIndex = 0 # here is the correpsonding index + if baseType.itemId notin rootItemIdCount: + rootItemIdCount[baseType.itemId] = 1 + else: + mIndex = rootItemIdCount[baseType.itemId] + rootItemIdCount.inc(baseType.itemId) + for idx in 0..<g.methods[bucket].methods.len: + let obj = g.methods[bucket].methods[idx].typ.firstParamType.skipTypes(skipPtrs) + itemTable[obj.itemId][mIndex] = LazySym(sym: g.methods[bucket].methods[idx]) + + for baseType in rootTypeSeq: + g.setMethodsPerType(baseType, itemTable[baseType]) + for item in g.objectTree[baseType]: + let typ = item.value.skipTypes(skipPtrs) + let idx = typ.itemId + for mIndex in 0..<itemTable[idx].len: + if itemTable[idx][mIndex].sym == nil: + let parentIndex = typ.baseClass.skipTypes(skipPtrs).itemId + itemTable[idx][mIndex] = itemTable[parentIndex][mIndex] + g.setMethodsPerType(idx, itemTable[idx]) diff --git a/compiler/wordrecg.nim b/compiler/wordrecg.nim index 55a8921af..39e0b2e25 100644 --- a/compiler/wordrecg.nim +++ b/compiler/wordrecg.nim @@ -84,7 +84,7 @@ type wComputedGoto = "computedGoto", wExperimental = "experimental", wDoctype = "doctype", wWrite = "write", wGensym = "gensym", wInject = "inject", wDirty = "dirty", wInheritable = "inheritable", wThreadVar = "threadvar", wEmit = "emit", - wAsmNoStackFrame = "asmNoStackFrame", wImplicitStatic = "implicitStatic", + wAsmNoStackFrame = "asmNoStackFrame", wAsmSyntax = "asmSyntax", wImplicitStatic = "implicitStatic", wGlobal = "global", wCodegenDecl = "codegenDecl", wUnchecked = "unchecked", wGuard = "guard", wLocks = "locks", wPartial = "partial", wExplain = "explain", wLiftLocals = "liftlocals", wEnforceNoRaises = "enforceNoRaises", wSystemRaisesDefect = "systemRaisesDefect", |