diff --git a/changelog.md b/changelog.md index f4a9d627cf67..a137b3e42606 100644 --- a/changelog.md +++ b/changelog.md @@ -13,6 +13,9 @@ (a, b) = (1, 2, 3, 4) ``` will no longer compile. +- `internalNew` is removed from system, use `new` instead. + +- `bindMethod` in `std/jsffi` is deprecated, don't use it with closures. ## Standard library additions and changes @@ -30,6 +33,10 @@ slots when enlarging a sequence. - Added `hasDefaultValue` to `std/typetraits` to check if a type has a valid default value. - Added Viewport API for the JavaScript targets in the `dom` module. - Added `toSinglyLinkedRing` and `toDoublyLinkedRing` to `std/lists` to convert from `openArray`s. +- ORC: To be enabled via `nimOrcStats` there is a new API called `GC_orcStats` that can be used to query how many + objects the cyclic collector did free. If the number is zero that is a strong indicator that you can use `--mm:arc` + instead of `--mm:orc`. +- A `$` template is provided for `Path` in `std/paths`. [//]: # "Deprecations:" @@ -40,7 +47,7 @@ slots when enlarging a sequence. ## Language changes -- `noInit` can be used in types and fields to disable member initializers in the C++ backend. +- `noInit` can be used in types and fields to disable member initializers in the C++ backend. - C++ custom constructors initializers see https://nim-lang.org/docs/manual_experimental.htm#constructor-initializer - `member` can be used to attach a procedure to a C++ type. - C++ `constructor` now reuses `result` instead creating `this`. @@ -62,7 +69,7 @@ slots when enlarging a sequence. symbols in generic routine bodies to be replaced by symbols injected locally by templates/macros at instantiation time. `bind` may be used to keep the captured symbols over the injected ones regardless of enabling the option. - + Since this change may affect runtime behavior, the experimental switch `genericsOpenSym` needs to be enabled, and a warning is given in the case where an injected symbol would replace a captured symbol not bound by `bind` diff --git a/changelogs/changelog_2_0_0_details.md b/changelogs/changelog_2_0_0_details.md index 950fa4069565..24dc4edad067 100644 --- a/changelogs/changelog_2_0_0_details.md +++ b/changelogs/changelog_2_0_0_details.md @@ -72,7 +72,7 @@ - `shallowCopy` and `shallow` are removed for ARC/ORC. Use `move` when possible or combine assignment and `sink` for optimization purposes. -- The experimental `nimPreviewDotLikeOps` switch is going to be removed or deprecated because it didn't fullfill its promises. +- The experimental `nimPreviewDotLikeOps` switch is going to be removed or deprecated because it didn't fulfill its promises. - The `{.this.}` pragma, deprecated since 0.19, has been removed. - `nil` literals can no longer be directly assigned to variables or fields of `distinct` pointer types. They must be converted instead. diff --git a/compiler/ast.nim b/compiler/ast.nim index 732763f0fe61..4de277ba9a23 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,202 +36,7 @@ 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] @@ -553,7 +361,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.} @@ -680,7 +488,6 @@ type mUnaryPlusI, mBitnotI, mUnaryPlusF64, mUnaryMinusF64, mCharToStr, mBoolToStr, - mIntToStr, mInt64ToStr, mFloatToStr, # for compiling nimStdlibVersion < 1.5.1 (not bootstrapping) mCStrToStr, mStrToStr, mEnumToStr, mAnd, mOr, @@ -697,7 +504,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, @@ -750,7 +557,6 @@ const mUnaryMinusI, mUnaryMinusI64, mAbsI, mNot, mUnaryPlusI, mBitnotI, mUnaryPlusF64, mUnaryMinusF64, mCharToStr, mBoolToStr, - mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, mStrToStr, mEnumToStr, mAnd, mOr, @@ -780,10 +586,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 @@ -886,7 +688,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: @@ -955,11 +758,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 @@ -991,24 +795,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 @@ -1110,8 +896,6 @@ const nfAllFieldsSet* = nfBase2 - nkCallKinds* = {nkCall, nkInfix, nkPrefix, nkPostfix, - nkCommand, nkCallStrLit, nkHiddenCallConv} nkIdentKinds* = {nkIdent, nkSym, nkAccQuoted, nkOpenSymChoice, nkClosedSymChoice} @@ -1146,7 +930,7 @@ proc getPIdent*(a: PNode): PIdent {.inline.} = 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 @@ -1348,6 +1132,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: @@ -1445,11 +1256,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) @@ -1488,6 +1294,20 @@ proc newIntNode*(kind: TNodeKind, intVal: Int128): PNode = result.intVal = castToInt64(intVal) 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] @@ -1770,24 +1590,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) @@ -2308,3 +2114,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 0fd13de00cac..7a9892f78ad2 100644 --- a/compiler/astalgo.nim +++ b/compiler/astalgo.nim @@ -65,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 @@ -717,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) @@ -881,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 c990b36e88de..aeeff1fd0f15 100644 --- a/compiler/astmsgs.nim +++ b/compiler/astmsgs.nim @@ -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/ccgcalls.nim b/compiler/ccgcalls.nim index 607f6d51e64b..6b716f75951c 100644 --- a/compiler/ccgcalls.nim +++ b/compiler/ccgcalls.nim @@ -150,8 +150,14 @@ proc genBoundsCheck(p: BProc; arr, a, b: TLoc) 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: @@ -166,7 +172,10 @@ proc genOpenArraySlice(p: BProc; q: PNode; formalType, destType: PType; prepareF genBoundsCheck(p, a, b, c) if prepareForMutation: linefmt(p, cpsStmts, "#nimPrepareStrMutationV2($1);$n", [byRefLoc(p, a)]) - let ty = skipTypes(a.t, abstractVar+{tyPtr}) + # bug #23321: In the function mapType, ptrs (tyPtr, tyVar, tyLent, tyRef) + # are mapped into ctPtrToArray, the dereference of which is skipped + # in the `genref`. We need to skip these ptrs here + let ty = skipTypes(a.t, abstractVar+{tyPtr, tyRef}) let dest = getTypeDesc(p.module, destType) let lengthExpr = "($1)-($2)+1" % [rdLoc(c), rdLoc(b)] case ty.kind @@ -310,6 +319,11 @@ proc genArg(p: BProc, n: PNode, param: PSym; call: PNode; result: var Rope; need addRdLoc(a, result) else: a = initLocExprSingleUse(p, n) + if param.typ.kind in abstractPtrs: + let typ = skipTypes(param.typ, abstractPtrs) + if typ.sym != nil and sfImportc in typ.sym.flags: + a.r = "(($1) ($2))" % + [getTypeDesc(p.module, param.typ), rdCharLoc(a)] addRdLoc(withTmpIfNeeded(p, a, needsTmp), result) #assert result != nil @@ -354,7 +368,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.. ord(n.kind == nkObjConstr) and n.isDeepConstExpr: @@ -1505,8 +1501,7 @@ 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 + var tmp2 = TLoc(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") @@ -1521,7 +1516,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 @@ -1857,9 +1857,9 @@ proc genArrayLen(p: BProc, e: PNode, d: var TLoc, op: TMagic) = if optBoundsCheck in p.options: genBoundsCheck(p, m, b, c) 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)") @@ -2088,7 +2088,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]) @@ -2250,9 +2250,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) = @@ -2461,16 +2467,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: @@ -2558,7 +2562,6 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = [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: diff --git a/compiler/ccgstmts.nim b/compiler/ccgstmts.nim index 28c0851aa6b0..a55512466beb 100644 --- a/compiler/ccgstmts.nim +++ b/compiler/ccgstmts.nim @@ -289,7 +289,7 @@ 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) @@ -298,12 +298,23 @@ proc genCppParamsForCtor(p: BProc; call: PNode): string = #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: @@ -330,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) @@ -365,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) @@ -1037,8 +1059,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)) diff --git a/compiler/ccgtypes.nim b/compiler/ccgtypes.nim index 6a51fe3a04fc..75b520f3aa7c 100644 --- a/compiler/ccgtypes.nim +++ b/compiler/ccgtypes.nim @@ -55,13 +55,28 @@ 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.. -1: + isStatic = true + name = name.replace("static ", "") isFnConst = afterParams.find("const") > -1 isOverride = afterParams.find("override") > -1 isMemberVirtual = name.find("virtual ") > -1 @@ -1195,7 +1220,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() @@ -1213,8 +1238,8 @@ proc genMemberProcHeader(m: BModule; prc: PSym; result: var Rope; asPtr: bool = 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 +1248,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: @@ -1600,7 +1627,7 @@ proc generateRttiDestructor(g: ModuleGraph; typ: PType; owner: PSym; kind: TType )) ) else: - let addrOf = newNodeIT(nkAddr, info, theProc.typ.firstParamType) + let addrOf = newNodeIT(nkHiddenAddr, info, theProc.typ.firstParamType) addrOf.add newDeref(newTreeIT( nkCast, info, castType, newNodeIT(nkType, info, castType), newSymNode(dest) @@ -1834,8 +1861,7 @@ proc typeToC(t: PType): string = ## to be unique. let s = typeToString(t) result = newStringOfCap(s.len) - for i in 0.. 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 @@ -153,3 +106,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..= 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 +309,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 +320,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.} @@ -531,7 +537,7 @@ proc constructLoc(p: BProc, loc: var TLoc, isTemp = false) = 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): @@ -556,8 +562,9 @@ proc getTemp(p: BProc, t: PType, needsInit=false): TLoc = result = TLoc(r: "T" & rope(p.labels) & "_", k: locTemp, lode: lodeTyp t, storage: OnStack, flags: {}) if p.module.compileToCpp and isOrHasImportedCppType(t): + var didGenTemp = false linefmt(p, cpsLocals, "$1 $2$3;$n", [getTypeDesc(p.module, t, dkVar), result.r, - genCppInitializer(p.module, p, t)]) + genCppInitializer(p.module, p, t, didGenTemp)]) else: linefmt(p, cpsLocals, "$1 $2;$n", [getTypeDesc(p.module, t, dkVar), result.r]) constructLoc(p, result, not needsInit) @@ -574,7 +581,7 @@ proc getTempCpp(p: BProc, t: PType, value: Rope): TLoc = inc(p.labels) result = TLoc(r: "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.r, value]) proc getIntTemp(p: BProc): TLoc = inc(p.labels) @@ -614,7 +621,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) @@ -649,18 +657,7 @@ proc genGlobalVarDecl(p: BProc, n: PNode; td, value: Rope; decl: var Rope) = else: decl = runtimeFormat(s.cgDeclFrmt & ";$n", [td, s.loc.r]) -proc genCppVarForCtor(p: BProc; call: PNode; decl: var Rope) - -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 @@ -716,6 +713,18 @@ proc assignGlobalVar(p: BProc, n: PNode; value: Rope) = # 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.r + 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 != "") scopeMangledParam(p, s) @@ -1033,7 +1042,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(...) @@ -1048,7 +1057,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 @@ -1060,14 +1069,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: @@ -1076,7 +1091,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 @@ -1102,9 +1117,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: @@ -1129,9 +1144,21 @@ proc allPathsAsgnResult(n: PNode): InitResultEnum = allPathsInBranch(n[0]) for i in 1.. 0: if m.hcrOn: appcg(m, m.s[cfsTypeInit1], "\t#TNimNode* $1;$N", [m.typeNodesName]) @@ -1954,6 +1982,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 @@ -1982,9 +2044,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 @@ -2184,6 +2254,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.r = "NimDestroyGlobals" + if isDynlib: + incl(result.loc.flags, lfExportLib) + + let theProc = newNodeI(nkProcDef, m.module.info, bodyPos+1) + for i in 0.. 0: # echo "hi" # :state = 1 # Next state @@ -26,12 +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 +# else: +# return # The transformation should play well with lambdalifting, however depending # on situation, it can be called either before or after lambdalifting @@ -104,12 +107,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 +121,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 +134,8 @@ # raise # state = -1 # Goto next state. In this case we just exit # break :stateLoop +# else: +# return import ast, msgs, idents, @@ -150,7 +156,7 @@ type 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 @@ -166,6 +172,7 @@ type const nkSkip = {nkEmpty..nkNilLit, nkTemplateDef, nkTypeSection, nkStaticStmt, nkCommentStmt, nkMixinStmt, nkBindStmt} + procDefs + emptyStateLabel = -1 proc newStateAccess(ctx: var Ctx): PNode = if ctx.stateVarSym.isNil: @@ -187,6 +194,7 @@ 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 + result.flags.incl sfNoInit assert(not typ.isNil) if not ctx.stateVarSym.isNil: @@ -228,10 +236,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: @@ -263,8 +268,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).. 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,18 +446,19 @@ 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, @@ -470,7 +475,7 @@ proc passCopyToSink(n: PNode; c: var Con; s: var Scope): PNode = m.add p(n, c, s, normal) 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 +484,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 @@ -594,7 +599,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: @@ -769,6 +776,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}: @@ -859,9 +878,7 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode; tmpFlags = {sfSing 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: @@ -907,7 +924,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: @@ -1166,9 +1186,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)) diff --git a/compiler/installer.ini b/compiler/installer.ini index 8569d0ef81f5..54a35dbeeac6 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 diff --git a/compiler/jsgen.nim b/compiler/jsgen.nim index 471d51c0f987..382f12a9d51c 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, backendpragmas, + mangleutils import pipelineutils @@ -105,25 +106,17 @@ type optionsStack: seq[TOptions] 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. 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 + let ind = p.blocks.len + p.extraIndent result = repeat(' ', ind*2) & r template line(p: PProc, added: string) = @@ -175,10 +168,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} @@ -269,6 +258,10 @@ 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)) @@ -464,9 +457,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: ["", ""]] @@ -788,7 +778,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 +801,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 +821,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 +831,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 +925,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 @@ -1019,7 +1018,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 @@ -1198,8 +1197,16 @@ 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 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.r = "this" + for i in 1..= 3: # echo "BEGIN generating code for: " & prc.name.s var p = newProc(oldProc.g, oldProc.module, prc.ast, prc.options) - p.up = oldProc var returnStmt: Rope = "" var resultAsgn: Rope = "" var name = mangleName(p.module, prc) - let header = generateHeader(p, prc.typ) + 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) @@ -2921,7 +2910,15 @@ 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: + 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) @@ -2984,7 +2981,7 @@ 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 + 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) @@ -2992,11 +2989,8 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = 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 @@ -3004,7 +2998,18 @@ 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: + var a: TCompRes = default(TCompRes) + if n[0].kind == nkClosure: + gen(p, n[0][1], a) + let sym = n[0][1].typ[0].n[0].sym + r.res = "(($1).$2 < 0)" % [rdLoc(a), mangleName(p.module, sym)] + else: + gen(p, n[0], a) + let sym = n[0].typ[0].n[0].sym + r.res = "((($1.ClE_0).$2) < 0)" % [rdLoc(a), mangleName(p.module, sym)] + r.kind = resExpr of nkPragmaBlock: gen(p, n.lastSon, r) of nkComesFrom: discard "XXX to implement for better stack traces" @@ -3111,15 +3116,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/lambdalifting.nim b/compiler/lambdalifting.nim index 4db7471f14f8..faa043cb49e7 100644 --- a/compiler/lambdalifting.nim +++ b/compiler/lambdalifting.nim @@ -239,11 +239,6 @@ proc interestingIterVar(s: PSym): bool {.inline.} = template isIterator*(owner: PSym): bool = owner.kind == skIterator and owner.typ.callConv == ccClosure -proc liftingHarmful(conf: ConfigRef; owner: PSym): bool {.inline.} = - ## 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 - proc createTypeBoundOpsLL(g: ModuleGraph; refType: PType; info: TLineInfo; idgen: IdGenerator; owner: PSym) = if owner.kind != skMacro: createTypeBoundOps(g, nil, refType.elementType, info, idgen) @@ -260,12 +255,10 @@ proc genCreateEnv(env: PNode): PNode = proc liftIterSym*(g: ModuleGraph; n: PNode; idgen: IdGenerator; owner: PSym): PNode = # transforms (iter) to (let env = newClosure[iter](); (iter, env)) - if liftingHarmful(g.config, owner): return n 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: @@ -467,6 +460,7 @@ proc detectCapturedVars(n: PNode; owner: PSym; c: var DetectionPass) = #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) @@ -883,14 +877,9 @@ 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 ( - g.config.backend == backendJs and not isCompileTime) or + if body.kind == nkEmpty or (fn.skipGenericOwner.kind != skModule and force notin flags): # ignore forward declaration: @@ -950,7 +939,6 @@ proc liftForLoop*(g: ModuleGraph; body: PNode; idgen: IdGenerator; owner: PSym): break ... """ - if liftingHarmful(g.config, owner): return body if not (body.kind == nkForStmt and body[^2].kind in nkCallKinds): localError(g.config, body.info, "ignored invalid for loop") return body diff --git a/compiler/liftdestructors.nim b/compiler/liftdestructors.nim index aba1aa38c702..f62927cec771 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) @@ -222,7 +222,10 @@ proc fillBodyObj(c: var TLiftCtx; n, body, x, y: PNode; enforceDefaultOp: bool) proc fillBodyObjTImpl(c: var TLiftCtx; t: PType, body, x, y: PNode) = if t.baseClass != nil: - fillBody(c, skipTypes(t.baseClass, abstractPtrs), body, x, y) + let obj = newNodeIT(nkHiddenSubConv, c.info, t.baseClass) + obj.add newNodeI(nkEmpty, c.info) + obj.add x + fillBody(c, skipTypes(t.baseClass, abstractPtrs), body, obj, y) fillBodyObj(c, t.n, body, x, y, enforceDefaultOp = false) proc fillBodyObjT(c: var TLiftCtx; t: PType, body, x, y: PNode) = @@ -1051,7 +1054,9 @@ proc produceSymDistinctType(g: ModuleGraph; c: PContext; typ: PType; assert typ.kind == tyDistinct 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) @@ -1090,7 +1095,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) @@ -1101,7 +1106,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) @@ -1143,13 +1148,13 @@ 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) @@ -1252,7 +1257,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 dc0b6c360f58..b48252acefac 100644 --- a/compiler/lineinfos.nim +++ b/compiler/lineinfos.nim @@ -95,6 +95,7 @@ type warnGenericsIgnoredInjection = "GenericsIgnoredInjection", warnStdPrefix = "StdPrefix" warnUser = "User", + warnGlobalVarConstructorTemporary = "GlobalVarConstructorTemporary", # hints hintSuccess = "Success", hintSuccessX = "SuccessX", hintCC = "CC", @@ -200,6 +201,7 @@ const warnGenericsIgnoredInjection: "$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", diff --git a/compiler/lookups.nim b/compiler/lookups.nim index 52296644dd10..e6b4c8f9a288 100644 --- a/compiler/lookups.nim +++ b/compiler/lookups.nim @@ -137,7 +137,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 +150,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 +222,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 +240,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: @@ -272,7 +272,7 @@ proc isAmbiguous*(c: PContext, s: PIdent, filter: TSymKinds, sym: var PSym): boo 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: @@ -347,7 +347,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]] = @[] @@ -558,7 +558,7 @@ 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") = @@ -584,7 +584,11 @@ proc errorUndeclaredIdentifier*(c: PContext; info: TLineInfo; name: string, extr 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 @@ -675,7 +679,7 @@ proc qualifiedLookUp*(c: PContext, n: PNode, flags: set[TLookupFlag]): PSym = result = strTableGet(c.topLevelScope.symbols, ident) else: if c.importModuleLookup.getOrDefault(m.name.id).len > 1: - var amb: bool + var amb: bool = false result = errorUseQualifier(c, n.info, m, amb) else: result = someSym(c.graph, m, ident) diff --git a/compiler/main.nim b/compiler/main.nim index 4d472da6f9fc..0b74162a96d4 100644 --- a/compiler/main.nim +++ b/compiler/main.nim @@ -155,7 +155,7 @@ 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: @@ -222,7 +222,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: diff --git a/compiler/mangleutils.nim b/compiler/mangleutils.nim new file mode 100644 index 000000000000..2ae954518445 --- /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.. 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 89ed4967f9e7..75f3a3c70bde 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] 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 @@ -108,7 +103,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 +135,8 @@ type idgen*: IdGenerator operators*: Operators + cachedFiles*: StringTableRef + TPassContext* = object of RootObj # the pass's context idgen*: IdGenerator PPassContext* = ref TPassContext @@ -262,7 +259,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 @@ -283,7 +280,7 @@ 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 @@ -504,7 +501,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() @@ -518,6 +515,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() @@ -709,16 +707,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/modules.nim b/compiler/modules.nim index 0aa1c8930f4e..6e2af8bcc790 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 1d67811829f5..1b223417c48c 100644 --- a/compiler/msgs.nim +++ b/compiler/msgs.nim @@ -123,14 +123,14 @@ 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 = @@ -429,7 +429,8 @@ To create a stacktrace, rerun compilation with './koch temp $1 ', 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) @@ -437,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: @@ -555,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) @@ -645,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}) diff --git a/compiler/nimeval.nim b/compiler/nimeval.nim index e98de7e62b69..0833cfeb32bf 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/nir/ast2ir.nim b/compiler/nir/ast2ir.nim index 907d45013ee8..11bd711f9765 100644 --- a/compiler/nir/ast2ir.nim +++ b/compiler/nir/ast2ir.nim @@ -1819,15 +1819,8 @@ proc genMagic(c: var ProcCon; n: PNode; d: var Value; m: TMagic) = 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) @@ -1903,7 +1896,7 @@ proc genMagic(c: var ProcCon; n: PNode; d: var Value; m: TMagic) = of mDefault, mZeroDefault: genDefault c, n, d of mMove: genMove(c, n, d) - of mWasMoved, mReset: + of mWasMoved: unused(c, n, d) genWasMoved(c, n) of mDestroy: genDestroy(c, n) @@ -2423,7 +2416,7 @@ proc addCallConv(c: var ProcCon; info: PackedLineInfo; callConv: TCallingConvent of ccInline: ann InlineCall of ccNoInline: ann NoinlineCall of ccThisCall: ann ThisCall - of ccNoConvention: ann NoCall + of ccNoConvention, ccMember: ann NoCall proc genProc(cOuter: var ProcCon; prc: PSym) = if prc.magic notin generatedMagics: return diff --git a/compiler/nir/types2ir.nim b/compiler/nir/types2ir.nim index cdadc4f0d0ec..8d9583486378 100644 --- a/compiler/nir/types2ir.nim +++ b/compiler/nir/types2ir.nim @@ -150,7 +150,7 @@ proc procToIr(c: var TypesCon; g: var TypeGraph; t: PType; addEnv = false): Type of ccInline: g.addAnnotation "__inline" of ccNoInline: g.addAnnotation "__noinline" of ccThisCall: g.addAnnotation "__thiscall" - of ccNoConvention: g.addAnnotation "" + of ccNoConvention, ccMember: g.addAnnotation "" for i in 0..