diff --git a/.github/workflows/ci_docs.yml b/.github/workflows/ci_docs.yml index da71181fd3..4cf7c7a837 100644 --- a/.github/workflows/ci_docs.yml +++ b/.github/workflows/ci_docs.yml @@ -45,7 +45,7 @@ jobs: - target: windows os: windows-latest - target: osx - os: macos-13 + os: macos-15 name: ${{ matrix.target }} runs-on: ${{ matrix.os }} diff --git a/.gitignore b/.gitignore index fad7909bd8..efb7dfe61e 100644 --- a/.gitignore +++ b/.gitignore @@ -68,6 +68,7 @@ testament.db /csources /csources_v1 /csources_v2 +/csources_v3 /dist/ # /lib/fusion # fusion is now unbundled; `git status` should reveal if it's there so users can act on it diff --git a/azure-pipelines.yml b/azure-pipelines.yml index 7fa0c3911d..96e747a730 100644 --- a/azure-pipelines.yml +++ b/azure-pipelines.yml @@ -28,12 +28,12 @@ jobs: # # g++-multilib : Depends: gcc-multilib (>= 4:5.3.1-1ubuntu1) but it is not going to be installed # vmImage: 'ubuntu-18.04' # CPU: i386 - OSX_amd64: - vmImage: 'macOS-13' - CPU: amd64 - OSX_amd64_cpp: - vmImage: 'macOS-13' - CPU: amd64 + OSX_arm64: + vmImage: 'macos-15' + CPU: arm64 + OSX_arm64_cpp: + vmImage: 'macos-15' + CPU: arm64 NIM_COMPILE_TO_CPP: true Windows_amd64_batch0_3: vmImage: 'windows-2025' diff --git a/changelog.md b/changelog.md index 959f105669..08aafba6b8 100644 --- a/changelog.md +++ b/changelog.md @@ -27,6 +27,12 @@ errors. - With `-d:nimPreviewDuplicateModuleError`, importing two modules that share the same name becomes a compile-time error. This includes importing the same module more than once. Use `import foo as foo1` (or other aliases) to avoid collisions. +- Adds the switch `--mangle:nim|cpp`, which selects `nim` or `cpp` style name mangling when used with `debuginfo` on, defaults to `cpp`. + +- The second parameter of `succ`, `pred`, `inc`, and `dec` in `system` now accepts `SomeInteger` (previously `Ordinal`). + +- Bitshift operators (`shl`, `shr`, `ashr`) now apply bitmasking to the right operand in the C/C++/VM/JS backends. + ## Standard library additions and changes [//]: # "Additions:" @@ -99,7 +105,15 @@ errors. ## Compiler changes +- Fixed a bug where `sizeof(T)` inside a `typedesc` template called from a generic type's + `when` clause would error with "'sizeof' requires '.importc' types to be '.completeStruct'". + The issue was that `hasValuelessStatics` in `semtypinst.nim` didn't recognize + `tyTypeDesc(tyGenericParam)` as an unresolved generic parameter. ## Tool changes - Added `--stdinfile` flag to name of the file used when running program from stdin (defaults to `stdinfile.nim`) + +## Documentation changes + +- Added documentation for the `completeStruct` pragma in the manual. diff --git a/compiler/ast.nim b/compiler/ast.nim index 78867814d6..89f24c63ca 100644 --- a/compiler/ast.nim +++ b/compiler/ast.nim @@ -10,7 +10,7 @@ # abstract syntax tree + symbol table import - lineinfos, options, ropes, idents, int128, wordrecg + lineinfos, options, idents, int128, wordrecg import std/[tables, hashes] from std/strutils import toLowerAscii @@ -23,823 +23,417 @@ export int128 import nodekinds export nodekinds -type - TCallingConvention* = enum - ccNimCall = "nimcall" # nimcall, also the default - ccStdCall = "stdcall" # procedure is stdcall - ccCDecl = "cdecl" # cdecl - ccSafeCall = "safecall" # safecall - ccSysCall = "syscall" # system call - ccInline = "inline" # proc should be inlined - ccNoInline = "noinline" # proc should not be inlined - ccFastCall = "fastcall" # fastcall (pass parameters in registers) - ccThisCall = "thiscall" # thiscall (parameters are pushed right-to-left) - ccClosure = "closure" # proc has a closure - ccNoConvention = "noconv" # needed for generating proper C procs sometimes - ccMember = "member" # proc is a (cpp) member - - TNodeKinds* = set[TNodeKind] - -type - 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 - # for symbol file generation; such symbols should always - # be written into the ROD file - sfGlobal, # symbol is at global scope - - sfForward, # symbol is forward declared - sfWasForwarded, # symbol had a forward declaration - # (implies it's too dangerous to patch its type signature) - sfImportc, # symbol is external; imported - sfExportc, # symbol is exported (under a specified name) - sfMangleCpp, # mangle as cpp (combines with `sfExportc`) - sfVolatile, # variable is volatile - sfRegister, # variable should be placed in a register - sfPure, # object is "pure" that means it has no type-information - # enum is "pure", its values need qualified access - # variable is "pure"; it's an explicit "global" - sfNoSideEffect, # proc has no side effects - sfSideEffect, # proc may have side effects; cannot prove it has none - sfMainModule, # module is the main module - sfSystemModule, # module is the system module - sfNoReturn, # proc never returns (an exit proc) - sfAddrTaken, # the variable's address is taken (ex- or implicitly); - # *OR*: a proc is indirectly called (used as first class) - sfCompilerProc, # proc is a compiler proc, that is a C proc that is - # needed for the code generator - sfEscapes # param escapes - # currently unimplemented - sfDiscriminant, # field is a discriminant in a record/object - sfRequiresInit, # field must be initialized during construction - sfDeprecated, # symbol is deprecated - sfExplain, # provide more diagnostics when this symbol is used - sfError, # usage of symbol should trigger a compile-time error - sfShadowed, # a symbol that was shadowed in some inner scope - sfThread, # proc will run as a thread - # variable is a thread variable - sfCppNonPod, # tells compiler to treat such types as non-pod's, so that - # `thread_local` is used instead of `__thread` for - # {.threadvar.} + `--threads`. Only makes sense for importcpp types. - # This has a performance impact so isn't set by default. - sfCompileTime, # proc can be evaluated at compile time - sfConstructor, # proc is a C++ constructor - sfDispatcher, # copied method symbol is the dispatcher - # deprecated and unused, except for the con - sfBorrow, # proc is borrowed - sfInfixCall, # symbol needs infix call syntax in target language; - # for interfacing with C++, JS - 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 - 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 - # implementation. - sfGenSym # symbol is 'gensym'ed; do not add to symbol table - sfNonReloadable # symbol will be left as-is when hot code reloading is on - - # meaning that it won't be renamed and/or changed in any way - sfGeneratedOp # proc is a generated '='; do not inject destructors in it - # variable is generated closure environment; requires early - # destruction for --newruntime. - sfTemplateParam # symbol is a template parameter - sfCursor # variable/field is a cursor, see RFC 177 for details - sfInjectDestructors # whether the proc needs the 'injectdestructors' transformation - sfNeverRaises # proc can never raise an exception, not even OverflowDefect - # or out-of-memory - sfSystemRaisesDefect # proc in the system can raise defects - sfUsedInFinallyOrExcept # symbol is used inside an 'except' or 'finally' - sfSingleUsedTemp # For temporaries that we know will only be used once - sfNoalias # 'noalias' annotation, means C's 'restrict' - # for templates and macros, means cannot be called - # as a lone symbol (cannot use alias syntax) - sfEffectsDelayed # an 'effectsDelayed' parameter - sfGeneratedType # A anonymous generic type that is generated by the compiler for - # objects that do not have generic parameters in case one of the - # object fields has one. - # - # This is disallowed but can cause the typechecking to go into - # an infinite loop, this flag is used as a sentinel to stop it. - sfVirtual # proc is a C++ virtual function - 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 - - sfNoForward* = sfRegister - # forward declarations are not required (per module) - sfReorder* = sfForward - # reordering pass is enabled - - sfCompileToCpp* = sfInfixCall # compile the module as C++ code - sfCompileToObjc* = sfNamedParamCall # compile the module as Objective-C code - sfExperimental* = sfOverridden # module uses the .experimental switch - sfWrittenTo* = sfBorrow # param is assigned to - # currently unimplemented - sfCppMember* = { sfVirtual, sfMember, sfConstructor } # proc is a C++ member, meaning it will be attached to the type definition - -const - # getting ready for the future expr/stmt merge - nkWhen* = nkWhenStmt - nkWhenExpr* = nkWhenStmt - nkEffectList* = nkArgList - # hacks ahead: an nkEffectList is a node with 4 children: - exceptionEffects* = 0 # exceptions at position 0 - requiresEffects* = 1 # 'requires' annotation - ensuresEffects* = 2 # 'ensures' annotation - tagEffects* = 3 # user defined tag ('gc', 'time' etc.) - pragmasEffects* = 4 # not an effect, but a slot for pragmas in proc type - forbiddenEffects* = 5 # list of illegal effects - effectListLen* = 6 # list of effects list - nkLastBlockStmts* = {nkRaiseStmt, nkReturnStmt, nkBreakStmt, nkContinueStmt} - # these must be last statements in a block - -type - TTypeKind* = enum # order is important! - # Don't forget to change hti.nim if you make a change here - # XXX put this into an include file to avoid this issue! - # several types are no longer used (guess which), but a - # spot in the sequence is kept for backwards compatibility - # (apparently something with bootstrapping) - # if you need to add a type, they can apparently be reused - tyNone, tyBool, tyChar, - tyEmpty, tyAlias, tyNil, tyUntyped, tyTyped, tyTypeDesc, - tyGenericInvocation, # ``T[a, b]`` for types to invoke - tyGenericBody, # ``T[a, b, body]`` last parameter is the body - tyGenericInst, # ``T[a, b, realInstance]`` instantiated generic type - # realInstance will be a concrete type like tyObject - # unless this is an instance of a generic alias type. - # then realInstance will be the tyGenericInst of the - # completely (recursively) resolved alias. - - tyGenericParam, # ``a`` in the above patterns - tyDistinct, - tyEnum, - tyOrdinal, # integer types (including enums and boolean) - tyArray, - tyObject, - tyTuple, - tySet, - tyRange, - tyPtr, tyRef, - tyVar, - tySequence, - tyProc, - tyPointer, tyOpenArray, - tyString, tyCstring, tyForward, - tyInt, tyInt8, tyInt16, tyInt32, tyInt64, # signed integers - tyFloat, tyFloat32, tyFloat64, tyFloat128, - tyUInt, tyUInt8, tyUInt16, tyUInt32, tyUInt64, - tyOwned, tySink, tyLent, - tyVarargs, - tyUncheckedArray - # An array with boundaries [0,+∞] - - 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 - - tyUserTypeClass - # the body of a user-defined type class - - tyUserTypeClassInst - # Instance of a parametric user-defined type class. - # Structured similarly to tyGenericInst. - # tyGenericInst represents concrete types, while - # this is still a "generic param" that will bind types - # and resolves them during sigmatch and instantiation. - - tyCompositeTypeClass - # Type such as seq[Number] - # The notes for tyUserTypeClassInst apply here as well - # sons[0]: the original expression used by the user. - # sons[1]: fully expanded and instantiated meta type - # (potentially following aliases) - - 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 `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. last will - # be updated to store a type best conforming to all candidates) - - tyAnd, tyOr, tyNot - # boolean type classes such as `string|int`,`not seq`, - # `Sortable and Enumable`, etc - - tyAnything - # a type class matching any type - - tyStatic - # a value known at compile type (the underlying type is .base) - - tyFromExpr - # This is a type representing an expression that depends - # on generic parameters (the expression is stored in t.n) - # It will be converted to a real type only during generic - # instantiation and prior to this it has the potential to - # be any type. - - tyConcept - # new style concept. - - tyVoid - # now different from tyEmpty, hurray! - tyIterable - -static: - # remind us when TTypeKind stops to fit in a single 64-bit word - # assert TTypeKind.high.ord <= 63 - discard - -const - tyPureObject* = tyTuple - GcTypeKinds* = {tyRef, tySequence, tyString} - - tyTypeClasses* = {tyBuiltInTypeClass, tyCompositeTypeClass, - tyUserTypeClass, tyUserTypeClassInst, tyConcept, - tyAnd, tyOr, tyNot, tyAnything} - - tyMetaTypes* = {tyGenericParam, tyTypeDesc, tyUntyped} + tyTypeClasses - tyUserTypeClasses* = {tyUserTypeClass, tyUserTypeClassInst} - # consider renaming as `tyAbstractVarRange` - abstractVarRange* = {tyGenericInst, tyRange, tyVar, tyDistinct, tyOrdinal, - tyTypeDesc, tyAlias, tyInferred, tySink, tyOwned} - abstractInst* = {tyGenericInst, tyDistinct, tyOrdinal, tyTypeDesc, tyAlias, - tyInferred, tySink, tyOwned} # xxx what about tyStatic? - -type - TTypeKinds* = set[TTypeKind] - - TNodeFlag* = enum - nfNone, - nfBase2, # nfBase10 is default, so not needed - nfBase8, - nfBase16, - nfAllConst, # used to mark complex expressions constant; easy to get rid of - # but unfortunately it has measurable impact for compilation - # efficiency - nfTransf, # node has been transformed - nfNoRewrite # node should not be transformed anymore - nfSem # node has been checked for semantics - nfLL # node has gone through lambda lifting - nfDotField # the call can use a dot operator - nfDotSetter # the call can use a setter dot operarator - nfExplicitCall # x.y() was used instead of x.y - nfExprCall # this is an attempt to call a regular expression - nfIsRef # this node is a 'ref' node; used for the VM - nfIsPtr # this node is a 'ptr' node; used for the VM - nfPreventCg # this node should be ignored by the codegen - nfBlockArg # this a stmtlist appearing in a call (e.g. a do block) - nfFromTemplate # a top-level node returned from a template - nfDefaultParam # an automatically inserter default parameter - nfDefaultRefsParam # a default param value references another parameter - # the flag is applied to proc default values and to calls - nfExecuteOnReload # A top-level statement that will be executed during reloads - nfLastRead # this node is a last read - 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) - tfVarargs, # procedure has C styled varargs - # tyArray type represeting a varargs list - tfNoSideEffect, # procedure type does not allow side effects - tfFinal, # is the object final? - tfInheritable, # is the object inheritable? - tfHasOwned, # type contains an 'owned' type and must be moved - tfEnumHasHoles, # enum cannot be mapped into a range - tfShallow, # type can be shallow copied on assignment - tfThread, # proc type is marked as ``thread``; alias for ``gcsafe`` - tfFromGeneric, # type is an instantiation of a generic; this is needed - # because for instantiations of objects, structural - # type equality has to be used - tfUnresolved, # marks unresolved typedesc/static params: e.g. - # proc foo(T: typedesc, list: seq[T]): var T - # proc foo(L: static[int]): array[L, int] - # can be attached to ranges to indicate that the range - # can be attached to generic procs with free standing - # type parameters: e.g. proc foo[T]() - # depends on unresolved static params. - tfResolved # marks a user type class, after it has been bound to a - # concrete type (lastSon becomes the concrete type) - tfRetType, # marks return types in proc (used to detect type classes - # used as return types for return type inference) - tfCapturesEnv, # whether proc really captures some environment - tfByCopy, # pass object/tuple by copy (C backend) - tfByRef, # pass object/tuple by reference (C backend) - tfIterator, # type is really an iterator, not a tyProc - tfPartial, # type is declared as 'partial' - tfNotNil, # type cannot be 'nil' - 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.} - # all fields must be initialized - tfVarIsPtr, # 'var' type is translated like 'ptr' even in C++ mode - tfHasMeta, # type contains "wildcard" sub-types such as generic params - # or other type classes - tfHasGCedMem, # type contains GC'ed memory - tfPacked - tfHasStatic - tfGenericTypeParam - tfImplicitTypeParam - tfInferrableStatic - tfConceptMatchedTypeSym - tfExplicit # for typedescs, marks types explicitly prefixed with the - # `type` operator (e.g. type int) - tfWildcard # consider a proc like foo[T, I](x: Type[T, I]) - # T and I here can bind to both typedesc and static types - # before this is determined, we'll consider them to be a - # wildcard type. - tfHasAsgn # type has overloaded assignment operator - tfBorrowDot # distinct type borrows '.' - tfTriggersCompileTime # uses the NimNode type which make the proc - # implicitly '.compiletime' - tfRefsAnonObj # used for 'ref object' and 'ptr object' - tfCovariant # covariant generic param mimicking a ptr type - tfWeakCovariant # covariant generic param mimicking a seq/array type - tfContravariant # contravariant generic param - tfCheckedForDestructor # type was checked for having a destructor. - # If it has one, t.destructor is not nil. - tfAcyclic # object type was annotated as .acyclic - tfIncompleteStruct # treat this type as if it had sizeof(pointer) - tfCompleteStruct - # (for importc types); type is fully specified, allowing to compute - # sizeof, alignof, offsetof at CT - tfExplicitCallConv - tfIsConstructor - tfEffectSystemWorkaround - tfIsOutParam - tfSendable - tfImplicitStatic - - TTypeFlags* = set[TTypeFlag] - - TSymKind* = enum # the different symbols (start with the prefix sk); - # order is important for the documentation generator! - skUnknown, # unknown symbol: used for parsing assembler blocks - # and first phase symbol lookup in generics - skConditional, # symbol for the preprocessor (may become obsolete) - skDynLib, # symbol represents a dynamic library; this is used - # internally; it does not exist in Nim code - skParam, # a parameter - skGenericParam, # a generic parameter; eq in ``proc x[eq=`==`]()`` - skTemp, # a temporary variable (introduced by compiler) - skModule, # module identifier - skType, # a type - skVar, # a variable - skLet, # a 'let' symbol - skConst, # a constant - skResult, # special 'result' variable - skProc, # a proc - skFunc, # a func - skMethod, # a method - skIterator, # an iterator - skConverter, # a type converter - skMacro, # a macro - skTemplate, # a template; currently also misused for user-defined - # pragmas - skField, # a field in a record or object - skEnumField, # an identifier in an enum - skForVar, # a for loop variable - skLabel, # a label (for block statement) - skStub, # symbol is a stub and not yet loaded from the ROD - # file (it is loaded on demand, which may - # mean: never) - skPackage, # symbol is a package (used for canonicalization) - TSymKinds* = set[TSymKind] - -const - routineKinds* = {skProc, skFunc, skMethod, skIterator, - skConverter, skMacro, skTemplate} - ExportableSymKinds* = {skVar, skLet, skConst, skType, skEnumField, skStub} + routineKinds - - tfUnion* = tfNoSideEffect - tfGcSafe* = tfThread - tfObjHasKids* = tfEnumHasHoles - tfReturnsNew* = tfInheritable - tfNonConstExpr* = tfExplicitCallConv - ## tyFromExpr where the expression shouldn't be evaluated as a static value - tfGenericHasDestructor* = tfExplicitCallConv - ## tyGenericBody where an instance has a generated destructor - skError* = skUnknown - -var - eqTypeFlags* = {tfIterator, tfNotNil, tfVarIsPtr, tfGcSafe, tfNoSideEffect, tfIsOutParam} - ## type flags that are essential for type equality. - ## This is now a variable because for emulation of version:1.0 we - ## might exclude {tfGcSafe, tfNoSideEffect}. - -type - TMagic* = enum # symbols that require compiler magic: - mNone, - mDefined, mDeclared, mDeclaredInScope, mCompiles, mArrGet, mArrPut, mAsgn, - mLow, mHigh, mSizeOf, mAlignOf, mOffsetOf, mTypeTrait, - mIs, mOf, mAddr, mType, mTypeOf, - mPlugin, mEcho, mShallowCopy, mSlurp, mStaticExec, mStatic, - mParseExprToAst, mParseStmtToAst, mExpandToAst, mQuoteAst, - mInc, mDec, mOrd, - mNew, mNewFinalize, mNewSeq, mNewSeqOfCap, - mLengthOpenArray, mLengthStr, mLengthArray, mLengthSeq, - mIncl, mExcl, mCard, mChr, - mGCref, mGCunref, - mAddI, mSubI, mMulI, mDivI, mModI, - mSucc, mPred, - mAddF64, mSubF64, mMulF64, mDivF64, - mShrI, mShlI, mAshrI, mBitandI, mBitorI, mBitxorI, - mMinI, mMaxI, - mAddU, mSubU, mMulU, mDivU, mModU, - mEqI, mLeI, mLtI, - mEqF64, mLeF64, mLtF64, - mLeU, mLtU, - mEqEnum, mLeEnum, mLtEnum, - mEqCh, mLeCh, mLtCh, - mEqB, mLeB, mLtB, - mEqRef, mLePtr, mLtPtr, - mXor, mEqCString, mEqProc, - mUnaryMinusI, mUnaryMinusI64, mAbsI, mNot, - mUnaryPlusI, mBitnotI, - mUnaryPlusF64, mUnaryMinusF64, - mCharToStr, mBoolToStr, - mCStrToStr, - mStrToStr, mEnumToStr, - mAnd, mOr, - mImplies, mIff, mExists, mForall, mOld, - mEqStr, mLeStr, mLtStr, - mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, mXorSet, - mConStrStr, mSlice, - mDotDot, # this one is only necessary to give nice compile time warnings - mFields, mFieldPairs, mOmpParFor, - mAppendStrCh, mAppendStrStr, mAppendSeqElem, - mInSet, mRepr, mExit, - mSetLengthStr, mSetLengthSeq, - mSetLengthSeqUninit, - mIsPartOf, mAstToStr, mParallel, - mSwap, mIsNil, mArrToSeq, mOpenArrayToSeq, - mNewString, mNewStringOfCap, mParseBiggestFloat, - mMove, mEnsureMove, mWasMoved, mDup, mDestroy, mTrace, - mDefault, mUnown, mFinished, mIsolate, mAccessEnv, mAccessTypeField, - mArray, mOpenArray, mRange, mSet, mSeq, mVarargs, - mRef, mPtr, mVar, mDistinct, mVoid, mTuple, - mOrdinal, mIterableType, - mInt, mInt8, mInt16, mInt32, mInt64, - mUInt, mUInt8, mUInt16, mUInt32, mUInt64, - mFloat, mFloat32, mFloat64, mFloat128, - mBool, mChar, mString, mCstring, - mPointer, mNil, mExpr, mStmt, mTypeDesc, - mVoidType, mPNimrodNode, mSpawn, mDeepCopy, - mIsMainModule, mCompileDate, mCompileTime, mProcCall, - mCpuEndian, mHostOS, mHostCPU, mBuildOS, mBuildCPU, mAppType, - mCompileOption, mCompileOptionArg, - mNLen, mNChild, mNSetChild, mNAdd, mNAddMultiple, mNDel, - mNKind, mNSymKind, - - mNccValue, mNccInc, mNcsAdd, mNcsIncl, mNcsLen, mNcsAt, - mNctPut, mNctLen, mNctGet, mNctHasNext, mNctNext, - - mNIntVal, mNFloatVal, mNGetType, mNStrVal, mNSetIntVal, - mNSetFloatVal, mNSetStrVal, mNLineInfo, - mNNewNimNode, mNCopyNimNode, mNCopyNimTree, mStrToIdent, mNSigHash, mNSizeOf, - mNBindSym, mNCallSite, - mEqIdent, mEqNimrodNode, mSameNodeType, mGetImpl, mNGenSym, - mNHint, mNWarning, mNError, - mInstantiationInfo, mGetTypeInfo, mGetTypeInfoV2, - mNimvm, mIntDefine, mStrDefine, mBoolDefine, mGenericDefine, mRunnableExamples, - mException, mBuiltinType, mSymOwner, mUncheckedArray, mGetImplTransf, - mSymIsInstantiationOf, mNodeId, mPrivateAccess, mZeroDefault - - -const - # things that we can evaluate safely at compile time, even if not asked for it: - ctfeWhitelist* = {mNone, mSucc, - mPred, mInc, mDec, mOrd, mLengthOpenArray, - mLengthStr, mLengthArray, mLengthSeq, - mArrGet, mArrPut, mAsgn, mDestroy, - mIncl, mExcl, mCard, mChr, - mAddI, mSubI, mMulI, mDivI, mModI, - mAddF64, mSubF64, mMulF64, mDivF64, - mShrI, mShlI, mBitandI, mBitorI, mBitxorI, - mMinI, mMaxI, - mAddU, mSubU, mMulU, mDivU, mModU, - mEqI, mLeI, mLtI, - mEqF64, mLeF64, mLtF64, - mLeU, mLtU, - mEqEnum, mLeEnum, mLtEnum, - mEqCh, mLeCh, mLtCh, - mEqB, mLeB, mLtB, - mEqRef, mEqProc, mLePtr, mLtPtr, mEqCString, mXor, - mUnaryMinusI, mUnaryMinusI64, mAbsI, mNot, mUnaryPlusI, mBitnotI, - mUnaryPlusF64, mUnaryMinusF64, - mCharToStr, mBoolToStr, - mCStrToStr, - mStrToStr, mEnumToStr, - mAnd, mOr, - mEqStr, mLeStr, mLtStr, - mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, mXorSet, - mConStrStr, mAppendStrCh, mAppendStrStr, mAppendSeqElem, - mInSet, mRepr, mOpenArrayToSeq} - - generatedMagics* = {mNone, mIsolate, mFinished, mOpenArrayToSeq} - ## magics that are generated as normal procs in the backend - -type - ItemId* = object - module*: int32 - item*: int32 - -proc `$`*(x: ItemId): string = - "(module: " & $x.module & ", item: " & $x.item & ")" - -proc `==`*(a, b: ItemId): bool {.inline.} = - a.item == b.item and a.module == b.module - -proc hash*(x: ItemId): Hash = - var h: Hash = hash(x.module) - h = h !& hash(x.item) - result = !$h - - -type - PNode* = ref TNode - TNodeSeq* = seq[PNode] - PType* = ref TType - PSym* = ref TSym - TNode*{.final, acyclic.} = object # on a 32bit machine, this takes 32 bytes - when defined(useNodeIds): - id*: int - typField: PType - info*: TLineInfo - flags*: TNodeFlags - case kind*: TNodeKind - of nkCharLit..nkUInt64Lit: - intVal*: BiggestInt - of nkFloatLit..nkFloat128Lit: - floatVal*: BiggestFloat - of nkStrLit..nkTripleStrLit: - strVal*: string - of nkSym: - sym*: PSym - of nkIdent: - ident*: PIdent - else: - sons*: TNodeSeq - when defined(nimsuggest): - endInfo*: TLineInfo - - TStrTable* = object # a table[PIdent] of PSym - counter*: int - data*: seq[PSym] - - # -------------- backend information ------------------------------- - TLocKind* = enum - locNone, # no location - locTemp, # temporary location - locLocalVar, # location is a local variable - locGlobalVar, # location is a global variable - locParam, # location is a parameter - locField, # location is a record field - locExpr, # "location" is really an expression - locProc, # location is a proc (an address of a procedure) - locData, # location is a constant - locCall, # location is a call expression - locOther # location is something other - TLocFlag* = enum - lfIndirect, # backend introduced a pointer - lfNoDeepCopy, # no need for a deep copy - lfNoDecl, # do not declare it in C - lfDynamicLib, # link symbol to dynamic library - lfExportLib, # export symbol for dynamic library generation - lfHeader, # include header file for symbol - lfImportCompilerProc, # ``importc`` of a compilerproc - lfSingleUse # no location yet and will only be used once - lfEnforceDeref # a copyMem is required to dereference if this a - # ptr array due to C array limitations. - # See #1181, #6422, #11171 - lfPrepareForMutation # string location is about to be mutated (V2) - TStorageLoc* = enum - OnUnknown, # location is unknown (stack, heap or static) - OnStatic, # in a static section - OnStack, # location is on hardware stack - OnHeap # location is on heap or global - # (reference counting needed) - TLocFlags* = set[TLocFlag] - TLoc* = object - k*: TLocKind # kind of location - storage*: TStorageLoc - flags*: TLocFlags # location's flags - lode*: PNode # Node where the location came from; can be faked - snippet*: Rope # C code snippet of location (code generators) - - # ---------------- end of backend information ------------------------------ - - TLibKind* = enum - libHeader, libDynamic - - TLib* = object # also misused for headers! - # keep in sync with PackedLib - kind*: TLibKind - generated*: bool # needed for the backends: - isOverridden*: bool - name*: Rope - path*: PNode # can be a string literal! - - - CompilesId* = int ## id that is used for the caching logic within - ## ``system.compiles``. See the seminst module. - TInstantiation* = object - sym*: PSym - concreteTypes*: seq[PType] - genericParamsCount*: int # for terrible reasons `concreteTypes` contains all the types, - # so we need to know how many generic params there were - # this is not serialized for IC and that is fine. - compilesId*: CompilesId - - PInstantiation* = ref TInstantiation - - TScope* {.acyclic.} = object - depthLevel*: int - symbols*: TStrTable - parent*: PScope - allowPrivateAccess*: seq[PSym] # # enable access to private fields - optionStackLen*: int - - PScope* = ref TScope - - PLib* = ref TLib - 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: - #procInstCache*: seq[PInstantiation] - gcUnsafetyReason*: PSym # for better error messages regarding gcsafe - transformedBody*: PNode # cached body after transf pass - of skLet, skVar, skField, skForVar: - guard*: PSym - bitsize*: int - alignment*: int # for alignment - else: nil - magic*: TMagic - typ*: PType - name*: PIdent - info*: TLineInfo - when defined(nimsuggest): - endInfo*: TLineInfo - hasUserSpecifiedType*: bool # used for determining whether to display inlay type hints - ownerField: PSym - flags*: TSymFlags - ast*: PNode # syntax tree of proc, iterator, etc.: - # the whole proc including header; this is used - # for easy generation of proper error messages - # for variant record fields the discriminant - # expression - # for modules, it's a placeholder for compiler - # generated code that will be appended to the - # module after the sem pass (see appendToModule) - options*: TOptions - position*: int # used for many different things: - # for enum fields its position; - # for fields its offset - # for parameters its position (starting with 0) - # for a conditional: - # 1 iff the symbol is defined, else 0 - # (or not in symbol table) - # for modules, an unique index corresponding - # to the module's fileIdx - # for variables a slot index for the evaluator - offset*: int32 # offset of record field - disamb*: int32 # disambiguation number; the basic idea is that - # `___` is unique - loc*: TLoc - annex*: PLib # additional fields (seldom used, so we use a - # reference to another object to save space) - when hasFFI: - cname*: string # resolved C declaration name in importc decl, e.g.: - # proc fun() {.importc: "$1aux".} => cname = funaux - constraint*: PNode # additional constraints like 'lit|result'; also - # misused for the codegenDecl and virtual pragmas in the hope - # it won't cause problems - # for skModule the string literal to output for - # deprecated modules. - instantiatedFrom*: PSym # for instances, the generic symbol where it came from. - when defined(nimsuggest): - allUsages*: seq[TLineInfo] - - TTypeSeq* = seq[PType] - - TTypeAttachedOp* = enum ## as usual, order is important here - attachedWasMoved, - attachedDestructor, - attachedAsgn, - attachedDup, - attachedSink, - attachedTrace, - attachedDeepCopy - - 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 - sons: TTypeSeq # base types, etc. - n*: PNode # node for types: - # for range types a nkRange node - # for record types a nkRecord node - # for enum types a list of symbols - # if kind == tyInt: it is an 'int literal(x)' type - # for procs and tyGenericBody, it's the - # formal param list - # for concepts, the concept body - # else: unused - ownerField: PSym # the 'owner' of the type - sym*: PSym # types have the sym associated with them - # it is used for converting types to strings - size*: BiggestInt # the size of the type in bytes - # -1 means that the size is unkwown - align*: int16 # the type's alignment requirements - paddingAtEnd*: int16 # - loc*: TLoc - typeInst*: PType # for generic instantiations the tyGenericInst that led to this - # type. - uniqueId*: ItemId # due to a design mistake, we need to keep the real ID here as it - # is required by the --incremental:on mode. - - TPair* = object - key*, val*: RootRef - - TPairSeq* = seq[TPair] - - TIdPair*[T] = object - key*: ItemId - val*: T - - TIdPairSeq*[T] = seq[TIdPair[T]] - TIdTable*[T] = object - counter*: int - data*: TIdPairSeq[T] - - TNodePair* = object - h*: Hash # because it is expensive to compute! - key*: PNode - val*: int - - TNodePairSeq* = seq[TNodePair] - TNodeTable* = object # the same as table[PNode] of int; - # nodes are compared by structure! - counter*: int - data*: TNodePairSeq - ignoreTypes*: bool - - TObjectSeq* = seq[RootRef] - TObjectSet* = object - counter*: int - data*: TObjectSeq - - TImplication* = enum - impUnknown, impNo, impYes +import astdef +export astdef + +when not defined(nimKochBootstrap): + import ast2nif + +when not defined(nimKochBootstrap): + var program* {.threadvar.}: DecodeContext + +proc setupProgram*(config: ConfigRef; cache: IdentCache) = + when not defined(nimKochBootstrap): + program = createDecodeContext(config, cache) + +template loadSym(s: PSym) = + ## Loads a symbol from NIF file if it's in Partial state. + when not defined(nimKochBootstrap): + ast2nif.loadSym(program, s) + +template loadType(t: PType) = + ## Loads a type from NIF file if it's in Partial state. + when not defined(nimKochBootstrap): + ast2nif.loadType(program, t) + +proc loadSymCallback*(s: PSym) {.nimcall.} = + loadSym(s) + +proc loadTypeCallback*(t: PType) {.nimcall.} = + loadType(t) + +proc ensureMutable*(s: PSym) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + +proc ensureMutable*(t: PType) {.inline.} = + assert t.state != Sealed + if t.state == Partial: loadType(t) + +proc backendEnsureMutable*(s: PSym) {.inline.} = + #assert s.state != Sealed + # ^ IC review this later + if s.state == Partial: loadSym(s) + +proc backendEnsureMutable*(t: PType) {.inline.} = + #assert t.state != Sealed + # ^ IC review this later + if t.state == Partial: loadType(t) + +proc owner*(s: PSym): PSym {.inline.} = + if s.state == Partial: loadSym(s) + result = s.ownerFieldImpl + +proc owner*(s: PType): PSym {.inline.} = + if s.state == Partial: loadType(s) + result = s.ownerFieldImpl + +proc setOwner*(s: PSym; owner: PSym) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.ownerFieldImpl = owner + +proc setOwner*(s: PType; owner: PSym) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadType(s) + s.ownerFieldImpl = owner + +proc kind*(s: PSym): TSymKind {.inline.} = + if s.state == Partial: loadSym(s) + result = s.kindImpl + +proc `kind=`*(s: PSym, val: TSymKind) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.kindImpl = val + +proc gcUnsafetyReason*(s: PSym): PSym {.inline.} = + if s.state == Partial: loadSym(s) + result = s.gcUnsafetyReasonImpl + +proc `gcUnsafetyReason=`*(s: PSym, val: PSym) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.gcUnsafetyReasonImpl = val + +proc transformedBody*(s: PSym): PNode {.inline.} = + if s.state == Partial: loadSym(s) + result = s.transformedBodyImpl + +proc `transformedBody=`*(s: PSym, val: PNode) {.inline.} = + #assert s.state != Sealed + # Make an exception here for this misfeature... + if s.state == Partial: loadSym(s) + s.transformedBodyImpl = val + +proc guard*(s: PSym): PSym {.inline.} = + if s.state == Partial: loadSym(s) + result = s.guardImpl + +proc `guard=`*(s: PSym, val: PSym) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.guardImpl = val + +proc bitsize*(s: PSym): int {.inline.} = + if s.state == Partial: loadSym(s) + result = s.bitsizeImpl + +proc `bitsize=`*(s: PSym, val: int) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.bitsizeImpl = val + +proc alignment*(s: PSym): int {.inline.} = + if s.state == Partial: loadSym(s) + result = s.alignmentImpl + +proc `alignment=`*(s: PSym, val: int) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.alignmentImpl = val + +proc magic*(s: PSym): TMagic {.inline.} = + if s.state == Partial: loadSym(s) + result = s.magicImpl + +proc `magic=`*(s: PSym, val: TMagic) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.magicImpl = val + +proc typ*(s: PSym): PType {.inline.} = + if s.state == Partial: loadSym(s) + result = s.typImpl + +proc `typ=`*(s: PSym, val: PType) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.typImpl = val + +proc info*(s: PSym): TLineInfo {.inline.} = + if s.state == Partial: loadSym(s) + result = s.infoImpl + +proc `info=`*(s: PSym, val: TLineInfo) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.infoImpl = val + +when defined(nimsuggest): + proc endInfo*(s: PSym): TLineInfo {.inline.} = + if s.state == Partial: loadSym(s) + result = s.endInfoImpl + + proc `endInfo=`*(s: PSym, val: TLineInfo) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.endInfoImpl = val + + proc hasUserSpecifiedType*(s: PSym): bool {.inline.} = + if s.state == Partial: loadSym(s) + result = s.hasUserSpecifiedTypeImpl + + proc `hasUserSpecifiedType=`*(s: PSym, val: bool) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.hasUserSpecifiedTypeImpl = val + +proc flags*(s: PSym): TSymFlags {.inline.} = + if s.state == Partial: loadSym(s) + result = s.flagsImpl + +proc `flags=`*(s: PSym, val: TSymFlags) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.flagsImpl = val + +proc ast*(s: PSym): PNode {.inline.} = + if s.state == Partial: loadSym(s) + result = s.astImpl + +proc `ast=`*(s: PSym, val: PNode) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.astImpl = val + +proc options*(s: PSym): TOptions {.inline.} = + if s.state == Partial: loadSym(s) + result = s.optionsImpl + +proc `options=`*(s: PSym, val: TOptions) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.optionsImpl = val + +proc position*(s: PSym): int {.inline.} = + if s.state == Partial: loadSym(s) + result = s.positionImpl + +proc `position=`*(s: PSym, val: int) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.positionImpl = val + +proc offset*(s: PSym): int32 {.inline.} = + if s.state == Partial: loadSym(s) + result = s.offsetImpl + +proc `offset=`*(s: PSym, val: int32) {.inline.} = + #assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.offsetImpl = val + +proc loc*(s: PSym): TLoc {.inline.} = + if s.state == Partial: loadSym(s) + result = s.locImpl + +proc `loc=`*(s: PSym, val: TLoc) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.locImpl = val + +proc annex*(s: PSym): PLib {.inline.} = + if s.state == Partial: loadSym(s) + result = s.annexImpl + +proc `annex=`*(s: PSym, val: PLib) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.annexImpl = val + +when hasFFI: + proc cname*(s: PSym): string {.inline.} = + if s.state == Partial: loadSym(s) + result = s.cnameImpl + + proc `cname=`*(s: PSym, val: string) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.cnameImpl = val + +proc constraint*(s: PSym): PNode {.inline.} = + if s.state == Partial: loadSym(s) + result = s.constraintImpl + +proc `constraint=`*(s: PSym, val: PNode) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.constraintImpl = val + +proc instantiatedFrom*(s: PSym): PSym {.inline.} = + if s.state == Partial: loadSym(s) + result = s.instantiatedFromImpl + +proc `instantiatedFrom=`*(s: PSym, val: PSym) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.instantiatedFromImpl = val + +proc setSnippet*(s: PSym; val: sink string) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.locImpl.snippet = val + +proc incl*(s: PSym; flag: TSymFlag) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.flagsImpl.incl(flag) + +proc incl*(s: PSym; flags: set[TSymFlag]) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.flagsImpl.incl(flags) + +proc incl*(s: PSym; flag: TLocFlag) {.inline.} = + #assert s.state != Sealed + # locImpl is a backend field so do not protect it against mutations + if s.state == Partial: loadSym(s) + s.locImpl.flags.incl(flag) + +proc excl*(s: PSym; flag: TSymFlag) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.flagsImpl.excl(flag) + +when defined(nimsuggest): + proc allUsages*(s: PSym): var seq[TLineInfo] {.inline.} = + if s.state == Partial: loadSym(s) + result = s.allUsagesImpl + + proc `allUsages=`*(s: PSym, val: sink seq[TLineInfo]) {.inline.} = + assert s.state != Sealed + if s.state == Partial: loadSym(s) + s.allUsagesImpl = val + +# Accessor procs for TType fields +proc callConv*(t: PType): TCallingConvention {.inline.} = + if t.state == Partial: loadType(t) + result = t.callConvImpl + +proc `callConv=`*(t: PType, val: TCallingConvention) {.inline.} = + assert t.state != Sealed + if t.state == Partial: loadType(t) + t.callConvImpl = val + +proc flags*(t: PType): TTypeFlags {.inline.} = + if t.state == Partial: loadType(t) + result = t.flagsImpl + +proc `flags=`*(t: PType, val: TTypeFlags) {.inline.} = + assert t.state != Sealed + if t.state == Partial: loadType(t) + t.flagsImpl = val + +proc sons*(t: PType): var TTypeSeq {.inline.} = + if t.state == Partial: loadType(t) + result = t.sonsImpl + +proc `sons=`*(t: PType, val: sink TTypeSeq) {.inline.} = + assert t.state != Sealed + if t.state == Partial: loadType(t) + t.sonsImpl = val + +proc n*(t: PType): PNode {.inline.} = + if t.state == Partial: loadType(t) + result = t.nImpl + +proc `n=`*(t: PType, val: PNode) {.inline.} = + assert t.state != Sealed + if t.state == Partial: loadType(t) + t.nImpl = val + +proc sym*(t: PType): PSym {.inline.} = + if t.state == Partial: loadType(t) + result = t.symImpl + +proc `sym=`*(t: PType, val: PSym) {.inline.} = + assert t.state != Sealed + if t.state == Partial: loadType(t) + t.symImpl = val + +proc size*(t: PType): BiggestInt {.inline.} = + if t.state == Partial: loadType(t) + result = t.sizeImpl + +proc `size=`*(t: PType, val: BiggestInt) {.inline.} = + backendEnsureMutable t + t.sizeImpl = val + +proc align*(t: PType): int16 {.inline.} = + if t.state == Partial: loadType(t) + result = t.alignImpl + +proc `align=`*(t: PType, val: int16) {.inline.} = + backendEnsureMutable t + t.alignImpl = val + +proc paddingAtEnd*(t: PType): int16 {.inline.} = + if t.state == Partial: loadType(t) + result = t.paddingAtEndImpl + +proc `paddingAtEnd=`*(t: PType, val: int16) {.inline.} = + backendEnsureMutable t + t.paddingAtEndImpl = val + +proc loc*(t: PType): TLoc {.inline.} = + if t.state == Partial: loadType(t) + result = t.locImpl + +proc `loc=`*(t: PType, val: TLoc) {.inline.} = + assert t.state != Sealed + if t.state == Partial: loadType(t) + t.locImpl = val + +proc typeInst*(t: PType): PType {.inline.} = + if t.state == Partial: loadType(t) + result = t.typeInstImpl + +proc `typeInst=`*(t: PType, val: PType) {.inline.} = + assert t.state != Sealed + if t.state == Partial: loadType(t) + t.typeInstImpl = val + +proc incl*(t: PType; flag: TTypeFlag) {.inline.} = + assert t.state != Sealed + if t.state == Partial: loadType(t) + t.flagsImpl.incl(flag) + +proc incl*(t: PType; flags: set[TTypeFlag]) {.inline.} = + assert t.state != Sealed + if t.state == Partial: loadType(t) + t.flagsImpl.incl(flags) + +proc excl*(t: PType; flag: TTypeFlag) {.inline.} = + assert t.state != Sealed + if t.state == Partial: loadType(t) + t.flagsImpl.excl(flag) + +proc excl*(t: PType; flags: set[TTypeFlag]) {.inline.} = + assert t.state != Sealed + if t.state == Partial: loadType(t) + t.flagsImpl.excl(flags) + +proc typ*(n: PNode): PType {.inline.} = + result = n.typField + if result == nil and nfLazyType in n.flags: + result = n.sym.typ + +proc `typ=`*(n: PNode, val: sink PType) {.inline.} = + n.typField = val template nodeId(n: PNode): int = cast[int](n) -template typ*(n: PNode): PType = - n.typField - -proc owner*(s: PSym|PType): PSym {.inline.} = - result = s.ownerField - -proc setOwner*(s: PSym|PType, owner: PSym) {.inline.} = - s.ownerField = owner - type Gconfig = object # we put comments in a side channel to avoid increasing `sizeof(TNode)`, which # reduces memory usage given that `PNode` is the most allocated type by far. @@ -876,73 +470,6 @@ proc `comment=`*(n: PNode, a: string) = # same name as an imported module. This is necessary because of # the poor naming choices in the standard library. -const - OverloadableSyms* = {skProc, skFunc, skMethod, skIterator, - skConverter, skModule, skTemplate, skMacro, skEnumField} - - GenericTypes*: TTypeKinds = {tyGenericInvocation, tyGenericBody, - tyGenericParam} - - StructuralEquivTypes*: TTypeKinds = {tyNil, tyTuple, tyArray, - tySet, tyRange, tyPtr, tyRef, tyVar, tyLent, tySequence, tyProc, tyOpenArray, - tyVarargs} - - ConcreteTypes*: TTypeKinds = { # types of the expr that may occur in:: - # var x = expr - tyBool, tyChar, tyEnum, tyArray, tyObject, - tySet, tyTuple, tyRange, tyPtr, tyRef, tyVar, tyLent, tySequence, tyProc, - tyPointer, - tyOpenArray, tyString, tyCstring, tyInt..tyInt64, tyFloat..tyFloat128, - tyUInt..tyUInt64} - IntegralTypes* = {tyBool, tyChar, tyEnum, tyInt..tyInt64, - tyFloat..tyFloat128, tyUInt..tyUInt64} # weird name because it contains tyFloat - ConstantDataTypes*: TTypeKinds = {tyArray, tySet, - tyTuple, tySequence} - NilableTypes*: TTypeKinds = {tyPointer, tyCstring, tyRef, tyPtr, - tyProc, tyError} # TODO - PtrLikeKinds*: TTypeKinds = {tyPointer, tyPtr} # for VM - PersistentNodeFlags*: TNodeFlags = {nfBase2, nfBase8, nfBase16, - nfDotSetter, nfDotField, - nfIsRef, nfIsPtr, nfPreventCg, nfLL, - nfFromTemplate, nfDefaultRefsParam, - nfExecuteOnReload, nfLastRead, - nfFirstWrite, nfSkipFieldChecking, - nfDisabledOpenSym} - namePos* = 0 - patternPos* = 1 # empty except for term rewriting macros - genericParamsPos* = 2 - paramsPos* = 3 - pragmasPos* = 4 - miscPos* = 5 # used for undocumented and hacky stuff - bodyPos* = 6 # position of body; use rodread.getBody() instead! - resultPos* = 7 - dispatcherPos* = 8 - - nfAllFieldsSet* = nfBase2 - - nkIdentKinds* = {nkIdent, nkSym, nkAccQuoted, nkOpenSymChoice, - nkClosedSymChoice, nkOpenSym} - - nkPragmaCallKinds* = {nkExprColonExpr, nkCall, nkCallStrLit} - nkLiterals* = {nkCharLit..nkTripleStrLit} - nkFloatLiterals* = {nkFloatLit..nkFloat128Lit} - nkLambdaKinds* = {nkLambda, nkDo} - declarativeDefs* = {nkProcDef, nkFuncDef, nkMethodDef, nkIteratorDef, nkConverterDef} - routineDefs* = declarativeDefs + {nkMacroDef, nkTemplateDef} - procDefs* = nkLambdaKinds + declarativeDefs - callableDefs* = nkLambdaKinds + routineDefs - - nkSymChoices* = {nkClosedSymChoice, nkOpenSymChoice} - nkStrKinds* = {nkStrLit..nkTripleStrLit} - - skLocalVars* = {skVar, skLet, skForVar, skParam, skResult} - skProcKinds* = {skProc, skFunc, skTemplate, skMacro, skIterator, - skMethod, skConverter} - - defaultSize = -1 - defaultAlignment = -1 - defaultOffset* = -1 - proc getPIdent*(a: PNode): PIdent {.inline.} = ## Returns underlying `PIdent` for `{nkSym, nkIdent}`, or `nil`. case a.kind @@ -1008,14 +535,6 @@ proc isCallExpr*(n: PNode): bool = proc discardSons*(father: PNode) -proc len*(n: PNode): int {.inline.} = - result = n.sons.len - -proc safeLen*(n: PNode): int {.inline.} = - ## works even for leaves. - if n.kind in {nkNone..nkNilLit}: result = 0 - else: result = n.len - proc safeArrLen*(n: PNode): int {.inline.} = ## works for array-like objects (strings passed as openArray in VM). if n.kind in {nkStrLit..nkTripleStrLit}: result = n.strVal.len @@ -1029,24 +548,36 @@ proc add*(father, son: PNode) = 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 father.kind != tyProc or father.sonsImpl.len == 0 assert son != nil - father.sons.add(son) + father.sonsImpl.add son proc addAllowNil*(father, son: PType) {.inline.} = - father.sons.add(son) + assert father.kind != tyProc or father.sonsImpl.len == 0 + father.sonsImpl.add son -template `[]`*(n: PType, i: int): PType = n.sons[i] -template `[]=`*(n: PType, i: int; x: PType) = n.sons[i] = x +template `[]`*(n: PType, i: int): PType = + if n.state == Partial: loadType(n) + if n.kind == tyProc and i > 0: + assert n.nImpl[i] != nil and n.nImpl[i].sym != nil + n.nImpl[i].sym.typ + else: + n.sonsImpl[i] +template `[]=`*(n: PType, i: int; x: PType) = + if n.state == Partial: loadType(n) + if n.kind == tyProc and i > 0: + assert n.nImpl[i] != nil and n.nImpl[i].sym != nil + n.nImpl[i].sym.typ = x + else: + n.sonsImpl[i] = 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 +template `[]`*(n: PType, i: BackwardsIndex): PType = + if n.state == Partial: loadType(n) + n[n.len - i.int] +template `[]=`*(n: PType, i: BackwardsIndex; x: PType) = + if n.state == Partial: loadType(n) + 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. @@ -1085,15 +616,17 @@ 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: # bug #24167 - if s.ast[pragmasPos] != nil and s.ast[pragmasPos].kind != nkEmpty: - result = s.ast[pragmasPos] + let astVal = s.ast + if astVal != nil and astVal[pragmasPos] != nil and astVal[pragmasPos].kind != nkEmpty: + result = astVal[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: + let astVal = s.ast + if astVal != nil and astVal.len > 0: + if astVal[0].kind == nkPragmaExpr and astVal[0].len > 1: # s.ast = nkTypedef / nkPragmaExpr / [nkSym, nkPragma] - result = s.ast[0][1] + result = astVal[0][1] else: result = nil else: @@ -1116,56 +649,6 @@ proc setInfoRecursive*(n: PNode, info: TLineInfo) = for i in 0.. 0: - newSeq(result.sons, children) - setIdMaybe() - -proc newNodeIT*(kind: TNodeKind, info: TLineInfo, typ: PType): PNode = - ## new node with line info, type, and no children - result = newNode(kind) - 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 @@ -1223,8 +706,8 @@ proc newSym*(symKind: TSymKind, name: PIdent, idgen: IdGenerator; owner: PSym, # generates a symbol and initializes the hash field too assert not name.isNil let id = nextSymId idgen - result = PSym(name: name, kind: symKind, flags: {}, info: info, itemId: id, - options: options, ownerField: owner, offset: defaultOffset, + result = PSym(name: name, kindImpl: symKind, flagsImpl: {}, infoImpl: info, itemId: id, + optionsImpl: options, ownerFieldImpl: owner, offsetImpl: defaultOffset, disamb: getOrDefault(idgen.disambTable, name).int32) idgen.disambTable.inc name when false: @@ -1235,10 +718,11 @@ proc newSym*(symKind: TSymKind, name: PIdent, idgen: IdGenerator; owner: PSym, proc astdef*(s: PSym): PNode = # get only the definition (initializer) portion of the ast - if s.ast != nil and s.ast.kind in {nkIdentDefs, nkConstDef}: - s.ast[2] + let astVal = s.ast + if astVal != nil and astVal.kind in {nkIdentDefs, nkConstDef}: + astVal[2] else: - s.ast + astVal proc isMetaType*(t: PType): bool = return t.kind in tyMetaTypes or @@ -1250,35 +734,30 @@ proc isUnresolvedStatic*(t: PType): bool = proc linkTo*(t: PType, s: PSym): PType {.discardable.} = t.sym = s - s.typ = t + s.typImpl = t result = t proc linkTo*(s: PSym, t: PType): PSym {.discardable.} = t.sym = s - s.typ = t + s.typImpl = t result = s template fileIdx*(c: PSym): FileIndex = # XXX: this should be used only on module symbols - c.position.FileIndex + c.position().FileIndex template filename*(c: PSym): string = # XXX: this should be used only on module symbols - c.position.FileIndex.toFilename + c.position().FileIndex.toFilename proc appendToModule*(m: PSym, n: PNode) = ## The compiler will use this internally to add nodes that will be ## appended to the module after the sem pass - if m.ast == nil: - m.ast = newNode(nkStmtList) - m.ast.sons = @[n] + if m.astImpl == nil: + m.astImpl = newNode(nkStmtList) else: - assert m.ast.kind == nkStmtList - m.ast.sons.add(n) - -const # for all kind of hash tables: - GrowthFactor* = 2 # must be power of 2, > 0 - StartSize* = 8 # must be power of 2, > 0 + assert m.astImpl.kind == nkStmtList + m.astImpl.add(n) proc copyStrTable*(dest: var TStrTable, src: TStrTable) = dest.counter = src.counter @@ -1299,26 +778,16 @@ proc discardSons*(father: PNode) = father.sons = @[] proc withInfo*(n: PNode, info: TLineInfo): PNode = + # XXX Dead code. Remove n.info = info return n -proc newIdentNode*(ident: PIdent, info: TLineInfo): PNode = - result = newNode(nkIdent) - result.ident = ident - result.info = info - proc newSymNode*(sym: PSym): PNode = result = newNode(nkSym) result.sym = sym - result.typ() = sym.typ + result.typField = sym.typ result.info = sym.info -proc newSymNode*(sym: PSym, info: TLineInfo): PNode = - result = newNode(nkSym) - result.sym = sym - result.typ() = sym.typ - result.info = info - proc newOpenSym*(n: PNode): PNode {.inline.} = result = newTreeI(nkOpenSym, n.info, n) @@ -1345,27 +814,63 @@ proc replaceFirstSon*(n, newson: PNode) {.inline.} = proc replaceSon*(n: PNode; i: int; newson: PNode) {.inline.} = n.sons[i] = newson -proc last*(n: PType): PType {.inline.} = n.sons[^1] +proc last*(n: PType): PType {.inline.} = + if n.state == Partial: loadType(n) + if n.kind == tyProc and n.nImpl.len > 1: + n.nImpl[^1].sym.typ + else: + n.sonsImpl[^1] -proc elementType*(n: PType): PType {.inline.} = n.sons[^1] -proc skipModifier*(n: PType): PType {.inline.} = n.sons[^1] +proc elementType*(n: PType): PType {.inline.} = + if n.state == Partial: loadType(n) + n.sonsImpl[^1] -proc indexType*(n: PType): PType {.inline.} = n.sons[0] -proc baseClass*(n: PType): PType {.inline.} = n.sons[0] +proc skipModifier*(n: PType): PType {.inline.} = + if n.state == Partial: loadType(n) + n.sonsImpl[^1] + +proc indexType*(n: PType): PType {.inline.} = + if n.state == Partial: loadType(n) + n.sonsImpl[0] + +proc baseClass*(n: PType): PType {.inline.} = + if n.state == Partial: loadType(n) + n.sonsImpl[0] proc base*(t: PType): PType {.inline.} = - result = t.sons[0] + if t.state == Partial: loadType(t) + result = t.sonsImpl[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 returnType*(n: PType): PType {.inline.} = + if n.state == Partial: loadType(n) + n.sonsImpl[0] -proc firstParamType*(n: PType): PType {.inline.} = n.sons[1] -proc firstGenericParam*(n: PType): PType {.inline.} = n.sons[1] +proc setReturnType*(n, r: PType) {.inline.} = + if n.state == Partial: loadType(n) + n.sonsImpl[0] = r -proc typeBodyImpl*(n: PType): PType {.inline.} = n.sons[^1] +proc setIndexType*(n, idx: PType) {.inline.} = + if n.state == Partial: loadType(n) + n.sonsImpl[0] = idx -proc genericHead*(n: PType): PType {.inline.} = n.sons[0] +proc firstParamType*(n: PType): PType {.inline.} = + if n.state == Partial: loadType(n) + if n.kind == tyProc: + n.nImpl[1].sym.typ + else: + n.sonsImpl[1] + +proc firstGenericParam*(n: PType): PType {.inline.} = + if n.state == Partial: loadType(n) + n.sonsImpl[1] + +proc typeBodyImpl*(n: PType): PType {.inline.} = + if n.state == Partial: loadType(n) + n.sonsImpl[^1] + +proc genericHead*(n: PType): PType {.inline.} = + if n.state == Partial: loadType(n) + n.sonsImpl[0] proc skipTypes*(t: PType, kinds: TTypeKinds): PType = ## Used throughout the compiler code to test whether a type tree contains or @@ -1396,7 +901,7 @@ proc newIntTypeNode*(intVal: BiggestInt, typ: PType): PNode = result = newNode(nkIntLit) else: raiseAssert $kind result.intVal = intVal - result.typ() = typ + result.typField = typ proc newIntTypeNode*(intVal: Int128, typ: PType): PNode = # XXX: introduce range check @@ -1406,14 +911,6 @@ proc newFloatNode*(kind: TNodeKind, floatVal: BiggestFloat): PNode = result = newNode(kind) result.floatVal = floatVal -proc newStrNode*(kind: TNodeKind, strVal: string): PNode = - result = newNode(kind) - result.strVal = strVal - -proc newStrNode*(strVal: string; info: TLineInfo): PNode = - result = newNodeI(nkStrLit, info) - result.strVal = strVal - proc newProcNode*(kind: TNodeKind, info: TLineInfo, body: PNode, params, name, pattern, genericParams, @@ -1432,121 +929,123 @@ proc `$`*(s: PSym): string = else: result = "" -when false: - iterator items*(t: PType): PType = - for i in 0.. 0 +proc genericParamHasConstraints*(t: PType): bool {.inline.} = t.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 hasElementType*(t: PType): bool {.inline.} = t.len > 0 +proc isEmptyTupleType*(t: PType): bool {.inline.} = t.len == 0 +proc isSingletonTupleType*(t: PType): bool {.inline.} = t.len == 1 -proc genericConstraint*(t: PType): PType {.inline.} = t.sons[0] +proc genericConstraint*(t: PType): PType {.inline.} = t[0] iterator genericInstParams*(t: PType): (bool, PType) = - for i in 1..= b.sons.len: + for i in 1..= b.len: yield (false, nil, nil) else: - yield (true, a.sons[i], b.sons[i]) + yield (true, a[i], b[i]) iterator genericBodyParams*(t: PType): (int, PType) = - for i in 0.. 1: - setLen(t.sons, 1) + if t.len > 1: + setLen(t.sonsImpl, 1) proc assignType*(dest, src: PType) = dest.kind = src.kind - dest.flags = src.flags - dest.callConv = src.callConv - dest.n = src.n - dest.size = src.size - dest.align = src.align + dest.flagsImpl = src.flags + dest.callConvImpl = src.callConv + dest.nImpl = src.n + dest.sizeImpl = src.size + dest.alignImpl = src.align # this fixes 'type TLock = TSysLock': if src.sym != nil: if dest.sym != nil: - dest.sym.flags.incl src.sym.flags-{sfUsed, sfExported} - if dest.sym.annex == nil: dest.sym.annex = src.sym.annex - mergeLoc(dest.sym.loc, src.sym.loc) + var destFlags = dest.sym.flags + var srcFlags = src.sym.flags + dest.sym.flagsImpl = destFlags + (srcFlags - {sfUsed, sfExported}) + if dest.sym.annex == nil: dest.sym.annexImpl = src.sym.annex + mergeLoc(dest.sym.locImpl, src.sym.loc) else: - dest.sym = src.sym - newSons(dest, src.sons.len) - for i in 0.. 0: + setLen(dest.sonsImpl, 1) + dest.sonsImpl[0] = src.sonsImpl[0] + else: + newSons(dest, src.len) + for i in 0.. genericParamsPos and + hookSym.astImpl[genericParamsPos].kind != nkEmpty + result = HookIndexEntry(typ: typSymId, hook: hookSymId, isGeneric: isGeneric) + +proc toConverterIndexEntry*(config: ConfigRef; converterSym: PSym): (nifstreams.SymId, nifstreams.SymId) = + ## Converts a converter symbol to an index entry (destType, converterSym). + ## Returns the destination type's SymId and the converter's SymId. + # Get the return type of the converter (destination type) + let retType = converterSym.typImpl + if retType != nil and retType.sonsImpl.len > 0: + let destType = retType.sonsImpl[0] # Return type is first son + if destType != nil: + let destTypeSymName = "`t" & $destType.itemId.item & "." & cachedModuleSuffix(config, destType.itemId.module.FileIndex) + let convSymName = converterSym.name.s & "." & $converterSym.disamb & "." & cachedModuleSuffix(config, converterSym.itemId.module.FileIndex) + result = (pool.syms.getOrIncl(destTypeSymName), pool.syms.getOrIncl(convSymName)) + return + # Fallback: return empty entry + result = (nifstreams.SymId(0), nifstreams.SymId(0)) + +proc toMethodIndexEntry*(config: ConfigRef; methodSym: PSym; signature: string): MethodIndexEntry = + ## Converts a method symbol to a MethodIndexEntry. + let methodSymName = methodSym.name.s & "." & $methodSym.disamb & "." & cachedModuleSuffix(config, methodSym.itemId.module.FileIndex) + result = MethodIndexEntry( + fn: pool.syms.getOrIncl(methodSymName), + signature: pool.strings.getOrIncl(signature) + ) + +proc toClassSymId*(config: ConfigRef; typeId: ItemId): nifstreams.SymId = + ## Converts a type ItemId to its SymId for the class index. + let typeSymName = "`t" & $typeId.item & "." & cachedModuleSuffix(config, typeId.module.FileIndex) + result = pool.syms.getOrIncl(typeSymName) + +# ---------------- Line info handling ----------------------------------------- + +type + LineInfoWriter = object + fileK: FileIndex # remember the current pair, even faster than the hash table + fileV: FileId + tab: Table[FileIndex, FileId] + revTab: Table[FileId, FileIndex] # reverse mapping for oldLineInfo + man: LineInfoManager + config: ConfigRef + +proc get(w: var LineInfoWriter; key: FileIndex): FileId = + if w.fileK == key: + result = w.fileV + else: + if key in w.tab: + result = w.tab[key] + w.fileK = key + w.fileV = result + else: + result = pool.files.getOrIncl(msgs.toFullPath(w.config, key)) + w.fileK = key + w.fileV = result + w.tab[key] = result + w.revTab[result] = key + +proc nifLineInfo(w: var LineInfoWriter; info: TLineInfo): PackedLineInfo = + if info == unknownLineInfo: + result = NoLineInfo + else: + let fid = get(w, info.fileIndex) + # Must use pool.man since toString uses pool.man to unpack + result = pack(pool.man, fid, info.line.int32, info.col) + +proc oldLineInfo(w: var LineInfoWriter; info: PackedLineInfo): TLineInfo = + if info == NoLineInfo: + result = unknownLineInfo + else: + var x = unpack(pool.man, info) + var fileIdx: FileIndex + if w.fileV == x.file: + fileIdx = w.fileK + elif x.file in w.revTab: + fileIdx = w.revTab[x.file] + else: + # Need to look up FileId -> FileIndex via the file path + let filePath = pool.files[x.file] + fileIdx = msgs.fileInfoIdx(w.config, AbsoluteFile filePath) + w.revTab[x.file] = fileIdx + result = TLineInfo(line: x.line.uint16, col: x.col.int16, fileIndex: fileIdx) + + +# ------------- Writer --------------------------------------------------------------- + +#[ + +Strategy: + +We produce NIF from the PNode structure as the single source of truth. NIF nodes can +however, refer to PSym and PType, these get NIF names. If the PSym/PType belongs to +the module that we are currently writing, we emit these fields as an inner NIF +structure via the special tags `sd` and `td`. In fact it is only these tags +that get the NIF `SymbolDef` kinds so that the lazy loading mechanism cannot +be confused. + +We could also emit non-local symbols and types later as the index structure +will tell us the precise offsets anyway. + +]# + +const + hiddenTypeTagName = "ht" + symDefTagName = "sd" + typeDefTagName = "td" + +let + sdefTag = registerTag(symDefTagName) + tdefTag = registerTag(typeDefTagName) + hiddenTypeTag = registerTag(hiddenTypeTagName) + +type + Writer = object + deps: TokenBuf # include&import deps + infos: LineInfoWriter + currentModule: int32 + decodedFileIndices: HashSet[FileIndex] + locals: HashSet[ItemId] # track proc-local symbols + inProc: int + #writtenTypes: seq[PType] # types written in this module, to be unloaded later + #writtenSyms: seq[PSym] # symbols written in this module, to be unloaded later + exports: Table[FileIndex, HashSet[string]] # module -> specific symbol names (empty = all) + writtenPackages: HashSet[string] + +const + # Symbol kinds that are always local to a proc and should never have module suffix + skLocalSymKinds = {skParam, skForVar, skResult, skTemp} + +proc isLocalSym(sym: PSym): bool {.inline.} = + sym.kindImpl in skLocalSymKinds or + (sym.kindImpl in {skVar, skLet} and {sfGlobal, sfThread} * sym.flagsImpl == {}) + +proc toNifSymName(w: var Writer; sym: PSym): string = + ## Generate NIF name for a symbol: local names are `ident.disamb`, + ## global names are `ident.disamb.moduleSuffix` + result = sym.name.s + result.add '.' + result.addInt sym.disamb + if not isLocalSym(sym) and sym.itemId notin w.locals: + # Global symbol: ident.disamb.moduleSuffix + result.add '.' + let module = if sym.kindImpl == skPackage: w.currentModule else: sym.itemId.module + result.add modname(module, w.infos.config) + + +proc globalName(sym: PSym; config: ConfigRef): string = + result = sym.name.s + result.add '.' + result.addInt sym.disamb + result.add '.' + result.add modname(sym.itemId.module, config) + +type + ParsedSymName* = object + name*: string + module*: string + count*: int + +proc parseSymName*(s: string): ParsedSymName = + var i = s.len - 2 + while i > 0: + if s[i] == '.': + if s[i+1] in {'0'..'9'}: + var count = ord(s[i+1]) - ord('0') + var j = i+2 + while j < s.len and s[j] in {'0'..'9'}: + count = count * 10 + ord(s[j]) - ord('0') + inc j + return ParsedSymName(name: substr(s, 0, i-1), module: "", count: count) + else: + let mend = s.high + var b = i-1 + while b > 0 and s[b] != '.': dec b + var j = b+1 + var count = 0 + while j < s.len and s[j] in {'0'..'9'}: + count = count * 10 + ord(s[j]) - ord('0') + inc j + + return ParsedSymName(name: substr(s, 0, b-1), module: substr(s, i+1, mend), count: count) + dec i + return ParsedSymName(name: s, module: "") + +template buildTree(dest: var TokenBuf; tag: TagId; body: untyped) = + dest.addParLe tag + body + dest.addParRi + +template buildTree(dest: var TokenBuf; tag: string; body: untyped) = + buildTree dest, pool.tags.getOrIncl(tag), body + +proc writeFlags[E](dest: var TokenBuf; flags: set[E]) = + var flagsAsIdent = "" + genFlags(flags, flagsAsIdent) + if flagsAsIdent.len > 0: + dest.addIdent flagsAsIdent + else: + dest.addDotToken + +proc trLineInfo(w: var Writer; info: TLineInfo): PackedLineInfo {.inline.} = + result = nifLineInfo(w.infos, info) + +proc writeNode(w: var Writer; dest: var TokenBuf; n: PNode; forAst = false) +proc writeType(w: var Writer; dest: var TokenBuf; typ: PType) +proc writeSym(w: var Writer; dest: var TokenBuf; sym: PSym) + +proc writeLoc(w: var Writer; dest: var TokenBuf; loc: TLoc) = + dest.addIdent toNifTag(loc.k) + dest.addIdent toNifTag(loc.storage) + writeFlags(dest, loc.flags) # TLocFlags + dest.addStrLit loc.snippet + +proc writeTypeDef(w: var Writer; dest: var TokenBuf; typ: PType) = + dest.buildTree tdefTag: + dest.addSymDef pool.syms.getOrIncl(typeToNifSym(typ, w.infos.config)), NoLineInfo + + #dest.addIdent toNifTag(typ.kind) + writeFlags(dest, typ.flagsImpl) + dest.addIdent toNifTag(typ.callConvImpl) + dest.addIntLit typ.sizeImpl + dest.addIntLit typ.alignImpl + dest.addIntLit typ.paddingAtEndImpl + dest.addIntLit typ.itemId.item # nonUniqueId + + writeType(w, dest, typ.typeInstImpl) + #if typ.kind in {tyProc, tyIterator} and typ.nImpl != nil and typ.nImpl.kind != nkFormalParams: + + writeNode(w, dest, typ.nImpl) + writeSym(w, dest, typ.ownerFieldImpl) + writeSym(w, dest, typ.symImpl) + + # Write TLoc structure + writeLoc w, dest, typ.locImpl + # we store the type's elements here at the end so that + # it is not ambiguous and saves space: + for ch in typ.sonsImpl: + writeType(w, dest, ch) + + +proc writeType(w: var Writer; dest: var TokenBuf; typ: PType) = + if typ == nil: + dest.addDotToken() + elif typ.itemId.module == w.currentModule and typ.state == Complete: + typ.state = Sealed + writeTypeDef(w, dest, typ) + else: + dest.addSymUse pool.syms.getOrIncl(typeToNifSym(typ, w.infos.config)), NoLineInfo + +proc writeBool(dest: var TokenBuf; b: bool) = + dest.buildTree (if b: "true" else: "false"): + discard + +proc writeLib(w: var Writer; dest: var TokenBuf; lib: PLib) = + if lib == nil: + dest.addDotToken() + else: + dest.buildTree toNifTag(lib.kind): + dest.writeBool lib.generated + dest.writeBool lib.isOverridden + dest.addStrLit lib.name + writeNode w, dest, lib.path + +proc collectGenericParams(w: var Writer; n: PNode) = + ## Pre-collect generic param symbols into w.locals before writing the type. + ## This ensures generic params get consistent short names, and their sdefs + ## are written in the type (where lazy loading can find them). + if n == nil: return + case n.kind + of nkSym: + if n.sym != nil and w.inProc > 0: + w.locals.incl(n.sym.itemId) + of nkIdentDefs, nkVarTuple: + for i in 0 ..< max(0, n.len - 2): + collectGenericParams(w, n[i]) + of nkGenericParams: + for child in n: + collectGenericParams(w, child) + else: + discard + +proc writeSymDef(w: var Writer; dest: var TokenBuf; sym: PSym) = + dest.addParLe sdefTag, trLineInfo(w, sym.infoImpl) + dest.addSymDef pool.syms.getOrIncl(w.toNifSymName(sym)), NoLineInfo + if sfExported in sym.flagsImpl: + dest.addIdent "x" + else: + dest.addDotToken + # field `disamb` made part of the name, so do not store it here + dest.buildTree sym.kindImpl.toNifTag: + case sym.kindImpl + of skLet, skVar, skField, skForVar: + writeSym(w, dest, sym.guardImpl) + dest.addIntLit sym.bitsizeImpl + dest.addIntLit sym.alignmentImpl + else: + discard + + if sym.magicImpl == mNone: + dest.addDotToken + else: + dest.addIdent toNifTag(sym.magicImpl) + writeFlags(dest, sym.flagsImpl) + writeFlags(dest, sym.optionsImpl) + dest.addIntLit sym.offsetImpl + + if sym.kindImpl == skModule: + dest.addDotToken() # position will be set by the loader! + else: + dest.addIntLit sym.positionImpl + + writeLib(w, dest, sym.annexImpl) + + # For routine symbols, pre-collect generic params into w.locals before writing + # the type. This ensures they get consistent short names, and their sdefs are + # written in the type where lazy loading can find them via extractLocalSymsFromTree. + if sym.kindImpl in routineKinds and sym.astImpl != nil and sym.astImpl.len > genericParamsPos: + inc w.inProc + collectGenericParams(w, sym.astImpl[genericParamsPos]) + dec w.inProc + + writeType(w, dest, sym.typImpl) + writeSym(w, dest, sym.ownerFieldImpl) + # Store the AST for routine symbols and constants + # Constants need their AST for astdef() to return the constant's value + writeNode(w, dest, sym.astImpl, forAst = true) + writeLoc w, dest, sym.locImpl + writeNode(w, dest, sym.constraintImpl) + writeSym(w, dest, sym.instantiatedFromImpl) + dest.addParRi + + +proc shouldWriteSymDef(w: var Writer; sym: PSym): bool {.inline.} = + # Don't write module/package symbols - they don't have NIF files + if sym.kindImpl == skPackage: + return not w.writtenPackages.containsOrIncl(sym.name.s) + # Already written - don't write again + if sym.state == Sealed: + return false + # If the symbol belongs to current module and would be written WITHOUT module suffix + # (due to being in w.locals or being in skLocalSymKinds), it MUST have an sdef. + # Otherwise it gets written as a bare SymUse and can't be found when loading. + if sym.itemId.module == w.currentModule: + if sym.itemId in w.locals or isLocalSym(sym): + return true # Would be written without module suffix, needs sdef + if sym.state == Complete: + return true # Normal case for global symbols + return false + +proc writeSym(w: var Writer; dest: var TokenBuf; sym: PSym) = + if sym == nil: + dest.addDotToken() + elif shouldWriteSymDef(w, sym): + sym.state = Sealed + writeSymDef(w, dest, sym) + else: + # NIF has direct support for symbol references so we don't need to use a tag here, + # unlike what we do for types! + dest.addSymUse pool.syms.getOrIncl(w.toNifSymName(sym)), NoLineInfo + +proc writeSymNode(w: var Writer; dest: var TokenBuf; n: PNode; sym: PSym) = + if sym == nil: + dest.addDotToken() + elif shouldWriteSymDef(w, sym): + sym.state = Sealed + if n.typField != n.sym.typImpl: + dest.buildTree hiddenTypeTag, trLineInfo(w, n.info): + writeType(w, dest, n.typField) + writeSymDef(w, dest, sym) + else: + writeSymDef(w, dest, sym) + else: + # NIF has direct support for symbol references so we don't need to use a tag here, + # unlike what we do for types! + let info = trLineInfo(w, n.info) + if n.typField != n.sym.typImpl: + dest.buildTree hiddenTypeTag, info: + writeType(w, dest, n.typField) + dest.addSymUse pool.syms.getOrIncl(w.toNifSymName(sym)), info + else: + dest.addSymUse pool.syms.getOrIncl(w.toNifSymName(sym)), info + +proc writeNodeFlags(dest: var TokenBuf; flags: set[TNodeFlag]) {.inline.} = + writeFlags(dest, flags) + +template withNode(w: var Writer; dest: var TokenBuf; n: PNode; body: untyped) = + dest.addParLe pool.tags.getOrIncl(toNifTag(n.kind)), trLineInfo(w, n.info) + writeNodeFlags(dest, n.flags) + writeType(w, dest, n.typField) + body + dest.addParRi + +proc addLocalSym(w: var Writer; n: PNode) = + ## Add symbol from a node to locals set if it's a symbol node + if n != nil and n.kind == nkSym and n.sym != nil and w.inProc > 0: + w.locals.incl(n.sym.itemId) + +proc addLocalSyms(w: var Writer; n: PNode) = + case n.kind + of nkIdentDefs, nkVarTuple: + # nkIdentDefs: [ident1, ident2, ..., type, default] + # All children except the last two are identifiers + for i in 0 ..< max(0, n.len - 2): + addLocalSyms(w, n[i]) + of nkPostfix: + addLocalSyms(w, n[1]) + of nkPragmaExpr: + addLocalSyms(w, n[0]) + of nkSym: + addLocalSym(w, n) + else: + discard + +proc trInclude(w: var Writer; n: PNode) = + w.deps.addParLe pool.tags.getOrIncl(toNifTag(n.kind)), trLineInfo(w, n.info) + w.deps.addDotToken # flags + w.deps.addDotToken # type + for child in n: + assert child.kind == nkStrLit + w.deps.addStrLit child.strVal # raw string literal, no wrapper needed + w.deps.addParRi + +proc moduleSuffix(conf: ConfigRef; f: FileIndex): string = + cachedModuleSuffix(conf, f) + +proc trImport(w: var Writer; n: PNode) = + for child in n: + if child.kind == nkSym: + w.deps.addParLe pool.tags.getOrIncl(toNifTag(n.kind)), trLineInfo(w, n.info) + w.deps.addDotToken # flags + w.deps.addDotToken # type + let s = child.sym + assert s.kindImpl == skModule + let fp = moduleSuffix(w.infos.config, s.positionImpl.FileIndex) + w.deps.addStrLit fp # raw string literal, no wrapper needed + w.deps.addParRi + +proc writeNode(w: var Writer; dest: var TokenBuf; n: PNode; forAst = false) = + if n == nil: + dest.addDotToken + else: + case n.kind + of nkNone: + assert n.typField == nil, "nkNone should not have a type" + let info = trLineInfo(w, n.info) + dest.addParLe pool.tags.getOrIncl(toNifTag(n.kind)), info + dest.addParRi + of nkEmpty: + if n.typField != nil: + w.withNode dest, n: + let info = trLineInfo(w, n.info) + dest.addParLe pool.tags.getOrIncl(toNifTag(n.kind)), info + dest.addParRi + else: + let info = trLineInfo(w, n.info) + dest.addParLe pool.tags.getOrIncl(toNifTag(n.kind)), info + dest.addParRi + of nkIdent: + # nkIdent uses flags and typ when it is a generic parameter + w.withNode dest, n: + dest.addIdent n.ident.s + of nkSym: + writeSymNode(w, dest, n, n.sym) + of nkCharLit: + w.withNode dest, n: + dest.add charToken(n.intVal.char, NoLineInfo) + of nkIntLit .. nkInt64Lit: + w.withNode dest, n: + dest.addIntLit n.intVal + of nkUIntLit .. nkUInt64Lit: + w.withNode dest, n: + dest.addUIntLit cast[BiggestUInt](n.intVal) + of nkFloatLit .. nkFloat128Lit: + w.withNode dest, n: + dest.add floatToken(pool.floats.getOrIncl(n.floatVal), NoLineInfo) + of nkStrLit .. nkTripleStrLit: + w.withNode dest, n: + dest.addStrLit n.strVal + of nkNilLit: + w.withNode dest, n: + discard + of nkLetSection, nkVarSection, nkConstSection: + # Track local variables declared in let/var sections + w.withNode dest, n: + for child in n: + addLocalSyms w, child + # Process the child node + writeNode(w, dest, child, forAst) + of nkForStmt: + # Track for loop variable (first child is the loop variable) + w.withNode dest, n: + if n.len > 0: + addLocalSyms(w, n[0]) + for i in 0 ..< n.len: + writeNode(w, dest, n[i], forAst) + of nkFormalParams: + # Track parameters (first child is return type, rest are parameters) + inc w.inProc + w.withNode dest, n: + for i in 0 ..< n.len: + if i > 0: # Skip return type + addLocalSyms(w, n[i]) + writeNode(w, dest, n[i], forAst) + dec w.inProc + of nkProcDef, nkFuncDef, nkMethodDef, nkIteratorDef, nkConverterDef, nkMacroDef, nkTemplateDef: + # For top-level named routines (not forAst), just write the symbol. + # The full AST will be stored in the symbol's sdef. + if not forAst and n[namePos].kind == nkSym: + writeSym(w, dest, n[namePos].sym) + else: + # Writing AST inside sdef or anonymous proc: write full structure + inc w.inProc + var ast = n + var skipParams = false + if n[namePos].kind == nkSym: + ast = n[namePos].sym.astImpl + if ast == nil: ast = n + else: skipParams = true + w.withNode dest, ast: + for i in 0 ..< ast.len: + if i == paramsPos and skipParams: + # Parameter are redundant with s.typ.n and even dangerous as for generic instances + # we do not adapt the symbols properly + addDotToken(dest) + else: + writeNode(w, dest, ast[i], forAst) + dec w.inProc + of nkLambda, nkDo: + # Lambdas are expressions, always write full structure + inc w.inProc + var ast = n + if n[namePos].kind == nkSym: + ast = n[namePos].sym.astImpl + if ast == nil: ast = n + w.withNode dest, ast: + for i in 0 ..< ast.len: + writeNode(w, dest, ast[i], forAst) + dec w.inProc + of nkImportStmt: + # this has been transformed for us, see `importer.nim` to contain a list of module syms: + trImport w, n + of nkIncludeStmt: + trInclude w, n + of nkExportStmt, nkExportExceptStmt: + # Collect export information for the index + # nkExportStmt children are nkSym nodes + # When exporting a module (export dollars), the module symbol is a child + # followed by all symbols from that module - we use empty set to mean "export all" + # When exporting specific symbols (export foo, bar), we collect their names + # Note: nkExportExceptStmt is transformed to nkExportStmt by semExportExcept, + # but we handle both just in case + var exportAllModules = initHashSet[FileIndex]() + for child in n: + if child.kind == nkSym: + let s = child.sym + if s.kindImpl == skModule: + # Export all from this module - use empty set + let modIdx = s.positionImpl.FileIndex + exportAllModules.incl modIdx + if modIdx notin w.exports: + w.exports[modIdx] = initHashSet[string]() # empty means "export all" + else: + # Export specific symbol, but only if we're not already exporting all from this module + let modIdx = s.itemId.module.FileIndex + if modIdx notin exportAllModules: + if modIdx notin w.exports: + w.exports[modIdx] = initHashSet[string]() + w.exports[modIdx].incl s.name.s + # Write the export statement as a regular node + w.withNode dest, n: + for i in 0 ..< n.len: + if n[i].kind == nkSym and n[i].sym.kindImpl == skModule: + discard "do not write module syms here" + else: + writeNode(w, dest, n[i], forAst) + else: + w.withNode dest, n: + for i in 0 ..< n.len: + writeNode(w, dest, n[i], forAst) + +proc writeGlobal(w: var Writer; dest: var TokenBuf; n: PNode) = + case n.kind + of nkVarTuple: + writeNode(w, dest, n) + of nkIdentDefs, nkConstDef: + # nkIdentDefs: [ident1, ident2, ..., type, default] + # All children except the last two are identifiers + for i in 0 ..< max(0, n.len - 2): + writeGlobal(w, dest, n[i]) + of nkPostfix: + writeGlobal(w, dest, n[1]) + of nkPragmaExpr: + writeGlobal(w, dest, n[0]) + of nkSym: + writeSym(w, dest, n.sym) + else: + discard + +proc writeGlobals(w: var Writer; dest: var TokenBuf; n: PNode) = + w.withNode dest, n: + for child in n: + writeGlobal(w, dest, child) + +proc writeToplevelNode(w: var Writer; dest, bottom: var TokenBuf; n: PNode) = + case n.kind + of nkStmtList, nkStmtListExpr: + for son in n: writeToplevelNode(w, dest, bottom, son) + of nkEmpty: + discard "ignore" + of nkTypeSection, nkCommentStmt, nkMixinStmt, nkBindStmt, nkUsingStmt, + nkPragma, + nkProcDef, nkFuncDef, nkMethodDef, nkIteratorDef, nkConverterDef, nkMacroDef, nkTemplateDef: + # We write purely declarative nodes at the bottom of the file + writeNode(w, bottom, n) + of nkConstSection: + writeGlobals(w, bottom, n) + of nkLetSection, nkVarSection: + writeGlobals(w, dest, n) + else: + writeNode w, dest, n + +proc createStmtList(buf: var TokenBuf; info: PackedLineInfo) {.inline.} = + buf.addParLe pool.tags.getOrIncl(toNifTag(nkStmtList)), info + buf.addDotToken # flags + buf.addDotToken # type + +proc buildExportBuf(w: var Writer): TokenBuf = + ## Build the export section for the NIF index from collected exports + result = createTokenBuf(32) + for modIdx, names in w.exports: + let path = toFullPath(w.infos.config, modIdx) + if names.len == 0: + # Export all from this module + result.addParLe(TagId(ExportIdx), NoLineInfo) + result.add strToken(pool.strings.getOrIncl(path), NoLineInfo) + result.addParRi() + else: + # Export specific symbols + result.addParLe(TagId(FromexportIdx), NoLineInfo) + result.add strToken(pool.strings.getOrIncl(path), NoLineInfo) + for name in names: + result.add identToken(pool.strings.getOrIncl(name), NoLineInfo) + result.addParRi() + +let replayTag = registerTag("replay") +let repConverterTag = registerTag("repconverter") +let repDestroyTag = registerTag("repdestroy") +let repWasMovedTag = registerTag("repwasmoved") +let repCopyTag = registerTag("repcopy") +let repSinkTag = registerTag("repsink") +let repDupTag = registerTag("repdup") +let repTraceTag = registerTag("reptrace") +let repDeepCopyTag = registerTag("repdeepcopy") +let repEnumToStrTag = registerTag("repenumtostr") +let repMethodTag = registerTag("repmethod") +#let repClassTag = registerTag("repclass") +let includeTag = registerTag("include") +let importTag = registerTag("import") +let implTag = registerTag("implementation") + +proc writeOp(w: var Writer; content: var TokenBuf; op: LogEntry) = + case op.kind + of HookEntry: + case op.op + of attachedDestructor: + content.addParLe repDestroyTag, NoLineInfo + of attachedAsgn: + content.addParLe repCopyTag, NoLineInfo + of attachedWasMoved: + content.addParLe repWasMovedTag, NoLineInfo + of attachedDup: + content.addParLe repDupTag, NoLineInfo + of attachedSink: + content.addParLe repSinkTag, NoLineInfo + of attachedTrace: + content.addParLe repTraceTag, NoLineInfo + of attachedDeepCopy: + content.addParLe repDeepCopyTag, NoLineInfo + content.add strToken(pool.strings.getOrIncl(op.key), NoLineInfo) + content.add symToken(pool.syms.getOrIncl(w.toNifSymName(op.sym)), NoLineInfo) + content.addParRi() + of ConverterEntry: + content.addParLe repConverterTag, NoLineInfo + content.add strToken(pool.strings.getOrIncl(op.key), NoLineInfo) + content.add symToken(pool.syms.getOrIncl(w.toNifSymName(op.sym)), NoLineInfo) + content.addParRi() + of MethodEntry: + discard "to implement" + of EnumToStrEntry: + discard "to implement" + of GenericInstEntry: + discard "will only be written later to ensure it is materialized" + +proc writeNifModule*(config: ConfigRef; thisModule: int32; n: PNode; + opsLog: seq[LogEntry]; + replayActions: seq[PNode] = @[]) = + var w = Writer(infos: LineInfoWriter(config: config), currentModule: thisModule) + var content = createTokenBuf(300) + + let rootInfo = trLineInfo(w, n.info) + createStmtList(content, rootInfo) + + # Write replay actions first, wrapped in a (replay ...) node + if replayActions.len > 0: + content.addParLe replayTag, rootInfo + for action in replayActions: + writeNode(w, content, action) + content.addParRi() + # Only write ops that belong to this module + for op in opsLog: + if op.module == thisModule.int: + writeOp(w, content, op) + + var bottom = createTokenBuf(300) + w.writeToplevelNode content, bottom, n + + # the implTag is used to tell the loader that the + # bottom of the file is the implementation of the module: + content.addParLe implTag, NoLineInfo + content.addParRi() + content.add bottom + content.addParRi() + + let m = modname(w.currentModule, w.infos.config) + let nifFilename = AbsoluteFile(m).changeFileExt(".nif") + let d = completeGeneratedFilePath(config, nifFilename).string + + var dest = createTokenBuf(600) + createStmtList(dest, rootInfo) + dest.add w.deps + # do not write the (stmts .. ) wrapper: + for i in 3 ..< content.len-1: + dest.add content[i] + + # ensure the hooks we announced end up in the NIF file regardless of + # whether they have been used: + for op in opsLog: + if op.module == thisModule.int: + let s = op.sym + if s.state != Sealed: + s.state = Sealed + writeSymDef w, dest, s + + dest.addParRi() + + writeFile(dest, d) + + let exportBuf = buildExportBuf(w) + createIndex(d, dest[0].info, false, + IndexSections(exportBuf: exportBuf)) + +# --------------------------- Loader (lazy!) ----------------------------------------------- + +proc nodeKind(n: Cursor): TNodeKind {.inline.} = + assert n.kind == ParLe + parse(TNodeKind, pool.tags[n.tagId]) + +proc expect(n: Cursor; k: set[NifKind]) = + if n.kind notin k: + when defined(debug): + writeStackTrace() + quit "[NIF decoder] expected: " & $k & " but got: " & $n.kind & toString n + +proc expect(n: Cursor; k: NifKind) {.inline.} = + expect n, {k} + +proc incExpect(n: var Cursor; k: set[NifKind]) = + inc n + expect n, k + +proc incExpect(n: var Cursor; k: NifKind) {.inline.} = + incExpect n, {k} + +proc skipParRi(n: var Cursor) = + expect n, {ParRi} + inc n + +proc firstSon*(n: Cursor): Cursor {.inline.} = + result = n + inc result + +proc expectTag(n: Cursor; tagId: TagId) = + if n.kind == ParLe and n.tagId == tagId: + discard + else: + when defined(debug): + writeStackTrace() + if n.kind != ParLe: + quit "[NIF decoder] expected: ParLe but got: " & $n.kind & toString n + else: + quit "[NIF decoder] expected: " & pool.tags[tagId] & " but got: " & pool.tags[n.tagId] & toString n + +proc incExpectTag(n: var Cursor; tagId: TagId) = + inc n + expectTag(n, tagId) + +proc loadBool(n: var Cursor): bool = + if n.kind == ParLe: + result = pool.tags[n.tagId] == "true" + inc n + skipParRi n + else: + raiseAssert "(true)/(false) expected" + +type + NifModule = ref object + stream: nifstreams.Stream + symCounter: int32 + index: NifIndex + suffix: string + + DecodeContext* = object + infos: LineInfoWriter + #moduleIds: Table[string, int32] + types: Table[string, (PType, NifIndexEntry)] + syms: Table[string, (PSym, NifIndexEntry)] + mods: Table[FileIndex, NifModule] + cache: IdentCache + +proc createDecodeContext*(config: ConfigRef; cache: IdentCache): DecodeContext = + ## Supposed to be a global variable + result = DecodeContext(infos: LineInfoWriter(config: config), cache: cache) + +proc cursorFromIndexEntry(c: var DecodeContext; module: FileIndex; entry: NifIndexEntry; + buf: var TokenBuf): Cursor = + let s = addr c.mods[module].stream + s.r.jumpTo entry.offset + nifcursors.parse(s[], buf, entry.info) + result = cursorAt(buf, 0) + +type + LoadFlag* = enum + LoadFullAst, AlwaysLoadInterface + +proc moduleId(c: var DecodeContext; suffix: string; flags: set[LoadFlag] = {}): FileIndex = + var isKnownFile = false + result = c.infos.config.registerNifSuffix(suffix, isKnownFile) + if not isKnownFile or AlwaysLoadInterface in flags: + let modFile = (getNimcacheDir(c.infos.config) / RelativeFile(suffix & ".nif")).string + let idxFile = (getNimcacheDir(c.infos.config) / RelativeFile(suffix & ".s.idx.nif")).string + if not fileExists(modFile): + raiseAssert "NIF file not found for module suffix '" & suffix & "': " & modFile & + ". This can happen when loading a module from NIF that references another module " & + "whose NIF file hasn't been written yet." + c.mods[result] = NifModule(stream: nifstreams.open(modFile), index: readIndex(idxFile), suffix: suffix) + +proc getOffset(c: var DecodeContext; module: FileIndex; nifName: string): NifIndexEntry = + let ii = addr c.mods[module].index + result = ii.public.getOrDefault(nifName) + if result.offset == 0: + result = ii.private.getOrDefault(nifName) + if result.offset == 0: + raiseAssert "symbol has no offset: " & nifName + +proc loadNode(c: var DecodeContext; n: var Cursor; thisModule: string; + localSyms: var Table[string, PSym]): PNode + +proc loadSymFromCursor(c: var DecodeContext; s: PSym; n: var Cursor; thisModule: string; + localSyms: var Table[string, PSym]) + +proc createTypeStub(c: var DecodeContext; t: SymId): PType = + let name = pool.syms[t] + assert name.startsWith("`t") + var i = len("`t") + var k = 0 + while i < name.len and name[i] in {'0'..'9'}: + k = k * 10 + name[i].ord - ord('0') + inc i + if i < name.len and name[i] == '.': inc i + var itemId = 0'i32 + while i < name.len and name[i] in {'0'..'9'}: + itemId = itemId * 10'i32 + int32(name[i].ord - ord('0')) + inc i + if i < name.len and name[i] == '.': inc i + let suffix = name.substr(i) + result = c.types.getOrDefault(name)[0] + if result == nil: + let id = ItemId(module: moduleId(c, suffix).int32, item: itemId) + let offs = c.getOffset(id.module.FileIndex, name) + result = PType(itemId: id, uniqueId: id, kind: TTypeKind(k), state: Partial) + c.types[name] = (result, offs) + +proc extractLocalSymsFromTree(c: var DecodeContext; n: var Cursor; thisModule: string; + localSyms: var Table[string, PSym]) = + ## Scan a tree for local symbol definitions (sdef tags) and add them to localSyms. + ## For local symbols, fully load them immediately since they have no index offsets. + ## After this proc returns, n is positioned AFTER the tree. + # Handle atoms (non-compound nodes) - just skip them + if n.kind != ParLe: + inc n + return + var depth = 0 + while true: + if n.kind == ParLe: + if n.tagId == sdefTag: + # Found an sdef - check if it's local + let name = n.firstSon + if name.kind == SymbolDef: + let symName = pool.syms[name.symId] + let sn = parseSymName(symName) + if sn.module.len == 0 and symName notin localSyms: + # Local symbol - create stub and immediately load it fully + # since local symbols have no index offsets for lazy loading + let module = moduleId(c, thisModule) + let val = addr c.mods[module].symCounter + inc val[] + let id = ItemId(module: module.int32, item: val[]) + let sym = PSym(itemId: id, kindImpl: skStub, name: c.cache.getIdent(sn.name), + disamb: sn.count.int32, state: Complete) + localSyms[symName] = sym + # Load the full symbol definition immediately + # We're currently at the `(sd` position, need to skip to SymbolDef + inc n # skip past `sd` tag to get to SymbolDef + inc depth # account for the opening `(` of the sdef + loadSymFromCursor(c, sym, n, thisModule, localSyms) + sym.state = Sealed # mark as fully loaded + # loadSymFromCursor consumed everything including the closing `)`, + # so we need to account for it in depth tracking + dec depth + # Continue processing - loadSymFromCursor already advanced n past the closing `)` + continue + inc depth + elif n.kind == ParRi: + dec depth + if depth == 0: + inc n # Move PAST the closing ) + break + inc n + +proc loadTypeFromCursor(c: var DecodeContext; n: var Cursor; t: PType; localSyms: var Table[string, PSym]) + +proc loadTypeStub(c: var DecodeContext; n: var Cursor; localSyms: var Table[string, PSym]): PType = + if n.kind == DotToken: + result = nil + inc n + elif n.kind == Symbol: + let s = n.symId + result = createTypeStub(c, s) + inc n + elif n.kind == ParLe and n.tagId == tdefTag: + let s = n.firstSon.symId + result = createTypeStub(c, s) + if result.state == Partial: + result.state = Sealed # Mark as loaded to prevent loadType from re-loading with empty localSyms + loadTypeFromCursor(c, n, result, localSyms) + else: + skip n # Type already loaded, skip over the td block + else: + raiseAssert "type expected but got " & $n.kind + +proc loadSymStub(c: var DecodeContext; t: SymId; thisModule: string; + localSyms: var Table[string, PSym]): PSym = + let symAsStr = pool.syms[t] + let sn = parseSymName(symAsStr) + # For local symbols (no module suffix), they MUST be in localSyms. + # Local symbols are not in the index - they're defined inline in the NIF file. + # If not found, it's a bug in how we populate localSyms. + if sn.module.len == 0: + result = localSyms.getOrDefault(symAsStr) + if result != nil: + return result + else: + raiseAssert "local symbol '" & symAsStr & "' not found in localSyms." + # Global symbol - look up in index for lazy loading + result = c.syms.getOrDefault(symAsStr)[0] + if result == nil: + let module = moduleId(c, sn.module) + let val = addr c.mods[module].symCounter + inc val[] + let id = ItemId(module: module.int32, item: val[]) + + let offs = c.getOffset(module, symAsStr) + result = PSym(itemId: id, kindImpl: skStub, name: c.cache.getIdent(sn.name), disamb: sn.count.int32, state: Partial) + c.syms[symAsStr] = (result, offs) + +proc loadSymStub(c: var DecodeContext; n: var Cursor; thisModule: string; + localSyms: var Table[string, PSym]): PSym = + if n.kind == DotToken: + result = nil + inc n + elif n.kind == Symbol: + let s = n.symId + result = loadSymStub(c, s, thisModule, localSyms) + inc n + elif n.kind == ParLe and n.tagId == sdefTag: + let s = n.firstSon.symId + skip n + result = loadSymStub(c, s, thisModule, localSyms) + else: + raiseAssert "sym expected but got " & $n.kind + +proc isStub*(t: PType): bool {.inline.} = t.state == Partial +proc isStub*(s: PSym): bool {.inline.} = s.state == Partial + +proc loadAtom[T](t: typedesc[set[T]]; n: var Cursor): set[T] = + if n.kind == DotToken: + result = {} + inc n + else: + expect n, Ident + result = parse(T, pool.strings[n.litId]) + inc n + +proc loadAtom[T: enum](t: typedesc[T]; n: var Cursor): T = + if n.kind == DotToken: + result = default(T) + inc n + else: + expect n, Ident + result = parse(T, pool.strings[n.litId]) + inc n + +proc loadAtom(t: typedesc[string]; n: var Cursor): string = + expect n, StringLit + result = pool.strings[n.litId] + inc n + +proc loadAtom[T: int16|int32|int64](t: typedesc[T]; n: var Cursor): T = + expect n, IntLit + result = pool.integers[n.intId].T + inc n + +template loadField(field) {.dirty.} = + field = loadAtom(typeof(field), n) + +proc loadLoc(c: var DecodeContext; n: var Cursor; loc: var TLoc) = + loadField loc.k + loadField loc.storage + loadField loc.flags + loadField loc.snippet + +proc loadTypeFromCursor(c: var DecodeContext; n: var Cursor; t: PType; localSyms: var Table[string, PSym]) = + expect n, ParLe + if n.tagId != tdefTag: + raiseAssert "(td) expected" + + var scanCursor = n # copy cursor at start of type + let typesModule = parseSymName(pool.syms[n.firstSon.symId]).module + extractLocalSymsFromTree(c, scanCursor, typesModule, localSyms) + + inc n # move past (td + expect n, SymbolDef + # ignore the type's name, we have already used it to create this PType's itemId! + inc n + #loadField t.kind + loadField t.flagsImpl + loadField t.callConvImpl + loadField t.sizeImpl + loadField t.alignImpl + loadField t.paddingAtEndImpl + loadField t.itemId.item # nonUniqueId + + t.typeInstImpl = loadTypeStub(c, n, localSyms) + t.nImpl = loadNode(c, n, typesModule, localSyms) + t.ownerFieldImpl = loadSymStub(c, n, typesModule, localSyms) + t.symImpl = loadSymStub(c, n, typesModule, localSyms) + loadLoc c, n, t.locImpl + + while n.kind != ParRi: + t.sonsImpl.add loadTypeStub(c, n, localSyms) + + skipParRi n + +proc loadType*(c: var DecodeContext; t: PType) = + if t.state != Partial: return + t.state = Sealed + var buf = createTokenBuf(30) + let typeName = typeToNifSym(t, c.infos.config) + var n = cursorFromIndexEntry(c, t.itemId.module.FileIndex, c.types[typeName][1], buf) + var localSyms = initTable[string, PSym]() + loadTypeFromCursor(c, n, t, localSyms) + +proc loadAnnex(c: var DecodeContext; n: var Cursor; thisModule: string; localSyms: var Table[string, PSym]): PLib = + if n.kind == DotToken: + result = nil + inc n + elif n.kind == ParLe: + result = PLib(kind: parse(TLibKind, pool.tags[n.tagId])) + inc n + result.generated = loadBool(n) + result.isOverridden = loadBool(n) + expect n, StringLit + result.name = pool.strings[n.litId] + inc n + result.path = loadNode(c, n, thisModule, localSyms) + skipParRi n + else: + raiseAssert "`lib/annex` information expected" + +proc loadSymFromCursor(c: var DecodeContext; s: PSym; n: var Cursor; thisModule: string; + localSyms: var Table[string, PSym]) = + ## Loads a symbol definition from the current cursor position. + ## The cursor should be positioned after the opening (sd tag. + expect n, SymbolDef + # ignore the symbol's name, we have already used it to create this PSym instance! + inc n + if n.kind == Ident: + if pool.strings[n.litId] == "x": + s.flagsImpl.incl sfExported + inc n + else: + raiseAssert "expected `x` as the export marker" + elif n.kind == DotToken: + inc n + else: + raiseAssert "expected `x` or '.' but got " & $n.kind + + expect n, ParLe + {.cast(uncheckedAssign).}: + s.kindImpl = parse(TSymKind, pool.tags[n.tagId]) + inc n + + case s.kindImpl + of skLet, skVar, skField, skForVar: + s.guardImpl = loadSymStub(c, n, thisModule, localSyms) + loadField s.bitsizeImpl + loadField s.alignmentImpl + else: + discard + skipParRi n + + loadField s.magicImpl + loadField s.flagsImpl + loadField s.optionsImpl + loadField s.offsetImpl + + if s.kindImpl == skModule: + expect n, DotToken + inc n + var isKnownFile = false + s.positionImpl = int c.infos.config.registerNifSuffix(thisModule, isKnownFile) + # do to the precompiled mechanism things end up as main modules which are not! + excl s.flagsImpl, sfMainModule + else: + loadField s.positionImpl + + s.annexImpl = loadAnnex(c, n, thisModule, localSyms) + + # Local symbols were already extracted upfront in loadSym, so we can use + # the simple loadTypeStub here. + s.typImpl = loadTypeStub(c, n, localSyms) + s.ownerFieldImpl = loadSymStub(c, n, thisModule, localSyms) + # Load the AST for routine symbols and constants + # Constants need their AST for astdef() to return the constant's value + s.astImpl = loadNode(c, n, thisModule, localSyms) + loadLoc c, n, s.locImpl + s.constraintImpl = loadNode(c, n, thisModule, localSyms) + s.instantiatedFromImpl = loadSymStub(c, n, thisModule, localSyms) + skipParRi n + +proc loadSym*(c: var DecodeContext; s: PSym) = + if s.state != Partial: return + s.state = Sealed + var buf = createTokenBuf(30) + let symsModule = s.itemId.module.FileIndex + let nifname = globalName(s, c.infos.config) + var n = cursorFromIndexEntry(c, symsModule, c.syms[nifname][1], buf) + + expect n, ParLe + if n.tagId != sdefTag: + raiseAssert "(sd) expected" + + # Pre-scan the ENTIRE symbol definition to extract ALL local symbols upfront. + # This ensures local symbols are registered before any references to them, + # regardless of where they appear in the definition (in types, nested procs, etc.) + var localSyms = initTable[string, PSym]() + var scanCursor = n + extractLocalSymsFromTree(c, scanCursor, c.mods[symsModule].suffix, localSyms) + + # Now parse the symbol definition with all local symbols pre-registered + s.infoImpl = c.infos.oldLineInfo(n.info) + inc n + loadSymFromCursor(c, s, n, c.mods[symsModule].suffix, localSyms) + + +template withNode(c: var DecodeContext; n: var Cursor; result: PNode; kind: TNodeKind; body: untyped) = + let info = c.infos.oldLineInfo(n.info) + inc n + let flags = loadAtom(TNodeFlags, n) + result = newNodeI(kind, info) + result.flags = flags + result.typField = c.loadTypeStub(n, localSyms) + body + skipParRi n + +proc loadNode(c: var DecodeContext; n: var Cursor; thisModule: string; + localSyms: var Table[string, PSym]): PNode = + result = nil + case n.kind + of Symbol: + let info = c.infos.oldLineInfo(n.info) + let symName = pool.syms[n.symId] + # Check local symbols first + let localSym = localSyms.getOrDefault(symName) + if localSym != nil: + result = newSymNode(localSym, info) + inc n + else: + result = newSymNode(c.loadSymStub(n, thisModule, localSyms), info) + if result.typField == nil: + result.flags.incl nfLazyType + of DotToken: + result = nil + inc n + of StringLit: + result = newStrNode(pool.strings[n.litId], c.infos.oldLineInfo(n.info)) + inc n + of ParLe: + let kind = n.nodeKind + case kind + of nkNone: + # special NIF introduced tag? + case pool.tags[n.tagId] + of hiddenTypeTagName: + inc n + let typ = c.loadTypeStub(n, localSyms) + let info = c.infos.oldLineInfo(n.info) + result = newSymNode(c.loadSymStub(n, thisModule, localSyms), info) + result.typField = typ + skipParRi n + of symDefTagName: + let info = c.infos.oldLineInfo(n.info) + let name = n.firstSon + assert name.kind == SymbolDef + let symName = pool.syms[name.symId] + # Check if this is a local symbol (no module suffix in name) + let sn = parseSymName(symName) + let isLocal = sn.module.len == 0 + var sym: PSym + if isLocal: + # Local symbol - not in the index, defined inline in NIF. + # Check if we already have a stub from extractLocalSymsFromType + sym = localSyms.getOrDefault(symName) + if sym == nil: + # First time seeing this local symbol - create it + let module = moduleId(c, thisModule) + let val = addr c.mods[module].symCounter + inc val[] + let id = ItemId(module: module.int32, item: val[]) + sym = PSym(itemId: id, kindImpl: skStub, name: c.cache.getIdent(sn.name), + disamb: sn.count.int32, state: Complete) + localSyms[symName] = sym # register for later references + # Now fully load the symbol from the sdef + inc n # skip `sd` tag + loadSymFromCursor(c, sym, n, thisModule, localSyms) + sym.state = Sealed # mark as fully loaded + result = newSymNode(sym, info) + else: + sym = c.loadSymStub(name.symId, thisModule, localSyms) + skip n # skip the entire sdef for indexed symbols + result = newSymNode(sym, info) + result.flags.incl nfLazyType + of typeDefTagName: + raiseAssert "`td` tag in invalid context" + of "none": + result = newNodeI(nkNone, c.infos.oldLineInfo(n.info)) + inc n + result.flags = loadAtom(TNodeFlags, n) + skipParRi n + else: + raiseAssert "Unknown NIF tag " & pool.tags[n.tagId] + of nkEmpty: + result = newNodeI(nkEmpty, c.infos.oldLineInfo(n.info)) + inc n + if n.kind != ParRi: + result.flags = loadAtom(TNodeFlags, n) + result.typField = c.loadTypeStub(n, localSyms) + skipParRi n + of nkIdent: + let info = c.infos.oldLineInfo(n.info) + inc n + let flags = loadAtom(TNodeFlags, n) + let typ = c.loadTypeStub(n, localSyms) + expect n, Ident + result = newIdentNode(c.cache.getIdent(pool.strings[n.litId]), info) + inc n + result.flags = flags + result.typField = typ + skipParRi n + of nkSym: + #let info = c.infos.oldLineInfo(n.info) + #result = newSymNode(c.loadSymStub n, info) + raiseAssert "nkSym should be mapped to a NIF symbol, not a tag" + of nkCharLit: + c.withNode n, result, kind: + expect n, CharLit + result.intVal = n.charLit.int + inc n + of nkIntLit .. nkInt64Lit: + c.withNode n, result, kind: + expect n, IntLit + result.intVal = pool.integers[n.intId] + inc n + of nkUIntLit .. nkUInt64Lit: + c.withNode n, result, kind: + expect n, UIntLit + result.intVal = cast[BiggestInt](pool.uintegers[n.uintId]) + inc n + of nkFloatLit .. nkFloat128Lit: + c.withNode n, result, kind: + if n.kind == FloatLit: + result.floatVal = pool.floats[n.floatId] + inc n + elif n.kind == ParLe: + case pool.tags[n.tagId] + of "inf": + result.floatVal = Inf + of "nan": + result.floatVal = NaN + of "neginf": + result.floatVal = NegInf + else: + raiseAssert "expected float literal but got " & pool.tags[n.tagId] + inc n + skipParRi n + else: + raiseAssert "expected float literal but got " & $n.kind + of nkStrLit .. nkTripleStrLit: + c.withNode n, result, kind: + expect n, StringLit + result.strVal = pool.strings[n.litId] + inc n + of nkNilLit: + c.withNode n, result, kind: + discard + else: + c.withNode n, result, kind: + while n.kind != ParRi: + result.sons.add c.loadNode(n, thisModule, localSyms) + else: + raiseAssert "expected string literal but got " & $n.kind + +proc loadSymFromIndexEntry(c: var DecodeContext; module: FileIndex; + nifName: string; entry: NifIndexEntry; thisModule: string): PSym = + ## Loads a symbol from the NIF index entry using the entry directly. + ## Creates a symbol stub without looking up in the index (since the index may be moved out). + result = c.syms.getOrDefault(nifName)[0] + if result == nil: + let symAsStr = nifName + let sn = parseSymName(symAsStr) + let symModule = moduleId(c, if sn.module.len > 0: sn.module else: thisModule) + let val = addr c.mods[symModule].symCounter + inc val[] + + let id = ItemId(module: symModule.int32, item: val[]) + result = PSym(itemId: id, kindImpl: skStub, name: c.cache.getIdent(sn.name), disamb: sn.count.int32, state: Partial) + c.syms[symAsStr] = (result, entry) + +proc extractBasename(nifName: string): string = + ## Extract the base name from a NIF name (ident.disamb.module -> ident) + result = "" + for c in nifName: + if c == '.': break + result.add c + +proc populateInterfaceTablesFromIndex(c: var DecodeContext; module: FileIndex; + interf, interfHidden: var TStrTable; thisModule: string) = + ## Populates interface tables from the NIF index structure. + ## Uses the index's public/private tables instead of traversing AST. + + # Move the public table and exports list out to avoid iterator invalidation + # (moduleId can add to c.mods which would invalidate Table iterators) + # We move them back after iteration. + var publicTab = move c.mods[module].index.public + var exportsList = move c.mods[module].index.exports + + # Add all public symbols to interf (exported interface) and interfHidden + for nifName, entry in publicTab: + if not nifName.startsWith("`t"): + # do not load types, they are not part of an interface but an implementation detail! + #echo "LOADING SYM ", nifName, " ", entry.offset + let sym = loadSymFromIndexEntry(c, module, nifName, entry, thisModule) + if sym != nil: + strTableAdd(interf, sym) + strTableAdd(interfHidden, sym) + + # Move public table back + c.mods[module].index.public = move publicTab + + # Process exports (re-exports from other modules) + for exp in exportsList: + let (path, kind, names) = exp + # Convert path to module suffix + let expSuffix = moduleSuffix(path, cast[seq[string]](c.infos.config.searchPaths)) + # Load the exported module's index + let expModule = moduleId(c, expSuffix) + + # Move the exported module's public table out to avoid iterator invalidation + var expPublicTab = move c.mods[expModule].index.public + + # Build a set of names for filtering + var nameSet = initHashSet[string]() + for nameId in names: + nameSet.incl pool.strings[nameId] + + # Add symbols based on export kind + for nifName, entry in expPublicTab: + if nifName.startsWith("`t"): + continue # skip types + + let basename = extractBasename(nifName) + let shouldInclude = + case kind + of ExportIdx: true # export all + of FromexportIdx: basename in nameSet # only specific names + of ExportexceptIdx: basename notin nameSet # all except specific names + else: false + + if shouldInclude: + let sym = loadSymFromIndexEntry(c, expModule, nifName, entry, expSuffix) + if sym != nil: + strTableAdd(interf, sym) + strTableAdd(interfHidden, sym) + + # Move exported module's public table back + c.mods[expModule].index.public = move expPublicTab + + # Move exports list back + c.mods[module].index.exports = move exportsList + + when false: + # Add private symbols to interfHidden only + for nifName, entry in idx.private: + let sym = loadSymFromIndexEntry(c, module, nifName, entry, thisModule) + if sym != nil: + strTableAdd(interfHidden, sym) + +proc toNifFilename*(conf: ConfigRef; f: FileIndex): string = + let suffix = moduleSuffix(conf, f) + result = toGeneratedFile(conf, AbsoluteFile(suffix), ".nif").string + +proc toNifIndexFilename*(conf: ConfigRef; f: FileIndex): string = + let suffix = moduleSuffix(conf, f) + result = toGeneratedFile(conf, AbsoluteFile(suffix), ".s.idx.nif").string + +proc resolveSym(c: var DecodeContext; symAsStr: string; alsoConsiderPrivate: bool): PSym = + result = c.syms.getOrDefault(symAsStr)[0] + if result != nil: + return result + + let sn = parseSymName(symAsStr) + if sn.module.len == 0: + return nil # Local symbols shouldn't be hooks + let module = moduleId(c, sn.module) + # Look up the symbol in the module's index + var offs = c.mods[module].index.public.getOrDefault(symAsStr) + if offs.offset == 0: + if alsoConsiderPrivate: + offs = c.mods[module].index.private.getOrDefault(symAsStr) + if offs.offset == 0: + return nil + else: + return nil + # Create a stub symbol + let val = addr c.mods[module].symCounter + inc val[] + let id = ItemId(module: int32(module), item: val[]) + result = PSym(itemId: id, kindImpl: skProc, name: c.cache.getIdent(sn.name), + disamb: sn.count.int32, state: Partial) + c.syms[symAsStr] = (result, offs) + +proc resolveHookSym*(c: var DecodeContext; symId: nifstreams.SymId): PSym = + ## Resolves a hook SymId to PSym. + ## Hook symbols are often private (generated =destroy, =wasMoved, etc.) + let symAsStr = pool.syms[symId] + result = resolveSym(c, symAsStr, true) + +proc tryResolveCompilerProc*(c: var DecodeContext; name: string; moduleFileIdx: FileIndex): PSym = + ## Tries to resolve a compiler proc from a module by checking the NIF index. + ## Returns nil if the symbol doesn't exist. + let suffix = moduleSuffix(c.infos.config, moduleFileIdx) + let symName = name & ".0." & suffix + result = resolveSym(c, symName, true) + +proc loadLogOp(c: var DecodeContext; logOps: var seq[LogEntry]; s: var Stream; kind: LogEntryKind; op: TTypeAttachedOp; module: int): PackedToken = + result = next(s) + var key = "" + if result.kind == StringLit: + key = pool.strings[result.litId] + result = next(s) + else: + raiseAssert "expected StringLit but got " & $result.kind + if result.kind == Symbol: + let sym = resolveHookSym(c, result.symId) + if sym != nil: + logOps.add LogEntry(kind: kind, op: op, module: module, key: key, sym: sym) + # else: symbol not indexed, skip this hook entry + result = next(s) + if result.kind == ParRi: + result = next(s) + else: + raiseAssert "expected ParRi but got " & $result.kind + +proc skipTree(s: var Stream): PackedToken = + result = next(s) + var nested = 1 + while nested > 0: + if result.kind == ParLe: + inc nested + elif result.kind == ParRi: + dec nested + elif result.kind == EofToken: + break + result = next(s) + +proc nextSubtree(r: var Stream; dest: var TokenBuf; tok: var PackedToken) = + r.parents[0] = tok.info + var nested = 1 + dest.add tok # tag + while true: + tok = r.next() + dest.add tok + if tok.kind == EofToken: + break + elif tok.kind == ParLe: + inc nested + elif tok.kind == ParRi: + dec nested + if nested == 0: break + +type + ModuleSuffix* = distinct string + PrecompiledModule* = object + topLevel*: PNode # top level statements of the main module + deps*: seq[ModuleSuffix] # other modules we need to process the top level statements of + logOps*: seq[LogEntry] + module*: PSym # set by modulegraphs.nim! + +proc loadImport(c: var DecodeContext; s: var Stream; deps: var seq[ModuleSuffix]; tok: var PackedToken) = + tok = next(s) # skip `(import` + if tok.kind == DotToken: + tok = next(s) # skip dot + if tok.kind == DotToken: + tok = next(s) # skip dot + if tok.kind == StringLit: + deps.add ModuleSuffix(pool.strings[tok.litId]) + tok = next(s) + else: + raiseAssert "expected StringLit but got " & $tok.kind + if tok.kind == ParRi: + tok = next(s) # skip ) + else: + raiseAssert "expected ParRi but got " & $tok.kind + +proc processTopLevel(c: var DecodeContext; s: var Stream; flags: set[LoadFlag] = {}; suffix: string; module: int): PrecompiledModule = + result = PrecompiledModule(topLevel: newNode(nkStmtList)) + var localSyms = initTable[string, PSym]() + + var t = next(s) # skip dot + var cont = true + while cont and t.kind != EofToken: + if t.kind == ParLe: + if t.tagId == replayTag: + # Always load replay actions (macro cache operations) + t = next(s) # move past (replay + while t.kind != ParRi and t.kind != EofToken: + if t.kind == ParLe: + var buf = createTokenBuf(50) + nextSubtree(s, buf, t) + var cursor = cursorAt(buf, 0) + let replayNode = loadNode(c, cursor, suffix, localSyms) + if replayNode != nil: + result.topLevel.sons.add replayNode + t = next(s) + if t.kind == ParRi: + t = next(s) + else: + raiseAssert "expected ParRi but got " & $t.kind + elif t.tagId == repConverterTag: + t = loadLogOp(c, result.logOps, s, ConverterEntry, attachedTrace, module) + elif t.tagId == repDestroyTag: + t = loadLogOp(c, result.logOps, s, HookEntry, attachedDestructor, module) + elif t.tagId == repWasMovedTag: + t = loadLogOp(c, result.logOps, s, HookEntry, attachedWasMoved, module) + elif t.tagId == repCopyTag: + t = loadLogOp(c, result.logOps, s, HookEntry, attachedAsgn, module) + elif t.tagId == repSinkTag: + t = loadLogOp(c, result.logOps, s, HookEntry, attachedSink, module) + elif t.tagId == repDupTag: + t = loadLogOp(c, result.logOps, s, HookEntry, attachedDup, module) + elif t.tagId == repTraceTag: + t = loadLogOp(c, result.logOps, s, HookEntry, attachedTrace, module) + elif t.tagId == repDeepCopyTag: + t = loadLogOp(c, result.logOps, s, HookEntry, attachedDeepCopy, module) + elif t.tagId == repEnumToStrTag: + t = loadLogOp(c, result.logOps, s, EnumToStrEntry, attachedTrace, module) + elif t.tagId == repMethodTag: + t = loadLogOp(c, result.logOps, s, MethodEntry, attachedTrace, module) + #elif t.tagId == repClassTag: + # t = loadLogOp(c, logOps, s, ClassEntry, attachedTrace, module) + elif t.tagId == includeTag: + t = skipTree(s) + elif t.tagId == importTag: + loadImport(c, s, result.deps, t) + elif t.tagId == implTag: + cont = false + elif LoadFullAst in flags: + # Parse the full statement + var buf = createTokenBuf(50) + nextSubtree(s, buf, t) + t = next(s) # skip ParRi + var cursor = cursorAt(buf, 0) + let stmtNode = loadNode(c, cursor, suffix, localSyms) + if stmtNode != nil: + result.topLevel.sons.add stmtNode + else: + cont = false + else: + cont = false + +proc loadNifModule*(c: var DecodeContext; suffix: ModuleSuffix; interf, interfHidden: var TStrTable; + flags: set[LoadFlag] = {}): PrecompiledModule = + # Ensure module index is loaded - moduleId returns the FileIndex for this suffix + let module = moduleId(c, string(suffix), flags) + + # Populate interface tables from the NIF index structure + # Symbols are created as stubs (Partial state) and will be loaded lazily via loadSym + populateInterfaceTablesFromIndex(c, module, interf, interfHidden, string(suffix)) + + # Load the module AST (or just replay actions if loadFullAst is false) + let s = addr c.mods[module].stream + s.r.jumpTo 0 # Start from beginning + discard processDirectives(s.r) + var t = next(s[]) + if t.kind == ParLe and pool.tags[t.tagId] == toNifTag(nkStmtList): + t = next(s[]) # skip (stmts + t = next(s[]) # skip flags + result = processTopLevel(c, s[], flags, string(suffix), module.int) + else: + result = PrecompiledModule(topLevel: newNode(nkStmtList)) + +proc loadNifModule*(c: var DecodeContext; f: FileIndex; interf, interfHidden: var TStrTable; + flags: set[LoadFlag] = {}): PrecompiledModule = + let suffix = ModuleSuffix(moduleSuffix(c.infos.config, f)) + result = loadNifModule(c, suffix, interf, interfHidden, flags) + +when isMainModule: + import std / syncio + let obj = parseSymName("a.123.sys") + echo obj.name, " ", obj.module, " ", obj.count + let objb = parseSymName("abcdef.0121") + echo objb.name, " ", objb.module, " ", objb.count diff --git a/compiler/astalgo.nim b/compiler/astalgo.nim index 14dc7c5994..baa852b9e0 100644 --- a/compiler/astalgo.nim +++ b/compiler/astalgo.nim @@ -68,8 +68,6 @@ template mdbg*: bool {.deprecated.} = # --------------------------------------------------------------------------- proc lookupInRecord*(n: PNode, field: PIdent): PSym -proc mustRehash*(length, counter: int): bool -proc nextTry*(h, maxHash: Hash): Hash {.inline.} # ------------- table[int, int] --------------------------------------------- const @@ -216,10 +214,6 @@ proc getNamedParamFromList*(list: PNode, ident: PIdent): PSym = proc hashNode(p: RootRef): Hash = result = hash(cast[pointer](p)) -proc mustRehash(length, counter: int): bool = - assert(length > counter) - result = (length * 2 < counter * 3) or (length - counter < 4) - import std/tables const backrefStyle = "\e[90m" @@ -484,12 +478,6 @@ proc debug(n: PNode; conf: ConfigRef) = this.value(n) echo($this.res) -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 - # random-number generation for proof). - proc objectSetContains*(t: TObjectSet, obj: RootRef): bool = # returns true whether n is in t var h: Hash = hashNode(obj) and high(t.data) # start with real hash value @@ -537,95 +525,6 @@ proc objectSetContainsOrIncl*(t: var TObjectSet, obj: RootRef): bool = inc(t.counter) result = false -proc strTableContains*(t: TStrTable, n: PSym): bool = - var h: Hash = n.name.h and high(t.data) # start with real hash value - while t.data[h] != nil: - if (t.data[h] == n): - return true - h = nextTry(h, high(t.data)) - result = false - -proc strTableRawInsert(data: var seq[PSym], n: PSym) = - var h: Hash = n.name.h and high(data) - while data[h] != nil: - if data[h] == n: - # allowed for 'export' feature: - #InternalError(n.info, "StrTableRawInsert: " & n.name.s) - return - h = nextTry(h, high(data)) - assert(data[h] == nil) - data[h] = n - -proc symTabReplaceRaw(data: var seq[PSym], prevSym: PSym, newSym: PSym) = - assert prevSym.name.h == newSym.name.h - var h: Hash = prevSym.name.h and high(data) - while data[h] != nil: - if data[h] == prevSym: - data[h] = newSym - return - h = nextTry(h, high(data)) - assert false - -proc symTabReplace*(t: var TStrTable, prevSym: PSym, newSym: PSym) = - symTabReplaceRaw(t.data, prevSym, newSym) - -proc strTableEnlarge(t: var TStrTable) = - var n: seq[PSym] - newSeq(n, t.data.len * GrowthFactor) - for i in 0..high(t.data): - if t.data[i] != nil: strTableRawInsert(n, t.data[i]) - swap(t.data, n) - -proc strTableAdd*(t: var TStrTable, n: PSym) = - if mustRehash(t.data.len, t.counter): strTableEnlarge(t) - strTableRawInsert(t.data, n) - inc(t.counter) - -proc strTableInclReportConflict*(t: var TStrTable, n: PSym; - onConflictKeepOld = false): PSym = - # if `t` has a conflicting symbol (same identifier as `n`), return it - # otherwise return `nil`. Incl `n` to `t` unless `onConflictKeepOld = true` - # and a conflict was found. - assert n.name != nil - var h: Hash = n.name.h and high(t.data) - var replaceSlot = -1 - while true: - var it = t.data[h] - if it == nil: break - # Semantic checking can happen multiple times thanks to templates - # and overloading: (var x=@[]; x).mapIt(it). - # So it is possible the very same sym is added multiple - # times to the symbol table which we allow here with the 'it == n' check. - if it.name.id == n.name.id: - if it == n: return nil - replaceSlot = h - h = nextTry(h, high(t.data)) - if replaceSlot >= 0: - result = t.data[replaceSlot] # found it - if not onConflictKeepOld: - t.data[replaceSlot] = n # overwrite it with newer definition! - return result # but return the old one - elif mustRehash(t.data.len, t.counter): - strTableEnlarge(t) - strTableRawInsert(t.data, n) - else: - assert(t.data[h] == nil) - t.data[h] = n - inc(t.counter) - result = nil - -proc strTableIncl*(t: var TStrTable, n: PSym; - onConflictKeepOld = false): bool {.discardable.} = - result = strTableInclReportConflict(t, n, onConflictKeepOld) != nil - -proc strTableGet*(t: TStrTable, name: PIdent): PSym = - var h: Hash = name.h and high(t.data) - while true: - result = t.data[h] - if result == nil: break - if result.name.id == name.id: break - h = nextTry(h, high(t.data)) - type TIdentIter* = object # iterator over all syms with same identifier diff --git a/compiler/astdef.nim b/compiler/astdef.nim new file mode 100644 index 0000000000..b9a8aab3e1 --- /dev/null +++ b/compiler/astdef.nim @@ -0,0 +1,1160 @@ +# +# +# The Nim Compiler +# (c) Copyright 2025 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +import + lineinfos, options, ropes, idents, int128 + +import std/[tables, hashes] + +when defined(nimPreviewSlimSystem): + import std/assertions + +export int128 + +import nodekinds +export nodekinds + +type + TCallingConvention* = enum + ccNimCall = "nimcall" # nimcall, also the default + ccStdCall = "stdcall" # procedure is stdcall + ccCDecl = "cdecl" # cdecl + ccSafeCall = "safecall" # safecall + ccSysCall = "syscall" # system call + ccInline = "inline" # proc should be inlined + ccNoInline = "noinline" # proc should not be inlined + ccFastCall = "fastcall" # fastcall (pass parameters in registers) + ccThisCall = "thiscall" # thiscall (parameters are pushed right-to-left) + ccClosure = "closure" # proc has a closure + ccNoConvention = "noconv" # needed for generating proper C procs sometimes + ccMember = "member" # proc is a (cpp) member + + TNodeKinds* = set[TNodeKind] + +type + 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 + # for symbol file generation; such symbols should always + # be written into the ROD file + sfGlobal, # symbol is at global scope + + sfForward, # symbol is forward declared + sfWasForwarded, # symbol had a forward declaration + # (implies it's too dangerous to patch its type signature) + sfImportc, # symbol is external; imported + sfExportc, # symbol is exported (under a specified name) + sfMangleCpp, # mangle as cpp (combines with `sfExportc`) + sfVolatile, # variable is volatile + sfRegister, # variable should be placed in a register + sfPure, # object is "pure" that means it has no type-information + # enum is "pure", its values need qualified access + # variable is "pure"; it's an explicit "global" + sfNoSideEffect, # proc has no side effects + sfSideEffect, # proc may have side effects; cannot prove it has none + sfMainModule, # module is the main module + sfSystemModule, # module is the system module + sfNoReturn, # proc never returns (an exit proc) + sfAddrTaken, # the variable's address is taken (ex- or implicitly); + # *OR*: a proc is indirectly called (used as first class) + sfCompilerProc, # proc is a compiler proc, that is a C proc that is + # needed for the code generator + sfEscapes # param escapes + # currently unimplemented + sfDiscriminant, # field is a discriminant in a record/object + sfRequiresInit, # field must be initialized during construction + sfDeprecated, # symbol is deprecated + sfExplain, # provide more diagnostics when this symbol is used + sfError, # usage of symbol should trigger a compile-time error + sfShadowed, # a symbol that was shadowed in some inner scope + sfThread, # proc will run as a thread + # variable is a thread variable + sfCppNonPod, # tells compiler to treat such types as non-pod's, so that + # `thread_local` is used instead of `__thread` for + # {.threadvar.} + `--threads`. Only makes sense for importcpp types. + # This has a performance impact so isn't set by default. + sfCompileTime, # proc can be evaluated at compile time + sfConstructor, # proc is a C++ constructor + sfDispatcher, # copied method symbol is the dispatcher + # deprecated and unused, except for the con + sfBorrow, # proc is borrowed + sfInfixCall, # symbol needs infix call syntax in target language; + # for interfacing with C++, JS + 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 + 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 + # implementation. + sfGenSym # symbol is 'gensym'ed; do not add to symbol table + sfNonReloadable # symbol will be left as-is when hot code reloading is on - + # meaning that it won't be renamed and/or changed in any way + sfGeneratedOp # proc is a generated '='; do not inject destructors in it + # variable is generated closure environment; requires early + # destruction for --newruntime. + sfTemplateParam # symbol is a template parameter + sfCursor # variable/field is a cursor, see RFC 177 for details + sfInjectDestructors # whether the proc needs the 'injectdestructors' transformation + sfNeverRaises # proc can never raise an exception, not even OverflowDefect + # or out-of-memory + sfSystemRaisesDefect # proc in the system can raise defects + sfUsedInFinallyOrExcept # symbol is used inside an 'except' or 'finally' + sfSingleUsedTemp # For temporaries that we know will only be used once + sfNoalias # 'noalias' annotation, means C's 'restrict' + # for templates and macros, means cannot be called + # as a lone symbol (cannot use alias syntax) + sfEffectsDelayed # an 'effectsDelayed' parameter + sfGeneratedType # A anonymous generic type that is generated by the compiler for + # objects that do not have generic parameters in case one of the + # object fields has one. + # + # This is disallowed but can cause the typechecking to go into + # an infinite loop, this flag is used as a sentinel to stop it. + sfVirtual # proc is a C++ virtual function + 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 + + sfNoForward* = sfRegister + # forward declarations are not required (per module) + sfReorder* = sfForward + # reordering pass is enabled + + sfCompileToCpp* = sfInfixCall # compile the module as C++ code + sfCompileToObjc* = sfNamedParamCall # compile the module as Objective-C code + sfExperimental* = sfOverridden # module uses the .experimental switch + sfWrittenTo* = sfBorrow # param is assigned to + # currently unimplemented + sfCppMember* = { sfVirtual, sfMember, sfConstructor } # proc is a C++ member, meaning it will be attached to the type definition + +const + # getting ready for the future expr/stmt merge + nkWhen* = nkWhenStmt + nkWhenExpr* = nkWhenStmt + nkEffectList* = nkArgList + # hacks ahead: an nkEffectList is a node with 4 children: + exceptionEffects* = 0 # exceptions at position 0 + requiresEffects* = 1 # 'requires' annotation + ensuresEffects* = 2 # 'ensures' annotation + tagEffects* = 3 # user defined tag ('gc', 'time' etc.) + pragmasEffects* = 4 # not an effect, but a slot for pragmas in proc type + forbiddenEffects* = 5 # list of illegal effects + effectListLen* = 6 # list of effects list + nkLastBlockStmts* = {nkRaiseStmt, nkReturnStmt, nkBreakStmt, nkContinueStmt} + # these must be last statements in a block + +type + TTypeKind* = enum # order is important! + # Don't forget to change hti.nim if you make a change here + # XXX put this into an include file to avoid this issue! + # several types are no longer used (guess which), but a + # spot in the sequence is kept for backwards compatibility + # (apparently something with bootstrapping) + # if you need to add a type, they can apparently be reused + tyNone, tyBool, tyChar, + tyEmpty, tyAlias, tyNil, tyUntyped, tyTyped, tyTypeDesc, + tyGenericInvocation, # ``T[a, b]`` for types to invoke + tyGenericBody, # ``T[a, b, body]`` last parameter is the body + tyGenericInst, # ``T[a, b, realInstance]`` instantiated generic type + # realInstance will be a concrete type like tyObject + # unless this is an instance of a generic alias type. + # then realInstance will be the tyGenericInst of the + # completely (recursively) resolved alias. + + tyGenericParam, # ``a`` in the above patterns + tyDistinct, + tyEnum, + tyOrdinal, # integer types (including enums and boolean) + tyArray, + tyObject, + tyTuple, + tySet, + tyRange, + tyPtr, tyRef, + tyVar, + tySequence, + tyProc, + tyPointer, tyOpenArray, + tyString, tyCstring, tyForward, + tyInt, tyInt8, tyInt16, tyInt32, tyInt64, # signed integers + tyFloat, tyFloat32, tyFloat64, tyFloat128, + tyUInt, tyUInt8, tyUInt16, tyUInt32, tyUInt64, + tyOwned, tySink, tyLent, + tyVarargs, + tyUncheckedArray + # An array with boundaries [0,+∞] + + 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 + + tyUserTypeClass + # the body of a user-defined type class + + tyUserTypeClassInst + # Instance of a parametric user-defined type class. + # Structured similarly to tyGenericInst. + # tyGenericInst represents concrete types, while + # this is still a "generic param" that will bind types + # and resolves them during sigmatch and instantiation. + + tyCompositeTypeClass + # Type such as seq[Number] + # The notes for tyUserTypeClassInst apply here as well + # sons[0]: the original expression used by the user. + # sons[1]: fully expanded and instantiated meta type + # (potentially following aliases) + + 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 `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. last will + # be updated to store a type best conforming to all candidates) + + tyAnd, tyOr, tyNot + # boolean type classes such as `string|int`,`not seq`, + # `Sortable and Enumable`, etc + + tyAnything + # a type class matching any type + + tyStatic + # a value known at compile type (the underlying type is .base) + + tyFromExpr + # This is a type representing an expression that depends + # on generic parameters (the expression is stored in t.n) + # It will be converted to a real type only during generic + # instantiation and prior to this it has the potential to + # be any type. + + tyConcept + # new style concept. + + tyVoid + # now different from tyEmpty, hurray! + tyIterable + +static: + # remind us when TTypeKind stops to fit in a single 64-bit word + # assert TTypeKind.high.ord <= 63 + discard + +const + tyPureObject* = tyTuple + GcTypeKinds* = {tyRef, tySequence, tyString} + + tyTypeClasses* = {tyBuiltInTypeClass, tyCompositeTypeClass, + tyUserTypeClass, tyUserTypeClassInst, tyConcept, + tyAnd, tyOr, tyNot, tyAnything} + + tyMetaTypes* = {tyGenericParam, tyTypeDesc, tyUntyped} + tyTypeClasses + tyUserTypeClasses* = {tyUserTypeClass, tyUserTypeClassInst} + # consider renaming as `tyAbstractVarRange` + abstractVarRange* = {tyGenericInst, tyRange, tyVar, tyDistinct, tyOrdinal, + tyTypeDesc, tyAlias, tyInferred, tySink, tyOwned} + abstractInst* = {tyGenericInst, tyDistinct, tyOrdinal, tyTypeDesc, tyAlias, + tyInferred, tySink, tyOwned} # xxx what about tyStatic? + +type + TTypeKinds* = set[TTypeKind] + + TNodeFlag* = enum + nfNone, + nfBase2, # nfBase10 is default, so not needed + nfBase8, + nfBase16, + nfAllConst, # used to mark complex expressions constant; easy to get rid of + # but unfortunately it has measurable impact for compilation + # efficiency + nfTransf, # node has been transformed + nfNoRewrite # node should not be transformed anymore + nfSem # node has been checked for semantics + nfLL # node has gone through lambda lifting + nfDotField # the call can use a dot operator + nfDotSetter # the call can use a setter dot operarator + nfExplicitCall # x.y() was used instead of x.y + nfExprCall # this is an attempt to call a regular expression + nfIsRef # this node is a 'ref' node; used for the VM + nfIsPtr # this node is a 'ptr' node; used for the VM + nfPreventCg # this node should be ignored by the codegen + nfBlockArg # this a stmtlist appearing in a call (e.g. a do block) + nfFromTemplate # a top-level node returned from a template + nfDefaultParam # an automatically inserter default parameter + nfDefaultRefsParam # a default param value references another parameter + # the flag is applied to proc default values and to calls + nfExecuteOnReload # A top-level statement that will be executed during reloads + nfLastRead # this node is a last read + 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 + nfLazyType # node has a lazy type + + TNodeFlags* = set[TNodeFlag] + TTypeFlag* = enum # keep below 32 for efficiency reasons (now: 47) + tfVarargs, # procedure has C styled varargs + # tyArray type represeting a varargs list + tfNoSideEffect, # procedure type does not allow side effects + tfFinal, # is the object final? + tfInheritable, # is the object inheritable? + tfHasOwned, # type contains an 'owned' type and must be moved + tfEnumHasHoles, # enum cannot be mapped into a range + tfShallow, # type can be shallow copied on assignment + tfThread, # proc type is marked as ``thread``; alias for ``gcsafe`` + tfFromGeneric, # type is an instantiation of a generic; this is needed + # because for instantiations of objects, structural + # type equality has to be used + tfUnresolved, # marks unresolved typedesc/static params: e.g. + # proc foo(T: typedesc, list: seq[T]): var T + # proc foo(L: static[int]): array[L, int] + # can be attached to ranges to indicate that the range + # can be attached to generic procs with free standing + # type parameters: e.g. proc foo[T]() + # depends on unresolved static params. + tfResolved # marks a user type class, after it has been bound to a + # concrete type (lastSon becomes the concrete type) + tfRetType, # marks return types in proc (used to detect type classes + # used as return types for return type inference) + tfCapturesEnv, # whether proc really captures some environment + tfByCopy, # pass object/tuple by copy (C backend) + tfByRef, # pass object/tuple by reference (C backend) + tfIterator, # type is really an iterator, not a tyProc + tfPartial, # type is declared as 'partial' + tfNotNil, # type cannot be 'nil' + 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.} + # all fields must be initialized + tfVarIsPtr, # 'var' type is translated like 'ptr' even in C++ mode + tfHasMeta, # type contains "wildcard" sub-types such as generic params + # or other type classes + tfHasGCedMem, # type contains GC'ed memory + tfPacked + tfHasStatic + tfGenericTypeParam + tfImplicitTypeParam + tfInferrableStatic + tfConceptMatchedTypeSym + tfExplicit # for typedescs, marks types explicitly prefixed with the + # `type` operator (e.g. type int) + tfWildcard # consider a proc like foo[T, I](x: Type[T, I]) + # T and I here can bind to both typedesc and static types + # before this is determined, we'll consider them to be a + # wildcard type. + tfHasAsgn # type has overloaded assignment operator + tfBorrowDot # distinct type borrows '.' + tfTriggersCompileTime # uses the NimNode type which make the proc + # implicitly '.compiletime' + tfRefsAnonObj # used for 'ref object' and 'ptr object' + tfCovariant # covariant generic param mimicking a ptr type + tfWeakCovariant # covariant generic param mimicking a seq/array type + tfContravariant # contravariant generic param + tfCheckedForDestructor # type was checked for having a destructor. + # If it has one, t.destructor is not nil. + tfAcyclic # object type was annotated as .acyclic + tfIncompleteStruct # treat this type as if it had sizeof(pointer) + tfCompleteStruct + # (for importc types); type is fully specified, allowing to compute + # sizeof, alignof, offsetof at CT + tfExplicitCallConv + tfIsConstructor + tfEffectSystemWorkaround + tfIsOutParam + tfSendable + tfImplicitStatic + + TTypeFlags* = set[TTypeFlag] + + TSymKind* = enum # the different symbols (start with the prefix sk); + # order is important for the documentation generator! + skUnknown, # unknown symbol: used for parsing assembler blocks + # and first phase symbol lookup in generics + skConditional, # symbol for the preprocessor (may become obsolete) + skDynLib, # symbol represents a dynamic library; this is used + # internally; it does not exist in Nim code + skParam, # a parameter + skGenericParam, # a generic parameter; eq in ``proc x[eq=`==`]()`` + skTemp, # a temporary variable (introduced by compiler) + skModule, # module identifier + skType, # a type + skVar, # a variable + skLet, # a 'let' symbol + skConst, # a constant + skResult, # special 'result' variable + skProc, # a proc + skFunc, # a func + skMethod, # a method + skIterator, # an iterator + skConverter, # a type converter + skMacro, # a macro + skTemplate, # a template; currently also misused for user-defined + # pragmas + skField, # a field in a record or object + skEnumField, # an identifier in an enum + skForVar, # a for loop variable + skLabel, # a label (for block statement) + skStub, # symbol is a stub and not yet loaded from the ROD + # file (it is loaded on demand, which may + # mean: never) + skPackage, # symbol is a package (used for canonicalization) + TSymKinds* = set[TSymKind] + +const + routineKinds* = {skProc, skFunc, skMethod, skIterator, + skConverter, skMacro, skTemplate} + ExportableSymKinds* = {skVar, skLet, skConst, skType, skEnumField, skStub} + routineKinds + + tfUnion* = tfNoSideEffect + tfGcSafe* = tfThread + tfObjHasKids* = tfEnumHasHoles + tfReturnsNew* = tfInheritable + tfNonConstExpr* = tfExplicitCallConv + ## tyFromExpr where the expression shouldn't be evaluated as a static value + tfGenericHasDestructor* = tfExplicitCallConv + ## tyGenericBody where an instance has a generated destructor + skError* = skUnknown + +var + eqTypeFlags* = {tfIterator, tfNotNil, tfVarIsPtr, tfGcSafe, tfNoSideEffect, tfIsOutParam} + ## type flags that are essential for type equality. + ## This is now a variable because for emulation of version:1.0 we + ## might exclude {tfGcSafe, tfNoSideEffect}. + +type + TMagic* = enum # symbols that require compiler magic: + mNone, + mDefined, mDeclared, mDeclaredInScope, mCompiles, mArrGet, mArrPut, mAsgn, + mLow, mHigh, mSizeOf, mAlignOf, mOffsetOf, mTypeTrait, + mIs, mOf, mAddr, mType, mTypeOf, + mPlugin, mEcho, mShallowCopy, mSlurp, mStaticExec, mStatic, + mParseExprToAst, mParseStmtToAst, mExpandToAst, mQuoteAst, + mInc, mDec, mOrd, + mNew, mNewFinalize, mNewSeq, mNewSeqOfCap, + mLengthOpenArray, mLengthStr, mLengthArray, mLengthSeq, + mIncl, mExcl, mCard, mChr, + mGCref, mGCunref, + mAddI, mSubI, mMulI, mDivI, mModI, + mSucc, mPred, + mAddF64, mSubF64, mMulF64, mDivF64, + mShrI, mShlI, mAshrI, mBitandI, mBitorI, mBitxorI, + mMinI, mMaxI, + mAddU, mSubU, mMulU, mDivU, mModU, + mEqI, mLeI, mLtI, + mEqF64, mLeF64, mLtF64, + mLeU, mLtU, + mEqEnum, mLeEnum, mLtEnum, + mEqCh, mLeCh, mLtCh, + mEqB, mLeB, mLtB, + mEqRef, mLePtr, mLtPtr, + mXor, mEqCString, mEqProc, + mUnaryMinusI, mUnaryMinusI64, mAbsI, mNot, + mUnaryPlusI, mBitnotI, + mUnaryPlusF64, mUnaryMinusF64, + mCharToStr, mBoolToStr, + mCStrToStr, + mStrToStr, mEnumToStr, + mAnd, mOr, + mImplies, mIff, mExists, mForall, mOld, + mEqStr, mLeStr, mLtStr, + mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, mXorSet, + mConStrStr, mSlice, + mDotDot, # this one is only necessary to give nice compile time warnings + mFields, mFieldPairs, mOmpParFor, + mAppendStrCh, mAppendStrStr, mAppendSeqElem, + mInSet, mRepr, mExit, + mSetLengthStr, mSetLengthSeq, + mSetLengthSeqUninit, + mIsPartOf, mAstToStr, mParallel, + mSwap, mIsNil, mArrToSeq, mOpenArrayToSeq, + mNewString, mNewStringOfCap, mParseBiggestFloat, + mMove, mEnsureMove, mWasMoved, mDup, mDestroy, mTrace, + mDefault, mUnown, mFinished, mIsolate, mAccessEnv, mAccessTypeField, + mArray, mOpenArray, mRange, mSet, mSeq, mVarargs, + mRef, mPtr, mVar, mDistinct, mVoid, mTuple, + mOrdinal, mIterableType, + mInt, mInt8, mInt16, mInt32, mInt64, + mUInt, mUInt8, mUInt16, mUInt32, mUInt64, + mFloat, mFloat32, mFloat64, mFloat128, + mBool, mChar, mString, mCstring, + mPointer, mNil, mExpr, mStmt, mTypeDesc, + mVoidType, mPNimrodNode, mSpawn, mDeepCopy, + mIsMainModule, mCompileDate, mCompileTime, mProcCall, + mCpuEndian, mHostOS, mHostCPU, mBuildOS, mBuildCPU, mAppType, + mCompileOption, mCompileOptionArg, + mNLen, mNChild, mNSetChild, mNAdd, mNAddMultiple, mNDel, + mNKind, mNSymKind, + + mNccValue, mNccInc, mNcsAdd, mNcsIncl, mNcsLen, mNcsAt, + mNctPut, mNctLen, mNctGet, mNctHasNext, mNctNext, + + mNIntVal, mNFloatVal, mNSymbol, mNIdent, mNGetType, mNStrVal, mNSetIntVal, + mNSetFloatVal, mNSetSymbol, mNSetIdent, mNSetStrVal, mNLineInfo, + mNNewNimNode, mNCopyNimNode, mNCopyNimTree, mStrToIdent, mNSigHash, mNSizeOf, + mNBindSym, mNCallSite, + mEqIdent, mEqNimrodNode, mSameNodeType, mGetImpl, mNGenSym, + mNHint, mNWarning, mNError, + mInstantiationInfo, mGetTypeInfo, mGetTypeInfoV2, + mNimvm, mIntDefine, mStrDefine, mBoolDefine, mGenericDefine, mRunnableExamples, + mException, mBuiltinType, mSymOwner, mUncheckedArray, mGetImplTransf, + mSymIsInstantiationOf, mNodeId, mPrivateAccess, mZeroDefault + + +const + # things that we can evaluate safely at compile time, even if not asked for it: + ctfeWhitelist* = {mNone, mSucc, + mPred, mInc, mDec, mOrd, mLengthOpenArray, + mLengthStr, mLengthArray, mLengthSeq, + mArrGet, mArrPut, mAsgn, mDestroy, + mIncl, mExcl, mCard, mChr, + mAddI, mSubI, mMulI, mDivI, mModI, + mAddF64, mSubF64, mMulF64, mDivF64, + mShrI, mShlI, mBitandI, mBitorI, mBitxorI, + mMinI, mMaxI, + mAddU, mSubU, mMulU, mDivU, mModU, + mEqI, mLeI, mLtI, + mEqF64, mLeF64, mLtF64, + mLeU, mLtU, + mEqEnum, mLeEnum, mLtEnum, + mEqCh, mLeCh, mLtCh, + mEqB, mLeB, mLtB, + mEqRef, mEqProc, mLePtr, mLtPtr, mEqCString, mXor, + mUnaryMinusI, mUnaryMinusI64, mAbsI, mNot, mUnaryPlusI, mBitnotI, + mUnaryPlusF64, mUnaryMinusF64, + mCharToStr, mBoolToStr, + mCStrToStr, + mStrToStr, mEnumToStr, + mAnd, mOr, + mEqStr, mLeStr, mLtStr, + mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, mXorSet, + mConStrStr, mAppendStrCh, mAppendStrStr, mAppendSeqElem, + mInSet, mRepr, mOpenArrayToSeq} + + generatedMagics* = {mNone, mIsolate, mFinished, mOpenArrayToSeq} + ## magics that are generated as normal procs in the backend + +type + ItemId* = object + module*: int32 + item*: int32 + +proc `$`*(x: ItemId): string = + "(module: " & $x.module & ", item: " & $x.item & ")" + +proc `==`*(a, b: ItemId): bool {.inline.} = + a.item == b.item and a.module == b.module + +proc hash*(x: ItemId): Hash = + var h: Hash = hash(x.module) + h = h !& hash(x.item) + result = !$h + + +type + PNode* = ref TNode + TNodeSeq* = seq[PNode] + PType* = ref TType + PSym* = ref TSym + TNode*{.final, acyclic.} = object # on a 32bit machine, this takes 32 bytes + when defined(useNodeIds): + id*: int + typField*: PType + info*: TLineInfo + flags*: TNodeFlags + case kind*: TNodeKind + of nkCharLit..nkUInt64Lit: + intVal*: BiggestInt + of nkFloatLit..nkFloat128Lit: + floatVal*: BiggestFloat + of nkStrLit..nkTripleStrLit: + strVal*: string + of nkSym: + sym*: PSym + of nkIdent: + ident*: PIdent + else: + sons*: TNodeSeq + when defined(nimsuggest): + endInfo*: TLineInfo + + TStrTable* = object # a table[PIdent] of PSym + counter*: int + data*: seq[PSym] + + # -------------- backend information ------------------------------- + TLocKind* = enum + locNone, # no location + locTemp, # temporary location + locLocalVar, # location is a local variable + locGlobalVar, # location is a global variable + locParam, # location is a parameter + locField, # location is a record field + locExpr, # "location" is really an expression + locProc, # location is a proc (an address of a procedure) + locData, # location is a constant + locCall, # location is a call expression + locOther # location is something other + TLocFlag* = enum + lfIndirect, # backend introduced a pointer + lfNoDeepCopy, # no need for a deep copy + lfNoDecl, # do not declare it in C + lfDynamicLib, # link symbol to dynamic library + lfExportLib, # export symbol for dynamic library generation + lfHeader, # include header file for symbol + lfImportCompilerProc, # ``importc`` of a compilerproc + lfSingleUse # no location yet and will only be used once + lfEnforceDeref # a copyMem is required to dereference if this a + # ptr array due to C array limitations. + # See #1181, #6422, #11171 + lfPrepareForMutation # string location is about to be mutated (V2) + TStorageLoc* = enum + OnUnknown, # location is unknown (stack, heap or static) + OnStatic, # in a static section + OnStack, # location is on hardware stack + OnHeap # location is on heap or global + # (reference counting needed) + TLocFlags* = set[TLocFlag] + TLoc* = object + k*: TLocKind # kind of location + storage*: TStorageLoc + flags*: TLocFlags # location's flags + lode*: PNode # Node where the location came from; can be faked + snippet*: Rope # C code snippet of location (code generators) + + # ---------------- end of backend information ------------------------------ + + TLibKind* = enum + libHeader, libDynamic + + TLib* = object # also misused for headers! + # keep in sync with PackedLib + kind*: TLibKind + generated*: bool # needed for the backends: + isOverridden*: bool + name*: Rope + path*: PNode # can be a string literal! + + + CompilesId* = int ## id that is used for the caching logic within + ## ``system.compiles``. See the seminst module. + TInstantiation* = object + sym*: PSym + concreteTypes*: seq[PType] + genericParamsCount*: int # for terrible reasons `concreteTypes` contains all the types, + # so we need to know how many generic params there were + # this is not serialized for IC and that is fine. + compilesId*: CompilesId + + PInstantiation* = ref TInstantiation + + TScope* {.acyclic.} = object + depthLevel*: int + symbols*: TStrTable + parent*: PScope + allowPrivateAccess*: seq[PSym] # # enable access to private fields + optionStackLen*: int + + PScope* = ref TScope + + ItemState* = enum + Complete # completely in memory + Partial # partially in memory + Sealed # complete in memory, already written to NIF file, so further mutations are not allowed + + PLib* = ref TLib + TSym* {.acyclic.} = object # Keep in sync with ast2nif.nim + itemId*: ItemId + # proc and type instantiations are cached in the generic symbol + state*: ItemState + case kindImpl*: TSymKind # Note: kept as 'kind' for case statement, but accessor checks state + of routineKinds: + #procInstCache*: seq[PInstantiation] + gcUnsafetyReasonImpl*: PSym # for better error messages regarding gcsafe + transformedBodyImpl*: PNode # cached body after transf pass + of skLet, skVar, skField, skForVar: + guardImpl*: PSym + bitsizeImpl*: int + alignmentImpl*: int # for alignment + else: nil + magicImpl*: TMagic + typImpl*: PType + name*: PIdent + infoImpl*: TLineInfo + when defined(nimsuggest): + endInfoImpl*: TLineInfo + hasUserSpecifiedTypeImpl*: bool # used for determining whether to display inlay type hints + ownerFieldImpl*: PSym + flagsImpl*: TSymFlags + astImpl*: PNode # syntax tree of proc, iterator, etc.: + # the whole proc including header; this is used + # for easy generation of proper error messages + # for variant record fields the discriminant + # expression + # for modules, it's a placeholder for compiler + # generated code that will be appended to the + # module after the sem pass (see appendToModule) + optionsImpl*: TOptions + positionImpl*: int # used for many different things: + # for enum fields its position; + # for fields its offset + # for parameters its position (starting with 0) + # for a conditional: + # 1 iff the symbol is defined, else 0 + # (or not in symbol table) + # for modules, an unique index corresponding + # to the module's fileIdx + # for variables a slot index for the evaluator + offsetImpl*: int32 # offset of record field + disamb*: int32 # disambiguation number; the basic idea is that + # `___` is unique + locImpl*: TLoc + annexImpl*: PLib # additional fields (seldom used, so we use a + # reference to another object to save space) + when hasFFI: + cnameImpl*: string # resolved C declaration name in importc decl, e.g.: + # proc fun() {.importc: "$1aux".} => cname = funaux + constraintImpl*: PNode # additional constraints like 'lit|result'; also + # misused for the codegenDecl and virtual pragmas in the hope + # it won't cause problems + # for skModule the string literal to output for + # deprecated modules. + instantiatedFromImpl*: PSym # for instances, the generic symbol where it came from. + when defined(nimsuggest): + allUsagesImpl*: seq[TLineInfo] + + TTypeSeq* = seq[PType] + + TTypeAttachedOp* = enum ## as usual, order is important here + attachedWasMoved, + attachedDestructor, + attachedAsgn, + attachedDup, + attachedSink, + attachedTrace, + attachedDeepCopy + + 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 + state*: ItemState + uniqueId*: ItemId # due to a design mistake, we need to keep the real ID here as it + # is required by the --incremental:on mode. + callConvImpl*: TCallingConvention # for procs + flagsImpl*: TTypeFlags # flags of the type + sonsImpl*: TTypeSeq # base types, etc. + nImpl*: PNode # node for types: + # for range types a nkRange node + # for record types a nkRecord node + # for enum types a list of symbols + # if kind == tyInt: it is an 'int literal(x)' type + # for procs and tyGenericBody, it's the + # formal param list + # for concepts, the concept body + # else: unused + ownerFieldImpl*: PSym # the 'owner' of the type + symImpl*: PSym # types have the sym associated with them + # it is used for converting types to strings + sizeImpl*: BiggestInt # the size of the type in bytes + # -1 means that the size is unknown + alignImpl*: int16 # the type's alignment requirements + paddingAtEndImpl*: int16 # + locImpl*: TLoc + typeInstImpl*: PType # for generic instantiations the tyGenericInst that led to this + # type. + + TPair* = object + key*, val*: RootRef + + TPairSeq* = seq[TPair] + + TIdPair*[T] = object + key*: ItemId + val*: T + + TIdPairSeq*[T] = seq[TIdPair[T]] + TIdTable*[T] = object + counter*: int + data*: TIdPairSeq[T] + + TNodePair* = object + h*: Hash # because it is expensive to compute! + key*: PNode + val*: int + + TNodePairSeq* = seq[TNodePair] + TNodeTable* = object # the same as table[PNode] of int; + # nodes are compared by structure! + counter*: int + data*: TNodePairSeq + ignoreTypes*: bool + + TObjectSeq* = seq[RootRef] + TObjectSet* = object + counter*: int + data*: TObjectSeq + + TImplication* = enum + impUnknown, impNo, impYes + + +const + OverloadableSyms* = {skProc, skFunc, skMethod, skIterator, + skConverter, skModule, skTemplate, skMacro, skEnumField} + + GenericTypes*: TTypeKinds = {tyGenericInvocation, tyGenericBody, + tyGenericParam} + + StructuralEquivTypes*: TTypeKinds = {tyNil, tyTuple, tyArray, + tySet, tyRange, tyPtr, tyRef, tyVar, tyLent, tySequence, tyProc, tyOpenArray, + tyVarargs} + + ConcreteTypes*: TTypeKinds = { # types of the expr that may occur in:: + # var x = expr + tyBool, tyChar, tyEnum, tyArray, tyObject, + tySet, tyTuple, tyRange, tyPtr, tyRef, tyVar, tyLent, tySequence, tyProc, + tyPointer, + tyOpenArray, tyString, tyCstring, tyInt..tyInt64, tyFloat..tyFloat128, + tyUInt..tyUInt64} + IntegralTypes* = {tyBool, tyChar, tyEnum, tyInt..tyInt64, + tyFloat..tyFloat128, tyUInt..tyUInt64} # weird name because it contains tyFloat + ConstantDataTypes*: TTypeKinds = {tyArray, tySet, + tyTuple, tySequence} + NilableTypes*: TTypeKinds = {tyPointer, tyCstring, tyRef, tyPtr, + tyProc, tyError} # TODO + PtrLikeKinds*: TTypeKinds = {tyPointer, tyPtr} # for VM + PersistentNodeFlags*: TNodeFlags = {nfBase2, nfBase8, nfBase16, + nfDotSetter, nfDotField, + nfIsRef, nfIsPtr, nfPreventCg, nfLL, + nfFromTemplate, nfDefaultRefsParam, + nfExecuteOnReload, nfLastRead, + nfFirstWrite, nfSkipFieldChecking, + nfDisabledOpenSym, nfLazyType} + namePos* = 0 + patternPos* = 1 # empty except for term rewriting macros + genericParamsPos* = 2 + paramsPos* = 3 + pragmasPos* = 4 + miscPos* = 5 # used for undocumented and hacky stuff + bodyPos* = 6 # position of body; use rodread.getBody() instead! + resultPos* = 7 + dispatcherPos* = 8 + + nfAllFieldsSet* = nfBase2 + + nkIdentKinds* = {nkIdent, nkSym, nkAccQuoted, nkOpenSymChoice, + nkClosedSymChoice, nkOpenSym} + + nkPragmaCallKinds* = {nkExprColonExpr, nkCall, nkCallStrLit} + nkLiterals* = {nkCharLit..nkTripleStrLit} + nkFloatLiterals* = {nkFloatLit..nkFloat128Lit} + nkLambdaKinds* = {nkLambda, nkDo} + declarativeDefs* = {nkProcDef, nkFuncDef, nkMethodDef, nkIteratorDef, nkConverterDef} + routineDefs* = declarativeDefs + {nkMacroDef, nkTemplateDef} + procDefs* = nkLambdaKinds + declarativeDefs + callableDefs* = nkLambdaKinds + routineDefs + + nkSymChoices* = {nkClosedSymChoice, nkOpenSymChoice} + nkStrKinds* = {nkStrLit..nkTripleStrLit} + + skLocalVars* = {skVar, skLet, skForVar, skParam, skResult} + skProcKinds* = {skProc, skFunc, skTemplate, skMacro, skIterator, + skMethod, skConverter} + + defaultSize* = -1 + defaultAlignment* = -1 + defaultOffset* = -1 + + +proc len*(n: PNode): int {.inline.} = + result = n.sons.len + +proc safeLen*(n: PNode): int {.inline.} = + ## works even for leaves. + if n.kind in {nkNone..nkNilLit}: result = 0 + else: result = n.len + +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 + +iterator items*(n: PNode): PNode = + for i in 0.. 0: + newSeq(result.sons, children) + setIdMaybe() + +proc newNodeIT*(kind: TNodeKind, info: TLineInfo, typ: PType): PNode = + ## new node with line info, type, and no children + result = newNode(kind) + result.info = info + result.typField = typ + +proc newNode*(kind: TNodeKind, info: TLineInfo): PNode = + ## new node with line info, no type, and no children + newNodeImpl(info) + setIdMaybe() + +proc newIdentNode*(ident: PIdent, info: TLineInfo): PNode = + result = newNode(nkIdent) + result.ident = ident + result.info = info + +proc newSymNode*(sym: PSym, info: TLineInfo): PNode = + result = newNode(nkSym) + result.sym = sym + result.typField = sym.typImpl + result.info = info + +proc newStrNode*(kind: TNodeKind, strVal: string): PNode = + result = newNode(kind) + result.strVal = strVal + +proc newStrNode*(strVal: string; info: TLineInfo): PNode = + result = newNodeI(nkStrLit, info) + result.strVal = strVal + +# Hooks, converters, method dispatchers and enum-to-string generated procs need special +# handling for IC, they end up in IC indexes etc. Thus we "log" them in the module graph +# and to pass them around to the NIF writer. This is not very elegant but it works. + +type + LogEntryKind* = enum + HookEntry, ConverterEntry, MethodEntry, EnumToStrEntry, GenericInstEntry + LogEntry* = object + kind*: LogEntryKind + op*: TTypeAttachedOp + isGeneric*: bool + module*: int # Which module this entry belongs to + key*: string + sym*: PSym + + +proc forcePartial*(s: PSym) = + ## Resets all impl-fields to their default values and sets state to Partial. + ## This is useful for creating a stub symbol that can be lazily loaded later. + ## The fields itemId, name, and disamb are preserved. + s.state = Partial + case s.kindImpl + of routineKinds: + s.gcUnsafetyReasonImpl = nil + s.transformedBodyImpl = nil + of skLet, skVar, skField, skForVar: + s.guardImpl = nil + s.bitsizeImpl = 0 + s.alignmentImpl = 0 # for alignment + else: discard + s.magicImpl = mNone + s.typImpl = nil + s.infoImpl = unknownLineInfo + s.ownerFieldImpl = nil + s.flagsImpl = {} + s.astImpl = nil + s.optionsImpl = {} + s.positionImpl = 0 + s.offsetImpl = 0 + s.locImpl = TLoc() + s.annexImpl = nil + s.constraintImpl = nil + s.instantiatedFromImpl = nil + when defined(nimsuggest): + s.endInfoImpl = unknownLineInfo + s.hasUserSpecifiedTypeImpl = false + s.allUsagesImpl = @[] + when hasFFI: + s.cnameImpl = "" + +proc forcePartial*(t: PType) = + ## Resets all impl-fields to their default values and sets state to Partial. + ## This is useful for creating a stub type that can be lazily loaded later. + ## The fields itemId, kind, uniqueId are preserved. + t.state = Partial + t.callConvImpl = ccNimCall + t.flagsImpl = {} + t.sonsImpl = @[] + t.nImpl = nil + t.ownerFieldImpl = nil + t.symImpl = nil + t.sizeImpl = defaultSize + t.alignImpl = defaultAlignment + t.paddingAtEndImpl = 0'i16 + t.locImpl = TLoc() + t.typeInstImpl = nil + +const # for all kind of hash tables: + GrowthFactor* = 2 # must be power of 2, > 0 + StartSize* = 8 # must be power of 2, > 0 + +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 + # random-number generation for proof). + +proc mustRehash*(length, counter: int): bool = + assert(length > counter) + result = (length * 2 < counter * 3) or (length - counter < 4) + +proc strTableContains*(t: TStrTable, n: PSym): bool = + var h: Hash = n.name.h and high(t.data) # start with real hash value + while t.data[h] != nil: + if (t.data[h] == n): + return true + h = nextTry(h, high(t.data)) + result = false + +proc strTableRawInsert(data: var seq[PSym], n: PSym) = + var h: Hash = n.name.h and high(data) + while data[h] != nil: + if data[h] == n: + # allowed for 'export' feature: + #InternalError(n.info, "StrTableRawInsert: " & n.name.s) + return + h = nextTry(h, high(data)) + assert(data[h] == nil) + data[h] = n + +proc symTabReplaceRaw(data: var seq[PSym], prevSym: PSym, newSym: PSym) = + assert prevSym.name.h == newSym.name.h + var h: Hash = prevSym.name.h and high(data) + while data[h] != nil: + if data[h] == prevSym: + data[h] = newSym + return + h = nextTry(h, high(data)) + assert false + +proc symTabReplace*(t: var TStrTable, prevSym: PSym, newSym: PSym) = + symTabReplaceRaw(t.data, prevSym, newSym) + +proc strTableEnlarge(t: var TStrTable) = + var n: seq[PSym] + newSeq(n, t.data.len * GrowthFactor) + for i in 0..high(t.data): + if t.data[i] != nil: strTableRawInsert(n, t.data[i]) + swap(t.data, n) + +proc strTableAdd*(t: var TStrTable, n: PSym) = + if mustRehash(t.data.len, t.counter): strTableEnlarge(t) + strTableRawInsert(t.data, n) + inc(t.counter) + +proc strTableInclReportConflict*(t: var TStrTable, n: PSym; + onConflictKeepOld = false): PSym = + # if `t` has a conflicting symbol (same identifier as `n`), return it + # otherwise return `nil`. Incl `n` to `t` unless `onConflictKeepOld = true` + # and a conflict was found. + assert n.name != nil + var h: Hash = n.name.h and high(t.data) + var replaceSlot = -1 + while true: + var it = t.data[h] + if it == nil: break + # Semantic checking can happen multiple times thanks to templates + # and overloading: (var x=@[]; x).mapIt(it). + # So it is possible the very same sym is added multiple + # times to the symbol table which we allow here with the 'it == n' check. + if it.name.id == n.name.id: + if it == n: return nil + replaceSlot = h + h = nextTry(h, high(t.data)) + if replaceSlot >= 0: + result = t.data[replaceSlot] # found it + if not onConflictKeepOld: + t.data[replaceSlot] = n # overwrite it with newer definition! + return result # but return the old one + elif mustRehash(t.data.len, t.counter): + strTableEnlarge(t) + strTableRawInsert(t.data, n) + else: + assert(t.data[h] == nil) + t.data[h] = n + inc(t.counter) + result = nil + +proc strTableIncl*(t: var TStrTable, n: PSym; + onConflictKeepOld = false): bool {.discardable.} = + result = strTableInclReportConflict(t, n, onConflictKeepOld) != nil + +proc strTableGet*(t: TStrTable, name: PIdent): PSym = + var h: Hash = name.h and high(t.data) + while true: + result = t.data[h] + if result == nil: break + if result.name.id == name.id: break + h = nextTry(h, high(t.data)) diff --git a/compiler/cbuilderdecls.nim b/compiler/cbuilderdecls.nim index 0b170c7183..eb6dd3d627 100644 --- a/compiler/cbuilderdecls.nim +++ b/compiler/cbuilderdecls.nim @@ -154,14 +154,14 @@ template addField(builder: var Builder, constr: var StructInitializer, name: str # no name, can just add value valueBody of siOrderedStruct: - # no name, can just add value on C - assert name.len != 0, "name has to be given for struct initializer field" + # positional init - name not used in output (empty allowed for anonymous unions) valueBody of siNamedStruct: - assert name.len != 0, "name has to be given for struct initializer field" - builder.add(".") - builder.add(name) - builder.add(" = ") + # designated init - empty name for anonymous unions (skips .name = prefix) + if name.len != 0: + builder.add(".") + builder.add(name) + builder.add(" = ") valueBody proc finishStructInitializer(builder: var Builder, constr: StructInitializer) = diff --git a/compiler/ccgcalls.nim b/compiler/ccgcalls.nim index 02e689071c..f4169315e4 100644 --- a/compiler/ccgcalls.nim +++ b/compiler/ccgcalls.nim @@ -368,8 +368,8 @@ proc genArg(p: BProc, n: PNode, param: PSym; call: PNode; result: var Builder; n # 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 + n.typ = n.typ.exactReplica + n.typ.incl tfVarIsPtr a = initLocExprSingleUse(p, n) a = withTmpIfNeeded(p, a, needsTmp) if needsIndirect: a.flags.incl lfIndirect @@ -498,7 +498,7 @@ proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = else: cCall(p, params, e) cIfExpr(e, - eCall, + eCall, cCall(cCast(pTyp, p), params)) template callIter(rp, params: Snippet): Snippet = diff --git a/compiler/ccgexprs.nim b/compiler/ccgexprs.nim index d3e215ea56..e4e51f65be 100644 --- a/compiler/ccgexprs.nim +++ b/compiler/ccgexprs.nim @@ -170,7 +170,7 @@ proc canMove(p: BProc, n: PNode; dest: TLoc): bool = template simpleAsgn(builder: var Builder, dest, src: TLoc) = let rd = rdLoc(dest) let rs = rdLoc(src) - builder.addAssignment(rd, rs) + builder.addAssignment(rd, rs) proc genRefAssign(p: BProc, dest, src: TLoc) = if (dest.storage == OnStack and p.config.selectedGC != gcGo) or not usesWriteBarrier(p.config): @@ -675,7 +675,7 @@ proc binaryArithOverflow(p: BProc, e: PNode, d: var TLoc, m: TMagic) = if e[2].kind in {nkIntLit..nkInt64Lit}: needsOverflowCheck = e[2].intVal == -1 if canBeZero: - # remove extra paren from `==` op here to avoid Wparentheses-equality: + # remove extra paren from `==` op here to avoid Wparentheses-equality: p.s(cpsStmts).addSingleIfStmt(removeSinglePar(cOp(Equal, rdLoc(b), cIntValue(0)))): p.s(cpsStmts).addCallStmt(cgsymValue(p.module, "raiseDivByZero")) raiseInstr(p, p.s(cpsStmts)) @@ -696,7 +696,7 @@ proc unaryArithOverflow(p: BProc, e: PNode, d: var TLoc, m: TMagic) = let ra = rdLoc(a) if optOverflowCheck in p.options: let first = cIntLiteral(firstOrd(p.config, t)) - # remove extra paren from `==` op here to avoid Wparentheses-equality: + # remove extra paren from `==` op here to avoid Wparentheses-equality: p.s(cpsStmts).addSingleIfStmt(removeSinglePar(cOp(Equal, ra, first))): p.s(cpsStmts).addCallStmt(cgsymValue(p.module, "raiseOverflow")) raiseInstr(p, p.s(cpsStmts)) @@ -749,16 +749,16 @@ proc binaryArith(p: BProc, e: PNode, d: var TLoc, op: TMagic) = let t = getType() let at = cUintType(k) let bt = cUintType(s) - res = cCast(t, cOp(Shr, at, cCast(at, ra), cCast(bt, rb))) + res = cCast(t, cOp(Shr, at, cCast(at, ra), cOp(BitAnd, at, cCast(bt, rb), cIntLiteral(k - 1)))) of mShlI: let t = getType() let at = cUintType(s) - res = cCast(t, cOp(Shl, at, cCast(at, ra), cCast(at, rb))) + res = cCast(t, cOp(Shl, at, cCast(at, ra), cOp(BitAnd, at, cCast(at, rb), cIntLiteral(k - 1)))) of mAshrI: let t = getType() let at = cIntType(s) let bt = cUintType(s) - res = cCast(t, cOp(Shr, at, cCast(at, ra), cCast(bt, rb))) + res = cCast(t, cOp(Shr, at, cCast(at, ra), cOp(BitAnd, at, cCast(bt, rb), cIntLiteral(k - 1)))) of mBitandI: let t = getType() res = cCast(t, cOp(BitAnd, t, ra, rb)) @@ -919,6 +919,10 @@ proc genDeref(p: BProc, e: PNode, d: var TLoc) = return else: a = initLocExprSingleUse(p, e[0]) + + if e.typ != nil and e.typ.kind == tyObject: + # bug #23453 #25265 + discard getTypeDesc(p.module, e.typ) if d.k == locNone: # dest = *a; <-- We do not know that 'dest' is on the heap! # It is completely wrong to set 'd.storage' here, unless it's not yet @@ -1002,7 +1006,7 @@ proc genTupleElem(p: BProc, e: PNode, d: var TLoc) = var i: int = 0 var a: TLoc = initLocExpr(p, e[0]) - let tupType = a.t.skipTypes(abstractInst+{tyVar}) + let tupType = a.t.skipTypes(abstractInst+{tyVar}+tyUserTypeClasses) # ref #25227 assert tupType.kind == tyTuple d.inheritLocation(a) discard getTypeDesc(p.module, a.t) # fill the record's fields.loc @@ -1912,7 +1916,7 @@ proc genSeqConstr(p: BProc, n: PNode, d: var TLoc) = proc genArrToSeq(p: BProc, n: PNode, d: var TLoc) = var elem, arr: TLoc if n[1].kind == nkBracket: - n[1].typ() = n.typ + n[1].typ = n.typ genSeqConstr(p, n[1], d) return if d.k == locNone: @@ -3359,8 +3363,9 @@ proc genConstSetup(p: BProc; sym: PSym): bool = useHeader(m, sym) if sym.loc.k == locNone: fillBackendName(p.module, sym) - fillLoc(sym.loc, locData, sym.astdef, OnStatic) - if m.hcrOn: incl(sym.loc.flags, lfIndirect) + backendEnsureMutable sym + fillLoc(sym.locImpl, locData, sym.astdef, OnStatic) + if m.hcrOn: incl(sym, lfIndirect) result = lfNoDecl notin sym.loc.flags proc genConstHeader(m, q: BModule; p: BProc, sym: PSym) = @@ -3430,7 +3435,7 @@ proc genConstDefinition(q: BModule; p: BProc; sym: PSym) = proc genConstStmt(p: BProc, n: PNode) = # This code is only used in the new DCE implementation. - assert useAliveDataFromDce in p.module.flags + assert delayedCodegen(p.module) let m = p.module for it in n: if it[0].kind == nkSym: @@ -3448,7 +3453,7 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = var sym = n.sym case sym.kind of skMethod: - if useAliveDataFromDce in p.module.flags or {sfDispatcher, sfForward} * sym.flags != {}: + if delayedCodegen(p.module) or {sfDispatcher, sfForward} * sym.flags != {}: # we cannot produce code for the dispatcher yet: fillProcLoc(p.module, n) genProcPrototype(p.module, sym) @@ -3461,11 +3466,15 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = if sfCompileTime in sym.flags: localError(p.config, n.info, "request to generate code for .compileTime proc: " & sym.name.s) - if useAliveDataFromDce in p.module.flags and sym.typ.callConv != ccInline: + if delayedCodegen(p.module) and sym.typ.callConv != ccInline: fillProcLoc(p.module, n) genProcPrototype(p.module, sym) else: genProc(p.module, sym) + # For cross-module inline procs with optCompress, ensure prototype is emitted + if sym.typ.callConv == ccInline and optCompress in p.config.globalOptions and + sym.itemId.module != p.module.module.position: + genProcPrototype(p.module, sym) 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) @@ -3474,7 +3483,13 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = var lit = newBuilder("") genLiteral(p, sym.astdef, sym.typ, lit) putIntoDest(p, d, n, extract(lit), OnStatic) - elif useAliveDataFromDce in p.module.flags: + elif optCompress in p.config.globalOptions: + # With delayed codegen, we need to ensure the definition is generated + # not just the extern header declaration + requestConstImpl(p, sym) + assert((sym.loc.snippet != "") and (sym.loc.t != nil)) + putLocIntoDest(p, d, sym.loc) + elif delayedCodegen(p.module): genConstHeader(p.module, p.module, p, sym) assert((sym.loc.snippet != "") and (sym.loc.t != nil)) putLocIntoDest(p, d, sym.loc) @@ -3606,7 +3621,7 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = of nkWhileStmt: genWhileStmt(p, n) of nkVarSection, nkLetSection: genVarStmt(p, n) of nkConstSection: - if useAliveDataFromDce in p.module.flags: + if delayedCodegen(p.module): genConstStmt(p, n) else: # enforce addressable consts for exportc let m = p.module @@ -3672,7 +3687,10 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = of nkProcDef, nkFuncDef, nkMethodDef, nkConverterDef: if n[genericParamsPos].kind == nkEmpty: var prc = n[namePos].sym - if useAliveDataFromDce in p.module.flags: + if optCompress in p.config.globalOptions: + if prc.magic in generatedMagics: + genProc(p.module, prc) + elif delayedCodegen(p.module): if p.module.alive.contains(prc.itemId.item) and prc.magic in generatedMagics: genProc(p.module, prc) @@ -3692,9 +3710,67 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = inc p.splitDecls genGotoState(p, n) of nkBreakState: genBreakState(p, n, d) - of nkMixinStmt, nkBindStmt: discard + of nkMixinStmt, nkBindStmt, nkReplayAction: discard else: internalError(p.config, n.info, "expr(" & $n.kind & "); unknown node kind") +proc isOpaqueImportcType(t: PType): bool = + # importc type without completeStruct that can't use aggregate init (e.g. C11 _Atomic) + if t.sym != nil and sfImportc in t.sym.flags: + if tfCompleteStruct notin t.flags: + if tfIncompleteStruct in t.flags: + return true + if t.kind == tyObject and (t.n == nil or t.n.len == 0): + return true + return false + +proc containsOpaqueImportcField(typ: PType): bool + +proc containsOpaqueImportcFieldAux(t: PType; n: PNode): bool = + if n == nil: return false + case n.kind + of nkRecList: + for child in n.sons: + if containsOpaqueImportcFieldAux(t, child): + return true + of nkRecCase: + if containsOpaqueImportcFieldAux(t, n[0]): + return true + for i in 1.. 0) and noSafePoints notin p.flags: # If we're in a finally block, and we came here by exception # consume it before we return. @@ -736,8 +743,10 @@ proc genBlock(p: BProc, n: PNode, d: var TLoc) = # named block? assert(n[0].kind == nkSym) var sym = n[0].sym - sym.loc.k = locOther - sym.position = p.breakIdx+1 + backendEnsureMutable sym + sym.locImpl.k = locOther + sym.positionImpl = p.breakIdx+1 + # ^ IC: review this expr(p, n[1], d) endSimpleBlock(p, scope) @@ -1250,7 +1259,8 @@ proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = initElifBranch(p.s(cpsStmts), ifStmt, orExpr) if exvar != nil: fillLocalName(p, exvar.sym) - fillLoc(exvar.sym.loc, locTemp, exvar, OnStack) + backendEnsureMutable exvar.sym + fillLoc(exvar.sym.locImpl, locTemp, exvar, OnStack) linefmt(p, cpsStmts, "$1 $2 = T$3_;$n", [getTypeDesc(p.module, exvar.sym.typ), rdLoc(exvar.sym.loc), rope(etmp+1)]) # we handled the error: @@ -1298,7 +1308,8 @@ proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = if isImportedException(typeNode.typ, p.config): let exvar = t[i][j][2] # ex1 in `except ExceptType as ex1:` fillLocalName(p, exvar.sym) - fillLoc(exvar.sym.loc, locTemp, exvar, OnStack) + backendEnsureMutable exvar.sym + fillLoc(exvar.sym.locImpl, locTemp, exvar, OnStack) startBlockWith(p): lineCg(p, cpsStmts, "catch ($1& $2) {$n", [getTypeDesc(p.module, typeNode.typ), rdLoc(exvar.sym.loc)]) genExceptBranchBody(t[i][^1]) # exception handler body will duplicated for every type @@ -1389,7 +1400,8 @@ proc genTryCppOld(p: BProc, t: PNode, d: var TLoc) = if t[i][j].isInfixAs(): let exvar = t[i][j][2] # ex1 in `except ExceptType as ex1:` fillLocalName(p, exvar.sym) - fillLoc(exvar.sym.loc, locTemp, exvar, OnUnknown) + backendEnsureMutable exvar.sym + fillLoc(exvar.sym.locImpl, locTemp, exvar, OnUnknown) startBlockWith(p): lineCg(p, cpsStmts, "catch ($1& $2) {$n", [getTypeDesc(p.module, t[i][j][1].typ), rdLoc(exvar.sym.loc)]) else: diff --git a/compiler/ccgtypes.nim b/compiler/ccgtypes.nim index 2d8981704e..6a74f4a298 100644 --- a/compiler/ccgtypes.nim +++ b/compiler/ccgtypes.nim @@ -11,7 +11,7 @@ # ------------------------- Name Mangling -------------------------------- -import sighashes, modulegraphs, std/strscans +import sighashes, std/strscans import ../dist/checksums/src/checksums/md5 import std/sequtils @@ -75,7 +75,7 @@ proc mangleProc(m: BModule; s: PSym; makeUnique: bool): string = proc fillBackendName(m: BModule; s: PSym) = if s.loc.snippet == "": var result: Rope - if not m.compileToCpp and s.kind in routineKinds and optCDebug in m.g.config.globalOptions and + if s.kind in routineKinds and {optCDebug, optItaniumMangle} * m.g.config.globalOptions == {optCDebug, optItaniumMangle} and m.g.config.symbolFiles == disabledSf: result = mangleProc(m, s, false).rope else: @@ -84,7 +84,8 @@ proc fillBackendName(m: BModule; s: PSym) = if m.hcrOn: result.add '_' result.add(idOrSig(s, m.module.name.s.mangle, m.sigConflicts, m.config)) - s.loc.snippet = result + backendEnsureMutable s + s.locImpl.snippet = result proc fillParamName(m: BModule; s: PSym) = if s.loc.snippet == "": @@ -107,7 +108,8 @@ 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.snippet = res.rope + backendEnsureMutable s + s.locImpl.snippet = res.rope proc fillLocalName(p: BProc; s: PSym) = assert s.kind in skLocalVars+{skTemp} @@ -122,7 +124,8 @@ proc fillLocalName(p: BProc; s: PSym) = elif s.kind != skResult: result.add "_" & rope(counter+1) p.sigConflicts.inc(key) - s.loc.snippet = result + backendEnsureMutable s + s.locImpl.snippet = result proc scopeMangledParam(p: BProc; param: PSym) = ## parameter generation only takes BModule, not a BProc, so we have to @@ -156,8 +159,9 @@ proc getTypeName(m: BModule; typ: PType; sig: SigHash): Rope = break 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 + backendEnsureMutable typ + typ.typeName(typ.locImpl.snippet) + typ.locImpl.snippet.add $sig else: when defined(debugSigHashes): # check consistency: @@ -247,6 +251,7 @@ proc isOrHasImportedCppType(typ: PType): bool = searchTypeFor(typ.skipTypes({tyRef}), isImportedCppType) proc hasNoInit(t: PType): bool = + let t = skipTypes(t, {tyGenericInst}) result = t.sym != nil and sfNoInit in t.sym.flags proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDescKind): Rope @@ -299,12 +304,13 @@ proc addAbiCheck(m: BModule; t: PType, name: Rope) = proc fillResult(conf: ConfigRef; param: PNode, proctype: PType) = - fillLoc(param.sym.loc, locParam, param, "Result", + ensureMutable param.sym + fillLoc(param.sym.locImpl, locParam, param, "Result", OnStack) let t = param.sym.typ if mapReturnType(conf, t) != ctArray and isInvalidReturnType(conf, proctype): - incl(param.sym.loc.flags, lfIndirect) - param.sym.loc.storage = OnUnknown + incl(param.sym.locImpl.flags, lfIndirect) + param.sym.locImpl.storage = OnUnknown proc typeNameOrLiteral(m: BModule; t: PType, literal: string): Rope = if t.sym != nil and sfImportc in t.sym.flags and t.sym.magic == mNone: @@ -523,14 +529,15 @@ proc genMemberProcParams(m: BModule; prc: PSym, superCall, rettype, name, params var types, names, args: seq[string] = @[] if not isCtor: var this = t.n[1].sym + ensureMutable this fillParamName(m, this) - fillLoc(this.loc, locParam, t.n[1], + fillLoc(this.locImpl, locParam, t.n[1], this.paramStorageLoc) if this.typ.kind == tyPtr: - this.loc.snippet = "this" + this.locImpl.snippet = "this" else: - this.loc.snippet = "(*this)" - names.add this.loc.snippet + this.locImpl.snippet = "(*this)" + names.add this.locImpl.snippet types.add getTypeDescWeak(m, this.typ, check, dkParam) let firstParam = if isCtor: 1 else: 2 @@ -544,13 +551,14 @@ proc genMemberProcParams(m: BModule; prc: PSym, superCall, rettype, name, params else: descKind = dkRefParam var typ, name: string + ensureMutable param fillParamName(m, param) - fillLoc(param.loc, locParam, t.n[i], + fillLoc(param.locImpl, locParam, t.n[i], param.paramStorageLoc) 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 + incl(param.locImpl.flags, lfIndirect) + param.locImpl.storage = OnUnknown elif weakDep: typ = getTypeDescWeak(m, param.typ, check, descKind) else: @@ -558,7 +566,7 @@ proc genMemberProcParams(m: BModule; prc: PSym, superCall, rettype, name, params if sfNoalias in param.flags: typ.add("NIM_NOALIAS ") - name = param.loc.snippet + name = param.locImpl.snippet types.add typ names.add name if sfCodegenDecl notin param.flags: @@ -600,14 +608,15 @@ proc genProcParams(m: BModule; t: PType, rettype: var Rope, params: var Builder, else: descKind = dkRefParam if isCompileTimeOnly(param.typ): continue + backendEnsureMutable param fillParamName(m, param) - fillLoc(param.loc, locParam, t.n[i], + fillLoc(param.locImpl, locParam, t.n[i], param.paramStorageLoc) var typ: Rope if ccgIntroducedPtr(m.config, param, t.returnType) and descKind == dkParam: typ = ptrType(getTypeDescWeak(m, param.typ, check, descKind)) - incl(param.loc.flags, lfIndirect) - param.loc.storage = OnUnknown + incl(param.locImpl.flags, lfIndirect) + param.locImpl.storage = OnUnknown elif weakDep: typ = (getTypeDescWeak(m, param.typ, check, descKind)) else: @@ -619,9 +628,9 @@ proc genProcParams(m: BModule; t: PType, rettype: var Rope, params: var Builder, 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 + if param.typ.kind in {tyVar, tyLent}: param.locImpl.storage = OnUnknown # need to pass hidden parameter: - params.addParam(paramBuilder, name = param.loc.snippet & "Len_" & $j, typ = NimInt) + params.addParam(paramBuilder, name = param.locImpl.snippet & "Len_" & $j, typ = NimInt) inc(j) arr = arr[0].skipTypes({tySink}) if t.returnType != nil and isInvalidReturnType(m.config, t): @@ -706,12 +715,13 @@ proc genRecordFieldsAux(m: BModule; n: PNode, if field.typ.kind == tyVoid: return #assert(field.ast == nil) let sname = mangleRecFieldName(m, field) - fillLoc(field.loc, locField, n, unionPrefix & sname, OnUnknown) + backendEnsureMutable field + fillLoc(field.locImpl, locField, n, unionPrefix & sname, OnUnknown) # 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 fieldType = field.loc.lode.typ.skipTypes(abstractInst) + let fieldType = field.loc.t.skipTypes(abstractInst) var typ: Rope = "" var isFlexArray = false var initializer = "" @@ -834,6 +844,54 @@ proc getOpenArrayDesc(m: BModule; t: PType, check: var IntSet; kind: TypeDescKin m.s[cfsTypes].addField(name = "Field0", typ = ptrType(elemType)) m.s[cfsTypes].addField(name = "Field1", typ = NimInt) +proc importedCppObject(m: BModule; t, tt: PType; check: var IntSet; kind: TypeDescKind; sig: SigHash; result: var Rope) = + let cppNameAsRope = getTypeName(m, t, sig) + let cppName = $cppNameAsRope + var i = 0 + var chunkStart = 0 + + template addResultType(ty: untyped) = + if ty == nil or ty.kind == tyVoid: + result.add(CVoid) + elif ty.kind == tyStatic: + internalAssert m.config, ty.n != nil + result.add ty.n.renderTree + else: + result.add getTypeDescAux(m, ty, check, kind) + + while i < cppName.len: + if cppName[i] == '\'': + var chunkEnd = i-1 + var idx, stars: int = 0 + if scanCppGenericSlot(cppName, i, idx, stars): + result.add cppName.substr(chunkStart, chunkEnd) + chunkStart = i + + let typeInSlot = resolveStarsInCppType(tt, idx + 1, stars) + addResultType(typeInSlot) + else: + inc i + + if chunkStart != 0: + result.add cppName.substr(chunkStart) + else: + result = cppNameAsRope & "<" + for needsComma, a in tt.genericInstParams: + if needsComma: result.add(" COMMA ") + addResultType(a) + result.add("> ") + # always call for sideeffects: + assert t.kind != tyTuple + discard getRecordDesc(m, t, result, check) + # The resulting type will include commas and these won't play well + # with the C macros for defining procs such as N_NIMCALL. We must + # create a typedef for the type and use it in the proc signature: + let typedefName = "TY" & $sig + m.s[cfsTypes].addTypedef(name = typedefName): + m.s[cfsTypes].add(result) + m.typeCache[sig] = typedefName + result = typedefName + proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDescKind): Rope = # returns only the type's name var t = origTyp.skipTypes(irrelevantForBackend-{tyOwned}) @@ -849,7 +907,7 @@ proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDes # tyDistinct matters if it is an importc type result = getTypePre(m, origTyp.skipTypes(irrelevantForBackend-{tyOwned, tyDistinct}), sig) - defer: # defer is the simplest in this case + defer: if isImportedType(t) and not m.typeABICache.containsOrIncl(sig): addAbiCheck(m, t, result) @@ -983,7 +1041,7 @@ proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDes m.s[cfsTypes].addArrayTypedef(name = result, len = 1): m.s[cfsTypes].add(et) of tyArray: - var n: BiggestInt = toInt64(lengthOrd(m.config, t)) + var n = toInt64(lengthOrd(m.config, t)) if n <= 0: n = 1 # make an array of at least one element result = getTypeName(m, origTyp, sig) m.typeCache[sig] = result @@ -994,52 +1052,7 @@ proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDes of tyObject, tyTuple: let tt = origTyp.skipTypes({tyDistinct}) if isImportedCppType(t) and tt.kind == tyGenericInst: - let cppNameAsRope = getTypeName(m, t, sig) - let cppName = $cppNameAsRope - var i = 0 - var chunkStart = 0 - - template addResultType(ty: untyped) = - if ty == nil or ty.kind == tyVoid: - result.add(CVoid) - elif ty.kind == tyStatic: - internalAssert m.config, ty.n != nil - result.add ty.n.renderTree - else: - result.add getTypeDescAux(m, ty, check, kind) - - while i < cppName.len: - if cppName[i] == '\'': - var chunkEnd = i-1 - var idx, stars: int = 0 - if scanCppGenericSlot(cppName, i, idx, stars): - result.add cppName.substr(chunkStart, chunkEnd) - chunkStart = i - - let typeInSlot = resolveStarsInCppType(tt, idx + 1, stars) - addResultType(typeInSlot) - else: - inc i - - if chunkStart != 0: - result.add cppName.substr(chunkStart) - else: - result = cppNameAsRope & "<" - for needsComma, a in tt.genericInstParams: - if needsComma: result.add(" COMMA ") - addResultType(a) - result.add("> ") - # always call for sideeffects: - assert t.kind != tyTuple - discard getRecordDesc(m, t, result, check) - # The resulting type will include commas and these won't play well - # with the C macros for defining procs such as N_NIMCALL. We must - # create a typedef for the type and use it in the proc signature: - let typedefName = "TY" & $sig - m.s[cfsTypes].addTypedef(name = typedefName): - m.s[cfsTypes].add(result) - m.typeCache[sig] = typedefName - result = typedefName + importedCppObject(m, t, tt, check, kind, sig, result) else: result = cacheGetType(m.forwTypeCache, sig) if result == "": @@ -1154,7 +1167,8 @@ proc genMemberProcHeader(m: BModule; prc: PSym; result: var Builder; asPtr: bool let isCtor = sfConstructor in prc.flags var check = initIntSet() fillBackendName(m, prc) - fillLoc(prc.loc, locProc, prc.ast[namePos], OnUnknown) + ensureMutable prc + fillLoc(prc.locImpl, locProc, prc.ast[namePos], OnUnknown) var memberOp = "#." #only virtual var typ: PType if isCtor: @@ -1186,7 +1200,7 @@ proc genMemberProcHeader(m: BModule; prc: PSym; result: var Builder; asPtr: bool superCall = "" else: if not isCtor: - prc.loc.snippet = "$1$2(@)" % [memberOp, name] + prc.locImpl.snippet = "$1$2(@)" % [memberOp, name] elif superCall != "": superCall = " : " & superCall @@ -1201,14 +1215,15 @@ proc genProcHeader(m: BModule; prc: PSym; result: var Builder; visibility: var D # using static is needed for inline procs var check = initIntSet() fillBackendName(m, prc) - fillLoc(prc.loc, locProc, prc.ast[namePos], OnUnknown) + backendEnsureMutable prc + fillLoc(prc.locImpl, locProc, prc.ast[namePos], OnUnknown) var rettype: Snippet = "" var desc = newBuilder("") genProcParams(m, prc.typ, rettype, desc, check, true, false) let params = extract(desc) # handle the 2 options for hotcodereloading codegen - function pointer # (instead of forward declaration) or header for function body with "_actual" postfix - var name = prc.loc.snippet + var name = prc.locImpl.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 @@ -1448,7 +1463,7 @@ proc genObjectInfo(m: BModule; typ, origType: PType, name: Rope; info: TLineInfo var t = typ.baseClass while t != nil: t = t.skipTypes(skipPtrs) - t.flags.incl tfObjHasKids + t.incl tfObjHasKids t = t.baseClass proc genTupleInfo(m: BModule; typ, origType: PType, name: Rope; info: TLineInfo) = @@ -1644,8 +1659,8 @@ proc generateRttiDestructor(g: ModuleGraph; typ: PType; owner: PSym; kind: TType n[bodyPos] = body result.ast = n - incl result.flags, sfFromGeneric - incl result.flags, sfGeneratedOp + incl result.flagsImpl, sfFromGeneric + incl result.flagsImpl, sfGeneratedOp proc genHook(m: BModule; t: PType; info: TLineInfo; op: TTypeAttachedOp; result: var Builder) = let theProc = getAttachedOp(m.g.graph, t, op) @@ -1850,6 +1865,12 @@ proc genTypeInfoV2Impl(m: BModule; t, origType: PType, name: Rope; info: TLineIn if t.kind == tyObject and t.baseClass != nil and optEnableDeepCopy in m.config.globalOptions: discard genTypeInfoV1(m, t, info) +proc myModuleOpenForCodegen(m: BModule; idx: FileIndex): bool {.inline.} = + if moduleOpenForCodegen(m.g.graph, idx): + result = idx.int < m.g.mods.len and m.g.mods[idx.int] != nil + else: + result = false + proc genTypeInfoV2(m: BModule; t: PType; info: TLineInfo): Rope = let origType = t # distinct types can have their own destructors @@ -1878,9 +1899,9 @@ proc genTypeInfoV2(m: BModule; t: PType; info: TLineInfo): Rope = m.typeInfoMarkerV2[sig] = result let owner = t.skipTypes(typedescPtrs).itemId.module - if owner != m.module.position and moduleOpenForCodegen(m.g.graph, FileIndex owner): + if owner != m.module.position and myModuleOpenForCodegen(m, FileIndex owner): # make sure the type info is created in the owner module - discard genTypeInfoV2(m.g.modules[owner], origType, info) + discard genTypeInfoV2(m.g.mods[owner], origType, info) # reference the type info as extern here cgsym(m, "TNimTypeV2") declareNimType(m, "TNimTypeV2", result, owner) @@ -1963,9 +1984,9 @@ proc genTypeInfoV1(m: BModule; t: PType; info: TLineInfo): Rope = return prefixTI(result) var owner = t.skipTypes(typedescPtrs).itemId.module - if owner != m.module.position and moduleOpenForCodegen(m.g.graph, FileIndex owner): + if owner != m.module.position and myModuleOpenForCodegen(m, FileIndex owner): # make sure the type info is created in the owner module - discard genTypeInfoV1(m.g.modules[owner], origType, info) + discard genTypeInfoV1(m.g.mods[owner], origType, info) # reference the type info as extern here cgsym(m, "TNimType") cgsym(m, "TNimNode") @@ -2042,17 +2063,21 @@ proc genTypeInfo*(config: ConfigRef, m: BModule; t: PType; info: TLineInfo): Rop else: result = genTypeInfoV1(m, t, info) +proc retrieveSym(n: PNode): PSym = + case n.kind + of nkPostfix: result = retrieveSym(n[1]) + of nkPragmaExpr, nkTypeDef: result = retrieveSym(n[0]) + of nkSym: result = n.sym + else: result = nil + proc genTypeSection(m: BModule, n: PNode) = var intSet = initIntSet() - for i in 0..= m.g.mods.len: + result = newModule(m.g, ms, m.config, idGeneratorFromModule(ms)) + else: + result = m.g.mods[ms.position] + if result == nil: + result = newModule(m.g, ms, m.config, idGeneratorFromModule(ms)) else: var ms = getModule(s) - result = m.g.modules[ms.position] + result = m.g.mods[ms.position] proc initLoc(k: TLocKind, lode: PNode, s: TStorageLoc, flags: TLocFlags = {}): TLoc = result = TLoc(k: k, storage: s, lode: lode, @@ -97,7 +108,7 @@ proc t(a: TLoc): PType {.inline.} = proc lodeTyp(t: PType): PNode = result = newNode(nkEmpty) - result.typ() = t + result.typ = t proc isSimpleConst(typ: PType): bool = let t = skipTypes(typ, abstractVar) @@ -122,10 +133,10 @@ proc getModuleDllPath(m: BModule): Rope = result = makeCString(dir.string & "/" & filename) proc getModuleDllPath(m: BModule, module: int): Rope = - result = getModuleDllPath(m.g.modules[module]) + result = getModuleDllPath(m.g.mods[module]) proc getModuleDllPath(m: BModule, s: PSym): Rope = - result = getModuleDllPath(m.g.modules[s.itemId.module]) + result = getModuleDllPath(m.g.mods[s.itemId.module]) import std/macros @@ -326,7 +337,10 @@ proc genLineDir(p: BProc, t: PNode) = let line = t.info.safeLineNm if optEmbedOrigSrc in p.config.globalOptions: - p.s(cpsStmts).add("//" & sourceLine(p.config, t.info) & "\L") + var code = sourceLine(p.config, t.info) + if code.endsWith('\\'): + code.add "#" + p.s(cpsStmts).add("// " & code & "\L") let lastFileIndex = p.lastLineInfo.fileIndex let freshLine = freshLineInfo(p, t.info) if freshLine: @@ -506,7 +520,7 @@ 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): + if isImportedCppType(typ): var didGenTemp = false let rl = rdLoc(loc) let init = genCppInitializer(p.module, p, typ, didGenTemp) @@ -600,7 +614,8 @@ proc initLocalVar(p: BProc, v: PSym, immediateAsgn: bool) = # ``var v = X()`` gets transformed into ``X(&v)``. # Nowadays the logic in ccgcalls deals with this case however. if not immediateAsgn: - constructLoc(p, v.loc) + backendEnsureMutable v + constructLoc(p, v.locImpl) proc getTemp(p: BProc, t: PType, needsInit=false): TLoc = inc(p.labels) @@ -646,8 +661,9 @@ proc localVarDecl(res: var Builder, p: BProc; n: PNode, let s = n.sym if s.loc.k == locNone: fillLocalName(p, s) - fillLoc(s.loc, locLocalVar, n, OnStack) - if s.kind == skLet: incl(s.loc.flags, lfNoDeepCopy) + backendEnsureMutable s + fillLoc(s.locImpl, locLocalVar, n, OnStack) + if s.kind == skLet: incl(s, lfNoDeepCopy) genCLineDir(res, p, n.info, p.config) @@ -707,15 +723,17 @@ proc assignGlobalVar(p: BProc, n: PNode; value: Rope) = let s = n.sym if s.loc.k == locNone: fillBackendName(p.module, s) - fillLoc(s.loc, locGlobalVar, n, OnHeap) - if treatGlobalDifferentlyForHCR(p.module, s): incl(s.loc.flags, lfIndirect) + backendEnsureMutable s + fillLoc(s.locImpl, locGlobalVar, n, OnHeap) + if treatGlobalDifferentlyForHCR(p.module, s): incl(s, lfIndirect) if lfDynamicLib in s.loc.flags: var q = findPendingModule(p.module, s) if q != nil and not containsOrIncl(q.declaredThings, s.id): varInDynamicLib(q, s) else: - s.loc.snippet = mangleDynLibProc(s) + backendEnsureMutable s + s.locImpl.snippet = mangleDynLibProc(s) if value != "": internalError(p.config, n.info, ".dynlib variables cannot have a value") return @@ -755,12 +773,14 @@ proc assignGlobalVar(p: BProc, n: PNode; value: Rope) = genGlobalVarDecl(p.module.s[cfsVars], p, n, td, initializer = initializer) if p.withinLoop > 0 and value == "": # fixes tests/run/tzeroarray: - resetLoc(p, s.loc) + backendEnsureMutable s + resetLoc(p, s.locImpl) 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) + backendEnsureMutable s + fillLoc(s.locImpl, locGlobalVar, vn, OnHeap) let td = getTypeDesc(p.module, vn.sym.typ, dkVar) var val = genCppParamsForCtor(p, value, didGenTemp) if didGenTemp: return # generated in the caller @@ -779,7 +799,8 @@ proc fillProcLoc(m: BModule; n: PNode) = let sym = n.sym if sym.loc.k == locNone: fillBackendName(m, sym) - fillLoc(sym.loc, locProc, n, OnStack) + backendEnsureMutable sym + fillLoc(sym.locImpl, locProc, n, OnStack) proc getLabel(p: BProc): TLabel = inc(p.labels) @@ -948,7 +969,8 @@ proc symInDynamicLib(m: BModule, sym: PSym) = var extname = sym.loc.snippet if not isCall: loadDynamicLib(m, lib) var tmp = mangleDynLibProc(sym) - sym.loc.snippet = tmp # from now on we only need the internal name + backendEnsureMutable sym + sym.locImpl.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: @@ -990,9 +1012,10 @@ proc varInDynamicLib(m: BModule, sym: PSym) = var lib = sym.annex var extname = sym.loc.snippet loadDynamicLib(m, lib) - incl(sym.loc.flags, lfIndirect) + incl(sym, lfIndirect) var tmp = mangleDynLibProc(sym) - sym.loc.snippet = tmp # from now on we only need the internal name + backendEnsureMutable sym + sym.locImpl.snippet = tmp # from now on we only need the internal name inc(m.labels, 2) let t = ptrType(getTypeDesc(m, sym.typ, dkVar)) # cgsym has side effects, do it first: @@ -1005,7 +1028,8 @@ proc varInDynamicLib(m: BModule, sym: PSym) = m.s[cfsVars].addVar(name = sym.loc.snippet, typ = t) proc symInDynamicLibPartial(m: BModule, sym: PSym) = - sym.loc.snippet = mangleDynLibProc(sym) + backendEnsureMutable sym + sym.locImpl.snippet = mangleDynLibProc(sym) sym.typ.sym = nil # generate a new name proc cgsymImpl(m: BModule; sym: PSym) {.inline.} = @@ -1275,7 +1299,7 @@ proc genProcBody(p: BProc; procBody: PNode) = p.blocks[0].sections[cpsInit].addAssignmentWithValue("nimErr_"): p.blocks[0].sections[cpsInit].addCall(cgsymValue(p.module, "nimErrorFlag")) -proc genProcAux*(m: BModule, prc: PSym) = +proc genProcLvl3*(m: BModule, prc: PSym) = var p = newProc(prc, m) var header = newBuilder("") let isCppMember = m.config.backend == backendCpp and sfCppMember * prc.flags != {} @@ -1300,7 +1324,7 @@ proc genProcAux*(m: BModule, prc: PSym) = let resNode = prc.ast[resultPos] let res = resNode.sym # get result symbol if not isInvalidReturnType(m.config, prc.typ) and sfConstructor notin prc.flags: - if sfNoInit in prc.flags: incl(res.flags, sfNoInit) + if sfNoInit in prc.flags: incl(res, sfNoInit) if sfNoInit in prc.flags and p.module.compileToCpp and (let val = easyResultAsgn(procBody); val != nil): var a: TLoc = initLocExprSingleUse(p, val) let ra = rdLoc(a) @@ -1321,9 +1345,11 @@ proc genProcAux*(m: BModule, prc: PSym) = returnBuilder.addReturn(rres) returnStmt = extract(returnBuilder) 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) + resNode.sym.incl lfIndirect + backendEnsureMutable resNode.sym + fillLoc(resNode.sym.locImpl, locParam, resNode, "this", OnHeap) + backendEnsureMutable prc + prc.locImpl.snippet = getTypeDesc(m, resNode.sym.locImpl.t, dkVar) else: fillResult(p.config, resNode, prc.typ) assignParam(p, res, prc.typ.returnType) @@ -1336,10 +1362,12 @@ proc genProcAux*(m: BModule, prc: PSym) = if sfNoInit in prc.flags: discard elif allPathsAsgnResult(p, procBody) == InitSkippable: discard else: - resetLoc(p, res.loc) + backendEnsureMutable res + resetLoc(p, res.locImpl) if skipTypes(res.typ, abstractInst).kind == tyArray: #incl(res.loc.flags, lfIndirect) - res.loc.storage = OnUnknown + backendEnsureMutable res + res.locImpl.storage = OnUnknown for i in 1.. 0 or m.preInitProc.s(cpsStmts).buf.len > 0: # Give this small function its own scope prcBody.addScope(): @@ -2342,13 +2387,14 @@ proc rawNewModule(g: BModuleList; module: PSym, filename: AbsoluteFile): BModule proc rawNewModule(g: BModuleList; module: PSym; conf: ConfigRef): BModule = result = rawNewModule(g, module, AbsoluteFile toFullPath(conf, module.position.FileIndex)) -proc newModule*(g: BModuleList; module: PSym; conf: ConfigRef): BModule = +proc newModule(g: BModuleList; module: PSym; conf: ConfigRef; idgen: IdGenerator): BModule = # we should create only one cgen module for each module sym result = rawNewModule(g, module, conf) - if module.position >= g.modules.len: - setLen(g.modules, module.position + 1) + result.idgen = idgen + if module.position >= g.mods.len: + setLen(g.mods, module.position + 1) #growCache g.modules, module.position - g.modules[module.position] = result + g.mods[module.position] = result template injectG() {.dirty.} = if graph.backend == nil: @@ -2357,8 +2403,7 @@ template injectG() {.dirty.} = proc setupCgen*(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = injectG() - result = newModule(g, module, graph.config) - result.idgen = idgen + result = newModule(g, module, graph.config, idgen) if optGenIndex in graph.config.globalOptions and g.generatedHeader == nil: let f = if graph.config.headerFile.len > 0: AbsoluteFile graph.config.headerFile else: graph.config.projectFull @@ -2433,7 +2478,10 @@ proc handleProcGlobals(m: BModule) = # fixes recursive calls #24997 swap stmts, m.preInitProc.s(cpsStmts) - genStmts(m.preInitProc, procGlobals[i]) + var transformedN = procGlobals[i] + if sfInjectDestructors in m.module.flags: + transformedN = injectDestructorCalls(m.g.graph, m.idgen, m.module, transformedN) + genStmts(m.preInitProc, transformedN) swap stmts, m.preInitProc.s(cpsStmts) handleProcGlobals(m) @@ -2480,16 +2528,15 @@ proc shouldRecompile(m: BModule; code: Rope, cfile: Cfile): bool = rawMessage(m.config, errCannotOpenFile, cfile.cname.string) result = true -# We need 2 different logics here: pending modules (including -# 'nim__dat') may require file merging for the combination of dead code -# elimination and incremental compilation! Non pending modules need no -# such logic and in fact the logic hurts for the main module at least; -# it would generate multiple 'main' procs, for instance. - -proc writeModule(m: BModule, pending: bool) = +proc writeModule(m: BModule) = let cfile = getCFile(m) if moduleHasChanged(m.g.graph, m.module): genInitCode(m) + + while m.queue.len > 0: + let sym = m.queue.pop() + genProcLvl2(m, sym) + finishTypeDescriptions(m) if sfMainModule in m.module.flags: # generate main file: @@ -2524,10 +2571,11 @@ proc generateLibraryDestroyGlobals(graph: ModuleGraph; m: BModule; body: PNode; 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 = prefixedName + backendEnsureMutable result + incl result.flagsImpl, sfExportc + result.locImpl.snippet = prefixedName if isDynlib: - incl(result.loc.flags, lfExportLib) + incl(result.locImpl.flags, lfExportLib) let theProc = newNodeI(nkProcDef, m.module.info, bodyPos+1) for i in 0.. 0: let prc = g.forwardedProcs.pop() - m = g.modules[prc.itemId.module] + m = g.mods[prc.itemId.module] if sfForward in prc.flags: internalError(m.config, prc.info, "still forwarded: " & prc.name.s) - genProcNoForward(m, prc) + genProcLvl2(m, prc) proc cgenWriteModules*(backend: RootRef, config: ConfigRef) = let g = BModuleList(backend) @@ -2625,6 +2673,6 @@ proc cgenWriteModules*(backend: RootRef, config: ConfigRef) = genForwardedProcs(g) for m in cgenModules(g): - m.writeModule(pending=true) + m.writeModule() writeMapping(config, g.mapping) if g.generatedHeader != nil: writeHeader(g.generatedHeader) diff --git a/compiler/cgendata.nim b/compiler/cgendata.nim index f9ed9c6fda..5b5668024a 100644 --- a/compiler/cgendata.nim +++ b/compiler/cgendata.nim @@ -117,9 +117,9 @@ type BModuleList* = ref object of RootObj mainModProcs*, mainModInit*, otherModsInit*, mainDatInit*: Builder mapping*: Rope # the generated mapping file (if requested) - modules*: seq[BModule] # list of all compiled modules + mods*: seq[BModule] # list of all compiled modules modulesClosed*: seq[BModule] # list of the same compiled modules, but in the order they were closed - forwardedProcs*: seq[PSym] # proc:s that did not yet have a body + forwardedProcs*: seq[PSym] # procs that did not yet have a body generatedHeader*: BModule typeInfoMarker*: TypeCacheWithOwner typeInfoMarkerV2*: TypeCacheWithOwner @@ -155,6 +155,7 @@ type 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 + queue*: seq[PSym] # queue of procs to generate alive*: IntSet # symbol IDs of alive data as computed by `dce.nim` headerFiles*: seq[string] # needed headers to include typeInfoMarker*: TypeCache # needed for generating type information @@ -178,6 +179,9 @@ template config*(m: BModule): ConfigRef = m.g.config template config*(p: BProc): ConfigRef = p.module.g.config template vccAndC*(p: BProc): bool = p.module.config.cCompiler == ccVcc and p.module.config.backend == backendC +proc delayedCodegen*(m: BModule): bool {.inline.} = + useAliveDataFromDce in m.flags or m.config.globalOptions.contains(optCompress) + proc includeHeader*(this: BModule; header: string) = if not this.headerFiles.contains header: this.headerFiles.add header diff --git a/compiler/cgmeth.nim b/compiler/cgmeth.nim index fe6da1c1eb..924d033144 100644 --- a/compiler/cgmeth.nim +++ b/compiler/cgmeth.nim @@ -55,7 +55,7 @@ proc methodCall*(n: PNode; conf: ConfigRef): PNode = # replace ordinary method by dispatcher method: let disp = getDispatcher(result[0].sym) if disp != nil: - result[0].typ() = disp.typ + result[0].typ = disp.typ result[0].sym = disp # change the arguments to up/downcasts to fit the dispatcher's parameters: for i in 1.. resultPos: disp.ast[resultPos].sym = copySym(s.ast[resultPos].sym, idgen) diff --git a/compiler/closureiters.nim b/compiler/closureiters.nim index 8b61106abc..ddf9c2704c 100644 --- a/compiler/closureiters.nim +++ b/compiler/closureiters.nim @@ -139,8 +139,7 @@ import ast, msgs, idents, - renderer, magicsys, lowerings, lambdalifting, modulegraphs, lineinfos, - options + renderer, magicsys, lowerings, lambdalifting, modulegraphs, lineinfos import std/tables @@ -174,12 +173,14 @@ type tempVarId: int # unique name counter hasExceptions: bool # Does closure have yield in try? curExcLandingState: PNode - curExceptLevel: int curFinallyLevel: int idgen: IdGenerator varStates: Table[ItemId, int] # Used to detect if local variable belongs to multiple states finallyPathLen: PNode # int literal + nullifyCurExc: PNode # Empty node, if no yields in tries + restoreExternExc: PNode # Empty node, id no yields in tries + const nkSkip = {nkEmpty..nkNilLit, nkTemplateDef, nkTypeSection, nkStaticStmt, nkCommentStmt, nkMixinStmt, nkBindStmt, nkTypeOfExpr} + procDefs @@ -198,7 +199,7 @@ proc newStateAssgn(ctx: var Ctx, toValue: PNode): 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 + result.flagsImpl.incl sfNoInit assert(not typ.isNil, "Env var needs a type") let envParam = getEnvParam(ctx.fn) @@ -311,7 +312,7 @@ proc hasYields(n: PNode): bool = break proc newNullifyCurExc(ctx: var Ctx, info: TLineInfo): PNode = - # :curEcx = nil + # :curExc = nil let curExc = ctx.newCurExcAccess() curExc.info = info let nilnode = newNodeIT(nkNilLit, info, getSysType(ctx.g, info, tyNil)) @@ -456,7 +457,7 @@ proc newNotCall(g: ModuleGraph; e: PNode): PNode = proc boolLit(g: ModuleGraph; info: TLineInfo; value: bool): PNode = result = newIntLit(g, info, ord value) - result.typ() = getSysType(g, info, tyBool) + result.typ = getSysType(g, info, tyBool) proc captureVar(c: var Ctx, s: PSym) = if c.varStates.getOrDefault(s.itemId) != localRequiresLifting: @@ -817,7 +818,7 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = result = newNodeIT(nkStmtListExpr, n.info, n.typ) let (st, ex) = exprToStmtList(n[1]) n.transitionSonsKind(nkBlockStmt) - n.typ() = nil + n.typ = nil n[1] = st result.add(n) result.add(ex) @@ -862,7 +863,7 @@ proc newEndFinallyNode(ctx: var Ctx, info: TLineInfo): PNode = retStmt.flags.incl(nfNoRewrite) let ifBody = newTree(nkIfStmt, - newTree(nkElifBranch, excNilCmp, retStmt), + newTree(nkElifBranch, excNilCmp, newTree(nkStmtList, ctx.newRestoreExternException(), retStmt)), newTree(nkElse, newTree(nkStmtList, newTreeI(nkRaiseStmt, info, ctx.g.emptyNode)))) @@ -917,16 +918,15 @@ proc transformBreakStmt(ctx: var Ctx, n: PNode): PNode = result = n proc transformReturnStmt(ctx: var Ctx, n: PNode): PNode = - # "Returning" involves jumping along all the cureent finally path. + # "Returning" involves jumping along all the current finally path. # The last finally should exit to state 0 which is a special case for last exit # (either return or propagating exception to the caller). # It is eccounted for in newEndFinallyNode. result = newNodeI(nkStmtList, n.info) # Returns prevent exception propagation - result.add(ctx.newNullifyCurExc(n.info)) + result.add(ctx.nullifyCurExc) - result.add(ctx.newRestoreExternException()) var finallyChain = newSeq[PNode]() @@ -950,6 +950,7 @@ proc transformReturnStmt(ctx: var Ctx, n: PNode): PNode = result.add(ctx.newJumpAlongFinallyChain(finallyChain, n.info)) else: # There are no (split) finallies on the path, so we can return right away + result.add(ctx.restoreExternExc) result.add(n) proc transformBreaksAndReturns(ctx: var Ctx, n: PNode): PNode = @@ -960,7 +961,7 @@ proc transformBreaksAndReturns(ctx: var Ctx, n: PNode): PNode = # of nkContinueStmt: # By this point all relevant continues should be # lowered to breaks in transf.nim. of nkReturnStmt: - if ctx.curFinallyLevel > 0 and nfNoRewrite notin n.flags: + if nfNoRewrite notin n.flags: result = ctx.transformReturnStmt(n) else: for i in 0.. 0 or ctx.curFinallyLevel > 0: - result = newTree(nkStmtList, ctx.newRestoreExternException(), result) + result = newTree(nkStmtList, ctx.restoreExternExc, result) of nkElse, nkElseExpr: result[0] = addGotoOut(result[0], gotoOut) @@ -1107,7 +1107,6 @@ proc transformClosureIteratorBody(ctx: var Ctx, n: PNode, gotoOut: PNode): PNode tryBody = ctx.transformClosureIteratorBody(tryBody, tryOut) if exceptBody.kind != nkEmpty: - inc ctx.curExceptLevel ctx.curExcLandingState = if finallyBody.kind != nkEmpty: finallyLabel else: oldExcLandingState discard ctx.newState(exceptBody, false, exceptLabel) @@ -1116,7 +1115,6 @@ proc transformClosureIteratorBody(ctx: var Ctx, n: PNode, gotoOut: PNode): PNode exceptBody = ctx.addElseToExcept(exceptBody, normalOut) # echo "EXCEPT: ", renderTree(exceptBody) exceptBody = ctx.transformClosureIteratorBody(exceptBody, tryOut) - inc ctx.curExceptLevel ctx.curExcLandingState = oldExcLandingState @@ -1308,16 +1306,15 @@ proc countStateOccurences(ctx: var Ctx, n: PNode, stateOccurences: var openArray proc replaceDeletedStates(ctx: var Ctx, n: PNode): PNode = result = n - for i in 0 ..< n.safeLen: - let c = n[i] - if c.kind == nkIntLit: - let idx = c.intVal - if idx >= 0 and idx < ctx.states.len and ctx.states[idx].label == c and ctx.states[idx].deletable: - let gt = ctx.replaceDeletedStates(skipStmtList(ctx.states[idx].body)) - assert(gt.kind == nkGotoState) - n[i] = gt[0] - else: - n[i] = ctx.replaceDeletedStates(c) + if n.kind == nkIntLit: + let idx = n.intVal + if idx >= 0 and idx < ctx.states.len and ctx.states[idx].label == n and ctx.states[idx].deletable: + let gt = ctx.replaceDeletedStates(skipStmtList(ctx.states[idx].body)) + assert(gt.kind == nkGotoState) + result = gt[0] + else: + for i in 0 ..< n.safeLen: + n[i] = ctx.replaceDeletedStates(n[i]) proc replaceInlinedStates(ctx: var Ctx, n: PNode): PNode = ## Find all nkGotoState(stateIdx) nodes that do not follow nkYield. @@ -1348,6 +1345,7 @@ proc optimizeStates(ctx: var Ctx) = # Replace deletable state labels to labels of respective non-empty states for i in 0 .. ctx.states.high: ctx.states[i].body = ctx.replaceDeletedStates(ctx.states[i].body) + ctx.states[i].excLandingState = ctx.replaceDeletedStates(ctx.states[i].excLandingState) # Remove deletable states var i = 0 @@ -1469,13 +1467,17 @@ proc transformClosureIterator*(g: ModuleGraph; idgen: IdGenerator; fn: PSym, n: ctx.curExcLandingState = ctx.newStateLabel() ctx.stateLoopLabel = newSym(skLabel, getIdent(ctx.g.cache, ":stateLoop"), idgen, fn, fn.info) + + + ctx.nullifyCurExc = newTree(nkStmtList) + ctx.restoreExternExc = newTree(nkStmtList) + var n = n.toStmtList # echo "transformed into ", n discard ctx.newState(n, false, nil) - let finalState = ctx.newStateLabel() - let gotoOut = newTree(nkGotoState, finalState) + let gotoOut = newTree(nkGotoState, g.newIntLit(n.info, -1)) var ns = false n = ctx.lowerStmtListExprs(n, ns) @@ -1487,11 +1489,9 @@ proc transformClosureIterator*(g: ModuleGraph; idgen: IdGenerator; fn: PSym, n: # Splitting transformation discard ctx.transformClosureIteratorBody(n, gotoOut) - let finalStateBody = newTree(nkStmtList) if ctx.hasExceptions: - finalStateBody.add(ctx.newRestoreExternException()) - finalStateBody.add(newTree(nkGotoState, g.newIntLit(n.info, -1))) - discard ctx.newState(finalStateBody, true, finalState) + ctx.nullifyCurExc.add(ctx.newNullifyCurExc(fn.info)) + ctx.restoreExternExc.add(ctx.newRestoreExternException()) # Assign state label indexes for i in 0 .. ctx.states.high: @@ -1510,7 +1510,9 @@ proc transformClosureIterator*(g: ModuleGraph; idgen: IdGenerator; fn: PSym, n: let body = ctx.transformStateAssignments(s.body) caseDispatcher.add newTreeI(nkOfBranch, body.info, s.label, body) - caseDispatcher.add newTreeI(nkElse, n.info, newTreeI(nkReturnStmt, n.info, g.emptyNode)) + caseDispatcher.add newTreeI(nkElse, n.info, + newTree(nkStmtList, ctx.restoreExternExc, + newTreeI(nkReturnStmt, n.info, g.emptyNode))) result = wrapIntoStateLoop(ctx, caseDispatcher) result = liftLocals(ctx, result) diff --git a/compiler/commands.nim b/compiler/commands.nim index 2cd18185bb..1bf8ec5505 100644 --- a/compiler/commands.nim +++ b/compiler/commands.nim @@ -364,6 +364,7 @@ proc testCompileOption*(conf: ConfigRef; switch: string, info: TLineInfo): bool result = false of "panics": result = contains(conf.globalOptions, optPanics) of "jsbigint64": result = contains(conf.globalOptions, optJsBigInt64) + of "mangle": result = contains(conf.globalOptions, optItaniumMangle) else: result = false invalidCmdLineOption(conf, passCmd1, switch, info) @@ -497,6 +498,8 @@ proc parseCommand*(command: string): Command = of "secret": cmdInteractive of "nop", "help": cmdNop of "jsonscript": cmdJsonscript + of "nifc": cmdNifC # generate C from NIF files + of "ic": cmdIc # generate .build.nif for nifmake else: cmdUnknown proc setCmd*(conf: ConfigRef, cmd: Command) = @@ -509,6 +512,11 @@ proc setCmd*(conf: ConfigRef, cmd: Command) = of cmdCompileToOC: conf.backend = backendObjc of cmdCompileToJS: conf.backend = backendJs of cmdCompileToNif: conf.backend = backendNif + of cmdNifC: + conf.backend = backendC # NIF to C compilation + of cmdM: + # cmdM requires optCompress for proper IC handling (include files, etc.) + conf.globalOptions.incl optCompress else: discard proc setCommandEarly*(conf: ConfigRef, command: string) = @@ -762,6 +770,16 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; conf.globalOptions.excl optCDebug else: localError(conf, info, "expected native|gdb|on|off but found " & arg) + of "mangle": + case arg.normalize + of "nim": + conf.globalOptions.excl optItaniumMangle + of "cpp": + conf.globalOptions.incl optItaniumMangle + else: + localError(conf, info, "expected nim|cpp but found " & arg) + of "compress": + conf.globalOptions.incl optCompress of "g": # alias for --debugger:native conf.globalOptions.incl optCDebug conf.options.incl optLineDir @@ -884,11 +902,19 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; of "import": expectArg(conf, switch, arg, pass, info) if pass in {passCmd2, passPP}: - conf.implicitImports.add findModule(conf, arg, toFullPath(conf, info)).string + let m = findModule(conf, arg, toFullPath(conf, info)).string + if m.len == 0: + localError(conf, info, "Cannot resolve filename: " & arg) + else: + conf.implicitImports.add m of "include": expectArg(conf, switch, arg, pass, info) if pass in {passCmd2, passPP}: - conf.implicitIncludes.add findModule(conf, arg, toFullPath(conf, info)).string + let m = findModule(conf, arg, toFullPath(conf, info)).string + if m.len == 0: + localError(conf, info, "Cannot resolve filename: " & arg) + else: + conf.implicitIncludes.add m of "listcmd": processOnOffSwitchG(conf, {optListCmd}, arg, pass, info) of "asm": @@ -974,7 +1000,8 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; # xxx maybe also ic, since not in help? if pass in {passCmd2, passPP}: case arg.normalize - of "on": conf.symbolFiles = v2Sf + of "on": conf.ic = true + of "legacy": conf.symbolFiles = v2Sf of "off": conf.symbolFiles = disabledSf of "writeonly": conf.symbolFiles = writeOnlySf of "readonly": conf.symbolFiles = readOnlySf diff --git a/compiler/concepts.nim b/compiler/concepts.nim index a16b2fbfa2..4f531c2cf9 100644 --- a/compiler/concepts.nim +++ b/compiler/concepts.nim @@ -11,9 +11,9 @@ ## for details. Note this is a first implementation and only the "Concept matching" ## section has been implemented. -import ast, astalgo, semdata, lookups, lineinfos, idents, msgs, renderer, types, layeredtable +import ast, semdata, lookups, lineinfos, idents, msgs, renderer, types, layeredtable -import std/intsets +import std/sets when defined(nimPreviewSlimSystem): import std/assertions @@ -29,7 +29,7 @@ proc declareSelf(c: PContext; info: TLineInfo) = let ow = getCurrOwner(c) let s = newSym(skType, getIdent(c.cache, "Self"), c.idgen, ow, info) s.typ = newType(tyTypeDesc, c.idgen, ow) - s.typ.flags.incl {tfUnresolved, tfPacked} + s.typ.incl {tfUnresolved, tfPacked} s.typ.add newType(tyEmpty, c.idgen, ow) addDecl(c, s, info) @@ -73,18 +73,20 @@ type MatchFlags* = enum mfDontBind # Do not bind generic parameters mfCheckGeneric # formal <- formal comparison as opposed to formal <- operand - + + ConceptTypePair = tuple[conceptId, typeId: ItemId] + ## Pair of (concept type id, implementation type id) used for cycle detection + MatchCon = object ## Context we pass around during concept matching. bindings: LayeredIdTable - marker: IntSet ## Some protection against wild runaway recursions. + marker: HashSet[ConceptTypePair] ## Tracks (concept, type) pairs being checked to detect cycles. potentialImplementation: PType ## the concrete type that might match the concept we try to match. magic: TMagic ## mArrGet and mArrPut is wrong in system.nim and ## cannot be fixed that easily. ## Thus we special case it here. concpt: PType ## current concept being evaluated - depthCount = 0 flags: set[MatchFlags] - + MatchKind = enum mkNoMatch, mkSubset, mkSame @@ -137,7 +139,7 @@ proc bindParam(c: PContext, m: var MatchCon; key, v: PType): bool {. discardable # check previously bound value if not matchType(c, old, value, m): return false - elif key.hasElementType and key.elementType.kind != tyNone: + elif key.hasElementType and not key.elementType.isNil and key.elementType.kind != tyNone: # check constaint if matchType(c, unrollGenericParam(key), value, m) == false: return false @@ -188,32 +190,48 @@ iterator traverseTyOr(t: PType): PType {. closure .}= proc matchConceptToImpl(c: PContext, f, potentialImpl: PType; m: var MatchCon): bool = assert not(potentialImpl.reduceToBase.kind == tyConcept) let concpt = f.reduceToBase - if m.depthCount > 0: - # concepts that are more then 2 levels deep are treated like - # tyAnything to stop dependencies from getting out of control + + # Handle self-referential concepts: when a concept references itself in its body + # (e.g., `A = concept; proc test(x: Self, y: A)`), the inner type A has n=nil. + # We detect this by checking if the concept has the same symbol name as the + # one we're currently matching and has no body (n=nil). + if concpt.n.isNil: + if concpt.sym != nil and m.concpt.sym != nil and + concpt.sym == m.concpt.sym: + # Self-reference: check if potentialImpl matches what we're already checking + return potentialImpl.id == m.potentialImplementation.id + # Concept without body that's not a self-reference - cannot match + return false + + # Cycle detection: track (concept, type) pairs to prevent infinite recursion. + # Returns true on cycle (coinductive semantics) to support co-dependent concepts. + let pair: ConceptTypePair = (concpt.itemId, potentialImpl.itemId) + if pair in m.marker: return true + m.marker.incl pair + var efPot = potentialImpl if potentialImpl.isSelf: if m.concpt.n == concpt.n: + m.marker.excl pair return true efPot = m.potentialImplementation - + var oldBindings = m.bindings m.bindings = newTypeMapLayer(m.bindings) let oldPotentialImplementation = m.potentialImplementation m.potentialImplementation = efPot let oldConcept = m.concpt m.concpt = concpt - + var invocation: PType = nil if f.kind in {tyGenericInvocation, tyGenericInst}: invocation = f - inc m.depthCount result = processConcept(c, concpt, invocation, oldBindings, m) - dec m.depthCount m.potentialImplementation = oldPotentialImplementation m.concpt = oldConcept m.bindings = oldBindings + m.marker.excl pair proc cmpConceptDefs(c: PContext, fn, an: PNode, m: var MatchCon): bool= if fn.kind != an.kind: @@ -263,6 +281,22 @@ proc conceptsMatch(c: PContext, fc, ac: PType; m: var MatchCon): MatchKind = return mkNoMatch return mkSubset +proc isObjectSubtype(f, a: PType): bool = + var t = a + result = false + while t != nil: + t = t.baseClass + if t == nil: + break + t = t.skipTypes({tyPtr,tyRef}) + if t == nil: + break + if t.kind != tyObject: + break + if sameObjectTypes(f, t): + result = true + break + proc matchType(c: PContext; fo, ao: PType; m: var MatchCon): bool = ## The heart of the concept matching process. 'f' is the formal parameter of some ## routine inside the concept that we're looking for. 'a' is the formal parameter @@ -327,6 +361,8 @@ proc matchType(c: PContext; fo, ao: PType; m: var MatchCon): bool = result = a.base.sym == f.sym else: result = sameType(f, a) + if not result and f.kind == tyObject and a.kind == tyObject: + result = isObjectSubtype(f, a) of tyEmpty, tyString, tyCstring, tyPointer, tyNil, tyUntyped, tyTyped, tyVoid: result = a.skipTypes(ignorableForArgType).kind == f.kind of tyBool, tyChar, tyInt..tyUInt64: @@ -358,6 +394,14 @@ proc matchType(c: PContext; fo, ao: PType; m: var MatchCon): bool = if not matchType(c, f[i], ea[i], m): result = false break + elif f.kind == tyGenericInvocation: + # bind potential generic constraints into body + let body = f.base + for i in 1 ..< len(f): + bindParam(c,m,body[i-1], f[i]) + result = matchType(c, body, a, m) + else: # tyGenericInst + result = matchType(c, f.last, a, m) of tyOrdinal: result = isOrdinalType(a, allowEnumWithHoles = false) or a.kind == tyGenericParam of tyStatic: @@ -584,7 +628,7 @@ proc conceptMatch*(c: PContext; concpt, arg: PType; bindings: var LayeredIdTable ## `C[S, T]` parent type that we look for. We need this because we need to store bindings ## for 'S' and 'T' inside 'bindings' on a successful match. It is very important that ## we do not add any bindings at all on an unsuccessful match! - var m = MatchCon(bindings: bindings, potentialImplementation: arg, concpt: concpt, flags: flags) + var m = MatchCon(bindings: bindings, potentialImplementation: arg, concpt: concpt, flags: flags, marker: initHashSet[ConceptTypePair]()) if arg.isConcept: result = conceptsMatch(c, concpt.reduceToBase, arg.reduceToBase, m) >= mkSubset elif arg.acceptsAllTypes: diff --git a/compiler/deps.nim b/compiler/deps.nim new file mode 100644 index 0000000000..7f3dfb797b --- /dev/null +++ b/compiler/deps.nim @@ -0,0 +1,389 @@ +# +# +# The Nim Compiler +# (c) Copyright 2025 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Generate a .build.nif file for nifmake from a Nim project. +## This enables incremental and parallel compilation using the `m` switch. + +import std / [os, tables, sets, times, osproc, strutils] +import options, msgs, lineinfos, pathutils + +import "../dist/nimony/src/lib" / [nifstreams, nifcursors, bitabs, nifreader, nifbuilder] +import "../dist/nimony/src/gear2" / modnames + +type + FilePair = object + nimFile: string + modname: string + + Node = ref object + files: seq[FilePair] # main file + includes + deps: seq[int] # indices into DepContext.nodes + id: int + + DepContext = object + config: ConfigRef + nifler: string + nodes: seq[Node] + processedModules: Table[string, int] # modname -> node index + includeStack: seq[string] + +proc toPair(c: DepContext; f: string): FilePair = + FilePair(nimFile: f, modname: moduleSuffix(f, cast[seq[string]](c.config.searchPaths))) + +proc depsFile(c: DepContext; f: FilePair): string = + getNimcacheDir(c.config).string / f.modname & ".deps.nif" + +proc parsedFile(c: DepContext; f: FilePair): string = + getNimcacheDir(c.config).string / f.modname & ".p.nif" + +proc semmedFile(c: DepContext; f: FilePair): string = + getNimcacheDir(c.config).string / f.modname & ".nif" + +proc findNifler(): string = + # Look for nifler in common locations + let nimDir = getAppDir() + result = nimDir / "nifler" + if not fileExists(result): + result = findExe("nifler") + +proc findNifmake(): string = + # Look for nifmake in common locations + # Try relative to nim executable + let nimDir = getAppDir() + result = nimDir / "nifmake" + if not fileExists(result): + result = findExe("nifmake") + +proc runNifler(c: DepContext; nimFile: string): bool = + ## Run nifler deps on a file if needed. Returns true on success. + let pair = c.toPair(nimFile) + let depsPath = c.depsFile(pair) + + # Check if deps file is up-to-date + if fileExists(depsPath) and fileExists(nimFile): + if getLastModificationTime(depsPath) > getLastModificationTime(nimFile): + return true # Already up-to-date + + # Create output directory if needed + createDir(parentDir(depsPath)) + + # Run nifler deps + let cmd = quoteShell(c.nifler) & " deps " & quoteShell(nimFile) & " " & quoteShell(depsPath) + let exitCode = execShellCmd(cmd) + result = exitCode == 0 + +proc resolveFile(c: DepContext; origin, toResolve: string): string = + ## Resolve an import path relative to origin file + # Handle std/ prefix + var path = toResolve + if path.startsWith("std/"): + path = path.substr(4) + + # Try relative to origin first + let originDir = parentDir(origin) + result = originDir / path.addFileExt("nim") + if fileExists(result): + return result + + # Try search paths + for searchPath in c.config.searchPaths: + result = searchPath.string / path.addFileExt("nim") + if fileExists(result): + return result + + result = "" + +proc traverseDeps(c: var DepContext; pair: FilePair; current: Node) + +proc processInclude(c: var DepContext; includePath: string; current: Node) = + let resolved = resolveFile(c, current.files[current.files.len - 1].nimFile, includePath) + if resolved.len == 0 or not fileExists(resolved): + return + + # Check for recursive includes + for s in c.includeStack: + if s == resolved: + return # Skip recursive include + + c.includeStack.add resolved + current.files.add c.toPair(resolved) + traverseDeps(c, c.toPair(resolved), current) + discard c.includeStack.pop() + +proc processImport(c: var DepContext; importPath: string; current: Node) = + let resolved = resolveFile(c, current.files[0].nimFile, importPath) + if resolved.len == 0 or not fileExists(resolved): + return + + let pair = c.toPair(resolved) + let existingIdx = c.processedModules.getOrDefault(pair.modname, -1) + + if existingIdx == -1: + # New module - create node and process it + let newNode = Node(files: @[pair], id: c.nodes.len) + current.deps.add newNode.id + c.processedModules[pair.modname] = newNode.id + c.nodes.add newNode + traverseDeps(c, pair, newNode) + else: + # Already processed - just add dependency + if existingIdx notin current.deps: + current.deps.add existingIdx + +proc readDepsFile(c: var DepContext; pair: FilePair; current: Node) = + ## Read a .deps.nif file and process imports/includes + let depsPath = c.depsFile(pair) + if not fileExists(depsPath): + return + + var s = nifstreams.open(depsPath) + defer: nifstreams.close(s) + discard processDirectives(s.r) + + var t = next(s) + if t.kind != ParLe: + return + + # Skip to content (past stmts tag) + t = next(s) + + while t.kind != EofToken: + if t.kind == ParLe: + let tag = pool.tags[t.tagId] + case tag + of "import", "fromimport": + # Read import path + t = next(s) + # Check for "when" marker (conditional import) + if t.kind == Ident and pool.strings[t.litId] == "when": + t = next(s) # skip it, still process the import + # Handle path expression (could be ident, string, or infix like std/foo) + var importPath = "" + if t.kind == Ident: + importPath = pool.strings[t.litId] + elif t.kind == StringLit: + importPath = pool.strings[t.litId] + elif t.kind == ParLe and pool.tags[t.tagId] == "infix": + # Handle std / foo style imports + t = next(s) # skip infix tag + if t.kind == Ident: # operator (/) + t = next(s) + if t.kind == Ident: # first part (std) + importPath = pool.strings[t.litId] + t = next(s) + if t.kind == Ident: # second part (foo) + importPath = importPath & "/" & pool.strings[t.litId] + if importPath.len > 0: + processImport(c, importPath, current) + # Skip to end of import node + var depth = 1 + while depth > 0: + t = next(s) + if t.kind == ParLe: inc depth + elif t.kind == ParRi: dec depth + of "include": + # Read include path + t = next(s) + if t.kind == Ident and pool.strings[t.litId] == "when": + t = next(s) # skip conditional marker + var includePath = "" + if t.kind == Ident: + includePath = pool.strings[t.litId] + elif t.kind == StringLit: + includePath = pool.strings[t.litId] + if includePath.len > 0: + processInclude(c, includePath, current) + # Skip to end + var depth = 1 + while depth > 0: + t = next(s) + if t.kind == ParLe: inc depth + elif t.kind == ParRi: dec depth + else: + # Skip unknown node + var depth = 1 + while depth > 0: + t = next(s) + if t.kind == ParLe: inc depth + elif t.kind == ParRi: dec depth + t = next(s) + +proc traverseDeps(c: var DepContext; pair: FilePair; current: Node) = + ## Process a module: run nifler and read deps + if not runNifler(c, pair.nimFile): + rawMessage(c.config, errGenerated, "nifler failed for: " & pair.nimFile) + return + readDepsFile(c, pair, current) + +proc generateBuildFile(c: DepContext): string = + ## Generate the .build.nif file for nifmake + createDir("nifcache") + result = "nifcache" / c.nodes[0].files[0].modname & ".build.nif" + #getNimcacheDir(c.config).string / c.nodes[0].files[0].modname & ".build.nif" + + var b = nifbuilder.open(result) + defer: b.close() + + b.addHeader("nim ic", "nifmake") + b.addTree "stmts" + + # Define nifler command + b.addTree "cmd" + b.addSymbolDef "nifler" + b.addStrLit c.nifler + b.addStrLit "parse" + b.addStrLit "--deps" + b.addTree "input" + b.endTree() + b.addTree "output" + b.endTree() + b.endTree() + + # Define nim m command + b.addTree "cmd" + b.addSymbolDef "nim_m" + b.addStrLit getAppFilename() + b.addStrLit "m" + b.addStrLit "--nimcache:nifcache" + # Add search paths + for p in c.config.searchPaths: + b.addStrLit "--path:" & p.string + b.addTree "args" + b.endTree() + b.withTree "input": + b.addIntLit 0 # main parsed file + b.endTree() + + # Define nim nifc command + b.addTree "cmd" + b.addSymbolDef "nim_nifc" + b.addStrLit getAppFilename() + b.addStrLit "nifc" + b.addStrLit "--nimcache:nifcache" + # Add search paths + for p in c.config.searchPaths: + b.addStrLit "--path:" & p.string + b.addTree "input" + b.addIntLit 0 + b.endTree() + b.endTree() + + # Build rules for parsing (nifler) + var seenFiles = initHashSet[string]() + for node in c.nodes: + for pair in node.files: + let parsed = c.parsedFile(pair) + if not seenFiles.containsOrIncl(parsed): + b.addTree "do" + b.addIdent "nifler" + b.addTree "input" + b.addStrLit pair.nimFile + b.endTree() + b.addTree "output" + b.addStrLit parsed + b.endTree() + b.addTree "output" + b.addStrLit c.depsFile(pair) + b.endTree() + b.endTree() + + # Build rules for semantic checking (nim m) + for i in countdown(c.nodes.len - 1, 0): + let node = c.nodes[i] + let pair = node.files[0] + b.addTree "do" + b.addIdent "nim_m" + # Input: all parsed files for this module + b.withTree "input": + b.addStrLit node.files[0].nimFile + for f in node.files: + b.addTree "input" + b.addStrLit c.parsedFile(f) + b.endTree() + # Also depend on semmed files of dependencies + for depIdx in node.deps: + b.addTree "input" + b.addStrLit c.semmedFile(c.nodes[depIdx].files[0]) + b.endTree() + # Output: semmed file + b.addTree "output" + b.addStrLit c.semmedFile(pair) + b.endTree() + b.endTree() + + # Final compilation step: generate executable from main module + let mainNif = c.nodes[0].files[0].nimFile + let exeFile = changeFileExt(c.nodes[0].files[0].nimFile, ExeExt) + b.addTree "do" + b.addIdent "nim_nifc" + # Input: .nim file (expanded as argument) and .nif file (dependency) + b.addTree "input" + b.addStrLit mainNif + b.endTree() + b.addTree "output" + b.addStrLit exeFile + b.endTree() + b.endTree() + + b.endTree() # stmts + +proc commandIc*(conf: ConfigRef) = + ## Main entry point for `nim ic` + when not defined(nimKochBootstrap): + let nifler = findNifler() + if nifler.len == 0: + rawMessage(conf, errGenerated, "nifler tool not found. Install nimony or add nifler to PATH.") + return + + let projectFile = conf.projectFull.string + if not fileExists(projectFile): + rawMessage(conf, errGenerated, "project file not found: " & projectFile) + return + + # Create nimcache directory + createDir(getNimcacheDir(conf).string) + + var c = DepContext( + config: conf, + nifler: nifler, + nodes: @[], + processedModules: initTable[string, int](), + includeStack: @[] + ) + + # Create root node for main project file + let rootPair = c.toPair(projectFile) + let rootNode = Node(files: @[rootPair], id: 0) + c.nodes.add rootNode + c.processedModules[rootPair.modname] = 0 + + # model the system.nim dependency: + let sysNode = Node(files: @[toPair(c, (conf.libpath / RelativeFile"system.nim").string)], id: 1) + c.nodes.add sysNode + rootNode.deps.add sysNode.id + + # Process dependencies + traverseDeps(c, rootPair, rootNode) + + # Generate build file + let buildFile = generateBuildFile(c) + rawMessage(conf, hintSuccess, "generated: " & buildFile) + + # Automatically run nifmake + let nifmake = findNifmake() + if nifmake.len == 0: + rawMessage(conf, hintSuccess, "run: nifmake run " & buildFile) + else: + let cmd = quoteShell(nifmake) & " run " & quoteShell(buildFile) + rawMessage(conf, hintExecuting, cmd) + let exitCode = execShellCmd(cmd) + if exitCode != 0: + rawMessage(conf, errGenerated, "nifmake failed with exit code: " & $exitCode) + else: + rawMessage(conf, errGenerated, "nim ic not available in bootstrap build") diff --git a/compiler/docgen.nim b/compiler/docgen.nim index 1ea8eafd5d..8167fc4b68 100644 --- a/compiler/docgen.nim +++ b/compiler/docgen.nim @@ -19,7 +19,7 @@ import wordrecg, syntaxes, renderer, lexer, packages/docutils/[rst, rstidx, rstgen, dochelpers], trees, types, - typesrenderer, astalgo, lineinfos, + typesrenderer, lineinfos, pathutils, nimpaths, renderverbatim, packages import packages/docutils/rstast except FileIndex, TLineInfo @@ -1320,7 +1320,7 @@ proc documentEffect(cache: IdentCache; n, x: PNode, effectType: TSpecialWord, id if t.startsWith("ref "): t = substr(t, 4) effects[i] = newIdentNode(getIdent(cache, t), n.info) # set the type so that the following analysis doesn't screw up: - effects[i].typ() = real[i].typ + effects[i].typ = real[i].typ result = newTreeI(nkExprColonExpr, n.info, newIdentNode(getIdent(cache, $effectType), n.info), effects) diff --git a/compiler/enumtostr.nim b/compiler/enumtostr.nim index 2223be2ffb..0227e3023e 100644 --- a/compiler/enumtostr.nim +++ b/compiler/enumtostr.nim @@ -47,8 +47,7 @@ proc genEnumToStrProc*(t: PType; info: TLineInfo; g: ModuleGraph; idgen: IdGener n[bodyPos] = body n[resultPos] = newSymNode(res) result.ast = n - incl result.flags, sfFromGeneric - incl result.flags, sfNeverRaises + incl result.flagsImpl, {sfFromGeneric, sfNeverRaises} proc searchObjCaseImpl(obj: PNode; field: PSym): PNode = case obj.kind @@ -110,5 +109,4 @@ proc genCaseObjDiscMapping*(t: PType; field: PSym; info: TLineInfo; g: ModuleGra n[bodyPos] = body n[resultPos] = newSymNode(res) result.ast = n - incl result.flags, sfFromGeneric - incl result.flags, sfNeverRaises + incl result.flagsImpl, {sfFromGeneric, sfNeverRaises} diff --git a/compiler/evalffi.nim b/compiler/evalffi.nim index 84b51d7a00..9871c81af6 100644 --- a/compiler/evalffi.nim +++ b/compiler/evalffi.nim @@ -275,7 +275,7 @@ proc unpackObject(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = # the nkPar node: if n.isNil: result = newNode(nkTupleConstr) - result.typ() = typ + result.typ = typ if typ.n.isNil: internalError(conf, "cannot unpack unnamed tuple") unpackObjectAdd(conf, x, typ.n, result) @@ -298,7 +298,7 @@ proc unpackObject(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = proc unpackArray(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = if n.isNil: result = newNode(nkBracket) - result.typ() = typ + result.typ = typ newSeq(result.sons, lengthOrd(conf, typ).toInt) else: result = n @@ -319,7 +319,7 @@ proc unpack(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = template aw(k, v, field: untyped): untyped = if n.isNil: result = newNode(k) - result.typ() = typ + result.typ = typ else: # check we have the right field: result = n @@ -333,12 +333,12 @@ proc unpack(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = template setNil() = if n.isNil: result = newNode(nkNilLit) - result.typ() = typ + result.typ = typ else: reset n[] result = n result[] = TNode(kind: nkNilLit) - result.typ() = typ + result.typ = typ template awi(kind, v: untyped): untyped = aw(kind, v, intVal) template awf(kind, v: untyped): untyped = aw(kind, v, floatVal) @@ -427,7 +427,7 @@ proc fficast*(conf: ConfigRef, x: PNode, destTyp: PType): PNode = # cast through a pointer needs a new inner object: let y = if x.kind == nkRefTy: newNodeI(nkRefTy, x.info, 1) else: x.copyTree - y.typ() = x.typ + y.typ = x.typ result = unpack(conf, a, destTyp, y) dealloc a @@ -481,7 +481,7 @@ proc callForeignFunction*(conf: ConfigRef, fn: PNode, fntyp: PType, if aTyp.isNil: internalAssert conf, i+1 < fntyp.len aTyp = fntyp[i+1] - args[i+start].typ() = aTyp + args[i+start].typ = aTyp sig[i] = mapType(conf, aTyp) if sig[i].isNil: globalError(conf, info, "cannot map FFI type") diff --git a/compiler/evaltempl.nim b/compiler/evaltempl.nim index 33916385b1..d2e6046094 100644 --- a/compiler/evaltempl.nim +++ b/compiler/evaltempl.nim @@ -182,7 +182,7 @@ proc wrapInComesFrom*(info: TLineInfo; sym: PSym; res: PNode): PNode = d.add newSymNode(sym, info) result.add d result.add res - result.typ() = res.typ + result.typ = res.typ proc evalTemplate*(n: PNode, tmpl, genSymOwner: PSym; conf: ConfigRef; diff --git a/compiler/guards.nim b/compiler/guards.nim index 15922b3442..553cc744df 100644 --- a/compiler/guards.nim +++ b/compiler/guards.nim @@ -1104,7 +1104,7 @@ proc settype(n: PNode): PType = proc buildOf(it, loc: PNode; o: Operators): PNode = var s = newNodeI(nkCurly, it.info, it.len-1) - s.typ() = settype(loc) + s.typ = settype(loc) for i in 0.. 300: return n + if loopDetector > 300: + message(c.config, n.info, warnUser, "term rewrite macro instantiation too nested") + return n case n.kind of nkMacroDef, nkTemplateDef, procDefs: # already processed (special cases in semstmts.nim) @@ -80,7 +81,7 @@ proc hlo(c: PContext, n: PNode): PNode = # no optimization applied, try subtrees: for i in 0.. 0: + # if kind == tyProc, parameter types are stored in t.n + # and you can access them with `kits` iterator. + # return type is stored in t.sons[0]. + p.types.add t[0].storeType(c, m) + else: + for kid in kids t: + p.types.add kid.storeType(c, m) c.addMissing t.sym p.sym = t.sym.safeItemId(c, m) c.addMissing t.owner @@ -838,7 +844,7 @@ proc loadNodes*(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; 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 + result.typ = result.sym.typ of externIntLit: result.intVal = g[thisModule].fromDisk.numbers[n.litId] of nkStrLit..nkTripleStrLit: @@ -852,7 +858,7 @@ proc loadNodes*(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; 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 + result.typ = result.sym.typ else: for n0 in sonsReadonly(tree, n): result.addAllowNil loadNodes(c, g, thisModule, tree, n0) @@ -899,11 +905,11 @@ proc moduleIndex*(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: in proc symHeaderFromPacked(c: var PackedDecoder; g: var PackedModuleGraph; s: PackedSym; si, item: int32): PSym = result = PSym(itemId: ItemId(module: si, item: item), - kind: s.kind, magic: s.magic, flags: s.flags, - info: translateLineInfo(c, g, si, s.info), - options: s.options, - position: if s.kind in {skForVar, skVar, skLet, skTemp}: 0 else: s.position, - offset: if s.kind in routineKinds: defaultOffset else: s.offset, + kindImpl: s.kind, magicImpl: s.magic, flagsImpl: s.flags, + infoImpl: translateLineInfo(c, g, si, s.info), + optionsImpl: s.options, + positionImpl: if s.kind in {skForVar, skVar, skLet, skTemp}: 0 else: s.position, + offsetImpl: if s.kind in routineKinds: defaultOffset else: s.offset, disamb: s.disamb, name: getIdent(c.cache, g[si].fromDisk.strings[s.name]) ) @@ -945,8 +951,8 @@ proc symBodyFromPacked(c: var PackedDecoder; g: var PackedModuleGraph; setOwner(result, loadSym(c, g, si, s.owner)) let externalName = g[si].fromDisk.strings[s.externalName] if externalName != "": - result.loc.snippet = externalName - result.loc.flags = s.locFlags + result.locImpl.snippet = externalName + result.locImpl.flags = s.locFlags result.instantiatedFrom = loadSym(c, g, si, s.instantiatedFrom) proc needsRecompile(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCache; @@ -990,10 +996,10 @@ proc loadSym(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; s: proc typeHeaderFromPacked(c: var PackedDecoder; g: var PackedModuleGraph; t: PackedType; si, item: int32): PType = result = PType(itemId: ItemId(module: si, item: t.nonUniqueId), kind: t.kind, - flags: t.flags, size: t.size, align: t.align, - paddingAtEnd: t.paddingAtEnd, + flagsImpl: t.flags, sizeImpl: t.size, alignImpl: t.align, + paddingAtEndImpl: t.paddingAtEnd, uniqueId: ItemId(module: si, item: item), - callConv: t.callConv) + callConvImpl: t.callConv) proc typeBodyFromPacked(c: var PackedDecoder; g: var PackedModuleGraph; t: PackedType; si, item: int32; result: PType) = @@ -1058,12 +1064,12 @@ proc setupLookupTables(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCa let filename = AbsoluteFile toFullPath(conf, fileIdx) # We cannot call ``newSym`` here, because we have to circumvent the ID # mechanism, which we do in order to assign each module a persistent ID. - m.module = PSym(kind: skModule, itemId: ItemId(module: int32(fileIdx), item: 0'i32), + m.module = PSym(kindImpl: skModule, itemId: ItemId(module: int32(fileIdx), item: 0'i32), name: getIdent(cache, splitFile(filename).name), - info: newLineInfo(fileIdx, 1, 1), - position: int(fileIdx)) + infoImpl: newLineInfo(fileIdx, 1, 1), + positionImpl: int(fileIdx)) setOwner(m.module, getPackage(conf, cache, fileIdx)) - m.module.flags = m.fromDisk.moduleFlags + m.module.flagsImpl = m.fromDisk.moduleFlags proc loadToReplayNodes(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCache; fileIdx: FileIndex; m: var LoadedModule) = diff --git a/compiler/ic/navigator.nim b/compiler/ic/navigator.nim index 39037b94f2..9d58aa3840 100644 --- a/compiler/ic/navigator.nim +++ b/compiler/ic/navigator.nim @@ -7,7 +7,7 @@ # distribution, for details about the copyright. # -## Supports the "nim check --ic:on --defusages:FILE,LINE,COL" +## Supports the "nim check --ic:legacy --defusages:FILE,LINE,COL" ## IDE-like features. It uses the set of .rod files to accomplish ## its task. The set must cover a complete Nim project. diff --git a/compiler/importer.nim b/compiler/importer.nim index 23814ae50f..2d50973756 100644 --- a/compiler/importer.nim +++ b/compiler/importer.nim @@ -10,7 +10,7 @@ ## This module implements the symbol importing mechanism. import - ast, astalgo, msgs, options, idents, lookups, + ast, msgs, options, idents, lookups, semdata, modulepaths, sigmatch, lineinfos, modulegraphs, wordrecg from std/strutils import `%`, startsWith @@ -245,7 +245,8 @@ proc importModuleAs(c: PContext; n: PNode, realModule: PSym, importHidden, track # avoids modifying `realModule`, see D20201209T194412 for `import {.all.}` result = createModuleAliasImpl(realModule.name) if importHidden: - result.options.incl optImportHidden + ensureMutable result + result.optionsImpl.incl optImportHidden let moduleIdent = if n.kind in {nkInfix, nkImportAs}: n[^1] else: n result.info = moduleIdent.info if trackUnusedImport: diff --git a/compiler/injectdestructors.nim b/compiler/injectdestructors.nim index 1f2cff7e5f..e6ddf79a8a 100644 --- a/compiler/injectdestructors.nim +++ b/compiler/injectdestructors.nim @@ -343,7 +343,7 @@ proc genMarkCyclic(c: var Con; result, dest: PNode) = result.add callCodegenProc(c.graph, "nimMarkCyclic", dest.info, dest) else: let xenv = genBuiltin(c.graph, c.idgen, mAccessEnv, "accessEnv", dest) - xenv.typ() = getSysType(c.graph, dest.info, tyPointer) + xenv.typ = getSysType(c.graph, dest.info, tyPointer) result.add callCodegenProc(c.graph, "nimMarkCyclic", dest.info, xenv) proc genCopyNoCheck(c: var Con; dest, ri: PNode; a: TTypeAttachedOp): PNode = @@ -419,7 +419,7 @@ proc genWasMoved(c: var Con, n: PNode): PNode = proc genDefaultCall(t: PType; c: Con; info: TLineInfo): PNode = result = newNodeI(nkCall, info) result.add(newSymNode(createMagic(c.graph, c.idgen, "default", mDefault))) - result.typ() = t + result.typ = t proc destructiveMoveVar(n: PNode; c: var Con; s: var Scope): PNode = # generate: (let tmp = v; reset(v); tmp) @@ -825,9 +825,9 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode; tmpFlags = {sfSing n[1].typ.skipTypes(abstractInst-{tyOwned}).kind == tyOwned: # allow conversions from owned to unowned via this little hack: let nTyp = n[1].typ - n[1].typ() = n.typ + n[1].typ = n.typ result[1] = p(n[1], c, s, sinkArg) - result[1].typ() = nTyp + result[1].typ = nTyp else: result[1] = p(n[1], c, s, sinkArg) elif n.kind in {nkObjDownConv, nkObjUpConv}: @@ -964,14 +964,14 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode; tmpFlags = {sfSing s.locals.add v.sym pVarTopLevel(v, c, s, result) if ri.kind != nkEmpty: - let isGlobalPragma = v.kind == nkSym and + let isGlobalPragma = v.kind == nkSym and {sfPure, sfGlobal} <= v.sym.flags and isInProc - let value = moveOrCopy(v, ri, c, s, if v.kind == nkSym: {IsDecl} else: {}) if isGlobalPragma: - c.graph.procGlobals.add value + c.graph.procGlobals.add newTree(nkFastAsgn, v, ri) else: + let value = moveOrCopy(v, ri, c, s, if v.kind == nkSym: {IsDecl} else: {}) result.add value elif ri.kind == nkEmpty and c.inLoop > 0: let skipInit = v.kind == nkDotExpr and # Closure var @@ -1036,9 +1036,9 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode; tmpFlags = {sfSing n[1].typ.skipTypes(abstractInst-{tyOwned}).kind == tyOwned: # allow conversions from owned to unowned via this little hack: let nTyp = n[1].typ - n[1].typ() = n.typ + n[1].typ = n.typ result[1] = p(n[1], c, s, mode) - result[1].typ() = nTyp + result[1].typ = nTyp else: result[1] = p(n[1], c, s, mode) @@ -1155,7 +1155,7 @@ proc ownsData(c: var Con; s: var Scope; orig: PNode; flags: set[MoveOrCopyFlag]) if n.kind in nkCallKinds and n.typ != nil and hasDestructor(c, n.typ): result = newNodeIT(nkStmtListExpr, orig.info, orig.typ) let tmp = c.getTemp(s, n.typ, n.info) - tmp.sym.flags.incl sfSingleUsedTemp + tmp.sym.flagsImpl.incl sfSingleUsedTemp result.add newTree(nkFastAsgn, tmp, copyTree(n)) s.final.add c.genDestroy(tmp) n[] = tmp[] @@ -1330,7 +1330,7 @@ proc addSinkCopy(c: var Con; s: var Scope; sinkParams: seq[PSym]; n: PNode): PNo for param in sinkParams: if param.id in mutatedSet: let newSym = newSym(skTemp, getIdent(c.graph.cache, "sinkCopy"), c.idgen, param.owner, n.info) - newSym.flags.incl sfFromGeneric + newSym.flagsImpl.incl sfFromGeneric newSym.typ = param.typ.elementType mapping[param.id] = newSym let v = newNodeI(nkVarSection, n.info) diff --git a/compiler/inliner.nim b/compiler/inliner.nim new file mode 100644 index 0000000000..a8f032bccc --- /dev/null +++ b/compiler/inliner.nim @@ -0,0 +1,122 @@ + +proc copySymdef(n: PNode; locals: var Table[int, PSym]; idgen: IdGenerator; owner: PSym): PNode = + case n.kind + of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: + result = n + of nkSym: + let oldSym = n.sym + let newSym = copySym(oldSym, idgen) + setOwner(newSym, owner) + locals[oldSym.id] = newSym + result = newSymNode(newSym, oldSym.info) + else: + result = shallowCopy(n) + for i in 0.. 0: + result.typ.n.add copyNode(prc.typ.n[0]) + for i in 1..> BigInt($2))") + applyFormat("BigInt.asIntN(64, BigInt.asUintN(64, $1) >> (BigInt($2) & 63n))") elif typ.kind == tyUInt64 and optJsBigInt64 in p.config.globalOptions: - applyFormat("($1 >> BigInt($2))") + applyFormat("($1 >> (BigInt($2) & 63n))") else: + let bitmask = typ.size * 8 - 1 if typ.kind in {tyInt..tyInt32}: let trimmerU = unsignedTrimmer(typ.size) let trimmerS = signedTrimmer(typ.size) - r.res = "((($1 $2) >>> $3) $4)" % [xLoc, trimmerU, yLoc, trimmerS] + r.res = "((($1 $2) >>> ($3 & $5)) $4)" % [xLoc, trimmerU, yLoc, trimmerS, $bitmask] else: - applyFormat("($1 >>> $2)") + r.res = "($1 >>> ($2 & $3))" % [xLoc, yLoc, $bitmask] of mShlI: let typ = n[1].typ.skipTypes(abstractVarRange) if typ.size == 8: if typ.kind == tyInt64 and optJsBigInt64 in p.config.globalOptions: - applyFormat("BigInt.asIntN(64, $1 << BigInt($2))") + applyFormat("BigInt.asIntN(64, $1 << (BigInt($2) & 63n))") elif typ.kind == tyUInt64 and optJsBigInt64 in p.config.globalOptions: - applyFormat("BigInt.asUintN(64, $1 << BigInt($2))") + applyFormat("BigInt.asUintN(64, $1 << (BigInt($2) & 63n))") else: - applyFormat("($1 * Math.pow(2, $2))") + applyFormat("($1 * Math.pow(2, ($2 & 63)))") else: + let bitmask = typ.size * 8 - 1 if typ.kind in {tyUInt..tyUInt32}: let trimmer = unsignedTrimmer(typ.size) - r.res = "(($1 << $2) $3)" % [xLoc, yLoc, trimmer] + r.res = "(($1 << ($2 & $4)) $3)" % [xLoc, yLoc, trimmer, $bitmask] else: let trimmer = signedTrimmer(typ.size) - r.res = "(($1 << $2) $3)" % [xLoc, yLoc, trimmer] + r.res = "(($1 << ($2 & $4)) $3)" % [xLoc, yLoc, trimmer, $bitmask] of mAshrI: let typ = n[1].typ.skipTypes(abstractVarRange) if typ.size == 8: if optJsBigInt64 in p.config.globalOptions: - applyFormat("($1 >> BigInt($2))") + applyFormat("($1 >> (BigInt($2) & 63n))") else: - applyFormat("Math.floor($1 / Math.pow(2, $2))") + applyFormat("Math.floor($1 / Math.pow(2, ($2 & 63)))") else: + let bitmask = typ.size * 8 - 1 if typ.kind in {tyUInt..tyUInt32}: - applyFormat("($1 >>> $2)") + r.res = "($1 >>> ($2 & $3)))" % [xLoc, yLoc, $bitmask] else: - applyFormat("($1 >> $2)") + r.res = "($1 >> ($2 & $3))" % [xLoc, yLoc, $bitmask] of mBitandI: bitwiseExpr("&") of mBitorI: bitwiseExpr("|") of mBitxorI: bitwiseExpr("^") @@ -1002,7 +1006,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.snippet = mangleName(p.module, excAlias.sym) + ensureMutable excAlias.sym + excAlias.sym.locImpl.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) @@ -1135,7 +1140,8 @@ proc genBlock(p: PProc, n: PNode, r: var TCompRes) = # named block? if (n[0].kind != nkSym): internalError(p.config, n.info, "genBlock") var sym = n[0].sym - sym.loc.k = locOther + ensureMutable sym + sym.locImpl.k = locOther sym.position = idx+1 let labl = p.unique lineF(p, "Label$1: {$n", [labl.rope]) @@ -1234,7 +1240,8 @@ proc generateHeader(p: PProc, prc: PSym): Rope = # to keep it simple let env = prc.ast[paramsPos].lastSon assert env.kind == nkSym, "env is missing" - env.sym.loc.snippet = "this" + ensureMutable env.sym + env.sym.locImpl.snippet = "this" for i in 1.. 0 @@ -2333,8 +2351,8 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = r.res = "if (null != $1) { if (null == $2) $2 = $3; else $2 += $3; }" % [b, lhs.rdLoc, tmp] else: - let (a, tmp) = maybeMakeTemp(p, n[1], lhs) - r.res = "$1.push.apply($3, $2);" % [a, rhs.rdLoc, tmp] + useMagic(p, "nimAddStrStr") + r.res = "nimAddStrStr($1, $2);" % [lhs.rdLoc, rhs.rdLoc] r.kind = resExpr of mAppendSeqElem: var x, y: TCompRes = default(TCompRes) @@ -2577,7 +2595,9 @@ 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.snippet == "": f.loc.snippet = mangleName(p.module, f) + if f.loc.snippet == "": + ensureMutable f + f.locImpl.snippet = mangleName(p.module, f) fieldIDs.incl(lookupFieldAgain(n.typ.skipTypes({tyDistinct}), f).id) let typ = val.typ.skipTypes(abstractInst) diff --git a/compiler/lambdalifting.nim b/compiler/lambdalifting.nim index e9195644e1..e547bc66c9 100644 --- a/compiler/lambdalifting.nim +++ b/compiler/lambdalifting.nim @@ -150,7 +150,7 @@ template isIterator*(owner: PSym): bool = proc createEnvObj(g: ModuleGraph; idgen: IdGenerator; owner: PSym; info: TLineInfo): PType = result = createObj(g, idgen, owner, info, final=false) - result.flags.incl tfFinal + result.incl tfFinal if owner.isIterator: rawAddField(result, createStateField(g, owner, idgen)) @@ -161,7 +161,7 @@ proc getClosureIterResult*(g: ModuleGraph; iter: PSym; idgen: IdGenerator): PSym # XXX a bit hacky: result = newSym(skResult, getIdent(g.cache, ":result"), idgen, iter, iter.info, {}) result.typ = iter.typ.returnType - incl(result.flags, sfUsed) + incl(result.flagsImpl, sfUsed) iter.ast.add newSymNode(result) proc addHiddenParam(routine: PSym, param: PSym) = @@ -228,7 +228,7 @@ proc makeClosure*(g: ModuleGraph; idgen: IdGenerator; prc: PSym; env: PNode; inf #if isClosureIterator(result.typ): createTypeBoundOps(g, nil, result.typ, info, idgen) if tfHasAsgn in result.typ.flags or optSeqDestructors in g.config.globalOptions: - prc.flags.incl sfInjectDestructors + prc.incl sfInjectDestructors template liftingHarmful(conf: ConfigRef; owner: PSym): bool = ## lambda lifting can be harmful for JS-like code generators. @@ -240,7 +240,7 @@ proc createTypeBoundOpsLL(g: ModuleGraph; refType: PType; info: TLineInfo; 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 + owner.incl sfInjectDestructors proc genCreateEnv(env: PNode): PNode = var c = newNodeIT(nkObjConstr, env.info, env.typ) @@ -290,7 +290,7 @@ proc markAsClosure(g: ModuleGraph; owner: PSym; n: PNode) = 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]) - incl(owner.typ.flags, tfCapturesEnv) + incl(owner.typ, tfCapturesEnv) if not isEnv: owner.typ.callConv = ccClosure @@ -336,7 +336,7 @@ proc asOwnedRef(c: var DetectionPass; t: PType): PType = if optOwnedRefs in c.graph.config.globalOptions: assert t.kind == tyRef result = newType(tyOwned, c.idgen, t.owner) - result.flags.incl tfHasOwned + result.incl tfHasOwned result.rawAddSon t else: result = t @@ -414,7 +414,7 @@ proc addClosureParam(c: var DetectionPass; fn: PSym; info: TLineInfo) = let t = c.getEnvTypeForOwner(owner, info) if cp == nil: cp = newSym(skParam, getIdent(c.graph.cache, paramName), c.idgen, fn, fn.info) - incl(cp.flags, sfFromGeneric) + incl(cp.flagsImpl, sfFromGeneric) cp.typ = t addHiddenParam(fn, cp) elif cp.typ != t and fn.kind != skIterator: @@ -610,7 +610,7 @@ proc rawClosureCreation(owner: PSym; let unowned = c.unownedEnvVars[owner.id] assert unowned != nil let env2 = copyTree(env) - env2.typ() = unowned.typ + env2.typ = unowned.typ result.add newAsgnStmt(unowned, env2, env.info) createTypeBoundOpsLL(d.graph, unowned.typ, env.info, d.idgen, owner) @@ -624,7 +624,7 @@ proc rawClosureCreation(owner: PSym; if owner.kind != skMacro: createTypeBoundOps(d.graph, nil, fieldAccess.typ, env.info, d.idgen) if tfHasAsgn in fieldAccess.typ.flags or optSeqDestructors in d.graph.config.globalOptions: - owner.flags.incl sfInjectDestructors + owner.incl sfInjectDestructors let upField = lookupInRecord(env.typ.skipTypes({tyOwned, tyRef, tyPtr}).n, getIdent(d.graph.cache, upName)) if upField != nil: @@ -666,7 +666,7 @@ proc closureCreationForIter(owner: PSym, iter: PNode; result = newNodeIT(nkStmtListExpr, iter.info, iter.sym.typ) let iterOwner = iter.sym.skipGenericOwner var v = newSym(skVar, getIdent(d.graph.cache, envName), d.idgen, iterOwner, iter.info) - incl(v.flags, sfShadowed) + incl(v.flagsImpl, sfShadowed) v.typ = asOwnedRef(d, getHiddenParam(d.graph, iter.sym).typ) var vnode: PNode if iterOwner.isIterator: @@ -787,7 +787,7 @@ proc liftCapturedVars(n: PNode; owner: PSym; d: var DetectionPass; let oldInContainer = c.inContainer c.inContainer = 0 let m = newSymNode(n[namePos].sym) - m.typ() = n.typ + m.typ = n.typ result = liftCapturedVars(m, owner, d, c) c.inContainer = oldInContainer of nkHiddenStdConv: diff --git a/compiler/layeredtable.nim b/compiler/layeredtable.nim index 248ec4bcf2..81c6c63d75 100644 --- a/compiler/layeredtable.nim +++ b/compiler/layeredtable.nim @@ -1,4 +1,3 @@ -import std/[tables] import ast, astalgo type diff --git a/compiler/liftdestructors.nim b/compiler/liftdestructors.nim index 5d8fbc179d..c3b6ba0886 100644 --- a/compiler/liftdestructors.nim +++ b/compiler/liftdestructors.nim @@ -49,7 +49,7 @@ proc at(a, i: PNode, elemType: PType): PNode = result = newNodeI(nkBracketExpr, a.info, 2) result[0] = a result[1] = i - result.typ() = elemType + result.typ = elemType proc destructorOverridden(g: ModuleGraph; t: PType): bool = let op = getAttachedOp(g, t, attachedDestructor) @@ -68,7 +68,7 @@ proc dotField(x: PNode, f: PSym): PNode = else: result[0] = x result[1] = newSymNode(f, x.info) - result.typ() = f.typ + result.typ = f.typ proc newAsgnStmt(le, ri: PNode): PNode = result = newNodeI(nkAsgn, le.info, 2) @@ -88,7 +88,7 @@ proc defaultOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = body.add newAsgnStmt(x, y) elif c.kind == attachedDestructor and c.addMemReset: let call = genBuiltin(c, mDefault, "default", x) - call.typ() = t + call.typ = t body.add newAsgnStmt(x, call) elif c.kind == attachedWasMoved: body.add genBuiltin(c, mWasMoved, "wasMoved", x) @@ -105,7 +105,7 @@ proc genWhileLoop(c: var TLiftCtx; i, dest: PNode): PNode = result = newNodeI(nkWhileStmt, c.info, 2) let cmp = genBuiltin(c, mLtI, "<", i) cmp.add genLen(c.g, dest) - cmp.typ() = getSysType(c.g, c.info, tyBool) + cmp.typ = getSysType(c.g, c.info, tyBool) result[0] = cmp result[1] = newNodeI(nkStmtList, c.info) @@ -127,10 +127,10 @@ proc genContainerOf(c: var TLiftCtx; objType: PType, field, x: PSym): PNode = dotExpr.add newSymNode(field) let offsetOf = genBuiltin(c, mOffsetOf, "offsetof", dotExpr) - offsetOf.typ() = intType + offsetOf.typ = intType let minusExpr = genBuiltin(c, mSubI, "-", castExpr1) - minusExpr.typ() = intType + minusExpr.typ = intType minusExpr.add offsetOf let objPtr = makePtrType(objType.owner, objType, c.idgen) @@ -280,11 +280,11 @@ proc fillBodyObjT(c: var TLiftCtx; t: PType, body, x, y: PNode) = # because the wasMoved(dest) call would zero out src, if dest aliases src. var cond = newTree(nkCall, newSymNode(c.g.getSysMagic(c.info, "==", mEqRef)), newTreeIT(nkAddr, c.info, makePtrType(c.fn, x.typ, c.idgen), x), newTreeIT(nkAddr, c.info, makePtrType(c.fn, y.typ, c.idgen), y)) - cond.typ() = getSysType(c.g, x.info, tyBool) + cond.typ = getSysType(c.g, x.info, tyBool) body.add genIf(c, cond, newTreeI(nkReturnStmt, c.info, newNodeI(nkEmpty, c.info))) var temp = newSym(skTemp, getIdent(c.g.cache, lowerings.genPrefix), c.idgen, c.fn, c.info) temp.typ = x.typ - incl(temp.flags, sfFromGeneric) + incl(temp, sfFromGeneric) var v = newNodeI(nkVarSection, c.info) let blob = newSymNode(temp) v.addVar(blob, x) @@ -312,7 +312,7 @@ proc fillBodyObjT(c: var TLiftCtx; t: PType, body, x, y: PNode) = proc boolLit*(g: ModuleGraph; info: TLineInfo; value: bool): PNode = result = newIntLit(g, info, ord value) - result.typ() = getSysType(g, info, tyBool) + result.typ = getSysType(g, info, tyBool) proc getCycleParam(c: TLiftCtx): PNode = assert c.kind in {attachedAsgn, attachedDup} @@ -380,6 +380,10 @@ proc requiresDestructor(c: TLiftCtx; t: PType): bool {.inline.} = proc instantiateGeneric(c: var TLiftCtx; op: PSym; t, typeInst: PType): PSym = if c.c != nil and typeInst != nil: result = c.c.instTypeBoundOp(c.c, op, typeInst, c.info, attachedAsgn, 1) + elif typeInst != nil and getAttachedOp(c.g, typeInst, c.kind) != nil: + # c.c == nil in lambdalifting + # hooks are already insted + result = getAttachedOp(c.g, typeInst, c.kind) else: localError(c.g.config, c.info, "cannot generate destructor for generic type: " & typeToString(t)) @@ -393,7 +397,8 @@ proc considerAsgnOrSink(c: var TLiftCtx; t: PType; body, x, y: PNode; if op != nil and op != c.fn and (sfOverridden in op.flags or destructorOverridden): if sfError in op.flags: - incl c.fn.flags, sfError + ensureMutable c.fn + incl c.fn.flagsImpl, sfError #else: # markUsed(c.g.config, c.info, op, c.g.usageSym) onUse(c.info, op) @@ -419,7 +424,8 @@ proc considerAsgnOrSink(c: var TLiftCtx; t: PType; body, x, y: PNode; if op == nil: op = produceSym(c.g, c.c, t, c.kind, c.info, c.idgen) if sfError in op.flags: - incl c.fn.flags, sfError + ensureMutable c.fn + incl c.fn.flagsImpl, sfError #else: # markUsed(c.g.config, c.info, op, c.g.usageSym) onUse(c.info, op) @@ -535,7 +541,7 @@ proc considerUserDefinedOp(c: var TLiftCtx; t: PType; body, x, y: PNode): bool = proc declareCounter(c: var TLiftCtx; body: PNode; first: BiggestInt): PNode = var temp = newSym(skTemp, getIdent(c.g.cache, lowerings.genPrefix), c.idgen, c.fn, c.info) temp.typ = getSysType(c.g, body.info, tyInt) - incl(temp.flags, sfFromGeneric) + incl(temp.flagsImpl, sfFromGeneric) var v = newNodeI(nkVarSection, c.info) result = newSymNode(temp) @@ -545,7 +551,7 @@ proc declareCounter(c: var TLiftCtx; body: PNode; first: BiggestInt): PNode = proc declareTempOf(c: var TLiftCtx; body: PNode; value: PNode): PNode = var temp = newSym(skTemp, getIdent(c.g.cache, lowerings.genPrefix), c.idgen, c.fn, c.info) temp.typ = value.typ - incl(temp.flags, sfFromGeneric) + incl(temp.flagsImpl, sfFromGeneric) var v = newNodeI(nkVarSection, c.info) result = newSymNode(temp) @@ -561,18 +567,18 @@ proc newSeqCall(c: var TLiftCtx; x, y: PNode): PNode = # don't call genAddr(c, x) here: result = genBuiltin(c, mNewSeq, "newSeq", x) let lenCall = genBuiltin(c, mLengthSeq, "len", y) - lenCall.typ() = getSysType(c.g, x.info, tyInt) + lenCall.typ = getSysType(c.g, x.info, tyInt) result.add lenCall proc setLenStrCall(c: var TLiftCtx; x, y: PNode): PNode = let lenCall = genBuiltin(c, mLengthStr, "len", y) - lenCall.typ() = getSysType(c.g, x.info, tyInt) + lenCall.typ = getSysType(c.g, x.info, tyInt) result = genBuiltin(c, mSetLengthStr, "setLen", x) # genAddr(g, x)) result.add lenCall proc setLenSeqCall(c: var TLiftCtx; t: PType; x, y: PNode): PNode = let lenCall = genBuiltin(c, mLengthSeq, "len", y) - lenCall.typ() = getSysType(c.g, x.info, tyInt) + lenCall.typ = getSysType(c.g, x.info, tyInt) var op = getSysMagic(c.g, x.info, "setLen", mSetLengthSeq) op = instantiateGeneric(c, op, t, t) result = newTree(nkCall, newSymNode(op, x.info), x, lenCall) @@ -595,7 +601,7 @@ proc checkSelfAssignment(c: var TLiftCtx; t: PType; body, x, y: PNode) = newTreeIT(nkAddr, c.info, makePtrType(c.fn, x.typ, c.idgen), x), newTreeIT(nkAddr, c.info, makePtrType(c.fn, y.typ, c.idgen), y) ) - cond.typ() = getSysType(c.g, c.info, tyBool) + cond.typ = getSysType(c.g, c.info, tyBool) body.add genIf(c, cond, newTreeI(nkReturnStmt, c.info, newNodeI(nkEmpty, c.info))) proc fillSeqOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = @@ -736,7 +742,7 @@ proc atomicRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = if isFinal(elemType): addDestructorCall(c, elemType, actions, genDeref(tmp, nkDerefExpr)) var alignOf = genBuiltin(c, mAlignOf, "alignof", newNodeIT(nkType, c.info, elemType)) - alignOf.typ() = getSysType(c.g, c.info, tyInt) + alignOf.typ = getSysType(c.g, c.info, tyInt) actions.add callCodegenProc(c.g, "nimRawDispose", c.info, tmp, alignOf) else: addDestructorCall(c, elemType, newNodeI(nkStmtList, c.info), genDeref(tmp, nkDerefExpr)) @@ -746,7 +752,7 @@ proc atomicRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = if isCyclic: if isFinal(elemType): let typInfo = genBuiltin(c, mGetTypeInfoV2, "getTypeInfoV2", newNodeIT(nkType, x.info, elemType)) - typInfo.typ() = getSysType(c.g, c.info, tyPointer) + typInfo.typ = getSysType(c.g, c.info, tyPointer) cond = callCodegenProc(c.g, "nimDecRefIsLastCyclicStatic", c.info, tmp, typInfo) else: cond = callCodegenProc(c.g, "nimDecRefIsLastCyclicDyn", c.info, tmp) @@ -754,7 +760,7 @@ proc atomicRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = cond = callCodegenProc(c.g, "nimDecRefIsLastDyn", c.info, x) else: cond = callCodegenProc(c.g, "nimDecRefIsLast", c.info, x) - cond.typ() = getSysType(c.g, x.info, tyBool) + cond.typ = getSysType(c.g, x.info, tyBool) case c.kind of attachedSink: @@ -781,7 +787,7 @@ proc atomicRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = if isCyclic: if isFinal(elemType): let typInfo = genBuiltin(c, mGetTypeInfoV2, "getTypeInfoV2", newNodeIT(nkType, x.info, elemType)) - typInfo.typ() = getSysType(c.g, c.info, tyPointer) + typInfo.typ = getSysType(c.g, c.info, tyPointer) body.add callCodegenProc(c.g, "nimTraceRef", c.info, genAddrOf(x, c.idgen), typInfo, y) else: # If the ref is polymorphic we have to account for this @@ -802,7 +808,7 @@ proc atomicClosureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = ## Closures are really like refs except they always use a virtual destructor ## and we need to do the refcounting only on the ref field which we call 'xenv': let xenv = genBuiltin(c, mAccessEnv, "accessEnv", x) - xenv.typ() = getSysType(c.g, c.info, tyPointer) + xenv.typ = getSysType(c.g, c.info, tyPointer) let isCyclic = c.g.config.selectedGC == gcOrc let tmp = @@ -818,7 +824,7 @@ proc atomicClosureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = if isCyclic: "nimDecRefIsLastCyclicDyn" else: "nimDecRefIsLast" let cond = callCodegenProc(c.g, decRefProc, c.info, tmp) - cond.typ() = getSysType(c.g, x.info, tyBool) + cond.typ = getSysType(c.g, x.info, tyBool) case c.kind of attachedSink: @@ -830,7 +836,7 @@ proc atomicClosureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = body.add newAsgnStmt(x, y) of attachedAsgn: let yenv = genBuiltin(c, mAccessEnv, "accessEnv", y) - yenv.typ() = getSysType(c.g, c.info, tyPointer) + yenv.typ = getSysType(c.g, c.info, tyPointer) if isCyclic: body.add genIf(c, yenv, callCodegenProc(c.g, "nimIncRefCyclic", c.info, yenv, getCycleParam(c))) body.add newAsgnStmt(x, y) @@ -842,7 +848,7 @@ proc atomicClosureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = body.add newAsgnStmt(x, y) of attachedDup: let yenv = genBuiltin(c, mAccessEnv, "accessEnv", y) - yenv.typ() = getSysType(c.g, c.info, tyPointer) + yenv.typ = getSysType(c.g, c.info, tyPointer) if isCyclic: body.add newAsgnStmt(x, y) body.add genIf(c, yenv, callCodegenProc(c.g, "nimIncRefCyclic", c.info, yenv, getCycleParam(c))) @@ -894,7 +900,7 @@ proc ownedRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = if isFinal(elemType): addDestructorCall(c, elemType, actions, genDeref(x, nkDerefExpr)) var alignOf = genBuiltin(c, mAlignOf, "alignof", newNodeIT(nkType, c.info, elemType)) - alignOf.typ() = getSysType(c.g, c.info, tyInt) + alignOf.typ = getSysType(c.g, c.info, tyInt) actions.add callCodegenProc(c.g, "nimRawDispose", c.info, x, alignOf) else: addDestructorCall(c, elemType, newNodeI(nkStmtList, c.info), genDeref(x, nkDerefExpr)) @@ -917,14 +923,14 @@ proc closureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = # a big problem is that we don't know the environment's type here, so we # have to go through some indirection; we delegate this to the codegen: let call = newNodeI(nkCall, c.info, 2) - call.typ() = t + call.typ = t call[0] = newSymNode(createMagic(c.g, c.idgen, "deepCopy", mDeepCopy)) call[1] = y body.add newAsgnStmt(x, call) elif (optOwnedRefs in c.g.config.globalOptions and optRefCheck in c.g.config.options) or c.g.config.selectedGC in {gcArc, gcAtomicArc, gcOrc}: let xx = genBuiltin(c, mAccessEnv, "accessEnv", x) - xx.typ() = getSysType(c.g, c.info, tyPointer) + xx.typ = getSysType(c.g, c.info, tyPointer) case c.kind of attachedSink: # we 'nil' y out afterwards so we *need* to take over its reference @@ -933,13 +939,13 @@ proc closureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = body.add newAsgnStmt(x, y) of attachedAsgn: let yy = genBuiltin(c, mAccessEnv, "accessEnv", y) - yy.typ() = getSysType(c.g, c.info, tyPointer) + yy.typ = getSysType(c.g, c.info, tyPointer) body.add genIf(c, yy, callCodegenProc(c.g, "nimIncRef", c.info, yy)) body.add genIf(c, xx, callCodegenProc(c.g, "nimDecWeakRef", c.info, xx)) body.add newAsgnStmt(x, y) of attachedDup: let yy = genBuiltin(c, mAccessEnv, "accessEnv", y) - yy.typ() = getSysType(c.g, c.info, tyPointer) + yy.typ = getSysType(c.g, c.info, tyPointer) body.add newAsgnStmt(x, y) body.add genIf(c, yy, callCodegenProc(c.g, "nimIncRef", c.info, yy)) of attachedDestructor: @@ -954,7 +960,7 @@ proc closureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = proc ownedClosureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = let xx = genBuiltin(c, mAccessEnv, "accessEnv", x) - xx.typ() = getSysType(c.g, c.info, tyPointer) + xx.typ = getSysType(c.g, c.info, tyPointer) var actions = newNodeI(nkStmtList, c.info) #discard addDestructorCall(c, elemType, newNodeI(nkStmtList, c.info), genDeref(xx)) actions.add callCodegenProc(c.g, "nimDestroyAndDispose", c.info, xx) @@ -1120,8 +1126,7 @@ proc symDupPrototype(g: ModuleGraph; typ: PType; owner: PSym; kind: TTypeAttache n[bodyPos] = newNodeI(nkStmtList, info) n[resultPos] = newSymNode(res) result.ast = n - incl result.flags, sfFromGeneric - incl result.flags, sfGeneratedOp + incl result.flagsImpl, {sfFromGeneric, sfGeneratedOp} proc symPrototype(g: ModuleGraph; typ: PType; owner: PSym; kind: TTypeAttachedOp; info: TLineInfo; idgen: IdGenerator; isDiscriminant = false): PSym = @@ -1163,17 +1168,17 @@ proc symPrototype(g: ModuleGraph; typ: PType; owner: PSym; kind: TTypeAttachedOp n[paramsPos] = result.typ.n n[bodyPos] = newNodeI(nkStmtList, info) result.ast = n - incl result.flags, sfFromGeneric - incl result.flags, sfGeneratedOp + incl result.flagsImpl, sfFromGeneric + incl result.flagsImpl, sfGeneratedOp if kind == attachedWasMoved: - incl result.flags, sfNoSideEffect - incl result.typ.flags, tfNoSideEffect + incl result.flagsImpl, sfNoSideEffect + incl result.typ, tfNoSideEffect proc genTypeFieldCopy(c: var TLiftCtx; t: PType; body, x, y: PNode) = let xx = genBuiltin(c, mAccessTypeField, "accessTypeField", x) let yy = genBuiltin(c, mAccessTypeField, "accessTypeField", y) - xx.typ() = getSysType(c.g, c.info, tyPointer) - yy.typ() = xx.typ + xx.typ = getSysType(c.g, c.info, tyPointer) + yy.typ = xx.typ body.add newAsgnStmt(xx, yy) proc produceSym(g: ModuleGraph; c: PContext; typ: PType; kind: TTypeAttachedOp; @@ -1200,14 +1205,17 @@ proc produceSym(g: ModuleGraph; c: PContext; typ: PType; kind: TTypeAttachedOp; if kind == attachedSink and destructorOverridden(g, typ): ## compiler can use a combination of `=destroy` and memCopy for sink op - dest.flags.incl sfCursor + ensureMutable dest + dest.flagsImpl.incl sfCursor let op = getAttachedOp(g, typ, attachedDestructor) 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 + var skipped: PType = nil if g.config.selectedGC in {gcArc, gcOrc, gcHooks, gcAtomicArc}: - tk = skipTypes(typ, {tyOrdinal, tyRange, tyInferred, tyGenericInst, tyStatic, tyAlias, tySink}).kind + skipped = skipTypes(typ, {tyOrdinal, tyRange, tyInferred, tyGenericInst, tyStatic, tyAlias, tySink}) + tk = skipped.kind else: tk = tyNone # no special casing for strings and seqs case tk @@ -1217,18 +1225,20 @@ proc produceSym(g: ModuleGraph; c: PContext; typ: PType; kind: TTypeAttachedOp; fillStrOp(a, typ, result.ast[bodyPos], d, src) else: fillBody(a, typ, result.ast[bodyPos], d, src) - if tk == tyObject and a.kind in {attachedAsgn, attachedSink, attachedDeepCopy, attachedDup} and not isObjLackingTypeField(typ): + if tk == tyObject and a.kind in {attachedAsgn, attachedSink, attachedDeepCopy, attachedDup} and not isObjLackingTypeField(skipped): # 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 + ensureMutable result + incl result.flagsImpl, sfNeverRaises result.ast[pragmasPos] = newNodeI(nkPragma, info) result.ast[pragmasPos].add newTree(nkExprColonExpr, newIdentNode(g.cache.getIdent("raises"), info), newNodeI(nkBracket, info)) if kind == attachedDestructor: - incl result.options, optQuirky + ensureMutable result + incl result.optionsImpl, optQuirky completePartialOp(g, idgen.module, typ, kind, result) @@ -1253,7 +1263,9 @@ proc produceDestructorForDiscriminator*(g: ModuleGraph; typ: PType; field: PSym, result.ast[bodyPos].add v let placeHolder = newNodeIT(nkSym, info, getSysType(g, info, tyPointer)) fillBody(a, typ, result.ast[bodyPos], d, placeHolder) - if not a.canRaise: incl result.flags, sfNeverRaises + if not a.canRaise: + ensureMutable result + incl result.flagsImpl, sfNeverRaises template liftTypeBoundOps*(c: PContext; typ: PType; info: TLineInfo) = @@ -1297,11 +1309,13 @@ proc createTypeBoundOps(g: ModuleGraph; c: PContext; orig: PType; info: TLineInf ## to ensure we lift assignment, destructors and moves properly. ## The later 'injectdestructors' pass depends on it. if orig == nil or {tfCheckedForDestructor, tfHasMeta} * orig.flags != {}: return - incl orig.flags, tfCheckedForDestructor + # IC: review this solution again later + incl orig.flagsImpl, tfCheckedForDestructor # for user defined generic destructors: let origRoot = genericRoot(orig) if origRoot != nil: - incl origRoot.flags, tfGenericHasDestructor + # IC: review this solution again later + incl origRoot.flagsImpl, tfGenericHasDestructor let skipped = orig.skipTypes({tyGenericInst, tyAlias, tySink}) if isEmptyContainer(skipped) or skipped.kind == tyStatic: return @@ -1327,7 +1341,7 @@ proc createTypeBoundOps(g: ModuleGraph; c: PContext; orig: PType; info: TLineInf # bug #15122: We need to produce all prototypes before entering the # mind boggling recursion. Hacks like these imply we should rewrite # this module. - var generics: array[attachedWasMoved..attachedTrace, bool] = default(array[attachedWasMoved..attachedTrace, bool]) + var generics = default(array[attachedWasMoved..attachedTrace, bool]) for k in attachedWasMoved..lastAttached: generics[k] = getAttachedOp(g, canon, k) != nil if not generics[k]: @@ -1346,5 +1360,6 @@ proc createTypeBoundOps(g: ModuleGraph; c: PContext; orig: PType; info: TLineInf if not isTrivial(getAttachedOp(g, orig, attachedDestructor)): #or not isTrivial(orig.assignment) or # not isTrivial(orig.sink): - orig.flags.incl tfHasAsgn + # IC: review this solution again later + orig.flagsImpl.incl tfHasAsgn # ^ XXX Breaks IC! diff --git a/compiler/liftlocals.nim b/compiler/liftlocals.nim index 682d20c715..aaa0707e05 100644 --- a/compiler/liftlocals.nim +++ b/compiler/liftlocals.nim @@ -32,12 +32,12 @@ proc interestingVar(s: PSym): bool {.inline.} = proc lookupOrAdd(c: var Ctx; s: PSym; info: TLineInfo): PNode = let field = addUniqueField(c.objType, s, c.cache, c.idgen) var deref = newNodeI(nkHiddenDeref, info) - deref.typ() = c.objType + deref.typ = c.objType deref.add(newSymNode(c.partialParam, info)) result = newNodeI(nkDotExpr, info) result.add(deref) result.add(newSymNode(field)) - result.typ() = field.typ + result.typ = field.typ proc liftLocals(n: PNode; i: int; c: var Ctx) = let it = n[i] diff --git a/compiler/lineinfos.nim b/compiler/lineinfos.nim index 292a02e60e..397d407077 100644 --- a/compiler/lineinfos.nim +++ b/compiler/lineinfos.nim @@ -273,6 +273,10 @@ const errFloatToString* = "cannot convert '$1' to '$2'" type + FileInfoKind* = enum + fikSource, ## A real source file path + fikNifModule ## A NIF module suffix (not a real path) + TFileInfo* = object fullPath*: AbsoluteFile # This is a canonical full filesystem path projPath*: RelativeFile # This is relative to the project's root @@ -291,6 +295,7 @@ type # for 'nimsuggest' hash*: string # the checksum of the file dirty*: bool # for 'nimpretty' like tooling + kind*: FileInfoKind # distinguishes real files from NIF suffixes when defined(nimpretty): fullContent*: string FileIndex* = distinct int32 diff --git a/compiler/lookups.nim b/compiler/lookups.nim index acaad9d9b4..bbc5b4df40 100644 --- a/compiler/lookups.nim +++ b/compiler/lookups.nim @@ -311,7 +311,7 @@ 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) + incl(result.flagsImpl, 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) diff --git a/compiler/lowerings.nim b/compiler/lowerings.nim index a55d2776d8..72f2814459 100644 --- a/compiler/lowerings.nim +++ b/compiler/lowerings.nim @@ -82,7 +82,7 @@ proc lowerTupleUnpacking*(g: ModuleGraph; n: PNode; idgen: IdGenerator; owner: P var temp = newSym(skTemp, getIdent(g.cache, genPrefix), idgen, owner, value.info, g.config.options) temp.typ = skipTypes(value.typ, abstractInst) - incl(temp.flags, sfFromGeneric) + incl(temp.flagsImpl, sfFromGeneric) tempAsNode = newSymNode(temp) var v = newNodeI(nkVarSection, value.info) @@ -103,7 +103,7 @@ proc evalOnce*(g: ModuleGraph; value: PNode; idgen: IdGenerator; owner: PSym): P var temp = newSym(skTemp, getIdent(g.cache, genPrefix), idgen, owner, value.info, g.config.options) temp.typ = skipTypes(value.typ, abstractInst) - incl(temp.flags, sfFromGeneric) + incl(temp.flagsImpl, sfFromGeneric) var v = newNodeI(nkLetSection, value.info) let tempAsNode = newSymNode(temp) @@ -127,8 +127,8 @@ proc lowerSwap*(g: ModuleGraph; n: PNode; idgen: IdGenerator; owner: PSym): PNod # note: cannot use 'skTemp' here cause we really need the copy for the VM :-( var temp = newSym(skVar, getIdent(g.cache, genPrefix), idgen, owner, n.info, owner.options) temp.typ = n[1].typ - incl(temp.flags, sfFromGeneric) - incl(temp.flags, sfGenSym) + incl(temp.flagsImpl, sfFromGeneric) + incl(temp.flagsImpl, sfGenSym) var v = newNodeI(nkVarSection, n.info) let tempAsNode = newSymNode(temp) @@ -147,13 +147,13 @@ proc createObj*(g: ModuleGraph; idgen: IdGenerator; owner: PSym, info: TLineInfo result = newType(tyObject, idgen, owner) if final: rawAddSon(result, nil) - incl result.flags, tfFinal + incl result, tfFinal else: rawAddSon(result, getCompilerProc(g, "RootObj").typ) result.n = newNodeI(nkRecList, info) let s = newSym(skType, getIdent(g.cache, "Env_" & toFilename(g.config, info) & "_" & $owner.name.s), idgen, owner, info, owner.options) - incl s.flags, sfAnon + incl s.flagsImpl, sfAnon s.typ = result result.sym = s @@ -174,12 +174,12 @@ proc rawIndirectAccess*(a: PNode; field: PSym; info: TLineInfo): PNode = # returns a[].field as a node assert field.kind == skField var deref = newNodeI(nkHiddenDeref, info) - deref.typ() = a.typ.skipTypes(abstractInst)[0] + deref.typ = a.typ.skipTypes(abstractInst)[0] deref.add a result = newNodeI(nkDotExpr, info) result.add deref result.add newSymNode(field) - result.typ() = field.typ + result.typ = field.typ proc rawDirectAccess*(obj, field: PSym): PNode = # returns a.field as a node @@ -187,7 +187,7 @@ proc rawDirectAccess*(obj, field: PSym): PNode = result = newNodeI(nkDotExpr, field.info) result.add newSymNode(obj) result.add newSymNode(field) - result.typ() = field.typ + result.typ = field.typ proc lookupInRecord(n: PNode, id: ItemId): PSym = result = nil @@ -250,12 +250,12 @@ proc newDotExpr*(obj, b: PSym): PNode = assert field != nil, b.name.s result.add newSymNode(obj) result.add newSymNode(field) - result.typ() = field.typ + result.typ = field.typ 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).elementType + deref.typ = a.typ.skipTypes(abstractInst).elementType var t = deref.typ.skipTypes(abstractInst) var field: PSym while true: @@ -273,12 +273,12 @@ proc indirectAccess*(a: PNode, b: ItemId, info: TLineInfo): PNode = result = newNodeI(nkDotExpr, info) result.add deref result.add newSymNode(field) - result.typ() = field.typ + result.typ = field.typ 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).elementType + deref.typ = a.typ.skipTypes(abstractInst).elementType var t = deref.typ.skipTypes(abstractInst) var field: PSym let bb = getIdent(cache, b) @@ -297,7 +297,7 @@ proc indirectAccess*(a: PNode, b: string, info: TLineInfo; cache: IdentCache): P result = newNodeI(nkDotExpr, info) result.add deref result.add newSymNode(field) - result.typ() = field.typ + result.typ = field.typ proc getFieldFromObj*(t: PType; v: PSym): PSym = assert v.kind != skField @@ -320,7 +320,7 @@ proc indirectAccess*(a, b: PSym, info: TLineInfo): PNode = proc genAddrOf*(n: PNode; idgen: IdGenerator; typeKind = tyPtr): PNode = result = newNodeI(nkAddr, n.info, 1) result[0] = n - result.typ() = newType(typeKind, idgen, n.typ.owner) + result.typ = newType(typeKind, idgen, n.typ.owner) result.typ.rawAddSon(n.typ) proc genDeref*(n: PNode; k = nkHiddenDeref): PNode = @@ -344,18 +344,18 @@ proc callCodegenProc*(g: ModuleGraph; name: string; if optionalArgs != nil: for i in 1.. replay actions for NIF TPassContext* = object of RootObj # the pass's context idgen*: IdGenerator @@ -162,6 +170,9 @@ proc resetForBackend*(g: ModuleGraph) = g.enumToStringProcs.clear() g.dispatchers.setLen(0) g.methodsPerType.clear() + for a in mitems(g.loadedOps): + a.clear() + g.opsLog.setLen(0) const cb64 = [ @@ -357,13 +368,32 @@ proc getAttachedOp*(g: ModuleGraph; t: PType; op: TTypeAttachedOp): PSym = ## if no such operation exists. if g.attachedOps[op].contains(t.itemId): result = resolveAttachedOp(g, g.attachedOps[op][t.itemId]) + elif g.config.cmd in {cmdNifC, cmdM}: + # Fall back to key-based lookup for NIF-loaded hooks + let key = typeKey(t, g.config, loadTypeCallback, loadSymCallback) + result = g.loadedOps[op].getOrDefault(key) + #echo "fallback ", key, " ", op, " ", result else: result = nil proc setAttachedOp*(g: ModuleGraph; module: int; t: PType; op: TTypeAttachedOp; value: PSym) = ## we also need to record this to the packed module. + if not g.attachedOps[op].contains(t.itemId): + let key = typeKey(t, g.config, loadTypeCallback, loadSymCallback) + # Use key-based deduplication for opsLog because different type objects + # (e.g. canon vs orig) can have different itemIds but same structural key + if key notin g.loadedOps[op]: + # Hooks should be written to the module where the type is defined, + # not the module that triggered the registration + let ownerModule = if t.sym != nil: t.sym.itemId.module.int else: module + g.opsLog.add LogEntry(kind: HookEntry, op: op, module: ownerModule, key: key, sym: value) + g.loadedOps[op][key] = value g.attachedOps[op][t.itemId] = LazySym(sym: value) +proc setAttachedOp*(g: ModuleGraph; module: int; typeId: ItemId; op: TTypeAttachedOp; value: PSym) = + ## Overload that takes ItemId directly, useful for registering hooks from NIF index. + g.attachedOps[op][typeId] = LazySym(sym: value) + proc setAttachedOpPartial*(g: ModuleGraph; module: int; t: PType; op: TTypeAttachedOp; value: PSym) = ## we also need to record this to the packed module. g.attachedOps[op][t.itemId] = LazySym(sym: value) @@ -391,6 +421,10 @@ proc setMethodsPerType*(g: ModuleGraph; id: ItemId, methods: seq[LazySym]) = # TODO: add it for packed modules g.methodsPerType[id] = methods +proc addNifReplayAction*(g: ModuleGraph; module: int32; n: PNode) = + ## Stores a replay action for NIF-based incremental compilation. + g.nifReplayActions.mgetOrPut(module, @[]).add n + iterator getMethodsPerType*(g: ModuleGraph; t: PType): PSym = if g.methodsPerType.contains(t.itemId): for it in mitems g.methodsPerType[t.itemId]: @@ -402,6 +436,9 @@ proc getToStringProc*(g: ModuleGraph; t: PType): PSym = proc setToStringProc*(g: ModuleGraph; t: PType; value: PSym) = g.enumToStringProcs[t.itemId] = LazySym(sym: value) + let key = typeKey(t, g.config, loadTypeCallback, loadSymCallback) + let ownerModule = if t.sym != nil: t.sym.itemId.module.int else: value.itemId.module.int + g.opsLog.add LogEntry(kind: EnumToStrEntry, module: ownerModule, key: key, sym: value) iterator methodsForGeneric*(g: ModuleGraph; t: PType): (int, PSym) = if g.methodsPerGenericType.contains(t.itemId): @@ -410,6 +447,17 @@ iterator methodsForGeneric*(g: ModuleGraph; t: PType): (int, PSym) = proc addMethodToGeneric*(g: ModuleGraph; module: int; t: PType; col: int; m: PSym) = g.methodsPerGenericType.mgetOrPut(t.itemId, @[]).add (col, LazySym(sym: m)) + let key = typeKey(t, g.config, loadTypeCallback, loadSymCallback) + let ownerModule = if t.sym != nil: t.sym.itemId.module.int else: module + g.opsLog.add LogEntry(kind: MethodEntry, module: ownerModule, key: key, sym: m) + +proc logGenericInstance*(g: ModuleGraph; inst: PSym) = + ## Log a generic instance so it gets written to the NIF file. + ## This is needed when generic instances are created during compile-time + ## evaluation and may be referenced from other modules compiled in the same run. + if g.config.cmd in {cmdNifC, cmdM}: + let ownerModule = inst.itemId.module.int + g.opsLog.add LogEntry(kind: GenericInstEntry, module: ownerModule, sym: inst) proc hasDisabledAsgn*(g: ModuleGraph; t: PType): bool = let op = getAttachedOp(g, t, attachedAsgn) @@ -423,7 +471,30 @@ proc copyTypeProps*(g: ModuleGraph; module: int; dest, src: PType) = proc loadCompilerProc*(g: ModuleGraph; name: string): PSym = result = nil - if g.config.symbolFiles == disabledSf: return nil + if g.config.symbolFiles == disabledSf and optWithinConfigSystem notin g.config.globalOptions: + # For NIF-based compilation, search in loaded NIF modules + when not defined(nimKochBootstrap): + # Only try to resolve from NIF if we're actually using NIF files (cmdNifC) + if g.config.cmd == cmdNifC: + # First try system module (most compilerprocs are there) + let systemFileIdx = g.config.m.systemFileIdx + if systemFileIdx != InvalidFileIdx: + result = tryResolveCompilerProc(ast.program, name, systemFileIdx) + if result != nil: + strTableAdd(g.compilerprocs, result) + return result + + # Try threadpool module (some compilerprocs like FlowVar are there) + # Find threadpool module by searching loaded modules + for moduleIdx in 0..= g.packed.len: setLen(g.packed.pm, m.position + 1) - g.ifaces[m.position] = Iface(module: m, converters: @[], patterns: @[], - uniqueName: rope(uniqueModuleName(g.config, m))) - initStrTables(g, m) + if g.ifaces[m.position].module == nil: + g.ifaces[m.position] = Iface(module: m, converters: @[], patterns: @[], + uniqueName: rope(uniqueModuleName(g.config, m))) + initStrTables(g, m) proc registerModuleById*(g: ModuleGraph; m: FileIndex) = registerModule(g, g.packed[int m].module) @@ -586,6 +658,7 @@ proc newModuleGraph*(cache: IdentCache; config: ConfigRef): ModuleGraph = result.config = config result.cache = cache initModuleGraphFields(result) + ast.setupProgram(config, cache) proc resetAllModules*(g: ModuleGraph) = g.packageSyms = initStrTable() @@ -681,13 +754,13 @@ proc markDirty*(g: ModuleGraph; fileIdx: FileIndex) = if m != nil: g.suggestSymbols.del(fileIdx) g.suggestErrors.del(fileIdx) - incl m.flags, sfDirty + incl m.flagsImpl, sfDirty proc unmarkAllDirty*(g: ModuleGraph) = for i in 0i32..= 0 and fileIdx.int < conf.m.fileInfos.len: + result = conf.m.fileInfos[fileIdx.int].kind + else: + result = fikSource # Default to source for unknown indices + proc newLineInfo*(fileInfoIdx: FileIndex, line, col: int): TLineInfo = result = TLineInfo(fileIndex: fileInfoIdx) if line < int high(uint16): diff --git a/compiler/nifbackend.nim b/compiler/nifbackend.nim new file mode 100644 index 0000000000..fa293bbfe3 --- /dev/null +++ b/compiler/nifbackend.nim @@ -0,0 +1,154 @@ +# +# +# The Nim Compiler +# (c) Copyright 2025 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## NIF-based C/C++ code generator backend. +## +## This module implements C code generation from precompiled NIF files. +## It traverses the module dependency graph starting from the main module +## and generates C code for all reachable modules. +## +## Usage: +## 1. Compile modules to NIF: nim m mymodule.nim +## 2. Generate C from NIF: nim nifc myproject.nim + +import std/[intsets, tables, sets, os] + +when defined(nimPreviewSlimSystem): + import std/assertions + +import ast, options, lineinfos, modulegraphs, cgendata, cgen, + pathutils, extccomp, msgs, modulepaths, idents, types, ast2nif + +proc loadModuleDependencies(g: ModuleGraph; mainFileIdx: FileIndex): seq[PrecompiledModule] = + ## Traverse the module dependency graph using a stack. + ## Returns all modules that need code generation, in dependency order. + let mainModule = moduleFromNifFile(g, mainFileIdx, {LoadFullAst}) + + var stack: seq[ModuleSuffix] = @[] + result = @[] + + if mainModule.module != nil: + incl mainModule.module.flagsImpl, sfMainModule + for dep in mainModule.deps: + stack.add dep + + var visited = initHashSet[string]() + + while stack.len > 0: + let suffix = stack.pop() + + if not visited.containsOrIncl(suffix.string): + let nifFile = toGeneratedFile(g.config, AbsoluteFile(suffix.string), ".nif") + let fileIdx = msgs.fileInfoIdx(g.config, nifFile) + let precomp = moduleFromNifFile(g, fileIdx, {LoadFullAst}) + if precomp.module != nil: + result.add precomp + for dep in precomp.deps: + if not visited.contains(dep.string): + stack.add dep + + if mainModule.module != nil: + result.add mainModule + +proc setupNifBackendModule(g: ModuleGraph; module: PSym): BModule = + ## Set up a BModule for code generation from a NIF module. + if g.backend == nil: + g.backend = cgendata.newModuleList(g) + result = cgen.newModule(BModuleList(g.backend), module, g.config, idGeneratorFromModule(module)) + +proc finishModule(g: ModuleGraph; bmod: BModule) = + # Finalize the module (this adds it to modulesClosed) + # Create an empty stmt list as the init body - genInitCode in writeModule will set it up properly + let initStmt = newNode(nkStmtList) + finalCodegenActions(g, bmod, initStmt) + + # Generate dispatcher methods + for disp in getDispatchers(g): + genProcLvl3(bmod, disp) + +proc generateCodeForModule(g: ModuleGraph; precomp: PrecompiledModule) = + ## Generate C code for a single module. + let moduleId = precomp.module.position + var bmod = BModuleList(g.backend).mods[moduleId] + if bmod == nil: + bmod = setupNifBackendModule(g, precomp.module) + + # Generate code for the module's top-level statements + if precomp.topLevel != nil: + cgen.genTopLevelStmt(bmod, precomp.topLevel) + +proc generateCode*(g: ModuleGraph; mainFileIdx: FileIndex) = + ## Main entry point for NIF-based C code generation. + ## Traverses the module dependency graph and generates C code. + + # Reset backend state + resetForBackend(g) + + var isKnownFile = false + let systemFileIdx = registerNifSuffix(g.config, "sysma2dyk", isKnownFile) + g.config.m.systemFileIdx = systemFileIdx + #msgs.fileInfoIdx(g.config, + # g.config.libpath / RelativeFile"system.nim") + + # Load system module first - it's always needed and contains essential hooks + var precompSys = PrecompiledModule(module: nil) + precompSys = moduleFromNifFile(g, systemFileIdx, {LoadFullAst, AlwaysLoadInterface}) + g.systemModule = precompSys.module + + # Load all modules in dependency order using stack traversal + # This must happen BEFORE any code generation so that hooks are loaded into loadedOps + let modules = loadModuleDependencies(g, mainFileIdx) + if modules.len == 0: + rawMessage(g.config, errGenerated, + "Cannot load NIF file for main module: " & toFullPath(g.config, mainFileIdx)) + return + + # Set up backend modules for all modules that need code generation + for m in modules: + discard setupNifBackendModule(g, m.module) + + # Also ensure system module is set up and generated first if it exists + if precompSys.module != nil: + discard setupNifBackendModule(g, precompSys.module) + generateCodeForModule(g, precompSys) + + # Track which modules have been processed to avoid duplicates + var processed = initIntSet() + if precompSys.module != nil: + processed.incl precompSys.module.position + + # Generate code for all modules (skip system since it's already processed) + for m in modules: + if not processed.containsOrIncl(m.module.position): + generateCodeForModule(g, m) + + # during code generation of `main.nim` we can trigger the code generation + # of symbols in different modules so we need to finish these modules + # here later, after the above loop! + # Important: The main module must be finished LAST so that all other modules + # have registered their init procs before genMainProc uses them. + var mainModule: BModule = nil + for m in BModuleList(g.backend).mods: + if m != nil: + assert m.module != nil + if sfMainModule in m.module.flags: + mainModule = m + else: + finishModule g, m + if mainModule != nil: + finishModule g, mainModule + + # Write C files + cgenWriteModules(g.backend, g.config) + + # Run C compiler + if g.config.cmd != cmdTcc: + extccomp.callCCompiler(g.config) + if not g.config.hcrOn: + extccomp.writeJsonBuildInstructions(g.config, g.cachedFiles) diff --git a/compiler/nilcheck.nim b/compiler/nilcheck.nim index 1fa0e7897c..7e0efc34bb 100644 --- a/compiler/nilcheck.nim +++ b/compiler/nilcheck.nim @@ -919,7 +919,7 @@ proc infix(ctx: NilCheckerContext, l: PNode, r: PNode, magic: TMagic): PNode = newSymNode(op, r.info), l, r) - result.typ() = newType(tyBool, ctx.idgen, nil) + result.typ = newType(tyBool, ctx.idgen, nil) proc prefixNot(ctx: NilCheckerContext, node: PNode): PNode = var cache = newIdentCache() @@ -929,7 +929,7 @@ proc prefixNot(ctx: NilCheckerContext, node: PNode): PNode = result = nkPrefix.newTree( newSymNode(op, node.info), node) - result.typ() = newType(tyBool, ctx.idgen, nil) + result.typ = newType(tyBool, ctx.idgen, nil) proc infixEq(ctx: NilCheckerContext, l: PNode, r: PNode): PNode = infix(ctx, l, r, mEqRef) diff --git a/compiler/nim.nim b/compiler/nim.nim index 005f11a580..ed6774983c 100644 --- a/compiler/nim.nim +++ b/compiler/nim.nim @@ -118,7 +118,7 @@ proc handleCmdLine(cache: IdentCache; conf: ConfigRef) = if conf.selectedGC == gcUnselected: if conf.backend in {backendC, backendCpp, backendObjc} or (conf.cmd in cmdDocLike and conf.backend != backendJs) or - conf.cmd == cmdGendepend: + conf.cmd in {cmdGendepend, cmdNifC, cmdIc, cmdM}: initOrcDefines(conf) mainCommand(graph) diff --git a/compiler/nimeval.nim b/compiler/nimeval.nim index 0833cfeb32..5331b3ee07 100644 --- a/compiler/nimeval.nim +++ b/compiler/nimeval.nim @@ -128,7 +128,7 @@ proc createInterpreter*(scriptName: string; if conf.libpath.isEmpty: conf.libpath = AbsoluteDir p var m = graph.makeModule(scriptName) - incl(m.flags, sfMainModule) + incl(m, sfMainModule) var idgen = idGeneratorFromModule(m) var vm = newCtx(m, cache, graph, idgen) vm.mode = emRepl @@ -168,7 +168,7 @@ proc runRepl*(r: TLLRepl; if supportNimscript: defineSymbol(conf.symbols, "nimconfig") when hasFFI: defineSymbol(graph.config.symbols, "nimffi") var m = graph.makeStdinModule() - incl(m.flags, sfMainModule) + incl(m, sfMainModule) var idgen = idGeneratorFromModule(m) if supportNimscript: graph.vm = setupVM(m, cache, "stdin", graph, idgen) diff --git a/compiler/nimsets.nim b/compiler/nimsets.nim index c864d63be1..7edf55278c 100644 --- a/compiler/nimsets.nim +++ b/compiler/nimsets.nim @@ -84,7 +84,7 @@ proc toTreeSet*(conf: ConfigRef; s: TBitSet, settype: PType, info: TLineInfo): P elemType = settype[0] first = firstOrd(conf, elemType).toInt64 result = newNodeI(nkCurly, info) - result.typ() = settype + result.typ = settype result.info = info e = 0 while e < s.len * ElemSize: @@ -101,7 +101,7 @@ proc toTreeSet*(conf: ConfigRef; s: TBitSet, settype: PType, info: TLineInfo): P result.add aa else: n = newNodeI(nkRange, info) - n.typ() = elemType + n.typ = elemType n.add aa let bb = newIntTypeNode(b + first, elemType) bb.info = info diff --git a/compiler/options.nim b/compiler/options.nim index fa2c2069b3..086954563d 100644 --- a/compiler/options.nim +++ b/compiler/options.nim @@ -25,7 +25,7 @@ const useEffectSystem* = true useWriteTracking* = false hasFFI* = defined(nimHasLibFFI) - copyrightYear* = "2025" + copyrightYear* = "2026" nimEnableCovariance* = defined(nimEnableCovariance) @@ -110,6 +110,9 @@ type # please make sure we have under 32 options optEnableDeepCopy # ORC specific: enable 'deepcopy' for all types. optShowNonExportedFields # for documentation: show fields that are not exported optJsBigInt64 # use bigints for 64-bit integers in JS + optItaniumMangle # mangling follows the Itanium spec + optCompress # turn on AST compression by converting it to NIF + optWithinConfigSystem # we still compile within the configuration system TGlobalOptions* = set[TGlobalOption] @@ -173,6 +176,8 @@ type cmdJsonscript # compile a .json build file # old unused: cmdInterpret, cmdDef: def feature (find definition for IDEs) cmdCompileToNif + cmdNifC # generate C code from NIF files + cmdIc # generate .build.nif for nifmake const cmdBackends* = {cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, @@ -364,6 +369,7 @@ type numberOfProcessors*: int # number of processors lastCmdTime*: float # when caas is enabled, we measure each command symbolFiles*: SymbolFilesOption + ic*: bool # whether ic is enabled spellSuggestMax*: int # max number of spelling suggestions for typos cppDefines*: HashSet[string] # (*) @@ -508,7 +514,7 @@ const optHints, optStackTrace, optLineTrace, # consider adding `optStackTraceMsgs` optTrMacros, optStyleCheck, optCursorInference} DefaultGlobalOptions* = {optThreadAnalysis, optExcessiveStackTrace, - optJsBigInt64} + optJsBigInt64, optItaniumMangle} proc getSrcTimestamp(): DateTime = try: diff --git a/compiler/packages.nim b/compiler/packages.nim index 63879acd26..95c42151b0 100644 --- a/compiler/packages.nim +++ b/compiler/packages.nim @@ -33,7 +33,7 @@ proc getPackage*(conf: ConfigRef; cache: IdentCache; fileIdx: FileIndex): PSym = pkgIdent = getIdent(cache, pkgName) newSym(skPackage, pkgIdent, idGeneratorForPackage(int32(fileIdx)), nil, info) -func getPackageSymbol*(sym: PSym): PSym = +proc getPackageSymbol*(sym: PSym): PSym = ## Return the owning package symbol. assert sym != nil result = sym @@ -41,18 +41,18 @@ func getPackageSymbol*(sym: PSym): PSym = result = result.owner assert result != nil, repr(sym.info) -func getPackageId*(sym: PSym): int = +proc getPackageId*(sym: PSym): int = ## Return the owning package ID. sym.getPackageSymbol.id -func belongsToProjectPackage*(conf: ConfigRef, sym: PSym): bool = +proc belongsToProjectPackage*(conf: ConfigRef, sym: PSym): bool = ## Return whether the symbol belongs to the project's package. ## ## See Also: ## * `modulegraphs.belongsToStdlib` conf.mainPackageId == sym.getPackageId -func belongsToProjectPackageMaybeNil*(conf: ConfigRef, sym: PSym): bool = +proc belongsToProjectPackageMaybeNil*(conf: ConfigRef, sym: PSym): bool = ## Return whether the symbol belongs to the project's package. ## Returns `false` if `sym` is nil. ## diff --git a/compiler/passes.nim b/compiler/passes.nim index c7c7fc5e3e..5047ed1085 100644 --- a/compiler/passes.nim +++ b/compiler/passes.nim @@ -173,7 +173,7 @@ proc compileModule*(graph: ModuleGraph; fileIdx: FileIndex; flags: TSymFlags, fr let filename = AbsoluteFile toFullPath(graph.config, fileIdx) if result == nil: result = newModule(graph, fileIdx) - result.flags.incl flags + result.incl flags registerModule(graph, result) processModuleAux("import") else: @@ -185,7 +185,7 @@ proc compileModule*(graph: ModuleGraph; fileIdx: FileIndex; flags: TSymFlags, fr replayStateChanges(graph.packed.pm[m.int].module, graph) replayGenericCacheInformation(graph, m.int) elif graph.isDirty(result): - result.flags.excl sfDirty + result.excl sfDirty # reset module fields: initStrTables(graph, result) result.ast = nil diff --git a/compiler/pipelines.nim b/compiler/pipelines.nim index e617ae8b90..fd1193bd3b 100644 --- a/compiler/pipelines.nim +++ b/compiler/pipelines.nim @@ -3,6 +3,11 @@ import sem, cgen, modulegraphs, ast, llstream, parser, msgs, packages, syntaxes, depends, vm, pragmas, idents, lookups, wordrecg, liftdestructors, nifgen +when not defined(nimKochBootstrap): + import vmdef + import ast2nif + import "../dist/nimony/src/lib" / [nifstreams, bitabs] + import pipelineutils import ../dist/checksums/src/checksums/sha1 @@ -35,7 +40,12 @@ proc processPipeline(graph: ModuleGraph; semNode: PNode; bModule: PPassContext): of GenDependPass: result = addDotDependency(bModule, semNode) of SemPass: - result = graph.emptyNode + # Return the semantic node for cmdM (NIF generation needs it) + # For regular check, we don't need the result + if graph.config.cmd == cmdM: + result = semNode + else: + result = graph.emptyNode of Docgen2Pass, Docgen2TexPass: when not defined(leanCompiler): result = processNode(bModule, semNode) @@ -52,7 +62,8 @@ proc processPipeline(graph: ModuleGraph; semNode: PNode; bModule: PPassContext): raiseAssert "use setPipeLinePass to set a proper PipelinePass" proc processImplicitImports*(graph: ModuleGraph; implicits: seq[string], nodeKind: TNodeKind, - m: PSym, ctx: PContext, bModule: PPassContext, idgen: IdGenerator) = + m: PSym, ctx: PContext, bModule: PPassContext, idgen: IdGenerator; + topLevelStmts: PNode) = # XXX fixme this should actually be relative to the config file! let relativeTo = toFullPath(graph.config, m.info) for module in items(implicits): @@ -64,8 +75,13 @@ proc processImplicitImports*(graph: ModuleGraph; implicits: seq[string], nodeKin importStmt.add str message(graph.config, importStmt.info, hintProcessingStmt, $idgen[]) let semNode = semWithPContext(ctx, importStmt) - if semNode == nil or processPipeline(graph, semNode, bModule) == nil: + if semNode == nil: break + let top = processPipeline(graph, semNode, bModule) + if top == nil: + break + if topLevelStmts != nil: + topLevelStmts.add top proc prePass*(c: PContext; n: PNode) = for son in n: @@ -87,7 +103,7 @@ proc prePass*(c: PContext; n: PNode) = let feature = parseEnum[Feature](name.strVal) if feature == codeReordering: c.features.incl feature - c.module.flags.incl sfReorder + c.module.incl sfReorder except ValueError: discard else: @@ -150,6 +166,11 @@ proc processPipelineModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator else: s = stream graph.interactive = stream.kind == llsStdIn + var topLevelStmts = + if optCompress in graph.config.globalOptions or graph.config.cmd == cmdM: + newNodeI(nkStmtList, module.info) + else: + nil while true: syntaxes.openParser(p, fileIdx, s, graph.cache, graph.config) @@ -159,8 +180,8 @@ proc processPipelineModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator # in ROD files. I think we should enable this feature only # for the interactive mode. if module.name.s != "nimscriptapi": - processImplicitImports graph, graph.config.implicitImports, nkImportStmt, module, ctx, bModule, idgen - processImplicitImports graph, graph.config.implicitIncludes, nkIncludeStmt, module, ctx, bModule, idgen + processImplicitImports graph, graph.config.implicitImports, nkImportStmt, module, ctx, bModule, idgen, topLevelStmts + processImplicitImports graph, graph.config.implicitIncludes, nkIncludeStmt, module, ctx, bModule, idgen, topLevelStmts checkFirstLineIndentation(p) block processCode: @@ -181,7 +202,9 @@ proc processPipelineModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator if graph.pipelinePass != EvalPass: message(graph.config, sl.info, hintProcessingStmt, $idgen[]) var semNode = semWithPContext(ctx, sl) - discard processPipeline(graph, semNode, bModule) + let top = processPipeline(graph, semNode, bModule) + if top != nil and topLevelStmts != nil: + topLevelStmts.add top closeParser(p) if s.kind != llsStdIn: break @@ -198,7 +221,7 @@ proc processPipelineModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator if retTyp != nil: # TODO: properly semcheck the code of dispatcher? createTypeBoundOps(graph, ctx, retTyp, disp.ast.info, idgen) - genProcAux(m, disp) + genProcLvl3(m, disp) discard closePContext(graph, ctx, nil) of JSgenPass: when not defined(leanCompiler): @@ -218,10 +241,28 @@ proc processPipelineModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator of NonePass: raiseAssert "use setPipeLinePass to set a proper PipelinePass" - if graph.config.backend notin {backendC, backendCpp, backendObjc}: + when not defined(nimKochBootstrap): + if (optCompress in graph.config.globalOptions or graph.config.cmd == cmdM) and + not graph.config.isDefined("nimscript"): + topLevelStmts.add finalNode + # Collect replay actions from both pragma computations and VM state diff + var replayActions: seq[PNode] = @[] + # Get pragma-recorded replay actions (compile, link, passC, passL, etc.) + if graph.nifReplayActions.hasKey(module.position.int32): + replayActions.add graph.nifReplayActions[module.position.int32] + # Also get VM state diff (macro cache operations) + if graph.vm != nil: + for (m, n) in PCtx(graph.vm).vmstateDiff: + if m == module: + replayActions.add n + + writeNifModule(graph.config, module.position.int32, topLevelStmts, graph.opsLog, replayActions) + + if graph.config.backend notin {backendC, backendCpp, backendObjc} and graph.config.cmd != cmdM: # We only write rod files here if no C-like backend is active. # The C-like backends have been patched to support the IC mechanism. # They are responsible for closing the rod files. See `cbackend.nim`. + # cmdM uses NIF files only, not ROD files. closeRodFile(graph, module) result = true @@ -239,7 +280,23 @@ proc compilePipelineModule*(graph: ModuleGraph; fileIdx: FileIndex; flags: TSymF discard processPipelineModule(graph, result, idGeneratorFromModule(result), s) if result == nil: var cachedModules: seq[FileIndex] = @[] - result = moduleFromRodFile(graph, fileIdx, cachedModules) + when not defined(nimKochBootstrap): + # For cmdM: load imports from NIF files (but compile the main module from source) + # Skip when withinSystem is true (compiling system.nim itself) + if graph.config.cmd == cmdM and + sfMainModule notin flags and + not graph.withinSystem and + not graph.config.isDefined("nimscript"): + let precomp = moduleFromNifFile(graph, fileIdx) + if precomp.module == nil: + let nifPath = toNifFilename(graph.config, fileIdx) + localError(graph.config, unknownLineInfo, + "nim m requires precompiled NIF for import: " & toFullPath(graph.config, fileIdx) & + " (expected: " & nifPath & ")") + return nil # Don't fall through to compile from source + if result == nil and graph.config.cmd != cmdM: + # Fall back to ROD file loading (not used for cmdM which uses NIF only) + result = moduleFromRodFile(graph, fileIdx, cachedModules) let path = toFullPath(graph.config, fileIdx) let filename = AbsoluteFile path # it could be a stdinfile/cmdfile @@ -247,26 +304,29 @@ proc compilePipelineModule*(graph: ModuleGraph; fileIdx: FileIndex; flags: TSymF graph.cachedFiles[path] = $secureHashFile(path) if result == nil: result = newModule(graph, fileIdx) - result.flags.incl flags + result.incl flags registerModule(graph, result) processModuleAux("import") else: if sfSystemModule in flags: graph.systemModule = result if sfMainModule in flags and graph.config.cmd == cmdM: - result.flags.incl flags + result.incl flags registerModule(graph, result) processModuleAux("import") partialInitModule(result, graph, fileIdx, filename) for m in cachedModules: registerModuleById(graph, m) - if sfMainModule in flags and graph.config.cmd == cmdM: - discard + if graph.config.cmd == cmdM: + # cmdM uses NIF files - replay from module AST loaded by loadNifModule + let module = graph.getModule(m) + if module != nil and module.ast != nil: + replayStateChanges(module, graph) else: replayStateChanges(graph.packed.pm[m.int].module, graph) replayGenericCacheInformation(graph, m.int) elif graph.isDirty(result): - result.flags.excl sfDirty + result.excl sfDirty # reset module fields: initStrTables(graph, result) result.ast = nil @@ -294,10 +354,12 @@ proc connectPipelineCallbacks*(graph: ModuleGraph) = proc compilePipelineSystemModule*(graph: ModuleGraph) = if graph.systemModule == nil: + graph.withinSystem = true connectPipelineCallbacks(graph) graph.config.m.systemFileIdx = fileInfoIdx(graph.config, graph.config.libpath / RelativeFile"system.nim") discard graph.compilePipelineModule(graph.config.m.systemFileIdx, {sfSystemModule}) + graph.withinSystem = false proc compilePipelineProject*(graph: ModuleGraph; projectFileIdx = InvalidFileIdx) = connectPipelineCallbacks(graph) @@ -314,7 +376,24 @@ proc compilePipelineProject*(graph: ModuleGraph; projectFileIdx = InvalidFileIdx graph.importStack.add projectFile if projectFile == systemFileIdx: + graph.withinSystem = true discard graph.compilePipelineModule(projectFile, {sfMainModule, sfSystemModule}) + graph.withinSystem = false + elif graph.config.cmd == cmdM: + # For cmdM: load system.nim from NIF first, then compile the main module + connectPipelineCallbacks(graph) + graph.config.m.systemFileIdx = fileInfoIdx(graph.config, + graph.config.libpath / RelativeFile"system.nim") + var cachedModules: seq[FileIndex] = @[] + when not defined(nimKochBootstrap): + let precomp = moduleFromNifFile(graph, graph.config.m.systemFileIdx) + graph.systemModule = precomp.module + if graph.systemModule == nil: + let nifPath = toNifFilename(graph.config, graph.config.m.systemFileIdx) + localError(graph.config, unknownLineInfo, + "nim m requires precompiled NIF for system module (expected: " & nifPath & ")") + return + discard graph.compilePipelineModule(projectFile, {sfMainModule}) else: graph.compilePipelineSystemModule() discard graph.compilePipelineModule(projectFile, {sfMainModule}) diff --git a/compiler/plugins/itersgen.nim b/compiler/plugins/itersgen.nim index e2c97bdc57..6c0bfd8f30 100644 --- a/compiler/plugins/itersgen.nim +++ b/compiler/plugins/itersgen.nim @@ -33,7 +33,7 @@ proc iterToProcImpl*(c: PContext, n: PNode): PNode = let prc = newSym(skProc, n[3].ident, c.idgen, iter.sym.owner, iter.sym.info) prc.typ = copyType(iter.sym.typ, c.idgen, prc) - excl prc.typ.flags, tfCapturesEnv + excl prc.typ, tfCapturesEnv prc.typ.n.add newSymNode(getEnvParam(iter.sym)) prc.typ.rawAddSon t let orig = iter.sym.ast diff --git a/compiler/pragmas.nim b/compiler/pragmas.nim index 8cf547c9be..5f99cae7f8 100644 --- a/compiler/pragmas.nim +++ b/compiler/pragmas.nim @@ -148,7 +148,7 @@ proc pragmaEnsures(c: PContext, n: PNode) = 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.returnType - incl(s.flags, sfUsed) + incl(s.flagsImpl, sfUsed) addDecl(c, s) n[1] = c.semExpr(c, n[1]) closeScope(c) @@ -156,12 +156,12 @@ proc pragmaEnsures(c: PContext, n: PNode) = proc setExternName(c: PContext; s: PSym, extname: string, info: TLineInfo) = # special cases to improve performance: if extname == "$1": - s.loc.snippet = rope(s.name.s) + s.setSnippet(rope(s.name.s)) elif '$' notin extname: - s.loc.snippet = rope(extname) + s.setSnippet(rope(extname)) else: try: - s.loc.snippet = rope(extname % s.name.s) + s.setSnippet(rope(extname % s.name.s)) except ValueError: localError(c.config, info, "invalid extern name: '" & extname & "'. (Forgot to escape '$'?)") when hasFFI: @@ -170,36 +170,36 @@ proc setExternName(c: PContext; s: PSym, extname: string, info: TLineInfo) = proc makeExternImport(c: PContext; s: PSym, extname: string, info: TLineInfo) = setExternName(c, s, extname, info) - incl(s.flags, sfImportc) - excl(s.flags, sfForward) + s.incl(sfImportc) + s.excl(sfForward) proc makeExternExport(c: PContext; s: PSym, extname: string, info: TLineInfo) = setExternName(c, s, extname, info) - incl(s.flags, sfExportc) + s.incl(sfExportc) proc processImportCompilerProc(c: PContext; s: PSym, extname: string, info: TLineInfo) = setExternName(c, s, extname, info) - incl(s.flags, sfImportc) - excl(s.flags, sfForward) - incl(s.loc.flags, lfImportCompilerProc) + s.incl(sfImportc) + s.excl(sfForward) + incl(s.locImpl.flags, lfImportCompilerProc) proc processImportCpp(c: PContext; s: PSym, extname: string, info: TLineInfo) = setExternName(c, s, extname, info) - incl(s.flags, sfImportc) - incl(s.flags, sfInfixCall) - excl(s.flags, sfForward) + s.incl(sfImportc) + incl(s.flagsImpl, sfInfixCall) + excl(s.flagsImpl, sfForward) if c.config.backend == backendC: let m = s.getModule() - incl(m.flags, sfCompileToCpp) + incl(m.flagsImpl, sfCompileToCpp) incl c.config.globalOptions, optMixedMode proc processImportObjC(c: PContext; s: PSym, extname: string, info: TLineInfo) = setExternName(c, s, extname, info) - incl(s.flags, sfImportc) - incl(s.flags, sfNamedParamCall) - excl(s.flags, sfForward) + s.incl(sfImportc) + incl(s.flagsImpl, sfNamedParamCall) + excl(s.flagsImpl, sfForward) let m = s.getModule() - incl(m.flags, sfCompileToObjc) + m.incl(sfCompileToObjc) proc newEmptyStrNode(c: PContext; n: PNode, strVal: string = ""): PNode {.noinline.} = result = newNodeIT(nkStrLit, n.info, getSysType(c.graph, n.info, tyString)) @@ -239,14 +239,14 @@ proc getOptionalStr(c: PContext, n: PNode, defaultStr: string): string = proc processVirtual(c: PContext, n: PNode, s: PSym, flag: TSymFlag) = s.constraint = newEmptyStrNode(c, n, getOptionalStr(c, n, "$1")) s.constraint.strVal = s.constraint.strVal % s.name.s - s.flags.incl {flag, sfInfixCall, sfExportc, sfMangleCpp} + s.flagsImpl.incl {flag, sfInfixCall, sfExportc, sfMangleCpp} s.typ.callConv = ccMember incl c.config.globalOptions, optMixedMode proc processCodegenDecl(c: PContext, n: PNode, sym: PSym) = sym.constraint = getStrLitNode(c, n) - sym.flags.incl sfCodegenDecl + sym.flagsImpl.incl sfCodegenDecl proc processMagic(c: PContext, n: PNode, s: PSym) = #if sfSystemModule notin c.module.flags: @@ -282,10 +282,10 @@ proc onOff(c: PContext, n: PNode, op: TOptions, resOptions: var TOptions) = proc pragmaNoForward*(c: PContext, n: PNode; flag=sfNoForward) = if isTurnedOn(c, n): - incl(c.module.flags, flag) + incl(c.module.flagsImpl, flag) c.features.incl codeReordering else: - excl(c.module.flags, flag) + excl(c.module.flagsImpl, flag) # c.features.excl codeReordering # deprecated as of 0.18.1 @@ -357,9 +357,9 @@ proc processDynLib(c: PContext, n: PNode, sym: PSym) = var lib = getLib(c, libDynamic, expectDynlibNode(c, n)) if not lib.isOverridden: addToLib(lib, sym) - incl(sym.loc.flags, lfDynamicLib) + sym.incl(lfDynamicLib) else: - incl(sym.loc.flags, lfExportLib) + sym.incl(lfExportLib) # since we'll be loading the dynlib symbols dynamically, we must use # a calling convention that doesn't introduce custom name mangling # cdecl is the default - the user can override this explicitly @@ -435,7 +435,7 @@ proc processExperimental(c: PContext; n: PNode) = if not isTopLevel(c): localError(c.config, n.info, "Code reordering experimental pragma only valid at toplevel") - c.module.flags.incl sfReorder + c.module.flagsImpl.incl sfReorder except ValueError: localError(c.config, n[1].info, "unknown experimental feature") else: @@ -636,7 +636,7 @@ proc semAsmOrEmit*(con: PContext, n: PNode, marker: char): PNode = var e = searchInScopes(con, getIdent(con.cache, sub), amb) # XXX what to do here if 'amb' is true? if e != nil: - incl(e.flags, sfUsed) + incl(e.flagsImpl, sfUsed) if isDefined(con.config, "nimPreviewAsmSemSymbol"): result.add con.semExprWithType(con, newSymNode(e), {efTypeAllowed}) else: @@ -725,12 +725,12 @@ proc processPragma(c: PContext, n: PNode, i: int) = proc pragmaRaisesOrTags(c: PContext, n: PNode) = proc processExc(c: PContext, x: PNode) = if c.hasUnresolvedArgs(c, x): - x.typ() = makeTypeFromExpr(c, x) + x.typ = makeTypeFromExpr(c, x) else: var t = skipTypes(c.semTypeNode(c, x, nil), skipPtrs) if t.kind notin {tyObject, tyOr}: localError(c.config, x.info, errGenerated, "invalid type for raises/tags list") - x.typ() = t + x.typ = t if n.kind in nkPragmaCallKinds and n.len == 2: let it = n[1] @@ -757,15 +757,15 @@ proc typeBorrow(c: PContext; sym: PSym, n: PNode) = let it = n[1] if it.kind != nkAccQuoted: localError(c.config, n.info, "a type can only borrow `.` for now") - incl(sym.typ.flags, tfBorrowDot) + incl(sym.typ, tfBorrowDot) proc markCompilerProc(c: PContext; s: PSym) = # minor hack ahead: FlowVar is the only generic .compilerproc type which # should not have an external name set: if s.kind != skType or s.name.s != "FlowVar": makeExternExport(c, s, "$1", s.info) - incl(s.flags, sfCompilerProc) - incl(s.flags, sfUsed) + incl(s, sfCompilerProc) + incl(s.flagsImpl, sfUsed) registerCompilerProc(c.graph, s) if c.config.symbolFiles != disabledSf: addCompilerProc(c.encoder, c.packedRepr, s) @@ -773,7 +773,7 @@ proc markCompilerProc(c: PContext; s: PSym) = proc deprecatedStmt(c: PContext; outerPragma: PNode) = let pragma = outerPragma[1] if pragma.kind in {nkStrLit..nkTripleStrLit}: - incl(c.module.flags, sfDeprecated) + incl(c.module, sfDeprecated) c.module.constraint = getStrLitNode(c, outerPragma) return if pragma.kind != nkBracket: @@ -842,7 +842,7 @@ proc processEffectsOf(c: PContext, n: PNode; owner: PSym) = let r = c.semExpr(c, n) if r.kind == nkSym and r.sym.kind == skParam: if r.sym.owner == owner: - incl r.sym.flags, sfEffectsDelayed + incl r.sym, sfEffectsDelayed else: localError(c.config, n.info, errGenerated, "parameter cannot be declared as .effectsOf") else: @@ -907,8 +907,8 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, if c.config.backend != backendCpp: localError(c.config, it.info, "exportcpp requires `cpp` backend, got: " & $c.config.backend) else: - incl(sym.flags, sfMangleCpp) - incl(sym.flags, sfUsed) # avoid wrong hints + incl(sym, sfMangleCpp) + incl(sym.flagsImpl, sfUsed) # avoid wrong hints of wImportc: let name = getOptionalStr(c, it, "$1") cppDefine(c.config, name) @@ -921,24 +921,24 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, processImportCompilerProc(c, sym, name, it.info) of wExtern: setExternName(c, sym, expectStrLit(c, it), it.info) of wDirty: - if sym.kind == skTemplate: incl(sym.flags, sfDirty) + if sym.kind == skTemplate: incl(sym, sfDirty) else: invalidPragma(c, it) of wRedefine: - if sym.kind == skTemplate: incl(sym.flags, sfTemplateRedefinition) + if sym.kind == skTemplate: incl(sym, sfTemplateRedefinition) else: invalidPragma(c, it) of wCallsite: - if sym.kind == skTemplate: incl(sym.flags, sfCallsite) + if sym.kind == skTemplate: incl(sym, sfCallsite) else: invalidPragma(c, it) of wImportCpp: processImportCpp(c, sym, getOptionalStr(c, it, "$1"), it.info) of wCppNonPod: - incl(sym.flags, sfCppNonPod) + incl(sym, sfCppNonPod) of wImportJs: if c.config.backend != backendJs: localError(c.config, it.info, "`importjs` pragma requires the JavaScript target") let name = getOptionalStr(c, it, "$1") - incl(sym.flags, sfImportc) - incl(sym.flags, sfInfixCall) + incl(sym, sfImportc) + incl(sym.flagsImpl, sfInfixCall) if sym.kind in skProcKinds and {'(', '#', '@'} notin name: localError(c.config, n.info, "`importjs` for routines requires a pattern") setExternName(c, sym, name, it.info) @@ -968,29 +968,29 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, localError(c.config, it.info, "power of two expected") of wNodecl: noVal(c, it) - incl(sym.loc.flags, lfNoDecl) + sym.incl(lfNoDecl) of wPure, wAsmNoStackFrame: noVal(c, it) if sym != nil: if k == wPure and sym.kind in routineKinds: invalidPragma(c, it) - else: incl(sym.flags, sfPure) + else: incl(sym, sfPure) of wVolatile: noVal(c, it) - incl(sym.flags, sfVolatile) + incl(sym, sfVolatile) of wCursor: noVal(c, it) - incl(sym.flags, sfCursor) + incl(sym, sfCursor) of wRegister: noVal(c, it) - incl(sym.flags, sfRegister) + incl(sym, sfRegister) of wNoalias: noVal(c, it) - incl(sym.flags, sfNoalias) + incl(sym, sfNoalias) of wEffectsOf: processEffectsOf(c, it, sym) of wThreadVar: noVal(c, it) - incl(sym.flags, {sfThread, sfGlobal}) + incl(sym, {sfThread, sfGlobal}) of wDeadCodeElimUnused: warningDeprecated(c.config, n.info, "'{.deadcodeelim: on.}' is deprecated, now a noop") # deprecated, dead code elim always on of wNoForward: pragmaNoForward(c, it) @@ -1000,51 +1000,50 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, noVal(c, it) if comesFromPush: if sym.kind in {skProc, skFunc}: - incl(sym.flags, sfCompileTime) + incl(sym, sfCompileTime) else: - incl(sym.flags, sfCompileTime) + incl(sym, sfCompileTime) #incl(sym.loc.flags, lfNoDecl) of wGlobal: noVal(c, it) - incl(sym.flags, sfGlobal) - incl(sym.flags, sfPure) + incl(sym, {sfGlobal, sfPure}) of wConstructor: - incl(sym.flags, sfConstructor) + incl(sym, sfConstructor) if sfImportc notin sym.flags: sym.constraint = newEmptyStrNode(c, it, getOptionalStr(c, it, "")) sym.constraint.strVal = sym.constraint.strVal - sym.flags.incl {sfExportc, sfMangleCpp} + sym.flagsImpl.incl {sfExportc, sfMangleCpp} sym.typ.callConv = ccNoConvention of wHeader: var lib = getLib(c, libHeader, getStrLitNode(c, it)) addToLib(lib, sym) - incl(sym.flags, sfImportc) - incl(sym.loc.flags, lfHeader) - incl(sym.loc.flags, lfNoDecl) + incl(sym, sfImportc) + incl(sym.locImpl.flags, lfHeader) + incl(sym.locImpl.flags, lfNoDecl) # implies nodecl, because otherwise header would not make sense - if sym.loc.snippet == "": sym.loc.snippet = rope(sym.name.s) + if sym.locImpl.snippet == "": sym.locImpl.snippet = rope(sym.name.s) of wNoSideEffect: noVal(c, it) if sym != nil: - incl(sym.flags, sfNoSideEffect) - if sym.typ != nil: incl(sym.typ.flags, tfNoSideEffect) + incl(sym, sfNoSideEffect) + if sym.typ != nil: incl(sym.typ, tfNoSideEffect) of wSideEffect: noVal(c, it) - incl(sym.flags, sfSideEffect) + incl(sym, sfSideEffect) of wNoreturn: noVal(c, it) # Disable the 'noreturn' annotation when in the "Quirky Exceptions" mode! if c.config.exc != excQuirky: - incl(sym.flags, sfNoReturn) + incl(sym, sfNoReturn) if sym.typ.returnType != nil: localError(c.config, sym.ast[paramsPos][0].info, ".noreturn with return type not allowed") of wNoDestroy: noVal(c, it) - incl(sym.flags, sfGeneratedOp) + incl(sym, sfGeneratedOp) of wNosinks: noVal(c, it) - incl(sym.flags, sfWasForwarded) + incl(sym, sfWasForwarded) of wDynlib: processDynLib(c, it, sym) of wCompilerProc, wCore: @@ -1053,79 +1052,79 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, recordPragma(c, it, "cppdefine", sym.name.s) if sfFromGeneric notin sym.flags: markCompilerProc(c, sym) of wNonReloadable: - sym.flags.incl sfNonReloadable + sym.incl sfNonReloadable of wProcVar: # old procvar annotation, no longer needed noVal(c, it) of wExplain: - sym.flags.incl sfExplain + sym.incl sfExplain of wDeprecated: if sym != nil and sym.kind in routineKinds + {skType, skVar, skLet, skConst}: if it.kind in nkPragmaCallKinds: discard getStrLitNode(c, it) - incl(sym.flags, sfDeprecated) + incl(sym, sfDeprecated) elif sym != nil and sym.kind != skModule: # We don't support the extra annotation field if it.kind in nkPragmaCallKinds: localError(c.config, it.info, "annotation to deprecated not supported here") - incl(sym.flags, sfDeprecated) + incl(sym, sfDeprecated) # At this point we're quite sure this is a statement and applies to the # whole module elif it.kind in nkPragmaCallKinds: deprecatedStmt(c, it) - else: incl(c.module.flags, sfDeprecated) + else: incl(c.module, sfDeprecated) of wVarargs: noVal(c, it) if sym.typ == nil: invalidPragma(c, it) - else: incl(sym.typ.flags, tfVarargs) + else: incl(sym.typ, tfVarargs) of wBorrow: if sym.kind == skType: typeBorrow(c, sym, it) else: noVal(c, it) - incl(sym.flags, sfBorrow) + incl(sym, sfBorrow) of wFinal: noVal(c, it) if sym.typ == nil: invalidPragma(c, it) - else: incl(sym.typ.flags, tfFinal) + else: incl(sym.typ, tfFinal) of wInheritable: noVal(c, it) if sym.typ == nil or tfFinal in sym.typ.flags: invalidPragma(c, it) - else: incl(sym.typ.flags, tfInheritable) + else: incl(sym.typ, tfInheritable) of wPackage: noVal(c, it) if sym.typ == nil: invalidPragma(c, it) - else: incl(sym.flags, sfForward) + else: incl(sym, sfForward) of wAcyclic: noVal(c, it) if sym.typ == nil: invalidPragma(c, it) - else: incl(sym.typ.flags, tfAcyclic) + else: incl(sym.typ, tfAcyclic) of wShallow: noVal(c, it) if sym.typ == nil: invalidPragma(c, it) - else: incl(sym.typ.flags, tfShallow) + else: incl(sym.typ, tfShallow) of wThread: noVal(c, it) - incl(sym.flags, sfThread) + incl(sym, sfThread) if sym.typ != nil: - incl(sym.typ.flags, tfThread) + incl(sym.typ, tfThread) if sym.typ.callConv == ccClosure: sym.typ.callConv = ccNimCall of wSendable: noVal(c, it) if sym != nil and sym.typ != nil: - incl(sym.typ.flags, tfSendable) + incl(sym.typ, tfSendable) else: invalidPragma(c, it) of wGcSafe: noVal(c, it) if sym != nil: - if sym.kind != skType: incl(sym.flags, sfThread) - if sym.typ != nil: incl(sym.typ.flags, tfGcSafe) + if sym.kind != skType: incl(sym, sfThread) + if sym.typ != nil: incl(sym.typ, tfGcSafe) else: invalidPragma(c, it) else: discard "no checking if used as a code block" of wPacked: noVal(c, it) if sym.typ == nil: invalidPragma(c, it) - else: incl(sym.typ.flags, tfPacked) + else: incl(sym.typ, tfPacked) of wHint: let s = expectStrLit(c, it) recordPragma(c, it, "hint", s) @@ -1141,8 +1140,8 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, # distinguish properly between # ``proc p() {.error}`` and ``proc p() = {.error: "msg".}`` if it.kind in nkPragmaCallKinds: discard getStrLitNode(c, it) - incl(sym.flags, sfError) - excl(sym.flags, sfForward) + incl(sym, sfError) + excl(sym, sfForward) else: let s = expectStrLit(c, it) recordPragma(c, it, "error", s) @@ -1152,18 +1151,18 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, of wUndef: processUndef(c, it) of wCompile: let m = sym.getModule() - incl(m.flags, sfUsed) + incl(m.flagsImpl, sfUsed) processCompile(c, it) of wLink: processLink(c, it) of wPassl: let m = sym.getModule() - incl(m.flags, sfUsed) + incl(m.flagsImpl, 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) + incl(m.flagsImpl, sfUsed) let s = expectStrLit(c, it) extccomp.addCompileOption(c.config, s) recordPragma(c, it, "passc", s) @@ -1181,16 +1180,16 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, result = true of wPragma: if not sym.isNil and sym.kind == skTemplate: - sym.flags.incl sfCustomPragma + sym.incl sfCustomPragma else: processPragma(c, n, i) result = true of wDiscardable: noVal(c, it) - if sym != nil: incl(sym.flags, sfDiscardable) + if sym != nil: incl(sym, sfDiscardable) of wNoInit: noVal(c, it) - if sym != nil: incl(sym.flags, sfNoInit) + if sym != nil: incl(sym, sfNoInit) of wCodegenDecl: processCodegenDecl(c, it, sym) of wChecks, wObjChecks, wFieldChecks, wRangeChecks, wBoundChecks, wOverflowChecks, wNilChecks, wAssertions, wWarnings, wHints, @@ -1200,7 +1199,8 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, processOption(c, it, c.config.options) of wStackTrace, wLineTrace: if sym.kind in {skProc, skMethod, skConverter}: - processOption(c, it, sym.options) + ensureMutable sym + processOption(c, it, sym.optionsImpl) else: processOption(c, it, c.config.options) of FirstCallConv..LastCallConv: @@ -1208,7 +1208,7 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, if sym.typ == nil: invalidPragma(c, it) else: sym.typ.callConv = wordToCallConv(k) - sym.typ.flags.incl tfExplicitCallConv + sym.typ.incl tfExplicitCallConv of wEmit: pragmaEmit(c, it) of wUnroll: pragmaUnroll(c, it) of wLinearScanEnd, wComputedGoto: noVal(c, it) @@ -1218,11 +1218,11 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, of wIncompleteStruct: noVal(c, it) if sym.typ == nil: invalidPragma(c, it) - else: incl(sym.typ.flags, tfIncompleteStruct) + else: incl(sym.typ, tfIncompleteStruct) of wCompleteStruct: noVal(c, it) if sym.typ == nil: invalidPragma(c, it) - else: incl(sym.typ.flags, tfCompleteStruct) + else: incl(sym.typ, tfCompleteStruct) of wUnchecked: noVal(c, it) if sym.typ == nil or sym.typ.kind notin {tyArray, tyUncheckedArray}: @@ -1235,34 +1235,35 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, else: noVal(c, it) if sym.typ == nil: invalidPragma(c, it) - else: incl(sym.typ.flags, tfUnion) + else: incl(sym.typ, tfUnion) of wRequiresInit: noVal(c, it) if sym.kind == skField: - sym.flags.incl sfRequiresInit + sym.incl sfRequiresInit elif sym.typ != nil: - incl(sym.typ.flags, tfNeedsFullInit) + incl(sym.typ, tfNeedsFullInit) else: invalidPragma(c, it) of wByRef: noVal(c, it) if sym != nil and sym.kind == skParam: - sym.options.incl optByRef + ensureMutable sym + sym.optionsImpl.incl optByRef elif sym == nil or sym.typ == nil: processOption(c, it, c.config.options) else: - incl(sym.typ.flags, tfByRef) + incl(sym.typ, tfByRef) of wByCopy: noVal(c, it) if sym.kind == skParam: - incl(sym.flags, sfByCopy) + incl(sym, sfByCopy) elif sym.kind != skType or sym.typ == nil: invalidPragma(c, it) - else: incl(sym.typ.flags, tfByCopy) + else: incl(sym.typ, tfByCopy) of wPartial: noVal(c, it) if sym.kind != skType or sym.typ == nil: invalidPragma(c, it) else: - incl(sym.typ.flags, tfPartial) + incl(sym.typ, tfPartial) of wInject, wGensym: # We check for errors, but do nothing with these pragmas otherwise # as they are handled directly in 'evalTemplate'. @@ -1290,7 +1291,7 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, if sym == nil or sym.kind notin {skVar, skLet}: invalidPragma(c, it) else: - sym.flags.incl sfGoto + sym.incl sfGoto of wExportNims: if sym == nil: invalidPragma(c, it) else: magicsys.registerNimScriptSymbol(c.graph, sym) @@ -1305,7 +1306,7 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, noVal(c, it) of wBase: noVal(c, it) - sym.flags.incl sfBase + sym.incl sfBase of wIntDefine: processDefineConst(c, n, sym, mIntDefine) of wStrDefine: @@ -1315,21 +1316,22 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, of wUsed: noVal(c, it) if sym == nil: invalidPragma(c, it) - else: sym.flags.incl sfUsed + else: sym.incl sfUsed of wLiftLocals: - sym.flags.incl(sfForceLift) + sym.incl(sfForceLift) of wRequires, wInvariant, wAssume, wAssert: pragmaProposition(c, it) of wEnsures: pragmaEnsures(c, it) of wEnforceNoRaises: - sym.flags.incl sfNeverRaises + sym.incl sfNeverRaises of wQuirky: - sym.flags.incl sfNeverRaises + sym.incl sfNeverRaises if sym.kind in {skProc, skMethod, skConverter, skFunc, skIterator}: - sym.options.incl optQuirky + ensureMutable sym + sym.optionsImpl.incl optQuirky of wSystemRaisesDefect: - sym.flags.incl sfSystemRaisesDefect + sym.incl sfSystemRaisesDefect of wVirtual: processVirtual(c, it, sym, sfVirtual) of wMember: @@ -1386,9 +1388,9 @@ proc implicitPragmas*(c: PContext, sym: PSym, info: TLineInfo, var lib = c.optionStack[^1].dynlib if {lfDynamicLib, lfHeader} * sym.loc.flags == {} and sfImportc in sym.flags and lib != nil: - incl(sym.loc.flags, lfDynamicLib) + incl(sym, lfDynamicLib) addToLib(lib, sym) - if sym.loc.snippet == "": sym.loc.snippet = rope(sym.name.s) + if sym.locImpl.snippet == "": sym.locImpl.snippet = rope(sym.name.s) proc hasPragma*(n: PNode, pragma: TSpecialWord): bool = if n == nil: return false diff --git a/compiler/renderer.nim b/compiler/renderer.nim index a2e7626b42..e8cdfad6d2 100644 --- a/compiler/renderer.nim +++ b/compiler/renderer.nim @@ -1836,6 +1836,9 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext, fromStmtList = false) = putWithSpace(g, tkSymbol, "error") #gcomma(g, n, c) gsub(g, n[0], c) + of nkReplayAction: + put(g, tkSymbol, "replayaction") + #gsons(g, n, c, 0) else: #nkNone, nkExplicitTypeListCall: internalError(g.config, n.info, "renderer.gsub(" & $n.kind & ')') diff --git a/compiler/scriptconfig.nim b/compiler/scriptconfig.nim index e3d2bcd458..10d3f73bc0 100644 --- a/compiler/scriptconfig.nim +++ b/compiler/scriptconfig.nim @@ -213,9 +213,10 @@ proc runNimScript*(cache: IdentCache; scriptName: AbsoluteFile; unregisterArcOrc(conf) conf.globalOptions.excl optOwnedRefs conf.selectedGC = gcUnselected + conf.globalOptions.incl optWithinConfigSystem var m = graph.makeModule(scriptName) - incl(m.flags, sfMainModule) + incl(m, sfMainModule) var vm = setupVM(m, cache, scriptName.string, graph, idgen) graph.vm = vm @@ -251,4 +252,5 @@ proc runNimScript*(cache: IdentCache; scriptName: AbsoluteFile; #initDefines() undefSymbol(conf.symbols, "nimscript") undefSymbol(conf.symbols, "nimconfig") + conf.globalOptions.excl optWithinConfigSystem conf.symbolFiles = oldSymbolFiles diff --git a/compiler/sem.nim b/compiler/sem.nim index 38da68a0b0..1d2ed2e350 100644 --- a/compiler/sem.nim +++ b/compiler/sem.nim @@ -102,7 +102,7 @@ proc fitNode(c: PContext, formal: PType, arg: PNode; info: TLineInfo): PNode = renderTree(arg, {renderNoComments})) # error correction: result = copyTree(arg) - result.typ() = formal + result.typ = formal elif arg.kind in nkSymChoices and formal.skipTypes(abstractInst).kind == tyEnum: # Pick the right 'sym' from the sym choice by looking at 'formal' type: result = nil @@ -116,7 +116,7 @@ proc fitNode(c: PContext, formal: PType, arg: PNode; info: TLineInfo): PNode = typeMismatch(c.config, info, formal, arg.typ, arg) # error correction: result = copyTree(arg) - result.typ() = formal + result.typ = formal else: result = fitNodePostMatch(c, formal, result) @@ -126,7 +126,7 @@ proc fitNodeConsiderViewType(c: PContext, formal: PType, arg: PNode; info: TLine #classifyViewType(formal) != noView: result = newNodeIT(nkHiddenAddr, a.info, formal) result.add a - formal.flags.incl tfVarIsPtr + formal.incl tfVarIsPtr else: result = a @@ -260,7 +260,7 @@ proc newSymG*(kind: TSymKind, n: PNode, c: PContext): PSym = else: result = newSym(kind, considerQuotedIdent(c, n), c.idgen, getCurrOwner(c), n.info) if find(result.name.s, '`') >= 0: - result.flags.incl sfWasGenSym + result.flagsImpl.incl sfWasGenSym #if kind in {skForVar, skLet, skVar} and result.owner.kind == skModule: # incl(result.flags, sfGlobal) when defined(nimsuggest): @@ -491,7 +491,7 @@ proc semAfterMacroCall(c: PContext, call, macroResult: PNode, renderTree(result, {renderNoComments})) result = newSymNode(errorSym(c, result)) else: - result.typ() = makeTypeDesc(c, typ) + result.typ = makeTypeDesc(c, typ) #result = symNodeFromType(c, typ, n.info) else: if s.ast[genericParamsPos] != nil and retType.isMetaType: @@ -650,7 +650,7 @@ proc defaultFieldsForTuple(c: PContext, recNode: PNode, hasDefault: var bool, ch newNodeIT(nkType, recNode.info, asgnType) ) asgnExpr.flags.incl nfSkipFieldChecking - asgnExpr.typ() = recNode.typ + asgnExpr.typ = recNode.typ result.add newTree(nkExprColonExpr, recNode, asgnExpr) else: raiseAssert "unreachable" @@ -672,7 +672,7 @@ proc defaultFieldsForTheUninitialized(c: PContext, recNode: PNode, checkDefault: if checkDefault: # don't add defaults when checking whether a case branch has default fields return defaultValue = newIntNode(nkIntLit#[c.graph]#, 0) - defaultValue.typ() = discriminator.typ + defaultValue.typ = discriminator.typ selectedBranch = recNode.pickCaseBranchIndex defaultValue defaultValue.flags.incl nfSkipFieldChecking result.add newTree(nkExprColonExpr, discriminator, defaultValue) @@ -685,7 +685,7 @@ proc defaultFieldsForTheUninitialized(c: PContext, recNode: PNode, checkDefault: elif recType.kind in {tyObject, tyArray, tyTuple}: let asgnExpr = defaultNodeField(c, recNode, recNode.typ, checkDefault) if asgnExpr != nil: - asgnExpr.typ() = recNode.typ + asgnExpr.typ = recNode.typ asgnExpr.flags.incl nfSkipFieldChecking result.add newTree(nkExprColonExpr, recNode, asgnExpr) else: @@ -698,7 +698,7 @@ proc defaultNodeField(c: PContext, a: PNode, aTyp: PType, checkDefault: bool): P let child = defaultFieldsForTheUninitialized(c, aTypSkip.n, checkDefault) if child.len > 0: var asgnExpr = newTree(nkObjConstr, newNodeIT(nkType, a.info, aTyp)) - asgnExpr.typ() = aTyp + asgnExpr.typ = aTyp asgnExpr.sons.add child result = semExpr(c, asgnExpr) else: @@ -710,11 +710,11 @@ proc defaultNodeField(c: PContext, a: PNode, aTyp: PType, checkDefault: bool): P let node = newNode(nkIntLit) node.intVal = toInt64(lengthOrd(c.graph.config, aTypSkip)) let typeNode = newNode(nkType) - typeNode.typ() = makeTypeDesc(c, aTypSkip[1]) + typeNode.typ = makeTypeDesc(c, aTypSkip[1]) result = semExpr(c, newTree(nkCall, newTree(nkBracketExpr, newSymNode(getSysSym(c.graph, a.info, "arrayWithDefault"), a.info), typeNode), node )) - result.typ() = aTyp + result.typ = aTyp else: result = nil of tyTuple: @@ -723,7 +723,7 @@ proc defaultNodeField(c: PContext, a: PNode, aTyp: PType, checkDefault: bool): P let children = defaultFieldsForTuple(c, aTypSkip.n, hasDefault, checkDefault) if hasDefault and children.len > 0: result = newNodeI(nkTupleConstr, a.info) - result.typ() = aTyp + result.typ = aTyp result.sons.add children result = semExpr(c, result) else: diff --git a/compiler/semcall.nim b/compiler/semcall.nim index a80b58be7b..77a86d9d74 100644 --- a/compiler/semcall.nim +++ b/compiler/semcall.nim @@ -695,7 +695,7 @@ proc instGenericConvertersArg*(c: PContext, a: PNode, x: TCandidate) = internalError(c.config, a.info, "generic converter failed rematch") let finalCallee = generateInstance(c, s, convMatch.bindings, a.info) a[0].sym = finalCallee - a[0].typ() = finalCallee.typ + a[0].typ = finalCallee.typ #a.typ = finalCallee.typ.returnType proc instGenericConvertersSons*(c: PContext, n: PNode, x: TCandidate) = @@ -730,13 +730,13 @@ proc inferWithMetatype(c: PContext, formal: PType, # This almost exactly replicates the steps taken by the compiler during # param matching. It performs an embarrassing amount of back-and-forth # type jugling, but it's the price to pay for consistency and correctness - result.typ() = generateTypeInstance(c, m.bindings, arg.info, + result.typ = generateTypeInstance(c, m.bindings, arg.info, formal.skipTypes({tyCompositeTypeClass})) else: typeMismatch(c.config, arg.info, formal, arg.typ, arg) # error correction: result = copyTree(arg) - result.typ() = formal + result.typ = formal proc updateDefaultParams(c: PContext, call: PNode) = # In generic procs, the default parameter may be unique for each @@ -759,7 +759,7 @@ proc updateDefaultParams(c: PContext, call: PNode) = 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) + def.typ = errorType(c) call[i] = def proc getCallLineInfo(n: PNode): TLineInfo = @@ -846,8 +846,8 @@ proc semResolvedCall(c: PContext, x: var TCandidate, result = x.call result[0] = newSymNode(finalCallee, getCallLineInfo(result[0])) if containsGenericType(result.typ): - result.typ() = newTypeS(tyError, c) - incl result.typ.flags, tfCheckedForDestructor + result.typ = newTypeS(tyError, c) + incl result.typ, tfCheckedForDestructor return let gp = finalCallee.ast[genericParamsPos] if gp.isGenericParams: @@ -873,7 +873,7 @@ proc semResolvedCall(c: PContext, x: var TCandidate, # this node will be used in template substitution, # pretend this is an untyped node and let regular sem handle the type # to prevent problems where a generic parameter is treated as a value - tn.typ() = nil + tn.typ = nil x.call.add tn else: internalAssert c.config, false @@ -885,7 +885,7 @@ proc semResolvedCall(c: PContext, x: var TCandidate, markConvertersUsed(c, result) result[0] = newSymNode(finalCallee, getCallLineInfo(result[0])) if finalCallee.magic notin {mArrGet, mArrPut}: - result.typ() = finalCallee.typ.returnType + result.typ = finalCallee.typ.returnType updateDefaultParams(c, result) proc canDeref(n: PNode): bool {.inline.} = @@ -894,7 +894,7 @@ proc canDeref(n: PNode): bool {.inline.} = proc tryDeref(n: PNode): PNode = result = newNodeI(nkHiddenDeref, n.info) - result.typ() = n.typ.skipTypes(abstractInst)[0] + result.typ = n.typ.skipTypes(abstractInst)[0] result.add n proc semOverloadedCall(c: PContext, n, nOrig: PNode, @@ -913,7 +913,7 @@ proc semOverloadedCall(c: PContext, n, nOrig: PNode, else: if c.inGenericContext > 0 and c.matchedConcept == nil: result = semGenericStmt(c, n) - result.typ() = makeTypeFromExpr(c, result.copyTree) + result.typ = makeTypeFromExpr(c, result.copyTree) elif efNoUndeclared in flags: result = nil elif efExplain notin flags: @@ -945,7 +945,7 @@ proc explicitGenericSym(c: PContext, n: PNode, s: PSym, errors: var CandidateErr diagnostics: m.diagnostics)) return nil var newInst = generateInstance(c, s, m.bindings, n.info) - newInst.typ.flags.excl tfUnresolved + newInst.typ.excl tfUnresolved let info = getCallLineInfo(n) markUsed(c, info, s, isGenericInstance = false) onUse(info, s, isGenericInstance = false) @@ -964,9 +964,9 @@ proc setGenericParams(c: PContext, n, expectedParams: PNode) = nil e = semExprWithType(c, n[i], expectedType = constraint) if e.typ == nil: - n[i].typ() = errorType(c) + n[i].typ = errorType(c) else: - n[i].typ() = e.typ.skipTypes({tyTypeDesc}) + n[i].typ = e.typ.skipTypes({tyTypeDesc}) proc explicitGenericInstantiation(c: PContext, n: PNode, s: PSym, doError: bool): PNode = assert n.kind == nkBracketExpr @@ -983,7 +983,7 @@ proc explicitGenericInstantiation(c: PContext, n: PNode, s: PSym, doError: bool) # same as in semOverloadedCall, make expression untyped, # may have failed match due to unresolved types result = semGenericStmt(c, n) - result.typ() = makeTypeFromExpr(c, result.copyTree) + result.typ = makeTypeFromExpr(c, result.copyTree) elif doError: notFoundError(c, n, errors) elif a.kind in {nkClosedSymChoice, nkOpenSymChoice}: @@ -1001,7 +1001,7 @@ proc explicitGenericInstantiation(c: PContext, n: PNode, s: PSym, doError: bool) # any failing match stops building the symchoice for correctness, # can also make it untyped from the start result = semGenericStmt(c, n) - result.typ() = makeTypeFromExpr(c, result.copyTree) + result.typ = makeTypeFromExpr(c, result.copyTree) return # get rid of nkClosedSymChoice if not ambiguous: if result.len == 0: diff --git a/compiler/semdata.nim b/compiler/semdata.nim index e3be90014e..b1dd28ec4c 100644 --- a/compiler/semdata.nim +++ b/compiler/semdata.nim @@ -153,7 +153,6 @@ type generics*: seq[TInstantiationPair] # pending list of instantiated generics to compile topStmts*: int # counts the number of encountered top level statements lastGenericIdx*: int # used for the generics stack - hloLoopDetector*: int # used to prevent endless loops in the HLO inParallelStmt*: int instTypeBoundOp*: proc (c: PContext; dc: PSym; t: PType; info: TLineInfo; op: TTypeAttachedOp; col: int): PSym {.nimcall.} @@ -202,29 +201,29 @@ proc getIntLitType*(c: PContext; literal: PNode): PType = proc setIntLitType*(c: PContext; result: PNode) = let i = result.intVal case c.config.target.intSize - of 8: result.typ() = getIntLitType(c, result) + of 8: result.typ = getIntLitType(c, result) of 4: if i >= low(int32) and i <= high(int32): - result.typ() = getIntLitType(c, result) + result.typ = getIntLitType(c, result) else: - result.typ() = getSysType(c.graph, result.info, tyInt64) + result.typ = getSysType(c.graph, result.info, tyInt64) of 2: if i >= low(int16) and i <= high(int16): - result.typ() = getIntLitType(c, result) + result.typ = getIntLitType(c, result) elif i >= low(int32) and i <= high(int32): - result.typ() = getSysType(c.graph, result.info, tyInt32) + result.typ = getSysType(c.graph, result.info, tyInt32) else: - result.typ() = getSysType(c.graph, result.info, tyInt64) + result.typ = getSysType(c.graph, result.info, tyInt64) of 1: # 8 bit CPUs are insane ... if i >= low(int8) and i <= high(int8): - result.typ() = getIntLitType(c, result) + result.typ = getIntLitType(c, result) elif i >= low(int16) and i <= high(int16): - result.typ() = getSysType(c.graph, result.info, tyInt16) + result.typ = getSysType(c.graph, result.info, tyInt16) elif i >= low(int32) and i <= high(int32): - result.typ() = getSysType(c.graph, result.info, tyInt32) + result.typ = getSysType(c.graph, result.info, tyInt32) else: - result.typ() = getSysType(c.graph, result.info, tyInt64) + result.typ = getSysType(c.graph, result.info, tyInt64) else: internalError(c.config, result.info, "invalid int size") @@ -359,6 +358,9 @@ proc addImportFileDep*(c: PContext; f: FileIndex) = proc addPragmaComputation*(c: PContext; n: PNode) = if c.config.symbolFiles != disabledSf: addPragmaComputation(c.encoder, c.packedRepr, n) + # Also store for NIF-based IC (cmdM mode or optCompress) + if optCompress in c.config.globalOptions or c.config.cmd == cmdM: + addNifReplayAction(c.graph, c.module.position.int32, n) proc inclSym(sq: var seq[PSym], s: PSym): bool = for i in 0.. 0): # expression is compiled early in a generic body - result.typ() = makeTypeFromExpr(c, copyTree(result)) + result.typ = makeTypeFromExpr(c, copyTree(result)) return result if not isSymChoice(op): @@ -491,7 +491,7 @@ proc semCast(c: PContext, n: PNode): PNode = if not isCastable(c, targetType, castedExpr.typ, n.info): localError(c.config, n.info, "expression cannot be cast to '$1'" % $targetType) result = newNodeI(nkCast, n.info) - result.typ() = targetType + result.typ = targetType result.add copyTree(n[0]) result.add castedExpr @@ -505,18 +505,18 @@ proc semLowHigh(c: PContext, n: PNode, m: TMagic): PNode = var typ = skipTypes(n[1].typ, abstractVarRange + {tyTypeDesc, tyUserTypeClassInst}) case typ.kind of tySequence, tyString, tyCstring, tyOpenArray, tyVarargs: - n.typ() = getSysType(c.graph, n.info, tyInt) + n.typ = getSysType(c.graph, n.info, tyInt) of tyArray: - n.typ() = typ.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) + n.typ = getSysType(c.graph, n.info, tyInt) of tyInt..tyInt64, tyChar, tyBool, tyEnum, tyUInt..tyUInt64, tyFloat..tyFloat64: - n.typ() = n[1].typ.skipTypes({tyTypeDesc}) + n.typ = n[1].typ.skipTypes({tyTypeDesc}) of tyGenericParam: # prepare this for resolving in semtypinst: # we must use copyTree here in order to avoid creating a cycle # that could easily turn into an infinite recursion in semtypinst - n.typ() = makeTypeFromExpr(c, n.copyTree) + n.typ = makeTypeFromExpr(c, n.copyTree) else: localError(c.config, n.info, "invalid argument for: " & opToStr[m]) result = n @@ -532,7 +532,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() = newTypeS(tyStatic, c, n.typ) + n.typ = newTypeS(tyStatic, c, n.typ) n.typ.n = n # XXX: cycles like the one here look dangerous. # Consider using `n.copyTree` @@ -582,7 +582,7 @@ proc isOpImpl(c: PContext, n: PNode, flags: TExprFlags): PNode = # `res = sameType(t1, t2)` would be wrong, e.g. for `int is (int|float)` result = newIntNode(nkIntLit, ord(res)) - result.typ() = n.typ + result.typ = n.typ proc semIs(c: PContext, n: PNode, flags: TExprFlags): PNode = if n.len != 3 or n[2].kind == nkEmpty: @@ -591,7 +591,7 @@ proc semIs(c: PContext, n: PNode, flags: TExprFlags): PNode = let boolType = getSysType(c.graph, n.info, tyBool) result = n - n.typ() = boolType + n.typ = boolType var liftLhs = true n[1] = semExprWithType(c, n[1], {efDetermineType, efWantIterator}) @@ -605,7 +605,7 @@ proc semIs(c: PContext, n: PNode, flags: TExprFlags): PNode = n[1] = evaluated else: result = newIntNode(nkIntLit, 0) - result.typ() = boolType + result.typ = boolType return elif t2.kind == tyTypeDesc and (t2.base.kind == tyNone or tfExplicit in t2.flags): @@ -635,7 +635,7 @@ proc semOpAux(c: PContext, n: PNode) = let info = a[0].info a[0] = newIdentNode(considerQuotedIdent(c, a[0], a), info) a[1] = semExprWithType(c, a[1], flags) - a.typ() = a[1].typ + a.typ = a[1].typ else: n[i] = semExprWithType(c, a, flags) @@ -708,7 +708,7 @@ proc changeType(c: PContext; n: PNode, newType: PType, check: bool) = localError(c.config, n.info, "cannot convert '" & n.sym.name.s & "' to '" & typeNameAndDesc(newType) & "'") else: discard - n.typ() = newType + n.typ = newType proc arrayConstrType(c: PContext, n: PNode): PType = var typ = newTypeS(tyArray, c) @@ -730,12 +730,12 @@ proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PTyp var expectedElementType, expectedIndexType: PType = nil var expectedBase: PType = nil if constructType: - result.typ() = newTypeS(tyArray, c) + result.typ = newTypeS(tyArray, c) rawAddSon(result.typ, nil) # index type if expectedType != nil: expectedBase = expectedType.skipTypes(abstractRange-{tyDistinct}) else: - result.typ() = n.typ + result.typ = n.typ expectedBase = n.typ.skipTypes(abstractRange) # include tyDistinct this time if expectedBase != nil: case expectedBase.kind @@ -815,9 +815,9 @@ proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PTyp for i in 0.. 0: # don't make assumptions, entire expression needs to be tyFromExpr result = semGenericStmt(c, n) - result.typ() = makeTypeFromExpr(c, result.copyTree) + result.typ = makeTypeFromExpr(c, result.copyTree) return else: n[0] = n0 @@ -1361,7 +1361,7 @@ proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode = of tyStatic: if typ.n != nil: result = typ.n - result.typ() = typ.base + result.typ = typ.base else: result = newSymNode(s, n.info) else: @@ -1407,11 +1407,11 @@ proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode = onUse(n.info, s) if s.typ.kind == tyStatic: result = newSymNode(s, n.info) - result.typ() = s.typ + result.typ = s.typ elif s.ast != nil: result = semExpr(c, s.ast) else: - n.typ() = s.typ + n.typ = s.typ return n of skType: if n.kind != nkDotExpr: # dotExpr is already checked by builtinFieldAccess @@ -1422,7 +1422,7 @@ proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode = if s.typ.kind == tyStatic and s.typ.base.kind != tyNone and s.typ.n != nil: return s.typ.n result = newSymNode(s, n.info) - result.typ() = makeTypeDesc(c, s.typ) + result.typ = makeTypeDesc(c, s.typ) of skField: # old code, not sure if it's live code: markUsed(c, n.info, s) @@ -1448,7 +1448,7 @@ proc tryReadingGenericParam(c: PContext, n: PNode, i: PIdent, t: PType): PNode = if result == c.graph.emptyNode: if c.inGenericContext > 0: result = semGenericStmt(c, n) - result.typ() = makeTypeFromExpr(c, result.copyTree) + result.typ = makeTypeFromExpr(c, result.copyTree) else: result = nil of tyUserTypeClasses: @@ -1456,7 +1456,7 @@ proc tryReadingGenericParam(c: PContext, n: PNode, i: PIdent, t: PType): PNode = result = readTypeParameter(c, t, i, n.info) elif c.inGenericContext > 0: result = semGenericStmt(c, n) - result.typ() = makeTypeFromExpr(c, copyTree(result)) + result.typ = makeTypeFromExpr(c, copyTree(result)) else: result = nil of tyGenericBody, tyCompositeTypeClass: @@ -1465,12 +1465,12 @@ proc tryReadingGenericParam(c: PContext, n: PNode, i: PIdent, t: PType): PNode = if result != nil: # generic parameter exists, stop here but delay until instantiation result = semGenericStmt(c, n) - result.typ() = makeTypeFromExpr(c, copyTree(result)) + 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)) + result.typ = makeTypeFromExpr(c, copyTree(result)) else: result = nil @@ -1488,14 +1488,14 @@ proc tryReadingTypeField(c: PContext, n: PNode, i: PIdent, ty: PType): PNode = if f != nil: result = newSymNode(f) result.info = n.info - result.typ() = ty + result.typ = ty markUsed(c, n.info, f) onUse(n.info, f) of tyObject, tyTuple: if ty.n != nil and ty.n.kind == nkRecList: let field = lookupInRecord(ty.n, i) if field != nil: - n.typ() = makeTypeDesc(c, field.typ) + n.typ = makeTypeDesc(c, field.typ) result = n of tyGenericInst: result = tryReadingTypeField(c, n, i, ty.skipModifier) @@ -1542,7 +1542,7 @@ proc builtinFieldAccess(c: PContext; n: PNode; flags: var TExprFlags): PNode = # tyFromExpr, but when this happen in a macro this is not a built-in # field access and we leave the compiler to compile a normal call: if getCurrOwner(c).kind != skMacro: - n.typ() = makeTypeFromExpr(c, n.copyTree) + n.typ = makeTypeFromExpr(c, n.copyTree) flags.incl efCannotBeDotCall return n else: @@ -1582,12 +1582,12 @@ proc builtinFieldAccess(c: PContext; n: PNode; flags: var TExprFlags): PNode = n[0] = makeDeref(n[0]) n[1] = newSymNode(f) # we now have the correct field n[1].info = info # preserve the original info - n.typ() = f.typ + n.typ = f.typ if check == nil: result = n else: check[0] = n - check.typ() = n.typ + check.typ = n.typ result = check elif ty.kind == tyTuple and ty.n != nil: f = getSymFromList(ty.n, i) @@ -1596,7 +1596,7 @@ proc builtinFieldAccess(c: PContext; n: PNode; flags: var TExprFlags): PNode = onUse(n[1].info, f) n[0] = makeDeref(n[0]) n[1] = newSymNode(f) - n.typ() = f.typ + n.typ = f.typ result = n # we didn't find any field, let's look for a generic param @@ -1662,9 +1662,9 @@ proc semDeref(c: PContext, n: PNode, flags: TExprFlags): PNode = result = n var t = skipTypes(n[0].typ, {tyGenericInst, tyVar, tyLent, tyAlias, tySink, tyOwned}) case t.kind - of tyRef, tyPtr: n.typ() = t.elementType + of tyRef, tyPtr: n.typ = t.elementType of tyMetaTypes, tyFromExpr: - n.typ() = makeTypeFromExpr(c, n.copyTree) + n.typ = makeTypeFromExpr(c, n.copyTree) else: result = nil #GlobalError(n[0].info, errCircumNeedsPointer) @@ -1697,7 +1697,7 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags, afterOverloading = f if arr.kind == tyStatic: if arr.base.kind == tyNone: result = n - result.typ() = semStaticType(c, n[1], nil) + result.typ = semStaticType(c, n[1], nil) return elif arr.n != nil: return semSubscript(c, arr.n, flags, afterOverloading) @@ -1719,18 +1719,18 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags, afterOverloading = f if arg != nil: n[1] = arg result = n - result.typ() = elemType(arr) + result.typ = elemType(arr) # Other types have a bit more of leeway elif n[1].typ.skipTypes(abstractRange-{tyDistinct}).kind in {tyInt..tyInt64, tyUInt..tyUInt64}: result = n - result.typ() = elemType(arr) + result.typ = elemType(arr) of tyTypeDesc: # The result so far is a tyTypeDesc bound # a tyGenericBody. The line below will substitute # it with the instantiated type. result = n - result.typ() = makeTypeDesc(c, semTypeNode(c, n, nil)) + result.typ = makeTypeDesc(c, semTypeNode(c, n, nil)) #result = symNodeFromType(c, semTypeNode(c, n, nil), n.info) of tyTuple: if n.len != 2: return nil @@ -1740,7 +1740,7 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags, afterOverloading = f if skipTypes(n[1].typ, {tyGenericInst, tyRange, tyOrdinal, tyAlias, tySink}).kind in {tyInt..tyInt64}: let idx = getOrdValue(n[1]) - if idx >= 0 and idx < arr.len: n.typ() = arr[toInt(idx)] + if idx >= 0 and idx < arr.len: n.typ = arr[toInt(idx)] else: localError(c.config, n.info, "invalid index $1 in subscript for tuple of length $2" % @@ -1837,7 +1837,7 @@ proc takeImplicitAddr(c: PContext, n: PNode; isLent: bool): PNode = 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 + n.typ = n.typ.elementType result.add(n) proc asgnToResultVar(c: PContext, n, le, ri: PNode) {.inline.} = @@ -1847,10 +1847,10 @@ proc asgnToResultVar(c: PContext, n, le, ri: PNode) {.inline.} = if x.sym.kind == skResult and (x.typ.kind in {tyVar, tyLent} or classifyViewType(x.typ) != noView): n[0] = x # 'result[]' --> 'result' n[1] = takeImplicitAddr(c, ri, x.typ.kind == tyLent) - x.typ.flags.incl tfVarIsPtr + x.typ.incl tfVarIsPtr #echo x.info, " setting it for this type ", typeToString(x.typ), " ", n.info elif sfGlobal in x.sym.flags: - x.typ.flags.incl tfVarIsPtr + x.typ.incl tfVarIsPtr proc borrowCheck(c: PContext, n, le, ri: PNode) = const @@ -1920,7 +1920,7 @@ proc makeTupleAssignments(c: PContext; n: PNode): PNode = let temp = newSym(skTemp, getIdent(c.cache, "tmpTupleAsgn"), c.idgen, getCurrOwner(c), n.info) temp.typ = value.typ - temp.flags.incl(sfGenSym) + temp.flagsImpl.incl(sfGenSym) var v = newNodeI(nkLetSection, value.info) let tempNode = newSymNode(temp) #newIdentNode(getIdent(genPrefix & $temp.id), value.info) var vpart = newNodeI(nkIdentDefs, v.info, 3) @@ -1937,7 +1937,7 @@ proc makeTupleAssignments(c: PContext; n: PNode): PNode = # generate `let _ = temp[i]` which should generate a destructor let utemp = newSym(skLet, lhs[i].ident, c.idgen, getCurrOwner(c), lhs[i].info) utemp.typ = value.typ[i] - temp.flags.incl(sfGenSym) + temp.flagsImpl.incl(sfGenSym) var uv = newNodeI(nkLetSection, lhs[i].info) let utempNode = newSymNode(utemp) var uvpart = newNodeI(nkIdentDefs, v.info, 3) @@ -2031,7 +2031,7 @@ proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode = let lhs = n[0] let rhs = semExprWithType(c, n[1], {efTypeAllowed}, le) if lhs.kind == nkSym and lhs.sym.kind == skResult: - n.typ() = c.enforceVoidContext + n.typ = c.enforceVoidContext if c.p.owner.kind != skMacro and resultTypeIsInferrable(lhs.sym.typ): var rhsTyp = rhs.typ if rhsTyp.kind in tyUserTypeClasses and rhsTyp.isResolvedUserTypeClass: @@ -2042,7 +2042,7 @@ proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode = 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 + lhs.typ = rhsTyp c.p.resultSym.typ = rhsTyp c.p.owner.typ.setReturnType rhsTyp else: @@ -2090,7 +2090,7 @@ proc semProcBody(c: PContext, n: PNode; expectedType: PType = nil): PNode = if result.kind == nkNilLit: # or ImplicitlyDiscardable(result): # new semantic: 'result = x' triggers the void context - result.typ() = nil + result.typ = nil elif result.kind == nkStmtListExpr and result.typ.kind == tyNil: # to keep backwards compatibility bodies like: # nil @@ -2124,7 +2124,7 @@ proc semYieldVarResult(c: PContext, n: PNode, restype: PType) = var t = skipTypes(restype, {tyGenericInst, tyAlias, tySink}) case t.kind of tyVar, tyLent: - t.flags.incl tfVarIsPtr # bugfix for #4048, #4910, #6892 + t.incl tfVarIsPtr # bugfix for #4048, #4910, #6892 if n[0].kind in {nkHiddenStdConv, nkHiddenSubConv}: n[0] = n[0][1] n[0] = takeImplicitAddr(c, n[0], t.kind == tyLent) @@ -2132,7 +2132,7 @@ proc semYieldVarResult(c: PContext, n: PNode, restype: PType) = for i in 0.. 0) == srFlowVar: - result.typ() = createFlowVar(c, typ, n.info) + result.typ = createFlowVar(c, typ, n.info) else: - result.typ() = typ + result.typ = typ result.add instantiateCreateFlowVarCall(c, typ, n.info).newSymNode else: result.add c.graph.emptyNode @@ -2597,7 +2598,7 @@ proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags; expectedType: P markUsed(c, n.info, s) result = setMs(n, s) result[1] = semExpr(c, n[1]) - result.typ() = n[1].typ + result.typ = n[1].typ of mPlugin: markUsed(c, n.info, s) # semDirectOp with conditional 'afterCallActions': @@ -2728,19 +2729,19 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = else: illFormedAst(n, c.config) if cannotResolve: result = semGenericStmt(c, n) - result.typ() = makeTypeFromExpr(c, result.copyTree) + result.typ = makeTypeFromExpr(c, result.copyTree) return if result == nil: result = newNodeI(nkEmpty, n.info) if whenNimvm: - result.typ() = typ + result.typ = typ if n.len == 1: result.add(newTree(nkElse, newNode(nkStmtList))) proc semSetConstr(c: PContext, n: PNode, expectedType: PType = nil): PNode = result = newNodeI(nkCurly, n.info) - result.typ() = newTypeS(tySet, c) - result.typ.flags.incl tfIsConstructor + result.typ = newTypeS(tySet, c) + result.typ.incl tfIsConstructor var expectedElementType: PType = nil if expectedType != nil and ( let expected = expectedType.skipTypes(abstractRange-{tyDistinct}); @@ -2770,7 +2771,7 @@ proc semSetConstr(c: PContext, n: PNode, expectedType: PType = nil): PNode = if doSetType: typ = skipTypes(n[i][1].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal, tyAlias, tySink}) - n[i].typ() = n[i][2].typ # range node needs type too + n[i].typ = n[i][2].typ # range node needs type too elif n[i].kind == nkRange: # already semchecked if doSetType: @@ -2801,9 +2802,9 @@ proc semSetConstr(c: PContext, n: PNode, expectedType: PType = nil): PNode = for i in 0.. 0: # don't interpret () as type internalAssert c.config, tupexp.kind == nkTupleConstr - isTupleType = tupexp[0].typ.kind == tyTypeDesc + isTupleType = isTypeTupleField(tupexp[0]) # check if either everything or nothing is tyTypeDesc for i in 1..= isSubtype: - result.typ() = expectedType + result.typ = expectedType # or: result = fitNode(c, expectedType, result, n.info) of nkIntLit: if result.typ == nil: @@ -3391,10 +3399,10 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType if expectedType != nil and ( let expected = expectedType.skipTypes(abstractRange-{tyDistinct}); expected.kind in {tyFloat..tyFloat128}): - result.typ() = expected + result.typ = expected changeType(c, result, expectedType, check=true) else: - result.typ() = getSysType(c.graph, n.info, tyFloat64) + result.typ = getSysType(c.graph, n.info, tyFloat64) of nkFloat32Lit: directLiteral(tyFloat32) of nkFloat64Lit: directLiteral(tyFloat64) of nkFloat128Lit: directLiteral(tyFloat128) @@ -3403,9 +3411,9 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType if expectedType != nil and ( let expected = expectedType.skipTypes(abstractRange-{tyDistinct}); expected.kind in {tyString, tyCstring}): - result.typ() = expectedType + result.typ = expectedType else: - result.typ() = getSysType(c.graph, n.info, tyString) + result.typ = getSysType(c.graph, n.info, tyString) of nkCharLit: directLiteral(tyChar) of nkDotExpr: result = semFieldAccess(c, n, flags) @@ -3420,13 +3428,13 @@ 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(newTypeS(modifier, c, baseType)) + result.typ = c.makeTypeDesc(newTypeS(modifier, c, baseType)) return var typ = semTypeNode(c, n, nil).skipTypes({tyTypeDesc}) - result.typ() = makeTypeDesc(c, typ) + result.typ = makeTypeDesc(c, typ) of nkStmtListType: let typ = semTypeNode(c, n, nil) - result.typ() = makeTypeDesc(c, typ) + result.typ = makeTypeDesc(c, typ) of nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, nkCallStrLit: # check if it is an expression macro: checkMinSonsLen(n, 1, c.config) diff --git a/compiler/semfields.nim b/compiler/semfields.nim index 5bace728f3..775895e431 100644 --- a/compiler/semfields.nim +++ b/compiler/semfields.nim @@ -24,7 +24,7 @@ proc wrapNewScope(c: PContext, n: PNode): PNode {.inline.} = # a scope has to be opened in the codegen as well for reused # template instantiations let trueLit = newIntLit(c.graph, n.info, 1) - trueLit.typ() = getSysType(c.graph, n.info, tyBool) + trueLit.typ = getSysType(c.graph, n.info, tyBool) result = newTreeI(nkIfStmt, n.info, newTreeI(nkElifBranch, n.info, trueLit, n)) proc instFieldLoopBody(c: TFieldInstCtx, n: PNode, forLoop: PNode): PNode = diff --git a/compiler/semfold.nim b/compiler/semfold.nim index 451d675188..1a3f40a47a 100644 --- a/compiler/semfold.nim +++ b/compiler/semfold.nim @@ -16,7 +16,7 @@ import commands, magicsys, modulegraphs, lineinfos, wordrecg import std/[strutils, math, strtabs] -from system/memory import nimCStrLen +#from system/memory import nimCStrLen when defined(nimPreviewSlimSystem): import std/[assertions, formatfloat] @@ -24,7 +24,7 @@ when defined(nimPreviewSlimSystem): proc errorType*(g: ModuleGraph): PType = ## creates a type representing an error state result = newType(tyError, g.idgen, g.owners[^1]) - result.flags.incl tfCheckedForDestructor + result.flagsImpl.incl tfCheckedForDestructor proc getIntLitTypeG(g: ModuleGraph; literal: PNode; idgen: IdGenerator): PType = # we cache some common integer literal types for performance: @@ -38,7 +38,7 @@ proc newIntNodeT*(intVal: Int128, n: PNode; idgen: IdGenerator; g: ModuleGraph): # original type was 'int', not a distinct int etc. if n.typ.kind == tyInt: # access cache for the int lit type - result.typ() = getIntLitTypeG(g, result, idgen) + result.typ = getIntLitTypeG(g, result, idgen) result.info = n.info proc newFloatNodeT*(floatVal: BiggestFloat, n: PNode; g: ModuleGraph): PNode = @@ -46,12 +46,12 @@ proc newFloatNodeT*(floatVal: BiggestFloat, n: PNode; g: ModuleGraph): PNode = result = newFloatNode(nkFloat32Lit, floatVal) else: result = newFloatNode(nkFloatLit, floatVal) - result.typ() = n.typ + result.typ = n.typ result.info = n.info proc newStrNodeT*(strVal: string, n: PNode; g: ModuleGraph): PNode = result = newStrNode(nkStrLit, strVal) - result.typ() = n.typ + result.typ = n.typ result.info = n.info proc getConstExpr*(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode @@ -179,29 +179,30 @@ proc evalOp(m: TMagic, n, a, b, c: PNode; idgen: IdGenerator; g: ModuleGraph): P let argB = getInt(b) result = newIntNodeT(if argA > argB: argA else: argB, n, idgen, g) of mShlI: + let valueB = toInt64(getInt(b)) and (n.typ.size * 8 - 1) case skipTypes(n.typ, abstractRange).kind - of tyInt8: result = newIntNodeT(toInt128(toInt8(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) - of tyInt16: result = newIntNodeT(toInt128(toInt16(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) - of tyInt32: result = newIntNodeT(toInt128(toInt32(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) - of tyInt64: result = newIntNodeT(toInt128(toInt64(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + of tyInt8: result = newIntNodeT(toInt128(toInt8(getInt(a)) shl valueB), n, idgen, g) + of tyInt16: result = newIntNodeT(toInt128(toInt16(getInt(a)) shl valueB), n, idgen, g) + of tyInt32: result = newIntNodeT(toInt128(toInt32(getInt(a)) shl valueB), n, idgen, g) + of tyInt64: result = newIntNodeT(toInt128(toInt64(getInt(a)) shl valueB), n, idgen, g) of tyInt: if g.config.target.intSize == 4: - result = newIntNodeT(toInt128(toInt32(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + result = newIntNodeT(toInt128(toInt32(getInt(a)) shl valueB), n, idgen, g) else: - result = newIntNodeT(toInt128(toInt64(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) - of tyUInt8: result = newIntNodeT(toInt128(toUInt8(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) - of tyUInt16: result = newIntNodeT(toInt128(toUInt16(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) - of tyUInt32: result = newIntNodeT(toInt128(toUInt32(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) - of tyUInt64: result = newIntNodeT(toInt128(toUInt64(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + result = newIntNodeT(toInt128(toInt64(getInt(a)) shl valueB), n, idgen, g) + of tyUInt8: result = newIntNodeT(toInt128(toUInt8(getInt(a)) shl valueB), n, idgen, g) + of tyUInt16: result = newIntNodeT(toInt128(toUInt16(getInt(a)) shl valueB), n, idgen, g) + of tyUInt32: result = newIntNodeT(toInt128(toUInt32(getInt(a)) shl valueB), n, idgen, g) + of tyUInt64: result = newIntNodeT(toInt128(toUInt64(getInt(a)) shl valueB), n, idgen, g) of tyUInt: if g.config.target.intSize == 4: - result = newIntNodeT(toInt128(toUInt32(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + result = newIntNodeT(toInt128(toUInt32(getInt(a)) shl valueB), n, idgen, g) else: - result = newIntNodeT(toInt128(toUInt64(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + result = newIntNodeT(toInt128(toUInt64(getInt(a)) shl valueB), n, idgen, g) else: internalError(g.config, n.info, "constant folding for shl") of mShrI: - var a = cast[uint64](getInt(a)) - let b = cast[uint64](getInt(b)) + var a = castToUInt64(getInt(a)) + let b = castToUInt64(getInt(b)) and cast[uint64](n.typ.size * 8 - 1) # To support the ``-d:nimOldShiftRight`` flag, we need to mask the # signed integers to cut off the extended sign bit in the internal # representation. @@ -220,12 +221,13 @@ proc evalOp(m: TMagic, n, a, b, c: PNode; idgen: IdGenerator; g: ModuleGraph): P let c = cast[BiggestInt](a shr b) result = newIntNodeT(toInt128(c), n, idgen, g) of mAshrI: + let valueB = toInt64(getInt(b)) and (n.typ.size * 8 - 1) case skipTypes(n.typ, abstractRange).kind - of tyInt8: result = newIntNodeT(toInt128(ashr(toInt8(getInt(a)), toInt8(getInt(b)))), n, idgen, g) - of tyInt16: result = newIntNodeT(toInt128(ashr(toInt16(getInt(a)), toInt16(getInt(b)))), n, idgen, g) - of tyInt32: result = newIntNodeT(toInt128(ashr(toInt32(getInt(a)), toInt32(getInt(b)))), n, idgen, g) + of tyInt8: result = newIntNodeT(toInt128(ashr(toInt8(getInt(a)), valueB)), n, idgen, g) + of tyInt16: result = newIntNodeT(toInt128(ashr(toInt16(getInt(a)), valueB)), n, idgen, g) + of tyInt32: result = newIntNodeT(toInt128(ashr(toInt32(getInt(a)), valueB)), n, idgen, g) of tyInt64, tyInt: - result = newIntNodeT(toInt128(ashr(toInt64(getInt(a)), toInt64(getInt(b)))), n, idgen, g) + result = newIntNodeT(toInt128(ashr(toInt64(getInt(a)), valueB)), n, idgen, g) else: internalError(g.config, n.info, "constant folding for ashr") of mDivI: let argA = getInt(a) @@ -319,7 +321,7 @@ proc evalOp(m: TMagic, n, a, b, c: PNode; idgen: IdGenerator; g: ModuleGraph): P of mEnumToStr: result = newStrNodeT(ordinalValToString(a, g), n, g) of mArrToSeq: result = copyTree(a) - result.typ() = n.typ + result.typ = n.typ of mCompileOption: result = newIntNodeT(toInt128(ord(commands.testCompileOption(g.config, a.getStr, n.info))), n, idgen, g) of mCompileOptionArg: @@ -414,7 +416,7 @@ proc foldConv(n, a: PNode; idgen: IdGenerator; g: ModuleGraph; check = false): P result = newIntNodeT(toInt128(a.getOrdValue != 0), n, idgen, g) of tyBool, tyEnum: # xxx shouldn't we disallow `tyEnum`? result = a - result.typ() = n.typ + result.typ = n.typ else: raiseAssert $srcTyp.kind of tyInt..tyInt64, tyUInt..tyUInt64: @@ -431,7 +433,7 @@ proc foldConv(n, a: PNode; idgen: IdGenerator; g: ModuleGraph; check = false): P result = newIntNodeT(val, n, idgen, g) else: result = a - result.typ() = n.typ + result.typ = n.typ if check and result.kind in {nkCharLit..nkUInt64Lit} and dstTyp.kind notin {tyUInt..tyUInt64}: rangeCheck(n, getInt(result), g) @@ -441,12 +443,12 @@ proc foldConv(n, a: PNode; idgen: IdGenerator; g: ModuleGraph; check = false): P result = newFloatNodeT(toFloat64(getOrdValue(a)), n, g) else: result = a - result.typ() = n.typ + result.typ = n.typ of tyOpenArray, tyVarargs, tyProc, tyPointer: result = nil else: result = a - result.typ() = n.typ + result.typ = n.typ proc getArrayConstr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = if n.kind == nkBracket: @@ -518,10 +520,10 @@ proc foldConStrStr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode proc newSymNodeTypeDesc*(s: PSym; idgen: IdGenerator; info: TLineInfo): PNode = result = newSymNode(s, info) if s.typ.kind != tyTypeDesc: - result.typ() = newType(tyTypeDesc, idgen, s.owner) + result.typ = newType(tyTypeDesc, idgen, s.owner) result.typ.addSonSkipIntLit(s.typ, idgen) else: - result.typ() = s.typ + result.typ = s.typ proc foldDefine(m, s: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = result = nil @@ -640,7 +642,7 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode if s.typ.kind == tyStatic: if s.typ.n != nil and tfUnresolved notin s.typ.flags: result = s.typ.n - result.typ() = s.typ.base + result.typ = s.typ.base elif s.typ.isIntLit: result = s.typ.n else: @@ -753,7 +755,7 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode if a == nil: return if leValueConv(n[1], a) and leValueConv(a, n[2]): result = a # a <= x and x <= b - result.typ() = n.typ + result.typ = n.typ elif n.typ.kind in {tyUInt..tyUInt64}: discard "don't check uints" else: @@ -764,7 +766,7 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode var a = getConstExpr(m, n[0], idgen, g) if a == nil: return result = a - result.typ() = n.typ + result.typ = n.typ of nkHiddenStdConv, nkHiddenSubConv, nkConv: var a = getConstExpr(m, n[1], idgen, g) if a == nil: return @@ -781,7 +783,7 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode not (n.typ.kind == tyProc and a.typ.kind == tyProc): # we allow compile-time 'cast' for pointer types: result = a - result.typ() = n.typ + result.typ = n.typ of nkBracketExpr: result = foldArrayAccess(m, n, idgen, g) of nkDotExpr: result = foldFieldAccess(m, n, idgen, g) of nkCheckedFieldExpr: diff --git a/compiler/semgnrc.nim b/compiler/semgnrc.nim index 9268498040..10bb33bcdc 100644 --- a/compiler/semgnrc.nim +++ b/compiler/semgnrc.nim @@ -50,13 +50,13 @@ proc semGenericStmtScope(c: PContext, n: PNode, result = semGenericStmt(c, n, flags, ctx) closeScope(c) -template isMixedIn(sym): bool = +template isMixedIn(sym): bool {.dirty.} = let s = sym s.name.id in ctx.toMixin or (withinConcept in flags and s.magic == mNone and s.kind in OverloadableSyms) -template canOpenSym(s): bool = +template canOpenSym(s): bool {.dirty.} = {withinMixin, withinConcept} * flags == {withinMixin} and s.id notin ctx.toBind proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, @@ -65,7 +65,7 @@ proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, fromDotExpr=false): PNode = result = nil semIdeForTemplateOrGenericCheck(c.config, n, ctx.cursorInBody) - incl(s.flags, sfUsed) + incl(s.flagsImpl, sfUsed) template maybeDotChoice(c: PContext, n: PNode, s: PSym, fromDotExpr: bool) = if fromDotExpr: result = symChoice(c, n, s, scForceOpen) @@ -78,10 +78,10 @@ proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, if result.kind == nkSym: result = newOpenSym(result) else: - result.typ() = nil + result.typ = nil else: result.flags.incl nfDisabledOpenSym - result.typ() = nil + result.typ = nil case s.kind of skUnknown: # Introduced in this pass! Leave it as an identifier. @@ -116,7 +116,7 @@ proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, result = newOpenSym(result) else: result.flags.incl nfDisabledOpenSym - result.typ() = nil + result.typ = nil else: result = n else: @@ -126,7 +126,7 @@ proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, result = newOpenSym(result) else: result.flags.incl nfDisabledOpenSym - result.typ() = nil + result.typ = nil onUse(n.info, s) of skParam: result = n @@ -145,7 +145,7 @@ proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, result = newOpenSym(result) else: result.flags.incl nfDisabledOpenSym - result.typ() = nil + 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 @@ -157,7 +157,7 @@ proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, result = newOpenSym(result) else: result.flags.incl nfDisabledOpenSym - result.typ() = nil + result.typ = nil else: result = n onUse(n.info, s) @@ -168,7 +168,7 @@ proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, result = newOpenSym(result) else: result.flags.incl nfDisabledOpenSym - result.typ() = nil + result.typ = nil onUse(n.info, s) proc lookup(c: PContext, n: PNode, flags: TSemGenericFlags, @@ -248,13 +248,13 @@ proc addTempDecl(c: PContext; n: PNode; kind: TSymKind) = onDef(n.info, s) proc addTempDeclToIdents(c: PContext; n: PNode; kind: TSymKind; inCall: bool) = - case n.kind + case n.kind of nkIdent: if inCall: addTempDecl(c, n, kind) of nkCallKinds: for s in n: - addTempDeclToIdents(c, s, kind, true) + addTempDeclToIdents(c, s, kind, true) else: for s in n: addTempDeclToIdents(c, s, kind, inCall) @@ -274,7 +274,7 @@ proc semGenericStmt(c: PContext, n: PNode, result = lookup(c, n, flags, ctx) if result != nil and result.kind == nkSym: assert result.sym != nil - incl result.sym.flags, sfUsed + incl result.sym.flagsImpl, sfUsed markOwnerModuleAsUsed(c, result.sym) of nkDotExpr: #let luf = if withinMixin notin flags: {checkUndeclared} else: {} @@ -318,7 +318,7 @@ proc semGenericStmt(c: PContext, n: PNode, var first = int ord(withinConcept in flags) var mixinContext = false if s != nil: - incl(s.flags, sfUsed) + incl(s.flagsImpl, sfUsed) mixinContext = s.magic in {mDefined, mDeclared, mDeclaredInScope, mCompiles, mAstToStr} let whichChoice = if s.id in ctx.toBind: scClosed elif s.isMixedIn: scForceOpen @@ -632,7 +632,7 @@ proc semGenericStmt(c: PContext, n: PNode, # treat as mixin context for user pragmas & macro args x[j] = semGenericStmt(c, x[j], flags+{withinMixin}, ctx) elif prag == wInvalid: - # only sem if not a language-level pragma + # only sem if not a language-level pragma # treat as mixin context for user pragmas & macro args result[i] = semGenericStmt(c, x, flags+{withinMixin}, ctx) of nkExprColonExpr, nkExprEqExpr: diff --git a/compiler/seminst.nim b/compiler/seminst.nim index 7db6469d92..a34467636a 100644 --- a/compiler/seminst.nim +++ b/compiler/seminst.nim @@ -24,7 +24,7 @@ proc addObjFieldsToLocalScope(c: PContext; n: PNode) = let f = n.sym if f.kind == skField and fieldVisible(c, f): c.currentScope.symbols.strTableIncl(f, onConflictKeepOld=true) - incl(f.flags, sfUsed) + incl(f.flagsImpl, sfUsed) # it is not an error to shadow fields via parameters else: discard @@ -42,7 +42,7 @@ iterator instantiateGenericParamList(c: PContext, n: PNode, pt: LayeredIdTable): if q.typ.kind in {tyTypeDesc, tyGenericParam, tyStatic, tyConcept}+tyTypeClasses: 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} + s.flagsImpl.incl {sfUsed, sfFromGeneric} var t = lookup(pt, q.typ) if t == nil: if tfRetType in q.typ.flags: @@ -149,7 +149,7 @@ proc instantiateBody(c: PContext, n, params: PNode, result, orig: PSym) = nil b = semProcBody(c, b, resultType) result.ast[bodyPos] = hloBody(c, b) - excl(result.flags, sfForward) + excl(result, sfForward) trackProc(c, result, result.ast[bodyPos]) dec c.inGenericInst @@ -208,7 +208,7 @@ proc instGenericContainer(c: PContext, info: TLineInfo, header: PType, # this scope was not created by the user, # unused params shouldn't be reported. - param.flags.incl sfUsed + param.flagsImpl.incl sfUsed addDecl(c, param) result = replaceTypeVarsT(cl, header) @@ -244,7 +244,8 @@ proc instantiateProcType(c: PContext, pt: LayeredIdTable, var result = instCopyType(cl, prc.typ) let originalParams = result.n result.n = originalParams.shallowCopy - for i, resulti in paramTypes(result): + for i in 1 ..< originalParams.len: + let resulti = originalParams[i].sym.typ # twrong_field_caching requires these 'resetIdTable' calls: if i > FirstParamAt: resetIdTable(cl.symMap) @@ -257,24 +258,24 @@ proc instantiateProcType(c: PContext, pt: LayeredIdTable, 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) + resulti.incl tfNonConstExpr + var paramType = replaceTypeVarsT(cl, resulti) if needsStaticSkipping: - result[i] = result[i].skipTypes({tyStatic}) + paramType = paramType.skipTypes({tyStatic}) if needsTypeDescSkipping: - result[i] = result[i].skipTypes({tyTypeDesc}) - typeToFit = result[i] + paramType = paramType.skipTypes({tyTypeDesc}) + typeToFit = paramType # ...otherwise, we use the instantiated type in `fitNode` if (typeToFit.kind != tyTypeDesc or typeToFit.base.kind != tyNone) and (typeToFit.kind != tyStatic): - typeToFit = result[i] + typeToFit = paramType internalAssert c.config, originalParams[i].kind == nkSym let oldParam = originalParams[i].sym let param = copySym(oldParam, c.idgen) setOwner(param, prc) - param.typ = result[i] + param.typ = paramType # The default value is instantiated and fitted against the final # concrete param type. We avoid calling `replaceTypeVarsN` on the @@ -282,7 +283,7 @@ proc instantiateProcType(c: PContext, pt: LayeredIdTable, if oldParam.ast != nil: var def = oldParam.ast.copyTree if def.typ.kind == tyFromExpr: - def.typ.flags.incl tfNonConstExpr + def.typ.incl tfNonConstExpr if not isIntLit(def.typ): def = prepareNode(cl, def) @@ -302,15 +303,15 @@ proc instantiateProcType(c: PContext, pt: LayeredIdTable, # 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 + param.ast.typ = def.typ else: param.ast = fitNodePostMatch(c, typeToFit, converted) - param.typ = result[i] + param.typ = paramType result.n[i] = newSymNode(param) - if isRecursiveStructuralType(result[i]): + if isRecursiveStructuralType(paramType): localError(c.config, originalParams[i].sym.info, "illegal recursion in type '" & typeToString(result[i]) & "'") - propagateToOwner(result, result[i]) + propagateToOwner(result, paramType) addDecl(c, param) resetIdTable(cl.symMap) @@ -337,7 +338,7 @@ proc instantiateOnlyProcType(c: PContext, pt: LayeredIdTable, prc: PSym, info: T # examples are in texplicitgenerics # might be buggy, see rest of generateInstance if problems occur let fakeSym = copySym(prc, c.idgen) - incl(fakeSym.flags, sfFromGeneric) + incl(fakeSym.flagsImpl, sfFromGeneric) fakeSym.instantiatedFrom = prc openScope(c) for s in instantiateGenericParamList(c, prc.ast[genericParamsPos], pt): @@ -393,7 +394,7 @@ proc generateInstance(c: PContext, fn: PSym, pt: LayeredIdTable, let oldScope = c.currentScope while not isTopLevel(c): c.currentScope = c.currentScope.parent result = copySym(fn, c.idgen) - incl(result.flags, sfFromGeneric) + incl(result, sfFromGeneric) result.instantiatedFrom = fn if sfGlobal in result.flags and c.config.symbolFiles != disabledSf: let passc = getLocalPassC(c, producer) @@ -438,7 +439,7 @@ proc generateInstance(c: PContext, fn: PSym, pt: LayeredIdTable, inc i #echo "INSTAN ", fn.name.s, " ", typeToString(result.typ), " ", entry.concreteTypes.len if tfTriggersCompileTime in result.typ.flags: - incl(result.flags, sfCompileTime) + incl(result, sfCompileTime) n[genericParamsPos] = c.graph.emptyNode var oldPrc = genericCacheGet(c.graph, fn, entry[], c.compilesContextId) if oldPrc == nil: @@ -450,6 +451,10 @@ proc generateInstance(c: PContext, fn: PSym, pt: LayeredIdTable, entry.compilesId = c.compilesContextId addToGenericProcCache(c, fn, entry) c.generics.add(makeInstPair(fn, entry)) + # Log the generic instance so it gets written to the NIF file. + # This is needed for cyclic module dependencies where generic instances + # may be created in one module but referenced from another. + logGenericInstance(c.graph, result) # bug #12985 bug #22913 # TODO: use the context of the declaration of generic functions instead # TODO: consider fixing options as well diff --git a/compiler/semmacrosanity.nim b/compiler/semmacrosanity.nim index 1675114c2b..12e0271f00 100644 --- a/compiler/semmacrosanity.nim +++ b/compiler/semmacrosanity.nim @@ -93,8 +93,8 @@ proc annotateType*(n: PNode, t: PType; conf: ConfigRef; producedClosure: var boo case n.kind of nkObjConstr: let x = t.skipTypes(abstractPtrs) - n.typ() = t - n[0].typ() = t + n.typ = t + n[0].typ = t for i in 1..= x.kidsLen: globalError conf, n.info, "invalid field at index " & $i else: annotateType(n[i], x[i], conf, producedClosure) elif x.kind == tyProc and x.callConv == ccClosure: - n.typ() = t + n.typ = t if n.len > 1 and n[1].kind notin {nkEmpty, nkNilLit}: producedClosure = true elif x.kind == tyOpenArray: # `opcSlice` transforms slices into tuples @@ -136,18 +136,18 @@ proc annotateType*(n: PNode, t: PType; conf: ConfigRef; producedClosure: var boo globalError(conf, n.info, "Incorrectly generated tuple constr") n[] = bracketExpr[] - n.typ() = t + n.typ = t else: globalError(conf, n.info, "() must have a tuple type") of nkBracket: if x.kind in {tyArray, tySequence, tyOpenArray}: - n.typ() = t + n.typ = t for m in n: annotateType(m, x.elemType, conf, producedClosure) else: globalError(conf, n.info, "[] must have some form of array type") of nkCurly: if x.kind in {tySet}: - n.typ() = t + n.typ = t for m in n: if m.kind == nkRange: annotateType(m[0], x.elemType, conf, producedClosure) @@ -158,22 +158,22 @@ proc annotateType*(n: PNode, t: PType; conf: ConfigRef; producedClosure: var boo globalError(conf, n.info, "{} must have the set type") of nkFloatLit..nkFloat128Lit: if x.kind in {tyFloat..tyFloat128}: - n.typ() = t + n.typ = t else: globalError(conf, n.info, "float literal must have some float type") of nkCharLit..nkUInt64Lit: if x.kind in {tyInt..tyUInt64, tyBool, tyChar, tyEnum}: - n.typ() = t + n.typ = t else: globalError(conf, n.info, "integer literal must have some int type") of nkStrLit..nkTripleStrLit: if x.kind in {tyString, tyCstring}: - n.typ() = t + n.typ = t else: globalError(conf, n.info, "string literal must be of some string type") of nkNilLit: if x.kind in NilableTypes+{tyString, tySequence}: - n.typ() = t + n.typ = t else: globalError(conf, n.info, "nil literal must be of some pointer type") else: discard diff --git a/compiler/semmagic.nim b/compiler/semmagic.nim index 0ad6117813..8a91d820f0 100644 --- a/compiler/semmagic.nim +++ b/compiler/semmagic.nim @@ -18,7 +18,7 @@ proc addDefaultFieldForNew(c: PContext, n: PNode): PNode = let typ = result[1].typ # new(x) if typ.skipTypes({tyGenericInst, tyAlias, tySink}).kind == tyRef and typ.skipTypes({tyGenericInst, tyAlias, tySink})[0].kind == tyObject: var asgnExpr = newTree(nkObjConstr, newNodeIT(nkType, result[1].info, typ)) - asgnExpr.typ() = typ + asgnExpr.typ = typ var t = typ.skipTypes({tyGenericInst, tyAlias, tySink})[0] while true: asgnExpr.sons.add defaultFieldsForTheUninitialized(c, t.n, false) @@ -34,11 +34,11 @@ 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) + x.sym.flagsImpl.incl(sfAddrTaken) if isAssignable(c, x) notin {arLValue, arLocalLValue, arAddressableConst, arLentValue}: localError(c.config, n.info, errExprHasNoAddress) result.add x - result.typ() = makePtrType(c, x.typ.skipTypes({tySink})) + result.typ = makePtrType(c, x.typ.skipTypes({tySink})) proc semTypeOf(c: PContext; n: PNode): PNode = var m = BiggestInt 1 # typeOfIter @@ -54,16 +54,16 @@ proc semTypeOf(c: PContext; n: PNode): PNode = let typExpr = semExprWithType(c, n[1], if m == 1: {efInTypeof} else: {}) result.add typExpr if typExpr.typ.kind == tyFromExpr: - typExpr.typ.flags.incl tfNonConstExpr + typExpr.typ.incl tfNonConstExpr var t = typExpr.typ if t.kind == tyStatic: let base = t.skipTypes({tyStatic}) if c.inGenericContext > 0 and base.containsGenericType: t = makeTypeFromExpr(c, copyTree(typExpr)) - t.flags.incl tfNonConstExpr + t.incl tfNonConstExpr else: t = base - result.typ() = makeTypeDesc(c, t) + result.typ = makeTypeDesc(c, t) type SemAsgnMode = enum asgnNormal, noOverloadedSubscript, noOverloadedAsgn @@ -84,8 +84,8 @@ proc semArrGet(c: PContext; n: PNode; flags: TExprFlags): PNode = 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 + result.typ = makeTypeFromExpr(c, copyTree(result)) + result.typ.incl tfNonConstExpr return let s = # extract sym from first arg if n.len > 1: @@ -208,15 +208,15 @@ proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym) let preferStr = traitCall[2].strVal prefer = parseEnum[TPreferedDesc](preferStr) result = newStrNode(nkStrLit, operand.typeToString(prefer)) - result.typ() = getSysType(c.graph, traitCall[1].info, tyString) + result.typ = getSysType(c.graph, traitCall[1].info, tyString) result.info = traitCall.info of "name", "$": result = newStrNode(nkStrLit, operand.typeToString(preferTypeName)) - result.typ() = getSysType(c.graph, traitCall[1].info, tyString) + result.typ = getSysType(c.graph, traitCall[1].info, tyString) result.info = traitCall.info of "arity": result = newIntNode(nkIntLit, operand.len - ord(operand.kind==tyProc)) - result.typ() = newType(tyInt, c.idgen, context) + result.typ = newType(tyInt, c.idgen, context) result.info = traitCall.info of "genericHead": var arg = operand @@ -243,7 +243,7 @@ proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym) let cond = operand.kind == tyTuple and operand.n != nil result = newIntNodeT(toInt128(ord(cond)), traitCall, c.idgen, c.graph) of "tupleLen": - var operand = operand.skipTypes({tyGenericInst}) + var operand = operand.skipTypes({tyGenericInst, tyAlias}) assert operand.kind == tyTuple, $operand.kind result = newIntNodeT(toInt128(operand.len), traitCall, c.idgen, c.graph) of "distinctBase": @@ -286,7 +286,7 @@ proc semOrd(c: PContext, n: PNode): PNode = discard else: localError(c.config, n.info, errOrdinalTypeExpected % typeToString(parType, preferDesc)) - result.typ() = errorType(c) + result.typ = errorType(c) proc semBindSym(c: PContext, n: PNode): PNode = result = copyNode(n) @@ -402,7 +402,7 @@ proc semOf(c: PContext, n: PNode): PNode = message(c.config, n.info, hintConditionAlwaysTrue, renderTree(n)) result = newIntNode(nkIntLit, 1) result.info = n.info - result.typ() = getSysType(c.graph, n.info, tyBool) + result.typ = getSysType(c.graph, n.info, tyBool) return result elif diff == high(int): if commonSuperclass(a, b) == nil: @@ -411,10 +411,10 @@ proc semOf(c: PContext, n: PNode): PNode = message(c.config, n.info, hintConditionAlwaysFalse, renderTree(n)) result = newIntNode(nkIntLit, 0) result.info = n.info - result.typ() = getSysType(c.graph, n.info, tyBool) + result.typ = getSysType(c.graph, n.info, tyBool) else: localError(c.config, n.info, "'of' takes 2 arguments") - n.typ() = getSysType(c.graph, n.info, tyBool) + n.typ = getSysType(c.graph, n.info, tyBool) result = n proc semUnown(c: PContext; n: PNode): PNode = @@ -442,16 +442,16 @@ proc semUnown(c: PContext; n: PNode): PNode = copyTypeProps(c.graph, c.idgen.module, result, t) result[^1] = b - result.flags.excl tfHasOwned + result.excl tfHasOwned else: result = t else: result = t result = copyTree(n[1]) - result.typ() = unownedType(c, result.typ) + result.typ = unownedType(c, result.typ) # little hack for injectdestructors.nim (see bug #11350): - #result[0].typ() = nil + #result[0].typ = nil proc turnFinalizerIntoDestructor(c: PContext; orig: PSym; info: TLineInfo): PSym = # We need to do 2 things: Replace n.typ which is a 'ref T' by a 'var T' type. @@ -461,7 +461,7 @@ proc turnFinalizerIntoDestructor(c: PContext; orig: PSym; info: TLineInfo): PSym proc transform(c: PContext; n: PNode; old, fresh: PType; oldParam, newParam: PSym): PNode = result = shallowCopy(n) if sameTypeOrNil(n.typ, old): - result.typ() = fresh + result.typ = fresh if n.kind == nkSym and n.sym == oldParam: result.sym = newParam for i in 0 ..< safeLen(n): @@ -471,7 +471,7 @@ proc turnFinalizerIntoDestructor(c: PContext; orig: PSym; info: TLineInfo): PSym result = copySym(orig, c.idgen) result.info = info - result.flags.incl sfFromGeneric + result.incl sfFromGeneric setOwner(result, orig) let origParamType = orig.typ.firstParamType let newParamType = makeVarType(result, origParamType.skipTypes(abstractPtrs), c.idgen) @@ -550,8 +550,8 @@ proc semNewFinalize(c: PContext; n: PNode): PNode = else: 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.firstParamType - wrapperSym.flags.incl sfUsed + selfSymNode.typ = fin.typ.firstParamType + wrapperSym.flagsImpl.incl sfUsed let wrapper = c.semExpr(c, newProcNode(nkProcDef, fin.info, body = newTree(nkCall, newSymNode(fin), selfSymNode), params = nkFormalParams.newTree(c.graph.emptyNode, @@ -568,7 +568,7 @@ proc semNewFinalize(c: PContext; n: PNode): PNode = let selfSymbolType = makePtrType(c, origParamType.skipTypes(abstractPtrs)) let selfPtr = newNodeI(nkHiddenAddr, transFormedSym.ast[bodyPos][1].info) selfPtr.add transFormedSym.ast[bodyPos][1] - selfPtr.typ() = selfSymbolType + selfPtr.typ = selfSymbolType transFormedSym.ast[bodyPos][1] = c.semExpr(c, selfPtr) bindTypeHook(c, transFormedSym, n, attachedDestructor) result = addDefaultFieldForNew(c, n) @@ -623,7 +623,7 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, of mTypeTrait: result = semTypeTraits(c, n) of mAstToStr: result = newStrNodeT(renderTree(n[1], {renderNoComments}), n, c.graph) - result.typ() = getSysType(c.graph, n.info, tyString) + result.typ = getSysType(c.graph, n.info, tyString) of mInstantiationInfo: result = semInstantiationInfo(c, n) of mOrd: result = semOrd(c, n) of mOf: result = semOf(c, n) @@ -636,7 +636,7 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, result = semDynamicBindSym(c, n) of mProcCall: result = n - result.typ() = n[1].typ + result.typ = n[1].typ of mDotDot: result = n of mPlugin: @@ -692,7 +692,7 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, result = n 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 + result.typ = expectedType # type inference for empty sequence # bug #21377 of mEnsureMove: result = n if n[1].kind in {nkStmtListExpr, nkBlockExpr, diff --git a/compiler/semobjconstr.nim b/compiler/semobjconstr.nim index 36a7cc5584..d9317c3320 100644 --- a/compiler/semobjconstr.nim +++ b/compiler/semobjconstr.nim @@ -192,7 +192,7 @@ proc collectOrAddMissingCaseFields(c: PContext, branchNode: PNode, newNodeIT(nkType, constrCtx.initExpr.info, asgnType) ) asgnExpr.flags.incl nfSkipFieldChecking - asgnExpr.typ() = recTyp + asgnExpr.typ = recTyp defaults.add newTree(nkExprColonExpr, newSymNode(sym), asgnExpr) proc collectBranchFields(c: PContext, n: PNode, discriminatorVal: PNode, @@ -482,10 +482,10 @@ proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType if t.kind == tyRef: t = skipTypes(t.elementType, {tyGenericInst, tyAlias, tySink, tyOwned}) if optOwnedRefs in c.config.globalOptions: - result.typ() = makeVarType(c, result.typ, tyOwned) + result.typ = makeVarType(c, result.typ, tyOwned) # we have to watch out, there are also 'owned proc' types that can be used # multiple times as long as they don't have closures. - result.typ.flags.incl tfHasOwned + result.typ.incl tfHasOwned if t.kind != tyObject: return localErrorNode(c, result, if t.kind != tyGenericBody: "object constructor needs an object type".dup(addTypeNodeDeclaredLoc(c.config, t)) diff --git a/compiler/semparallel.nim b/compiler/semparallel.nim index b0071979bc..a91a212331 100644 --- a/compiler/semparallel.nim +++ b/compiler/semparallel.nim @@ -407,9 +407,9 @@ proc transformSlices(g: ModuleGraph; idgen: IdGenerator; n: PNode): PNode = result = copyNode(n) var typ = newType(tyOpenArray, idgen, result.typ.owner) typ.add result.typ.elementType - result.typ() = typ + result.typ = typ let opSlice = newSymNode(createMagic(g, idgen, "slice", mSlice)) - opSlice.typ() = getSysType(g, n.info, tyInt) + opSlice.typ = getSysType(g, n.info, tyInt) result.add opSlice result.add n[1] let slice = n[2].skipStmtList @@ -491,7 +491,7 @@ proc liftParallel*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n: PNode): P var varSection = newNodeI(nkVarSection, n.info) var temp = newSym(skTemp, getIdent(g.cache, "barrier"), idgen, owner, n.info) temp.typ = magicsys.getCompilerProc(g, "Barrier").typ - incl(temp.flags, sfFromGeneric) + incl(temp.flagsImpl, sfFromGeneric) let tempNode = newSymNode(temp) varSection.addVar tempNode diff --git a/compiler/sempass2.nim b/compiler/sempass2.nim index aa3e865ffd..88106b635f 100644 --- a/compiler/sempass2.nim +++ b/compiler/sempass2.nim @@ -11,7 +11,7 @@ import ast, astalgo, msgs, renderer, magicsys, types, idents, trees, wordrecg, options, guards, lineinfos, semfold, semdata, modulegraphs, varpartitions, typeallowed, nilcheck, errorhandling, - semstrictfuncs, suggestsymdb, pushpoppragmas, lowerings + semstrictfuncs, suggestsymdb, pushpoppragmas import std/[tables, intsets, strutils, sequtils] @@ -141,7 +141,7 @@ proc createTypeBoundOps(tracked: PEffects, typ: PType; info: TLineInfo; explicit if tracked.config.selectedGC == gcRefc or optSeqDestructors in tracked.config.globalOptions or tfHasAsgn in typ.flags: - tracked.owner.flags.incl sfInjectDestructors + tracked.owner.incl sfInjectDestructors proc isLocalSym(a: PEffects, s: PSym): bool = s.typ != nil and (s.kind in {skLet, skVar, skResult} or (s.kind == skParam and isOutParam(s.typ))) and @@ -196,7 +196,7 @@ proc guardDotAccess(a: PEffects; n: PNode) = let dot = newNodeI(nkDotExpr, n.info, 2) dot[0] = n[0] dot[1] = newSymNode(g) - dot.typ() = g.typ + dot.typ = g.typ for L in a.locked: #if a.guards.sameSubexprs(dot, L): return if guards.sameTree(dot, L): return @@ -206,7 +206,7 @@ proc guardDotAccess(a: PEffects; n: PNode) = proc makeVolatile(a: PEffects; s: PSym) {.inline.} = if a.inTryStmt > 0 and a.config.exc == excSetjmp: - incl(s.flags, sfVolatile) + incl(s, sfVolatile) proc varDecl(a: PEffects; n: PNode) {.inline.} = if n.kind == nkSym: @@ -372,9 +372,9 @@ proc useVarNoInitCheck(a: PEffects; n: PNode; s: PSym) = proc useVar(a: PEffects, n: PNode) = let s = n.sym - if a.inExceptOrFinallyStmt > 0: - incl s.flags, sfUsedInFinallyOrExcept if isLocalSym(a, s): + if a.inExceptOrFinallyStmt > 0: + incl s, sfUsedInFinallyOrExcept if sfNoInit in s.flags: # If the variable is explicitly marked as .noinit. do not emit any error a.init.add s.id @@ -417,7 +417,7 @@ proc throws(tracked, n, orig: PNode) = if n.typ == nil or n.typ.kind != tyError: if orig != nil: let x = copyTree(orig) - x.typ() = n.typ + x.typ = n.typ tracked.add x else: tracked.add n @@ -432,12 +432,12 @@ proc excType(g: ModuleGraph; n: PNode): PType = proc createRaise(g: ModuleGraph; n: PNode): PNode = result = newNode(nkType) - result.typ() = getEbase(g, n.info) + result.typ = getEbase(g, n.info) if not n.isNil: result.info = n.info proc createTag(g: ModuleGraph; n: PNode): PNode = result = newNode(nkType) - result.typ() = g.sysTypeFromName(n.info, "RootEffect") + result.typ = g.sysTypeFromName(n.info, "RootEffect") if not n.isNil: result.info = n.info proc addRaiseEffect(a: PEffects, e, comesFrom: PNode) = @@ -1243,9 +1243,9 @@ proc track(tracked: PEffects, n: PNode) = of nkSym: useVar(tracked, n) if n.sym.typ != nil and tfHasAsgn in n.sym.typ.flags: - tracked.owner.flags.incl sfInjectDestructors + tracked.owner.incl sfInjectDestructors # bug #15038: ensure consistency - if n.typ == nil or (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) and n.typ.kind notin {tyVar, tyLent}: @@ -1627,7 +1627,7 @@ proc setEffectsForProcType*(g: ModuleGraph; t: PType, n: PNode; s: PSym = nil) = effects[pragmasEffects] = n if s != nil and s.magic != mNone: if s.magic != mEcho: - t.flags.incl tfNoSideEffect + t.incl tfNoSideEffect proc rawInitEffects(g: ModuleGraph; effects: PNode) = newSeq(effects.sons, effectListLen) @@ -1682,7 +1682,7 @@ proc trackProc*(c: PContext; s: PSym, body: PNode) = t.scopes[res.id] = t.currentBlock if sfNoInit in s.flags: # marks result "noinit" - incl res.flags, sfNoInit + incl res, sfNoInit track(t, body) @@ -1769,9 +1769,9 @@ proc trackProc*(c: PContext; s: PSym, body: PNode) = else: localError(g.config, s.info, "") # simple error for `system.compiles` context if not t.gcUnsafe: - s.typ.flags.incl tfGcSafe + s.typ.incl tfGcSafe if not t.hasSideEffect and sfSideEffect notin s.flags: - s.typ.flags.incl tfNoSideEffect + s.typ.incl tfNoSideEffect when defined(drnim): if c.graph.strongSemCheck != nil: c.graph.strongSemCheck(c.graph, s, body) when defined(useDfa): diff --git a/compiler/semstmts.nim b/compiler/semstmts.nim index ae4c744ead..be9e409108 100644 --- a/compiler/semstmts.nim +++ b/compiler/semstmts.nim @@ -79,7 +79,7 @@ proc semBreakOrContinue(c: PContext, n: PNode): PNode = if s.kind == skLabel and s.owner.id == c.p.owner.id: var x = newSymNode(s) x.info = n.info - incl(s.flags, sfUsed) + incl(s.flagsImpl, sfUsed) n[0] = x suggestSym(c.graph, x.info, s, c.graph.usageSym) onUse(x.info, s) @@ -112,11 +112,11 @@ proc semWhile(c: PContext, n: PNode; flags: TExprFlags): PNode = dec(c.p.nestedLoopCounter) closeScope(c) if n[1].typ == c.enforceVoidContext: - result.typ() = c.enforceVoidContext + result.typ = c.enforceVoidContext elif efInTypeof in flags: - result.typ() = n[1].typ + result.typ = n[1].typ elif implicitlyDiscardable(n[1]): - result[1].typ() = c.enforceVoidContext + result[1].typ = c.enforceVoidContext proc semProc(c: PContext, n: PNode): PNode @@ -275,7 +275,7 @@ proc fixNilType(c: PContext; n: PNode) = elif n.kind in {nkStmtList, nkStmtListExpr}: n.transitionSonsKind(nkStmtList) for it in n: fixNilType(c, it) - n.typ() = nil + n.typ = nil proc discardCheck(c: PContext, result: PNode, flags: TExprFlags) = if c.matchedConcept != nil or efInTypeof in flags: return @@ -331,14 +331,14 @@ proc semIf(c: PContext, n: PNode; flags: TExprFlags; expectedType: PType = nil): for it in n: discardCheck(c, it.lastSon, flags) result.transitionSonsKind(nkIfStmt) # propagate any enforced VoidContext: - if typ == c.enforceVoidContext: result.typ() = c.enforceVoidContext + if typ == c.enforceVoidContext: result.typ = c.enforceVoidContext else: for it in n: let j = it.len-1 if not endsInNoReturn(it[j]): it[j] = fitNode(c, typ, it[j], it[j].info) result.transitionSonsKind(nkIfExpr) - result.typ() = typ + result.typ = typ proc semTry(c: PContext, n: PNode; flags: TExprFlags; expectedType: PType = nil): PNode = var check = initIntSet() @@ -394,8 +394,9 @@ proc semTry(c: PContext, n: PNode; flags: TExprFlags; expectedType: PType = nil) elif a.len == 1: # count number of ``except: body`` blocks inc catchAllExcepts - message(c.config, a.info, warnBareExcept, - "The bare except clause is deprecated; use `except CatchableError:` instead") + if noPanicOnExcept in c.graph.config.legacyFeatures: + message(c.config, a.info, warnBareExcept, + "The bare except clause is deprecated; use `except CatchableError:` instead") else: # support ``except KeyError, ValueError, ... : body`` if catchAllExcepts > 0: @@ -438,7 +439,7 @@ proc semTry(c: PContext, n: PNode; flags: TExprFlags; expectedType: PType = nil) discardCheck(c, n[0], flags) for i in 1.. 0: v.flags.incl(sfShadowed) + if c.inUnrolledContext > 0: v.incl(sfShadowed) else: let shadowed = findShadowedVar(c, v) if shadowed != nil: - shadowed.flags.incl(sfShadowed) + shadowed.incl(sfShadowed) if shadowed.kind == skResult and sfGenSym notin v.flags: message(c.config, a.info, warnResultShadowed) if def.kind != nkEmpty: @@ -1113,13 +1114,13 @@ proc semForVars(c: PContext, n: PNode; flags: TExprFlags): PNode = for i in 0.. resultPos and n[resultPos] != nil: @@ -2058,7 +2059,7 @@ proc semInferredLambda(c: PContext, pt: LayeredIdTable, n: PNode): PNode = popOwner(c) closeScope(c) if optOwnedRefs in c.config.globalOptions and result.typ != nil: - result.typ() = makeVarType(c, result.typ, tyOwned) + result.typ = makeVarType(c, result.typ, tyOwned) # alternative variant (not quite working): # var prc = arg[0].sym # let inferred = c.semGenerateInstance(c, prc, m.bindings, arg.info) @@ -2129,7 +2130,7 @@ proc bindDupHook(c: PContext; s: PSym; n: PNode; op: TTypeAttachedOp) = if cond: var obj = t.firstParamType while true: - incl(obj.flags, tfHasAsgn) + incl(obj, tfHasAsgn) if obj.kind in {tyGenericBody, tyGenericInst}: obj = obj.skipModifier elif obj.kind == tyGenericInvocation: obj = obj.genericHead else: break @@ -2158,8 +2159,8 @@ proc bindDupHook(c: PContext; s: PSym; n: PNode; op: TTypeAttachedOp) = localError(c.config, n.info, errGenerated, "signature for '=dup' must be proc[T: object](x: T): T") - incl(s.flags, sfUsed) - incl(s.flags, sfOverridden) + incl(s.flagsImpl, sfUsed) + incl(s, sfOverridden) proc bindTypeHook(c: PContext; s: PSym; n: PNode; op: TTypeAttachedOp) = let t = s.typ @@ -2184,7 +2185,7 @@ proc bindTypeHook(c: PContext; s: PSym; n: PNode; op: TTypeAttachedOp) = if cond: var obj = t.firstParamType.skipTypes({tyVar}) while true: - incl(obj.flags, tfHasAsgn) + incl(obj, tfHasAsgn) if obj.kind in {tyGenericBody, tyGenericInst}: obj = obj.skipModifier elif obj.kind == tyGenericInvocation: obj = obj.genericHead else: break @@ -2216,8 +2217,8 @@ proc bindTypeHook(c: PContext; s: PSym; n: PNode; op: TTypeAttachedOp) = else: localError(c.config, n.info, errGenerated, "signature for '" & s.name.s & "' must be proc[T: object](x: var T)") - incl(s.flags, sfUsed) - incl(s.flags, sfOverridden) + incl(s.flagsImpl, sfUsed) + incl(s, sfOverridden) proc semOverride(c: PContext, s: PSym, n: PNode) = let name = s.name.s.normalize @@ -2257,19 +2258,19 @@ proc semOverride(c: PContext, s: PSym, n: PNode) = else: localError(c.config, n.info, errGenerated, "signature for 'deepCopy' must be proc[T: ptr|ref](x: T): T") - incl(s.flags, sfUsed) - incl(s.flags, sfOverridden) + incl(s.flagsImpl, sfUsed) + incl(s, sfOverridden) of "=", "=copy", "=sink": if s.magic == mAsgn: return - incl(s.flags, sfUsed) - incl(s.flags, sfOverridden) + incl(s.flagsImpl, sfUsed) + incl(s, sfOverridden) 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.returnType == nil and t.firstParamType.kind == tyVar: var obj = t.firstParamType.elementType while true: - incl(obj.flags, tfHasAsgn) + incl(obj, tfHasAsgn) if obj.kind == tyGenericBody: obj = obj.skipModifier elif obj.kind == tyGenericInvocation: obj = obj.genericHead else: break @@ -2360,7 +2361,7 @@ proc semCppMember(c: PContext; s: PSym; n: PNode) = 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: + if sameOwners(typ.owner, s.owner) and sameOwners(c.module, s.owner): c.graph.memberProcsPerType.mgetOrPut(typ.itemId, @[]).add s else: localError(c.config, n.info, @@ -2428,8 +2429,8 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, case n[namePos].kind of nkEmpty: s = newSym(kind, c.cache.idAnon, c.idgen, c.getCurrOwner, n.info) - s.flags.incl sfUsed - s.flags.incl sfGenSym + s.flagsImpl.incl sfUsed + s.incl sfGenSym n[namePos] = newSymNode(s) of nkSym: s = n[namePos].sym @@ -2455,7 +2456,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, #s.scope = c.currentScope if s.kind in {skMacro, skTemplate}: # push noalias flag at first to prevent unwanted recursive calls: - incl(s.flags, sfNoalias) + incl(s, sfNoalias) # before compiling the proc params & body, set as current the scope # where the proc was declared @@ -2493,14 +2494,14 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, n[genericParamsPos] = n[miscPos][1] n[miscPos] = c.graph.emptyNode - if tfTriggersCompileTime in s.typ.flags: incl(s.flags, sfCompileTime) + if tfTriggersCompileTime in s.typ.flags: incl(s, sfCompileTime) if n[patternPos].kind != nkEmpty: n[patternPos] = semPattern(c, n[patternPos], s) if s.kind == skIterator: - s.typ.flags.incl(tfIterator) + s.typ.incl(tfIterator) elif s.kind == skFunc: - incl(s.flags, sfNoSideEffect) - incl(s.typ.flags, tfNoSideEffect) + incl(s, sfNoSideEffect) + incl(s.typ, tfNoSideEffect) var (proto, comesFromShadowScope) = if isAnon: (nil, false) @@ -2546,7 +2547,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if n[pragmasPos].kind != nkEmpty and sfBorrow notin s.flags: setEffectsForProcType(c.graph, s.typ, n[pragmasPos], s) - s.typ.flags.incl tfEffectSystemWorkaround + s.typ.incl tfEffectSystemWorkaround # To ease macro generation that produce forwarded .async procs we now # allow a bit redundancy in the pragma declarations. The rule is @@ -2573,8 +2574,8 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if sfForward notin proto.flags and proto.magic == mNone: wrongRedefinition(c, n.info, proto.name.s, proto.info) if not comesFromShadowScope: - excl(proto.flags, sfForward) - incl(proto.flags, sfWasForwarded) + excl(proto, sfForward) + incl(proto, sfWasForwarded) suggestSym(c.graph, s.info, proto, c.graph.usageSym) closeScope(c) # close scope with wrong parameter symbols openScope(c) # open scope for old (correct) parameter symbols @@ -2655,7 +2656,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, # we need to add a result symbol for them maybeAddResult(c, s, n) - + trackProc(c, s, s.ast[bodyPos]) else: if (s.typ.returnType != nil and s.kind != skIterator): @@ -2676,8 +2677,8 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, 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) - incl(s.flags, sfWasForwarded) + incl(s, sfForward) + incl(s, sfWasForwarded) elif sfBorrow in s.flags: semBorrow(c, n, s) sideEffectsCheck(c, s) @@ -2688,9 +2689,9 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, c.patterns.add(s) if isAnon: n.transitionSonsKind(nkLambda) - result.typ() = s.typ + result.typ = s.typ if optOwnedRefs in c.config.globalOptions: - result.typ() = makeVarType(c, result.typ, tyOwned) + result.typ = makeVarType(c, result.typ, tyOwned) elif isTopLevel(c) and s.kind != skIterator and s.typ.callConv == ccClosure: localError(c.config, s.info, "'.closure' calling convention for top level routines is invalid") @@ -2724,13 +2725,13 @@ proc semIterator(c: PContext, n: PNode): PNode = # we require first class iterators to be marked with 'closure' explicitly # -- at least for 0.9.2. if s.typ.callConv == ccClosure: - incl(s.typ.flags, tfCapturesEnv) + incl(s.typ, tfCapturesEnv) else: s.typ.callConv = ccInline if result[bodyPos].kind == nkEmpty and s.magic == mNone and c.inConceptDecl == 0: localError(c.config, n.info, errImplOfXexpected % s.name.s) if optOwnedRefs in c.config.globalOptions and result.typ != nil: - result.typ() = makeVarType(c, result.typ, tyOwned) + result.typ = makeVarType(c, result.typ, tyOwned) result.typ.callConv = ccClosure proc semProc(c: PContext, n: PNode): PNode = @@ -2794,14 +2795,14 @@ proc semMacroDef(c: PContext, n: PNode): PNode = if param.typ.kind != tyUntyped: allUntyped = false # no default value, parameters required in call if param.ast == nil: nullary = false - if allUntyped: incl(s.flags, sfAllUntyped) + if allUntyped: incl(s, sfAllUntyped) if nullary and n[genericParamsPos].kind == nkEmpty: # macro can be called with alias syntax, remove pushed noalias flag - excl(s.flags, sfNoalias) + excl(s, sfNoalias) if n[bodyPos].kind == nkEmpty: localError(c.config, n.info, errImplOfXexpected % s.name.s) -proc incMod(c: PContext, n: PNode, it: PNode, includeStmtResult: PNode) = +proc incMod(c: PContext, n: PNode, it: PNode, includeStmtResult, resolvedIncStmt: PNode) = var f = checkModuleName(c.config, it) if f != InvalidFileIdx: addIncludeFileDep(c, f) @@ -2809,12 +2810,22 @@ proc incMod(c: PContext, n: PNode, it: PNode, includeStmtResult: PNode) = if containsOrIncl(c.includedFiles, f.int): localError(c.config, n.info, errRecursiveDependencyX % toMsgFilename(c.config, f)) else: + if resolvedIncStmt != nil: + resolvedIncStmt.add newStrNode(toFullPath(c.config, f), it.info) includeStmtResult.add semStmt(c, c.graph.includeFileCallback(c.graph, c.module, f), {}) excl(c.includedFiles, f.int) proc evalInclude(c: PContext, n: PNode): PNode = result = newNodeI(nkStmtList, n.info) - result.add n + var resolvedIncStmt: PNode = nil + if optCompress in c.config.globalOptions: + # New resolve the include filenames to string literals that contain absolute paths, + # nicer for IC: + resolvedIncStmt = newNodeI(nkIncludeStmt, n.info) + result.add resolvedIncStmt + else: + # Legacy: Keep `include` statement as is: + result.add n template checkAs(it: PNode) = if it.kind == nkInfix and it.len == 3: let op = it[0].getPIdent @@ -2832,9 +2843,9 @@ proc evalInclude(c: PContext, n: PNode): PNode = for x in it[lastPos]: checkAs(x) imp[lastPos] = x - incMod(c, n, imp, result) + incMod(c, n, imp, result, resolvedIncStmt) else: - incMod(c, n, it, result) + incMod(c, n, it, result, resolvedIncStmt) proc recursiveSetFlag(n: PNode, flag: TNodeFlag) = if n != nil: @@ -2876,7 +2887,7 @@ proc semPragmaBlock(c: PContext, n: PNode; expectedType: PType = nil): PNode = n[1] = semExpr(c, n[1], expectedType = expectedType) dec c.inUncheckedAssignSection, inUncheckedAssignSection result = n - result.typ() = n[1].typ + result.typ = n[1].typ for i in 0.. 0: # from templates diff --git a/compiler/semtempl.nim b/compiler/semtempl.nim index c424b801f5..7335ff0dc3 100644 --- a/compiler/semtempl.nim +++ b/compiler/semtempl.nim @@ -68,7 +68,7 @@ proc symChoice(c: PContext, n: PNode, s: PSym, r: TSymChoiceRule; if not isField or sfGenSym notin s.flags: result = newSymNode(s, info) # possibly not final field sym - incl(s.flags, sfUsed) + incl(s.flagsImpl, sfUsed) markOwnerModuleAsUsed(c, s) onUse(info, s) else: @@ -85,7 +85,7 @@ proc symChoice(c: PContext, n: PNode, s: PSym, r: TSymChoiceRule; a = initOverloadIter(o, c, n) while a != nil: if a.kind != skModule and (not isField or sfGenSym notin a.flags): - incl(a.flags, sfUsed) + incl(a.flagsImpl, sfUsed) markOwnerModuleAsUsed(c, a) result.add newSymNode(a, info) onUse(info, a) @@ -180,8 +180,7 @@ proc semTemplBodyScope(c: var TemplCtx, n: PNode): PNode = proc newGenSym(kind: TSymKind, n: PNode, c: var TemplCtx): PSym = result = newSym(kind, considerQuotedIdent(c.c, n), c.c.idgen, c.owner, n.info) - incl(result.flags, sfGenSym) - incl(result.flags, sfShadowed) + incl(result.flagsImpl, {sfGenSym, sfShadowed}) proc addLocalDecl(c: var TemplCtx, n: var PNode, k: TSymKind) = # locals default to 'gensym', fields default to 'inject': @@ -218,10 +217,10 @@ proc addLocalDecl(c: var TemplCtx, n: var PNode, k: TSymKind) = onDef(n.info, local) replaceIdentBySym(c.c, n, newSymNode(local, n.info)) if k == skParam and c.inTemplateHeader > 0: - local.flags.incl sfTemplateParam + local.incl sfTemplateParam proc semTemplSymbol(c: var TemplCtx, n: PNode, s: PSym; isField, isAmbiguous: bool): PNode = - incl(s.flags, sfUsed) + incl(s.flagsImpl, 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: @@ -239,10 +238,10 @@ proc semTemplSymbol(c: var TemplCtx, n: PNode, s: PSym; isField, isAmbiguous: bo if result.kind == nkSym: result = newOpenSym(result) else: - result.typ() = nil + result.typ = nil else: result.flags.incl nfDisabledOpenSym - result.typ() = nil + result.typ = nil of skGenericParam: if isField and sfGenSym in s.flags: result = n else: @@ -252,7 +251,7 @@ proc semTemplSymbol(c: var TemplCtx, n: PNode, s: PSym; isField, isAmbiguous: bo result = newOpenSym(result) else: result.flags.incl nfDisabledOpenSym - result.typ() = nil + result.typ = nil of skParam: result = n of skType: @@ -270,10 +269,10 @@ proc semTemplSymbol(c: var TemplCtx, n: PNode, s: PSym; isField, isAmbiguous: bo if result.kind == nkSym: result = newOpenSym(result) else: - result.typ() = nil + result.typ = nil else: result.flags.incl nfDisabledOpenSym - result.typ() = nil + result.typ = nil else: if isField and sfGenSym in s.flags: result = n else: @@ -283,7 +282,7 @@ proc semTemplSymbol(c: var TemplCtx, n: PNode, s: PSym; isField, isAmbiguous: bo result = newOpenSym(result) else: result.flags.incl nfDisabledOpenSym - result.typ() = nil + result.typ = nil # Issue #12832 when defined(nimsuggest): suggestSym(c.c.graph, n.info, s, c.c.graph.usageSym, false) @@ -298,7 +297,7 @@ proc semRoutineInTemplName(c: var TemplCtx, n: PNode, explicitInject: bool): PNo if s != nil: if s.owner == c.owner and (s.kind == skParam or (sfGenSym in s.flags and not explicitInject)): - incl(s.flags, sfUsed) + incl(s.flagsImpl, sfUsed) result = newSymNode(s, n.info) onUse(n.info, s) else: @@ -384,7 +383,7 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = let s = qualifiedLookUp(c.c, n, {}) if s != nil: if s.owner == c.owner and s.kind == skParam and sfTemplateParam in s.flags: - incl(s.flags, sfUsed) + incl(s.flagsImpl, sfUsed) result = newSymNode(s, n.info) onUse(n.info, s) elif contains(c.toBind, s.id): @@ -394,7 +393,7 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = elif s.owner == c.owner and sfGenSym in s.flags and c.noGenSym == 0: # template tmp[T](x: var seq[T]) = # var yz: T - incl(s.flags, sfUsed) + incl(s.flagsImpl, sfUsed) result = newSymNode(s, n.info) onUse(n.info, s) else: @@ -545,7 +544,7 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = let x = n[i] let prag = whichPragma(x) if prag == wInvalid: - # only sem if not a language-level pragma + # only sem if not a language-level pragma result[i] = semTemplBody(c, x) elif x.kind in nkPragmaCallKinds: # is pragma, but value still needs to be checked @@ -608,7 +607,7 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = # do not symchoice a quoted template parameter (bug #2390): if s.owner == c.owner and s.kind == skParam and n.kind == nkAccQuoted and n.len == 1: - incl(s.flags, sfUsed) + incl(s.flagsImpl, sfUsed) onUse(n.info, s) return newSymNode(s, n.info) elif contains(c.toBind, s.id): @@ -688,7 +687,7 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = var s: PSym if isTopLevel(c): s = semIdentVis(c, skTemplate, n[namePos], {sfExported}) - incl(s.flags, sfGlobal) + incl(s, sfGlobal) else: s = semIdentVis(c, skTemplate, n[namePos], {}) assert s.kind == skTemplate @@ -701,7 +700,7 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = # check parameter list: #s.scope = c.currentScope # push noalias flag at first to prevent unwanted recursive calls: - incl(s.flags, sfNoalias) + incl(s, sfNoalias) pushOwner(c, s) openScope(c) n[namePos] = newSymNode(s) @@ -724,8 +723,8 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = for i in 1.. 0: - incl(result.flags, tfRequiresInit) + incl(result, tfRequiresInit) elif n[1].kind in {nkCharLit..nkUInt64Lit} and n[1].intVal < 0: - incl(result.flags, tfRequiresInit) + incl(result, tfRequiresInit) elif n[0].kind in {nkFloatLit..nkFloat64Lit} and n[0].floatVal > 0.0: - incl(result.flags, tfRequiresInit) + incl(result, tfRequiresInit) elif n[1].kind in {nkFloatLit..nkFloat64Lit} and n[1].floatVal < 0.0: - incl(result.flags, tfRequiresInit) + incl(result, tfRequiresInit) else: if n[1].kind == nkInfix and considerQuotedIdent(c, n[1][0]).s == "..<": localError(c.config, n[0].info, "range types need to be constructed with '..', '..<' is not supported") @@ -453,10 +453,10 @@ proc semArrayIndex(c: PContext, n: PNode): PType = 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) - if c.inGenericContext > 0: result.flags.incl tfUnresolved + if c.inGenericContext > 0: result.incl tfUnresolved else: result = e.typ.skipTypes({tyTypeDesc}) - result.flags.incl tfImplicitStatic + result.incl tfImplicitStatic elif e.kind in (nkCallKinds + {nkBracketExpr}) and hasUnresolvedArgs(c, e): if not isOrdinalType(e.typ.skipTypes({tyStatic, tyAlias, tyGenericInst, tySink})): localError(c.config, n[1].info, errOrdinalTypeExpected % typeToString(e.typ, preferDesc)) @@ -535,7 +535,7 @@ proc firstRange(config: ConfigRef, t: PType): PNode = result = newFloatNode(nkFloatLit, firstFloat(t)) else: result = newIntNode(nkIntLit, firstOrd(config, t)) - result.typ() = t + result.typ = t proc semTuple(c: PContext, n: PNode, prev: PType): PType = var typ: PType @@ -556,7 +556,7 @@ proc semTuple(c: PContext, n: PNode, prev: PType): PType = typ = a[^1].typ else: fitDefaultNode(c, a[^1], typ) - typ = a[^1].typ + typ = a[^1].typ.skipIntLit(c.idgen) elif a[^2].kind != nkEmpty: typ = semTypeNode(c, a[^2], nil) if c.graph.config.isDefined("nimPreviewRangeDefault") and typ.skipTypes(abstractInst).kind == tyRange: @@ -595,7 +595,7 @@ proc semIdentVis(c: PContext, kind: TSymKind, n: PNode, result = newSymG(kind, n[1], c) var v = considerQuotedIdent(c, n[0]) if sfExported in allowed and v.id == ord(wStar): - incl(result.flags, sfExported) + incl(result, sfExported) else: if not (sfExported in allowed): localError(c.config, n[0].info, errXOnlyAtModuleScope % "export") @@ -805,7 +805,7 @@ proc semRecordCase(c: PContext, n: PNode, check: var IntSet, pos: var int, if a[0].kind != nkSym: internalError(c.config, "semRecordCase: discriminant is no symbol") return - incl(a[0].sym.flags, sfDiscriminant) + incl(a[0].sym, sfDiscriminant) var covered = toInt128(0) var chckCovered = false var typ = skipTypes(a[0].typ, abstractVar-{tyTypeDesc}) @@ -928,7 +928,7 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, typ = n[^1].typ else: fitDefaultNode(c, n[^1], typ) - typ = n[^1].typ + typ = n[^1].typ.skipIntLit(c.idgen) propagateToOwner(rectype, typ) elif n[^2].kind == nkEmpty: localError(c.config, n.info, errTypeExpected) @@ -958,8 +958,9 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, if fieldOwner != nil and {sfImportc, sfExportc} * fieldOwner.flags != {} and not hasCaseFields and f.loc.snippet == "": - f.loc.snippet = rope(f.name.s) - f.flags.incl {sfImportc, sfExportc} * fieldOwner.flags + ensureMutable f + f.locImpl.snippet = rope(f.name.s) + f.incl {sfImportc, sfExportc} * fieldOwner.flags inc(pos) if containsOrIncl(check, f.name.id): localError(c.config, info, "attempt to redefine: '" & f.name.s & "'") @@ -1074,8 +1075,8 @@ proc semObjectNode(c: PContext, n: PNode, prev: PType; flags: TTypeFlags): PType c.forwardTypeUpdates.add (result, n) # we retry in the final pass rawAddSon(result, realBase) if realBase == nil and tfInheritable in flags: - result.flags.incl tfInheritable - if tfAcyclic in flags: result.flags.incl tfAcyclic + result.incl tfInheritable + if tfAcyclic in flags: result.incl tfAcyclic if result.n.isNil: result.n = newNodeI(nkRecList, n.info) else: @@ -1090,9 +1091,9 @@ proc semObjectNode(c: PContext, n: PNode, prev: PType; flags: TTypeFlags): PType s.typ = result pragma(c, s, n[0], typePragmas) if base == nil and tfInheritable notin result.flags: - incl(result.flags, tfFinal) + incl(result, tfFinal) if c.inGenericContext == 0 and computeRequiresInit(c, result): - result.flags.incl tfRequiresInit + result.incl tfRequiresInit proc semAnyRef(c: PContext; n: PNode; kind: TTypeKind; prev: PType): PType = if n.len < 1: @@ -1135,22 +1136,22 @@ 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.elementType.kind == tyObject: incl(result.elementType.flags, tfPartial) + if result.elementType.kind == tyObject: incl(result.elementType, tfPartial) # if not isNilable: result.flags.incl tfNotNil case wrapperKind of tyOwned: if optOwnedRefs in c.config.globalOptions: let t = newTypeS(tyOwned, c, result) - t.flags.incl tfHasOwned + t.incl tfHasOwned result = t of tySink: let t = newTypeS(tySink, c, result) result = t else: discard - if result.kind == tyRef and + if result.kind == tyRef and c.config.selectedGC in {gcArc, gcOrc, gcAtomicArc} and tfTriggersCompileTime notin result.flags: - result.flags.incl tfHasAsgn + result.incl tfHasAsgn proc findEnforcedStaticType(t: PType): PType = # This handles types such as `static[T] and Foo`, @@ -1207,10 +1208,10 @@ proc addImplicitGeneric(c: PContext; typeClass: PType, typId: PIdent; let owner = if typeClass.sym != nil: typeClass.sym else: getCurrOwner(c) var s = newSym(skType, finalTypId, c.idgen, owner, info) - if sfExplain in owner.flags: s.flags.incl sfExplain - if typId == nil: s.flags.incl(sfAnon) + if sfExplain in owner.flags: s.incl sfExplain + if typId == nil: s.incl(sfAnon) s.linkTo(typeClass) - typeClass.flags.incl tfImplicitTypeParam + typeClass.incl tfImplicitTypeParam s.position = genericParams.len genericParams.add newSymNode(s) result = typeClass @@ -1243,7 +1244,7 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, localError(c.config, info, errMacroBodyDependsOnGenericTypes % paramName) result = addImplicitGeneric(c, newTypeS(tyStatic, c, base), paramTypId, info, genericParams, paramName) - if result != nil: result.flags.incl({tfHasStatic, tfUnresolved}) + if result != nil: result.incl({tfHasStatic, tfUnresolved}) of tyTypeDesc: if tfUnresolved notin paramType.flags: @@ -1254,7 +1255,7 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, # XXX Why doesn't this check for tyTypeDesc instead? paramTypId = nil let t = newTypeS(tyTypeDesc, c, paramType.base) - incl t.flags, tfCheckedForDestructor + incl t, tfCheckedForDestructor result = addImplicitGeneric(c, t, paramTypId, info, genericParams, paramName) else: result = nil @@ -1304,7 +1305,7 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, for i in 0.. 0: result = semTypeNode(c, n[^1], prev) - n.typ() = result - n[^1].typ() = result + n.typ = result + n[^1].typ = result else: result = nil @@ -1645,15 +1646,15 @@ proc semBlockType(c: PContext, n: PNode, prev: PType): PType = if n[0].kind notin {nkEmpty, nkSym}: addDecl(c, newSymS(skLabel, n[0], c)) result = semStmtListType(c, n[1], prev) - n[1].typ() = result - n.typ() = result + n[1].typ = result + n.typ = result closeScope(c) c.p.breakInLoop = oldBreakInLoop dec(c.p.nestedBlockCounter) proc semGenericParamInInvocation(c: PContext, n: PNode): PType = result = semTypeNode(c, n, nil) - n.typ() = makeTypeDesc(c, result) + n.typ = makeTypeDesc(c, result) proc trySemObjectTypeForInheritedGenericInst(c: PContext, n: PNode, t: PType): bool = var @@ -1776,7 +1777,10 @@ proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = if not trySemObjectTypeForInheritedGenericInst(c, n, tx): return newOrPrevType(tyError, prev, c) var position = 0 - recomputeFieldPositions(tx, tx.n, position) + # it can be that we cached this generic instance. In this case, we don't have to + # recompute the field positions: + if tx.state != Sealed: + recomputeFieldPositions(tx, tx.n, position) proc maybeAliasType(c: PContext; typeExpr, prev: PType): PType = if prev != nil and (prev.kind == tyGenericBody or @@ -1846,7 +1850,7 @@ proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = # if n.len == 0: return newConstraint(c, tyTypeClass) if isNewStyleConcept(n): result = newOrPrevType(tyConcept, prev, c) - result.flags.incl tfCheckedForDestructor + result.incl tfCheckedForDestructor result.n = semConceptDeclaration(c, n) return result @@ -1857,7 +1861,7 @@ proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = var owner = getCurrOwner(c) var candidateTypeSlot = newTypeS(tyAlias, c, c.errorType) result = newOrPrevType(tyUserTypeClass, prev, c, son = candidateTypeSlot) - result.flags.incl tfCheckedForDestructor + result.incl tfCheckedForDestructor result.n = n if inherited.kind != nkEmpty: @@ -1879,8 +1883,8 @@ proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = # if modifier == tyRef: # dummyType.flags.incl tfNotNil if modifier == tyTypeDesc: - dummyType.flags.incl tfConceptMatchedTypeSym - dummyType.flags.incl tfCheckedForDestructor + dummyType.incl tfConceptMatchedTypeSym + dummyType.incl tfCheckedForDestructor else: dummyName = param dummyType = candidateTypeSlot @@ -1893,7 +1897,7 @@ proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = var dummyParam = newSym(if modifier == tyTypeDesc: skType else: skVar, dummyName.ident, c.idgen, owner, param.info) dummyParam.typ = dummyType - incl dummyParam.flags, sfUsed + incl dummyParam.flagsImpl, sfUsed addDecl(c, dummyParam) result.n[3] = semConceptBody(c, n[3]) @@ -1978,7 +1982,7 @@ proc semStaticType(c: PContext, childNode: PNode, prev: PType): PType = result = newOrPrevType(tyStatic, prev, c) var base = semTypeNode(c, childNode, nil).skipTypes({tyTypeDesc, tyAlias}) result.rawAddSon(base) - result.flags.incl tfHasStatic + result.incl tfHasStatic proc semTypeOf(c: PContext; n: PNode; prev: PType): PType = openScope(c) @@ -1988,12 +1992,12 @@ proc semTypeOf(c: PContext; n: PNode; prev: PType): PType = closeScope(c) result = ex.typ if result.kind == tyFromExpr: - result.flags.incl tfNonConstExpr + result.incl tfNonConstExpr elif result.kind == tyStatic: let base = result.skipTypes({tyStatic}) if c.inGenericContext > 0 and base.containsGenericType: result = makeTypeFromExpr(c, copyTree(ex)) - result.flags.incl tfNonConstExpr + result.incl tfNonConstExpr else: result = base fixupTypeOf(c, prev, result) @@ -2013,12 +2017,12 @@ proc semTypeOf2(c: PContext; n: PNode; prev: PType): PType = closeScope(c) result = ex.typ if result.kind == tyFromExpr: - result.flags.incl tfNonConstExpr + result.incl tfNonConstExpr elif result.kind == tyStatic: let base = result.skipTypes({tyStatic}) if c.inGenericContext > 0 and base.containsGenericType: result = makeTypeFromExpr(c, copyTree(ex)) - result.flags.incl tfNonConstExpr + result.incl tfNonConstExpr else: result = base fixupTypeOf(c, prev, result) @@ -2052,14 +2056,14 @@ proc semTypeIdent(c: PContext, n: PNode): PSym = return errorSym(c, n) result = result.typ.sym.copySym(c.idgen) result.typ = exactReplica(result.typ) - result.typ.flags.incl tfUnresolved + result.typ.incl tfUnresolved if result.kind == skGenericParam: if result.typ.kind == tyGenericParam and result.typ.len == 0 and tfWildcard in result.typ.flags: # collapse the wild-card param to a type result.transitionGenericParamToType() - result.typ.flags.excl tfWildcard + result.typ.excl tfWildcard return else: localError(c.config, n.info, errTypeExpected) @@ -2085,7 +2089,7 @@ proc semTypeIdent(c: PContext, n: PNode): PSym = n.transitionNoneToSym() n.sym = result n.info = oldInfo - n.typ() = result.typ + n.typ = result.typ else: localError(c.config, n.info, "identifier expected") result = errorSym(c, n) @@ -2101,7 +2105,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = # for ``typeof(countup(1,3))``, see ``tests/ttoseq``. checkSonsLen(n, 1, c.config) result = semTypeOf(c, n[0], prev) - if result.kind == tyTypeDesc: result.flags.incl tfExplicit + if result.kind == tyTypeDesc: result.incl tfExplicit of nkPar: if n.len == 1: result = semTypeNode(c, n[0], prev) else: @@ -2121,7 +2125,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = if result.skipTypes({tyGenericInst, tyAlias, tySink, tyOwned}).kind in NilableTypes+GenericTypes: if tfNotNil in result.flags: result = freshType(c, result, prev) - result.flags.excl(tfNotNil) + result.excl(tfNotNil) else: localError(c.config, n.info, errGenerated, "invalid type") elif n[0].kind notin nkIdentKinds: @@ -2184,7 +2188,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = makeTypeFromExpr(c, newTree(nkStmtListType, n.copyTree)) of NilableTypes + {tyGenericInvocation, tyForward}: result = freshType(c, result, prev) - result.flags.incl(tfNotNil) + result.incl(tfNotNil) else: localError(c.config, n.info, errGenerated, "invalid type") of 2: @@ -2230,11 +2234,11 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = of mSeq: result = semContainer(c, n, tySequence, "seq", prev) if optSeqDestructors in c.config.globalOptions: - incl result.flags, tfHasAsgn + incl result, tfHasAsgn of mVarargs: result = semVarargs(c, n, prev) of mTypeDesc, mType, mTypeOf: result = makeTypeDesc(c, semTypeNode(c, n[1], nil)) - result.flags.incl tfExplicit + result.incl tfExplicit of mStatic: result = semStaticType(c, n[1], prev) of mExpr: @@ -2353,7 +2357,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = newTypeS(tyBuiltInTypeClass, c) let child = newTypeS(tyProc, c) if n.kind == nkIteratorTy: - child.flags.incl tfIterator + child.incl tfIterator if n.len > 0 and n[1].kind != nkEmpty and n[1].len > 0: # typeclass with pragma let symKind = if n.kind == nkIteratorTy: skIterator else: skProc @@ -2371,9 +2375,9 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = newOrPrevType(tyError, prev, c) if n.kind == nkIteratorTy and result.kind == tyProc: - result.flags.incl(tfIterator) + result.incl(tfIterator) if result.callConv == ccClosure and c.config.selectedGC in {gcArc, gcOrc, gcAtomicArc}: - result.flags.incl tfHasAsgn + result.incl tfHasAsgn of nkEnumTy: result = semEnum(c, n, prev) of nkType: result = n.typ of nkStmtListType: result = semStmtListType(c, n, prev) @@ -2384,7 +2388,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = when false: localError(c.config, n.info, "type expected, but got: " & renderTree(n)) result = newOrPrevType(tyError, prev, c) - n.typ() = result + n.typ = result dec c.inTypeContext proc setMagicType(conf: ConfigRef; m: PSym, kind: TTypeKind, size: int) = @@ -2403,7 +2407,7 @@ proc setMagicType(conf: ConfigRef; m: PSym, kind: TTypeKind, size: int) = proc setMagicIntegral(conf: ConfigRef; m: PSym, kind: TTypeKind, size: int) = setMagicType(conf, m, kind, size) - incl m.typ.flags, tfCheckedForDestructor + incl m.typ, tfCheckedForDestructor proc processMagicType(c: PContext, m: PSym) = case m.magic @@ -2427,7 +2431,7 @@ proc processMagicType(c: PContext, m: PSym) = setMagicType(c.config, m, tyString, szUncomputedSize) rawAddSon(m.typ, getSysType(c.graph, m.info, tyChar)) if optSeqDestructors in c.config.globalOptions: - incl m.typ.flags, tfHasAsgn + incl m.typ, tfHasAsgn of mCstring: setMagicIntegral(c.config, m, tyCstring, c.config.target.ptrSize) rawAddSon(m.typ, getSysType(c.graph, m.info, tyChar)) @@ -2464,7 +2468,7 @@ proc processMagicType(c: PContext, m: PSym) = of mSeq: setMagicType(c.config, m, tySequence, szUncomputedSize) if optSeqDestructors in c.config.globalOptions: - incl m.typ.flags, tfHasAsgn + incl m.typ, tfHasAsgn if defined(nimsuggest) or c.config.cmd == cmdCheck: # bug #18985 discard else: @@ -2477,8 +2481,8 @@ proc processMagicType(c: PContext, m: PSym) = setMagicIntegral(c.config, m, tyIterable, 0) rawAddSon(m.typ, newTypeS(tyNone, c)) of mPNimrodNode: - incl m.typ.flags, tfTriggersCompileTime - incl m.typ.flags, tfCheckedForDestructor + incl m.typ, tfTriggersCompileTime + incl m.typ, tfCheckedForDestructor of mException: discard of mBuiltinType: case m.name.s @@ -2486,7 +2490,7 @@ proc processMagicType(c: PContext, m: PSym) = of "sink": setMagicType(c.config, m, tySink, szUncomputedSize) of "owned": setMagicType(c.config, m, tyOwned, c.config.target.ptrSize) - incl m.typ.flags, tfHasOwned + incl m.typ, tfHasOwned else: localError(c.config, m.info, errTypeExpected) else: localError(c.config, m.info, errTypeExpected) @@ -2519,7 +2523,7 @@ proc semGenericParamList(c: PContext, n: PNode, father: PType = nil): PNode = if typ.kind == tyTypeDesc: if typ.elementType.kind == tyNone: typ = newTypeS(tyTypeDesc, c, newTypeS(tyNone, c)) - incl typ.flags, tfCheckedForDestructor + incl typ, tfCheckedForDestructor else: typ = semGenericConstraints(c, typ) @@ -2531,15 +2535,15 @@ proc semGenericParamList(c: PContext, n: PNode, father: PType = nil): PNode = else: # the following line fixes ``TV2*[T:SomeNumber=TR] = array[0..1, T]`` # from manyloc/named_argument_bug/triengine: - def.typ() = def.typ.skipTypes({tyTypeDesc}) + def.typ = def.typ.skipTypes({tyTypeDesc}) if not containsGenericType(def.typ): def = fitNode(c, typ, def, def.info) if typ == nil: typ = newTypeS(tyGenericParam, c) - if father == nil: typ.flags.incl tfWildcard + if father == nil: typ.incl tfWildcard - typ.flags.incl tfGenericTypeParam + typ.incl tfGenericTypeParam for j in 0.. depthf: a.skipGenericAlias else: a let rootf = if skipBoth or depthf > deptha: f.skipGenericAlias else: f - + if f.isConcept: result = enterConceptMatch(c, rootf, roota, flags) elif a.kind == tyGenericInst: @@ -1989,7 +1988,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, var concrete = a if tfWildcard in a.flags: a.sym.transitionGenericParamToType() - a.flags.excl tfWildcard + a.excl tfWildcard elif doBind: # 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 @@ -2180,18 +2179,18 @@ proc implicitConv(kind: TNodeKind, f: PType, arg: PNode, m: TCandidate, result = newNodeI(kind, arg.info) if containsGenericType(f): if not m.matchedErrorType: - result.typ() = getInstantiatedType(c, arg, m, f).skipTypes({tySink}) + result.typ = getInstantiatedType(c, arg, m, f).skipTypes({tySink}) else: - result.typ() = errorType(c) + result.typ = errorType(c) else: - result.typ() = f.skipTypes({tySink}) + result.typ = f.skipTypes({tySink}) # keep varness if arg.typ != nil and arg.typ.kind == tyVar: - result.typ() = toVar(result.typ, tyVar, c.idgen) + result.typ = toVar(result.typ, tyVar, c.idgen) # copy the tfVarIsPtr flag result.typ.flags = arg.typ.flags else: - result.typ() = result.typ.skipTypes({tyVar}) + result.typ = result.typ.skipTypes({tyVar}) if result.typ == nil: internalError(c.graph.config, arg.info, "implicitConv") result.add c.graph.emptyNode @@ -2219,13 +2218,13 @@ proc convertLiteral(kind: TNodeKind, c: PContext, m: TCandidate; n: PNode, newTy result.add x else: result.addConsiderNil convertLiteral(kind, c, m, n[i], elemType(newType)) - result.typ() = newType + result.typ = newType return of nkBracket: result = copyNode(n) for i in 0.. lastOrd(c.config, newType): return nil result = copyNode(n) - result.typ() = newType + 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 + result.typ = newType return of nkSym: if n.sym.kind == skEnumField and not sameTypeOrNil(n.sym.typ, newType) and isOrdinalType(newType): @@ -2272,7 +2271,7 @@ proc convertLiteral(kind: TNodeKind, c: PContext, m: TCandidate; n: PNode, newTy if value < firstOrd(c.config, newType) or value > lastOrd(c.config, newType): return nil result = copyNode(n) - result.typ() = newType + result.typ = newType return else: discard return implicitConv(kind, newType, n, m, c) @@ -2316,10 +2315,10 @@ proc userConvMatch(c: PContext, m: var TCandidate, f, a: PType, let fdest = typeRel(m, f, dest) if fdest in {isEqual, isGeneric} and not (dest.kind == tyLent and f.kind in {tyVar}): # can't fully mark used yet, may not be used in final call - incl(c.converters[i].flags, sfUsed) + incl(c.converters[i].flagsImpl, sfUsed) markOwnerModuleAsUsed(c, c.converters[i]) var s = newSymNode(c.converters[i]) - s.typ() = c.converters[i].typ + s.typ = c.converters[i].typ s.info = arg.info result = newNodeIT(nkHiddenCallConv, arg.info, dest) result.add s @@ -2339,7 +2338,7 @@ proc userConvMatch(c: PContext, m: var TCandidate, f, a: PType, result.add param if dest.kind in {tyVar, tyLent}: - dest.flags.incl tfVarIsPtr + dest.incl tfVarIsPtr result = newDeref(result) inc(m.convMatches) @@ -2373,7 +2372,7 @@ proc localConvMatch(c: PContext, m: var TCandidate, f, a: PType, if result.kind == nkCall: result.transitionSonsKind(nkHiddenCallConv) inc(m.convMatches) if r == isGeneric: - result.typ() = getInstantiatedType(c, arg, m, base(f)) + result.typ = getInstantiatedType(c, arg, m, base(f)) m.baseTypeMatch = true proc incMatches(m: var TCandidate; r: TTypeRelation; convMatch = 1) = @@ -2429,13 +2428,13 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, let typ = newTypeS(tyStatic, c, son = evaluated.typ) typ.n = evaluated arg = copyTree(arg) # fix #12864 - arg.typ() = typ + arg.typ = typ a = typ else: if m.callee.kind == tyGenericBody: if f.kind == tyStatic and typeRel(m, f.base, a) != isNone: result = makeStaticExpr(m.c, arg) - result.typ.flags.incl tfUnresolved + result.typ.incl tfUnresolved result.typ.n = arg return @@ -2547,7 +2546,7 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, # doesn't work: `proc foo[T](): array[T, int] = ...; foo[3]()` (see #23204) (arg.typ.isIntLit and not m.isNoCall): result = arg.copyTree - result.typ() = getInstantiatedType(c, arg, m, f).skipTypes({tySink}) + result.typ = getInstantiatedType(c, arg, m, f).skipTypes({tySink}) else: result = arg of isBothMetaConvertible: @@ -2603,7 +2602,7 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, of isGeneric: inc(m.convMatches) result = copyTree(arg) - result.typ() = getInstantiatedType(c, arg, m, base(f)) + result.typ = getInstantiatedType(c, arg, m, base(f)) m.baseTypeMatch = true of isFromIntLit: inc(m.intConvMatches, 256) @@ -2629,7 +2628,7 @@ proc staticAwareTypeRel(m: var TCandidate, f: PType, arg: var PNode): TTypeRelat # 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 = exactReplica(copiedNode.typ) copiedNode.typ.n = arg arg = copiedNode typeRel(m, f, arg.typ) @@ -2898,7 +2897,7 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int var newlyTyped = false n[a][1] = prepareOperand(c, formal.typ, n[a][1], newlyTyped) if newlyTyped: m.newlyTypedOperands.add(a) - n[a].typ() = n[a][1].typ + n[a].typ = n[a][1].typ arg = paramTypesMatch(m, formal.typ, n[a].typ, n[a][1], n[a][1]) m.firstMismatch.kind = kTypeMismatch @@ -2995,7 +2994,7 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int #assert(container == nil) if container.isNil: container = newNodeIT(nkBracket, n[a].info, arrayConstr(c, arg)) - container.typ.flags.incl tfVarargs + container.typ.incl tfVarargs else: incrIndexType(container.typ) container.add arg @@ -3078,7 +3077,7 @@ proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = 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) + formal.ast.typ = errorType(c) if nfDefaultRefsParam in formal.ast.flags: m.call.flags.incl nfDefaultRefsParam var defaultValue = copyTree(formal.ast) diff --git a/compiler/sinkparameter_inference.nim b/compiler/sinkparameter_inference.nim index 09d54ec790..3c6e4cf09d 100644 --- a/compiler/sinkparameter_inference.nim +++ b/compiler/sinkparameter_inference.nim @@ -38,14 +38,15 @@ proc checkForSink*(config: ConfigRef; idgen: IdGenerator; owner: PSym; arg: PNod sinkType.add argType arg.sym.typ = sinkType - owner.typ[arg.sym.position+1] = sinkType + assert owner.typ.n[arg.sym.position+1].sym == arg.sym #message(config, arg.info, warnUser, # ("turned '$1' to a sink parameter") % [$arg]) #echo config $ arg.info, " turned into a sink parameter ", arg.sym.name.s elif sfWasForwarded notin arg.sym.flags: # we only report every potential 'sink' parameter only once: - incl arg.sym.flags, sfWasForwarded + ensureMutable arg.sym + incl arg.sym.flagsImpl, sfWasForwarded message(config, arg.info, hintPerformance, "could not turn '$1' to a sink parameter" % [arg.sym.name.s]) #echo config $ arg.info, " candidate for a sink parameter here" diff --git a/compiler/sizealignoffsetimpl.nim b/compiler/sizealignoffsetimpl.nim index 3a3457cb89..1dd481ec0b 100644 --- a/compiler/sizealignoffsetimpl.nim +++ b/compiler/sizealignoffsetimpl.nim @@ -477,7 +477,7 @@ template foldSizeOf*(conf: ConfigRef; n: PNode; fallback: PNode): PNode = if size >= 0: let res = newIntNode(nkIntLit, size) res.info = node.info - res.typ() = node.typ + res.typ = node.typ res else: fallback @@ -491,7 +491,7 @@ template foldAlignOf*(conf: ConfigRef; n: PNode; fallback: PNode): PNode = if align >= 0: let res = newIntNode(nkIntLit, align) res.info = node.info - res.typ() = node.typ + res.typ = node.typ res else: fallback @@ -519,7 +519,7 @@ template foldOffsetOf*(conf: ConfigRef; n: PNode; fallback: PNode): PNode = if offset >= 0: let tmp = newIntNode(nkIntLit, offset) tmp.info = node.info - tmp.typ() = node.typ + tmp.typ = node.typ tmp else: fallback diff --git a/compiler/spawn.nim b/compiler/spawn.nim index 99b3b55332..cd5d8031cc 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.returnType + result.typ = a.typ.returnType # we have 4 cases to consider: # - a void proc --> nothing to do @@ -58,7 +58,7 @@ proc addLocalVar(g: ModuleGraph; varSection, varInit: PNode; idgen: IdGenerator; result = newSym(skTemp, getIdent(g.cache, genPrefix), idgen, owner, varSection.info, owner.options) result.typ = typ - incl(result.flags, sfFromGeneric) + incl(result.flagsImpl, sfFromGeneric) var vpart = newNodeI(nkIdentDefs, varSection.info, 3) vpart[0] = newSymNode(result) @@ -117,7 +117,7 @@ proc castToVoidPointer(g: ModuleGraph, n: PNode, fvField: PNode): PNode = result = newNodeI(nkCast, fvField.info) result.add newNodeI(nkEmpty, fvField.info) result.add fvField - result.typ() = ptrType + result.typ = ptrType proc createWrapperProc(g: ModuleGraph; f: PNode; threadParam, argsParam: PSym; varSection, varInit, call, barrier, fv: PNode; @@ -200,7 +200,7 @@ proc createCastExpr(argsParam: PSym; objType: PType; idgen: IdGenerator): PNode result = newNodeI(nkCast, argsParam.info) result.add newNodeI(nkEmpty, argsParam.info) result.add newSymNode(argsParam) - result.typ() = newType(tyPtr, idgen, objType.owner) + result.typ = newType(tyPtr, idgen, objType.owner) result.typ.rawAddSon(objType) template checkMagicProcs(g: ModuleGraph, n: PNode, formal: PNode) = @@ -266,9 +266,9 @@ proc setupArgsForParallelism(g: ModuleGraph; n: PNode; objType: PType; if argType.kind in {tyVarargs, tyOpenArray}: # important special case: we always create a zero-copy slice: let slice = newNodeI(nkCall, n.info, 4) - slice.typ() = n.typ + slice.typ = n.typ slice[0] = newSymNode(createMagic(g, idgen, "slice", mSlice)) - slice[0].typ() = getSysType(g, n.info, tyInt) # fake type + slice[0].typ = getSysType(g, n.info, tyInt) # fake type var fieldB = newSym(skField, tmpName, idgen, objType.owner, n.info, g.config.options) fieldB.typ = getSysType(g, n.info, tyInt) discard objType.addField(fieldB, g.cache, idgen) @@ -358,7 +358,7 @@ proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExp threadParam = newSym(skParam, getIdent(g.cache, "thread"), idgen, wrapperProc, n.info, g.config.options) argsParam = newSym(skParam, getIdent(g.cache, "args"), idgen, wrapperProc, n.info, g.config.options) - wrapperProc.flags.incl sfInjectDestructors + wrapperProc.incl sfInjectDestructors block: let ptrType = getSysType(g, n.info, tyPointer) threadParam.typ = ptrType @@ -366,13 +366,13 @@ proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExp argsParam.position = 1 var objType = createObj(g, idgen, owner, n.info) - incl(objType.flags, tfFinal) + incl(objType, tfFinal) let castExpr = createCastExpr(argsParam, objType, idgen) var scratchObj = newSym(skVar, getIdent(g.cache, "scratch"), idgen, owner, n.info, g.config.options) block: scratchObj.typ = objType - incl(scratchObj.flags, sfFromGeneric) + incl(scratchObj.flagsImpl, sfFromGeneric) var varSectionB = newNodeI(nkVarSection, n.info) varSectionB.addVar(scratchObj.newSymNode) result.add varSectionB diff --git a/compiler/suggest.nim b/compiler/suggest.nim index 3953936eb6..a1cd8b9237 100644 --- a/compiler/suggest.nim +++ b/compiler/suggest.nim @@ -43,7 +43,7 @@ when defined(nimsuggest): const sep = '\t' -type +type ImportContext = object isMultiImport: bool # True if we're in a [...] context baseDir: string # e.g., "folder/" in "import folder/[..." @@ -356,12 +356,12 @@ proc filterSymNoOpr(s: PSym; prefix: PNode; res: var PrefixMatch): bool {.inline not isKeyword(s.name) proc fieldVisible*(c: PContext, f: PSym): bool {.inline.} = - let fmoduleId = getModule(f).id - result = sfExported in f.flags or fmoduleId == c.module.id + let fmodule = getModule(f) + result = sfExported in f.flags or sameModules(fmodule, c.module) if not result: for module in c.friendModules: - if fmoduleId == module.id: return true + if sameModules(fmodule, module): return true if f.kind == skField: var symObj = f.owner.typ.toObjectFromRefPtrGeneric.sym assert symObj != nil @@ -590,7 +590,7 @@ when defined(nimsuggest): let infoAsInt = info.infoToInt for infoB in s.allUsages: if infoB.infoToInt == infoAsInt: return - s.allUsages.add(info) + s.allUsagesImpl.add(info) proc findUsages(g: ModuleGraph; info: TLineInfo; s: PSym; usageSym: var PSym) = if g.config.suggestVersion == 1: @@ -707,9 +707,9 @@ proc markOwnerModuleAsUsed(c: PContext; s: PSym) = proc markUsed(c: PContext; info: TLineInfo; s: PSym; checkStyle = true; isGenericInstance = false) = if not isGenericInstance: let conf = c.config - incl(s.flags, sfUsed) + incl(s.flagsImpl, sfUsed) if s.kind == skEnumField and s.owner != nil: - incl(s.owner.flags, sfUsed) + incl(s.owner.flagsImpl, sfUsed) if sfDeprecated in s.owner.flags: warnAboutDeprecated(conf, info, s) if {sfDeprecated, sfError} * s.flags != {}: @@ -788,7 +788,7 @@ proc extractImportContextFromAst(n: PNode, cursorCol: int): ImportContext = proc findModuleFile(c: PContext, partialPath: string): seq[string] = result = @[] let currentModuleDir = parentDir(toFullPath(c.config, FileIndex(c.module.position))) - + proc tryAddModule(path, baseName: string) = if fileExists(path & ".nim"): result.add(baseName) @@ -800,7 +800,7 @@ proc findModuleFile(c: PContext, partialPath: string): seq[string] = let (_, name, ext) = splitFile(path) if kind == pcFile: if ext == ".nim" and name.startsWith(file): - result.add(name) + result.add(name) proc collectImportModulesFromDir(dir: string, result: var seq[string]) = for kind, path in walkDir(dir): @@ -809,10 +809,10 @@ proc findModuleFile(c: PContext, partialPath: string): seq[string] = if kind == pcFile: if ext == ".nim" and name.startsWith(partialPath): result.add(name) - else: + else: if name.startsWith(partialPath): result.add(name) - + if '/' in partialPath: let parts = partialPath.split('/') let dir = parts[0] @@ -839,13 +839,13 @@ proc suggestModuleNames(c: PContext, n: PNode) = column: n.info.col.int, doc: "", quality: 100, - contextFits: true, + contextFits: true, prefix: if partialPath.len > 0: prefixMatch(path, partialPath) else: PrefixMatch.None, symkind: byte skModule ) suggestions.add(suggest) - + let importCtx = extractImportContextFromAst(n, c.config.m.trackPos.col) var searchPath = "" if importCtx.baseDir.len > 0: @@ -901,7 +901,7 @@ proc suggestExprNoCheck*(c: PContext, n: PNode) = if outputs.len > 0 and c.config.ideCmd in {ideSug, ideCon, ideDef}: produceOutput(outputs, c.config) suggestQuit() - + proc suggestExpr*(c: PContext, n: PNode) = if exactEquals(c.config.m.trackPos, n.info): suggestExprNoCheck(c, n) diff --git a/compiler/transf.nim b/compiler/transf.nim index 066be57f87..124ffa2f78 100644 --- a/compiler/transf.nim +++ b/compiler/transf.nim @@ -65,16 +65,14 @@ proc newTransNode(a: PNode): PNode {.inline.} = proc newTransNode(kind: TNodeKind, info: TLineInfo, sons: int): PNode {.inline.} = - var x = newNodeI(kind, info) - newSeq(x.sons, sons) - result = x + result = newNodeI(kind, info) + newSeq(result.sons, sons) proc newTransNode(kind: TNodeKind, n: PNode, sons: int): PNode {.inline.} = - var x = newNodeIT(kind, n.info, n.typ) - newSeq(x.sons, sons) -# x.flags = n.flags - result = x + result = newNodeIT(kind, n.info, n.typ) + newSeq(result.sons, sons) + # x.flags = n.flags proc newTransCon(owner: PSym): PTransCon = assert owner != nil @@ -95,7 +93,7 @@ proc getCurrOwner(c: PTransf): PSym = proc newTemp(c: PTransf, typ: PType, info: TLineInfo): PNode = let r = newSym(skTemp, getIdent(c.graph.cache, genPrefix), c.idgen, getCurrOwner(c), info) r.typ = typ #skipTypes(typ, {tyGenericInst, tyAlias, tySink}) - incl(r.flags, sfFromGeneric) + incl(r.flagsImpl, sfFromGeneric) let owner = getCurrOwner(c) result = newSymNode(r) @@ -181,7 +179,7 @@ proc transformSym(c: PTransf, n: PNode): PNode = proc freshVar(c: PTransf; v: PSym): PNode = let owner = getCurrOwner(c) var newVar = copySym(v, c.idgen) - incl(newVar.flags, sfFromGeneric) + incl(newVar.flagsImpl, sfFromGeneric) setOwner(newVar, owner) result = newSymNode(newVar) @@ -247,6 +245,7 @@ proc hasContinue(n: PNode): bool = case n.kind of nkEmpty..nkNilLit, nkForStmt, nkParForStmt, nkWhileStmt: result = false of nkContinueStmt: result = true + of routineDefs: result = false else: result = false for i in 0.. x result = n[0][0] if n.typ.skipTypes(abstractVar).kind != tyOpenArray: - result.typ() = n.typ + result.typ = n.typ proc generateThunk(c: PTransf; prc: PNode, dest: PType): PNode = ## Converts 'prc' into '(thunk, nil)' so that it's compatible with @@ -566,7 +565,7 @@ proc transformConv(c: PTransf, n: PNode): PNode = getSysType(c.graph, n.info, tyInt32) else: getSysType(c.graph, n.info, tyInt64) - result[0] = + result[0] = newTreeIT(n.kind, n.info, n.typ, n[0], newTreeIT(nkConv, n.info, intType, newNodeIT(nkType, n.info, intType), transform(c, n[1])) @@ -611,7 +610,7 @@ proc transformConv(c: PTransf, n: PNode): PNode = else: result = transform(c, n[1]) #result = transformSons(c, n) - result.typ() = takeType(n.typ, n[1].typ, c.graph, c.idgen) + result.typ = takeType(n.typ, n[1].typ, c.graph, c.idgen) #echo n.info, " came here and produced ", typeToString(result.typ), # " from ", typeToString(n.typ), " and ", typeToString(n[1].typ) of tyCstring: @@ -639,7 +638,7 @@ proc transformConv(c: PTransf, n: PNode): PNode = result[0] = transform(c, n[1]) else: result = transform(c, n[1]) - result.typ() = n.typ + result.typ = n.typ else: result = transformSons(c, n) of tyObject: @@ -652,7 +651,7 @@ proc transformConv(c: PTransf, n: PNode): PNode = result[0] = transform(c, n[1]) else: result = transform(c, n[1]) - result.typ() = n.typ + result.typ = n.typ of tyGenericParam, tyOrdinal: result = transform(c, n[1]) # happens sometimes for generated assignments, etc. @@ -795,7 +794,8 @@ proc transformFor(c: PTransf, n: PNode): PNode = addVar(v, copyTree(n[i][j])) # declare new vars else: if n[i].kind == nkSym and isSimpleIteratorVar(c, iter, call, n[i].sym.owner): - incl n[i].sym.flags, sfCursor + # IC: review this solution again later + incl n[i].sym.flagsImpl, sfCursor addVar(v, copyTree(n[i])) # declare new vars stmtList.add(v) @@ -828,13 +828,16 @@ proc transformFor(c: PTransf, n: PNode): PNode = elif t.destructor == nil and arg.typ.destructor != nil: t = arg.typ - if arg.kind in {nkDerefExpr, nkHiddenDeref}: + if arg.kind in {nkDerefExpr, nkHiddenDeref} and + arg[0].typ.skipTypes(abstractInst).kind != tyLent: # optimizes for `[]` # bug #24093 + # bug #25251: enforce a copy if the arg is a deref of a lent pointer + # since the arg could be a temporary that will go out of scope var temp = newTemp(c, arg[0].typ, formal.info) addVar(v, temp) stmtList.add(newAsgnStmt(c, nkFastAsgn, temp, arg[0], true)) let newD = newDeref(temp) - newD.typ() = t + newD.typ = t newC.mapping[formal.itemId] = newD else: # generate a temporary and produce an assignment statement: @@ -850,7 +853,7 @@ proc transformFor(c: PTransf, n: PNode): PNode = of paViaIndirection: let t = formal.typ let vt = makeVarType(t.owner, t, c.idgen) - vt.flags.incl tfVarIsPtr + vt.incl tfVarIsPtr var temp = newTemp(c, vt, formal.info) addVar(v, temp) var addrExp = newNodeIT(nkHiddenAddr, formal.info, makeVarType(t.owner, t, c.idgen, tyPtr)) @@ -888,7 +891,7 @@ proc transformCase(c: PTransf, n: PNode): PNode = # as an expr let kind = if n.typ != nil: nkIfExpr else: nkIfStmt ifs = newTransNode(kind, it.info, 0) - ifs.typ() = n.typ + ifs.typ = n.typ ifs.add(e) of nkElse: if ifs == nil: result.add(e) @@ -1022,7 +1025,7 @@ proc transformExceptBranch(c: PTransf, n: PNode): PNode = let convNode = newTransNode(nkHiddenSubConv, n[1].info, 2) convNode[0] = newNodeI(nkEmpty, n.info) convNode[1] = excCall - convNode.typ() = excTypeNode.typ.toRef(c.idgen) + convNode.typ = excTypeNode.typ.toRef(c.idgen) # -> let exc = ... let identDefs = newTransNode(nkIdentDefs, n[1].info, 3) identDefs[0] = n[0][2] @@ -1082,7 +1085,7 @@ proc transformDerefBlock(c: PTransf, n: PNode): PNode = # We transform (block: x)[] to (block: x[]) let e0 = n[0] result = shallowCopy(e0) - result.typ() = n.typ + result.typ = n.typ for i in 0 ..< e0.len - 1: result[i] = e0[i] result[e0.len-1] = newTreeIT(nkHiddenDeref, n.info, n.typ, e0[e0.len-1]) @@ -1287,7 +1290,7 @@ proc liftDeferAux(n: PNode) = tryStmt.add deferPart n[i] = tryStmt n.sons.setLen(i+1) - n.typ() = tryStmt.typ + n.typ = tryStmt.typ goOn = true break for i in 0..n.safeLen-1: diff --git a/compiler/treetab.nim b/compiler/treetab.nim index 1fd539f0f2..fd6db77fa6 100644 --- a/compiler/treetab.nim +++ b/compiler/treetab.nim @@ -9,7 +9,7 @@ # Implements a table from trees to trees. Does structural equivalence checking. -import ast, astalgo, types +import ast, types import std/hashes @@ -21,20 +21,13 @@ proc hashTree*(n: PNode): Hash = return result = ord(n.kind) case n.kind - of nkEmpty, nkNilLit, nkType: - discard - of nkIdent: - result = result !& n.ident.h - of nkSym: - result = result !& n.sym.id - of nkCharLit..nkUInt64Lit: - if (n.intVal >= low(int)) and (n.intVal <= high(int)): - result = result !& int(n.intVal) - of nkFloatLit..nkFloat64Lit: - if (n.floatVal >= - 1000000.0) and (n.floatVal <= 1000000.0): - result = result !& toInt(n.floatVal) - of nkStrLit..nkTripleStrLit: - result = result !& hash(n.strVal) + of nkEmpty: discard + of nkSym: result = result !& n.sym.id + of nkIdent: result = result !& n.ident.h + of nkCharLit..nkUInt64Lit: result = result !& hash(n.intVal) + of nkFloatLit..nkFloat64Lit: result = result !& hash(cast[uint64](n.floatVal)) + of nkStrLit..nkTripleStrLit: result = result !& hash(n.strVal) + of nkType, nkNilLit: result = result !& hash(n.typ.itemId) else: for i in 0.. 0: + c.typeKey(t.skipModifierB, flags, conf) + of tyProc: + withTree c.m, (if tfIterator in t.flagsImpl: "itertype" else: "proctype"): + if CoProc in flags and t.nImpl != nil: + let params = t.nImpl + for i in 1.. 0: + c.typeKey(t.sonsImpl[0], flags, conf) + + c.m.addIdent toNifTag(t.callConvImpl) + if tfVarargs in t.flagsImpl: c.m.addIdent "´varargs" + of tyArray: + withTree c.m, toNifTag(t.kind): + c.typeKey(t.sonsImpl[^1], flags-{CoIgnoreRange}, conf) + c.typeKey(t.sonsImpl[0], flags-{CoIgnoreRange}, conf) + else: + withTree c.m, toNifTag(t.kind): + for i in 1.. max: stackTrace(c, tos, pc, "unhandled exception: value out of range") + of opcNarrowR: + decodeBC(rkInt) + let min = regs[rb].intVal + let max = regs[rc].intVal + if regs[ra].intVal < min or regs[ra].intVal > max: + stackTrace(c, tos, pc, "unhandled exception: value out of range") of opcNarrowU: decodeB(rkInt) regs[ra].intVal = regs[ra].intVal and ((1'i64 shl rb)-1) @@ -2004,7 +2018,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = else: internalAssert c.config, false regs[ra].node.info = n.info - regs[ra].node.typ() = n.typ + regs[ra].node.typ = n.typ of opcNCopyLineInfo: decodeB(rkNode) regs[ra].node.info = regs[rb].node.info @@ -2084,7 +2098,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = ensureKind(rkNode) regs[ra].node = temp regs[ra].node.info = c.debug[pc] - regs[ra].node.typ() = typ + regs[ra].node.typ = typ of opcConv: let rb = instr.regB inc pc @@ -2178,7 +2192,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if k < 0 or k > ord(high(TSymKind)): internalError(c.config, c.debug[pc], "request to create symbol of invalid kind") var sym = newSym(k.TSymKind, getIdent(c.cache, name), c.idgen, c.module.owner, c.debug[pc]) - incl(sym.flags, sfGenSym) + incl(sym.flagsImpl, sfGenSym) regs[ra].node = newSymNode(sym) regs[ra].node.flags.incl nfIsRef of opcNccValue: @@ -2315,8 +2329,7 @@ proc execProc*(c: PCtx; sym: PSym; args: openArray[PNode]): PNode = let start = genProc(c, sym) var tos = PStackFrame(prc: sym, comesFrom: 0, next: nil) - let maxSlots = sym.offset - newSeq(tos.slots, maxSlots) + newSeq(tos.slots, start.usedRegisters) # setup parameters: if not isEmptyType(sym.typ.returnType) or sym.kind == skMacro: @@ -2325,7 +2338,7 @@ proc execProc*(c: PCtx; sym: PSym; args: openArray[PNode]): PNode = for i in 0.. x @@ -1542,7 +1578,8 @@ proc genAsgn(c: PCtx; dest: TDest; ri: PNode; requiresCopy: bool) = proc setSlot(c: PCtx; v: PSym) = # XXX generate type initialization here? if v.position == 0: - v.position = getFreeRegister(c, if v.kind == skLet: slotFixedLet else: slotFixedVar, start = 1) + # IC: review this solution again later + v.positionImpl = getFreeRegister(c, if v.kind == skLet: slotFixedLet else: slotFixedVar, start = 1) template cannotEval(c: PCtx; n: PNode) = if c.config.cmd == cmdCheck and c.config.m.errorOutputs != {}: @@ -1687,7 +1724,7 @@ proc genAsgn(c: PCtx; le, ri: PNode; requiresCopy: bool) = proc genTypeLit(c: PCtx; t: PType; dest: var TDest) = var n = newNode(nkType) - n.typ() = t + n.typ = t genLit(c, n, dest) proc isEmptyBody(n: PNode): bool = @@ -1782,7 +1819,7 @@ proc genRdVar(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = # see tests/t99bott for an example that triggers it: cannotEval(c, n) -template needsRegLoad(): untyped = +template needsRegLoad(): untyped {.dirty.} = {gfNode, gfNodeAddr} * flags == {} and fitsRegister(n.typ.skipTypes({tyVar, tyLent, tyStatic})) @@ -1856,7 +1893,7 @@ proc genCheckedObjAccessAux(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags let fieldName = $accessExpr[1] let msg = genFieldDefect(c.config, fieldName, disc.sym) let strLit = newStrNode(msg, accessExpr[1].info) - strLit.typ() = strType + strLit.typ = strType c.genLit(strLit, msgReg) c.gABC(n, opcInvalidField, msgReg, discVal) c.freeTemp(discVal) @@ -2120,7 +2157,7 @@ proc genTupleConstr(c: PCtx, n: PNode, dest: var TDest) = c.preventFalseAlias(it, opcWrObj, dest, i.TRegister, tmp) c.freeTemp(tmp) -proc genProc*(c: PCtx; s: PSym): int +proc genProc*(c: PCtx; s: PSym): VmProcInfo proc toKey(s: PSym): string = result = "" @@ -2404,27 +2441,19 @@ proc optimizeJumps(c: PCtx; start: int) = c.finalJumpTarget(i, d - i) else: discard -proc genProc(c: PCtx; s: PSym): int = - let - pos = c.procToCodePos.getOrDefault(s.id) - wasNotGenProcBefore = pos == 0 - noRegistersAllocated = s.offset == -1 - if wasNotGenProcBefore or noRegistersAllocated: - # xxx: the noRegisterAllocated check is required in order to avoid issues - # where nimsuggest can crash due as a macro with pos will be loaded - # but it doesn't have offsets for register allocations see: - # https://github.com/nim-lang/Nim/issues/18385 - # Improvements and further use of IC should remove the need for this. +proc genProc(c: PCtx; s: PSym): VmProcInfo = + result = c.procToCodePos.getOrDefault(s.id, NoVmProcInfo) + if result.usedRegisters < 0: #if s.name.s == "outterMacro" or s.name.s == "innerProc": # echo "GENERATING CODE FOR ", s.name.s let last = c.code.len-1 - var eofInstr: TInstr = default(TInstr) + var eofInstr = default(TInstr) if last >= 0 and c.code[last].opcode == opcEof: eofInstr = c.code[last] c.code.setLen(last) c.debug.setLen(last) #c.removeLastEof - result = c.code.len+1 # skip the jump instruction + result.pc = (c.code.len+1).int32 # skip the jump instruction c.procToCodePos[s.id] = result # thanks to the jmp we can add top level statements easily and also nest # procs easily: @@ -2449,12 +2478,12 @@ proc genProc(c: PCtx; s: PSym): int = c.gABC(body, opcRet) c.patch(procStart) c.gABC(body, opcEof, eofInstr.regA) - c.optimizeJumps(result) - s.offset = c.prc.regInfo.len.int32 + c.optimizeJumps(result.pc) + result.usedRegisters = c.prc.regInfo.len.int32 + c.procToCodePos[s.id] = result #if s.name.s == "main" or s.name.s == "[]": # echo renderTree(body) # c.echoCode(result) c.prc = oldPrc else: - c.prc.regInfo.setLen s.offset - result = pos + c.prc.regInfo.setLen result.usedRegisters diff --git a/compiler/vmprofiler.nim b/compiler/vmprofiler.nim index 3f0db84bdd..38d9f1532f 100644 --- a/compiler/vmprofiler.nim +++ b/compiler/vmprofiler.nim @@ -1,5 +1,5 @@ -import options, vmdef, lineinfos, msgs +import ast, options, vmdef, lineinfos, msgs import std/[times, strutils, tables] diff --git a/compiler/vtables.nim b/compiler/vtables.nim index b9c64ef687..61d0330bbe 100644 --- a/compiler/vtables.nim +++ b/compiler/vtables.nim @@ -32,13 +32,13 @@ proc dispatch(x: Base, params: ...) = dispatchObject, newIntNode(nkIntLit, index) ) - getVTableCall.typ() = getSysType(g, unknownLineInfo, tyPointer) + getVTableCall.typ = getSysType(g, unknownLineInfo, tyPointer) var vTableCall = newNodeIT(nkCall, base.info, base.typ.returnType) var castNode = newTree(nkCast, newNodeIT(nkType, base.info, base.typ), getVTableCall) - castNode.typ() = base.typ + castNode.typ = base.typ vTableCall.add castNode for col in 1..", + completeStruct.} = object + wd: cint + mask: uint32 + cookie: uint32 + len: uint32 + # All fields must match the C struct exactly + ``` + +If the Nim fields don't match the C struct, a static assertion will fail +during C code generation. + +Without `completeStruct`, attempting to use `sizeof` on an `importc` type +at compile-time will error with "'sizeof' requires '.importc' types to be +'.completeStruct'". + + Compile pragma -------------- The `compile` pragma can be used to compile and link a C/C++ source file diff --git a/doc/nimc.md b/doc/nimc.md index 24a2b3afe1..bb48af1370 100644 --- a/doc/nimc.md +++ b/doc/nimc.md @@ -580,6 +580,8 @@ Define Effect Currently only clang and vcc. `strip` Strip debug symbols added by the backend compiler from the executable. +`heaptrack` Track memory allocations using + [heaptrack](https://github.com/KDE/heaptrack) ====================== ========================================================= diff --git a/doc/nimdoc.css b/doc/nimdoc.css index 3fc453dc0b..1ca55a2bd0 100644 --- a/doc/nimdoc.css +++ b/doc/nimdoc.css @@ -181,6 +181,7 @@ body { .nine.columns { width: 75.0%; + margin-left: 0; padding-left: 1.5em; } .twelve.columns { @@ -192,7 +193,9 @@ body { display: none; } .nine.columns { - width: 98.0%; + width: 100%; + margin-left: 0; + padding-left: 0; } body { font-size: 1em; diff --git a/doc/tut1.md b/doc/tut1.md index 3eaa1b1610..f116357394 100644 --- a/doc/tut1.md +++ b/doc/tut1.md @@ -1278,9 +1278,10 @@ Arrays can be constructed using `[]`: echo x[i] ``` -The notation `x[i]` is used to access the i-th element of `x`. -Array access is always bounds checked (at compile-time or at runtime). These -checks can be disabled via pragmas or invoking the compiler with the +The notation `x[i]` is used to access the i-th element of `x` in the example +above. Valid indexes can be defined by any subrange. Array access is +always bounds checked (at compile-time or at runtime). These checks can be +disabled via pragmas or invoking the compiler with the ``--bound_checks:off`` command line switch. Arrays are value types, like any other Nim type. The assignment operator diff --git a/koch.nim b/koch.nim index 48cd2cdcb2..7d7123abdd 100644 --- a/koch.nim +++ b/koch.nim @@ -11,12 +11,12 @@ const # examples of possible values for repos: Head, ea82b54 - NimbleStableCommit = "9207e8b2bbdf66b5a4d1020214cff44d2d30df92" # 0.20.1 - AtlasStableCommit = "26cecf4d0cc038d5422fc1aa737eec9c8803a82b" # 0.9 + NimbleStableCommit = "9207e8b2bbdf66b5a4d1020214cff44d2d30df92" # 0.20.1 + AtlasStableCommit = "2aa62121b40d580aa2fb27920a37b938d36c5f57" # 0.9.4 ChecksumsStableCommit = "0b8e46379c5bc1bf73d8b3011908389c60fb9b98" # 2.0.1 SatStableCommit = "faf1617f44d7632ee9601ebc13887644925dcc01" - NimonyStableCommit = "1dbabac403ae32e185ee4c29f006d04e04b50c6d" # unversioned \ + NimonyStableCommit = "fc8baa61b9911caf4666685a5f5ed41b9c04f6f8" # unversioned \ # Note that Nimony uses Nim as a git submodule but we don't want to install # Nimony's dependency to Nim as we are Nim. So a `git clone` without --recursive # is **required** here. @@ -188,6 +188,11 @@ proc bundleChecksums(latest: bool) = let nimonyCommit = if latest: "HEAD" else: NimonyStableCommit cloneDependency(distDir, "https://github.com/nim-lang/nimony.git", nimonyCommit, allowBundled = true) + if not fileExists("bin/nifler".exe): + nimCompileFold("Compile nifler", "dist/nimony/src/nifler/nifler.nim", options = "-d:release") + if not fileExists("bin/nifmake".exe): + nimCompileFold("Compile nifmake", "dist/nimony/src/nifmake/nifmake.nim", options = "-d:release") + proc bundleNimsuggest(args: string) = bundleChecksums(false) nimCompileFold("Compile nimsuggest", "nimsuggest/nimsuggest.nim", @@ -553,7 +558,7 @@ proc icTest(args: string) = for fragment in content.split("#!EDIT!#"): let file = inp.replace(".nim", "_temp.nim") writeFile(file, fragment) - var cmd = nimExe & " cpp --ic:on -d:nimIcIntegrityChecks --listcmd " + var cmd = nimExe & " cpp --ic:legacy -d:nimIcIntegrityChecks --listcmd " if i == 0: cmd.add "-f " cmd.add quoteShell(file) diff --git a/lib/core/typeinfo.nim b/lib/core/typeinfo.nim index 5ea776b727..c02d8d731c 100644 --- a/lib/core/typeinfo.nim +++ b/lib/core/typeinfo.nim @@ -118,21 +118,21 @@ when not defined(js): template `rawType=`(x: var Any, p: PNimType) = x.rawTypePtr = cast[pointer](p) -proc genericAssign(dest, src: pointer, mt: PNimType) {.importCompilerProc.} +proc genericAssign(dest, src: pointer, mt: PNimType) {.importCompilerProc, raises: [].} when not defined(gcDestructors): - proc genericShallowAssign(dest, src: pointer, mt: PNimType) {.importCompilerProc.} - proc incrSeq(seq: PGenSeq, elemSize, elemAlign: int): PGenSeq {.importCompilerProc.} - proc newObj(typ: PNimType, size: int): pointer {.importCompilerProc.} - proc newSeq(typ: PNimType, len: int): pointer {.importCompilerProc.} - proc objectInit(dest: pointer, typ: PNimType) {.importCompilerProc.} + proc genericShallowAssign(dest, src: pointer, mt: PNimType) {.importCompilerProc, raises: [].} + proc incrSeq(seq: PGenSeq, elemSize, elemAlign: int): PGenSeq {.importCompilerProc, raises: [].} + proc newObj(typ: PNimType, size: int): pointer {.importCompilerProc, raises: [].} + proc newSeq(typ: PNimType, len: int): pointer {.importCompilerProc, raises: [].} + proc objectInit(dest: pointer, typ: PNimType) {.importCompilerProc, raises: [].} else: - proc nimNewObj(size, align: int): pointer {.importCompilerProc.} - proc newSeqPayload(cap, elemSize, elemAlign: int): pointer {.importCompilerProc.} + proc nimNewObj(size, align: int): pointer {.importCompilerProc, raises: [].} + proc newSeqPayload(cap, elemSize, elemAlign: int): pointer {.importCompilerProc, raises: [].} proc prepareSeqAddUninit(len: int; p: pointer; addlen, elemSize, elemAlign: int): pointer {. - importCompilerProc.} + importCompilerProc, raises: [].} proc zeroNewElements(len: int; p: pointer; addlen, elemSize, elemAlign: int) {. - importCompilerProc.} + importCompilerProc, raises: [].} include system/ptrarith diff --git a/lib/pure/hashes.nim b/lib/pure/hashes.nim index c0171237d0..f53a88db8c 100644 --- a/lib/pure/hashes.nim +++ b/lib/pure/hashes.nim @@ -304,6 +304,35 @@ else: proc rotl32(x: uint32, r: int): uint32 {.inline.} = (x shl r) or (x shr (32 - r)) +proc load4e(s: openArray[byte], o=0): uint32 {.inline.} = + uint32(s[o + 3]) shl 24 or uint32(s[o + 2]) shl 16 or + uint32(s[o + 1]) shl 8 or uint32(s[o + 0]) + +proc load8e(s: openArray[byte], o=0): uint64 {.inline.} = + uint64(s[o + 7]) shl 56 or uint64(s[o + 6]) shl 48 or + uint64(s[o + 5]) shl 40 or uint64(s[o + 4]) shl 32 or + uint64(s[o + 3]) shl 24 or uint64(s[o + 2]) shl 16 or + uint64(s[o + 1]) shl 8 or uint64(s[o + 0]) + +when declared(copyMem): + from std/endians import littleEndian64, littleEndian32 + +proc load4(s: openArray[byte], o=0): uint32 {.inline.} = + when nimvm: result = load4e(s, o) + else: + when declared copyMem: + result = uint32(0) + littleEndian32(addr result, addr s[o]) + else: result = load4e(s, o) + +proc load8(s: openArray[byte], o=0): uint64 {.inline.} = + when nimvm: result = load8e(s, o) + else: + when declared copyMem: + result = uint64(0) + littleEndian64(addr result, addr s[o]) + else: result = load8e(s, o) + proc murmurHash(x: openArray[byte]): Hash = # https://github.com/PeterScott/murmur3/blob/master/murmur3.c const @@ -320,24 +349,10 @@ proc murmurHash(x: openArray[byte]): Hash = h1: uint32 = uint32(0) i = 0 - - template impl = - var j = stepSize - while j > 0: - dec j - k1 = (k1 shl 8) or (ord(x[i+j])).uint32 - # body while i < n * stepSize: - var k1: uint32 = uint32(0) + var k1 = load4(x, i) - when nimvm: - impl() - else: - when declared(copyMem): - copyMem(addr k1, addr x[i], 4) - else: - impl() inc i, stepSize k1 = imul(k1, c1) @@ -384,32 +399,6 @@ const k0 = 0xc3a5c85c97cb3127u64 # Primes on (2^63, 2^64) for various uses const k1 = 0xb492b66fbe98f273u64 const k2 = 0x9ae16a3b2f90404fu64 -proc load4e(s: openArray[byte], o=0): uint32 {.inline.} = - uint32(s[o + 3]) shl 24 or uint32(s[o + 2]) shl 16 or - uint32(s[o + 1]) shl 8 or uint32(s[o + 0]) - -proc load8e(s: openArray[byte], o=0): uint64 {.inline.} = - uint64(s[o + 7]) shl 56 or uint64(s[o + 6]) shl 48 or - uint64(s[o + 5]) shl 40 or uint64(s[o + 4]) shl 32 or - uint64(s[o + 3]) shl 24 or uint64(s[o + 2]) shl 16 or - uint64(s[o + 1]) shl 8 or uint64(s[o + 0]) - -proc load4(s: openArray[byte], o=0): uint32 {.inline.} = - when nimvm: result = load4e(s, o) - else: - when declared copyMem: - result = uint32(0) - copyMem result.addr, s[o].addr, result.sizeof - else: result = load4e(s, o) - -proc load8(s: openArray[byte], o=0): uint64 {.inline.} = - when nimvm: result = load8e(s, o) - else: - when declared copyMem: - result = uint64(0) - copyMem result.addr, s[o].addr, result.sizeof - else: result = load8e(s, o) - proc lenU(s: openArray[byte]): uint64 {.inline.} = s.len.uint64 proc shiftMix(v: uint64): uint64 {.inline.} = v xor (v shr 47) diff --git a/lib/pure/httpclient.nim b/lib/pure/httpclient.nim index ff6fcb3a66..ecd3b3e8e0 100644 --- a/lib/pure/httpclient.nim +++ b/lib/pure/httpclient.nim @@ -573,7 +573,7 @@ proc generateHeaders(requestUrl: Uri, httpMethod: HttpMethod, headers: HttpHeade result = $httpMethod result.add ' ' - if proxy.isNil or (requestUrl.scheme == "https" and proxy.url.scheme == "socks5h"): + if proxy.isNil or requestUrl.scheme == "https": # /path?query if not requestUrl.path.startsWith("/"): result.add '/' result.add(requestUrl.path) diff --git a/lib/pure/memfiles.nim b/lib/pure/memfiles.nim index 2ba26e5c84..8e2f61868e 100644 --- a/lib/pure/memfiles.nim +++ b/lib/pure/memfiles.nim @@ -57,8 +57,12 @@ proc setFileSize(fh: FileHandle, newFileSize = -1, oldSize = -1): OSErrorCode = when declared(posix_fallocate): while (e = posix_fallocate(fh, 0, newFileSize); e == EINTR): discard - if (e == EINVAL or e == EOPNOTSUPP) and ftruncate(fh, newFileSize) == -1: - result = osLastError() # fallback arguable; Most portable BUT allows SEGV + if e == EINVAL or e == EOPNOTSUPP or e == ENOSYS: + # fallback arguable; Most portable BUT allows SEGV + if ftruncate(fh, newFileSize) == -1: + result = osLastError() + else: + discard elif e != 0: result = osLastError() else: # shrink the file diff --git a/lib/pure/parsecfg.nim b/lib/pure/parsecfg.nim index 99b1c9a41e..c5e71c0179 100644 --- a/lib/pure/parsecfg.nim +++ b/lib/pure/parsecfg.nim @@ -170,7 +170,7 @@ runnableExamples: assert dict.getSectionValue(section4, "does_that_mean_anything_special") == "False" assert dict.getSectionValue(section4, "purpose") == "formatting for readability" -import std/[strutils, lexbase, streams, tables] +import std/[strformat, strutils, lexbase, streams, tables] import std/private/decode_helpers import std/private/since @@ -220,7 +220,7 @@ type const SymChars = {'a'..'z', 'A'..'Z', '0'..'9', '_', ' ', '\x80'..'\xFF', '.', '/', '\\', '-'} -proc rawGetTok(c: var CfgParser, tok: var Token) {.gcsafe.} +proc rawGetTok(c: var CfgParser, tok: var Token) {.gcsafe, raises: [ValueError, OSError, IOError].} proc open*(c: var CfgParser, input: Stream, filename: string, lineOffset = 0) {.rtl, extern: "npc$1".} = @@ -428,14 +428,12 @@ proc rawGetTok(c: var CfgParser, tok: var Token) = proc errorStr*(c: CfgParser, msg: string): string {.rtl, extern: "npc$1".} = ## Returns a properly formatted error message containing current line and ## column information. - result = `%`("$1($2, $3) Error: $4", - [c.filename, $getLine(c), $getColumn(c), msg]) + &"{c.filename}({getLine(c)}, {getColumn(c)}) Error: {msg}" proc warningStr*(c: CfgParser, msg: string): string {.rtl, extern: "npc$1".} = ## Returns a properly formatted warning message containing current line and ## column information. - result = `%`("$1($2, $3) Warning: $4", - [c.filename, $getLine(c), $getColumn(c), msg]) + &"{c.filename}({getLine(c)}, {getColumn(c)}) Warning: {msg}" proc ignoreMsg*(c: CfgParser, e: CfgEvent): string {.rtl, extern: "npc$1".} = ## Returns a properly formatted warning message containing that diff --git a/lib/pure/pegs.nim b/lib/pure/pegs.nim index 451c7ee035..97d586a7c1 100644 --- a/lib/pure/pegs.nim +++ b/lib/pure/pegs.nim @@ -19,10 +19,12 @@ include "system/inclrtl" when defined(nimPreviewSlimSystem): import std/[syncio, assertions] +{.push gcsafe.} + const useUnicode = true ## change this to deactivate proper UTF-8 support -import std/[strutils, macros] +import std/[strformat, strutils, macros] import std/private/decode_helpers when useUnicode: @@ -562,10 +564,10 @@ template matchOrParse(mopProc: untyped) = # procs. For the former, *enter* and *leave* event handler code generators # are provided which just return *discard*. - proc mopProc(s: string, p: Peg, start: int, c: var Captures): int {.gcsafe, raises: [].} = + proc mopProc(s: string, p: Peg, start: int, c: var Captures): int {.raises: [].} = result = 0 - proc matchBackRef(s: string, p: Peg, start: int, c: var Captures): int = + proc matchBackRef(s: string, p: Peg, start: int, c: var Captures): int {.raises: [].}= # Parse handler code must run in an *of* clause of its own for each # *PegKind*, so we encapsulate the identical clause body for # *pkBackRef..pkBackRefIgnoreStyle* here. @@ -1031,7 +1033,7 @@ template eventParser*(pegAst, handlers: untyped): (proc(s: string): int) = ## Symbols declared in an *enter* handler can be made visible in the ## corresponding *leave* handler by annotating them with an *inject* pragma. proc rawParse(s: string, p: Peg, start: int, c: var Captures): int - {.gensym.} = + {.gensym, raises: [ValueError].} = # binding from *macros* bind strVal @@ -1297,7 +1299,7 @@ when not defined(nimHasEffectsOf): {.pragma: effectsOf.} func replace*(s: string, sub: Peg, cb: proc( - match: int, cnt: int, caps: openArray[string]): string): string {. + match: int, cnt: int, caps: openArray[string]): string {.gcsafe.}): string {. rtl, extern: "npegs$1cb", effectsOf: cb.} = ## Replaces `sub` in `s` by the resulting strings from the callback. ## The callback proc receives the index of the current match (starting with 0), @@ -1343,7 +1345,7 @@ func replace*(s: string, sub: Peg, cb: proc( when not defined(js): proc transformFile*(infile, outfile: string, subs: varargs[tuple[pattern: Peg, repl: string]]) {. - rtl, extern: "npegs$1".} = + rtl, extern: "npegs$1", raises: [ValueError, IOError].} = ## reads in the file `infile`, performs a parallel replacement (calls ## `parallelReplace`) and writes back to `outfile`. Raises ``IOError`` if an ## error occurs. This is supposed to be used for quick scripting. @@ -1482,9 +1484,9 @@ func getLine(L: PegLexer): int {.inline.} = result = L.lineNumber func errorStr(L: PegLexer, msg: string, line = -1, col = -1): string = - var line = if line < 0: getLine(L) else: line - var col = if col < 0: getColumn(L) else: col - result = "$1($2, $3) Error: $4" % [L.filename, $line, $col, msg] + let line = if line < 0: getLine(L) else: line + let col = if col < 0: getColumn(L) else: col + &"{L.filename}({line}, {col}) Error: {msg}" func getEscapedChar(c: var PegLexer, tok: var Token) = inc(c.bufpos) @@ -1679,7 +1681,7 @@ func getBuiltin(c: var PegLexer, tok: var Token) = tok.kind = tkEscaped getEscapedChar(c, tok) # may set tok.kind to tkInvalid -func getTok(c: var PegLexer, tok: var Token) = +func getTok(c: var PegLexer, tok: var Token) {.raises: [].} = tok.kind = tkInvalid tok.modifier = modNone setLen(tok.literal, 0) @@ -1822,11 +1824,10 @@ type identIsVerbatim: bool skip: Peg -func pegError(p: PegParser, msg: string, line = -1, col = -1) {.noreturn.} = - var e = (ref EInvalidPeg)(msg: errorStr(p, msg, line, col)) - raise e +func pegError(p: PegParser, msg: string, line = -1, col = -1) {.noreturn, raises: [EInvalidPeg].} = + raise (ref EInvalidPeg)(msg: errorStr(p, msg, line, col)) -func getTok(p: var PegParser) = +func getTok(p: var PegParser) {.raises: [EInvalidPeg].}= getTok(p, p.tok) if p.tok.kind == tkInvalid: pegError(p, "'" & p.tok.literal & "' is invalid token") @@ -1834,7 +1835,7 @@ func eat(p: var PegParser, kind: TokKind) = if p.tok.kind == kind: getTok(p) else: pegError(p, tokKindToStr[kind] & " expected") -func parseExpr(p: var PegParser): Peg {.gcsafe.} +func parseExpr(p: var PegParser): Peg {.raises: [EInvalidPeg].} func getNonTerminal(p: var PegParser, name: string): NonTerminal = for i in 0..high(p.nonterms): @@ -1883,7 +1884,7 @@ func token(terminal: Peg, p: PegParser): Peg = if p.skip.kind == pkEmpty: result = terminal else: result = sequence(p.skip, terminal) -func primary(p: var PegParser): Peg = +func primary(p: var PegParser): Peg {.raises: [EInvalidPeg].}= case p.tok.kind of tkAmp: getTok(p) @@ -1976,7 +1977,7 @@ func primary(p: var PegParser): Peg = getTok(p) else: break -func seqExpr(p: var PegParser): Peg = +func seqExpr(p: var PegParser): Peg {.raises: [EInvalidPeg].}= result = primary(p) while true: case p.tok.kind @@ -2042,7 +2043,7 @@ func rawParse(p: var PegParser): Peg = elif ntUsed notin nt.flags and i > 0: pegError(p, "unused rule: " & nt.name, nt.line, nt.col) -func parsePeg*(pattern: string, filename = "pattern", line = 1, col = 0): Peg = +func parsePeg*(pattern: string, filename = "pattern", line = 1, col = 0): Peg {.raises: [EInvalidPeg].} = ## constructs a Peg object from `pattern`. `filename`, `line`, `col` are ## used for error messages, but they only provide start offsets. `parsePeg` ## keeps track of line and column numbers within `pattern`. @@ -2057,7 +2058,7 @@ func parsePeg*(pattern: string, filename = "pattern", line = 1, col = 0): Peg = getTok(p) result = rawParse(p) -func peg*(pattern: string): Peg = +func peg*(pattern: string): Peg {.raises: [EInvalidPeg].} = ## constructs a Peg object from the `pattern`. The short name has been ## chosen to encourage its use as a raw string modifier: ## diff --git a/lib/pure/terminal.nim b/lib/pure/terminal.nim index 895f658e4d..fb6b4748e2 100644 --- a/lib/pure/terminal.nim +++ b/lib/pure/terminal.nim @@ -909,6 +909,7 @@ when defined(windows): ## `true` otherwise. password.setLen(0) stdout.write(prompt) + stdout.flushFile() let hi = createFileA("CONIN$", GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0, 0) var mode = DWORD 0 @@ -936,6 +937,7 @@ else: cur.c_lflag = cur.c_lflag and not Cflag(ECHO) discard fd.tcSetAttr(TCSADRAIN, cur.addr) stdout.write prompt + stdout.flushFile() result = stdin.readLine(password) stdout.write "\n" discard fd.tcSetAttr(TCSADRAIN, old.addr) diff --git a/lib/pure/unicode.nim b/lib/pure/unicode.nim index a953ce8ccd..6337c25a05 100644 --- a/lib/pure/unicode.nim +++ b/lib/pure/unicode.nim @@ -1037,6 +1037,19 @@ proc split*(s: openArray[char], sep: Rune, maxsplit: int = -1): seq[string] {.no ## that returns a sequence of substrings. accResult(split(s, sep, maxsplit)) +func getRuneHeadIdx(s: openArray[char], idx: int): int = + ## Given `[idx]` is within a Rune, then `s[result]` is the first byte of that Rune. + result = idx + if s[result] <= '\x7F': # 0b0111_1111 + return + # 0b1... + dec result + for _ in 0..1: + if s[result] >= '\xC0': # 0b11xx_xxxx + # 0b110... or 0b1110... + return + dec result + proc strip*(s: openArray[char], leading = true, trailing = true, runes: openArray[Rune] = unicodeSpaces): string {.noSideEffect, rtl, extern: "nucStrip".} = @@ -1073,18 +1086,9 @@ proc strip*(s: openArray[char], leading = true, trailing = true, xI: int rune: Rune while i >= 0: + i = getRuneHeadIdx(s, i) xI = i fastRuneAt(s, xI, rune) - var yI = i - 1 - while yI >= 0: - var - yIend = yI - pRune: Rune - fastRuneAt(s, yIend, pRune) - if yIend < xI: break - i = yI - rune = pRune - dec(yI) if not runes.contains(rune): eI = xI - 1 break diff --git a/lib/pure/unittest.nim b/lib/pure/unittest.nim index 38890b0d4f..f1e6138e45 100644 --- a/lib/pure/unittest.nim +++ b/lib/pure/unittest.nim @@ -547,14 +547,11 @@ template test*(name, body) {.dirty.} = for formatter in formatters: formatter.testStarted(name) - {.push warning[BareExcept]:off.} try: when declared(testSetupIMPLFlag): testSetupIMPL() when declared(testTeardownIMPLFlag): defer: testTeardownIMPL() - {.push warning[BareExcept]:on.} body - {.pop.} except Exception: let e = getCurrentException() @@ -577,7 +574,6 @@ template test*(name, body) {.dirty.} = ) testEnded(testResult) checkpoints = @[] - {.pop.} proc checkpoint*(msg: string) = ## Set a checkpoint identified by `msg`. Upon test failure all @@ -801,11 +797,8 @@ macro expect*(exceptions: varargs[typed], body: untyped): untyped = discard template expectBody(errorTypes, lineInfoLit, body): NimNode {.dirty.} = - {.push warning[BareExcept]:off.} try: - {.push warning[BareExcept]:on.} body - {.pop.} checkpoint(lineInfoLit & ": Expect Failed, no exception was thrown.") fail() except errorTypes: @@ -814,8 +807,6 @@ macro expect*(exceptions: varargs[typed], body: untyped): untyped = let err = getCurrentException() checkpoint(lineInfoLit & ": Expect Failed, " & $err.name & " was thrown.") fail() - {.pop.} - var errorTypes = newNimNode(nnkBracket) var hasException = false for exp in exceptions: diff --git a/lib/std/assertions.nim b/lib/std/assertions.nim index 56c37d2057..f31a8465af 100644 --- a/lib/std/assertions.nim +++ b/lib/std/assertions.nim @@ -19,12 +19,16 @@ import std/private/miscdollars type InstantiationInfo = tuple[filename: string, line: int, column: int] +{.push overflowChecks: off, rangeChecks: off.} + proc `$`(info: InstantiationInfo): string = # The +1 is needed here # instead of overriding `$` (and changing its meaning), consider explicit name. result = "" result.toLocation(info.filename, info.line, info.column + 1) +{.pop.} + # --------------------------------------------------------------------------- diff --git a/lib/std/enumutils.nim b/lib/std/enumutils.nim index 9c338817d3..8bb593d74d 100644 --- a/lib/std/enumutils.nim +++ b/lib/std/enumutils.nim @@ -47,7 +47,7 @@ macro genEnumCaseStmt*(typ: typedesc, argSym: typed, default: typed, of nnkEnumFieldDef: fVal = f[0].strVal case f[1].kind - of nnkStrLit: + of nnkStrLit .. nnkTripleStrLit: fStr = f[1].strVal of nnkTupleConstr: fStr = f[1][1].strVal @@ -57,7 +57,7 @@ macro genEnumCaseStmt*(typ: typedesc, argSym: typed, default: typed, fNum = f[1].intVal else: let fAst = f[0].getImpl - if fAst.kind == nnkStrLit: + if fAst.kind in {nnkStrLit .. nnkTripleStrLit}: fStr = fAst.strVal else: error("Invalid tuple syntax!", f[1]) diff --git a/lib/std/private/digitsutils.nim b/lib/std/private/digitsutils.nim index f2d0d25cba..73b28a68ba 100644 --- a/lib/std/private/digitsutils.nim +++ b/lib/std/private/digitsutils.nim @@ -29,18 +29,23 @@ const # doAssert res == digits100 # ``` -proc utoa2Digits*(buf: var openArray[char]; pos: int; digits: uint32) {.inline.} = +{.push checks: off, stackTrace: off.} + +when not defined(nimHasEnforceNoRaises): + {.pragma: enforceNoRaises.} + +proc utoa2Digits*(buf: var openArray[char]; pos: int; digits: uint32) {.inline, enforceNoRaises.} = buf[pos] = digits100[2 * digits] buf[pos+1] = digits100[2 * digits + 1] #copyMem(buf, unsafeAddr(digits100[2 * digits]), 2 * sizeof((char))) -proc trailingZeros2Digits*(digits: uint32): int {.inline.} = +proc trailingZeros2Digits*(digits: uint32): int {.inline, enforceNoRaises.} = trailingZeros100[digits] when defined(js): proc numToString(a: SomeInteger): cstring {.importjs: "((#) + \"\")".} -func addChars[T](result: var string, x: T, start: int, n: int) {.inline.} = +func addChars[T](result: var string, x: T, start: int, n: int) {.inline, enforceNoRaises.} = let old = result.len result.setLen old + n template impl = @@ -52,10 +57,10 @@ func addChars[T](result: var string, x: T, start: int, n: int) {.inline.} = {.noSideEffect.}: copyMem result[old].addr, x[start].unsafeAddr, n -func addChars[T](result: var string, x: T) {.inline.} = +func addChars[T](result: var string, x: T) {.inline, enforceNoRaises.} = addChars(result, x, 0, x.len) -func addIntImpl(result: var string, x: uint64) {.inline.} = +func addIntImpl(result: var string, x: uint64) {.inline, enforceNoRaises.} = var tmp {.noinit.}: array[24, char] var num = x var next = tmp.len - 1 @@ -79,8 +84,6 @@ func addIntImpl(result: var string, x: uint64) {.inline.} = dec next addChars(result, tmp, next, tmp.len - next) -when not defined(nimHasEnforceNoRaises): - {.pragma: enforceNoRaises.} func addInt*(result: var string, x: uint64) {.enforceNoRaises.} = when nimvm: addIntImpl(result, x) @@ -114,3 +117,5 @@ proc addInt*(result: var string; x: int64) {.enforceNoRaises.} = proc addInt*(result: var string; x: int) {.inline, enforceNoRaises.} = addInt(result, int64(x)) + +{.pop.} diff --git a/lib/std/private/miscdollars.nim b/lib/std/private/miscdollars.nim index 06fda6fa1a..77ba158b0c 100644 --- a/lib/std/private/miscdollars.nim +++ b/lib/std/private/miscdollars.nim @@ -4,7 +4,13 @@ template toLocation*(result: var string, file: string | cstring, line: int, col: ## avoids spurious allocations # Hopefully this can be re-used everywhere so that if a user needs to customize, # it can be done in a single place. - result.add file + when file is cstring: + var i = 0 + while file[i] != '\0': + add(result, file[i]) + inc i + else: + result.add file if line > 0: result.add "(" addInt(result, line) diff --git a/lib/std/private/ospaths2.nim b/lib/std/private/ospaths2.nim index 43185f50a0..240736856f 100644 --- a/lib/std/private/ospaths2.nim +++ b/lib/std/private/ospaths2.nim @@ -41,7 +41,7 @@ proc normalizePathAux(path: var string){.inline, raises: [], noSideEffect.} import std/private/osseps export osseps -proc absolutePathInternal(path: string): string {.gcsafe.} +proc absolutePathInternal(path: string): string {.gcsafe, raises: [ValueError, OSerror].} proc normalizePathEnd*(path: var string, trailingSep = false) = ## Ensures ``path`` has exactly 0 or 1 trailing `DirSep`, depending on diff --git a/lib/std/sysatomics.nim b/lib/std/sysatomics.nim index 2f203b3eb7..cc6000c206 100644 --- a/lib/std/sysatomics.nim +++ b/lib/std/sysatomics.nim @@ -230,11 +230,11 @@ elif someVcc: proc atomicCompareExchangeN*[T: ptr](p, expected: ptr T, desired: T, weak: bool, success_memmodel: AtomMemModel, failure_memmodel: AtomMemModel): bool = when sizeof(T) == 8: - interlockedCompareExchange64(p, cast[int64](desired), cast[int64](expected)) == - cast[int64](expected) + interlockedCompareExchange64(p, cast[int64](desired), cast[int64](expected[])) == + cast[int64](expected[]) elif sizeof(T) == 4: - interlockedCompareExchange32(p, cast[int32](desired), cast[int32](expected)) == - cast[int32](expected) + interlockedCompareExchange32(p, cast[int32](desired), cast[int32](expected[])) == + cast[int32](expected[]) proc atomicExchangeN*[T: ptr](p: ptr T, val: T, mem: AtomMemModel): T = when sizeof(T) == 8: diff --git a/lib/system.nim b/lib/system.nim index fece232b34..e51a0965f7 100644 --- a/lib/system.nim +++ b/lib/system.nim @@ -555,9 +555,6 @@ type when defined(nimIcIntegrityChecks): include "system/exceptions" -else: - import system/exceptions - export exceptions when defined(js) or defined(nimdoc): type @@ -1621,8 +1618,43 @@ proc instantiationInfo*(index = -1, fullPaths = false): tuple[ when notJSnotNims: import system/ansi_c - import system/memory + include system/sysmem +when notJSnotNims and defined(nimSeqsV2): + const nimStrVersion {.core.} = 2 + + type + NimStrPayloadBase = object + cap: int + + NimStrPayload {.core.} = object + cap: int + data: UncheckedArray[char] + + NimStringV2 {.core.} = object + len: int + p: ptr NimStrPayload ## can be nil if len == 0. + +when defined(windows): + proc GetLastError(): int32 {.header: "", nodecl.} + const ERROR_BAD_EXE_FORMAT = 193 + +when notJSnotNims: + when defined(nimSeqsV2): + proc nimToCStringConv(s: NimStringV2): cstring {.compilerproc, nonReloadable, inline.} + + when hostOS != "standalone" and hostOS != "any": + type + LibHandle = pointer # private type + ProcAddr = pointer # library loading and loading of procs: + + proc nimLoadLibrary(path: string): LibHandle {.compilerproc, hcrInline, nonReloadable.} + proc nimUnloadLibrary(lib: LibHandle) {.compilerproc, hcrInline, nonReloadable.} + proc nimGetProcAddr(lib: LibHandle, name: cstring): ProcAddr {.compilerproc, hcrInline, nonReloadable.} + + proc nimLoadLibraryError(path: string) {.compilerproc, hcrInline, nonReloadable.} + + include "system/dyncalls" {.push stackTrace: off.} @@ -1651,6 +1683,10 @@ when not defined(js) and defined(nimV2): vTable: UncheckedArray[pointer] # vtable for types PNimTypeV2 = ptr TNimTypeV2 +when not defined(nimIcIntegrityChecks): + import system/exceptions + export exceptions + when notJSnotNims and defined(nimSeqsV2): include "system/strs_v2" include "system/seqs_v2" @@ -1740,6 +1776,28 @@ when not defined(nimscript): when not declared(sysFatal): include "system/fatal" +proc echo*(x: varargs[typed, `$`]) {.magic: "Echo", benign, sideEffect.} + ## Writes and flushes the parameters to the standard output. + ## + ## Special built-in that takes a variable number of arguments. Each argument + ## is converted to a string via `$`, so it works for user-defined + ## types that have an overloaded `$` operator. + ## It is roughly equivalent to `writeLine(stdout, x); flushFile(stdout)`, but + ## available for the JavaScript target too. + ## + ## Unlike other IO operations this is guaranteed to be thread-safe as + ## `echo` is very often used for debugging convenience. If you want to use + ## `echo` inside a `proc without side effects + ## `_ you can use `debugEcho + ## <#debugEcho,varargs[typed,]>`_ instead. + +proc debugEcho*(x: varargs[typed, `$`]) {.magic: "Echo", noSideEffect, + tags: [], raises: [].} + ## Same as `echo <#echo,varargs[typed,]>`_, but as a special semantic rule, + ## `debugEcho` pretends to be free of side effects, so that it can be used + ## for debugging routines marked as `noSideEffect + ## `_. + type PFrame* = ptr TFrame ## Represents a runtime frame of the call stack; ## part of the debugger API. @@ -1754,6 +1812,15 @@ type when NimStackTraceMsgs: frameMsgLen*: int ## end position in frameMsgBuf for this frame. +when notJSnotNims and not gotoBasedExceptions: + type + PSafePoint = ptr TSafePoint + TSafePoint {.compilerproc, final.} = object + prev: PSafePoint # points to next safe point ON THE STACK + status: int + context: C_JmpBuf + SafePoint = TSafePoint + when defined(nimV2): var framePtr {.threadvar.}: PFrame @@ -1766,6 +1833,113 @@ template newException*(exceptn: typedesc, message: string; ## to `message`. Returns the new exception object. (ref exceptn)(msg: message, parent: parentException) +# we have to compute this here before turning it off in except.nim anyway ... +const NimStackTrace = compileOption("stacktrace") +const + usesDestructors = defined(gcDestructors) or defined(gcHooks) + +include "system/gc_interface" + +when notJSnotNims: + proc setControlCHook*(hook: proc () {.noconv.}) {.raises: [], gcsafe.} + ## Allows you to override the behaviour of your application when CTRL+C + ## is pressed. Only one such hook is supported. + ## + ## The handler runs inside a C signal handler and comes with similar + ## limitations. + ## + ## Allocating memory and interacting with most system calls, including using + ## `echo`, `string`, `seq`, raising or catching exceptions etc is undefined + ## behavior and will likely lead to application crashes. + ## + ## The OS may call the ctrl-c handler from any thread, including threads + ## that were not created by Nim, such as happens on Windows. + ## + ## ## Example: + ## + ## ```nim + ## var stop: Atomic[bool] + ## proc ctrlc() {.noconv.} = + ## # Using atomics types is safe! + ## stop.store(true) + ## + ## setControlCHook(ctrlc) + ## + ## while not stop.load(): + ## echo "Still running.." + ## sleep(1000) + ## ``` + + when not defined(noSignalHandler) and not defined(useNimRtl): + proc unsetControlCHook*() + ## Reverts a call to setControlCHook. + + when hostOS != "standalone": + proc getStackTrace*(): string {.gcsafe.} + ## Gets the current stack trace. This only works for debug builds. + + proc getStackTrace*(e: ref Exception): string {.gcsafe.} + ## Gets the stack trace associated with `e`, which is the stack that + ## lead to the `raise` statement. This only works for debug builds. + + var + globalRaiseHook*: proc (e: ref Exception): bool {.nimcall, benign.} + ## With this hook you can influence exception handling on a global level. + ## If not nil, every 'raise' statement ends up calling this hook. + ## + ## .. warning:: Ordinary application code should never set this hook! You better know what you do when setting this. + ## + ## If `globalRaiseHook` returns false, the exception is caught and does + ## not propagate further through the call stack. + + localRaiseHook* {.threadvar.}: proc (e: ref Exception): bool {.nimcall, benign.} + ## With this hook you can influence exception handling on a + ## thread local level. + ## If not nil, every 'raise' statement ends up calling this hook. + ## + ## .. warning:: Ordinary application code should never set this hook! You better know what you do when setting this. + ## + ## If `localRaiseHook` returns false, the exception + ## is caught and does not propagate further through the call stack. + + outOfMemHook*: proc () {.nimcall, tags: [], benign, raises: [].} + ## Set this variable to provide a procedure that should be called + ## in case of an `out of memory`:idx: event. The standard handler + ## writes an error message and terminates the program. + ## + ## `outOfMemHook` can be used to raise an exception in case of OOM like so: + ## + ## ```nim + ## var gOutOfMem: ref EOutOfMemory + ## new(gOutOfMem) # need to be allocated *before* OOM really happened! + ## gOutOfMem.msg = "out of memory" + ## + ## proc handleOOM() = + ## raise gOutOfMem + ## + ## system.outOfMemHook = handleOOM + ## ``` + ## + ## If the handler does not raise an exception, ordinary control flow + ## continues and the program is terminated. + + unhandledExceptionHook*: proc (e: ref Exception) {.nimcall, tags: [], benign, raises: [].} + ## Set this variable to provide a procedure that should be called + ## in case of an `unhandle exception` event. The standard handler + ## writes an error message and terminates the program, except when + ## using `--os:any` + + {.push stackTrace: off, profiler: off.} + when defined(memtracker): + include "system/memtracker" + + when hostOS == "standalone": + include "system/embedded" + else: + include "system/excpt" + {.pop.} + + when not defined(nimPreviewSlimSystem): import std/assertions export assertions @@ -1842,11 +2016,6 @@ proc `<`*[T: tuple](x, y: T): bool = return false -include "system/gc_interface" - -# we have to compute this here before turning it off in except.nim anyway ... -const NimStackTrace = compileOption("stacktrace") - import system/coro_detection {.push checks: off.} @@ -1855,53 +2024,6 @@ import system/coro_detection # however, stack-traces are available for most parts # of the code -when notJSnotNims: - var - globalRaiseHook*: proc (e: ref Exception): bool {.nimcall, benign.} - ## With this hook you can influence exception handling on a global level. - ## If not nil, every 'raise' statement ends up calling this hook. - ## - ## .. warning:: Ordinary application code should never set this hook! You better know what you do when setting this. - ## - ## If `globalRaiseHook` returns false, the exception is caught and does - ## not propagate further through the call stack. - - localRaiseHook* {.threadvar.}: proc (e: ref Exception): bool {.nimcall, benign.} - ## With this hook you can influence exception handling on a - ## thread local level. - ## If not nil, every 'raise' statement ends up calling this hook. - ## - ## .. warning:: Ordinary application code should never set this hook! You better know what you do when setting this. - ## - ## If `localRaiseHook` returns false, the exception - ## is caught and does not propagate further through the call stack. - - outOfMemHook*: proc () {.nimcall, tags: [], benign, raises: [].} - ## Set this variable to provide a procedure that should be called - ## in case of an `out of memory`:idx: event. The standard handler - ## writes an error message and terminates the program. - ## - ## `outOfMemHook` can be used to raise an exception in case of OOM like so: - ## - ## ```nim - ## var gOutOfMem: ref EOutOfMemory - ## new(gOutOfMem) # need to be allocated *before* OOM really happened! - ## gOutOfMem.msg = "out of memory" - ## - ## proc handleOOM() = - ## raise gOutOfMem - ## - ## system.outOfMemHook = handleOOM - ## ``` - ## - ## If the handler does not raise an exception, ordinary control flow - ## continues and the program is terminated. - unhandledExceptionHook*: proc (e: ref Exception) {.nimcall, tags: [], benign, raises: [].} - ## Set this variable to provide a procedure that should be called - ## in case of an `unhandle exception` event. The standard handler - ## writes an error message and terminates the program, except when - ## using `--os:any` - when defined(js) or defined(nimdoc): proc add*(x: var string, y: cstring) {.asmNoStackFrame.} = ## Appends `y` to `x` in place. @@ -1938,27 +2060,6 @@ elif hasAlloc: inc(i) {.pop.} -proc echo*(x: varargs[typed, `$`]) {.magic: "Echo", benign, sideEffect.} - ## Writes and flushes the parameters to the standard output. - ## - ## Special built-in that takes a variable number of arguments. Each argument - ## is converted to a string via `$`, so it works for user-defined - ## types that have an overloaded `$` operator. - ## It is roughly equivalent to `writeLine(stdout, x); flushFile(stdout)`, but - ## available for the JavaScript target too. - ## - ## Unlike other IO operations this is guaranteed to be thread-safe as - ## `echo` is very often used for debugging convenience. If you want to use - ## `echo` inside a `proc without side effects - ## `_ you can use `debugEcho - ## <#debugEcho,varargs[typed,]>`_ instead. - -proc debugEcho*(x: varargs[typed, `$`]) {.magic: "Echo", noSideEffect, - tags: [], raises: [].} - ## Same as `echo <#echo,varargs[typed,]>`_, but as a special semantic rule, - ## `debugEcho` pretends to be free of side effects, so that it can be used - ## for debugging routines marked as `noSideEffect - ## `_. when hostOS == "standalone" and defined(nogc): proc nimToCStringConv(s: NimString): cstring {.compilerproc, inline.} = @@ -2028,6 +2129,16 @@ template unlikely*(val: bool): bool = import system/dollars export dollars +when notJSnotNims: + {.push stackTrace: off, profiler: off.} + + include "system/chcks" + + # we cannot compile this with stack tracing on + # as it would recurse endlessly! + include "system/integerops" + {.pop.} + when defined(nimAuditDelete): {.pragma: auditDelete, deprecated: "review this call for out of bounds behavior".} else: @@ -2110,17 +2221,17 @@ when notJSnotNims: nimZeroMem(p, size) when declared(memTrackerOp): memTrackerOp("zeroMem", p, size) - proc copyMem(dest, source: pointer, size: Natural) = + proc copyMem(dest, source: pointer, size: Natural) {.enforceNoRaises.} = nimCopyMem(dest, source, size) when declared(memTrackerOp): memTrackerOp("copyMem", dest, size) - proc moveMem(dest, source: pointer, size: Natural) = + proc moveMem(dest, source: pointer, size: Natural) {.enforceNoRaises.} = c_memmove(dest, source, csize_t(size)) when declared(memTrackerOp): memTrackerOp("moveMem", dest, size) - proc equalMem(a, b: pointer, size: Natural): bool = + proc equalMem(a, b: pointer, size: Natural): bool {.enforceNoRaises.} = nimCmpMem(a, b, size) == 0 - proc cmpMem(a, b: pointer, size: Natural): int = + proc cmpMem(a, b: pointer, size: Natural): int {.enforceNoRaises.} = nimCmpMem(a, b, size).int when not defined(js) or defined(nimscript): @@ -2173,14 +2284,36 @@ when not defined(js) and declared(alloc0) and declared(dealloc): inc(i) dealloc(a) -when notJSnotNims and not gotoBasedExceptions: - type - PSafePoint = ptr TSafePoint - TSafePoint {.compilerproc, final.} = object - prev: PSafePoint # points to next safe point ON THE STACK - status: int - context: C_JmpBuf - SafePoint = TSafePoint +when notJSnotNims and hostOS != "standalone": + proc getCurrentException*(): ref Exception {.compilerRtl, inl, benign.} = + ## Retrieves the current exception; if there is none, `nil` is returned. + result = currException + + proc nimBorrowCurrentException(): ref Exception {.compilerRtl, inl, benign, nodestroy.} = + # .nodestroy here so that we do not produce a write barrier as the + # C codegen only uses it in a borrowed way: + result = currException + + proc getCurrentExceptionMsg*(): string {.inline, benign.} = + ## Retrieves the error message that was attached to the current + ## exception; if there is none, `""` is returned. + return if currException == nil: "" else: currException.msg + + proc setCurrentException*(exc: ref Exception) {.inline, benign.} = + ## Sets the current exception. + ## + ## .. warning:: Only use this if you know what you are doing. + currException = exc + + proc raiseDefect() {.compilerRtl.} = + let e = getCurrentException() + if e of Defect: + reportUnhandledError(e) + rawQuit(1) + +elif defined(nimscript): + proc getCurrentException*(): ref Exception {.compilerRtl.} = discard + proc raiseDefect*() {.compilerRtl.} = discard when not defined(js): when hasThreadSupport: @@ -2194,63 +2327,6 @@ when not defined(js): when not defined(useNimRtl) and not defined(createNimRtl): initStackBottom() when declared(initGC): initGC() -when notJSnotNims: - proc setControlCHook*(hook: proc () {.noconv.}) {.raises: [], gcsafe.} - ## Allows you to override the behaviour of your application when CTRL+C - ## is pressed. Only one such hook is supported. - ## - ## The handler runs inside a C signal handler and comes with similar - ## limitations. - ## - ## Allocating memory and interacting with most system calls, including using - ## `echo`, `string`, `seq`, raising or catching exceptions etc is undefined - ## behavior and will likely lead to application crashes. - ## - ## The OS may call the ctrl-c handler from any thread, including threads - ## that were not created by Nim, such as happens on Windows. - ## - ## ## Example: - ## - ## ```nim - ## var stop: Atomic[bool] - ## proc ctrlc() {.noconv.} = - ## # Using atomics types is safe! - ## stop.store(true) - ## - ## setControlCHook(ctrlc) - ## - ## while not stop.load(): - ## echo "Still running.." - ## sleep(1000) - ## ``` - - when not defined(noSignalHandler) and not defined(useNimRtl): - proc unsetControlCHook*() - ## Reverts a call to setControlCHook. - - when hostOS != "standalone": - proc getStackTrace*(): string {.gcsafe.} - ## Gets the current stack trace. This only works for debug builds. - - proc getStackTrace*(e: ref Exception): string {.gcsafe.} - ## Gets the stack trace associated with `e`, which is the stack that - ## lead to the `raise` statement. This only works for debug builds. - - {.push stackTrace: off, profiler: off.} - when defined(memtracker): - include "system/memtracker" - - when hostOS == "standalone": - include "system/embedded" - else: - include "system/excpt" - include "system/chcks" - - # we cannot compile this with stack tracing on - # as it would recurse endlessly! - include "system/integerops" - {.pop.} - when not defined(js): # this is a hack: without this when statement, you would get: @@ -2260,19 +2336,6 @@ when not defined(js): when notJSnotNims: - when hostOS != "standalone" and hostOS != "any": - type - LibHandle = pointer # private type - ProcAddr = pointer # library loading and loading of procs: - - proc nimLoadLibrary(path: string): LibHandle {.compilerproc, hcrInline, nonReloadable.} - proc nimUnloadLibrary(lib: LibHandle) {.compilerproc, hcrInline, nonReloadable.} - proc nimGetProcAddr(lib: LibHandle, name: cstring): ProcAddr {.compilerproc, hcrInline, nonReloadable.} - - proc nimLoadLibraryError(path: string) {.compilerproc, hcrInline, nonReloadable.} - - include "system/dyncalls" - import system/countbits_impl include "system/sets" @@ -2324,37 +2387,6 @@ when notJSnotNims and hasThreadSupport and hostOS != "standalone": include "system/channels_builtin" -when notJSnotNims and hostOS != "standalone": - proc getCurrentException*(): ref Exception {.compilerRtl, inl, benign.} = - ## Retrieves the current exception; if there is none, `nil` is returned. - result = currException - - proc nimBorrowCurrentException(): ref Exception {.compilerRtl, inl, benign, nodestroy.} = - # .nodestroy here so that we do not produce a write barrier as the - # C codegen only uses it in a borrowed way: - result = currException - - proc getCurrentExceptionMsg*(): string {.inline, benign.} = - ## Retrieves the error message that was attached to the current - ## exception; if there is none, `""` is returned. - return if currException == nil: "" else: currException.msg - - proc setCurrentException*(exc: ref Exception) {.inline, benign.} = - ## Sets the current exception. - ## - ## .. warning:: Only use this if you know what you are doing. - currException = exc - - proc raiseDefect() {.compilerRtl.} = - let e = getCurrentException() - if e of Defect: - reportUnhandledError(e) - rawQuit(1) - -elif defined(nimscript): - proc getCurrentException*(): ref Exception {.compilerRtl.} = discard - proc raiseDefect*() {.compilerRtl.} = discard - when notJSnotNims: {.push stackTrace: off, profiler: off.} when (defined(profiler) or defined(memProfiler)): diff --git a/lib/system/alloc.nim b/lib/system/alloc.nim index fcb7ccb0c8..8a29b3bf30 100644 --- a/lib/system/alloc.nim +++ b/lib/system/alloc.nim @@ -11,7 +11,6 @@ {.push profiler:off.} include osalloc -import std/private/syslocks template track(op, address, size) = when defined(memTracker): @@ -837,6 +836,15 @@ when defined(gcDestructors): dec maxIters if it == nil: break +when defined(heaptrack): + const heaptrackLib = + when defined(heaptrack_inject): + "libheaptrack_inject.so" + else: + "libheaptrack_preload.so" + proc heaptrack_malloc(a: pointer, size: int) {.cdecl, importc, dynlib: heaptrackLib.} + proc heaptrack_free(a: pointer) {.cdecl, importc, dynlib: heaptrackLib.} + proc rawAlloc(a: var MemRegion, requestedSize: int): pointer = when defined(nimTypeNames): inc(a.allocCounter) @@ -959,6 +967,8 @@ proc rawAlloc(a: var MemRegion, requestedSize: int): pointer = sysAssert(isAccessible(a, result), "rawAlloc 14") sysAssert(allocInv(a), "rawAlloc: end") when logAlloc: cprintf("var pointer_%p = alloc(%ld) # %p\n", result, requestedSize, addr a) + when defined(heaptrack): + heaptrack_malloc(result, requestedSize) proc rawAlloc0(a: var MemRegion, requestedSize: int): pointer = result = rawAlloc(a, requestedSize) @@ -967,6 +977,8 @@ proc rawAlloc0(a: var MemRegion, requestedSize: int): pointer = proc rawDealloc(a: var MemRegion, p: pointer) = when defined(nimTypeNames): inc(a.deallocCounter) + when defined(heaptrack): + heaptrack_free(p) #sysAssert(isAllocatedPtr(a, p), "rawDealloc: no allocated pointer") sysAssert(allocInv(a), "rawDealloc: begin") var c = pageAddr(p) diff --git a/lib/system/arc.nim b/lib/system/arc.nim index 5677013013..14da1531c2 100644 --- a/lib/system/arc.nim +++ b/lib/system/arc.nim @@ -14,7 +14,7 @@ at offset 0 then. The ``ref`` object header is independent from the runtime type and only contains a reference count. ]# -{.push raises: [].} +{.push raises: [], rangeChecks: off.} when defined(gcOrc): const diff --git a/lib/system/arithmetics.nim b/lib/system/arithmetics.nim index e229a0f4b4..5711004822 100644 --- a/lib/system/arithmetics.nim +++ b/lib/system/arithmetics.nim @@ -1,4 +1,6 @@ -proc succ*[T, V: Ordinal](x: T, y: V = 1): T {.magic: "Succ", noSideEffect.} = +{.push stack_trace: off.} + +proc succ*[T: Ordinal, V: SomeInteger](x: T, y: V = 1): T {.magic: "Succ", noSideEffect.} = ## Returns the `y`-th successor (default: 1) of the value `x`. ## ## If such a value does not exist, `OverflowDefect` is raised @@ -7,7 +9,7 @@ proc succ*[T, V: Ordinal](x: T, y: V = 1): T {.magic: "Succ", noSideEffect.} = assert succ(5) == 6 assert succ(5, 3) == 8 -proc pred*[T, V: Ordinal](x: T, y: V = 1): T {.magic: "Pred", noSideEffect.} = +proc pred*[T: Ordinal, V: SomeInteger](x: T, y: V = 1): T {.magic: "Pred", noSideEffect.} = ## Returns the `y`-th predecessor (default: 1) of the value `x`. ## ## If such a value does not exist, `OverflowDefect` is raised @@ -16,7 +18,7 @@ proc pred*[T, V: Ordinal](x: T, y: V = 1): T {.magic: "Pred", noSideEffect.} = assert pred(5) == 4 assert pred(5, 3) == 2 -proc inc*[T, V: Ordinal](x: var T, y: V = 1) {.magic: "Inc", noSideEffect.} = +proc inc*[T: Ordinal, V: SomeInteger](x: var T, y: V = 1) {.magic: "Inc", noSideEffect.} = ## Increments the ordinal `x` by `y`. ## ## If such a value does not exist, `OverflowDefect` is raised or a compile @@ -28,7 +30,7 @@ proc inc*[T, V: Ordinal](x: var T, y: V = 1) {.magic: "Inc", noSideEffect.} = inc(i, 3) assert i == 6 -proc dec*[T, V: Ordinal](x: var T, y: V = 1) {.magic: "Dec", noSideEffect.} = +proc dec*[T: Ordinal, V: SomeInteger](x: var T, y: V = 1) {.magic: "Dec", noSideEffect.} = ## Decrements the ordinal `x` by `y`. ## ## If such a value does not exist, `OverflowDefect` is raised or a compile @@ -134,7 +136,10 @@ when defined(nimOldShiftRight): else: proc `shr`*(x: int, y: SomeInteger): int {.magic: "AshrI", noSideEffect.} = ## Computes the `shift right` operation of `x` and `y`, filling - ## vacant bit positions with the sign bit. + ## vacant bit positions with the sign bit. `y` (the number of + ## positions to shift) is reduced to modulo `sizeof(x) * 8`. + ## That is `15'i32 shr 35` is equivalent to `15'i32 shr 3` + ## bitmasked to always be in the range `0 ..< sizeof(int)`. ## ## **Note**: `Operator precedence `_ ## is different than in *C*. @@ -156,7 +161,9 @@ else: proc `shl`*(x: int, y: SomeInteger): int {.magic: "ShlI", noSideEffect.} = - ## Computes the `shift left` operation of `x` and `y`. + ## Computes the `shift left` operation of `x` and `y`. `y` (the number of + ## positions to shift) is reduced to modulo `sizeof(x) * 8`. + ## That is `15'i32 shl 35` is equivalent to `15'i32 shl 3`. ## ## **Note**: `Operator precedence `_ ## is different than in *C*. @@ -170,7 +177,9 @@ proc `shl`*(x: int64, y: SomeInteger): int64 {.magic: "ShlI", noSideEffect.} proc ashr*(x: int, y: SomeInteger): int {.magic: "AshrI", noSideEffect.} = ## Shifts right by pushing copies of the leftmost bit in from the left, - ## and let the rightmost bits fall off. + ## and let the rightmost bits fall off. `y` (the number of + ## positions to shift) is reduced to modulo `sizeof(x) * 8`. + ## That is `ashr(15'i32, 35)` is equivalent to `ashr(15'i32, 3)`. ## ## Note that `ashr` is not an operator so use the normal function ## call syntax for it. @@ -179,7 +188,7 @@ proc ashr*(x: int, y: SomeInteger): int {.magic: "AshrI", noSideEffect.} = ## * `shr func<#shr,int,SomeInteger>`_ runnableExamples: assert ashr(0b0001_0000'i8, 2) == 0b0000_0100'i8 - assert ashr(0b1000_0000'i8, 8) == 0b1111_1111'i8 + assert ashr(0b1000_0000'i8, 8) == 0b1000_0000'i8 assert ashr(0b1000_0000'i8, 1) == 0b1100_0000'i8 proc ashr*(x: int8, y: SomeInteger): int8 {.magic: "AshrI", noSideEffect.} proc ashr*(x: int16, y: SomeInteger): int16 {.magic: "AshrI", noSideEffect.} @@ -403,3 +412,5 @@ proc `%%`*(x, y: int8): int8 {.inline.} = cast[int8](cast[uint8](x) mod cast[u proc `%%`*(x, y: int16): int16 {.inline.} = cast[int16](cast[uint16](x) mod cast[uint16](y)) proc `%%`*(x, y: int32): int32 {.inline.} = cast[int32](cast[uint32](x) mod cast[uint32](y)) proc `%%`*(x, y: int64): int64 {.inline.} = cast[int64](cast[uint64](x) mod cast[uint64](y)) + +{.pop.} diff --git a/lib/system/channels_builtin.nim b/lib/system/channels_builtin.nim index 80eda56896..2123707301 100644 --- a/lib/system/channels_builtin.nim +++ b/lib/system/channels_builtin.nim @@ -138,11 +138,11 @@ ## localChannelExample() # "Hello from the main thread!" ## ``` +{.push raises: [], gcsafe.} + when not declared(ThisIsSystem): {.error: "You must not import this module explicitly".} -import std/private/syslocks - type pbytes = ptr UncheckedArray[byte] RawChannel {.pure, final.} = object ## msg queue for a thread @@ -365,23 +365,35 @@ proc sendImpl(q: PRawChannel, typ: PNimType, msg: pointer, noBlock: bool): bool releaseSys(q.lock) result = true -proc send*[TMsg](c: var Channel[TMsg], msg: sink TMsg) {.inline.} = - ## Sends a message to a thread. `msg` is deeply copied. - discard sendImpl(cast[PRawChannel](addr c), cast[PNimType](getTypeInfo(msg)), unsafeAddr(msg), false) - when defined(gcDestructors): +when defined(gcDestructors): + proc send*[TMsg](c: var Channel[TMsg], msg: sink TMsg) {.inline.} = + ## Sends a message to a thread. + discard sendImpl(cast[PRawChannel](addr c), cast[PNimType](getTypeInfo(msg)), unsafeAddr(msg), false) wasMoved(msg) -proc trySend*[TMsg](c: var Channel[TMsg], msg: sink TMsg): bool {.inline.} = - ## Tries to send a message to a thread. - ## - ## `msg` is deeply copied. Doesn't block. - ## - ## Returns `false` if the message was not sent because number of pending items - ## in the channel exceeded `maxItems`. - result = sendImpl(cast[PRawChannel](addr c), cast[PNimType](getTypeInfo(msg)), unsafeAddr(msg), true) - when defined(gcDestructors): + proc trySend*[TMsg](c: var Channel[TMsg], msg: sink TMsg): bool {.inline.} = + ## Tries to send a message to a thread. + ## + ## Doesn't block. + ## + ## Returns `false` if the message was not sent because number of pending items + ## in the channel exceeded `maxItems`. + result = sendImpl(cast[PRawChannel](addr c), cast[PNimType](getTypeInfo(msg)), unsafeAddr(msg), true) if result: wasMoved(msg) +else: + proc send*[TMsg](c: var Channel[TMsg], msg: TMsg) {.inline.} = + ## Sends a message to a thread. `msg` is deeply copied. + discard sendImpl(cast[PRawChannel](addr c), cast[PNimType](getTypeInfo(msg)), unsafeAddr(msg), false) + + proc trySend*[TMsg](c: var Channel[TMsg], msg: TMsg): bool {.inline.} = + ## Tries to send a message to a thread. + ## + ## `msg` is deeply copied. Doesn't block. + ## + ## Returns `false` if the message was not sent because number of pending items + ## in the channel exceeded `maxItems`. + result = sendImpl(cast[PRawChannel](addr c), cast[PNimType](getTypeInfo(msg)), unsafeAddr(msg), true) proc llRecv(q: PRawChannel, res: pointer, typ: PNimType) = q.ready = true @@ -390,7 +402,7 @@ proc llRecv(q: PRawChannel, res: pointer, typ: PNimType) = q.ready = false if typ != q.elemType: releaseSys(q.lock) - raise newException(ValueError, "cannot receive message of wrong type") + raiseAssert "cannot receive message of wrong type" rawRecv(q, res, typ) if q.maxItems > 0 and q.count == q.maxItems - 1: # Parent thread is awaiting in send. Wake it up. @@ -455,3 +467,5 @@ proc ready*[TMsg](c: var Channel[TMsg]): bool = ## new messages. var q = cast[PRawChannel](addr(c)) result = q.ready + +{.pop.} \ No newline at end of file diff --git a/lib/system/chcks.nim b/lib/system/chcks.nim index 1a7d7f0a90..901f7a5f2b 100644 --- a/lib/system/chcks.nim +++ b/lib/system/chcks.nim @@ -9,8 +9,6 @@ # Implementation of some runtime checks. include system/indexerrors -when defined(nimPreviewSlimSystem): - import std/formatfloat proc raiseRangeError(val: BiggestInt) {.compilerproc, noinline.} = when hostOS == "standalone": @@ -53,12 +51,6 @@ proc raiseRangeErrorI(i, a, b: BiggestInt) {.compilerproc, noinline.} = else: sysFatal(RangeDefect, "value out of range: " & $i & " notin " & $a & " .. " & $b) -proc raiseRangeErrorF(i, a, b: float) {.compilerproc, noinline.} = - when defined(standalone): - sysFatal(RangeDefect, "value out of range") - else: - sysFatal(RangeDefect, "value out of range: " & $i & " notin " & $a & " .. " & $b) - proc raiseRangeErrorU(i, a, b: uint64) {.compilerproc, noinline.} = # todo: better error reporting sysFatal(RangeDefect, "value out of range") @@ -97,16 +89,6 @@ proc chckRangeU(i, a, b: uint64): uint64 {.compilerproc.} = result = 0 sysFatal(RangeDefect, "value out of range") -proc chckRangeF(x, a, b: float): float = - if x >= a and x <= b: - return x - else: - result = 0.0 - when hostOS == "standalone": - sysFatal(RangeDefect, "value out of range") - else: - sysFatal(RangeDefect, "value out of range: ", $x) - proc chckNil(p: pointer) = if p == nil: sysFatal(NilAccessDefect, "attempt to write to a nil address") @@ -164,3 +146,30 @@ when not defined(nimV2): when defined(nimV2): proc raiseObjectCaseTransition() {.compilerproc.} = sysFatal(FieldDefect, "assignment to discriminant changes object branch") + +import std/formatfloat + +when not defined(nimPreviewSlimSystem): + export addFloat + +func f2s(x: float | float32): string = + ## Outplace version of `addFloat`. + result = "" + result.addFloat(x) + + +proc raiseRangeErrorF(i, a, b: float) {.compilerproc, noinline.} = + when defined(standalone): + sysFatal(RangeDefect, "value out of range") + else: + sysFatal(RangeDefect, "value out of range: " & f2s(i) & " notin " & f2s(a) & " .. " & f2s(b)) + +proc chckRangeF(x, a, b: float): float = + if x >= a and x <= b: + return x + else: + result = 0.0 + when hostOS == "standalone": + sysFatal(RangeDefect, "value out of range") + else: + sysFatal(RangeDefect, "value out of range: ", f2s(x)) diff --git a/lib/system/countbits_impl.nim b/lib/system/countbits_impl.nim index 34969cb328..d16f06ae79 100644 --- a/lib/system/countbits_impl.nim +++ b/lib/system/countbits_impl.nim @@ -85,9 +85,3 @@ func countSetBitsImpl*(x: SomeInteger): int {.inline.} = else: when sizeof(x) <= 4: result = countBitsImpl(x.uint32) else: result = countBitsImpl(x.uint64) - -proc countBits32*(n: uint32): int {.compilerproc, inline.} = - result = countSetBitsImpl(n) - -proc countBits64*(n: uint64): int {.compilerproc, inline.} = - result = countSetBitsImpl(n) diff --git a/lib/system/dyncalls.nim b/lib/system/dyncalls.nim index 817f7d8a5f..2088e466e3 100644 --- a/lib/system/dyncalls.nim +++ b/lib/system/dyncalls.nim @@ -12,7 +12,7 @@ # However, the interface has been designed to take platform differences into # account and been ported to all major platforms. -{.push stack_trace: off.} +{.push stack_trace: off, checks: off.} const NilLibHandle: LibHandle = nil diff --git a/lib/system/excpt.nim b/lib/system/excpt.nim index 511839914f..12552515cc 100644 --- a/lib/system/excpt.nim +++ b/lib/system/excpt.nim @@ -22,10 +22,6 @@ var ## instead of `stdmsg.write` when printing stacktrace. ## Unstable API. -when defined(windows): - proc GetLastError(): int32 {.header: "", nodecl.} - const ERROR_BAD_EXE_FORMAT = 193 - when not defined(windows) or not defined(guiapp): proc writeToStdErr(msg: cstring) = rawWrite(cstderr, msg) proc writeToStdErr(msg: cstring, length: int) = @@ -42,18 +38,22 @@ proc writeToStdErr(msg: string) {.inline.} = # fix bug #13115: handles correctly '\0' unlike default implicit conversion to cstring writeToStdErr(msg.cstring, msg.len) +proc cstrToStrBuiltin(x: cstring): string {.magic: "CStrToStr", noSideEffect.} +when defined(genode): + template `$`(s: string): string = s + proc showErrorMessage(data: cstring, length: int) {.gcsafe, raises: [].} = var toWrite = true if errorMessageWriter != nil: try: - errorMessageWriter($data) + errorMessageWriter(cstrToStrBuiltin data) toWrite = false except: discard if toWrite: when defined(genode): # stderr not available by default, use the LOG session - echo data + echo cstrToStrBuiltin(data) else: writeToStdErr(data, length) @@ -261,7 +261,10 @@ template addFrameEntry(s: var string, f: StackTraceEntry|PFrame) = var oldLen = s.len s.toLocation(f.filename, f.line, 0) for k in 1..max(1, 25-(s.len-oldLen)): add(s, ' ') - add(s, f.procname) + var i = 0 + while f.procname[i] != '\0': + add(s, f.procname[i]) + inc i when NimStackTraceMsgs: when typeof(f) is StackTraceEntry: add(s, f.frameMsg) @@ -282,9 +285,35 @@ proc `$`(stackTraceEntries: seq[StackTraceEntry]): string = elif s[i].line == reraisedFromEnd: result.add "]]\n" else: addFrameEntry(result, s[i]) -when hasSomeStackTrace: +const + Ten = ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - proc auxWriteStackTrace(f: PFrame, s: var string) = +proc i2s(x: int64): string = + # quick reimplementation; optimized for code size, no dependencies + if x < 0: + if x == -9223372036854775808: + result = "-9223372036854775808" + else: + result = "-" & i2s(0-x) + elif x < 10: + result = Ten[int x] # saves allocations + else: + var y = x + while true: + result.add char((y mod 10) + int('0')) + y = y div 10 + if y == 0: break + let last = result.len-1 + var i = 0 + let b = result.len div 2 + while i < b: + let ch = result[i] + result[i] = result[last-i] + result[last-i] = ch + inc i + +when hasSomeStackTrace: + proc auxWriteStackTrace(f: PFrame, s: var string) {.raises: [].} = when hasThreadSupport: var tempFrames: array[maxStackTraceLines, PFrame] # but better than a threadvar @@ -322,14 +351,14 @@ when hasSomeStackTrace: for j in countdown(i-1, 0): if tempFrames[j] == nil: add(s, "(") - add(s, $skipped) + s.add(i2s(skipped)) add(s, " calls omitted) ...\n") else: addFrameEntry(s, tempFrames[j]) proc stackTraceAvailable*(): bool - proc rawWriteStackTrace(s: var string) = + proc rawWriteStackTrace(s: var string) {.raises: [].} = when defined(nimStackTraceOverride): add(s, "Traceback (most recent call last, using override)\n") auxWriteStackTraceWithOverride(s) @@ -388,7 +417,7 @@ proc reportUnhandledErrorAux(e: ref Exception) {.nodestroy, gcsafe.} = add(buf, "Error: unhandled exception: ") add(buf, e.msg) add(buf, " [") - add(buf, $e.name) + add(buf, cstrToStrBuiltin(e.name)) add(buf, "]\n") if onUnhandledException != nil: @@ -418,7 +447,7 @@ proc reportUnhandledErrorAux(e: ref Exception) {.nodestroy, gcsafe.} = xadd(buf, e.name, e.name.len) add(buf, "]\n") if onUnhandledException != nil: - onUnhandledException($cast[cstring](buf.addr)) + onUnhandledException(cstrToStrBuiltin(cast[cstring](buf.addr))) else: showErrorMessage(cast[cstring](buf.addr), L) @@ -515,8 +544,7 @@ proc reraiseException() {.compilerRtl.} = else: raiseExceptionAux(currException) -proc threadTrouble() = - # also forward declared, it is 'raises: []' hence the try-except. +proc threadTrouble() {.raises: [], gcsafe.} = try: if currException != nil: reportUnhandledError(currException) except: @@ -559,13 +587,16 @@ const nimCallDepthLimit {.intdefine.} = 2000 proc callDepthLimitReached() {.noinline.} = writeStackTrace() - let msg = "Error: call depth limit reached in a debug build (" & - $nimCallDepthLimit & " function calls). You can change it with " & - "-d:nimCallDepthLimit= but really try to avoid deep " & - "recursions instead.\n" + var msg = "Error: call depth limit reached in a debug build (" + msg.add(i2s(nimCallDepthLimit)) + msg.add(" function calls). You can change it with " & + "-d:nimCallDepthLimit= but really try to avoid deep " & + "recursions instead.\n") showErrorMessage2(msg) rawQuit(1) +{.push overflowChecks: off.} + proc nimFrame(s: PFrame) {.compilerRtl, inl, raises: [].} = if framePtr == nil: s.calldepth = 0 @@ -577,6 +608,8 @@ proc nimFrame(s: PFrame) {.compilerRtl, inl, raises: [].} = framePtr = s if s.calldepth == nimCallDepthLimit: callDepthLimitReached() +{.pop.} + when defined(cpp) and appType != "lib" and not gotoBasedExceptions and not defined(js) and not defined(nimscript) and hostOS != "standalone" and hostOS != "any" and not defined(noCppExceptions) and @@ -601,9 +634,9 @@ when defined(cpp) and appType != "lib" and not gotoBasedExceptions and {.emit: "#endif".} except Exception: msg = currException.getStackTrace() & "Error: unhandled exception: " & - currException.msg & " [" & $currException.name & "]" + currException.msg & " [" & cstrToStrBuiltin(currException.name) & "]" except StdException as e: - msg = "Error: unhandled cpp exception: " & $e.what() + msg = "Error: unhandled cpp exception: " & cstrToStrBuiltin(e.what()) except: msg = "Error: unhandled unknown cpp exception" diff --git a/lib/system/gc.nim b/lib/system/gc.nim index c2fadd0725..3942e5eb7f 100644 --- a/lib/system/gc.nim +++ b/lib/system/gc.nim @@ -97,7 +97,7 @@ type waZctDecRef, waPush #, waDebug - Finalizer {.compilerproc.} = proc (self: pointer) {.nimcall, benign, raises: [].} + Finalizer {.compilerproc.} = proc (self: pointer) {.nimcall, benign, raises: [], gcsafe.} # A ref type can have a finalizer that is called before the object's # storage is freed. @@ -481,17 +481,17 @@ proc rawNewObj(typ: PNimType, size: int, gch: var GcHeap): pointer = {.pop.} # .stackTrace off {.pop.} # .profiler off -proc newObjNoInit(typ: PNimType, size: int): pointer {.compilerRtl.} = +proc newObjNoInit(typ: PNimType, size: int): pointer {.compilerRtl, raises: [].} = result = rawNewObj(typ, size, gch) when defined(memProfiler): nimProfile(size) -proc newObj(typ: PNimType, size: int): pointer {.compilerRtl, noinline.} = +proc newObj(typ: PNimType, size: int): pointer {.compilerRtl, noinline, raises: [].} = result = rawNewObj(typ, size, gch) zeroMem(result, size) when defined(memProfiler): nimProfile(size) {.push overflowChecks: on.} -proc newSeq(typ: PNimType, len: int): pointer {.compilerRtl.} = +proc newSeq(typ: PNimType, len: int): pointer {.compilerRtl, raises: [].} = # `newObj` already uses locks, so no need for them here. let size = align(GenericSeqSize, typ.base.align) + len * typ.base.size result = newObj(typ, size) @@ -500,7 +500,7 @@ proc newSeq(typ: PNimType, len: int): pointer {.compilerRtl.} = when defined(memProfiler): nimProfile(size) {.pop.} -proc newObjRC1(typ: PNimType, size: int): pointer {.compilerRtl, noinline.} = +proc newObjRC1(typ: PNimType, size: int): pointer {.compilerRtl, noinline, raises: [].} = # generates a new object and sets its reference counter to 1 incTypeSize typ, size sysAssert(allocInv(gch.region), "newObjRC1 begin") @@ -528,7 +528,7 @@ proc newObjRC1(typ: PNimType, size: int): pointer {.compilerRtl, noinline.} = when defined(memProfiler): nimProfile(size) {.push overflowChecks: on.} -proc newSeqRC1(typ: PNimType, len: int): pointer {.compilerRtl.} = +proc newSeqRC1(typ: PNimType, len: int): pointer {.compilerRtl, raises: [].} = let size = align(GenericSeqSize, typ.base.align) + len * typ.base.size result = newObjRC1(typ, size) cast[PGenericSeq](result).len = len @@ -670,7 +670,7 @@ proc doOperation(p: pointer, op: WalkOp) = add(gch.tempStack, c) #of waDebug: debugGraph(c) -proc nimGCvisit(d: pointer, op: int) {.compilerRtl.} = +proc nimGCvisit(d: pointer, op: int) {.compilerRtl, raises: [].} = doOperation(d, WalkOp(op)) proc collectZCT(gch: var GcHeap): bool {.benign, raises: [].} diff --git a/lib/system/gc_hooks.nim b/lib/system/gc_hooks.nim index ace62eea0a..936b31b20a 100644 --- a/lib/system/gc_hooks.nim +++ b/lib/system/gc_hooks.nim @@ -46,8 +46,8 @@ var newObjHook*: proc (typ: PNimType, size: int): pointer {.nimcall, tags: [], raises: [], gcsafe.} traverseObjHook*: proc (p: pointer, op: int) {.nimcall, tags: [], raises: [], gcsafe.} -proc nimGCvisit(p: pointer, op: int) {.inl, compilerRtl.} = +proc nimGCvisit(p: pointer, op: int) {.inl, compilerRtl, raises: [].} = traverseObjHook(p, op) -proc newObj(typ: PNimType, size: int): pointer {.inl, compilerRtl.} = +proc newObj(typ: PNimType, size: int): pointer {.inl, compilerRtl, raises: [].} = result = newObjHook(typ, size) diff --git a/lib/system/gc_interface.nim b/lib/system/gc_interface.nim index 4540db21f2..b34ce4a566 100644 --- a/lib/system/gc_interface.nim +++ b/lib/system/gc_interface.nim @@ -1,6 +1,4 @@ # ----------------- GC interface --------------------------------------------- -const - usesDestructors = defined(gcDestructors) or defined(gcHooks) when not usesDestructors: {.pragma: nodestroy.} diff --git a/lib/system/gc_ms.nim b/lib/system/gc_ms.nim index 5ea177b3e5..9efca9cbae 100644 --- a/lib/system/gc_ms.nim +++ b/lib/system/gc_ms.nim @@ -36,7 +36,7 @@ type # local waMarkPrecise # fast precise marking - Finalizer {.compilerproc.} = proc (self: pointer) {.nimcall, benign, raises: [].} + Finalizer {.compilerproc.} = proc (self: pointer) {.nimcall, benign, raises: [], gcsafe.} # A ref type can have a finalizer that is called before the object's # storage is freed. @@ -289,23 +289,23 @@ when useCellIds: {.pop.} -proc newObj(typ: PNimType, size: int): pointer {.compilerRtl.} = +proc newObj(typ: PNimType, size: int): pointer {.compilerRtl, raises: [].} = result = rawNewObj(typ, size, gch) zeroMem(result, size) when defined(memProfiler): nimProfile(size) -proc newObjNoInit(typ: PNimType, size: int): pointer {.compilerRtl.} = +proc newObjNoInit(typ: PNimType, size: int): pointer {.compilerRtl, raises: [].} = result = rawNewObj(typ, size, gch) when defined(memProfiler): nimProfile(size) -proc newObjRC1(typ: PNimType, size: int): pointer {.compilerRtl.} = +proc newObjRC1(typ: PNimType, size: int): pointer {.compilerRtl, raises: [].} = result = rawNewObj(typ, size, gch) zeroMem(result, size) when defined(memProfiler): nimProfile(size) when not defined(nimSeqsV2): {.push overflowChecks: on.} - proc newSeq(typ: PNimType, len: int): pointer {.compilerRtl.} = + proc newSeq(typ: PNimType, len: int): pointer {.compilerRtl, raises: [].} = # `newObj` already uses locks, so no need for them here. let size = align(GenericSeqSize, typ.base.align) + len * typ.base.size result = newObj(typ, size) @@ -313,7 +313,7 @@ when not defined(nimSeqsV2): cast[PGenericSeq](result).reserved = len when defined(memProfiler): nimProfile(size) - proc newSeqRC1(typ: PNimType, len: int): pointer {.compilerRtl.} = + proc newSeqRC1(typ: PNimType, len: int): pointer {.compilerRtl, raises: [].} = let size = align(GenericSeqSize, typ.base.align) + len * typ.base.size result = newObj(typ, size) cast[PGenericSeq](result).len = len @@ -346,7 +346,7 @@ when not defined(nimSeqsV2): result = cellToUsr(res) when defined(memProfiler): nimProfile(newsize-oldsize) - proc growObj(old: pointer, newsize: int): pointer {.rtl.} = + proc growObj(old: pointer, newsize: int): pointer {.rtl, raises: [].} = result = growObj(old, newsize, gch) {.push profiler:off.} diff --git a/lib/system/gc_regions.nim b/lib/system/gc_regions.nim index e18eade184..0385e2963d 100644 --- a/lib/system/gc_regions.nim +++ b/lib/system/gc_regions.nim @@ -6,6 +6,8 @@ # distribution, for details about the copyright. # +{.push raises: [], gcsafe.} + # "Stack GC" for embedded devices or ultra performance requirements. import std/private/syslocks @@ -39,7 +41,7 @@ else: # We also support 'finalizers'. type - Finalizer {.compilerproc.} = proc (self: pointer) {.nimcall, benign.} + Finalizer {.compilerproc.} = proc (self: pointer) {.nimcall, benign, raises: [], gcsafe.} # A ref type can have a finalizer that is called before the object's # storage is freed. @@ -305,26 +307,26 @@ proc rawNewSeq(r: var MemRegion, typ: PNimType, size: int): pointer = res.region = addr(r) result = res +! sizeof(SeqHeader) -proc newObj(typ: PNimType, size: int): pointer {.compilerRtl.} = +proc newObj(typ: PNimType, size: int): pointer {.compilerRtl, raises: [].} = sysAssert typ.kind notin {tySequence, tyString}, "newObj cannot be used to construct seqs" result = rawNewObj(tlRegion, typ, size) zeroMem(result, size) when defined(memProfiler): nimProfile(size) -proc newObjNoInit(typ: PNimType, size: int): pointer {.compilerRtl.} = +proc newObjNoInit(typ: PNimType, size: int): pointer {.compilerRtl, raises: [].} = sysAssert typ.kind notin {tySequence, tyString}, "newObj cannot be used to construct seqs" result = rawNewObj(tlRegion, typ, size) when defined(memProfiler): nimProfile(size) {.push overflowChecks: on.} -proc newSeq(typ: PNimType, len: int): pointer {.compilerRtl.} = +proc newSeq(typ: PNimType, len: int): pointer {.compilerRtl, raises: [].} = let size = roundup(align(GenericSeqSize, typ.base.align) + len * typ.base.size, MemAlign) result = rawNewSeq(tlRegion, typ, size) zeroMem(result, size) cast[PGenericSeq](result).len = len cast[PGenericSeq](result).reserved = len -proc newStr(typ: PNimType, len: int; init: bool): pointer {.compilerRtl.} = +proc newStr(typ: PNimType, len: int; init: bool): pointer {.compilerRtl, raises: [].} = let size = roundup(len + GenericSeqSize, MemAlign) result = rawNewSeq(tlRegion, typ, size) if init: zeroMem(result, size) @@ -332,14 +334,14 @@ proc newStr(typ: PNimType, len: int; init: bool): pointer {.compilerRtl.} = cast[PGenericSeq](result).reserved = len {.pop.} -proc newObjRC1(typ: PNimType, size: int): pointer {.compilerRtl.} = +proc newObjRC1(typ: PNimType, size: int): pointer {.compilerRtl, raises: [].} = result = rawNewObj(tlRegion, typ, size) zeroMem(result, size) -proc newSeqRC1(typ: PNimType, len: int): pointer {.compilerRtl.} = +proc newSeqRC1(typ: PNimType, len: int): pointer {.compilerRtl, raises: [].} = result = newSeq(typ, len) -proc growObj(regionUnused: var MemRegion; old: pointer, newsize: int): pointer = +proc growObj(regionUnused: var MemRegion; old: pointer, newsize: int): pointer {.raises: [].} = let sh = cast[ptr SeqHeader](old -! sizeof(SeqHeader)) let typ = sh.typ result = rawNewSeq(sh.region[], typ, @@ -351,7 +353,7 @@ proc growObj(regionUnused: var MemRegion; old: pointer, newsize: int): pointer = copyMem(result, old, oldsize) dealloc(sh.region[], old, roundup(oldsize, MemAlign)) -proc growObj(old: pointer, newsize: int): pointer {.rtl.} = +proc growObj(old: pointer, newsize: int): pointer {.rtl, raises: [].} = result = growObj(tlRegion, old, newsize) proc unsureAsgnRef(dest: PPointer, src: pointer) {.compilerproc, inline.} = @@ -434,3 +436,5 @@ proc nimGC_setStackBottom(theStackBottom: pointer) = discard proc nimGCref(x: pointer) {.compilerproc.} = discard proc nimGCunref(x: pointer) {.compilerproc.} = discard + +{.pop.} diff --git a/lib/system/jssys.nim b/lib/system/jssys.nim index 6934e67ee4..b469c4695f 100644 --- a/lib/system/jssys.nim +++ b/lib/system/jssys.nim @@ -687,6 +687,14 @@ proc isObj(obj, subclass: PNimType): bool {.compilerproc.} = proc addChar(x: string, c: char) {.compilerproc, asmNoStackFrame.} = {.emit: "`x`.push(`c`);".} +proc nimAddStrStr(x, y: string) {.compilerproc, asmNoStackFrame.} = + {.emit: """ + var L = `y`.length; + for (var i = 0; i < L; ++i) { + `x`.push(`y`[i]); + } + """.} + {.pop.} proc tenToThePowerOf(b: int): BiggestFloat = diff --git a/lib/system/memalloc.nim b/lib/system/memalloc.nim index 6347357347..b26f3af24d 100644 --- a/lib/system/memalloc.nim +++ b/lib/system/memalloc.nim @@ -1,13 +1,13 @@ when notJSnotNims: proc zeroMem*(p: pointer, size: Natural) {.inline, noSideEffect, - tags: [], raises: [].} + tags: [], raises: [], enforceNoRaises.} ## Overwrites the contents of the memory at `p` with the value 0. ## ## Exactly `size` bytes will be overwritten. Like any procedure ## dealing with raw memory this is **unsafe**. proc copyMem*(dest, source: pointer, size: Natural) {.inline, benign, - tags: [], raises: [].} + tags: [], raises: [], enforceNoRaises.} ## Copies the contents from the memory at `source` to the memory ## at `dest`. ## Exactly `size` bytes will be copied. The memory @@ -15,7 +15,7 @@ when notJSnotNims: ## memory this is **unsafe**. proc moveMem*(dest, source: pointer, size: Natural) {.inline, benign, - tags: [], raises: [].} + tags: [], raises: [], enforceNoRaises.} ## Copies the contents from the memory at `source` to the memory ## at `dest`. ## @@ -25,7 +25,7 @@ when notJSnotNims: ## dealing with raw memory this is still **unsafe**, though. proc equalMem*(a, b: pointer, size: Natural): bool {.inline, noSideEffect, - tags: [], raises: [].} + tags: [], raises: [], enforceNoRaises.} ## Compares the memory blocks `a` and `b`. `size` bytes will ## be compared. ## @@ -34,7 +34,7 @@ when notJSnotNims: ## **unsafe**. proc cmpMem*(a, b: pointer, size: Natural): int {.inline, noSideEffect, - tags: [], raises: [].} + tags: [], raises: [], enforceNoRaises.} ## Compares the memory blocks `a` and `b`. `size` bytes will ## be compared. ## diff --git a/lib/system/memory.nim b/lib/system/memory.nim index 156773c484..72a7b73d2c 100644 --- a/lib/system/memory.nim +++ b/lib/system/memory.nim @@ -2,10 +2,9 @@ const useLibC = not defined(nimNoLibc) -when useLibC: - import ansi_c +import ansi_c -proc nimCopyMem*(dest, source: pointer, size: Natural) {.nonReloadable, compilerproc, inline.} = +proc nimCopyMem*(dest, source: pointer, size: Natural) {.nonReloadable, inline, enforceNoRaises.} = when useLibC: c_memcpy(dest, source, cast[csize_t](size)) else: @@ -16,7 +15,7 @@ proc nimCopyMem*(dest, source: pointer, size: Natural) {.nonReloadable, compiler d[i] = s[i] inc i -proc nimSetMem*(a: pointer, v: cint, size: Natural) {.nonReloadable, inline.} = +proc nimSetMem*(a: pointer, v: cint, size: Natural) {.nonReloadable, inline, enforceNoRaises.} = when useLibC: c_memset(a, v, cast[csize_t](size)) else: @@ -27,10 +26,10 @@ proc nimSetMem*(a: pointer, v: cint, size: Natural) {.nonReloadable, inline.} = a[i] = v inc i -proc nimZeroMem*(p: pointer, size: Natural) {.compilerproc, nonReloadable, inline.} = +proc nimZeroMem*(p: pointer, size: Natural) {.nonReloadable, inline, enforceNoRaises.} = nimSetMem(p, 0, size) -proc nimCmpMem*(a, b: pointer, size: Natural): cint {.compilerproc, nonReloadable, inline.} = +proc nimCmpMem*(a, b: pointer, size: Natural): cint {.nonReloadable, inline, enforceNoRaises.} = when useLibC: c_memcmp(a, b, cast[csize_t](size)) else: @@ -42,7 +41,7 @@ proc nimCmpMem*(a, b: pointer, size: Natural): cint {.compilerproc, nonReloadabl if d != 0: return d inc i -proc nimCStrLen*(a: cstring): int {.compilerproc, nonReloadable, inline.} = +proc nimCStrLen*(a: cstring): int {.nonReloadable, inline, enforceNoRaises.} = if a.isNil: return 0 when useLibC: cast[int](c_strlen(a)) diff --git a/lib/system/mm/boehm.nim b/lib/system/mm/boehm.nim index 362d2d470b..1617bfec0e 100644 --- a/lib/system/mm/boehm.nim +++ b/lib/system/mm/boehm.nim @@ -1,4 +1,4 @@ - +{.push raises: [], gcsafe.} proc boehmGCinit {.importc: "GC_init", boehmGC.} @@ -95,7 +95,7 @@ proc initGC() = when hasThreadSupport: boehmGC_allow_register_threads() -proc boehmgc_finalizer(obj: pointer, typedFinalizer: (proc(x: pointer) {.cdecl.})) = +proc boehmgc_finalizer(obj: pointer, typedFinalizer: (proc(x: pointer) {.cdecl, raises: [], gcsafe.})) = typedFinalizer(obj) @@ -138,3 +138,5 @@ proc deallocOsPages(r: var MemRegion) {.inline.} = discard proc deallocOsPages() {.inline.} = discard include "system/cellsets" + +{.pop.} diff --git a/lib/system/mm/go.nim b/lib/system/mm/go.nim index 8f3aeb964c..853364bdb1 100644 --- a/lib/system/mm/go.nim +++ b/lib/system/mm/go.nim @@ -1,3 +1,4 @@ +{.push raises: [], gcsafe.} when defined(windows): const goLib = "libgo.dll" @@ -151,3 +152,5 @@ proc alloc0(r: var MemRegion, size: int): pointer = proc dealloc(r: var MemRegion, p: pointer) = dealloc(p) proc deallocOsPages(r: var MemRegion) {.inline.} = discard proc deallocOsPages() {.inline.} = discard + +{.pop.} diff --git a/lib/system/mm/none.nim b/lib/system/mm/none.nim index 7818a08054..53cea7f503 100644 --- a/lib/system/mm/none.nim +++ b/lib/system/mm/none.nim @@ -20,7 +20,7 @@ proc newObjNoInit(typ: PNimType, size: int): pointer = result = alloc(size) {.push overflowChecks: on.} -proc newSeq(typ: PNimType, len: int): pointer {.compilerproc.} = +proc newSeq(typ: PNimType, len: int): pointer {.compilerproc, raises: [].} = result = newObj(typ, align(GenericSeqSize, typ.align) + len * typ.base.size) cast[PGenericSeq](result).len = len cast[PGenericSeq](result).reserved = len diff --git a/lib/system/mmdisp.nim b/lib/system/mmdisp.nim index de82c0fb47..7fd61e0dc3 100644 --- a/lib/system/mmdisp.nim +++ b/lib/system/mmdisp.nim @@ -60,10 +60,10 @@ elif (defined(nogc) or defined(gcDestructors)) and defined(useMalloc): when defined(nogc): proc GC_getStatistics(): string = "" - proc newObj(typ: PNimType, size: int): pointer {.compilerproc.} = + proc newObj(typ: PNimType, size: int): pointer {.compilerproc, raises: [].} = result = alloc0(size) - proc newSeq(typ: PNimType, len: int): pointer {.compilerproc.} = + proc newSeq(typ: PNimType, len: int): pointer {.compilerproc, raises: [].} = result = newObj(typ, align(GenericSeqSize, typ.align) + len * typ.base.size) cast[PGenericSeq](result).len = len cast[PGenericSeq](result).reserved = len diff --git a/lib/system/osalloc.nim b/lib/system/osalloc.nim index 5509d0070c..5b6a191dfc 100644 --- a/lib/system/osalloc.nim +++ b/lib/system/osalloc.nim @@ -7,6 +7,8 @@ # distribution, for details about the copyright. # +{.push raises: [], gcsafe.} + proc roundup(x, v: int): int {.inline.} = result = (x + (v-1)) and not (v-1) sysAssert(result >= x, "roundup: result < x") @@ -216,3 +218,5 @@ elif hostOS == "standalone" or defined(StandaloneHeapSize): else: {.error: "Port memory manager to your platform".} + +{.pop.} diff --git a/lib/system/sets.nim b/lib/system/sets.nim index 97431c2964..d3b054c0ed 100644 --- a/lib/system/sets.nim +++ b/lib/system/sets.nim @@ -10,6 +10,13 @@ # set handling +# IC: compilerprocs now must be defined in system.nim or threadpool.nim! +proc countBits32*(n: uint32): int {.compilerproc, inline.} = + result = countSetBitsImpl(n) + +proc countBits64*(n: uint64): int {.compilerproc, inline.} = + result = countSetBitsImpl(n) + proc cardSetImpl(s: ptr UncheckedArray[uint8], len: int): int {.inline.} = var i = 0 result = 0 diff --git a/lib/system/stacktraces.nim b/lib/system/stacktraces.nim index 42be9d94fb..cdb24eaedf 100644 --- a/lib/system/stacktraces.nim +++ b/lib/system/stacktraces.nim @@ -29,6 +29,8 @@ when defined(nimStackTraceOverride): proc (programCounters: seq[cuintptr_t], maxLength: cint): seq[StackTraceEntry] {. nimcall, gcsafe, raises: [], tags: [], noinline.} + + # Default procedures (not normally used, because people opting in on this # override are supposed to register their own versions). var @@ -62,22 +64,34 @@ when defined(nimStackTraceOverride): let programCounters = stackTraceOverrideGetProgramCounters(maxStackTraceLines) if s.len == 0: s = newSeqOfCap[StackTraceEntry](programCounters.len) - for programCounter in programCounters: - s.add(StackTraceEntry(programCounter: cast[uint](programCounter))) + for i in 0.. 0: - result.add(stackTraceOverrideGetDebuggingInfo(programCounters, maxStackTraceLines)) + result.addStackTraceEntrySeq(stackTraceOverrideGetDebuggingInfo(programCounters, maxStackTraceLines)) diff --git a/lib/system/strs_v2.nim b/lib/system/strs_v2.nim index 95e76b1f8f..9861c9ae4e 100644 --- a/lib/system/strs_v2.nim +++ b/lib/system/strs_v2.nim @@ -9,19 +9,7 @@ ## Default new string implementation used by Nim's core. -type - NimStrPayloadBase = object - cap: int - - NimStrPayload {.core.} = object - cap: int - data: UncheckedArray[char] - - NimStringV2 {.core.} = object - len: int - p: ptr NimStrPayload ## can be nil if len == 0. - -const nimStrVersion {.core.} = 2 +{.push overflowChecks: off, rangeChecks: off.} template isLiteral(s): bool = (s.p == nil) or (s.p.cap and strlitFlag) == strlitFlag @@ -141,6 +129,10 @@ proc mnewString(len: int): NimStringV2 {.compilerproc.} = result = NimStringV2(len: len, p: p) proc setLengthStrV2(s: var NimStringV2, newLen: int) {.compilerRtl.} = + ## Sets the `s` length to `newLen` zeroing memory on growth. + ## Terminating zero at `s[newLen]` for cstring compatibility is set + ## on length change, **excluding** `newLen == 0`. + ## Negative `newLen` is **not** bound to zero. if newLen == 0: discard "do not free the buffer here, pattern 's.setLen 0' is common for avoiding allocations" else: @@ -223,3 +215,5 @@ func capacity*(self: string): int {.inline.} = let str = cast[ptr NimStringV2](unsafeAddr self) result = if str.p != nil: str.p.cap and not strlitFlag else: 0 + +{.pop.} diff --git a/lib/system/sysmem.nim b/lib/system/sysmem.nim new file mode 100644 index 0000000000..c1d1b57138 --- /dev/null +++ b/lib/system/sysmem.nim @@ -0,0 +1,52 @@ +{.push stack_trace: off.} + +const useLibC = not defined(nimNoLibc) + +proc nimCopyMem(dest, source: pointer, size: Natural) {.nonReloadable, compilerproc, inline, enforceNoRaises.} = + when useLibC: + c_memcpy(dest, source, cast[csize_t](size)) + else: + let d = cast[ptr UncheckedArray[byte]](dest) + let s = cast[ptr UncheckedArray[byte]](source) + var i = 0 + while i < size: + d[i] = s[i] + inc i + +proc nimSetMem(a: pointer, v: cint, size: Natural) {.nonReloadable, inline, enforceNoRaises.} = + when useLibC: + c_memset(a, v, cast[csize_t](size)) + else: + let a = cast[ptr UncheckedArray[byte]](a) + var i = 0 + let v = cast[byte](v) + while i < size: + a[i] = v + inc i + +proc nimZeroMem(p: pointer, size: Natural) {.compilerproc, nonReloadable, inline, enforceNoRaises.} = + nimSetMem(p, 0, size) + +proc nimCmpMem(a, b: pointer, size: Natural): cint {.compilerproc, nonReloadable, inline, enforceNoRaises.} = + when useLibC: + c_memcmp(a, b, cast[csize_t](size)) + else: + let a = cast[ptr UncheckedArray[byte]](a) + let b = cast[ptr UncheckedArray[byte]](b) + var i = 0 + while i < size: + let d = a[i].cint - b[i].cint + if d != 0: return d + inc i + +proc nimCStrLen*(a: cstring): int {.compilerproc, nonReloadable, inline, enforceNoRaises.} = + if a.isNil: return 0 + when useLibC: + cast[int](c_strlen(a)) + else: + var a = cast[ptr byte](a) + while a[] != 0: + a = cast[ptr byte](cast[uint](a) + 1) + inc result + +{.pop.} diff --git a/lib/system/sysstr.nim b/lib/system/sysstr.nim index 4fee660033..9110261ce9 100644 --- a/lib/system/sysstr.nim +++ b/lib/system/sysstr.nim @@ -15,6 +15,7 @@ # we don't use refcounts because that's a behaviour # the programmer may not want +{.push raises: [], gcsafe.} proc dataPointer(a: PGenericSeq, elemAlign: int): pointer = cast[pointer](cast[int](a) +% align(GenericSeqSize, elemAlign)) @@ -48,6 +49,8 @@ else: cast[NimString](newObjNoInit(addr(strDesc), size)) proc rawNewStringNoInit(space: int): NimString = + ## Returns a newly-allocated NimString with `reserved` set. + ## .. warning:: `len` and the terminating null-byte are not set! let s = max(space, 7) result = allocStrNoInit(sizeof(TGenericSeq) + s + 1) result.reserved = s @@ -55,11 +58,21 @@ proc rawNewStringNoInit(space: int): NimString = result.elemSize = 1 proc rawNewString(space: int): NimString {.compilerproc.} = + ## Returns a newly-allocated and *not* zeroed NimString + ## with everything required set: + ## - `reserved` + ## - `len` (0) + ## - terminating null-byte result = rawNewStringNoInit(space) result.len = 0 result.data[0] = '\0' proc mnewString(len: int): NimString {.compilerproc.} = + ## Returns a newly-allocated and zeroed NimString + ## with everything required set: + ## - `reserved` + ## - `len` + ## - terminating null-byte result = rawNewStringNoInit(len) result.len = len zeroMem(addr result.data[0], len + 1) @@ -91,29 +104,28 @@ proc toNimStr(str: cstring, len: int): NimString {.compilerproc.} = copyMem(addr(result.data), str, len) result.data[len] = '\0' +proc toOwnedCopy(src: NimString): NimString {.inline, raises: [].} = + ## Expects `src` to be not nil and initialized (len and terminating zero set) + result = rawNewStringNoInit(src.len) + result.len = src.len + copyMem(addr(result.data), addr(src.data), src.len + 1) + proc cstrToNimstr(str: cstring): NimString {.compilerRtl.} = if str == nil: NimString(nil) else: toNimStr(str, str.len) proc copyString(src: NimString): NimString {.compilerRtl.} = + ## Expects `src` to be initialized (len and terminating zero set) if src != nil: if (src.reserved and seqShallowFlag) != 0: result = src else: - result = rawNewStringNoInit(src.len) - result.len = src.len - copyMem(addr(result.data), addr(src.data), src.len + 1) + result = toOwnedCopy(src) sysAssert((seqShallowFlag and result.reserved) == 0, "copyString") when defined(nimShallowStrings): if (src.reserved and strlitFlag) != 0: result.reserved = (result.reserved and not strlitFlag) or seqShallowFlag -proc newOwnedString(src: NimString; n: int): NimString = - result = rawNewStringNoInit(n) - result.len = n - copyMem(addr(result.data), addr(src.data), n) - result.data[n] = '\0' - proc copyStringRC1(src: NimString): NimString {.compilerRtl.} = if src != nil: if (src.reserved and seqShallowFlag) != 0: @@ -129,39 +141,20 @@ proc copyStringRC1(src: NimString): NimString {.compilerRtl.} = result.reserved = s when defined(gogc): result.elemSize = 1 + result.len = src.len + copyMem(addr(result.data), addr(src.data), src.len + 1) else: - result = rawNewStringNoInit(src.len) - result.len = src.len - copyMem(addr(result.data), addr(src.data), src.len + 1) + result = toOwnedCopy(src) sysAssert((seqShallowFlag and result.reserved) == 0, "copyStringRC1") when defined(nimShallowStrings): if (src.reserved and strlitFlag) != 0: result.reserved = (result.reserved and not strlitFlag) or seqShallowFlag -proc copyDeepString(src: NimString): NimString {.inline.} = +proc copyDeepString(src: NimString): NimString {.inline, raises: [].} = if src != nil: - result = rawNewStringNoInit(src.len) - result.len = src.len - copyMem(addr(result.data), addr(src.data), src.len + 1) + result = toOwnedCopy(src) -proc addChar(s: NimString, c: char): NimString = - # is compilerproc! - if s == nil: - result = rawNewStringNoInit(1) - result.len = 0 - else: - result = s - if result.len >= result.space: - let r = resize(result.space) - result = rawNewStringNoInit(r) - result.len = s.len - copyMem(addr result.data[0], unsafeAddr(s.data[0]), s.len+1) - result.reserved = r - result.data[result.len] = c - result.data[result.len+1] = '\0' - inc(result.len) - -# These routines should be used like following: +# The following resize- and append- routines should be used like following: # # s &= "Hello " & name & ", how do you feel?" # @@ -193,46 +186,61 @@ proc addChar(s: NimString, c: char): NimString = # s = rawNewString(0); proc resizeString(dest: NimString, addlen: int): NimString {.compilerRtl.} = + ## Prepares `dest` for appending up to `addlen` new bytes. + ## .. warning:: Does not update `len`! if dest == nil: - result = rawNewString(addlen) - elif dest.len + addlen <= dest.space: + return rawNewString(addlen) + let futureLen = dest.len + addlen + if futureLen <= dest.space: result = dest else: # slow path: - let sp = max(resize(dest.space), dest.len + addlen) + # growth strategy: next `resize` step or exact `futureLen` if jumping over + let sp = max(resize(dest.space), futureLen) result = rawNewStringNoInit(sp) result.len = dest.len - copyMem(addr result.data[0], unsafeAddr(dest.data[0]), dest.len+1) - result.reserved = sp - #result = rawNewString(sp) - #copyMem(result, dest, dest.len + sizeof(TGenericSeq)) - # DO NOT UPDATE LEN YET: dest.len = newLen - -proc appendString(dest, src: NimString) {.compilerproc, inline.} = - if src != nil: - copyMem(addr(dest.data[dest.len]), addr(src.data), src.len + 1) - inc(dest.len, src.len) + # newFutureLen > space => addlen is never zero, copy terminating null anyway + copyMem(addr(result.data), addr(dest.data), dest.len + 1) proc appendChar(dest: NimString, c: char) {.compilerproc, inline.} = dest.data[dest.len] = c dest.data[dest.len+1] = '\0' inc(dest.len) -proc setLengthStr(s: NimString, newLen: int): NimString {.compilerRtl.} = - let n = max(newLen, 0) +proc addChar(s: NimString, c: char): NimString = + # is compilerproc! used in `ccgexprs.nim` if s == nil: - if n == 0: - return s - else: - result = mnewString(n) - elif n <= s.space: + result = rawNewStringNoInit(1) + result.len = 0 + else: result = s + if s.len >= s.space: # len.inc would overflow (`>` just in case) + let sp = resize(s.space) + result = rawNewStringNoInit(sp) + copyMem(addr(result.data), addr(s.data), s.len) + result.len = s.len + result.appendChar(c) + +proc appendString(dest, src: NimString) {.compilerproc, inline.} = + ## Raw, does not prepare `dest` space for copying + if src != nil: + copyMem(addr(dest.data[dest.len]), addr(src.data), src.len + 1) + inc(dest.len, src.len) + +proc setLengthStr(s: NimString, newLen: int): NimString {.compilerRtl.} = + ## Sets the `s` length to `newLen` zeroing memory on growth. + ## Terminating zero at `s[newLen]` for cstring compatibility is set + ## on any length change, including `newLen == 0`. + ## Negative `newLen` is bound to zero. + let n = max(newLen, 0) + if s == nil: # early return check + return if n == 0: s else: mnewString(n) # sets everything required + if n <= s.space: + result = s # len and null-byte still need updating else: let sp = max(resize(s.space), n) - result = rawNewStringNoInit(sp) - result.len = s.len - copyMem(addr result.data[0], unsafeAddr(s.data[0]), s.len) + result = rawNewStringNoInit(sp) # len and null-byte not set + copyMem(addr(result.data), addr(s.data), s.len) zeroMem(addr result.data[s.len], n - s.len) - result.reserved = sp result.len = n result.data[n] = '\0' @@ -252,14 +260,6 @@ proc incrSeq(seq: PGenericSeq, elemSize, elemAlign: int): PGenericSeq {.compiler result.reserved = r inc(result.len) -proc incrSeqV2(seq: PGenericSeq, elemSize, elemAlign: int): PGenericSeq {.compilerproc.} = - # incrSeq version 2 - result = seq - if result.len >= result.space: - let r = resize(result.space) - result = cast[PGenericSeq](growObj(result, align(GenericSeqSize, elemAlign) + elemSize * r)) - result.reserved = r - proc incrSeqV3(s: PGenericSeq, typ: PNimType): PGenericSeq {.compilerproc.} = if s == nil: result = cast[PGenericSeq](newSeq(typ, 1)) @@ -274,112 +274,68 @@ proc incrSeqV3(s: PGenericSeq, typ: PNimType): PGenericSeq {.compilerproc.} = # since we steal the content from 's', it's crucial to set s's len to 0. s.len = 0 -proc setLengthSeq(seq: PGenericSeq, elemSize, elemAlign, newLen: int): PGenericSeq {. - compilerRtl, inl.} = - result = seq - if result.space < newLen: - let r = max(resize(result.space), newLen) - result = cast[PGenericSeq](growObj(result, align(GenericSeqSize, elemAlign) + elemSize * r)) - result.reserved = r - elif newLen < result.len: - # we need to decref here, otherwise the GC leaks! - when not defined(boehmGC) and not defined(nogc) and - not defined(gcMarkAndSweep) and not defined(gogc) and - not defined(gcRegions): - if ntfNoRefs notin extGetCellType(result).base.flags: - for i in newLen..result.len-1: - forAllChildrenAux(dataPointer(result, elemAlign, elemSize, i), - extGetCellType(result).base, waZctDecRef) +proc extendCapacityRaw(src: PGenericSeq; typ: PNimType; + elemSize, elemAlign, newLen: int): PGenericSeq {.inline.} = + ## Reallocs `src` to fit `newLen` elements without any checks. + ## Capacity always increases to at least next `resize` step. + let newCap = max(resize(src.space), newLen) + result = cast[PGenericSeq](newSeq(typ, newCap)) + copyMem(dataPointer(result, elemAlign), dataPointer(src, elemAlign), src.len * elemSize) + # since we steal the content from 's', it's crucial to set s's len to 0. + src.len = 0 - # XXX: zeroing out the memory can still result in crashes if a wiped-out - # cell is aliased by another pointer (ie proc parameter or a let variable). - # This is a tough problem, because even if we don't zeroMem here, in the - # presence of user defined destructors, the user will expect the cell to be - # "destroyed" thus creating the same problem. We can destroy the cell in the - # finalizer of the sequence, but this makes destruction non-deterministic. - zeroMem(dataPointer(result, elemAlign, elemSize, newLen), (result.len-%newLen) *% elemSize) - result.len = newLen +proc truncateRaw(src: PGenericSeq; baseFlags: set[TNimTypeFlag]; isTrivial: bool; + elemSize, elemAlign, newLen: int): PGenericSeq {.inline.} = + ## Truncates `src` to `newLen` without any checks. + ## Does not set `src.len` + # sysAssert src.space > newlen + # sysAssert newLen < src.len + result = src + # we need to decref here, otherwise the GC leaks! + when not defined(boehmGC) and not defined(nogc) and + not defined(gcMarkAndSweep) and not defined(gogc) and + not defined(gcRegions): + if ntfNoRefs notin baseFlags: + for i in newLen.. s.space: + s.extendCapacityRaw(typ, elemSize, elemAlign, newLen) + elif newLen < s.len: + s.truncateRaw(typ.base.flags, isTrivial, elemSize, elemAlign, newLen) + else: + when doInit: + zeroMem(dataPointer(s, elemAlign, elemSize, s.len), (newLen-%s.len) *% elemSize) + s result.len = newLen +proc setLengthSeqUninit(s: PGenericSeq; typ: PNimType; newLen: int; isTrivial: bool): PGenericSeq {. + compilerRtl.} = + sysAssert typ.kind == tySequence, "setLengthSeqUninit: type is not a seq" + setLengthSeqImpl(s, typ, newLen, isTrivial, doInit = false) + proc setLengthSeqV2(s: PGenericSeq, typ: PNimType, newLen: int, isTrivial: bool): PGenericSeq {. compilerRtl.} = sysAssert typ.kind == tySequence, "setLengthSeqV2: type is not a seq" - if s == nil: - if newLen == 0: - result = s - else: - result = cast[PGenericSeq](newSeq(typ, newLen)) - else: - let elemSize = typ.base.size - let elemAlign = typ.base.align - if s.space < newLen: - let r = max(resize(s.space), newLen) - result = cast[PGenericSeq](newSeq(typ, r)) - copyMem(dataPointer(result, elemAlign), dataPointer(s, elemAlign), s.len * elemSize) - # since we steal the content from 's', it's crucial to set s's len to 0. - s.len = 0 - elif newLen < s.len: - result = s - # we need to decref here, otherwise the GC leaks! - when not defined(boehmGC) and not defined(nogc) and - not defined(gcMarkAndSweep) and not defined(gogc) and - not defined(gcRegions): - if ntfNoRefs notin typ.base.flags: - for i in newLen..result.len-1: - forAllChildrenAux(dataPointer(result, elemAlign, elemSize, i), - extGetCellType(result).base, waZctDecRef) - - # XXX: zeroing out the memory can still result in crashes if a wiped-out - # cell is aliased by another pointer (ie proc parameter or a let variable). - # This is a tough problem, because even if we don't zeroMem here, in the - # presence of user defined destructors, the user will expect the cell to be - # "destroyed" thus creating the same problem. We can destroy the cell in the - # finalizer of the sequence, but this makes destruction non-deterministic. - if not isTrivial: # optimization for trivial types - zeroMem(dataPointer(result, elemAlign, elemSize, newLen), (result.len-%newLen) *% elemSize) - else: - result = s - zeroMem(dataPointer(result, elemAlign, elemSize, result.len), (newLen-%result.len) *% elemSize) - result.len = newLen + setLengthSeqImpl(s, typ, newLen, isTrivial, doInit = true) func capacity*(self: string): int {.inline.} = ## Returns the current capacity of the string. @@ -402,3 +358,5 @@ func capacity*[T](self: seq[T]): int {.inline.} = let sek = cast[PGenericSeq](self) result = if sek != nil: sek.space else: 0 + +{.pop.} diff --git a/lib/system/threadimpl.nim b/lib/system/threadimpl.nim index 093a920a1d..dcd1b267a0 100644 --- a/lib/system/threadimpl.nim +++ b/lib/system/threadimpl.nim @@ -2,7 +2,7 @@ var nimThreadDestructionHandlers* {.rtlThreadVar.}: seq[proc () {.closure, gcsafe, raises: [].}] when not defined(boehmgc) and not hasSharedHeap and not defined(gogc) and not defined(gcRegions): proc deallocOsPages() {.rtl, raises: [].} -proc threadTrouble() {.raises: [], gcsafe.} + # create for the main thread. Note: do not insert this data into the list # of all threads; it's not to be stopped etc. when not defined(useNimRtl): diff --git a/nim.nimble b/nim.nimble index bf195b0faf..d188d03451 100644 --- a/nim.nimble +++ b/nim.nimble @@ -6,7 +6,7 @@ license = "MIT" bin = @["compiler/nim", "nimsuggest/nimsuggest"] skipFiles = @["azure-pipelines.yml" , "build_all.bat" , "build_all.sh" , "build_nimble.bat" , "build_nimble.sh" , "changelog.md" , "koch.nim.cfg" , "nimblemeta.json" , "readme.md" , "security.md" ] -skipDirs = @["build" , "changelogs" , "ci" , "csources_v2" , "drnim" , "nimdoc", "testament"] +skipDirs = @["build" , "changelogs" , "ci" , "csources_v3" , "drnim" , "nimdoc", "testament"] before install: when defined(windows): diff --git a/nimdoc/testproject/expected/nimdoc.out.css b/nimdoc/testproject/expected/nimdoc.out.css index 3fc453dc0b..1ca55a2bd0 100644 --- a/nimdoc/testproject/expected/nimdoc.out.css +++ b/nimdoc/testproject/expected/nimdoc.out.css @@ -181,6 +181,7 @@ body { .nine.columns { width: 75.0%; + margin-left: 0; padding-left: 1.5em; } .twelve.columns { @@ -192,7 +193,9 @@ body { display: none; } .nine.columns { - width: 98.0%; + width: 100%; + margin-left: 0; + padding-left: 0; } body { font-size: 1em; diff --git a/nimsuggest/nimsuggest.nim b/nimsuggest/nimsuggest.nim index 6144352f05..0e303cafae 100644 --- a/nimsuggest/nimsuggest.nim +++ b/nimsuggest/nimsuggest.nim @@ -1151,9 +1151,9 @@ proc executeNoHooksV3(cmd: IdeCmd, file: AbsoluteFile, dirtyfile: AbsoluteFile, # ideSug/ideCon performs partial build of the file, thus mark it dirty for the # future calls. graph.markDirtyIfNeeded(file.string, fileIndex) - graph.recompilePartially(fileIndex) + graph.recompilePartially(fileIndex) let m = graph.getModule fileIndex - incl m.flags, sfDirty + incl m, sfDirty of ideOutline: let n = parseFile(fileIndex, graph.cache, graph.config) graph.iterateOutlineNodes(n, graph.fileSymbols(fileIndex).deduplicateSymInfoPair(false)) diff --git a/nimsuggest/tester.nim b/nimsuggest/tester.nim index 9b9488348c..b69569288d 100644 --- a/nimsuggest/tester.nim +++ b/nimsuggest/tester.nim @@ -5,7 +5,7 @@ # When debugging, to run a single test, use for e.g.: # `nim r nimsuggest/tester.nim nimsuggest/tests/tsug_accquote.nim` -import os, osproc, strutils, streams, re, sexp, net +import os, osproc, strutils, streams, sexp, net from sequtils import toSeq type @@ -148,8 +148,28 @@ proc runCmd(cmd, dest: string): bool = quit "unknown command: " & cmd proc smartCompare(pattern, x: string): bool = - if pattern.contains('*'): - result = match(x, re(escapeRe(pattern).replace("\\x2A","(.*)"), {})) + let pp = splitLines(pattern.strip()) + let xx = splitLines(x.strip()) + if pp.len > xx.len: + return false + for l in 0..pp.len-1: + let p = pp[l].split('\t') + let x = xx[l].split('\t') + if p.len > x.len: + return false + for i in 0..p.len-1: + let starAt = p[i].find('*') + if starAt >= 0: + if p[i] == "*": + discard "field exists, that is good enough" + elif x[i].startsWith(p[i].substr(0, starAt-1)) and x[i].endsWith(p[i].substr(starAt+1)): + discard + else: + return false + else: + if x[i] != p[i]: + return false + return true proc sendEpcStr(socket: Socket; cmd: string) = let s = cmd.find(' ') diff --git a/nimsuggest/tests/tinclude.nim b/nimsuggest/tests/tinclude.nim index f5cbabf053..d47bce0748 100644 --- a/nimsuggest/tests/tinclude.nim +++ b/nimsuggest/tests/tinclude.nim @@ -17,9 +17,9 @@ def;;skType;;minclude_types.Greet;;Greet;;*fixtures/minclude_types.nim;;4;;2;;"" >def $path/fixtures/minclude_include.nim:3:71 def;;skType;;minclude_types.Greet;;Greet;;*fixtures/minclude_types.nim;;4;;2;;"";;100 >outline $path/fixtures/minclude_import.nim -outline;;skProc;;minclude_import.say;;*fixtures/minclude_import.nim;;7;;5;;"";;100 -outline;;skProc;;minclude_import.create;;*fixtures/minclude_include.nim;;3;;5;;"";;100 -outline;;skProc;;minclude_import.say;;*fixtures/minclude_import.nim;;13;;5;;"";;100 +outline;;skProc;;minclude_import.say;;*;;*fixtures/minclude_import.nim;;7;;5;;"";;100 +outline;;skProc;;minclude_import.create;;*;;*fixtures/minclude_include.nim;;3;;5;;"";;100 +outline;;skProc;;minclude_import.say;;*;;*fixtures/minclude_import.nim;;13;;5;;"";;100 """ # TODO test/fix if the first `def` is not first or repeated we get no results diff --git a/readme.md b/readme.md index 69899da71b..22d5294c2f 100644 --- a/readme.md +++ b/readme.md @@ -49,7 +49,7 @@ Compiling the Nim compiler is quite straightforward if you follow these steps: First, the C source of an older version of the Nim compiler is needed to bootstrap the latest version because the Nim compiler itself is written in the Nim programming language. Those C sources are available within the -[``nim-lang/csources_v2``][csources-v2-repo] repository. +[``nim-lang/csources_v3``][csources-v3-repo] repository. Next, to build from source you will need: @@ -202,7 +202,7 @@ Nim. You are explicitly permitted to develop commercial applications using Nim. Please read the [copying.txt](copying.txt) file for more details. -Copyright © 2006-2025 Andreas Rumpf, all rights reserved. +Copyright © 2006-2026 Andreas Rumpf, all rights reserved. [nim-site]: https://nim-lang.org [nim-forum]: https://forum.nim-lang.org @@ -221,7 +221,7 @@ Copyright © 2006-2025 Andreas Rumpf, all rights reserved. [nimble-repo]: https://github.com/nim-lang/nimble [nimsuggest-repo]: https://github.com/nim-lang/nimsuggest [csources-repo-deprecated]: https://github.com/nim-lang/csources -[csources-v2-repo]: https://github.com/nim-lang/csources_v2 +[csources-v3-repo]: https://github.com/nim-lang/csources_v3 [badge-nim-irc]: https://img.shields.io/badge/chat-on_irc-blue.svg?style=flat-square [badge-nim-discord]: https://img.shields.io/discord/371759389889003530?color=blue&label=discord&logo=discord&logoColor=gold&style=flat-square [badge-nim-gitter]: https://img.shields.io/badge/chat-on_gitter-blue.svg?style=flat-square diff --git a/testament/categories.nim b/testament/categories.nim index eba1e3cb27..b16ddbb91d 100644 --- a/testament/categories.nim +++ b/testament/categories.nim @@ -493,8 +493,8 @@ proc icTests(r: var TResults; testsDir: string, cat: Category, options: string; tooltests = ["compiler/nim.nim"] writeOnly = " --incremental:writeonly " readOnly = " --incremental:readonly " - incrementalOn = " --incremental:on -d:nimIcIntegrityChecks " - navTestConfig = " --ic:on -d:nimIcNavigatorTests --hint:Conf:off --warnings:off " + incrementalOn = " --incremental:legacy -d:nimIcIntegrityChecks " + navTestConfig = " --ic:legacy -d:nimIcNavigatorTests --hint:Conf:off --warnings:off " template test(x: untyped) = testSpecWithNimcache(r, makeRawTest(file, x & options, cat), nimcache) @@ -508,7 +508,7 @@ proc icTests(r: var TResults; testsDir: string, cat: Category, options: string; template checkTest() = var test = makeRawTest(file, options, cat) - test.spec.cmd = compilerPrefix & " check --hint:Conf:off --warnings:off --ic:on $options " & file + test.spec.cmd = compilerPrefix & " check --hint:Conf:off --warnings:off --ic:legacy $options " & file testSpecWithNimcache(r, test, nimcache) if not isNavigatorTest: diff --git a/testament/important_packages.nim b/testament/important_packages.nim index 68048cd6ac..ea1020944c 100644 --- a/testament/important_packages.nim +++ b/testament/important_packages.nim @@ -93,7 +93,7 @@ pkg "lockfreequeues" pkg "loopfusion" pkg "macroutils" pkg "manu" -pkg "markdown" +pkg "markdown", "nim c -r tests/testmarkdown.nim" pkg "measuremancer", "nimble testDeps; nimble -y test" pkg "memo" pkg "metrics" diff --git a/tests/arc/tgenerics.nim b/tests/arc/tgenerics.nim new file mode 100644 index 0000000000..20495dc029 --- /dev/null +++ b/tests/arc/tgenerics.nim @@ -0,0 +1,19 @@ +discard """ + matrix: "--mm:refc" +""" +type + State = enum + Uninit + Init + Uart[T: static State] = object + baudRate: int + port: int + +proc `=destroy`(uart: var Uart[Init]) = raiseAssert "Destroyed" + +# proc `=copy`(a: var Uart[Init], b: Uart[Init]) {.error.} # Error: signature for '=copy' must be proc[T: object](x: var T; y: T) + +proc main() = + var a = Uart[Uninit]() + +main() \ No newline at end of file diff --git a/tests/async/tasyncclosestall.nim b/tests/async/tasyncclosestall.nim index d1c7a5fbae..566523a726 100644 --- a/tests/async/tasyncclosestall.nim +++ b/tests/async/tasyncclosestall.nim @@ -8,7 +8,7 @@ import asyncdispatch, asyncnet when defined(windows): from winlean import ERROR_NETNAME_DELETED else: - from posix import EBADF + from posix import EBADF, ECONNRESET, EPIPE # This reproduces a case where a socket remains stuck waiting for writes # even when the socket is closed. @@ -18,12 +18,37 @@ var port = Port(0) var sent = 0 +proc isExpectedDisconnectionError(errCode: int32): bool = + ## Check if an error code indicates an expected disconnection. + ## On POSIX systems, the error code depends on timing: + ## - EBADF: Socket was closed locally before kernel detected remote state + ## - ECONNRESET: Remote peer sent RST packet (detected first) + ## - EPIPE: Socket is no longer connected (broken pipe) + ## All three are valid disconnection errors for this test scenario. + when defined(windows): + errCode == ERROR_NETNAME_DELETED + else: + errCode == EBADF or errCode == ECONNRESET or errCode == EPIPE + proc keepSendingTo(c: AsyncSocket) {.async.} = while true: # This write will eventually get stuck because the client is not reading # its messages. let sendFut = c.send("Foobar" & $sent & "\n", flags = {}) - if not await withTimeout(sendFut, timeout): + var sendTimedOut = false + try: + # On some platforms (notably macOS ARM64), the kernel may return + # ECONNRESET immediately when detecting a non-responsive connection, + # rather than letting the send stall. We catch this case here. + sendTimedOut = not await withTimeout(sendFut, timeout) + except OSError as e: + if isExpectedDisconnectionError(e.errorCode): + echo("send has errored. As expected. All good!") + quit(QuitSuccess) + else: + raise + + if sendTimedOut: # The write is stuck. Let's simulate a scenario where the socket # does not respond to PING messages, and we close it. The above future # should complete after the socket is closed, not continue stalling. @@ -38,26 +63,16 @@ proc keepSendingTo(c: AsyncSocket) {.async.} = # is raised which we classif as a "diconnection error", hence we overwrite # the flags above in the `send` call so that this error is raised. # - # On Linux the EBADF error code is raised, this is because the socket - # is closed. - # # This means that by default the behaviours will differ between Windows - # and Linux. I think this is fine though, it makes sense mainly because + # and POSIX. I think this is fine though, it makes sense mainly because # Windows doesn't use a IO readiness model. We can fix this later if # necessary to reclassify ERROR_NETNAME_DELETED as not a "disconnection # error" (TODO) - when defined(windows): - if errCode == ERROR_NETNAME_DELETED: - echo("send has errored. As expected. All good!") - quit(QuitSuccess) - else: - raise newException(ValueError, "Test failed. Send failed with code " & $errCode) + if isExpectedDisconnectionError(errCode): + echo("send has errored. As expected. All good!") + quit(QuitSuccess) else: - if errCode == EBADF: - echo("send has errored. As expected. All good!") - quit(QuitSuccess) - else: - raise newException(ValueError, "Test failed. Send failed with code " & $errCode) + raise newException(ValueError, "Test failed. Send failed with code " & $errCode) # The write shouldn't succeed and also shouldn't be stalled. if timeoutFut.read(): diff --git a/tests/ccgbugs/t25387.nim b/tests/ccgbugs/t25387.nim new file mode 100644 index 0000000000..d694e3351d --- /dev/null +++ b/tests/ccgbugs/t25387.nim @@ -0,0 +1,8 @@ +discard """ + matrix: "--embedsrc=on" +""" + +proc trim() = + let s = 10 + let x = s + 5 # user entered literal \ +trim() \ No newline at end of file diff --git a/tests/ccgbugs/timportc_field_init.nim b/tests/ccgbugs/timportc_field_init.nim new file mode 100644 index 0000000000..58075fc195 --- /dev/null +++ b/tests/ccgbugs/timportc_field_init.nim @@ -0,0 +1,178 @@ +discard """ + targets: "c cpp" +""" +# Test const initialization of objects with opaque importc fields (e.g. FILE from stdio.h) + +type OpaqueFile {.importc: "FILE", header: "".} = object + +type + SimpleStruct = object + normal: int + opaque: OpaqueFile + + NestedStruct = object + inner: SimpleStruct + value: float + + VariantStruct = object + case kind: bool + of true: + opaque: OpaqueFile + of false: + normal: int + + ArrayElementStruct = object + id: int + atom: OpaqueFile + +const simple = default(SimpleStruct) +const nested = default(NestedStruct) +const variant = default(VariantStruct) +const arr = default(array[3, ArrayElementStruct]) + +static: + doAssert simple.normal == 0 + doAssert nested.value == 0.0 + doAssert arr[0].id == 0 + +# completeStruct types use normal aggregate init +type CompleteImportc {.importc: "int", completeStruct, nodecl.} = object + value: cint + +type StructWithComplete = object + c: CompleteImportc + x: int + +const withComplete = default(StructWithComplete) + +type TupleWithOpaque = tuple[x: int, s: SimpleStruct, y: float] +const tupleVal = default(TupleWithOpaque) + +# Sandwich: opaque between non-opaque fields requires designated init +type SandwichStruct = object + first: int + opaque: OpaqueFile + last: float + +const sandwich = default(SandwichStruct) + +static: + doAssert withComplete.x == 0 + doAssert tupleVal.x == 0 + doAssert sandwich.first == 0 + doAssert sandwich.last == 0.0 + +proc useSimple(s: ptr SimpleStruct) {.exportc, noinline.} = discard +proc useNested(s: ptr NestedStruct) {.exportc, noinline.} = discard +proc useArr(a: ptr array[3, ArrayElementStruct]) {.exportc, noinline.} = discard +proc useComplete(s: ptr StructWithComplete) {.exportc, noinline.} = discard +proc useVariant(v: ptr VariantStruct) {.exportc, noinline.} = discard +proc useTuple(t: TupleWithOpaque) {.exportc, noinline.} = discard +proc useSandwich(s: ptr SandwichStruct) {.exportc, noinline.} = discard + +useSimple(simple.addr) +useNested(nested.addr) +useArr(arr.addr) +useComplete(withComplete.addr) +useVariant(variant.addr) +useTuple(tupleVal) +useSandwich(sandwich.addr) + +# Edge cases: different C/Nim names +type OpaqueWithCName {.importc: "FILE", header: "".} = object + +type StructWithRenamedField = object + nimName {.importc: "c_name".}: int + opaque: OpaqueWithCName + +const renamedField = default(StructWithRenamedField) +proc useRenamedField(s: ptr StructWithRenamedField) {.exportc, noinline.} = discard +useRenamedField(renamedField.addr) +static: doAssert renamedField.nimName == 0 + +type NimTypeName {.importc: "int", completeStruct, nodecl.} = distinct cint + +type StructContainingRenamedType = object + inner: NimTypeName + opaque: OpaqueFile + +const withRenamedType = default(StructContainingRenamedType) +proc useRenamedType(s: ptr StructContainingRenamedType) {.exportc, noinline.} = discard +useRenamedType(withRenamedType.addr) + +type StructWithExportedField = object + nimField {.exportc: "exported_field".}: int + opaque: OpaqueFile + +const withExported = default(StructWithExportedField) +proc useExportedField(s: ptr StructWithExportedField) {.exportc, noinline.} = discard +useExportedField(withExported.addr) +static: doAssert withExported.nimField == 0 + +type ByCopyStruct {.bycopy.} = object + data: int + opaque: OpaqueFile + +const byCopyVal = default(ByCopyStruct) +proc useByCopy(s: ByCopyStruct) {.exportc, noinline.} = discard +useByCopy(byCopyVal) +static: doAssert byCopyVal.data == 0 + +type PackedStruct {.packed.} = object + a: int8 + opaque: OpaqueFile + b: int8 + +const packedVal = default(PackedStruct) +proc usePacked(s: ptr PackedStruct) {.exportc, noinline.} = discard +usePacked(packedVal.addr) +static: + doAssert packedVal.a == 0 + doAssert packedVal.b == 0 + +type UnionWithOpaque {.union.} = object + intVal: int + opaque: OpaqueFile + +const unionVal = default(UnionWithOpaque) +proc useUnion(u: ptr UnionWithOpaque) {.exportc, noinline.} = discard +useUnion(unionVal.addr) + +# Deep nesting +type DeepLevel1 = object + field1: int + opaque: OpaqueFile + +type DeepLevel2 = object + nested: DeepLevel1 + field2: float + +type DeepLevel3 = object + deep: DeepLevel2 + field3: int + opaque2: OpaqueWithCName + +const deepVal = default(DeepLevel3) +proc useDeep(d: ptr DeepLevel3) {.exportc, noinline.} = discard +useDeep(deepVal.addr) +static: + doAssert deepVal.deep.nested.field1 == 0 + doAssert deepVal.deep.field2 == 0.0 + doAssert deepVal.field3 == 0 + +# Multiple opaque fields with renamed non-opaque fields +type MultiOpaque = object + first {.importc: "first_field".}: int + opaque1: OpaqueFile + second {.importc: "second_field".}: float + opaque2: OpaqueWithCName + third: int + +const multiOpaque = default(MultiOpaque) +proc useMultiOpaque(m: ptr MultiOpaque) {.exportc, noinline.} = discard +useMultiOpaque(multiOpaque.addr) + +static: + doAssert multiOpaque.first == 0 + doAssert multiOpaque.second == 0.0 + doAssert multiOpaque.third == 0 diff --git a/tests/codegen/titaniummangle.nim b/tests/codegen/titaniummangle.nim index d566900b19..7623559a35 100644 --- a/tests/codegen/titaniummangle.nim +++ b/tests/codegen/titaniummangle.nim @@ -1,6 +1,6 @@ discard """ - targets: "c" - matrix: "--debugger:native" + targets: "c cpp" + matrix: "--debugger:native --mangle:cpp; --debugger:native" ccodecheck: "'_ZN14titaniummangle8testFuncE'" ccodecheck: "'_ZN14titaniummangle8testFuncE6stringN14titaniummangle3FooE'" ccodecheck: "'_ZN14titaniummangle8testFuncE3int7varargsI6stringE'" diff --git a/tests/codegen/titaniummangle_nim.nim b/tests/codegen/titaniummangle_nim.nim new file mode 100644 index 0000000000..204d6ac063 --- /dev/null +++ b/tests/codegen/titaniummangle_nim.nim @@ -0,0 +1,199 @@ +discard """ + targets: "c" + matrix: "--debugger:native --mangle:nim" + ccodecheck: "'testFunc__titaniummangle95nim_u1316'" + ccodecheck: "'testFunc__titaniummangle95nim_u156'" + ccodecheck: "'testFunc__titaniummangle95nim_u1305'" + ccodecheck: "'testFunc__titaniummangle95nim_u241'" + ccodecheck: "'testFunc__titaniummangle95nim_u1357'" + ccodecheck: "'testFunc__titaniummangle95nim_u292'" + ccodecheck: "'testFunc__titaniummangle95nim_u38'" + ccodecheck: "'testFunc__titaniummangle95nim_u175'" + ccodecheck: "'testFunc__titaniummangle95nim_u1302'" + ccodecheck: "'testFunc__titaniummangle95nim_u1305'" + ccodecheck: "'testFunc__titaniummangle95nim_u535'" + ccodecheck: "'testFunc__titaniummangle95nim_u1294'" + ccodecheck: "'testFunc__titaniummangle95nim_u336'" + ccodecheck: "'testFunc__titaniummangle95nim_u425'" + ccodecheck: "'testFunc__titaniummangle95nim_u308'" + ccodecheck: "'testFunc__titaniummangle95nim_u129'" + ccodecheck: "'testFunc__titaniummangle95nim_u320'" + ccodecheck: "'testFunc__titaniummangle95nim_u223'" + ccodecheck: "'testFunc__titaniummangle95nim_u545'" + ccodecheck: "'testFunc__titaniummangle95nim_u543'" + ccodecheck: "'testFunc__titaniummangle95nim_u895'" + ccodecheck: "'testFunc__titaniummangle95nim_u1104'" + ccodecheck: "'testFunc__titaniummangle95nim_u1155'" + ccodecheck: "'testFunc__titaniummangle95nim_u636'" + ccodecheck: "'testFunc__titaniummangle95nim_u705'" + ccodecheck: "'testFunc__titaniummangle95nim_u800'" + ccodecheck: "'new__titaniummangle95nim_u1320'" + ccodecheck: "'xxx__titaniummangle95nim_u1391'" + ccodecheck: "'xxx__titaniummangle95nim_u1394'" +""" + +#When debugging this notice that if one check fails, it can be due to any of the above. + +type + Comparable = concept x, y + (x < y) is bool + + Foo = object + a: int32 + b: int32 + + FooTuple = tuple + a: int + b: int + + Container[T] = object + data: T + + Container2[T, T2] = object + data: T + data2: T2 + + Boo = distinct Foo + + Coo = Foo + + Doo = Boo | Foo + + TestProc = proc(a:string): string + +type EnumSample = enum + a, b, c + +type EnumAnotherSample = enum + a, b, c + +proc testFunc(a: set[EnumSample]) = + echo $a + +proc testFunc(a: typedesc) = + echo $a + +proc testFunc(a: ptr Foo) = + echo repr a + +proc testFunc(s: string, a: Coo) = + echo repr a + +proc testFunc(s: int, a: Comparable) = + echo repr a + +proc testFunc(a: TestProc) = + let b = "" + echo repr a("") + +proc testFunc(a: ref Foo) = + echo repr a + +proc testFunc(b: Boo) = + echo repr b + +proc testFunc(a: ptr UncheckedArray[int]) = + echo repr a + +proc testFunc(a: ptr int) = + echo repr a + +proc testFunc(a: ptr ptr int) = + echo repr a + +proc testFunc(e: FooTuple, str: cstring) = + echo e + +proc testFunc(e: (float, float)) = + echo e + +proc testFunc(e: EnumSample) = + echo e + +proc testFunc(e: var int) = + echo e + +proc testFunc(e: var Foo, a, b: int32, refFoo: ref Foo) = + echo e + +proc testFunc(xs: Container[int]) = + let a = 2 + echo xs + +proc testFunc(xs: Container2[int32, int32]) = + let a = 2 + echo xs + +proc testFunc(xs: Container[Container2[int32, int32]]) = + let a = 2 + echo xs + +proc testFunc(xs: seq[int]) = + let a = 2 + echo xs + +proc testFunc(xs: openArray[string]) = + let a = 2 + echo xs + +proc testFunc(xs: array[2, int]) = + let a = 2 + echo xs + +proc testFunc(e: EnumAnotherSample) = + echo e + +proc testFunc(a, b: int) = + echo "hola" + discard + +proc testFunc(a: int, xs: varargs[string]) = + let a = 10 + for x in xs: + echo x + +proc xxx(v: static int) = + echo v + +proc testFunc() = + var a = 2 + var aPtr = a.addr + var foo = Foo() + let refFoo : ref Foo = new(Foo) + let b = Foo().Boo() + let d: Doo = Foo() + testFunc("", Coo()) + testFunc(1, ) + testFunc(b) + testFunc(EnumAnotherSample) + var t = [1, 2] + let uArr = cast[ptr UncheckedArray[int]](t.addr) + testFunc(uArr) + testFunc({}) + testFunc(proc(s:string): string = "test") + testFunc(20, a.int32) + testFunc(20, 2) + testFunc(EnumSample.c) + testFunc(EnumAnotherSample.c) + testFunc((2, 1), "adios") + testFunc((22.1, 1.2)) + testFunc(a.addr) + testFunc(foo.addr) + testFunc(aPtr.addr) + testFunc(refFoo) + testFunc(foo, 2, 1, refFoo) + testFunc(a) + testFunc(@[2, 1, 2]) + testFunc(@["hola"]) + testFunc(2, "hola", "adios") + let arr: array[2, int] = [2, 1] + testFunc(arr) + testFunc(Container[int](data: 10)) + let c2 = Container2[int32, int32](data: 10, data2: 20) + testFunc(c2) + testFunc(Container[Container2[int32, int32]](data: c2)) + xxx(10) + xxx(20) + + +testFunc() \ No newline at end of file diff --git a/tests/compiler/tasm.nim b/tests/compiler/tasm.nim index 63c8344f03..8a1f670c62 100644 --- a/tests/compiler/tasm.nim +++ b/tests/compiler/tasm.nim @@ -1,3 +1,7 @@ +discard """ + disabled: "osx" +""" + proc testAsm() = let src = 41 var dst = 0 diff --git a/tests/concepts/t17630.nim b/tests/concepts/t17630.nim new file mode 100644 index 0000000000..b0cd7fbe0f --- /dev/null +++ b/tests/concepts/t17630.nim @@ -0,0 +1,15 @@ +discard """ + action: "compile" +""" + +# https://github.com/nim-lang/Nim/issues/17630 +# A concept that references itself in a proc signature +# should not cause infinite recursion / stack overflow + +type + A = concept + proc test(x: Self, y: A) + +proc test(x: int, y: int) = discard + +discard (int is A) diff --git a/tests/concepts/tconceptsv2.nim b/tests/concepts/tconceptsv2.nim index c735aeeacc..d861c51c75 100644 --- a/tests/concepts/tconceptsv2.nim +++ b/tests/concepts/tconceptsv2.nim @@ -546,3 +546,57 @@ proc len[T](t: DummyIndexable[T]): int = let dummyIndexable = DummyIndexable(@[1, 2]) echoAll(dummyIndexable) + +block: + type + C = concept + proc a(x: Self, i: int) + AObj[T] = object + x: T + ARef[T] = ref AObj[T] + + proc a[T: int](x: ARef[T], i: int) = + discard + + assert (ref AObj[int]) is C + +block: + type + C = concept + proc a(x: Self, i: int) + AObj[T; B] = object + x: T + ARef[T; B] = ref AObj[T,B] + + proc a[T: int, C: float](x: ARef[T, C], i: int) = + discard + + assert (ref AObj[int, int]) isnot C + assert (ref AObj[int, float]) is C + +block: + type + C = concept + proc a(x: Self, i: int) + AObj[T] = object + ARef[T] = ref AObj[T] + + proc a(x: ARef, i: int) = + discard + + assert (ref AObj[int]) is C + +block: + type + C = concept + proc x(a:Self, x: int) + StreamObj = object of RootObj + Stream = ref StreamObj + MemMapFileStreamObj = object of Stream + MemMapFileStream = ref MemMapFileStreamObj + + proc x(a: Stream, x: int) = discard + proc spring(x: C) = discard + + let test = MemMapFileStream() + spring(test) diff --git a/tests/concepts/trecursive_concepts.nim b/tests/concepts/trecursive_concepts.nim new file mode 100644 index 0000000000..7a2c042e20 --- /dev/null +++ b/tests/concepts/trecursive_concepts.nim @@ -0,0 +1,132 @@ +discard """ +action: "run" +output: ''' +int is Primitive: true +Handle is Primitive: true +SpecialHandle is Primitive: true +FileDescriptor is Primitive: true +float is Primitive: false +string is Primitive: false +char is PrimitiveBase: true +ptr int is PrimitiveBase: true +''' +""" + +# Test recursive concepts with cycle detection +# This tests concepts that reference themselves via distinctBase + +import std/typetraits + +block: # Basic recursive concept with distinctBase + type + PrimitiveBase = SomeInteger | bool | char | ptr | pointer + + # Recursive concept: matches PrimitiveBase or any distinct type whose base is Primitive + Primitive = concept x + x is PrimitiveBase or distinctBase(x) is Primitive + + # Real-world example: handle types that wrap integers + Handle = distinct int + SpecialHandle = distinct Handle + FileDescriptor = distinct SpecialHandle + + # Direct base types + echo "int is Primitive: ", int is Primitive + + # Single-level distinct (like a simple handle type) + echo "Handle is Primitive: ", Handle is Primitive + + # Two-level distinct + echo "SpecialHandle is Primitive: ", SpecialHandle is Primitive + + # Three-level distinct + echo "FileDescriptor is Primitive: ", FileDescriptor is Primitive + + # Non-primitive types should NOT match + echo "float is Primitive: ", float is Primitive + echo "string is Primitive: ", string is Primitive + +block: # Ensure base type matching still works + type + PrimitiveBase = SomeInteger | bool | char | ptr | pointer + + echo "char is PrimitiveBase: ", char is PrimitiveBase + echo "ptr int is PrimitiveBase: ", (ptr int) is PrimitiveBase + +block: # Test that cycle detection doesn't break normal concept matching + type + Addable = concept x, y + x + y is typeof(x) + + doAssert int is Addable + doAssert float is Addable + +block: # Test non-matching recursive case + type + IntegerBase = SomeInteger + + IntegerLike = concept x + x is IntegerBase or distinctBase(x) is IntegerLike + + Percentage = distinct float # float base, not integer + + doAssert int is IntegerLike + doAssert not(float is IntegerLike) + doAssert not(Percentage is IntegerLike) # float base doesn't match + +block: # Test deep distinct chains (5+ levels) - e.g., layered ID types + type + IdBase = SomeInteger + + IdLike = concept x + x is IdBase or distinctBase(x) is IdLike + + EntityId = distinct int + UserId = distinct EntityId + AdminId = distinct UserId + SuperAdminId = distinct AdminId + RootId = distinct SuperAdminId + + doAssert int is IdLike + doAssert EntityId is IdLike + doAssert UserId is IdLike + doAssert AdminId is IdLike + doAssert SuperAdminId is IdLike + doAssert RootId is IdLike + doAssert not(float is IdLike) + +block: # Test 3-way mutual recursion (co-dependent concepts) + # This tests that cycle detection properly handles A -> B -> C -> A cycles + type + Serializable = concept + proc serialize(x: Self): Bytes + + Bytes = concept + proc compress(x: Self): Compressed + + Compressed = concept + proc decompress(x: Self): Serializable + + Data = object + value: int + + proc serialize(x: Data): Data = x + proc compress(x: Data): Data = x + proc decompress(x: Data): Data = x + + # Data should satisfy all three mutually recursive concepts + doAssert Data is Serializable + doAssert Data is Bytes + doAssert Data is Compressed + +block: # Test concept with method returning same type + type + Cloneable = concept + proc clone(x: Self): Self + + Document = object + content: string + + proc clone(x: Document): Document = x + + doAssert Document is Cloneable diff --git a/tests/destructor/t25341.nim b/tests/destructor/t25341.nim new file mode 100644 index 0000000000..fbe77cb5df --- /dev/null +++ b/tests/destructor/t25341.nim @@ -0,0 +1,7 @@ +discard """ + cmd: "nim c --mm:orc $file" + output: "" +""" +import ./t25341_aux/a, ./t25341_aux/b +a() +b() diff --git a/tests/destructor/t25341_aux/a.nim b/tests/destructor/t25341_aux/a.nim new file mode 100644 index 0000000000..0107ba572f --- /dev/null +++ b/tests/destructor/t25341_aux/a.nim @@ -0,0 +1,4 @@ +import ./module + +proc a*() = + discard make1[4]().make2() diff --git a/tests/destructor/t25341_aux/b.nim b/tests/destructor/t25341_aux/b.nim new file mode 100644 index 0000000000..81b515e4f9 --- /dev/null +++ b/tests/destructor/t25341_aux/b.nim @@ -0,0 +1,6 @@ +import ./module + +var globalObj: Distinct2[4] + +proc b*() = + globalObj = make1[4]().make2() diff --git a/tests/destructor/t25341_aux/module.nim b/tests/destructor/t25341_aux/module.nim new file mode 100644 index 0000000000..a4fd85a6ca --- /dev/null +++ b/tests/destructor/t25341_aux/module.nim @@ -0,0 +1,14 @@ +type + BaseObject*[N: static int] = object + value*: int + + Distinct1*[N: static int] = distinct BaseObject[N] + Distinct2*[N: static int] = distinct BaseObject[N] + +proc `=copy`*[N: static int](dest: var Distinct2[N], src: Distinct2[N]) {.error: "no".} + +proc make1*[N: static int](): Distinct1[N] = + Distinct1[N](BaseObject[N](value: 0)) + +proc make2*[N: static int](u: sink Distinct1[N]): Distinct2[N] = + Distinct2[N](BaseObject[N](u)) diff --git a/tests/errmsgs/t23536.nim b/tests/errmsgs/t23536.nim index 610a85babd..d8f1433331 100644 --- a/tests/errmsgs/t23536.nim +++ b/tests/errmsgs/t23536.nim @@ -6,8 +6,8 @@ const expected = """ wrong trace: t23536.nim(22) t23536 t23536.nim(17) foo -assertions.nim(41) failedAssertImpl -assertions.nim(36) raiseAssert +assertions.nim(45) failedAssertImpl +assertions.nim(40) raiseAssert fatal.nim(53) sysFatal """ diff --git a/tests/errmsgs/t24974.nim b/tests/errmsgs/t24974.nim index 4f7da11c96..39d473a89e 100644 --- a/tests/errmsgs/t24974.nim +++ b/tests/errmsgs/t24974.nim @@ -4,8 +4,8 @@ discard """ t24974.nim(22) t24974 t24974.nim(19) d t24974.nim(16) s -assertions.nim(41) failedAssertImpl -assertions.nim(36) raiseAssert +assertions.nim(45) failedAssertImpl +assertions.nim(40) raiseAssert fatal.nim(53) sysFatal Error: unhandled exception: t24974.nim(16, 26) `false` [AssertionDefect] ''' @@ -19,4 +19,4 @@ proc d(): B = if s(k): discard quit 0 k -for _ in [0]: discard d() \ No newline at end of file +for _ in [0]: discard d() diff --git a/tests/errmsgs/tvmranges.nim b/tests/errmsgs/tvmranges.nim new file mode 100644 index 0000000000..236da34148 --- /dev/null +++ b/tests/errmsgs/tvmranges.nim @@ -0,0 +1,17 @@ +discard """ + action: reject + nimout: ''' +stack trace: (most recent call last) +tvmranges.nim(14, 10) +tvmranges.nim(14, 10) Error: unhandled exception: value out of range +''' +""" + +type X = enum + a + b + +when pred(a) == b: + echo "a" +else: + echo "b" \ No newline at end of file diff --git a/tests/generic/tgeneric_typedesc_sizeof.nim b/tests/generic/tgeneric_typedesc_sizeof.nim new file mode 100644 index 0000000000..b8284495ee --- /dev/null +++ b/tests/generic/tgeneric_typedesc_sizeof.nim @@ -0,0 +1,34 @@ +discard """ + output: ''' +42 +''' +""" + +# Regression test for semtypinst.nim hasValuelessStatics bug. +# +# Bug: hasValuelessStatics only checked for tyStatic, missing tyTypeDesc(tyGenericParam) +# Fix: Added check for tyTypeDesc wrapping tyGenericParam in compiler/semtypinst.nim +# +# The bug triggers when: +# 1. A generic type has a when clause calling a typedesc template with sizeof(T) +# 2. A generic proc on that type is called, triggering instantiation +# 3. The T in sizeof(T) becomes tyTypeDesc(tyGenericParam), which wasn't recognized as unresolved +# +# Error without fix: 'sizeof' requires '.importc' types to be '.completeStruct' + +template isSmall(T: typedesc): bool = + sizeof(T) <= 8 + +type Foo[T] = object + when isSmall(T): + a: T + else: + b: ptr T + +proc bar[T](x: var Foo[T]) = + discard + +var x: Foo[int] +x.a = 42 +x.bar() +echo x.a diff --git a/tests/generics/t22305.nim b/tests/generics/t22305.nim new file mode 100644 index 0000000000..6158ee3f1b --- /dev/null +++ b/tests/generics/t22305.nim @@ -0,0 +1,57 @@ +discard """ + joinable: false +""" + +import asyncdispatch, options + +proc recv*[T](tc: ptr Channel[T]): Future[T] {.async.} = + discard + +type SharedBuf = object + +type WorkProc[A, B] = proc(a: A): Option[B] {.nimcall.} + +proc worker[TArg](p: TArg) {.thread, nimcall.} = + discard + +proc readFilesThread() = + type TArg[A, B] = + tuple[r: ptr Channel[Option[A]], w: ptr Channel[Option[B]], p: WorkProc[A, B]] + + var readThread: Thread[TArg[int, SharedBuf]] + +proc readFilesAd() {.async.} = + var readChan: Channel[Option[int]] + + type TArg[A, B] = + tuple[r: ptr Channel[Option[A]], w: ptr Channel[Option[B]], p: WorkProc[A, B]] + + var readThread: Thread[TArg[int, SharedBuf]] + let test = await (addr readChan).recv() + + joinThread(readThread) + +waitFor readFilesAd() + +type + SharedPtr[T] = object + p: ptr T + +proc `=destroy`[T](self: var SharedPtr[T]) = + discard + +type + SomethingObj[T] = object + Something[T] = SharedPtr[SomethingObj[T]] + +proc useSomething() = + # discard Something[int]() # When you uncomment this line, it will compile successfully. + discard Something[float]() + +proc fn() = + let thing = Something[int]() + proc closure() = + discard thing + closure() + +fn() \ No newline at end of file diff --git a/tests/global/mglobal3.nim b/tests/global/mglobal3.nim new file mode 100644 index 0000000000..289c2d8e47 --- /dev/null +++ b/tests/global/mglobal3.nim @@ -0,0 +1,2 @@ +proc v*() = + let u {.global.} = default(ref int) \ No newline at end of file diff --git a/tests/global/tglobal3.nim b/tests/global/tglobal3.nim index 80c1cd640d..1f9536e160 100644 --- a/tests/global/tglobal3.nim +++ b/tests/global/tglobal3.nim @@ -55,3 +55,14 @@ block: # bug #24997 doAssert not isNil(u(typeof(B.j))) R() discard u(B) + +proc f2(str: string): string = str +proc m2() = + let v {.global, used.}: string = f2(f2("123")) + assert v == "123" + +m2() + +import mglobal3 +block: + v() \ No newline at end of file diff --git a/tests/ic/tgenericinst.nim b/tests/ic/tgenericinst.nim index 3346764f54..dea55235b1 100644 --- a/tests/ic/tgenericinst.nim +++ b/tests/ic/tgenericinst.nim @@ -1,5 +1,5 @@ discard """ - cmd: "nim cpp --incremental:on $file" + cmd: "nim cpp --incremental:legacy $file" """ {.emit:"""/*TYPESECTION*/ @@ -8,4 +8,4 @@ discard """ """.} type Foo {.importcpp.} = object -echo $Foo() #Notice the generic is instantiate in the this module if not, it wouldnt find Foo \ No newline at end of file +echo $Foo() #Notice the generic is instantiate in the this module if not, it wouldnt find Foo diff --git a/tests/int/tarithm.nim b/tests/int/tarithm.nim index d0943d225d..ff770e54f3 100644 --- a/tests/int/tarithm.nim +++ b/tests/int/tarithm.nim @@ -14,6 +14,7 @@ int32 0 tUnsignedOps OK ''' +targets: "c cpp js" nimout: "tUnsignedOps OK" """ @@ -185,3 +186,67 @@ block tUnsignedOps: testUnsignedOps() static: testUnsignedOps() + +block tshl: + # Signed types + block: + const t0: int8 = 1'i8 shl 8 + const t1: int16 = 1'i16 shl 16 + const t2: int32 = 1'i32 shl 32 + const t3: int64 = 1'i64 shl 64 + doAssert t0 == 1 + doAssert t1 == 1 + doAssert t2 == 1 + doAssert t3 == 1 + + # Unsigned types + block: + const t0: uint8 = 1'u8 shl 8 + const t1: uint16 = 1'u16 shl 16 + const t2: uint32 = 1'u32 shl 32 + const t3: uint64 = 1'u64 shl 64 + doAssert t0 == 1 + doAssert t1 == 1 + doAssert t2 == 1 + doAssert t3 == 1 + +block bitmaking: + + # test semfold (single expression) + doAssert (0x10'i8 shr 2) == (0x10'i8 shr 0b1010_1010) + doAssert (0x10'u8 shr 2) == (0x10'u8 shr 0b0101_1010) + doAssert (0x10'i16 shr 2) == (0x10'i16 shr 0b1011_0010) + doAssert (0x10'u16 shr 2) == (0x10'u16 shr 0b0101_0010) + doAssert (0x10'i32 shr 2) == (0x10'i32 shr 0b1010_0010) + doAssert (0x10'u32 shr 2) == (0x10'u32 shr 0b0110_0010) + doAssert (0x10'i64 shr 2) == (0x10'i32 shr 0b1100_0010) + doAssert (0x10'u64 shr 2) == (0x10'u32 shr 0b0100_0010) + + doAssert (0x10'i8 shl 2) == (0x10'i8 shl 0b1010_1010) + doAssert (0x10'u8 shl 2) == (0x10'u8 shl 0b0101_1010) + doAssert (0x10'i16 shl 2) == (0x10'i16 shl 0b1011_0010) + doAssert (0x10'u16 shl 2) == (0x10'u16 shl 0b0101_0010) + doAssert (0x10'i32 shl 2) == (0x10'i32 shl 0b1010_0010) + doAssert (0x10'u32 shl 2) == (0x10'u32 shl 0b0110_0010) + doAssert (0x10'i64 shl 2) == (0x10'i32 shl 0b1100_0010) + doAssert (0x10'u64 shl 2) == (0x10'u32 shl 0b0100_0010) + + proc testVmAndBackend[T: SomeInteger](a: T, b1, b2: int) {.sideeffect.} = + # this echo is to cause a side effect and therefore ensure this + # proc isn't evaluated at compile time when it should not. + doAssert((a shr b1) == (a shr b2)) + doAssert((a shl b1) == (a shl b2)) + + proc callTestVmAndBackend() = + testVmAndBackend(0x10'i8, 2, 0b1010_1010) + testVmAndBackend(0x10'u8, 2, 0b0101_1010) + testVmAndBackend(0x10'i16, 2, 0b1011_0010) + testVmAndBackend(0x10'u16, 2, 0b0101_0010) + testVmAndBackend(0x10'i32, 2, 0b1010_0010) + testVmAndBackend(0x10'u32, 2, 0b0110_0010) + testVmAndBackend(0x10'i64, 2, 0b1100_0010) + testVmAndBackend(0x10'u64, 2, 0b0100_0010) + + callTestVmAndBackend() # test at runtime + static: + callTestVmAndBackend() # test at compiletime diff --git a/tests/iter/titer_issues.nim b/tests/iter/titer_issues.nim index ff0b8eb49f..5070a54713 100644 --- a/tests/iter/titer_issues.nim +++ b/tests/iter/titer_issues.nim @@ -432,3 +432,28 @@ block: let x = cast[typeof(aaa)](aaa) # not even var for _ in x[]: discard + +import std/[tables, unicode, sequtils] + +const + myTable = { + "en": "abcdefghijklmnopqrstuvwxyz", + }.toTable + +proc buggyVersion(locale: string): seq[Rune] = + result = toSeq(runes(myTable[locale])) + +proc workingVersion(locale: string): seq[Rune] = + # string lifetime is extended + let str = myTable[locale] + result = toSeq(runes(str)) + +# echo "Testing working version..." +let runes2 = workingVersion("en") +# echo "Got ", runes2.len, " runes" + +# echo "Testing buggy version..." +let runes1 = buggyVersion("en") # <-- CRASHES HERE + +doAssert runes1.len == runes2.len +# echo "Got ", runes1.len, " runes" diff --git a/tests/iter/tyieldintry.nim b/tests/iter/tyieldintry.nim index 4e7afcfe40..983cae5408 100644 --- a/tests/iter/tyieldintry.nim +++ b/tests/iter/tyieldintry.nim @@ -17,9 +17,12 @@ proc testClosureIterAux(it: iterator(): int, exceptionExpected: bool, expectedRe var exceptionCaught = false + var maxIterations = 10000 try: for i in it(): closureIterResult.add(i) + dec maxIterations + doAssert(maxIterations > 0, "Too many iterations in test. Infinite loop?") except TestError: exceptionCaught = true @@ -798,3 +801,99 @@ block: #25202 doAssert(checkpoints1 == checkpoints2) p() + +block: #25261 + iterator y(): int {.closure.} = + try: + try: + raise newException(CatchableError, "Error") + except CatchableError: + return 123 + yield 0 + finally: + discard + + let w = y + doAssert(w() == 123) + doAssert(getCurrentExceptionMsg() == "") + + try: + raise newException(ValueError, "Outer error") + except: + doAssert(getCurrentExceptionMsg() == "Outer error") + let w = y + doAssert(w() == 123) + doAssert(getCurrentExceptionMsg() == "Outer error") + doAssert(getCurrentExceptionMsg() == "") + +block: + # Looks almost like above, but last finally changed to except + iterator y(): int {.closure.} = + try: + try: + raise newException(CatchableError, "Error") + except CatchableError: + return 123 + yield 0 + except: + discard + + let w = y + doAssert(w() == 123) + doAssert(getCurrentExceptionMsg() == "") + + try: + raise newException(ValueError, "Outer error") + except: + doAssert(getCurrentExceptionMsg() == "Outer error") + let w = y + doAssert(w() == 123) + doAssert(getCurrentExceptionMsg() == "Outer error") + doAssert(getCurrentExceptionMsg() == "") + +block: #25330 (v1) + iterator count1(): int {.closure.} = + yield 1 + raiseTestError() + + iterator count0(): int {.closure.} = + try: + var count = count1 + while true: + yield count() + if finished(count): break + finally: + try: + checkpoint(2) + var count2 = count1 + while true: + yield count2() + if finished(count2): break + discard # removing this outputs "raise" + except: + checkpoint(3) + raise + + testExc(count0, 1, 2, 1, 3) + +block: #25330 (v2) + iterator count1(): int {.closure.} = + yield 1 + raiseTestError() + + iterator count0(): int {.closure.} = + try: + var count = count1 + for x in 0 .. 10: + yield count() + finally: + try: + checkpoint(2) + var count2 = count1 + for x in 0 .. 10: + yield count2() + except: + checkpoint(3) + raise + + testExc(count0, 1, 2, 1, 3) diff --git a/tests/metatype/ttypetraits.nim b/tests/metatype/ttypetraits.nim index 74ace75c3a..0107f6b049 100644 --- a/tests/metatype/ttypetraits.nim +++ b/tests/metatype/ttypetraits.nim @@ -194,6 +194,11 @@ block: # tupleLen MyGenericTuple2Alias2 = MyGenericTuple2Alias[float] static: doAssert MyGenericTuple2Alias2.tupleLen == 3 + type + MyGenericTuple3[T] = T + MyGenericTuple3Alias = MyGenericTuple3[(string, int)] + static: doAssert MyGenericTuple3Alias.tupleLen == 2 + static: doAssert (int, float).tupleLen == 2 static: doAssert (1, ).tupleLen == 1 static: doAssert ().tupleLen == 0 diff --git a/tests/objects/tobject_default_value.nim b/tests/objects/tobject_default_value.nim index 8b6ea812b7..1d86dd1550 100644 --- a/tests/objects/tobject_default_value.nim +++ b/tests/objects/tobject_default_value.nim @@ -819,3 +819,18 @@ block: var t = MyTyp() t.thing[""] = "" + + +type + Thing = object + a: int = 100 # this is fine + b = 100 # this is not + +proc overloaded[T: SomeSignedInt](x: T) = discard +proc overloaded[T: SomeUnsignedInt](x: T) = discard +proc overloaded[T: object](x: T) = + for val in fields(x): + var v: typeof(val) + overloaded(v) + +overloaded(Thing()) \ No newline at end of file diff --git a/tests/pragmas/thintprocessing.nim b/tests/pragmas/thintprocessing.nim index 943d921669..93b8fa4a61 100644 --- a/tests/pragmas/thintprocessing.nim +++ b/tests/pragmas/thintprocessing.nim @@ -3,7 +3,7 @@ discard """ matrix: "--hint:processing" nimout: ''' compile start -... +.... warn_module.nim(6, 6) Hint: 'test' is declared but not used [XDeclaredButNotUsed] compile end ''' diff --git a/tests/stdlib/tarithmetics.nim b/tests/stdlib/tarithmetics.nim index 0a6dd1fcfd..5b0cb93f3a 100644 --- a/tests/stdlib/tarithmetics.nim +++ b/tests/stdlib/tarithmetics.nim @@ -1,6 +1,7 @@ discard """ matrix: "--mm:refc; --mm:orc" targets: "c cpp js" + disabled: "osx" """ import std/assertions # TODO: in future work move existing arithmetic tests (tests/arithm/*) into this file diff --git a/tests/stdlib/thttpclient.nim b/tests/stdlib/thttpclient.nim index 99ccaba8b3..4f90bb8b06 100644 --- a/tests/stdlib/thttpclient.nim +++ b/tests/stdlib/thttpclient.nim @@ -3,6 +3,7 @@ discard """ disabled: "openbsd" disabled: "freebsd" disabled: "windows" + disabled: "osx" """ #[ diff --git a/tests/stdlib/tstrutils.nim b/tests/stdlib/tstrutils.nim index dfa72faf22..d57fa2d8ae 100644 --- a/tests/stdlib/tstrutils.nim +++ b/tests/stdlib/tstrutils.nim @@ -642,6 +642,30 @@ template main() = let myA = CAMPAIGN_TABLE doAssert $parseEnum[Tables](myA) == "wikientries_campaign" + block: + const tripleQuotedStr = """foobar""" + + type MyEnum = enum + a = tripleQuotedStr + b = """bazquz""" + + let myA = tripleQuotedStr + doAssert $parseEnum[MyEnum](myA) == myA + let myB = "bazquz" + doAssert $parseEnum[MyEnum](myB) == myB + + block: + const rawStr = r"foobar" + + type MyEnum = enum + a = rawStr + b = r"bazquz" + + let myA = rawStr + doAssert $parseEnum[MyEnum](myA) == myA + let myB = r"bazquz" + doAssert $parseEnum[MyEnum](myB) == myB + block: # check enum defined in block type Bar = enum diff --git a/tests/stdlib/tunicode.nim b/tests/stdlib/tunicode.nim index b9e68b15b4..a272d16c92 100644 --- a/tests/stdlib/tunicode.nim +++ b/tests/stdlib/tunicode.nim @@ -194,6 +194,23 @@ block stripTests: doAssert(strip("×text×", leading = false, runes = ["×".asRune]) == "×text") doAssert(strip("×text×", trailing = false, runes = ["×".asRune]) == "text×") + doAssert(strip("\u2000") == "") + doAssert(strip("a\u2000") == "a") + + # bug #19846 + block: + # check against unicode whose utf8 byteLen > 2 + doAssert(strip("‟„”“‛‚’‘‗•STR•‗‘’‚‛“”„‟", runes = "•‗‘’‚‛“”„‟".toRunes) == "STR") + let chi = "abc\u8377\u9020" + doAssert(strip(chi, leading = false, runes = ["\u9020".asRune]) == "abc\u8377") + doAssert(strip(chi) == chi) # the last byte of s is \x0a, which is in unicodeSpace + + let + grinning_face = "\u{1f600}" + thinking_face = "\u{1f914}" + doAssert(strip(grinning_face & thinking_face & thinking_face, + runes = thinking_face.toRunes) == grinning_face) + block repeatTests: doAssert repeat('c'.Rune, 5) == "ccccc" doAssert repeat("×".asRune, 5) == "×××××" diff --git a/tests/system/tconcat.nim b/tests/system/tconcat.nim index fdce3ea00d..8cf995c938 100644 --- a/tests/system/tconcat.nim +++ b/tests/system/tconcat.nim @@ -1,11 +1,33 @@ discard """ - output: "DabcD" + targets: "c cpp js" + output: ''' +DabcD +(8192, 8, 1024) +''' """ -const - x = "abc" +import std/assertions -var v = "D" & x & "D" +block: + const + x = "abc" -echo v + var v = "D" & x & "D" + doAssert v == "DabcD" + echo v + +block: # test large additions + var a = "abcdefgh" + let initialLen = a.len + let times = 10 + for i in 1..times: + let start = a.len + a.add(a) + doAssert a.len == 2 * start + let multiplier = 1 shl times + doAssert a.len == initialLen * multiplier + echo (a.len, initialLen, multiplier) + for i in 1 ..< multiplier: + for j in 0 ..< initialLen: + doAssert a[j] == a[i * initialLen + j] diff --git a/tests/threads/tmembug.nim b/tests/threads/tmembug.nim index 3618f0eccb..621a443fe8 100644 --- a/tests/threads/tmembug.nim +++ b/tests/threads/tmembug.nim @@ -12,14 +12,14 @@ var chan1.open() chan2.open() -proc routeMessage*(msg: BackendMessage) = +proc routeMessage*(msg: BackendMessage) {.raises: [], gcsafe.} = # no exceptions! discard chan2.trySend(msg) var recv: Thread[void] stopToken: Atomic[bool] -proc recvMsg() = +proc recvMsg() {.raises: [], gcsafe.} = # no exceptions! while not stopToken.load(moRelaxed): let resp = chan1.tryRecv() if resp.dataAvailable: diff --git a/tests/tuples/tgenericparamtypetuple.nim b/tests/tuples/tgenericparamtypetuple.nim new file mode 100644 index 0000000000..93f1ff2d29 --- /dev/null +++ b/tests/tuples/tgenericparamtypetuple.nim @@ -0,0 +1,34 @@ +# issue #25312 + +import heapqueue + +proc test1[T](test: (float, T)) = # Works + discard + +proc test2[T](test: seq[(float, T)]) = # Works + discard + +proc test3[T](test: HeapQueue[tuple[sqd: float, data: T]]) = # Works + discard + +proc test4(test: HeapQueue[(float, float)]) = # Works + discard + +type ExampleObj = object + a: string + b: seq[float] + +proc test5(test: HeapQueue[(float, ExampleObj)]) = # Works + discard + +proc failingTest[T](test: HeapQueue[(float, T)]) = # (Compile) Error: Mixing types and values in tuples is not allowed. + discard + +proc failingTest2[T](test: HeapQueue[(T, float)]) = # (Compile) Error: Mixing types and values in tuples is not allowed. + discard + +proc test6[T](test: HeapQueue[(T, T)]) = # works + discard + +proc test7[T, U](test: HeapQueue[(T, U)]) = # works + discard diff --git a/tests/varres/tprevent_forloopvar_mutations.nim b/tests/varres/tprevent_forloopvar_mutations.nim index c9aeb94d8f..aff3847232 100644 --- a/tests/varres/tprevent_forloopvar_mutations.nim +++ b/tests/varres/tprevent_forloopvar_mutations.nim @@ -2,7 +2,7 @@ discard """ errormsg: "type mismatch: got " nimout: '''tprevent_forloopvar_mutations.nim(16, 3) Error: type mismatch: got but expected one of: -proc inc[T, V: Ordinal](x: var T; y: V = 1) +proc inc[T: Ordinal; V: SomeInteger](x: var T; y: V = 1) first type mismatch at position: 1 required type for x: var T: Ordinal but expression 'i' is immutable, not 'var' diff --git a/tools/enumgen.nim b/tools/enumgen.nim new file mode 100644 index 0000000000..d1a6473475 --- /dev/null +++ b/tools/enumgen.nim @@ -0,0 +1,301 @@ +## Generate effective NIF representation for `Enum` + +import ".." / compiler / [astdef, options] + +import std / [syncio, assertions, strutils, tables] + +# We need to duplicate this type here as ast.nim's version of it does not work +# as it sets the string values explicitly breaking our logic... +type + TCallingConventionMirror = enum + ccNimCall + ccStdCall + ccCDecl + ccSafeCall + ccSysCall + ccInline + ccNoInline + ccFastCall + ccThisCall + ccClosure + ccNoConvention + ccMember + +const + SpecialCases = [ + ("nkCommand", "cmd"), + ("nkIfStmt", "if"), + ("nkError", "err"), + ("nkType", "onlytype"), + ("nkTypeSection", "type"), + ("nkExprEqExpr", "vv"), + ("nkExprColonExpr", "kv"), + ("nkDerefExpr", "deref"), + ("nkReturnStmt", "ret"), + ("nkBreakStmt", "brk"), + ("nkStmtListExpr", "expr"), + ("nkEnumFieldDef", "efld"), + ("nkNilLit", "nil"), + ("ccNoConvention", "noconv"), + ("mExpr", "exprm"), + ("mStmt", "stmtm"), + ("mEqNimrodNode", "eqnimnode"), + ("mPNimrodNode", "nimnode"), + ("mNone", "nonem"), + ("mAsgn", "asgnm"), + ("mOf", "ofm"), + ("mAddr", "addrm"), + ("mType", "typem"), + ("mStatic", "staticm"), + ("mRange", "rangem"), + ("mVar", "varm"), + ("mInSet", "contains"), + ("mNil", "nilm"), + ("nkStmtList", "stmts"), + ("nkDotExpr", "dot"), + ("nkBracketExpr", "at"), + + ("tyNone", "n0"), # we always use a digit for type kinds so there can be no overlap with node kinds + ("tyBool", "b0"), + ("tyChar", "c0"), + ("tyEmpty", "e0"), + ("tyAlias", "a0"), + ("tyNil", "n1"), + ("tyUntyped", "U0"), + ("tyTyped", "t0"), + ("tyTypeDesc", "t1"), + ("tyGenericInvocation", "g0"), + ("tyGenericBody", "g1"), + ("tyGenericInst", "g2"), + ("tyGenericParam", "g4"), + ("tyDistinct", "d0"), + ("tyEnum", "e1"), + ("tyOrdinal", "o0"), + ("tyArray", "a1"), + ("tyObject", "o1"), + ("tyTuple", "t2"), + ("tySet", "s0"), + ("tyRange", "r0"), + ("tyPtr", "p0"), + ("tyRef", "r1"), + ("tyVar", "v0"), + ("tySequence", "s1"), + ("tyProc", "p1"), + ("tyPointer", "p2"), + ("tyOpenArray", "o3"), + ("tyString", "s2"), + ("tyCstring", "c1"), + ("tyForward", "F0"), + ("tyInt", "i0"), + ("tyInt8", "i1"), + ("tyInt16", "i2"), + ("tyInt32", "i3"), + ("tyInt64", "i4"), + ("tyFloat", "f0"), + ("tyFloat32", "f1"), + ("tyFloat64", "f2"), + ("tyFloat128", "f3"), + ("tyUInt", "u0"), + ("tyUInt8", "u1"), + ("tyUInt16", "u2"), + ("tyUInt32", "u3"), + ("tyUInt64", "u4"), + ("tyOwned", "o2"), + ("tySink", "s3"), + ("tyLent", "L0"), + ("tyVarargs", "v1"), + ("tyUncheckedArray", "U1"), + ("tyError", "e2"), + ("tyBuiltInTypeClass", "b1"), + ("tyUserTypeClass", "U2"), + ("tyUserTypeClassInst", "U3"), + ("tyCompositeTypeClass", "c2"), + ("tyInferred", "I0"), + ("tyAnd", "a2"), + ("tyOr", "o4"), + ("tyNot", "n2"), + ("tyAnything", "a3"), + ("tyStatic", "s4"), + ("tyFromExpr", "F1"), + ("tyConcept", "c3"), + ("tyVoid", "v2"), + ("tyIterable", "I1") + ] + SuffixesToReplace = [ + ("Section", ""), ("Branch", ""), ("Stmt", ""), ("I", ""), + ("Expr", "x"), ("Def", "") + ] + PrefixesToReplace = [ + ("Length", "len"), + ("SetLength", "setlen"), + ("Append", "add") + ] + AdditionalNodes = [ + "nf", # "node flag" + "tf", # "type flag" + "sf", # "sym flag" + "htype", # annotated with a hidden type + "missing" + ] + +proc genEnum[E](f: var File; enumName: string; known: var OrderedTable[string, bool]; prefixLen = 2) = + var mappingA = initOrderedTable[string, E]() + var cases = "" + for e in low(E)..high(E): + var es = $e + if es.startsWith("nkHidden"): + es = es.replace("nkHidden", "nkh") # prefix will be removed + else: + for (suffix, repl) in items SuffixesToReplace: + if es.len - prefixLen > suffix.len and es.endsWith(suffix): + es.setLen es.len - len(suffix) + es.add repl + break + for (suffix, repl) in items PrefixesToReplace: + if es.len - prefixLen > suffix.len and es.substr(prefixLen).startsWith(suffix): + es = es.substr(0, prefixLen-1) & repl & es.substr(prefixLen+suffix.len) + break + + let s = es.substr(prefixLen) + var done = false + for enu, key in items SpecialCases: + if $e == enu: + assert(not mappingA.hasKey(key)) + if known.hasKey(key): echo "conflict: ", key + known[key] = true + assert key.len > 0 + mappingA[key] = e + cases.add " of " & $e & ": " & escape(key) & "\n" + done = true + break + if not done: + let key = s.toLowerAscii + if not mappingA.hasKey(key): + assert key.len > 0, $e + if known.hasKey(key): echo "conflict: ", key + known[key] = true + mappingA[key] = e + cases.add " of " & $e & ": " & escape(key) & "\n" + done = true + if not done: + var d = 0 + while d < 10: + let key = s.toLowerAscii & $d + if not mappingA.hasKey(key): + assert key.len > 0 + mappingA[key] = e + cases.add " of " & $e & ": " & escape(key) & "\n" + done = true + break + inc d + if not done: + echo "Could not map: " & s + #echo mapping + var code = "" + code.add "proc toNifTag*(s: " & enumName & "): string =\n" + code.add " case s\n" + code.add cases + code.add "\n\n" + let procname = "parse" # & enumName.substr(1) + code.add "proc " & procname & "*(t: typedesc[" & enumName & "]; s: string): " & enumName & " =\n" + code.add " case s\n" + for (k, v) in pairs mappingA: + code.add " of " & escape(k) & ": " & $v & "\n" + code.add " else: " & $low(E) & "\n\n\n" + f.write code + +proc genEnum[E](f: var File; enumName: string; prefixLen = 2) = + var known = initOrderedTable[string, bool]() + genEnum[E](f, enumName, known, prefixLen) + + +proc genFlags[E](f: var File; enumName: string; prefixLen = 2) = + var mappingA = initOrderedTable[string, E]() + var mappingB = initOrderedTable[string, E]() + var cases = "" + for e in low(E)..high(E): + let s = ($e).substr(prefixLen) + var done = false + for c in s: + if c in {'A'..'Z'}: + let key = $c.toLowerAscii + if not mappingA.hasKey(key): + mappingA[key] = e + cases.add " of " & $e & ": dest.add " & escape(key) & "\n" + done = true + break + if not done: + var d = 0 + while d < 10: + let key = $s[0].toLowerAscii & $d + if not mappingB.hasKey(key): + mappingB[key] = e + cases.add " of " & $e & ": dest.add " & escape(key) & "\n" + done = true + break + inc d + if not done: + quit "Could not map: " & s + #echo mapping + var code = "" + code.add "proc genFlags*(s: set[" & enumName & "]; dest: var string) =\n" + code.add " for e in s:\n" + code.add " case e\n" + code.add cases + code.add "\n\n" + code.add "proc parse*(t: typedesc[" & enumName & "]; s: string): set[" & enumName & "] =\n" + code.add " result = {}\n" + code.add " var i = 0\n" + code.add " while i < s.len:\n" + code.add " case s[i]\n" + for c in 'a'..'z': + var letterFound = false + var digitsFound = 0 + for d in '0'..'9': + if mappingB.hasKey($c & $d): + if not letterFound: + letterFound = true + code.add " of '" & c & "':\n" + if digitsFound == 0: + code.add " if" + else: + code.add " elif" + inc digitsFound + code.add " i+1 < s.len and s[i+1] == '" & d & "':\n" + code.add " result.incl " & $mappingB[$c & $d] & "\n" + code.add " inc i\n" + + if mappingA.hasKey($c): + if digitsFound == 0: + code.add " of '" & c & "': " + else: + code.add " else: " + code.add "result.incl " & $mappingA[$c] & "\n" + + code.add " else: discard\n" + code.add " inc i\n\n" + f.write code + +var f = open("compiler/ic/enum2nif.nim", fmWrite) +f.write "# Generated by tools/enumgen.nim. DO NOT EDIT!\n\n" +f.write "import \"..\" / [ast, options]\n\n" +# use the same mapping for TNodeKind and TMagic so that we can detect conflicts! +var nodeTags = initOrderedTable[string, bool]() +for a in AdditionalNodes: + nodeTags[a] = true + +genEnum[TNodeKind](f, "TNodeKind", nodeTags) +genEnum[TSymKind](f, "TSymKind") +genEnum[TTypeKind](f, "TTypeKind") +genEnum[TLocKind](f, "TLocKind", 3) +genEnum[TCallingConventionMirror](f, "TCallingConvention", 2) +genEnum[TMagic](f, "TMagic", nodeTags, 1) +genEnum[TStorageLoc](f, "TStorageLoc") +genEnum[TLibKind](f, "TLibKind") +genFlags[TSymFlag](f, "TSymFlag") +genFlags[TNodeFlag](f, "TNodeFlag") +genFlags[TTypeFlag](f, "TTypeFlag") +genFlags[TLocFlag](f, "TLocFlag") +genFlags[TOption](f, "TOption", 3) + +f.close() diff --git a/tools/niminst/niminst.nim b/tools/niminst/niminst.nim index 5244536099..4f4d7adfc4 100644 --- a/tools/niminst/niminst.nim +++ b/tools/niminst/niminst.nim @@ -544,7 +544,7 @@ proc srcdist(c: var ConfigData) = var dir = getOutputDir(c) / buildDir(osA, cpuA) if dirExists(dir): removeDir(dir) createDir(dir) - var cmd = ("$# compile -f --incremental:off --compileonly " & + var cmd = ("$# compile -f --incremental:off --d:nimKochBootstrap --compileonly " & "--gen_mapping --cc:gcc --skipUserCfg" & " --os:$# --cpu:$# $# $#") % [findNim(), osname, cpuname, c.nimArgs, c.mainfile]