diff --git a/compiler/ast.nim b/compiler/ast.nim index 5266925bcc4..d4b6a601431 100644 --- a/compiler/ast.nim +++ b/compiler/ast.nim @@ -7,1006 +7,24 @@ # distribution, for details about the copyright. # -# abstract syntax tree + symbol table +## abstract syntax tree + symbol table import lineinfos, hashes, options, ropes, idents, int128, tables -from strutils import toLowerAscii - -export int128 - -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 - -type - TNodeKind* = enum # order is extremely important, because ranges are used - # to check whether a node belongs to a certain class - nkNone, # unknown node kind: indicates an error - # Expressions: - # Atoms: - nkEmpty, # the node is empty - nkIdent, # node is an identifier - nkSym, # node is a symbol - nkType, # node is used for its typ field - - nkCharLit, # a character literal '' - nkIntLit, # an integer literal - nkInt8Lit, - nkInt16Lit, - nkInt32Lit, - nkInt64Lit, - nkUIntLit, # an unsigned integer literal - nkUInt8Lit, - nkUInt16Lit, - nkUInt32Lit, - nkUInt64Lit, - nkFloatLit, # a floating point literal - nkFloat32Lit, - nkFloat64Lit, - nkFloat128Lit, - nkStrLit, # a string literal "" - nkRStrLit, # a raw string literal r"" - nkTripleStrLit, # a triple string literal """ - nkNilLit, # the nil literal - # end of atoms - nkComesFrom, # "comes from" template/macro information for - # better stack trace generation - nkDotCall, # used to temporarily flag a nkCall node; - # this is used - # for transforming ``s.len`` to ``len(s)`` - - nkCommand, # a call like ``p 2, 4`` without parenthesis - nkCall, # a call like p(x, y) or an operation like +(a, b) - nkCallStrLit, # a call with a string literal - # x"abc" has two sons: nkIdent, nkRStrLit - # x"""abc""" has two sons: nkIdent, nkTripleStrLit - nkInfix, # a call like (a + b) - nkPrefix, # a call like !a - nkPostfix, # something like a! (also used for visibility) - nkHiddenCallConv, # an implicit type conversion via a type converter - - nkExprEqExpr, # a named parameter with equals: ''expr = expr'' - nkExprColonExpr, # a named parameter with colon: ''expr: expr'' - nkIdentDefs, # a definition like `a, b: typeDesc = expr` - # either typeDesc or expr may be nil; used in - # formal parameters, var statements, etc. - nkVarTuple, # a ``var (a, b) = expr`` construct - nkPar, # syntactic (); may be a tuple constructor - nkObjConstr, # object constructor: T(a: 1, b: 2) - nkCurly, # syntactic {} - nkCurlyExpr, # an expression like a{i} - nkBracket, # syntactic [] - nkBracketExpr, # an expression like a[i..j, k] - nkPragmaExpr, # an expression like a{.pragmas.} - nkRange, # an expression like i..j - nkDotExpr, # a.b - nkCheckedFieldExpr, # a.b, but b is a field that needs to be checked - nkDerefExpr, # a^ - nkIfExpr, # if as an expression - nkElifExpr, - nkElseExpr, - nkLambda, # lambda expression - nkDo, # lambda block appearing as trailing proc param - nkAccQuoted, # `a` as a node - - nkTableConstr, # a table constructor {expr: expr} - nkBind, # ``bind expr`` node - nkClosedSymChoice, # symbol choice node; a list of nkSyms (closed) - nkOpenSymChoice, # symbol choice node; a list of nkSyms (open) - nkHiddenStdConv, # an implicit standard type conversion - nkHiddenSubConv, # an implicit type conversion from a subtype - # to a supertype - nkConv, # a type conversion - nkCast, # a type cast - nkStaticExpr, # a static expr - nkAddr, # a addr expression - nkHiddenAddr, # implicit address operator - nkHiddenDeref, # implicit ^ operator - nkObjDownConv, # down conversion between object types - nkObjUpConv, # up conversion between object types - nkChckRangeF, # range check for floats - nkChckRange64, # range check for 64 bit ints - nkChckRange, # range check for ints - nkStringToCString, # string to cstring - nkCStringToString, # cstring to string - # end of expressions - - nkAsgn, # a = b - nkFastAsgn, # internal node for a fast ``a = b`` - # (no string copy) - nkGenericParams, # generic parameters - nkFormalParams, # formal parameters - nkOfInherit, # inherited from symbol - - nkImportAs, # a 'as' b in an import statement - nkProcDef, # a proc - nkMethodDef, # a method - nkConverterDef, # a converter - nkMacroDef, # a macro - nkTemplateDef, # a template - nkIteratorDef, # an iterator - - nkOfBranch, # used inside case statements - # for (cond, action)-pairs - nkElifBranch, # used in if statements - nkExceptBranch, # an except section - nkElse, # an else part - nkAsmStmt, # an assembler block - nkPragma, # a pragma statement - nkPragmaBlock, # a pragma with a block - nkIfStmt, # an if statement - nkWhenStmt, # a when expression or statement - nkForStmt, # a for statement - nkParForStmt, # a parallel for statement - nkWhileStmt, # a while statement - nkCaseStmt, # a case statement - nkTypeSection, # a type section (consists of type definitions) - nkVarSection, # a var section - nkLetSection, # a let section - nkConstSection, # a const section - nkConstDef, # a const definition - nkTypeDef, # a type definition - nkYieldStmt, # the yield statement as a tree - nkDefer, # the 'defer' statement - nkTryStmt, # a try statement - nkFinally, # a finally section - nkRaiseStmt, # a raise statement - nkReturnStmt, # a return statement - nkBreakStmt, # a break statement - nkContinueStmt, # a continue statement - nkBlockStmt, # a block statement - nkStaticStmt, # a static statement - nkDiscardStmt, # a discard statement - nkStmtList, # a list of statements - nkImportStmt, # an import statement - nkImportExceptStmt, # an import x except a statement - nkExportStmt, # an export statement - nkExportExceptStmt, # an 'export except' statement - nkFromStmt, # a from * import statement - nkIncludeStmt, # an include statement - nkBindStmt, # a bind statement - nkMixinStmt, # a mixin statement - nkUsingStmt, # an using statement - nkCommentStmt, # a comment statement - nkStmtListExpr, # a statement list followed by an expr; this is used - # to allow powerful multi-line templates - nkBlockExpr, # a statement block ending in an expr; this is used - # to allow powerful multi-line templates that open a - # temporary scope - nkStmtListType, # a statement list ending in a type; for macros - nkBlockType, # a statement block ending in a type; for macros - # types as syntactic trees: - - nkWith, # distinct with `foo` - nkWithout, # distinct without `foo` - - nkTypeOfExpr, # type(1+2) - nkObjectTy, # object body - nkTupleTy, # tuple body - nkTupleClassTy, # tuple type class - nkTypeClassTy, # user-defined type class - nkStaticTy, # ``static[T]`` - nkRecList, # list of object parts - nkRecCase, # case section of object - nkRecWhen, # when section of object - nkRefTy, # ``ref T`` - nkPtrTy, # ``ptr T`` - nkVarTy, # ``var T`` - nkConstTy, # ``const T`` - nkMutableTy, # ``mutable T`` - nkDistinctTy, # distinct type - nkProcTy, # proc type - nkIteratorTy, # iterator type - nkSharedTy, # 'shared T' - # we use 'nkPostFix' for the 'not nil' addition - nkEnumTy, # enum body - nkEnumFieldDef, # `ident = expr` in an enumeration - nkArgList, # argument list - nkPattern, # a special pattern; used for matching - nkHiddenTryStmt, # a hidden try statement - nkClosure, # (prc, env)-pair (internally used for code gen) - nkGotoState, # used for the state machine (for iterators) - nkState, # give a label to a code section (for iterators) - nkBreakState, # special break statement for easier code generation - nkFuncDef, # a func - nkTupleConstr # a tuple constructor - nkError # erroneous AST node see `errorhandling` - nkModuleRef # for .rod file support: A (moduleId, itemId) pair - nkReplayAction # for .rod file support: A replay action - nkNilRodNode # for .rod file support: a 'nil' PNode - - TNodeKinds* = set[TNodeKind] - -type - TSymFlag* = enum # 48 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 - sfProcvar, # proc can be passed to a proc var - 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 - sfOverriden, # 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 - 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' - sfEffectsDelayed # an 'effectsDelayed' parameter - - TSymFlags* = set[TSymFlag] - -const - sfNoInit* = sfMainModule # don't generate code to init the variable - - sfAllUntyped* = sfVolatile # macro or template is immediately expanded \ - # in a generic context - - sfDirty* = sfPure - # template is not hygienic (old styled template) - # module, compiled from a dirty-buffer - - sfAnon* = sfDiscardable - # symbol name that was generated by the compiler - # the compiler will avoid printing such names - # in user messages. - - sfNoForward* = sfRegister - # forward declarations are not required (per module) - sfReorder* = sfForward - # reordering pass is enabled - - sfCompileToCpp* = sfInfixCall # compile the module as C++ code - sfCompileToObjc* = sfNamedParamCall # compile the module as Objective-C code - sfExperimental* = sfOverriden # module uses the .experimental switch - sfGoto* = sfOverriden # var is used for 'goto' code generation - sfWrittenTo* = sfBorrow # param is assigned to - sfEscapes* = sfProcvar # param escapes - sfBase* = sfDiscriminant - sfIsSelf* = sfOverriden # param is 'self' - sfCustomPragma* = sfRegister # symbol is custom pragma template -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 - effectListLen* = 5 # 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,+∞] - - tyProxy # used as errornous type (for idetools) - - 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 `lastSon`. Between `base` and `lastSon` - # there may be 0, 2 or more types that were also considered as - # possible candidates in the inference process (i.e. lastSon 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} - tyError* = tyProxy # as an errornous node should match everything - tyUnknown* = tyFromExpr - - tyUnknownTypes* = {tyError, tyFromExpr} - - tyTypeClasses* = {tyBuiltInTypeClass, tyCompositeTypeClass, - tyUserTypeClass, tyUserTypeClassInst, - 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 - nfImplicitPragma # node is a "singlePragma" this is a transition flag - # created as part of nkError refactoring for the pragmas - # module. an old proc, `singlePragma` did a lot of side- - # effects and returned a bool signal to callers typically to - # either break a loop and raise an error in - # `pragmas.implicitPragmas` or simply break a loop in - # `pragmas.pragmaRec`. - - TNodeFlags* = set[TNodeFlag] - TTypeFlag* = enum # keep below 32 for efficiency reasons (now: 43) - 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 constains 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 - - 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) - skAlias # an alias (needs to be resolved immediately) - TSymKinds* = set[TSymKind] - -const - routineKinds* = {skProc, skFunc, skMethod, skIterator, - skConverter, skMacro, skTemplate} - ExportableSymKinds* = {skVar, skLet, skConst, skType, skEnumField, skStub, skAlias} + routineKinds - - tfUnion* = tfNoSideEffect - tfGcSafe* = tfThread - tfObjHasKids* = tfEnumHasHoles - tfReturnsNew* = tfInheritable - skError* = skUnknown - -var - eqTypeFlags* = {tfIterator, tfNotNil, tfVarIsPtr, tfGcSafe, tfNoSideEffect} - ## 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, - mIntToStr, mInt64ToStr, mFloatToStr, # for compiling nimStdlibVersion < 1.5.1 (not bootstrapping) - mCStrToStr, - mStrToStr, mEnumToStr, - mAnd, mOr, - mImplies, mIff, mExists, mForall, mOld, - mEqStr, mLeStr, mLtStr, - mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, - 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, - mIsPartOf, mAstToStr, mParallel, - mSwap, mIsNil, mArrToSeq, - mNewString, mNewStringOfCap, mParseBiggestFloat, - mMove, mWasMoved, mDestroy, mTrace, - mDefault, mUnown, mFinished, mIsolate, mAccessEnv, mReset, - 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, mNSetType, 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, mRunnableExamples, - mException, mBuiltinType, mSymOwner, mUncheckedArray, mGetImplTransf, - mSymIsInstantiationOf, mNodeId, mPrivateAccess - - -# things that we can evaluate safely at compile time, even if not asked for it: -const - 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, - mIntToStr, mInt64ToStr, mFloatToStr, - mCStrToStr, - mStrToStr, mEnumToStr, - mAnd, mOr, - mEqStr, mLeStr, mLtStr, - mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, - mConStrStr, mAppendStrCh, mAppendStrStr, mAppendSeqElem, - mInSet, mRepr} - -type - ItemId* = object - module*: int32 - item*: int32 - -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 +from strutils import toLowerAscii +import ./ast_types +export ast_types -type - TIdObj* {.acyclic.} = object of RootObj - itemId*: ItemId - PIdObj* = ref TIdObj - - 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 - typ*: 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 - - 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 - lfFullExternalName, # only used when 'conf.cmd == cmdNimfix': Indicates - # that the symbol has been imported via 'importc: "fullname"' and - # no format string. - lfNoDeepCopy, # no need for a deep copy - lfNoDecl, # do not declare it in C - lfDynamicLib, # link symbol to dynamic library - 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 - r*: Rope # rope value 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: - isOverriden*: 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] - compilesId*: CompilesId - - PInstantiation* = ref TInstantiation - - TScope* {.acyclic.} = object - depthLevel*: int - symbols*: TStrTable - parent*: PScope - allowPrivateAccess*: seq[PSym] # # enable access to private fields - - PScope* = ref TScope - - PLib* = ref TLib - TSym* {.acyclic.} = object of TIdObj # Keep in sync with PackedSym - # 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 - owner*: 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) - # for skError, starting to migrate this to be the - # nkError node with the necessary error info - 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*: int # offset of record field - 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 pragma in the hope - # it won't cause problems - # for skModule the string literal to output for - # deprecated modules. - when defined(nimsuggest): - allUsages*: seq[TLineInfo] - - TTypeSeq* = seq[PType] - TLockLevel* = distinct int16 - - TTypeAttachedOp* = enum ## as usual, order is important here - attachedDestructor, - attachedAsgn, - attachedSink, - attachedTrace, - attachedDeepCopy - - TType* {.acyclic.} = object of TIdObj # \ - # types are identical iff they have the - # same id; there may be multiple copies of a type - # in memory! - # Keep in sync with PackedType - 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 - owner*: 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 # - lockLevel*: TLockLevel # lock level as required for deadlock checking - 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* = object - key*: PIdObj - val*: RootRef - - TIdPairSeq* = seq[TIdPair] - TIdTable* = object # the same as table[PIdent] of PObject - counter*: int - data*: TIdPairSeq - - TIdNodePair* = object - key*: PIdObj - val*: PNode - - TIdNodePairSeq* = seq[TIdNodePair] - TIdNodeTable* = object # the same as table[PIdObj] of PNode - counter*: int - data*: TIdNodePairSeq - - TNodePair* = object - h*: Hash # because it is expensive to compute! - key*: PNode - val*: int - - TNodePairSeq* = seq[TNodePair] - TNodeTable* = object # the same as table[PNode] of int; - # nodes are compared by structure! - counter*: int - data*: TNodePairSeq - - TObjectSeq* = seq[RootRef] - TObjectSet* = object - counter*: int - data*: TObjectSeq - - TImplication* = enum - impUnknown, impNo, impYes +export int128 template nodeId(n: PNode): int = cast[int](n) 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. + ## 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. comments: Table[int, string] # nodeId => comment useIc*: bool @@ -1042,6 +60,12 @@ const OverloadableSyms* = {skProc, skFunc, skMethod, skIterator, skConverter, skModule, skTemplate, skMacro, skEnumField} + skipForDiscardable* = {nkIfStmt, nkIfExpr, nkCaseStmt, nkOfBranch, + nkElse, nkStmtListExpr, nkTryStmt, nkFinally, nkExceptBranch, + nkElifBranch, nkElifExpr, nkElseExpr, nkBlockStmt, nkBlockExpr, + nkHiddenStdConv, nkHiddenDeref} + + GenericTypes*: TTypeKinds = {tyGenericInvocation, tyGenericBody, tyGenericParam} @@ -1068,15 +92,23 @@ const nfIsRef, nfIsPtr, nfPreventCg, nfLL, nfFromTemplate, nfDefaultRefsParam, nfExecuteOnReload, nfLastRead, nfFirstWrite} - 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 + namePos* = 0 ## Name of the type/proc-like node + patternPos* = 1 ## empty except for term rewriting macros + genericParamsPos* = 2 ## Generic parametesr in the procedure-like nodes + paramsPos* = 3 ## Formal parameters in the procedure-like nodes + pragmasPos* = 4 ## Position of the pragma in the procedure-like nodes + miscPos* = 5 ## used for undocumented and hacky stuff + bodyPos* = 6 ## position of body; use rodread.getBody() instead! + resultPos* = 7 + dispatcherPos* = 8 + + wrongNodePos* = 0 ## Error the ast node we swapped + errorKindPos* = 1 ## Error kind enum as an intlit + compilerInfoPos* = 2 ## Error compiler source file as strlit, line & col + ## on info + firstArgPos* = 3 ## Error first 0..n additional nodes depends on + ## error kind + nfAllFieldsSet* = nfBase2 @@ -1129,11 +161,11 @@ const nkIfExpr, nkIfStmt, nkElifBranch, nkElifExpr, nkElse, nkElseExpr, nkCaseStmt, nkOfBranch, nkWhenStmt, - + nkForStmt, nkWhileStmt, - + nkBlockExpr, nkBlockStmt, - + nkDiscardStmt, nkContinueStmt, nkBreakStmt, nkReturnStmt, nkRaiseStmt, nkYieldStmt, @@ -1340,7 +372,7 @@ when defined(useNodeIds): var gNodeId: int template newNodeImpl(info2) = - result = PNode(kind: kind, info: info2) + result = PNode(kind: kind, info: info2, reportId: emptyReportId) when false: # this would add overhead, so we skip it; it results in a small amount of leaked entries # for old PNode that gets re-allocated at the same address as a PNode that @@ -1832,6 +864,7 @@ template copyNodeImpl(dst, src, processSonsStmt) = dst.typ = src.typ dst.flags = src.flags * PersistentNodeFlags dst.comment = src.comment + dst.reportId = src.reportId when defined(useNodeIds): if dst.id == nodeIdToDebug: echo "COMES FROM ", src.id diff --git a/compiler/ast_types.nim b/compiler/ast_types.nim new file mode 100644 index 00000000000..24d61a21bbb --- /dev/null +++ b/compiler/ast_types.nim @@ -0,0 +1,1173 @@ +import ropes +import std/[hashes] + +const + hasFFI = defined(nimHasLibFFI) + +type + TOption* = enum + ## please make sure we have under 32 options (improves code efficiency + ## a lot!) **keep binary compatible** + optNone + optObjCheck ## `ccgenexprs.nim` generates `isObj` check if this options + ## is enabled for a procedure + optFieldCheck ## Codegen uses it to conditionally generate check for a + ## discriminant field + optRangeCheck ## Control generation of range checks in the backend + optBoundsCheck ## Control generation of the array boundary checks in + ## the backend + optOverflowCheck ## Integer overflow check control + optRefCheck ## Deprecated option, does something with refs in te + ## `liftdestructors.nim`, need to investigate further + optNaNCheck ## Raise float invalid defect C backend if operation + ## returned nan + optInfCheck ## Raise float overflow in C backend if operation reaturned + ## inf + optStaticBoundsCheck + optStyleCheck ## Check symbol for spelling consistency + optAssert + optLineDir + optWarns + optHints + optOptimizeSpeed + optOptimizeSize + optStackTrace ## stack tracing support + optStackTraceMsgs ## enable custom runtime msgs via `setFrameMsg` + optLineTrace ## line tracing support (includes stack tracing) + optByRef ## use pass by ref for objects + ## (for interfacing with C) + optProfiler ## profiler turned on + optImplicitStatic ## optimization: implicit at compile time + ## evaluation + optTrMacros ## en/disable pattern matching + optMemTracker + optSinkInference ## 'sink T' inference + optCursorInference + optImportHidden + + TOptions* = set[TOption] + + +type + FileIndex* = distinct int32 + TLineInfo* = object ## This is designed to be as small as + ## possible, because it is used in syntax nodes. We save space here by + ## using two int16 and an int32. On 64 bit and on 32 bit systems this + ## is only 8 bytes. + + line*: uint16 + col*: int16 + fileIndex*: FileIndex + when defined(nimpretty): + offsetA*, offsetB*: int + commentOffsetA*, commentOffsetB*: int + +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 + +type + TNodeKind* = enum + ## order is important, because ranges are used to check whether a node + ## belongs to a certain class + + nkNone ## unknown node kind: indicates an error + ## Expressions: + ## Atoms: + nkEmpty ## the node is empty + nkIdent ## node is an identifier + nkSym ## node is a symbol + nkType ## node is used for its typ field + + nkCharLit ## a character literal '' + nkIntLit ## an integer literal + nkInt8Lit + nkInt16Lit + nkInt32Lit + nkInt64Lit + nkUIntLit ## an unsigned integer literal + nkUInt8Lit + nkUInt16Lit + nkUInt32Lit + nkUInt64Lit + nkFloatLit ## a floating point literal + nkFloat32Lit + nkFloat64Lit + nkFloat128Lit + nkStrLit ## a string literal "" + nkRStrLit ## a raw string literal r"" + nkTripleStrLit ## a triple string literal """ + nkNilLit ## the nil literal + ## end of atoms + nkComesFrom ## "comes from" template/macro information for + ## better stack trace generation + nkDotCall ## used to temporarily flag a nkCall node; + ## this is used + ## for transforming ``s.len`` to ``len(s)`` + + nkCommand ## a call like ``p 2, 4`` without parenthesis + nkCall ## a call like p(x, y) or an operation like +(a, b) + nkCallStrLit ## a call with a string literal + ## x"abc" has two sons: nkIdent, nkRStrLit + ## x"""abc""" has two sons: nkIdent, nkTripleStrLit + nkInfix ## a call like (a + b) + nkPrefix ## a call like !a + nkPostfix ## something like a! (also used for visibility) + nkHiddenCallConv ## an implicit type conversion via a type converter + + nkExprEqExpr ## a named parameter with equals: ''expr = expr'' + nkExprColonExpr ## a named parameter with colon: ''expr: expr'' + nkIdentDefs ## a definition like `a, b: typeDesc = expr` + ## either typeDesc or expr may be nil; used in + ## formal parameters, var statements, etc. + nkVarTuple ## a ``var (a, b) = expr`` construct + nkPar ## syntactic (); may be a tuple constructor + nkObjConstr ## object constructor: T(a: 1, b: 2) + nkCurly ## syntactic {} + nkCurlyExpr ## an expression like a{i} + nkBracket ## syntactic [] + nkBracketExpr ## an expression like a[i..j, k] + nkPragmaExpr ## an expression like a{.pragmas.} + nkRange ## an expression like i..j + nkDotExpr ## a.b + nkCheckedFieldExpr ## a.b, but b is a field that needs to be checked + nkDerefExpr ## a^ + nkIfExpr ## if as an expression + nkElifExpr + nkElseExpr + nkLambda ## lambda expression + nkDo ## lambda block appearing as trailing proc param + nkAccQuoted ## `a` as a node + + nkTableConstr ## a table constructor {expr: expr} + nkBind ## ``bind expr`` node + nkClosedSymChoice ## symbol choice node; a list of nkSyms (closed) + nkOpenSymChoice ## symbol choice node; a list of nkSyms (open) + nkHiddenStdConv ## an implicit standard type conversion + nkHiddenSubConv ## an implicit type conversion from a subtype + ## to a supertype + nkConv ## a type conversion + nkCast ## a type cast + nkStaticExpr ## a static expr + nkAddr ## a addr expression + nkHiddenAddr ## implicit address operator + nkHiddenDeref ## implicit ^ operator + nkObjDownConv ## down conversion between object types + nkObjUpConv ## up conversion between object types + nkChckRangeF ## range check for floats + nkChckRange64 ## range check for 64 bit ints + nkChckRange ## range check for ints + nkStringToCString ## string to cstring + nkCStringToString ## cstring to string + ## end of expressions + + nkAsgn ## a = b + nkFastAsgn ## internal node for a fast ``a = b`` + ## (no string copy) + nkGenericParams ## generic parameters + nkFormalParams ## formal parameters + nkOfInherit ## inherited from symbol + + nkImportAs ## a 'as' b in an import statement + nkProcDef ## a proc + nkMethodDef ## a method + nkConverterDef ## a converter + nkMacroDef ## a macro + nkTemplateDef ## a template + nkIteratorDef ## an iterator + + nkOfBranch ## used inside case statements + ## for (cond, action)-pairs + nkElifBranch ## used in if statements + nkExceptBranch ## an except section + nkElse ## an else part + nkAsmStmt ## an assembler block + nkPragma ## a pragma statement + nkPragmaBlock ## a pragma with a block + nkIfStmt ## an if statement + nkWhenStmt ## a when expression or statement + nkForStmt ## a for statement + nkParForStmt ## a parallel for statement + nkWhileStmt ## a while statement + nkCaseStmt ## a case statement + nkTypeSection ## a type section (consists of type definitions) + nkVarSection ## a var section + nkLetSection ## a let section + nkConstSection ## a const section + nkConstDef ## a const definition + nkTypeDef ## a type definition + nkYieldStmt ## the yield statement as a tree + nkDefer ## the 'defer' statement + nkTryStmt ## a try statement + nkFinally ## a finally section + nkRaiseStmt ## a raise statement + nkReturnStmt ## a return statement + nkBreakStmt ## a break statement + nkContinueStmt ## a continue statement + nkBlockStmt ## a block statement + nkStaticStmt ## a static statement + nkDiscardStmt ## a discard statement + nkStmtList ## a list of statements + nkImportStmt ## an import statement + nkImportExceptStmt ## an import x except a statement + nkExportStmt ## an export statement + nkExportExceptStmt ## an 'export except' statement + nkFromStmt ## a from * import statement + nkIncludeStmt ## an include statement + nkBindStmt ## a bind statement + nkMixinStmt ## a mixin statement + nkUsingStmt ## an using statement + nkCommentStmt ## a comment statement + nkStmtListExpr ## a statement list followed by an expr; this is used + ## to allow powerful multi-line templates + nkBlockExpr ## a statement block ending in an expr; this is used + ## to allow powerful multi-line templates that open a + ## temporary scope + nkStmtListType ## a statement list ending in a type; for macros + nkBlockType ## a statement block ending in a type; for macros + ## types as syntactic trees: + + nkWith ## distinct with `foo` + nkWithout ## distinct without `foo` + + nkTypeOfExpr ## type(1+2) + nkObjectTy ## object body + nkTupleTy ## tuple body + nkTupleClassTy ## tuple type class + nkTypeClassTy ## user-defined type class + nkStaticTy ## ``static[T]`` + nkRecList ## list of object parts + nkRecCase ## case section of object + nkRecWhen ## when section of object + nkRefTy ## ``ref T`` + nkPtrTy ## ``ptr T`` + nkVarTy ## ``var T`` + nkConstTy ## ``const T`` + nkMutableTy ## ``mutable T`` + nkDistinctTy ## distinct type + nkProcTy ## proc type + nkIteratorTy ## iterator type + nkSharedTy ## 'shared T' + ## we use 'nkPostFix' for the 'not nil' addition + nkEnumTy ## enum body + nkEnumFieldDef ## `ident = expr` in an enumeration + nkArgList ## argument list + nkPattern ## a special pattern; used for matching + nkHiddenTryStmt ## a hidden try statement + nkClosure ## (prc, env)-pair (internally used for code gen) + nkGotoState ## used for the state machine (for iterators) + nkState ## give a label to a code section (for iterators) + nkBreakState ## special break statement for easier code generation + nkFuncDef ## a func + nkTupleConstr ## a tuple constructor + nkError ## erroneous AST node see `errorhandling` + nkModuleRef ## for .rod file support: A (moduleId, itemId) pair + nkReplayAction ## for .rod file support: A replay action + nkNilRodNode ## for .rod file support: a 'nil' PNode + + TNodeKinds* = set[TNodeKind] + +type + TSymFlag* = enum # 48 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 + sfProcvar ## proc can be passed to a proc var + 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 + sfOverriden ## 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 + 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' + sfEffectsDelayed ## an 'effectsDelayed' parameter + + TSymFlags* = set[TSymFlag] + +const + sfNoInit* = sfMainModule ## don't generate code to init the variable + + sfAllUntyped* = sfVolatile ## macro or template is immediately expanded \ + ## in a generic context + + sfDirty* = sfPure + ## template is not hygienic (old styled template) + ## module, compiled from a dirty-buffer + + sfAnon* = sfDiscardable + ## symbol name that was generated by the compiler + ## the compiler will avoid printing such names + ## in user messages. + + sfNoForward* = sfRegister ## forward declarations are not required (per module) + sfReorder* = sfForward ## reordering pass is enabled + sfCompileToCpp* = sfInfixCall ## compile the module as C++ code + sfCompileToObjc* = sfNamedParamCall ## compile the module as Objective-C code + sfExperimental* = sfOverriden ## module uses the .experimental switch + sfGoto* = sfOverriden ## var is used for 'goto' code generation + sfWrittenTo* = sfBorrow ## param is assigned to + sfEscapes* = sfProcvar ## param escapes + sfBase* = sfDiscriminant + sfIsSelf* = sfOverriden ## param is 'self' + sfCustomPragma* = sfRegister ## symbol is custom pragma template + +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 + effectListLen* = 5 ## 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,+∞] + + tyProxy ## used as errornous type (for idetools) + + 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 `lastSon`. Between `base` and `lastSon` + ## there may be 0, 2 or more types that were also considered as + ## possible candidates in the inference process (i.e. lastSon 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} + tyError* = tyProxy ## as an errornous node should match everything + tyUnknown* = tyFromExpr + + tyUnknownTypes* = {tyError, tyFromExpr} + + tyTypeClasses* = {tyBuiltInTypeClass, tyCompositeTypeClass, + tyUserTypeClass, tyUserTypeClassInst, + 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 + nfImplicitPragma ## node is a "singlePragma" this is a transition flag + ## created as part of nkError refactoring for the pragmas + ## module. an old proc, `singlePragma` did a lot of side- + ## effects and returned a bool signal to callers typically to + ## either break a loop and raise an error in + ## `pragmas.implicitPragmas` or simply break a loop in + ## `pragmas.pragmaRec`. + + TNodeFlags* = set[TNodeFlag] + TTypeFlag* = enum ## keep below 32 for efficiency reasons (now: 43) + 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 constains 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 + + 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) + skAlias ## an alias (needs to be resolved immediately) + + TSymKinds* = set[TSymKind] + + +const + routineKinds* = {skProc, skFunc, skMethod, skIterator, + skConverter, skMacro, skTemplate} + ExportableSymKinds* = {skVar, skLet, skConst, skType, skEnumField, skStub, skAlias} + routineKinds + + tfUnion* = tfNoSideEffect + tfGcSafe* = tfThread + tfObjHasKids* = tfEnumHasHoles + tfReturnsNew* = tfInheritable + skError* = skUnknown + +var + eqTypeFlags* = { + tfIterator, + tfNotNil, + tfVarIsPtr, # so that we don't unify T& and T* in C++ land + tfGcSafe, + tfNoSideEffect + } + ## 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, + mIntToStr, mInt64ToStr, mFloatToStr, # for compiling nimStdlibVersion < 1.5.1 (not bootstrapping) + mCStrToStr, + mStrToStr, mEnumToStr, + mAnd, mOr, + mImplies, mIff, mExists, mForall, mOld, + mEqStr, mLeStr, mLtStr, + mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, + 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, + mIsPartOf, mAstToStr, mParallel, + mSwap, mIsNil, mArrToSeq, + mNewString, mNewStringOfCap, mParseBiggestFloat, + mMove, mWasMoved, mDestroy, mTrace, + mDefault, mUnown, mFinished, mIsolate, mAccessEnv, mReset, + 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, mNSetType, 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, mRunnableExamples, + mException, mBuiltinType, mSymOwner, mUncheckedArray, mGetImplTransf, + mSymIsInstantiationOf, mNodeId, mPrivateAccess + + +# things that we can evaluate safely at compile time, even if not asked for it: +const + 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, + mIntToStr, mInt64ToStr, mFloatToStr, + mCStrToStr, + mStrToStr, mEnumToStr, + mAnd, mOr, + mEqStr, mLeStr, mLtStr, + mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, + mConStrStr, mAppendStrCh, mAppendStrStr, mAppendSeqElem, + mInSet, mRepr} + +type + ItemId* = object + module*: int32 + item*: int32 + +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 + TIdObj* {.acyclic.} = object of RootObj + itemId*: ItemId + PIdObj* = ref TIdObj + + PNode* = ref TNode + TNodeSeq* = seq[PNode] + PType* = ref TType + PSym* = ref TSym + ReportId* = distinct uint32 ## Id of the report in the report list. + ## Report itself is defined in the `reports.nim` which imports `ast.nim`, + ## so id type is 'forward'-declared here to avoid cyclic dependencies. + ## Main type definitions are in the `reports.nim`, storage of the reports + ## list (that report id indexes into) + + PIdent* = ref TIdent + TIdent*{.acyclic.} = object + id*: int ## unique id; use this for comparisons and not the pointers + s*: string + next*: PIdent ## for hash-table chaining + h*: Hash ## hash value of s + + TNode*{.final, acyclic.} = object # on a 32bit machine, this takes 32 bytes + when defined(useNodeIds): + id*: int + typ*: PType + info*: TLineInfo + flags*: TNodeFlags + reportId*: ReportId + 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 + + 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 + lfFullExternalName, ## only used when 'conf.cmd == cmdNimfix': Indicates + ## that the symbol has been imported via 'importc: "fullname"' and + ## no format string. + lfNoDeepCopy, ## no need for a deep copy + lfNoDecl, ## do not declare it in C + lfDynamicLib, ## link symbol to dynamic library + 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 + r*: Rope ## rope value 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: + isOverriden*: 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] + compilesId*: CompilesId + + PInstantiation* = ref TInstantiation + + TScope* {.acyclic.} = object + depthLevel*: int + symbols*: TStrTable + parent*: PScope + allowPrivateAccess*: seq[PSym] # # enable access to private fields + + PScope* = ref TScope + + + + PLib* = ref TLib + TSym* {.acyclic.} = object of TIdObj # Keep in sync with PackedSym + ## 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 + owner*: 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) + ## for skError, starting to migrate this to be the + ## nkError node with the necessary error info + options*: TOptions # QUESTION I don't understand the exact purpose of + # this field - most of the time it is copied between + # symbols all over the place, but checked only in + # the `linter.nep1CheckDefImpl` proc (considering + # the `optStyleCheck` could've been a global option + # it makes it even more weird) + 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*: int ## offset of record field + 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 pragma in the hope + ## it won't cause problems + ## for skModule the string literal to output for + ## deprecated modules. + when defined(nimsuggest): + allUsages*: seq[TLineInfo] + + TTypeSeq* = seq[PType] + TLockLevel* = distinct int16 + + TTypeAttachedOp* = enum ## as usual, order is important here + attachedDestructor, + attachedAsgn, + attachedSink, + attachedTrace, + attachedDeepCopy + + TType* {.acyclic.} = object of TIdObj + ## types are identical only if they have the same id; there may be multiple + ## copies of a type in memory! Keep in sync with PackedType + 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 + owner*: 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 ## + lockLevel*: TLockLevel ## lock level as required for deadlock checking + 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* = object + key*: PIdObj + val*: RootRef + + TIdPairSeq* = seq[TIdPair] + TIdTable* = object # the same as table[PIdent] of PObject + counter*: int + data*: TIdPairSeq + + TIdNodePair* = object + key*: PIdObj + val*: PNode + + TIdNodePairSeq* = seq[TIdNodePair] + TIdNodeTable* = object # the same as table[PIdObj] of PNode + counter*: int + data*: TIdNodePairSeq + + TNodePair* = object + h*: Hash # because it is expensive to compute! + key*: PNode + val*: int + + TNodePairSeq* = seq[TNodePair] + TNodeTable* = object # the same as table[PNode] of int; + # nodes are compared by structure! + counter*: int + data*: TNodePairSeq + + TObjectSeq* = seq[RootRef] + TObjectSet* = object + counter*: int + data*: TObjectSeq + + TImplication* = enum + impUnknown, impNo, impYes + + + +type + EffectsCompat* = enum + efCompat + efRaisesDiffer + efRaisesUnknown + efTagsDiffer + efTagsUnknown + efLockLevelsDiffer + efEffectsDelayed + + MismatchKind* = enum + ## Procedure call argument mismatch reason + kUnknown + kAlreadyGiven ## Named argument already given + kUnknownNamedParam ## No such named parameter + kTypeMismatch ## Parameter type mismatch + kVarNeeded ## Parameter should be mutable + kMissingParam ## Missing procedure parameter + kExtraArg ## Too many arguments for a procedure call + kPositionalAlreadyGiven ## Positional parameter has already been givend + ## as a named parameter + + TTypeRelation* = enum ## order is important! + isNone + isConvertible + isIntConv + isSubtype + isSubrange ## subrange of the wanted type; no type conversion + ## but apart from that counts as ``isSubtype`` + isBothMetaConvertible ## generic proc parameter was matched against + ## generic type, e.g., map(mySeq, x=>x+1), + ## maybe recoverable by rerun if the parameter is + ## the proc's return value + isInferred ## generic proc was matched against a concrete type + isInferredConvertible ## same as above, but requiring proc CC conversion + isGeneric + isFromIntLit ## conversion *from* int literal; proven safe + isEqual + + ProcConvMismatch* = enum + pcmNoSideEffect + pcmNotGcSafe + pcmLockDifference + pcmNotIterator + pcmDifferentCallConv + +type + TTypeAllowedFlag* = enum + taField, + taHeap, + taConcept, + taIsOpenArray, + taNoUntyped + taIsTemplateOrMacro + taProcContextIsNotMacro + + TTypeAllowedFlags* = set[TTypeAllowedFlag] + + +type + TExprFlag* = enum + efLValue, efWantIterator, efWantIterable, efInTypeof, + efNeedStatic, + # Use this in contexts where a static value is mandatory + efPreferStatic, + # Use this in contexts where a static value could bring more + # information, but it's not strictly mandatory. This may become + # the default with implicit statics in the future. + efPreferNilResult, + # Use this if you want a certain result (e.g. static value), + # but you don't want to trigger a hard error. For example, + # you may be in position to supply a better error message + # to the user. + efWantStmt, efAllowStmt, efDetermineType, efExplain, + efWantValue, efOperand, efNoSemCheck, + efNoEvaluateGeneric, efInCall, efFromHlo, efNoSem2Check, + efNoUndeclared + # Use this if undeclared identifiers should not raise an error during + # overload resolution. + + TExprFlags* = set[TExprFlag] + + +const emptyReportId* = ReportId(0) + +func `==`*(id1, id2: ReportId): bool = uint32(id1) == uint32(id2) +func `<`*(id1, id2: ReportId): bool = uint32(id1) < uint32(id2) + +func isEmpty*(id: ReportId): bool = id == emptyReportId + +func `$`*(id: ReportId): string = + if id.isEmpty: + "" + + else: + "" diff --git a/compiler/astalgo.nim b/compiler/astalgo.nim index 94fa9da9329..dcd0d2d861a 100644 --- a/compiler/astalgo.nim +++ b/compiler/astalgo.nim @@ -627,6 +627,13 @@ proc value(this: var DebugPrinter; value: PNode) = if this.renderSymType and value.typ != nil: this.key "typ" this.value value.typ + + if value.kind == nkError: + this.key "file" + this.value $value[compilerInfoPos].strVal + this.key "line" + this.value $value[compilerInfoPos].info.line + if value.len > 0: this.key "sons" this.openBracket diff --git a/compiler/ccgcalls.nim b/compiler/ccgcalls.nim index 12f366a539a..14ec756d30b 100644 --- a/compiler/ccgcalls.nim +++ b/compiler/ccgcalls.nim @@ -53,7 +53,7 @@ proc preventNrvo(p: BProc; le, ri: PNode): bool = # annoying warnings, see #14514 if canRaise(ri[0]) and locationEscapes(p, le, p.nestedTryStmts.len > 0): - message(p.config, le.info, warnObservableStores, $le) + localReport(p.config, le, reportSem rsemObservableStores) proc hasNoInit(call: PNode): bool {.inline.} = result = call[0].kind == nkSym and sfNoInit in call[0].sym.flags @@ -500,7 +500,9 @@ proc genOtherArg(p: BProc; ri: PNode; i: int; typ: PType): Rope = result = genArgNoParam(p, ri[i]) #, typ.n[i].sym) else: if tfVarargs notin typ.flags: - localError(p.config, ri.info, "wrong argument count") + localReport(p.config, ri.info, semReportCountMismatch( + rsemWrongNumberOfArguments, expected = 1, got = 0, node = ri)) + result = nil else: result = genArgNoParam(p, ri[i]) @@ -624,7 +626,7 @@ proc genPatternCall(p: BProc; ri: PNode; pat: string; typ: PType): Rope = result.add genOtherArg(p, ri, k, typ) result.add(~")") else: - localError(p.config, ri.info, "call expression expected for C++ pattern") + localReport(p.config, ri, reportSem rsemExpectedCallForCxxPattern) inc i elif i+1 < pat.len and pat[i+1] == '.': result.add genThisArg(p, ri, j, typ) diff --git a/compiler/ccgexprs.nim b/compiler/ccgexprs.nim index 284c9007836..aff8418b395 100644 --- a/compiler/ccgexprs.nim +++ b/compiler/ccgexprs.nim @@ -951,7 +951,9 @@ proc genArrayElem(p: BProc, n, x, y: PNode, d: var TLoc) = if not isConstExpr(y): # semantic pass has already checked for const index expressions if firstOrd(p.config, ty) == 0 and lastOrd(p.config, ty) >= 0: - if (firstOrd(p.config, b.t) < firstOrd(p.config, ty)) or (lastOrd(p.config, b.t) > lastOrd(p.config, ty)): + if (firstOrd(p.config, b.t) < firstOrd(p.config, ty)) or + (lastOrd(p.config, b.t) > lastOrd(p.config, ty)): + linefmt(p, cpsStmts, "if ((NU)($1) > (NU)($2)){ #raiseIndexError2($1, $2); $3}$n", [rdCharLoc(b), intLiteral(lastOrd(p.config, ty)), raiseInstr(p)]) else: @@ -959,8 +961,16 @@ proc genArrayElem(p: BProc, n, x, y: PNode, d: var TLoc) = [rdCharLoc(b), first, intLiteral(lastOrd(p.config, ty)), raiseInstr(p)]) else: let idx = getOrdValue(y) - if idx < firstOrd(p.config, ty) or idx > lastOrd(p.config, ty): - localError(p.config, x.info, formatErrorIndexBound(idx, firstOrd(p.config, ty), lastOrd(p.config, ty))) + if idx < firstOrd(p.config, ty) or lastOrd(p.config, ty) < idx: + localReport( + p.config, x.info, SemReport( + kind: rsemStaticOutOfBounds, + indexSpec: ( + usedIdx: idx, + minIdx: firstOrd(p.config, ty), + maxIdx: lastOrd(p.config, ty)), + ast: y)) + d.inheritLocation(a) putIntoDest(p, d, n, ropecg(p.module, "$1[($2)- $3]", [rdLoc(a), rdCharLoc(b), first]), a.storage) @@ -1165,7 +1175,8 @@ proc genEcho(p: BProc, n: PNode) = linefmt(p, cpsStmts, "fflush(stdout);$n", []) proc gcUsage(conf: ConfigRef; n: PNode) = - if conf.selectedGC == gcNone: message(conf, n.info, warnGcMem, n.renderTree) + if conf.selectedGC == gcNone: + localReport(conf, n, reportSem rsemUseOfGc) proc strLoc(p: BProc; d: TLoc): Rope = if optSeqDestructors in p.config.globalOptions: @@ -1330,9 +1341,7 @@ proc rawGenNew(p: BProc, a: var TLoc, sizeExpr: Rope; needsInit: bool) = # finalizer is: ``proc (x: ref T) {.nimcall.}``. We need to check the calling # convention at least: if op.typ == nil or op.typ.callConv != ccNimCall: - localError(p.module.config, a.lode.info, - "the destructor that is turned into a finalizer needs " & - "to have the 'nimcall' calling convention") + localReport(p.module.config, a.lode, reportSem rsemExpectedNimcallProc) var f: TLoc initLocExpr(p, newSymNode(op), f) p.module.s[cfsTypeInit3].addf("$1->finalizer = (void*)$2;$n", [ti, rdLoc(f)]) @@ -1644,9 +1653,10 @@ proc genOf(p: BProc, x: PNode, typ: PType, d: var TLoc) = while t.kind == tyObject and t[0] != nil: r.add(~".Sup") t = skipTypes(t[0], skipPtrs) + if isObjLackingTypeField(t): - globalError(p.config, x.info, - "no 'of' operator available for pure objects") + localReport(p.config, x, reportSem rsemDisallowedOfForPureObjects) + if nilCheck != nil: r = ropecg(p.module, "(($1) && ($2))", [nilCheck, genOfHelper(p, dest, r, x.info)]) else: @@ -1658,7 +1668,7 @@ proc genOf(p: BProc, n: PNode, d: var TLoc) = proc genRepr(p: BProc, e: PNode, d: var TLoc) = if optTinyRtti in p.config.globalOptions: - localError(p.config, e.info, "'repr' is not available for --newruntime") + localReport(p.config, e, reportSem rsemDisallowedReprForNewruntime) var a: TLoc initLocExpr(p, e[1], a) var t = skipTypes(e[1].typ, abstractVarRange) @@ -1701,7 +1711,7 @@ proc genRepr(p: BProc, e: PNode, d: var TLoc) = ropecg(p.module, "#reprAny($1, $2)", [ rdLoc(a), genTypeInfoV1(p.module, t, e.info)]), a.storage) of tyEmpty, tyVoid: - localError(p.config, e.info, "'repr' doesn't support 'void' type") + localReport(p.config, e, reportSem rsemUnexpectedVoidType) else: putIntoDest(p, d, e, ropecg(p.module, "#reprAny($1, $2)", [addrLoc(p.config, a), genTypeInfoV1(p.module, t, e.info)]), @@ -2259,7 +2269,7 @@ proc genSlice(p: BProc; e: PNode; d: var TLoc) = if d.k == locNone: getTemp(p, e.typ, d) linefmt(p, cpsStmts, "$1.Field0 = $2; $1.Field1 = $3;$n", [rdLoc(d), x, y]) when false: - localError(p.config, e.info, "invalid context for 'toOpenArray'; " & + localReport(p.config, e.info, "invalid context for 'toOpenArray'; " & "'toOpenArray' is only valid within a call expression") proc genEnumToStr(p: BProc, e: PNode, d: var TLoc) = @@ -2423,12 +2433,15 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = of mEcho: genEcho(p, e[1].skipConv) of mArrToSeq: genArrToSeq(p, e, d) of mNLen..mNError, mSlurp..mQuoteAst: - localError(p.config, e.info, strutils.`%`(errXMustBeCompileTime, e[0].sym.name.s)) + localReport(p.config, e.info, reportSym( + rsemConstExpressionExpected, e[0].sym)) + of mSpawn: when defined(leanCompiler): p.config.quitOrRaise "compiler built without support for the 'spawn' statement" else: - let n = spawn.wrapProcForSpawn(p.module.g.graph, p.module.idgen, p.module.module, e, e.typ, nil, nil) + let n = spawn.wrapProcForSpawn( + p.module.g.graph, p.module.idgen, p.module.module, e, e.typ, nil, nil) expr(p, n, d) of mParallel: when defined(leanCompiler): @@ -2438,8 +2451,7 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = expr(p, n, d) of mDeepCopy: if p.config.selectedGC in {gcArc, gcOrc} and optEnableDeepCopy notin p.config.globalOptions: - localError(p.config, e.info, - "for --gc:arc|orc 'deepcopy' support has to be enabled with --deepcopy:on") + localReport(p.config, e, reportSem rsemRequiresDeepCopyEnabled) var a, b: TLoc let x = if e[1].kind in {nkAddr, nkHiddenAddr}: e[1][0] else: e[1] @@ -2746,8 +2758,9 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = #if sym.kind == skIterator: # echo renderTree(sym.getBody, {renderIds}) if sfCompileTime in sym.flags: - localError(p.config, n.info, "request to generate code for .compileTime proc: " & - sym.name.s) + localReport(p.config, n.info, reportSym( + rsemCannotCodegenCompiletimeProc, sym)) + if useAliveDataFromDce in p.module.flags and sym.typ.callConv != ccInline: fillProcLoc(p.module, n) genProcPrototype(p.module, sym) @@ -3000,7 +3013,8 @@ proc getDefaultValue(p: BProc; typ: PType; info: TLineInfo): Rope = if mapSetType(p.config, t) == ctArray: result = rope"{}" else: result = rope"0" else: - globalError(p.config, info, "cannot create null element for: " & $t.kind) + internalError( + p.config, info, "cannot create null element for: " & $t.kind) proc caseObjDefaultBranch(obj: PNode; branch: Int128): int = for i in 1 ..< obj.len: @@ -3070,7 +3084,7 @@ proc getNullValueAux(p: BProc; t: PType; obj, constOrNil: PNode, # not found, produce default value: result.add getDefaultValue(p, field.typ, info) else: - localError(p.config, info, "cannot create null element for: " & $obj) + internalError(p.config, info, "cannot create null element for: " & $obj) proc getNullValueAuxT(p: BProc; orig, t: PType; obj, constOrNil: PNode, result: var Rope; count: var int; @@ -3215,7 +3229,8 @@ proc genBracedInit(p: BProc, n: PNode; isConst: bool; optionalType: PType): Rope result = genConstTuple(p, n, isConst, typ) of tyOpenArray: if n.kind != nkBracket: - internalError(p.config, n.info, "const openArray expression is not an array construction") + internalError( + p.config, n.info, "const openArray expression is not an array construction") let data = genConstSimpleList(p, n, isConst) diff --git a/compiler/ccgliterals.nim b/compiler/ccgliterals.nim index ee56da58656..3ba5e3d9252 100644 --- a/compiler/ccgliterals.nim +++ b/compiler/ccgliterals.nim @@ -100,7 +100,8 @@ proc genStringLiteralDataOnly(m: BModule; s: string; info: TLineInfo; result = getTempName(m) genStringLiteralDataOnlyV2(m, s, result, isConst) else: - localError(m.config, info, "cannot determine how to produce code for string literal") + internalError( + m.config, info, "cannot determine how to produce code for string literal") proc genNilStringLiteral(m: BModule; info: TLineInfo): Rope = result = ropecg(m, "((#NimStringDesc*) NIM_NIL)", []) @@ -110,4 +111,5 @@ proc genStringLiteral(m: BModule; n: PNode): Rope = of 0, 1: result = genStringLiteralV1(m, n) of 2: result = genStringLiteralV2(m, n, isConst = true) else: - localError(m.config, n.info, "cannot determine how to produce code for string literal") + internalError( + m.config, n.info, "cannot determine how to produce code for string literal") diff --git a/compiler/ccgreset.nim b/compiler/ccgreset.nim index fc7370d8121..800c516a9cf 100644 --- a/compiler/ccgreset.nim +++ b/compiler/ccgreset.nim @@ -26,7 +26,7 @@ proc specializeResetN(p: BProc, accessor: Rope, n: PNode; let disc = n[0].sym if disc.loc.r == nil: fillObjectFields(p.module, typ) if disc.loc.t == nil: - internalError(p.config, n.info, "specializeResetN()") + internalError(p.config, n.info, "specializeResetN()") lineF(p, cpsStmts, "switch ($1.$2) {$n", [accessor, disc.loc.r]) for i in 1.. 10_000: - localError(p.config, it.info, - "case statement has too many cases for computed goto"); return + localReport(p.config, it, reportSem rsemTooManyEntriesForComputedGoto) + return + arraySize = toInt(aSize) if firstOrd(p.config, it[0].typ) != 0: - localError(p.config, it.info, - "case statement has to start at 0 for computed goto"); return + localReport(p.config, it, reportSem rsemExpectedLow0ForComputedGoto) + return + if casePos < 0: - localError(p.config, n.info, "no case statement found for computed goto"); return + localReport(p.config, n, reportSem rsemExpectedCaseForComputedGoto) + return + var id = p.labels+1 inc p.labels, arraySize+1 let tmp = "TMP$1_" % [id.rope] @@ -549,7 +556,7 @@ proc genComputedGoto(p: BProc; n: PNode) = let it = caseStmt[i] for j in 0.. 0: result.add closeNamespaceNim() result.addf("#endif /* $1 */$n", [guard]) if not writeRope(result, m.filename): - rawMessage(m.config, errCannotOpenFile, m.filename.string) + localReport(m.config, reportStr(rsemCannotOpenFile, m.filename.string)) proc getCFile(m: BModule): AbsoluteFile = let ext = @@ -1951,7 +1954,8 @@ proc shouldRecompile(m: BModule; code: Rope, cfile: Cfile): bool = else: echo "new file ", cfile.cname.string if not writeRope(code, cfile.cname): - rawMessage(m.config, errCannotOpenFile, cfile.cname.string) + localReport(m.config, reportStr(rsemCannotOpenFile, cfile.cname.string)) + result = true elif fileExists(cfile.obj) and os.fileNewer(cfile.obj.string, cfile.cname.string): result = false @@ -1959,7 +1963,8 @@ proc shouldRecompile(m: BModule; code: Rope, cfile: Cfile): bool = result = true else: if not writeRope(code, cfile.cname): - rawMessage(m.config, errCannotOpenFile, cfile.cname.string) + localReport(m.config, reportStr(rsemCannotOpenFile, cfile.cname.string)) + result = true # We need 2 different logics here: pending modules (including @@ -1990,7 +1995,9 @@ proc writeModule(m: BModule, pending: bool) = onExit() return - if not shouldRecompile(m, code, cf): cf.flags = {CfileFlag.Cached} + if not shouldRecompile(m, code, cf): + cf.flags = {CfileFlag.Cached} + addFileToCompile(m.config, cf) onExit() diff --git a/compiler/cgmeth.nim b/compiler/cgmeth.nim index 484bc9d9760..976a9cbbcd5 100644 --- a/compiler/cgmeth.nim +++ b/compiler/cgmeth.nim @@ -10,8 +10,8 @@ ## This module implements code generation for methods. import - intsets, options, ast, msgs, idents, renderer, types, magicsys, - sempass2, strutils, modulegraphs, lineinfos + intsets, options, ast, msgs, renderer, types, magicsys, + sempass2, modulegraphs, lineinfos, reports proc genConv(n: PNode, d: PType, downcast: bool; conf: ConfigRef): PNode = var dest = skipTypes(d, abstractPtrs) @@ -24,7 +24,9 @@ proc genConv(n: PNode, d: PType, downcast: bool; conf: ConfigRef): PNode = elif diff < 0: result = newNodeIT(nkObjUpConv, n.info, d) result.add n - if downcast: internalError(conf, n.info, "cgmeth.genConv: no upcast allowed") + if downcast: + internalError(conf, n.info, "cgmeth.genConv: no upcast allowed") + elif diff > 0: result = newNodeIT(nkObjDownConv, n.info, d) result.add n @@ -51,7 +53,8 @@ proc methodCall*(n: PNode; conf: ConfigRef): PNode = for i in 1.. 1: + result = $n[0] & "(" & result & ")" + + elif n.kind in {nkHiddenStdConv, nkHiddenSubConv} and n.len == 2: + result = typeToString(n.typ.skipTypes(abstractVar)) & "(" & result & ")" + +proc addPragmaAndCallConvMismatch*( + message: var string, + formal, actual: PType, + conf: ConfigRef, + ) = + ## Add pragma and calling convention mismatch for the `formal` (aka + ## expected) and `actual` (aka provided) types. + assert formal.kind == tyProc and actual.kind == tyProc + let (convMismatch, _) = getProcConvMismatch(conf, formal, actual) + + var + gotPragmas = "" + expectedPragmas = "" + + for reason in convMismatch: + case reason: + of pcmDifferentCallConv: + message.add "\n Calling convention mismatch: got '{.$1.}', but expected '{.$2.}'." % [ + $actual.callConv, $formal.callConv] + + of pcmNoSideEffect: + expectedPragmas.add "noSideEffect, " + of pcmNotGcSafe: + expectedPragmas.add "gcsafe, " + of pcmLockDifference: + gotPragmas.add("locks: " & $actual.lockLevel & ", ") + expectedPragmas.add("locks: " & $formal.lockLevel & ", ") + of pcmNotIterator: discard + + if expectedPragmas.len > 0: + gotPragmas.setLen(max(0, gotPragmas.len - 2)) # Remove ", " + expectedPragmas.setLen(max(0, expectedPragmas.len - 2)) # Remove ", " + message.add "\n Pragma mismatch: got '{.$1.}', but expected '{.$2.}'." % [gotPragmas, expectedPragmas] + + +proc effectProblem(f, a: PType; result: var string) = + ## Add effect difference annotation for `f` (aka formal/expected) and `a` + ## (aka actual/provided) types + if f.kind == tyProc and a.kind == tyProc: + if tfThread in f.flags and tfThread notin a.flags: + result.add "\n This expression is not GC-safe. Annotate the " & + "proc with {.gcsafe.} to get extended error information." + elif tfNoSideEffect in f.flags and tfNoSideEffect notin a.flags: + result.add "\n This expression can have side effects. Annotate the " & + "proc with {.noSideEffect.} to get extended error information." + else: + case compatibleEffects(f, a) + of efCompat: discard + of efRaisesDiffer: + result.add "\n The `.raises` requirements differ." + of efRaisesUnknown: + result.add "\n The `.raises` requirements differ. Annotate the " & + "proc with {.raises: [].} to get extended error information." + of efTagsDiffer: + result.add "\n The `.tags` requirements differ." + of efTagsUnknown: + result.add "\n The `.tags` requirements differ. Annotate the " & + "proc with {.tags: [].} to get extended error information." + of efLockLevelsDiffer: + result.add "\n The `.locks` requirements differ. Annotate the " & + "proc with {.locks: 0.} to get extended error information." + of efEffectsDelayed: + result.add "\n The `.effectsOf` annotations differ." + +proc argTypeToString(arg: PNode; prefer: TPreferedDesc): string = + ## Convert argument node type to string + if arg.kind in nkSymChoices: + result = typeToString(arg[0].typ, prefer) + for i in 1 ..< arg.len: + result.add(" | ") + result.add typeToString(arg[i].typ, prefer) + + elif arg.typ == nil: + result = "void" + + else: + result = arg.typ.typeToString(prefer) + + + +proc describeArgs(conf: ConfigRef, args: seq[PNode]; prefer = preferName): string = + ## Generate comma-separated list of arguments + for idx, arg in args: + if arg.kind == nkExprEqExpr: + result.add renderTree(arg[0]) + result.add ": " + if arg.typ.isNil and arg.kind notin {nkStmtList, nkDo}: + assert false, ( + "call `semcall.maybeResemArgs` on report construciton site - " & + "this is a temporary hack that is necessary to actually provide " & + "proper types for error reports.") + + else: + if arg.typ.isNil and arg.kind notin { + nkStmtList, nkDo, nkElse, nkOfBranch, nkElifBranch, nkExceptBranch + }: + assert false, "call `semcall.maybeResemArgs` on report construction site" + + if arg.typ != nil and arg.typ.kind == tyError: + return + + result.add argTypeToString(arg, prefer) + if idx != args.len - 1: + result.add ", " + +proc describeArgs( + conf: ConfigRef, n: PNode, startIdx = 1; + prefer = preferName + ): string = + ## Geenrate comma-separated list of arguments, overload for sequence + describeArgs(conf, toSeq(n.sons[startIdx .. ^1]), prefer) + +proc renderAsType*(vals: IntSet, t: PType): string = + ## Render integer values as type. For integer no representation + ## conversion is done, for char convert to characters, for enums use enum + ## symbols. + result = "{" + let t = t.skipTypes(abstractRange) + var enumSymOffset = 0 + var i = 0 + for val in vals: + if result.len > 1: + result &= ", " + case t.kind: + of tyEnum, tyBool: + while t.n[enumSymOffset].sym.position < val: inc(enumSymOffset) + result &= t.n[enumSymOffset].sym.name.s + of tyChar: + result.addQuoted(char(val)) + else: + if i == 64: + result &= "omitted $1 values..." % $(vals.len - i) + break + else: + result &= $val + inc(i) + result &= "}" + +proc getSymRepr*(conf: ConfigRef; s: PSym, getDeclarationPath = true): string = + case s.kind + of routineKinds, skType: + result = getProcHeader(conf, s, getDeclarationPath = getDeclarationPath) + else: + result = "'$1'" % s.name.s + if getDeclarationPath: + result.addDeclaredLoc(conf, s) + + +proc presentFailedCandidates( + conf: ConfigRef, + n: PNode, + errors: seq[SemCallMismatch] + ): (TPreferedDesc, string) = + ## Format failed candidates for call overload resolution failure + + var prefer = preferName + # to avoid confusing errors like: + # got (SslPtr, SocketHandle) + # but expected one of: + # openssl.SSL_set_fd(ssl: SslPtr, fd: SocketHandle): cint + # we do a pre-analysis. If all types produce the same string, we will add + # module information. + let proto = describeArgs(conf, n, 1, preferName) + for err in errors: + var errProto = "" + let n = err.target.typ.n + for i in 1 ..< n.len: + var p = n[i] + if p.kind == nkSym: + errProto.add(typeToString(p.sym.typ, preferName)) + if i != n.len - 1: + errProto.add(", ") + + if errProto == proto: + prefer = preferModuleInfo + break + + var filterOnlyFirst = false + if optShowAllMismatches notin conf.globalOptions: + for err in errors: + if err.arg > 1: + filterOnlyFirst = true + break + + var + maybeWrongSpace = false + candidatesAll: seq[string] + candidates = "" + skipped = 0 + + for err in errors: + candidates.setLen 0 + if filterOnlyFirst and err.arg == 1: + inc skipped + continue + + if err.target.kind in routineKinds and err.target.ast != nil: + candidates.add(renderTree( + err.target.ast, {renderNoBody, renderNoComments, renderNoPragmas})) + + else: + candidates.add(getProcHeader(conf, err.target, prefer)) + + candidates.addDeclaredLocMaybe(conf, err.target) + candidates.add("\n") + + let nArg = if err.arg < n.len: n[err.arg] else: nil + + let nameParam = if err.targetArg != nil: err.targetArg.name.s else: "" + if n.len > 1: + candidates.add(" first type mismatch at position: " & $err.arg) + # candidates.add "\n reason: " & $err.firstMismatch.kind # for debugging + case err.kind: + of kUnknownNamedParam: + if nArg == nil: + candidates.add("\n unknown named parameter") + else: + candidates.add("\n unknown named parameter: " & $nArg[0]) + + of kAlreadyGiven: + candidates.add("\n named param already provided: " & $nArg[0]) + + of kPositionalAlreadyGiven: + candidates.add("\n positional param was already given as named param") + + of kExtraArg: + candidates.add("\n extra argument given") + + of kMissingParam: + candidates.add("\n missing parameter: " & nameParam) + + of kTypeMismatch, kVarNeeded: + doAssert nArg != nil + let wanted = err.targetArg.typ + doAssert err.targetArg != nil + + candidates.add("\n required type for " & nameParam & ": ") + candidates.addTypeDeclVerboseMaybe(conf, wanted) + candidates.add "\n but expression '" + + if err.kind == kVarNeeded: + candidates.add renderNotLValue(nArg) + candidates.add "' is immutable, not 'var'" + + else: + candidates.add renderTree(nArg) + candidates.add "' is of type: " + + let got = nArg.typ + candidates.addTypeDeclVerboseMaybe(conf, got) + doAssert wanted != nil + + if got != nil: + if got.kind == tyProc and wanted.kind == tyProc: + # These are proc mismatches so, + # add the extra explict detail of the mismatch + candidates.addPragmaAndCallConvMismatch(wanted, got, conf) + effectProblem(wanted, got, candidates) + + of kUnknown: + discard "do not break 'nim check'" + + candidates.add "\n" + if err.arg == 1 and nArg.kind == nkTupleConstr and + n.kind == nkCommand: + maybeWrongSpace = true + + candidatesAll.add candidates + + candidatesAll.sort # fix #13538 + candidates = join(candidatesAll) + + if skipped > 0: + candidates.add( + $skipped & + " other mismatching symbols have been " & + "suppressed; compile with --showAllMismatches:on to see them\n") + + if maybeWrongSpace: + candidates.add( + "maybe misplaced space between " & renderTree(n[0]) & " and '(' \n") + + result = (prefer, candidates) + +proc presentSpellingCandidates*( + conf: ConfigRef, candidates: seq[SemSpellCandidate]): string = + ## Format potential spelling candidates + + result = "candidates (edit distance, scope distance); see '--spellSuggest':" + for candidate in candidates: + result.add "\n ($1, $2): '$3'" % [ + $candidate.dist, + $candidate.depth, + $candidate.sym.name.s + ] + + result.addDeclaredLoc(conf, candidate.sym) + +proc reportBody*(conf: ConfigRef, r: SemReport): string = + const defaultRenderFlags: set[TRenderFlag] = { + renderNoComments, + renderWithoutErrorPrefix + } + proc render(n: PNode, rf = defaultRenderFlags): string = renderTree(n, rf) + proc render(t: PType): string = typeToString(t) + + case SemReportKind(r.kind): + of rsemTypelessParam: + result = "typeless param" + + of rsemLinterReport: + result.addf("'$1' should be: '$2'", r.linterFail.got, r.linterFail.wanted) + + of rsemLinterReportUse: + result.addf("'$1' should be: '$2'", r.linterFail.got, r.linterFail.wanted) + result.addDeclaredLoc(conf, r.sym) + + of rsemWrappedError: + assert false, ( + "Cannot report wrapped sem error - use `walkErrors` in " & + "order to write out all accumulated reports") + + of rsemCannotConvertTypes: + result = "cannot convert $1 to $2" % [ + r.actualType.render, r.formalType.render] + + of rsemProveField: + result = "cannot prove that field '$1' is accessible" % r.ast.render + + of rsemUninit: + result = "use explicit initialization of '$1' for clarity" % r.symstr + + of rsemDuplicateCaseLabel: + result = "duplicate case label" + + of rsemIllegalMemoryCapture: + let s = r.symbols[0] + result = ( + "'$1' is of type <$2> which cannot be captured as it would violate memory" & + " safety, declared here: $3; using '-d:nimNoLentIterators' helps in some cases" + ) % [s.name.s, typeToString(s.typ), conf $ s.info] + + of rsemUnavailableTypeBound: + result.add( + "'", + r.str, + "' is not available for type <", + r.typ.render, + ">" + ) + + if r.str in ["=", "=copy"]: + result.add( + "; requires a copy because it's not the last read of '", + r.ast.render, + "'" + ) + + if r.missingTypeBoundElaboration.anotherRead.isSome(): + result.add( + "; another read is done here: ", + conf.toStr(r.missingTypeBoundElaboration.anotherRead.get())) + + elif r.missingTypeBoundElaboration.tryMakeSinkParam: + result.add("; try to make", r.ast.render, "a 'sink' parameter") + + result.add("; routine: ", r.symstr) + + of rsemIllegalCallconvCapture: + let s = r.symbols[0] + let owner = r.symbols[1] + result = "illegal capture '$1' because '$2' has the calling convention: <$3>" % [ + s.name.s, owner.name.s, $owner.typ.callConv] + + of rsemCallTypeMismatch: + let (prefer, candidates) = presentFailedCandidates( + conf, r.ast, r.callMismatches) + + result.add "type mismatch: got <" + result.add conf.describeArgs(r.ast, 1, prefer) + result.add ">" + if candidates != "": + result.add "\nbut expected one of:\n" & candidates + + result.add "\nexpression: " + result.add r.ast.render + + of rsemCallIndirectTypeMismatch: + result.addf( + "type mismatch: got <$1>\nbut expected one of:\n$2", + conf.describeArgs(r.ast, 1), + r.typ.render) + + if r.typ.sym != nil and + sfAnon notin r.typ.sym.flags and + r.typ.kind == tyProc: + result.add(" = ", typeToString(r.typ, preferDesc)) + + + of rsemVmStackTrace: + result = "stack trace: (most recent call last)\n" + for idx, (sym, loc) in r.stacktrace: + result.add( + conf.toStr(loc), + " ", + sym.name.s, + if idx == r.stacktrace.high: "" else: "\n" + ) + + of rsemVmUnhandledException: + result.addf( + "unhandled exception: $1 [$2]", + r.ast[3].skipColon.strVal, + r.ast[2].skipColon.strVal + ) + + of rsemExpandArc: + result.add( + "--expandArc: ", + r.symstr, + "\n", + r.expandedAst.renderTree({renderIr, renderNoComments}), + "\n", + "-- end of expandArc ------------------------" + ) + + of rsemCannotBorrow: + result.add( + "cannot borrow ", + r.symstr, + "; what it borrows from is potentially mutated" + ) + + if r.borrowPair.mutatedHere.isKnown(): + result.add("\n", conf.toStr(r.borrowPair.mutatedHere), " the mutation is here") + + if r.borrowPair.connectedVia.isKnown(): + result.add( + "\n", + conf.toStr(r.borrowPair.connectedVia), + " is the statement that connected the mutation to the parameter") + + of rsemVmNodeNotASymbol: + result = "node is not a symbol" + + of rsemVmNodeNotAProcSymbol: + result = "node is not a proc symbol" + + of rsemVmDerefUnsupportedPtr: + result = "deref unsupported ptr type: $1 $2" % [r.typ.render, $r.typ.kind] + + of rsemVmNilAccess: + result = "attempt to access a nil address" + + of rsemVmOverOrUnderflow: + result = "over- or underflow" + + of rsemVmDivisionByConstZero: + result = "division by zero" + + of rsemVmTooManyIterations: + result = "interpretation requires too many iterations; " & + "if you are sure this is not a bug in your code, compile " & + "with `--maxLoopIterationsVM:number` (current value: $1)" % + $conf.maxLoopIterationsVM + + of rsemVmCannotModifyTypechecked: + result = "typechecked nodes may not be modified" + + of rsemVmNoType: + result = "node has no type" + + of rsemVmIllegalConv: + result = r.str + + of rsemVmFieldNotFound: + result = "node lacks field: " & r.str + + of rsemVmNodeNotAFieldSymbol: + result = "symbol is not a field (nskField)" + + of rsemVmCannotSetChild: + result = "cannot set child of node kind: n" & $r.ast.kind + + of rsemVmCannotAddChild: + result = "cannot add to node kind: n" & $r.ast.kind + + of rsemVmCannotGetChild: + result = "cannot get child of node kind: n" & $r.ast.kind + + of rsemVmMissingCacheKey: + result = "key does not exist: " & r.str + + of rsemVmCacheKeyAlreadyExists: + result = "key already exists: " & r.str + + of rsemVmFieldInavailable: + result = r.str + + of rsemBorrowOutlivesSource: + result.add( + "'", + r.symbols[0].name.s, + "' borrows from location '", + r.symbols[1].name.s, + "' which does not live long enough" + ) + + of rsemImmutableBorrowMutation: + result.add( + "'", + r.symbols[0].name.s, + "' borrows from the immutable location '", + r.symbols[1].name.s, + "' and attempts to mutate it" + ) + + of rsemPragmaRecursiveDependency: + result.add "recursive dependency: " + result.add r.sym.name.s + + of rsemMisplacedDeprecation: + result = "annotation to deprecated not supported here" + + of rsemNoUnionForJs: + result = "`{.union.}` is not implemented for js backend." + + of rsemBitsizeRequiresPositive: + result = "bitsize needs to be positive" + + of rsemExperimentalRequiresToplevel: + result = "'experimental' pragma only valid as toplevel " & + "statement or in a 'push' environment" + + of rsemDeprecated: + if r.symbols.len == 2: + # symbols and it's alternative + result.add( + "use ", + r.symbols[1].name.s, + " instead; ", + r.symbols[0].name.s, + " is deprecated" + ) + + else: + result = r.str + if not r.sym.isNil: + let s = r.sym + if 0 < r.str.len: + result.add("; ") + + # Depreaction was added for a whole enum, not a specific field + if s.kind == skEnumField and sfDeprecated notin s.flags: + result.addf( + "enum '$1' which contains field '$2' is deprecated", + s.owner.name.s, + s.name.s, + ) + + elif s.kind == skModule and not s.constraint.isNil(): + result.addf("$1; $2 is deprecated", s.constraint.strVal, s.name.s) + + else: + result.add(s.name.s, " is deprecated") + + + + of rsemThisPragmaRequires01Args: + # FIXME remove this report kind, reuse "wrong number of arguments" + result = "'this' pragma is allowed to have zero or one arguments" + + of rsemTooManyRegistersRequired: + result = "VM problem: too many registers required" + + of rsemVmCannotFindBreakTarget: + result = "VM problem: cannot find 'break' target" + + of rsemVmNotUnused: + echo r.ast.render + result = "not unused" + + of rsemVmTooLargetOffset: + result = "too large offset! cannot generate code for: " & + r.sym.name.s + + of rsemVmCannotGenerateCode: + result = "cannot generate code for: " & + $r.ast + + of rsemVmCannotCast: + result = "VM does not support 'cast' from " & + $r.actualType.kind & " to " & $r.formalType.kind + + of rsemVmInvalidBindSym: + result = "invalid bindSym usage" + + of rsemSymbolKindMismatch: + var ask: string + if len(r.expectedSymbolKind) == 1: + for n in r.expectedSymbolKind: + ask = n.toHumanStr + + else: + ask = $r.expectedSymbolKind + + result = "cannot use symbol of kind '$1' as a '$2'" % + [$r.sym.kind.toHumanStr, ask] + + of rsemTypeNotAllowed: + let (t, typ, kind) = ( + r.allowedType.allowed, r.allowedType.actual, r.allowedType.kind) + + if t == typ: + result = "invalid type: '$1' for $2" % [ + typeToString(typ), toHumanStr(kind)] + + if kind in {skVar, skLet, skConst} and + taIsTemplateOrMacro in r.allowedType.allowedFlags: + + result &= ". Did you mean to call the $1 with '()'?" % [ + toHumanStr(typ.owner.kind)] + + else: + result = "invalid type: '$1' in this context: '$2' for $3" % [ + typeToString(t), typeToString(typ), toHumanStr(kind)] + + of rsemCyclicTree: + result = "the resulting AST is cyclic and cannot be processed further" + + of rsemConstExprExpected: + result = "constant expression expected" + + of rsemTemplateInstantiationTooNested: + result = "template instantiation too nested" + + of rsemExpressionHasNoType: + result = "expression has no type: " & render(r.ast) + + of rsemMissingGenericParamsForTemplate: + result = "'$1' has unspecified generic parameters" % r.sym.name.s + + of rsemExpandMacro: + result = "expanded macro:\n" & r.expandedAst.render() + + of rsemUnusedImport: + result = "imported and not used: '$1'" % r.sym.name.s + + of rsemCallNotAProcOrField: + for sym in r.unexpectedCandidate: + result.addf("\n found $1", getSymRepr(conf, sym)) + + if r.explicitCall: + if result.len == 0: + result = "attempting to call undeclared routine: '$1'" % $r.str + else: + result = "attempting to call routine: '$1'$2" % [$r.str, $result] + + else: + let sym = r.typ.typSym + var typeHint = "" + if sym == nil: + # Perhaps we're in a `compiles(foo.bar)` expression, or + # in a concept, e.g.: + # ExplainedConcept {.explain.} = concept x + # x.foo is int + discard + else: + + typeHint = " for type " & getProcHeader(conf, sym) + + let suffix = if result.len > 0: " " & result else: "" + + result = "undeclared field: '$1'" % r.str & typeHint & suffix + + + + + of rsemUndeclaredField: + result = "undeclared field: '$1' for type $2" % [ + $r.ast.ident.s, $getProcHeader(conf, r.sym)] + + of rsemCannotCodegenCompiletimeProc: + result = "request to generate code for .compileTime proc: " & r.symstr + + of rsemFieldAssignmentInvalid: + result = "Invalid field assignment '$1'" % r.ast.render + + of rsemAmbiguous: + var args = "(" + for i in 1 ..< r.ast.len: + if i > 1: + args.add(", ") + args.add(typeToString(r.ast[i].typ)) + args.add(")") + + + result = "ambiguous call; both $1 and $2 match for: $3" % [ + getProcHeader(conf, r.symbols[0]), + getProcHeader(conf, r.symbols[1]), + args + ] + + of rsemCopiesToSink: + result = ( + "passing '$1' to a sink parameter introduces an implicit copy; " & + "if possible, rearrange your program's control flow to prevent it") % [ + r.ast.render] + + + of rsemAmbiguousIdent: + result = "ambiguous identifier: '" & r.symstr & "' -- use one of the following:\n" + var i = 0 + for sym in r.symbols: + result.add( + tern(0 < i, "\n", ""), + " ", + sym.owner.name.s, + ".", + sym.name.s, + ": ", + sym.typ.render() + ) + + inc i + + + of rsemStaticOutOfBounds, rsemVmIndexError: + let (i, a, b) = r.indexSpec + if b < a: + result = "index out of bounds, the container is empty" + else: + result = "index " & $i & " not in " & $a & " .. " & $b + + of rsemStaticFieldNotFound: + result = "field not found: " & r.sym.name.s + + of rsemInvalidIntdefine: + result = "{.intdefine.} const was set to an invalid integer: '" & r.str & "'" + + of rsemInvalidBooldefine: + result = "{.booldefine.} const was set to an invalid bool: '" & r.str & "'" + + of rsemSemfoldInvalidConversion: + result = "conversion from $1 to $2 is invalid" % [ + typeToString(r.actualType()), typeToString(r.formalType())] + + of rsemIllformedAst: + result = "illformed AST: " & render(r.ast) + + of rsemTypeExpected: + if r.sym.typ.isNil: + result = "type expected, but symbol '$1' has no type." % r.symstr + + else: + result = "type expected, but got symbol '$1' of kind '$2'" % + [r.sym.name.s, r.sym.kind.toHumanStr] + + of rsemCyclicDependency: + result = "recursive dependency: '$1'" % r.symstr + + of rsemCannotInstantiate: + if r.typ.isNil: + if r.sym.isNil: + result = "cannot instantiate: '$1'" % r.ast.render + + else: + result = "cannot instantiate: '$1'" % r.symstr + + elif r.ownerSym.isNil: + result.addf( + "cannot instantiate: '$1'; Maybe generic arguments are missing?", + typeToString(r.typ, preferDesc) + ) + + else: + result.addf( + "cannot instantiate '$1' inside of type definition: '$2'; " & + "Maybe generic arguments are missing?", + typeToString(r.typ, preferDesc), + r.ownerSym.name.s + ) + + of rsemTypeKindMismatch: + result = r.str + + of rsemExprHasNoAddress: + result = "expression has no address" + if r.isUnsafeAddr: + result.add "; maybe use 'unsafeAddr'" + + of rsemVmCannotEvaluateAtComptime: + result = "cannot evaluate at compile time: " & r.ast.render + + of rsemIntLiteralExpected: + result = "integer literal expected" + + of rsemGenericTypeExpected: + result = "expected generic type, got: type $2 of kind $1" % [ + r.actualType.kind.toHumanStr, + typeToString(r.actualType)] + + of rsemUnknownTrait: + result = "unknown trait: " & r.sym.name.s + + of rsemExpectedOrdinal: + if not r.ast.isNil and r.ast.kind == nkBracket: + result.add "expected ordinal value for array index, got '$1'" % r.wrongNode.render + + else: + result = "ordinal type expected" + + of rsemStringLiteralExpected: + result = "string literal expected" + + of rsemConditionAlwaysTrue: + result = "condition is always true: '$1'" % render(r.ast) + + of rsemConditionAlwaysFalse: + result = "condition is always false: '$1'" % render(r.ast) + + of rsemWrongNumberOfArguments: + result = "wrong number of arguments" + + of rsemCannotBeOfSubtype: + result = "'$1' cannot be of this subtype" % typeToString(r.actualType()) + + of rsemQuantifierInRangeExpected: + result = " 'in' expected" + + of rsemOldTakesParameterName: + result = "'old' takes a parameter name" + + of rsemOldDoesNotBelongTo: + result = r.ast.sym.name.s & " does not belong to " & r.symstr + + of rsemCannotFindPlugin: + result = "cannot find plugin " & r.symstr + + of rsemExpectedProcReferenceForFinalizer: + result = "finalizer must be a direct reference to a proc" + + of rsemUnsafeSetLen: + result = "setLen can potentially expand the sequence, " & + "but the element type '$1' doesn't have a valid default value" % + typeToString(r.typ) + + of rsemUnsafeDefault: + result = "The '$1' type doesn't have a valid default value" % + typeToString(r.typ) + + of rsemCannotIsolate: + result = "expression cannot be isolated: " & render(r.ast) + + of rsemInnerCodeReordering: + result = "Code reordering experimental pragma only valid at toplevel" + + of rsemUnknownExperimental: + result = "unknown experimental feature" + + of rsemWrongIdent: + result = joinAnyOf(r.expectedIdents, quote = true) & " expected" + + of rsemPragmaOptionExpected: + result = "option expected" + + of rsemUnexpectedPushArgument: + result = "'push' cannot have arguments" + + of rsemExcessiveCompilePragmaArgs: + result = "'.compile' pragma takes up 2 arguments" + + of rsemEmptyAsm: + result = "empty 'asm' statement" + + of rsemLinePragmaExpectsTuple: + result = "tuple expected" + + of rsemRaisesPragmaExpectsObject: + result = "invalid type for raises/tags list" + + of rsemLocksPragmaExpectsList: + result = "locks pragma takes a list of expressions" + + of rsemLocksPragmaBadLevel: + result = r.str + + of rsemBorrowPragmaNonDot: + result = "a type can only borrow `.` for now" + + of rsemInvalidExtern: + result = "invalid extern name: '" & r.externName & "'. (Forgot to escape '$'?)" + + of rsemBadDeprecatedArgs: + result = r.str + + of rsemInvalidPragma: + result = "invalid pragma: " & r.ast.render + + of rsemMisplacedEffectsOf: + result = "parameter cannot be declared as .effectsOf" + + of rsemMissingPragmaArg: + result = "parameter name expected" + + of rsemCannotPushCast: + result = "a 'cast' pragma cannot be pushed" + + of rsemCastRequiresStatement: + result = "'cast' pragma only allowed in statement context" + + of rsemImplicitObjConv: + result = "Implicit conversion: Receiver '$1' will not receive fields of sub-type '$2'" % [ + typeToString(r.formalType), + typeToString(r.actualType) + ] + + of rsemExtendedContext: + assert false, "This is a configuration hint" + + of rsemUserRaw: + assert false, "Appears to be unused" + + of rsemNonMatchingCandidates: + let (_, candidates) = presentFailedCandidates(conf, r.ast, r.callMismatches) + result = "Non-matching candidates for " & render(r.ast) & "\n" & + candidates + + of rsemEffectsListingHint: + for tag in r.effectListing.exceptions: + result.add typeToString(tag) + result.add "\n" + + for tag in r.effectListing.tags: + result.add typeToString(tag) + result.add "\n" + + of rsemLockLevelMismatch: + result = "expected lock level < " & $r.lockMismatch.expected & + " but got lock level " & $r.lockMismatch.got + + of rsemCantPassProcvar: + result = "'$1' cannot be passed to a procvar" % r.symstr + + of rsemCannotProveNotNil: + result = "cannot prove '$1' is not nil" % render(r.ast) + + of rsemProvablyNil: + result = "'$1' is provably nil" % render(r.ast) + + of rsemInvalidBindContext: + result = "invalid context for 'bind' statement: " & render(r.ast) + + of rsemExpectedTypelessDeferBody: + result = "'defer' takes a 'void' expression" + + of rsemUnexpectedToplevelDefer: + result = "defer statement not supported at top level" + + of rsemExportRequiresToplevel: + result = "export is only allowed at top level" + + of rsemImportRequiresToplevel: + result = "import is only allowed at top level" + + of rsemBindDeprecated: + result = "bind is deprecated" + + of rsemCannotMixTypesAndValuesInTuple: + result = "Mixing types and values in tuples is not allowed." + + of rsemCannotExport: + result = "cannot export: " & render(r.ast) + if r.sym.kind == skEnumField: + result.add "; enum field cannot be exported individually" + + of rsemExpectedModuleNameForImportExcept: + result = "The export/except syntax expects a module name" + + of rsemDisallowedTypedescForTupleField: + result = "typedesc not allowed as tuple field." + + of rsemFieldInitTwice: + result = "field initialized twice: '$1'" % r.str + + of rsemNamedExprNotAllowed: + result = "named expression not allowed here" + + of rsemNamedExprExpected: + result = "named expression expected" + + of rsemExpectedExpressionForSpawn: + result = "'spawn' takes a call expression; got: " & render(r.ast) + + of rsemEnableExperimentalParallel: + result = "use the {.experimental.} pragma to enable 'parallel'" + + of rsemExpectedTypeOrValue: + result = "'$1' expects a type or value" % r.str + + of rsemSystemNeeds: + result = "system needs: '$1'" % r.str + + of rsemCovariantUsedAsNonCovariant: + result = "covariant param '" & r.symstr & "' used in a non-covariant position" + + of rsemContravariantUsedAsNonCovariant: + result = "contravariant param '" & r.symstr & "' used in a non-contravariant position" + + of rsemExpectedInvariantParam: + result = "non-invariant type param used in a proc type: " & $r.typ + + of rsemNonInvariantCannotBeUsedWith: + result = "non-invariant type parameters cannot be used with types such '" & $r.typ & "'" + + of rsemNonInvariantCnnnotBeUsedInConcepts: + result = "non-invariant type parameters are not supported in concepts" + + of rsemImplementationExpected: + result = "implementation of '$1' expected" % r.symstr + + of rsemUnexpectedExportcInAlias: + result = "{.exportc.} not allowed for type aliases" + + of rsemCannotCreateFlowVarOfType: + result = "cannot create a flowVar of type: " & typeToString(r.typ) + + of rsemCannotSpawnMagicProc: + result = "'spawn'ed function cannot have a 'typed' or 'untyped' parameter" + + of rsemCannotSpawnProcWithVar: + result = "'spawn'ed function cannot have a 'var' parameter" + + of rsemCannotDiscardSpawn: + result = "'spawn' must not be discarded" + + of rsemSpawnRequiresCall: + result = "'spawn' takes a call expression; got: " & render(r.ast) + + of rsemSpawnRequiresGcSafe: + result = "'spawn' takes a GC safe call expression" + + of rsemSpawnForbidsClosure: + result = "closure in spawn environment is not allowed" + + of rsemSpawnForbidsIterator: + result = "iterator in spawn environment is not allowed" + + of rsemUnexpectedClosureOnToplevelProc: + result = "'.closure' calling convention for top level routines is invalid" + + of rsemExpectedReturnTypeForIterator: + result = "iterator needs a return type" + + of rsemUsageIsError: + result = "$1usage of '$2' is an {.error.} defined at $3" % + [r.str, r.symstr, toFileLineCol(conf, r.sym.ast.info)] + + of rsemCustomError, rsemCustomPrintMsgAndNodeError: + assert false, $r.kind & " appears to be unused" + + of rsemTypeMismatch: + let (actual, formal) = (r.actualType, r.formalType) + let actualStr = typeToString(actual) + let formalStr = typeToString(formal) + let desc = typeToString(formal, preferDesc) + + let x = if formalStr == desc: formalStr else: formalStr & " = " & desc + + let verbose = actualStr == formalStr or optDeclaredLocs in conf.globalOptions + result = "type mismatch:" + if verbose: + result.add "\n" + + if conf.isDefined("nimLegacyTypeMismatch"): + result.add " got <$1>" % actualStr + + else: + result.add " got '$1' for '$2'" % [actualStr, r.ast.renderTree] + + if verbose: + result.addDeclaredLoc(conf, actual) + result.add "\n" + + result.add " but expected '$1'" % x + + if verbose: + result.addDeclaredLoc(conf, formal) + + if formal.kind == tyProc and actual.kind == tyProc: + result.addPragmaAndCallConvMismatch(formal, actual, conf) + case compatibleEffects(formal, actual): + of efCompat: + discard + + of efRaisesDiffer: + result.add "\n.raise effects differ" + + of efRaisesUnknown: + result.add "\n.raise effect is 'can raise any'" + + of efTagsDiffer: + result.add "\n.tag effects differ" + + of efTagsUnknown: + result.add "\n.tag effect is 'any tag allowed'" + + of efLockLevelsDiffer: + result.add "\nlock levels differ" + + of efEffectsDelayed: + result.add "\n.effectsOf annotations differ" + + of rsemConverterRequiresToplevel: + result = "converter is only allowed at top level" + + of rsemUsingRequiresToplevel: + result = "using is only allowed at top level" + + of rsemInvalidVisibility: + result = "invalid visibility: '$1'" % r.ast.render + + of rsemUnknownPackageName: + result = "unknown package name: " % r.str + + of rsemTypeCannotBeForwarded: + result = r.symstr & " is not a type that can be forwarded" + + of rsemPackageRequiresToplevel: + result = "only top level types in a package can be 'package'" + + of rsemDoubleCompletionOf: + result = "cannot complete type '" & + r.symbols[1].name.s & + "' twice; " & + "previous type completion was here: " & + (conf $ r.symbols[0].info) + + of rsemInheritanceOnlyWorksWithAnEnum: + result = "inheritance only works with an enum" + + of rsemWrongNumberOfVariables: + result = "wrong number of variables" + + of rsemInvalidOrderInEnum: + result = "invalid order in enum '$1'" % $r.symstr + + of rsemSetTooBig: + result = "set is too large" + + of rsemTIsNotAConcreteType: + result = "'$1' is not a concrete type" % r.typ.render() + + of rsemVarVarNotAllowed: + result = "type 'var var' is not allowed" + + of rsemRangeIsEmpty: + result = "range is empty" + + of rsemExpectedOrdinalOrFloat: + result = "ordinal or float type expected" + + of rsemExpectedUnholyEnum: + result = "enum '$1' has holes" % r.typ.render() + + of rsemRangeDoesNotSupportNan: + result = "NaN is not a valid start or end for a range" + + of rsemRangeRequiresDotDot: + result = "range types need to be constructed with '..', '..<' is not supported" + + of rsemExpectedRange: + result = "expected range" + + of rsemArrayExpectsPositiveRange: + result = "Array length can't be negative, but was " & $r.countMismatch.got + + of rsemDistinctDoesNotHaveDefaultValue: + result = "The $1 distinct type doesn't have a default value." % r.typ.render + + of rsemObjectRequiresFieldInit: + result = "The $1 type requires the following fields to be initialized: $2." % [ + r.typ.render, r.symbols.csvList()] + + of rsemObjectRequiresFieldInitNoDefault: + result = ("The $1 type doesn't have a default value. The following fields must " & + "be initialized: $2.") % [r.typ.render, r.symbols.csvList()] + + of rsemExpectedObjectType: + result = "object constructor needs an object type" + + of rsemAmbiguousCall: + result = "overloaded '$1' leads to ambiguous calls" % r.symstr + + of rsemDeclarationVisibilityMismatch: + result = ( + "public implementation '$1' has non-public forward declaration at $2" + ) % [getProcHeader(conf, r.sym, getDeclarationPath = false), conf $ r.sym.info] + + of rsemVmInvalidObjectConstructor: + result = "invalid object constructor" + + of rsemImplementationNotAllowed: + result = "implementation of '$1' is not allowed" % r.symstr + + of rsemGenericLambdaNowAllowed: + result = "A nested proc can have generic parameters only when " & + "it is used as an operand to another routine and the types " & + "of the generic paramers can be inferred from the expected signature." + + of rsemUnexpectedAutoInForwardDeclaration: + result = "return type 'auto' cannot be used in forward declarations" + + of rsemInvalidControlFlow: + result = "invalid control flow: $1" % [ + if r.sym.isNil: r.ast.render else: r.symstr + ] + + of rsemContinueCannotHaveLabel: + result = "'continue' cannot have a label" + + of rsemUseOrDiscard: + result = "value of type '$1' has to be used (or discarded)" % r.typ.render + + of rsemDiscardingProc: + result = "illegal discard" + + of rsemUseOrDiscardExpr: + var n = r.ast + while n.kind in skipForDiscardable: + n = n.lastSon + + result.add( + "expression '", + n.render, + "' is of type '", + n.typ.skipTypes({tyVar}).render, + "' and has to be used (or discarded)" + ) + + if r.ast.info.line != n.info.line or + r.ast.info.fileIndex != n.info.fileIndex: + + result.add "; start of expression here: " & conf$r.ast.info + + if r.ast.typ.kind == tyProc: + result.add "; for a function call use ()" + + of rsemHasSideEffects: + if r.sideEffectTrace[0].trace == ssefParameterMutation: + let part = r.sideEffectTrace[0] + result.addf( + "'$1' can have side effects.\nan object reachable " & + "from '$2' is potentially mutated", + part.isUnsafe.name.s, + part.unsafeVia.name.s + ) + + if part.location != unknownLineInfo: + result.addf("\n$1 the mutation is here", conf.toStr(part.location)) + + if r.sideEffectMutateConnection != unknownLineInfo: + result.addf( + "\n$1 is the statement that connected the mutation to the parameter", + conf.toStr(r.sideEffectMutateConnection)) + + else: + result = "'$1' can have side effects\n" % r.symstr + template addHint( + msg: string, lineInfo: TLineInfo, sym: string, level: int) = + result.addf( + "$# $# $#'$#' $#\n", + repeat(">", level), + conf.toStr(lineInfo), + conf.wrap(reportTitles[rsevHint], reportColors[rsevHint]), + sym, + msg + ) + + for part in r.sideEffectTrace: + let s = part.isUnsafe + let u = part.unsafeVia + let useLineInfo = part.location + + case part.trace: + of ssefUsesGlobalState: + addHint( + "accesses global state '$#'" % u.name.s, + useLineInfo, s.name.s, part.level) + + addHint( + "accessed by '$#'" % s.name.s, u.info, + u.name.s, part.level + 1) + + of ssefCallsSideEffect: + addHint( + "calls `.sideEffect` '$#'" % u.name.s, + useLineInfo, s.name.s, part.level) + + addHint( + "called by '$#'" % s.name.s, + u.info, u.name.s, part.level + 1) + + of ssefCallsViaHiddenIndirection: + addHint( + "calls routine via hidden pointer indirection", + useLineInfo, s.name.s, part.level) + + of ssefCallsViaIndirection: + addHint( + "calls routine via pointer indirection", + useLineInfo, s.name.s, part.level) + + of ssefParameterMutation: + assert false, "Must be handled as a standalone effect" + + if result[^1] == '\n': + result.setLen(result.high) + + of rsemCannotBeRaised: + result = "only a 'ref object' can be raised" + + of rsemXCannotRaiseY: + result = "'$1' cannot raise '$2'" % [r.ast.render, r.raisesList.render] + + of rsemUnlistedRaises, rsemWarnUnlistedRaises: + result.add("$1 can raise an unlisted exception: " % r.ast.render, + r.typ.render) + + of rsemUnlistedEffects: + result.add(r.ast.render, "can have an unlisted effect: ", r.typ.render) + + of rsemWarnGcUnsafe: + result = "not GC-safe: '$1'" % r.ast.render + + of rsemExceptionAlreadyHandled: + result = "exception already handled" + + of rsemCannotExceptNativeAndImported: + result = "Mix of imported and native exception types is not allowed in one except branch" + + of rsemExpectedSingleFinally: + result = "Only one finally is allowed after all other branches" + + of rsemExpectedSingleGeneralExcept: + result = "Only one general except clause is allowed after more specific exceptions" + + of rsemCannotConvertToRange: + result = "cannot convert '$1' to '$2'" % [$r.ast.floatVal, typeToString(r.typ)] + + of rsemProveInit: + result = "Cannot prove that '$1' is initialized. This will become a compile time error in the future." % + (if r.sym != nil: r.symstr else: r.ast.render()) + # presently this can be either a sym or an ast node + + of rsemUsingRequiresType: + result = "'using' section must have a type" + + of rsemUsingDisallowsAssign: + result = "'using' sections cannot contain assignments" + + of rsemImplicitFieldConstructinoRequiresPartial: + result = "implicit object field construction " & + "requires a .partial object, but got " & r.typ.render + + of rsemDifferentTypeForReintroducedSymbol: + result = "inconsistent typing for reintroduced symbol '" & + r.symstr & "': previous type was: " & r.formalType.render() & + "; new type is: " & r.actualType.render() + + of rsemMisplacedRunnableExample: + result = "runnableExamples must appear before the first non-comment statement" + + of rsemCannotInferTypeOfLiteral: + result = "cannot infer the type of the $1" % r.typ.kind.toHumanStr + + of rsemProcHasNoConcreteType: + result = "'$1' doesn't have a concrete type, due to unspecified generic parameters." % + r.ast.render + + of rsemEachIdentIsTuple: + result = "each identifier is a tuple" + + of rsemResultShadowed: + result = "Special variable 'result' is shadowed." + + of rsemThreadvarCannotInit: + result = "a thread var cannot be initialized explicitly; this would only run for the main thread" + + of rsemLetNeedsInit: + result = "'let' symbol requires an initialization" + + of rsemGlobalVar: + result = "global variable declared here" + + of rsemForExpectsIterator: + result = "iterator within for loop context expected" + + of rsemSelectorMustBeOfCertainTypes: + result = "selector must be of an ordinal type, float, or string" + + of rsemUnreachableElse: + result = "unreachable else, all cases are already covered" + + of rsemMissingCaseBranches: + result = "not all cases are covered" + if 0 < r.nodes.len: + result.add "; missing: {$1}" % r.nodes.csvListIt(it.render) + + of rsemCannotRaiseNonException: + result = "raised object of type $1 does not inherit from Exception" & r.typ.render + + of rsemUnexpectedEqInObjectConstructor: + result = "object construction uses ':', not '='" + + of rsemConvFromXtoItselfNotNeeded: + result = "conversion from $1 to itself is pointless" % r.typ.render + + of rsemIllegalConversion: + result = "illegal conversion from '$1' to '$2'" % [ + r.actualType.render, r.formalType.render + ] + + of rsemCannotBeConvertedTo: + let value = if r.ast.kind in {nkCharLit..nkUInt64Lit}: $r.ast.getInt else: $r.ast.getFloat + result = value & " can't be converted to " & r.typ.render + + of rsemCannotCastToNonConcrete: + result = "cannot cast to a non concrete type: '$1'" % r.typ.render + + of rsemCannotCastTypes: + let tar = $r.formalType + let alt = typeToString(r.formalType, preferDesc) + let msg = if tar != alt: tar & "=" & alt else: tar + result = "expression cannot be cast to " & msg + + of rsemInvalidArgumentFor: + result = "invalid argument for: " & r.str + + of rsemNoTupleTypeForConstructor: + result = "no tuple type for constructor" + + of rsemInvalidTupleConstructor: + result = "invalid tuple constructor" + + of rsemUnknownIdentifier: + result = "unknown identifier: " & r.symstr + + of rsemIndexOutOfBounds: + result = "size of array exceeds range of index type '$1' by $2 elements" % [ + typeToString(r.typ), $(r.countMismatch.got - r.countMismatch.expected)] + + of rsemVarForOutParamNeeded: + result = "for a 'var' type a variable needs to be passed; but '$1' is immutable" % + r.ast.render + + of rsemStackEscape: + result = "address of '$1' may not escape its stack frame" % r.ast.render + + of rsemCannotInterpretNode: + result = "cannot evaluate '$1'" % r.ast.render + + of rsemRecursiveDependencyIterator: + result = "recursion is not supported in iterators: '$1'" % r.symstr + + of rsemDisallowedNilDeref: + result = "nil dereference is not allowed" + + of rsemInvalidTupleSubscript: + result = "invalid index value for tuple subscript" + + of rsemLocalEscapesStackFrame: + result = "'$1' escapes its stack frame; context: '$2'" % [r.symstr, r.ast.render] + + of rsemImplicitAddrIsNotFirstParam: + result = "'$1' is not the first parameter; context: '$2'" % [r.symstr, r.ast.render] + + of rsemExpectedOwnerReturn: + result = "cannot return an owned pointer as an unowned pointer; " & + "use 'owned(" & r.typ.render & ")' as the return type" + + of rsemExpectedUnownedRef: + result = "assignment produces a dangling ref: the unowned ref lives longer than the owned ref" + + of rsemCannotAssignTo: + result = "'$1' cannot be assigned to" % r.ast.render + + of rsemNoReturnTypeDeclared: + result = "no return type declared" + + of rsemReturnNotAllowed: + result = "'return' not allowed here" + + of rsemCannotInferReturnType: + result = "cannot infer the return type of '$1'" % r.symstr + + of rsemUnexpectedYield: + result = "'yield' only allowed in an iterator" + + of rsemCannotReturnTypeless: + result = "current routine cannot return an expression" + + of rsemExpectedValueForYield: + result = "yield statement must yield a value" + + of rsemExpectedIdentifier: + result = "identifier expected, but got: " & r.ast.render + + of rsemExpectedMacroOrTemplate: + result = "'$1' is not a macro or template" % ( + if r.sym.isNil: r.ast.render else: r.symstr) + + of rsemExpectedTemplateWithNArgs: + result = "expected a template that takes " & $(r.countMismatch.expected) & " arguments" + + of rsemAmbiguousGetAst: + result = "ambiguous symbol in 'getAst' context: " & r.ast.render + + of rsemExpectedCallForGetAst: + result = "getAst takes a call, but got " & r.ast.render + + of rsemSuspiciousEnumConv: + result = "suspicious code: enum to enum conversion" + + of rsemStringOrIdentNodeExpected: + result = "string or ident node expected" + + of rsemExpectedObjectForOf: + result = "'of' takes object types" + + of rsemSemfoldDivByZero: + result = "over- or underflow" + + of rsemRuntimeDiscriminantRequiresElif: + result = "branch initialization with a runtime discriminator " & + "is not supported inside of an `elif` branch." + + of rsemRuntimeDiscriminantMustBeImmutable: + result = "runtime discriminator must be immutable if branch fields are " & + "initialized, a 'let' binding is required." + + of rsemObjectConstructorIncorrect: + result = "Invalid object constructor: '$1'" % r.ast.render + + of rsemVmBadExpandToAst: + result = "expandToAst requires 1 argument" + + of rsemMissingImportcCompleteStruct: + result = "'$1' requires '.importc' types to be '.completeStruct'" % r.str + + of rsemVmEnableFFIToImportc: + result = "VM is not allowed to 'importc' without --experimental:compiletimeFFI" + + of rsemVmCannotImportc: + result = "cannot 'importc' variable at compile time; " & r.symstr + + of rsemVmCannotCreateNullElement: + result = "cannot create null element for: " & r.typ.render + + of rsemVmNoClosureIterators: + result = "Closure iterators are not supported by VM!" + + of rsemVmCannotCallMethod: + result = "cannot call method " & r.symstr & " at compile time" + + of rsemBorrowTargetNotFound: + result = "no symbol to borrow from found" + + of rsemIncorrectResultProcSymbol: + result = "incorrect result proc symbol" + + of rsemCannotInferTypeOfParameter: + result = "cannot infer type of parameter: " & r.symstr + + of rsemRebidingImplicitDestructor: + result = "cannot bind another '" & r.symstr & "' to: " & r.typ.render + result.add "; previous declaration was constructed here implicitly: " & (conf $ r.sym.info) + + of rsemRebidingDestructor: + result = "cannot bind another '" & r.symstr & "' to: " & r.typ.render + result.add "; previous declaration was here: " & (conf $ r.sym.info) + + of rsemInseparableTypeBoundOp: + result = "type bound operation `" & r.symstr & + "` can be defined only in the same module with its type (" & r.typ.render & ")" + + of rsemUnexpectedTypeBoundOpSignature: + result = "signature for '" & r.symstr & "' must be proc[T: object](x: var T)" + + of rsemRebidingDeepCopy: + result = "cannot bind another 'deepCopy' to: " & r.typ.render + + of rsemExpectedDestroyOrDeepCopyForOverride: + result = "'destroy' or 'deepCopy' expected for 'override'" + + of rsemGenericMethodsDeprecated: + result = "generic methods are deprecated" + + of rsemExpectedObjectForMethod: + result = "'method' needs a parameter that has an object type" + + of rsemUnexpectedPragmaInDefinitionOf: + let proto = r.symbols[0] + let s = r.symbols[1] + result = "pragmas are only allowed in the header of a proc; redefinition of $1" % + ("'" & proto.name.s & "' from " & conf $ proto.info & + " '" & s.name.s & "' from " & conf $ s.info) + + of rsemParallelCannotProveDisjoint: + result = r.str + + of rsemParallelInvalidControlFlow: + result = "invalid control flow for 'parallel'" + + of rsemSpawnInvalidContext: + result = "invalid context for 'spawn'" + + of rsemParallelWithoutSpawn: + result = "'parallel' section without 'spawn'" + + of rsemDisjointFields: + result = ("The fields '$1' and '$2' cannot be initialized together, " & + "because they are from conflicting branches in the case object.") % + [r.fieldMismatches.first.csvList(), r.fieldMismatches.second.csvList()] + + of rsemUnsafeRuntimeDiscriminantInit: + result = ("cannot prove that it's safe to initialize '$1' with " & + "the runtime value for the discriminator '$2' ") % + [r.fieldMismatches.first.csvList(), r.fieldMismatches.second.csvList()] + + of rsemConflictingDiscriminantInit: + result = ("a case selecting discriminator '$1' with value '$2' " & + "appears in the object construction, but the field(s) $3 " & + "are in conflict with this value.") % + [r.fieldMismatches.first.csvList(), r.ast.render, r.fieldMismatches.second.csvList()] + + of rsemConflictingDiscriminantValues: + result = ("possible values " & + "{$1} are in conflict with discriminator values for " & + "selected object branch $2") % [ + r.nodes.csvListIt(render(it)), r.str] + + of rsemRuntimeDiscriminantInitCap: + result = "branch initialization with a runtime discriminator only " & + "supports ordinal types with 2^16 elements or less." + + of rsemBitsizeRequires1248: + result = "size may only be 1, 2, 4 or 8" + + of rsemAlignRequiresPowerOfTwo: + result = "power of two expected" + + of rsemNoReturnHasReturn: + result = "???" + + of rsemUserHint: + result = r.str + + of rsemUserWarning: + result = r.str + + of rsemUserError: + result = r.str + + of rsemCustomUserError: + result = r.str + + of rsemImplicitPragmaError: + result = "???" + + of rsemInvalidModulePath: + result = "invalid path: " & r.str + + of rsemDotForModuleImport: + result = "using '.' instead of '/' in import paths is deprecated" + + of rsemInvalidModuleName: + result = "invalid module name: '$1'" % r.ast.render + + of rsemInvalidMethodDeclarationOrder: + result = "invalid declaration order; cannot attach '" & r.symbols[0].name.s & + "' to method defined here: " & conf$r.symbols[1].info + + of rsemRecursiveInclude: + result = "recursive dependency: '$1'" % r.str + + of rsemUnexpectedInfixInInclude: + result = "Cannot use '" & r.str & "' in 'include'." + + of rsemInvalidPragmaBlock: + result = "invalid pragma block: " & $r.ast.render + + of rsemConceptInferenceFailed: + result = "cannot infer the concept parameter '%s', due to a type mismatch. " & + "attempt to equate '%s' and '%s'." % [ + r.ast.render, r.actualType.render, r.formalType.render] + + of rsemConceptPredicateFailed: + result = "concept predicate failed" + + of rsemUnreachableCode: + result = "unreachable code after 'return' statement or '{.noReturn.}' proc" + + of rsemNoMagicEqualsForType: + result = "can't find magic equals operator for type kind " & $r.typ.kind + + of rsemConflictingExportnims: + result = "symbol conflicts with other .exportNims symbol at: " & + conf $ r.symbols[1].info + + of rsemCantConvertLiteralToType: + result = "Cannot convert int literal to $1. The value is invalid." % + r.typ.render + + of rsemNodeNotAllowed: + result = "'$1' not allowed here" % r.ast.render + + of rsemCustomGlobalError: + result = r.str + + of rsemCannotImportItself: + result = "module '$1' cannot import itself" % r.symstr + + of rsemRecursiveImport: + result = "recursive dependency: '$1'" % r.str + + of rsemCannotOpenFile: + result = "cannot open '$1'" % r.str + + of rsemMethodRequiresToplevel: + result = "'method' is only allowed at top level" + + of rsemExpectedReturnTypeForConverter: + result = "converter needs a return type" + + of rsemExpectedOneArgumentForConverter: + result = "a converter takes exactly one argument" + + of rsemIncompatibleDefaultExpr: + result = ( + "The default parameter '$1' has incompatible type " & + "with the explicitly requested proc instantiation" + ) % r.symstr + + of rsemSemfoldOverflow: + result = "over- or underflow" + + of rsemCaseInUnion: + result = "Illegal use of ``case`` in union type." + + of rsemOffsetInUnion: + result = "union type may not have an object header" + + of rsemUnexpectedInNewConcept: + result = "unexpected construct in the new-styled concept: " & r.ast.render + + of rsemTooNestedConcept: + result = r.ast.render & " too nested for type matching" + + of rsemIllegalRecursion: + result = "illegal recursion in type '$1'" % r.typ.render + + of rsemCannotInferStaticValue: + result = "cannot infer the value of the static param '" & ( + if r.sym.isNil: r.str else: r.symstr + ) & "'" + + of rsemProcIsNotAConcreteType: + result = ("'$1' is not a concrete type; " & + "for a callback without parameters use 'proc()'") % r.typ.render + + of rsemCannotInstantiateWithParameter: + result = "cannot instantiate " + result.addTypeHeader(conf, r.typ) + result.add "\ngot: <$1>\nbut expected: <$2>" % [ + describeArgs(conf, r.arguments.got), + describeArgs(conf, r.arguments.expected) + ] + + of rsemCannotGenerateGenericDestructor: + result = "cannot generate destructor for generic type: " & r.typ.render + + of rsemExpectedLow0Discriminant: + result = "low(" & r.symstr & ") must be 0 for discriminant" + + of rsemExpectedHighCappedDiscriminant: + result = "len($1) must be less than 32768" % r.symstr + + of rsemCantConvertLiteralToRange: + result = "cannot convert " & $r.str & " to " & r.typ.render + + of rsemCantComputeOffsetof: + result = "can't compute offsetof on this ast" + + of rsemExpectObjectForBase: + result = "cannot inherit from a type that is not an object type" + + of rsemExpectNonFinalForBase: + result = "inheritance only works with non-final objects; " & + "for " & r.typ.render & " to be inheritable it must be " & + "'object of RootObj' instead of 'object'" + + of rsemTVoidNotAllowed: + result = "type '$1 void' is not allowed" % r.str + + of rsemExpectedObjectForRegion: + result = "region needs to be an object type" + + of rsemPtrRegionIsDeprecated: + result = "region for pointer types is deprecated" + + of rsemMacroBodyDependsOnGenericTypes: + result = "the macro body cannot be compiled, " & + "because the parameter '$1' has a generic type" % r.str + + of rsemUnexpectedVoidType: + result = "'repr' doesn't support 'void' type" + + of rsemUnexpectedArrayAssignForCstring: + result = "cstring doesn't support `[]=` operator" + + of rsemMalformedNotNilType: + result = "Invalid syntax. When used with a type, 'not' can be followed only by 'nil'" + + of rsemEnableNotNilExperimental: + result = "enable the 'not nil' annotation with {.experimental: \"notnil\".} or " & + " the `strict not nil` annotation with {.experimental: \"strictNotNil\".} " & + " the \"notnil\" one is going to be deprecated, so please use \"strictNotNil\"" + + of rsemEnableDotOperatorsExperimental: + result = "the overloaded " & r.symstr & + " operator has to be enabled with {.experimental: \"dotOperators\".}" + + of rsemEnableCallOperatorExperimental: + result = "the overloaded " & r.symstr & + " operator has to be enabled with {.experimental: \"callOperator\".}" + + of rsemExpectedImportedType: + result = "the '$1' modifier can be used only with imported types" % r.ast.render + + of rsemExpectedDistinctForBorrow: + result = "only a 'distinct' type can borrow `.`" + + of rsemRedefinitionOf: + if r.sym.isNil: + result.addf( + "redefinition of '$1'; previous declaration here: $2", + r.symbols[0].name.s, + conf.toStr(r.symbols[1].info) + ) + + else: + result = "attempt to redefine: '" & r.symstr & "'" + + of rsemDefaultParamIsIncompatible: + assert false, "REMOVE" + + of rsemExpressionCannotBeCalled: + result = "expression cannot be called" + + of rsemWrongNumberOfGenericParams: + result.addf( + "cannot instantiate: '$1'; got $2 typeof(s) but expected $3", + r.ast.render, + $r.countMismatch.got, + $r.countMismatch.expected + ) + + of rsemNoGenericParamsAllowed: + result = "no generic parameters allowed for $1" % r.symstr + + of rsemIllegalCustomPragma: + result = "cannot attach a custom pragma to '$1'" % r.symstr + + of rsemCallingConventionMismatch: + assert false, "REMOVE" + + of rsemParallelCounterAfterIncrement: + result = "invalid usage of counter after increment" + + of rsemUndeclaredIdentifier: + result = "undeclared identifier: '" & r.str & "'" + if 0 < r.spellingCandidates.len: + result.add "\n" + result.add presentSpellingCandidates( + conf, r.spellingCandidates) + + of rsemXDeclaredButNotUsed: + result = "'$1' is declared but not used" % r.symstr + + of rsemCompilesReport, rsemCompilesError: + assert false, "Temporary report for `compiles()` speedup, cannot be printed" + + of rsemCannotMakeSink: + result = "could not turn '$1' to a sink parameter" % r.symstr + + of rsemExprAlwaysX: + result = "expression always evaluates to constant value" + + of rsemProcessingStmt: + result = "processing stmt" + + of rsemProcessing: + let path = toFilenameOption(conf, r.processing.fileIdx, conf.filenameOption) + let indent = repeat(">", r.processing.importStackLen) + let fromModule = r.sym + let fromModule2 = if fromModule != nil: $fromModule.name.s else: "(toplevel)" + let mode = if r.processing.isNimscript: "(nims) " else: "" + result = "$#$# $#: $#: $#" % [mode, indent, fromModule2, r.processing.moduleStatus, path] + + of rsemConvToBaseNotNeeded: + result = "??" + + of rsemDuplicateModuleImport: + result = "duplicate import of '$1'; previous import here: $2" % + [r.symstr, conf.toStr(r.previous.info)] + + of rsemHintLibDependency: + result = r.str + + of rsemCaseTransition: + result = "Potential object case transition, instantiate new object instead" + + of rsemObservableStores: + result = "observable stores to '$1'" % r.ast.render + + of rsemParallelWarnNotDisjoint: + result = r.str + + of rsemParallelWarnCanProve: + result = r.str + + of rsemParallelWarnCannotProve: + result = r.str + + of rsemUncollectableRefCycle: + if r.cycleField == nil: + result = "'$#' creates an uncollectable ref cycle" % [r.ast.render] + else: + result = "'$#' creates an uncollectable ref cycle; annotate '$#' with .cursor" % [ + r.ast.render, r.cycleField.render] + + of rsemResultUsed: + result = "used 'result' variable" + + of rsemTypedReturnDeprecated: + result = "`typed` will change its meaning in future versions of Nim. " & + "`void` or no return type declaration at all has the same " & + "meaning as the current meaning of `typed` as return type " & + "declaration." + + of rsemInheritFromException: + result = "inherit from a more precise exception type like ValueError, " & + "IOError or OSError. If these don't suit, inherit from CatchableError or Defect." + + of rsemUseBase: + result = "use {.base.} for base methods; baseless methods are deprecated" + + of rsemMethodLockMismatch: + result = "method has lock level $1, but another method has $2" % + [r.lockMismatch[0], r.lockMismatch[1]] + + of rsemReorderingFail: + result = "Circular dependency detected. `codeReordering` pragma may not be able to" & + " reorder some nodes properly" + + of rsemUnknownMagic: + result = "unknown magic '$1' might crash the compiler" % r.str + + of rsemErrGcUnsafe: + result = r.ast.render & " is not GC safe" + + of rsemDrnimCannotPorveGe: + assert false, "TODO" + + of rsemDrnimCannotProveLeq: + assert false, "TODO" + + of rsemDrNimRequiresUsesMissingResult: + assert false, "TODO" + + of rsemInvalidGuardField: + result = "invalid guard field: " & r.symstr + + of rsemUnguardedAccess: + result = "unguarded access: " & r.ast.render + + of rsemInvalidNestedLocking: + result = "invalid nested locking" + + of rsemMultilockRequiresSameLevel: + result = "multi-lock requires the same static lock level for every operand" + + of rsemLocksRequiresArgs: + result = "locks pragma without argument" + + of rsemMismatchedPopPush: + result = "{.pop.} without a corresponding {.push.}" + + of rsemImportjsRequiresPattern: + result = "`importjs` for routines requires a pattern" + + of rsemImportjsRequiresJs: + result = "`importjs` pragma requires the JavaScript target" + + of rsemDynlibRequiresExportc: + assert false, "UNUSED?" + + of rsemExportcppRequiresCpp: + result = "exportcpp requires `cpp` backend, got: " & $conf.backend + + of rsemTypeInvalid: + result = "invalid type" + + of rsemIdentExpectedInExpr: + if not r.wrongNode.isNil: + result = "in expression '$1': " % [r.wrongNode.render] + + result.addf("identifier expected, but found '$1'", r.ast.render) + + of rsemInitHereNotAllowed: + result = "initialization not allowed here" + + of rsemPragmaDynlibRequiresExportc: + result = ".dynlib requires .exportc" + + of rsemPropositionExpected: + result = "proposition expected" + + of rsemUnexpectedPragma: + result = "unexpected pragma" + + of rsemCannotAttachPragma: + result = "cannot attach a custom pragma to '" & r.symstr & "'" + + of rsemDisallowedReprForNewruntime: + result = "'repr' is not available for --newruntime" + + of rsemDisallowedOfForPureObjects: + result = "no 'of' operator available for pure objects" + + of rsemRequiresDeepCopyEnabled: + result = "for --gc:arc|orc 'deepcopy' support has to be enabled with --deepcopy:on" + + of rsemExpectedLiteralForGoto: + result = "'goto' target must be a literal value" + + of rsemExpectedParameterForCxxPattern: + result = "wrong importcpp pattern; expected parameter at position " & + $r.countMismatch.expected & " but got only: " & $r.countMismatch.got + + of rsemExpectedCallForCxxPattern: + result = "call expression expected for C++ pattern" + + of rsemDisallowedRangeForComputedGoto: + result = "range notation not available for computed goto" + + of rsemExpectedCaseForComputedGoto: + result = "no case statement found for computed goto" + + of rsemExpectedLow0ForComputedGoto: + result = "case statement has to start at 0 for computed goto" + + of rsemTooManyEntriesForComputedGoto: + result = "case statement has too many cases for computed goto" + + of rsemExpectedUnholyEnumForComputedGoto: + result = "case statement cannot work on enums with holes for computed goto" + + of rsemExpectedExhaustiveCaseForComputedGoto: + result = "case statement must be exhaustive for computed goto" + + of rsemExpectedNimcallProc: + result = r.symstr & " needs to have the 'nimcall' calling convention" + + of rsemRttiRequestForIncompleteObject: + result = "request for RTTI generation for incomplete object: " & r.typ.render + + of rsemVmNotAField: + result = "symbol is not a field (nskField)" + + of rsemVmOutOfRange: + result = "unhandled exception: value out of range" + + of rsemVmErrInternal: + result = r.str + + of rsemVmCallingNonRoutine: + result = "NimScript: attempt to call non-routine: " & r.symstr + + of rsemVmGlobalError: + result = r.str + + of rsemNotAFieldSymbol: + result = "no field symbol" + + of rsemVmOpcParseExpectedExpression: + result = "expected expression, but got multiple statements" + + of rsemCannotDetermineBorrowTarget: + result = "cannot determine the target of the borrow" + + of rsemResultMustBorrowFirst: + result = "'result' must borrow from the first parameter" + + of rsemExpressionIsNotAPath: + result = "cannot borrow from " & r.ast.render & ", it is not a path expression" + + of rsemCallconvExpected: + result = "calling convention expected" + + of rsemOnOrOffExpected: + result = "'on' or 'off' expected" + + of rsemUnresolvedGenericParameter: + result = "unresolved generic parameter" + + of rsemRawTypeMismatch: + result = "type mismatch" + + of rsemCannotAssignToDiscriminantWithCustomDestructor: + result = "Assignment to discriminant for objects with user " & + "defined destructor is not supported, object must have default " & + "destructor.\nIt is best to factor out piece of object that needs " & + "custom destructor into separate object or not use discriminator assignment" + + of rsemCannotCreateImplicitOpenarray: + result = "cannot create an implicit openArray copy to be passed to a sink parameter" + + of rsemWrongNumberOfQuoteArguments: + assert false, "UNUSED" + + of rsemIllegalNimvmContext: + result = "illegal context for 'nimvm' magic" + + of rsemInvalidOrderInArrayConstructor: + result = "invalid order in array constructor" + + of rsemTypeConversionArgumentMismatch: + result = "a type conversion takes exactly one argument" + + of rsemConstantOfTypeHasNoValue: + result = "constant of type '" & r.typ.render & "' has no value" + + of rsemNoObjectOrTupleType: + result = "no object or tuple type" + + of rsemParallelFieldsDisallowsCase: + result = "parallel 'fields' iterator does not work for 'case' objects" + + of rsemFieldsIteratorCannotContinue: + result = "'continue' not supported in a 'fields' loop" + + of rsemConstExpressionExpected: + result = "constant expression expected" + + of rsemDiscardingVoid: + result = "statement returns no value that can be discarded" + + of rsemParameterNotPointerToPartial: + result = "parameter '$1' is not a pointer to a partial object" % r.ast.render + + of rsemIsNotParameterOf: + result = "'$1' is not a parameter of '$2'" % [$r.ast.render, r.symstr] + + of rsemGenericInstantiationTooNested: + result = "generic instantiation too nested" + + of rsemMacroInstantiationTooNested: + result = "macro instantiation too nested" + + of rsemExpectedNonemptyPattern: + result = "a pattern cannot be empty" + + of rsemInvalidExpression: + result = "invalid expression" + + of rsemParameterRedefinition: + result = "attempt to redefine: '" & r.symstr & "'" + + of rsemParameterRequiresAType: + result = "parameter '$1' requires a type" % r.symstr + + of rsemCannotInferParameterType: + result = "cannot infer the type of parameter '" & r.ast.render & "'" + + of rsemMisplacedMagicType: + result = "return type '" & r.typ.render & + "' is only valid for macros and templates" + + of rsemIgnoreInvalidForLoop: + result = "ignored invalid for loop" + + of rsemNotABaseMethod: + result = "method is not a base" + + of rsemMissingMethodDispatcher: + result = "'" & r.ast.render & "' lacks a dispatcher" + + of rsemWarnUnsafeCode: + result = "not GC-safe: '$1'" % r.ast.render + + of rsemImplicitCstringConvert: + result = "implicit conversion to 'cstring' from a non-const location: " & + ("$1; this will become a compile time error in the future" % r.ast.render) + + of rsemHoleEnumConvert: + result = "conversion to enum with holes is unsafe: $1" % r.ast.render + + + of rsemAnyEnumConvert: + result = "enum conversion: $1" % r.ast.render + + of rsemUseOfGc: + result = "'$1' uses GC'ed memory" % r.ast.render + + + of rsemPattern: + result = r.ast.render + + of rsemFatalError: + result = r.str + + of rsemSugNoSymbolAtPosition: + result = "found no symbol at position" + + of rsemOverrideSafetyMismatch: + result = "base method is GC-safe, but '$1' is not" % r.symbols[1].name.s + + of rsemOverrideLockMismatch: + result = "base method has lock level $1, but dispatcher has $2" % [ + $r.symbols[1].typ.lockLevel, + $r.symbols[0].typ.lockLevel + ] + + of rsemExpectedIdentifierInExpr: + result = "in expression '$1': identifier expected, but found '$2'" % [ + r.ast.render(), r.wrongNode.render() + ] + + of rsemFieldNotAccessible: + result = "the field '$1' is not accessible." % r.symstr + + of rsemFieldOkButAssignedValueInvalid: + result = "Invalid field assignment '$1'$2" % [ + r.wrongNode.render, + tern(r.ast.isNil, "", "; " & r.ast.render) + ] + + of rsemStrictNotNilResult: + case r.nilIssue: + of Nil: + result = "return value is nil" + of MaybeNil: + result = "return value might be nil" + of Unreachable: + result = "return value is unreachable" + of Safe, Parent: + discard + + of rsemStrictNotNilExpr: + result.add( + "can't deref ", + r.ast.render, + ", ", + case r.nilIssue: + of Nil: "it is nil" + of MaybeNil: "it might be nil" + of Unreachable: "it is unreachable" + else: "" + ) + + if r.nilHistory.len > 0: + result.add("\n") + + + for step in r.nilHistory: + result.addf(" $1 on line "): + case step.kind: + of NilTransition.TArg: "param with nilable type" + of NilTransition.TNil: "it returns true for isNil" + of NilTransition.TAssign: "assigns a value which might be nil" + of NilTransition.TVarArg: "passes it as a var arg which might change to nil" + of NilTransition.TResult: "it is nil by default" + of NilTransition.TType: "it has ref type" + of NilTransition.TSafe: "it is safe here as it returns false for isNil" + of NilTransition.TPotentialAlias: "it might be changed directly or through an alias" + of NilTransition.TDependant: "it might be changed because its base might be changed" + + result.addf("$1:$2", $step.info.line, $step.info.col) + + + of rsemWarnGcUnsafeListing, rsemErrGcUnsafeListing: + let trace = r.gcUnsafeTrace + let (s, u) = (trace.isUnsafe.name.s, trace.unsafeVia.name.s) + case trace.unsafeRelation: + of sgcuCallsUnsafe: + result.addf("'$#' is not GC-safe as it calls '$#'", s, u) + + of sgcuAccessesGcGlobal: + result.addf( + "'$#' is not GC-safe as it accesses '$#' which is a global using GC'ed memory", + s, u) + + of sgcuIndirectCallVia: + + result.addf( + "'$#' is not GC-safe as it performs an indirect call via '$#'", s, u) + + of sgcuIndirectCallHere: + result.addf( + "'$#' is not GC-safe as it performs an indirect call here", s) + + +const standalone = { + rsemExpandArc, # Original compiler did not consider it as a hint + rsemVmStackTrace, # Always associated with extra report +} + +const repWithPrefix = repAllKinds - standalone +const repWithSuffix = repWarningKinds + repHintKinds - standalone +const repWithLocation = repAllKinds - standalone + +func prefixShort(conf: ConfigRef, r: ReportTypes): string {.inline.} = + if r.kind in repWithPrefix: + # `Hint: `, `Error: ` etc. + reportTitles[conf.severity(r)] + else: + "" + +proc prefix(conf: ConfigRef, r: ReportTypes): string = + let sev = conf.severity(r) + if r.location.isSome() and r.kind in repWithLocation: + # Optional report location + result.add conf.toStr(r.location.get()) & " " + + if r.kind in repWithPrefix: + # `Hint: `, `Error: ` etc. + result.add conf.wrap(prefixShort(conf, r), reportColors[sev]) + +func suffixShort(conf: ConfigRef, r: ReportTypes): string {.inline.} = + if r.kind in repWithSuffix or conf.hasHint(rintErrKind): + " [" & $r.kind & "]" + else: + "" + +proc suffix( + conf: ConfigRef, + r: ReportTypes + ): string = + if r.kind in repWithSuffix or conf.hasHint(rintErrKind): + result.add conf.wrap(suffixShort(conf, r), fgCyan) + + if conf.hasHint(rintMsgOrigin): + result.add( + "\n", + conf.toStr(r.reportInst), + " compiler msg instantiated here ", + conf.wrap("[MsgOrigin]", fgCyan) + ) + + if r.reportInst != r.reportFrom: + result.add( + "\n", + conf.toStr(r.reportFrom), + " compiler report submitted here ", + conf.wrap("[MsgOrigin]", fgCyan) + ) + +proc reportFull*(conf: ConfigRef, r: SemReport): string = + assertKind r + + if r.kind == rsemProcessing and conf.hintProcessingDots: + return "." + + result.add( + conf.getContext(r.context), + conf.prefix(r), + reportBody(conf, r), + conf.suffix(r) + ) + +proc reportShort*(conf: ConfigRef, r: SemReport): string = + # mostly created for nimsuggest + assertKind r + if r.kind == rsemProcessing and conf.hintProcessingDots: + "." + else: + reportBody(conf, r) & suffixShort(conf, r) + + +proc reportBody*(conf: ConfigRef, r: ParserReport): string = + assertKind r + case ParserReportKind(r.kind): + of rparInvalidIndentation: + result = "invalid indentation" + result.add r.msg + + of rparNestableRequiresIndentation: + result = "nestable statement requires indentation" + + of rparIdentExpected: + result = "identifier expected, but got '$1'" % r.found + + of rparIdentOrKwdExpected: + result = "identifier expected, but got '$1'" % r.found + + of rparExprExpected: + result = "expression expected, but found '$1'" % r.found + + of rparMissingToken: + result = "expected " & r.expected[0] + + of rparUnexpectedToken: + result = "expected: '" & $r.expected[0] & "', but got: '" & r.found & "'" + + of rparUnexpectedTokenKind: + result = r.msg + + of rparFuncNotAllowed: + result = "func keyword is not allowed in type descriptions, use proc with {.noSideEffect.} pragma instead" + + of rparTupleTypeWithPar: + result = "the syntax for tuple types is 'tuple[...]', not 'tuple(...)'" + + of rparMisplacedParameterVar: + result = "the syntax is 'parameter: var T', not 'var parameter: T'" + + of rparConceptNotinType: + result = "the 'concept' keyword is only valid in 'type' sections" + + of rparRotineExpected: + result = r.msg + + of rparPragmaAlreadyPresent: + result = "pragma already present" + + of rparMisplacedExport: + result = "invalid indentation; an export marker '*' follows the declared identifier" + + of rparTemplMissingEndClose: + result = "?" + + of rparTemplInvalidExpression: + result = "?" + + of rparInconsistentSpacing: + result = "Number of spaces around '$#' is not consistent" + + of rparEnablePreviewDotOps: + result = "?" + + of rparPragmaNotFollowingTypeName: + result = "?" + + of rparPragmaBeforeGenericParameters: + result = "?" + + of rparName: + result = "?" + + of rparInvalidFilter: + result = "?" + +proc reportFull*(conf: ConfigRef, r: ParserReport): string = + assertKind r + result = conf.prefix(r) & conf.reportBody(r) & conf.suffix(r) + +proc reportShort*(conf: ConfigRef, r: ParserReport): string = + # mostly created for nimsuggest + assertKind r + reportBody(conf, r) & suffixShort(conf, r) + + +proc reportBody*(conf: ConfigRef, r: InternalReport): string = + assertKind r + case InternalReportKind(r.kind): + of rintStackTrace: + result = conf.formatTrace(r.trace) + + of rintListWarnings: + result = "Warnings:" + for kind in repWarningKinds: + result.addf("\n [$1] $2", tern( + kind in r.enabledOptions, "X", " "), $kind) + + of rintListHints: + result = "Hints:" + for kind in repHintKinds: + result.addf("\n [$1] $2", tern( + kind in r.enabledOptions, "X", " "), $kind) + + of rintSuccessX: + var build = "" + let par = r.buildParams + if conf.cmd in cmdBackends: + build.add "gc: $#; " % par.gc + + if par.threads: + build.add "threads: on; " + + build.add "opt: " + if par.optimize == "debug": + build.add "none (DEBUG BUILD, `-d:release` generates faster code)" + + else: + build.add par.optimize + build.add "; " + build.add par.buildMode + build.add " " + + let mem = + if par.isMaxMem: + formatSize(par.mem) & " peakmem" + + else: + formatSize(par.mem) & " totmem" + + result = &"{conf.prefix(r)}{build}{par.linesCompiled} lines; {par.sec:.3f}s; {mem}; proj: {par.project}; out: {par.output}{conf.suffix(r)}" + + of rintUsingLeanCompiler: + result = r.msg + + of rintMissingStackTrace: + result = """ +No stack traceback available +To create a stacktrace, rerun compilation with './koch temp $1 ' + """ + + of rintAssert: + result.add( + conf.prefix(r), + "Internal assert '", + r.expression, + "' failed in ", + conf.toStr(r.reportInst) + ) + + of rintUnreachable: + result.add( + conf.prefix(r), + "Internal unreachable code executed - ", + conf.toStr(r.reportInst), + " (", r.msg, ") should never be called." + ) + + of rintEchoMessage: + if conf.cmd == cmdInteractive: + result = ">>> " & r.msg + + else: + result = r.msg + + of rintCannotOpenFile, rintWarnCannotOpenFile: + result = "cannot open file: $1" % r.file + + of rintUnknown: + result = "unknown" + + of rintFatal: + result = "fatal" + + of rintIce: + result = r.msg + + of rintNotUsingNimcore: + result = "Nim tooling must be built using -d:nimcore" + + of rintNotImplemented: + result = r.msg + + of rintUnexpected: + result = "unexpected" + + of rintWarnFileChanged: + result = "file changed: $1" % r.file + + of rintSource: + assert false, "is a configuration hint, should not be reported manually" + + of rintGCStats: + result = r.msg + + of rintQuitCalled: + result = "quit() called" + + of rintMsgOrigin, rintErrKind: + assert false, "is a configuration hint, should not be reported manually" + + of rintNimconfWrite: + result = "" + + of rintDumpState: + if getConfigVar(conf, "dump.format") == "json": + let s = r.stateDump + var definedSymbols = newJArray() + for s in s.definedSymbols: + definedSymbols.elems.add(%s) + + var libpaths = newJArray() + var lazyPaths = newJArray() + for dir in conf.searchPaths: + libpaths.elems.add(%dir.string) + + for dir in conf.lazyPaths: + lazyPaths.elems.add(%dir.string) + + var hints = newJObject() + for (a, state) in s.hints: + hints[$a] = %(state) + + + var warnings = newJObject() + for (a, state) in s.warnings: + warnings[$a] = %(state) + + result = $(%[ + (key: "version", val: %s.version), + (key: "nimExe", val: %s.nimExe), + (key: "prefixdir", val: %s.prefixdir), + (key: "libpath", val: %s.libpath), + (key: "project_path", val: %s.projectPath), + (key: "defined_symbols", val: definedSymbols), + (key: "lib_paths", val: libpaths), + (key: "lazyPaths", val: lazyPaths), + (key: "outdir", val: %s.outdir), + (key: "out", val: %s.out), + (key: "nimcache", val: %s.nimcache), + (key: "hints", val: hints), + (key: "warnings", val: warnings), + ]) + + else: + result.add "-- list of currently defined symbols --\n" + let s = r.stateDump + for s in s.definedSymbols: + result.add(s, "\n") + + result.add "-- end of list --\n" + + for it in s.libPaths: + result.add it, "\n" + +proc reportFull*(conf: ConfigRef, r: InternalReport): string = + assertKind r + case r.kind: + of rintCannotOpenFile, rintWarnCannotOpenFile: + result.add(conf.prefix(r), conf.reportBody(r), conf.suffix(r)) + + else: + result = reportBody(conf, r) + +proc reportShort*(conf: ConfigRef, r: InternalReport): string = + # mostly created for nimsuggest + assertKind r + result = reportBody(conf, r) + if r.kind in {rintCannotOpenFile, rintWarnCannotOpenFile}: + result.add conf.suffixShort(r) + + +proc reportBody*(conf: ConfigRef, r: LexerReport): string = + assertKind r + case LexerReportKind(r.kind): + of rlexMalformedTrailingUnderscre: + result.add "invalid token: trailing underscore" + + of rlexMalformedUnderscores: + result.add "only single underscores may occur in a token and token may not " & + "end with an underscore: e.g. '1__1' and '1_' are invalid" + + of rlexInvalidToken: + result.add r.msg + + of rlexNoTabs: + result.add "tabs are not allowed, use spaces instead" + + of rlexInvalidIntegerPrefix: + result.add r.msg + + of rlexInvalidIntegerSuffix: + result.add r.msg + + of rlexNumberNotInRange: + result.add r.msg + + of rlexExpectedHex: + result.add r.msg + + of rlexInvalidIntegerLiteral: + result.add r.msg + + of rlexInvalidCharLiteral: + result.add r.msg + + of rlexMissingClosingApostrophe: + result.add "missing closing ' for character literal" + + of rlexInvalidUnicodeCodepoint: + result.add r.msg + + of rlexUnclosedTripleString: + result.add "closing \"\"\" expected, but end of file reached" + + of rlexUnclosedSingleString: + result.add "closing \" expected" + + of rlexExpectedToken: + assert false + + of rlexCfgInvalidDirective: + result.add "?" + + of rlexUnclosedComment: + result.add "end of multiline comment expected" + + of rlexDeprecatedOctalPrefix: + result.add r.msg + + of rlexLinterReport: + result.addf("'$1' should be: '$2'", r.got, r.wanted) + + of rlexLineTooLong: + result.add "line too long" + + of rlexSyntaxesCode: + result.add "?" + +proc reportFull*(conf: ConfigRef, r: LexerReport): string = + assertKind r + result.add(prefix(conf, r), reportBody(conf, r), suffix(conf, r)) + +proc reportShort*(conf: ConfigRef, r: LexerReport): string = + # mostly created for nimsuggest + assertKind r + prefixShort(conf, r) & reportBody(conf, r) & suffixShort(conf, r) + + +proc reportBody*(conf: ConfigRef, r: ExternalReport): string = + assertKind r + case ExternalReportKind(r.kind): + of rextConf: + result.add( + conf.prefix(r), + "used config file '$1'" % r.msg, + conf.suffix(r) + ) + + of rextCommandMissing: + result.add("Command missing") + + of rextInvalidHint: + result.add("Invalid hint - ", r.cmdlineProvided) + + of rextInvalidWarning: + result.add("Invalid warning - ", r.cmdlineProvided) + + of rextInvalidCommand: + result.add("Invalid command - ", r.cmdlineProvided) + + of rextInvalidCommandLineOption: + result.add("Invalid command line option - ", r.cmdlineProvided) + + of rextUnknownCCompiler: + result = "unknown C compiler: '$1'. Available options are: $2" % [ + r.passedCompiler, + r.knownCompilers.join(", ") + ] + + of rextOnlyAllOffSupported: + result = "only 'all:off' is supported" + + of rextExpectedOnOrOff: + result = "'on' or 'off' expected, but '$1' found" % r.cmdlineProvided + + of rextExpectedOnOrOffOrList: + result = "'on', 'off' or 'list' expected, but '$1' found" % r.cmdlineProvided + + of rextExpectedCmdArgument: + result = "argument for command line option expected: '$1'" % r.cmdlineSwitch + + of rextExpectedNoCmdArgument: + result = "invalid argument for command line option: '$1'" % r.cmdlineSwitch + + of rextInvalidNumber: + result = "$1 is not a valid number" % r.cmdlineProvided + + of rextInvalidValue: + result = r.cmdlineError + + of rextUnexpectedValue: + result = "Unexpected value for $1. Expected one of $2" % [ + r.cmdlineSwitch, r.cmdlineAllowed.join(", ") + ] + + of rextIcUnknownFileName: + result = "unknown file name: " & r.msg + + of rextIcNoSymbolAtPosition: + result = "no symbol at this position" + + of rextExpectedTinyCForRun: + result = "'run' command not available; rebuild with -d:tinyc" + + of rextExpectedCbackendForRun: + result = "'run' requires c backend, got: '$1'" % $conf.backend + + of rextExpectedRunOptForArgs: + result = "arguments can only be given if the '--run' option is selected" + + of rextUnexpectedRunOpt: + result = "'$1 cannot handle --run" % r.cmdlineProvided + + of rextInvalidPath: + result = "invalid path: " & r.cmdlineProvided + + of rextInvalidPackageName: + result = "invalid package name: " & r.packageName + + of rextDeprecated: + result = r.msg + + of rextPath: + result = "added path: '$1'" % r.packagePath + +proc reportFull*(conf: ConfigRef, r: ExternalReport): string = + assertKind r + reportBody(conf, r) + +proc reportShort*(conf: ConfigRef, r: ExternalReport): string {.inline.} = + # mostly created for nimsuggest + reportBody(conf, r) + +const + dropTraceExt = off + reportCaller = on + +proc reportBody*(conf: ConfigRef, r: DebugReport): string = + assertKind r + func toStr(opc: TOpcode): string = substr($opc, 3) + + case DebugReportKind(r.kind): + of rdbgTraceStep: + let s = r.semstep + result.addf("$1]", align($s.level, 2, '#')) + result.add( + repeat(" ", s.level), + tern(s.direction == semstepEnter, "> ", "< "), + wrap(s.name, tern(s.direction == semstepEnter, fgGreen, fgRed)), + " @ ", + wrap(conf.toStr(r.reportInst, dropTraceExt), fgCyan), + tern( + reportCaller and s.steppedFrom.isValid(), + " from " & conf.toStr(s.steppedFrom, dropTraceExt), + "")) + + of rdbgTraceLine: + let ind = repeat(" ", r.ctraceData.level) + var paths: seq[string] + var width = 0 + for entry in r.ctraceData.entries: + paths.add "$1($2)" % [ + formatPath(conf, $entry.filename), $entry.line] + + width = max(paths[^1].len, width) + + for idx, entry in r.ctraceData.entries: + result.add( + " ]", + ind, " | ", + alignLeft(paths[idx], width + 1), + conf.wrap($entry.procname, fgGreen), + tern(idx < r.ctraceData.entries.high, "\n", "") + ) + + of rdbgTraceStart: + result = ">>] trace start" + + of rdbgTraceEnd: + result = "<<] trace end" + + of rdbgTraceDefined: + result = ">>] debug trace defined at " & toStr(conf, r.location.get()) + + of rdbgTraceUndefined: + result = "<<] debug trace undefined " & toStr(conf, r.location.get()) + + of rdbgVmExecTraceMinimal: + result.addf( + "$# [$#] $#", + conf.toStr(r.vmgenExecMinimal.info), + r.vmgenExecMinimal.opc.toStr, + conf.sourceLine(r.vmgenExecMinimal.info), + ) + + of rdbgOptionsPush: + result = "PUSH: " & $r.optionsNow + + of rdbgOptionsPop: + result = "POP: " & $r.optionsNow + + of rdbgVmExecTraceFull: + let exec = r.vmgenExecFull + result.addf( + "PC:$1 $2 $3 $4 $5", + $exec.pc, + $exec.opc.toStr, + tern(exec.ra == rkNone, "", $exec.ra), + tern(exec.rb == rkNone, "", $exec.rb), + tern(exec.rc == rkNone, "", $exec.rc) + ) + + of rdbgFinishedConfRead: + result = "finished configuration file read $1" % r.filename + + of rdbgStartingConfRead: + result = "starting configuration file read $1" % r.filename + + of rdbgCfgTrace: + result = "cfg trace '" & r.str & "'" + + of rdbgVmCodeListing: + for e in r.vmgenListing.entries: + if e.isTarget: + result.add("L:\n", e.pc) + + case e.opc: + of {opcIndCall, opcIndCallAsgn}: + result.addf("\t$#\tr$#, r$#, nargs:$#", e.opc, e.ra, e.rb, e.rc) + + of {opcConv, opcCast}: + result.addf( + "\t$#\tr$#, r$#, $#, $#", + $e.opc.toStr, + $e.ra, + $e.rb, + $e.types[0].typeToString(), + $e.types[1].typeToString()) + + elif e.opc < firstABxInstr: + result.addf("\t$#\tr$#, r$#, r$#", e.opc.toStr, $e.ra, $e.rb, $e.rc) + + elif e.opc in relativeJumps + {opcTry}: + result.addf("\t$#\tr$#, L$#", e.opc.toStr, $e.ra, $e.idx) + + elif e.opc in {opcExcept}: + result.addf("\t$#\t$#, $#", $e.opc.toStr, $e.ra, $e.idx) + + elif e.opc in {opcLdConst, opcAsgnConst}: + result.addf( + "\t$#\tr$#, $# ($#)", + $e.opc.toStr, $e.ra, $e.ast.renderTree(), $e.idx) + + else: + result.addf("\t$#\tr$#, $#", e.opc.toStr, $e.ra, $e.idx) + + result.add("\t# ") + result.add(toStr(conf, e.info)) + result.add("\n") + +proc reportFull*(conf: ConfigRef, r: DebugReport): string = + assertKind r + case r.kind: + of rdbgCfgTrace: + result.add(prefix(conf, r), reportBody(conf, r), suffix(conf, r)) + + else: + result = reportBody(conf, r) + +proc reportShort*(conf: ConfigRef, r: DebugReport): string = + # mostly created for nimsuggest + assertKind r + result = reportBody(conf, r) + if r.kind == rdbgCfgTrace: + result.add suffixShort(conf, r) + +proc reportBody*(conf: ConfigRef, r: BackendReport): string = + assertKind r + case BackendReportKind(r.kind): + of rbackJsUnsupportedClosureIter: + result = "Closure iterators are not supported by JS backend!" + + of rbackJsTooCaseTooLarge: + result = "Your case statement contains too many branches, consider using if/else instead!" + + of rbackCannotWriteScript, rbackCannotWriteMappingFile: + result = "could not write to file: " & r.filename + + of rbackTargetNotSupported: + result = "Compiler '$1' doesn't support the requested target" % r.usedCompiler + + of rbackJsonScriptMismatch: + result = ( + "jsonscript command outputFile '$1' must " & + "match '$2' which was specified during --compileOnly, see \"outputFile\" entry in '$3' " + ) % [ + r.jsonScriptParams[0], + r.jsonScriptParams[1], + r.jsonScriptParams[2], + ] + + of rbackRstCannotOpenFile: + result = "cannot open '$1'" % r.msg + + of rbackRstExpected: + result = "'$1' expected" % r.msg + + of rbackRstGridTableNotImplemented: + result = "grid table is not implemented" + + of rbackRstMarkdownIllformedTable: + result = "illformed delimiter row of a Markdown table" + + of rbackRstNewSectionExpected: + result = "new section expected $1" % r.msg + + of rbackRstGeneralParseError: + result = "general parse error" % r.msg + + of rbackRstInvalidDirective: + result = "invalid directive: '$1'" % r.msg + + of rbackRstInvalidField: + result = "invalid field: $1" % r.msg + + of rbackRstFootnoteMismatch: + result = "mismatch in number of footnotes and their refs: $1" % r.msg + + of rbackCannotProduceAssembly: + result = "Couldn't produce assembler listing " & + "for the selected C compiler: " & r.usedCompiler + + of rbackRstTestUnsupported: + result = "the ':test:' attribute is not supported by this backend" + + of rbackRstRedefinitionOfLabel: + result = "redefinition of label '$1'" % r.msg + + of rbackRstUnknownSubstitution: + result = "unknown substitution '$1'" % r.msg + + of rbackRstBrokenLink: + result = "unknown substitution '$1'" % r.msg + + of rbackRstUnsupportedLanguage: + result = "language '$1' not supported" % r.msg + + of rbackRstUnsupportedField: + result = "field '$1' not supported" % r.msg + + of rbackRstRstStyle: + result = "RST style: $1" % r.msg + + of rbackProducedAssembly: + result = "Produced assembler here: " & r.filename + + of rbackLinking: + result = "" + + of rbackCompiling: + result = "" + +proc reportFull*(conf: ConfigRef, r: BackendReport): string = + assertKind r + case BackendReportKind(r.kind): + of rbackJsUnsupportedClosureIter, + rbackJsTooCaseTooLarge: + result.add( + conf.prefix(r), + conf.reportBody(r), + conf.suffix(r) + ) + + else: + result = reportBody(conf, r) + +proc reportShort*(conf: ConfigRef, r: BackendReport): string = + # mostly created for nimsuggest + assertKind r + result = reportBody(conf, r) + if BackendReportKind(r.kind) in {rbackJsUnsupportedClosureIter, + rbackJsTooCaseTooLarge}: + result.add conf.suffixShort(r) + + +proc reportBody*(conf: ConfigRef, r: CmdReport): string = + assertKind r + case CmdReportKind(r.kind): + of rcmdCompiling: + result = "CC: " & r.msg + + of rcmdLinking: + result = conf.prefix(r) & conf.suffix(r) + + of rcmdFailedExecution: + result = "execution of an external program '$1' failed with exit code '$2'" % [ + r.cmd, $r.code + ] + + of rcmdExecuting: + result = r.cmd + + of rcmdRunnableExamplesSuccess: + result = "runnableExamples: " & r.msg + +proc reportFull*(conf: ConfigRef, r: CmdReport): string = + assertKind r + reportBody(conf, r) + +proc reportShort*(conf: ConfigRef, r: CmdReport): string {.inline.} = + # mostly created for nimsuggest + reportBody(conf, r) + + +proc reportBody*(conf: ConfigRef, r: Report): string = + ## Generate main body of the report. Dispatches into implementations for + ## specific report categories. + assertKind r + case r.category: + of repLexer: result = conf.reportBody(r.lexReport) + of repParser: result = conf.reportBody(r.parserReport) + of repCmd: result = conf.reportBody(r.cmdReport) + of repSem: result = conf.reportBody(r.semReport) + of repDebug: result = conf.reportBody(r.debugReport) + of repInternal: result = conf.reportBody(r.internalReport) + of repBackend: result = conf.reportBody(r.backendReport) + of repExternal: result = conf.reportBody(r.externalReport) + +proc reportFull*(conf: ConfigRef, r: Report): string = + ## Generate full version of the report (location, severity, body, + ## optional suffix) + assertKind r + case r.category: + of repLexer: result = conf.reportFull(r.lexReport) + of repParser: result = conf.reportFull(r.parserReport) + of repCmd: result = conf.reportFull(r.cmdReport) + of repSem: result = conf.reportFull(r.semReport) + of repDebug: result = conf.reportFull(r.debugReport) + of repInternal: result = conf.reportFull(r.internalReport) + of repBackend: result = conf.reportFull(r.backendReport) + of repExternal: result = conf.reportFull(r.externalReport) + +proc reportShort*(conf: ConfigRef, r: Report): string = + ## Generate short report version of the report + assertKind r + case r.category: + of repLexer: result = conf.reportShort(r.lexReport) + of repParser: result = conf.reportShort(r.parserReport) + of repCmd: result = conf.reportShort(r.cmdReport) + of repSem: result = conf.reportShort(r.semReport) + of repDebug: result = conf.reportShort(r.debugReport) + of repInternal: result = conf.reportShort(r.internalReport) + of repBackend: result = conf.reportShort(r.backendReport) + of repExternal: result = conf.reportShort(r.externalReport) + +var lastDot: bool = false + +const forceWrite = { + rsemExpandArc # Not considered a hint for now +} + +const rdbgTracerKinds* = {rdbgTraceDefined .. rdbgTraceEnd} + + +const + # additional configuration switches to control the behavior of the debug + # printer. Since most of them are for compiler debugging, you will most + # likely recompile the compiler anyway, so toggling couple hardcoded + # constants here is easier than dragging out completely unnecessary + # switches, or adding more magic `define()` blocks + semStack = off ## Show `| context` entries in the call tracer + + reportInTrace = off ## Error messages are shown with matching indentation + ## if report was triggered during execution of the sem trace + +const traceDir = "nimCompilerDebugTraceDir" +var traceIndex = 0 +var traceFile: File + +proc rotatedTrace(conf: ConfigRef, r: Report) = + ## Write out debug traces into separate files in directory defined by + ## `nimCompilerDebugTraceDir` + # Dispatch each `{.define(nimCompilerDebug).}` section into separate file + assert r.kind in rdbgTracerKinds, $r.kind + case r.kind: + of rdbgTraceDefined, rdbgTraceStart: + if not dirExists(conf.getDefined(traceDir)): + createDir conf.getDefined(traceDir) + + traceFile = open(conf.getDefined(traceDir) / $traceIndex, fmWrite) + + of rdbgTraceUndefined, rdbgTraceEnd: + close(traceFile) + inc traceIndex + + else: + discard + + +proc reportHook*(conf: ConfigRef, r: Report): TErrorHandling = + ## Default implementation of the report hook + let tryhack = conf.m.errorOutputs == {} + # REFACTOR this check is an absolute hack, `errorOutputs` need to be + # removed. For more details see `lineinfos.MsgConfig.errorOutputs` + # comment + assertKind r + + if conf.isEnabled(r) and r.category == repDebug and tryhack: + # Force write of the report messages using regular stdout if tryhack is + # enabled + if lastDot: + conf.writeln("") + lastDot = false + echo conf.reportFull(r) + + elif r.kind in rdbgTracerKinds and conf.isDefined(traceDir): + rotatedTrace(conf, r) + + elif ( + # Not explicitly enanled + not conf.isEnabled(r) and + # And not added for forced write + r.kind notin forceWrite + ) or ( + # Or we are in the special hack mode for `compiles()` processing + tryhack + ) or ( + # Optionally Ignore context stacktrace + not semStack and r.kind == rdbgTraceLine + ): + + # Return without writing + return + + elif r.kind == rsemProcessing and conf.hintProcessingDots: + # REFACTOR 'processing with dots' - requires special hacks, pretty + # useless, need to be removed in the future. + conf.write(".") + lastDot = true + + else: + if lastDot: + conf.writeln("") + lastDot = false + + if reportInTrace: + var indent {.global.}: int + if r.kind == rdbgTraceStep: + indent = r.debugReport.semstep.level + + case r.kind: + of rdbgTracerKinds: + conf.writeln(conf.reportFull(r)) + + of repSemKinds: + if 0 < indent: + for line in conf.reportFull(r).splitLines(): + conf.writeln(" ]", repeat(" ", indent), " ! ", line) + + else: + conf.writeln(conf.reportFull(r)) + + else: + conf.writeln(conf.reportFull(r)) + + else: + conf.writeln(conf.reportFull(r)) diff --git a/compiler/closureiters.nim b/compiler/closureiters.nim index a8da7485e83..45539f35c9c 100644 --- a/compiler/closureiters.nim +++ b/compiler/closureiters.nim @@ -465,7 +465,9 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = needsSplit = true result = newNodeI(nkStmtListExpr, n.info) - if n.typ.isNil: internalError(ctx.g.config, "lowerStmtListExprs: constr typ.isNil") + if n.typ.isNil: + internalError(ctx.g.config, "lowerStmtListExprs: constr typ.isNil") + result.typ = n.typ for i in 0.. 0 and path[0] == '"': strutils.unescape(path) else: path let basedir = toFullPath(conf, info).splitFile().dir @@ -372,12 +506,10 @@ proc processCfgPath(conf: ConfigRef; path: string, info: TLineInfo): AbsoluteDir try: result = AbsoluteDir pathSubs(conf, p, basedir) except ValueError: - localError(conf, info, "invalid path: " & p) + conf.localReport(info, ExternalReport( + kind: rextInvalidPath, cmdlineProvided: p, cmdlineSwitch: switch)) result = AbsoluteDir p -const - errInvalidNumber = "$1 is not a valid number" - proc makeAbsolute(s: string): AbsoluteFile = if isAbsolute(s): AbsoluteFile pathnorm.normalizePath(s) @@ -389,9 +521,11 @@ proc setTrackingInfo(conf: ConfigRef; dirty, file, line, column: string, ## set tracking info, common code for track, trackDirty, & ideTrack var ln, col: int if parseUtils.parseInt(line, ln) <= 0: - localError(conf, info, errInvalidNumber % line) + conf.localReport(info, ExternalReport( + kind: rextInvalidNumber, cmdlineProvided: line)) if parseUtils.parseInt(column, col) <= 0: - localError(conf, info, errInvalidNumber % column) + conf.localReport(info, ExternalReport( + kind: rextInvalidNumber, cmdlineProvided: column)) let a = makeAbsolute(file) if dirty == "": @@ -404,13 +538,18 @@ proc setTrackingInfo(conf: ConfigRef; dirty, file, line, column: string, proc trackDirty(conf: ConfigRef; arg: string, info: TLineInfo) = var a = arg.split(',') - if a.len != 4: localError(conf, info, - "DIRTY_BUFFER,ORIGINAL_FILE,LINE,COLUMN expected") + if a.len != 4: + conf.localReport(info, ExternalReport( + kind: rextInvalidValue, + cmdlineProvided: arg, cmdlineError: "DIRTY_BUFFER,ORIGINAL_FILE,LINE,COLUMN expected")) setTrackingInfo(conf, a[0], a[1], a[2], a[3], info) proc track(conf: ConfigRef; arg: string, info: TLineInfo) = var a = arg.split(',') - if a.len != 3: localError(conf, info, "FILE,LINE,COLUMN expected") + if a.len != 3: + conf.localReport(info, ExternalReport( + kind: rextInvalidValue, + cmdlineProvided: arg, cmdlineError: "FILE,LINE,COLUMN expected")) setTrackingInfo(conf, "", a[0], a[1], a[2], info) proc trackIde(conf: ConfigRef; cmd: IdeCmd, arg: string, info: TLineInfo) = @@ -422,7 +561,9 @@ proc trackIde(conf: ConfigRef; cmd: IdeCmd, arg: string, info: TLineInfo) = of 3: setTrackingInfo(conf, "", a[0], a[1], a[2], info) else: - localError(conf, info, "[DIRTY_BUFFER,]ORIGINAL_FILE,LINE,COLUMN expected") + conf.localReport(info, ExternalReport( + kind: rextInvalidValue, + cmdlineProvided: arg, cmdlineError: "[DIRTY_BUFFER,]ORIGINAL_FILE,LINE,COLUMN expected")) conf.ideCmd = cmd proc dynlibOverride(conf: ConfigRef; switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = @@ -446,6 +587,7 @@ proc handleCmdInput*(conf: ConfigRef) = handleStdinOrCmdInput() proc parseCommand*(command: string): Command = + # NOTE when adding elements to this list, sync with `cmdNames` const case command.normalize of "c", "cc", "compile", "compiletoc": cmdCompileToC of "cpp", "compiletocpp": cmdCompileToCpp @@ -491,9 +633,9 @@ proc setCommandEarly*(conf: ConfigRef, command: string) = # must be handled here to honor subsequent `--hint:x:on|off` case conf.cmd of cmdRst2html, cmdRst2tex: # xxx see whether to add others: cmdGendepend, etc. - conf.foreignPackageNotes = {hintSuccessX} + conf.foreignPackageNotes = NotesVerbosity.base + {rintSuccessX} else: - conf.foreignPackageNotes = foreignPackageNotesDefault + conf.foreignPackageNotes = NotesVerbosity.foreign proc specialDefine(conf: ConfigRef, key: string; pass: TCmdLinePass) = # Keep this syncronized with the default config/nim.cfg! @@ -501,12 +643,12 @@ proc specialDefine(conf: ConfigRef, key: string; pass: TCmdLinePass) = conf.exc = excQuirky elif cmpIgnoreStyle(key, "release") == 0 or cmpIgnoreStyle(key, "danger") == 0: if pass in {passCmd1, passPP}: - conf.options.excl {optStackTrace, optLineTrace, optLineDir, optOptimizeSize} + conf.excl {optStackTrace, optLineTrace, optLineDir, optOptimizeSize} conf.globalOptions.excl {optExcessiveStackTrace, optCDebug} - conf.options.incl optOptimizeSpeed + conf.incl optOptimizeSpeed if cmpIgnoreStyle(key, "danger") == 0 or cmpIgnoreStyle(key, "quick") == 0: if pass in {passCmd1, passPP}: - conf.options.excl {optObjCheck, optFieldCheck, optRangeCheck, optBoundsCheck, + conf.excl {optObjCheck, optFieldCheck, optRangeCheck, optBoundsCheck, optOverflowCheck, optAssert, optStackTrace, optLineTrace, optLineDir} conf.globalOptions.excl {optCDebug} @@ -514,6 +656,16 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; conf: ConfigRef) = var key, val: string + proc invalidSwitchValue( + wanted: seq[string], cmdlineError: string = ""): ExternalReport = + + ExternalReport( + kind: rextInvalidValue, + cmdlineProvided: arg, + cmdlineAllowed: wanted, + cmdlineError: cmdlineError, + cmdlineSwitch: switch) + case switch.normalize of "eval": expectArg(conf, switch, arg, pass, info) @@ -526,13 +678,13 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; of "path", "p": expectArg(conf, switch, arg, pass, info) for path in nimbleSubs(conf, arg): - addPath(conf, if pass == passPP: processCfgPath(conf, path, info) - else: processPath(conf, path, info), info) + addPath(conf, if pass == passPP: processCfgPath(conf, path, info, switch) + else: processPath(conf, path, info, switch), info) of "nimblepath", "babelpath": if switch.normalize == "babelpath": deprecatedAlias(switch, "nimblepath") if pass in {passCmd2, passPP} and optNoNimblePath notin conf.globalOptions: expectArg(conf, switch, arg, pass, info) - var path = processPath(conf, arg, info, notRelativeToProj=true) + var path = processPath(conf, arg, info, switch, notRelativeToProj=true) let nimbleDir = AbsoluteDir getEnv("NIMBLE_DIR") if not nimbleDir.isEmpty and pass == passPP: path = nimbleDir / RelativeDir"pkgs" @@ -546,7 +698,7 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; clearNimblePath(conf) of "excludepath": expectArg(conf, switch, arg, pass, info) - let path = processPath(conf, arg, info) + let path = processPath(conf, arg, info, switch) conf.searchPaths.keepItIf(it != path) conf.lazyPaths.keepItIf(it != path) of "nimcache": @@ -555,17 +707,17 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; # refs bug #18674, otherwise `--os:windows` messes up with `--nimcache` set # in config nims files, e.g. via: `import os; switch("nimcache", "/tmp/somedir")` if conf.target.targetOS == osWindows and DirSep == '/': arg = arg.replace('\\', '/') - conf.nimcacheDir = processPath(conf, arg, info, notRelativeToProj=true) + conf.nimcacheDir = processPath(conf, arg, info, switch, notRelativeToProj=true) of "out", "o": expectArg(conf, switch, arg, pass, info) - let f = splitFile(processPath(conf, arg, info, notRelativeToProj=true).string) + let f = splitFile(processPath(conf, arg, info, switch, notRelativeToProj=true).string) conf.outFile = RelativeFile f.name & f.ext conf.outDir = toAbsoluteDir f.dir of "outdir": expectArg(conf, switch, arg, pass, info) - conf.outDir = processPath(conf, arg, info, notRelativeToProj=true) + conf.outDir = processPath(conf, arg, info, switch, notRelativeToProj=true) of "usenimcache": - processOnOffSwitchG(conf, {optUseNimcache}, arg, pass, info) + processOnOffSwitchG(conf, {optUseNimcache}, arg, pass, info, switch) of "docseesrcurl": expectArg(conf, switch, arg, pass, info) conf.docSeeSrcUrl = arg @@ -573,7 +725,10 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; conf.docRoot = if arg.len == 0: docRootDefault else: arg of "backend", "b": let backend = parseEnum(arg.normalize, TBackend.default) - if backend == TBackend.default: localError(conf, info, "invalid backend: '$1'" % arg) + if backend == TBackend.default: + conf.localReport( + info, invalidSwitchValue @["c", "cpp", "js", "objc"]) + conf.backend = backend of "doccmd": conf.docCmd = arg of "define", "d": @@ -596,19 +751,19 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; if pass in {passCmd2, passPP}: addExternalFileToLink(conf, AbsoluteFile arg) of "debuginfo": - processOnOffSwitchG(conf, {optCDebug}, arg, pass, info) + processOnOffSwitchG(conf, {optCDebug}, arg, pass, info, switch) of "embedsrc": - processOnOffSwitchG(conf, {optEmbedOrigSrc}, arg, pass, info) + processOnOffSwitchG(conf, {optEmbedOrigSrc}, arg, pass, info, switch) of "compileonly", "c": - processOnOffSwitchG(conf, {optCompileOnly}, arg, pass, info) + processOnOffSwitchG(conf, {optCompileOnly}, arg, pass, info, switch) of "nolinking": - processOnOffSwitchG(conf, {optNoLinking}, arg, pass, info) + processOnOffSwitchG(conf, {optNoLinking}, arg, pass, info, switch) of "nomain": - processOnOffSwitchG(conf, {optNoMain}, arg, pass, info) + processOnOffSwitchG(conf, {optNoMain}, arg, pass, info, switch) of "forcebuild", "f": - processOnOffSwitchG(conf, {optForceFullMake}, arg, pass, info) + processOnOffSwitchG(conf, {optForceFullMake}, arg, pass, info, switch) of "project": - processOnOffSwitchG(conf, {optWholeProject, optGenIndex}, arg, pass, info) + processOnOffSwitchG(conf, {optWholeProject, optGenIndex}, arg, pass, info, switch) of "gc": if conf.backend == backendJs: return # for: bug #16033 expectArg(conf, switch, arg, pass, info) @@ -649,7 +804,7 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; conf.selectedGC = gcHooks defineSymbol(conf.symbols, "gchooks") incl conf.globalOptions, optSeqDestructors - processOnOffSwitchG(conf, {optSeqDestructors}, arg, pass, info) + processOnOffSwitchG(conf, {optSeqDestructors}, arg, pass, info, switch) if pass in {passCmd2, passPP}: defineSymbol(conf.symbols, "nimSeqsV2") of "go": @@ -662,46 +817,53 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; conf.selectedGC = gcRegions defineSymbol(conf.symbols, "gcregions") of "v2": warningOptionNoop(arg) - else: localError(conf, info, errNoneBoehmRefcExpectedButXFound % arg) + else: + conf.localReport( + info, invalidSwitchValue gcNames) + of "warnings", "w": - if processOnOffSwitchOrList(conf, {optWarns}, arg, pass, info): listWarnings(conf) + if processOnOffSwitchOrList(conf, {optWarns}, arg, pass, info, switch): + listWarnings(conf) of "warning": processSpecificNote(arg, wWarning, pass, info, switch, conf) of "hint": processSpecificNote(arg, wHint, pass, info, switch, conf) of "warningaserror": processSpecificNote(arg, wWarningAsError, pass, info, switch, conf) of "hintaserror": processSpecificNote(arg, wHintAsError, pass, info, switch, conf) of "hints": - if processOnOffSwitchOrList(conf, {optHints}, arg, pass, info): listHints(conf) + if processOnOffSwitchOrList(conf, {optHints}, arg, pass, info, switch): + listHints(conf) of "threadanalysis": if conf.backend == backendJs: discard - else: processOnOffSwitchG(conf, {optThreadAnalysis}, arg, pass, info) - of "stacktrace": processOnOffSwitch(conf, {optStackTrace}, arg, pass, info) - of "stacktracemsgs": processOnOffSwitch(conf, {optStackTraceMsgs}, arg, pass, info) - of "excessivestacktrace": processOnOffSwitchG(conf, {optExcessiveStackTrace}, arg, pass, info) - of "linetrace": processOnOffSwitch(conf, {optLineTrace}, arg, pass, info) + else: processOnOffSwitchG(conf, {optThreadAnalysis}, arg, pass, info, switch) + of "stacktrace": processOnOffSwitch(conf, {optStackTrace}, arg, pass, info, switch) + of "stacktracemsgs": processOnOffSwitch(conf, {optStackTraceMsgs}, arg, pass, info, switch) + of "excessivestacktrace": processOnOffSwitchG(conf, {optExcessiveStackTrace}, arg, pass, info, switch) + of "linetrace": processOnOffSwitch(conf, {optLineTrace}, arg, pass, info, switch) of "debugger": case arg.normalize of "on", "native", "gdb": conf.globalOptions.incl optCDebug - conf.options.incl optLineDir + conf.incl optLineDir #defineSymbol(conf.symbols, "nimTypeNames") # type names are used in gdb pretty printing of "off": conf.globalOptions.excl optCDebug else: - localError(conf, info, "expected native|gdb|on|off but found " & arg) + conf.localReport( + info, invalidSwitchValue @["native", "gdb", "on", "off"]) + of "g": # alias for --debugger:native conf.globalOptions.incl optCDebug - conf.options.incl optLineDir + conf.incl optLineDir #defineSymbol(conf.symbols, "nimTypeNames") # type names are used in gdb pretty printing of "profiler": - processOnOffSwitch(conf, {optProfiler}, arg, pass, info) + processOnOffSwitch(conf, {optProfiler}, arg, pass, info, switch) if optProfiler in conf.options: defineSymbol(conf.symbols, "profiler") else: undefSymbol(conf.symbols, "profiler") of "memtracker": - processOnOffSwitch(conf, {optMemTracker}, arg, pass, info) + processOnOffSwitch(conf, {optMemTracker}, arg, pass, info, switch) if optMemTracker in conf.options: defineSymbol(conf.symbols, "memtracker") else: undefSymbol(conf.symbols, "memtracker") of "hotcodereloading": - processOnOffSwitchG(conf, {optHotCodeReloading}, arg, pass, info) + processOnOffSwitchG(conf, {optHotCodeReloading}, arg, pass, info, switch) if conf.hcrOn: defineSymbol(conf.symbols, "hotcodereloading") defineSymbol(conf.symbols, "useNimRtl") @@ -712,46 +874,50 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; else: undefSymbol(conf.symbols, "hotcodereloading") undefSymbol(conf.symbols, "useNimRtl") - of "checks", "x": processOnOffSwitch(conf, ChecksOptions, arg, pass, info) + of "checks", "x": processOnOffSwitch(conf, ChecksOptions, arg, pass, info, switch) of "floatchecks": - processOnOffSwitch(conf, {optNaNCheck, optInfCheck}, arg, pass, info) - of "infchecks": processOnOffSwitch(conf, {optInfCheck}, arg, pass, info) - of "nanchecks": processOnOffSwitch(conf, {optNaNCheck}, arg, pass, info) - of "objchecks": processOnOffSwitch(conf, {optObjCheck}, arg, pass, info) - of "fieldchecks": processOnOffSwitch(conf, {optFieldCheck}, arg, pass, info) - of "rangechecks": processOnOffSwitch(conf, {optRangeCheck}, arg, pass, info) - of "boundchecks": processOnOffSwitch(conf, {optBoundsCheck}, arg, pass, info) + processOnOffSwitch(conf, {optNaNCheck, optInfCheck}, arg, pass, info, switch) + of "infchecks": processOnOffSwitch(conf, {optInfCheck}, arg, pass, info, switch) + of "nanchecks": processOnOffSwitch(conf, {optNaNCheck}, arg, pass, info, switch) + of "objchecks": processOnOffSwitch(conf, {optObjCheck}, arg, pass, info, switch) + of "fieldchecks": processOnOffSwitch(conf, {optFieldCheck}, arg, pass, info, switch) + of "rangechecks": processOnOffSwitch(conf, {optRangeCheck}, arg, pass, info, switch) + of "boundchecks": processOnOffSwitch(conf, {optBoundsCheck}, arg, pass, info, switch) of "refchecks": - warningDeprecated(conf, info, "refchecks is deprecated!") - processOnOffSwitch(conf, {optRefCheck}, arg, pass, info) - of "overflowchecks": processOnOffSwitch(conf, {optOverflowCheck}, arg, pass, info) - of "staticboundchecks": processOnOffSwitch(conf, {optStaticBoundsCheck}, arg, pass, info) - of "stylechecks": processOnOffSwitch(conf, {optStyleCheck}, arg, pass, info) - of "linedir": processOnOffSwitch(conf, {optLineDir}, arg, pass, info) - of "assertions", "a": processOnOffSwitch(conf, {optAssert}, arg, pass, info) + processOnOffSwitch(conf, {optRefCheck}, arg, pass, info, switch) + of "overflowchecks": processOnOffSwitch(conf, {optOverflowCheck}, arg, pass, info, switch) + of "staticboundchecks": processOnOffSwitch(conf, {optStaticBoundsCheck}, arg, pass, info, switch) + of "stylechecks": processOnOffSwitch(conf, {optStyleCheck}, arg, pass, info, switch) + of "linedir": processOnOffSwitch(conf, {optLineDir}, arg, pass, info, switch) + of "assertions", "a": processOnOffSwitch(conf, {optAssert}, arg, pass, info, switch) of "threads": if conf.backend == backendJs: discard - else: processOnOffSwitchG(conf, {optThreads}, arg, pass, info) + else: processOnOffSwitchG(conf, {optThreads}, arg, pass, info, switch) #if optThreads in conf.globalOptions: conf.setNote(warnGcUnsafe) - of "tlsemulation": processOnOffSwitchG(conf, {optTlsEmulation}, arg, pass, info) + of "tlsemulation": processOnOffSwitchG(conf, {optTlsEmulation}, arg, pass, info, switch) of "implicitstatic": - processOnOffSwitch(conf, {optImplicitStatic}, arg, pass, info) + processOnOffSwitch(conf, {optImplicitStatic}, arg, pass, info, switch) of "patterns", "trmacros": if switch.normalize == "patterns": deprecatedAlias(switch, "trmacros") - processOnOffSwitch(conf, {optTrMacros}, arg, pass, info) + processOnOffSwitch(conf, {optTrMacros}, arg, pass, info, switch) of "opt": expectArg(conf, switch, arg, pass, info) case arg.normalize of "speed": - incl(conf.options, optOptimizeSpeed) - excl(conf.options, optOptimizeSize) + incl(conf, optOptimizeSpeed) + excl(conf, optOptimizeSize) of "size": - excl(conf.options, optOptimizeSpeed) - incl(conf.options, optOptimizeSize) + excl(conf, optOptimizeSpeed) + incl(conf, optOptimizeSize) of "none": - excl(conf.options, optOptimizeSpeed) - excl(conf.options, optOptimizeSize) - else: localError(conf, info, errNoneSpeedOrSizeExpectedButXFound % arg) + excl(conf, optOptimizeSpeed) + excl(conf, optOptimizeSize) + else: + conf.localReport(info, ExternalReport( + kind: rextInvalidValue, + cmdlineProvided: arg, + cmdlineAllowed: @["speed", "size", "none"], + cmdlineSwitch: switch)) of "app": expectArg(conf, switch, arg, pass, info) case arg.normalize @@ -773,7 +939,9 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; excl(conf.globalOptions, optGenGuiApp) defineSymbol(conf.symbols, "library") defineSymbol(conf.symbols, "staticlib") - else: localError(conf, info, errGuiConsoleOrLibExpectedButXFound % arg) + else: + conf.localReport( + info, invalidSwitchValue @["gui", "console", "lib", "staticlib"]) of "passc", "t": expectArg(conf, switch, arg, pass, info) if pass in {passCmd2, passPP}: extccomp.addCompileOptionCmd(conf, arg) @@ -782,19 +950,21 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; if pass in {passCmd2, passPP}: extccomp.addLinkOptionCmd(conf, arg) of "cincludes": expectArg(conf, switch, arg, pass, info) - if pass in {passCmd2, passPP}: conf.cIncludes.add processPath(conf, arg, info) + if pass in {passCmd2, passPP}: + conf.cIncludes.add processPath(conf, arg, info, switch) of "clibdir": expectArg(conf, switch, arg, pass, info) - if pass in {passCmd2, passPP}: conf.cLibs.add processPath(conf, arg, info) + if pass in {passCmd2, passPP}: + conf.cLibs.add processPath(conf, arg, info, switch) of "clib": expectArg(conf, switch, arg, pass, info) if pass in {passCmd2, passPP}: - conf.cLinkedLibs.add processPath(conf, arg, info).string + conf.cLinkedLibs.add processPath(conf, arg, info, switch).string of "header": if conf != nil: conf.headerFile = arg incl(conf.globalOptions, optGenIndex) of "index": - processOnOffSwitchG(conf, {optGenIndex}, arg, pass, info) + processOnOffSwitchG(conf, {optGenIndex}, arg, pass, info, switch) of "import": expectArg(conf, switch, arg, pass, info) if pass in {passCmd2, passPP}: @@ -804,29 +974,30 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; if pass in {passCmd2, passPP}: conf.implicitIncludes.add findModule(conf, arg, toFullPath(conf, info)).string of "listcmd": - processOnOffSwitchG(conf, {optListCmd}, arg, pass, info) + processOnOffSwitchG(conf, {optListCmd}, arg, pass, info, switch) of "asm": - processOnOffSwitchG(conf, {optProduceAsm}, arg, pass, info) + processOnOffSwitchG(conf, {optProduceAsm}, arg, pass, info, switch) of "genmapping": - processOnOffSwitchG(conf, {optGenMapping}, arg, pass, info) + processOnOffSwitchG(conf, {optGenMapping}, arg, pass, info, switch) of "os": expectArg(conf, switch, arg, pass, info) let theOS = platform.nameToOS(arg) if theOS == osNone: - let osList = platform.listOSnames().join(", ") - localError(conf, info, "unknown OS: '$1'. Available options are: $2" % [arg, $osList]) + conf.localReport( + info, invalidSwitchValue platform.listOSnames()) else: setTarget(conf.target, theOS, conf.target.targetCPU) of "cpu": expectArg(conf, switch, arg, pass, info) let cpu = platform.nameToCPU(arg) if cpu == cpuNone: - let cpuList = platform.listCPUnames().join(", ") - localError(conf, info, "unknown CPU: '$1'. Available options are: $2" % [ arg, cpuList]) + conf.localReport( + info, invalidSwitchValue platform.listCPUnames()) + else: setTarget(conf.target, conf.target.targetOS, cpu) of "run", "r": - processOnOffSwitchG(conf, {optRun}, arg, pass, info) + processOnOffSwitchG(conf, {optRun}, arg, pass, info, switch) of "maxloopiterationsvm": expectArg(conf, switch, arg, pass, info) conf.maxLoopIterationsVM = parseInt(arg) @@ -841,10 +1012,11 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; of "verbosity": expectArg(conf, switch, arg, pass, info) let verbosity = parseInt(arg) - if verbosity notin {0..3}: - localError(conf, info, "invalid verbosity level: '$1'" % arg) + if verbosity notin {0 .. 3}: + conf.localReport( + info, invalidSwitchValue @["0", "1", "2", "3"]) conf.verbosity = verbosity - var verb = NotesVerbosity[conf.verbosity] + var verb = NotesVerbosity.main[conf.verbosity] ## We override the default `verb` by explicitly modified (set/unset) notes. conf.notes = (conf.modifiedyNotes * conf.notes + verb) - (conf.modifiedyNotes * verb - conf.notes) @@ -875,24 +1047,26 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; of "readonly": conf.symbolFiles = readOnlySf of "v2": conf.symbolFiles = v2Sf of "stress": conf.symbolFiles = stressTest - else: localError(conf, info, "invalid option for --incremental: " & arg) + else: + conf.localReport( + info, invalidSwitchValue @["on", "off", "writeonly", "readonly", "v2", "stress"]) setUseIc(conf.symbolFiles != disabledSf) of "skipcfg": - processOnOffSwitchG(conf, {optSkipSystemConfigFile}, arg, pass, info) + processOnOffSwitchG(conf, {optSkipSystemConfigFile}, arg, pass, info, switch) of "skipprojcfg": - processOnOffSwitchG(conf, {optSkipProjConfigFile}, arg, pass, info) + processOnOffSwitchG(conf, {optSkipProjConfigFile}, arg, pass, info, switch) of "skipusercfg": - processOnOffSwitchG(conf, {optSkipUserConfigFile}, arg, pass, info) + processOnOffSwitchG(conf, {optSkipUserConfigFile}, arg, pass, info, switch) of "skipparentcfg": - processOnOffSwitchG(conf, {optSkipParentConfigFiles}, arg, pass, info) + processOnOffSwitchG(conf, {optSkipParentConfigFiles}, arg, pass, info, switch) of "genscript", "gendeps": if switch.normalize == "gendeps": deprecatedAlias(switch, "genscript") - processOnOffSwitchG(conf, {optGenScript}, arg, pass, info) - processOnOffSwitchG(conf, {optCompileOnly}, arg, pass, info) - of "colors": processOnOffSwitchG(conf, {optUseColors}, arg, pass, info) + processOnOffSwitchG(conf, {optGenScript}, arg, pass, info, switch) + processOnOffSwitchG(conf, {optCompileOnly}, arg, pass, info, switch) + of "colors": processOnOffSwitchG(conf, {optUseColors}, arg, pass, info, switch) of "lib": expectArg(conf, switch, arg, pass, info) - conf.libpath = processPath(conf, arg, info, notRelativeToProj=true) + conf.libpath = processPath(conf, arg, info, switch, notRelativeToProj=true) of "putenv": expectArg(conf, switch, arg, pass, info) splitSwitch(conf, arg, key, val, pass, info) @@ -922,23 +1096,26 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; expectArg(conf, switch, arg, pass, info) trackIde(conf, ideDus, arg, info) of "stdout": - processOnOffSwitchG(conf, {optStdout}, arg, pass, info) + processOnOffSwitchG(conf, {optStdout}, arg, pass, info, switch) of "filenames": case arg.normalize of "abs": conf.filenameOption = foAbs of "canonical": conf.filenameOption = foCanonical of "legacyrelproj": conf.filenameOption = foLegacyRelProj - else: localError(conf, info, "expected: abs|canonical|legacyRelProj, got: $1" % arg) + else: + conf.localReport(info, invalidSwitchValue @["abs", "canonical", "legacyRelProj"]) + of "processing": - incl(conf.notes, hintProcessing) - incl(conf.mainPackageNotes, hintProcessing) + incl(conf, cnCurrent, rsemProcessing) + incl(conf, cnMainPackage, rsemProcessing) case arg.normalize of "dots": conf.hintProcessingDots = true of "filenames": conf.hintProcessingDots = false of "off": - excl(conf.notes, hintProcessing) - excl(conf.mainPackageNotes, hintProcessing) - else: localError(conf, info, "expected: dots|filenames|off, got: $1" % arg) + excl(conf, cnCurrent, rsemProcessing) + excl(conf, cnMainPackage, rsemProcessing) + else: + conf.localReport(info, invalidSwitchValue @["dots", "filenames", "off"]) of "unitsep": conf.unitSep = if switchOn(arg): "\31" else: "" of "listfullpaths": @@ -949,11 +1126,11 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; elif arg == "auto": conf.spellSuggestMax = spellSuggestSecretSauce else: conf.spellSuggestMax = parseInt(arg) of "declaredlocs": - processOnOffSwitchG(conf, {optDeclaredLocs}, arg, pass, info) + processOnOffSwitchG(conf, {optDeclaredLocs}, arg, pass, info, switch) of "dynliboverride": dynlibOverride(conf, switch, arg, pass, info) of "dynliboverrideall": - processOnOffSwitchG(conf, {optDynlibOverrideAll}, arg, pass, info) + processOnOffSwitchG(conf, {optDynlibOverrideAll}, arg, pass, info, switch) of "experimental": if arg.len == 0: conf.features.incl oldExperimentalFeatures @@ -961,12 +1138,18 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; try: conf.features.incl parseEnum[Feature](arg) except ValueError: - localError(conf, info, "unknown experimental feature") + conf.localReport( + info, invalidSwitchValue( + getEnumNames({low(Feature) .. high(Feature)}), + "unknown experimental feature")) of "legacy": try: conf.legacyFeatures.incl parseEnum[LegacyFeature](arg) except ValueError: - localError(conf, info, "unknown obsolete feature") + conf.localReport( + info, invalidSwitchValue( + getEnumNames({low(LegacyFeature) .. high(LegacyFeature)}), + "unknown obsolete feature")) of "nocppexceptions": expectNoArg(conf, switch, arg, pass, info) conf.exc = low(ExceptionSystem) @@ -977,13 +1160,13 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; of "setjmp": conf.exc = excSetjmp of "quirky": conf.exc = excQuirky of "goto": conf.exc = excGoto - else: localError(conf, info, errInvalidExceptionSystem % arg) + else: + conf.localReport(info, invalidSwitchValue @["cpp", "setjmp", "quirky", "goto"]) of "cppdefine": expectArg(conf, switch, arg, pass, info) if conf != nil: conf.cppDefine(arg) of "newruntime": - warningDeprecated(conf, info, "newruntime is deprecated, use arc/orc instead!") expectNoArg(conf, switch, arg, pass, info) if pass in {passCmd2, passPP}: doAssert(conf != nil) @@ -997,7 +1180,7 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; defineSymbol(conf.symbols, "nimSeqsV2") defineSymbol(conf.symbols, "nimOwnedEnabled") of "seqsv2": - processOnOffSwitchG(conf, {optSeqDestructors}, arg, pass, info) + processOnOffSwitchG(conf, {optSeqDestructors}, arg, pass, info, switch) if pass in {passCmd2, passPP}: defineSymbol(conf.symbols, "nimSeqsV2") of "stylecheck": @@ -1006,9 +1189,10 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; of "hint": conf.globalOptions = conf.globalOptions + {optStyleHint} - {optStyleError} of "error": conf.globalOptions = conf.globalOptions + {optStyleError} of "usages": conf.globalOptions.incl optStyleUsages - else: localError(conf, info, errOffHintsError % arg) + else: + conf.localReport(info, invalidSwitchValue @["off", "hint", "error", "usages"]) of "showallmismatches": - processOnOffSwitchG(conf, {optShowAllMismatches}, arg, pass, info) + processOnOffSwitchG(conf, {optShowAllMismatches}, arg, pass, info, switch) of "cppcompiletonamespace": if arg.len > 0: conf.cppCustomNamespace = arg @@ -1016,9 +1200,9 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; conf.cppCustomNamespace = "Nim" defineSymbol(conf.symbols, "cppCompileToNamespace", conf.cppCustomNamespace) of "docinternal": - processOnOffSwitchG(conf, {optDocInternal}, arg, pass, info) + processOnOffSwitchG(conf, {optDocInternal}, arg, pass, info, switch) of "multimethods": - processOnOffSwitchG(conf, {optMultiMethods}, arg, pass, info) + processOnOffSwitchG(conf, {optMultiMethods}, arg, pass, info, switch) of "expandmacro": expectArg(conf, switch, arg, pass, info) conf.macrosToExpand[arg] = "T" @@ -1041,30 +1225,34 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; defineSymbol(conf.symbols, "NimMinor", "2") conf.globalOptions.incl optNimV12Emulation else: - localError(conf, info, "unknown Nim version; currently supported values are: `1.0`, `1.2`") + conf.localReport(info, invalidSwitchValue( + @["1.0", "1.2"], + "unknown Nim version; currently supported values are: `1.0`, `1.2`")) # always be compatible with 1.x.100: defineSymbol(conf.symbols, "NimPatch", "100") of "benchmarkvm": - processOnOffSwitchG(conf, {optBenchmarkVM}, arg, pass, info) + processOnOffSwitchG(conf, {optBenchmarkVM}, arg, pass, info, switch) of "profilevm": - processOnOffSwitchG(conf, {optProfileVM}, arg, pass, info) + processOnOffSwitchG(conf, {optProfileVM}, arg, pass, info, switch) of "sinkinference": - processOnOffSwitch(conf, {optSinkInference}, arg, pass, info) + processOnOffSwitch(conf, {optSinkInference}, arg, pass, info, switch) of "cursorinference": # undocumented, for debugging purposes only: - processOnOffSwitch(conf, {optCursorInference}, arg, pass, info) + processOnOffSwitch(conf, {optCursorInference}, arg, pass, info, switch) of "panics": - processOnOffSwitchG(conf, {optPanics}, arg, pass, info) + processOnOffSwitchG(conf, {optPanics}, arg, pass, info, switch) if optPanics in conf.globalOptions: defineSymbol(conf.symbols, "nimPanics") of "sourcemap": # xxx document in --fullhelp conf.globalOptions.incl optSourcemap - conf.options.incl optLineDir + conf.incl optLineDir of "deepcopy": - processOnOffSwitchG(conf, {optEnableDeepCopy}, arg, pass, info) + processOnOffSwitchG(conf, {optEnableDeepCopy}, arg, pass, info, switch) of "": # comes from "-" in for example: `nim c -r -` (gets stripped from -) handleStdinInput(conf) - of "nilseqs", "nilchecks", "mainmodule", "m", "symbol", "taintmode", "cs", "deadcodeelim": warningOptionNoop(switch) + of "nilseqs", "nilchecks", "mainmodule", "m", "symbol", "taintmode", + "cs", "deadcodeelim": + warningOptionNoop(switch) else: if strutils.find(switch, '.') >= 0: options.setConfigVar(conf, switch, arg) else: invalidCmdLineOption(conf, pass, switch, info) @@ -1107,3 +1295,53 @@ proc processArgument*(pass: TCmdLinePass; p: OptParser; config.arguments = cmdLineRest(p) result = true inc argsCount + +proc addCmdPrefix*(result: var string, kind: CmdLineKind) = + # consider moving this to std/parseopt + case kind + of cmdLongOption: result.add "--" + of cmdShortOption: result.add "-" + of cmdArgument, cmdEnd: discard + +proc processCmdLine*(pass: TCmdLinePass, cmd: string; config: ConfigRef) = + ## Process input command-line parameters into `config` settings + var p = parseopt.initOptParser(cmd) + var argsCount = 0 + + config.commandLine.setLen 0 + # bugfix: otherwise, config.commandLine ends up duplicated + + while true: + parseopt.next(p) + case p.kind: + of cmdEnd: break + of cmdLongOption, cmdShortOption: + config.commandLine.add " " + config.commandLine.addCmdPrefix p.kind + config.commandLine.add p.key.quoteShell # quoteShell to be future proof + if p.val.len > 0: + config.commandLine.add ':' + config.commandLine.add p.val.quoteShell + + if p.key == "": # `-` was passed to indicate main project is stdin + p.key = "-" + if processArgument(pass, p, argsCount, config): + break + + else: + # Main part of the configuration processing - + # `commands.processSwitch` processes input switches a second time + # and puts them in necessary configuration fields. + processSwitch(pass, p, config) + + of cmdArgument: + config.commandLine.add " " + config.commandLine.add p.key.quoteShell + if processArgument(pass, p, argsCount, config): + break + + if pass == passCmd2: + if {optRun, optWasNimscript} * config.globalOptions == {} and + config.arguments.len > 0 and config.cmd notin { + cmdTcc, cmdNimscript, cmdCrun}: + localReport(config, ExternalReport(kind: rextExpectedRunOptForArgs)) diff --git a/compiler/concepts.nim b/compiler/concepts.nim index 885b69c600d..384d90377d0 100644 --- a/compiler/concepts.nim +++ b/compiler/concepts.nim @@ -11,7 +11,8 @@ ## 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, intsets +import ast, astalgo, semdata, lookups, lineinfos, idents, + msgs, renderer, types, intsets, reports from magicsys import addSonSkipIntLit @@ -59,7 +60,8 @@ proc semConceptDecl(c: PContext; n: PNode): PNode = result[i] = n[i] result[^1] = semConceptDecl(c, n[^1]) else: - localError(c.config, n.info, "unexpected construct in the new-styled concept: " & renderTree(n)) + c.config.localReport(n.info, reportAst( + rsemUnexpectedInNewConcept, n)) result = n proc semConceptDeclaration*(c: PContext; n: PNode): PNode = diff --git a/compiler/condsyms.nim b/compiler/condsyms.nim index e42cd8dfaec..9c0d64fc53f 100644 --- a/compiler/condsyms.nim +++ b/compiler/condsyms.nim @@ -13,7 +13,7 @@ import strtabs from options import Feature -from lineinfos import hintMin, hintMax, warnMin, warnMax +import reports proc defineSymbol*(symbols: StringTableRef; symbol: string, value: string = "true") = symbols[symbol] = value @@ -91,9 +91,10 @@ proc initDefines*(symbols: StringTableRef) = for f in Feature: defineSymbol("nimHas" & $f) - for s in warnMin..warnMax: + for s in repWarningKinds: defineSymbol("nimHasWarning" & $s) - for s in hintMin..hintMax: + + for s in repHintKinds: defineSymbol("nimHasHint" & $s) defineSymbol("nimFixedOwned") @@ -138,4 +139,4 @@ proc initDefines*(symbols: StringTableRef) = defineSymbol("nimHasHintAll") defineSymbol("nimHasTrace") defineSymbol("nimHasEffectsOf") - defineSymbol("nimHasEnforceNoRaises") \ No newline at end of file + defineSymbol("nimHasEnforceNoRaises") diff --git a/compiler/debugutils.nim b/compiler/debugutils.nim index 7ae74eb08fb..ea56b9bb38a 100644 --- a/compiler/debugutils.nim +++ b/compiler/debugutils.nim @@ -10,15 +10,9 @@ useful debugging flags: --stacktrace -d:debug -d:nimDebugUtils nim c -o:bin/nim_temp --stacktrace -d:debug -d:nimDebugUtils compiler/nim -## future work -* expose and improve astalgo.debug, replacing it by std/prettyprints, - refs https://github.com/nim-lang/RFCs/issues/385 ]# -when not defined(nimDebugUtils): - {.error: "`nimDebugUtils` was not defined, set via -`d:nimDebugUtils`".} - -import options +import options, reports, msgs proc isCompilerDebug*(conf: ConfigRef): bool {.inline.} = ##[ @@ -37,3 +31,276 @@ proc isCompilerDebug*(conf: ConfigRef): bool {.inline.} = {.undef(nimCompilerDebug).} echo 'x' conf.isDefined("nimCompilerDebug") + +template addInNimDebugUtilsAux(conf: ConfigRef; prcname: string; + enterMsg, leaveMsg) = + ## used by one of the dedicated templates in order to output compiler trace + ## data, use a dedicated template (see below) for actual output. this is a + ## helper that takes three templates, `enterMsg`, `leaveMsg`, and `getInfo` + ## that will emit a message when entering and leaving a proc, and getting + ## the string out of some lineinfo, respectively. + ## + ## The dedicate templates take specific parameters and pass in the above + ## templates with the following signatures: + ## * enterMsg: indent: string -> string + ## * leaveMsg: indent: string -> string + ## + ## once a specialized template exists, again see below, use at the start of a + ## proc, typically a high traffic one such as `semExpr` and then this will + ## output partial traces through the compiler. + ## + ## The output is roughly: + ## 1. begin message with starting location + ## a. a full stacktrace for context + ## 2. for each proc (nests): + ## a. `>prcname plus useful info...` + ## b. delta stack trace `| procname filepath(line, col)` + ## c. ` PNode`, with expr flags + ## and can determine the type + when defined(nimDebugUtils): + template enterMsg(indentLevel: int) = + handleReport(c, wrap(instLoc(instDepth), DebugReport( + kind: rdbgTraceStep, + semstep: DebugSemStep( + direction: semstepEnter, + level: indentLevel, + name: action, + steppedFrom: calledFromInfo(), + node: r, + kind: stepNodeFlagsToNode, + flags: flags))), instLoc(instDepth)) + + template leaveMsg(indentLevel: int) = + handleReport(c, wrap(instLoc(instDepth), DebugReport( + kind: rdbgTraceStep, + semstep: DebugSemStep( + direction: semstepLeave, + level: indentLevel, + name: action, + steppedFrom: calledFromInfo(), + node: r, + kind: stepNodeFlagsToNode, + flags: flags))), instLoc(instDepth)) + + addInNimDebugUtilsAux(c, action, enterMsg, leaveMsg) + +template addInNimDebugUtils*(c: ConfigRef; action: string; n, r: PNode) = + ## add tracing to procs that are primarily `PNode -> PNode`, and can + ## determine the type + + when defined(nimDebugUtils): + template enterMsg(indentLevel: int) = + handleReport(c, wrap(instLoc(instDepth), DebugReport( + kind: rdbgTraceStep, + semstep: DebugSemStep( + direction: semstepEnter, + level: indentLevel, + name: action, + steppedFrom: calledFromInfo(), + node: n, + kind: stepNodeToNode))), instLoc(instDepth)) + + template leaveMsg(indentLevel: int) = + handleReport(c, wrap(instLoc(instDepth), DebugReport( + kind: rdbgTraceStep, + semstep: DebugSemStep( + direction: semstepLeave, + level: indentLevel, + name: action, + steppedFrom: calledFromInfo(), + node: r, + kind: stepNodeToNode))), instLoc(instDepth)) + + addInNimDebugUtilsAux(c, action, enterMsg, leaveMsg) + +template addInNimDebugUtilsError*(c: ConfigRef; n, e: PNode) = + ## add tracing error generation `PNode -> PNode` + + when defined(nimDebugUtils): + const action = "newError" + template enterMsg(indentLevel: int) = + handleReport(c, wrap(instLoc(instDepth), DebugReport( + kind: rdbgTraceStep, + semstep: DebugSemStep( + direction: semstepEnter, + level: indentLevel, + name: action, + steppedFrom: calledFromInfo(), + node: n, + kind: stepWrongNode))), instLoc(instDepth)) + + template leaveMsg(indentLevel: int) = + handleReport(c, wrap(instLoc(instDepth), DebugReport( + kind: rdbgTraceStep, + semstep: DebugSemStep( + direction: semstepLeave, + level: indentLevel, + name: action, + steppedFrom: calledFromInfo(), + node: e, + kind: stepError))), instLoc(instDepth)) + + addInNimDebugUtilsAux(c, action, enterMsg, leaveMsg) + +template addInNimDebugUtils*(c: ConfigRef; action: string; n: PNode; + prev, r: PType) = + ## add tracing to procs that are primarily `PNode, PType|nil -> PType`, + ## determining a type node, with a possible previous type. + + when defined(nimDebugUtils): + template enterMsg(indentLevel: int) = + handleReport(c, wrap(instLoc(instDepth), DebugReport( + kind: rdbgTraceStep, + semstep: DebugSemStep( + direction: semstepEnter, + level: indentLevel, + name: action, + steppedFrom: calledFromInfo(), + node: n, + typ: prev, + kind: stepNodeTypeToNode))), instLoc(instDepth)) + + template leaveMsg(indentLevel: int) = + handleReport(c, wrap(instLoc(instDepth), DebugReport( + kind: rdbgTraceStep, + semstep: DebugSemStep( + direction: semstepLeave, + level: indentLevel, + name: action, + steppedFrom: calledFromInfo(), + node: n, + typ: r, + kind: stepNodeTypeToNode))), instLoc(instDepth)) + + addInNimDebugUtilsAux(c, action, enterMsg, leaveMsg) + +template addInNimDebugUtils*(c: ConfigRef; action: string; x, y, r: PType) = + ## add tracing to procs that are primarily `PType, PType -> PType`, looking + ## for a common type + when defined(nimDebugUtils): + template enterMsg(indentLevel: int) = + handleReport(c, wrap(instLoc(instDepth), DebugReport( + kind: rdbgTraceStep, + semstep: DebugSemStep( + direction: semstepEnter, + level: indentLevel, + name: action, + steppedFrom: calledFromInfo(), + typ: x, + typ1: y, + kind: stepTypeTypeToType))), instLoc(instDepth)) + + template leaveMsg(indentLevel: int) = + handleReport(c, wrap(instLoc(instDepth), DebugReport( + kind: rdbgTraceStep, + semstep: DebugSemStep( + direction: semstepLeave, + level: indentLevel, + name: action, + steppedFrom: calledFromInfo(), + typ: r, + kind: stepTypeTypeToType))), instLoc(instDepth)) + + addInNimDebugUtilsAux(c, action, enterMsg, leaveMsg) + +template addInNimDebugUtils*(c: ConfigRef; action: string) = + ## add tracing to procs that are primarily `PType, PType -> PType`, looking + ## for a common type + when defined(nimDebugUtils): + template enterMsg(indentLevel: int) = + handleReport(c, wrap(instLoc(instDepth), DebugReport( + kind: rdbgTraceStep, + semstep: DebugSemStep( + direction: semstepEnter, + steppedFrom: calledFromInfo(), + level: indentLevel, name: action, + kind: stepTrack))), instLoc(instDepth)) + + template leaveMsg(indentLevel: int) = + handleReport(c, wrap(instLoc(instDepth), DebugReport( + kind: rdbgTraceStep, + semstep: DebugSemStep( + direction: semstepLeave, + steppedFrom: calledFromInfo(), + level: indentLevel, name: action, + kind: stepTrack))), instLoc(instDepth)) + + addInNimDebugUtilsAux(c, action, enterMsg, leaveMsg) diff --git a/compiler/depends.nim b/compiler/depends.nim index 30fc961c52d..98a2f723611 100644 --- a/compiler/depends.nim +++ b/compiler/depends.nim @@ -10,7 +10,7 @@ # This module implements a dependency file generator. import - options, ast, ropes, idents, passes, modulepaths, pathutils + options, ast, ropes, passes, modulepaths, pathutils from modulegraphs import ModuleGraph, PPassContext @@ -65,4 +65,3 @@ proc myOpen(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext result = g const gendependPass* = makePass(open = myOpen, process = addDotDependency) - diff --git a/compiler/dfa.nim b/compiler/dfa.nim index 0539f6699bf..7e7fb4d91f5 100644 --- a/compiler/dfa.nim +++ b/compiler/dfa.nim @@ -29,7 +29,7 @@ ## "A Graph–Free Approach to Data–Flow Analysis" by Markus Mohnen. ## https://link.springer.com/content/pdf/10.1007/3-540-45937-5_6.pdf -import ast, intsets, lineinfos, renderer +import ast, intsets, renderer import std/private/asciitables type diff --git a/compiler/docgen.nim b/compiler/docgen.nim index 1acfc7489e1..0944cc136ce 100644 --- a/compiler/docgen.nim +++ b/compiler/docgen.nim @@ -16,7 +16,8 @@ import packages/docutils/rst, packages/docutils/rstgen, json, xmltree, trees, types, typesrenderer, astalgo, lineinfos, intsets, - pathutils, tables, nimpaths, renderverbatim, osproc + pathutils, tables, nimpaths, renderverbatim, osproc, reports + import packages/docutils/rstast except FileIndex, TLineInfo from uri import encodeUrl @@ -173,8 +174,8 @@ proc presentationPath*(conf: ConfigRef, file: AbsoluteFile): RelativeFile = elif conf.docRoot.len > 0: # we're (currently) requiring `isAbsolute` to avoid confusion when passing # a relative path (would it be relative with regard to $PWD or to projectfile) - conf.globalAssert conf.docRoot.isAbsolute, arg=conf.docRoot - conf.globalAssert conf.docRoot.dirExists, arg=conf.docRoot + conf.internalAssert(conf.docRoot.isAbsolute, conf.docRoot) + conf.internalAssert(conf.docRoot.dirExists, conf.docRoot) # needed because `canonicalizePath` called on `file` result = file.relativeTo conf.docRoot.expandFilename.AbsoluteDir else: @@ -207,28 +208,32 @@ proc attachToType(d: PDoc; p: PSym): PSym = for i in 2.. 3: globalError(d.conf, n.info, "runnableExamples invalid") + if n.len < 2 or 3 < n.len: + internalError(d.conf, n.info, "runnableExamples invalid") + if n.len == 3: let n1 = n[1] # xxx this should be evaluated during sempass - if n1.kind notin nkStrKinds: globalError(d.conf, n1.info, "string litteral expected") + if n1.kind notin nkStrKinds: + globalReport(d.conf, n1.info, reportAst( + rsemStringLiteralExpected, n1)) + rdoccmd = n1.strVal let useRenderModule = false @@ -658,7 +674,9 @@ proc getAllRunnableExamplesImpl(d: PDoc; n: PNode, dest: var ItemPre, dest.add(d.config.getOrDefault"doc.listing_end" % id) return rsRunnable else: - localError(d.conf, n.info, errUser, "runnableExamples must appear before the first non-comment statement") + localReport(d.conf, n.info, reportAst( + rsemMisplacedRunnableExample, n)) + else: discard return rsDone # change this to `rsStart` if you want to keep generating doc comments @@ -1438,8 +1456,9 @@ proc writeOutput*(d: PDoc, useWarning = false, groupedToc = false) = try: writeFile(outfile, content) except IOError: - rawMessage(d.conf, if useWarning: warnCannotOpenFile else: errCannotOpenFile, - outfile.string) + localReport(d.conf, InternalReport( + kind: rintCannotOpenFile, msg: outfile.string)) + if not d.wroteSupportFiles: # nimdoc.css + dochack.js let nimr = $d.conf.getPrefixDir() copyFile(docCss.interp(nimr = nimr), $d.conf.outDir / nimdocOutCss) @@ -1466,9 +1485,10 @@ proc writeOutputJson*(d: PDoc, useWarning = false) = close(f) updateOutfile(d, d.destFile.AbsoluteFile) else: - localError(d.conf, newLineInfo(d.conf, AbsoluteFile d.filename, -1, -1), - warnUser, "unable to open file \"" & d.destFile & - "\" for writing") + localReport( + d.conf, + newLineInfo(d.conf, AbsoluteFile d.filename, -1, -1), + InternalReport(kind: rintCannotOpenFile, msg: d.destFile)) proc handleDocOutputOptions*(conf: ConfigRef) = if optWholeProject in conf.globalOptions: @@ -1514,8 +1534,9 @@ proc commandJson*(cache: IdentCache, conf: ConfigRef) = var d = newDocumentor(conf.projectFull, cache, conf) d.onTestSnippet = proc (d: var RstGenerator; filename, cmd: string; status: int; content: string) = - localError(conf, newLineInfo(conf, AbsoluteFile d.filename, -1, -1), - warnUser, "the ':test:' attribute is not supported by this backend") + localReport(conf, newLineInfo(conf, AbsoluteFile d.filename, -1, -1), + BackendReport(kind: rbackRstTestUnsupported)) + d.hasToc = true generateJson(d, ast) finishGenerateDoc(d) @@ -1530,7 +1551,8 @@ proc commandJson*(cache: IdentCache, conf: ConfigRef) = try: writeFile(filename, content) except: - rawMessage(conf, errCannotOpenFile, filename.string) + localReport(conf, InternalReport( + kind: rintCannotOpenFile, msg: filename.string)) proc commandTags*(cache: IdentCache, conf: ConfigRef) = var ast = parseFile(conf.projectMainIdx, cache, conf) @@ -1538,8 +1560,8 @@ proc commandTags*(cache: IdentCache, conf: ConfigRef) = var d = newDocumentor(conf.projectFull, cache, conf) d.onTestSnippet = proc (d: var RstGenerator; filename, cmd: string; status: int; content: string) = - localError(conf, newLineInfo(conf, AbsoluteFile d.filename, -1, -1), - warnUser, "the ':test:' attribute is not supported by this backend") + localReport(conf, newLineInfo(conf, AbsoluteFile d.filename, -1, -1), + BackendReport(kind: rbackRstTestUnsupported)) d.hasToc = true var content = "" @@ -1553,7 +1575,8 @@ proc commandTags*(cache: IdentCache, conf: ConfigRef) = try: writeFile(filename, content) except: - rawMessage(conf, errCannotOpenFile, filename.string) + localReport(conf, InternalReport( + kind: rintCannotOpenFile, msg: filename.string)) proc commandBuildIndex*(conf: ConfigRef, dir: string, outFile = RelativeFile"") = var content = mergeIndexes(dir) @@ -1574,4 +1597,5 @@ proc commandBuildIndex*(conf: ConfigRef, dir: string, outFile = RelativeFile"") try: writeFile(filename, code) except: - rawMessage(conf, errCannotOpenFile, filename.string) + localReport(conf, InternalReport( + kind: rintCannotOpenFile, msg: filename.string)) diff --git a/compiler/errorhandling.nim b/compiler/errorhandling.nim index f07976d9839..7ab63dc249d 100644 --- a/compiler/errorhandling.nim +++ b/compiler/errorhandling.nim @@ -13,17 +13,17 @@ ## An nkError node is used where an error occurs within the AST. Wrap the ast ## node with `newError` and typically take over the position of the wrapped ## node in whatever AST it was in. -## +## ## Internally an nkError node stores these children: ## * 0 - wraps an AST node that has the error ## * 1 - nkIntLit with a value corresponding to `ord(ErrorKind)` ## * 2 - compiler instantiation location info ## * 3 - first argument position, assuming one was provided ## * _ - zero or more nodes with data for the error message -## +## ## The rest of the compiler should watch for nkErrors and mostly no-op or wrap ## further errors as needed. -## +## ## # Future Considerations/Improvements: ## * accomodate for compiler related information like site of node creation to ## make it easier to debug the compiler itself, so we know where a node was @@ -31,95 +31,9 @@ ## * rework internals to store actual error information in a lookup data ## structure on the side instead of directly in the node -import ast -from options import ConfigRef - -type - ErrorKind* {.pure.} = enum ## expand as you need. - CustomError - CustomPrintMsgAndNodeError - ## just like custom error, prints a message and renders wrongNode - RawTypeMismatchError - - CustomUserError - ## just like customer error, but reported as a errUser in msgs - - # Global Errors - CustomGlobalError - ## just like custom error, but treat it like a "raise" and fast track the - ## "graceful" abort of this compilation run, used by `errorreporting` to - ## bridge into the existing `msgs.liMessage` and `msgs.handleError`. - - # Fatal Errors - FatalError - ## treat as a fatal error, meaning we do a less (?) "graceful" abort, - ## used by `errorreporting` to bridge into the existing `msgs.liMessage` - ## and `msgs.handleError`. - ## xxx: with the curren way the errorreporting module works, these must - ## be created via msgs.fatal - - # Call - CallTypeMismatch - ExpressionCannotBeCalled - WrongNumberOfArguments - AmbiguousCall - CallingConventionMismatch - - # ParameterTypeMismatch - - # Identifier Lookup - UndeclaredIdentifier - ExpectedIdentifier - ExpectedIdentifierInExpr - - # Object and Object Construction - FieldNotAccessible - ## object field is not accessible - FieldAssignmentInvalid - ## object field assignment invalid syntax - FieldOkButAssignedValueInvalid - ## object field assignment, where the field name is ok, but value is not - ObjectConstructorIncorrect - ## one or more issues encountered with object constructor - - # General Type Checks - ExpressionHasNoType - ## an expression has not type or is ambiguous - - # Literals - IntLiteralExpected - ## int literal node was expected, but got something else - StringLiteralExpected - ## string literal node was expected, but got something else - - # Pragma - InvalidPragma - ## suplied pragma is invalid - IllegalCustomPragma - ## supplied pragma is not a legal custom pragma, and cannot be attached - NoReturnHasReturn - ## a routine marked as no return, has a return type - ImplicitPragmaError - ## a symbol encountered an error when processing implicit pragmas, this - ## should be applied to symbols and treated as a wrapper for the purposes - ## of reporting. the original symbol is stored as the first argument - PragmaDynlibRequiresExportc - ## much the same as `ImplicitPragmaError`, except it's a special case - ## where dynlib pragma requires an importc pragma to exist on the same - ## symbol - ## xxx: pragmas shouldn't require each other, that's just bad design - - WrappedError - ## there is no meaningful error to construct, but there is an error - ## further down the AST that invalidates the whole - -type InstantiationInfo* = typeof(instantiationInfo()) - ## type alias for instantiation information -template instLoc(depth = -2): InstantiationInfo = - ## grabs where in the compiler an error was instanced to ease debugging. - ## - ## whether to use full paths depends on --excessiveStackTrace compiler option. - instantiationInfo(depth, fullPaths = compileOption"excessiveStackTrace") +import ast, msgs, options +from lineinfos import unknownLineInfo +import reports, debugutils proc errorSubNode*(n: PNode): PNode = ## find the first error node, or nil, under `n` using a depth first traversal @@ -135,18 +49,12 @@ proc errorSubNode*(n: PNode): PNode = result = errorSubNode(s) if result != nil: break -const - wrongNodePos* = 0 ## the ast node we swapped - errorKindPos* = 1 ## the enum as an intlit - compilerInfoPos* = 2 ## compiler source file as strlit, line & col on info - firstArgPos* = 3 ## first 0..n additional nodes depends on error kind - -func errorKind*(e: PNode): ErrorKind {.inline.} = +func errorKind*(e: PNode): SemReportKind {.inline.} = ## property to retrieve the error kind assert e != nil, "can't have a nil error node" assert e.kind == nkError, "must be an error node to have an ErrorKind" - result = ErrorKind(e[errorKindPos].intVal) + result = SemReportKind(e[errorKindPos].intVal) func compilerInstInfo*(e: PNode): InstantiationInfo {.inline.} = ## return where the error was instantiated in the compiler @@ -154,87 +62,81 @@ func compilerInstInfo*(e: PNode): InstantiationInfo {.inline.} = assert i != nil, "we should always have compiler diagnositics" (filename: i.strVal, line: i.info.line.int, column: i.info.col.int) -proc newErrorAux( +proc newError*( + conf: ConfigRef; wrongNode: PNode; - k: ErrorKind; - inst: InstantiationInfo; + errorKind: ReportKind, + report: ReportId, + inst: InstantiationInfo, args: varargs[PNode] ): PNode = - ## create an `nkError` node with error `k`, with additional error `args` and - ## given `inst` as to where it was instanced int he compiler. + ## Create `nkError` node with given error report and additional subnodes. + assert errorKind in repSemKinds assert wrongNode != nil, "can't have a nil node for `wrongNode`" + assert not report.isEmpty(), $report - result = newNodeIT(nkError, wrongNode.info, - newType(tyError, ItemId(module: -2, item: -1), nil)) + result = PNode( + kind: nkError, + info: wrongNode.info, + typ: newType(tyError, ItemId(module: -2, item: -1), nil), + reportId: report + ) - result.add wrongNode - result.add newIntNode(nkIntLit, ord(k)) # errorKindPos - result.add newStrNode(inst.filename, wrongNode.info) # compilerInfoPos + addInNimDebugUtilsError(conf, wrongNode, result) - # save the compiler's line and column information here for reporting - result[compilerInfoPos].info.line = uint16 inst.line - result[compilerInfoPos].info.col = int16 inst.column + result.add #[ 0 ]# wrongNode # wrapped wrong node + result.add #[ 1 ]# newIntNode(nkIntLit, ord(errorKind)) # errorKindPos + result.add #[ 2 ]# newStrNode(inst.filename, TLineInfo( + line: uint16(inst.line), col: int16(inst.column))) # compilerInfoPos - for a in args: result.add a + for a in args: + result.add #[ 3+ ]# a -proc newErrorActual( - wrongNode: PNode; - k: ErrorKind; +proc newError*( + conf: ConfigRef, + wrongNode: PNode, + report: SemReport, inst: InstantiationInfo, - args: varargs[PNode] + args: seq[PNode] = @[], + posInfo: TLineInfo = unknownLineInfo, ): PNode = - ## create an `nkError` node with error `k`, with additional error `args` and - ## given `inst` as to where it was instanced in the compiler. - assert wrongNode != nil, "can't have a nil node for `wrongNode`" - - result = newErrorAux(wrongNode, k, inst, args) - -proc newErrorActual( - wrongNode: PNode; - msg: string, - inst: InstantiationInfo - ): PNode = - ## create an `nkError` node with a `CustomError` message `msg` - newErrorAux( - wrongNode, CustomError, inst, newStrNode(msg, wrongNode.info)) - -template newError*(wrongNode: PNode; k: ErrorKind; args: varargs[PNode]): PNode = - ## create an `nkError` node with error `k`, with additional error `args` and - ## given `inst` as to where it was instanced int he compiler. - assert k != FatalError, - "use semdata.fatal(config:ConfigRef, err: PNode) instead" - newErrorActual(wrongNode, k, instLoc(-1), args) - -template newFatal*(wrongNode: PNode; args: varargs[PNode]): PNode - {.deprecated: "rework to remove the need for this awkward fatal handling".} = - ## just like `newError`, only meant to be used by `semDdta` an and other - ## modules that know to appropriately use `msgs.fatal(ConfigRef, PNode)` as - ## the next call. - newErrorActual(wrongNode, FatalError, - instLoc(-1), args) - -template newError*(wrongNode: PNode; msg: string): PNode = - ## create an `nkError` node with a `CustomError` message `msg` - newErrorActual(wrongNode, msg, instLoc(-1)) -template newCustomErrorMsgAndNode*(wrongNode: PNode; msg: string): PNode = - ## create an `nkError` node with a `CustomMsgError` message `msg` - newErrorActual( - wrongNode, - CustomPrintMsgAndNodeError, - instLoc(-1), - newStrNode(msg, wrongNode.info) - ) - -proc wrapErrorInSubTree*(wrongNodeContainer: PNode): PNode = + var rep = report + if isNil(rep.ast): + rep.ast = wrongNode + + let tmp = wrap( + rep, + inst, + if posInfo == unknownLineInfo: wrongNode.info else: posInfo) + + let id = conf.addReport(tmp) + assert not id.isEmpty(), $id + newError(conf, wrongNode, tmp.semReport.kind, id, inst, args) + +template newError*( + conf: ConfigRef, + wrongNode: PNode, + report: SemReport, + args: seq[PNode] = @[], + posInfo: TLineInfo = unknownLineInfo, + ): untyped = + newError(conf, wrongNode, report, instLoc(), args, posInfo) + +template wrapErrorInSubTree*(conf: ConfigRef, wrongNodeContainer: PNode): PNode = ## `wrongNodeContainer` doesn't directly have an error but one exists further ## down the tree, this is used to wrap the `wrongNodeContainer` in an nkError ## node but no message will be reported for it. var e = errorSubNode(wrongNodeContainer) assert e != nil, "there must be an error node within" - result = newErrorAux(wrongNodeContainer, WrappedError, instLoc()) - -proc wrapIfErrorInSubTree*(wrongNodeContainer: PNode): PNode + newError( + conf, + wrongNodeContainer, + rsemWrappedError, + conf.store reportSem(rsemWrappedError), + instLoc()) + +proc wrapIfErrorInSubTree*(conf: ConfigRef, wrongNodeContainer: PNode): PNode {.deprecated: "transition proc, remove usage as soon as possible".} = ## `wrongNodeContainer` doesn't directly have an error but one may exist ## further down the tree. If an error does exist it will wrap @@ -246,19 +148,24 @@ proc wrapIfErrorInSubTree*(wrongNodeContainer: PNode): PNode if e.isNil: wrongNodeContainer else: - newErrorAux(wrongNodeContainer, WrappedError, instLoc()) - -proc buildErrorList(n: PNode, errs: var seq[PNode]) = + newError( + conf, + wrongNodeContainer, + rsemWrappedError, + conf.store reportSem(rsemWrappedError), + instLoc()) + +proc buildErrorList(config: ConfigRef, n: PNode, errs: var seq[PNode]) = ## creates a list (`errs` seq) from least specific to most specific case n.kind - of nkEmpty..nkNilLit: + of nkEmpty .. nkNilLit: discard of nkError: errs.add n - buildErrorList(n[wrongNodePos], errs) + buildErrorList(config, n[wrongNodePos], errs) else: for i in countdown(n.len - 1, 0): - buildErrorList(n[i], errs) + buildErrorList(config, n[i], errs) iterator walkErrors*(config: ConfigRef; n: PNode): PNode = ## traverses the ast and yields errors from innermost to outermost. this is a @@ -266,13 +173,20 @@ iterator walkErrors*(config: ConfigRef; n: PNode): PNode = ## first error (per `PNode.sons`) being yielded. assert n != nil var errNodes: seq[PNode] = @[] - buildErrorList(n, errNodes) - + buildErrorList(config, n, errNodes) + # report from last to first (deepest in tree to highest) for i in 1..errNodes.len: # reverse index so we go from the innermost to outermost let e = errNodes[^i] - if e.errorKind == WrappedError: continue + if e.errorKind == rsemWrappedError: + continue + + assert( + not e.reportId.isEmpty(), + "Error node of kind" & $e.errorKind & "created in " & + $n.compilerInstInfo() & " has empty report id") + yield e iterator ifErrorWalkErrors*(config: ConfigRef; n: PNode): PNode = diff --git a/compiler/errorreporting.nim b/compiler/errorreporting.nim index a911d27924a..0a62b219312 100644 --- a/compiler/errorreporting.nim +++ b/compiler/errorreporting.nim @@ -13,7 +13,8 @@ ## * write an error reporting proc that handles string conversion and also ## determines which error handling strategy to use doNothing, raise, etc. -import ast, errorhandling, renderer, strutils, astmsgs, types, options +import ast, errorhandling, renderer, reports +from options import ConfigRef from msgs import TErrorHandling export compilerInstInfo, walkErrors, errorKind @@ -26,129 +27,13 @@ proc errorHandling*(err: PNode): TErrorHandling = ## `msg.liMessage` when reporting errors. assert err.isError, "err can't be nil and must be an nkError" case err.errorKind: - of CustomGlobalError: doRaise - of FatalError: doAbort + of rsemCustomGlobalError: doRaise + of rsemFatalError: doAbort else: doNothing -proc `$`(info: InstantiationInfo): string = - ## prints the compiler line info in `filepath(line, column)` format - "$1($2, $3)" % [ info.filename, $info.line.int, $info.column.int ] - -proc errorToString*( - config: ConfigRef; n: PNode, rf = {renderWithoutErrorPrefix} - ): string = - ## converts an error node into a string representation for reporting - - # xxx: note the schema/structure of each error kind - assert n.kind == nkError, "not an error '$1'" % n.renderTree(rf) - assert n.len > 1 - let wrongNode = n[wrongNodePos] - - case ErrorKind(n[errorKindPos].intVal) - of CustomError, CustomGlobalError, CustomUserError: - result = n[firstArgPos].strVal - of CustomPrintMsgAndNodeError: - result = "$1$2" % [ n[firstArgPos].strVal, n[wrongNodePos].renderTree(rf) ] - of RawTypeMismatchError: - result = "type mismatch" - of FatalError: - result = "Fatal: $1" % n[firstArgPos].strVal - of CallTypeMismatch: - result = "type mismatch: got <" - var hasErrorType = false - for i in 1.. 1: result.add(", ") - let nt = wrongNode[i].typ - result.add(typeToString(nt)) - if nt.kind == tyError: - hasErrorType = true - break - if not hasErrorType: - let typ = wrongNode[0].typ - result.add(">\nbut expected one of:\n$1" % typeToString(typ)) - if typ.sym != nil and sfAnon notin typ.sym.flags and typ.kind == tyProc: - # when can `typ.sym != nil` ever happen? - result.add(" = $1" % typeToString(typ, preferDesc)) - result.addDeclaredLocMaybe(config, typ) - of ExpressionCannotBeCalled: - result = "expression '$1' cannot be called" % wrongNode[0].renderTree(rf) - of WrongNumberOfArguments: - result = "wrong number of arguments" - of AmbiguousCall: - let - a = n[firstArgPos].sym - b = n[firstArgPos + 1].sym - var args = "(" - for i in 1.. 1: args.add(", ") - args.add(typeToString(wrongNode[i].typ)) - args.add(")") - result = "ambiguous call; both $1 and $2 match for: $3" % [ - getProcHeader(config, a), - getProcHeader(config, b), - args] - of CallingConventionMismatch: - result = n[firstArgPos].strVal - of UndeclaredIdentifier: - let - identName = n[firstArgPos].strVal - optionalExtraErrMsg = if n.len > firstArgPos + 1: n[firstArgPos + 1].strVal else: "" - result = "undeclared identifier: '$1'$2" % [identName, optionalExtraErrMsg] - of ExpectedIdentifier: - result = "identifier expected, but found '$1'" % wrongNode.renderTree(rf) - of ExpectedIdentifierInExpr: - result = "in expression '$1': identifier expected, but found '$2'" % [ - n[firstArgPos].renderTree(rf), - wrongNode.renderTree(rf) - ] - of FieldNotAccessible: - result = "the field '$1' is not accessible." % n[firstArgPos].sym.name.s - of FieldAssignmentInvalid, FieldOkButAssignedValueInvalid: - let - hasHint = n.len > firstArgPos - hint = if hasHint: "; " & n[firstArgPos].renderTree(rf) else: "" - result = "Invalid field assignment '$1'$2" % [ - wrongNode.renderTree(rf), - hint, - ] - of ObjectConstructorIncorrect: - result = "Invalid object constructor: '$1'" % wrongNode.renderTree(rf) - of ExpressionHasNoType: - result = "expression '$1' has no type (or is ambiguous)" % [ - n[firstArgPos].renderTree(rf) - ] - of StringLiteralExpected: - result = "string literal expected" - of IntLiteralExpected: - result = "int literal expected" - of InvalidPragma: - result = "invalid pragma: $1" % wrongNode.renderTree(rf) - of IllegalCustomPragma: - result = "cannot attach a custom pragma to '$1'" % n[firstArgPos].sym.name.s - of NoReturnHasReturn: - result = ".noreturn with return type not allowed" - of ImplicitPragmaError: - result = "" # treat as a wrapper - of PragmaDynlibRequiresExportc: - result = ".dynlib requires .exportc" - of WrappedError: - result = "" - - # useful for debugging where error nodes are generated - # result = result & " compiler error origin: " & $n.compilerInstInfo() - -template messageError*(config: ConfigRef; err: PNode) = - ## report errors, call this on a per error basis, as you would receive from - ## `errorhandling.walkErrors` - msgs.liMessage( - conf = config, - info = err.info, - msg = - case err.errorKind: - of FatalError: errFatal - of CustomUserError: errUser - else: errGenerated, - arg = errorreporting.errorToString(config, err), - eh = err.errorHandling, - info2 = err.compilerInstInfo - ) \ No newline at end of file +template localReport*(conf: ConfigRef, node: PNode) = + ## Write out existing sem report that is stored in the nkError node + assert node.kind == nkError, $node.kind + for err in walkErrors(conf, node): + if true or canReport(conf, err): + handleReport(conf, err.reportId, instLoc(), node.errorHandling) diff --git a/compiler/evaltempl.nim b/compiler/evaltempl.nim index 8a6bf928709..5da5456146a 100644 --- a/compiler/evaltempl.nim +++ b/compiler/evaltempl.nim @@ -10,7 +10,8 @@ ## Template evaluation engine. Now hygienic. import - strutils, options, ast, astalgo, msgs, renderer, lineinfos, idents + options, ast, astalgo, msgs, renderer, lineinfos, idents, + reports type TemplCtx = object @@ -46,7 +47,7 @@ proc evalTemplateAux(templ, actual: PNode, c: var TemplCtx, result: PNode) = s.kind == skType and s.typ != nil and s.typ.kind == tyGenericParam): handleParam actual[s.owner.typ.len + s.position - 1] else: - internalAssert c.config, sfGenSym in s.flags or s.kind == skType + internalAssert(c.config, sfGenSym in s.flags or s.kind == skType, "") var x = PSym(idTableGet(c.mapping, s)) if x == nil: x = copySym(s, nextSymId(c.idgen)) @@ -93,11 +94,6 @@ proc evalTemplateAux(templ, actual: PNode, c: var TemplCtx, result: PNode) = result.add res if isDeclarative: c.isDeclarative = false -const - errWrongNumberOfArguments = "wrong number of arguments" - errMissingGenericParamsForTemplate = "'$1' has unspecified generic parameters" - errTemplateInstantiationTooNested = "template instantiation too nested" - proc evalTemplateArgs(n: PNode, s: PSym; conf: ConfigRef; fromHlo: bool): PNode = # if the template has zero arguments, it can be called without ``()`` # `n` is then a nkSym or something similar @@ -121,11 +117,11 @@ proc evalTemplateArgs(n: PNode, s: PSym; conf: ConfigRef; fromHlo: bool): PNode if givenRegularParams < 0: givenRegularParams = 0 if totalParams > expectedRegularParams + genericParams: - globalError(conf, n.info, errWrongNumberOfArguments) + globalReport(conf, n.info, reportAst(rsemWrongNumberOfArguments, n)) if totalParams < genericParams: - globalError(conf, n.info, errMissingGenericParamsForTemplate % - n.renderTree) + globalReport(conf, n.info, reportAst( + rsemMissingGenericParamsForTemplate, n, sym = s)) result = newNodeI(nkArgList, n.info) for i in 1..givenRegularParams: @@ -136,7 +132,7 @@ proc evalTemplateArgs(n: PNode, s: PSym; conf: ConfigRef; fromHlo: bool): PNode for i in givenRegularParams+1..expectedRegularParams: let default = s.typ.n[i].sym.ast if default.isNil or default.kind == nkEmpty: - localError(conf, n.info, errWrongNumberOfArguments) + localReport(conf, n, reportSem rsemWrongNumberOfArguments) result.add newNodeI(nkEmpty, n.info) else: result.add default.copyTree @@ -177,7 +173,9 @@ proc evalTemplate*(n: PNode, tmpl, genSymOwner: PSym; fromHlo=false): PNode = inc(conf.evalTemplateCounter) if conf.evalTemplateCounter > evalTemplateLimit: - globalError(conf, n.info, errTemplateInstantiationTooNested) + globalReport(conf, n.info, SemReport( + kind: rsemTemplateInstantiationTooNested)) + result = n # replace each param by the corresponding node: @@ -196,10 +194,14 @@ proc evalTemplate*(n: PNode, tmpl, genSymOwner: PSym; if isAtom(body): result = newNodeI(nkPar, body.info) evalTemplateAux(body, args, ctx, result) - if result.len == 1: result = result[0] + if result.len == 1: + result = result[0] + else: - localError(conf, result.info, "illformed AST: " & - renderTree(result, {renderNoComments})) + localReport(conf, result.info, reportAst( + rsemIllformedAst, result, + str = "Expected single subnode, but found " & $result.len)) + else: result = copyNode(body) ctx.instLines = sfCallsite in tmpl.flags diff --git a/compiler/extccomp.nim b/compiler/extccomp.nim index dec70b6c18c..82dffbc00a0 100644 --- a/compiler/extccomp.nim +++ b/compiler/extccomp.nim @@ -7,50 +7,52 @@ # distribution, for details about the copyright. # -# Module providing functions for calling the different external C compilers -# Uses some hard-wired facts about each C/C++ compiler, plus options read -# from a lineinfos file, to provide generalized procedures to compile -# nim files. +## Module providing functions for calling the different external C +## compilers Uses some hard-wired facts about each C/C++ compiler, plus +## options read from a lineinfos file, to provide generalized procedures to +## compile nim files. + +import ropes, platform, condsyms, options, msgs, lineinfos, pathutils, reports -import ropes, platform, condsyms, options, msgs, lineinfos, pathutils import std/[os, strutils, osproc, sha1, streams, sequtils, times, strtabs, json, jsonutils, sugar] type - TInfoCCProp* = enum # properties of the C compiler: - hasSwitchRange, # CC allows ranges in switch statements (GNU C) - hasComputedGoto, # CC has computed goto (GNU C extension) - hasCpp, # CC is/contains a C++ compiler - hasAssume, # CC has __assume (Visual C extension) - hasGcGuard, # CC supports GC_GUARD to keep stack roots - hasGnuAsm, # CC's asm uses the absurd GNU assembler syntax - hasDeclspec, # CC has __declspec(X) - hasAttribute, # CC has __attribute__((X)) + TInfoCCProp* = enum ## properties of the C compiler: + hasSwitchRange ## CC allows ranges in switch statements (GNU C) + hasComputedGoto ## CC has computed goto (GNU C extension) + hasCpp ## CC is/contains a C++ compiler + hasAssume ## CC has `__assume` (Visual C extension) + hasGcGuard ## CC supports GC_GUARD to keep stack roots + hasGnuAsm ## CC's asm uses the absurd GNU assembler syntax + hasDeclspec ## CC has `__declspec(X)` + hasAttribute ## CC has `__attribute__((X))` + TInfoCCProps* = set[TInfoCCProp] - TInfoCC* = tuple[ - name: string, # the short name of the compiler - objExt: string, # the compiler's object file extension - optSpeed: string, # the options for optimization for speed - optSize: string, # the options for optimization for size - compilerExe: string, # the compiler's executable - cppCompiler: string, # name of the C++ compiler's executable (if supported) - compileTmpl: string, # the compile command template - buildGui: string, # command to build a GUI application - buildDll: string, # command to build a shared library - buildLib: string, # command to build a static library - linkerExe: string, # the linker's executable (if not matching compiler's) - linkTmpl: string, # command to link files to produce an exe - includeCmd: string, # command to add an include dir - linkDirCmd: string, # command to add a lib dir - linkLibCmd: string, # command to link an external library - debug: string, # flags for debug build - pic: string, # command for position independent code - # used on some platforms - asmStmtFrmt: string, # format of ASM statement - structStmtFmt: string, # Format for struct statement - produceAsm: string, # Format how to produce assembler listings - cppXsupport: string, # what to do to enable C++X support - props: TInfoCCProps] # properties of the C compiler + TInfoCC* = object + name*: string ## the short name of the compiler + objExt*: string ## the compiler's object file extension + optSpeed*: string ## the options for optimization for speed + optSize*: string ## the options for optimization for size + compilerExe*: string ## the compiler's executable + cppCompiler*: string ## name of the C++ compiler's executable (if supported) + compileTmpl*: string ## the compile command template + buildGui*: string ## command to build a GUI application + buildDll*: string ## command to build a shared library + buildLib*: string ## command to build a static library + linkerExe*: string ## the linker's executable (if not matching compiler's) + linkTmpl*: string ## command to link files to produce an exe + includeCmd*: string ## command to add an include dir + linkDirCmd*: string ## command to add a lib dir + linkLibCmd*: string ## command to link an external library + debug*: string ## flags for debug build + pic*: string ## command for position independent code + ## used on some platforms + asmStmtFrmt*: string ## format of ASM statement + structStmtFmt*: string ## Format for struct statement + produceAsm*: string ## Format how to produce assembler listings + cppXsupport*: string ## what to do to enable C++X support + props*: TInfoCCProps ## properties of the C compiler # Configuration settings for various compilers. @@ -65,7 +67,7 @@ const # GNU C and C++ Compiler compiler gcc: - result = ( + result = TInfoCC( name: "gcc", objExt: "o", optSpeed: " -O3 -fno-ident", @@ -92,7 +94,7 @@ compiler gcc: # GNU C and C++ Compiler compiler nintendoSwitchGCC: - result = ( + result = TInfoCC( name: "switch_gcc", objExt: "o", optSpeed: " -O3 ", @@ -140,7 +142,7 @@ compiler clang: # Microsoft Visual C/C++ Compiler compiler vcc: - result = ( + result = TInfoCC( name: "vcc", objExt: "obj", optSpeed: " /Ogityb2 ", @@ -188,7 +190,7 @@ compiler icc: # Borland C Compiler compiler bcc: - result = ( + result = TInfoCC( name: "bcc", objExt: "obj", optSpeed: " -O3 -6 ", @@ -215,7 +217,7 @@ compiler bcc: # Tiny C Compiler compiler tcc: - result = ( + result = TInfoCC( name: "tcc", objExt: "o", optSpeed: "", @@ -241,7 +243,7 @@ compiler tcc: # Your C Compiler compiler envcc: - result = ( + result = TInfoCC( name: "env", objExt: "o", optSpeed: " -O3 ", @@ -294,10 +296,8 @@ proc nameToCC*(name: string): TSystemCC = return i result = ccNone -proc listCCnames(): string = - result = "" +proc listCCnames(): seq[string] = for i in succ(ccNone)..high(TSystemCC): - if i > succ(ccNone): result.add ", " result.add CC[i].name proc isVSCompatible*(conf: ConfigRef): bool = @@ -332,11 +332,18 @@ proc getConfigVar(conf: ConfigRef; c: TSystemCC, suffix: string): string = proc setCC*(conf: ConfigRef; ccname: string; info: TLineInfo) = conf.cCompiler = nameToCC(ccname) if conf.cCompiler == ccNone: - localError(conf, info, "unknown C compiler: '$1'. Available options are: $2" % [ccname, listCCnames()]) + conf.localReport(ExternalReport( + kind: rextUnknownCCompiler, + knownCompilers: listCCnames(), + passedCompiler: ccname)) + conf.compileOptions = getConfigVar(conf, conf.cCompiler, ".options.always") conf.linkOptions = "" conf.cCompilerPath = getConfigVar(conf, conf.cCompiler, ".path") - for c in CC: undefSymbol(conf.symbols, c.name) + + for c in CC: + undefSymbol(conf.symbols, c.name) + defineSymbol(conf.symbols, CC[conf.cCompiler].name) proc addOpt(dest: var string, src: string) = @@ -394,21 +401,23 @@ proc resetCompilationLists*(conf: ConfigRef) = proc addExternalFileToLink*(conf: ConfigRef; filename: AbsoluteFile) = conf.externalToLink.insert(filename.string, 0) -proc execWithEcho(conf: ConfigRef; cmd: string, msg = hintExecuting): int = - rawMessage(conf, msg, if msg == hintLinking and not(optListCmd in conf.globalOptions or conf.verbosity > 1): "" else: cmd) +proc execWithEcho(conf: ConfigRef; cmd: string, execKind: ReportKind): int = + conf.localReport(CmdReport(kind: execKind, cmd: cmd)) result = execCmd(cmd) -proc execExternalProgram*(conf: ConfigRef; cmd: string, msg = hintExecuting) = - if execWithEcho(conf, cmd, msg) != 0: - rawMessage(conf, errGenerated, "execution of an external program failed: '$1'" % - cmd) +proc execExternalProgram*(conf: ConfigRef; cmd: string, kind: ReportKind) = + if execWithEcho(conf, cmd, kind) != 0: + conf.localReport CmdReport(kind: rcmdFailedExecution, cmd: cmd) proc generateScript(conf: ConfigRef; script: Rope) = let (_, name, _) = splitFile(conf.outFile.string) - let filename = getNimcacheDir(conf) / RelativeFile(addFileExt("compile_" & name, - platform.OS[conf.target.targetOS].scriptExt)) + let filename = getNimcacheDir(conf) / RelativeFile( + addFileExt("compile_" & name, platform.OS[conf.target.targetOS].scriptExt)) + if not writeRope(script, filename): - rawMessage(conf, errGenerated, "could not write to file: " & filename.string) + conf.globalReport BackendReport( + kind: rbackCannotWriteScript, + filename: filename.string) proc getOptSpeed(conf: ConfigRef; c: TSystemCC): string = result = getConfigVar(conf, c, ".options.speed") @@ -492,20 +501,27 @@ proc envFlags(conf: ConfigRef): string = getEnv("CFLAGS") proc getCompilerExe(conf: ConfigRef; compiler: TSystemCC; cfile: AbsoluteFile): string = + var target: string if compiler == ccEnv: result = if useCpp(conf, cfile): - getEnv("CXX") - else: - getEnv("CC") + target = "c++" + getEnv("CXX") + else: + target = "c" + getEnv("CC") else: result = if useCpp(conf, cfile): - CC[compiler].cppCompiler - else: - CC[compiler].compilerExe + target = "c++" + CC[compiler].cppCompiler + else: + target = "c" + CC[compiler].compilerExe + if result.len == 0: - rawMessage(conf, errGenerated, - "Compiler '$1' doesn't support the requested target" % - CC[compiler].name) + conf.globalReport BackendReport( + kind: rbackTargetNotSupported, + requestedTarget: target, + usedCompiler: CC[compiler].name) proc ccHasSaneOverflow*(conf: ConfigRef): bool = if conf.cCompiler == ccGcc: @@ -607,11 +623,13 @@ proc getCompileCFileCmd*(conf: ConfigRef; cfile: Cfile, let asmfile = objfile.changeFileExt(".asm").quoteShell addOpt(result, CC[conf.cCompiler].produceAsm % ["asmfile", asmfile]) if produceOutput: - rawMessage(conf, hintUserRaw, "Produced assembler here: " & asmfile) + conf.localReport BackendReport(kind: rbackProducedAssembly, filename: asmfile) + else: if produceOutput: - rawMessage(conf, hintUserRaw, "Couldn't produce assembler listing " & - "for the selected C compiler: " & CC[conf.cCompiler].name) + conf.localReport BackendReport( + kind: rbackCannotProduceAssembly, + usedCompiler: CC[conf.cCompiler].name) result.add(' ') result.addf(CC[c].compileTmpl, [ @@ -760,11 +778,11 @@ template tryExceptOSErrorMessage(conf: ConfigRef; errorPrefix: string = "", body body except OSError: let ose = (ref OSError)(getCurrentException()) - if errorPrefix.len > 0: - rawMessage(conf, errGenerated, errorPrefix & " " & ose.msg & " " & $ose.errorCode) - else: - rawMessage(conf, errGenerated, "execution of an external program failed: '$1'" % - (ose.msg & " " & $ose.errorCode)) + conf.localReport CmdReport( + kind: rcmdFailedExecution, + msg: if 0 < len(errorPrefix): errorPrefix & " " & ose.msg else: ose.msg, + code: ose.errorCode) + raise proc getExtraCmds(conf: ConfigRef; output: AbsoluteFile): seq[string] = @@ -775,31 +793,36 @@ proc getExtraCmds(conf: ConfigRef; output: AbsoluteFile): seq[string] = proc execLinkCmd(conf: ConfigRef; linkCmd: string) = tryExceptOSErrorMessage(conf, "invocation of external linker program failed."): - execExternalProgram(conf, linkCmd, hintLinking) + execExternalProgram(conf, linkCmd, rcmdLinking) proc execCmdsInParallel(conf: ConfigRef; cmds: seq[string]; prettyCb: proc (idx: int)) = let runCb = proc (idx: int, p: Process) = let exitCode = p.peekExitCode if exitCode != 0: - rawMessage(conf, errGenerated, "execution of an external compiler program '" & - cmds[idx] & "' failed with exit code: " & $exitCode & "\n\n") - if conf.numberOfProcessors == 0: conf.numberOfProcessors = countProcessors() + conf.localReport CmdReport( + kind: rcmdFailedExecution, cmd: cmds[idx], code: exitCode) + + if conf.numberOfProcessors == 0: + conf.numberOfProcessors = countProcessors() + var res = 0 if conf.numberOfProcessors <= 1: for i in 0..high(cmds): tryExceptOSErrorMessage(conf, "invocation of external compiler program failed."): - res = execWithEcho(conf, cmds[i]) + res = execWithEcho(conf, cmds[i], rcmdExecuting) + if res != 0: - rawMessage(conf, errGenerated, "execution of an external program failed: '$1'" % - cmds[i]) + conf.localReport CmdReport( + kind: rcmdFailedExecution, cmd: cmds[i], code: res) else: tryExceptOSErrorMessage(conf, "invocation of external compiler program failed."): res = execProcesses(cmds, {poStdErrToStdOut, poUsePath, poParentStreams}, conf.numberOfProcessors, prettyCb, afterRunEvent=runCb) + if res != 0: if conf.numberOfProcessors <= 1: - rawMessage(conf, errGenerated, "execution of an external program failed: '$1'" % - cmds.join()) + conf.localReport CmdReport( + kind: rcmdFailedExecution, cmd: cmds.join(), code: res) proc linkViaResponseFile(conf: ConfigRef; cmd: string) = # Extracting the linker.exe here is a bit hacky but the best solution @@ -838,11 +861,11 @@ proc hcrLinkTargetName(conf: ConfigRef, objFile: string, isMain = false): Absolu result = conf.getNimcacheDir / RelativeFile(targetName) proc displayProgressCC(conf: ConfigRef, path, compileCmd: string): string = - if conf.hasHint(hintCC): - if optListCmd in conf.globalOptions or conf.verbosity > 1: - result = MsgKindToStr[hintCC] % (demanglePackageName(path.splitFile.name) & ": " & compileCmd) - else: - result = MsgKindToStr[hintCC] % demanglePackageName(path.splitFile.name) + if conf.hasHint(rcmdCompiling): + conf.localReport CmdReport( + kind: rcmdCompiling, + cmd: compileCmd, + msg: demanglePackageName(path.splitFile.name)) proc callCCompiler*(conf: ConfigRef) = var @@ -929,7 +952,7 @@ proc callCCompiler*(conf: ConfigRef) = else: execLinkCmd(conf, linkCmd) for cmd in extraCmds: - execExternalProgram(conf, cmd, hintExecuting) + execExternalProgram(conf, cmd, rcmdExecuting) else: linkCmd = "" if optGenScript in conf.globalOptions: @@ -1019,17 +1042,21 @@ proc runJsonBuildInstructions*(conf: ConfigRef; jsonFile: AbsoluteFile) = createDir output.parentDir let outputCurrent = $conf.absOutFile if output != outputCurrent or bcache.cacheVersion != cacheVersion: - globalError(conf, gCmdLineInfo, - "jsonscript command outputFile '$1' must match '$2' which was specified during --compileOnly, see \"outputFile\" entry in '$3' " % - [outputCurrent, output, jsonFile.string]) + conf.globalReport BackendReport( + kind: rbackJsonScriptMismatch, + jsonScriptParams: (outputCurrent, output, jsonFile.string)) + var cmds, prettyCmds: TStringSeq let prettyCb = proc (idx: int) = writePrettyCmdsStderr(prettyCmds[idx]) for (name, cmd) in bcache.compile: cmds.add cmd prettyCmds.add displayProgressCC(conf, name, cmd) + execCmdsInParallel(conf, cmds, prettyCb) execLinkCmd(conf, bcache.linkcmd) - for cmd in bcache.extraCmds: execExternalProgram(conf, cmd, hintExecuting) + + for cmd in bcache.extraCmds: + execExternalProgram(conf, cmd, rcmdExecuting) proc genMappingFiles(conf: ConfigRef; list: CfileList): Rope = for it in list: @@ -1052,4 +1079,5 @@ proc writeMapping*(conf: ConfigRef; symbolMapping: Rope) = code.addf("\n[Symbols]$n$1", [symbolMapping]) let filename = getNimcacheDir(conf) / RelativeFile"mapping.txt" if not writeRope(code, filename): - rawMessage(conf, errGenerated, "could not write to file: " & filename.string) + conf.localReport BackendReport( + kind: rbackCannotWriteMappingFile, filename: filename.string) diff --git a/compiler/filter_tmpl.nim b/compiler/filter_tmpl.nim index 84ed9916450..41be25c2667 100644 --- a/compiler/filter_tmpl.nim +++ b/compiler/filter_tmpl.nim @@ -7,11 +7,11 @@ # distribution, for details about the copyright. # -# This module implements Nim's standard template filter. +## This module implements Nim's standard template filter. import llstream, strutils, ast, msgs, options, - filters, lineinfos, pathutils + filters, lineinfos, pathutils, reports type TParseState = enum @@ -21,8 +21,8 @@ type state: TParseState info: TLineInfo indent, emitPar: int - x: string # the current input line - outp: PLLStream # the output will be parsed by parser + x: string ## the current input line + outp: PLLStream ## the output will be parsed by parser subsChar, nimDirective: char emit, conc, toStr: string curly, bracket, par: int @@ -86,7 +86,7 @@ proc parseLine(p: var TTmplParser) = dec(p.indent, 2) else: p.info.col = int16(j) - localError(p.config, p.info, "'end' does not close a control flow construct") + p.config.localReport(p.info, ParserReport(kind: rparTemplMissingEndClose)) llStreamWrite(p.outp, spaces(p.indent)) llStreamWrite(p.outp, "#end") of "if", "when", "try", "while", "for", "block", "case", "proc", "iterator", @@ -171,7 +171,8 @@ proc parseLine(p: var TTmplParser) = llStreamWrite(p.outp, p.x[j]) inc(j) if curly > 0: - localError(p.config, p.info, "expected closing '}'") + p.config.localReport(p.info, ParserReport( + kind: rparMissingToken, expected: @["}"])) break llStreamWrite(p.outp, ')') llStreamWrite(p.outp, p.conc) @@ -193,7 +194,8 @@ proc parseLine(p: var TTmplParser) = inc(j) else: p.info.col = int16(j) - localError(p.config, p.info, "invalid expression") + p.config.localReport(p.info, ParserReport( + kind: rparTemplInvalidExpression)) else: llStreamWrite(p.outp, p.x[j]) inc(j) diff --git a/compiler/filters.nim b/compiler/filters.nim index 8151c0b9380..2fcdb90d072 100644 --- a/compiler/filters.nim +++ b/compiler/filters.nim @@ -7,15 +7,14 @@ # distribution, for details about the copyright. # -# This module implements Nim's simple filters and helpers for filters. +## This module implements Nim's simple filters and helpers for filters. import - llstream, idents, strutils, ast, msgs, options, - renderer, pathutils + llstream, strutils, ast, msgs, options, + renderer, pathutils, reports proc invalidPragma(conf: ConfigRef; n: PNode) = - localError(conf, n.info, - "'$1' not allowed here" % renderTree(n, {renderNoComments})) + conf.localReport(n.info, reportAst(rsemNodeNotAllowed, n)) proc getArg(conf: ConfigRef; n: PNode, name: string, pos: int): PNode = result = nil diff --git a/compiler/guards.nim b/compiler/guards.nim index d1265d42c2e..048aefc753f 100644 --- a/compiler/guards.nim +++ b/compiler/guards.nim @@ -10,7 +10,7 @@ ## This module implements the 'implies' relation for guards. import ast, astalgo, msgs, magicsys, nimsets, trees, types, renderer, idents, - saturate, modulegraphs, options, lineinfos, int128 + saturate, modulegraphs, options, lineinfos, int128, reports const someEq = {mEqI, mEqF64, mEqEnum, mEqCh, mEqB, mEqRef, mEqProc, @@ -1055,4 +1055,5 @@ proc checkFieldAccess*(m: TModel, n: PNode; conf: ConfigRef) = for i in 1.. '" & - renderTree(result, {renderNoComments}) & "'") + + if c.config.hasHint(rsemPattern): + c.config.localReport(orig.info, SemReport( + kind: rsemPattern, + ast: original, + expandedAst: result)) proc applyPatterns(c: PContext, n: PNode): PNode = result = n @@ -45,7 +55,9 @@ proc applyPatterns(c: PContext, n: PNode): PNode = # better be safe than sorry, so check evalTemplateCounter too: inc(c.config.evalTemplateCounter) if c.config.evalTemplateCounter > evalTemplateLimit: - globalError(c.config, n.info, "template instantiation too nested") + globalReport(c.config, n.info, SemReport( + kind: rsemTemplateInstantiationTooNested)) + # deactivate this pattern: c.patterns[i] = nil if x.kind == nkStmtList: diff --git a/compiler/ic/ic.nim b/compiler/ic/ic.nim index 7387d165b99..818fbe73531 100644 --- a/compiler/ic/ic.nim +++ b/compiler/ic/ic.nim @@ -10,7 +10,7 @@ import hashes, tables, intsets, std/sha1 import packed_ast, bitabs, rodfiles import ".." / [ast, idents, lineinfos, msgs, ropes, options, - pathutils, condsyms] + pathutils, condsyms, reports] #import ".." / [renderer, astalgo] from os import removeFile, isAbsolute @@ -29,11 +29,11 @@ type PackedModule* = object ## the parts of a PackedEncoder that are part of the .rod file definedSymbols: string moduleFlags: TSymFlags - includes*: seq[(LitId, string)] # first entry is the module filename itself - imports: seq[LitId] # the modules this module depends on - toReplay*: PackedTree # pragmas and VM specific state to replay. - topLevel*: PackedTree # top level statements - bodies*: PackedTree # other trees. Referenced from typ.n and sym.ast by their position. + includes*: seq[(LitId, string)] ## first entry is the module filename itself + imports: seq[LitId] ## the modules this module depends on + toReplay*: PackedTree ## pragmas and VM specific state to replay. + topLevel*: PackedTree ## top level statements + bodies*: PackedTree ## other trees. Referenced from typ.n and sym.ast by their position. #producedGenerics*: Table[GenericKey, SymId] exports*: seq[(LitId, int32)] hidden*: seq[(LitId, int32)] @@ -53,16 +53,16 @@ type syms*: seq[PackedSym] types*: seq[PackedType] - strings*: BiTable[string] # we could share these between modules. - numbers*: BiTable[BiggestInt] # we also store floats in here so - # that we can assure that every bit is kept + strings*: BiTable[string] ## we could share these between modules. + numbers*: BiTable[BiggestInt] ## we also store floats in here so + ## that we can assure that every bit is kept cfg: PackedConfig PackedEncoder* = object #m*: PackedModule thisModule*: int32 - lastFile*: FileIndex # remember the last lookup entry. + lastFile*: FileIndex ## remember the last lookup entry. lastLit*: LitId filenames*: Table[FileIndex, LitId] pendingTypes*: seq[PType] @@ -541,12 +541,15 @@ proc storeExpansion*(c: var PackedEncoder; m: var PackedModule; info: TLineInfo; proc loadError(err: RodFileError; filename: AbsoluteFile; config: ConfigRef;) = case err of cannotOpen: - rawMessage(config, warnCannotOpenFile, filename.string) + config.localReport InternalReport( + kind: rintWarnCannotOpenFile, file: filename.string) + of includeFileChanged: - rawMessage(config, warnFileChanged, filename.string) + config.localReport InternalReport( + kind: rintWarnFileChanged, file: filename.string) else: - rawMessage(config, warnCannotOpenFile, filename.string & " reason: " & $err) - #echo "Error: ", $err, " loading file: ", filename.string + config.localReport InternalReport( + kind: rintCannotOpenFile, file: filename.string, msg: $err) proc loadRodFile*(filename: AbsoluteFile; m: var PackedModule; config: ConfigRef; ignoreConfig = false): RodFileError = diff --git a/compiler/ic/navigator.nim b/compiler/ic/navigator.nim index a1a14885d95..c04f636da4a 100644 --- a/compiler/ic/navigator.nim +++ b/compiler/ic/navigator.nim @@ -16,7 +16,7 @@ import sets from os import nil from std/private/miscdollars import toLocation -import ".." / [ast, modulegraphs, msgs, options] +import ".." / [ast, modulegraphs, msgs, options, reports] import packed_ast, bitabs, ic type @@ -79,7 +79,7 @@ proc usage(c: var NavContext; info: PackedLineInfo; isDecl: bool) = file = os.extractFilename file toLocation(m, file, info.line.int, info.col.int + ColOffset) if not c.alreadyEmitted.containsOrIncl(m): - msgWriteln c.g.config, (if isDecl: "def" else: "usage") & c.outputSep & m + c.g.config.writeln (if isDecl: "def" else: "usage") & c.outputSep & m proc list(c: var NavContext; tree: PackedTree; sym: ItemId) = for i in 0..high(tree.nodes): @@ -119,7 +119,9 @@ proc nav(g: ModuleGraph) = mid = searchForIncludeFile(g, fullPath) if mid < 0: - localError(g.config, unpacked, "unknown file name: " & fullPath) + localReport(g.config, unpacked, ExternalReport( + kind: rextIcUnknownFileName, msg: fullPath)) + return let fileId = g.packed[mid].fromDisk.strings.getKeyId(fullPath) @@ -139,7 +141,9 @@ proc nav(g: ModuleGraph) = symId = search(c, g.packed[mid].fromDisk.bodies) if symId == EmptyItemId: - localError(g.config, unpacked, "no symbol at this position") + localReport(g.config, unpacked, SemReport( + kind: rextIcNoSymbolAtPosition)) + return for i in 0..high(g.packed): diff --git a/compiler/ic/replayer.nim b/compiler/ic/replayer.nim index 61aa0e697f6..aee20a6c88f 100644 --- a/compiler/ic/replayer.nim +++ b/compiler/ic/replayer.nim @@ -12,7 +12,7 @@ ## support. import ".." / [ast, modulegraphs, trees, extccomp, btrees, - msgs, lineinfos, pathutils, options, cgmeth] + msgs, pathutils, options, cgmeth, reports] import tables @@ -29,9 +29,15 @@ proc replayStateChanges*(module: PSym; g: ModuleGraph) = if n.len >= 2: internalAssert g.config, n[0].kind == nkStrLit and n[1].kind == nkStrLit case n[0].strVal - of "hint": message(g.config, n.info, hintUser, n[1].strVal) - of "warning": message(g.config, n.info, warnUser, n[1].strVal) - of "error": localError(g.config, n.info, errUser, n[1].strVal) + of "hint": localReport(g.config, n.info, reportStr( + rsemUserHint, n[1].strVal)) + + of "warning": localReport(g.config, n.info, reportStr( + rsemUserWarning, n[1].strVal)) + + of "error": localReport(g.config, n.info, reportStr( + rsemUserError, n[1].strVal)) + of "compile": internalAssert g.config, n.len == 4 and n[2].kind == nkStrLit let cname = AbsoluteFile n[1].strVal @@ -47,7 +53,8 @@ proc replayStateChanges*(module: PSym; g: ModuleGraph) = of "passc": extccomp.addCompileOption(g.config, n[1].strVal) of "localpassc": - extccomp.addLocalCompileOption(g.config, n[1].strVal, toFullPathConsiderDirty(g.config, module.info.fileIndex)) + extccomp.addLocalCompileOption( + g.config, n[1].strVal, toFullPathConsiderDirty(g.config, module.info.fileIndex)) of "cppdefine": options.cppDefine(g.config, n[1].strVal) of "inc": @@ -73,7 +80,7 @@ proc replayStateChanges*(module: PSym; g: ModuleGraph) = else: block search: for existing in g.cacheSeqs[destKey]: - if exprStructuralEquivalent(existing, val, strictSymEquality=true): + if exprStructuralEquivalent(existing, val, strictSymEquality = true): break search g.cacheSeqs[destKey].add val of "add": diff --git a/compiler/idents.nim b/compiler/idents.nim index 9616a012f6d..72148186d16 100644 --- a/compiler/idents.nim +++ b/compiler/idents.nim @@ -7,21 +7,18 @@ # distribution, for details about the copyright. # -# Identifier handling -# An identifier is a shared immutable string that can be compared by its -# id. This module is essential for the compiler's performance. +## Identifier handling +## +## An identifier is a shared immutable string that can be compared by its +## id. This module is essential for the compiler's performance. import hashes, wordrecg -type - PIdent* = ref TIdent - TIdent*{.acyclic.} = object - id*: int # unique id; use this for comparisons and not the pointers - s*: string - next*: PIdent # for hash-table chaining - h*: Hash # hash value of s +import ast_types +export PIdent +type IdentCache* = ref object buckets: array[0..4096 * 2 - 1, PIdent] wordCounter: int @@ -127,11 +124,17 @@ proc whichKeyword*(id: PIdent): TSpecialWord = func hash*(x: PIdent): Hash {.inline.} = x.h ## don't actually compute, we just access it + func `==`*(a, b: PIdent): bool {.inline.} = ## identity based (`PIdent.id`) based equality, unless either are nil, then ## resort to reference based equality - if a.isNil or b.isNil: result = system.`==`(a, b) - else: result = a.id == b.id + if a.isNil or b.isNil: + result = system.`==`(a, b) + + else: + result = a.id == b.id + + func isNotFound*(ic: IdentCache, i: PIdent): bool {.inline.} = ## optimization: check against the cached/canonical not found ident entry - ic.identNotFound == i \ No newline at end of file + ic.identNotFound == i diff --git a/compiler/importer.nim b/compiler/importer.nim index af392f84969..ccdbf6f6ee7 100644 --- a/compiler/importer.nim +++ b/compiler/importer.nim @@ -12,8 +12,7 @@ import intsets, ast, astalgo, msgs, options, idents, lookups, semdata, modulepaths, sigmatch, lineinfos, sets, - modulegraphs, wordrecg, tables -from strutils import `%` + modulegraphs, wordrecg, tables, reports proc readExceptSet*(c: PContext, n: PNode): IntSet = assert n.kind in {nkImportExceptStmt, nkExportExceptStmt} @@ -109,14 +108,19 @@ proc rawImportSymbol(c: PContext, s, origin: PSym; importSet: var IntSet) = c.exportIndirections.incl((origin.id, s.id)) proc splitPragmas(c: PContext, n: PNode): (PNode, seq[TSpecialWord]) = - template bail = globalError(c.config, n.info, "invalid pragma") if n.kind == nkPragmaExpr: if n.len == 2 and n[1].kind == nkPragma: result[0] = n[0] for ni in n[1]: - if ni.kind == nkIdent: result[1].add whichKeyword(ni.ident) - else: bail() - else: bail() + if ni.kind == nkIdent: + result[1].add whichKeyword(ni.ident) + + else: + globalReport(c.config, n.info, reportAst(rsemInvalidPragma, n)) + + else: + globalReport(c.config, n.info, reportAst(rsemInvalidPragma, n)) + else: result[0] = n if result[0].safeLen > 0: @@ -125,7 +129,7 @@ proc splitPragmas(c: PContext, n: PNode): (PNode, seq[TSpecialWord]) = proc importSymbol(c: PContext, n: PNode, fromMod: PSym; importSet: var IntSet) = let (n, kws) = splitPragmas(c, n) if kws.len > 0: - globalError(c.config, n.info, "unexpected pragma") + globalReport(c.config, n.info, reportSem(rsemUnexpectedPragma)) let ident = lookups.considerQuotedIdent(c, n) let s = someSym(c.graph, fromMod, ident) @@ -141,7 +145,9 @@ proc importSymbol(c: PContext, n: PNode, fromMod: PSym; importSet: var IntSet) = var it: ModuleIter var e = initModuleIter(it, c.graph, fromMod, s.name) while e != nil: - if e.name.id != s.name.id: internalError(c.config, n.info, "importSymbol: 3") + if e.name.id != s.name.id: + internalError(c.config, n.info, "importSymbol: 3") + if s.kind in ExportableSymKinds: rawImportSymbol(c, e, fromMod, importSet) e = nextModuleIter(it, c.graph) @@ -218,7 +224,8 @@ proc importForwarded(c: PContext, n: PNode, exceptSet: IntSet; fromMod: PSym; im elif exceptSet.isNil or s.name.id notin exceptSet: rawImportSymbol(c, s, fromMod, importSet) of nkExportExceptStmt: - localError(c.config, n.info, "'export except' not implemented") + localReport(c.config, n.info, InternalReport( + kind: rintNotImplemented, msg: "'export except' not implemented")) else: for i in 0..n.safeLen-1: importForwarded(c, n[i], exceptSet, fromMod, importSet) @@ -227,9 +234,15 @@ proc importModuleAs(c: PContext; n: PNode, realModule: PSym, importHidden: bool) result = realModule template createModuleAliasImpl(ident): untyped = createModuleAlias(realModule, nextSymId c.idgen, ident, n.info, c.config.options) - if n.kind != nkImportAs: discard + if n.kind != nkImportAs: + discard elif n.len != 2 or n[1].kind != nkIdent: - localError(c.config, n.info, "module alias must be an identifier") + localReport( + c.config, n.info, + reportAst( + rsemExpectedIdentifier, n[1], + str = "module alias must be an identifier")) + elif n[1].ident.id != realModule.name.id: # some misguided guy will write 'import abc.foo as foo' ... result = createModuleAliasImpl(n[1].ident) @@ -248,8 +261,12 @@ proc transformImportAs(c: PContext; n: PNode): tuple[node: PNode, importHidden: result = result2 for ai in kws: case ai - of wImportHidden: ret.importHidden = true - else: globalError(c.config, n.info, "invalid pragma, expected: " & ${wImportHidden}) + of wImportHidden: + ret.importHidden = true + else: + globalReport(c.config, n.info, reportAst( + rsemInvalidPragma, n2, + str = "invalid pragma, expected: " & ${wImportHidden})) if n.kind == nkInfix and considerQuotedIdent(c, n[0]).s == "as": ret.node = newNodeI(nkImportAs, n.info) @@ -270,12 +287,11 @@ proc myImportModule(c: PContext, n: var PNode, importStmtResult: PNode): PSym = c.graph.importStack.add f #echo "adding ", toFullPath(f), " at ", L+1 if recursion >= 0: - var err = "" - for i in recursion.. recursion: err.add "\n" - err.add toFullPath(c.config, c.graph.importStack[i]) & " imports " & - toFullPath(c.config, c.graph.importStack[i+1]) - c.recursiveDep = err + for i in recursion ..< L: + c.recursiveDep.add(( + importer: toFullPath(c.config, c.graph.importStack[i]), + importee: toFullPath(c.config, c.graph.importStack[i + 1]) + )) var realModule: PSym discard pushOptionEntry(c) @@ -288,11 +304,12 @@ proc myImportModule(c: PContext, n: var PNode, importStmtResult: PNode): PSym = # we cannot perform this check reliably because of # test: modules/import_in_config) # xxx is that still true? if realModule == c.module: - localError(c.config, n.info, "module '$1' cannot import itself" % realModule.name.s) + localReport(c.config, n.info, reportSym( + rsemCannotImportItself, realModule)) + if sfDeprecated in realModule.flags: - var prefix = "" - if realModule.constraint != nil: prefix = realModule.constraint.strVal & "; " - message(c.config, n.info, warnDeprecated, prefix & realModule.name.s & " is deprecated") + localReport(c.config, n.info, reportSym(rsemDeprecated, realModule)) + suggestSym(c.graph, n.info, result, c.graph.usageSym, false) importStmtResult.add newSymNode(result, n.info) #newStrNode(toFullPath(c.config, f), n.info) @@ -316,7 +333,7 @@ proc impMod(c: PContext; it: PNode; importStmtResult: PNode) = proc evalImport*(c: PContext, n: PNode): PNode = result = newNodeI(nkImportStmt, n.info) - for i in 0.." + var rep = SemReport( + kind: rsemUnavailableTypeBound, + typ: t, + str: opname, + ast: ri, + sym: c.owner + ) + if (opname == "=" or opname == "=copy") and ri != nil: - m.add "; requires a copy because it's not the last read of '" - m.add renderTree(ri) - m.add '\'' if ri.comment.startsWith('\n'): - m.add "; another read is done here: " - m.add c.graph.config $ c.g[parseInt(ri.comment[1..^1])].n.info - elif ri.kind == nkSym and ri.sym.kind == skParam and not isSinkType(ri.sym.typ): - m.add "; try to make " - m.add renderTree(ri) - m.add " a 'sink' parameter" - m.add "; routine: " - m.add c.owner.name.s - localError(c.graph.config, ri.info, errGenerated, m) + rep.missingTypeBoundElaboration.anotherRead = some( + c.g[parseInt(ri.comment[1..^1])].n.info ) + + elif ri.kind == nkSym and + ri.sym.kind == skParam and + not isSinkType(ri.sym.typ): + rep.missingTypeBoundElaboration.tryMakeSinkParam = true + + localReport(c.graph.config, ri.info, rep) proc makePtrType(c: var Con, baseType: PType): PType = result = newType(tyPtr, nextTypeId c.idgen, c.owner) @@ -281,11 +285,15 @@ proc genOp(c: var Con; t: PType; kind: TTypeAttachedOp; dest, ri: PNode): PNode op = getAttachedOp(c.graph, canon, kind) if op == nil: #echo dest.typ.id - globalError(c.graph.config, dest.info, "internal error: '" & AttachedOpToStr[kind] & - "' operator not found for type " & typeToString(t)) + internalError( + c.graph.config, dest.info, "internal error: '" & AttachedOpToStr[kind] & + "' operator not found for type " & typeToString(t)) + elif op.ast.isGenericRoutine: - globalError(c.graph.config, dest.info, "internal error: '" & AttachedOpToStr[kind] & - "' operator is generic") + internalError( + c.graph.config, dest.info, "internal error: '" & AttachedOpToStr[kind] & + "' operator is generic") + dbg: if kind == attachedDestructor: echo "destructor is ", op.id, " ", op.ast @@ -390,8 +398,7 @@ proc genDiscriminantAsgn(c: var Con; s: var Scope; n: PNode): PNode = if hasDestructor(c, objType): if getAttachedOp(c.graph, objType, attachedDestructor) != nil and sfOverriden in getAttachedOp(c.graph, objType, attachedDestructor).flags: - localError(c.graph.config, n.info, errGenerated, """Assignment to discriminant for objects with user defined destructor is not supported, object must have default destructor. -It is best to factor out piece of object that needs custom destructor into separate object or not use discriminator assignment""") + localReport(c.graph.config, n, reportSem rsemCannotAssignToDiscriminantWithCustomDestructor) result.add newTree(nkFastAsgn, le, tmp) return @@ -458,15 +465,21 @@ proc passCopyToSink(n: PNode; c: var Con; s: var Scope): PNode = m.add p(n, c, s, normal) c.finishCopy(m, n, isFromSink = true) result.add m - if isLValue(n) and not isCapturedVar(n) and n.typ.skipTypes(abstractInst).kind != tyRef and c.inSpawn == 0: - message(c.graph.config, n.info, hintPerformance, - ("passing '$1' to a sink parameter introduces an implicit copy; " & - "if possible, rearrange your program's control flow to prevent it") % $n) + if isLValue(n) and + not isCapturedVar(n) and + n.typ.skipTypes(abstractInst).kind != tyRef and + c.inSpawn == 0: + + localReport(c.graph.config, n, reportSem rsemCopiesToSink) + else: if c.graph.config.selectedGC in {gcArc, gcOrc}: assert(not containsManagedMemory(n.typ)) + if n.typ.skipTypes(abstractInst).kind in {tyOpenArray, tyVarargs}: - localError(c.graph.config, n.info, "cannot create an implicit openArray copy to be passed to a sink parameter") + localReport(c.graph.config, n.info, reportAst( + rsemCannotCreateImplicitOpenarray, n)) + result.add newTree(nkAsgn, tmp, p(n, c, s, normal)) # Since we know somebody will take over the produced copy, there is # no need to destroy it. @@ -527,12 +540,11 @@ proc cycleCheck(n: PNode; c: var Con) = else: break if exprStructuralEquivalent(x, value, strictSymEquality = true): - let msg = - if field != nil: - "'$#' creates an uncollectable ref cycle; annotate '$#' with .cursor" % [$n, $field] - else: - "'$#' creates an uncollectable ref cycle" % [$n] - message(c.graph.config, n.info, warnCycleCreated, msg) + localReport(c.graph.config, n.info): + reportAst(rsemUncollectableRefCycle, field).withIt do: + it.cycleField = field + + break proc pVarTopLevel(v: PNode; c: var Con; s: var Scope; res: PNode) = @@ -1151,6 +1163,9 @@ proc injectDestructorCalls*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n: echo renderTree(result, {renderIds}) if g.config.arcToExpand.hasKey(owner.name.s): - echo "--expandArc: ", owner.name.s - echo renderTree(result, {renderIr, renderNoComments}) - echo "-- end of expandArc ------------------------" + g.config.localReport(SemReport( + kind: rsemExpandArc, + ast: n, + sym: owner, + expandedAst: result + )) diff --git a/compiler/jsgen.nim b/compiler/jsgen.nim index 3ebb1946e81..7fd2cac12e2 100644 --- a/compiler/jsgen.nim +++ b/compiler/jsgen.nim @@ -33,7 +33,7 @@ import nversion, msgs, idents, types, ropes, passes, ccgutils, wordrecg, renderer, cgmeth, lowerings, sighashes, modulegraphs, lineinfos, rodutils, - transf, injectdestructors, sourcemap, astmsgs + transf, injectdestructors, sourcemap, astmsgs, reports import json, sets, math, tables, intsets, strutils @@ -304,9 +304,10 @@ proc useMagic(p: PProc, name: string) = p.g.constants.add(code) else: if p.prc != nil: - globalError(p.config, p.prc.info, "system module needs: " & name) + globalReport(p.config, p.prc.info, reportStr(rsemSystemNeeds, name)) + else: - rawMessage(p.config, errGenerated, "system module needs: " & name) + localReport(p.config, reportStr(rsemSystemNeeds, name)) proc isSimpleExpr(p: PProc; n: PNode): bool = # calls all the way down --> can stay expression based @@ -884,8 +885,8 @@ proc genCaseJS(p: PProc, n: PNode, r: var TCompRes) = var v = copyNode(e[0]) inc(totalRange, int(e[1].intVal - v.intVal)) if totalRange > 65535: - localError(p.config, n.info, - "Your case statement contains too many branches, consider using if/else instead!") + localReport(p.config, n.info, BackendReport(kind: rbackJsTooCaseTooLarge)) + while v.intVal <= e[1].intVal: gen(p, v, cond) lineF(p, "case $1:$n", [cond.rdLoc]) @@ -1048,7 +1049,7 @@ proc genAsgnAux(p: PProc, x, y: PNode, noCopyNeeded: bool) = # disable `[]=` for cstring if x.kind == nkBracketExpr and x.len >= 2 and x[0].typ.skipTypes(abstractInst).kind == tyCstring: - localError(p.config, x.info, "cstring doesn't support `[]=` operator") + localReport(p.config, x, reportSem rsemUnexpectedArrayAssignForCstring) gen(p, x, a) genLineDir(p, y) @@ -1288,7 +1289,7 @@ template isIndirect(x: PSym): bool = v.kind notin {skProc, skFunc, skConverter, skMethod, skIterator, skConst, skTemp, skLet}) -proc genSymAddr(p: PProc, n: PNode, typ: PType, r: var TCompRes) = +proc genSymAddr(p: PProc, n: PNode, typ: PType, r: var TCompRes) = ## Generates a dereferenced symbol, ## as many things in the JS gen'd code ## are stored in an arrays they have different dereference methods. @@ -1442,8 +1443,9 @@ proc genSym(p: PProc, n: PNode, r: var TCompRes) = r.res = s.loc.r of skProc, skFunc, skConverter, skMethod: if sfCompileTime in s.flags: - localError(p.config, n.info, "request to generate code for .compileTime proc: " & - s.name.s) + localReport(p.config, n.info, reportSym( + rsemCannotCodegenCompiletimeProc, s)) + discard mangleName(p.module, s) r.res = s.loc.r if lfNoDecl in s.loc.flags or s.magic notin {mNone, mIsolate} or @@ -1543,15 +1545,19 @@ proc genArgs(p: PProc, n: PNode, r: var TCompRes; start=1) = # XXX look into this: let jsp = countJsParams(typ) if emitted != jsp and tfVarargs notin typ.flags: - localError(p.config, n.info, "wrong number of parameters emitted; expected: " & $jsp & + localReport(p.config, n.info, "wrong number of parameters emitted; expected: " & $jsp & " but got: " & $emitted) r.kind = resExpr proc genOtherArg(p: PProc; n: PNode; i: int; typ: PType; generated: var int; r: var TCompRes) = if i >= n.len: - globalError(p.config, n.info, "wrong importcpp pattern; expected parameter at position " & $i & - " but got only: " & $(n.len-1)) + globalReport(p.config, n.info, semReportCountMismatch( + rsemExpectedParameterForCxxPattern, + expected = i, + got = n.len - 1, + node = n)) + let it = n[i] var paramType: PNode = nil if i < typ.len: @@ -1614,7 +1620,7 @@ proc genInfixCall(p: PProc, n: PNode, r: var TCompRes) = gen(p, n[1], r) if r.typ == etyBaseIndex: if r.address == nil: - globalError(p.config, n.info, "cannot invoke with infix syntax") + internalError(p.config, n.info, "cannot invoke with infix syntax") r.res = "$1[$2]" % [r.address, r.res] r.address = nil r.typ = etyNone @@ -1960,7 +1966,7 @@ proc genRepr(p: PProc, n: PNode, r: var TCompRes) = of tySet: genReprAux(p, n, r, "reprSet", genTypeInfo(p, t)) of tyEmpty, tyVoid: - localError(p.config, n.info, "'repr' doesn't support 'void' type") + localReport(p.config, n, reportSem rsemUnexpectedVoidType) of tyPointer: genReprAux(p, n, r, "reprPointer") of tyOpenArray, tyVarargs: @@ -2155,7 +2161,9 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = of mReset, mWasMoved: genReset(p, n) of mEcho: genEcho(p, n, r) of mNLen..mNError, mSlurp, mStaticExec: - localError(p.config, n.info, errXMustBeCompileTime % n[0].sym.name.s) + localReport(p.config, n.info, reportSym( + rsemConstExpressionExpected, n[0].sym)) + of mNewString: unaryExpr(p, n, r, "mnewString", "mnewString($1)") of mNewStringOfCap: unaryExpr(p, n, r, "mnewString", "mnewString(0)") @@ -2641,7 +2649,10 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = nkMixinStmt, nkBindStmt: discard of nkIteratorDef: if n[0].sym.typ.callConv == TCallingConvention.ccClosure: - globalError(p.config, n.info, "Closure iterators are not supported by JS backend!") + globalReport(p.config, n.info, BackendReport( + kind: rbackJsUnsupportedClosureIter)) + assert false, "asdfasdf" + of nkPragma: genPragma(p, n) of nkProcDef, nkFuncDef, nkMethodDef, nkConverterDef: var s = n[namePos].sym @@ -2649,7 +2660,9 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = genSym(p, n[namePos], r) r.res = nil of nkGotoState, nkState: - globalError(p.config, n.info, "First class iterators not implemented") + globalReport(p.config, n.info, BackendReport( + kind: rbackJsUnsupportedClosureIter)) + of nkPragmaBlock: gen(p, n.lastSon, r) of nkComesFrom: discard "XXX to implement for better stack traces" @@ -2785,4 +2798,4 @@ proc myOpen(graph: ModuleGraph; s: PSym; idgen: IdGenerator): PPassContext = result = newModule(graph, s) result.idgen = idgen -const JSgenPass* = makePass(myOpen, myProcess, myClose) \ No newline at end of file +const JSgenPass* = makePass(myOpen, myProcess, myClose) diff --git a/compiler/jstypes.nim b/compiler/jstypes.nim index 5b684b60c0b..540508c1595 100644 --- a/compiler/jstypes.nim +++ b/compiler/jstypes.nim @@ -58,7 +58,9 @@ proc genObjectFields(p: PProc, typ: PType, n: PNode): Rope = u.add(rope(getOrdValue(b[j]))) of nkElse: u = rope(lengthOrd(p.config, field.typ)) - else: internalError(p.config, n.info, "genObjectFields(nkRecCase)") + else: + internalError(p.config, n.info, "genObjectFields(nkRecCase)") + if result != nil: result.add(", \L") result.addf("[setConstr($1), $2]", [u, genObjectFields(p, typ, lastSon(b))]) diff --git a/compiler/lambdalifting.nim b/compiler/lambdalifting.nim index a622f6de6b5..4a465a64da9 100644 --- a/compiler/lambdalifting.nim +++ b/compiler/lambdalifting.nim @@ -10,7 +10,7 @@ # This file implements lambda lifting for the transformator. import - intsets, strutils, options, ast, astalgo, msgs, + intsets, options, ast, astalgo, msgs, reports, idents, renderer, types, magicsys, lowerings, tables, modulegraphs, lineinfos, transf, liftdestructors, typeallowed @@ -175,7 +175,11 @@ proc getHiddenParam(g: ModuleGraph; routine: PSym): PSym = assert sfFromGeneric in result.flags else: # writeStackTrace() - localError(g.config, routine.info, "internal error: could not find env param for " & routine.name.s) + internalError( + g.config, + routine.info, + "internal error: could not find env param for " & routine.name.s) + result = routine proc getEnvParam*(routine: PSym): PSym = @@ -214,7 +218,7 @@ proc makeClosure*(g: ModuleGraph; idgen: IdGenerator; prc: PSym; env: PNode; inf result.add(newNodeIT(nkNilLit, info, getSysType(g, info, tyNil))) else: if env.skipConv.kind == nkClosure: - localError(g.config, info, "internal error: taking closure of closure") + internalError(g.config, info, "taking closure of closure") result.add(env) #if isClosureIterator(result.typ): createTypeBoundOps(g, nil, result.typ, info, idgen) @@ -280,7 +284,7 @@ proc freshVarForClosureIter*(g: ModuleGraph; s: PSym; idgen: IdGenerator; owner: if field != nil: result = rawIndirectAccess(access, field, s.info) else: - localError(g.config, s.info, "internal error: cannot generate fresh variable") + internalError(g.config, s.info, "internal error: cannot generate fresh variable") result = access # ------------------ new stuff ------------------------------------------- @@ -288,13 +292,17 @@ proc freshVarForClosureIter*(g: ModuleGraph; s: PSym; idgen: IdGenerator; owner: proc markAsClosure(g: ModuleGraph; owner: PSym; n: PNode) = let s = n.sym if illegalCapture(s): - localError(g.config, n.info, - ("'$1' is of type <$2> which cannot be captured as it would violate memory" & - " safety, declared here: $3; using '-d:nimNoLentIterators' helps in some cases") % - [s.name.s, typeToString(s.typ), g.config$s.info]) - elif not (owner.typ.callConv == ccClosure or owner.typ.callConv == ccNimCall and tfExplicitCallConv notin owner.typ.flags): - localError(g.config, n.info, "illegal capture '$1' because '$2' has the calling convention: <$3>" % - [s.name.s, owner.name.s, $owner.typ.callConv]) + localReport(g.config, n.info, reportSymbols( + rsemIllegalMemoryCapture, @[s, owner])) + + elif not ( + owner.typ.callConv == ccClosure or + owner.typ.callConv == ccNimCall and + tfExplicitCallConv notin owner.typ.flags + ): + localReport(g.config, n.info, reportSymbols( + rsemIllegalCallconvCapture, @[s, owner])) + incl(owner.typ.flags, tfCapturesEnv) owner.typ.callConv = ccClosure @@ -361,17 +369,17 @@ proc createUpField(c: var DetectionPass; dest, dep: PSym; info: TLineInfo) = else: c.getEnvTypeForOwner(dep, info) if refObj == fieldType: - localError(c.graph.config, dep.info, "internal error: invalid up reference computed") + internalError(c.graph.config, dep.info, "internal error: invalid up reference computed") let upIdent = getIdent(c.graph.cache, upName) let upField = lookupInRecord(obj.n, upIdent) if upField != nil: if upField.typ.skipTypes({tyOwned, tyRef, tyPtr}) != fieldType.skipTypes({tyOwned, tyRef, tyPtr}): - localError(c.graph.config, dep.info, "internal error: up references do not agree") + internalError(c.graph.config, dep.info, "internal error: up references do not agree") when false: if c.graph.config.selectedGC == gcDestructors and sfCursor notin upField.flags: - localError(c.graph.config, dep.info, "internal error: up reference is not a .cursor") + localUnreachable(c.graph.config, dep.info, "internal error: up reference is not a .cursor") else: let result = newSym(skField, upIdent, nextSymId(c.idgen), obj.owner, obj.owner.info) result.typ = fieldType @@ -416,7 +424,7 @@ proc addClosureParam(c: var DetectionPass; fn: PSym; info: TLineInfo) = cp.typ = t addHiddenParam(fn, cp) elif cp.typ != t and fn.kind != skIterator: - localError(c.graph.config, fn.info, "internal error: inconsistent environment type") + internalError(c.graph.config, fn.info, "internal error: inconsistent environment type") #echo "adding closure to ", fn.name.s proc detectCapturedVars(n: PNode; owner: PSym; c: var DetectionPass) = @@ -534,7 +542,7 @@ proc accessViaEnvParam(g: ModuleGraph; n: PNode; owner: PSym): PNode = let upField = lookupInRecord(obj.n, getIdent(g.cache, upName)) if upField == nil: break access = rawIndirectAccess(access, upField, n.info) - localError(g.config, n.info, "internal error: environment misses: " & s.name.s) + internalError(g.config, n.info, "internal error: environment misses: " & s.name.s) result = n proc newEnvVar(cache: IdentCache; owner: PSym; typ: PType; info: TLineInfo; idgen: IdGenerator): PNode = @@ -558,7 +566,8 @@ proc setupEnvVar(owner: PSym; d: var DetectionPass; if result.isNil: let envVarType = d.ownerToType.getOrDefault(owner.id) if envVarType.isNil: - localError d.graph.config, owner.info, "internal error: could not determine closure type" + internalError( + d.graph.config, owner.info, "internal error: could not determine closure type") result = newEnvVar(d.graph.cache, owner, asOwnedRef(d, envVarType), info, d.idgen) c.envVars[owner.id] = result if optOwnedRefs in d.graph.config.globalOptions: @@ -573,7 +582,7 @@ proc getUpViaParam(g: ModuleGraph; owner: PSym): PNode = if owner.isIterator: let upField = lookupInRecord(p.typ.skipTypes({tyOwned, tyRef, tyPtr}).n, getIdent(g.cache, upName)) if upField == nil: - localError(g.config, owner.info, "could not find up reference for closure iter") + internalError(g.config, owner.info, "could not find up reference for closure iter") else: result = rawIndirectAccess(result, upField, p.info) @@ -618,17 +627,21 @@ proc rawClosureCreation(owner: PSym; if tfHasAsgn in fieldAccess.typ.flags or optSeqDestructors in d.graph.config.globalOptions: owner.flags.incl sfInjectDestructors - let upField = lookupInRecord(env.typ.skipTypes({tyOwned, tyRef, tyPtr}).n, getIdent(d.graph.cache, upName)) + let upField = lookupInRecord( + env.typ.skipTypes({tyOwned, tyRef, tyPtr}).n, getIdent(d.graph.cache, upName)) + if upField != nil: let up = getUpViaParam(d.graph, owner) - if up != nil and upField.typ.skipTypes({tyOwned, tyRef, tyPtr}) == up.typ.skipTypes({tyOwned, tyRef, tyPtr}): + if up != nil and upField.typ.skipTypes({tyOwned, tyRef, tyPtr}) == + up.typ.skipTypes({tyOwned, tyRef, tyPtr}): + result.add(newAsgnStmt(rawIndirectAccess(env, upField, env.info), up, env.info)) #elif oldenv != nil and oldenv.typ == upField.typ: # result.add(newAsgnStmt(rawIndirectAccess(env, upField, env.info), # oldenv, env.info)) else: - localError(d.graph.config, env.info, "internal error: cannot create up reference") + internalError(d.graph.config, env.info, "internal error: cannot create up reference") # we are not in the sem'check phase anymore! so pass 'nil' for the PContext # and hope for the best: createTypeBoundOpsLL(d.graph, env.typ, owner.info, d.idgen, owner) @@ -669,7 +682,8 @@ proc closureCreationForIter(iter: PNode; result.add(newAsgnStmt(rawIndirectAccess(vnode, upField, iter.info), u, iter.info)) else: - localError(d.graph.config, iter.info, "internal error: cannot create up reference for iter") + internalError( + d.graph.config, iter.info, "internal error: cannot create up reference for iter") result.add makeClosure(d.graph, d.idgen, iter.sym, vnode, iter.info) proc accessViaEnvVar(n: PNode; owner: PSym; d: var DetectionPass; @@ -682,7 +696,8 @@ proc accessViaEnvVar(n: PNode; owner: PSym; d: var DetectionPass; if field != nil: result = rawIndirectAccess(access, field, n.info) else: - localError(d.graph.config, n.info, "internal error: not part of closure object type") + internalError( + d.graph.config, n.info, "internal error: not part of closure object type") result = n proc getStateField*(g: ModuleGraph; owner: PSym): PSym = @@ -714,7 +729,7 @@ proc symToClosure(n: PNode; owner: PSym; d: var DetectionPass; let obj = access.typ.skipTypes({tyOwned, tyRef, tyPtr}) let upField = lookupInRecord(obj.n, getIdent(d.graph.cache, upName)) if upField == nil: - localError(d.graph.config, n.info, "internal error: no environment found") + internalError(d.graph.config, n.info, "internal error: no environment found") return n access = rawIndirectAccess(access, upField, n.info) @@ -758,7 +773,7 @@ proc liftCapturedVars(n: PNode; owner: PSym; d: var DetectionPass; n[0] = liftCapturedVars(n[0], owner, d, c) let x = n[0].skipConv if x.kind == nkClosure: - #localError(n.info, "internal error: closure to closure created") + #localReport(n.info, "internal error: closure to closure created") # now we know better, so patch it: n[0] = x[0] n[1] = x[1] @@ -922,7 +937,7 @@ proc liftForLoop*(g: ModuleGraph; body: PNode; idgen: IdGenerator; owner: PSym): """ if liftingHarmful(g.config, owner): return body if not (body.kind == nkForStmt and body[^2].kind in nkCallKinds): - localError(g.config, body.info, "ignored invalid for loop") + localReport(g.config, body, reportSem rsemIgnoreInvalidForLoop) return body var call = body[^2] diff --git a/compiler/layouter.nim b/compiler/layouter.nim index ec9db6aad5a..bec1a70acf0 100644 --- a/compiler/layouter.nim +++ b/compiler/layouter.nim @@ -9,7 +9,8 @@ ## Layouter for nimpretty. -import idents, lexer, lineinfos, llstream, options, msgs, strutils, pathutils +import idents, lexer, lineinfos, llstream, options, msgs, strutils, pathutils, + reports const MinLineLen = 15 @@ -251,7 +252,9 @@ proc writeOut*(em: Emitter, content: string) = return var f = llStreamOpen(outFile, fmWrite) if f == nil: - rawMessage(em.config, errGenerated, "cannot open file: " & outFile.string) + em.config.localReport(InternalReport( + kind: rintCannotOpenFile, msg: outFile.string)) + return f.llStreamWrite content llStreamClose(f) diff --git a/compiler/lexer.nim b/compiler/lexer.nim index 506b0e92426..3470105e6ea 100644 --- a/compiler/lexer.nim +++ b/compiler/lexer.nim @@ -7,17 +7,18 @@ # distribution, for details about the copyright. # -# This lexer is handwritten for efficiency. I used an elegant buffering -# scheme which I have not seen anywhere else: -# We guarantee that a whole line is in the buffer. Thus only when scanning -# the \n or \r character we have to check whether we need to read in the next -# chunk. (\n or \r already need special handling for incrementing the line -# counter; choosing both \n and \r allows the lexer to properly read Unix, -# DOS or Macintosh text files, even when it is not the native format. +## This lexer is handwritten for efficiency. I used an elegant buffering +## scheme which I have not seen anywhere else: We guarantee that a whole +## line is in the buffer. Thus only when scanning the `\n` or `\r` +## character we have to check whether we need to read in the next chunk. +## (`\n` or `\r` already need special handling for incrementing the line +## counter; choosing both `\n` and `\r` allows the lexer to properly read +## Unix, DOS or Macintosh text files, even when it is not the native +## format. import hashes, options, msgs, strutils, platform, idents, nimlexbase, llstream, - wordrecg, lineinfos, pathutils, parseutils + wordrecg, lineinfos, pathutils, parseutils, reports const MaxLineLength* = 80 # lines longer than this lead to a warning @@ -86,38 +87,36 @@ const type NumericalBase* = enum - base10, # base10 is listed as the first element, - # so that it is the correct default value + base10, ## base10 is listed as the first element, + ## so that it is the correct default value base2, base8, base16 - Token* = object # a Nim token - tokType*: TokType # the type of the token - indent*: int # the indentation; != -1 if the token has been - # preceded with indentation - ident*: PIdent # the parsed identifier - iNumber*: BiggestInt # the parsed integer literal - fNumber*: BiggestFloat # the parsed floating point literal - base*: NumericalBase # the numerical base; only valid for int - # or float literals - strongSpaceA*: int8 # leading spaces of an operator - strongSpaceB*: int8 # trailing spaces of an operator - literal*: string # the parsed (string) literal; and - # documentation comments are here too + Token* = object ## a Nim token + tokType*: TokType ## the type of the token + indent*: int ## the indentation; != -1 if the token has been + ## preceded with indentation + ident*: PIdent ## the parsed identifier + iNumber*: BiggestInt ## the parsed integer literal + fNumber*: BiggestFloat ## the parsed floating point literal + base*: NumericalBase ## the numerical base; only valid for int + ## or float literals + strongSpaceA*: int8 ## leading spaces of an operator + strongSpaceB*: int8 ## trailing spaces of an operator + literal*: string ## the parsed (string) literal; and + ## documentation comments are here too line*, col*: int when defined(nimpretty): - offsetA*, offsetB*: int # used for pretty printing so that literals - # like 0b01 or r"\L" are unaffected + offsetA*, offsetB*: int ## used for pretty printing so that literals + ## like 0b01 or r"\L" are unaffected commentOffsetA*, commentOffsetB*: int - ErrorHandler* = proc (conf: ConfigRef; info: TLineInfo; msg: TMsgKind; arg: string) Lexer* = object of TBaseLexer fileIdx*: FileIndex - indentAhead*: int # if > 0 an indentation has already been read - # this is needed because scanning comments - # needs so much look-ahead + indentAhead*: int ## if > 0 an indentation has already been read + ## this is needed because scanning comments + ## needs so much look-ahead currLineIndent*: int strongSpaces*, allowTabs*: bool - errorHandler*: ErrorHandler cache*: IdentCache when defined(nimsuggest): previousToken: TLineInfo @@ -164,7 +163,7 @@ proc prettyTok*(tok: Token): string = proc printTok*(conf: ConfigRef; tok: Token) = # xxx factor with toLocation - msgWriteln(conf, $tok.line & ":" & $tok.col & "\t" & $tok.tokType & " " & $tok) + conf.writeln($tok.line & ":" & $tok.col & "\t" & $tok.tokType & " " & $tok) proc initToken*(L: var Token) = L.tokType = tkInvalid @@ -216,23 +215,6 @@ proc closeLexer*(lex: var Lexer) = proc getLineInfo(L: Lexer): TLineInfo = result = newLineInfo(L.fileIdx, L.lineNumber, getColNumber(L, L.bufpos)) -proc dispMessage(L: Lexer; info: TLineInfo; msg: TMsgKind; arg: string) = - if L.errorHandler.isNil: - msgs.message(L.config, info, msg, arg) - else: - L.errorHandler(L.config, info, msg, arg) - -proc lexMessage*(L: Lexer, msg: TMsgKind, arg = "") = - L.dispMessage(getLineInfo(L), msg, arg) - -proc lexMessageTok*(L: Lexer, msg: TMsgKind, tok: Token, arg = "") = - var info = newLineInfo(L.fileIdx, tok.line, tok.col) - L.dispMessage(info, msg, arg) - -proc lexMessagePos(L: var Lexer, msg: TMsgKind, pos: int, arg = "") = - var info = newLineInfo(L.fileIdx, L.lineNumber, pos - L.lineStart) - L.dispMessage(info, msg, arg) - proc matchTwoChars(L: Lexer, first: char, second: set[char]): bool = result = (L.buf[L.bufpos] == first) and (L.buf[L.bufpos + 1] in second) @@ -285,6 +267,19 @@ template eatChar(L: var Lexer, t: var Token) = t.literal.add(L.buf[L.bufpos]) inc(L.bufpos) +template localReport*(L: Lexer, report: ReportTypes): untyped = + L.config.handleReport(wrap(report, instLoc(), getLineInfo(L)), instLoc()) + +template localReportTok*(L: Lexer, report: ReportTypes, tok: Token): untyped = + L.config.handleReport(wrap( + report, instLoc(), newLineInfo(L.fileIdx, tok.line, tok.col)), instLoc()) + +template localReportPos*(L: Lexer, report: ReportTypes, pos: int): untyped = + L.config.handleReport(wrap( + report, instLoc(), newLineInfo( + L.fileIdx, L.lineNumber, pos - L.lineStart)), instLoc()) + + proc getNumber(L: var Lexer, result: var Token) = proc matchUnderscoreChars(L: var Lexer, tok: var Token, chars: set[char]): Natural = var pos = L.bufpos # use registers for pos, buf @@ -298,9 +293,7 @@ proc getNumber(L: var Lexer, result: var Token) = break if L.buf[pos] == '_': if L.buf[pos+1] notin chars: - lexMessage(L, errGenerated, - "only single underscores may occur in a token and token may not " & - "end with an underscore: e.g. '1__1' and '1_' are invalid") + L.localReport(LexerReport(kind: rlexMalformedUnderscores)) break tok.literal.add('_') inc(pos) @@ -313,7 +306,7 @@ proc getNumber(L: var Lexer, result: var Token) = inc(pos) L.bufpos = pos - proc lexMessageLitNum(L: var Lexer, msg: string, startpos: int, msgKind = errGenerated) = + proc lexMessageLitNum(L: var Lexer, msg: string, startpos: int, msgKind: LexerReportKind) = # Used to get slightly human friendlier err messages. const literalishChars = {'A'..'Z', 'a'..'z', '0'..'9', '_', '.', '\''} var msgPos = L.bufpos @@ -332,7 +325,7 @@ proc getNumber(L: var Lexer, result: var Token) = inc(L.bufpos) matchChars(L, t, {'0'..'9'}) L.bufpos = msgPos - lexMessage(L, msgKind, msg % t.literal) + L.localReport(LexerReport(kind: msgKind, msg: msg % t.literal)) var xi: BiggestInt @@ -369,12 +362,12 @@ proc getNumber(L: var Lexer, result: var Token) = "$1 will soon be invalid for oct literals; Use '0o' " & "for octals. 'c', 'C' prefix", startpos, - warnDeprecated) + rlexDeprecatedOctalPrefix) eatChar(L, result, 'c') numDigits = matchUnderscoreChars(L, result, {'0'..'7'}) of 'O': lexMessageLitNum(L, "$1 is an invalid int literal; For octal literals " & - "use the '0o' prefix.", startpos) + "use the '0o' prefix.", startpos, rlexInvalidIntegerPrefix) of 'x', 'X': eatChar(L, result, 'x') numDigits = matchUnderscoreChars(L, result, {'0'..'9', 'a'..'f', 'A'..'F'}) @@ -385,9 +378,9 @@ proc getNumber(L: var Lexer, result: var Token) = eatChar(L, result, 'b') numDigits = matchUnderscoreChars(L, result, {'0'..'1'}) else: - internalError(L.config, getLineInfo(L), "getNumber") + L.config.internalError(getLineInfo(L), rintIce, "getNumber") if numDigits == 0: - lexMessageLitNum(L, "invalid number: '$1'", startpos) + lexMessageLitNum(L, "invalid number: '$1'", startpos, rlexInvalidIntegerLiteral) else: discard matchUnderscoreChars(L, result, {'0'..'9'}) if (L.buf[L.bufpos] == '.') and (L.buf[L.bufpos + 1] in {'0'..'9'}): @@ -440,14 +433,14 @@ proc getNumber(L: var Lexer, result: var Token) = result.literal.add suffix result.tokType = tkCustomLit else: - lexMessageLitNum(L, "invalid number suffix: '$1'", errPos) + lexMessageLitNum(L, "invalid number suffix: '$1'", errPos, rlexInvalidIntegerSuffix) else: - lexMessageLitNum(L, "invalid number suffix: '$1'", errPos) + lexMessageLitNum(L, "invalid number suffix: '$1'", errPos, rlexInvalidIntegerSuffix) # Is there still a literalish char awaiting? Then it's an error! if L.buf[postPos] in literalishChars or (L.buf[postPos] == '.' and L.buf[postPos + 1] in {'0'..'9'}): - lexMessageLitNum(L, "invalid number: '$1'", startpos) + lexMessageLitNum(L, "invalid number: '$1'", startpos, rlexInvalidIntegerLiteral) if result.tokType != tkCustomLit: # Third stage, extract actual number @@ -490,7 +483,7 @@ proc getNumber(L: var Lexer, result: var Token) = else: break else: - internalError(L.config, getLineInfo(L), "getNumber") + L.config.internalError(getLineInfo(L), rintIce, "getNumber") case result.tokType of tkIntLit, tkInt64Lit: setNumber result.iNumber, xi @@ -507,7 +500,8 @@ proc getNumber(L: var Lexer, result: var Token) = # XXX: Test this on big endian machine! of tkFloat64Lit, tkFloatLit: setNumber result.fNumber, (cast[PFloat64](addr(xi)))[] - else: internalError(L.config, getLineInfo(L), "getNumber") + else: + L.config.internalError(getLineInfo(L), rintIce, "getNumber") # Bounds checks. Non decimal literals are allowed to overflow the range of # the datatype as long as their pattern don't overflow _bitwise_, hence @@ -524,7 +518,8 @@ proc getNumber(L: var Lexer, result: var Token) = if outOfRange: #echo "out of range num: ", result.iNumber, " vs ", xi - lexMessageLitNum(L, "number out of range: '$1'", startpos) + lexMessageLitNum( + L, "number out of range: '$1'", startpos, rlexNumberNotInRange) else: case result.tokType @@ -563,7 +558,7 @@ proc getNumber(L: var Lexer, result: var Token) = else: false if outOfRange: - lexMessageLitNum(L, "number out of range: '$1'", startpos) + lexMessageLitNum(L, "number out of range: '$1'", startpos, rlexNumberNotInRange) # Promote int literal to int64? Not always necessary, but more consistent if result.tokType == tkIntLit: @@ -571,17 +566,18 @@ proc getNumber(L: var Lexer, result: var Token) = result.tokType = tkInt64Lit except ValueError: - lexMessageLitNum(L, "invalid number: '$1'", startpos) + lexMessageLitNum(L, "invalid number: '$1'", startpos, rlexInvalidIntegerLiteral) except OverflowDefect, RangeDefect: - lexMessageLitNum(L, "number out of range: '$1'", startpos) + lexMessageLitNum(L, "number out of range: '$1'", startpos, rlexNumberNotInRange) tokenEnd(result, postPos-1) L.bufpos = postPos proc handleHexChar(L: var Lexer, xi: var int; position: range[0..4]) = template invalid() = - lexMessage(L, errGenerated, - "expected a hex digit, but found: " & L.buf[L.bufpos] & - "; maybe prepend with 0") + L.localReport(LexerReport( + kind: rlexExpectedHex, + msg: "expected a hex digit, but found: " & L.buf[L.bufpos] & + "; maybe prepend with 0")) case L.buf[L.bufpos] of '0'..'9': @@ -653,7 +649,10 @@ proc getEscapedChar(L: var Lexer, tok: var Token) = inc(L.bufpos) of 'p', 'P': if tok.tokType == tkCharLit: - lexMessage(L, errGenerated, "\\p not allowed in character literal") + L.localReport(LexerReport( + kind: rlexInvalidCharLiteral, + msg: "\\p not allowed in character literal")) + tok.literal.add(L.config.target.tnl) inc(L.bufpos) of 'r', 'R', 'c', 'C': @@ -694,7 +693,9 @@ proc getEscapedChar(L: var Lexer, tok: var Token) = tok.literal.add(chr(xi)) of 'u', 'U': if tok.tokType == tkCharLit: - lexMessage(L, errGenerated, "\\u not allowed in character literal") + L.localReport(LexerReport( + kind: rlexInvalidCharLiteral, + msg: "\\u not allowed in character literal")) inc(L.bufpos) var xi = 0 if L.buf[L.bufpos] == '{': @@ -703,13 +704,15 @@ proc getEscapedChar(L: var Lexer, tok: var Token) = while L.buf[L.bufpos] != '}': handleHexChar(L, xi, 0) if start == L.bufpos: - lexMessage(L, errGenerated, - "Unicode codepoint cannot be empty") + L.localReport(LexerReport( + kind: rlexInvalidUnicodeCodepoint, + msg: "Unicode codepoint cannot be empty")) inc(L.bufpos) if xi > 0x10FFFF: let hex = ($L.buf)[start..L.bufpos-2] - lexMessage(L, errGenerated, - "Unicode codepoint must be lower than 0x10FFFF, but was: " & hex) + L.localReport(LexerReport( + kind: rlexInvalidUnicodeCodepoint, + msg: "Unicode codepoint must be lower than 0x10FFFF, but was: " & hex)) else: handleHexChar(L, xi, 1) handleHexChar(L, xi, 2) @@ -718,12 +721,15 @@ proc getEscapedChar(L: var Lexer, tok: var Token) = addUnicodeCodePoint(tok.literal, xi) of '0'..'9': if matchTwoChars(L, '0', {'0'..'9'}): - lexMessage(L, warnOctalEscape) + L.localReport(LexerReport(kind: rlexDeprecatedOctalPrefix)) var xi = 0 handleDecChars(L, xi) - if (xi <= 255): tok.literal.add(chr(xi)) - else: lexMessage(L, errGenerated, "invalid character constant") - else: lexMessage(L, errGenerated, "invalid character constant") + if (xi <= 255): + tok.literal.add(chr(xi)) + else: + L.localReport(LexerReport(kind: rlexInvalidCharLiteral)) + else: + L.localReport(LexerReport(kind: rlexInvalidCharLiteral)) proc handleCRLF(L: var Lexer, pos: int): int = template registerLine = @@ -731,7 +737,8 @@ proc handleCRLF(L: var Lexer, pos: int): int = when not defined(nimpretty): if col > MaxLineLength: - lexMessagePos(L, hintLineTooLong, pos) + L.localReportPos( + LexerReport(kind: rlexLineTooLong), pos) case L.buf[pos] of CR: @@ -780,7 +787,8 @@ proc getString(L: var Lexer, tok: var Token, mode: StringMode) = tokenEndIgnore(tok, pos) var line2 = L.lineNumber L.lineNumber = line - lexMessagePos(L, errGenerated, L.lineStart, "closing \"\"\" expected, but end of file reached") + L.localReportPos(LexerReport( + kind: rlexUnclosedTripleString), L.lineStart) L.lineNumber = line2 L.bufpos = pos break @@ -803,7 +811,7 @@ proc getString(L: var Lexer, tok: var Token, mode: StringMode) = break elif c in {CR, LF, nimlexbase.EndOfFile}: tokenEndIgnore(tok, pos) - lexMessage(L, errGenerated, "closing \" expected") + L.localReport LexerReport(kind: rlexUnclosedSingleString) break elif (c == '\\') and mode == normal: L.bufpos = pos @@ -821,7 +829,7 @@ proc getCharacter(L: var Lexer; tok: var Token) = var c = L.buf[L.bufpos] case c of '\0'..pred(' '), '\'': - lexMessage(L, errGenerated, "invalid character literal") + L.localReport LexerReport(kind: rlexInvalidCharLiteral) tok.literal = $c of '\\': getEscapedChar(L, tok) else: @@ -835,7 +843,7 @@ proc getCharacter(L: var Lexer; tok: var Token) = tok.literal = "'" L.bufpos = startPos+1 else: - lexMessage(L, errGenerated, "missing closing ' for character literal") + L.localReport LexerReport(kind: rlexMissingClosingApostrophe) tokenEndIgnore(tok, L.bufpos) const @@ -899,12 +907,14 @@ proc getSymbol(L: var Lexer, tok: var Token) = suspicious = true of '_': if L.buf[pos+1] notin SymChars: - lexMessage(L, errGenerated, "invalid token: trailing underscore") + L.localReport LexerReport(kind: rlexMalformedTrailingUnderscre) break inc(pos) suspicious = true of '\x80'..'\xFF': - if c in UnicodeOperatorStartChars and unicodeOperators in L.config.features and unicodeOprLen(L.buf, pos)[0] != 0: + if c in UnicodeOperatorStartChars and + unicodeOperators in L.config.features and + unicodeOprLen(L.buf, pos)[0] != 0: break else: h = h !& ord(c) @@ -919,7 +929,10 @@ proc getSymbol(L: var Lexer, tok: var Token) = else: tok.tokType = TokType(tok.ident.id + ord(tkSymbol)) if suspicious and {optStyleHint, optStyleError} * L.config.globalOptions != {}: - lintReport(L.config, getLineInfo(L), tok.ident.s.normalize, tok.ident.s) + L.localReport LexerReport( + kind: rlexLinterReport, + wanted: tok.ident.s.normalize, + got: tok.ident.s) L.bufpos = pos @@ -1075,7 +1088,9 @@ proc skipMultiLineComment(L: var Lexer; tok: var Token; start: int; dec c of nimlexbase.EndOfFile: tokenEndIgnore(tok, pos) - lexMessagePos(L, errGenerated, pos, "end of multiline comment expected") + L.localReportPos( + LexerReport(kind: rlexUnclosedComment), pos) + break else: if isDoc or defined(nimpretty): tok.literal.add L.buf[pos] @@ -1157,7 +1172,10 @@ proc skip(L: var Lexer, tok: var Token) = inc(pos) inc(tok.strongSpaceA) of '\t': - if not L.allowTabs: lexMessagePos(L, errGenerated, pos, "tabs are not allowed, use spaces instead") + if not L.allowTabs: + L.localReportPos( + LexerReport(kind: rlexNoTabs), pos) + inc(pos) of CR, LF: tokenEndPrevious(tok, pos) @@ -1179,7 +1197,9 @@ proc skip(L: var Lexer, tok: var Token) = break tok.strongSpaceA = 0 when defined(nimpretty): - if L.buf[pos] == '#' and tok.line < 0: commentIndent = indent + if L.buf[pos] == '#' and tok.line < 0: + commentIndent = indent + if L.buf[pos] > ' ' and (L.buf[pos] != '#' or L.buf[pos+1] == '#'): tok.indent = indent L.currLineIndent = indent @@ -1335,7 +1355,9 @@ proc rawGetTok*(L: var Lexer, tok: var Token) = else: tok.literal = $c tok.tokType = tkInvalid - lexMessage(L, errGenerated, "invalid token: " & c & " (\\" & $(ord(c)) & ')') + L.localReport LexerReport( + kind: rlexInvalidToken, + msg: "invalid token: " & c & " (\\" & $(ord(c)) & ')') of '\"': # check for generalized raw string literal: let mode = if L.bufpos > 0 and L.buf[L.bufpos-1] in SymChars: generalized else: normal @@ -1356,7 +1378,9 @@ proc rawGetTok*(L: var Lexer, tok: var Token) = unicodeOprLen(L.buf, L.bufpos)[0] != 0: discard else: - lexMessage(L, errGenerated, "invalid token: no whitespace between number and identifier") + L.localReport LexerReport( + kind: rlexInvalidToken, + msg: "invalid token: no whitespace between number and identifier") of '-': if L.buf[L.bufpos+1] in {'0'..'9'} and (L.bufpos-1 == 0 or L.buf[L.bufpos-1] in UnaryMinusWhitelist): @@ -1371,7 +1395,9 @@ proc rawGetTok*(L: var Lexer, tok: var Token) = unicodeOprLen(L.buf, L.bufpos)[0] != 0: discard else: - lexMessage(L, errGenerated, "invalid token: no whitespace between number and identifier") + L.localReport LexerReport( + kind: rlexInvalidToken, + msg: "invalid token: no whitespace between number and identifier") else: getOperator(L, tok) else: @@ -1383,7 +1409,9 @@ proc rawGetTok*(L: var Lexer, tok: var Token) = else: tok.literal = $c tok.tokType = tkInvalid - lexMessage(L, errGenerated, "invalid token: " & c & " (\\" & $(ord(c)) & ')') + L.localReport LexerReport( + kind: rlexInvalidToken, + msg: "invalid token: " & c & " (\\" & $(ord(c)) & ')') inc(L.bufpos) atTokenEnd() diff --git a/compiler/liftdestructors.nim b/compiler/liftdestructors.nim index cc7e36cdb7f..6ae3cf55a65 100644 --- a/compiler/liftdestructors.nim +++ b/compiler/liftdestructors.nim @@ -11,7 +11,8 @@ ## (``=sink``, ``=``, ``=destroy``, ``=deepCopy``). import modulegraphs, lineinfos, idents, ast, renderer, semdata, - sighashes, lowerings, options, types, msgs, magicsys, tables, ccgutils + sighashes, lowerings, options, types, msgs, magicsys, tables, ccgutils, + reports from trees import isCaseObj @@ -199,9 +200,13 @@ proc fillBodyObj(c: var TLiftCtx; n, body, x, y: PNode; enforceDefaultOp: bool) fillBodyObj(c, n[0], body, x, y, enforceDefaultOp = false) c.filterDiscriminator = oldfilterDiscriminator of nkRecList: - for t in items(n): fillBodyObj(c, t, body, x, y, enforceDefaultOp) + for t in items(n): + fillBodyObj(c, t, body, x, y, enforceDefaultOp) else: - illFormedAstLocal(n, c.g.config) + c.g.config.localReport(n.info, reportAst( + rsemIllformedAst, n, + str = "Unexpected node kind for 'fillBodyObj' - " & + "wanted Sym, NilLit, RecList or RecCase, but found " & $n.kind)) proc fillBodyObjTImpl(c: var TLiftCtx; t: PType, body, x, y: PNode) = if t.len > 0 and t[0] != nil: @@ -280,7 +285,7 @@ proc getCycleParam(c: TLiftCtx): PNode = proc newHookCall(c: var TLiftCtx; op: PSym; x, y: PNode): PNode = #if sfError in op.flags: - # localError(c.config, x.info, "usage of '$1' is a user-defined error" % op.name.s) + # localReport(c.config, x.info, "usage of '$1' is a user-defined error" % op.name.s) result = newNodeI(nkCall, x.info) result.add newSymNode(op) if sfNeverRaises notin op.flags: @@ -325,8 +330,11 @@ 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) else: - localError(c.g.config, c.info, - "cannot generate destructor for generic type: " & typeToString(t)) + localReport( + c.g.config, + c.info, + reportTyp(rsemCannotGenerateGenericDestructor, t)) + result = nil proc considerAsgnOrSink(c: var TLiftCtx; t: PType; body, x, y: PNode; @@ -397,8 +405,8 @@ proc addDestructorCall(c: var TLiftCtx; orig: PType; body, x: PNode) = onUse(c.info, op) body.add destructorCall(c, op, x) elif useNoGc(c, t): - internalError(c.g.config, c.info, - "type-bound operator could not be resolved") + internalError( + c.g.config, c.info, "type-bound operator could not be resolved") proc considerUserDefinedOp(c: var TLiftCtx; t: PType; body, x, y: PNode): bool = case c.kind @@ -1043,7 +1051,7 @@ proc inst(g: ModuleGraph; c: PContext; t: PType; kind: TTypeAttachedOp; idgen: I patchBody(g, c, opInst.ast, info, a.idgen) setAttachedOp(g, idgen.module, t, kind, opInst) else: - localError(g.config, info, "unresolved generic parameter") + localReport(g.config, info, reportSem(rsemUnresolvedGenericParameter)) proc isTrival(s: PSym): bool {.inline.} = s == nil or (s.ast != nil and s.ast[bodyPos].len == 0) diff --git a/compiler/liftlocals.nim b/compiler/liftlocals.nim index 7ca46ab1b8c..d66f9e0d805 100644 --- a/compiler/liftlocals.nim +++ b/compiler/liftlocals.nim @@ -10,7 +10,7 @@ ## This module implements the '.liftLocals' pragma. import - strutils, options, ast, msgs, + options, ast, msgs, reports, idents, renderer, types, lowerings, lineinfos from pragmas import getPragmaVal @@ -60,12 +60,14 @@ proc liftLocalsIfRequested*(prc: PSym; n: PNode; cache: IdentCache; conf: Config if liftDest == nil: return n let partialParam = lookupParam(prc.typ.n, liftDest) if partialParam.isNil: - localError(conf, liftDest.info, "'$1' is not a parameter of '$2'" % - [$liftDest, prc.name.s]) + localReport(conf, liftDest.info, reportAst( + rsemIsNotParameterOf, liftDest, sym = prc)) + return n let objType = partialParam.typ.skipTypes(abstractPtrs) if objType.kind != tyObject or tfPartial notin objType.flags: - localError(conf, liftDest.info, "parameter '$1' is not a pointer to a partial object" % $liftDest) + localReport(conf, liftDest.info, reportAst( + rsemParameterNotPointerToPartial, liftDest)) return n var c = Ctx(partialParam: partialParam, objType: objType, cache: cache, idgen: idgen) let w = newTree(nkStmtList, n) diff --git a/compiler/lineinfos.nim b/compiler/lineinfos.nim index c70c0b72acc..327cfa7609e 100644 --- a/compiler/lineinfos.nim +++ b/compiler/lineinfos.nim @@ -12,6 +12,16 @@ import ropes, tables, pathutils, hashes +from ast_types import + PSym, # Contextual details of the instantnation stack optionally refer to + # the used symbol + TLineInfo, + FileIndex # Forward-declared to avoid cyclic dependencies + +export FileIndex, TLineInfo + +import reports + const explanationsBaseUrl* = "https://nim-lang.github.io/Nim" # was: "https://nim-lang.org/docs" but we're now usually showing devel docs @@ -25,249 +35,136 @@ proc createDocLink*(urlSuffix: string): string = else: result.add "/" & urlSuffix -type - TMsgKind* = enum - # fatal errors - errUnknown, errFatal, errInternal, - # non-fatal errors - errIllFormedAstX, errCannotOpenFile, - errXExpected, - errRstGridTableNotImplemented, - errRstMarkdownIllformedTable, - errRstNewSectionExpected, - errRstGeneralParseError, - errRstInvalidDirectiveX, - errRstInvalidField, - errRstFootnoteMismatch, - errProveInit, # deadcode - errGenerated, - errUser, - # warnings - warnCannotOpenFile = "CannotOpenFile", warnOctalEscape = "OctalEscape", - warnXIsNeverRead = "XIsNeverRead", warnXmightNotBeenInit = "XmightNotBeenInit", - warnDeprecated = "Deprecated", warnConfigDeprecated = "ConfigDeprecated", - warnDotLikeOps = "DotLikeOps", - warnSmallLshouldNotBeUsed = "SmallLshouldNotBeUsed", warnUnknownMagic = "UnknownMagic", - warnRstRedefinitionOfLabel = "RedefinitionOfLabel", - warnRstUnknownSubstitutionX = "UnknownSubstitutionX", - warnRstBrokenLink = "BrokenLink", - warnRstLanguageXNotSupported = "LanguageXNotSupported", - warnRstFieldXNotSupported = "FieldXNotSupported", - warnRstStyle = "warnRstStyle", - warnCommentXIgnored = "CommentXIgnored", - warnTypelessParam = "TypelessParam", - warnUseBase = "UseBase", warnWriteToForeignHeap = "WriteToForeignHeap", - warnUnsafeCode = "UnsafeCode", warnUnusedImportX = "UnusedImport", - warnInheritFromException = "InheritFromException", warnEachIdentIsTuple = "EachIdentIsTuple", - warnUnsafeSetLen = "UnsafeSetLen", warnUnsafeDefault = "UnsafeDefault", - warnProveInit = "ProveInit", warnProveField = "ProveField", warnProveIndex = "ProveIndex", - warnUnreachableElse = "UnreachableElse", warnUnreachableCode = "UnreachableCode", - warnStaticIndexCheck = "IndexCheck", warnGcUnsafe = "GcUnsafe", warnGcUnsafe2 = "GcUnsafe2", - warnUninit = "Uninit", warnGcMem = "GcMem", warnDestructor = "Destructor", - warnLockLevel = "LockLevel", warnResultShadowed = "ResultShadowed", - warnInconsistentSpacing = "Spacing", warnCaseTransition = "CaseTransition", - warnCycleCreated = "CycleCreated", warnObservableStores = "ObservableStores", - warnStrictNotNil = "StrictNotNil", - warnResultUsed = "ResultUsed", - warnCannotOpen = "CannotOpen", - warnFileChanged = "FileChanged", - warnSuspiciousEnumConv = "EnumConv", - warnAnyEnumConv = "AnyEnumConv", - warnHoleEnumConv = "HoleEnumConv", - warnCstringConv = "CStringConv", - warnEffect = "Effect", - warnUser = "User", - # hints - hintSuccess = "Success", hintSuccessX = "SuccessX", - hintCC = "CC", - hintLineTooLong = "LineTooLong", - hintXDeclaredButNotUsed = "XDeclaredButNotUsed", hintDuplicateModuleImport = "DuplicateModuleImport", - hintXCannotRaiseY = "XCannotRaiseY", hintConvToBaseNotNeeded = "ConvToBaseNotNeeded", - hintConvFromXtoItselfNotNeeded = "ConvFromXtoItselfNotNeeded", hintExprAlwaysX = "ExprAlwaysX", - hintQuitCalled = "QuitCalled", hintProcessing = "Processing", hintProcessingStmt = "ProcessingStmt", hintCodeBegin = "CodeBegin", - hintCodeEnd = "CodeEnd", hintConf = "Conf", hintPath = "Path", - hintConditionAlwaysTrue = "CondTrue", hintConditionAlwaysFalse = "CondFalse", hintName = "Name", - hintPattern = "Pattern", hintExecuting = "Exec", hintLinking = "Link", hintDependency = "Dependency", - hintSource = "Source", hintPerformance = "Performance", hintStackTrace = "StackTrace", - hintGCStats = "GCStats", hintGlobalVar = "GlobalVar", hintExpandMacro = "ExpandMacro", - hintUser = "User", hintUserRaw = "UserRaw", hintExtendedContext = "ExtendedContext", - hintMsgOrigin = "MsgOrigin", # since 1.3.5 - hintDeclaredLoc = "DeclaredLoc", # since 1.5.1 - hintImplicitObjConv = "ImplicitObjConv" +proc computeNotesVerbosity(): tuple[ + main: array[0..3, ReportKinds], + foreign: ReportKinds, + base: ReportKinds + ] = + ## Create configuration sets for the default compilation report verbosity + + # Mandatory reports - cannot be turned off, present in all verbosity + # settings + result.base = (repErrorKinds + repInternalKinds) + + # Somewhat awkward handing - stack trace report cannot be error (because + # actual error report must follow), so it is a hint-level report (can't + # be debug because it is a user-facing, can't be "trace" because it is + # not for compiler developers use only) + result.base.incl {rsemVmStackTrace} + + when defined(debugOptions): + # debug report for transition of the configuration options + result.base.incl {rdbgOptionsPush, rdbgOptionsPop} + + when defined(nimVMDebug): + result.base.incl { + rdbgVmExecTraceFull, # execution of the generated code listings + rdbgVmCodeListing # immediately generated code listings + } + + when defined(nimDebugUtils): + result.base.incl { + rdbgTraceStart, # Begin report + rdbgTraceStep, # in/out + rdbgTraceLine, + rdbgTraceEnd # End report + } + + result.main[3] = result.base + repWarningKinds + repHintKinds - { + rsemObservableStores, + rsemResultUsed, + rsemAnyEnumConvert, + rbackLinking, + + rbackLinking, + rbackCompiling, + rcmdLinking, + rcmdCompiling, + + rintErrKind + } + + + if defined(release): + result.main[3].excl rintStackTrace + + + result.main[2] = result.main[3] - { + rsemUninit, + rsemExtendedContext, + rsemProcessingStmt, + rsemWarnGcUnsafe, + rextConf, + } + + result.main[1] = result.main[2] - { + rsemProveField, + rsemErrGcUnsafe, + rextPath, + rsemHintLibDependency, + rsemGlobalVar, + rintGCStats, + } + + result.main[0] = result.main[1] - { + rintSuccessX, + rextConf, + rsemProcessing, + rsemPattern, + rcmdExecuting, + rbackLinking, + rintMsgOrigin + } + + result.foreign = result.base + { + rsemProcessing, + rsemUserHint, + rsemUserWarning, + rsemUserHint, + rsemUserWarning, + rsemUserError, + rintQuitCalled, + rsemImplicitObjConv + } + + for idx, n in @[ + result.foreign, + # result.base, + result.main[3], + result.main[2], + result.main[1], + result.main[0], + ]: + assert rbackLinking notin n + assert rsemImplicitObjConv in n, $idx + assert rsemVmStackTrace in n, $idx -const - MsgKindToStr*: array[TMsgKind, string] = [ - errUnknown: "unknown error", - errFatal: "fatal error: $1", - errInternal: "internal error: $1", - errIllFormedAstX: "illformed AST: $1", - errCannotOpenFile: "cannot open '$1'", - errXExpected: "'$1' expected", - errRstGridTableNotImplemented: "grid table is not implemented", - errRstMarkdownIllformedTable: "illformed delimiter row of a markdown table", - errRstNewSectionExpected: "new section expected $1", - errRstGeneralParseError: "general parse error", - errRstInvalidDirectiveX: "invalid directive: '$1'", - errRstInvalidField: "invalid field: $1", - errRstFootnoteMismatch: "number of footnotes and their references don't match: $1", - errProveInit: "Cannot prove that '$1' is initialized.", # deadcode - errGenerated: "$1", - errUser: "$1", - warnCannotOpenFile: "cannot open '$1'", - warnOctalEscape: "octal escape sequences do not exist; leading zero is ignored", - warnXIsNeverRead: "'$1' is never read", - warnXmightNotBeenInit: "'$1' might not have been initialized", - warnDeprecated: "$1", - warnConfigDeprecated: "config file '$1' is deprecated", - warnDotLikeOps: "$1", - warnSmallLshouldNotBeUsed: "'l' should not be used as an identifier; may look like '1' (one)", - warnUnknownMagic: "unknown magic '$1' might crash the compiler", - warnRstRedefinitionOfLabel: "redefinition of label '$1'", - warnRstUnknownSubstitutionX: "unknown substitution '$1'", - warnRstBrokenLink: "broken link '$1'", - warnRstLanguageXNotSupported: "language '$1' not supported", - warnRstFieldXNotSupported: "field '$1' not supported", - warnRstStyle: "RST style: $1", - warnCommentXIgnored: "comment '$1' ignored", - warnTypelessParam: "", # deadcode - warnUseBase: "use {.base.} for base methods; baseless methods are deprecated", - warnWriteToForeignHeap: "write to foreign heap", - warnUnsafeCode: "unsafe code: '$1'", - warnUnusedImportX: "imported and not used: '$1'", - warnInheritFromException: "inherit from a more precise exception type like ValueError, " & - "IOError or OSError. If these don't suit, inherit from CatchableError or Defect.", - warnEachIdentIsTuple: "each identifier is a tuple", - warnUnsafeSetLen: "setLen can potentially expand the sequence, " & - "but the element type '$1' doesn't have a valid default value", - warnUnsafeDefault: "The '$1' type doesn't have a valid default value", - warnProveInit: "Cannot prove that '$1' is initialized. This will become a compile time error in the future.", - warnProveField: "cannot prove that field '$1' is accessible", - warnProveIndex: "cannot prove index '$1' is valid", - warnUnreachableElse: "unreachable else, all cases are already covered", - warnUnreachableCode: "unreachable code after 'return' statement or '{.noReturn.}' proc", - warnStaticIndexCheck: "$1", - warnGcUnsafe: "not GC-safe: '$1'", - warnGcUnsafe2: "$1", - warnUninit: "use explicit initialization of '$1' for clarity", - warnGcMem: "'$1' uses GC'ed memory", - warnDestructor: "usage of a type with a destructor in a non destructible context. This will become a compile time error in the future.", - warnLockLevel: "$1", - warnResultShadowed: "Special variable 'result' is shadowed.", - warnInconsistentSpacing: "Number of spaces around '$#' is not consistent", - warnCaseTransition: "Potential object case transition, instantiate new object instead", - warnCycleCreated: "$1", - warnObservableStores: "observable stores to '$1'", - warnStrictNotNil: "$1", - warnResultUsed: "used 'result' variable", - warnCannotOpen: "cannot open: $1", - warnFileChanged: "file changed: $1", - warnSuspiciousEnumConv: "$1", - warnAnyEnumConv: "$1", - warnHoleEnumConv: "$1", - warnCstringConv: "$1", - warnEffect: "$1", - warnUser: "$1", - hintSuccess: "operation successful: $#", - # keep in sync with `testament.isSuccess` - hintSuccessX: "$build\n$loc lines; ${sec}s; $mem; proj: $project; out: $output", - hintCC: "CC: $1", - hintLineTooLong: "line too long", - hintXDeclaredButNotUsed: "'$1' is declared but not used", - hintDuplicateModuleImport: "$1", - hintXCannotRaiseY: "$1", - hintConvToBaseNotNeeded: "conversion to base object is not needed", - hintConvFromXtoItselfNotNeeded: "conversion from $1 to itself is pointless", - hintExprAlwaysX: "expression evaluates always to '$1'", - hintQuitCalled: "quit() called", - hintProcessing: "$1", - hintProcessingStmt: "$1", - hintCodeBegin: "generated code listing:", - hintCodeEnd: "end of listing", - hintConf: "used config file '$1'", - hintPath: "added path: '$1'", - hintConditionAlwaysTrue: "condition is always true: '$1'", - hintConditionAlwaysFalse: "condition is always false: '$1'", - hintName: "$1", - hintPattern: "$1", - hintExecuting: "$1", - hintLinking: "$1", - hintDependency: "$1", - hintSource: "$1", - hintPerformance: "$1", - hintStackTrace: "$1", - hintGCStats: "$1", - hintGlobalVar: "global variable declared here", - hintExpandMacro: "expanded macro: $1", - hintUser: "$1", - hintUserRaw: "$1", - hintExtendedContext: "$1", - hintMsgOrigin: "$1", - hintDeclaredLoc: "$1", - hintImplicitObjConv: "Implicit conversion: Receiver '$2' will not receive fields of sub-type '$1' [$3]" - ] - -const - fatalMsgs* = {errUnknown..errInternal} - errMin* = errUnknown - errMax* = errUser - warnMin* = warnCannotOpenFile - warnMax* = pred(hintSuccess) - hintMin* = hintSuccess - hintMax* = high(TMsgKind) - rstWarnings* = {warnRstRedefinitionOfLabel..warnRstStyle} - -type - TNoteKind* = range[warnMin..hintMax] # "notes" are warnings or hints - TNoteKinds* = set[TNoteKind] - -proc computeNotesVerbosity(): array[0..3, TNoteKinds] = - result[3] = {low(TNoteKind)..high(TNoteKind)} - {warnObservableStores, warnResultUsed, warnAnyEnumConv} - result[2] = result[3] - {hintStackTrace, warnUninit, hintExtendedContext, hintDeclaredLoc, hintProcessingStmt} - result[1] = result[2] - {warnProveField, warnProveIndex, - warnGcUnsafe, hintPath, hintDependency, hintCodeBegin, hintCodeEnd, - hintSource, hintGlobalVar, hintGCStats, hintMsgOrigin, hintPerformance} - result[0] = result[1] - {hintSuccessX, hintSuccess, hintConf, - hintProcessing, hintPattern, hintExecuting, hintLinking, hintCC} const NotesVerbosity* = computeNotesVerbosity() - errXMustBeCompileTime* = "'$1' can only be used in compile-time context" - errArgsNeedRunOption* = "arguments can only be given if the '--run' option is selected" + type TFileInfo* = object - fullPath*: AbsoluteFile # This is a canonical full filesystem path - projPath*: RelativeFile # This is relative to the project's root - shortName*: string # short name of the module - quotedName*: Rope # cached quoted short name for codegen - # purposes - quotedFullName*: Rope # cached quoted full name for codegen - # purposes - - lines*: seq[string] # the source code of the module - # used for better error messages and - # embedding the original source in the - # generated code - dirtyFile*: AbsoluteFile # the file that is actually read into memory - # and parsed; usually "" but is used - # for 'nimsuggest' - hash*: string # the checksum of the file - dirty*: bool # for 'nimfix' / 'nimpretty' like tooling + fullPath*: AbsoluteFile ## This is a canonical full filesystem path + projPath*: RelativeFile ## This is relative to the project's root + shortName*: string ## short name of the module + quotedName*: Rope ## cached quoted short name for codegen + ## purposes + quotedFullName*: Rope ## cached quoted full name for codegen + ## purposes + + lines*: seq[string] ## the source code of the module used for + ## better error messages and embedding the + ## original source in the generated code + + dirtyFile*: AbsoluteFile ## the file that is actually read into memory + ## and parsed; usually "" but is used + ## for 'nimsuggest' + hash*: string ## the checksum of the file + dirty*: bool ## for 'nimfix' / 'nimpretty' like tooling when defined(nimpretty): fullContent*: string - FileIndex* = distinct int32 - TLineInfo* = object # This is designed to be as small as possible, - # because it is used - # in syntax nodes. We save space here by using - # two int16 and an int32. - # On 64 bit and on 32 bit systems this is - # only 8 bytes. - line*: uint16 - col*: int16 - fileIndex*: FileIndex - when defined(nimpretty): - offsetA*, offsetB*: int - commentOffsetA*, commentOffsetB*: int TErrorOutput* = enum eStdOut @@ -290,13 +187,17 @@ const InvalidFileIdx* = FileIndex(-1) unknownLineInfo* = TLineInfo(line: 0, col: -1, fileIndex: InvalidFileIdx) +func isKnown*(info: TLineInfo): bool = + ## Check if `info` represents valid source file location + info != unknownLineInfo + type Severity* {.pure.} = enum ## VS Code only supports these three Hint, Warning, Error const - trackPosInvalidFileIdx* = FileIndex(-2) # special marker so that no suggestions - # are produced within comments and string literals + trackPosInvalidFileIdx* = FileIndex(-2) ## special marker so that no + ## suggestions are produced within comments and string literals commandLineIdx* = FileIndex(-3) type @@ -305,14 +206,28 @@ type trackPosAttached*: bool ## whether the tracking position was attached to ## some close token. - errorOutputs*: TErrorOutputs - msgContext*: seq[tuple[info: TLineInfo, detail: string]] + errorOutputs*: TErrorOutputs ## Allowed output streams for messages. + # REFACTOR this field is mostly touched in sem for 'performance' + # reasons - don't write out error messages when compilation failed, + # don't generate list of call candidates when `compiles()` fails and so + # on. This should be replaced with `.inTryExpr` or something similar, + # and let the reporting hook deal with all the associated heuristics. + + msgContext*: seq[tuple[info: TLineInfo, detail: PSym]] ## \ Contextual + ## information about instantiation stack - "template/generic + ## instantiation of" message is constructed from this field. Right now + ## `.detail` field is only used in the `sem.semMacroExpr()`, + ## `seminst.generateInstance()` and `semexprs.semTemplateExpr()`. In + ## all other cases this field is left empty (SemReport is `skUnknown`) + reports*: ReportList ## Intermediate storage for the + writtenSemReports*: ReportSet lastError*: TLineInfo filenameToIndexTbl*: Table[string, FileIndex] - fileInfos*: seq[TFileInfo] + fileInfos*: seq[TFileInfo] ## Information about all known source files + ## is stored in this field - full/relative paths, list of line etc. + ## (For full list see `TFileInfo`) systemFileIdx*: FileIndex - proc initMsgConfig*(): MsgConfig = result.msgContext = @[] result.lastError = unknownLineInfo diff --git a/compiler/linter.nim b/compiler/linter.nim index 5fb646051a2..9e51586fe5f 100644 --- a/compiler/linter.nim +++ b/compiler/linter.nim @@ -10,9 +10,7 @@ ## This module implements the style checker. import std/strutils -from std/sugar import dup - -import options, ast, msgs, idents, lineinfos, wordrecg, astmsgs +import options, ast, msgs, lineinfos, wordrecg, reports const Letters* = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF', '_'} @@ -91,9 +89,12 @@ proc nep1CheckDefImpl(conf: ConfigRef; info: TLineInfo; s: PSym; k: TSymKind) = if s.typ != nil and s.typ.kind == tyTypeDesc: return if {sfImportc, sfExportc} * s.flags != {}: return if optStyleCheck notin s.options: return - let beau = beautifyName(s.name.s, k) - if s.name.s != beau: - lintReport(conf, info, beau, s.name.s) + let wanted = beautifyName(s.name.s, k) + if s.name.s != wanted: + conf.localReport(info, SemReport( + sym: s, + kind: rsemLinterReport, + linterFail: (wanted, s.name.s))) template styleCheckDef*(conf: ConfigRef; info: TLineInfo; s: PSym; k: TSymKind) = if {optStyleHint, optStyleError} * conf.globalOptions != {} and optStyleUsages notin conf.globalOptions: @@ -129,10 +130,20 @@ proc styleCheckUse*(conf: ConfigRef; info: TLineInfo; s: PSym) = let badName = differs(conf, info, newName) if badName.len > 0: # special rules for historical reasons - let forceHint = badName == "nnkArgList" and newName == "nnkArglist" or badName == "nnkArglist" and newName == "nnkArgList" - lintReport(conf, info, newName, badName, forceHint = forceHint, extraMsg = "".dup(addDeclaredLoc(conf, s))) + let forceHint = + (badName == "nnkArgList" and newName == "nnkArglist") or + (badName == "nnkArglist" and newName == "nnkArgList") + conf.localReport(info, SemReport( + sym: s, + info: info, + kind: rsemLinterReportUse, + linterFail: (wanted: newName, got: badName) + )) proc checkPragmaUse*(conf: ConfigRef; info: TLineInfo; w: TSpecialWord; pragmaName: string) = let wanted = $w if pragmaName != wanted: - lintReport(conf, info, wanted, pragmaName) + conf.localReport(info, SemReport( + kind: rsemLinterReport, + linterFail: (wanted: wanted, got: pragmaName) + )) diff --git a/compiler/lookups.nim b/compiler/lookups.nim index ed51d54b7da..1356fb88ac2 100644 --- a/compiler/lookups.nim +++ b/compiler/lookups.nim @@ -10,9 +10,9 @@ # This module implements lookup helpers. import std/[algorithm, strutils] import - intsets, ast, astalgo, idents, semdata, types, msgs, options, - renderer, nimfix/prettybase, lineinfos, modulegraphs, astmsgs, - errorhandling + intsets, ast, astalgo, idents, semdata, msgs, options, + renderer, nimfix/prettybase, lineinfos, modulegraphs, + errorhandling, errorreporting, reports proc ensureNoMissingOrUnusedSymbols(c: PContext; scope: PScope) @@ -27,11 +27,10 @@ proc noidentError2(conf: ConfigRef; n, origin: PNode): PNode = ## the the expression within which `n` resides, if `origin` is the same then ## a simplified error is generated. assert n != nil, "`n` must be provided" - var m = "" - if origin != n: - m.add "in expression '" & origin.renderTree & "': " - m.add "identifier expected, but found '" & n.renderTree & "'" - newError(if origin.isNil: n else: origin, m) + conf.newError(tern(origin.isNil, n, origin)): + reportAst(rsemIdentExpectedInExpr, n).withIt do: + it.wrongNode = origin + proc considerQuotedIdent2*(c: PContext; n: PNode): PIdentResult = ## Retrieve a PIdent from a PNode, taking into account accent nodes. @@ -71,17 +70,17 @@ proc considerQuotedIdent2*(c: PContext; n: PNode): PIdentResult = (ident: ic.getNotFoundIdent(), errNode: n) else: (ident: ic.getNotFoundIdent(), errNode: n) - + # this handles the case where in an `nkAccQuoted` node we "dig" if result[1] != nil: result[1] = noidentError2(c.config, result[1], n) proc noidentError(conf: ConfigRef; n, origin: PNode) = - var m = "" - if origin != nil: - m.add "in expression '" & origin.renderTree & "': " - m.add "identifier expected, but found '" & n.renderTree & "'" - localError(conf, n.info, m) + conf.localReport(n.info, SemReport( + kind: rsemIdentExpectedInExpr, + ast: n, + wrongNode: origin + )) proc considerQuotedIdent*(c: PContext; n: PNode, origin: PNode = nil): PIdent = ## Retrieve a PIdent from a PNode, taking into account accent nodes. @@ -156,8 +155,8 @@ proc skipAlias*(s: PSym; n: PNode; conf: ConfigRef): PSym = if conf.cmd == cmdNimfix: prettybase.replaceDeprecated(conf, n.info, s, result) else: - message(conf, n.info, warnDeprecated, "use " & result.name.s & " instead; " & - s.name.s & " is deprecated") + conf.localReport( + n.info, reportSymbols(rsemDeprecated, @[s, result])) proc isShadowScope*(s: PScope): bool {.inline.} = s.parent != nil and s.parent.depthLevel == s.depthLevel @@ -322,15 +321,6 @@ type importIdx: int marked: IntSet -proc getSymRepr*(conf: ConfigRef; s: PSym, getDeclarationPath = true): string = - case s.kind - of routineKinds, skType: - result = getProcHeader(conf, s, getDeclarationPath = getDeclarationPath) - else: - result = "'$1'" % s.name.s - if getDeclarationPath: - result.addDeclaredLoc(conf, s) - proc ensureNoMissingOrUnusedSymbols(c: PContext; scope: PScope) = # check if all symbols have been used and defined: var it: TTabIter @@ -342,8 +332,9 @@ proc ensureNoMissingOrUnusedSymbols(c: PContext; scope: PScope) = # too many 'implementation of X' errors are annoying # and slow 'suggest' down: if missingImpls == 0: - localError(c.config, s.info, "implementation of '$1' expected" % - getSymRepr(c.config, s, getDeclarationPath=false)) + c.config.localReport(s.info, reportSym( + rsemImplementationExpected, s)) + inc missingImpls elif {sfUsed, sfExported} * s.flags == {}: if s.kind notin {skForVar, skParam, skMethod, skUnknown, skGenericParam, skEnumField}: @@ -354,30 +345,33 @@ proc ensureNoMissingOrUnusedSymbols(c: PContext; scope: PScope) = unusedSyms.add (s, toFileLineCol(c.config, s.info)) s = nextIter(it, scope.symbols) for (s, _) in sortedByIt(unusedSyms, it.key): - message(c.config, s.info, hintXDeclaredButNotUsed, s.name.s) + c.config.localReport(s.info, reportSym(rsemXDeclaredButNotUsed, s)) -proc wrongRedefinition*(c: PContext; info: TLineInfo, s: string; - conflictsWith: TLineInfo, note = errGenerated) = +proc wrongRedefinition*( + c: PContext; info: TLineInfo, s: PSym; + conflictsWith: PSym) = ## Emit a redefinition error if in non-interactive mode if c.config.cmd != cmdInteractive: - localError(c.config, info, note, - "redefinition of '$1'; previous declaration here: $2" % - [s, c.config $ conflictsWith]) + c.config.localReport(info, reportSymbols( + rsemRedefinitionOf, @[s, conflictsWith])) # xxx pending bootstrap >= 1.4, replace all those overloads with a single one: # proc addDecl*(c: PContext, sym: PSym, info = sym.info, scope = c.currentScope) {.inline.} = proc addDeclAt*(c: PContext; scope: PScope, sym: PSym, info: TLineInfo) = let conflict = scope.addUniqueSym(sym) if conflict != nil: - if sym.kind == skModule and conflict.kind == skModule and sym.owner == conflict.owner: + if sym.kind == skModule and + conflict.kind == skModule and + sym.owner == conflict.owner: # e.g.: import foo; import foo # xxx we could refine this by issuing a different hint for the case # where a duplicate import happens inside an include. - localError(c.config, info, hintDuplicateModuleImport, - "duplicate import of '$1'; previous import here: $2" % - [sym.name.s, c.config $ conflict.info]) + c.config.localReport(info, SemReport( + kind: rsemDuplicateModuleImport, + sym: sym, + previous: conflict)) else: - wrongRedefinition(c, info, sym.name.s, conflict.info, errGenerated) + wrongRedefinition(c, info, sym, conflict) proc addDeclAt*(c: PContext; scope: PScope, sym: PSym) {.inline.} = addDeclAt(c, scope, sym, sym.info) @@ -397,8 +391,11 @@ proc addInterfaceDeclAux(c: PContext, sym: PSym) = ## adds symbol to the module for either private or public access. if sfExported in sym.flags: # add to interface: - if c.module != nil: exportSym(c, sym) - else: internalError(c.config, sym.info, "addInterfaceDeclAux") + if c.module != nil: + exportSym(c, sym) + else: + c.config.internalError("addInterfaceDeclAux") + elif sym.kind in ExportableSymKinds and c.module != nil and isTopLevelInsideDeclaration(c, sym): strTableAdd(semtabAll(c.graph, c.module), sym) if c.config.symbolFiles != disabledSf: @@ -419,11 +416,11 @@ proc addOverloadableSymAt*(c: PContext; scope: PScope, fn: PSym) = ## adds an symbol to the given scope, will check for and raise errors if it's ## a redefinition as opposed to an overload. if fn.kind notin OverloadableSyms: - internalError(c.config, fn.info, "addOverloadableSymAt") + c.config.internalError(fn.info, "addOverloadableSymAt") return let check = strTableGet(scope.symbols, fn.name) if check != nil and check.kind notin OverloadableSyms: - wrongRedefinition(c, fn.info, fn.name.s, check.info) + wrongRedefinition(c, fn.info, fn, check) else: scope.addSym(fn) @@ -472,75 +469,79 @@ when false: import std/editdistance, heapqueue -type SpellCandidate = object - dist: int - depth: int - msg: string - sym: PSym - -template toOrderTup(a: SpellCandidate): auto = +template toOrderTup(a: SemSpellCandidate): auto = # `dist` is first, to favor nearby matches # `depth` is next, to favor nearby enclosing scopes among ties # `sym.name.s` is last, to make the list ordered and deterministic among ties - (a.dist, a.depth, a.msg) + (a.dist, a.depth, a.sym.name.s) -proc `<`(a, b: SpellCandidate): bool = - a.toOrderTup < b.toOrderTup +func `<`(a, b: SemSpellCandidate): bool = + # QUESTION this is /not/ the same as `a.dist < b.dist and ...`. So how in + # the world this code even works? + toOrderTup(a) < toOrderTup(b) proc mustFixSpelling(c: PContext): bool {.inline.} = result = c.config.spellSuggestMax != 0 and c.compilesContextId == 0 # don't slowdown inside compiles() -proc fixSpelling(c: PContext, n: PNode, ident: PIdent, result: var string) = +proc fixSpelling*(c: PContext, ident: PIdent): seq[SemSpellCandidate] = ## when we cannot find the identifier, suggest nearby spellings - var list = initHeapQueue[SpellCandidate]() + var list = initHeapQueue[SemSpellCandidate]() let name0 = ident.s.nimIdentNormalize for (sym, depth, isLocal) in allSyms(c): let depth = -depth - 1 let dist = editDistance(name0, sym.name.s.nimIdentNormalize) - var msg: string - msg.add "\n ($1, $2): '$3'" % [$dist, $depth, sym.name.s] - addDeclaredLoc(msg, c.config, sym) # `msg` needed for deterministic ordering. - list.push SpellCandidate(dist: dist, depth: depth, msg: msg, sym: sym) + list.push SemSpellCandidate( + dist: dist, depth: depth, sym: sym, isLocal: isLocal) + + if list.len == 0: + return - if list.len == 0: return let e0 = list[0] var count = 0 while true: - # pending https://github.com/timotheecour/Nim/issues/373 use more efficient `itemsSorted`. - if list.len == 0: break + if list.len == 0: + break + let e = list.pop() if c.config.spellSuggestMax == spellSuggestSecretSauce: const smallThres = 2 maxCountForSmall = 4 - # avoids ton of operator matches when mis-matching short symbols such as `i` - # other heuristics could be devised, such as only suggesting operators if `name0` - # is an operator (likewise with non-operators). - if e.dist > e0.dist or (name0.len <= smallThres and count >= maxCountForSmall): break - elif count >= c.config.spellSuggestMax: break - if count == 0: - result.add "\ncandidates (edit distance, scope distance); see '--spellSuggest': " - result.add e.msg - count.inc - -proc errorUseQualifier(c: PContext; info: TLineInfo; s: PSym; amb: var bool): PSym = - var err = "ambiguous identifier: '" & s.name.s & "'" - var i = 0 - var ignoredModules = 0 + # avoids ton of operator matches when mis-matching short symbols + # such as `i` other heuristics could be devised, such as only + # suggesting operators if `name0` is an operator (likewise with + # non-operators). + + if e.dist > e0.dist or + (name0.len <= smallThres and count >= maxCountForSmall): + break + + elif count >= c.config.spellSuggestMax: + break + + result.add e + inc count + + +proc errorUseQualifier( + c: PContext; info: TLineInfo; s: PSym; amb: var bool): PSym = + var + i = 0 + ignoredModules = 0 + rep = SemReport(kind: rsemAmbiguousIdent, sym: s) + for candidate in importedItems(c, s.name): - if i == 0: err.add " -- use one of the following:\n" - else: err.add "\n" - err.add " " & candidate.owner.name.s & "." & candidate.name.s - err.add ": " & typeToString(candidate.typ) + rep.symbols.add candidate if candidate.kind == skModule: inc ignoredModules else: result = candidate inc i - if ignoredModules != i-1: - localError(c.config, info, errGenerated, err) + + if ignoredModules != i - 1: + c.config.localReport(info, rep) result = nil else: amb = false @@ -550,29 +551,40 @@ proc errorUseQualifier*(c: PContext; info: TLineInfo; s: PSym) = discard errorUseQualifier(c, info, s, amb) proc errorUseQualifier(c: PContext; info: TLineInfo; candidates: seq[PSym]) = - var err = "ambiguous identifier: '" & candidates[0].name.s & "'" - var i = 0 + var + i = 0 + rep = reportSym(rsemAmbiguousIdent, candidates[0]) + for candidate in candidates: - if i == 0: err.add " -- use one of the following:\n" - else: err.add "\n" - err.add " " & candidate.owner.name.s & "." & candidate.name.s - err.add ": " & typeToString(candidate.typ) + rep.symbols.add candidate inc i - localError(c.config, info, errGenerated, err) -proc errorUndeclaredIdentifier*(c: PContext; info: TLineInfo; name: string, extra = "") = - var err = "undeclared identifier: '" & name & "'" & extra + c.config.localReport(info, rep) + +proc errorUndeclaredIdentifier*( + c: PContext; info: TLineInfo; name: string, + candidates: seq[SemSpellCandidate] = @[] + ) = + + c.config.localReport(info, SemReport( + kind: rsemUndeclaredIdentifier, + str: name, + spellingCandidates: candidates, + potentiallyRecursive: c.recursiveDep.len > 0 + )) + if c.recursiveDep.len > 0: - err.add "\nThis might be caused by a recursive module dependency:\n" - err.add c.recursiveDep # prevent excessive errors for 'nim check' - c.recursiveDep = "" - localError(c.config, info, errGenerated, err) + c.recursiveDep.setLen 0 + +proc errorUndeclaredIdentifierHint*( + c: PContext; n: PNode, ident: PIdent): PSym = + var candidates: seq[SemSpellCandidate] + if c.mustFixSpelling: + candidates = fixSpelling(c, ident) + + errorUndeclaredIdentifier(c, n.info, ident.s, candidates) -proc errorUndeclaredIdentifierHint*(c: PContext; n: PNode, ident: PIdent): PSym = - var extra = "" - if c.mustFixSpelling: fixSpelling(c, n, ident, extra) - errorUndeclaredIdentifier(c, n.info, ident.s, extra) result = errorSym(c, n) proc lookUp*(c: PContext, n: PNode): PSym = @@ -589,7 +601,7 @@ proc lookUp*(c: PContext, n: PNode): PSym = result = searchInScopes(c, ident, amb).skipAlias(n, c.config) if result == nil: result = errorUndeclaredIdentifierHint(c, n, ident) else: - internalError(c.config, n.info, "lookUp") + c.config.internalError("lookUp") return if amb: #contains(c.ambiguousSymbols, result.id): @@ -610,11 +622,15 @@ proc errorExpectedIdentifier( ): PSym {.inline.} = ## create an error symbol for non-identifier in identifier position within an ## expression (`exp`). non-nil `exp` leads to better error messages. + echo "Error expected identifier" let ast = if exp.isNil: - newError(n, ExpectedIdentifier) + c.config.newError(n, SemReport(kind: rsemExpectedIdentifier)) else: - newError(n, ExpectedIdentifierInExpr, exp) + c.config.newError(n): + reportAst(rsemExpectedIdentifierInExpr, exp).withIt do: + it.wrongNode = n + result = newQualifiedLookUpError(c, ident, n.info, ast) proc errorSym2*(c: PContext, n, err: PNode): PSym = @@ -635,31 +651,35 @@ proc errorSym2*(c: PContext, n, err: PNode): PSym = c.moduleScope.addSym(result) proc errorUndeclaredIdentifierWithHint( - c: PContext; n: PNode; name: string, extra = "" + c: PContext; n: PNode; name: string, + candidates: seq[SemSpellCandidate] = @[] ): PSym = ## creates an error symbol with hints as to what it might be eg: recursive ## imports - var err = extra + # echo "errorUndeclaredIdentifierWithHint" + # writeStackTrace() + result = errorSym2(c, n, c.config.newError( + n, + SemReport( + kind: rsemUndeclaredIdentifier, + potentiallyRecursive: c.recursiveDep.len > 0, + spellingCandidates: candidates, + str: name))) + if c.recursiveDep.len > 0: - err.add "\nThis might be caused by a recursive module dependency:\n" - err.add c.recursiveDep - # prevent excessive errors for 'nim check' - c.recursiveDep = "" - result = errorSym2(c, n, newError(n, UndeclaredIdentifier, newStrNode(name, n.info), - newStrNode(err, n.info))) + c.recursiveDep.setLen 0 proc errorAmbiguousUseQualifier( c: PContext; ident: PIdent, n: PNode, candidates: seq[PSym] ): PSym = ## create an error symbol for an ambiguous unqualified lookup - var err = "ambiguous identifier: '" & candidates[0].name.s & "'" + var rep = reportSym(rsemAmbiguousIdent, candidates[0]) for i, candidate in candidates.pairs: - if i == 0: err.add " -- use one of the following:\n" - else: err.add "\n" - err.add " " & candidate.owner.name.s & "." & candidate.name.s - err.add ": " & typeToString(candidate.typ) - let ast = newError(n, err) - newQualifiedLookUpError(c, ident, n.info, ast) + rep.symbols.add candidate + + let err = c.config.newError(n, rep) + result = newQualifiedLookUpError(c, ident, n.info, err) + c.config.localReport(err) type TLookupFlag* = enum @@ -669,19 +689,19 @@ proc qualifiedLookUp2*(c: PContext, n: PNode, flags: set[TLookupFlag]): PSym = ## updated version of `qualifiedLookUp`, takes an identifier (ident, accent ## quoted, dot expression qualified, etc), finds the associated symbol or ## reports errors based on the `flags` configuration (allow ambiguity, etc). - ## + ## ## this new version returns an error symbol rather than issuing errors ## directly. The symbol's `ast` field will contain an nkError, and the `typ` ## field on the symbol will be the errorType - ## + ## ## XXX: currently skError is just a const for skUnknown which has many uses, ## once things are cleaner, create a proper skError and use that instead ## of a tuple return. - ## + ## ## XXX: maybe remove the flags for ambiguity and undeclared and let the call ## sites figure it out instead? const allExceptModule = {low(TSymKind)..high(TSymKind)} - {skModule, skPackage} - + proc symFromCandidates( c: PContext, candidates: seq[PSym], ident: PIdent, n: PNode, flags: set[TLookupFlag], amb: var bool @@ -696,7 +716,7 @@ proc qualifiedLookUp2*(c: PContext, n: PNode, flags: set[TLookupFlag]): PSym = errorAmbiguousUseQualifier(c, ident, n, candidates) else: candidates[0] - + case n.kind of nkIdent, nkAccQuoted: var @@ -710,8 +730,10 @@ proc qualifiedLookUp2*(c: PContext, n: PNode, flags: set[TLookupFlag]): PSym = result = searchInScopes(c, ident, amb).skipAlias(n, c.config) # search in scopes can return an skError if not result.isNil and result.kind == skError and not amb: - result.ast = newError(n, UndeclaredIdentifier, - newStrNode(ident.s, n.info)) + var rep = reportStr(rsemUndeclaredIdentifier, ident.s) + rep.spellingCandidates = c.fixSpelling(ident) + result.ast = c.config.newError(n, rep) + else: let candidates = searchInScopesFilterBy(c, ident, allExceptModule) #.skipAlias(n, c.config) result = symFromCandidates(c, candidates, ident, n, flags, amb) @@ -724,9 +746,12 @@ proc qualifiedLookUp2*(c: PContext, n: PNode, flags: set[TLookupFlag]): PSym = result = symFromCandidates(c, candidates, ident, n, flags, amb) if result.isNil and checkUndeclared in flags: - var extra = "" - if c.mustFixSpelling: fixSpelling(c, n, ident, extra) - result = errorUndeclaredIdentifierWithHint(c, n, ident.s, extra) + var candidates: seq[SemSpellCandidate] + if c.mustFixSpelling: + candidates = fixSpelling(c, ident) + + result = errorUndeclaredIdentifierWithHint(c, n, ident.s, candidates) + elif checkAmbiguity in flags and result != nil and amb: var i = 0 @@ -749,7 +774,7 @@ proc qualifiedLookUp2*(c: PContext, n: PNode, flags: set[TLookupFlag]): PSym = if result == nil: if checkUndeclared in flags: - result = errorUndeclaredIdentifierWithHint(c, n, ident.s) + result = errorUndeclaredIdentifierWithHint(c, n, ident.s, @[]) else: discard elif result.kind == skError and result.typ.isNil: @@ -774,15 +799,20 @@ proc qualifiedLookUp2*(c: PContext, n: PNode, flags: set[TLookupFlag]): PSym = if ident != nil and errNode.isNil: if m == c.module: result = strTableGet(c.topLevelScope.symbols, ident).skipAlias(n, c.config) + else: result = someSym(c.graph, m, ident).skipAlias(n, c.config) + if result == nil and checkUndeclared in flags: - result = errorUndeclaredIdentifierWithHint(c, n[1], ident.s) + result = errorUndeclaredIdentifierWithHint(c, n[1], ident.s, @[]) + elif n[1].kind == nkSym: result = n[1].sym elif checkUndeclared in flags and n[1].kind notin {nkOpenSymChoice, nkClosedSymChoice}: - result = errorSym2(c, n[1], newError(n[1], ExpectedIdentifier)) + result = errorSym2(c, n[1], + c.config.newError( + n[1], reportSem(rsemExpectedIdentifier))) else: result = nil when false: @@ -792,7 +822,7 @@ proc qualifiedLookUp*(c: PContext, n: PNode, flags: set[TLookupFlag]): PSym = ## updated version of `qualifiedLookUp`, takes an identifier (ident, accent ## quoted, dot expression qualified, etc), finds the associated symbol or ## reports errors based on the `flags` configuration (allow ambiguity, etc). - ## + ## ## XXX: legacy, deprecate and replace with `qualifiedLookup2` const allExceptModule = {low(TSymKind)..high(TSymKind)} - {skModule, skPackage} case n.kind @@ -843,8 +873,9 @@ proc qualifiedLookUp*(c: PContext, n: PNode, flags: set[TLookupFlag]): PSym = result = n[1].sym elif checkUndeclared in flags and n[1].kind notin {nkOpenSymChoice, nkClosedSymChoice}: - localError(c.config, n[1].info, "identifier expected, but got: " & - renderTree(n[1])) + c.config.localReport(n[1].info, reportAst( + rsemExpectedIdentifier, n[1])) + result = errorSym(c, n[1]) else: result = nil @@ -1033,4 +1064,3 @@ proc pickSym*(c: PContext, n: PNode; kinds: set[TSymKind]; if result == nil: result = a else: return nil # ambiguous a = nextOverloadIter(o, c, n) - diff --git a/compiler/lowerings.nim b/compiler/lowerings.nim index 37405d8d961..2ad35e44356 100644 --- a/compiler/lowerings.nim +++ b/compiler/lowerings.nim @@ -13,7 +13,7 @@ const genPrefix* = ":tmp" # prefix for generated names import ast, astalgo, types, idents, magicsys, msgs, options, modulegraphs, - lineinfos + lineinfos, reports proc newDeref*(n: PNode): PNode {.inline.} = result = newNodeIT(nkHiddenDeref, n.info, n.typ[0]) @@ -340,7 +340,8 @@ proc callCodegenProc*(g: ModuleGraph; name: string; result = newNodeI(nkCall, info) let sym = magicsys.getCompilerProc(g, name) if sym == nil: - localError(g.config, info, "system module needs: " & name) + g.config.localReport(info, reportStr(rsemSystemNeeds, name)) + else: result.add newSymNode(sym) if arg1 != nil: result.add arg1 @@ -372,4 +373,3 @@ proc genLen*(g: ModuleGraph; n: PNode): PNode = result.typ = getSysType(g, n.info, tyInt) result[0] = newSymNode(getSysMagic(g, n.info, "len", mLengthSeq)) result[1] = n - diff --git a/compiler/magicsys.nim b/compiler/magicsys.nim index 2b6d1bbfb23..620891c7f83 100644 --- a/compiler/magicsys.nim +++ b/compiler/magicsys.nim @@ -10,8 +10,8 @@ # Built-in types and compilerprocs are registered here. import - ast, astalgo, msgs, platform, idents, - modulegraphs, lineinfos, errorhandling + ast, astalgo, msgs, platform, idents, reports, + modulegraphs, lineinfos, errorhandling, options export createMagic @@ -24,11 +24,15 @@ proc newSysType(g: ModuleGraph; kind: TTypeKind, size: int): PType = proc getSysSym*(g: ModuleGraph; info: TLineInfo; name: string): PSym = result = systemModuleSym(g, getIdent(g.cache, name)) - if result == nil: - localError(g.config, info, "system module needs: " & name) - result = newSym(skError, getIdent(g.cache, name), nextSymId(g.idgen), g.systemModule, g.systemModule.info, {}) + if result.isNil: + g.config.localReport(info, reportStr(rsemSystemNeeds, name)) + + result = newSym( + skError, getIdent(g.cache, name), nextSymId(g.idgen), g.systemModule, g.systemModule.info, {}) result.typ = newType(tyError, nextTypeId(g.idgen), g.systemModule) - if result.kind == skAlias: result = result.owner + if result.kind == skAlias: + result = result.owner + proc getSysMagic*(g: ModuleGraph; info: TLineInfo; name: string, m: TMagic): PSym = let id = getIdent(g.cache, name) @@ -38,7 +42,8 @@ proc getSysMagic*(g: ModuleGraph; info: TLineInfo; name: string, m: TMagic): PSy if r.typ[0] != nil and r.typ[0].kind == tyInt: return r result = r if result != nil: return result - localError(g.config, info, "system module needs: " & name) + g.config.localReport(info, reportStr(rsemSystemNeeds, name)) + result = newSym(skError, id, nextSymId(g.idgen), g.systemModule, g.systemModule.info, {}) result.typ = newType(tyError, nextTypeId(g.idgen), g.systemModule) @@ -71,13 +76,20 @@ proc getSysType*(g: ModuleGraph; info: TLineInfo; kind: TTypeKind): PType = of tyCstring: result = sysTypeFromName("cstring") of tyPointer: result = sysTypeFromName("pointer") of tyNil: result = newSysType(g, tyNil, g.config.target.ptrSize) - else: internalError(g.config, "request for typekind: " & $kind) + else: + g.config.localReport InternalReport( + kind: rintUnreachable, msg: "request for typekind: " & $kind) g.sysTypes[kind] = result if result.kind != kind: if kind == tyFloat64 and result.kind == tyFloat: discard # because of aliasing else: - internalError(g.config, "wanted: " & $kind & " got: " & $result.kind) - if result == nil: internalError(g.config, "type not found: " & $kind) + g.config.localReport InternalReport( + kind: rintUnreachable, + msg: "wanted: " & $kind & " got: " & $result.kind) + if result == nil: + g.config.localReport InternalReport( + kind: rintUnreachable, + msg: "type not found: " & $kind) proc resetSysTypes*(g: ModuleGraph) = g.systemModule = nil @@ -118,8 +130,8 @@ proc registerNimScriptSymbol*(g: ModuleGraph; s: PSym) = if conflict == nil: strTableAdd(g.exposed, s) else: - localError(g.config, s.info, - "symbol conflicts with other .exportNims symbol at: " & g.config$conflict.info) + g.config.localReport(s.info, reportSymbols( + rsemConflictingExportnims, @[s, conflict])) proc registerNimScriptSymbol2*(g: ModuleGraph; s: PSym): PNode = # Nimscript symbols must be al unique: @@ -128,9 +140,10 @@ proc registerNimScriptSymbol2*(g: ModuleGraph; s: PSym): PNode = if conflict == nil: strTableAdd(g.exposed, s) else: - result = newError(newSymNode(s), - "symbol conflicts with other .exportNims symbol at: " & - g.config$conflict.info) + result = g.config.newError( + newSymNode(s), + reportSymbols(rsemConflictingExportnims, @[s, conflict]), + posInfo = s.info) proc getNimScriptSymbol*(g: ModuleGraph; name: string): PSym = strTableGet(g.exposed, getIdent(g.cache, name)) @@ -157,7 +170,4 @@ proc getMagicEqSymForType*(g: ModuleGraph; t: PType; info: TLineInfo): PSym = of tyProc: result = getSysMagic(g, info, "==", mEqProc) else: - globalError(g.config, info, - "can't find magic equals operator for type kind " & $t.kind) - - + g.config.globalReport(info, reportTyp(rsemNoMagicEqualsForType, t)) diff --git a/compiler/main.nim b/compiler/main.nim index e4ec4d72931..7c891b78d80 100644 --- a/compiler/main.nim +++ b/compiler/main.nim @@ -20,6 +20,7 @@ import cgen, nversion, platform, nimconf, passaux, depends, vm, modules, + reports, modulegraphs, lineinfos, pathutils, vmprofiler import ic / [cbackend, integrity, navigator] @@ -50,9 +51,16 @@ proc commandGenDepend(graph: ModuleGraph) = let project = graph.config.projectFull writeDepsFile(graph) generateDot(graph, project) - execExternalProgram(graph.config, "dot -Tpng -o" & - changeFileExt(project, "png").string & - ' ' & changeFileExt(project, "dot").string) + execExternalProgram( + graph.config, + ( + "dot -Tpng -o" & + changeFileExt(project, "png").string & + ' ' & + changeFileExt(project, "dot").string + ), + rcmdExecuting + ) proc commandCheck(graph: ModuleGraph) = let conf = graph.config @@ -124,7 +132,10 @@ proc commandJsonScript(graph: ModuleGraph) = proc commandCompileToJS(graph: ModuleGraph) = let conf = graph.config when defined(leanCompiler): - globalError(conf, unknownLineInfo, "compiler wasn't built with JS code generator") + globalReport(conf, unknownLineInfo, InternalReport( + kind: rintUsingLeanCompiler, + msg: "Compiler was not build with js support")) + else: conf.exc = excCpp setTarget(conf.target, osJS, cpuJS) @@ -172,7 +183,8 @@ proc commandScan(cache: IdentCache, config: ConfigRef) = if tok.tokType == tkEof: break closeLexer(L) else: - rawMessage(config, errGenerated, "cannot open file: " & f.string) + localReport(config, InternalReport( + kind: rintCannotOpenFile, msg: f.string)) proc commandView(graph: ModuleGraph) = let f = toAbsolute(mainCommandArg(graph.config), AbsoluteDir getCurrentDir()).addFileExt(RodExt) @@ -207,6 +219,7 @@ proc setOutFile*(conf: ConfigRef) = conf.outFile = RelativeFile targetName proc mainCommand*(graph: ModuleGraph) = + ## Execute main compiler command let conf = graph.config let cache = graph.cache @@ -277,15 +290,19 @@ proc mainCommand*(graph: ModuleGraph) = when hasTinyCBackend: extccomp.setCC(conf, "tcc", unknownLineInfo) if conf.backend != backendC: - rawMessage(conf, errGenerated, "'run' requires c backend, got: '$1'" % $conf.backend) + globalReport(conf, ExternalReport( + kind: rextExpectedCbackednForRun, usedCompiler: $conf.backend)) + compileToBackend() else: - rawMessage(conf, errGenerated, "'run' command not available; rebuild with -d:tinyc") + globalReport(conf, ExternalReport( + kind: rextExpectedTinyCForRun)) + of cmdDoc0: docLikeCmd commandDoc(cache, conf) of cmdDoc: docLikeCmd(): - conf.setNoteDefaults(warnLockLevel, false) # issue #13218 - conf.setNoteDefaults(warnRstRedefinitionOfLabel, false) # issue #13218 + conf.setNoteDefaults(rsemLockLevelMismatch, false) # issue #13218 + conf.setNoteDefaults(rbackRstRedefinitionOfLabel, false) # issue #13218 # because currently generates lots of false positives due to conflation # of labels links in doc comments, e.g. for random.rand: # ## * `rand proc<#rand,Rand,Natural>`_ that returns an integer @@ -297,7 +314,7 @@ proc mainCommand*(graph: ModuleGraph) = # XXX: why are warnings disabled by default for rst2html and rst2tex? for warn in rstWarnings: conf.setNoteDefaults(warn, true) - conf.setNoteDefaults(warnRstRedefinitionOfLabel, false) # similar to issue #13218 + conf.setNoteDefaults(rbackRstRedefinitionOfLabel, false) # similar to issue #13218 when defined(leanCompiler): conf.quitOrRaise "compiler wasn't built with documentation generator" else: @@ -320,53 +337,41 @@ proc mainCommand*(graph: ModuleGraph) = of cmdBuildindex: docLikeCmd commandBuildIndex(conf, $conf.projectFull, conf.outFile) of cmdGendepend: commandGenDepend(graph) of cmdDump: - if getConfigVar(conf, "dump.format") == "json": - wantMainModule(conf) + wantMainModule(conf) + var state = InternalStateDump() + for s in definedSymbolNames(conf.symbols): + state.definedSymbols.add $s - var definedSymbols = newJArray() - for s in definedSymbolNames(conf.symbols): definedSymbols.elems.add(%s) - - var libpaths = newJArray() - var lazyPaths = newJArray() - for dir in conf.searchPaths: libpaths.elems.add(%dir.string) - for dir in conf.lazyPaths: lazyPaths.elems.add(%dir.string) - - var hints = newJObject() # consider factoring with `listHints` - for a in hintMin..hintMax: - hints[$a] = %(a in conf.notes) - var warnings = newJObject() - for a in warnMin..warnMax: - warnings[$a] = %(a in conf.notes) - - var dumpdata = %[ - (key: "version", val: %VersionAsString), - (key: "nimExe", val: %(getAppFilename())), - (key: "prefixdir", val: %conf.getPrefixDir().string), - (key: "libpath", val: %conf.libpath.string), - (key: "project_path", val: %conf.projectFull.string), - (key: "defined_symbols", val: definedSymbols), - (key: "lib_paths", val: %libpaths), - (key: "lazyPaths", val: %lazyPaths), - (key: "outdir", val: %conf.outDir.string), - (key: "out", val: %conf.outFile.string), - (key: "nimcache", val: %getNimcacheDir(conf).string), - (key: "hints", val: hints), - (key: "warnings", val: warnings), - ] - - msgWriteln(conf, $dumpdata, {msgStdout, msgSkipHook, msgNoUnitSep}) - # `msgNoUnitSep` to avoid generating invalid json, refs bug #17853 - else: - msgWriteln(conf, "-- list of currently defined symbols --", - {msgStdout, msgSkipHook, msgNoUnitSep}) - for s in definedSymbolNames(conf.symbols): msgWriteln(conf, s, {msgStdout, msgSkipHook, msgNoUnitSep}) - msgWriteln(conf, "-- end of list --", {msgStdout, msgSkipHook}) + for dir in conf.searchPaths: + state.libPaths.add(dir.string) + + for dir in conf.lazyPaths: + state.lazyPaths.add(dir.string) + + for a in repHintKinds: + state.hints.add(($a, a in conf.notes)) + + for a in repWarningKinds: + state.warnings.add(($a, a in conf.notes)) + + state.version = VersionAsString + state.nimExe = getAppFilename() + state.prefixdir = conf.getPrefixDir().string + state.libpath = conf.libpath.string + state.projectPath = conf.projectFull.string + state.outdir = conf.outDir.string + state.`out` = conf.outFile.string + state.nimcache = getNimcacheDir(conf).string + + conf.localReport(InternalReport(kind: rintDumpState, stateDump: state)) + + of cmdCheck: + commandCheck(graph) - for it in conf.searchPaths: msgWriteln(conf, it.string) - of cmdCheck: commandCheck(graph) of cmdParse: wantMainModule(conf) discard parseFile(conf.projectMainIdx, cache, conf) + of cmdRod: wantMainModule(conf) commandView(graph) @@ -375,14 +380,17 @@ proc mainCommand*(graph: ModuleGraph) = of cmdNimscript: if conf.projectIsCmd or conf.projectIsStdin: discard elif not fileExists(conf.projectFull): - rawMessage(conf, errGenerated, "NimScript file does not exist: " & conf.projectFull.string) + localReport(conf, InternalReport( + kind: rintCannotOpenFile, msg: conf.projectFull.string)) + # main NimScript logic handled in `loadConfigs`. of cmdNop: discard of cmdJsonscript: setOutFile(graph.config) commandJsonScript(graph) of cmdUnknown, cmdNone, cmdIdeTools, cmdNimfix: - rawMessage(conf, errGenerated, "invalid command: " & conf.command) + localReport(conf, ExternalReport( + msg: conf.command, kind: rextInvalidCommand)) if conf.errorCounter == 0 and conf.cmd notin {cmdTcc, cmdDump, cmdNop}: if optProfileVM in conf.globalOptions: diff --git a/compiler/modulegraphs.nim b/compiler/modulegraphs.nim index de34e739ef4..4668e1e79d2 100644 --- a/compiler/modulegraphs.nim +++ b/compiler/modulegraphs.nim @@ -12,7 +12,8 @@ ## or stored in a rod-file. import intsets, tables, hashes, md5 -import ast, astalgo, options, lineinfos,idents, btrees, ropes, msgs, pathutils +import ast, astalgo, options, lineinfos,idents, + btrees, ropes, msgs, pathutils, reports import ic / [packed_ast, ic] type @@ -419,7 +420,7 @@ proc registerModule*(g: ModuleGraph; m: PSym) = g.ifaces[m.position] = Iface(module: m, converters: @[], patterns: @[], uniqueName: rope(uniqueModuleName(g.config, FileIndex(m.position)))) - + initStrTables(g, m) proc registerModuleById*(g: ModuleGraph; m: FileIndex) = @@ -598,14 +599,16 @@ proc moduleFromRodFile*(g: ModuleGraph; fileIdx: FileIndex; proc configComplete*(g: ModuleGraph) = rememberStartupConfig(g.startupPackedConfig, g.config) -from std/strutils import repeat, `%` - proc onProcessing*(graph: ModuleGraph, fileIdx: FileIndex, moduleStatus: string, fromModule: PSym, ) = let conf = graph.config let isNimscript = conf.isDefined("nimscript") - if (not isNimscript) or hintProcessing in conf.cmdlineNotes: + if (not isNimscript) or rsemProcessing in conf.cmdlineNotes: let path = toFilenameOption(conf, fileIdx, conf.filenameOption) - let indent = ">".repeat(graph.importStack.len) - let fromModule2 = if fromModule != nil: $fromModule.name.s else: "(toplevel)" - let mode = if isNimscript: "(nims) " else: "" - rawMessage(conf, hintProcessing, "$#$# $#: $#: $#" % [mode, indent, fromModule2, moduleStatus, path]) + conf.localReport SemReport( + kind: rsemProcessing, + sym: fromModule, + processing: ( + isNimscript: isNimscript, + importStackLen: graph.importStack.len, + moduleStatus: moduleStatus, + fileIdx: fileIdx)) diff --git a/compiler/modulepaths.nim b/compiler/modulepaths.nim index a16b669c459..2a35a9413df 100644 --- a/compiler/modulepaths.nim +++ b/compiler/modulepaths.nim @@ -7,8 +7,8 @@ # distribution, for details about the copyright. # -import ast, renderer, strutils, msgs, options, idents, os, lineinfos, - pathutils +import ast, renderer, strutils, msgs, options, os, lineinfos, + pathutils, reports when false: const @@ -101,7 +101,7 @@ when false: of nkIdent: result = scriptableImport(pkg.ident.s, sub, pkg.info) else: - localError(pkg.info, "package name must be an identifier or string literal") + localReport(pkg.info, "package name must be an identifier or string literal") result = "" proc getModuleName*(conf: ConfigRef; n: PNode): string = @@ -113,8 +113,9 @@ proc getModuleName*(conf: ConfigRef; n: PNode): string = try: result = pathSubs(conf, n.strVal, toFullPath(conf, n.info).splitFile().dir) except ValueError: - localError(conf, n.info, "invalid path: " & n.strVal) + conf.localReport(n.info, reportAst(rsemInvalidModulePath, n)) result = n.strVal + of nkIdent: result = n.ident.s of nkSym: @@ -127,7 +128,7 @@ proc getModuleName*(conf: ConfigRef; n: PNode): string = if n0.kind == nkIdent and n0.ident.s == "/": result = lookupPackage(n1[1], n[2]) else: - localError(n.info, "only '/' supported with $package notation") + localReport(n.info, "only '/' supported with $package notation") result = "" else: let modname = getModuleName(conf, n[2]) @@ -144,12 +145,12 @@ proc getModuleName*(conf: ConfigRef; n: PNode): string = # hacky way to implement 'x / y /../ z': result = renderTree(n, {renderNoComments}).replace(" ") of nkDotExpr: - localError(conf, n.info, warnDeprecated, "using '.' instead of '/' in import paths is deprecated") + conf.localReport(n.info, reportAst(rsemDotForModuleImport, n)) result = renderTree(n, {renderNoComments}).replace(".", "/") of nkImportAs: result = getModuleName(conf, n[0]) else: - localError(conf, n.info, "invalid module name: '$1'" % n.renderTree) + conf.localReport(n.info, reportAst(rsemInvalidModuleName, n)) result = "" proc checkModuleName*(conf: ConfigRef; n: PNode; doLocalError=true): FileIndex = @@ -159,7 +160,8 @@ proc checkModuleName*(conf: ConfigRef; n: PNode; doLocalError=true): FileIndex = if fullPath.isEmpty: if doLocalError: let m = if modulename.len > 0: modulename else: $n - localError(conf, n.info, "cannot open file: " & m) + conf.localReport(n.info, InternalReport( + kind: rintCannotOpenFile, file: m)) result = InvalidFileIdx else: result = fileInfoIdx(conf, fullPath) diff --git a/compiler/modules.nim b/compiler/modules.nim index 512302b3d8f..a5a79cb234e 100644 --- a/compiler/modules.nim +++ b/compiler/modules.nim @@ -12,7 +12,7 @@ import ast, astalgo, magicsys, msgs, options, idents, lexer, passes, syntaxes, llstream, modulegraphs, - lineinfos, pathutils, tables + lineinfos, pathutils, tables, reports import ic / replayer @@ -44,7 +44,7 @@ proc getPackage(graph: ModuleGraph; fileIdx: FileIndex): PSym = if existing != nil and existing.info.fileIndex != info.fileIndex: when false: # we used to produce an error: - localError(graph.config, info, + localReport(graph.config, info, "module names need to be unique per Nimble package; module clashes with " & toFullPath(graph.config, existing.info.fileIndex)) else: @@ -80,7 +80,8 @@ proc newModule(graph: ModuleGraph; fileIdx: FileIndex): PSym = name: getModuleIdent(graph, filename), info: newLineInfo(fileIdx, 1, 1)) if not isNimIdentifier(result.name.s): - rawMessage(graph.config, errGenerated, "invalid module name: " & result.name.s) + localReport(graph.config, reportSym(rsemInvalidModuleName, result)) + partialInitModule(result, graph, fileIdx, filename) graph.registerModule(result) @@ -133,11 +134,15 @@ proc importModule*(graph: ModuleGraph; s: PSym, fileIdx: FileIndex): PSym = if graph.config.hcrOn: graph.importDeps.mgetOrPut(FileIndex(s.position), @[]).add(fileIdx) #if sfSystemModule in result.flags: - # localError(result.info, errAttemptToRedefine, result.name.s) + # localReport(result.info, errAttemptToRedefine, result.name.s) # restore the notes for outer module: - graph.config.notes = - if s.getnimblePkgId == graph.config.mainPackageId or isDefined(graph.config, "booting"): graph.config.mainPackageNotes - else: graph.config.foreignPackageNotes + if s.getnimblePkgId == graph.config.mainPackageId or + isDefined(graph.config, "booting"): + graph.config.asgn(cnCurrent, cnMainPackage) + + else: + graph.config.asgn(cnCurrent, cnForeign) + proc includeModule*(graph: ModuleGraph; s: PSym, fileIdx: FileIndex): PNode = result = syntaxes.parseFile(fileIdx, graph.cache, graph.config) @@ -157,7 +162,8 @@ proc compileSystemModule*(graph: ModuleGraph) = proc wantMainModule*(conf: ConfigRef) = if conf.projectFull.isEmpty: - fatal(conf, gCmdLineInfo, "command expects a filename") + localReport(conf, gCmdLineInfo, ExternalReport(kind: rextInvalidPath)) + conf.projectMainIdx = fileInfoIdx(conf, addFileExt(conf.projectFull, NimExt)) proc compileProject*(graph: ModuleGraph; projectFileIdx = InvalidFileIdx) = diff --git a/compiler/msgs.nim b/compiler/msgs.nim index b41d1960ff0..271b51a881f 100644 --- a/compiler/msgs.nim +++ b/compiler/msgs.nim @@ -9,11 +9,24 @@ import std/[strutils, os, tables, terminal, macros, times], - std/private/miscdollars, - options, ropes, lineinfos, pathutils, strutils2 + std/private/miscdollars -type InstantiationInfo* = typeof(instantiationInfo()) -template instLoc*(): InstantiationInfo = instantiationInfo(-2, fullPaths = compileOption"excessiveStackTrace") +import + std/options as std_options + +import + options, ropes, lineinfos, pathutils, strutils2, reports + +from ast_types import PSym + +export InstantiationInfo +export TErrorHandling + +template instLoc*(depth: int = -2): InstantiationInfo = + ## grabs where in the compiler an error was instanced to ease debugging. + ## + ## whether to use full paths depends on --excessiveStackTrace compiler option. + instantiationInfo(depth, fullPaths = compileOption"excessiveStackTrace") template toStdOrrKind(stdOrr): untyped = if stdOrr == stdout: stdOrrStdout else: stdOrrStderr @@ -147,11 +160,7 @@ proc concat(strings: openArray[string]): string = proc suggestWriteln*(conf: ConfigRef; s: string) = if eStdOut in conf.m.errorOutputs: - if isNil(conf.writelnHook): - writeLine(stdout, s) - flushFile(stdout) - else: - conf.writelnHook(s) + writelnHook(conf, s) proc msgQuit*(x: int8) = quit x proc msgQuit*(x: string) = quit x @@ -159,17 +168,7 @@ proc msgQuit*(x: string) = quit x proc suggestQuit*() = raise newException(ESuggestDone, "suggest done") -# this format is understood by many text editors: it is the same that -# Borland and Freepascal use const - KindFormat = " [$1]" - KindColor = fgCyan - ErrorTitle = "Error: " - ErrorColor = fgRed - WarningTitle = "Warning: " - WarningColor = fgYellow - HintTitle = "Hint: " - HintColor = fgGreen # NOTE: currently line info line numbers start with 1, # but column numbers start with 0, however most editors expect # first column to be 1, so we need to +1 here @@ -179,16 +178,30 @@ const proc getInfoContextLen*(conf: ConfigRef): int = return conf.m.msgContext.len proc setInfoContextLen*(conf: ConfigRef; L: int) = setLen(conf.m.msgContext, L) -proc pushInfoContext*(conf: ConfigRef; info: TLineInfo; detail: string = "") = +proc pushInfoContext*( + conf: ConfigRef; + info: TLineInfo, + detail: PSym = nil + ) = + ## Add entry to the message context information stack. conf.m.msgContext.add((info, detail)) proc popInfoContext*(conf: ConfigRef) = + ## Remove one entry from the message context information stack setLen(conf.m.msgContext, conf.m.msgContext.len - 1) proc getInfoContext*(conf: ConfigRef; index: int): TLineInfo = - let i = if index < 0: conf.m.msgContext.len + index else: index - if i >=% conf.m.msgContext.len: result = unknownLineInfo - else: result = conf.m.msgContext[i].info + let i = + if index < 0: + conf.m.msgContext.len + index + else: + index + + if i >=% conf.m.msgContext.len: + result = unknownLineInfo + + else: + result = conf.m.msgContext[i].info template toFilename*(conf: ConfigRef; fileIdx: FileIndex): string = if fileIdx.int32 < 0 or conf == nil: @@ -207,6 +220,11 @@ proc toFullPath*(conf: ConfigRef; fileIdx: FileIndex): string = else: result = conf.m.fileInfos[fileIdx.int32].fullPath.string +proc toReportLineInfo*(conf: ConfigRef, info: TLineInfo): ReportLineInfo = + ReportLineInfo( + file: conf.toFullPath(info.fileIndex), + line: info.line, col: info.col) + proc setDirtyFile*(conf: ConfigRef; fileIdx: FileIndex; filename: AbsoluteFile) = assert fileIdx.int32 >= 0 conf.m.fileInfos[fileIdx.int32].dirtyFile = filename @@ -278,7 +296,19 @@ proc toFileLineCol(info: InstantiationInfo): string {.inline.} = result.toLocation(info.filename, info.line, info.column + ColOffset) proc toFileLineCol*(conf: ConfigRef; info: TLineInfo): string {.inline.} = - result.toLocation(toMsgFilename(conf, info), info.line.int, info.col.int + ColOffset) + ## Construct `file(line, col)` string from report location information + result.toLocation( + toMsgFilename(conf, info), info.line.int, info.col.int + ColOffset) + +proc toReportPoint*( + conf: ConfigRef; info: TLineInfo): ReportLineInfo {.inline.} = + ## Construct report location instance based on the information from + ## `info` + + ReportLineInfo( + file: toMsgFilename(conf, info), + line: info.line, + col: info.col + ColOffset) proc `$`*(conf: ConfigRef; info: TLineInfo): string = toFileLineCol(conf, info) @@ -288,36 +318,30 @@ proc `??`* (conf: ConfigRef; info: TLineInfo, filename: string): bool = # only for debugging purposes result = filename in toFilename(conf, info) -type - MsgFlag* = enum ## flags altering msgWriteln behavior - msgStdout, ## force writing to stdout, even stderr is default - msgSkipHook ## skip message hook even if it is present - msgNoUnitSep ## the message is a complete "paragraph". - MsgFlags* = set[MsgFlag] - -proc msgWriteln*(conf: ConfigRef; s: string, flags: MsgFlags = {}) = +proc msgWrite*(conf: ConfigRef; s: string, flags: MsgFlags = {}) = ## Writes given message string to stderr by default. ## If ``--stdout`` option is given, writes to stdout instead. If message hook ## is present, then it is used to output message rather than stderr/stdout. ## This behavior can be altered by given optional flags. - + ## ## This is used for 'nim dump' etc. where we don't have nimsuggest ## support. - #if conf.cmd == cmdIdeTools and optCDebug notin gGlobalOptions: return + ## + ## This procedure is used as a default implementation of the + ## `ConfigRef.writeHook`. let sep = if msgNoUnitSep notin flags: conf.unitSep else: "" - if not isNil(conf.writelnHook) and msgSkipHook notin flags: - conf.writelnHook(s & sep) - elif optStdout in conf.globalOptions or msgStdout in flags: + + if optStdout in conf.globalOptions or msgStdout in flags: if eStdOut in conf.m.errorOutputs: - flushDot(conf) - write stdout, s - writeLine(stdout, sep) + write(stdout, s) + write(stdout, sep) flushFile(stdout) + else: if eStdErr in conf.m.errorOutputs: - flushDot(conf) - write stderr, s - writeLine(stderr, sep) + write(stderr, s) + write(stderr, sep) + # On Windows stderr is fully-buffered when piped, regardless of C std. when defined(windows): flushFile(stderr) @@ -349,80 +373,56 @@ macro callStyledWriteLineStderr(args: varargs[typed]): untyped = # not needed because styledWriteLine already ends with resetAttributes result = newStmtList(result, newCall(bindSym"resetAttributes", bindSym"stderr")) -template callWritelnHook(args: varargs[string, `$`]) = - conf.writelnHook concat(args) - -proc msgWrite(conf: ConfigRef; s: string) = - if conf.m.errorOutputs != {}: - let stdOrr = - if optStdout in conf.globalOptions: - stdout - else: - stderr - write(stdOrr, s) - flushFile(stdOrr) - conf.lastMsgWasDot.incl stdOrr.toStdOrrKind() # subsequent writes need `flushDot` - -template styledMsgWriteln(args: varargs[typed]) = - if not isNil(conf.writelnHook): - callIgnoringStyle(callWritelnHook, nil, args) - elif optStdout in conf.globalOptions: - if eStdOut in conf.m.errorOutputs: - flushDot(conf) - callIgnoringStyle(writeLine, stdout, args) - flushFile(stdout) - elif eStdErr in conf.m.errorOutputs: - flushDot(conf) - if optUseColors in conf.globalOptions: - callStyledWriteLineStderr(args) - else: - callIgnoringStyle(writeLine, stderr, args) - # On Windows stderr is fully-buffered when piped, regardless of C std. - when defined(windows): - flushFile(stderr) - -proc msgKindToString*(kind: TMsgKind): string = MsgKindToStr[kind] - # later versions may provide translated error messages - -proc getMessageStr(msg: TMsgKind, arg: string): string = msgKindToString(msg) % [arg] - -type TErrorHandling* = enum doNothing, doAbort, doRaise - proc log*(s: string) = var f: File if open(f, getHomeDir() / "nimsuggest.log", fmAppend): f.writeLine(s) close(f) -proc quit(conf: ConfigRef; msg: TMsgKind) {.gcsafe.} = - if conf.isDefined("nimDebug"): quitOrRaise(conf, $msg) - elif defined(debug) or msg == errInternal or conf.hasHint(hintStackTrace): +proc quit(conf: ConfigRef; withTrace: bool) {.gcsafe.} = + if conf.isDefined("nimDebug"): + quitOrRaise(conf) + + elif defined(debug) or withTrace or conf.hasHint(rintStackTrace): {.gcsafe.}: - if stackTraceAvailable() and isNil(conf.writelnHook): - writeStackTrace() + if stackTraceAvailable(): + discard conf.report(InternalReport( + kind: rintStackTrace, + trace: getStackTraceEntries())) + else: - styledMsgWriteln(fgRed, """ -No stack traceback available -To create a stacktrace, rerun compilation with './koch temp $1 ', see $2 for details""" % - [conf.command, "intern.html#debugging-the-compiler".createDocLink], conf.unitSep) + discard conf.report(InternalReport( + kind: rintMissingStackTrace)) + quit 1 -proc handleError(conf: ConfigRef; msg: TMsgKind, eh: TErrorHandling, s: string) = - if msg in fatalMsgs: - if conf.cmd == cmdIdeTools: log(s) - quit(conf, msg) - if msg >= errMin and msg <= errMax or - (msg in warnMin..hintMax and msg in conf.warningAsErrors): +proc errorActions( + conf: ConfigRef, + report: Report, + eh: TErrorHandling + ): tuple[action: TErrorHandling, withTrace: bool] = + + if conf.isCompilerFatal(report): + # Fatal message such as ICE (internal compiler), errFatal, + return (doAbort, true) + + elif conf.isCodeError(report): + # Regular code error inc(conf.errorCounter) conf.exitcode = 1'i8 - if conf.errorCounter >= conf.errorMax: + if conf.errorMax <= conf.errorCounter: # only really quit when we're not in the new 'nim check --def' mode: if conf.ideCmd == ideNone: - quit(conf, msg) + return (doAbort, false) + elif eh == doAbort and conf.cmd != cmdIdeTools: - quit(conf, msg) + return (doAbort, false) + elif eh == doRaise: - raiseRecoverableError(s) + {.warning: "[IMPLEMENT] Convert report to string message ?".} + return (doRaise, false) + + return (doNothing, false) proc `==`*(a, b: TLineInfo): bool = result = a.line == b.line and a.fileIndex == b.fileIndex @@ -430,27 +430,26 @@ proc `==`*(a, b: TLineInfo): bool = proc exactEquals*(a, b: TLineInfo): bool = result = a.fileIndex == b.fileIndex and a.line == b.line and a.col == b.col -proc writeContext(conf: ConfigRef; lastinfo: TLineInfo) = - const instantiationFrom = "template/generic instantiation from here" - const instantiationOfFrom = "template/generic instantiation of `$1` from here" +proc getContext*(conf: ConfigRef; lastinfo: TLineInfo): seq[ReportContext] = + ## Get list of context context entries from the current message context + ## information. Context messages can later be used in the + ## `SemReport.context` field var info = lastinfo - for i in 0..= errGenerated and conf.cmd == cmdIdeTools and optIdeDebug notin conf.globalOptions + info = context.info proc addSourceLine(conf: ConfigRef; fileIdx: FileIndex, line: string) = conf.m.fileInfos[fileIdx.int32].lines.add line @@ -478,175 +477,246 @@ proc sourceLine*(conf: ConfigRef; i: TLineInfo): string = result = conf.m.fileInfos[i.fileIndex.int32].lines[i.line.int-1] proc getSurroundingSrc(conf: ConfigRef; info: TLineInfo): string = - if conf.hasHint(hintSource) and info != unknownLineInfo: + if conf.hasHint(rintSource) and info != unknownLineInfo: const indent = " " result = "\n" & indent & $sourceLine(conf, info) if info.col >= 0: result.add "\n" & indent & spaces(info.col) & '^' -proc formatMsg*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg: string): string = - let title = case msg - of warnMin..warnMax: WarningTitle - of hintMin..hintMax: HintTitle - else: ErrorTitle - conf.toFileLineCol(info) & " " & title & getMessageStr(msg, arg) +proc handleReport*( + conf: ConfigRef, + report: Report, + reportFrom: InstantiationInfo, + eh: TErrorHandling = doNothing + ) {.noinline.} = + + var report = report + report.reportFrom = toReportLineInfo(reportFrom) + if report.category == repSem: + if report.location.isSome(): + report.semReport.context = conf.getContext( + report.location.get()) + + let userAction = conf.report(report) + + let (action, trace) = + if userAction == doDefault: + errorActions(conf, report, eh) -proc liMessage*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg: string, - eh: TErrorHandling, info2: InstantiationInfo, isRaw = false) {.noinline.} = - var - title: string - color: ForegroundColor - ignoreMsg = false - sev: Severity - let errorOutputsOld = conf.m.errorOutputs - if msg in fatalMsgs: - # don't gag, refs bug #7080, bug #18278; this can happen with `{.fatal.}` - # or inside a `tryConstExpr`. - conf.m.errorOutputs = {eStdOut, eStdErr} - - let kind = if msg in warnMin..hintMax and msg != hintUserRaw: $msg else: "" # xxx not sure why hintUserRaw is special - case msg - of errMin..errMax: - sev = Severity.Error - writeContext(conf, info) - title = ErrorTitle - color = ErrorColor - when false: - # we try to filter error messages so that not two error message - # in the same file and line are produced: - # xxx `lastError` is only used in this disabled code; but could be useful to revive - ignoreMsg = conf.m.lastError == info and info != unknownLineInfo and eh != doAbort - if info != unknownLineInfo: conf.m.lastError = info - of warnMin..warnMax: - sev = Severity.Warning - ignoreMsg = not conf.hasWarn(msg) - if msg in conf.warningAsErrors: - ignoreMsg = false - title = ErrorTitle - else: - title = WarningTitle - if not ignoreMsg: writeContext(conf, info) - color = WarningColor - inc(conf.warnCounter) - of hintMin..hintMax: - sev = Severity.Hint - ignoreMsg = not conf.hasHint(msg) - if msg in conf.warningAsErrors: - ignoreMsg = false - title = ErrorTitle else: - title = HintTitle - color = HintColor - inc(conf.hintCounter) - - let s = if isRaw: arg else: getMessageStr(msg, arg) - if not ignoreMsg: - let loc = if info != unknownLineInfo: conf.toFileLineCol(info) & " " else: "" - # we could also show `conf.cmdInput` here for `projectIsCmd` - var kindmsg = if kind.len > 0: KindFormat % kind else: "" - if conf.structuredErrorHook != nil: - conf.structuredErrorHook(conf, info, s & kindmsg, sev) - if not ignoreMsgBecauseOfIdeTools(conf, msg): - if msg == hintProcessing and conf.hintProcessingDots: - msgWrite(conf, ".") - else: - styledMsgWriteln(styleBright, loc, resetStyle, color, title, resetStyle, s, KindColor, kindmsg, - resetStyle, conf.getSurroundingSrc(info), conf.unitSep) - if hintMsgOrigin in conf.mainPackageNotes: - # xxx needs a bit of refactoring to honor `conf.filenameOption` - styledMsgWriteln(styleBright, toFileLineCol(info2), resetStyle, - " compiler msg initiated here", KindColor, - KindFormat % $hintMsgOrigin, - resetStyle, conf.unitSep) - handleError(conf, msg, eh, s) - if msg in fatalMsgs: - # most likely would have died here but just in case, we restore state - conf.m.errorOutputs = errorOutputsOld - -template rawMessage*(conf: ConfigRef; msg: TMsgKind, args: openArray[string]) = - let arg = msgKindToString(msg) % args - liMessage(conf, unknownLineInfo, msg, arg, eh = doAbort, instLoc(), isRaw = true) - -template rawMessage*(conf: ConfigRef; msg: TMsgKind, arg: string) = - liMessage(conf, unknownLineInfo, msg, arg, eh = doAbort, instLoc()) - -template fatal*(conf: ConfigRef; info: TLineInfo, arg = "", msg = errFatal) = - liMessage(conf, info, msg, arg, doAbort, instLoc()) - -template globalAssert*(conf: ConfigRef; cond: untyped, info: TLineInfo = unknownLineInfo, arg = "") = + (userAction, false) + + case action: + of doAbort: quit(conf, trace) + of doRaise: raiseRecoverableError("report") + of doNothing: discard + of doDefault: assert( + false, + "Default error handing action must be turned into ignore/raise/abort") + + +proc handleReport*( + conf: ConfigRef, + id: ReportId, + reportFrom: InstantiationInfo, + eh: TErrorHandling = doNothing + ) = + + if true or conf.canReport(id): + conf.m.writtenSemReports.incl id + conf.handleReport(conf.m.reports.getReport(id), reportFrom, eh) + + +template globalAssert*( + conf: ConfigRef; + cond: untyped, info: TLineInfo = unknownLineInfo, arg = "") = ## avoids boilerplate if not cond: var arg2 = "'$1' failed" % [astToStr(cond)] if arg.len > 0: arg2.add "; " & astToStr(arg) & ": " & arg - liMessage(conf, info, errGenerated, arg2, doRaise, instLoc()) + handleReport(conf, info, errGenerated, arg2, doRaise, instLoc()) + +template globalReport*( + conf: ConfigRef; info: TLineInfo, report: ReportTypes) = + ## `local` means compilation keeps going until errorMax is reached (via + ## `doNothing`), `global` means it stops. + handleReport( + conf, wrap(report, instLoc(), info), instLoc(), doRaise) + +template globalReport*(conf: ConfigRef, report: ReportTypes) = + handleReport( + conf, wrap(report, instLoc()), instLoc(), doRaise) + +template localReport*(conf: ConfigRef; info: TLineInfo, report: ReportTypes) = + {.line.}: + handleReport( + conf, wrap(report, instLoc(), info), instLoc(), doNothing) + +template localReport*(conf: ConfigRef; info: TLineInfo, report: ReportTypes) = + handleReport( + conf, wrap(report, instLoc(), info), instLoc(), doNothing) + +template localReport*(conf: ConfigRef; node: PNode, report: SemReport) = + var tmp = report + if isNil(tmp.ast): + tmp.ast = node + handleReport( + conf, wrap(tmp, instLoc(), node.info), instLoc(), doNothing) + +proc temporaryStringError*(conf: ConfigRef, info: TLineInfo, text: string) = + assert false + +template localReport*(conf: ConfigRef, report: ReportTypes) = + handleReport( + conf, wrap(report, instLoc()), instLoc(), doNothing) + +template localReport*(conf: ConfigRef, report: Report) = + handleReport(conf, report, instLoc(), doNothing) + + +proc semReportCountMismatch*( + kind: ReportKind, + expected, got: distinct SomeInteger, + node: PNode = nil, + ): SemReport = + + result = SemReport(kind: kind, ast: node) + result.countMismatch = (toInt128(expected), toInt128(got)) + +template semReportIllformedAst*( + conf: ConfigRef, node: PNode, explain: string): untyped = + + handleReport( + conf, + wrap( + SemReport(kind: rsemIllformedAst, ast: node ), + instLoc(), + node.info), + instLoc(), + doNothing) + +proc joinAnyOf*[T](values: seq[T], quote: bool = false): string = + proc q(s: string): string = + if quote: + "'" & s & "'" + else: + s + + if len(values) == 1: + result.add q($values[0]) -template globalError*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg = "") = - ## `local` means compilation keeps going until errorMax is reached (via `doNothing`), - ## `global` means it stops. - liMessage(conf, info, msg, arg, doRaise, instLoc()) + elif len(values) == 2: + result.add q($values[0]) & " or " & q($values[1]) + + else: + for idx in 0 ..< len(values) - 1: + if idx > 0: + result.add ", " + result.add q($values[idx]) -template globalError*(conf: ConfigRef; info: TLineInfo, arg: string) = - liMessage(conf, info, errGenerated, arg, doRaise, instLoc()) + result.add " or " + result.add q($values[^1]) -template localError*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg = "") = - liMessage(conf, info, msg, arg, doNothing, instLoc()) -template localError*(conf: ConfigRef; info: TLineInfo, arg: string) = - liMessage(conf, info, errGenerated, arg, doNothing, instLoc()) -template message*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg = "") = - liMessage(conf, info, msg, arg, doNothing, instLoc()) +template semReportIllformedAst*( + conf: ConfigRef, node: PNode, expected: set[TNodeKind]): untyped = + var exp: seq[TNodeKind] + for e in expected: + exp.add e -proc warningDeprecated*(conf: ConfigRef, info: TLineInfo = gCmdLineInfo, msg = "") {.inline.} = - message(conf, info, warnDeprecated, msg) + var msg = "Expected " + msg.add joinAnyOf(exp) + msg.add ", but found " + msg.add $node.kind -proc internalErrorImpl(conf: ConfigRef; info: TLineInfo, errMsg: string, info2: InstantiationInfo) = - if conf.cmd == cmdIdeTools and conf.structuredErrorHook.isNil: return - writeContext(conf, info) - liMessage(conf, info, errInternal, errMsg, doAbort, info2) + semReportIllformedAst(conf, node, msg) -template internalError*(conf: ConfigRef; info: TLineInfo, errMsg: string) = - internalErrorImpl(conf, info, errMsg, instLoc()) +template localReport*(conf: ConfigRef, info: TLineInfo, report: ReportTypes) = + handleReport(conf, wrap(report, instLoc(), info), instLoc(), doNothing) -template internalError*(conf: ConfigRef; errMsg: string) = - internalErrorImpl(conf, unknownLineInfo, errMsg, instLoc()) +template internalAssert*( + conf: ConfigRef, e: bool, failMsg: string = "") = -template internalAssert*(conf: ConfigRef, e: bool) = - # xxx merge with `globalAssert` if not e: - const info2 = instLoc() - let arg = info2.toFileLineCol - internalErrorImpl(conf, unknownLineInfo, arg, info2) + handleReport( + conf, + wrap(InternalReport( + kind: rintAssert, msg: failMsg), instLoc()), + instLoc(), + doAbort + ) + +template internalError*( + conf: ConfigRef, repKind: InternalReportKind, fail: string): untyped = + conf.handleReport( + wrap(InternalReport( + kind: repKind, + msg: fail), + instLoc()), + instLoc(), + doAbort + ) + +template internalError*( + conf: ConfigRef, info: TLineInfo, + repKind: InternalReportKind, fail: string): untyped = + conf.handleReport(wrap( + InternalReport( + kind: repKind, msg: fail), instLoc(), info), + instLoc(), doAbort) + +template internalError*( + conf: ConfigRef, + info: TLineInfo, + fail: string, + ): untyped = + + conf.handleReport(wrap( + InternalReport(kind: rintUnreachable, msg: fail), + instLoc(), info), instLoc(), doAbort) + + +template internalError*( + conf: ConfigRef, + fail: string + ): untyped = + + conf.handleReport(wrap(InternalReport( + kind: rintUnreachable, msg: fail), instLoc()), instLoc(), doAbort) -template lintReport*(conf: ConfigRef; info: TLineInfo, beau, got: string, forceHint = false, extraMsg = "") = - let m = "'$1' should be: '$2'$3" % [got, beau, extraMsg] - let msg = if optStyleError in conf.globalOptions and not forceHint: errGenerated else: hintName - liMessage(conf, info, msg, m, doNothing, instLoc()) proc quotedFilename*(conf: ConfigRef; i: TLineInfo): Rope = if i.fileIndex.int32 < 0: result = makeCString "???" + elif optExcessiveStackTrace in conf.globalOptions: result = conf.m.fileInfos[i.fileIndex.int32].quotedFullName + else: result = conf.m.fileInfos[i.fileIndex.int32].quotedName -template listMsg(title, r) = - msgWriteln(conf, title, {msgNoUnitSep}) - for a in r: msgWriteln(conf, " [$1] $2" % [if a in conf.notes: "x" else: " ", $a], {msgNoUnitSep}) +proc listWarnings*(conf: ConfigRef) = + conf.localReport(InternalReport( + kind: rintListWarnings, + enabledOptions: repWarningKinds * conf.notes)) -proc listWarnings*(conf: ConfigRef) = listMsg("Warnings:", warnMin..warnMax) -proc listHints*(conf: ConfigRef) = listMsg("Hints:", hintMin..hintMax) +proc listHints*(conf: ConfigRef) = + conf.localReport(InternalReport( + kind: rintListHints, + enabledOptions: repHintKinds * conf.notes)) proc uniqueModuleName*(conf: ConfigRef; fid: FileIndex): string = - ## The unique module name is guaranteed to only contain {'A'..'Z', 'a'..'z', '0'..'9', '_'} - ## so that it is useful as a C identifier snippet. + ## The unique module name is guaranteed to only contain {'A'..'Z', + ## 'a'..'z', '0'..'9', '_'} so that it is useful as a C identifier + ## snippet. let path = AbsoluteFile toFullPath(conf, fid) let rel = if path.string.startsWith(conf.libpath.string): relativeTo(path, conf.libpath).string else: relativeTo(path, conf.projectPath).string + let trunc = if rel.endsWith(".nim"): rel.len - len(".nim") else: rel.len result = newStringOfCap(trunc) for i in 0.. 0: build.add "; options:" & flags - let sec = formatFloat(epochTime() - conf.lastCmdTime, ffDecimal, 3) - let project = if conf.filenameOption == foAbs: $conf.projectFull else: $conf.projectName - # xxx honor conf.filenameOption more accurately - var output: string + $conf.projectName + if optCompileOnly in conf.globalOptions and conf.cmd != cmdJsonscript: - output = $conf.jsonBuildFile + params.output = $conf.jsonBuildFile + elif conf.outFile.isEmpty and conf.cmd notin {cmdJsonscript} + cmdDocLike + cmdBackends: # for some cmd we expect a valid absOutFile - output = "unknownOutput" + params.output = "unknownOutput" + + else: + params.output = $conf.absOutFile + + when declared(system.getMaxMem): + params.mem = getMaxMem() + params.isMaxMem = true + else: - output = $conf.absOutFile - if conf.filenameOption != foAbs: output = output.AbsoluteFile.extractFilename - # xxx honor filenameOption more accurately - rawMessage(conf, hintSuccessX, [ - "build", build, - "loc", loc, - "sec", sec, - "mem", mem, - "project", project, - "output", output, - ]) + params.mem = getTotalMem() + + if conf.filenameOption != foAbs: + params.output = params.output.AbsoluteFile.extractFilename + + discard conf.report(InternalReport( + kind: rintSuccessX, buildParams: params)) diff --git a/compiler/nilcheck.nim b/compiler/nilcheck.nim index 9c2d091f766..92af849fd06 100644 --- a/compiler/nilcheck.nim +++ b/compiler/nilcheck.nim @@ -7,7 +7,9 @@ # distribution, for details about the copyright. # -import ast, renderer, intsets, tables, msgs, options, lineinfos, strformat, idents, treetab, hashes +import ast, renderer, intsets, tables, msgs, options, lineinfos, + strformat, idents, treetab, hashes, reports, nilcheck_enums + import sequtils, strutils, sets # IMPORTANT: notes not up to date, i'll update this comment again @@ -116,51 +118,32 @@ type ## the set index SetIndex = distinct int - ## transition kind: - ## what was the reason for changing the nilability of an expression - ## useful for error messages and showing why an expression is being detected as nil / maybe nil - TransitionKind = enum TArg, TAssign, TType, TNil, TVarArg, TResult, TSafe, TPotentialAlias, TDependant - - ## keep history for each transition - History = object - info: TLineInfo ## the location - nilability: Nilability ## the nilability - kind: TransitionKind ## what kind of transition was that - node: PNode ## the node of the expression - ## the context for the checker: an instance for each procedure NilCheckerContext = ref object + ## the context for the checker: an instance for each procedure # abstractTime: AbstractTime # partitions: Partitions # symbolGraphs: Table[Symbol, ] symbolIndices: Table[Symbol, ExprIndex] ## index for each symbol expressions: SeqOfDistinct[ExprIndex, PNode] ## a sequence of pre-indexed expressions - dependants: SeqOfDistinct[ExprIndex, IntSet] ## expr indices for expressions which are compound and based on others - warningLocations: HashSet[TLineInfo] ## warning locations to check we don't warn twice for stuff like warnings in for loops + dependants: SeqOfDistinct[ExprIndex, IntSet] ## expr indices for + ## expressions which are compound and based on others + warningLocations: HashSet[TLineInfo] ## warning locations to check we + ## don't warn twice for stuff like warnings in for loops idgen: IdGenerator ## id generator config: ConfigRef ## the config of the compiler - ## a map that is containing the current nilability for usually a branch - ## and is pointing optionally to a parent map: they make a stack of maps NilMap = ref object - expressions: SeqOfDistinct[ExprIndex, Nilability] ## the expressions with the same order as in NilCheckerContext - history: SeqOfDistinct[ExprIndex, seq[History]] ## history for each of them + ## a map that is containing the current nilability for usually a branch + ## and is pointing optionally to a parent map: they make a stack of maps + expressions: SeqOfDistinct[ExprIndex, Nilability] ## the expressions + ## with the same order as in NilCheckerContext + history: SeqOfDistinct[ExprIndex, seq[SemNilHistory]] ## history for each of them # what about gc and refs? setIndices: SeqOfDistinct[ExprIndex, SetIndex] ## set indices for each expression sets: SeqOfDistinct[SetIndex, IntSet] ## disjoint sets with the aliased expressions parent: NilMap ## the parent map - ## Nilability : if a value is nilable. - ## we have maybe nil and nil, so we can differentiate between - ## cases where we know for sure a value is nil and not - ## otherwise we can have Safe, MaybeNil - ## Parent: is because we just use a sequence with the same length - ## instead of a table, and we need to check if something was initialized - ## at all: if Parent is set, then you need to check the parent nilability - ## if the parent is nil, then for now we return MaybeNil - ## unreachable is the result of add(Safe, Nil) and others - ## it is a result of no states left, so it's usually e.g. in unreachable else branches? - Nilability* = enum Parent, Safe, MaybeNil, Nil, Unreachable ## check Check = object @@ -225,7 +208,7 @@ proc newNilMap(parent: NilMap = nil, count: int = -1): NilMap = expressionsCount = parent.expressions.len.int result = NilMap( expressions: newSeqOfDistinct[ExprIndex, Nilability](expressionsCount), - history: newSeqOfDistinct[ExprIndex, seq[History]](expressionsCount), + history: newSeqOfDistinct[ExprIndex, seq[SemNilHistory]](expressionsCount), setIndices: newSeqOfDistinct[ExprIndex, SetIndex](expressionsCount), parent: parent) if parent.isNil: @@ -257,7 +240,7 @@ proc `[]`(map: NilMap, index: ExprIndex): Nilability = now = now.parent return MaybeNil -proc history(map: NilMap, index: ExprIndex): seq[History] = +proc history(map: NilMap, index: ExprIndex): seq[SemNilHistory] = if index < map.expressions.len: map.history[index] else: @@ -385,11 +368,20 @@ proc aliasSet(ctx: NilCheckerContext, map: NilMap, index: ExprIndex): IntSet = -proc store(map: NilMap, ctx: NilCheckerContext, index: ExprIndex, value: Nilability, kind: TransitionKind, info: TLineInfo, node: PNode = nil) = +proc store( + map: NilMap, + ctx: NilCheckerContext, + index: ExprIndex, + value: Nilability, + kind: NilTransition, + info: TLineInfo, + node: PNode = nil + ) = + if index == noExprIndex: return map.expressions[index] = value - map.history[index].add(History(info: info, kind: kind, node: node, nilability: value)) + map.history[index].add(SemNilHistory(info: info, kind: kind, node: node, nilability: value)) #echo node, " ", index, " ", value #echo ctx.namedMapAndSetsDebugInfo(map) #for a, b in map.sets: @@ -404,7 +396,8 @@ proc store(map: NilMap, ctx: NilCheckerContext, index: ExprIndex, value: Nilabil if value == Safe: map.history[a.ExprIndex] = @[] else: - map.history[a.ExprIndex].add(History(info: info, kind: TPotentialAlias, node: node, nilability: value)) + map.history[a.ExprIndex].add( + SemNilHistory(info: info, kind: TPotentialAlias, node: node, nilability: value)) proc moveOut(ctx: NilCheckerContext, map: NilMap, target: PNode) = #echo "move out ", target @@ -541,38 +534,19 @@ proc checkCall(n, ctx, map): Check = result.nilability = Safe # echo result.map -template event(b: History): string = - case b.kind: - of TArg: "param with nilable type" - of TNil: "it returns true for isNil" - of TAssign: "assigns a value which might be nil" - of TVarArg: "passes it as a var arg which might change to nil" - of TResult: "it is nil by default" - of TType: "it has ref type" - of TSafe: "it is safe here as it returns false for isNil" - of TPotentialAlias: "it might be changed directly or through an alias" - of TDependant: "it might be changed because its base might be changed" - proc derefWarning(n, ctx, map; kind: Nilability) = ## a warning for potentially unsafe dereference if n.info in ctx.warningLocations: return ctx.warningLocations.incl(n.info) - var a: seq[History] + var a: seq[SemNilHistory] + var rep = SemReport( + kind: rsemStrictNotNilExpr, nilIssue: kind, ast: n) + if n.kind == nkSym: - a = history(map, ctx.index(n)) - var res = "" - var issue = case kind: - of Nil: "it is nil" - of MaybeNil: "it might be nil" - of Unreachable: "it is unreachable" - else: "" - res.add("can't deref " & $n & ", " & issue) - if a.len > 0: - res.add("\n") - for b in a: - res.add(" " & event(b) & " on line " & $b.info.line & ":" & $b.info.col) - message(ctx.config, n.info, warnStrictNotNil, res) + rep.nilHistory = history(map, ctx.index(n)) + + localReport(ctx.config, n.info, rep) proc handleNilability(check: Check; n, ctx, map) = ## handle the check: @@ -1064,7 +1038,7 @@ proc reverse(value: Nilability): Nilability = of Parent: Parent of Unreachable: Unreachable -proc reverse(kind: TransitionKind): TransitionKind = +proc reverse(kind: NilTransition): NilTransition = case kind: of TNil: TSafe of TSafe: TNil @@ -1174,12 +1148,9 @@ proc checkCondition(n, ctx, map; reverse: bool, base: bool): NilMap = proc checkResult(n, ctx, map) = let resultNilability = map[resultExprIndex] case resultNilability: - of Nil: - message(ctx.config, n.info, warnStrictNotNil, "return value is nil") - of MaybeNil: - message(ctx.config, n.info, warnStrictNotNil, "return value might be nil") - of Unreachable: - message(ctx.config, n.info, warnStrictNotNil, "return value is unreachable") + of Nil, MaybeNil, Unreachable: + localReport(ctx.config, n.info, SemReport( + kind: rsemStrictNotNilResult, nilIssue: resultNilability)) of Safe, Parent: discard diff --git a/compiler/nilcheck_enums.nim b/compiler/nilcheck_enums.nim new file mode 100644 index 00000000000..d044e660b3f --- /dev/null +++ b/compiler/nilcheck_enums.nim @@ -0,0 +1,33 @@ +## Enum types used in nilability check reports and `nilcheck` +## implementation itself + +type + NilTransition* = enum + ## transition kind: what was the reason for changing the nilability of + ## an expression useful for error messages and showing why an + ## expression is being detected as nil / maybe nil + TArg + TAssign + TType + TNil + TVarArg + TResult + TSafe + TPotentialAlias + TDependant + + Nilability* = enum + ## Nilability : if a value is nilable. we have maybe nil and nil, so we + ## can differentiate between cases where we know for sure a value is + ## nil and not otherwise we can have Safe, MaybeNil Parent: is because + ## we just use a sequence with the same length instead of a table, and + ## we need to check if something was initialized at all: if Parent is + ## set, then you need to check the parent nilability if the parent is + ## nil, then for now we return MaybeNil unreachable is the result of + ## add(Safe, Nil) and others it is a result of no states left, so it's + ## usually e.g. in unreachable else branches? + Parent + Safe + MaybeNil + Nil + Unreachable diff --git a/compiler/nim.nim b/compiler/nim.nim index b8256d576aa..ddc73a9196b 100644 --- a/compiler/nim.nim +++ b/compiler/nim.nim @@ -7,7 +7,7 @@ # distribution, for details about the copyright. # -import std/[os, strutils, parseopt] +import std/[os] when defined(windows) and not defined(nimKochBootstrap): # remove workaround pending bootstrap >= 1.5.1 # refs https://github.com/nim-lang/Nim/issues/18334#issuecomment-867114536 @@ -24,8 +24,9 @@ when defined(windows) and not defined(nimKochBootstrap): {.link: "../icons/nim-i386-windows-vcc.res".} import - commands, options, msgs, extccomp, main, idents, lineinfos, cmdlinehelper, - pathutils, modulegraphs + cli_reporter, + commands, options, msgs, extccomp, main, idents, cmdlinehelper, + pathutils, modulegraphs, reports from browsers import openDefaultBrowser from nodejs import findNodeJs @@ -37,38 +38,6 @@ when defined(profiler) or defined(memProfiler): {.hint: "Profiling support is turned on!".} import nimprof -proc processCmdLine(pass: TCmdLinePass, cmd: string; config: ConfigRef) = - var p = parseopt.initOptParser(cmd) - var argsCount = 0 - - config.commandLine.setLen 0 - # bugfix: otherwise, config.commandLine ends up duplicated - - while true: - parseopt.next(p) - case p.kind - of cmdEnd: break - of cmdLongOption, cmdShortOption: - config.commandLine.add " " - config.commandLine.addCmdPrefix p.kind - config.commandLine.add p.key.quoteShell # quoteShell to be future proof - if p.val.len > 0: - config.commandLine.add ':' - config.commandLine.add p.val.quoteShell - - if p.key == "": # `-` was passed to indicate main project is stdin - p.key = "-" - if processArgument(pass, p, argsCount, config): break - else: - processSwitch(pass, p, config) - of cmdArgument: - config.commandLine.add " " - config.commandLine.add p.key.quoteShell - if processArgument(pass, p, argsCount, config): break - if pass == passCmd2: - if {optRun, optWasNimscript} * config.globalOptions == {} and - config.arguments.len > 0 and config.cmd notin {cmdTcc, cmdNimscript, cmdCrun}: - rawMessage(config, errGenerated, errArgsNeedRunOption) proc getNimRunExe(conf: ConfigRef): string = # xxx consider defining `conf.getConfigVar("nimrun.exe")` to allow users to @@ -78,6 +47,9 @@ proc getNimRunExe(conf: ConfigRef): string = elif conf.isDefined("amd64"): result = "wine64" proc handleCmdLine(cache: IdentCache; conf: ConfigRef) = + ## Main entry point to the compiler - dispatches command-line commands + ## into different subsystems, sets up configuration options for the + ## `conf`:arg: and so on. let self = NimProg( supportsStdinFile: true, processCmdLine: processCmdLine @@ -89,11 +61,15 @@ proc handleCmdLine(cache: IdentCache; conf: ConfigRef) = self.processCmdLineAndProjectPath(conf) var graph = newModuleGraph(cache, conf) + if not self.loadConfigsAndProcessCmdLine(cache, conf, graph): return + mainCommand(graph) - if conf.hasHint(hintGCStats): echo(GC_getStatistics()) - #echo(GC_getStatistics()) + if conf.hasHint(rintGCStats): + conf.localReport(InternalReport( + kind: rintGCStats, msg: GC_getStatistics())) + if conf.errorCounter != 0: return when hasTinyCBackend: if conf.cmd == cmdTcc: @@ -116,26 +92,40 @@ proc handleCmdLine(cache: IdentCache; conf: ConfigRef) = if cmdPrefix.len > 0: cmdPrefix.add " " # without the `cmdPrefix.len > 0` check, on windows you'd get a cryptic: # `The parameter is incorrect` - execExternalProgram(conf, cmdPrefix & output.quoteShell & ' ' & conf.arguments) + execExternalProgram( + conf, cmdPrefix & output.quoteShell & ' ' & conf.arguments, rcmdExecuting) + of cmdDocLike, cmdRst2html, cmdRst2tex: # bugfix(cmdRst2tex was missing) if conf.arguments.len > 0: # reserved for future use - rawMessage(conf, errGenerated, "'$1 cannot handle arguments" % [$conf.cmd]) + localReport(conf, ExternalReport( + kind: rextExpectedNoCmdArgument, cmdlineSwitch: $conf.cmd)) + openDefaultBrowser($output) else: # support as needed - rawMessage(conf, errGenerated, "'$1 cannot handle --run" % [$conf.cmd]) + localReport(conf, ExternalReport( + kind: rextUnexpectedRunOpt, cmdlineSwitch: $conf.cmd)) when declared(GC_setMaxPause): GC_setMaxPause 2_000 when compileOption("gc", "refc"): - # the new correct mark&sweet collector is too slow :-/ + # the new correct mark&sweep collector is too slow :-/ GC_disableMarkAndSweep() when not defined(selftest): - let conf = newConfigRef() + var conf = newConfigRef(cli_reporter.reportHook) + conf.writeHook = + proc(conf: ConfigRef, msg: string, flags: MsgFlags) = + msgs.msgWrite(conf, msg, flags) + + conf.writelnHook = + proc(conf: ConfigRef, msg: string, flags: MsgFlags) = + conf.writeHook(conf, msg & "\n", flags) + handleCmdLine(newIdentCache(), conf) when declared(GC_setMaxPause): echo GC_getStatistics() + msgQuit(int8(conf.errorCounter > 0)) diff --git a/compiler/nimblecmd.nim b/compiler/nimblecmd.nim index 9cd2941ba46..e00f4d9a38c 100644 --- a/compiler/nimblecmd.nim +++ b/compiler/nimblecmd.nim @@ -12,6 +12,8 @@ import parseutils, strutils, os, options, msgs, sequtils, lineinfos, pathutils, std/sha1, tables +import reports + proc addPath*(conf: ConfigRef; path: AbsoluteDir, info: TLineInfo) = if not conf.searchPaths.contains(path): conf.searchPaths.insert(path, 0) @@ -110,7 +112,8 @@ proc addPackage*(conf: ConfigRef; packages: var PackageInfo, p: string; else: packages[name] = ($version, "") else: - localError(conf, info, "invalid package name: " & p) + conf.localReport ExternalReport( + kind: rextInvalidPackageName, packageName: p) iterator chosen(packages: PackageInfo): string = for key, val in pairs(packages): @@ -136,7 +139,7 @@ proc addNimblePath(conf: ConfigRef; p: string, info: TLineInfo) = path = p / path if not contains(conf.searchPaths, AbsoluteDir path): - message(conf, info, hintPath, path) + conf.localReport ExternalReport(kind: rextPath, packagePath: path) conf.lazyPaths.insert(AbsoluteDir path, 0) proc addPathRec(conf: ConfigRef; dir: string, info: TLineInfo) = diff --git a/compiler/nimconf.nim b/compiler/nimconf.nim index 1cf22e20a9d..50f3289fbc2 100644 --- a/compiler/nimconf.nim +++ b/compiler/nimconf.nim @@ -10,8 +10,8 @@ # This module handles the reading of the config file. import - llstream, commands, os, strutils, msgs, lexer, ast, - options, idents, wordrecg, strtabs, lineinfos, pathutils, scriptconfig + llstream, commands, os, strutils, msgs, lexer, ast, reports, + options, idents, wordrecg, strtabs, pathutils, scriptconfig # ---------------- configuration file parser ----------------------------- # we use Nim's lexer here to save space and work @@ -26,8 +26,11 @@ proc parseAtom(L: var Lexer, tok: var Token; config: ConfigRef): bool = if tok.tokType == tkParLe: ppGetTok(L, tok) result = parseExpr(L, tok, config) - if tok.tokType == tkParRi: ppGetTok(L, tok) - else: lexMessage(L, errGenerated, "expected closing ')'") + if tok.tokType == tkParRi: + ppGetTok(L, tok) + else: + localReport(L, LexerReport(kind: rlexExpectedToken, msg: ")")) + elif tok.tokType == tkNot: ppGetTok(L, tok) result = not parseAtom(L, tok, config) @@ -52,13 +55,18 @@ proc parseExpr(L: var Lexer, tok: var Token; config: ConfigRef): bool = proc evalppIf(L: var Lexer, tok: var Token; config: ConfigRef): bool = ppGetTok(L, tok) # skip 'if' or 'elif' result = parseExpr(L, tok, config) - if tok.tokType == tkColon: ppGetTok(L, tok) - else: lexMessage(L, errGenerated, "expected ':'") + if tok.tokType == tkColon: + ppGetTok(L, tok) + + else: + localReport(L, LexerReport(kind: rlexExpectedToken, msg: ":")) #var condStack: seq[bool] = @[] proc doEnd(L: var Lexer, tok: var Token; condStack: var seq[bool]) = - if high(condStack) < 0: lexMessage(L, errGenerated, "expected @if") + if high(condStack) < 0: + localReport(L, LexerReport(kind: rlexExpectedToken, msg: "@if")) + ppGetTok(L, tok) # skip 'end' setLen(condStack, high(condStack)) @@ -69,16 +77,26 @@ type proc jumpToDirective(L: var Lexer, tok: var Token, dest: TJumpDest; config: ConfigRef; condStack: var seq[bool]) proc doElse(L: var Lexer, tok: var Token; config: ConfigRef; condStack: var seq[bool]) = - if high(condStack) < 0: lexMessage(L, errGenerated, "expected @if") + if high(condStack) < 0: + localReport(L, LexerReport(kind: rlexExpectedToken, msg: "@if")) + ppGetTok(L, tok) - if tok.tokType == tkColon: ppGetTok(L, tok) - if condStack[high(condStack)]: jumpToDirective(L, tok, jdEndif, config, condStack) + if tok.tokType == tkColon: + ppGetTok(L, tok) + + if condStack[high(condStack)]: + jumpToDirective(L, tok, jdEndif, config, condStack) proc doElif(L: var Lexer, tok: var Token; config: ConfigRef; condStack: var seq[bool]) = - if high(condStack) < 0: lexMessage(L, errGenerated, "expected @if") + if high(condStack) < 0: + localReport(L, LexerReport(kind: rlexExpectedToken, msg: "@if")) + var res = evalppIf(L, tok, config) - if condStack[high(condStack)] or not res: jumpToDirective(L, tok, jdElseEndif, config, condStack) - else: condStack[high(condStack)] = true + if condStack[high(condStack)] or not res: + jumpToDirective(L, tok, jdElseEndif, config, condStack) + + else: + condStack[high(condStack)] = true proc jumpToDirective(L: var Lexer, tok: var Token, dest: TJumpDest; config: ConfigRef; condStack: var seq[bool]) = @@ -106,7 +124,7 @@ proc jumpToDirective(L: var Lexer, tok: var Token, dest: TJumpDest; config: Conf discard ppGetTok(L, tok) elif tok.tokType == tkEof: - lexMessage(L, errGenerated, "expected @end") + localReport(L, LexerReport(kind: rlexExpectedToken, msg: "@end")) else: ppGetTok(L, tok) @@ -123,8 +141,10 @@ proc parseDirective(L: var Lexer, tok: var Token; config: ConfigRef; condStack: of wEnd: doEnd(L, tok, condStack) of wWrite: ppGetTok(L, tok) - msgs.msgWriteln(config, strtabs.`%`($tok, config.configVars, - {useEnvironment, useKey})) + L.localReport(InternalReport( + kind: rintNimconfWrite, + msg: strtabs.`%`($tok, config.configVars, {useEnvironment, useKey}))) + ppGetTok(L, tok) else: case tok.ident.s.normalize @@ -134,20 +154,28 @@ proc parseDirective(L: var Lexer, tok: var Token; config: ConfigRef; condStack: ppGetTok(L, tok) os.putEnv(key, $tok) ppGetTok(L, tok) + of "prependenv": ppGetTok(L, tok) var key = $tok ppGetTok(L, tok) os.putEnv(key, $tok & os.getEnv(key)) ppGetTok(L, tok) + of "appendenv": ppGetTok(L, tok) var key = $tok ppGetTok(L, tok) os.putEnv(key, os.getEnv(key) & $tok) ppGetTok(L, tok) + + of "trace": + ppGetTok(L, tok) + localReport(L, DebugReport(kind: rdbgCfgTrace, str: $tok)) + ppGetTok(L, tok) + else: - lexMessage(L, errGenerated, "invalid directive: '$1'" % $tok) + localReport(L, LexerReport(kind: rlexCfgInvalidDirective, msg: $tok)) proc confTok(L: var Lexer, tok: var Token; config: ConfigRef; condStack: var seq[bool]) = ppGetTok(L, tok) @@ -156,7 +184,7 @@ proc confTok(L: var Lexer, tok: var Token; config: ConfigRef; condStack: var seq proc checkSymbol(L: Lexer, tok: Token) = if tok.tokType notin {tkSymbol..tkInt64Lit, tkStrLit..tkTripleStrLit}: - lexMessage(L, errGenerated, "expected identifier, but got: " & $tok) + localReport(L, ParserReport(kind: rparIdentExpected, msg: $tok)) proc parseAssignment(L: var Lexer, tok: var Token; config: ConfigRef; condStack: var seq[bool]) = @@ -181,8 +209,12 @@ proc parseAssignment(L: var Lexer, tok: var Token; val.add('[') val.add($tok) confTok(L, tok, config, condStack) - if tok.tokType == tkBracketRi: confTok(L, tok, config, condStack) - else: lexMessage(L, errGenerated, "expected closing ']'") + if tok.tokType == tkBracketRi: + confTok(L, tok, config, condStack) + + else: + localReport(L, LexerReport(kind: rlexExpectedToken, msg: "]")) + val.add(']') let percent = tok.ident != nil and tok.ident.s == "%=" if tok.tokType in {tkColon, tkEquals} or percent: @@ -214,16 +246,29 @@ proc readConfigFile*(filename: AbsoluteFile; cache: IdentCache; L: Lexer tok: Token stream: PLLStream + stream = llStreamOpen(filename, fmRead) if stream != nil: + config.localReport DebugReport( + kind: rdbgStartingConfRead, + filename: filename.string + ) + initToken(tok) openLexer(L, filename, stream, cache, config) tok.tokType = tkEof # to avoid a pointless warning var condStack: seq[bool] = @[] confTok(L, tok, config, condStack) # read in the first token while tok.tokType != tkEof: parseAssignment(L, tok, config, condStack) - if condStack.len > 0: lexMessage(L, errGenerated, "expected @end") + if condStack.len > 0: + localReport(L, LexerReport(kind: rlexExpectedToken, msg: "@end")) closeLexer(L) + + config.localReport DebugReport( + kind: rdbgFinishedConfRead, + filename: filename.string + ) + return true proc getUserConfigPath*(filename: RelativeFile): AbsoluteFile = @@ -238,37 +283,55 @@ proc getSystemConfigPath*(conf: ConfigRef; filename: RelativeFile): AbsoluteFile if not fileExists(result): result = p / RelativeDir"etc/nim" / filename if not fileExists(result): result = AbsoluteDir"/etc/nim" / filename -proc loadConfigs*(cfg: RelativeFile; cache: IdentCache; conf: ConfigRef; idgen: IdGenerator) = +proc loadConfigs*( + cfg: RelativeFile; cache: IdentCache; + conf: ConfigRef; idgen: IdGenerator + ) = + + setDefaultLibpath(conf) - template readConfigFile(path) = + proc readConfigFile(path: AbsoluteFile) = let configPath = path if readConfigFile(configPath, cache, conf): conf.configFiles.add(configPath) - template runNimScriptIfExists(path: AbsoluteFile, isMain = false) = + proc runNimScriptIfExists(path: AbsoluteFile, isMain = false) = let p = path # eval once var s: PLLStream if isMain and optWasNimscript in conf.globalOptions: - if conf.projectIsStdin: s = stdin.llStreamOpen - elif conf.projectIsCmd: s = llStreamOpen(conf.cmdInput) - if s == nil and fileExists(p): s = llStreamOpen(p, fmRead) + if conf.projectIsStdin: + s = stdin.llStreamOpen + + elif conf.projectIsCmd: + s = llStreamOpen(conf.cmdInput) + + if s == nil and fileExists(p): + s = llStreamOpen(p, fmRead) + if s != nil: conf.configFiles.add(p) runNimScript(cache, p, idgen, freshDefines = false, conf, s) + if optSkipSystemConfigFile notin conf.globalOptions: readConfigFile(getSystemConfigPath(conf, cfg)) if cfg == DefaultConfig: runNimScriptIfExists(getSystemConfigPath(conf, DefaultConfigNims)) + if optSkipUserConfigFile notin conf.globalOptions: readConfigFile(getUserConfigPath(cfg)) if cfg == DefaultConfig: runNimScriptIfExists(getUserConfigPath(DefaultConfigNims)) - let pd = if not conf.projectPath.isEmpty: conf.projectPath else: AbsoluteDir(getCurrentDir()) + let pd = if not conf.projectPath.isEmpty: + conf.projectPath + else: + AbsoluteDir(getCurrentDir()) + + if optSkipParentConfigFiles notin conf.globalOptions: for dir in parentDirs(pd.string, fromRoot=true, inclusive=false): readConfigFile(AbsoluteDir(dir) / cfg) @@ -294,7 +357,7 @@ proc loadConfigs*(cfg: RelativeFile; cache: IdentCache; conf: ConfigRef; idgen: template showHintConf = for filename in conf.configFiles: # delayed to here so that `hintConf` is honored - rawMessage(conf, hintConf, filename.string) + localReport(conf, ExternalReport(kind: rextConf, msg: filename.string)) if conf.cmd == cmdNimscript: showHintConf() conf.configFiles.setLen 0 diff --git a/compiler/nimeval.nim b/compiler/nimeval.nim index 82e2f081218..8cb01780228 100644 --- a/compiler/nimeval.nim +++ b/compiler/nimeval.nim @@ -12,7 +12,8 @@ import ast, astalgo, modules, passes, condsyms, options, sem, llstream, lineinfos, vm, vmdef, modulegraphs, idents, os, pathutils, - passaux, scriptconfig, std/compilesettings + passaux, scriptconfig, std/compilesettings, + reports type Interpreter* = ref object ## Use Nim as an interpreter with this object @@ -101,12 +102,16 @@ proc findNimStdLibCompileTime*(): string = result = querySetting(libPath) doAssert fileExists(result / "system.nim"), "result:" & result -proc createInterpreter*(scriptName: string; - searchPaths: openArray[string]; - flags: TSandboxFlags = {}, - defines = @[("nimscript", "true")], - registerOps = true): Interpreter = - var conf = newConfigRef() +proc createInterpreter*( + scriptName: string, + searchPaths: openArray[string], + hook: ReportHook, + flags: TSandboxFlags = {}, + defines: seq[(string, string)] = @[("nimscript", "true")], + registerOps: bool = true + ): Interpreter = + + var conf = newConfigRef(hook) var cache = newIdentCache() var graph = newModuleGraph(cache, conf) connectCallbacks(graph) @@ -136,16 +141,21 @@ proc destroyInterpreter*(i: Interpreter) = ## destructor. discard "currently nothing to do." -proc registerErrorHook*(i: Interpreter, hook: - proc (config: ConfigRef; info: TLineInfo; msg: string; - severity: Severity) {.gcsafe.}) = - i.graph.config.structuredErrorHook = hook - -proc runRepl*(r: TLLRepl; - searchPaths: openArray[string]; - supportNimscript: bool) = +proc registerErrorHook*( + i: Interpreter, + hook: proc (config: ConfigRef, report: Report): TErrorHandling {.gcsafe.} + ) = + i.graph.config.structuredReportHook = hook + +proc runRepl*( + r: TLLRepl; + searchPaths: openArray[string]; + supportNimscript: bool, + reportHook: ReportHook + ) = ## deadcode but please don't remove... might be revived - var conf = newConfigRef() + var conf = newConfigRef(reportHook) + var cache = newIdentCache() var graph = newModuleGraph(cache, conf) diff --git a/compiler/optimizer.nim b/compiler/optimizer.nim index 744c82ab509..dbe01d7f40c 100644 --- a/compiler/optimizer.nim +++ b/compiler/optimizer.nim @@ -12,7 +12,7 @@ ## - recognize "all paths lead to 'wasMoved(x)'" import - ast, renderer, idents, intsets + ast, renderer, intsets from trees import exprStructuralEquivalent diff --git a/compiler/options.nim b/compiler/options.nim index f3b8276f685..1a4965c2a0d 100644 --- a/compiler/options.nim +++ b/compiler/options.nim @@ -9,7 +9,12 @@ import os, strutils, strtabs, sets, lineinfos, platform, - prefixmatches, pathutils, nimpaths, tables + prefixmatches, pathutils, nimpaths, tables, reports + +import std/options as sopt + +from ast_types import TOption, TOptions +export TOption, TOptions from terminal import isatty from times import utc, fromUnix, local, getTime, format, DateTime @@ -23,85 +28,65 @@ const nimEnableCovariance* = defined(nimEnableCovariance) -type # please make sure we have under 32 options - # (improves code efficiency a lot!) - TOption* = enum # **keep binary compatible** - optNone, optObjCheck, optFieldCheck, optRangeCheck, optBoundsCheck, - optOverflowCheck, optRefCheck, - optNaNCheck, optInfCheck, optStaticBoundsCheck, optStyleCheck, - optAssert, optLineDir, optWarns, optHints, - optOptimizeSpeed, optOptimizeSize, - optStackTrace, # stack tracing support - optStackTraceMsgs, # enable custom runtime msgs via `setFrameMsg` - optLineTrace, # line tracing support (includes stack tracing) - optByRef, # use pass by ref for objects - # (for interfacing with C) - optProfiler, # profiler turned on - optImplicitStatic, # optimization: implicit at compile time - # evaluation - optTrMacros, # en/disable pattern matching - optMemTracker, - optSinkInference # 'sink T' inference - optCursorInference - optImportHidden - - TOptions* = set[TOption] +type TGlobalOption* = enum gloptNone, optForceFullMake, - optWasNimscript, # redundant with `cmdNimscript`, could be removed + optWasNimscript, ## redundant with `cmdNimscript`, could be removed optListCmd, optCompileOnly, optNoLinking, - optCDebug, # turn on debugging information - optGenDynLib, # generate a dynamic library - optGenStaticLib, # generate a static library - optGenGuiApp, # generate a GUI application - optGenScript, # generate a script file to compile the *.c files - optGenMapping, # generate a mapping file - optRun, # run the compiled project - optUseNimcache, # save artifacts (including binary) in $nimcache - optStyleHint, # check that the names adhere to NEP-1 - optStyleError, # enforce that the names adhere to NEP-1 - optStyleUsages, # only enforce consistent **usages** of the symbol - optSkipSystemConfigFile, # skip the system's cfg/nims config file - optSkipProjConfigFile, # skip the project's cfg/nims config file - optSkipUserConfigFile, # skip the users's cfg/nims config file - optSkipParentConfigFiles, # skip parent dir's cfg/nims config files - optNoMain, # do not generate a "main" proc - optUseColors, # use colors for hints, warnings, and errors - optThreads, # support for multi-threading - optStdout, # output to stdout - optThreadAnalysis, # thread analysis pass - optTlsEmulation, # thread var emulation turned on - optGenIndex # generate index file for documentation; - optEmbedOrigSrc # embed the original source in the generated code - # also: generate header file - optIdeDebug # idetools: debug mode - optIdeTerse # idetools: use terse descriptions - optExcessiveStackTrace # fully qualified module filenames - optShowAllMismatches # show all overloading resolution candidates - optWholeProject # for 'doc': output any dependency - optDocInternal # generate documentation for non-exported symbols - optMixedMode # true if some module triggered C++ codegen - optDeclaredLocs # show declaration locations in messages + optCDebug, ## turn on debugging information + optGenDynLib, ## generate a dynamic library + optGenStaticLib, ## generate a static library + optGenGuiApp, ## generate a GUI application + optGenScript, ## generate a script file to compile the *.c files + optGenMapping, ## generate a mapping file + optRun, ## run the compiled project + optUseNimcache, ## save artifacts (including binary) in $nimcache + optStyleHint, ## check that the names adhere to NEP-1 + optStyleError, ## enforce that the names adhere to NEP-1 + optStyleUsages, ## only enforce consistent **usages** of the symbol + optSkipSystemConfigFile, ## skip the system's cfg/nims config file + optSkipProjConfigFile, ## skip the project's cfg/nims config file + optSkipUserConfigFile, ## skip the users's cfg/nims config file + optSkipParentConfigFiles, ## skip parent dir's cfg/nims config files + optNoMain, ## do not generate a "main" proc + optUseColors, ## use colors for hints, warnings, and errors + optThreads, ## support for multi-threading + optStdout, ## output to stdout + optThreadAnalysis, ## thread analysis pass + optTlsEmulation, ## thread var emulation turned on + optGenIndex ## generate index file for documentation; + optEmbedOrigSrc ## embed the original source in the generated code + ## also: generate header file + optIdeDebug ## idetools: debug mode + optIdeTerse ## idetools: use terse descriptions + optExcessiveStackTrace ## fully qualified module filenames + optShowAllMismatches ## show all overloading resolution candidates + optWholeProject ## for 'doc': output any dependency + optDocInternal ## generate documentation for non-exported symbols + optMixedMode ## true if some module triggered C++ codegen + optDeclaredLocs ## show declaration locations in messages optNoNimblePath optHotCodeReloading optDynlibOverrideAll - optSeqDestructors # active if the implementation uses the new - # string/seq implementation based on destructors - optTinyRtti # active if we use the new "tiny RTTI" - # implementation - optOwnedRefs # active if the Nim compiler knows about 'owned'. + optSeqDestructors ## active if the implementation uses the new + ## string/seq implementation based on destructors + optTinyRtti ## active if we use the new "tiny RTTI" + ## implementation + optOwnedRefs ## active if the Nim compiler knows about 'owned'. optMultiMethods - optBenchmarkVM # Enables cpuTime() in the VM - optProduceAsm # produce assembler code - optPanics # turn panics (sysFatal) into a process termination - optNimV1Emulation # emulate Nim v1.0 - optNimV12Emulation # emulate Nim v1.2 + optBenchmarkVM ## Enables cpuTime() in the VM + optProduceAsm ## produce assembler code + optPanics ## turn panics (sysFatal) into a process termination + optNimV1Emulation ## emulate Nim v1.0 + optNimV12Emulation ## emulate Nim v1.2 optSourcemap - optProfileVM # enable VM profiler - optEnableDeepCopy # ORC specific: enable 'deepcopy' for all types. + optProfileVM ## enable VM profiler + optEnableDeepCopy ## ORC specific: enable 'deepcopy' for all types. TGlobalOptions* = set[TGlobalOption] + + const harmlessOptions* = {optForceFullMake, optNoLinking, optRun, optUseColors, optStdout} genSubDir* = RelativeDir"nimcache" @@ -132,30 +117,30 @@ type # backendLlvm = "llvm" # probably not well supported; was cmdCompileToLLVM Command* = enum ## Nim's commands - cmdNone # not yet processed command - cmdUnknown # command unmapped + cmdNone ## not yet processed command + cmdUnknown ## command unmapped cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, cmdCompileToJS - cmdCrun # compile and run in nimache - cmdTcc # run the project via TCC backend - cmdCheck # semantic checking for whole project - cmdParse # parse a single file (for debugging) - cmdRod # .rod to some text representation (for debugging) - cmdIdeTools # ide tools (e.g. nimsuggest) - cmdNimscript # evaluate nimscript + cmdCrun ## compile and run in nimache + cmdTcc ## run the project via TCC backend + cmdCheck ## semantic checking for whole project + cmdParse ## parse a single file (for debugging) + cmdRod ## .rod to some text representation (for debugging) + cmdIdeTools ## ide tools (e.g. nimsuggest) + cmdNimscript ## evaluate nimscript cmdDoc0 - cmdDoc # convert .nim doc comments to HTML - cmdDoc2tex # convert .nim doc comments to LaTeX - cmdRst2html # convert a reStructuredText file to HTML - cmdRst2tex # convert a reStructuredText file to TeX + cmdDoc ## convert .nim doc comments to HTML + cmdDoc2tex ## convert .nim doc comments to LaTeX + cmdRst2html ## convert a reStructuredText file to HTML + cmdRst2tex ## convert a reStructuredText file to TeX cmdJsondoc0 cmdJsondoc cmdCtags cmdBuildindex cmdGendepend cmdDump - cmdInteractive # start interactive session + cmdInteractive ## start interactive session cmdNop - cmdJsonscript # compile a .json build file + cmdJsonscript ## compile a .json build file cmdNimfix # old unused: cmdInterpret, cmdDef: def feature (find definition for IDEs) @@ -220,22 +205,22 @@ type ## are not anymore. SymbolFilesOption* = enum - disabledSf, # disables Rod files and maybe packed AST features - writeOnlySf, # not really sure, beyond not reading rod files - readOnlySf, # we only read from rod files - v2Sf, # who knows, probably a bad idea - stressTest # likely more bad ideas + disabledSf, ## disables Rod files and maybe packed AST features + writeOnlySf, ## not really sure, beyond not reading rod files + readOnlySf, ## we only read from rod files + v2Sf, ## who knows, probably a bad idea + stressTest ## likely more bad ideas TSystemCC* = enum ccNone, ccGcc, ccNintendoSwitch, ccLLVM_Gcc, ccCLang, ccBcc, ccVcc, ccTcc, ccEnv, ccIcl, ccIcc, ccClangCl ExceptionSystem* = enum - excNone, # no exception system selected yet - excSetjmp, # setjmp based exception handling - excCpp, # use C++'s native exception handling - excGoto, # exception handling based on goto (should become the new default for C) - excQuirky # quirky exception handling + excNone, ## no exception system selected yet + excSetjmp, ## setjmp based exception handling + excCpp, ## use C++'s native exception handling + excGoto, ## exception handling based on goto (should become the new default for C) + excQuirky ## quirky exception handling CfileFlag* {.pure.} = enum Cached, ## no need to recompile this time @@ -251,16 +236,16 @@ type Suggest* = ref object section*: IdeCmd qualifiedPath*: seq[string] - name*: ptr string # not used beyond sorting purposes; name is also - # part of 'qualifiedPath' + name*: ptr string ## not used beyond sorting purposes; name is also + ## part of 'qualifiedPath' filePath*: string - line*: int # Starts at 1 - column*: int # Starts at 0 - doc*: string # Not escaped (yet) - forth*: string # type - quality*: range[0..100] # matching quality - isGlobal*: bool # is a global variable - contextFits*: bool # type/non-type context matches + line*: int ## Starts at 1 + column*: int ## Starts at 0 + doc*: string ## Unescaped documentation string + forth*: string ## type + quality*: range[0..100] ## matching quality + isGlobal*: bool ## is a global variable + contextFits*: bool ## type/non-type context matches prefix*: PrefixMatch symkind*: byte scope*, localUsages*, globalUsages*: int # more usages is better @@ -280,21 +265,46 @@ type stdOrrStderr FilenameOption* = enum - foAbs # absolute path, e.g.: /pathto/bar/foo.nim - foRelProject # relative to project path, e.g.: ../foo.nim - foCanonical # canonical module name - foLegacyRelProj # legacy, shortest of (foAbs, foRelProject) - foName # lastPathPart, e.g.: foo.nim - foStacktrace # if optExcessiveStackTrace: foAbs else: foName + foAbs ## absolute path, e.g.: /pathto/bar/foo.nim + foRelProject ## relative to project path, e.g.: ../foo.nim + foCanonical ## canonical module name + foLegacyRelProj ## legacy, shortest of (foAbs, foRelProject) + foName ## lastPathPart, e.g.: foo.nim + foStacktrace ## if optExcessiveStackTrace: foAbs else: foName + + MsgFlag* = enum ## flags altering msgWriteln behavior + msgStdout, ## force writing to stdout, even stderr is default + msgNoUnitSep ## the message is a complete "paragraph". + MsgFlags* = set[MsgFlag] + + TErrorHandling* = enum + doDefault ## Default action, custom report hook can return this in + ## order for automatic handing to decide appropriate + ## reaction. + doNothing ## Don't do anything + doAbort ## Immediately abort compilation + doRaise ## Raise recoverable error + + ReportHook* = proc(conf: ConfigRef, report: Report): TErrorHandling {.closure.} + ConfNoteSet* = enum + cnCurrent ## notes after resolving all logic(defaults, + ## verbosity)/cmdline/configs + cnMainPackage + cnForeign + cnWarnAsError + cnHintAsError + cnCmdline ## notes that have been set/unset from cmdline + cnModifiedy ## notes that have been set/unset from either + ## cmdline/configs ConfigRef* {.acyclic.} = ref object ## every global configuration ## fields marked with '*' are subject to ## the incremental compilation mechanisms ## (+) means "part of the dependency" - backend*: TBackend # set via `nim x` or `nim --backend:x` + backend*: TBackend ## set via `nim x` or `nim --backend:x` target*: Target # (+) linesCompiled*: int # all lines that have been compiled - options*: TOptions # (+) + localOptions*: TOptions # (+) globalOptions*: TGlobalOptions # (+) macrosToExpand*: StringTableRef arcToExpand*: StringTableRef @@ -304,18 +314,18 @@ type evalTemplateCounter*: int evalMacroCounter*: int exitcode*: int8 - cmd*: Command # raw command parsed as enum - cmdInput*: string # input command - projectIsCmd*: bool # whether we're compiling from a command input - implicitCmd*: bool # whether some flag triggered an implicit `command` - selectedGC*: TGCMode # the selected GC (+) + cmd*: Command ## raw command parsed as enum + cmdInput*: string ## input command + projectIsCmd*: bool ## whether we're compiling from a command input + implicitCmd*: bool ## whether some flag triggered an implicit `command` + selectedGC*: TGCMode ## the selected GC (+) exc*: ExceptionSystem - hintProcessingDots*: bool # true for dots, false for filenames - verbosity*: int # how verbose the compiler is - numberOfProcessors*: int # number of processors - lastCmdTime*: float # when caas is enabled, we measure each command + hintProcessingDots*: bool ## true for dots, false for filenames + verbosity*: int ## how verbose the compiler is + numberOfProcessors*: int ## number of processors + lastCmdTime*: float ## when caas is enabled, we measure each command symbolFiles*: SymbolFilesOption - spellSuggestMax*: int # max number of spelling suggestions for typos + spellSuggestMax*: int ## max number of spelling suggestions for typos cppDefines*: HashSet[string] # (*) headerFile*: string @@ -325,13 +335,13 @@ type ## should be run ideCmd*: IdeCmd oldNewlines*: bool - cCompiler*: TSystemCC # the used compiler - modifiedyNotes*: TNoteKinds # notes that have been set/unset from either cmdline/configs - cmdlineNotes*: TNoteKinds # notes that have been set/unset from cmdline - foreignPackageNotes*: TNoteKinds - notes*: TNoteKinds # notes after resolving all logic(defaults, verbosity)/cmdline/configs - warningAsErrors*: TNoteKinds - mainPackageNotes*: TNoteKinds + cCompiler*: TSystemCC ## the used compiler + + noteSets*: array[ConfNoteSet, ReportKinds] ## All note sets used for + ## compilation. Active note set (`ConfNoteSet.cnCurrent`) can be + ## swapped (depending on the context - push/pop, target package) or + ## modified (via user configuration, command-line flags) + mainPackageId*: int errorCounter*: int hintCounter*: int @@ -340,9 +350,9 @@ type maxLoopIterationsVM*: int ## VM: max iterations of all loops isVmTrace*: bool configVars*: StringTableRef - symbols*: StringTableRef ## We need to use a StringTableRef here as defined - ## symbols are always guaranteed to be style - ## insensitive. Otherwise hell would break lose. + symbols*: StringTableRef ## We need to use a StringTableRef here as + ## defined symbols are always guaranteed to be style insensitive. + ## Otherwise hell would break lose. packageCache*: StringTableRef nimblePaths*: seq[AbsoluteDir] searchPaths*: seq[AbsoluteDir] @@ -353,32 +363,33 @@ type prefixDir*, libpath*, nimcacheDir*: AbsoluteDir nimStdlibVersion*: NimVer dllOverrides, moduleOverrides*, cfileSpecificOptions*: StringTableRef - projectName*: string # holds a name like 'nim' - projectPath*: AbsoluteDir # holds a path like /home/alice/projects/nim/compiler/ - projectFull*: AbsoluteFile # projectPath/projectName - projectIsStdin*: bool # whether we're compiling from stdin - lastMsgWasDot*: set[StdOrrKind] # the last compiler message was a single '.' - projectMainIdx*: FileIndex # the canonical path id of the main module - projectMainIdx2*: FileIndex # consider merging with projectMainIdx - command*: string # the main command (e.g. cc, check, scan, etc) - commandArgs*: seq[string] # any arguments after the main command + projectName*: string ## holds a name like 'nim' + projectPath*: AbsoluteDir ## holds a path like /home/alice/projects/nim/compiler/ + projectFull*: AbsoluteFile ## projectPath/projectName + projectIsStdin*: bool ## whether we're compiling from stdin + lastMsgWasDot*: set[StdOrrKind] ## the last compiler message was a single '.' + projectMainIdx*: FileIndex ## the canonical path id of the main module + projectMainIdx2*: FileIndex ## consider merging with projectMainIdx + command*: string ## the main command (e.g. cc, check, scan, etc) + commandArgs*: seq[string] ## any arguments after the main command commandLine*: string - extraCmds*: seq[string] # for writeJsonBuildInstructions - keepComments*: bool # whether the parser needs to keep comments - implicitImports*: seq[string] # modules that are to be implicitly imported - implicitIncludes*: seq[string] # modules that are to be implicitly included - docSeeSrcUrl*: string # if empty, no seeSrc will be generated. \ - # The string uses the formatting variables `path` and `line`. + extraCmds*: seq[string] ## for writeJsonBuildInstructions + keepComments*: bool ## whether the parser needs to keep comments + implicitImports*: seq[string] ## modules that are to be implicitly imported + implicitIncludes*: seq[string] ## modules that are to be implicitly included + docSeeSrcUrl*: string ## if empty, no seeSrc will be + ## generated. The string uses the formatting variables `path` and + ## `line`. docRoot*: string ## see nim --fullhelp for --docRoot docCmd*: string ## see nim --fullhelp for --docCmd - configFiles*: seq[AbsoluteFile] # config files (cfg,nims) - cIncludes*: seq[AbsoluteDir] # directories to search for included files - cLibs*: seq[AbsoluteDir] # directories to search for lib files - cLinkedLibs*: seq[string] # libraries to link + configFiles*: seq[AbsoluteFile] ## config files (cfg,nims) + cIncludes*: seq[AbsoluteDir] ## directories to search for included files + cLibs*: seq[AbsoluteDir] ## directories to search for lib files + cLinkedLibs*: seq[string] ## libraries to link - externalToLink*: seq[string] # files to link in addition to the file - # we compiled (*) + externalToLink*: seq[string] ## files to link in addition to the file + ## we compiled (*) linkOptionsCmd*: string compileOptionsCmd*: seq[string] linkOptions*: string # (*) @@ -389,16 +400,280 @@ type suggestVersion*: int suggestMaxResults*: int lastLineInfo*: TLineInfo - writelnHook*: proc (output: string) {.closure.} # cannot make this gcsafe yet because of Nimble - structuredErrorHook*: proc (config: ConfigRef; info: TLineInfo; msg: string; - severity: Severity) {.closure.} - # cannot make this gcsafe yet because of sigmatch diagnostics + writelnHook*: proc( + conf: ConfigRef, + output: string, + flags: MsgFlags + ) {.closure.} ## All + ## textual output from the compiler goes through this callback. + writeHook*: proc(conf: ConfigRef, output: string, flags: MsgFlags) {.closure.} + + structuredReportHook*: ReportHook cppCustomNamespace*: string vmProfileData*: ProfileData when defined(nimDebugUtils): debugUtilsStack*: seq[string] ## which proc name to stop trace output - ## len is also used for output indent level + ## len is also used for output indent level + +template changed(conf: ConfigRef, s: ConfNoteSet, body: untyped) = + # Template for debugging purposes - single place to track all changes in + # the enabled note sets. + when defined(debug): + let before = conf.noteSets[s] + body + let after = conf.noteSets[s] + + # let n = rintMsgOrigin + # if (n in before) != (n in after): + # if n notin after: + # writeStackTrace() + # echo "changed conf $# -> $#" % [$(n in before), $(n in after)] + + else: + body + +proc incl*(conf: ConfigRef, nset: ConfNoteSet, note: ReportKind) = + ## Include report kind in specified note set + changed(conf, nset): + conf.noteSets[nset].incl note + +proc excl*(conf: ConfigRef, nset: ConfNoteSet, note: ReportKind) = + ## Exclude report kind from the specified note set + changed(conf, nset): + conf.noteSets[nset].excl note + +proc asgn*(conf: ConfigRef, nset: ConfNoteSet, notes: ReportKinds) = + ## Assign to specified note set + changed(conf, nset): + conf.noteSets[nset] = notes + +proc asgn*(conf: ConfigRef, sto, sfrom: ConfNoteSet) = + ## Assign between two specified note sets + conf.noteSets[sto] = conf.noteSets[sfrom] + +proc flip*( + conf: ConfigRef, nset: ConfNoteSet, note: ReportKind, state: bool) = + ## Include or exlude node from the specified note set based on the + ## `state` + if state: + conf.incl(nset, note) + + else: + conf.excl(nset, note) + + +func options*(conf: ConfigRef): TOptions = + ## Get list of active local options + result = conf.localOptions + +template changedOpts(conf: ConfigRef, body: untyped) = + when defined(debug): + let before = conf.localOptions + body + let after = conf.localOptions + let removed = (optHints in before) and (optHints notin after) + + else: + body + +proc `options=`*(conf: ConfigRef, opts: TOptions) = + ## Assign to list of active local options + changedOpts(conf): + conf.localOptions = opts + +proc excl*(conf: ConfigRef, opt: TOption | TOptions) = + ## Exclude from list of active local options + changedOpts(conf): + conf.localOptions.excl opt + +proc incl*(conf: ConfigRef, opt: TOption | TOptions) = + ## Include to list of active local options + changedOpts(conf): + conf.localOptions.incl opt + + +proc modifiedyNotes*(conf: ConfigRef): ReportKinds = + ## Get list of reports modified from the command line or config + conf.noteSets[cnModifiedy] + +proc cmdlineNotes*(conf: ConfigRef): ReportKinds = + ## Get list of report filters modified from the command line + conf.noteSets[cnCmdline] + +proc foreignPackageNotes*(conf: ConfigRef): ReportKinds = + ## Get list of reports for foreign packages + conf.noteSets[cnForeign] + +proc notes*(conf: ConfigRef): ReportKinds = + ## Get list of active notes + conf.noteSets[cnCurrent] + +proc warningAsErrors*(conf: ConfigRef): ReportKinds = + ## Get list of warning notes that are treated like errors + conf.noteSets[cnWarnAsError] + +proc hintsAsErrors*(conf: ConfigRef): ReportKinds = + ## Get list of hint notes that are treated like errors + conf.noteSets[cnHintAsError] + +proc mainPackageNotes*(conf: ConfigRef): ReportKinds = + ## Get list of notes for main package + conf.noteSets[cnMainPackage] + +proc `modifiedyNotes=`*(conf: ConfigRef, nset: ReportKinds) = + ## Set list of notes modified from the cli/config + conf.asgn cnModifiedy, nset + +proc `cmdlineNotes=`*(conf: ConfigRef, nset: ReportKinds) = + ## Set list of notes modified from the CLI + conf.asgn cnCmdline, nset + +proc `foreignPackageNotes=`*(conf: ConfigRef, nset: ReportKinds) = + ## Set list of notes for foreign packages + conf.asgn cnForeign, nset + +proc `notes=`*(conf: ConfigRef, nset: ReportKinds) = + ## Set list of active notes + conf.asgn cnCurrent, nset + +proc `warningAsErrors=`*(conf: ConfigRef, nset: ReportKinds) = + ## Set list of warning notes to be treated as errors + conf.asgn cnWarnAsError, nset + +proc `hintsAsErrors=`*(conf: ConfigRef, nset: ReportKinds) = + ## Set list of hint notes that are treated like erorrs + conf.asgn cnHintAsError, nset + +proc `mainPackageNotes=`*(conf: ConfigRef, nset: ReportKinds) = + ## Set list of notes for main package + conf.asgn cnMainPackage, nset + +proc writelnHook*(conf: ConfigRef, msg: string, flags: MsgFlags = {}) = + ## Write string using writeln hook + conf.writelnHook(conf, msg, flags) + +proc writeHook*(conf: ConfigRef, msg: string, flags: MsgFlags = {}) = + ## Write string usign write hook + conf.writeHook(conf, msg, flags) + +proc writeln*(conf: ConfigRef, args: varargs[string, `$`]) = + ## writeln hook overload for varargs + writelnHook(conf, args.join("")) + +proc write*(conf: ConfigRef, args: varargs[string, `$`]) = + ## write hook overload for varargs + writeHook(conf, args.join("")) + +proc setReportHook*(conf: ConfigRef, hook: ReportHook) = + ## Set active report hook. Must not be nil + assert not hook.isNil + conf.structuredReportHook = hook + +proc getReportHook*(conf: ConfigRef): ReportHook = + ## Get active report hook + conf.structuredReportHook + +proc report*(conf: ConfigRef, inReport: Report): TErrorHandling = + ## Write `inReport` + assert inReport.kind != repNone, "Cannot write out empty report" + assert( + not conf.structuredReportHook.isNil, + "Cannot write report with empty report hook") + return conf.structuredReportHook(conf, inReport) + +proc canReport*(conf: ConfigRef, id: ReportId): bool = + ## Check whether report with given ID can actually be written out, or it + ## has already been seen. This check is used to prevent multiple reports + ## from the `nkError` node. + id notin conf.m.writtenSemReports + +proc canReport*(conf: ConfigRef, node: PNode): bool = + ## Check whether `nkError` node can be reported + conf.canReport(node.reportId) + +proc report*(conf: ConfigRef, id: ReportId): TErrorHandling = + ## Write out existing stored report unless it has already been reported + ## (can happen with multiple `nkError` visitations). + ## + ## .. note:: This check is done only for reports that are generated via + ## IDs, because that's the only way report can (supposedly) + ## enter the error message system twice. + return conf.report(conf.m.reports.getReport(id)) + + +proc report*(conf: ConfigRef, node: PNode): TErrorHandling = + ## Write out report from the nkError node + assert node.kind == nkError + return conf.report(node.reportId) + + +template report*[R: ReportTypes]( + conf: ConfigRef, inReport: R): TErrorHandling = + ## Pass structured report object into `conf.structuredReportHook`, + ## converting to `Report` variant and updaing instantiation info. + report(conf, wrap(inReport, instLoc())) + +template report*[R: ReportTypes]( + conf: ConfigRef, tinfo: TLineInfo, inReport: R): TErrorHandling = + ## Write out new report, updating it's location info using `tinfo` and + ## it's instantiation info with `instantiationInfo()` of the template. + report(conf, wrap(inReport, instLoc(), tinfo)) + +proc addReport*(conf: ConfigRef, report: Report): ReportId = + ## Add new postponed report, return it's stored ID + result = conf.m.reports.addReport(report) + assert not result.isEmpty(), $result + +proc getReport*(conf: ConfigRef, report: ReportId): Report = + ## Get postponed report from the current report list + assert not report.isEmpty(), $report + result = conf.m.reports.getReport(report) + +proc getReport*(conf: ConfigRef, err: PNode): Report = + ## Get postponed report from the nkError node + conf.getReport(err.reportId) + +template store*(conf: ConfigRef, report: ReportTypes): untyped = + ## Add report to the postponed list, return new report ID + conf.addReport(wrap(report, instLoc())) + +template store*( + conf: ConfigRef, linfo: TLineInfo, report: ReportTypes): untyped = + ## Add report with given location information to the postponed list + conf.addReport(wrap(report, instLoc(), linfo)) + + +func isCompilerFatal*(conf: ConfigRef, report: Report): bool = + ## Check if report stores fatal compilation error + report.category == repInternal and + report.internalReport.severity() == rsevFatal + +func severity*(conf: ConfigRef, report: ReportTypes | Report): ReportSeverity = + # style checking is a hint by default, but can be globally overriden to + # be treated as error via `--styleCheck:error`, and this is handled in + # the different configuration as hints/warnings as errors + if report.kind in repLinterKinds and optStyleError in conf.globalOptions: + result = rsevError + + else: + result = report.severity(conf.warningAsErrors + conf.hintsAsErrors) + + +func isCodeError*(conf: ConfigRef, report: Report): bool = + ## Check if report stores a regular code error, or warning/hint that has + ## been configured to be treated as error under "warningAsError" + conf.severity(report) == rsevError + + +func ignoreMsgBecauseOfIdeTools(conf: ConfigRef, msg: ReportKind): bool = + msg notin (repErrorKinds + repFatalKinds) and + conf.cmd == cmdIdeTools and + optIdeDebug notin conf.globalOptions + +func useColor*(conf: ConfigRef): bool = + optUseColors in conf.globalOptions + proc parseNimVersion*(a: string): NimVer = # could be moved somewhere reusable @@ -418,31 +693,99 @@ template setErrorMaxHighMaybe*(conf: ConfigRef) = ## do not stop after first error (but honor --errorMax if provided) assignIfDefault(conf.errorMax, high(int)) -proc setNoteDefaults*(conf: ConfigRef, note: TNoteKind, enabled = true) = +proc setNoteDefaults*(conf: ConfigRef, note: ReportKind, enabled = true) = template fun(op) = - conf.notes.op note - conf.mainPackageNotes.op note - conf.foreignPackageNotes.op note + conf.op cnCurrent, note + conf.op cnMainPackage, note + conf.op cnForeign, note + if enabled: fun(incl) else: fun(excl) -proc setNote*(conf: ConfigRef, note: TNoteKind, enabled = true) = - # see also `prepareConfigNotes` which sets notes +proc setNote*(conf: ConfigRef, note: ReportKind, enabled = true) = + ## see also `prepareConfigNotes` which sets notes if note notin conf.cmdlineNotes: - if enabled: incl(conf.notes, note) else: excl(conf.notes, note) + if enabled: + incl(conf, cnCurrent, note) + + else: + excl(conf, cnCurrent, note) -proc hasHint*(conf: ConfigRef, note: TNoteKind): bool = +proc hasHint*(conf: ConfigRef, note: ReportKind): bool = # ternary states instead of binary states would simplify logic - if optHints notin conf.options: false - elif note in {hintConf, hintProcessing}: + if optHints notin conf.options: + false + + elif note in {rextConf, rsemProcessing}: # could add here other special notes like hintSource # these notes apply globally. note in conf.mainPackageNotes - else: note in conf.notes -proc hasWarn*(conf: ConfigRef, note: TNoteKind): bool {.inline.} = + else: + note in conf.notes + +proc hasWarn*(conf: ConfigRef, note: ReportKind): bool {.inline.} = + ## Check if warnings are enabled and specific report kind is contained in + ## the optWarns in conf.options and note in conf.notes -proc hcrOn*(conf: ConfigRef): bool = return optHotCodeReloading in conf.globalOptions +func isEnabled*(conf: ConfigRef, report: ReportKind): bool = + ## Check whether report kind is allowed to be generated by the compiler. + ## Uses `options.hasHint`, `options.hasWarn` to check whether particular + ## report is enabled, otherwise use query global/local options. + + + # Reports related to experimental features and inconsistent CLI flags + # (such as `--styleCheck` which controls both CLI flags and hints) are + # checked for with higher priority + case report: + of repNilcheckKinds: + result = strictNotNil in conf.features + + of rdbgVmExecTraceMinimal: + result = conf.isVmTrace + + of rlexLinterReport, rsemLinterReport, : + # Regular linter report is enabled if style check is either hint or + # error, AND not `usages` + result = 0 < len({optStyleHint, optStyleError} * conf.globalOptions) and + optStyleUsages notin conf.globalOptions + + of rsemLinterReportUse: + result = 0 < len({optStyleHint, optStyleError} * conf.globalOptions) + + else: + # All other reports follow default hint category handing: + case report: + of repHintKinds: + result = conf.hasHint(report) + + of repWarningKinds: + result = conf.hasWarn(report) + + of repErrorKinds, repFatalKinds: + result = true + + of repTraceKinds: + result = true + + else: + result = (report in conf.notes) and + not ignoreMsgBecauseOfIdeTools(conf, report) + +func isEnabled*(conf: ConfigRef, report: Report): bool = + ## Macro expansion configuration is done via `--expandMacro=name` + ## configuration, and requires full report information to check. + if report.kind == rsemExpandMacro and + conf.macrosToExpand.hasKey(report.semReport.sym.name.s): + result = true + + else: + result = conf.isEnabled(report.kind) + + + +proc hcrOn*(conf: ConfigRef): bool = + return optHotCodeReloading in conf.globalOptions when false: template depConfigFields*(fn) {.dirty.} = # deadcode @@ -451,7 +794,8 @@ when false: fn(globalOptions) fn(selectedGC) -const oldExperimentalFeatures* = {implicitDeref, dotOperators, callOperator, parallel} +const oldExperimentalFeatures* = { + implicitDeref, dotOperators, callOperator, parallel} const ChecksOptions* = {optObjCheck, optFieldCheck, optRangeCheck, @@ -491,17 +835,9 @@ template newPackageCache*(): untyped = proc newProfileData(): ProfileData = ProfileData(data: newTable[TLineInfo, ProfileInfo]()) -const foreignPackageNotesDefault* = { - hintProcessing, warnUnknownMagic, hintQuitCalled, hintExecuting, hintUser, warnUser} proc isDefined*(conf: ConfigRef; symbol: string): bool -when defined(nimDebugUtils): - # this allows inserting debugging utilties in all modules that import `options` - # with a single switch, which is useful when debugging compiler. - import debugutils - export debugutils - proc initConfigRefCommon(conf: ConfigRef) = conf.symbols = newStringTable(modeStyleInsensitive) conf.selectedGC = gcRefc @@ -510,18 +846,19 @@ proc initConfigRefCommon(conf: ConfigRef) = conf.options = DefaultOptions conf.globalOptions = DefaultGlobalOptions conf.filenameOption = foAbs - conf.foreignPackageNotes = foreignPackageNotesDefault - conf.notes = NotesVerbosity[1] - conf.mainPackageNotes = NotesVerbosity[1] + conf.foreignPackageNotes = NotesVerbosity.foreign + conf.notes = NotesVerbosity.main[1] + conf.mainPackageNotes = NotesVerbosity.main[1] when defined(nimDebugUtils): # ensures that `nimDebugUtils` is defined for the compiled code so it can # access the `system.nimCompilerDebugRegion` template if not conf.symbols.hasKey("nimDebugUtils"): conf.symbols["nimDebugUtils"] = "" -proc newConfigRef*(): ConfigRef = +proc newConfigRef*(hook: ReportHook): ConfigRef = result = ConfigRef( cCompiler: ccGcc, + structuredReportHook: hook, macrosToExpand: newStringTable(modeStyleInsensitive), arcToExpand: newStringTable(modeStyleInsensitive), m: initMsgConfig(), @@ -635,6 +972,9 @@ proc isDefined*(conf: ConfigRef; symbol: string): bool = osDragonfly, osMacosx} else: discard +proc getDefined*(conf: ConfigRef, sym: string): string = + conf.symbols[sym] + template quitOrRaise*(conf: ConfigRef, msg = "") = # xxx in future work, consider whether to also intercept `msgQuit` calls if conf.isDefined("nimDebug"): @@ -701,7 +1041,7 @@ proc getPrefixDir*(conf: ConfigRef): AbsoluteDir = else: result = AbsoluteDir splitPath(getAppDir()).head proc setDefaultLibpath*(conf: ConfigRef) = - # set default value (can be overwritten): + ## set default value (can be overwritten): if conf.libpath.isEmpty: # choose default libpath: var prefix = getPrefixDir(conf) diff --git a/compiler/parampatterns.nim b/compiler/parampatterns.nim index eb99004ab3c..e936eca8bd5 100644 --- a/compiler/parampatterns.nim +++ b/compiler/parampatterns.nim @@ -10,8 +10,8 @@ ## This module implements the pattern matching features for term rewriting ## macro support. -import strutils, ast, types, msgs, idents, renderer, wordrecg, trees, - options +import strutils, ast, types, msgs, renderer, wordrecg, trees, + options, reports # we precompile the pattern here for efficiency into some internal # stack based VM :-) Why? Because it's fun; I did no benchmarks to see if that @@ -42,9 +42,6 @@ type const MaxStackSize* = 64 ## max required stack size by the VM -proc patternError(n: PNode; conf: ConfigRef) = - localError(conf, n.info, "illformed AST: " & renderTree(n, {renderNoComments})) - proc add(code: var TPatternCode, op: TOpcode) {.inline.} = code.add chr(ord(op)) @@ -58,7 +55,9 @@ proc compileConstraints(p: PNode, result: var TPatternCode; conf: ConfigRef) = case p.kind of nkCallKinds: if p[0].kind != nkIdent: - patternError(p[0], conf) + conf.localReport(p[0].info, reportAst( + rsemIllformedAst, p, + str = "Expected ident for a first subnode, but found '$1'" % [$p[0].kind])) return let op = p[0].ident if p.len == 3: @@ -71,17 +70,28 @@ proc compileConstraints(p: PNode, result: var TPatternCode; conf: ConfigRef) = compileConstraints(p[2], result, conf) result.add(ppAnd) else: - patternError(p, conf) + conf.localReport(p.info, reportAst( + rsemIllformedAst, p, + str = "Expected any of '|', 'or', '&', 'and' for TRM pattern, but found '$1' ($2)" % [ + $op.s, $op.id])) + elif p.len == 2 and (op.s == "~" or op.id == ord(wNot)): compileConstraints(p[1], result, conf) result.add(ppNot) else: - patternError(p, conf) + conf.localReport(p.info, reportAst( + rsemIllformedAst, p, + str = "Unexpected trm patern - wanted negation or and/or infix")) + of nkAccQuoted, nkPar: if p.len == 1: compileConstraints(p[0], result, conf) else: - patternError(p, conf) + conf.localReport(p.info, reportAst( + rsemIllformedAst, p, + str = "Unexpected number of nodes for node - " & + "wanted $1, but found $2" % [$1, $p.len])) + of nkIdent: let spec = p.ident.s.normalize case spec @@ -98,22 +108,22 @@ proc compileConstraints(p: PNode, result: var TPatternCode; conf: ConfigRef) = of "nosideeffect": result.add(ppNoSideEffect) else: # check all symkinds: - internalAssert conf, int(high(TSymKind)) < 255 + internalAssert conf, int(high(TSymKind)) < 255, "[FIXME]" for i in TSymKind: if cmpIgnoreStyle(i.toHumanStr, spec) == 0: result.add(ppSymKind) result.add(chr(i.ord)) return # check all nodekinds: - internalAssert conf, int(high(TNodeKind)) < 255 + internalAssert conf, int(high(TNodeKind)) < 255, "[FIXME]" for i in TNodeKind: if cmpIgnoreStyle($i, spec) == 0: result.add(ppNodeKind) result.add(chr(i.ord)) return - patternError(p, conf) + conf.localReport(p.info, reportAst(rsemIllformedAst, p)) else: - patternError(p, conf) + conf.localReport(p.info, reportAst(rsemIllformedAst, p)) proc semNodeKindConstraints*(n: PNode; conf: ConfigRef; start: Natural): PNode = ## does semantic checking for a node kind pattern and compiles it into an @@ -124,10 +134,12 @@ proc semNodeKindConstraints*(n: PNode; conf: ConfigRef; start: Natural): PNode = if n.len >= 2: for i in start.. MaxStackSize-1: - internalError(conf, n.info, "parameter pattern too complex") + + if result.strVal.len > MaxStackSize - 1: + conf.internalError(n.info, "parameter pattern too complex") + else: - patternError(n, conf) + conf.localReport(n.info, reportAst(rsemIllformedAst, n)) result.strVal.add(ppEof) type @@ -342,4 +354,3 @@ proc matchNodeKinds*(p, n: PNode): bool = of ppNoSideEffect: push checkForSideEffects(n) != seSideEffect inc pc result = stack[sp-1] - diff --git a/compiler/parser.nim b/compiler/parser.nim index 5e9a7424a50..b74e9e291a7 100644 --- a/compiler/parser.nim +++ b/compiler/parser.nim @@ -7,12 +7,12 @@ # distribution, for details about the copyright. # -# This module implements the parser of the standard Nim syntax. -# The parser strictly reflects the grammar ("doc/grammar.txt"); however -# it uses several helper routines to keep the parser small. A special -# efficient algorithm is used for the precedence levels. The parser here can -# be seen as a refinement of the grammar, as it specifies how the AST is built -# from the grammar and how comments belong to the AST. +## This module implements the parser of the standard Nim syntax. +## The parser strictly reflects the grammar ("doc/grammar.txt"); however +## it uses several helper routines to keep the parser small. A special +## efficient algorithm is used for the precedence levels. The parser here can +## be seen as a refinement of the grammar, as it specifies how the AST is built +## from the grammar and how comments belong to the AST. # In fact the grammar is generated from this file: @@ -31,7 +31,7 @@ when isMainModule: import llstream, lexer, idents, strutils, ast, msgs, options, lineinfos, - pathutils + pathutils, reports when defined(nimpretty): import layouter @@ -66,7 +66,6 @@ proc parseTopLevelStmt*(p: var Parser): PNode # helpers for the other parsers proc isOperator*(tok: Token): bool proc getTok*(p: var Parser) -proc parMessage*(p: Parser, msg: TMsgKind, arg: string = "") proc skipComment*(p: var Parser, node: PNode) proc newNodeP*(kind: TNodeKind, p: Parser): PNode proc newIntNodeP*(kind: TNodeKind, intVal: BiggestInt, p: Parser): PNode @@ -138,17 +137,19 @@ proc closeParser(p: var Parser) = when defined(nimpretty): closeEmitter(p.em) -proc parMessage(p: Parser, msg: TMsgKind, arg = "") = - ## Produce and emit the parser message `arg` to output. - lexMessageTok(p.lex, msg, p.tok, arg) -proc parMessage(p: Parser, msg: string, tok: Token) = - ## Produce and emit a parser message to output about the token `tok` - parMessage(p, errGenerated, msg % prettyTok(tok)) +template localError(p: Parser, report: ParserReport): untyped = + var rep = report + if rep.found.len == 0: + rep.found = prettyTok(p.tok) -proc parMessage(p: Parser, arg: string) = - ## Produce and emit the parser message `arg` to output. - lexMessageTok(p.lex, errGenerated, p.tok, arg) + p.lex.config.handleReport( + wrap(rep, instLoc(), getLineInfo(p.lex, p.tok)), instLoc()) + + +template localError(p: Parser, report: ReportTypes): untyped = + p.lex.config.handleReport( + wrap(report, instLoc(), getLineInfo(p.lex, p.tok)), instLoc()) template withInd(p, body: untyped) = let oldInd = p.currInd @@ -180,7 +181,7 @@ proc rawSkipComment(p: var Parser, node: PNode) = rhs.add p.tok.literal node.comment = move rhs else: - parMessage(p, errInternal, "skipComment") + p.localError InternalReport(kind: rintUnreachable, msg: "skipComment") getTok(p) proc skipComment(p: var Parser, node: PNode) = @@ -189,18 +190,15 @@ proc skipComment(p: var Parser, node: PNode) = proc flexComment(p: var Parser, node: PNode) = if p.tok.indent < 0 or realInd(p): rawSkipComment(p, node) -const - errInvalidIndentation = "invalid indentation" - errIdentifierExpected = "identifier expected, but got '$1'" - errExprExpected = "expression expected, but found '$1'" - proc skipInd(p: var Parser) = if p.tok.indent >= 0: - if not realInd(p): parMessage(p, errInvalidIndentation) + if not realInd(p): + p.localError ParserReport(kind: rparInvalidIndentation) proc optPar(p: var Parser) = if p.tok.indent >= 0: - if p.tok.indent < p.currInd: parMessage(p, errInvalidIndentation) + if p.tok.indent < p.currInd: + p.localError ParserReport(kind: rparInvalidIndentation) proc optInd(p: var Parser, n: PNode) = skipComment(p, n) @@ -208,15 +206,18 @@ proc optInd(p: var Parser, n: PNode) = proc getTokNoInd(p: var Parser) = getTok(p) - if p.tok.indent >= 0: parMessage(p, errInvalidIndentation) + if p.tok.indent >= 0: + p.localError ParserReport(kind: rparInvalidIndentation) proc expectIdentOrKeyw(p: Parser) = if p.tok.tokType != tkSymbol and not isKeyword(p.tok.tokType): - lexMessage(p.lex, errGenerated, errIdentifierExpected % prettyTok(p.tok)) + p.localError ParserReport( + kind: rparIdentExpected, found: prettyTok(p.tok)) proc expectIdent(p: Parser) = if p.tok.tokType != tkSymbol: - lexMessage(p.lex, errGenerated, errIdentifierExpected % prettyTok(p.tok)) + p.localError ParserReport( + kind: rparIdentOrKwdExpected, found: prettyTok(p.tok)) proc eat(p: var Parser, tokType: TokType) = ## Move the parser to the next token if the current token is of type @@ -224,8 +225,9 @@ proc eat(p: var Parser, tokType: TokType) = if p.tok.tokType == tokType: getTok(p) else: - lexMessage(p.lex, errGenerated, - "expected: '" & $tokType & "', but got: '" & prettyTok(p.tok) & "'") + p.localError ParserReport( + kind: rparUnexpectedToken, + expected: @[$tokType], found: prettyTok(p.tok)) proc parLineInfo(p: Parser): TLineInfo = ## Retrieve the line information associated with the parser's current state. @@ -237,8 +239,12 @@ proc indAndComment(p: var Parser, n: PNode, maybeMissEquals = false) = elif maybeMissEquals: let col = p.bufposPrevious - p.lineStartPrevious var info = newLineInfo(p.lex.fileIdx, p.lineNumberPrevious, col) - parMessage(p, "invalid indentation, maybe you forgot a '=' at $1 ?" % [p.lex.config$info]) - else: parMessage(p, errInvalidIndentation) + p.localError ParserReport( + kind: rparInvalidIndentation, + msg: ", maybe you forgot a '=' at $1 ?" % [p.lex.config$info]) + + else: + p.localError ParserReport(kind: rparInvalidIndentation) else: skipComment(p, n) @@ -286,7 +292,8 @@ proc checkBinary(p: Parser) {.inline.} = # we don't check '..' here as that's too annoying if p.tok.tokType == tkOpr: if p.tok.strongSpaceB > 0 and p.tok.strongSpaceA == 0: - parMessage(p, warnInconsistentSpacing, prettyTok(p.tok)) + p.localError ParserReport( + kind: rparInconsistentSpacing, found: prettyTok(p.tok)) #| module = stmt ^* (';' / IND{=}) #| @@ -347,7 +354,7 @@ proc parseSymbol(p: var Parser, mode = smNormal): PNode = result = newNodeP(nkNilLit, p) getTok(p) else: - parMessage(p, errIdentifierExpected, p.tok) + p.localError ParserReport(kind: rparIdentExpected) result = p.emptyNode of tkAccent: result = newNodeP(nkAccQuoted, p) @@ -357,7 +364,7 @@ proc parseSymbol(p: var Parser, mode = smNormal): PNode = case p.tok.tokType of tkAccent: if result.len == 0: - parMessage(p, errIdentifierExpected, p.tok) + p.localError ParserReport(kind: rparIdentExpected) break of tkOpr, tkDot, tkDotDot, tkEquals, tkParLe..tkParDotRi: let lineinfo = parLineInfo(p) @@ -373,11 +380,11 @@ proc parseSymbol(p: var Parser, mode = smNormal): PNode = result.add(newIdentNodeP(p.lex.cache.getIdent($p.tok), p)) getTok(p) else: - parMessage(p, errIdentifierExpected, p.tok) + p.localError ParserReport(kind: rparIdentExpected) break eat(p, tkAccent) else: - parMessage(p, errIdentifierExpected, p.tok) + p.localError ParserReport(kind: rparIdentExpected) # BUGFIX: We must consume a token here to prevent endless loops! # But: this really sucks for idetools and keywords, so we don't do it # if it is a keyword: @@ -567,10 +574,10 @@ proc semiStmtList(p: var Parser, result: PNode) = if p.tok.tokType == tkParRi: break elif not (sameInd(p) or realInd(p)): - parMessage(p, errInvalidIndentation) + p.localError ParserReport(kind: rparIdentExpected) let a = complexOrSimpleStmt(p) if a.kind == nkEmpty: - parMessage(p, errExprExpected, p.tok) + p.localError ParserReport(kind: rparExprExpected) getTok(p) else: result.add a @@ -765,7 +772,7 @@ proc identOrLiteral(p: var Parser, mode: PrimaryMode): PNode = of tkCast: result = parseCast(p) else: - parMessage(p, errExprExpected, p.tok) + p.localError ParserReport(kind: rparExprExpected) getTok(p) # we must consume a token here to prevent endless loops! result = p.emptyNode @@ -864,7 +871,7 @@ proc primarySuffix(p: var Parser, r: PNode, result = parseGStrLit(p, result) else: if isDotLike2: - parMessage(p, warnDotLikeOps, "dot-like operators will be parsed differently with `-d:nimPreviewDotLikeOps`") + p.localError ParserReport(kind: rparEnablePreviewDotOps) if p.inPragma == 0 and (isUnary(p.tok) or p.tok.tokType notin {tkOpr, tkDotDot}): # actually parsing {.push hints:off.} as {.push(hints:off).} is a sweet # solution, but pragmas.nim can't handle that @@ -937,7 +944,8 @@ proc parsePragma(p: var Parser): PNode = if p.tok.tokType == tkCurlyRi: curlyRiWasPragma(p.em) getTok(p) else: - parMessage(p, "expected '.}'") + p.localError ParserReport( + kind: rparMissingToken, expected: @[".}"], found: $p.tok) dec p.inPragma when defined(nimpretty): dec p.em.doIndentMore @@ -1003,7 +1011,8 @@ proc parseIdentColonEquals(p: var Parser, flags: DeclaredIdentFlags): PNode = else: result.add(newNodeP(nkEmpty, p)) if p.tok.tokType != tkEquals and withBothOptional notin flags: - parMessage(p, "':' or '=' expected, but got '$1'", p.tok) + p.localError ParserReport( + kind: rparMissingToken, expected: @[":", "="], found: $p.tok) if p.tok.tokType == tkEquals: getTok(p) optInd(p, result) @@ -1046,11 +1055,11 @@ proc parseTuple(p: var Parser, indentAllowed = false): PNode = result.add(a) of tkEof: break else: - parMessage(p, errIdentifierExpected, p.tok) + p.localError ParserReport(kind: rparIdentExpected, found: $p.tok) break if not sameInd(p): break elif p.tok.tokType == tkParLe: - parMessage(p, errGenerated, "the syntax for tuple types is 'tuple[...]', not 'tuple(...)'") + p.localError ParserReport(kind: rparTupleTypeWithPar) else: result = newNodeP(nkTupleClassTy, p) @@ -1076,10 +1085,11 @@ proc parseParamList(p: var Parser, retColon = true): PNode = of tkParRi: break of tkVar: - parMessage(p, errGenerated, "the syntax is 'parameter: var T', not 'var parameter: T'") + p.localError ParserReport(kind: rparMisplacedParameterVar) break else: - parMessage(p, "expected closing ')'") + p.localError ParserReport( + kind: rparMissingToken, found: $p.tok, expected: @[")"]) break result.add(a) if p.tok.tokType notin {tkComma, tkSemiColon}: break @@ -1138,7 +1148,7 @@ proc parseProcExpr(p: var Parser; isExpr: bool; kind: TNodeKind): PNode = if hasSignature: result.add(params) if kind == nkFuncDef: - parMessage(p, "func keyword is not allowed in type descriptions, use proc with {.noSideEffect.} pragma instead") + p.localError ParserReport(kind: rparFuncNotAllowed) result.add(pragmas) proc isExprStart(p: Parser): bool = @@ -1299,7 +1309,7 @@ proc primary(p: var Parser, mode: PrimaryMode): PNode = if mode == pmTypeDef: result = parseTypeClass(p) else: - parMessage(p, "the 'concept' keyword is only valid in 'type' sections") + p.localError ParserReport(kind: rparConceptNotinType) of tkBind: result = newNodeP(nkBind, p) getTok(p) @@ -1427,7 +1437,8 @@ proc postExprBlocks(p: var Parser, x: PNode): PNode = if nextBlock.kind in {nkElse, nkFinally}: break else: if openingParams.kind != nkEmpty: - parMessage(p, "expected ':'") + p.localError ParserReport( + kind: rparMissingToken, expected: @[":"]) proc parseExprStmt(p: var Parser): PNode = #| exprStmt = simpleExpr @@ -1689,7 +1700,9 @@ proc parseTry(p: var Parser; isExpr: bool): PNode = colcom(p, b) b.add(parseStmt(p)) result.add(b) - if b == nil: parMessage(p, "expected 'except'") + if b == nil: + p.localError ParserReport( + kind: rparMissingToken, expected: @["except"]) proc parseExceptBlock(p: var Parser, kind: TNodeKind): PNode = result = newNodeP(kind, p) @@ -1726,7 +1739,10 @@ proc parseAsm(p: var Parser): PNode = of tkRStrLit: result.add(newStrNodeP(nkRStrLit, p.tok.literal, p)) of tkTripleStrLit: result.add(newStrNodeP(nkTripleStrLit, p.tok.literal, p)) else: - parMessage(p, "the 'asm' statement takes a string literal") + p.localError ParserReport( + kind: rparUnexpectedTokenKind, + msg: "the 'asm' statement takes a string literal", found: $p.tok) + result.add(p.emptyNode) return getTok(p) @@ -1854,14 +1870,15 @@ proc parseSection(p: var Parser, kind: TNodeKind, var a = newCommentStmt(p) result.add(a) else: - parMessage(p, errIdentifierExpected, p.tok) + p.localError ParserReport(kind: rparIdentExpected, found: $p.tok) break - if result.len == 0: parMessage(p, errIdentifierExpected, p.tok) + if result.len == 0: + p.localError ParserReport(kind: rparIdentExpected, found: $p.tok) elif p.tok.tokType in {tkSymbol, tkAccent, tkParLe} and p.tok.indent < 0: # tkParLe is allowed for ``var (x, y) = ...`` tuple parsing result.add(defparser(p)) else: - parMessage(p, errIdentifierExpected, p.tok) + p.localError ParserReport(kind: rparIdentExpected, found: $p.tok) proc parseEnum(p: var Parser): PNode = #| enumDecl = 'enum' optInd (symbol pragma? optInd ('=' optInd expr COMMENT?)? comma?)+ @@ -1907,7 +1924,7 @@ proc parseEnum(p: var Parser): PNode = p.tok.tokType == tkEof: break if result.len <= 1: - parMessage(p, errIdentifierExpected, p.tok) + p.localError ParserReport(kind: rparIdentExpected, found: $p.tok) proc parseObjectPart(p: var Parser): PNode proc parseObjectWhen(p: var Parser): PNode = @@ -1971,7 +1988,7 @@ proc parseObjectCase(p: var Parser): PNode = colcom(p, b) var fields = parseObjectPart(p) if fields.kind == nkEmpty: - parMessage(p, errIdentifierExpected, p.tok) + p.localError ParserReport(kind: rparIdentExpected) fields = newNodeP(nkNilLit, p) # don't break further semantic checking b.add(fields) result.add(b) @@ -1991,7 +2008,7 @@ proc parseObjectPart(p: var Parser): PNode = of tkCase, tkWhen, tkSymbol, tkAccent, tkNil, tkDiscard: result.add(parseObjectPart(p)) else: - parMessage(p, errIdentifierExpected, p.tok) + p.localError ParserReport(kind: rparIdentExpected, found: $p.tok) break elif sameOrNoInd(p): case p.tok.tokType @@ -2017,7 +2034,7 @@ proc parseObject(p: var Parser): PNode = getTok(p) if p.tok.tokType == tkCurlyDotLe and p.validInd: # Deprecated since v0.20.0 - parMessage(p, warnDeprecated, "type pragmas follow the type name; this form of writing pragmas is deprecated") + p.localError ParserReport(kind: rparPragmaNotFollowingTypeName) result.add(parsePragma(p)) else: result.add(p.emptyNode) @@ -2091,7 +2108,12 @@ proc parseTypeClass(p: var Parser): PNode = # an initial IND{>} HAS to follow: if not realInd(p): if result.isNewStyleConcept: - parMessage(p, "routine expected, but found '$1' (empty new-styled concepts are not allowed)", p.tok) + p.localError ParserReport( + kind: rparRotineExpected, + msg: "routine expected, but found '$1' (empty new-styled concepts are not allowed)" % [ + $p.tok], + found: $p.tok + ) result.add(p.emptyNode) else: result.add(parseStmt(p)) @@ -2118,7 +2140,7 @@ proc parseTypeDef(p: var Parser): PNode = if p.tok.tokType == tkBracketLe and p.validInd: if not noPragmaYet: # Deprecated since v0.20.0 - parMessage(p, warnDeprecated, "pragma before generic parameter list is deprecated") + p.localError ParserReport(kind: rparPragmaBeforeGenericParameters) genericParam = parseGenericParamList(p) else: genericParam = p.emptyNode @@ -2130,7 +2152,7 @@ proc parseTypeDef(p: var Parser): PNode = identPragma.add(identifier) identPragma.add(pragma) elif p.tok.tokType == tkCurlyDotLe: - parMessage(p, errGenerated, "pragma already present") + p.localError ParserReport(kind: rparPragmaAlreadyPresent) result.add(identPragma) result.add(genericParam) @@ -2316,7 +2338,7 @@ proc parseStmt(p: var Parser): PNode = else: break else: if p.tok.indent > p.currInd and p.tok.tokType != tkDot: - parMessage(p, errInvalidIndentation) + p.localError ParserReport(kind: rparInvalidIndentation) break if p.tok.tokType in {tkCurlyRi, tkParRi, tkCurlyDotRi, tkBracketRi}: # XXX this ensures tnamedparamanonproc still compiles; @@ -2328,7 +2350,7 @@ proc parseStmt(p: var Parser): PNode = let a = complexOrSimpleStmt(p) if a.kind == nkEmpty and not p.hasProgress: - parMessage(p, errExprExpected, p.tok) + p.localError ParserReport(kind: rparExprExpected) break else: result.add a @@ -2339,21 +2361,23 @@ proc parseStmt(p: var Parser): PNode = case p.tok.tokType of tkIf, tkWhile, tkCase, tkTry, tkFor, tkBlock, tkAsm, tkProc, tkFunc, tkIterator, tkMacro, tkType, tkConst, tkWhen, tkVar: - parMessage(p, "nestable statement requires indentation") + p.localError ParserReport(kind: rparNestableRequiresIndentation) result = p.emptyNode else: if p.inSemiStmtList > 0: result = simpleStmt(p) - if result.kind == nkEmpty: parMessage(p, errExprExpected, p.tok) + if result.kind == nkEmpty: + p.localError ParserReport(kind: rparExprExpected, found: $p.tok) else: result = newNodeP(nkStmtList, p) while true: if p.tok.indent >= 0: - parMessage(p, errInvalidIndentation) + p.localError ParserReport(kind: rparInvalidIndentation) p.hasProgress = false let a = simpleStmt(p) let err = not p.hasProgress - if a.kind == nkEmpty: parMessage(p, errExprExpected, p.tok) + if a.kind == nkEmpty: + p.localError ParserReport(kind: rparExprExpected, found: $p.tok) result.add(a) if p.tok.tokType != tkSemiColon: break getTok(p) @@ -2368,11 +2392,11 @@ proc parseAll(p: var Parser): PNode = if a.kind != nkEmpty and p.hasProgress: result.add(a) else: - parMessage(p, errExprExpected, p.tok) + p.localError ParserReport(kind: rparExprExpected, found: $p.tok) # bugfix: consume a token here to prevent an endless loop: getTok(p) if p.tok.indent != 0: - parMessage(p, errInvalidIndentation) + p.localError ParserReport(kind: rparInvalidIndentation) proc parseTopLevelStmt(p: var Parser): PNode = ## Implements an iterator which, when called repeatedly, returns the next @@ -2386,26 +2410,28 @@ proc parseTopLevelStmt(p: var Parser): PNode = elif p.tok.tokType != tkSemiColon: # special casing for better error messages: if p.tok.tokType == tkOpr and p.tok.ident.s == "*": - parMessage(p, errGenerated, - "invalid indentation; an export marker '*' follows the declared identifier") + p.localError ParserReport(kind: rparMisplacedExport, + msg: "invalid indentation; an export marker '*' follows the declared identifier") else: - parMessage(p, errInvalidIndentation) + p.localError ParserReport(kind: rparInvalidIndentation) p.firstTok = false case p.tok.tokType of tkSemiColon: getTok(p) - if p.tok.indent <= 0: discard - else: parMessage(p, errInvalidIndentation) + if p.tok.indent <= 0: + discard + else: + p.localError ParserReport(kind: rparInvalidIndentation) p.firstTok = true of tkEof: break else: result = complexOrSimpleStmt(p) - if result.kind == nkEmpty: parMessage(p, errExprExpected, p.tok) + if result.kind == nkEmpty: + p.localError ParserReport(kind: rparExprExpected, found: $p.tok) break proc parseString*(s: string; cache: IdentCache; config: ConfigRef; - filename: string = ""; line: int = 0; - errorHandler: ErrorHandler = nil): PNode = + filename: string = ""; line: int = 0): PNode = ## Parses a string into an AST, returning the top node. ## `filename` and `line`, although optional, provide info so that the ## compiler can generate correct error messages referring to the original @@ -2414,7 +2440,6 @@ proc parseString*(s: string; cache: IdentCache; config: ConfigRef; stream.lineOffset = line var parser: Parser - parser.lex.errorHandler = errorHandler openParser(parser, AbsoluteFile filename, stream, cache, config) result = parser.parseAll diff --git a/compiler/passaux.nim b/compiler/passaux.nim index 68b7832489b..026a11b7242 100644 --- a/compiler/passaux.nim +++ b/compiler/passaux.nim @@ -10,7 +10,7 @@ ## implements some little helper passes import - ast, passes, msgs, options, lineinfos + ast, passes, msgs, options, reports from modulegraphs import ModuleGraph, PPassContext @@ -26,6 +26,6 @@ proc verboseProcess(context: PPassContext, n: PNode): PNode = # called from `process` in `processTopLevelStmt`. result = n let v = VerboseRef(context) - message(v.config, n.info, hintProcessingStmt, $v.idgen[]) + localReport(v.config, n, reportSem rsemProcessingStmt) const verbosePass* = makePass(open = verboseOpen, process = verboseProcess) diff --git a/compiler/passes.nim b/compiler/passes.nim index 3debce1f65b..cd749f1989f 100644 --- a/compiler/passes.nim +++ b/compiler/passes.nim @@ -12,9 +12,9 @@ import options, ast, llstream, msgs, - idents, syntaxes, modulegraphs, reorder, - lineinfos, pathutils + lineinfos, pathutils, + reports type TPassData* = tuple[input: PNode, closeOutput: PNode] @@ -48,7 +48,11 @@ proc clearPasses*(g: ModuleGraph) = g.passes.setLen(0) proc registerPass*(g: ModuleGraph; p: TPass) = - internalAssert g.config, g.passes.len < maxPasses + internalAssert( + g.config, + g.passes.len < maxPasses, + "Cannot register more than " & $maxPasses & " passes") + g.passes.add(p) proc openPasses(g: ModuleGraph; a: var TPassContextArray; @@ -102,10 +106,18 @@ const proc prepareConfigNotes(graph: ModuleGraph; module: PSym) = # don't be verbose unless the module belongs to the main package: if module.getnimblePkgId == graph.config.mainPackageId: - graph.config.notes = graph.config.mainPackageNotes + graph.config.asgn(cnCurrent, cnMainPackage) + else: - if graph.config.mainPackageNotes == {}: graph.config.mainPackageNotes = graph.config.notes - graph.config.notes = graph.config.foreignPackageNotes + # QUESTION what are the exact conditions that lead to this branch being + # executed? For example, if I compile `tests/arc/thard_alignment.nim`, + # this sets configuration entries to the 'foreign' state after + # compilation has finished. This tests (despite being quite large) does + # not do any imports. + if graph.config.mainPackageNotes == {}: + graph.config.asgn(cnMainPackage, cnCurrent) + + graph.config.asgn(cnCurrent, cnForeign) proc moduleHasChanged*(graph: ModuleGraph; module: PSym): bool {.inline.} = result = true @@ -125,13 +137,17 @@ proc processModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator; a: TPassContextArray s: PLLStream fileIdx = module.fileIdx + prepareConfigNotes(graph, module) openPasses(graph, a, module, idgen) if stream == nil: let filename = toFullPathConsiderDirty(graph.config, fileIdx) s = llStreamOpen(filename, fmRead) if s == nil: - rawMessage(graph.config, errCannotOpenFile, filename.string) + localReport( + graph.config, + reportStr(rsemCannotOpenFile, filename.string)) + return false else: s = stream @@ -144,8 +160,10 @@ proc processModule*(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": - processImplicits graph, graph.config.implicitImports, nkImportStmt, a, module - processImplicits graph, graph.config.implicitIncludes, nkIncludeStmt, a, module + processImplicits( + graph, graph.config.implicitImports, nkImportStmt, a, module) + processImplicits( + graph, graph.config.implicitIncludes, nkIncludeStmt, a, module) while true: if graph.stopCompile(): break @@ -161,7 +179,8 @@ proc processModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator; var n = parseTopLevelStmt(p) if n.kind == nkEmpty: break sl.add n - if sfReorder in module.flags or codeReordering in graph.config.features: + if sfReorder in module.flags or + codeReordering in graph.config.features: sl = reorder(graph, sl, module) discard processTopLevelStmt(graph, sl, a) break diff --git a/compiler/patterns.nim b/compiler/patterns.nim index 4b39de3baa2..b2c1a0ea4bb 100644 --- a/compiler/patterns.nim +++ b/compiler/patterns.nim @@ -11,7 +11,7 @@ ## macro support. import - ast, types, semdata, sigmatch, idents, aliases, parampatterns, trees + ast, types, semdata, sigmatch, aliases, parampatterns, trees type TPatternContext = object diff --git a/compiler/plugins/itersgen.nim b/compiler/plugins/itersgen.nim index 24e26b2b7bc..043c3ce6d36 100644 --- a/compiler/plugins/itersgen.nim +++ b/compiler/plugins/itersgen.nim @@ -9,25 +9,37 @@ ## Plugin to transform an inline iterator into a data structure. -import ".." / [ast, modulegraphs, lookups, semdata, lambdalifting, msgs] +import ".." / [ + ast, modulegraphs, lookups, semdata, lambdalifting, msgs, reports] proc iterToProcImpl*(c: PContext, n: PNode): PNode = result = newNodeI(nkStmtList, n.info) let iter = n[1] if iter.kind != nkSym or iter.sym.kind != skIterator: - localError(c.config, iter.info, "first argument needs to be an iterator") + localReport(c.config, iter.info, reportAst( + rsemIllformedAst, iter, + str = "first argument needs to be an iterator")) + return if n[2].typ.isNil: - localError(c.config, n[2].info, "second argument needs to be a type") + localReport(c.config, n[2].info, reportAst( + rsemIllformedAst, n, + str = "second argument needs to be a type")) + return if n[3].kind != nkIdent: - localError(c.config, n[3].info, "third argument needs to be an identifier") + localReport(c.config, n[3].info, reportAst( + rsemIllformedAst, n, + str = "third argument needs to be an identifier")) + return let t = n[2].typ.skipTypes({tyTypeDesc, tyGenericInst}) if t.kind notin {tyRef, tyPtr} or t.lastSon.kind != tyObject: - localError(c.config, n[2].info, - "type must be a non-generic ref|ptr to object with state field") + localReport(c.config, n[2].info, reportAst( + rsemIllformedAst, n[2], + str = "type must be a non-generic ref|ptr to object with state field")) + return let body = liftIterToProc(c.graph, iter.sym, getBody(c.graph, iter.sym), t, c.idgen) diff --git a/compiler/pragmas.nim b/compiler/pragmas.nim index 8cc684071b7..fd50fa8ffbc 100644 --- a/compiler/pragmas.nim +++ b/compiler/pragmas.nim @@ -12,7 +12,7 @@ import os, condsyms, ast, astalgo, idents, semdata, msgs, renderer, wordrecg, ropes, options, strutils, extccomp, math, magicsys, trees, - types, lookups, lineinfos, pathutils, linter, errorhandling + types, lookups, lineinfos, pathutils, linter, errorhandling, reports from ic / ic import addCompilerProc @@ -102,21 +102,25 @@ proc recordPragma(c: PContext; n: PNode; args: varargs[string]) = recorded.add newStrNode(args[i], n.info) addPragmaComputation(c, recorded) -const - errStringLiteralExpected = "string literal expected" - errIntLiteralExpected = "integer literal expected" - proc invalidPragma*(c: PContext; n: PNode) = - localError(c.config, n.info, "invalid pragma: " & renderTree(n, {renderNoComments})) + localReport(c.config, n.info, reportAst(rsemInvalidPragma, n)) + proc illegalCustomPragma*(c: PContext, n: PNode, s: PSym) = - localError(c.config, n.info, "cannot attach a custom pragma to '" & s.name.s & "'") + localReport(c.config, n.info, reportSym( + rsemCannotAttachPragma, s, ast = n)) proc newInvalidPragmaNode*(c: PContext; n: PNode): PNode = ## create an error node (`nkError`) for an invalid pragma error - newError(n, InvalidPragma) + c.config.newError(n, reportAst(rsemInvalidPragma, n)) + proc newIllegalCustomPragmaNode*(c: PContext; n: PNode, s: PSym): PNode = ## create an error node (`nkError`) for an illegal custom pragma error - newError(n, IllegalCustomPragma, newSymNode(s)) + c.config.newError( + n, + reportSym(rsemIllegalCustomPragma, s, ast = n), + @[newSymNode(s)], + n.info + ) proc pragmaProposition(c: PContext, n: PNode): PNode = ## drnim - `ensures` pragma, must be a callable with single arg predicate, @@ -125,7 +129,7 @@ proc pragmaProposition(c: PContext, n: PNode): PNode = ## analysed ## 2. nkError node over `n`, when a callable unary proposition isn't provided if n.kind notin nkPragmaCallKinds or n.len != 2: - result = newError(n, "proposition expected") + result = c.config.newError(n, SemReport(kind: rsemPropositionExpected)) else: n[1] = c.semExpr(c, n[1]) @@ -136,7 +140,7 @@ proc pragmaEnsures(c: PContext, n: PNode): PNode = ## analysed, and if the current owner is a routineKind adds a `result` ## symbol. ## 2. nkError node over `n`, when a callable unary proposition isn't provided - ## + ## ## xxx: 1. the implementation is unclear, we create a `result` symbol for ## routines, adding it to the a sub-scope with the routine as owner, but ## won't that potentially create a duplicate `result` symbol? or does @@ -145,7 +149,7 @@ proc pragmaEnsures(c: PContext, n: PNode): PNode = ## as well? result = n if n.kind notin nkPragmaCallKinds or n.len != 2: - result = newError(n, "proposition expected") + result = c.config.newError(n, SemReport(kind: rsemPropositionExpected)) else: openScope(c) let o = getCurrOwner(c) @@ -266,7 +270,7 @@ proc newEmptyStrNode(c: PContext; n: PNode): PNode {.noinline.} = proc getStrLitNode(c: PContext, n: PNode): PNode = ## returns a PNode that's either an error or a string literal node if n.kind notin nkPragmaCallKinds or n.len != 2: - newError(n, StringLiteralExpected) + c.config.newError(n, SemReport(kind: rsemStringLiteralExpected)) else: n[1] = c.semConstExpr(c, n[1]) case n[1].kind @@ -276,8 +280,8 @@ proc getStrLitNode(c: PContext, n: PNode): PNode = # xxx: this is a potential bug, but requires a lot more tests in place # for pragmas prior to changing, but we're meant to return n[1], yet # on error we return a wrapped `n`, that's the wrong level of AST. - newError(n, StringLiteralExpected) - + c.config.newError(n, SemReport(kind: rsemStringLiteralExpected)) + proc strLitToStrOrErr(c: PContext, n: PNode): (string, PNode) = ## extracts the string from an string literal, or errors if it's not a string @@ -288,21 +292,21 @@ proc strLitToStrOrErr(c: PContext, n: PNode): (string, PNode) = (r.strVal, nil) of nkError: ("", r) - else: - ("", newError(n, errStringLiteralExpected)) + else: + ("", c.config.newError(n, SemReport(kind: rsemStringLiteralExpected))) proc intLitToIntOrErr(c: PContext, n: PNode): (int, PNode) = ## extracts the int from an int literal, or errors if it's not an int ## literal or doesn't evaluate to one if n.kind notin nkPragmaCallKinds or n.len != 2: - (-1, newError(n, errIntLiteralExpected)) + (-1, c.config.newError(n, SemReport(kind: rsemIntLiteralExpected))) else: n[1] = c.semConstExpr(c, n[1]) case n[1].kind of nkIntLit..nkInt64Lit: (int(n[1].intVal), nil) else: - (-1, newError(n, errIntLiteralExpected)) + (-1, c.config.newError(n, SemReport(kind: rsemIntLiteralExpected))) proc getOptionalStrLit(c: PContext, n: PNode, defaultStr: string): PNode = ## gets an optional strlit node, used for optional arguments to pragmas, @@ -322,7 +326,7 @@ proc processMagic(c: PContext, n: PNode, s: PSym): PNode = ## the `magic` field with the name of the magic in `n` as a string literal. result = n if n.kind notin nkPragmaCallKinds or n.len != 2: - result = newError(n, errStringLiteralExpected) + result = c.config.newError(n, SemReport(kind: rsemStringLiteralExpected)) else: var v: string if n[1].kind == nkIdent: @@ -339,7 +343,7 @@ proc processMagic(c: PContext, n: PNode, s: PSym): PNode = s.magic = m break if s.magic == mNone: - message(c.config, n.info, warnUnknownMagic, v) + c.config.localReport(n.info, reportStr(rsemUnknownMagic, v)) proc wordToCallConv(sw: TSpecialWord): TCallingConvention = # this assumes that the order of special words and calling conventions is @@ -354,9 +358,9 @@ proc isTurnedOn(c: PContext, n: PNode): (bool, PNode) = if x.kind == nkIntLit: (x.intVal != 0, nil) else: - (false, newError(n, "'on' or 'off' expected")) - else: - (false, newError(n, "'on' or 'off' expected")) + (false, c.config.newError(n, SemReport(kind: rsemOnOrOffExpected))) + else: + (false, c.config.newError(n, SemReport(kind: rsemOnOrOffExpected))) proc onOff(c: PContext, n: PNode, op: TOptions, resOptions: var TOptions): PNode = ## produces an error, or toggles the setting in `resOptions` param @@ -382,11 +386,6 @@ proc pragmaNoForward(c: PContext, n: PNode; flag=sfNoForward): PNode = else: err - # deprecated as of 0.18.1 - message(c.config, n.info, warnDeprecated, - "use {.experimental: \"codeReordering\".} instead; " & - (if flag == sfNoForward: "{.noForward.}" else: "{.reorder.}") & " is deprecated") - proc processCallConv(c: PContext, n: PNode): PNode = ## sets the calling convention on the the `c`ontext's option stack, and upon ## failure, eg: lack of calling convention, produces an error over `n`. @@ -397,9 +396,9 @@ proc processCallConv(c: PContext, n: PNode): PNode = of FirstCallConv..LastCallConv: c.optionStack[^1].defaultCC = wordToCallConv(sw) else: - result = newError(n, "calling convention expected") + result = c.config.newError(n, SemReport(kind: rsemCallconvExpected)) else: - result = newError(n, "calling convention expected") + result = c.config.newError(n, SemReport(kind: rsemCallconvExpected)) proc getLib(c: PContext, kind: TLibKind, path: PNode): PLib = for it in c.libs: @@ -416,7 +415,7 @@ proc expectDynlibNode(c: PContext, n: PNode): PNode = ## `n` must be a callable, this will produce the ast for the callable or ## produce a `StringLiteralExpected` error node. if n.kind notin nkPragmaCallKinds or n.len != 2: - result = newError(n, StringLiteralExpected) + result = c.config.newError(n, SemReport(kind: rsemStringLiteralExpected)) else: # For the OpenGL wrapper we support: # {.dynlib: myGetProcAddr(...).} @@ -424,7 +423,7 @@ proc expectDynlibNode(c: PContext, n: PNode): PNode = if result.kind == nkSym and result.sym.kind == skConst: result = result.sym.ast # look it up if result.typ == nil or result.typ.kind notin {tyPointer, tyString, tyProc}: - result = newError(n, StringLiteralExpected) + result = c.config.newError(n, SemReport(kind: rsemStringLiteralExpected)) proc processDynLib(c: PContext, n: PNode, sym: PSym): PNode = ## produces (mutates) the `sym` with all the dynamic libraries specified in @@ -462,19 +461,24 @@ proc processDynLib(c: PContext, n: PNode, sym: PSym): PNode = proc processNote(c: PContext, n: PNode): PNode = ## process a single pragma "note" `n` ## xxx: document this better, this is awful - template handleNote(enumVals, notes): PNode = - let x = findStr(enumVals.a, enumVals.b, n[0][1].ident.s, errUnknown) - case x - of errUnknown: - newInvalidPragmaNode(c, n) - else: - nk = TNoteKind(x) - let x = c.semConstBoolExpr(c, n[1]) - n[1] = x - if x.kind == nkIntLit and x.intVal != 0: incl(notes, nk) - else: excl(notes, nk) - n - + proc handleNote(enumVals: ReportKinds, notes: ConfNoteSet): PNode = + let x = findStr(enumVals, n[0][1].ident.s, repNone) + case x: + of repNone: + newInvalidPragmaNode(c, n) + + else: + let nk = x + let x = c.semConstBoolExpr(c, n[1]) + n[1] = x + + if x.kind == nkIntLit and x.intVal != 0: + incl(c.config, notes, nk) + else: + excl(c.config, notes, nk) + + n + let validPragma = n.kind in nkPragmaCallKinds and n.len == 2 exp = @@ -485,16 +489,16 @@ proc processNote(c: PContext, n: PNode): PNode = bracketExpr = if useExp: exp else: newInvalidPragmaNode(c, n) - + result = if isBracketExpr: - var nk: TNoteKind - case whichKeyword(n[0][0].ident) - of wHint: handleNote(hintMin .. hintMax, c.config.notes) - of wWarning: handleNote(warnMin .. warnMax, c.config.notes) - of wWarningAsError: handleNote(warnMin .. warnMax, c.config.warningAsErrors) - of wHintAsError: handleNote(hintMin .. hintMax, c.config.warningAsErrors) - else: newInvalidPragmaNode(c, n) + let cw = whichKeyword(n[0][0].ident) + case cw: + of wHint: handleNote(repHintKinds, cnCurrent) + of wWarning: handleNote(repWarningKinds, cnCurrent) + of wWarningAsError: handleNote(repWarningKinds, cnWarnAsError) + of wHintAsError: handleNote(repHintKinds, cnHintAsError) + else: newInvalidPragmaNode(c, n) else: bracketExpr @@ -542,15 +546,17 @@ proc processExperimental(c: PContext; n: PNode): PNode = c.features.incl feature if feature == codeReordering: if not isTopLevel(c): - result = newError(n, "Code reordering experimental pragma only valid at toplevel") + result = c.config.newError(n, reportSem(rsemInnerCodeReordering)) c.module.flags.incl sfReorder except ValueError: - n[1] = newError(n[1], "unknown experimental feature") - result = wrapErrorInSubTree(n) + n[1] = c.config.newError( + n[1], reportAst(rsemUnknownExperimental, n[1])) + + result = wrapErrorInSubTree(c.config, n) of nkError: - result = wrapErrorInSubTree(n) + result = wrapErrorInSubTree(c.config, n) else: - result = newError(n, StringLiteralExpected) + result = c.config.newError(n, reportSem(rsemStringLiteralExpected)) proc tryProcessOption(c: PContext, n: PNode, resOptions: var TOptions): (bool, PNode) = ## try to process callable pragmas that are also compiler options, the value @@ -588,6 +594,7 @@ proc tryProcessOption(c: PContext, n: PNode, resOptions: var TOptions): (bool, P let e = processDynLib(c, n, nil) result = (true, if e.kind == nkError: e else: nil) of wOptimization: + # debug n if n[1].kind != nkIdent: result = (false, newInvalidPragmaNode(c, n)) else: @@ -602,7 +609,9 @@ proc tryProcessOption(c: PContext, n: PNode, resOptions: var TOptions): (bool, P excl(resOptions, optOptimizeSpeed) excl(resOptions, optOptimizeSize) else: - result = (false, newError(n, "'none', 'speed' or 'size' expected")) + result = (false, c.config.newError(n, SemReport( + kind: rsemWrongIdent, + expectedIdents: @["none", "speed", "size"]))) else: result = (false, nil) @@ -615,7 +624,7 @@ proc processOption(c: PContext, n: PNode, resOptions: var TOptions): PNode = n else: # calling conventions (boring...): - newError(n, "option expected") + c.config.newError(n, SemReport(kind: rsemPragmaOptionExpected)) proc processPush(c: PContext, n: PNode, start: int): PNode = ## produces (mutates) `n`, or an error, `start` indicates which of the @@ -623,11 +632,14 @@ proc processPush(c: PContext, n: PNode, start: int): PNode = ## child and `n` each in errors. result = n if n[start-1].kind in nkPragmaCallKinds: - result = newError(n, "'push' cannot have arguments") + result = c.config.newError(n, reportSem(rsemUnexpectedPushArgument)) return var x = pushOptionEntry(c) for i in start.. MaxLockLevel: - it[1] = newError(it[1], "integer must be within 0.." & $MaxLockLevel) - result = (UnknownLockLevel, wrapErrorInSubTree(it)) + it[1] = c.config.newError(it[1], reportStr( + rsemLocksPragmaBadLevel, + "integer must be within 0.." & $MaxLockLevel)) + result = (UnknownLockLevel, wrapErrorInSubTree(c.config, it)) else: result = (TLockLevel(x), nil) @@ -956,7 +995,7 @@ proc typeBorrow(c: PContext; sym: PSym, n: PNode): PNode = if n.kind in nkPragmaCallKinds and n.len == 2: let it = n[1] if it.kind != nkAccQuoted: - result = newError(n, "a type can only borrow `.` for now") + result = c.config.newError(n, SemReport(kind: rsemBorrowPragmaNonDot)) return incl(sym.typ.flags, tfBorrowDot) @@ -972,7 +1011,10 @@ proc markCompilerProc(c: PContext; s: PSym): PNode = of ExternNameSet: discard of ExternNameSetFailed: - result = newError(newSymNode(s), "invalid extern name: '" & name & "'. (Forgot to escape '$'?)") + result = c.config.newError( + newSymNode(s), + SemReport(kind: rsemInvalidExtern, sym: s, externName: name)) + incl(s.flags, sfCompilerProc) incl(s.flags, sfUsed) registerCompilerProc(c.graph, s) @@ -986,10 +1028,11 @@ proc deprecatedStmt(c: PContext; outerPragma: PNode): PNode = incl(c.module.flags, sfDeprecated) c.module.constraint = getStrLitNode(c, outerPragma) if c.module.constraint.kind == nkError: - result = wrapErrorInSubTree(outerPragma) + result = wrapErrorInSubTree(c.config, outerPragma) return elif pragma.kind != nkBracket: - result = newError(pragma, "list of key:value pairs expected") + result = c.config.newError(pragma, reportStr( + rsemBadDeprecatedArgs, "list of key:value pairs expected")) return for n in pragma: if n.kind in nkPragmaCallKinds and n.len == 2: @@ -997,7 +1040,7 @@ proc deprecatedStmt(c: PContext; outerPragma: PNode): PNode = if dest == nil or dest.kind in routineKinds or dest.kind == skError: # xxx: warnings need to be figured out, also this is just silly, why # are they unreliable? - localError(c.config, n.info, warnUser, "the .deprecated pragma is unreliable for routines") + localReport(c.config, n.info, SemReport(kind: rsemUserWarning)) let (src, err) = considerQuotedIdent2(c, n[0]) if err.isNil: let alias = newSym(skAlias, src, nextSymId(c.idgen), dest, n[0].info, c.config.options) @@ -1013,7 +1056,8 @@ proc deprecatedStmt(c: PContext; outerPragma: PNode): PNode = result = err return else: - result = newError(n, "key:value pair expected") + result = c.config.newError(n, reportStr( + rsemBadDeprecatedArgs, "key:value pair expected")) return proc pragmaGuard(c: PContext; it: PNode; kind: TSymKind): PSym = @@ -1053,14 +1097,14 @@ proc semCustomPragma(c: PContext, n: PNode): PNode = elif n.kind in nkPragmaCallKinds: callNode = n else: - result = newError(n, InvalidPragma) + result = c.config.newError(n, reportAst(rsemInvalidPragma, n)) return # invalidPragma(c, n) # return n let r = c.semOverloadedCall(c, callNode, n, {skTemplate}, {efNoUndeclared}) if r.isNil or sfCustomPragma notin r[0].sym.flags: - result = newError(n, InvalidPragma) + result = c.config.newError(n, reportAst(rsemInvalidPragma, n)) return # invalidPragma(c, n) # return n @@ -1085,14 +1129,14 @@ proc processEffectsOf(c: PContext, n: PNode; owner: PSym): PNode = n else: # xxx: was errGenerated for error handling - newError(n, "parameter cannot be declared as .effectsOf") + c.config.newError(n, reportAst(rsemMisplacedEffectsOf, n)) else: # xxx: was errGenerated for error handling - newError(n, "parameter name expected") + c.config.newError(n, reportAst(rsemMissingPragmaArg, n)) if n.kind notin nkPragmaCallKinds or n.len != 2: # xxx: was errGenerated for error handling - result = newError(n, "parameter name expected") + result = c.config.newError(n, reportAst(rsemMissingPragmaArg, n)) else: let it = n[1] if it.kind in {nkCurly, nkBracket}: @@ -1109,14 +1153,14 @@ proc prepareSinglePragma( ): PNode = ## given a `sym`bol with pragmas `n`, check and prepare `i`'th pragma, if ## it's a single valid pragma, where valid is a kind within `validPragmas`. - ## + ## ## With special handling for: ## * comes from a push ## * whether it's `isStatement` ## ## what this does: ## * return an nkError if `invalidPragma` would have been called - ## * all the localErrors and what not should be nkErrors + ## * all the localReports and what not should be nkErrors ## * flag with nfImplicitPragma if it's an implcit pragma :D ## * return the pragma after prep and it's good to go var @@ -1130,9 +1174,9 @@ proc prepareSinglePragma( of nkCast: result = if comesFromPush: - newError(n, "a 'cast' pragma cannot be pushed") + c.config.newError(n, reportAst(rsemCannotPushCast, nil)) elif not isStatement: - newError(n, "'cast' pragma only allowed in statement context") + c.config.newError(n, reportAst(rsemCastRequiresStatement, nil)) elif whichPragma(key[1]) in {wRaises, wTags}: pragmaRaisesOrTags(c, key[1]) else: @@ -1162,9 +1206,11 @@ proc prepareSinglePragma( # number of pragmas increase/decrease with user pragma expansion inc c.instCounter if c.instCounter > 100: - result = newError(it, "recursive dependency: " & userPragma.name.s) + result = c.config.newError( + it, reportSym(rsemPragmaRecursiveDependency, userPragma)) + return # xxx: under the legacy error scheme, this was a - # `msgs.globalError`, which means `doRaise`, or throw an + # `msgs.globalReport`, which means `doRaise`, or throw an # exception on error, so we return. The rest of the code will # have to respsect this somewhat. @@ -1185,18 +1231,20 @@ proc prepareSinglePragma( if extLit.kind == nkError: result = it else: - let ext = extLit.strVal + let ext = extLit.strVal case makeExternExport(c, sym, ext) of ExternNameSet: if k == wExportCpp: if c.config.backend != backendCpp: - result = newError(it, "exportcpp requires `cpp` backend, got: " & $c.config.backend) + result = c.config.newError(it, reportSem rsemExportcppRequiresCpp) return else: incl(sym.flags, sfMangleCpp) result = it of ExternNameSetFailed: - result = newError(it, "invalid extern name: '" & ext & "'. (Forgot to escape '$'?)") + result = c.config.newError( + it, SemReport(kind: rsemInvalidExtern, externName: ext)) + incl(sym.flags, sfUsed) # avoid wrong hints of wImportc: let nameLit = getOptionalStrLit(c, it, "$1") @@ -1212,7 +1260,8 @@ proc prepareSinglePragma( of ExternNameSet: it of ExternNameSetFailed: - newError(it, "invalid extern name: '" & name & "'. (Forgot to escape '$'?)") + c.config.newError( + it, SemReport(kind: rsemInvalidExtern, externName: name)) of wImportCompilerProc: let nameLit = getOptionalStrLit(c, it, "$1") case nameLit.kind @@ -1227,7 +1276,8 @@ proc prepareSinglePragma( of ExternNameSet: it of ExternNameSetFailed: - newError(it, "invalid extern name: '" & name & "'. (Forgot to escape '$'?)") + c.config.newError( + it, SemReport(kind: rsemInvalidExtern, externName: name)) of wExtern: let (name, err) = strLitToStrOrErr(c, it) if err.isNil: @@ -1236,7 +1286,8 @@ proc prepareSinglePragma( of ExternNameSet: it of ExternNameSetFailed: - newError(it, "invalid extern name: '" & name & "'. (Forgot to escape '$'?)") + c.config.newError( + it, SemReport(kind: rsemInvalidExtern, externName: name)) else: result = err of wDirty: @@ -1258,7 +1309,8 @@ proc prepareSinglePragma( of ExternNameSet: it of ExternNameSetFailed: - newError(it, "invalid extern name: '" & name & "'. (Forgot to escape '$'?)") + c.config.newError( + it, SemReport(kind: rsemInvalidExtern, externName: name)) of wCppNonPod: incl(sym.flags, sfCppNonPod) result = it @@ -1271,9 +1323,9 @@ proc prepareSinglePragma( let name = nameLit.strVal result = if c.config.backend != backendJs: - newError(it, "`importjs` pragma requires the JavaScript target") + c.config.newError(it, reportSem rsemImportjsRequiresJs) elif sym.kind in skProcKinds and {'(', '#', '@'} notin name: - newError(it, "`importjs` for routines requires a pattern") + c.config.newError(it, reportSem rsemImportjsRequiresPattern) else: incl(sym.flags, sfImportc) incl(sym.flags, sfInfixCall) @@ -1281,7 +1333,8 @@ proc prepareSinglePragma( of ExternNameSet: it of ExternNameSetFailed: - newError(it, "invalid extern name: '" & name & "'. (Forgot to escape '$'?)") + c.config.newError( + it, SemReport(kind: rsemInvalidExtern, externName: name)) of wImportObjC: let nameLit = getOptionalStrLit(c, it, "$1") case nameLit.kind @@ -1294,7 +1347,8 @@ proc prepareSinglePragma( of ExternNameSet: it of ExternNameSetFailed: - newError(it, "invalid extern name: '" & name & "'. (Forgot to escape '$'?)") + c.config.newError( + it, SemReport(kind: rsemInvalidExtern, externName: name)) of wSize: result = if sym.typ == nil: @@ -1315,7 +1369,7 @@ proc prepareSinglePragma( sym.typ.align = floatInt64Align(c.config) it else: - newError(it, "size may only be 1, 2, 4 or 8") + c.config.newError(it, reportSem rsemBitsizeRequires1248) of wAlign: let (alignment, err) = intLitToIntOrErr(c, it) result = @@ -1323,12 +1377,12 @@ proc prepareSinglePragma( of -1: err of 0: - newError(it, "power of two expected") + c.config.newError(it, reportSem rsemAlignRequiresPowerOfTwo) elif isPowerOfTwo(alignment): sym.alignment = max(sym.alignment, alignment) it else: - newError(it, "power of two expected") + c.config.newError(it, reportSem rsemAlignRequiresPowerOfTwo) of wNodecl: result = noVal(c, it) incl(sym.loc.flags, lfNoDecl) @@ -1404,13 +1458,13 @@ proc prepareSinglePragma( incl(sym.flags, sfNoReturn) if sym.typ[0] != nil: # xxx: the info for this node used to be: sym.ast[paramsPos][0].info - result = newError(it, NoReturnHasReturn) + result = c.config.newError(it, reportSem rsemNoReturnHasReturn) of wNoDestroy: result = noVal(c, it) incl(sym.flags, sfGeneratedOp) of wNosinks: result = noVal(c, it) - incl(sym.flags, sfWasForwarded) + incl(sym.flags, sfWasForwarded) of wDynlib: result = processDynLib(c, it, sym) of wCompilerProc, wCore: @@ -1439,7 +1493,7 @@ proc prepareSinglePragma( elif sym != nil and sym.kind != skModule: # We don't support the extra annotation field if it.kind in nkPragmaCallKinds: - result = newError(it, "annotation to deprecated not supported here") + result = c.config.newError(it, reportSem rsemMisplacedDeprecation) incl(sym.flags, sfDeprecated) # At this point we're quite sure this is a statement and applies to the # whole module @@ -1497,7 +1551,7 @@ proc prepareSinglePragma( if sym.kind != skType: incl(sym.flags, sfThread) if sym.typ != nil: incl(sym.typ.flags, tfGcSafe) - else: + else: result = newInvalidPragmaNode(c, it) else: discard "no checking if used as a code block" @@ -1512,7 +1566,7 @@ proc prepareSinglePragma( result = if err.isNil: recordPragma(c, it, "hint", s) - message(c.config, it.info, hintUser, s) + c.config.localReport(it.info, reportStr(rsemUserHint, s)) it else: err @@ -1521,7 +1575,7 @@ proc prepareSinglePragma( result = if err.isNil: recordPragma(c, it, "warning", s) - message(c.config, it.info, warnUser, s) + c.config.localReport(it.info, reportStr(rsemUserWarning, s)) it else: err @@ -1545,9 +1599,11 @@ proc prepareSinglePragma( result = s # err else: recordPragma(c, it, "error", s.strVal) - result = newError(it, CustomUserError, s) + result = c.config.newError( + it, reportStr(rsemCustomUserError, s.strVal)) of wFatal: - result = c.newError(it, FatalError, getStrLitNode(c, it)) + result = c.config.newError( + it, SemReport(kind: rsemFatalError), args = @[getStrLitNode(c, it)]) of wDefine: result = processDefine(c, it) of wUndef: @@ -1562,7 +1618,7 @@ proc prepareSinglePragma( result = if err.isNil: extccomp.addLinkOption(c.config, s) - recordPragma(c, it, "passl", s) + recordPragma(c, it, "passl", s) it else: err @@ -1580,7 +1636,8 @@ proc prepareSinglePragma( let (s, err) = strLitToStrOrErr(c, it) result = if err.isNil: - extccomp.addLocalCompileOption(c.config, s, toFullPathConsiderDirty(c.config, sym.info.fileIndex)) + extccomp.addLocalCompileOption( + c.config, s, toFullPathConsiderDirty(c.config, sym.info.fileIndex)) recordPragma(c, it, "localpassl", s) it else: @@ -1610,13 +1667,16 @@ proc prepareSinglePragma( wLineDir, wOptimization, wStaticBoundchecks, wStyleChecks, wCallconv, wDebugger, wProfiler, wFloatChecks, wNanChecks, wInfChecks, wPatterns, wTrMacros: - result = processOption(c, it, c.config.options) + var tmp = c.config.options + result = processOption(c, it, tmp) + c.config.options = tmp of wStackTrace, wLineTrace: - result = - if sym.kind in {skProc, skMethod, skConverter}: - processOption(c, it, sym.options) - else: - processOption(c, it, c.config.options) + if sym.kind in {skProc, skMethod, skConverter}: + result = processOption(c, it, sym.options) + else: + var tmp = c.config.options + result = processOption(c, it, tmp) + c.config.options = tmp of FirstCallConv..LastCallConv: assert(sym != nil) result = it @@ -1654,7 +1714,7 @@ proc prepareSinglePragma( sym.typ.kind = tyUncheckedArray of wUnion: if c.config.backend == backendJs: - result = newError(it, "`{.union.}` is not implemented for js backend.") + result = c.config.newError(it, reportSem rsemNoUnionForJs) else: result = noVal(c, it) if sym.typ == nil: @@ -1672,7 +1732,9 @@ proc prepareSinglePragma( of wByRef: result = noVal(c, it) if sym == nil or sym.typ == nil: - result = processOption(c, it, c.config.options) + var tmp = c.config.options + result = processOption(c, it, tmp) + c.config.options = tmp else: incl(sym.typ.flags, tfByRef) of wByCopy: @@ -1712,7 +1774,7 @@ proc prepareSinglePragma( (sym.bitsize, result) = intLitToIntOrErr(c, it) if result.isNil: result = it if sym.bitsize <= 0: - result = newError(it, "bitsize needs to be positive") + result = c.config.newError(it, reportSem rsemBitsizeRequiresPositive) of wGuard: result = it if sym == nil or sym.kind notin {skVar, skLet, skField}: @@ -1739,22 +1801,26 @@ proc prepareSinglePragma( result = it of wExperimental: if not isTopLevel(c): - result = newError(it, "'experimental' pragma only valid as toplevel statement or in a 'push' environment") + result = c.config.newError(it, reportSem rsemExperimentalRequiresToplevel) result = processExperimental(c, it) of wThis: if it.kind in nkPragmaCallKinds and it.len == 2: (c.selfName, result) = considerQuotedIdent2(c, it[1]) if result == nil: result = it - message(c.config, n.info, warnDeprecated, "'.this' pragma is deprecated") + localReport( + c.config, n.info, + reportStr(rsemDeprecated, "'.this' pragma is deprecated")) else: it[1] = result # we retrieved it above from `it[1]`, so making sure return the same node - result = wrapErrorInSubTree(it) + result = wrapErrorInSubTree(c.config, it) elif it.kind == nkIdent or it.len == 1: c.selfName = getIdent(c.cache, "self") - message(c.config, n.info, warnDeprecated, "'.this' pragma is deprecated") + localReport( + c.config, n.info, + reportStr(rsemDeprecated, "'.this' pragma is deprecated")) else: - result = newError(it, "'this' pragma is allowed to have zero or one arguments") + result = c.config.newError(it, reportSem rsemThisPragmaRequires01Args) of wNoRewrite: result = noVal(c, it) of wBase: @@ -1783,7 +1849,7 @@ proc prepareSinglePragma( result = pragmaEnsures(c, it) of wEnforceNoRaises: sym.flags.incl sfNeverRaises - else: + else: result = newInvalidPragmaNode(c, it) elif comesFromPush and whichKeyword(ident) != wInvalid: discard "ignore the .push pragma; it doesn't apply" @@ -1813,14 +1879,18 @@ proc mergePragmas(n, pragmas: PNode) = proc pragmaRec(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords; isStatement: bool): PNode = result = n + assert not cyclicTree(n) if n == nil: return var i = 0 while i < n.len: let p = prepareSinglePragma(c, sym, n, i, validPragmas, false, isStatement) + assert not cyclicTree(p) if p.isErrorLike: + assert not cyclicTree(result) result[i] = p - result = wrapErrorInSubTree(result) + assert not cyclicTree(result) + result = wrapErrorInSubTree(c.config, result) return elif p != nil and nfImplicitPragma in p.flags: break @@ -1852,7 +1922,8 @@ proc implicitPragmas*(c: PContext, sym: PSym, info: TLineInfo, if p.kind == nkError: result = newSym(skError, sym.name, nextSymId(c.idgen), sym.owner, sym.info) result.typ = c.errorType - result.ast = newError(p, ImplicitPragmaError, newSymNode(sym)) + result.ast = c.config.newError( + p, reportSem rsemImplicitPragmaError, args = @[newSymNode(sym)]) return if nfImplicitPragma in p.flags: internalError(c.config, info, "implicitPragmas") @@ -1864,7 +1935,7 @@ proc implicitPragmas*(c: PContext, sym: PSym, info: TLineInfo, if lfExportLib in sym.loc.flags and sfExportc notin sym.flags: result = newSym(skError, sym.name, nextSymId(c.idgen), sym.owner, sym.info) result.typ = c.errorType - result.ast = newError(newSymNode(sym), PragmaDynlibRequiresExportc) + result.ast = c.config.newError(newSymNode(sym), reportSem rsemPragmaDynlibRequiresExportc) return var lib = c.optionStack[^1].dynlib if {lfDynamicLib, lfHeader} * sym.loc.flags == {} and @@ -1892,4 +1963,4 @@ proc pragmaCallable*(c: PContext, sym: PSym, n: PNode, let p = pragmaRec(c, sym, n[pragmasPos], validPragmas, false) if p.kind == nkError: n[pragmasPos] = p - result = wrapErrorInSubTree(n) + result = wrapErrorInSubTree(c.config, n) diff --git a/compiler/procfind.nim b/compiler/procfind.nim index 0bdb3dae6d5..647f44bebe5 100644 --- a/compiler/procfind.nim +++ b/compiler/procfind.nim @@ -11,7 +11,8 @@ # This is needed for proper handling of forward declarations. import - ast, astalgo, msgs, semdata, types, trees, strutils, lookups + ast, astalgo, msgs, semdata, types, trees, lookups, + reports proc equalGenericParams(procA, procB: PNode): bool = if procA.len != procB.len: return false @@ -38,13 +39,12 @@ proc searchForProcAux(c: PContext, scope: PScope, fn: PSym): PSym = case equalParams(result.typ.n, fn.typ.n) of paramsEqual: if (sfExported notin result.flags) and (sfExported in fn.flags): - let message = ("public implementation '$1' has non-public " & - "forward declaration at $2") % - [getProcHeader(c.config, result, getDeclarationPath = false), c.config$result.info] - localError(c.config, fn.info, message) + localReport(c.config, fn.info, reportSym( + rsemDeclarationVisibilityMismatch, result)) return of paramsIncompatible: - localError(c.config, fn.info, "overloaded '$1' leads to ambiguous calls" % fn.name.s) + localReport(c.config, fn.info, reportSym(rsemAmbiguousCall, fn)) + return of paramsNotEqual: discard diff --git a/compiler/renderer.nim b/compiler/renderer.nim index 4d76dcb32c2..c265fb7be0c 100644 --- a/compiler/renderer.nim +++ b/compiler/renderer.nim @@ -7,7 +7,7 @@ # distribution, for details about the copyright. # -# This module implements the renderer of the standard Nim representation. +## This module implements the renderer of the standard Nim representation. when defined(nimHasUsed): # 'import renderer' is so useful for debugging @@ -15,7 +15,7 @@ when defined(nimHasUsed): {.used.} import - lexer, options, idents, strutils, ast, msgs, lineinfos + lexer, options, idents, strutils, ast, msgs, lineinfos, reports type TRenderFlag* = enum @@ -411,7 +411,8 @@ proc atom(g: TSrcGen; n: PNode): string = if (n.typ != nil) and (n.typ.sym != nil): result = n.typ.sym.name.s else: result = "[type node]" else: - internalError(g.config, "renderer.atom " & $n.kind) + g.config.localReport InternalReport( + kind: rintUnreachable, msg: "renderer.atom " & $n.kind) result = "" proc lcomma(g: TSrcGen; n: PNode, start: int = 0, theEnd: int = - 1): int = @@ -423,7 +424,7 @@ proc lcomma(g: TSrcGen; n: PNode, start: int = 0, theEnd: int = - 1): int = inc(result, lsub(g, param)) inc(result, 2) # for ``, `` if result > 0: - dec(result, 2) # last does not get a comma! + dec(result, 2) # last does not get a comma proc lsons(g: TSrcGen; n: PNode, start: int = 0, theEnd: int = - 1): int = assert(theEnd < 0) @@ -1701,7 +1702,8 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext, fromStmtList = false) = gsub(g, n[0], c) else: #nkNone, nkExplicitTypeListCall: - internalError(g.config, n.info, "renderer.gsub(" & $n.kind & ')') + g.config.localReport InternalReport( + kind: rintUnreachable, msg: "renderer.gsub(" & $n.kind & ')') proc renderTree*(n: PNode, renderFlags: TRenderFlags = {}): string = if n == nil: return "" @@ -1739,7 +1741,8 @@ proc renderModule*(n: PNode, outfile: string, write(f, g.buf) close(f) else: - rawMessage(g.config, errGenerated, "cannot open file: " & outfile) + g.config.localReport InternalReport( + kind: rintCannotOpenFile, file: outfile) proc initTokRender*(r: var TSrcGen, n: PNode, renderFlags: TRenderFlags = {}) = initSrcGen(r, renderFlags, newPartialConfigRef()) diff --git a/compiler/reorder.nim b/compiler/reorder.nim index 65c1fb9eef4..6a82b91ebcd 100644 --- a/compiler/reorder.nim +++ b/compiler/reorder.nim @@ -1,8 +1,8 @@ import - intsets, ast, idents, algorithm, renderer, strutils, + intsets, ast, idents, algorithm, renderer, msgs, modulegraphs, syntaxes, options, modulepaths, - lineinfos + lineinfos, reports type DepN = ref object @@ -129,8 +129,13 @@ proc expandIncludes(graph: ModuleGraph, module: PSym, n: PNode, var f = checkModuleName(graph.config, a[i]) if f != InvalidFileIdx: if containsOrIncl(includedFiles, f.int): - localError(graph.config, a.info, "recursive dependency: '$1'" % - toMsgFilename(graph.config, f)) + localReport( + graph.config, + a.info, + reportStr( + rsemRecursiveInclude, + toMsgFilename(graph.config, f))) + else: let nn = includeModule(graph, module, f) let nnn = expandIncludes(graph, module, nn, modulePath, @@ -205,7 +210,7 @@ proc mergeSections(conf: ConfigRef; comps: seq[seq[DepN]], res: PNode) = wmsg &= "line " & $cs[^1].pnode.info.line & " depends on line " & $cs[j].pnode.info.line & ": " & cs[^1].expls[ci] & "\n" - message(conf, cs[0].pnode.info, warnUser, wmsg) + localReport(conf, cs[0].pnode.info, SemReport(kind: rsemReorderingFail)) var i = 0 while i < cs.len: diff --git a/compiler/reports.nim b/compiler/reports.nim new file mode 100644 index 00000000000..eda5aaba73f --- /dev/null +++ b/compiler/reports.nim @@ -0,0 +1,1998 @@ +## This module provides type definitions for all structured report entries +## that compiler can provide. +## +## Note that this module specifically does not import anything else from +## the compiler - by design it is supposed to be available in every other +## module (because almost any phase of the compiler can generate reports +## one way or another). By design report should contain as much information +## as possible and *never* be used for any conditional logic in the +## compiler - it is a final form of the output that can only be printed to +## the output (either via user-provided report hook implementation, or +## using one of the built-in ones) +## +## Not using compiler-specific types also allows this report to be easily +## reused by external tooling - custom error pretty-printers, test runners +## and so on. + +import std/[options, packedsets] + +import + ast_types, + vm_enums, + nilcheck_enums, + int128 + +export + ast_types, + options.some, + options.none, + options.Option, + int128.toInt128 + +type InstantiationInfo* = typeof(instantiationInfo()) + + +type + ReportCategory* = enum + ## Kinds of the toplevel reports. Only dispatches on report topics, + ## such as sem, parse, macro (for `echo` in compile-time code) and so + ## on. Subdivision is based on different phases of the compiler + ## operation, and not on report's state itself, as those are completely + ## orthogonal to each other (lexer might provide errors and hints, + ## parser can provide errors, hints and warnings) + + repParser = "Parser" + repLexer = "Lexer" ## Report generated by lexer - bad tokens, lines + ## that are too long etc. + + repSem = "Sem" ## Report produced directly by semantic analysis - + ## compilation errors, warnings and hints + + repCmd = "Cmd" ## Report related to execution of the external command - + ## start of the command, execution failure, succes and so on. + + repDebug = "Debug" ## Side channel for the compiler debug report. Sem + ## expansion traces and other helper messages designed specifically to + ## aid development of the compiler + + repInternal = "Internal" ## Reports constructed during hanling of the + ## internal compilation errors. Separate from debugging reports since + ## they always exist - ICE, internal fatal errors etc. + + repBackend = "Backend" ## Backend-specific reports. + + repExternal = "External" ## Report constructed during handling of the + ## external configuration, command-line flags, packages, modules. + + + ReportKind* = enum + ## Toplevel enum for different categories. Order of definitions is + ## really important - elements are first separated into categories + ## (internal reports, backend reports and so on) and can be further + ## split into severity levels. + ## + ## Different naming scheme is used for a reports with different + ## categories - this enum exists only to make it easier to work with + ## different report kinds, without having to manage seven different + ## enum types. + + repNone + + #-------------------------- Internal reports ---------------------------# + # Internal reports being + # fatal errors begin + rintUnknown ## Unknown internal report kind + rintFatal ## Explicitly fatal compiler error + + rintUnreachable ## State in the compiler code that must not be reached + rintAssert ## Failed internal assert in the compiler + + + rintIce ## Internal compilation error + # fatal end + + # errors being + rintCannotOpenFile + rintUsingLeanCompiler + rintNotUsingNimcore + rintNotImplemented + # errors end + + # warnings begin + rintWarnCannotOpenFile + rintUnexpected + rintWarnFileChanged + # warnings end + + # hints start + rintSource = "Source" ## Show source in the report + # REFACTOR this is a global configuration option, + # not a hint. + + + rintGCStats = "GCStats" ## Print GC statistics for the compiler run + rintQuitCalled = "QuitCalled" ## `quit()` called by the macro code + ## compilation error handling and similar + rintMissingStackTrace ## Stack trace would've been generated in the + ## debug compiler build + rintMsgOrigin = "MsgOrigin" + rintErrKind = "ErrKind" ## Show report kind in error messages + + rintSuccessX = "SuccessX" ## Succesfull compilation + # hints end + + rintStackTrace = "StackTrace" ## Stack trace during internal + rintNimconfWrite + rintListWarnings + rintListHints + rintDumpState + rintEchoMessage # last ! + + # internal reports end + + #-------------------------- External reports ---------------------------# + # External reports + # errors begin + rextUnknownCCompiler + + # malformed cmdline parameters begin + rextInvalidHint + rextInvalidWarning + rextInvalidCommandLineOption ## Invalid command-line option passed to + ## the compiler + rextOnlyAllOffSupported ## Only `all:off` is supported for mass + ## hint/warning modification. Separate diagnostics must be enabled on + ## one-by-one basis. + rextExpectedOnOrOff ## Command-line option expected 'on' or 'off' value + rextExpectedOnOrOffOrList ## Command-line option expected 'on', 'off' + ## or 'list' value. + rextExpectedCmdArgument ## Command-line option expected argument + rextExpectedNoCmdArgument ## Command-line option expected no arguments + rextInvalidNumber ## Command-line switch expected a number + rextInvalidValue + rextUnexpectedValue ## Command-line argument had value, but it did not + ## match with any expected. + + rextIcUnknownFileName + rextIcNoSymbolAtPosition + + rextExpectedCbackendForRun + rextExpectedTinyCForRun + rextInvalidCommand + rextCommandMissing + rextExpectedRunOptForArgs + rextUnexpectedRunOpt + rextInvalidPath ## Invalid path for a command-line argument + + rextInvalidPackageName ## When adding packages from the `--nimbleDir` + ## (or it's default value), names are validated. This error is + ## generated if package name is not correct. + # errors end + + # warnings begin + rextDeprecated ## Report about use of the deprecated feature that is + ## not in the semantic pass. Things like deprecated flags, compiler + ## commands and so on. + # warnings end + + # hints start + rextConf = "Conf" ## Processing user configutation file + rextPath = "Path" ## Add nimble path + # hints end + + # external reports end + + #---------------------------- Lexer reports ----------------------------# + # Lexer report begin + # errors begin + rlexMalformedUnderscores + rlexMalformedTrailingUnderscre + rlexInvalidToken + rlexNoTabs + + # numbers + rlexInvalidIntegerPrefix + rlexInvalidIntegerSuffix + rlexNumberNotInRange + rlexExpectedHex + rlexInvalidIntegerLiteral + + # char + rlexInvalidCharLiteral + rlexMissingClosingApostrophe + rlexInvalidUnicodeCodepoint + + # string + rlexUnclosedTripleString + rlexUnclosedSingleString + + rlexExpectedToken + rlexCfgInvalidDirective + + # comments + rlexUnclosedComment + + # errors end + + # warnings begin + rlexDeprecatedOctalPrefix = "OctalEscape" + # warnings end + + # hints begin + rlexLineTooLong = "LineTooLong" + rlexLinterReport = "Name" + + rlexSyntaxesCode + # hints end + + # Lexer report end + + #--------------------------- Parser reports ----------------------------# + # errors begin + # regular nim parser + rparInvalidIndentation + rparNestableRequiresIndentation + + rparIdentExpected + rparIdentOrKwdExpected + rparExprExpected + rparMissingToken + rparUnexpectedToken + rparUnexpectedTokenKind + + rparFuncNotAllowed + rparTupleTypeWithPar + rparMisplacedParameterVar + rparConceptNotinType + rparRotineExpected + rparPragmaAlreadyPresent + rparMisplacedExport + + # template parser `filter_tmpl.nim` + rparTemplMissingEndClose + rparTemplInvalidExpression + + rparInvalidFilter + + # erorrs end + + # warnings begin + rparInconsistentSpacing = "Spacing" + rparEnablePreviewDotOps = "DotLikeOps" + rparPragmaNotFollowingTypeName + rparPragmaBeforeGenericParameters + # warnings end + + rparName = "Name" ## Linter report about used identifier + + #----------------------------- Sem reports -----------------------------# + # semantic fatal + rsemFatalError + # end + + # Semantic errors begin + rsemUserError = "UserError" ## `{.error: }` + rsemUsageIsError + + rsemCompilesError + + rsemCustomError + rsemCustomPrintMsgAndNodeError + ## just like custom error, prints a message and renders wrongNode + rsemTypeMismatch + rsemTypeKindMismatch + rsemAmbiguous + rsemAmbiguousIdent + + rsemCustomUserError + ## just like customer error, but reported as a errUser in msgs + + rsemNodeNotAllowed + ## Generated in `filters.nim` + + rsemCannotProveNotNil + rsemProvablyNil + + # nimsuggest + rsemSugNoSymbolAtPosition + + # Global Errors + rsemCustomGlobalError + ## just like custom error, but treat it like a "raise" and fast track the + ## "graceful" abort of this compilation run, used by `errorreporting` to + ## bridge into the existing `msgs.liMessage` and `msgs.handleError`. + + # Module errors + rsemSystemNeeds + rsemInvalidModulePath + rsemInvalidModuleName + rsemCannotImportItself + rsemRecursiveInclude + rsemRecursiveImport + rsemCannotOpenFile + rsemExportRequiresToplevel + rsemExperimentalRequiresToplevel + rsemMethodRequiresToplevel + rsemPackageRequiresToplevel + rsemConverterRequiresToplevel + rsemImportRequiresToplevel + rsemUnexpectedToplevelDefer + rsemUsingRequiresToplevel + rsemInvalidVisibility + rsemUnknownPackageName + rsemUnexpectedInfixInInclude + + # .. + rsemConflictingExportnims + rsemNoMagicEqualsForType + rsemCantConvertLiteralToType + rsemCantConvertLiteralToRange + rsemCantComputeOffsetof + rsemStaticOutOfBounds ## Error generated when semfold or static bound + ## checking sees and out-of-bounds index error. + rsemStaticFieldNotFound # TODO DOC generated in `semfold.nim`, need + # better documentation, right now I don't know what exactly this error + # means and how to reproduce it in the example code. + rsemSemfoldOverflow + rsemSemfoldDivByZero + rsemSemfoldInvalidConversion + rsemInvalidIntdefine + rsemInvalidBooldefine + + + # Type definitions + rsemCaseInUnion ## `{.union.}` type cannot use `case:` statements + rsemOffsetInUnion ## `{.union.}` type cannot use inheritance and any + ## other features that add implicit chunk of data before the actually + ## listed fields. + rsemUnexpectedInNewConcept + rsemTooNestedConcept + rsemIllegalRecursion + rsemCannotInferStaticValue + + rsemVarVarNotAllowed ## `var lent`, `var var` etc. are not allowed in + ## types + rsemInvalidOrderInEnum + rsemSetTooBig + rsemTIsNotAConcreteType + rsemProcIsNotAConcreteType + rsemRangeIsEmpty + + rsemCannotInstantiate + rsemCannotInstantiateWithParameter + rsemCannotGenerateGenericDestructor + rsemUndeclaredField + rsemInheritanceOnlyWorksWithAnEnum # I have **//ABSOLUTELY NO IDEA//** + # what this error means. I think I might need to add something like + # `rsemWTF` + rsemExpectedOrdinal + rsemExpectedOrdinalOrFloat + rsemExpectedUnholyEnum # yes + rsemExpectedLow0Discriminant + rsemExpectedHighCappedDiscriminant + rsemMissingCaseBranches + rsemRangeDoesNotSupportNan + rsemRangeRequiresDotDot + rsemExpectedRange + rsemArrayExpectsPositiveRange + rsemExpectObjectForBase + rsemExpectNonFinalForBase + + rsemTVoidNotAllowed + rsemExpectedObjectForRegion + rsemUnexpectedVoidType + rsemUnexpectedArrayAssignForCstring + rsemMacroBodyDependsOnGenericTypes + rsemMalformedNotNilType + rsemEnableNotNilExperimental + rsemEnableDotOperatorsExperimental + rsemEnableCallOperatorExperimental + rsemExpectedObjectType + rsemExpectedImportedType + rsemUnexpectedExportcInAlias + rsemExpectedDistinctForBorrow + rsemBorrowTargetNotFound + rsemConceptInferenceFailed + rsemConceptPredicateFailed + + # Procedure definition and instantiation + rsemImplementationNotAllowed + rsemImplementationExpected + rsemRedefinitionOf + rsemDefaultParamIsIncompatible + rsemDeclarationVisibilityMismatch + rsemGenericLambdaNowAllowed + rsemUnexpectedAutoInForwardDeclaration + rsemUnexpectedClosureOnToplevelProc + rsemExpectedReturnTypeForIterator + rsemExpectedReturnTypeForConverter + rsemExpectedOneArgumentForConverter + rsemIncompatibleDefaultExpr + + # Call and procedures + rsemCallTypeMismatch + rsemCallIndirectTypeMismatch + rsemCallNotAProcOrField ## unknown or semantically invalid `obj.field`, + ## `obj.call()` + rsemExpressionCannotBeCalled + rsemWrongNumberOfArguments + rsemWrongNumberOfVariables + rsemWrongNumberOfGenericParams + rsemNoGenericParamsAllowed + rsemAmbiguousCall + rsemCallingConventionMismatch + rsemHasSideEffects + rsemCantPassProcvar + rsemUnlistedRaises + rsemUnlistedEffects + rsemOverrideSafetyMismatch + rsemOverrideLockMismatch + rsemMissingMethodDispatcher + rsemNotABaseMethod + rsemIllegalCallconvCapture + rsemIllegalMemoryCapture + rsemIgnoreInvalidForLoop + rsemMissingGenericParamsForTemplate + rsemMisplacedMagicType + rsemCannotInferParameterType + rsemParameterRequiresAType + rsemParameterRedefinition + rsemInvalidExpression + rsemExpectedNonemptyPattern + + rsemTemplateInstantiationTooNested + rsemMacroInstantiationTooNested + rsemGenericInstantiationTooNested # TODO write out list of generic, + # macro or template instantiations. There is a `pushOwner` called for + # each generic instantiation - can this be reused? + + rsemCannotSpawnProcWithVar + rsemCannotSpawnMagicProc + rsemCannotDiscardSpawn + rsemSpawnRequiresCall + rsemSpawnRequiresGcSafe + rsemSpawnForbidsClosure + rsemSpawnForbidsIterator + + rsemInvalidMethodDeclarationOrder # Right now I have no idea what this + # error means exactly. It /does/ have a 'sort of' reproducible example + # - https://github.com/nim-lang/Nim/issues/5325. No real tests for this + # one of course, I mean who needs this, right? + rsemIsNotParameterOf + rsemParameterNotPointerToPartial + + # Statements + rsemDiscardingVoid + rsemDiscardingProc + rsemInvalidControlFlow + rsemContinueCannotHaveLabel + rsemUseOrDiscard + rsemUseOrDiscardExpr + rsemCannotBeRaised + rsemCannotRaiseNonException + rsemExceptionAlreadyHandled + rsemCannotExceptNativeAndImported + rsemExpectedSingleFinally + rsemExpectedSingleGeneralExcept + rsemCannotConvertToRange + rsemUsingRequiresType + rsemUsingDisallowsAssign + rsemDifferentTypeForReintroducedSymbol + rsemImplicitFieldConstructinoRequiresPartial + rsemCannotInferTypeOfLiteral + rsemCannotInferTypeOfParameter + rsemProcHasNoConcreteType + rsemThreadvarCannotInit + rsemLetNeedsInit + rsemConstExpressionExpected + rsemFieldsIteratorCannotContinue + rsemParallelFieldsDisallowsCase + rsemNoObjectOrTupleType + rsemForExpectsIterator + rsemSelectorMustBeOfCertainTypes + rsemTypeCannotBeForwarded + rsemDoubleCompletionOf + rsemExpectedInvariantParam + rsemCovariantUsedAsNonCovariant + rsemContravariantUsedAsNonCovariant + rsemNonInvariantCannotBeUsedWith + rsemNonInvariantCnnnotBeUsedInConcepts + rsemIncorrectResultProcSymbol + rsemRebidingImplicitDestructor + rsemRebidingDestructor + rsemRebidingDeepCopy + rsemInseparableTypeBoundOp + rsemUnexpectedTypeBoundOpSignature + rsemExpectedDestroyOrDeepCopyForOverride + rsemExpectedObjectForMethod + rsemUnexpectedPragmaInDefinitionOf + rsemMisplacedRunnableExample + + # Expressions + rsemConstantOfTypeHasNoValue + rsemTypeConversionArgumentMismatch + rsemUnexpectedEqInObjectConstructor + rsemIllegalConversion + rsemCannotBeConvertedTo + rsemCannotCastToNonConcrete + rsemCannotCastTypes + rsemExpectedTypeOrValue + rsemInvalidArgumentFor + rsemNoTupleTypeForConstructor + rsemInvalidTupleConstructor + rsemUnknownIdentifier + rsemIndexOutOfBounds + rsemInvalidOrderInArrayConstructor + rsemVarForOutParamNeeded + rsemStackEscape + rsemExprHasNoAddress + rsemUnknownTrait + rsemStringOrIdentNodeExpected + rsemExpectedObjectForOf + rsemCannotBeOfSubtype + rsemQuantifierInRangeExpected + rsemOldTakesParameterName + rsemOldDoesNotBelongTo + rsemCannotFindPlugin + rsemExpectedProcReferenceForFinalizer + rsemCannotIsolate + rsemCannotInterpretNode + rsemRecursiveDependencyIterator + rsemIllegalNimvmContext + rsemDisallowedNilDeref + rsemInvalidTupleSubscript + rsemLocalEscapesStackFrame + rsemImplicitAddrIsNotFirstParam + rsemExpectedOwnerReturn + rsemExpectedUnownedRef + rsemCannotAssignTo + rsemNoReturnTypeDeclared + rsemReturnNotAllowed + rsemCannotInferReturnType + rsemExpectedValueForYield + rsemUnexpectedYield + rsemCannotReturnTypeless + rsemExpectedMacroOrTemplate + rsemAmbiguousGetAst + rsemExpectedTemplateWithNArgs + rsemExpectedCallForGetAst + rsemWrongNumberOfQuoteArguments + rsemEnableExperimentalParallel + rsemExpectedExpressionForSpawn + rsemNamedExprExpected + rsemNamedExprNotAllowed + rsemFieldInitTwice + rsemDisallowedTypedescForTupleField + rsemDisjointFields + rsemUnsafeRuntimeDiscriminantInit + rsemConflictingDiscriminantInit + rsemConflictingDiscriminantValues + rsemRuntimeDiscriminantInitCap + rsemRuntimeDiscriminantMustBeImmutable + rsemRuntimeDiscriminantRequiresElif + rsemObjectRequiresFieldInit + rsemObjectRequiresFieldInitNoDefault + rsemDistinctDoesNotHaveDefaultValue + rsemExpectedModuleNameForImportExcept + rsemCannotExport + rsemCannotMixTypesAndValuesInTuple + rsemExpectedTypelessDeferBody + rsemInvalidBindContext + rsemCannotCreateImplicitOpenarray + rsemCannotAssignToDiscriminantWithCustomDestructor + rsemUnavailableTypeBound + + rsemParallelInvalidControlFlow + rsemParallelCannotProveDisjoint + rsemParallelCounterAfterIncrement + rsemParallelWithoutSpawn + rsemSpawnInvalidContext + + # Identifier Lookup + rsemUndeclaredIdentifier + rsemExpectedIdentifier + rsemExpectedIdentifierInExpr + + # Object and Object Construction + rsemFieldNotAccessible + ## object field is not accessible + rsemFieldAssignmentInvalid + ## object field assignment invalid syntax + rsemFieldOkButAssignedValueInvalid + ## object field assignment, where the field name is ok, but value is not + rsemObjectConstructorIncorrect + ## one or more issues encountered with object constructor + + # General Type Checks + rsemExpressionHasNoType + ## an expression has not type or is ambiguous + + rsemRawTypeMismatch + + rsemCannotConvertTypes + rsemUnresolvedGenericParameter + rsemCannotCreateFlowVarOfType + rsemTypeNotAllowed + + # Literals + rsemIntLiteralExpected + ## int literal node was expected, but got something else + rsemStringLiteralExpected + ## string literal node was expected, but got something else + + rsemOnOrOffExpected + rsemCallconvExpected + rsemInnerCodeReordering + rsemUnknownExperimental + rsemDuplicateCaseLabel + + # view types + rsemExpressionIsNotAPath + rsemResultMustBorrowFirst + rsemCannotDetermineBorrowTarget # TODO DOC need better explanation for + # reasons of this error, right now it looks like a hacked-in check. + rsemCannotBorrow + rsemBorrowOutlivesSource + rsemImmutableBorrowMutation + + # VM + rsemVmOpcParseExpectedExpression + rsemTooManyRegistersRequired + rsemVmCannotFindBreakTarget + rsemVmNotUnused + rsemNotAFieldSymbol + rsemVmTooLargetOffset + rsemVmUnhandledException + rsemVmCannotGenerateCode + rsemVmCannotCast + rsemVmGlobalError ## Error report that was declared as 'global' in the + ## VM - with current 'globalError-is-a-control-flow-mechanism' approach + ## this report is largely meaningless, and used only to raise exception. + rsemVmInvalidBindSym + rsemVmBadExpandToAst + rsemVmCannotEvaluateAtComptime + rsemVmCannotImportc + rsemVmEnableFFIToImportc + rsemVmCannotCreateNullElement + rsemVmInvalidObjectConstructor + rsemVmNoClosureIterators + rsemVmCannotCallMethod + rsemVmCallingNonRoutine + rsemVmCannotModifyTypechecked + rsemVmNilAccess + rsemVmDerefUnsupportedPtr + rsemVmErrInternal + rsemVmIndexError + rsemVmOutOfRange + rsemVmOverOrUnderflow + rsemVmDivisionByConstZero + rsemVmNodeNotASymbol + rsemVmNodeNotAProcSymbol + rsemVmNodeNotAFieldSymbol + rsemVmIllegalConv + rsemVmMissingCacheKey + rsemVmCacheKeyAlreadyExists + rsemVmFieldNotFound + rsemVmFieldInavailable + rsemVmCannotSetChild + rsemVmCannotAddChild + rsemVmCannotGetChild + rsemVmNoType + rsemVmNotAField + + rsemVmTooManyIterations + + rsemMissingImportcCompleteStruct + + rsemCyclicTree + rsemCyclicDependency + rsemConstExprExpected + + # Codegen + rsemRttiRequestForIncompleteObject + rsemExpectedNimcallProc + rsemExpectedExhaustiveCaseForComputedGoto + rsemExpectedUnholyEnumForComputedGoto + rsemTooManyEntriesForComputedGoto + rsemExpectedLow0ForComputedGoto + rsemExpectedCaseForComputedGoto + rsemDisallowedRangeForComputedGoto + rsemExpectedCallForCxxPattern + rsemExpectedParameterForCxxPattern + rsemExpectedLiteralForGoto + rsemRequiresDeepCopyEnabled + rsemDisallowedOfForPureObjects + rsemDisallowedReprForNewruntime + rsemCannotCodegenCompiletimeProc + + # Pragma + rsemInvalidPragma + ## suplied pragma is invalid + rsemCannotAttachPragma + rsemUnexpectedPragma + rsemPropositionExpected + rsemIllegalCustomPragma + ## supplied pragma is not a legal custom pragma, and cannot be attached + rsemNoReturnHasReturn + ## a routine marked as no return, has a return type + rsemImplicitPragmaError + ## a symbol encountered an error when processing implicit pragmas, this + ## should be applied to symbols and treated as a wrapper for the purposes + ## of reporting. the original symbol is stored as the first argument + rsemPragmaDynlibRequiresExportc + ## much the same as `ImplicitPragmaError`, except it's a special case + ## where dynlib pragma requires an importc pragma to exist on the same + ## symbol + ## xxx: pragmas shouldn't require each other, that's just bad design + + rsemWrappedError + ## there is no meaningful error to construct, but there is an error + ## further down the AST that invalidates the whole + + rsemSymbolKindMismatch + rsemIllformedAst + rsemInitHereNotAllowed + rsemIdentExpectedInExpr + rsemTypeExpected + rsemGenericTypeExpected + rsemTypeInvalid + rsemWrongIdent + rsemPragmaOptionExpected + rsemUnexpectedPushArgument + rsemCannotPushCast + rsemCastRequiresStatement + rsemExportcppRequiresCpp + rsemDynlibRequiresExportc + rsemImportjsRequiresJs + rsemImportjsRequiresPattern + rsemBitsizeRequires1248 + rsemBitsizeRequiresPositive + rsemAlignRequiresPowerOfTwo + rsemPragmaRecursiveDependency + rsemMisplacedDeprecation + rsemNoUnionForJs + + rsemThisPragmaRequires01Args + rsemMismatchedPopPush + rsemExcessiveCompilePragmaArgs + rsemLinePragmaExpectsTuple + rsemRaisesPragmaExpectsObject + + # -- locking + rsemLocksPragmaExpectsList + rsemLocksPragmaBadLevel + rsemLocksRequiresArgs + rsemMultilockRequiresSameLevel + rsemInvalidNestedLocking + rsemUnguardedAccess + rsemInvalidGuardField + + rsemDrNimRequiresUsesMissingResult + rsemDrnimCannotProveLeq + rsemDrnimCannotPorveGe + + rsemErrGcUnsafeListing + rsemBorrowPragmaNonDot + rsemInvalidExtern + rsemInvalidPragmaBlock + rsemBadDeprecatedArgs + rsemMisplacedEffectsOf + rsemMissingPragmaArg + rsemErrGcUnsafe + rsemEmptyAsm + + + # end + + # Semantic warnings begin + rsemUserWarning = "User" ## `{.warning: }` + rsemUnknownMagic = "UnknownMagic" + rsemUnusedImport = "UnusedImport" + rsemDeprecated = "Deprecated" + rsemLockLevelMismatch = "LockLevel" + rsemTypelessParam = "TypelessParam" + + rsemWarnUnlistedRaises = "Effect" ## `sempass2.checkRaisesSpec` had + ## `emitWarnings: bool` parameter which was supposedly used to control + ## whether `strictEffects` warnings actually generated an error, or + ## just a warning. But all four uses of this proc had constant `false` + ## written to this field, so for now it does not mean anything and all + ## mismatched raises are routed as errors. + + rsemDotForModuleImport + rsemReorderingFail + rsemProveField = "ProveField" + rsemStrictNotNilExpr = "StrictNotNil" + rsemStrictNotNilResult = "StrictNotNil" + rsemWarnGcUnsafe = "GcUnsafe" + rsemWarnGcUnsafeListing = "GcUnsafe2" + rsemProveInit = "ProveInit" + rsemUninit = "Uninit" + rsemWarnUnsafeCode = "UnsafeCode" + rsemImplicitCstringConvert = "CStringConv" + rsemHoleEnumConvert = "HoleEnumConv" + rsemAnyEnumConvert = "AnyEnumConv" + rsemMethodLockMismatch + rsemUseBase = "UseBase" + rsemUnreachableElse = "UnreachableElse" + rsemUnreachableCode = "UnreachableCode" + rsemInheritFromException = "InheritFromException" + rsemPtrRegionIsDeprecated + rsemTypedReturnDeprecated + rsemEachIdentIsTuple = "EachIdentIsTuple" + rsemResultShadowed = "ResultShadowed" + rsemResultUsed = "ResultUsed" + rsemGenericMethodsDeprecated + rsemSuspiciousEnumConv = "EnumConv" + rsemUnsafeSetLen = "UnsafeSetLen" + rsemUnsafeDefault = "UnsafeDefault" + rsemBindDeprecated + rsemUncollectableRefCycle = "CycleCreated" + rsemParallelWarnCannotProve + rsemParallelWarnCanProve + rsemParallelWarnNotDisjoint + rsemObservableStores = "ObservableStores" + rsemCaseTransition = "CaseTransition" + rsemUseOfGc = "GcMem" # last ! + # end + + # trace + rsemVmStackTrace + # trace + + # Semantic hints begin + rsemUserHint = "User" ## `{.hint: .}` pragma encountereed + rsemLinterReport = "Name" + rsemLinterReportUse = "Name" + rsemHintLibDependency + rsemXDeclaredButNotUsed = "XDeclaredButNotUsed" + rsemDuplicateModuleImport = "DuplicateModuleImport" + rsemXCannotRaiseY = "XCannotRaiseY" + rsemConvToBaseNotNeeded = "ConvToBaseNotNeeded" + rsemConvFromXtoItselfNotNeeded = "ConvFromXtoItselfNotNeeded" + + rsemProcessing = "Processing" ## Processing module + rsemProcessingStmt = "ProcessingStmt" ## Processing toplevel statement + + rsemExprAlwaysX = "ExprAlwaysX" ## Expression always evaluates to "X" + rsemConditionAlwaysTrue = "CondTrue" ## Condition is always true + rsemConditionAlwaysFalse = "CondFalse" ## Condition is always false + + rsemPattern = "Pattern" ## Term rewriting pattern has been triggered + rsemCannotMakeSink ## Argument could not be turned into a sink + ## parameter. Generated once in the whole compiler + ## `sinkparameter_inference.nim` + rsemCopiesToSink ## Passing data to the `sink` parameter still copies + ## due to control flow in the code + + rsemGlobalVar = "GlobalVar" ## Track global variable declarations? + + rsemEffectsListingHint + rsemExpandMacro = "ExpandMacro" ## Trace macro expansion progress + rsemExpandArc = "ExpandArc" + + rsemCompilesReport + rsemNonMatchingCandidates + rsemUserRaw = "UserRaw" # REVIEW - Used in + # `semcall.semOverloadedCall()` and `extccomp.getCompileCFileCmd()`. + # Seems like this one should be removed, it spans multiple compiler + # subsystems. Can't understand what it is doing. + + rsemExtendedContext = "ExtendedContext" ## Extended contextual + ## information. Used in `ccgstmts.genStmts()` and + ## `semexprs.semExprNoType()` + rsemImplicitObjConv = "ImplicitObjConv" + # end + + + #------------------------ Command report kinds -------------------------# + # errors + rcmdFailedExecution + # errors end + + # hints + rcmdCompiling = "CC" + rcmdLinking = "Link" + rcmdExecuting = "Exec" + rcmdRunnableExamplesSuccess + # hints end + + + #---------------------------- Debug reports ----------------------------# + rdbgVmExecTraceFull + rdbgVmExecTraceMinimal + rdbgVmCodeListing + + rdbgTraceDefined # first ! tracer begin + rdbgTraceUndefined + rdbgTraceStart + rdbgTraceStep + rdbgTraceLine + rdbgTraceEnd # last ! tracer end + + rdbgStartingConfRead + rdbgFinishedConfRead + rdbgCfgTrace + + rdbgOptionsPush + rdbgOptionsPop + + #--------------------------- Backend reports ---------------------------# + # errors start + rbackCannotWriteScript ## Cannot write build script to a cache file + rbackCannotWriteMappingFile ## Canot write module compilation mapping + ## file to cache directory + rbackTargetNotSupported ## C compiler does not support requested target + rbackJsTooCaseTooLarge + rbackJsUnsupportedClosureIter + rbackJsonScriptMismatch # ??? used in `extccomp.nim`, TODO figure out + # what the original mesage was responsible for exactly + + rbackRstCannotOpenFile + rbackRstExpected + rbackRstGridTableNotImplemented + rbackRstMarkdownIllformedTable + rbackRstNewSectionExpected + rbackRstGeneralParseError + rbackRstInvalidDirective + rbackRstInvalidField + rbackRstFootnoteMismatch + + rbackCannotProduceAssembly + # errors end + + # warnings start + rbackRstTestUnsupported + rbackRstRedefinitionOfLabel = "RedefinitionOfLabel" + rbackRstUnknownSubstitution = "UnknownSubstitutionX" + rbackRstBrokenLink = "BrokenLink" + rbackRstUnsupportedLanguage = "LanguageXNotSupported" + rbackRstUnsupportedField = "FieldXNotSupported" + rbackRstRstStyle = "warnRstStyle" + + # warnings end + + # hints start + rbackProducedAssembly + rbackCompiling = "Compiling" + rbackLinking = "Link" + # hints end + + ReportKinds* = set[ReportKind] + +const rstWarnings* = {rbackRstTestUnsupported .. rbackRstRstStyle} + +type + ReportLineInfo* = object + ## Location expressed in terms of a single point in the file + file*: string + line*: uint16 + col*: int16 + + ReportSeverity* = enum + rsevDebug = "Debug" ## Internal compiler debug information + + rsevHint = "Hint" ## User-targeted hint + rsevWarning = "Warning" ## User-targeted warnings + rsevError = "Error" ## User-targeted error + + rsevFatal = "Fatal" + rsevTrace = "Trace" ## Additional information about compiler actions - + ## external commands mostly. + + ReportContextKind* = enum + sckInstantiationOf + sckInstantiationFrom + + + ReportContext* = object + location*: TLineInfo ## Report context instantiation + case kind*: ReportContextKind + of sckInstantiationOf: + entry*: PSym ## Instantiated entry symbol + + of sckInstantiationFrom: + discard + + ReportBase* = object of RootObj + context*: seq[ReportContext] + + location*: Option[TLineInfo] ## Location associated with report. Some + ## reports do not have any locations associated with them (most (but + ## not all, due to `gorge`) of the external command executions, sem + ## tracing etc). Some reports might have additional associated location + ## information (view type sealing reasons) - those are handled on the + ## per-report-kind basis. + + reportInst*: ReportLineInfo ## Information about instantiation location + ## of the reports - present for all reports in order to track their + ## origins. + + reportFrom*: ReportLineInfo ## Information about submit location of the + ## report + +type + LexerReportKind* = range[rlexMalformedUnderscores .. rlexSyntaxesCode] + LexerReport* = object of ReportBase + msg*: string + case kind*: ReportKind + of rlexLinterReport: + wanted*: string + got*: string + + else: + discard + + +const + repLexerKinds* = {low(LexerReportKind) .. high(LexerReportKind)} + rlexHintKinds* = {rlexLineTooLong .. rlexSyntaxesCode} + rlexWarningKinds* = {rlexDeprecatedOctalPrefix .. rlexDeprecatedOctalPrefix} + rlexErrorKinds* = {rlexMalformedUnderscores .. rlexUnclosedComment} + +func severity*(rep: LexerReport): ReportSeverity = + case LexerReportKind(rep.kind): + of rlexHintKinds: rsevHint + of rlexErrorKinds: rsevError + of rlexWarningKinds: rsevWarning + +type + ParserReportKind* = range[rparInvalidIndentation .. rparName] + ParserReport* = object of ReportBase + msg*: string + found*: string + case kind*: ReportKind + of rparIdentExpected .. rparUnexpectedToken: + expected*: seq[string] + + of rparInvalidFilter: + node*: PNode + + else: + discard + + + +const + repParserKinds* = {low(ParserReportKind) .. high(ParserReportKind)} + rparHintKinds* = {rparName} + rparErrorKinds* = {rparInvalidIndentation .. rparInvalidFilter} + rparWarningKinds* = { + rparInconsistentSpacing .. rparPragmaBeforeGenericParameters} + +func severity*(parser: ParserReport): ReportSeverity = + case ParserReportKind(parser.kind): + of rparHintKinds: rsevHint + of rparWarningKinds: rsevWarning + of rparErrorKinds: rsevError + +const + rsemReportTwoSym* = { + rsemConflictingExportnims, + rsemBorrowOutlivesSource, + rsemImmutableBorrowMutation, + rsemRedefinitionOf, + rsemInvalidMethodDeclarationOrder, # [s, witness] + rsemIllegalCallconvCapture, # [symbol, owner] + rsemDeprecated # [symbol, use-instead] + } + + rsemReportOneSym* = { + rsemUnexpectedPragmaInDefinitionOf, + rsemDoubleCompletionOf, + + rsemIllegalMemoryCapture, + rsemOverrideSafetyMismatch, + rsemOverrideLockMismatch + } + + rsemReportListSym* = { + rsemAmbiguous, + rsemAmbiguousIdent, + rsemObjectRequiresFieldInit, + rsemObjectRequiresFieldInitNoDefault + } + + rsemReportCountMismatch* = { + rsemWrongNumberOfArguments, + rsemWrongNumberOfGenericParams, + rsemInvalidOrderInEnum, + rsemSetTooBig, + rsemArrayExpectsPositiveRange, + rsemExpectedLow0Discriminant, + rsemInvalidOrderInArrayConstructor, + rsemTypeConversionArgumentMismatch, + rsemInvalidTupleSubscript, + rsemExpectedTemplateWithNArgs, + rsemExpectedParameterForCxxPattern, + rsemWrongNumberOfQuoteArguments, + rsemIndexOutOfBounds, + rsemExpectedHighCappedDiscriminant + } + +type + SemReportKind* = range[rsemFatalError .. rsemImplicitObjConv] + SemReportErrorKind* = range[rsemUserError .. rsemWrappedError] + + SemGcUnsafetyKind* = enum + sgcuCallsUnsafe + sgcuAccessesGcGlobal + sgcuIndirectCallVia + sgcuIndirectCallHere + + SemSideEffectCallKind* = enum + ssefUsesGlobalState + ssefCallsSideEffect + ssefCallsViaHiddenIndirection + ssefCallsViaIndirection + ssefParameterMutation + + SemTypeMismatch* = object + formalTypeKind*: set[TTypeKind] + actualType*, formalType*: PType + descriptionStr*: string + + SemCallMismatch* = object + ## Description of the single candidate mismatch. This type is later + ## used to construct meaningful type mismatch message, and must contain + ## all the necessary information to provide meaningful sorting, + ## collapse and other operations. + target*: PSym ## Procedure that was tried for an overload resolution + expression*: PNode ## Full typed expression that was used as a + ## procedure call + arg*: int ## Mismatched argument index. This corresponds to the + ## *expression* subnode index - due to varargs actual *target + ## parameter* index might differe. See `.formal` field for the actual + ## target argument symbol. + targetArg*: PSym ## parameter that mismatches against provided + ## argument its position can differ from `arg` because of varargs + diagnostics*: seq[SemReport] + arguments*: seq[PNode] + case kind*: MismatchKind + of kTypeMismatch, kVarNeeded: + typeMismatch*: SemTypeMismatch ## Argument type mismatch + ## elaboration + + of kPositionalAlreadyGiven, kUnknownNamedParam, + kAlreadyGiven, kMissingParam: + ## Parameter name (if used) is stored in the `.targetArg` symbol + discard + + else: + discard + + SemSpellCandidate* = object + dist*: int + depth*: int + sym*: PSym + isLocal*: bool + + SemNilHistory* = object + ## keep history for each transition + info*: TLineInfo ## the location + nilability*: Nilability ## the nilability + kind*: NilTransition ## what kind of transition was that + node*: PNode ## the node of the expression + + + SemReport* = object of ReportBase + ast*: PNode + typ*: PType + sym*: PSym + str*: string + spellingCandidates*: seq[SemSpellCandidate] + + case kind*: ReportKind + of rsemDuplicateModuleImport: + previous*: PSym + + of rsemCannotInstantiateWithParameter: + arguments*: tuple[got, expected: seq[PNode]] + + of rsemUnavailableTypeBound: + missingTypeBoundElaboration*: tuple[ + anotherRead: Option[TLineInfo], + tryMakeSinkParam: bool + ] + + of rsemDuplicateCaseLabel: + overlappingGroup*: PNode + + of rsemCannotBorrow: + borrowPair*: tuple[mutatedHere, connectedVia: TLineInfo] + + of rsemXCannotRaiseY: + raisesList*: PNode + + of rsemUncollectableRefCycle: + cycleField*: PNode + + of rsemStrictNotNilExpr, rsemStrictNotNilResult: + nilIssue*: Nilability + nilHistory*: seq[SemNilHistory] + + of rsemExpectedIdentifierInExpr, + rsemExpectedOrdinal, + rsemIdentExpectedInExpr, + rsemFieldOkButAssignedValueInvalid: + wrongNode*: PNode + + of rsemWarnGcUnsafeListing, rsemErrGcUnsafeListing: + gcUnsafeTrace*: tuple[ + isUnsafe: PSym, + unsafeVia: PSym, + unsafeRelation: SemGcUnsafetyKind, + ] + + of rsemHasSideEffects: + sideEffectTrace*: seq[tuple[ + isUnsafe: PSym, + unsafeVia: PSym, + trace: SemSideEffectCallKind, + location: TLineInfo, + level: int + ]] + + sideEffectMutateConnection*: TLineInfo + + of rsemEffectsListingHint: + effectListing*: tuple[tags, exceptions: seq[PType]] + + of rsemVmStackTrace: + currentExceptionA*, currentExceptionB*: PNode + traceReason*: ReportKind + stacktrace*: seq[tuple[sym: PSym, location: TLineInfo]] + + of rsemReportCountMismatch, + rsemWrongNumberOfVariables: + countMismatch*: tuple[expected, got: Int128] + + of rsemInvalidExtern: + externName*: string + + of rsemWrongIdent: + expectedIdents*: seq[string] + + of rsemDrnimCannotProveLeq, rsemDrnimCannotPorveGe: + drnimExpressions*: tuple[a, b: PNode] + + of rsemExprHasNoAddress: + isUnsafeAddr*: bool + + of rsemUndeclaredIdentifier, + rsemCallNotAProcOrField, + : + potentiallyRecursive*: bool + + explicitCall*: bool ## Whether `rsemCallNotAProcOrField` error was + ## caused by expression with explicit dot call: `obj.cal()` + unexpectedCandidate*: seq[PSym] ## Symbols that are syntactically + ## valid in this context, but semantically are not allowed - for + ## example `object.iterator()` call outside of the `for` loop. + + of rsemDisjointFields, + rsemUnsafeRuntimeDiscriminantInit, + rsemConflictingDiscriminantInit, + rsemMissingCaseBranches, + rsemConflictingDiscriminantValues: + fieldMismatches*: tuple[first, second: seq[PSym]] + nodes*: seq[PNode] + + of rsemCannotInstantiate: + ownerSym*: PSym + + of rsemReportTwoSym + rsemReportOneSym + rsemReportListSym: + symbols*: seq[PSym] + + of rsemExpandMacro, rsemPattern, rsemExpandArc: + expandedAst*: PNode + + of rsemLockLevelMismatch, rsemMethodLockMismatch: + anotherMethod*: PSym + lockMismatch*: tuple[expected, got: string] + + of rsemTypeMismatch, + rsemSuspiciousEnumConv, + rsemTypeKindMismatch, + rsemSemfoldInvalidConversion, + rsemCannotConvertTypes, + rsemImplicitObjConv, + rsemVmCannotCast, + rsemIllegalConversion, + rsemConceptInferenceFailed, + rsemCannotCastTypes, + rsemGenericTypeExpected, + rsemCannotBeOfSubtype, + rsemDifferentTypeForReintroducedSymbol: + typeMismatch*: seq[SemTypeMismatch] + + + of rsemSymbolKindMismatch: + expectedSymbolKind*: set[TSymKind] + + of rsemTypeNotAllowed: + allowedType*: tuple[ + allowed: PType, + actual: PType, + kind: TSymKind, + allowedFlags: TTypeAllowedFlags + ] + + of rsemCallTypeMismatch, rsemNonMatchingCandidates: + callMismatches*: seq[SemCallMismatch] ## Description of all the + ## failed candidates. + + of rsemStaticOutOfBounds, rsemVmIndexError: + indexSpec*: tuple[usedIdx, minIdx, maxIdx: Int128] + + + + of rsemProcessing: + processing*: tuple[ + isNimscript: bool, + importStackLen: int, + moduleStatus: string, + fileIdx: FileIndex + ] + + of rsemLinterReport, rsemLinterReportUse: + info*: TLineInfo + linterFail*: tuple[wanted, got: string] + + else: + discard + +const + repSemKinds* = {low(SemReportKind) .. high(SemReportKind)} + rsemErrorKinds* = {rsemUserError .. rsemEmptyAsm} + rsemWarningKinds* = {rsemUserWarning .. rsemUseOfGc} + rsemHintKinds* = {rsemUserHint .. rsemImplicitObjConv} + + # Separated into standalone set to reuse in the `options.severity` + # checking - `--styleCheck=error` is set up as a global option. + repLinterKinds* = {rlexLinterReport, rsemLinterReport, rsemLinterReportUse} + + # `--experimental=strictNotNil` and `{.experimental: "strictNotNil".}` + repNilcheckKinds* = {rsemStrictNotNilExpr, rsemStrictNotNilResult} + + rsemMultiNamed* = @{ + "Performance": {rsemCopiesToSink, rsemCannotMakeSink}, + "Name": repLinterKinds, + "Link": {rbackLinking, rcmdLinking}, + "StrictNotNil": {rsemStrictNotNilExpr, rsemStrictNotNilResult} + } + +func severity*(report: SemReport): ReportSeverity = + case SemReportKind(report.kind): + of rsemErrorKinds: result = rsevError + of rsemWarningKinds: result = rsevWarning + of rsemHintKinds: result = rsevHint + of rsemVmStackTrace: result = rsevTrace + of rsemFatalError: result = rsevFatal + +proc reportSymbols*( + kind: ReportKind, + symbols: seq[PSym], + typ: PType = nil, + ast: PNode = nil + ): SemReport = + case kind: + of rsemReportTwoSym: assert symbols.len == 2 + of rsemReportOneSym: assert symbols.len == 1 + of rsemReportListSym: discard + else: assert false, $kind + + result = SemReport(kind: kind, ast: ast) + result.symbols = symbols + result.typ = typ + +func reportSem*(kind: ReportKind): SemReport = SemReport(kind: kind) + +func reportAst*( + kind: ReportKind, + ast: PNode, str: string = "", typ: PType = nil, sym: PSym = nil + ): SemReport = + + SemReport(kind: kind, ast: ast, str: str, typ: typ, sym: sym) + +func reportTyp*( + kind: ReportKind, + typ: PType, ast: PNode = nil, sym: PSym = nil, str: string = "" + ): SemReport = + SemReport(kind: kind, typ: typ, ast: ast, sym: sym, str: str) + +func reportStr*( + kind: ReportKind, + str: string, ast: PNode = nil, typ: PType = nil, sym: PSym = nil + ): SemReport = + + SemReport(kind: kind, ast: ast, str: str, typ: typ, sym: sym) + +func reportSym*( + kind: ReportKind, + sym: PSym, ast: PNode = nil, str: string = "", typ: PType = nil, + ): SemReport = + + SemReport(kind: kind, ast: ast, str: str, typ: typ, sym: sym) + +template withIt*(expr: untyped, body: untyped): untyped = + block: + var it {.inject.} = expr + body + it + +template tern*(predicate: bool, tBranch: untyped, fBranch: untyped): untyped = + ## Shorthand for inline if/else. Allows use of conditions in strformat, + ## simplifies use in expressions. Less picky with formatting + {.line: instantiationInfo(fullPaths = true).}: + block: + if predicate: tBranch else: fBranch + + +type + CmdReportKind* = range[rcmdFailedExecution .. rcmdRunnableExamplesSuccess] + CmdReport* = object of ReportBase + cmd*: string + msg*: string + code*: int + case kind*: ReportKind + of rcmdFailedExecution: + exitOut*, exitErr*: string + + else: + discard + +const + repCmdKinds* = {low(CmdReportKind) .. high(CmdReportKind)} + rcmdErrorKinds* = {rcmdFailedExecution} + rcmdWarningKinds* = default(set[ReportKind]) + rcmdHintKinds* = {rcmdCompiling .. rcmdRunnableExamplesSuccess} + +func severity*(report: CmdReport): ReportSeverity = + case CmdReportKind(report.kind): + of rcmdHintKinds: rsevHint + of rcmdWarningKinds: rsevWarning + of rcmdErrorKinds: rsevError + +type + DebugReportKind* = range[rdbgVmExecTraceFull .. rdbgOptionsPop] + + DebugSemStepDirection* = enum semstepEnter, semstepLeave + DebugSemStepKind* = enum + stepNodeToNode + stepNodeFlagsToNode + stepNodeTypeToNode + stepTypeTypeToType + stepWrongNode + stepError + stepTrack + + + DebugSemStep* = object + direction*: DebugSemStepDirection + level*: int + name*: string + node*: PNode + steppedFrom*: ReportLineInfo + case kind*: DebugSemStepKind + of stepNodeToNode, stepTrack, stepWrongNode, stepError: + discard + + of stepNodeTypeToNode, stepTypeTypeToType: + typ*: PType + typ1*: PType + + of stepNodeFlagsToNode: + flags*: TExprFlags + + DebugVmCodeEntry* = object + isTarget*: bool + info*: TLineInfo + pc*: int + idx*: int + case opc*: TOpcode: + of opcConv, opcCast: + types*: tuple[tfrom, tto: PType] + + of opcLdConst, opcAsgnConst: + ast*: PNode + + else: + discard + + ra*: int + rb*: int + rc*: int + + + DebugReport* = object of ReportBase + case kind*: ReportKind + of rdbgOptionsPush, rdbgOptionsPop: + optionsNow*: TOptions + + of rdbgVmExecTraceFull: + vmgenExecFull*: tuple[ + pc: int, + opc: TOpcode, + info: TLineInfo, + ra, rb, rc: TRegisterKind + ] + + of rdbgTraceStep: + semstep*: DebugSemStep + + of rdbgStartingConfRead, rdbgFinishedConfRead: + filename*: string + + of rdbgCfgTrace: + str*: string + + of rdbgTraceLine, rdbgTraceStart: + ctraceData*: tuple[level: int, entries: seq[StackTraceEntry]] + + of rdbgVmCodeListing: + vmgenListing*: tuple[ + sym: PSym, + ast: PNode, + entries: seq[DebugVmCodeEntry] + ] + + of rdbgVmExecTraceMinimal: + vmgenExecMinimal*: tuple[ + info: TLineInfo, + opc: TOpcode + ] + + else: + discard + +const + repDebugKinds* = {low(DebugReportKind) .. high(DebugReportKind)} + +func severity*(report: DebugReport): ReportSeverity = + rsevDebug + +type + BackendReportKind* = range[rbackCannotWriteScript .. rbackLinking] + BackendReport* = object of ReportBase + msg*: string + usedCompiler*: string + case kind*: ReportKind + of rbackCannotWriteScript, + rbackProducedAssembly, + rbackCannotWriteMappingFile: + filename*: string + + of rbackTargetNotSupported: + requestedTarget*: string + + of rbackJsonScriptMismatch: + jsonScriptParams*: tuple[ + outputCurrent, output, jsonFile: string] + + else: + discard + +const + repBackendKinds* = {low(BackendReportKind) .. high(BackendReportKind)} + rbackErrorKinds* = {rbackCannotWriteScript .. rbackCannotProduceAssembly} + rbackWarningKinds* = {rbackRstTestUnsupported .. rbackRstRstStyle} + rbackHintKinds* = {rbackProducedAssembly .. rbackLinking} + + + +func severity*(report: BackendReport): ReportSeverity = + case BackendReportKind(report.kind): + of rbackErrorKinds: rsevError + of rbackHintKinds: rsevHint + of rbackWarningKinds: rsevWarning + +type + ExternalReportKind* = range[rextUnknownCCompiler .. rextPath] + ExternalReport* = object of ReportBase + ## Report about external environment reads, passed configuration + ## options etc. + msg*: string + + case kind*: ReportKind + of rextInvalidHint .. rextInvalidPath: + cmdlineSwitch*: string ## Switch in processing + cmdlineProvided*: string ## Value passed to the command-line + cmdlineAllowed*: seq[string] ## Allowed command-line values + cmdlineError*: string ## Textual description of the cmdline failure + + of rextUnknownCCompiler: + knownCompilers*: seq[string] + passedCompiler*: string + + of rextInvalidPackageName: + packageName*: string + + of rextPath: + packagePath*: string + + else: + discard + +const + repExternalKinds* = {low(ExternalReportKind) .. high(ExternalReportKind)} + rextErrorKinds* = {rextUnknownCCompiler .. rextInvalidPackageName} + rextWarningKinds* = {rextDeprecated} + rextHintKinds* = {rextConf .. rextPath} + +func severity*(report: ExternalReport): ReportSeverity = + case ExternalReportKind(report.kind): + of rextErrorKinds: rsevError + of rextWarningKinds: rsevWarning + of rextHintKinds: rsevHint + +type + InternalReportKind* = range[rintUnknown .. rintEchoMessage] + + UsedBuildParams* = object + project*: string + output*: string + linesCompiled*: int + mem*: int + isMaxMem*: bool + sec*: float + case isCompilation*: bool + of true: + threads*: bool + backend*: string + buildMode*: string + optimize*: string + gc*: string + + of false: + discard + + InternalStateDump* = ref object + version*: string + nimExe*: string + prefixdir*: string + libpath*: string + projectPath*: string + definedSymbols*: seq[string] + libPaths*: seq[string] + lazyPaths*: seq[string] + nimbleDir*: string + outdir*: string + `out`*: string + nimcache*: string + hints*, warnings*: seq[tuple[name: string, enabled: bool]] + + InternalReport* = object of ReportBase + ## Report generated for the internal compiler workings + msg*: string + case kind*: ReportKind + of rintStackTrace: + trace*: seq[StackTraceEntry] ## Generated stack trace entries + + of rintDumpState: + stateDump*: InternalStateDump + + of rintAssert: + expression*: string + + of rintSuccessX: + buildParams*: UsedBuildParams + + of rintCannotOpenFile .. rintWarnFileChanged: + file*: string + + of rintListWarnings, rintListHints: + enabledOptions*: set[ReportKind] + + else: + discard + +const + repInternalKinds*: ReportKinds = { + low(InternalReportKind) .. high(InternalReportKind)} + + rintFatalKinds* = {rintUnknown .. rintIce} ## Fatal internal compilation + ## reports + rintErrorKinds* = {rintCannotOpenFile .. rintNotImplemented} + rintWarningKinds* = {rintWarnCannotOpenFile .. rintWarnFileChanged} + rintHintKinds* = {rintSource .. rintSuccessX} + rintDataPassKinds* = {rintStackTrace .. rintEchoMessage} + + +func severity*(report: InternalReport): ReportSeverity = + case InternalReportKind(report.kind): + of rintFatalKinds: rsevFatal + of rintHintKinds: rsevHint + of rintWarningKinds: rsevWarning + of rintErrorKinds: rsevError + of rintDataPassKinds: rsevTrace + +const + repWarningKinds*: ReportKinds = + rsemWarningKinds + + rlexWarningKinds + + rparWarningKinds + + rbackWarningKinds + + rextWarningKinds + + rcmdWarningKinds + + rintWarningKinds + + repTraceKinds*: ReportKinds = {rsemVmStackTrace, rintStackTrace} + + repHintKinds*: ReportKinds = + rsemHintKinds + + rlexHintKinds + + rparHintKinds + + rbackHintKinds + + rextHintKinds + + rcmdHintKinds + + rintHintKinds + + repErrorKinds*: ReportKinds = + rsemErrorKinds + + rlexErrorKinds + + rparErrorKinds + + rbackErrorKinds + + rextErrorKinds + + rcmdErrorKinds + + rintErrorKinds + + repFatalKinds*: ReportKinds = rintFatalKinds + repAllKinds* = {low(ReportKind) .. high(ReportKind)} + + + +type + ReportTypes* = + LexerReport | + ParserReport | + SemReport | + CmdReport | + DebugReport | + InternalReport | + BackendReport | + ExternalReport + + Report* = object + ## Toplevel wrapper type for the compiler report + case category*: ReportCategory + of repLexer: + lexReport*: LexerReport + + of repParser: + parserReport*: ParserReport + + of repSem: + semReport*: SemReport + + of repCmd: + cmdReport*: CmdReport + + of repDebug: + debugReport*: DebugReport + + of repInternal: + internalReport*: InternalReport + + of repBackend: + backendReport*: BackendReport + + of repExternal: + externalReport*: ExternalReport + +static: + when false: + echo( + "Nimskull compiler outputs ", + ord(high(ReportKind)), + " different kinds of diagnostics") + + + echo "size of ReportBase ", sizeof(ReportBase) + echo "size of LexerReport ", sizeof(LexerReport) + echo "size of ParserReport ", sizeof(ParserReport) + echo "size of SemReport ", sizeof(SemReport) + echo "size of CmdReport ", sizeof(CmdReport) + echo "size of DebugReport ", sizeof(DebugReport) + echo "size of InternalReport ", sizeof(InternalReport) + echo "size of BackendReport ", sizeof(BackendReport) + echo "size of ExternalReport ", sizeof(ExternalReport) + echo "size of Report ", sizeof(Report) + echo "sem reports = ", len(repSemKinds) + echo "lexer reports = ", len(repLexerKinds) + echo "parser reports = ", len(repParserKinds) + echo "internal reports = ", len(repInternalKinds) + +let reportEmpty* = Report( + category: repInternal, + internalReport: InternalReport(kind: repNone)) + + +template eachCategory*(report: Report, field: untyped): untyped = + case report.category: + of repLexer: report.lexReport.field + of repParser: report.parserReport.field + of repCmd: report.cmdReport.field + of repSem: report.semReport.field + of repDebug: report.debugReport.field + of repInternal: report.internalReport.field + of repBackend: report.backendReport.field + of repExternal: report.externalReport.field + +func kind*(report: Report): ReportKind = eachCategory(report, kind) +func location*(report: Report): Option[TLineInfo] = eachCategory(report, location) +func reportInst*(report: Report): ReportLineInfo = eachCategory(report, reportInst) +func reportFrom*(report: Report): ReportLineInfo = eachCategory(report, reportFrom) + +func `reportFrom=`*(report: var Report, loc: ReportLineInfo) = + case report.category: + of repLexer: report.lexReport.reportFrom = loc + of repParser: report.parserReport.reportFrom = loc + of repCmd: report.cmdReport.reportFrom = loc + of repSem: report.semReport.reportFrom = loc + of repDebug: report.debugReport.reportFrom = loc + of repInternal: report.internalReport.reportFrom = loc + of repBackend: report.backendReport.reportFrom = loc + of repExternal: report.externalReport.reportFrom = loc + +func category*(kind: ReportKind): ReportCategory = + case kind: + of repDebugKinds: result = repDebug + of repInternalKinds: result = repInternal + of repExternalKinds: result = repExternal + of repCmdKinds: result = repCmd + + of repLexerKinds: result = repLexer + of repParserKinds: result = repParser + of repSemKinds: result = repSem + of repBackendKinds: result = repBackend + + of repNone: assert false, "'none' report does not have category" + +func severity*( + report: ReportTypes, + asError: ReportKinds, + asWarning: ReportKinds = default(ReportKinds) + ): ReportSeverity = + + if report.kind in asError: + rsevError + + elif report.kind in asWarning: + rsevWarning + + else: + severity(report) + + + +func severity*( + report: Report, + asError: ReportKinds = default(ReportKinds), + asWarning: ReportKinds = default(ReportKinds) + ): ReportSeverity = + ## Return report severity accounting for 'asError' and 'asWarning' + ## mapping sets. + + if report.kind in asError: rsevError + elif report.kind in asWarning: rsevWarning + else: + case report.category: + of repLexer: report.lexReport.severity() + of repParser: report.parserReport.severity() + of repSem: report.semReport.severity() + of repCmd: report.cmdReport.severity() + of repInternal: report.internalReport.severity() + of repBackend: report.backendReport.severity() + of repDebug: report.debugReport.severity() + of repExternal: report.externalReport.severity() + +func toReportLineInfo*(iinfo: InstantiationInfo): ReportLineInfo = + ReportLineInfo(file: iinfo[0], line: uint16(iinfo[1]), col: int16(iinfo[2])) + +template calledFromInfo*(): ReportLineInfo = + let e = getStackTraceEntries()[^2] + ReportLineInfo(file: $e.filename, line: e.line.uint16) + +func isValid*(point: ReportLineInfo): bool = + 0 < point.file.len and point.file != "???" + +template reportHere*[R: ReportTypes](report: R): R = + block: + var tmp = report + tmp.reportInsta = toReportLineInfo( + instantiationInfo(fullPaths = true)) + + tmp + +func wrap*(rep: sink LexerReport): Report = + assert rep.kind in repLexerKinds, $rep.kind + Report(category: repLexer, lexReport: rep) + +func wrap*(rep: sink ParserReport): Report = + assert rep.kind in repParserKinds, $rep.kind + Report(category: repParser, parserReport: rep) + +func wrap*(rep: sink SemReport): Report = + assert rep.kind in repSemKinds, $rep.kind + Report(category: repSem, semReport: rep) + +func wrap*(rep: sink BackendReport): Report = + assert rep.kind in repBackendKinds, $rep.kind + Report(category: repBackend, backendReport: rep) + +func wrap*(rep: sink CmdReport): Report = + assert rep.kind in repCmdKinds, $rep.kind + Report(category: repCmd, cmdReport: rep) + +func wrap*(rep: sink DebugReport): Report = + assert rep.kind in repDebugKinds, $rep.kind + Report(category: repDebug, debugreport: rep) + +func wrap*(rep: sink InternalReport): Report = + assert rep.kind in repInternalKinds, $rep.kind + Report(category: repInternal, internalReport: rep) + +func wrap*(rep: sink ExternalReport): Report = + assert rep.kind in repExternalKinds, $rep.kind + Report(category: repExternal, externalReport: rep) + +func wrap*[R: ReportTypes](rep: sink R, iinfo: InstantiationInfo): Report = + var tmp = rep + tmp.reportInst = toReportLineInfo(iinfo) + return wrap(tmp) + + +func wrap*[R: ReportTypes]( + rep: sink R, iinfo: ReportLineInfo, point: TLineInfo): Report = + var tmp = rep + tmp.reportInst = iinfo + tmp.location = some point + return wrap(tmp) + +func wrap*[R: ReportTypes]( + rep: sink R, iinfo: InstantiationInfo, point: TLineInfo): Report = + wrap(rep, toReportLineInfo(iinfo), point) + + +func wrap*[R: ReportTypes](iinfo: InstantiationInfo, rep: sink R): Report = + wrap(rep, iinfo) + + +template wrap*(rep: ReportTypes): Report = + wrap(rep, toReportLineInfo(instLoc())) + +func `$`*(point: ReportLineInfo): string = + point.file & "(" & $point.line & ", " & $point.col & ")" + + +type + ReportList* = object + ## List of the accumulated reports. Used for various `sem*` reporting + ## mostly, and in other places where report might be *generated*, but + ## not guaranteed to be printed out. + list: seq[Report] + + ReportSet* = object + ids: PackedSet[uint32] + +func incl*(s: var ReportSet, id: ReportId) = s.ids.incl uint32(id) +func contains*(s: var ReportSet, id: ReportId): bool = s.ids.contains uint32(id) + +func addReport*(list: var ReportList, report: Report): ReportId = + ## Add report to the report list + list.list.add report + result = ReportId(uint32(list.list.high) + 1) + +func addReport*[R: ReportTypes](list: var ReportList, report: R): ReportId = + addReport(list, wrap(report)) + + +func getReport*(list: ReportList, id: ReportId): Report = + ## Get report from the report list using it's id + list.list[int(uint32(id)) - 1] + + +func actualType*(r: SemReport): PType = r.typeMismatch[0].actualType +func formalType*(r: SemReport): PType = r.typeMismatch[0].formalType +func symstr*(r: SemReport): string = r.sym.name.s diff --git a/compiler/scriptconfig.nim b/compiler/scriptconfig.nim index 89510f6b2b9..d3d2a74e78e 100644 --- a/compiler/scriptconfig.nim +++ b/compiler/scriptconfig.nim @@ -14,7 +14,7 @@ import ast, modules, idents, passes, condsyms, options, sem, llstream, vm, vmdef, commands, os, times, osproc, wordrecg, strtabs, modulegraphs, - pathutils + pathutils, reports, msgs # we support 'cmpIgnoreStyle' natively for efficiency: from strutils import cmpIgnoreStyle, contains @@ -192,6 +192,12 @@ proc setupVM*(module: PSym; cache: IdentCache; scriptName: string; proc runNimScript*(cache: IdentCache; scriptName: AbsoluteFile; idgen: IdGenerator; freshDefines=true; conf: ConfigRef, stream: PLLStream) = + + conf.localReport DebugReport( + kind: rdbgStartingConfRead, + filename: scriptName.string + ) + let oldSymbolFiles = conf.symbolFiles conf.symbolFiles = disabledSf @@ -238,3 +244,8 @@ proc runNimScript*(cache: IdentCache; scriptName: AbsoluteFile; undefSymbol(conf.symbols, "nimscript") undefSymbol(conf.symbols, "nimconfig") conf.symbolFiles = oldSymbolFiles + + conf.localReport DebugReport( + kind: rdbgFinishedConfRead, + filename: scriptName.string + ) diff --git a/compiler/sem.nim b/compiler/sem.nim index 03cdfe04e34..bd2b0d91d1d 100644 --- a/compiler/sem.nim +++ b/compiler/sem.nim @@ -18,7 +18,7 @@ import evaltempl, patterns, parampatterns, sempass2, linter, semmacrosanity, lowerings, plugins/active, lineinfos, strtabs, int128, isolation_check, typeallowed, modulegraphs, enumtostr, concepts, astmsgs, - errorhandling, errorreporting + errorhandling, errorreporting, reports, debugutils when defined(nimfix): import nimfix/prettybase @@ -76,168 +76,6 @@ proc deltaTrace(stopProc, indent: string, entries: seq[StackTraceEntry]) echo: "$1| $2 $3($4)" % [indent, $e.procname, $e.filename, $e.line] -template addInNimDebugUtilsAux(conf: ConfigRef; prcname: string; - enterMsg, leaveMsg, getInfo: untyped) = - ## used by one of the dedicated templates in order to output compiler trace - ## data, use a dedicated template (see below) for actual output. this is a - ## helper that takes three templates, `enterMsg`, `leaveMsg`, and `getInfo` - ## that will emit a message when entering and leaving a proc, and getting - ## the string out of some lineinfo, respectively. - ## - ## The dedicate templates take specific parameters and pass in the above - ## templates with the following signatures: - ## * enterMsg: indent: string -> string - ## * leaveMsg: indent: string -> string - ## * getInfo: void -> string - ## - ## once a specialized template exists, again see below, use at the start of a - ## proc, typically a high traffic one such as `semExpr` and then this will - ## output partial traces through the compiler. - ## - ## The output is roughly: - ## 1. begin message with starting location - ## a. a full stacktrace for context - ## 2. for each proc (nests): - ## a. `>prcname plus useful info...` - ## b. delta stack trace `| procname filepath(line, col)` - ## c. ` PNode`, with expr flags - ## and can determine the type - template enterMsg(indent: string): string = - "$1>$2: $3, $4, $5" % [indent, name, $n.kind, c$n.info, $flags] - template leaveMsg(indent: string): string = - "$1<$2: $3, $4, $5" % - [indent, name, $r.kind, c$r.info, if r != nil: $r.typ else: ""] - template getInfo(): string = - c$n.info - - addInNimDebugUtilsAux(c, name, enterMsg, leaveMsg, getInfo) - -template addInNimDebugUtils(c: ConfigRef; name: string; n, r: PNode) = - ## add tracing to procs that are primarily `PNode -> PNode`, and can - ## determine the type - - template enterMsg(indent: string): string = - "$1>$2: $3, $4" % [indent, name, $n.kind, c$n.info] - template leaveMsg(indent: string): string = - "$1<$2: $3, $4, $5" % - [indent, name, $r.kind, c$r.info, if r != nil: $r.typ else: ""] - template getInfo(): string = - c$n.info - - addInNimDebugUtilsAux(c, name, enterMsg, leaveMsg, getInfo) - -template addInNimDebugUtils(c: ConfigRef; name: string; n: PNode; - prev, r: PType) = - ## add tracing to procs that are primarily `PNode, PType|nil -> PType`, - ## determining a type node, with a possible previous type. - template enterMsg(indent: string): string = - "$1>$2: $3, $4, prev: $5" % - [indent, name, $n.kind, c$n.info, $prev] - template leaveMsg(indent: string): string = - "$1<$2: $3, $4, $5, %6, prev: $7" % - [indent, name, $n.kind, c$n.info, $n.typ, $r, $prev] - template getInfo(): string = - c$n.info - addInNimDebugUtilsAux(c, name, enterMsg, leaveMsg, getInfo) - -template addInNimDebugUtils(c: ConfigRef; name: string; x: PType; n: PNode; - r: PType) = - ## add tracing to procs that are primarily `PType, PNode -> PType`, looking - ## for a common type - template enterMsg(indent: string): string = - "$1>$2: $3, $4, $5, $6" % - [indent, name, $x.kind, c$n.info, $n.kind, $n.typ] - template leaveMsg(indent: string): string = - "$1<$2: $3, $4, $5, %6, $7" % - [indent, name, $x.kind, c$n.info, $x, $r, $n.typ] - template getInfo(): string = - c$n.info - addInNimDebugUtilsAux(c, name, enterMsg, leaveMsg, getInfo) - -template addInNimDebugUtils(c: ConfigRef; name: string; x, y, r: PType) = - ## add tracing to procs that are primarily `PType, PType -> PType`, looking - ## for a common type - template enterMsg(indent: string): string = - "$1>$2: $3, $4" % [indent, name, $x.kind, $y.kind] - template leaveMsg(indent: string): string = - "$1<$2: $3, $4, $5, $6" % [indent, name, $x.kind, $x, $y, $r] - template getInfo(): string = - "" - addInNimDebugUtilsAux(c, name, enterMsg, leaveMsg, getInfo) - template semIdeForTemplateOrGenericCheck(conf, n, requiresCheck) = # we check quickly if the node is where the cursor is when defined(nimsuggest): @@ -266,8 +104,8 @@ proc fitNodePostMatch(c: PContext, formal: PType, arg: PNode): PNode = proc fitNode(c: PContext, formal: PType, arg: PNode; info: TLineInfo): PNode = if arg.typ.isNil: - localError(c.config, arg.info, "expression has no type: " & - renderTree(arg, {renderNoComments})) + c.config.localReport(arg.info, reportAst(rsemExpressionHasNoType, arg)) + # error correction: result = copyTree(arg) result.typ = formal @@ -276,8 +114,10 @@ proc fitNode(c: PContext, formal: PType, arg: PNode; info: TLineInfo): PNode = for ch in arg: if sameType(ch.typ, formal): return getConstExpr(c.module, ch, c.idgen, c.graph) + # XXX: why don't we set the `typ` field to formal like above and below? result = typeMismatch(c.config, info, formal, arg.typ, arg) + else: result = indexTypesMatch(c, formal, arg.typ, arg) if result == nil: @@ -396,7 +236,7 @@ proc endsInNoReturn(n: PNode): bool = proc commonType*(c: PContext; x: PType, y: PNode): PType = # ignore exception raising branches in case/if expressions - addInNimDebugUtils(c.config, "commonType", x, y, result) + addInNimDebugUtils(c.config, "commonType", y, x, result) result = x if endsInNoReturn(y): return result = commonType(c, x, y.typ) @@ -412,8 +252,11 @@ proc newSymG*(kind: TSymKind, n: PNode, c: PContext): PSym = # and sfGenSym in n.sym.flags: result = n.sym if result.kind notin {kind, skTemp}: - localError(c.config, n.info, "cannot use symbol of kind '$1' as a '$2'" % - [result.kind.toHumanStr, kind.toHumanStr]) + localReport(c.config, n.info, SemReport( + kind: rsemSymbolKindMismatch, + sym: result, + expectedSymbolKind: {kind})) + when false: if sfGenSym in result.flags and result.kind notin {skTemplate, skMacro, skParam}: # declarative context, so produce a fresh gensym: @@ -441,15 +284,22 @@ proc typeAllowedCheck(c: PContext; info: TLineInfo; typ: PType; kind: TSymKind; flags: TTypeAllowedFlags = {}) = let t = typeAllowed(typ, kind, c, flags) if t != nil: - var err: string - if t == typ: - err = "invalid type: '$1' for $2" % [typeToString(typ), toHumanStr(kind)] - if kind in {skVar, skLet, skConst} and taIsTemplateOrMacro in flags: - err &= ". Did you mean to call the $1 with '()'?" % [toHumanStr(typ.owner.kind)] - else: - err = "invalid type: '$1' in this context: '$2' for $3" % [typeToString(t), - typeToString(typ), toHumanStr(kind)] - localError(c.config, info, err) + # var err: string + # if t == typ: + # err = "invalid type: '$1' for $2" % [typeToString(typ), toHumanStr(kind)] + # if kind in {skVar, skLet, skConst} and taIsTemplateOrMacro in flags: + # err &= ". Did you mean to call the $1 with '()'?" % [toHumanStr(typ.owner.kind)] + # else: + # err = "invalid type: '$1' in this context: '$2' for $3" % [typeToString(t), + # typeToString(typ), toHumanStr(kind)] + + localReport(c.config, info, SemReport( + kind: rsemTypeNotAllowed, + allowedType: ( + allowed: t, + actual: typ, + kind: kind, + allowedFlags: flags))) proc paramsTypeCheck(c: PContext, typ: PType) {.inline.} = typeAllowedCheck(c, typ.n.info, typ, skProc) @@ -505,7 +355,7 @@ proc fixupTypeAfterEval(c: PContext, evaluated, eOrig: PNode): PNode = result = evaluated let expectedType = eOrig.typ.skipTypes({tyStatic}) if hasCycle(result): - result = localErrorNode(c, eOrig, "the resulting AST is cyclic and cannot be processed further") + result = newError(c.config, eOrig, SemReport(kind: rsemCyclicTree)) else: semmacrosanity.annotateType(result, expectedType, c.config) else: @@ -521,8 +371,10 @@ proc fixupTypeAfterEval(c: PContext, evaluated, eOrig: PNode): PNode = arg.typ = eOrig.typ proc tryConstExpr(c: PContext, n: PNode): PNode = + addInNimDebugUtils(c.config, "tryConstExpr", n, result) var e = semExprWithType(c, n) - if e == nil: return + if e == nil: + return result = getConstExpr(c.module, e, c.idgen, c.graph) if result != nil: return @@ -548,27 +400,25 @@ proc tryConstExpr(c: PContext, n: PNode): PNode = c.config.errorMax = oldErrorMax c.config.m.errorOutputs = oldErrorOutputs -const - errConstExprExpected = "constant expression expected" - proc semConstExpr(c: PContext, n: PNode): PNode = var e = semExprWithType(c, n) if e == nil: - localError(c.config, n.info, errConstExprExpected) + localReport(c.config, n.info, reportAst(rsemConstExprExpected, n)) + return n if e.kind in nkSymChoices and e[0].typ.skipTypes(abstractInst).kind == tyEnum: return e result = getConstExpr(c.module, e, c.idgen, c.graph) if result == nil: - #if e.kind == nkEmpty: globalError(n.info, errConstExprExpected) + #if e.kind == nkEmpty: globalReport(n.info, errConstExprExpected) result = evalConstExpr(c.module, c.idgen, c.graph, e) if result == nil or result.kind == nkEmpty: if e.info != n.info: pushInfoContext(c.config, n.info) - localError(c.config, e.info, errConstExprExpected) + localReport(c.config, e.info, SemReport(kind: rsemConstExprExpected)) popInfoContext(c.config) else: - localError(c.config, e.info, errConstExprExpected) + localReport(c.config, e.info, SemReport(kind: rsemConstExprExpected)) # error correction: result = e else: @@ -608,7 +458,7 @@ proc semAfterMacroCall(c: PContext, call, macroResult: PNode, ## contains. inc(c.config.evalTemplateCounter) if c.config.evalTemplateCounter > evalTemplateLimit: - globalError(c.config, s.info, "template instantiation too nested") + globalReport(c.config, s.info, SemReport(kind: rsemTemplateInstantiationTooNested)) c.friendModules.add(s.owner.getModule) result = macroResult resetSemFlag result @@ -632,8 +482,7 @@ proc semAfterMacroCall(c: PContext, call, macroResult: PNode, if result.kind == nkStmtList: result.transitionSonsKind(nkStmtListType) var typ = semTypeNode(c, result, nil) if typ == nil: - localError(c.config, result.info, "expression has no type: " & - renderTree(result, {renderNoComments})) + localReport(c.config, result, reportSem rsemExpressionHasNoType) result = newSymNode(errorSym(c, result)) else: result.typ = makeTypeDesc(c, typ) @@ -653,38 +502,47 @@ proc semAfterMacroCall(c: PContext, call, macroResult: PNode, result = semExpr(c, result, flags) result = fitNode(c, retType, result, result.info) - #globalError(s.info, errInvalidParamKindX, typeToString(s.typ[0])) + #globalReport(s.info, errInvalidParamKindX, typeToString(s.typ[0])) dec(c.config.evalTemplateCounter) discard c.friendModules.pop() -const - errMissingGenericParamsForTemplate = "'$1' has unspecified generic parameters" - errFloatToString = "cannot convert '$1' to '$2'" - proc semMacroExpr(c: PContext, n, nOrig: PNode, sym: PSym, flags: TExprFlags = {}): PNode = rememberExpansion(c, nOrig.info, sym) - pushInfoContext(c.config, nOrig.info, sym.detailedInfo) + pushInfoContext(c.config, nOrig.info, sym) let info = getCallLineInfo(n) markUsed(c, info, sym) onUse(info, sym) if sym == c.p.owner: - globalError(c.config, info, "recursive dependency: '$1'" % sym.name.s) + globalReport(c.config, info, reportSym(rsemCyclicDependency, sym)) let genericParams = sym.ast[genericParamsPos].len let suppliedParams = max(n.safeLen - 1, 0) if suppliedParams < genericParams: - globalError(c.config, info, errMissingGenericParamsForTemplate % n.renderTree) + globalReport( + c.config, info, reportAst( + rsemMissingGenericParamsForTemplate, n, sym = sym)) + + let reportTraceExpand = c.config.macrosToExpand.hasKey(sym.name.s) + var original: PNode + if reportTraceExpand: + original = n + + result = evalMacroCall( + c.module, c.idgen, c.graph, c.templInstCounter, n, nOrig, sym) - #if c.evalContext == nil: - # c.evalContext = c.createEvalContext(emStatic) - result = evalMacroCall(c.module, c.idgen, c.graph, c.templInstCounter, n, nOrig, sym) if efNoSemCheck notin flags: result = semAfterMacroCall(c, n, result, sym, flags) - if c.config.macrosToExpand.hasKey(sym.name.s): - message(c.config, nOrig.info, hintExpandMacro, renderTree(result)) + + if reportTraceExpand: + c.config.localReport(nOrig.info, SemReport( + sym: sym, + kind: rsemExpandMacro, + ast: original, + expandedAst: result)) + result = wrapInComesFrom(nOrig.info, sym, result) popInfoContext(c.config) @@ -695,7 +553,7 @@ proc forceBool(c: PContext, n: PNode): PNode = proc semConstBoolExpr(c: PContext, n: PNode): PNode = result = forceBool(c, semConstExpr(c, n)) if result.kind != nkIntLit: - localError(c.config, n.info, errConstExprExpected) + localReport(c.config, n, reportSem rsemConstExprExpected) proc semGenericStmt(c: PContext, n: PNode): PNode proc semConceptBody(c: PContext, n: PNode): PNode @@ -761,6 +619,7 @@ proc semStmtAndGenerateGenerics(c: PContext, n: PNode): PNode = ## level statement basis, with the `PContext` parameter `c` acting as an ## accumulator across the various top level statements, modules, and overall ## program compilation. + addInNimDebugUtils(c.config, "semStmtAndGenerateGenerics") if c.isfirstTopLevelStmt and not isImportSystemStmt(c.graph, n): if sfSystemModule notin c.module.flags and not isEmptyTree(n): @@ -806,7 +665,9 @@ proc myOpen(graph: ModuleGraph; module: PSym; c.enforceVoidContext = newType(tyTyped, nextTypeId(idgen), nil) c.voidType = newType(tyVoid, nextTypeId(idgen), nil) - if c.p != nil: internalError(graph.config, module.info, "sem.myOpen") + if c.p != nil: + internalError(graph.config, module.info, "sem.myOpen") + c.semConstExpr = semConstExpr c.semExpr = semExpr c.semTryExpr = tryExpr @@ -874,7 +735,8 @@ proc myProcess(context: PPassContext, n: PNode): PNode {.nosinks.} = proc reportUnusedModules(c: PContext) = for i in 0..high(c.unusedImports): if sfUsed notin c.unusedImports[i][0].flags: - message(c.config, c.unusedImports[i][1], warnUnusedImportX, c.unusedImports[i][0].name.s) + localReport(c.config, c.unusedImports[i][1], reportSym( + rsemUnusedImport, c.unusedImports[i][0])) proc addCodeForGenerics(c: PContext, n: PNode) = for i in c.lastGenericIdx.. 1: - result = $n[0] & "(" & result & ")" - elif n.kind in {nkHiddenStdConv, nkHiddenSubConv} and n.len == 2: - result = typeToString(n.typ.skipTypes(abstractVar)) & "(" & result & ")" - -proc presentFailedCandidates(c: PContext, n: PNode, errors: CandidateErrors): - (TPreferedDesc, string) = - var prefer = preferName - # to avoid confusing errors like: - # got (SslPtr, SocketHandle) - # but expected one of: - # openssl.SSL_set_fd(ssl: SslPtr, fd: SocketHandle): cint - # we do a pre-analysis. If all types produce the same string, we will add - # module information. - let proto = describeArgs(c, n, 1, preferName) - for err in errors: - var errProto = "" - let n = err.sym.typ.n - for i in 1.. 1: - filterOnlyFirst = true - break - - var - maybeWrongSpace = false - candidatesAll: seq[string] - candidates = "" - skipped = 0 + arg = c.semOperand(c, n[i]) + n[i] = arg + + if arg.typ != nil and arg.typ.kind == tyError: + return + + result.add arg + +proc presentFailedCandidates( + c: PContext, n: PNode, errors: CandidateErrors): seq[SemCallMismatch] = + ## Construct list of type mismatch descriptions for subsequent reporting. + ## This procedure simply repacks the data from CandidateErrors into + ## `SemCallMismatch` - discard unnecessary data, pull important elements + ## into the result. No actual formatting is done here. + + + var candidates: seq[SemCallMismatch] for err in errors: - candidates.setLen 0 - if filterOnlyFirst and err.firstMismatch.arg == 1: - inc skipped - continue - if err.sym.kind in routineKinds and err.sym.ast != nil: - candidates.add(renderTree(err.sym.ast, - {renderNoBody, renderNoComments, renderNoPragmas})) - else: - candidates.add(getProcHeader(c.config, err.sym, prefer)) - candidates.addDeclaredLocMaybe(c.config, err.sym) - candidates.add("\n") - let nArg = if err.firstMismatch.arg < n.len: n[err.firstMismatch.arg] else: nil - let nameParam = if err.firstMismatch.formal != nil: err.firstMismatch.formal.name.s else: "" + var cand = SemCallMismatch( + kind: err.firstMismatch.kind, + expression: n, + arguments: maybeResemArgs(c, n, 1) + ) + + cand.target = err.sym + cand.arg = err.firstMismatch.arg + + let nArg = + if err.firstMismatch.arg < n.len: + n[err.firstMismatch.arg] + else: + nil + + cand.targetArg = err.firstMismatch.formal + cand.diagnostics = err.diagnostics + if n.len > 1: - candidates.add(" first type mismatch at position: " & $err.firstMismatch.arg) - # candidates.add "\n reason: " & $err.firstMismatch.kind # for debugging - case err.firstMismatch.kind - of kUnknownNamedParam: - if nArg == nil: - candidates.add("\n unknown named parameter") - else: - candidates.add("\n unknown named parameter: " & $nArg[0]) - of kAlreadyGiven: candidates.add("\n named param already provided: " & $nArg[0]) - of kPositionalAlreadyGiven: candidates.add("\n positional param was already given as named param") - of kExtraArg: candidates.add("\n extra argument given") - of kMissingParam: candidates.add("\n missing parameter: " & nameParam) - of kTypeMismatch, kVarNeeded: - doAssert nArg != nil - let wanted = err.firstMismatch.formal.typ - doAssert err.firstMismatch.formal != nil - candidates.add("\n required type for " & nameParam & ": ") - candidates.addTypeDeclVerboseMaybe(c.config, wanted) - candidates.add "\n but expression '" - if err.firstMismatch.kind == kVarNeeded: - candidates.add renderNotLValue(nArg) - candidates.add "' is immutable, not 'var'" - else: - candidates.add renderTree(nArg) - candidates.add "' is of type: " - let got = nArg.typ - candidates.addTypeDeclVerboseMaybe(c.config, got) - doAssert wanted != nil - if got != nil: - if got.kind == tyProc and wanted.kind == tyProc: - # These are proc mismatches so, - # add the extra explict detail of the mismatch - candidates.addPragmaAndCallConvMismatch(wanted, got, c.config) - effectProblem(wanted, got, candidates, c) - - of kUnknown: discard "do not break 'nim check'" - candidates.add "\n" - if err.firstMismatch.arg == 1 and nArg.kind == nkTupleConstr and - n.kind == nkCommand: - maybeWrongSpace = true - for diag in err.diagnostics: - candidates.add(errorToString(c.config, diag) & "\n") - candidatesAll.add candidates - candidatesAll.sort # fix #13538 - candidates = join(candidatesAll) - if skipped > 0: - candidates.add($skipped & " other mismatching symbols have been " & - "suppressed; compile with --showAllMismatches:on to see them\n") - if maybeWrongSpace: - candidates.add("maybe misplaced space between " & renderTree(n[0]) & " and '(' \n") - - result = (prefer, candidates) - -const - errTypeMismatch = "type mismatch: got <" - errButExpected = "but expected one of:" - errUndeclaredField = "undeclared field: '$1'" - errUndeclaredRoutine = "attempting to call undeclared routine: '$1'" - errBadRoutine = "attempting to call routine: '$1'$2" - errAmbiguousCallXYZ = "ambiguous call; both $1 and $2 match for: $3" + case cand.kind: + of kUnknownNamedParam, + kAlreadyGiven, + kPositionalAlreadyGiven, + kExtraArg, + kMissingParam: + # Additional metadata only contains `targetArg` that is + # unconditionally assigned from `err.formal` + discard + + of kTypeMismatch, kVarNeeded: + assert nArg != nil + assert cand.targetArg != nil + assert cand.targetArg.typ != nil + assert nArg.typ != nil + cand.typeMismatch = c.config.typeMismatch( + err.firstMismatch.formal.typ, nArg.typ) + + of kUnknown: + # do not break 'nim check' + discard + + candidates.add cand + + result = candidates proc notFoundError(c: PContext, n: PNode, errors: CandidateErrors): PNode = ## Gives a detailed error message; this is separated from semOverloadedCall, ## as semOverloadedCall is already pretty slow (and we need this information ## only in case of an error). ## returns an nkError + addInNimDebugUtils(c.config, "notFoundError") if c.config.m.errorOutputs == {}: # xxx: this is a hack to detect we're evaluating a constant expression or # some other vm code, it seems # fail fast: - result = newError(n, RawTypeMismatchError) - return # xxx: under the legacy error scheme, this was a `msgs.globalError`, + result = c.config.newError(n, reportSem rsemRawTypeMismatch) + return # xxx: under the legacy error scheme, this was a `msgs.globalReport`, # which means `doRaise`, but that made sense because we did a # double pass, now we simply return for fast exit. if errors.len == 0: # no further explanation available for reporting - result = newError(n, ExpressionCannotBeCalled) + # + # QUESTION I wonder if it makes sense to still attempt spelling + # correction here. + result = c.config.newError(n, reportSem rsemExpressionCannotBeCalled) return - let (prefer, candidates) = presentFailedCandidates(c, n, errors) - var msg = errTypeMismatch - msg.add(describeArgs(c, n, 1, prefer)) - msg.add('>') - if candidates != "": - msg.add("\n" & errButExpected & "\n" & candidates) - result = - newError( - n, - msg & "\nexpression: " & n.renderTree({renderWithoutErrorPrefix}) - ) + var f = n[0] + if f.kind == nkBracketExpr: + f = f[0] + + if f.kind in {nkOpenSymChoice, nkClosedSymChoice}: + f = f[0] + + assert f.kind in {nkSym, nkIdent} + + var report = reportAst(rsemCallTypeMismatch, n) + report.spellingCandidates = fixSpelling( + c, tern(f.kind == nkSym, f.sym.name, f.ident)) + + report.callMismatches = presentFailedCandidates(c, n, errors) + + result = newError(c.config, n, report) + proc bracketNotFoundError(c: PContext; n: PNode): PNode = var errors: CandidateErrors = @[] @@ -326,13 +269,15 @@ proc bracketNotFoundError(c: PContext; n: PNode): PNode = firstMismatch: MismatchInfo(), diagnostics: @[])) symx = nextOverloadIter(o, c, headSymbol) - result = - if errors.len == 0: - newCustomErrorMsgAndNode(n, "could not resolve: ") - else: - notFoundError(c, n, errors) -proc getMsgDiagnostic(c: PContext, flags: TExprFlags, n, origF: PNode): string = + result = notFoundError(c, n, errors) + +proc getMsgDiagnostic( + c: PContext, flags: TExprFlags, n, origF: PNode): SemReport = + ## Generate report for + ## - `foo.bar()` in case of missing `bar()` overloads + ## - `iter()` for inline iterators outside of the loop + ## - `obj.field` for missing fields # for dotField calls, eg: `foo.bar()`, set f for nicer messages let f = if {nfDotField} <= n.flags and n.safeLen >= 3: @@ -340,36 +285,48 @@ proc getMsgDiagnostic(c: PContext, flags: TExprFlags, n, origF: PNode): string = else: origF + # HACK apparently this call is still necessary to provide some additional + # input validation and optionally raise the 'identifier expected but + # found' error. + discard considerQuotedIdent(c, f, n) + if c.compilesContextId > 0: # we avoid running more diagnostic when inside a `compiles(expr)`, to # errors while running diagnostic (see test D20180828T234921), and # also avoid slowdowns in evaluating `compiles(expr)`. - discard + result = SemReport(kind: rsemCompilesReport) + else: var o: TOverloadIter + if {nfDotField, nfExplicitCall} * n.flags == {nfDotField}: + result = SemReport( + typ: n[1].typ, + str: $f, + ast: n, + explicitCall: false, + kind: rsemCallNotAProcOrField) + + else: + result = SemReport( + str: $f, + ast: n, + explicitCall: true, + kind: rsemCallNotAProcOrField) + + + # store list of potenttial overload candidates that might be misuesd - + # for example `obj.iterator()` call outside of the for loop. var sym = initOverloadIter(o, c, f) while sym != nil: - result &= "\n found $1" % [getSymRepr(c.config, sym)] + result.unexpectedCandidate.add(sym) sym = nextOverloadIter(o, c, f) - let ident = considerQuotedIdent(c, f, n).s - if {nfDotField, nfExplicitCall} * n.flags == {nfDotField}: - let sym = n[1].typ.typSym - var typeHint = "" - if sym == nil: - # Perhaps we're in a `compiles(foo.bar)` expression, or - # in a concept, e.g.: - # ExplainedConcept {.explain.} = concept x - # x.foo is int - # We could use: `(c.config $ n[1].info)` to get more context. - discard - else: - typeHint = " for type " & getProcHeader(c.config, sym) - let suffix = if result.len > 0: " " & result else: "" - result = errUndeclaredField % ident & typeHint & suffix - else: - if result.len == 0: result = errUndeclaredRoutine % ident - else: result = errBadRoutine % [ident, result] + if f.kind == nkIdent: + # Throw in potential typos - `obj.cull()` or `obj.lenghh` might + # potentially be caused by this. This error is also called for `4 + # +2`, so command is not always an identifier. + result.spellingCandidates = fixSpelling(c, f.ident) + proc resolveOverloads(c: PContext, n, orig: PNode, filter: TSymKinds, flags: TExprFlags, @@ -411,7 +368,8 @@ proc resolveOverloads(c: PContext, n, orig: PNode, else: return if nfDotField in n.flags: - internalAssert c.config, f.kind == nkIdent and n.len >= 2 + internalAssert(c.config, f.kind == nkIdent and n.len >= 2, "") + if f.ident.s notin [".", ".()"]: # a dot call on a dot call is invalid # leave the op head symbol empty, # we are going to try multiple variants @@ -445,20 +403,22 @@ proc resolveOverloads(c: PContext, n, orig: PNode, if sym == nil: # xxx adapt/use errorUndeclaredIdentifierHint(c, n, f.ident) let msg = getMsgDiagnostic(c, flags, n, f) - result.call = newError(n, msg) + result.call = c.config.newError(n, msg) else: - let field = n[2].ident.s - let msg = errUndeclaredField % field & " for type " & getProcHeader(c.config, sym) - n[2] = newError(n[2], msg) - result.call = wrapErrorInSubTree(n) + n[2] = c.config.newError(n[2], SemReport( + kind: rsemUndeclaredField, ast: n[2], sym: sym, typ: sym.typ)) + + result.call = wrapErrorInSubTree(c.config, n) else: # xxx adapt/use errorUndeclaredIdentifierHint(c, n, f.ident) let msg = getMsgDiagnostic(c, flags, n, f) - result.call = newError(n, msg) + result.call = c.config.newError(n, msg) return elif result.state != csMatch: if nfExprCall in n.flags: - result.call = newError(n, ExpressionCannotBeCalled) + result.call = c.config.newError( + n, reportAst(rsemExpressionCannotBeCalled, n)) + else: if {nfDotField, nfDotSetter} * n.flags != {}: # clean up the inserted ops @@ -467,24 +427,19 @@ proc resolveOverloads(c: PContext, n, orig: PNode, return if alt.state == csMatch and cmpCandidates(result, alt) == 0 and not sameMethodDispatcher(result.calleeSym, alt.calleeSym): - internalAssert c.config, result.state == csMatch + internalAssert(c.config, result.state == csMatch, "") #writeMatches(result) #writeMatches(alt) if c.config.m.errorOutputs == {}: # quick error message for performance of 'compiles' built-in: - globalError(c.config, n.info, errGenerated, "ambiguous call") + globalReport(c.config, n.info, reportSem(rsemAmbiguous)) + elif c.config.errorCounter == 0: - # don't cascade errors - var args = "(" - for i in 1.. 1: args.add(", ") - args.add(typeToString(n[i].typ)) - args.add(")") - - localError(c.config, n.info, errAmbiguousCallXYZ % [ - getProcHeader(c.config, result.calleeSym), - getProcHeader(c.config, alt.calleeSym), - args]) + localReport(c.config, n.info, reportSymbols( + rsemAmbiguous, + @[result.calleeSym, alt.calleeSym], + ast = n + )) proc instGenericConvertersArg*(c: PContext, a: PNode, x: TCandidate) = let a = if a.kind == nkHiddenDeref: a[0] else: a @@ -589,7 +544,10 @@ proc semResolvedCall(c: PContext, x: TCandidate, of skType: x.call.add newSymNode(s, n.info) else: - internalAssert c.config, false + internalAssert( + c.config, false, + "Unexpected symbol kind for result of 'instantiateGenericParamList': " & + $s.kind) result = x.call instGenericConvertersSons(c, result, x) @@ -608,9 +566,11 @@ proc tryDeref(n: PNode): PNode = proc semOverloadedCall(c: PContext, n, nOrig: PNode, filter: TSymKinds, flags: TExprFlags): PNode {.nosinks.} = + addInNimDebugUtils(c.config, "semOverloadedCall") var errors: CandidateErrors = @[] var r = resolveOverloads(c, n, nOrig, filter, flags, errors) + if r.state != csMatch and implicitDeref in c.features and canDeref(n): # try to deref the first argument and then try overloading resolution again: # @@ -625,20 +585,26 @@ proc semOverloadedCall(c: PContext, n, nOrig: PNode, if r.state == csMatch: # this may be triggered, when the explain pragma is used if (r.diagnosticsEnabled or efExplain in flags) and errors.len > 0: - let (_, candidates) = presentFailedCandidates(c, n, errors) - message(c.config, n.info, hintUserRaw, - "Non-matching candidates for " & renderTree(n) & "\n" & - candidates) + localReport(c.config, n.info, SemReport( + ast: n, + kind: rsemNonMatchingCandidates, + callMismatches: presentFailedCandidates(c, n, errors) + )) + result = semResolvedCall(c, r, n, flags) + elif r.call != nil and r.call.kind == nkError: result = r.call + elif efNoUndeclared notin flags: result = notFoundError(c, n, errors) + else: result = r.call proc explicitGenericInstError(c: PContext; n: PNode): PNode = - localError(c.config, getCallLineInfo(n), errCannotInstantiateX % renderTree(n)) + localReport(c.config, getCallLineInfo(n), reportAst(rsemCannotInstantiate, n)) + result = n proc explicitGenericSym(c: PContext, n: PNode, s: PSym): PNode = @@ -680,8 +646,13 @@ proc explicitGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = # number of generic type parameters: if s.ast[genericParamsPos].safeLen != n.len-1: let expected = s.ast[genericParamsPos].safeLen - localError(c.config, getCallLineInfo(n), errGenerated, "cannot instantiate: '" & renderTree(n) & - "'; got " & $(n.len-1) & " typeof(s) but expected " & $expected) + localReport(c.config, getCallLineInfo(n), SemReport( + kind: rsemWrongNumberOfGenericParams, + ast: n, + countMismatch: ( + expected: toInt128(expected), + got: toInt128(n.len - 1)))) + return n result = explicitGenericSym(c, n, s) if result == nil: result = explicitGenericInstError(c, n) @@ -740,7 +711,8 @@ proc searchForBorrowProc(c: PContext, startScope: PScope, fn: PSym): PSym = var resolved = semOverloadedCall(c, call, call, filter, {}) if resolved != nil: if resolved.kind == nkError: - localError(c.config, resolved.info, errorToString(c.config, resolved)) + localReport(c.config, resolved) + result = resolved[0].sym if not compareTypes(result.typ[0], fn.typ[0], dcEqIgnoreDistinct): result = nil diff --git a/compiler/semdata.nim b/compiler/semdata.nim index bf4b9738c9e..df3503de788 100644 --- a/compiler/semdata.nim +++ b/compiler/semdata.nim @@ -14,7 +14,11 @@ import tables import intsets, options, ast, astalgo, msgs, idents, renderer, magicsys, vmdef, modulegraphs, lineinfos, sets, pathutils, - errorhandling, errorreporting + reports + +export TExprFlag, TExprFlags + +import std/strutils import ic / ic @@ -23,10 +27,10 @@ type options*: TOptions defaultCC*: TCallingConvention dynlib*: PLib - notes*: TNoteKinds + notes*: ReportKinds features*: set[Feature] otherPragmas*: PNode # every pragma can be pushed - warningAsErrors*: TNoteKinds + warningAsErrors*: ReportKinds POptionEntry* = ref TOptionEntry PProcCon* = ref TProcCon @@ -52,27 +56,6 @@ type genericSym*: PSym inst*: PInstantiation - TExprFlag* = enum - efLValue, efWantIterator, efWantIterable, efInTypeof, - efNeedStatic, - # Use this in contexts where a static value is mandatory - efPreferStatic, - # Use this in contexts where a static value could bring more - # information, but it's not strictly mandatory. This may become - # the default with implicit statics in the future. - efPreferNilResult, - # Use this if you want a certain result (e.g. static value), - # but you don't want to trigger a hard error. For example, - # you may be in position to supply a better error message - # to the user. - efWantStmt, efAllowStmt, efDetermineType, efExplain, - efWantValue, efOperand, efNoSemCheck, - efNoEvaluateGeneric, efInCall, efFromHlo, efNoSem2Check, - efNoUndeclared - # Use this if undeclared identifiers should not raise an error during - # overload resolution. - - TExprFlags* = set[TExprFlag] ImportMode* = enum importAll, importSet, importExcept @@ -151,7 +134,7 @@ type cache*: IdentCache graph*: ModuleGraph signatures*: TStrTable - recursiveDep*: string + recursiveDep*: seq[tuple[importer, importee: string]] suggestionsMade*: bool isAmbiguous*: bool # little hack features*: set[Feature] @@ -212,7 +195,8 @@ proc setIntLitType*(c: PContext; result: PNode) = else: result.typ = getSysType(c.graph, result.info, tyInt64) else: - internalError(c.config, result.info, "invalid int size") + c.config.internalError( + result.info, rintUnreachable, "invalid int size") proc makeInstPair*(s: PSym, inst: PInstantiation): TInstantiationPair = result.genericSym = s @@ -237,8 +221,11 @@ proc pushOwner*(c: PContext; owner: PSym) = c.graph.owners.add(owner) proc popOwner*(c: PContext) = - if c.graph.owners.len > 0: setLen(c.graph.owners, c.graph.owners.len - 1) - else: internalError(c.config, "popOwner") + if c.graph.owners.len > 0: + setLen(c.graph.owners, c.graph.owners.len - 1) + + else: + internalError(c.config, rintUnreachable, "popOwner") proc lastOptionEntry*(c: PContext): POptionEntry = result = c.optionStack[^1] @@ -429,7 +416,7 @@ proc makeVarType*(owner: PSym, baseType: PType; idgen: IdGenerator; kind = tyVar proc makeTypeSymNode*(c: PContext, typ: PType, info: TLineInfo): PNode = let typedesc = newTypeS(tyTypeDesc, c) incl typedesc.flags, tfCheckedForDestructor - internalAssert(c.config, typ != nil) + internalAssert(c.config, typ != nil, "[FIXME]") typedesc.addSonSkipIntLit(typ, c.idgen) let sym = newSym(skType, c.cache.idAnon, nextSymId(c.idgen), getCurrOwner(c), info, c.config.options).linkTo(typedesc) @@ -513,35 +500,6 @@ proc errorNode*(c: PContext, n: PNode): PNode = result = newNodeI(nkEmpty, n.info) result.typ = errorType(c) -proc newError*(c: PContext; wrongNode: PNode, k: ErrorKind; args: varargs[PNode]): PNode = - ## create an `nkError` node with error `k`, with additional error `args`, and - ## a type of error type associated to the current `PContext.owner` - case k: - of FatalError: - # in case we don't abort, ide tools, we set the result - result = errorhandling.newFatal(wrongNode, args) # this is an audited use - messageError(c.config, result) - else: - result = errorhandling.newError(wrongNode, k, args) - result.typ = errorType(c) - -# These mimic localError -template localErrorNode*(c: PContext, n: PNode, info: TLineInfo, msg: TMsgKind, arg: string): PNode = - liMessage(c.config, info, msg, arg, doNothing, instLoc()) - errorNode(c, n) - -template localErrorNode*(c: PContext, n: PNode, info: TLineInfo, arg: string): PNode = - liMessage(c.config, info, errGenerated, arg, doNothing, instLoc()) - errorNode(c, n) - -template localErrorNode*(c: PContext, n: PNode, msg: TMsgKind, arg: string): PNode = - let n2 = n - liMessage(c.config, n2.info, msg, arg, doNothing, instLoc()) - errorNode(c, n2) - -template localErrorNode*(c: PContext, n: PNode, arg: string): PNode = - newError(c, n, CustomError, newStrNode(arg, n.info)) - proc fillTypeS*(dest: PType, kind: TTypeKind, c: PContext) = dest.kind = kind dest.owner = getCurrOwner(c) @@ -562,17 +520,17 @@ proc markIndirect*(c: PContext, s: PSym) {.inline.} = incl(s.flags, sfAddrTaken) # XXX add to 'c' for global analysis -proc illFormedAst*(n: PNode; conf: ConfigRef) = - globalError(conf, n.info, errIllFormedAstX, renderTree(n, {renderNoComments})) - -proc illFormedAstLocal*(n: PNode; conf: ConfigRef) = - localError(conf, n.info, errIllFormedAstX, renderTree(n, {renderNoComments})) - proc checkSonsLen*(n: PNode, length: int; conf: ConfigRef) = - if n.len != length: illFormedAst(n, conf) + if n.len != length: + conf.globalReport(n.info, reportAst( + rsemIllformedAst, n, + str = "Expected $1 elements, but found $2" % [$length, $n.len])) proc checkMinSonsLen*(n: PNode, length: int; conf: ConfigRef) = - if n.len < length: illFormedAst(n, conf) + if n.len < length: + conf.globalReport(n.info, reportAst( + rsemIllformedAst, n, + str = "Expected at least $1 elements, but found $2" % [$length, $n.len])) proc isTopLevel*(c: PContext): bool {.inline.} = result = c.currentScope.depthLevel <= 2 diff --git a/compiler/semexprs.nim b/compiler/semexprs.nim index 70d15294af9..074abfd2e0d 100644 --- a/compiler/semexprs.nim +++ b/compiler/semexprs.nim @@ -13,17 +13,6 @@ when defined(nimCompilerStacktraceHints): import std/stackframes -const - errExprXHasNoType = "expression '$1' has no type (or is ambiguous)" - errXExpectsTypeOrValue = "'$1' expects a type or value" - errVarForOutParamNeededX = "for a 'var' type a variable needs to be passed; but '$1' is immutable" - errXStackEscape = "address of '$1' may not escape its stack frame" - errExprHasNoAddress = "expression has no address" - errCannotInterpretNodeX = "cannot evaluate '$1'" - errNamedExprExpected = "named expression expected" - errNamedExprNotAllowed = "named expression not allowed here" - errFieldInitTwice = "field initialized twice: '$1'" - proc semTemplateExpr(c: PContext, n: PNode, s: PSym, flags: TExprFlags = {}): PNode = rememberExpansion(c, n.info, s) @@ -32,7 +21,7 @@ proc semTemplateExpr(c: PContext, n: PNode, s: PSym, onUse(info, s) # Note: This is n.info on purpose. It prevents template from creating an info # context when called from an another template - pushInfoContext(c.config, n.info, s.detailedInfo) + pushInfoContext(c.config, n.info, s) result = evalTemplate(n, s, getCurrOwner(c), c.config, c.cache, c.templInstCounter, c.idgen, efFromHlo in flags) if efNoSemCheck notin flags: result = semAfterMacroCall(c, n, result, s, flags) @@ -45,7 +34,8 @@ proc semFieldAccess(c: PContext, n: PNode, flags: TExprFlags = {}): PNode template rejectEmptyNode(n: PNode) = # No matter what a nkEmpty node is not what we want here - if n.kind == nkEmpty: illFormedAst(n, c.config) + if n.kind == nkEmpty: + semReportIllformedAst(c.config, n, "Unexpected empty node") proc semOperand(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = rejectEmptyNode(n) @@ -54,14 +44,18 @@ proc semOperand(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = if result.typ != nil: # XXX tyGenericInst here? if result.typ.kind == tyProc and hasUnresolvedParams(result, {efOperand}): - #and tfUnresolved in result.typ.flags: - localError(c.config, n.info, errProcHasNoConcreteType % n.renderTree) - if result.typ.kind in {tyVar, tyLent}: result = newDeref(result) + localReport(c.config, n, reportAst(rsemProcHasNoConcreteType, n)) + + if result.typ.kind in {tyVar, tyLent}: + result = newDeref(result) + elif {efWantStmt, efAllowStmt} * flags != {}: result.typ = newTypeS(tyVoid, c) + else: - localError(c.config, n.info, errExprXHasNoType % - renderTree(result, {renderNoComments})) + localReport(c.config, n.info, reportAst( + rsemExpressionHasNoType, result)) + result.typ = errorType(c) proc semExprCheck(c: PContext, n: PNode, flags: TExprFlags): PNode = @@ -75,12 +69,11 @@ proc semExprCheck(c: PContext, n: PNode, flags: TExprFlags): PNode = if isEmpty or (isTypeError and not isError): # bug #12741, redundant error messages are the lesser evil here: - localError(c.config, n.info, errExprXHasNoType % - renderTree(n, {renderNoComments})) + localReport(c.config, n, reportSem rsemExpressionHasNoType) if isError and isTypeError: # newer code paths propagate nkError nodes - result = newError(result, ExpressionHasNoType, n) + result = c.config.newError(result, reportSem rsemExpressionHasNoType, args = @[n]) if isEmpty: # do not produce another redundant error message: @@ -91,8 +84,9 @@ proc semExprWithType(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = if result.typ == nil and efInTypeof in flags: result.typ = c.voidType elif result.typ == nil or result.typ == c.enforceVoidContext: - localError(c.config, n.info, errExprXHasNoType % - renderTree(result, {renderNoComments})) + localReport(c.config, n.info, reportAst( + rsemExpressionHasNoType, result)) + result.typ = errorType(c) elif result.typ.kind == tyError: # associates the type error to the current owner @@ -103,8 +97,9 @@ proc semExprWithType(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = proc semExprNoDeref(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = result = semExprCheck(c, n, flags) if result.typ == nil: - localError(c.config, n.info, errExprXHasNoType % - renderTree(result, {renderNoComments})) + localReport(c.config, n.info, reportAst( + rsemExpressionHasNoType, result)) + result.typ = errorType(c) proc semSymGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = @@ -113,7 +108,9 @@ proc semSymGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = proc inlineConst(c: PContext, n: PNode, s: PSym): PNode {.inline.} = result = copyTree(s.ast) if result.isNil: - localError(c.config, n.info, "constant of type '" & typeToString(s.typ) & "' has no value") + localReport(c.config, n.info, reportSym( + rsemConstantOfTypeHasNoValue, s)) + result = newSymNode(s) else: result.typ = s.typ @@ -172,7 +169,12 @@ proc checkConvertible(c: PContext, targetTyp: PType, src: PNode): TConvStatus = elif (targetBaseTyp.kind in IntegralTypes) and (srcBaseTyp.kind in IntegralTypes): if targetTyp.kind == tyEnum and srcBaseTyp.kind == tyEnum: - message(c.config, src.info, warnSuspiciousEnumConv, "suspicious code: enum to enum conversion") + localReport(c.config, src.info, SemReport( + kind: rsemSuspiciousEnumConv, + ast: src, + typeMismatch: @[ + c.config.typeMismatch(formal = targetTyp, actual = srcBaseTyp)])) + # `elif` would be incorrect here if targetTyp.kind == tyBool: discard "convOk" @@ -195,7 +197,11 @@ proc checkConvertible(c: PContext, targetTyp: PType, src: PNode): TConvStatus = # we use d, s here to speed up that operation a bit: case cmpTypes(c, d, s) of isNone, isGeneric: - if not compareTypes(targetTyp.skipTypes(abstractVar), srcTyp.skipTypes({tyOwned}), dcEqIgnoreDistinct): + if not compareTypes( + targetTyp.skipTypes(abstractVar), + srcTyp.skipTypes({tyOwned}), + dcEqIgnoreDistinct + ): result = convNotLegal else: discard @@ -265,7 +271,9 @@ proc isOwnedSym(c: PContext; n: PNode): bool = proc semConv(c: PContext, n: PNode): PNode = if n.len != 2: - localError(c.config, n.info, "a type conversion takes exactly one argument") + localReport(c.config, n.info, semReportCountMismatch( + rsemTypeConversionArgumentMismatch, expected = 1, got = n.len - 1, n)) + return n result = newNodeI(nkConv, n.info) @@ -273,7 +281,8 @@ proc semConv(c: PContext, n: PNode): PNode = var targetType = semTypeNode(c, n[0], nil) case targetType.kind of tyTypeDesc: - internalAssert c.config, targetType.len > 0 + internalAssert(c.config, targetType.len > 0, "") + if targetType.base.kind == tyNone: return semTypeOf(c, n) else: @@ -307,7 +316,8 @@ proc semConv(c: PContext, n: PNode): PNode = # special case to make MyObject(x = 3) produce a nicer error message: if n[1].kind == nkExprEqExpr and targetType.skipTypes(abstractPtrs).kind == tyObject: - localError(c.config, n.info, "object construction uses ':', not '='") + localReport(c.config, n, reportSem rsemUnexpectedEqInObjectConstructor) + var op = semExprWithType(c, n[1]) if targetType.kind != tyGenericParam and targetType.isMetaType: let final = inferWithMetatype(c, targetType, op, true) @@ -334,17 +344,21 @@ proc semConv(c: PContext, n: PNode): PNode = elif op.kind in {nkPar, nkTupleConstr} and targetType.kind == tyTuple: op = fitNode(c, targetType, op, result.info) of convNotNeedeed: - message(c.config, n.info, hintConvFromXtoItselfNotNeeded, result.typ.typeToString) + localReport(c.config, n.info, reportTyp( + rsemConvFromXtoItselfNotNeeded, result.typ, ast = result)) + of convNotLegal: result = fitNode(c, result.typ, result[1], result.info) if result == nil: - localError(c.config, n.info, "illegal conversion from '$1' to '$2'" % - [op.typ.typeToString, result.typ.typeToString]) + localReport(c.config, n.info, SemReport( + kind: rsemIllegalConversion, + typeMismatch: @[ + c.config.typeMismatch(formal = result.typ, actual = op.typ)])) + of convNotInRange: - let value = - if op.kind in {nkCharLit..nkUInt64Lit}: $op.getInt else: $op.getFloat - localError(c.config, n.info, errGenerated, value & " can't be converted to " & - result.typ.typeToString) + localReport(c.config, n.info, reportAst( + rsemCannotBeConvertedTo, op, typ = result.typ)) + else: for i in 0.. 0 and n[0].kind == nkExprColonExpr: # named tuple? for i in 0.. lastOrd(c.config, newType): - localError(c.config, n.info, "cannot convert " & $value & - " to " & typeToString(newType)) + localReport(c.config, n.info, reportAst( + rsemCannotBeConvertedTo, n, typ = newType)) + of nkFloatLit..nkFloat64Lit: if check and not floatRangeCheck(n.floatVal, newType): - localError(c.config, n.info, errFloatToString % [$n.floatVal, typeToString(newType)]) - else: discard + localReport(c.config, n.info, reportAst( + rsemCannotBeConvertedTo, ast = n, typ = newType)) + + else: + discard + n.typ = newType proc arrayConstrType(c: PContext, n: PNode): PType = @@ -603,8 +639,10 @@ proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = if x.kind == nkExprColonExpr and x.len == 2: var idx = semConstExpr(c, x[0]) if not isOrdinalType(idx.typ): - localError(c.config, idx.info, "expected ordinal value for array " & - "index, got '$1'" % renderTree(idx)) + localReport(c.config, idx): + reportTyp(rsemExpectedOrdinal, idx.typ, ast = result).withIt do: + it.wrongNode = idx + else: firstIndex = getOrdValue(idx) lastIndex = firstIndex @@ -618,17 +656,30 @@ proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = #var typ = skipTypes(result[0].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal}) for i in 1.. 0: discard "allow access within a cast(unsafeAssign) section" else: - localError(c.config, n.info, errVarForOutParamNeededX % renderNotLValue(n)) + localReport(c.config, n.info, reportAst(rsemVarForOutParamNeeded, n)) proc analyseIfAddressTaken(c: PContext, n: PNode): PNode = result = n @@ -724,6 +775,7 @@ proc analyseIfAddressTaken(c: PContext, n: PNode): PNode = checkSonsLen(n, 2, c.config) if n[1].kind != nkSym: internalError(c.config, n.info, "analyseIfAddressTaken") + return if skipTypes(n[1].sym.typ, abstractInst-{tyTypeDesc}).kind notin {tyVar, tyLent}: incl(n[1].sym.flags, sfAddrTaken) @@ -761,17 +813,19 @@ proc analyseIfAddressTakenInCall(c: PContext, n: PNode) = if aa == arDiscriminant and c.inUncheckedAssignSection > 0: discard "allow access within a cast(unsafeAssign) section" else: - localError(c.config, it.info, errVarForOutParamNeededX % $it) + localReport(c.config, it.info, reportAst( + rsemVarForOutParamNeeded, it)) + # bug #5113: disallow newSeq(result) where result is a 'var T': if n[0].sym.magic in {mNew, mNewFinalize, mNewSeq}: var arg = n[1] #.skipAddr if arg.kind == nkHiddenDeref: arg = arg[0] if arg.kind == nkSym and arg.sym.kind == skResult and arg.typ.skipTypes(abstractInst).kind in {tyVar, tyLent}: - localError(c.config, n.info, errXStackEscape % renderTree(n[1], {renderNoComments})) + localReport(c.config, n.info, reportAst(rsemStackEscape, n[1])) return - for i in 1.. we don't want the restriction # to 'skIterator' anymore; skIterator is preferred in sigmatch already @@ -898,7 +959,9 @@ proc semOverloadedCallAnalyseEffects(c: PContext, n: PNode, nOrig: PNode, of skMacro, skTemplate: discard else: if callee.kind == skIterator and callee.id == c.p.owner.id: - localError(c.config, n.info, errRecursiveDependencyIteratorX % callee.name.s) + localReport(c.config, n.info, reportSym( + rsemRecursiveDependencyIterator, callee)) + # error correction, prevents endless for loop elimination in transf. # See bug #2051: result[0] = newSymNode(errorSym(c, n)) @@ -959,6 +1022,7 @@ proc afterCallActions(c: PContext; n, orig: PNode, flags: TExprFlags): PNode = result = evalAtCompileTime(c, result) proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = + addInNimDebugUtils(c.config, "semIndirectOp") result = nil checkMinSonsLen(n, 1, c.config) if n.kind == nkError: return n @@ -977,13 +1041,13 @@ proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = of nkError: result = n result[0] = n0 - return wrapErrorInSubTree(result) + return wrapErrorInSubTree(c.config, result) else: n[0] = n0 else: n[0] = semExpr(c, n[0], {efInCall}) if n[0] != nil and n[0].isErrorLike: - result = wrapErrorInSubTree(n) + result = wrapErrorInSubTree(c.config, n) return let t = n[0].typ if t != nil and t.kind in {tyVar, tyLent}: @@ -1005,7 +1069,7 @@ proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = if m.state != csMatch: if c.config.m.errorOutputs == {}: # speed up error generation: - globalError(c.config, n.info, "type mismatch") + globalReport(c.config, n.info, SemReport(kind: rsemTypeMismatch)) return c.graph.emptyNode else: var hasErrorType = false @@ -1013,14 +1077,19 @@ proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = if n[i].typ.kind == tyError: hasErrorType = true break - result = - if not hasErrorType: - newError(n, CallTypeMismatch) - else: - # XXX: legacy path, consolidate with nkError - errorNode(c, n) + + if not hasErrorType: + result = c.config.newError(n, reportTyp( + rsemCallIndirectTypeMismatch, n[0].typ, ast = n)) + + else: + # XXX: legacy path, consolidate with nkError + result = errorNode(c, n) + return + result = nil + else: result = m.call instGenericConvertersSons(c, result, m) @@ -1050,7 +1119,7 @@ proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = elif result[0].kind == nkSym: result = if result[0].sym.isError: - wrapErrorInSubTree(result) + wrapErrorInSubTree(c.config, result) else: afterCallActions(c, result, nOrig, flags) else: @@ -1075,7 +1144,8 @@ proc buildEchoStmt(c: PContext, n: PNode): PNode = if e != nil: result.add(newSymNode(e)) else: - result.add localErrorNode(c, n, "system needs: echo") + result.add newError(c.config, n, reportStr(rsemSystemNeeds, "echo")) + result.add(n) result.add(newStrNode(nkStrLit, ": " & n.typ.typeToString)) result = semExpr(c, result) @@ -1085,7 +1155,7 @@ proc semExprNoType(c: PContext, n: PNode): PNode = ## hence the 'NoType` suffix in the name. ## ## Semantic/type analysis is still done as we perform a check for `discard`. - let isPush = c.config.hasHint(hintExtendedContext) + let isPush = c.config.hasHint(rsemExtendedContext) if isPush: pushInfoContext(c.config, n.info) result = semExpr(c, n, {efWantStmt}) discardCheck(c, result, {}) @@ -1114,7 +1184,9 @@ proc lookupInRecordAndBuildCheck(c: PContext, n, r: PNode, field: PIdent, if result != nil: return of nkRecCase: checkMinSonsLen(r, 2, c.config) - if (r[0].kind != nkSym): illFormedAst(r, c.config) + if (r[0].kind != nkSym): + semReportIllformedAst(c.config, r, {nkSym}) + result = lookupInRecordAndBuildCheck(c, n, r[0], field, check) if result != nil: return let setType = createSetType(c, r[0].typ) @@ -1154,10 +1226,14 @@ proc lookupInRecordAndBuildCheck(c: PContext, n, r: PNode, field: PIdent, notExpr.add inExpr check.add notExpr return - else: illFormedAst(it, c.config) + else: + semReportIllformedAst(c.config, it, {nkElse, nkOfBranch}) + of nkSym: - if r.sym.name.id == field.id: result = r.sym - else: illFormedAst(n, c.config) + if r.sym.name.id == field.id: + result = r.sym + else: + semReportIllformedAst(c.config, n, {nkSym, nkRecCase, nkRecList}) const tyTypeParamsHolders = {tyGenericInst, tyCompositeTypeClass} @@ -1267,11 +1343,11 @@ proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode = return s.typ.n elif sfGenSym in s.flags: # the owner should have been set by now by addParamOrResult - internalAssert c.config, s.owner != nil + internalAssert(c.config, s.owner != nil, "") result = newSymNode(s, n.info) of skVar, skLet, skResult, skForVar: if s.magic == mNimvm: - localError(c.config, n.info, "illegal context for 'nimvm' magic") + localReport(c.config, n, reportSem rsemIllegalNimvmContext) markUsed(c, n.info, s) onUse(n.info, s) @@ -1280,8 +1356,8 @@ proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode = # not sure the symbol really ends up being used: # var len = 0 # but won't be called # genericThatUsesLen(x) # marked as taking a closure? - if hasWarn(c.config, warnResultUsed): - message(c.config, n.info, warnResultUsed) + if hasWarn(c.config, rsemResultUsed): + localReport(c.config, n, reportSem rsemResultUsed) of skGenericParam: onUse(n.info, s) @@ -1515,13 +1591,17 @@ proc semDeref(c: PContext, n: PNode): PNode = let a = getConstExpr(c.module, n[0], c.idgen, c.graph) if a != nil: if a.kind == nkNilLit: - localError(c.config, n.info, "nil dereference is not allowed") + localReport(c.config, n, reportSem rsemDisallowedNilDeref) n[0] = a result = n var t = skipTypes(n[0].typ, {tyGenericInst, tyVar, tyLent, tyAlias, tySink, tyOwned}) - case t.kind - of tyRef, tyPtr: n.typ = t.lastSon - else: result = nil + case t.kind: + of tyRef, tyPtr: + n.typ = t.lastSon + + else: + result = nil + #GlobalError(n[0].info, errCircumNeedsPointer) proc maybeInstantiateGeneric(c: PContext, n: PNode, s: PSym): PNode = @@ -1607,8 +1687,14 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = 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)] - else: localError(c.config, n.info, "invalid index value for tuple subscript") + if 0 <= idx and idx < arr.len: + n.typ = arr[toInt(idx)] + else: + localReport(c.config, n.info, SemReport( + kind: rsemInvalidTupleSubscript, + ast: n[1], + countMismatch: (expected: toInt128(arr.len - 1), got: idx))) + result = n else: result = nil @@ -1671,11 +1757,13 @@ proc takeImplicitAddr(c: PContext, n: PNode; isLent: bool): PNode = if root != nil and root.owner == c.p.owner: template url: string = "var_t_return.html".createDocLink if root.kind in {skLet, skVar, skTemp} and sfGlobal notin root.flags: - localError(c.config, n.info, "'$1' escapes its stack frame; context: '$2'; see $3" % [ - root.name.s, renderTree(n, {renderNoComments}), url]) + localReport(c.config, n.info, reportSym( + rsemLocalEscapesStackFrame, root, ast = n)) + elif root.kind == skParam and root.position != 0: - localError(c.config, n.info, "'$1' is not the first parameter; context: '$2'; see $3" % [ - root.name.s, renderTree(n, {renderNoComments}), url]) + localReport(c.config, n.info, reportSym( + rsemImplicitAddrIsNotFirstParam, root, ast = n)) + case n.kind of nkHiddenAddr, nkAddr: return n of nkDerefExpr: return n[0] @@ -1689,9 +1777,9 @@ proc takeImplicitAddr(c: PContext, n: PNode; isLent: bool): PNode = let valid = isAssignable(c, n, isLent) if valid != arLValue: if valid == arLocalLValue: - localError(c.config, n.info, errXStackEscape % renderTree(n, {renderNoComments})) + localReport(c.config, n, reportSem rsemLocalEscapesStackFrame) else: - localError(c.config, n.info, errExprHasNoAddress) + localReport(c.config, n, reportSem rsemExprHasNoAddress) result = newNodeIT(nkHiddenAddr, n.info, if n.typ.kind in {tyVar, tyLent}: n.typ else: makePtrType(c, n.typ)) result.add(n) @@ -1744,11 +1832,11 @@ proc borrowCheck(c: PContext, n, le, ri: PNode) = le.typ != nil and le.typ.skipTypes(absInst).kind != tyOwned and scopedLifetime(c, ri): if le.kind == nkSym and le.sym.kind == skResult: - localError(c.config, n.info, "cannot return an owned pointer as an unowned pointer; " & - "use 'owned(" & typeToString(le.typ) & ")' as the return type") + localReport(c.config, n.info, reportTyp( + rsemExpectedOwnerReturn, le.typ)) + elif escapes(c, le): - localError(c.config, n.info, - "assignment produces a dangling ref: the unowned ref lives longer than the owned ref") + localReport(c.config, n, reportSem rsemExpectedUnownedRef) template resultTypeIsInferrable(typ: PType): untyped = typ.isMetaType and typ.kind != tyTypeDesc @@ -1806,19 +1894,20 @@ proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode = else: a = semExprWithType(c, a, {efLValue}) n[0] = a - + if a.kind != nkError: # a = b # both are vars, means: a[] = b[] # a = b # b no 'var T' means: a = addr(b) var le = a.typ if le == nil: - localError(c.config, a.info, "expression has no type") + localReport(c.config, a, reportSem rsemExpressionHasNoType) elif (skipTypes(le, {tyGenericInst, tyAlias, tySink}).kind notin {tyVar} and isAssignable(c, a) in {arNone, arLentValue}) or ( skipTypes(le, abstractVar).kind in {tyOpenArray, tyVarargs} and views notin c.features): # Direct assignment to a discriminant is allowed! - localError(c.config, a.info, errXCannotBeAssignedTo % - renderTree(a, {renderNoComments})) + localReport(c.config, a.info, reportAst( + rsemCannotAssignTo, a, typ = le)) + else: let lhs = n[0] let rhs = semExprWithType(c, n[1], {}) @@ -1829,7 +1918,7 @@ proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode = if rhsTyp.kind in tyUserTypeClasses and rhsTyp.isResolvedUserTypeClass: rhsTyp = rhsTyp.lastSon if cmpTypes(c, lhs.typ, rhsTyp) in {isGeneric, isEqual}: - internalAssert c.config, c.p.resultSym != nil + 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 @@ -1840,7 +1929,7 @@ proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode = # overall assignment and return that, cascading upward? let r = typeMismatch(c.config, n.info, lhs.typ, rhsTyp, rhs) if r.kind == nkError: - localError(c.config, n.info, errorToString(c.config, r)) + localReport(c.config, r) borrowCheck(c, n, lhs, rhs) n[1] = fitNode(c, le, rhs, goodLineInfo(n[1])) @@ -1865,14 +1954,14 @@ proc semReturn(c: PContext, n: PNode): PNode = a.add n[0] n[0] = a else: - localError(c.config, n.info, errNoReturnTypeDeclared) + localReport(c.config, n, reportSem rsemNoReturnTypeDeclared) return result[0] = semAsgn(c, n[0]) # optimize away ``result = result``: if result[0][1].kind == nkSym and result[0][1].sym == c.p.resultSym: result[0] = c.graph.emptyNode else: - localError(c.config, n.info, "'return' not allowed here") + localReport(c.config, n, reportSem rsemReturnNotAllowed) proc semProcBody(c: PContext, n: PNode): PNode = openScope(c) @@ -1903,12 +1992,14 @@ proc semProcBody(c: PContext, n: PNode): PNode = c.p.resultSym.typ = errorType(c) c.p.owner.typ[0] = nil else: - localError(c.config, c.p.resultSym.info, errCannotInferReturnType % - c.p.owner.name.s) + localReport(c.config, c.p.resultSym.info, reportSym( + rsemCannotInferReturnType, c.p.owner)) + if isInlineIterator(c.p.owner.typ) and c.p.owner.typ[0] != nil and c.p.owner.typ[0].kind == tyUntyped: - localError(c.config, c.p.owner.info, errCannotInferReturnType % - c.p.owner.name.s) + localReport(c.config, c.p.owner.info, reportSym( + rsemCannotInferReturnType, c.p.owner)) + closeScope(c) proc semYieldVarResult(c: PContext, n: PNode, restype: PType) = @@ -1931,7 +2022,7 @@ proc semYieldVarResult(c: PContext, n: PNode, restype: PType) = else: tupleConstr[i] = takeImplicitAddr(c, tupleConstr[i], e.kind == tyLent) else: - localError(c.config, n[0].info, errXExpected, "tuple constructor") + semReportIllformedAst(c.config, n[0], {nkPar, nkTupleConstr}) else: when false: # XXX investigate what we really need here. @@ -1942,7 +2033,7 @@ proc semYield(c: PContext, n: PNode): PNode = result = n checkSonsLen(n, 1, c.config) if c.p.owner == nil or c.p.owner.kind != skIterator: - localError(c.config, n.info, errYieldNotAllowedHere) + localReport(c.config, n, reportSem rsemUnexpectedYield) elif n[0].kind != nkEmpty: n[0] = semExprWithType(c, n[0]) # check for type compatibility: var iterType = c.p.owner.typ @@ -1950,7 +2041,8 @@ proc semYield(c: PContext, n: PNode): PNode = if restype != nil: if restype.kind != tyUntyped: n[0] = fitNode(c, restype, n[0], n.info) - if n[0].typ == nil: internalError(c.config, n.info, "semYield") + if n[0].typ == nil: + internalError(c.config, n.info, "semYield") if resultTypeIsInferrable(restype): let inferred = n[0].typ @@ -1960,9 +2052,10 @@ proc semYield(c: PContext, n: PNode): PNode = semYieldVarResult(c, n, restype) else: - localError(c.config, n.info, errCannotReturnExpr) + localReport(c.config, n, reportSem rsemCannotReturnTypeless) + elif c.p.owner.typ[0] != nil: - localError(c.config, n.info, errGenerated, "yield statement must yield a value") + localReport(c.config, n, reportSem rsemExpectedValueForYield) proc semDefined(c: PContext, n: PNode): PNode = checkSonsLen(n, 2, c.config) @@ -1997,7 +2090,7 @@ proc lookUpForDeclared(c: PContext, n: PNode, onlyCurrentScope: bool): PSym = of nkOpenSymChoice, nkClosedSymChoice: result = n[0].sym else: - localError(c.config, n.info, "identifier expected, but got: " & renderTree(n)) + localReport(c.config, n, reportSem rsemExpectedIdentifier) result = nil proc semDeclared(c: PContext, n: PNode, onlyCurrentScope: bool): PNode = @@ -2018,12 +2111,15 @@ proc expectMacroOrTemplateCall(c: PContext, n: PNode): PSym = return errorSym(c, n[0]) if expandedSym.kind notin {skMacro, skTemplate}: - localError(c.config, n.info, "'$1' is not a macro or template" % expandedSym.name.s) + localReport(c.config, n.info, reportSym( + rsemExpectedMacroOrTemplate, expandedSym)) + return errorSym(c, n[0]) result = expandedSym else: - localError(c.config, n.info, "'$1' is not a macro or template" % n.renderTree) + localReport(c.config, n, reportSem rsemExpectedMacroOrTemplate) + result = errorSym(c, n) proc expectString(c: PContext, n: PNode): string = @@ -2031,7 +2127,7 @@ proc expectString(c: PContext, n: PNode): string = if n.kind in nkStrKinds: return n.strVal else: - localError(c.config, n.info, errStringLiteralExpected) + localReport(c.config, n, reportSem rsemStringLiteralExpected) proc newAnonSym(c: PContext; kind: TSymKind, info: TLineInfo): PSym = result = newSym(kind, c.cache.idAnon, nextSymId c.idgen, getCurrOwner(c), info) @@ -2063,9 +2159,12 @@ proc semExpandToAst(c: PContext, n: PNode): PNode = inc cands symx = nextOverloadIter(o, c, headSymbol) if cands == 0: - localError(c.config, n.info, "expected a template that takes " & $(macroCall.len-1) & " arguments") + localReport(c.config, n.info, semReportCountMismatch( + rsemExpectedTemplateWithNArgs, macroCall.len - 1, 0, macroCall)) + elif cands >= 2: - localError(c.config, n.info, "ambiguous symbol in 'getAst' context: " & $macroCall) + localReport(c.config, n.info, reportAst( + rsemAmbiguousGetAst, macroCall)) else: let info = macroCall[0].info macroCall[0] = newSymNode(cand, info) @@ -2075,9 +2174,9 @@ proc semExpandToAst(c: PContext, n: PNode): PNode = # we just perform overloading resolution here: #n[1] = semOverloadedCall(c, macroCall, macroCall, {skTemplate, skMacro}) else: - localError(c.config, n.info, "getAst takes a call, but got " & n.renderTree) + localReport(c.config, n, reportSem rsemExpectedCallForGetAst) # Preserve the magic symbol in order to be handled in evals.nim - internalAssert c.config, n[0].sym.magic == mExpandToAst + internalAssert(c.config, n[0].sym.magic == mExpandToAst, "") #n.typ = getSysSym("NimNode").typ # expandedSym.getReturnType if n.kind == nkStmtList and n.len == 1: result = n[0] else: result = n @@ -2130,7 +2229,9 @@ proc processQuotations(c: PContext; n: var PNode, op: string, proc semQuoteAst(c: PContext, n: PNode): PNode = if n.len != 2 and n.len != 3: - localError(c.config, n.info, "'quote' expects 1 or 2 arguments") + localReport(c.config, n.info, semReportCountMismatch( + rsemWrongNumberOfArguments, expected = 1, got = n.len - 1, node = n)) + return n # We transform the do block into a template with a param for # each interpolation. We'll pass this template to getAst. @@ -2145,7 +2246,7 @@ proc semQuoteAst(c: PContext, n: PNode): PNode = # leave some room for the result symbol if quotedBlock.kind != nkStmtList: - localError(c.config, n.info, errXExpected, "block") + semReportIllformedAst(c.config, n, {nkStmtList}) # This adds a default first field to pass the result symbol ids[0] = newAnonSym(c, skParam, n.info).newSymNode @@ -2185,8 +2286,10 @@ proc tryExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = # watch out, hacks ahead: when defined(nimsuggest): # Remove the error hook so nimsuggest doesn't report errors there - let tempHook = c.graph.config.structuredErrorHook - c.graph.config.structuredErrorHook = nil + let tempHook = c.graph.config.structuredReportHook + c.graph.config.structuredReportHook = + proc(conf: ConfigRef, report: Report): TErrorHandling = discard + let oldErrorCount = c.config.errorCounter let oldErrorMax = c.config.errorMax let oldCompilesId = c.compilesContextId @@ -2195,6 +2298,7 @@ proc tryExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = if c.compilesContextId == 0: inc c.compilesContextIdGenerator c.compilesContextId = c.compilesContextIdGenerator + c.config.errorMax = high(int) # `setErrorMaxHighMaybe` not appropriate here # open a scope for temporary symbol inclusions: @@ -2238,7 +2342,7 @@ proc tryExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = c.config.errorMax = oldErrorMax when defined(nimsuggest): # Restore the error hook - c.graph.config.structuredErrorHook = tempHook + c.graph.config.structuredReportHook = tempHook proc semCompiles(c: PContext, n: PNode, flags: TExprFlags): PNode = # we replace this node by a 'true' or 'false' node: @@ -2280,7 +2384,9 @@ proc instantiateCreateFlowVarCall(c: PContext; t: PType; info: TLineInfo): PSym = let sym = magicsys.getCompilerProc(c.graph, "nimCreateFlowVar") if sym == nil: - localError(c.config, info, "system needs: nimCreateFlowVar") + localReport(c.config, info, reportStr( + rsemSystemNeeds, "nimCreateFlowVar")) + var bindings: TIdTable initIdTable(bindings) bindings.idTablePut(sym.ast[genericParamsPos][0].typ, t) @@ -2298,7 +2404,9 @@ proc setMs(n: PNode, s: PSym): PNode = proc semSizeof(c: PContext, n: PNode): PNode = if n.len != 2: - localError(c.config, n.info, errXExpectsTypeOrValue % "sizeof") + localReport(c.config, n, reportStr( + rsemExpectedTypeOrValue, "sizeof")) + else: n[1] = semExprWithType(c, n[1], {efDetermineType}) #restoreOldStyleType(n[1]) @@ -2350,7 +2458,7 @@ proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = of mParallel: markUsed(c, n.info, s) if parallel notin c.features: - localError(c.config, n.info, "use the {.experimental.} pragma to enable 'parallel'") + localReport(c.config, n, reportSem rsemEnableExperimentalParallel) result = setMs(n, s) var x = n.lastSon if x.kind == nkDo: x = x[bodyPos] @@ -2360,14 +2468,16 @@ proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = of mSpawn: markUsed(c, n.info, s) when defined(leanCompiler): - result = localErrorNode(c, n, "compiler was built without 'spawn' support") + internalError(c.config, n.info, rintUsingLeanCompiler, + "Compiler was not built with spawn support") else: result = setMs(n, s) for i in 1.. 1 and n[1].kind notin nkCallKinds: - return localErrorNode(c, n, n[1].info, "'spawn' takes a call expression; got: " & $n[1]) + return newError(c.config, n, reportAst( + rsemExpectedExpressionForSpawn, n[1])) let typ = result[^1].typ if not typ.isEmptyType: @@ -2476,10 +2586,14 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = typ = commonType(c, typ, it[0].typ) if result == nil: result = it[0] - else: illFormedAst(n, c.config) + else: + semReportIllformedAst(c.config, n, { + nkElse, nkElseExpr, nkElifBranch, nkElifExpr}) + if result == nil: result = newNodeI(nkEmpty, n.info) - if whenNimvm: result.typ = typ + if whenNimvm: + result.typ = typ proc semSetConstr(c: PContext, n: PNode): PNode = result = newNodeI(nkCurly, n.info) @@ -2509,10 +2623,12 @@ proc semSetConstr(c: PContext, n: PNode): PNode = if typ == nil: typ = skipTypes(n[i].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal, tyAlias, tySink}) if not isOrdinalType(typ, allowEnumWithHoles=true): - localError(c.config, n.info, errOrdinalTypeExpected) - typ = makeRangeType(c, 0, MaxSetElements-1, n.info) + localReport(c.config, n, reportSem rsemExpectedOrdinal) + typ = makeRangeType(c, 0, MaxSetElements - 1, n.info) + elif lengthOrd(c.config, typ) > MaxSetElements: - typ = makeRangeType(c, 0, MaxSetElements-1, n.info) + typ = makeRangeType(c, 0, MaxSetElements - 1, n.info) + addSonSkipIntLit(result.typ, typ, c.idgen) for i in 0.. 2 + c.compilesContextId: - localError(c.config, n.info, errXOnlyAtModuleScope % "import") + localReport(c.config, n, reportSem rsemImportRequiresToplevel) + result = evalImport(c, n) of nkImportExceptStmt: - if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "import") + if not isTopLevel(c): localReport( + c.config, n, reportSem rsemImportRequiresToplevel) + result = evalImportExcept(c, n) of nkFromStmt: - if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "from") + if not isTopLevel(c): localReport( + c.config, n, reportSem rsemImportRequiresToplevel) result = evalFrom(c, n) of nkIncludeStmt: - #if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "include") + #if not isTopLevel(c): localReport(c.config, n.info, errXOnlyAtModuleScope % "include") result = evalInclude(c, n) of nkExportStmt: - if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "export") + if not isTopLevel(c): localReport( + c.config, n, reportSem rsemExportRequiresToplevel) result = semExport(c, n) of nkExportExceptStmt: - if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "export") + if not isTopLevel(c): localReport( + c.config, n, reportSem rsemExportRequiresToplevel) result = semExportExcept(c, n) of nkPragmaBlock: result = semPragmaBlock(c, n) @@ -3118,13 +3254,15 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = result = semStaticStmt(c, n) of nkDefer: if c.currentScope == c.topLevelScope: - localError(c.config, n.info, "defer statement not supported at top level") + localReport(c.config, n, reportSem rsemUnexpectedToplevelDefer) n[0] = semExpr(c, n[0]) if not n[0].typ.isEmptyType and not implicitlyDiscardable(n[0]): - localError(c.config, n.info, "'defer' takes a 'void' expression") - #localError(c.config, n.info, errGenerated, "'defer' not allowed in this context") + localReport(c.config, n, reportSem rsemExpectedTypelessDeferBody) + #localReport(c.config, n.info, errGenerated, "'defer' not allowed in this context") of nkGotoState, nkState: - if n.len != 1 and n.len != 2: illFormedAst(n, c.config) + if n.len != 1 and n.len != 2: + semReportIllformedAst(c.config, n, "") + for i in 0.. 0 and n[0].kind == nkSym: c.p.localBindStmts.add n else: - localError(c.config, n.info, "invalid context for 'bind' statement: " & - renderTree(n, {renderNoComments})) + localReport(c.config, n, reportSem rsemInvalidBindContext) of nkError: discard "ignore errors for now" else: - localError(c.config, n.info, "invalid expression: " & - renderTree(n, {renderNoComments})) + localReport(c.config, n, reportSem rsemInvalidExpression) if result != nil: incl(result.flags, nfSem) diff --git a/compiler/semfields.nim b/compiler/semfields.nim index b9ed71536a3..dce7cc8802a 100644 --- a/compiler/semfields.nim +++ b/compiler/semfields.nim @@ -50,8 +50,7 @@ proc instFieldLoopBody(c: TFieldInstCtx, n: PNode, forLoop: PNode): PNode = break else: if n.kind == nkContinueStmt: - localError(c.c.config, n.info, - "'continue' not supported in a 'fields' loop") + localReport(c.c.config, n, reportSem rsemFieldsIteratorCannotContinue) result = shallowCopy(n) for i in 0.. 2: - localError(c.c.config, forLoop.info, - "parallel 'fields' iterator does not work for 'case' objects") + localReport(c.c.config, forLoop.info, reportAst( + rsemParallelFieldsDisallowsCase, call)) + return # iterate over the selector: semForObjectFields(c, typ[0], forLoop, father) @@ -98,9 +98,12 @@ proc semForObjectFields(c: TFieldsCtx, typ, forLoop, father: PNode) = caseStmt.add(branch) father.add(caseStmt) of nkRecList: - for t in items(typ): semForObjectFields(c, t, forLoop, father) + for t in items(typ): + semForObjectFields(c, t, forLoop, father) + else: - illFormedAstLocal(typ, c.c.config) + semReportIllformedAst(c.c.config, typ, { + nkRecList, nkRecCase, nkNilLit, nkSym}) proc semForFields(c: PContext, n: PNode, m: TMagic): PNode = # so that 'break' etc. work as expected, we produce @@ -108,8 +111,11 @@ proc semForFields(c: PContext, n: PNode, m: TMagic): PNode = result = newNodeI(nkWhileStmt, n.info, 2) var trueSymbol = systemModuleSym(c.graph, getIdent(c.cache, "true")) if trueSymbol == nil: - localError(c.config, n.info, "system needs: 'true'") - trueSymbol = newSym(skUnknown, getIdent(c.cache, "true"), nextSymId c.idgen, getCurrOwner(c), n.info) + localReport(c.config, n.info, reportStr(rsemSystemNeeds, "true")) + + trueSymbol = newSym( + skUnknown, getIdent(c.cache, "true"), + nextSymId c.idgen, getCurrOwner(c), n.info) trueSymbol.typ = getSysType(c.graph, n.info, tyBool) result[0] = newSymNode(trueSymbol, n.info) @@ -117,14 +123,19 @@ proc semForFields(c: PContext, n: PNode, m: TMagic): PNode = result[1] = stmts var call = n[^2] - if n.len-2 != call.len-1 + ord(m==mFieldPairs): - localError(c.config, n.info, errWrongNumberOfVariables) + if n.len-2 != call.len - 1 + ord(m == mFieldPairs): + localReport(c.config, n.info, semReportCountMismatch( + rsemWrongNumberOfVariables, + expected = call.len - 1 + ord(m == mFieldPairs), + got = n.len - 2)) + return result const skippedTypesForFields = abstractVar - {tyTypeDesc} + tyUserTypeClasses var tupleTypeA = skipTypes(call[1].typ, skippedTypesForFields) if tupleTypeA.kind notin {tyTuple, tyObject}: - localError(c.config, n.info, errGenerated, "no object or tuple type") + localReport(c.config, n.info, reportSem(rsemNoObjectOrTupleType)) + return result for i in 1.. lastOrd(g.config, n.typ): - localError(g.config, n.info, "cannot convert " & $value & - " to " & typeToString(n.typ)) + g.config.localReport(n.info, reportStr( + rsemCantConvertLiteralToRange, $value, typ = n.typ)) proc foldConv(n, a: PNode; idgen: IdGenerator; g: ModuleGraph; check = false): PNode = let dstTyp = skipTypes(n.typ, abstractRange - {tyTypeDesc}) @@ -438,25 +443,41 @@ proc foldArrayAccess(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNo var y = getConstExpr(m, n[1], idgen, g) if y == nil: return + proc outOfBounds(idx: int64): SemReport = + SemReport( + kind: rsemStaticOutOfBounds, + ast: n, + indexSpec: ( + usedIdx: toInt128(idx), + minIdx: toInt128(0), + maxIdx: toInt128(x.len - 1))) + var idx = toInt64(getOrdValue(y)) case x.kind of nkPar, nkTupleConstr: - if idx >= 0 and idx < x.len: + if 0 <= idx and idx < x.len: result = x.sons[idx] if result.kind == nkExprColonExpr: result = result[1] else: - localError(g.config, n.info, formatErrorIndexBound(idx, x.len-1) & $n) + g.config.localReport(n.info, outOfBounds(idx)) + of nkBracket: idx -= toInt64(firstOrd(g.config, x.typ)) - if idx >= 0 and idx < x.len: result = x[int(idx)] - else: localError(g.config, n.info, formatErrorIndexBound(idx, x.len-1) & $n) + if 0 <= idx and idx < x.len: + result = x[int(idx)] + + else: + g.config.localReport(n.info, outOfBounds(idx)) + of nkStrLit..nkTripleStrLit: result = newNodeIT(nkCharLit, x.info, n.typ) - if idx >= 0 and idx < x.strVal.len: + if 0 <= idx and idx < x.strVal.len: result.intVal = ord(x.strVal[int(idx)]) else: - localError(g.config, n.info, formatErrorIndexBound(idx, x.strVal.len-1) & $n) - else: discard + g.config.localReport(n.info, outOfBounds(idx)) + + else: + discard proc foldFieldAccess(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = # a real field access; proc calls have already been transformed @@ -474,7 +495,10 @@ proc foldFieldAccess(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNo if it[0].sym.name.id == field.name.id: result = x[i][1] return - localError(g.config, n.info, "field not found: " & field.name.s) + + g.config.localReport(n.info, reportAst( + rsemStaticFieldNotFound, n, sym = field)) + proc foldConStrStr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = result = newNodeIT(nkStrLit, n.info, n.typ) @@ -516,9 +540,9 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode try: result = newIntNodeT(toInt128(g.config.symbols[s.name.s].parseInt), n, idgen, g) except ValueError: - localError(g.config, s.info, - "{.intdefine.} const was set to an invalid integer: '" & - g.config.symbols[s.name.s] & "'") + g.config.localReport reportStr( + rsemInvalidIntdefine, g.config.symbols[s.name.s]) + else: result = copyTree(s.ast) of mStrDefine: @@ -531,9 +555,9 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode try: result = newIntNodeT(toInt128(g.config.symbols[s.name.s].parseBool.int), n, idgen, g) except ValueError: - localError(g.config, s.info, - "{.booldefine.} const was set to an invalid bool: '" & - g.config.symbols[s.name.s] & "'") + g.config.localReport reportStr( + rsemInvalidBooldefine, g.config.symbols[s.name.s]) + else: result = copyTree(s.ast) else: @@ -616,9 +640,9 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode else: result = magicCall(m, n, idgen, g) except OverflowDefect: - localError(g.config, n.info, "over- or underflow") + g.config.localReport(n.info, reportAst(rsemSemfoldOverflow, n)) except DivByZeroDefect: - localError(g.config, n.info, "division by zero") + g.config.localReport(n.info, reportAst(rsemSemfoldDivByZero, n)) of nkAddr: var a = getConstExpr(m, n[0], idgen, g) if a != nil: @@ -670,9 +694,10 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode result = a # a <= x and x <= b result.typ = n.typ else: - localError(g.config, n.info, - "conversion from $1 to $2 is invalid" % - [typeToString(n[0].typ), typeToString(n.typ)]) + g.config.localReport(n.info, SemReport( + kind: rsemSemfoldInvalidConversion, + typeMismatch: @[typeMismatch(g.config, n[0].typ, n.typ)])) + of nkStringToCString, nkCStringToString: var a = getConstExpr(m, n[0], idgen, g) if a == nil: return @@ -686,7 +711,7 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode let a = getConstExpr(m, n[0], idgen, g) if a != nil and a.kind == nkNilLit: result = nil - #localError(g.config, n.info, "nil dereference is not allowed") + #localReport(g.config, n.info, "nil dereference is not allowed") of nkCast: var a = getConstExpr(m, n[1], idgen, g) if a == nil: return diff --git a/compiler/semgnrc.nim b/compiler/semgnrc.nim index 25c5d67a8b9..15b9cc261d9 100644 --- a/compiler/semgnrc.nim +++ b/compiler/semgnrc.nim @@ -23,7 +23,9 @@ proc getIdentNode(c: PContext; n: PNode): PNode = of nkPragmaExpr: result = getIdentNode(c, n[0]) of nkIdent, nkAccQuoted, nkSym: result = n else: - illFormedAst(n, c.config) + semReportIllformedAst(c.config, n, { + nkPostfix, nkPragmaExpr, nkIdent, nkAccQuoted, nkSym}) + result = n type @@ -416,11 +418,15 @@ proc semGenericStmt(c: PContext, n: PNode, for j in 0.. 50: - globalError(c.config, info, "generic instantiation too nested") + if 64 < c.instCounter: + globalReport(c.config, info, SemReport( + kind: rsemGenericInstantiationTooNested)) + inc(c.instCounter) # careful! we copy the whole AST including the possibly nil body! var n = copyTree(fn.ast) @@ -362,9 +382,13 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, openScope(c) let gp = n[genericParamsPos] - internalAssert c.config, gp.kind == nkGenericParams + internalAssert( + c.config, + gp.kind == nkGenericParams, + "Expected genric param list of a proc, but found " & $gp.kind) + n[namePos] = newSymNode(result) - pushInfoContext(c.config, info, fn.detailedInfo) + pushInfoContext(c.config, info, fn) var entry = TInstantiation.new entry.sym = result # we need to compare both the generic types and the concrete types: @@ -399,7 +423,8 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, result.ast[pragmasPos] = pragma(c, result, n[pragmasPos], allRoutinePragmas) # check if we got any errors and if so report them for e in ifErrorWalkErrors(c.config, result.ast[pragmasPos]): - messageError(c.config, e) + localReport(c.config, e) + if isNil(n[bodyPos]): n[bodyPos] = copyTree(getBody(c.graph, fn)) if c.inGenericContext == 0: diff --git a/compiler/semmacrosanity.nim b/compiler/semmacrosanity.nim index aebee89981d..d431ced0b97 100644 --- a/compiler/semmacrosanity.nim +++ b/compiler/semmacrosanity.nim @@ -10,7 +10,7 @@ ## Implements type sanity checking for ASTs resulting from macros. Lots of ## room for improvement here. -import ast, msgs, types, options +import ast, msgs, types, options, reports, strutils proc ithField(n: PNode, field: var int): PSym = result = nil @@ -44,9 +44,17 @@ proc ithField(t: PType, field: var int): PSym = result = ithField(t.n, field) proc annotateType*(n: PNode, t: PType; conf: ConfigRef) = - let x = t.skipTypes(abstractInst+{tyRange}) + let x = t.skipTypes(abstractInst + {tyRange}) # Note: x can be unequal to t and we need to be careful to use 't' # to not to skip tyGenericInst + + proc malformedType(msg: string, expected: set[TTypeKind]) = + globalReport(conf, n.info, SemReport( + kind: rsemTypeKindMismatch, + typeMismatch: @[conf.typeMismatch(formal = expected, actual = n.typ)], + ast: n, + str: msg)) + case n.kind of nkObjConstr: let x = t.skipTypes(abstractPtrs) @@ -55,50 +63,89 @@ proc annotateType*(n: PNode, t: PType; conf: ConfigRef) = var j = i-1 let field = x.ithField(j) if field.isNil: - globalError conf, n.info, "invalid field at index " & $i + globalReport(conf, n.info, reportAst( + rsemIllformedAst, n, + str = "'nil' field at index" & $i)) + else: - internalAssert(conf, n[i].kind == nkExprColonExpr) + internalAssert( + conf, + n[i].kind == nkExprColonExpr, + "Object constructor expects exprColornExpr, but n[$1] has kind $2" % [ + $i, $n[i].kind]) + annotateType(n[i][1], field.typ, conf) of nkPar, nkTupleConstr: if x.kind == tyTuple: n.typ = t for i in 0..= x.len: globalError conf, n.info, "invalid field at index " & $i - else: annotateType(n[i], x[i], conf) + if i >= x.len: + globalReport(conf, n.info, reportAst( + rsemIllformedAst, n, + str = "Unexpected field at index $1 - type $2 is expected to have $3 fields." % [ + $i, $x, $x.len])) + + else: + annotateType(n[i], x[i], conf) + elif x.kind == tyProc and x.callConv == ccClosure: n.typ = t + else: - globalError(conf, n.info, "() must have a tuple type") + malformedType("() must have a tuple or closure proc type", {tyTuple, tyProc}) + of nkBracket: if x.kind in {tyArray, tySequence, tyOpenArray}: n.typ = t - for m in n: annotateType(m, x.elemType, conf) + for m in n: + annotateType(m, x.elemType, conf) + else: - globalError(conf, n.info, "[] must have some form of array type") + malformedType( + "[] must have some form of array type", + {tyArray, tySequence, tyOpenArray}) + of nkCurly: if x.kind in {tySet}: n.typ = t - for m in n: annotateType(m, x.elemType, conf) + for m in n: + annotateType(m, x.elemType, conf) else: - globalError(conf, n.info, "{} must have the set type") + malformedType("{} must have the set type", {tySet}) + of nkFloatLit..nkFloat128Lit: if x.kind in {tyFloat..tyFloat128}: n.typ = t + else: - globalError(conf, n.info, "float literal must have some float type") + malformedType( + "float literal must have some float type", {tyFloat..tyFloat128}) + of nkCharLit..nkUInt64Lit: if x.kind in {tyInt..tyUInt64, tyBool, tyChar, tyEnum}: n.typ = t + else: - globalError(conf, n.info, "integer literal must have some int type") + malformedType( + "integer literal must have some int type", + {tyInt..tyUInt64, tyBool, tyChar, tyEnum}) + of nkStrLit..nkTripleStrLit: if x.kind in {tyString, tyCstring}: n.typ = t + else: - globalError(conf, n.info, "string literal must be of some string type") + malformedType( + "string literal must be of some string type", + {tyString, tyCstring}) + of nkNilLit: - if x.kind in NilableTypes+{tyString, tySequence}: + if x.kind in NilableTypes + {tyString, tySequence}: n.typ = t + else: - globalError(conf, n.info, "nil literal must be of some pointer type") - else: discard + malformedType( + "nil literal must be of some pointer type", NilableTypes + {tyString, tySequence}) + + else: + discard diff --git a/compiler/semmagic.nim b/compiler/semmagic.nim index b10ef7c588e..50071d55c61 100644 --- a/compiler/semmagic.nim +++ b/compiler/semmagic.nim @@ -17,10 +17,10 @@ proc semAddrArg(c: PContext; n: PNode; isUnsafeAddr = false): PNode = if isAssignable(c, x, isUnsafeAddr) notin {arLValue, arLocalLValue}: # Do not suggest the use of unsafeAddr if this expression already is a # unsafeAddr - if isUnsafeAddr: - localError(c.config, n.info, errExprHasNoAddress) - else: - localError(c.config, n.info, errExprHasNoAddress & "; maybe use 'unsafeAddr'") + localReport(c.config, n.info) do: + reportSem(rsemExprHasNoAddress).withIt do: + it.isUnsafeAddr = isUnsafeAddr + result = x proc semTypeOf(c: PContext; n: PNode): PNode = @@ -28,7 +28,7 @@ proc semTypeOf(c: PContext; n: PNode): PNode = if n.len == 3: let mode = semConstExpr(c, n[2]) if mode.kind != nkIntLit: - localError(c.config, n.info, "typeof: cannot evaluate 'mode' parameter at compile-time") + localReport(c.config, n, reportSem rsemVmCannotEvaluateAtComptime) else: m = mode.intVal result = newNodeI(nkTypeOfExpr, n.info) @@ -75,7 +75,7 @@ proc expectIntLit(c: PContext, n: PNode): int = let x = c.semConstExpr(c, n) case x.kind of nkIntLit..nkInt64Lit: result = int(x.intVal) - else: localError(c.config, n.info, errIntLiteralExpected) + else: localReport(c.config, n, reportSem rsemIntLiteralExpected) proc semInstantiationInfo(c: PContext, n: PNode): PNode = result = newNodeIT(nkTupleConstr, n.info, n.typ) @@ -124,7 +124,7 @@ proc getTypeDescNode(c: PContext; typ: PType, sym: PSym, info: TLineInfo): PNode proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym): PNode = const skippedTypes = {tyTypeDesc, tyAlias, tySink} let trait = traitCall[0] - internalAssert c.config, trait.kind == nkSym + internalAssert(c.config, trait.kind == nkSym, "") var operand = operand.skipTypes(skippedTypes) template operand2: PType = @@ -169,7 +169,13 @@ proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym) # var resType = newType(tySequence, operand.owner) # result = toNode(resType, traitCall.info) # doesn't work yet else: - localError(c.config, traitCall.info, "expected generic type, got: type $2 of kind $1" % [arg.kind.toHumanStr, typeToString(operand)]) + localReport( + c.config, + traitCall.info, + SemReport( + kind: rsemGenericTypeExpected, + typeMismatch: @[c.config.typeMismatch({tyGenericInst}, arg)])) + result = newType(tyError, nextTypeId c.idgen, context).toNode(traitCall.info) of "stripGenericParams": result = uninstantiate(operand).toNode(traitCall.info) @@ -194,13 +200,15 @@ proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym) if not rec: break result = getTypeDescNode(c, arg, operand.owner, traitCall.info) else: - localError(c.config, traitCall.info, "unknown trait: " & s) + localReport(c.config, traitCall.info, reportSym( + rsemUnknownTrait, trait.sym)) + result = newNodeI(nkEmpty, traitCall.info) proc semTypeTraits(c: PContext, n: PNode): PNode = checkMinSonsLen(n, 2, c.config) let t = n[1].typ - internalAssert c.config, t != nil and t.kind == tyTypeDesc + internalAssert(c.config, t != nil and t.kind == tyTypeDesc, "") if t.len > 0: # This is either a type known to sem or a typedesc # param to a regular proc (again, known at instantiation) @@ -215,7 +223,8 @@ proc semOrd(c: PContext, n: PNode): PNode = if isOrdinalType(parType, allowEnumWithHoles=true): discard else: - result = newError(n, errOrdinalTypeExpected) + result = c.config.newError(n, reportTyp(rsemExpectedOrdinal, parType)) + result.typ = errorType(c) proc semBindSym(c: PContext, n: PNode): PNode = @@ -224,12 +233,12 @@ proc semBindSym(c: PContext, n: PNode): PNode = let sl = semConstExpr(c, n[1]) if sl.kind notin {nkStrLit, nkRStrLit, nkTripleStrLit}: - return localErrorNode(c, n, n[1].info, errStringLiteralExpected) + return newError(c.config, n, reportSem rsemStringLiteralExpected) let isMixin = semConstExpr(c, n[2]) if isMixin.kind != nkIntLit or isMixin.intVal < 0 or isMixin.intVal > high(TSymChoiceRule).int: - return localErrorNode(c, n, n[2].info, errConstExprExpected) + return newError(c.config, n, reportSem rsemConstExprExpected) let id = newIdentNode(getIdent(c.cache, sl.strVal), n.info) let s = qualifiedLookUp(c, id, {checkUndeclared}) @@ -246,10 +255,10 @@ proc semBindSym(c: PContext, n: PNode): PNode = proc opBindSym(c: PContext, scope: PScope, n: PNode, isMixin: int, info: PNode): PNode = if n.kind notin {nkStrLit, nkRStrLit, nkTripleStrLit, nkIdent}: - return localErrorNode(c, n, info.info, errStringOrIdentNodeExpected) + return newError(c.config, n, reportSem rsemStringOrIdentNodeExpected, posInfo = info.info) if isMixin < 0 or isMixin > high(TSymChoiceRule).int: - return localErrorNode(c, n, info.info, errConstExprExpected) + return newError(c.config, n, reportSem rsemConstExprExpected, posInfo = info.info) let id = if n.kind == nkIdent: n else: newIdentNode(getIdent(c.cache, n.strVal), info.info) @@ -317,9 +326,9 @@ proc semOf(c: PContext, n: PNode): PNode = let y = skipTypes(n[2].typ, abstractPtrs-{tyTypeDesc}) if x.kind == tyTypeDesc or y.kind != tyTypeDesc: - localError(c.config, n.info, "'of' takes object types") + localReport(c.config, n, reportSem rsemExpectedObjectForOf) elif b.kind != tyObject or a.kind != tyObject: - localError(c.config, n.info, "'of' takes object types") + localReport(c.config, n, reportSem rsemExpectedObjectForOf) else: let diff = inheritanceDiff(a, b) # | returns: 0 iff `a` == `b` @@ -328,21 +337,26 @@ proc semOf(c: PContext, n: PNode): PNode = # | returns: `maxint` iff `a` and `b` are not compatible at all if diff <= 0: # optimize to true: - message(c.config, n.info, hintConditionAlwaysTrue, renderTree(n)) + localReport(c.config, n, reportSem rsemConditionAlwaysTrue) result = newIntNode(nkIntLit, 1) result.info = n.info result.typ = getSysType(c.graph, n.info, tyBool) return result elif diff == high(int): if commonSuperclass(a, b) == nil: - localError(c.config, n.info, "'$1' cannot be of this subtype" % typeToString(a)) + localReport(c.config, n.info, SemReport( + kind: rsemCannotBeOfSubtype, + typeMismatch: @[c.config.typeMismatch(actual = a, formal = b)])) + else: - message(c.config, n.info, hintConditionAlwaysFalse, renderTree(n)) + localReport(c.config, n, reportSem rsemConditionAlwaysFalse) result = newIntNode(nkIntLit, 0) result.info = n.info result.typ = getSysType(c.graph, n.info, tyBool) else: - localError(c.config, n.info, "'of' takes 2 arguments") + localReport(c.config, n.info, semReportCountMismatch( + rsemWrongNumberOfArguments, expected = 2, got = n.len - 1, node = n)) + n.typ = getSysType(c.graph, n.info, tyBool) result = n @@ -439,17 +453,21 @@ proc semQuantifier(c: PContext; n: PNode): PNode = addDecl(c, v) result.add newTree(nkInfix, it[0], newSymNode(v), domain) if not valid: - localError(c.config, n.info, " 'in' expected") + localReport(c.config, n, reportSem rsemQuantifierInRangeExpected) result.add forceBool(c, semExprWithType(c, args[^1])) closeScope(c) proc semOld(c: PContext; n: PNode): PNode = if n[1].kind == nkHiddenDeref: n[1] = n[1][0] + if n[1].kind != nkSym or n[1].sym.kind != skParam: - localError(c.config, n[1].info, "'old' takes a parameter name") + localReport(c.config, n[1], reportSem rsemOldTakesParameterName) + elif n[1].sym.owner != getCurrOwner(c): - localError(c.config, n[1].info, n[1].sym.name.s & " does not belong to " & getCurrOwner(c).name.s) + localReport(c.config, n[1].info, reportAst( + rsemOldDoesNotBelongTo, n[1], sym = getCurrOwner(c))) + result = n proc semPrivateAccess(c: PContext, n: PNode): PNode = @@ -511,26 +529,28 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, of mPlugin: let plugin = getPlugin(c.cache, n[0].sym) if plugin.isNil: - localError(c.config, n.info, "cannot find plugin " & n[0].sym.name.s) + localReport(c.config, n.info, reportSym( + rsemCannotFindPlugin, sym = n[0].sym)) + result = n else: result = plugin(c, n) of mNewFinalize: # Make sure the finalizer procedure refers to a procedure if n[^1].kind == nkSym and n[^1].sym.kind notin {skProc, skFunc}: - localError(c.config, n.info, "finalizer must be a direct reference to a proc") + localReport(c.config, n, reportSem rsemExpectedProcReferenceForFinalizer) elif optTinyRtti in c.config.globalOptions: let nfin = skipConvCastAndClosure(n[^1]) let fin = case nfin.kind of nkSym: nfin.sym of nkLambda, nkDo: nfin[namePos].sym else: - localError(c.config, n.info, "finalizer must be a direct reference to a proc") + localReport(c.config, n, reportSem rsemExpectedProcReferenceForFinalizer) nil if fin != nil: if fin.kind notin {skProc, skFunc}: # calling convention is checked in codegen - localError(c.config, n.info, "finalizer must be a direct reference to a proc") + localReport(c.config, n, reportSem rsemExpectedProcReferenceForFinalizer) # check if we converted this finalizer into a destructor already: let t = whereToBindTypeHook(c, fin.typ[1].skipTypes(abstractInst+{tyRef})) @@ -564,16 +584,21 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, tyVar, tyGenericInst, tyOwned, tySink, tyAlias, tyUserTypeClassInst}) if seqType.kind == tySequence and seqType.base.requiresInit: - message(c.config, n.info, warnUnsafeSetLen, typeToString(seqType.base)) + localReport(c.config, n.info, reportTyp( + rsemUnsafeSetLen, seqType.base)) + of mDefault: result = n - c.config.internalAssert result[1].typ.kind == tyTypeDesc + c.config.internalAssert(result[1].typ.kind == tyTypeDesc, "") let constructed = result[1].typ.base if constructed.requiresInit: - message(c.config, n.info, warnUnsafeDefault, typeToString(constructed)) + localReport(c.config, n.info, reportTyp( + rsemUnsafeDefault, constructed)) + of mIsolate: if not checkIsolate(n[1]): - localError(c.config, n.info, "expression cannot be isolated: " & $n[1]) + localReport(c.config, n.info, reportAst(rsemCannotIsolate, n[1])) + result = n of mPred: if n[1].typ.skipTypes(abstractInst).kind in {tyUInt..tyUInt64}: diff --git a/compiler/semobjconstr.nim b/compiler/semobjconstr.nim index 6bb9d7bfe8d..0ea0ab9c93a 100644 --- a/compiler/semobjconstr.nim +++ b/compiler/semobjconstr.nim @@ -15,8 +15,6 @@ # included from sem.nim -from sugar import dup - type ObjConstrContext = object typ: PType # The constructed type @@ -58,10 +56,10 @@ proc mergeInitStatus(existing: var InitStatus, newStatus: InitStatus) = proc invalidObjConstr(c: PContext, n: PNode): PNode = if n.kind == nkInfix and n[0].kind == nkIdent and n[0].ident.s[0] == ':': - newError(c, n, FieldAssignmentInvalid, - newStrNode("use a space after the colon", n.info)) + newError(c.config, n, reportSem rsemFieldAssignmentInvalid) + else: - newError(c, n, FieldAssignmentInvalid) + newError(c.config, n, reportSem rsemFieldAssignmentInvalid) proc locateFieldInInitExpr(c: PContext, field: PSym, initExpr: PNode): PNode = ## Returns the assignment nkExprColonExpr node, nkError if malformed, or nil @@ -71,7 +69,7 @@ proc locateFieldInInitExpr(c: PContext, field: PSym, initExpr: PNode): PNode = e = initExpr[i] valid = e.kind == nkExprColonExpr partiallyValid = e.kind == nkError and - e.errorKind == FieldOkButAssignedValueInvalid + e.errorKind == rsemFieldOkButAssignedValueInvalid atLeastPartiallyValid = valid or partiallyValid assignment = if partiallyValid: e[wrongNodePos] else: e match = @@ -100,10 +98,13 @@ proc semConstrField(c: PContext, flags: TExprFlags, if nfSem in result.flags: return if not fieldVisible(c, field): - result = newError(initExpr, FieldNotAccessible, newSymNode(field)) + result = newError( + c.config, initExpr, + reportSym(rsemFieldNotAccessible, field)) + result.typ = errorType(c) return - if result.kind == nkError and result.errorKind != FieldOkButAssignedValueInvalid: + if result.kind == nkError and result.errorKind != rsemFieldOkButAssignedValueInvalid: return # result is the assignment error var initValue = semExprFlagDispatched(c, result[1], flags) @@ -113,7 +114,17 @@ proc semConstrField(c: PContext, flags: TExprFlags, result[1] = initValue result.flags.incl nfSem if initValue != nil and initValue.kind == nkError: - result = newError(c, result, FieldOkButAssignedValueInvalid) + result = newError( + c.config, + result, + reportSym( + rsemFieldOkButAssignedValueInvalid, + field, + ast = initValue + ).withIt do: + it.wrongNode = result + ) + proc caseBranchMatchesExpr(branch, matched: PNode): bool = for i in 0.. MaxSetElements or lengthOrd(c.config, n[0].typ) > MaxSetElements): - localError(c.config, discriminatorVal.info, - "branch initialization with a runtime discriminator only " & - "supports ordinal types with 2^16 elements or less.") + localReport(c.config, discriminatorVal.info, SemReport( + kind: rsemRuntimeDiscriminantInitCap)) if discriminatorVal == nil: badDiscriminatorError() @@ -298,13 +315,13 @@ proc semConstructFields(c: PContext, n: PNode, elif discriminatorVal.sym.kind notin {skLet, skParam} or discriminatorVal.sym.typ.kind in {tyVar}: if c.inUncheckedAssignSection == 0: - localError(c.config, discriminatorVal.info, - "runtime discriminator must be immutable if branch fields are " & - "initialized, a 'let' binding is required.") + localReport(c.config, discriminatorVal.info, SemReport( + kind: rsemRuntimeDiscriminantMustBeImmutable)) + elif ctorCase[ctorIdx].kind == nkElifBranch: - localError(c.config, discriminatorVal.info, "branch initialization " & - "with a runtime discriminator is not supported inside of an " & - "`elif` branch.") + localReport(c.config, discriminatorVal.info, SemReport( + kind: rsemRuntimeDiscriminantRequiresElif)) + else: var ctorBranchVals = branchVals(c, ctorCase, ctorIdx, true) @@ -386,7 +403,7 @@ proc semConstructFields(c: PContext, n: PNode, initNone else: - internalAssert c.config, false + internalAssert(c.config, false, "") proc semConstructTypeAux(c: PContext, constrCtx: var ObjConstrContext, @@ -409,7 +426,9 @@ proc semConstructTypeAux(c: PContext, constrCtx.needsFullInit = constrCtx.needsFullInit or tfNeedsFullInit in t.flags if result == initError: - constrCtx.initExpr = newError(c, constrCtx.initExpr, ObjectConstructorIncorrect) + constrCtx.initExpr = newError( + c.config, constrCtx.initExpr, + reportAst(rsemObjectConstructorIncorrect, constrCtx.initExpr)) proc initConstrContext(t: PType, initExpr: PNode): ObjConstrContext = ObjConstrContext( @@ -433,12 +452,16 @@ proc defaultConstructionError(c: PContext, t: PType, info: TLineInfo) = var constrCtx = initConstrContext(objType, newNodeI(nkObjConstr, info)) let initResult = semConstructTypeAux(c, constrCtx, {}) assert constrCtx.missingFields.len > 0 - localError(c.config, info, - "The $1 type doesn't have a default value. The following fields must " & - "be initialized: $2." % [typeToString(t), listSymbolNames(constrCtx.missingFields)]) + localReport( + c.config, info, + reportSymbols( + rsemObjectRequiresFieldInitNoDefault, + constrCtx.missingFields, typ = t)) + elif objType.kind == tyDistinct: - localError(c.config, info, - "The $1 distinct type doesn't have a default value." % typeToString(t)) + localReport(c.config, info, reportTyp( + rsemDistinctDoesNotHaveDefaultValue, t)) + else: assert false, "Must not enter here." @@ -448,7 +471,7 @@ proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = for child in n: result.add child if t == nil: - return localErrorNode(c, result, "object constructor needs an object type") + return newError(c.config, result, reportSem rsemExpectedObjectType) t = skipTypes(t, {tyGenericInst, tyAlias, tySink, tyOwned}) if t.kind == tyRef: @@ -459,8 +482,7 @@ proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = # multiple times as long as they don't have closures. result.typ.flags.incl tfHasOwned if t.kind != tyObject: - return localErrorNode(c, result, - "object constructor needs an object type".dup(addDeclaredLoc(c.config, t))) + return newError(c.config, result, reportTyp(rsemExpectedObjectType, t)) # Check if the object is fully initialized by recursively testing each # field (if this is a case object, initialized fields in two different @@ -476,9 +498,10 @@ proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = # It's possible that the object was not fully initialized while # specifying a .requiresInit. pragma: if missedFields: - localError(c.config, result.info, - "The $1 type requires the following fields to be initialized: $2." % - [t.sym.name.s, listSymbolNames(constrCtx.missingFields)]) + localReport(c.config, result.info, reportSymbols( + rsemObjectRequiresFieldInit, + constrCtx.missingFields, + typ = t)) if constructionError: result = constrCtx.initExpr @@ -506,22 +529,26 @@ proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = invalidObjConstr(c, field) # XXX: shouldn't report errors here, since creating and reporting split # need to cascade an nkError instead - localError(c.config, e.info, errorToString(c.config, e)) + localReport(c.config, e) hasError = true continue - + let id = considerQuotedIdent(c, field[0]) # This node was not processed. There are two possible reasons: # 1) It was shadowed by a field with the same name on the left for j in 1..= 0 and c.locals[s].stride != nil: - localError(c.graph.config, n.info, "invalid usage of counter after increment") + localReport( + c.graph.config, n, reportSem rsemParallelCounterAfterIncrement) + else: - for i in 0.. " & ?b) + localReport(c.graph.config, a.info, reportStr( + rsemParallelWarnCanProve, "can prove: " & ?a & " > " & ?b)) proc checkBounds(c: AnalysisCtx; arr, idx: PNode) = checkLe(c, lowBound(c.graph.config, arr), idx) @@ -164,20 +172,29 @@ proc overlap(m: TModel; conf: ConfigRef; x,y,c,d: PNode) = case proveLe(m, x, d) of impNo: discard of impUnknown, impYes: - message(conf, x.info, warnStaticIndexCheck, - "cannot prove: $# > $#; required for ($#)..($#) disjoint from ($#)..($#)" % - [?c, ?y, ?x, ?y, ?c, ?d]) + localReport(conf, x.info, reportStr( + rsemParallelWarnCannotProve, + "cannot prove: $# > $#; required for ($#)..($#) disjoint from ($#)..($#)" % [ + ?c, ?y, ?x, ?y, ?c, ?d])) + of impYes: case proveLe(m, x, d) of impUnknown: - message(conf, x.info, warnStaticIndexCheck, - "cannot prove: $# > $#; required for ($#)..($#) disjoint from ($#)..($#)" % - [?x, ?d, ?x, ?y, ?c, ?d]) + localReport(conf, x.info, reportStr( + rsemParallelWarnCannotProve, + "cannot prove: $# > $#; required for ($#)..($#) disjoint from ($#)..($#)" % [ + ?x, ?d, ?x, ?y, ?c, ?d])) + of impYes: - message(conf, x.info, warnStaticIndexCheck, "($#)..($#) not disjoint from ($#)..($#)" % - [?c, ?y, ?x, ?y, ?c, ?d]) - of impNo: discard - of impNo: discard + localReport(conf, x.info, reportStr( + rsemParallelWarnNotDisjoint, + "($#)..($#) not disjoint from ($#)..($#)" % [?c, ?y, ?x, ?y, ?c, ?d])) + + of impNo: + discard + + of impNo: + discard proc stride(c: AnalysisCtx; n: PNode): BiggestInt = if isLocal(n): @@ -247,11 +264,15 @@ proc checkSlicesAreDisjoint(c: var AnalysisCtx) = if k < stride and m < stride: discard else: - localError(c.graph.config, x.x.info, "cannot prove ($#)..($#) disjoint from ($#)..($#)" % - [?x.a, ?x.b, ?y.a, ?y.b]) + localReport(c.graph.config, x.x.info, reportStr( + rsemParallelCannotProveDisjoint, + "cannot prove ($#)..($#) disjoint from ($#)..($#)" % [ + ?x.a, ?x.b, ?y.a, ?y.b])) else: - localError(c.graph.config, x.x.info, "cannot prove ($#)..($#) disjoint from ($#)..($#)" % - [?x.a, ?x.b, ?y.a, ?y.b]) + localReport(c.graph.config, x.x.info, reportStr( + rsemParallelCannotProveDisjoint, + "cannot prove ($#)..($#) disjoint from ($#)..($#)" % [ + ?x.a, ?x.b, ?y.a, ?y.b])) proc analyse(c: var AnalysisCtx; n: PNode) @@ -352,7 +373,7 @@ proc analyse(c: var AnalysisCtx; n: PNode) = c.addSlice(n, n[0], n[1], n[1]) analyseSons(c, n) of nkReturnStmt, nkRaiseStmt, nkTryStmt, nkHiddenTryStmt: - localError(c.graph.config, n.info, "invalid control flow for 'parallel'") + localReport(c.graph.config, n, reportSem rsemParallelInvalidControlFlow) # 'break' that leaves the 'parallel' section is not valid either # or maybe we should generate a 'try' XXX of nkVarSection, nkLetSection: @@ -367,9 +388,15 @@ proc analyse(c: var AnalysisCtx; n: PNode) = for j in 0.. MaxLockLevel.TLockLevel: - localError(a.config, x.info, "invalid lock level: " & $thisLL) + localReport(a.config, x.info, reportStr( + rsemLocksPragmaBadLevel, $thisLL)) + elif firstLL < 0.TLockLevel: firstLL = thisLL elif firstLL != thisLL: - localError(a.config, x.info, - "multi-lock requires the same static lock level for every operand") + localReport(a.config, x.info, SemReport(kind: rsemMultilockRequiresSameLevel)) a.maxLockLevel = max(a.maxLockLevel, firstLL) a.locked.add x if firstLL >= 0.TLockLevel and firstLL != a.currLockLevel: if a.currLockLevel > 0.TLockLevel and a.currLockLevel <= firstLL: - localError(a.config, pragma.info, "invalid nested locking") + localReport(a.config, pragma.info, SemReport(kind: rsemInvalidNestedLocking)) a.currLockLevel = firstLL proc guardGlobal(a: PEffects; n: PNode; guard: PSym) = @@ -142,7 +143,8 @@ proc guardGlobal(a: PEffects; n: PNode; guard: PSym) = # message(a.config, n.info, warnUnguardedAccess, renderTree(n)) #else: if not a.isTopLevel: - localError(a.config, n.info, "unguarded access: " & renderTree(n)) + localReport( + a.config, n.info, reportAst(rsemUnguardedAccess, n)) # 'guard*' are checks which are concerned with 'guard' annotations # (var x{.guard: y.}: int) @@ -165,7 +167,7 @@ proc guardDotAccess(a: PEffects; n: PNode) = if ty == nil: break ty = ty.skipTypes(skipPtrs) if field == nil: - localError(a.config, n.info, "invalid guard field: " & g.name.s) + localReport(a.config, n.info, reportSym(rsemInvalidGuardField, g)) return g = field #ri.sym.guard = field @@ -178,7 +180,9 @@ proc guardDotAccess(a: PEffects; n: PNode) = for L in a.locked: #if a.guards.sameSubexprs(dot, L): return if guards.sameTree(dot, L): return - localError(a.config, n.info, "unguarded access: " & renderTree(n)) + localReport( + a.config, n.info, reportAst(rsemUnguardedAccess, n)) + else: guardGlobal(a, n, g) @@ -206,8 +210,7 @@ proc initVarViaNew(a: PEffects, n: PNode) = makeVolatile(a, s) proc warnAboutGcUnsafe(n: PNode; conf: ConfigRef) = - #assert false - message(conf, n.info, warnGcUnsafe, renderTree(n)) + localReport(conf, n.info, reportAst(rsemWarnGcUnsafe, n)) proc markGcUnsafe(a: PEffects; reason: PSym) = if not a.inEnforcedGcSafe: @@ -240,62 +243,97 @@ proc markSideEffect(a: PEffects; reason: PNode | PSym; useLoc: TLineInfo) = a.c.sideEffects.mgetOrPut(a.owner.id, @[]).add (useLoc, sym) when false: markGcUnsafe(a, reason) -proc listGcUnsafety(s: PSym; onlyWarning: bool; cycleCheck: var IntSet; conf: ConfigRef) = - let u = s.gcUnsafetyReason - if u != nil and not cycleCheck.containsOrIncl(u.id): - let msgKind = if onlyWarning: warnGcUnsafe2 else: errGenerated - case u.kind - of skLet, skVar: - if u.typ.skipTypes(abstractInst).kind == tyProc: - message(conf, s.info, msgKind, - "'$#' is not GC-safe as it calls '$#'" % - [s.name.s, u.name.s]) +proc listGcUnsafety( + s: PSym; onlyWarning: bool; cycleCheck: var IntSet; conf: ConfigRef) = + proc aux( + s: PSym, + onlyWarning: bool, + cycleCheck: var IntSet, + conf: ConfigRef, + ) = + + let u = s.gcUnsafetyReason + if u != nil and not cycleCheck.containsOrIncl(u.id): + var reason: SemGcUnsafetyKind + case u.kind + of skLet, skVar: + if u.typ.skipTypes(abstractInst).kind == tyProc: + reason = sgcuCallsUnsafe + + else: + reason = sgcuAccessesGcGlobal + + of routineKinds: + # recursive call *always* produces only a warning so the full error + # message is printed: + aux(u, true, cycleCheck, conf) + reason = sgcuCallsUnsafe + of skParam, skForVar: + reason = sgcuIndirectCallVia + else: - message(conf, s.info, msgKind, - ("'$#' is not GC-safe as it accesses '$#'" & - " which is a global using GC'ed memory") % [s.name.s, u.name.s]) - of routineKinds: - # recursive call *always* produces only a warning so the full error - # message is printed: - listGcUnsafety(u, true, cycleCheck, conf) - message(conf, s.info, msgKind, - "'$#' is not GC-safe as it calls '$#'" % - [s.name.s, u.name.s]) - of skParam, skForVar: - message(conf, s.info, msgKind, - "'$#' is not GC-safe as it performs an indirect call via '$#'" % - [s.name.s, u.name.s]) - else: - message(conf, u.info, msgKind, - "'$#' is not GC-safe as it performs an indirect call here" % s.name.s) + reason = sgcuIndirectCallHere + + + var report = reportSem(tern( + onlyWarning, + rsemWarnGcUnsafeListing, + rsemErrGcUnsafeListing)) + + report.gcUnsafeTrace = ( + isUnsafe: s, + unsafeVia: u, + unsafeRelation: reason + ) + + conf.localReport( + tern(reason == sgcuIndirectCallHere, u.info, s.info), + report) + + aux(s, onlyWarning, cycleCheck, conf) proc listGcUnsafety(s: PSym; onlyWarning: bool; conf: ConfigRef) = var cycleCheck = initIntSet() listGcUnsafety(s, onlyWarning, cycleCheck, conf) -proc listSideEffects(result: var string; s: PSym; cycleCheck: var IntSet; - conf: ConfigRef; context: PContext; indentLevel: int) = - template addHint(msg; lineInfo; sym; level = indentLevel) = - result.addf("$# $# Hint: '$#' $#\n", repeat(">", level), conf $ lineInfo, sym, msg) +proc listSideEffects( + result: var SemReport, + s: PSym, + cycleCheck: var IntSet, + conf: ConfigRef, + context: PContext, + level: int + ) = + if context.sideEffects.hasKey(s.id): for (useLineInfo, u) in context.sideEffects[s.id]: if u != nil and not cycleCheck.containsOrIncl(u.id): + var trace: SemSideEffectCallKind case u.kind of skLet, skVar: - addHint("accesses global state '$#'" % u.name.s, useLineInfo, s.name.s) - addHint("accessed by '$#'" % s.name.s, u.info, u.name.s, indentLevel + 1) + trace = ssefUsesGlobalState of routineKinds: - addHint("calls `.sideEffect` '$#'" % u.name.s, useLineInfo, s.name.s) - addHint("called by '$#'" % s.name.s, u.info, u.name.s, indentLevel + 1) - listSideEffects(result, u, cycleCheck, conf, context, indentLevel + 2) + trace = ssefCallsSideEffect of skParam, skForVar: - addHint("calls routine via hidden pointer indirection", useLineInfo, s.name.s) + trace = ssefCallsViaHiddenIndirection else: - addHint("calls routine via pointer indirection", useLineInfo, s.name.s) + trace = ssefCallsViaIndirection + + result.sideEffectTrace.add(( + isUnsafe: s, + unsafeVia: u, + trace: trace, + location: useLineInfo, + level: level + )) -proc listSideEffects(result: var string; s: PSym; conf: ConfigRef; context: PContext) = + if u.kind in routineKinds: + listSideEffects(result, u, cycleCheck, conf, context, level + 1) + + +proc listSideEffects(result: var SemReport; s: PSym; conf: ConfigRef; context: PContext) = var cycleCheck = initIntSet() - result.addf("'$#' can have side effects\n", s.name.s) + result.sym = s listSideEffects(result, s, cycleCheck, conf, context, 1) proc useVarNoInitCheck(a: PEffects; n: PNode; s: PSym) = @@ -321,9 +359,9 @@ proc useVar(a: PEffects, n: PNode) = a.init.add s.id elif s.id notin a.init: if s.typ.requiresInit: - message(a.config, n.info, warnProveInit, s.name.s) + localReport(a.config, n.info, reportSym(rsemProveInit, s)) elif a.leftPartOfAsgn <= 0: - message(a.config, n.info, warnUninit, s.name.s) + localReport(a.config, n.info, reportSym(rsemUninit, s)) # prevent superfluous warnings about the same variable: a.init.add s.id useVarNoInitCheck(a, n, s) @@ -399,8 +437,16 @@ proc mergeTags(a: PEffects, b, comesFrom: PNode) = for effect in items(b): addTag(a, effect, comesFrom) proc listEffects(a: PEffects) = - for e in items(a.exc): message(a.config, e.info, hintUser, typeToString(e.typ)) - for e in items(a.tags): message(a.config, e.info, hintUser, typeToString(e.typ)) + var report = reportSem(rsemEffectsListingHint) + for e in items(a.exc): + report.effectListing.exceptions.add e.typ + + for e in items(a.tags): + report.effectListing.tags.add e.typ + + a.config.localReport(report) + + #if a.maxLockLevel != 0: # message(e.info, hintUser, "lockLevel: " & a.maxLockLevel) @@ -528,9 +574,11 @@ proc mergeLockLevels(tracked: PEffects, n: PNode, lockLevel: TLockLevel) = if lockLevel >= tracked.currLockLevel: # if in lock section: if tracked.currLockLevel > 0.TLockLevel: - localError tracked.config, n.info, errGenerated, - "expected lock level < " & $tracked.currLockLevel & - " but got lock level " & $lockLevel + localReport(tracked.config, n.info, + SemReport( + kind: rsemLockLevelMismatch, + lockMismatch: ($tracked.currLockLevel, $lockLevel))) + tracked.maxLockLevel = max(tracked.maxLockLevel, lockLevel) proc propagateEffects(tracked: PEffects, n: PNode, s: PSym) = @@ -542,17 +590,20 @@ proc propagateEffects(tracked: PEffects, n: PNode, s: PSym) = mergeTags(tracked, tagSpec, n) if notGcSafe(s.typ) and sfImportc notin s.flags: - if tracked.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n, tracked.config) + warnAboutGcUnsafe(n, tracked.config) markGcUnsafe(tracked, s) + if tfNoSideEffect notin s.typ.flags: markSideEffect(tracked, s, n.info) mergeLockLevels(tracked, n, s.getLockLevel) proc procVarCheck(n: PNode; conf: ConfigRef) = if n.kind in nkSymChoices: - for x in n: procVarCheck(x, conf) + for x in n: + procVarCheck(x, conf) + elif n.kind == nkSym and n.sym.magic != mNone and n.sym.kind in routineKinds: - localError(conf, n.info, "'$1' cannot be passed to a procvar" % n.sym.name.s) + localReport(conf, n.info, reportSym(rsemCantPassProcvar, n.sym)) proc notNilCheck(tracked: PEffects, n: PNode, paramType: PType) = let n = n.skipConv @@ -575,12 +626,13 @@ proc notNilCheck(tracked: PEffects, n: PNode, paramType: PType) = return case impliesNotNil(tracked.guards, n) of impUnknown: - message(tracked.config, n.info, errGenerated, - "cannot prove '$1' is not nil" % n.renderTree) + localReport(tracked.config, n.info, reportAst(rsemCannotProveNotNil, n)) + of impNo: - message(tracked.config, n.info, errGenerated, - "'$1' is provably nil" % n.renderTree) - of impYes: discard + localReport(tracked.config, n.info, reportAst(rsemProvablyNil, n)) + + of impYes: + discard proc assumeTheWorst(tracked: PEffects; n: PNode; op: PType) = addRaiseEffect(tracked, createRaise(tracked.graph, n), nil) @@ -610,13 +662,18 @@ proc isTrival(caller: PNode): bool {.inline.} = proc trackOperandForIndirectCall(tracked: PEffects, n: PNode, formals: PType; argIndex: int; caller: PNode) = let a = skipConvCastAndClosure(n) let op = a.typ - let param = if formals != nil and argIndex < formals.len and formals.n != nil: formals.n[argIndex].sym else: nil + let param = + if formals != nil and argIndex < formals.len and formals.n != nil: + formals.n[argIndex].sym + else: + nil + # assume indirect calls are taken here: if op != nil and op.kind == tyProc and n.skipConv.kind != nkNilLit and not isTrival(caller) and ((param != nil and sfEffectsDelayed in param.flags) or strictEffects notin tracked.c.features): - internalAssert tracked.config, op.n[0].kind == nkEffectList + internalAssert(tracked.config, op.n[0].kind == nkEffectList, "Expected effect list node kind") var effectList = op.n[0] var s = n.skipConv if s.kind == nkCast and s[1].typ.kind == tyProc: @@ -633,7 +690,7 @@ proc trackOperandForIndirectCall(tracked: PEffects, n: PNode, formals: PType; ar assumeTheWorst(tracked, n, op) # assume GcUnsafe unless in its type; 'forward' does not matter: if notGcSafe(op) and not isOwnedProcVar(tracked, a): - if tracked.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n, tracked.config) + warnAboutGcUnsafe(n, tracked.config) markGcUnsafe(tracked, a) elif tfNoSideEffect notin op.flags and not isOwnedProcVar(tracked, a): markSideEffect(tracked, a, n.info) @@ -641,8 +698,9 @@ proc trackOperandForIndirectCall(tracked: PEffects, n: PNode, formals: PType; ar mergeRaises(tracked, effectList[exceptionEffects], n) mergeTags(tracked, effectList[tagEffects], n) if notGcSafe(op): - if tracked.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n, tracked.config) + warnAboutGcUnsafe(n, tracked.config) markGcUnsafe(tracked, a) + elif tfNoSideEffect notin op.flags: markSideEffect(tracked, a, n.info) let paramType = if formals != nil and argIndex < formals.len: formals[argIndex] else: nil @@ -655,7 +713,7 @@ proc trackOperandForIndirectCall(tracked: PEffects, n: PNode, formals: PType; ar # XXX figure out why this can be a non tyProc here. See httpclient.nim for an # example that triggers it. if argtype.kind == tyProc and notGcSafe(argtype) and not tracked.inEnforcedGcSafe: - localError(tracked.config, n.info, $n & " is not GC safe") + localReport(tracked.config, n.info, reportAst(rsemErrGcUnsafe, n)) notNilCheck(tracked, n, paramType) proc breaksBlock(n: PNode): bool = @@ -675,7 +733,7 @@ proc trackCase(tracked: PEffects, n: PNode) = let stringCase = n[0].typ != nil and skipTypes(n[0].typ, abstractVarRange-{tyTypeDesc}).kind in {tyFloat..tyFloat128, tyString} let interesting = not stringCase and interestingCaseExpr(n[0]) and - tracked.config.hasWarn(warnProveField) + tracked.config.hasWarn(rsemProveField) var inter: TIntersection = @[] var toCover = 0 for i in 1.. " & $b) + localReport( + c.config, a.info, + SemReport( + kind: rsemDrnimCannotPorveGe, + drnimExpressions: (a, b))) proc checkBounds(c: PEffects; arr, idx: PNode) = checkLe(c, lowBound(c.config, arr), idx) @@ -789,32 +854,14 @@ proc checkRange(c: PEffects; value: PNode; typ: PType) = checkLe(c, lowBound, value) checkLe(c, value, highBound) -#[ -proc passedToEffectsDelayedParam(tracked: PEffects; n: PNode) = - let t = n.typ.skipTypes(abstractInst) - if t.kind == tyProc: - if n.kind == nkSym and tracked.owner == n.sym.owner and sfEffectsDelayed in n.sym.flags: - discard "the arg is itself a delayed parameter, so do nothing" - else: - var effectList = t.n[0] - if effectList.len == effectListLen: - mergeRaises(tracked, effectList[exceptionEffects], n) - mergeTags(tracked, effectList[tagEffects], n) - if not importedFromC(n): - if notGcSafe(t): - if tracked.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n, tracked.config) - markGcUnsafe(tracked, n) - if tfNoSideEffect notin t.flags: - markSideEffect(tracked, n, n.info) -]# - proc trackCall(tracked: PEffects; n: PNode) = template gcsafeAndSideeffectCheck() = if notGcSafe(op) and not importedFromC(a): # and it's not a recursive call: if not (a.kind == nkSym and a.sym == tracked.owner): - if tracked.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n, tracked.config) + warnAboutGcUnsafe(n, tracked.config) markGcUnsafe(tracked, a) + if tfNoSideEffect notin op.flags and not importedFromC(a): # and it's not a recursive call: if not (a.kind == nkSym and a.sym == tracked.owner): @@ -869,7 +916,7 @@ proc trackCall(tracked: PEffects; n: PNode) = # var s: seq[notnil]; newSeq(s, 0) is a special case! discard else: - message(tracked.config, arg.info, warnProveInit, $arg) + localReport(tracked.config, arg.info, reportAst(rsemProveInit, arg)) # check required for 'nim check': if n[1].typ.len > 0: @@ -970,10 +1017,11 @@ proc castBlock(tracked: PEffects, pragma: PNode, bc: var PragmaBlockContext) = of wUncheckedAssign: discard "handled in sempass1" else: - localError(tracked.config, pragma.info, - "invalid pragma block: " & $pragma) + localReport(tracked.config, pragma.info, reportAst( + rsemInvalidPragmaBlock, pragma)) proc trackInnerProc(tracked: PEffects, n: PNode) = + addInNimDebugUtils(tracked.config, "trackInnerProc") case n.kind of nkSym: let s = n.sym @@ -1002,6 +1050,7 @@ proc allowCStringConv(n: PNode): bool = else: result = isCharArrayPtr(n.typ, false) proc track(tracked: PEffects, n: PNode) = + addInNimDebugUtils(tracked.config, "track") case n.kind of nkSym: useVar(tracked, n) @@ -1034,7 +1083,7 @@ proc track(tracked: PEffects, n: PNode) = for i in 0.. 0: rr = rr.lastSon - message(g.config, r.info, if emitWarnings: warnEffect else: errGenerated, - renderTree(rr) & " " & msg & typeToString(r.typ)) + while rr.kind in {nkStmtList, nkStmtListExpr} and rr.len > 0: + rr = rr.lastSon + + localReport(g.config, r.info, reportAst( + onFail, rr, typ = r.typ)) + popInfoContext(g.config) # hint about unnecessarily listed exception types: if hints: for s in 0.. disp.typ.lockLevel: when true: - message(g.config, branch.info, warnLockLevel, - "base method has lock level $1, but dispatcher has $2" % - [$branch.typ.lockLevel, $disp.typ.lockLevel]) + localReport(g.config, branch.info, reportSymbols( + rsemOverrideLockMismatch, @[disp, branch])) + else: # XXX make this an error after bigbreak has been released: - localError(g.config, branch.info, + localReport(g.config, branch.info, "base method has lock level $1, but dispatcher has $2" % [$branch.typ.lockLevel, $disp.typ.lockLevel]) @@ -1330,7 +1402,8 @@ proc setEffectsForProcType*(g: ModuleGraph; t: PType, n: PNode; s: PSym = nil) = var effects = t.n[0] if t.kind != tyProc or effects.kind != nkEffectList: return if n.kind != nkEmpty: - internalAssert g.config, effects.len == 0 + internalAssert(g.config, effects.len == 0, "Starting effects list must be empty") + newSeq(effects.sons, effectListLen) let raisesSpec = effectSpec(n, wRaises) if not isNil(raisesSpec): @@ -1390,6 +1463,7 @@ proc hasRealBody(s: PSym): bool = result = {sfForward, sfImportc} * s.flags == {} proc trackProc*(c: PContext; s: PSym, body: PNode) = + addInNimDebugUtils(c.config, "trackProc") let g = c.graph var effects = s.typ.n[0] if effects.kind != nkEffectList: return @@ -1423,11 +1497,11 @@ proc trackProc*(c: PContext; s: PSym, body: PNode) = s.kind in {skProc, skFunc, skConverter, skMethod}: var res = s.ast[resultPos].sym # get result symbol if res.id notin t.init: - message(g.config, body.info, warnProveInit, "result") + localReport(g.config, body.info, reportSym(rsemProveInit, res)) let p = s.ast[pragmasPos] let raisesSpec = effectSpec(p, wRaises) if not isNil(raisesSpec): - checkRaisesSpec(g, false, raisesSpec, t.exc, "can raise an unlisted exception: ", + checkRaisesSpec(g, rsemUnlistedRaises, raisesSpec, t.exc, hints=on, subtypeRelation, hintsArg=s.ast[0]) # after the check, use the formal spec: effects[exceptionEffects] = raisesSpec @@ -1436,7 +1510,7 @@ proc trackProc*(c: PContext; s: PSym, body: PNode) = let tagsSpec = effectSpec(p, wTags) if not isNil(tagsSpec): - checkRaisesSpec(g, false, tagsSpec, t.tags, "can have an unlisted effect: ", + checkRaisesSpec(g, rsemUnlistedEffects, tagsSpec, t.tags, hints=off, subtypeRelation) # after the check, use the formal spec: effects[tagEffects] = tagsSpec @@ -1466,23 +1540,39 @@ proc trackProc*(c: PContext; s: PSym, body: PNode) = if sfThread in s.flags and t.gcUnsafe: if optThreads in g.config.globalOptions and optThreadAnalysis in g.config.globalOptions: - #localError(s.info, "'$1' is not GC-safe" % s.name.s) + #localReport(s.info, "'$1' is not GC-safe" % s.name.s) listGcUnsafety(s, onlyWarning=false, g.config) else: listGcUnsafety(s, onlyWarning=true, g.config) - #localError(s.info, warnGcUnsafe2, s.name.s) + #localReport(s.info, warnGcUnsafe2, s.name.s) if sfNoSideEffect in s.flags and t.hasSideEffect: when false: listGcUnsafety(s, onlyWarning=false, g.config) else: if hasMutationSideEffect: - localError(g.config, s.info, "'$1' can have side effects$2" % [s.name.s, g.config $ mutationInfo]) - elif c.compilesContextId == 0: # don't render extended diagnostic messages in `system.compiles` context - var msg = "" - listSideEffects(msg, s, g.config, t.c) - message(g.config, s.info, errGenerated, msg) + var report = reportSym(rsemHasSideEffects, s) + + report.sideEffectTrace.add(( + isUnsafe: s, + unsafeVia: mutationInfo.param, + trace: ssefParameterMutation, + location: mutationInfo.mutatedHere, + level: 0 + )) + + report.sideEffectMutateConnection = mutationInfo.connectedVia + + localReport(g.config, s.info, report) + elif c.compilesContextId == 0: + # don't render extended diagnostic messages in `system.compiles` context + var report = reportSem(rsemHasSideEffects) + listSideEffects(report, s, g.config, t.c) + localReport(g.config, s.info, report) + else: - localError(g.config, s.info, "") # simple error for `system.compiles` context + # simple error for `system.compiles` context + localReport(g.config, s.info, reportSem(rsemCompilesError)) + if not t.gcUnsafe: s.typ.flags.incl tfGcSafe if not t.hasSideEffect and sfSideEffect notin s.flags: @@ -1490,10 +1580,10 @@ proc trackProc*(c: PContext; s: PSym, body: PNode) = if s.typ.lockLevel == UnspecifiedLockLevel: s.typ.lockLevel = t.maxLockLevel elif t.maxLockLevel > s.typ.lockLevel: - #localError(s.info, - message(g.config, s.info, warnLockLevel, - "declared lock level is $1, but real lock level is $2" % - [$s.typ.lockLevel, $t.maxLockLevel]) + localReport(g.config, s.info, SemReport( + kind: rsemLockLevelMismatch, + lockMismatch: ($s.typ.lockLevel, $t.maxLockLevel))) + when defined(drnim): if c.graph.strongSemCheck != nil: c.graph.strongSemCheck(c.graph, s, body) when defined(useDfa): @@ -1502,8 +1592,16 @@ proc trackProc*(c: PContext; s: PSym, body: PNode) = when false: trackWrites(s, body) if strictNotNil in c.features and s.kind == skProc: + # HACK I don't know why there are two different configurations anyway, + # but without mixing in `c.features` `checkNil` cannot know if nil + # reports are enabled or not. + let oldFeatures = g.config.features + g.config.features = c.features + g.config.features + checkNil(s, body, g.config, c.idgen) + g.config.features = oldFeatures + proc trackStmt*(c: PContext; module: PSym; n: PNode, isTopLevel: bool) = if n.kind in {nkPragma, nkMacroDef, nkTemplateDef, nkProcDef, nkFuncDef, nkTypeSection, nkConverterDef, nkMethodDef, nkIteratorDef}: diff --git a/compiler/semstmts.nim b/compiler/semstmts.nim index d92bc8f3ece..a0c0a0d4c1a 100644 --- a/compiler/semstmts.nim +++ b/compiler/semstmts.nim @@ -10,33 +10,6 @@ ## this module does the semantic checking of statements # included from sem.nim -const - errNoSymbolToBorrowFromFound = "no symbol to borrow from found" - errDiscardValueX = "value of type '$1' has to be used (or discarded)" - errInvalidDiscard = "statement returns no value that can be discarded" - errInvalidControlFlowX = "invalid control flow: $1" - errSelectorMustBeOfCertainTypes = "selector must be of an ordinal type, float, or string" - errExprCannotBeRaised = "only a 'ref object' can be raised" - errBreakOnlyInLoop = "'break' only allowed in loop construct" - errExceptionAlreadyHandled = "exception already handled" - errYieldNotAllowedHere = "'yield' only allowed in an iterator" - errYieldNotAllowedInTryStmt = "'yield' cannot be used within 'try' in a non-inlined iterator" - errInvalidNumberOfYieldExpr = "invalid number of 'yield' expressions" - errCannotReturnExpr = "current routine cannot return an expression" - errGenericLambdaNotAllowed = "A nested proc can have generic parameters only when " & - "it is used as an operand to another routine and the types " & - "of the generic paramers can be inferred from the expected signature." - errCannotInferTypeOfTheLiteral = "cannot infer the type of the $1" - errCannotInferReturnType = "cannot infer the return type of '$1'" - errCannotInferStaticParam = "cannot infer the value of the static param '$1'" - errProcHasNoConcreteType = "'$1' doesn't have a concrete type, due to unspecified generic parameters." - errLetNeedsInit = "'let' symbol requires an initialization" - errThreadvarCannotInit = "a thread var cannot be initialized explicitly; this would only run for the main thread" - errImplOfXexpected = "implementation of '$1' expected" - errRecursiveDependencyX = "recursive dependency: '$1'" - errRecursiveDependencyIteratorX = "recursion is not supported in iterators: '$1'" - errPragmaOnlyInHeaderOfProcX = "pragmas are only allowed in the header of a proc; redefinition of $1" - proc semDiscard(c: PContext, n: PNode): PNode = result = n checkSonsLen(n, 1, c.config) @@ -45,10 +18,10 @@ proc semDiscard(c: PContext, n: PNode): PNode = let sonType = n[0].typ let sonKind = n[0].kind if isEmptyType(sonType) or sonType.kind in {tyNone, tyTypeDesc} or sonKind == nkTypeOfExpr: - localError(c.config, n.info, errInvalidDiscard) + localReport(c.config, n, reportSem rsemDiscardingVoid) if sonType.kind == tyProc and sonKind notin nkCallKinds: # tyProc is disallowed to prevent ``discard foo`` to be valid, when ``discard foo()`` is meant. - localError(c.config, n.info, "illegal discard proc, did you mean: " & $n[0] & "()") + localReport(c.config, n, reportSem rsemDiscardingProc) proc semBreakOrContinue(c: PContext, n: PNode): PNode = result = n @@ -56,10 +29,12 @@ proc semBreakOrContinue(c: PContext, n: PNode): PNode = if n[0].kind != nkEmpty: if n.kind != nkContinueStmt: var s: PSym - case n[0].kind - of nkIdent: s = lookUp(c, n[0]) - of nkSym: s = n[0].sym - else: illFormedAst(n, c.config) + case n[0].kind: + of nkIdent: s = lookUp(c, n[0]) + of nkSym: s = n[0].sym + else: + semReportIllformedAst(c.config, n, {nkIdent, nkSym}) + s = getGenSym(c, s) if s.kind == skLabel and s.owner.id == c.p.owner.id: var x = newSymNode(s) @@ -69,12 +44,14 @@ proc semBreakOrContinue(c: PContext, n: PNode): PNode = suggestSym(c.graph, x.info, s, c.graph.usageSym) onUse(x.info, s) else: - localError(c.config, n.info, errInvalidControlFlowX % s.name.s) + localReport(c.config, n.info, reportSym(rsemInvalidControlFlow, s)) + else: - localError(c.config, n.info, errGenerated, "'continue' cannot have a label") - elif (c.p.nestedLoopCounter <= 0) and ((c.p.nestedBlockCounter <= 0) or n.kind == nkContinueStmt): - localError(c.config, n.info, errInvalidControlFlowX % - renderTree(n, {renderNoComments})) + localReport(c.config, n, reportSem rsemContinueCannotHaveLabel) + elif (c.p.nestedLoopCounter <= 0) and + ((c.p.nestedBlockCounter <= 0) or n.kind == nkContinueStmt): + + localReport(c.config, n, reportSem rsemInvalidControlFlow) proc semAsm(c: PContext, n: PNode): PNode = checkSonsLen(n, 2, c.config) @@ -112,20 +89,16 @@ proc semExprBranchScope(c: PContext, n: PNode): PNode = proc fixNilType(c: PContext; n: PNode) = if isAtom(n): if n.kind != nkNilLit and n.typ != nil: - localError(c.config, n.info, errDiscardValueX % n.typ.typeToString) + localReport(c.config, n, reportSem rsemUseOrDiscard) elif n.kind in {nkStmtList, nkStmtListExpr}: n.transitionSonsKind(nkStmtList) - for it in n: fixNilType(c, it) + for it in n: + fixNilType(c, it) + n.typ = nil # start `discard` check related code -const - skipForDiscardable = {nkIfStmt, nkIfExpr, nkCaseStmt, nkOfBranch, - nkElse, nkStmtListExpr, nkTryStmt, nkFinally, nkExceptBranch, - nkElifBranch, nkElifExpr, nkElseExpr, nkBlockStmt, nkBlockExpr, - nkHiddenStdConv, nkHiddenDeref} - proc implicitlyDiscardable(n: PNode): bool = var n = n while n.kind in skipForDiscardable: n = n.lastSon @@ -142,17 +115,14 @@ proc discardCheck(c: PContext, result: PNode, flags: TExprFlags) = if implicitlyDiscardable(result): var n = newNodeI(nkDiscardStmt, result.info, 1) n[0] = result + elif result.typ.kind != tyError and c.config.cmd != cmdInteractive: var n = result - while n.kind in skipForDiscardable: n = n.lastSon - var s = "expression '" & $n & "' is of type '" & - result.typ.typeToString & "' and has to be used (or discarded)" - if result.info.line != n.info.line or - result.info.fileIndex != n.info.fileIndex: - s.add "; start of expression here: " & c.config$result.info - if result.typ.kind == tyProc: - s.add "; for a function call use ()" - localError(c.config, n.info, s) + while n.kind in skipForDiscardable: + n = n.lastSon + + localReport( + c.config, n.info, reportAst(rsemUseOrDiscardExpr, result)) # end `discard` check related code @@ -172,7 +142,11 @@ proc semIf(c: PContext, n: PNode; flags: TExprFlags): PNode = hasElse = true it[0] = semExprBranchScope(c, it[0]) typ = commonType(c, typ, it[0]) - else: illFormedAst(it, c.config) + else: + semReportIllformedAst( + c.config, it, + "Expected one or two subnodes for if statement, but found " & $it.len) + if isEmptyType(typ) or typ.kind in {tyNil, tyUntyped} or (not hasElse and efInTypeof notin flags): for it in n: discardCheck(c, it.lastSon, flags) @@ -196,10 +170,13 @@ proc semTry(c: PContext, n: PNode; flags: TExprFlags): PNode = if isImportedException(typ, c.config): isImported = true elif not isException(typ): - localError(c.config, typeNode.info, errExprCannotBeRaised) + localReport(c.config, typeNode.info, reportAst( + rsemCannotBeRaised, typeNode, typ = typ)) if containsOrIncl(check, typ.id): - localError(c.config, typeNode.info, errExceptionAlreadyHandled) + localReport(c.config, typeNode.info, reportTyp( + rsemExceptionAlreadyHandled, typ)) + typeNode = newNodeIT(nkType, typeNode.info, typ) isImported @@ -244,35 +221,42 @@ proc semTry(c: PContext, n: PNode; flags: TExprFlags): PNode = # cannot be followed by a ``except KeyError, ... : body`` block inc catchAllExcepts var isNative, isImported: bool - for j in 0.. 1: # if number of ``except: body`` blocks is greater than 1 # or more specific exception follows a general except block, it is invalid - localError(c.config, a.info, "Only one general except clause is allowed after more specific exceptions") + localReport(c.config, a, reportSem rsemExpectedSingleGeneralExcept) # last child of an nkExcept/nkFinally branch is a statement: a[^1] = semExprBranchScope(c, a[^1]) - if a.kind != nkFinally: typ = commonType(c, typ, a[^1]) - else: dec last + if a.kind != nkFinally: + typ = commonType(c, typ, a[^1]) + + else: + dec last + closeScope(c) if isEmptyType(typ) or typ.kind in {tyNil, tyUntyped}: discardCheck(c, n[0], flags) - for i in 1.. 3: - message(c.config, a.info, warnEachIdentIsTuple) + localReport(c.config, a.info, reportSem rsemEachIdentIsTuple) for j in 0.. 0 and not isException(typ.lastSon): - localError(c.config, n.info, "raised object of type $1 does not inherit from Exception" % typeToString(typ)) + localReport(c.config, n.info, reportTyp( + rsemCannotRaiseNonException, typ)) proc addGenericParamListToScope(c: PContext, n: PNode) = - if n.kind != nkGenericParams: illFormedAst(n, c.config) + if n.kind != nkGenericParams: + semReportIllformedAst(c.config, n, {nkGenericParams}) + for i in 0.. resultPos and n[resultPos] != nil: if n[resultPos].sym.kind != skResult: - localError(c.config, n.info, "incorrect result proc symbol") + localReport(c.config, n, reportSem rsemIncorrectResultProcSymbol) + if n[resultPos].sym.owner != getCurrOwner(c): # re-write result with new ownership, and re-write the proc accordingly let sResSym = n[resultPos].sym @@ -1530,7 +1634,7 @@ proc semProcAnnotation(c: PContext, prc: PNode; # XXX: temporarily handle nkError here, rather than proper propagation. # this should be refactored over time. if r.kind == nkError: - localError(c.config, r.info, errorToString(c.config, r)) + localReport(c.config, r) return # the rest is likely too broken, don't bother continuing doAssert r[0].kind == nkSym @@ -1552,7 +1656,7 @@ proc semProcAnnotation(c: PContext, prc: PNode; validPragmas) # check if we got any errors and if so report them for e in ifErrorWalkErrors(c.config, result[pragmasPos]): - messageError(c.config, e) + localReport(c.config, e) return @@ -1576,8 +1680,9 @@ proc semInferredLambda(c: PContext, pt: TIdTable, n: PNode): PNode {.nosinks.} = for i in 1.. 0: n.comment = proto.ast.comment @@ -1993,16 +2107,20 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if sfOverriden in s.flags or s.name.s[0] == '=': semOverride(c, s, n) elif s.name.s[0] in {'.', '('}: if s.name.s in [".", ".()", ".="] and {Feature.destructor, dotOperators} * c.features == {}: - localError(c.config, n.info, "the overloaded " & s.name.s & - " operator has to be enabled with {.experimental: \"dotOperators\".}") + localReport(c.config, n.info, reportSym( + rsemEnableDotOperatorsExperimental, s)) + elif s.name.s == "()" and callOperator notin c.features: - localError(c.config, n.info, "the overloaded " & s.name.s & - " operator has to be enabled with {.experimental: \"callOperator\".}") + localReport(c.config, n.info, reportSym( + rsemEnableCallOperatorExperimental, s)) + if n[bodyPos].kind != nkEmpty and sfError notin s.flags: # for DLL generation we allow sfImportc to have a body, for use in VM if sfBorrow in s.flags: - localError(c.config, n[bodyPos].info, errImplOfXNotAllowed % s.name.s) + localReport(c.config, n[bodyPos].info, reportSym( + rsemImplementationNotAllowed, s)) + if c.config.ideCmd in {ideSug, ideCon} and s.kind notin {skMacro, skTemplate} and not cursorInProc(c.config, n[bodyPos]): # speed up nimsuggest @@ -2018,7 +2136,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, trackProc(c, s, s.ast[bodyPos]) popProcCon(c) elif efOperand notin flags: - localError(c.config, n.info, errGenericLambdaNotAllowed) + localReport(c.config, n, reportSem rsemGenericLambdaNowAllowed) else: pushProcCon(c, s) if n[genericParamsPos].kind == nkEmpty or s.kind in {skMacro, skTemplate}: @@ -2045,12 +2163,15 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, popProcCon(c) else: if s.kind == skMethod: semMethodPrototype(c, s, n) - if hasProto: localError(c.config, n.info, errImplOfXexpected % proto.name.s) + if hasProto: + localReport(c.config, n.info, reportSym( + rsemImplementationExpected, proto)) + if {sfImportc, sfBorrow, sfError} * s.flags == {} and s.magic == mNone: # this is a forward declaration and we're building the prototype if s.kind in {skProc, skFunc} and s.typ[0] != nil and s.typ[0].kind == tyUntyped: # `auto` is represented as `tyUntyped` at this point in compilation. - localError(c.config, n[paramsPos][0].info, "return type 'auto' cannot be used in forward declarations") + localReport(c.config, n[paramsPos][0], reportSem rsemUnexpectedAutoInForwardDeclaration) incl(s.flags, sfForward) incl(s.flags, sfWasForwarded) @@ -2067,7 +2188,8 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if optOwnedRefs in c.config.globalOptions: 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") + localReport(c.config, s.info, reportSym( + rsemUnexpectedClosureOnToplevelProc, s)) proc determineType(c: PContext, s: PSym) = if s.typ != nil: return @@ -2089,7 +2211,9 @@ proc semIterator(c: PContext, n: PNode): PNode = var s = result[namePos].sym var t = s.typ if t[0] == nil and s.typ.callConv != ccClosure: - localError(c.config, n.info, "iterator needs a return type") + localReport(c.config, n.info, reportSym( + rsemExpectedReturnTypeForIterator, s)) + # iterators are either 'inline' or 'closure'; for backwards compatibility, # we require first class iterators to be marked with 'closure' explicitly # -- at least for 0.9.2. @@ -2098,7 +2222,9 @@ proc semIterator(c: PContext, n: PNode): PNode = else: s.typ.callConv = ccInline if n[bodyPos].kind == nkEmpty and s.magic == mNone and c.inConceptDecl == 0: - localError(c.config, n.info, errImplOfXexpected % s.name.s) + localReport(c.config, n.info, reportSym( + rsemImplementationExpected, s)) + if optOwnedRefs in c.config.globalOptions and result.typ != nil: result.typ = makeVarType(c, result.typ, tyOwned) result.typ.callConv = ccClosure @@ -2112,7 +2238,9 @@ proc semFunc(c: PContext, n: PNode): PNode = result = semProcAux(c, n, skFunc, validPragmas) proc semMethod(c: PContext, n: PNode): PNode = - if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "method") + if not isTopLevel(c): + localReport(c.config, n, reportSem rsemMethodRequiresToplevel) + result = semProcAux(c, n, skMethod, methodPragmas) # macros can transform converters to nothing: if namePos >= result.safeLen: return result @@ -2133,7 +2261,9 @@ proc semMethod(c: PContext, n: PNode): PNode = else: disp.ast[resultPos].sym.typ = ret proc semConverterDef(c: PContext, n: PNode): PNode = - if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "converter") + if not isTopLevel(c): + localReport(c.config, n, reportSem rsemConverterRequiresToplevel) + checkSonsLen(n, bodyPos + 1, c.config) result = semProcAux(c, n, skConverter, converterPragmas) # macros can transform converters to nothing: @@ -2144,8 +2274,14 @@ proc semConverterDef(c: PContext, n: PNode): PNode = if result.kind != nkConverterDef: return var s = result[namePos].sym var t = s.typ - if t[0] == nil: localError(c.config, n.info, errXNeedsReturnType % "converter") - if t.len != 2: localError(c.config, n.info, "a converter takes exactly one argument") + if t[0] == nil: + localReport(c.config, n.info, reportSym( + rsemExpectedReturnTypeForConverter, s)) + + if t.len != 2: + localReport(c.config, n.info, reportSym( + rsemExpectedOneArgumentForConverter, s)) + addConverterDef(c, LazySym(sym: s)) proc semMacroDef(c: PContext, n: PNode): PNode = @@ -2165,7 +2301,8 @@ proc semMacroDef(c: PContext, n: PNode): PNode = if param.typ.kind != tyUntyped: allUntyped = false if allUntyped: incl(s.flags, sfAllUntyped) if n[bodyPos].kind == nkEmpty: - localError(c.config, n.info, errImplOfXexpected % s.name.s) + localReport(c.config, n, reportSym( + rsemImplementationExpected, s)) proc incMod(c: PContext, n: PNode, it: PNode, includeStmtResult: PNode) = var f = checkModuleName(c.config, it) @@ -2173,9 +2310,13 @@ proc incMod(c: PContext, n: PNode, it: PNode, includeStmtResult: PNode) = addIncludeFileDep(c, f) onProcessing(c.graph, f, "include", c.module) if containsOrIncl(c.includedFiles, f.int): - localError(c.config, n.info, errRecursiveDependencyX % toMsgFilename(c.config, f)) + localReport(c.config, n.info, reportStr( + rsemRecursiveInclude, toMsgFilename(c.config, f))) + else: - includeStmtResult.add semStmt(c, c.graph.includeFileCallback(c.graph, c.module, f), {}) + includeStmtResult.add semStmt( + c, c.graph.includeFileCallback(c.graph, c.module, f), {}) + excl(c.includedFiles, f.int) proc evalInclude(c: PContext, n: PNode): PNode = @@ -2185,7 +2326,9 @@ proc evalInclude(c: PContext, n: PNode): PNode = var imp: PNode let it = n[i] if it.kind == nkInfix and it.len == 3 and it[0].ident.s != "/": - localError(c.config, it.info, "Cannot use '" & it[0].ident.s & "' in 'include'.") + localReport(c.config, it.info, reportAst( + rsemUnexpectedInfixInInclude, it, str = it[0].ident.s)) + if it.kind == nkInfix and it.len == 3 and it[2].kind == nkBracket: let sep = it[0] let dir = it[1] @@ -2207,17 +2350,17 @@ proc setLine(n: PNode, info: TLineInfo) = proc semPragmaBlock(c: PContext, n: PNode): PNode = checkSonsLen(n, 2, c.config) let pragmaList = pragma(c, nil, n[0], exprPragmas, isStatement = true) - + if pragmaList != nil and pragmaList.kind == nkError: n[0] = pragmaList - result = wrapErrorInSubTree(n) + result = wrapErrorInSubTree(c.config, n) return var inUncheckedAssignSection = 0 for i, p in pragmaList.pairs: if p.kind == nkError: n[0] = pragmaList - result = wrapErrorInSubTree(n) + result = wrapErrorInSubTree(c.config, n) return elif whichPragma(p) == wCast: case whichPragma(p[1]) @@ -2226,10 +2369,10 @@ proc semPragmaBlock(c: PContext, n: PNode): PNode = of wUncheckedAssign: inUncheckedAssignSection = 1 else: - let e = newError(p, "invalid pragma block: " & $p) + let e = c.config.newError(p, reportAst(rsemInvalidPragmaBlock, p)) pragmaList[i] = e n[0] = pragmaList - result = wrapErrorInSubTree(n) + result = wrapErrorInSubTree(c.config, n) return inc c.inUncheckedAssignSection, inUncheckedAssignSection @@ -2277,9 +2420,12 @@ proc inferConceptStaticParam(c: PContext, inferred, n: PNode) = var typ = inferred.typ let res = semConstExpr(c, n) if not sameType(res.typ, typ.base): - localError(c.config, n.info, - "cannot infer the concept parameter '%s', due to a type mismatch. " & - "attempt to equate '%s' and '%s'." % [inferred.renderTree, $res.typ, $typ.base]) + localReport(c.config, n.info, SemReport( + kind: rsemConceptInferenceFailed, + ast: inferred, + typeMismatch: @[c.config.typeMismatch( + actual = res.typ, formal = typ.base)])) + typ.n = res proc semStmtList(c: PContext, n: PNode, flags: TExprFlags): PNode = @@ -2317,7 +2463,8 @@ proc semStmtList(c: PContext, n: PNode, flags: TExprFlags): PNode = let verdict = semConstExpr(c, n[i]) if verdict == nil or verdict.kind != nkIntLit or verdict.intVal == 0: - localError(c.config, result.info, "concept predicate failed") + localReport(c.config, result, reportSem rsemConceptPredicateFailed) + of tyUnknown: continue else: discard if n[i].typ == c.enforceVoidContext: #or usesResult(n[i]): @@ -2337,7 +2484,9 @@ proc semStmtList(c: PContext, n: PNode, flags: TExprFlags): PNode = for j in i + 1.. MaxSetElements: - localError(c.config, n.info, errSetTooBig) + localReport(c.config, n.info, SemReport( + kind: rsemSetTooBig, + countMismatch: ( + expected: toInt128(MaxSetElements), + got: lengthOrd(c.config, base)))) + else: - localError(c.config, n.info, errXExpectsOneTypeParam % "set") + c.config.semReportParamCountMismatch(n, result, 1, n.len - 1) addSonSkipIntLit(result, errorType(c), c.idgen) proc semContainerArg(c: PContext; n: PNode, kindStr: string; result: PType) = if n.len == 2: var base = semTypeNode(c, n[1], nil) if base.kind == tyVoid: - localError(c.config, n.info, errTIsNotAConcreteType % typeToString(base)) + localReport(c.config, n.info, reportTyp( + rsemTIsNotAConcreteType, base)) + addSonSkipIntLit(result, base, c.idgen) + else: - localError(c.config, n.info, errXExpectsOneTypeParam % kindStr) + c.config.semReportParamCountMismatch(n, result, 1, n.len - 1) addSonSkipIntLit(result, errorType(c), c.idgen) proc semContainer(c: PContext, n: PNode, kind: TTypeKind, kindStr: string, @@ -202,7 +221,7 @@ proc semVarargs(c: PContext, n: PNode, prev: PType): PType = if n.len == 3: result.n = newIdentNode(considerQuotedIdent(c, n[2]), n[2].info) else: - localError(c.config, n.info, errXExpectsOneTypeParam % "varargs") + c.config.semReportParamCountMismatch(n, result, 1, n.len - 1) addSonSkipIntLit(result, errorType(c), c.idgen) proc semVarOutType(c: PContext, n: PNode, prev: PType; kind: TTypeKind): PType = @@ -212,7 +231,7 @@ proc semVarOutType(c: PContext, n: PNode, prev: PType; kind: TTypeKind): PType = if base.kind == tyTypeDesc and not isSelf(base): base = base[0] if base.kind == tyVar: - localError(c.config, n.info, "type 'var var' is not allowed") + localReport(c.config, n, reportSem(rsemVarVarNotAllowed)) base = base[0] addSonSkipIntLit(result, base, c.idgen) else: @@ -234,7 +253,7 @@ proc semRangeAux(c: PContext, n: PNode, prev: PType): PType = addSonSkipIntLit(result, errorType(c), c.idgen) if (n[1].kind == nkEmpty) or (n[2].kind == nkEmpty): - localError(c.config, n.info, "range is empty") + localReport(c.config, n, reportSem rsemRangeIsEmpty) var range: array[2, PNode] range[0] = semExprWithType(c, n[1], {efDetermineType}) @@ -253,13 +272,16 @@ proc semRangeAux(c: PContext, n: PNode, prev: PType): PType = # the for loop, etc below? let r = typeMismatch(c.config, n.info, rangeT[0], rangeT[1], n) if r.kind == nkError: - localError(c.config, n.info, errorToString(c.config, r)) + localReport(c.config, r) elif not isOrdinalType(rangeT[0]) and rangeT[0].kind notin {tyFloat..tyFloat128} or rangeT[0].kind == tyBool: - localError(c.config, n.info, "ordinal or float type expected") + + localReport(c.config, n.info, reportTyp( + rsemExpectedOrdinalOrFloat, rangeT[0])) + elif enumHasHoles(rangeT[0]): - localError(c.config, n.info, "enum '$1' has holes" % typeToString(rangeT[0])) + localReport(c.config, n.info, reportTyp(rsemExpectedUnholyEnum, rangeT[0])) for i in 0..1: if hasUnresolvedArgs(c, range[i]): @@ -270,10 +292,10 @@ proc semRangeAux(c: PContext, n: PNode, prev: PType): PType = if (result.n[0].kind in {nkFloatLit..nkFloat64Lit} and result.n[0].floatVal.isNaN) or (result.n[1].kind in {nkFloatLit..nkFloat64Lit} and result.n[1].floatVal.isNaN): - localError(c.config, n.info, "NaN is not a valid start or end for a range") + localReport(c.config, n, reportSem rsemRangeDoesNotSupportNan) if weakLeValue(result.n[0], result.n[1]) == impNo: - localError(c.config, n.info, "range is empty") + localReport(c.config, n, reportSem rsemRangeIsEmpty) result[0] = rangeT[0] @@ -295,12 +317,14 @@ proc semRange(c: PContext, n: PNode, prev: PType): PType = incl(result.flags, 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") + localReport(c.config, n[0], reportSem rsemRangeRequiresDotDot) + else: - localError(c.config, n[0].info, "expected range") + localReport(c.config, n[0], reportSem rsemExpectedRange) + result = newOrPrevType(tyError, prev, c) else: - localError(c.config, n.info, errXExpectsOneTypeParam % "range") + c.config.semReportParamCountMismatch(n, nil, 1, n.len - 1, "range") result = newOrPrevType(tyError, prev, c) proc semArrayIndex(c: PContext, n: PNode): PType = @@ -312,20 +336,26 @@ proc semArrayIndex(c: PContext, n: PNode): PType = result = makeRangeWithStaticExpr(c, e.typ.n) elif e.kind in {nkIntLit..nkUInt64Lit}: if e.intVal < 0: - localError(c.config, n.info, - "Array length can't be negative, but was " & $e.intVal) + localReport(c.config, n.info, semReportCountMismatch( + rsemArrayExpectsPositiveRange, 0, e.intVal)) + result = makeRangeType(c, 0, e.intVal-1, n.info, e.typ) elif e.kind == nkSym and e.typ.kind == tyStatic: if e.sym.ast != nil: return semArrayIndex(c, e.sym.ast) if not isOrdinalType(e.typ.lastSon): let info = if n.safeLen > 1: n[1].info else: n.info - localError(c.config, info, errOrdinalTypeExpected) + localReport(c.config, info, reportTyp( + rsemExpectedOrdinal, e.typ.lastSon)) + result = makeRangeWithStaticExpr(c, e) - if c.inGenericContext > 0: result.flags.incl tfUnresolved + if c.inGenericContext > 0: + result.flags.incl tfUnresolved + elif e.kind in (nkCallKinds + {nkBracketExpr}) and hasUnresolvedArgs(c, e): if not isOrdinalType(e.typ.skipTypes({tyStatic, tyAlias, tyGenericInst, tySink})): - localError(c.config, n[1].info, errOrdinalTypeExpected) + localReport(c.config, n[1].info, reportTyp( + rsemExpectedOrdinal, e.typ)) # This is an int returning call, depending on an # yet unknown generic param (see tgenericshardcases). # We are going to construct a range type that will be @@ -341,7 +371,7 @@ proc semArrayIndex(c: PContext, n: PNode): PType = x.typ.skipTypes({tyTypeDesc})) else: result = x.typ.skipTypes({tyTypeDesc}) - #localError(c.config, n[1].info, errConstExprExpected) + #localReport(c.config, n[1].info, errConstExprExpected) proc semArray(c: PContext, n: PNode, prev: PType): PType = var base: PType @@ -354,10 +384,13 @@ proc semArray(c: PContext, n: PNode, prev: PType): PType = if indxB.skipTypes({tyRange}).kind in {tyUInt, tyUInt64}: discard elif not isOrdinalType(indxB): - localError(c.config, n[1].info, errOrdinalTypeExpected) + localReport(c.config, n[1].info, reportTyp( + rsemExpectedOrdinal, indxB)) + elif enumHasHoles(indxB): - localError(c.config, n[1].info, "enum '$1' has holes" % - typeToString(indxB.skipTypes({tyRange}))) + localReport(c.config, n[1].info, reportTyp( + rsemExpectedUnholyEnum, indxB.skipTypes({tyRange}))) + base = semTypeNode(c, n[2], nil) # ensure we only construct a tyArray when there was no error (bug #3048): result = newOrPrevType(tyArray, prev, c) @@ -366,7 +399,7 @@ proc semArray(c: PContext, n: PNode, prev: PType): PType = rawAddSonNoPropagationOfTypeFlags(result, indx) addSonSkipIntLit(result, base, c.idgen) else: - localError(c.config, n.info, errArrayExpectsTwoTypeParams) + semReportParamCountMismatch(c.config, n, prev, 2, n.len - 1, "array") result = newOrPrevType(tyError, prev, c) proc semIterableType(c: PContext, n: PNode, prev: PType): PType = @@ -375,7 +408,7 @@ proc semIterableType(c: PContext, n: PNode, prev: PType): PType = let base = semTypeNode(c, n[1], nil) addSonSkipIntLit(result, base, c.idgen) else: - localError(c.config, n.info, errXExpectsOneTypeParam % "iterable") + semReportParamCountMismatch(c.config, n, prev, 1, n.len - 1, "iterable") result = newOrPrevType(tyError, prev, c) proc semOrdinal(c: PContext, n: PNode, prev: PType): PType = @@ -384,10 +417,12 @@ proc semOrdinal(c: PContext, n: PNode, prev: PType): PType = var base = semTypeNode(c, n[1], nil) if base.kind != tyGenericParam: if not isOrdinalType(base): - localError(c.config, n[1].info, errOrdinalTypeExpected) + localReport(c.config, n[1].info, reportTyp( + rsemExpectedOrdinal, base)) + addSonSkipIntLit(result, base, c.idgen) else: - localError(c.config, n.info, errXExpectsOneTypeParam % "ordinal") + semReportParamCountMismatch(c.config, n, prev, 1, n.len - 1, "ordinal") result = newOrPrevType(tyError, prev, c) proc semTypeIdent(c: PContext, n: PNode): PSym = @@ -410,7 +445,7 @@ proc semTypeIdent(c: PContext, n: PNode): PSym = if bound != nil: return bound return result if result.typ.sym == nil: - localError(c.config, n.info, errTypeExpected) + localReport(c.config, n, reportSem rsemTypeExpected) return errorSym(c, n) result = result.typ.sym.copySym(nextSymId c.idgen) result.typ = exactReplica(result.typ) @@ -424,7 +459,7 @@ proc semTypeIdent(c: PContext, n: PNode): PSym = result.typ.flags.excl tfWildcard return else: - localError(c.config, n.info, errTypeExpected) + localReport(c.config, n, reportSem rsemTypeExpected) return errorSym(c, n) if result.kind != skType and result.magic notin {mStatic, mType, mTypeOf}: # this implements the wanted ``var v: V, x: V`` feature ... @@ -434,7 +469,9 @@ proc semTypeIdent(c: PContext, n: PNode): PSym = amb = nextOverloadIter(ov, c, n) if amb != nil: result = amb else: - if result.kind != skError: localError(c.config, n.info, errTypeExpected) + if result.kind != skError: + localReport(c.config, n, reportSem rsemTypeExpected) + return errorSym(c, n) if result.typ.kind != tyGenericParam: # XXX get rid of this hack! @@ -449,12 +486,12 @@ proc semTypeIdent(c: PContext, n: PNode): PSym = n.info = oldInfo n.typ = result.typ else: - localError(c.config, n.info, "identifier expected") + localReport(c.config, n, reportSem rsemIdentExpectedInExpr) result = errorSym(c, n) proc semAnonTuple(c: PContext, n: PNode, prev: PType): PType = if n.len == 0: - localError(c.config, n.info, errTypeExpected) + localReport(c.config, n, reportSem rsemTypeExpected) result = newOrPrevType(tyTuple, prev, c) for it in n: addSonSkipIntLit(result, semTypeNode(c, it, nil), c.idgen) @@ -467,30 +504,41 @@ proc semTuple(c: PContext, n: PNode, prev: PType): PType = var counter = 0 for i in ord(n.kind == nkBracketExpr).. 1: - result &= ", " case t.kind: - of tyEnum, tyBool: - while t.n[enumSymOffset].sym.position < val: inc(enumSymOffset) - result &= t.n[enumSymOffset].sym.name.s - of tyChar: - result.addQuoted(char(val)) - else: - if i == 64: - result &= "omitted $1 values..." % $(vals.len - i) - break + of tyEnum, tyBool: + while t.n[enumSymOffset].sym.position < val: + inc(enumSymOffset) + + result &= t.n[enumSymOffset] + + of tyChar: + result.add newIntNode(nkCharLit, BiggestInt(val)) + else: - result &= $val - inc(i) - result &= "}" + result.add newIntNode(nkIntLit, BiggestInt(val)) + + +proc toEnumFields(vals: IntSet, t: PType): seq[PSym] = + block: + let t = t.skipTypes(abstractRange) + assert(t.kind in {tyEnum, tyBool}, $t.kind) -proc formatMissingEnums(c: PContext, n: PNode): string = + for node in toLiterals(vals, t): + result.add node.sym + +proc missingInts(c: PContext, n: PNode): IntSet = var coveredCases = initIntSet() for i in 1.. 0x00007FFF: - localError(c.config, n.info, "len($1) must be less than 32768" % a[0].sym.name.s) + var rep = SemReport( + kind: rsemExpectedHighCappedDiscriminant, + countMismatch: ( + expected: toInt128(32768), + got: firstOrd(c.config, typ)), + typ: typ, + sym: a[0].sym) for i in 1.. 0: # use a new check intset here for each branch: var newCheck: IntSet @@ -791,11 +887,12 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, if father.kind != nkRecList and n.len >= 4: a = newNodeI(nkRecList, n.info) else: a = newNodeI(nkEmpty, n.info) if n[^1].kind != nkEmpty: - localError(c.config, n[^1].info, errInitHereNotAllowed) + localReport(c.config, n[^1], reportSem rsemInitHereNotAllowed) var typ: PType if n[^2].kind == nkEmpty: - localError(c.config, n.info, errTypeExpected) + localReport(c.config, n, reportSem rsemTypeExpected) typ = errorType(c) + else: typ = semTypeNode(c, n[^2], nil) propagateToOwner(rectype, typ) @@ -818,9 +915,14 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, f.flags.incl {sfImportc, sfExportc} * fieldOwner.flags inc(pos) if containsOrIncl(check, f.name.id): - localError(c.config, info, "attempt to redefine: '" & f.name.s & "'") - if a.kind == nkEmpty: father.add newSymNode(f) - else: a.add newSymNode(f) + localReport(c.config, info, reportSym(rsemRedefinitionOf, f)) + + if a.kind == nkEmpty: + father.add newSymNode(f) + + else: + a.add newSymNode(f) + styleCheckDef(c.config, f) onDef(f.info, f) if a.kind != nkEmpty: father.add a @@ -829,31 +931,38 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, # inherited from generic/partial specialized parent second check. # There is no branch validity check here if containsOrIncl(check, n.sym.name.id): - localError(c.config, n.info, "attempt to redefine: '" & n.sym.name.s & "'") + localReport(c.config, n.info, reportSym(rsemRedefinitionOf, n.sym)) + father.add n of nkEmpty: if father.kind in {nkElse, nkOfBranch}: father.add n - else: illFormedAst(n, c.config) + else: + semReportIllformedAst(c.config, n, "?") proc addInheritedFieldsAux(c: PContext, check: var IntSet, pos: var int, n: PNode) = case n.kind of nkRecCase: - if (n[0].kind != nkSym): internalError(c.config, n.info, "addInheritedFieldsAux") + if (n[0].kind != nkSym): + internalError(c.config, n.info, "addInheritedFieldsAux") + addInheritedFieldsAux(c, check, pos, n[0]) for i in 1..\nbut expected: <$2>" % [describeArgs(c, n), describeArgs(c, t.n, 0)] - localError(c.config, n.info, errGenerated, err) + localReport(c.config, n.info): + reportTyp(rsemCannotInstantiateWithParameter, t, ast = n).withIt do: + it.arguments.got = maybeResemArgs(c, n) + it.arguments.expected = maybeResemArgs(c, t.n, 0) + return newOrPrevType(tyError, prev, c) var isConcrete = true @@ -1515,7 +1652,9 @@ proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = if isConcrete: if s.ast == nil and s.typ.kind != tyCompositeTypeClass: # XXX: What kind of error is this? is it still relevant? - localError(c.config, n.info, errCannotInstantiateX % s.name.s) + localReport(c.config, n.info, reportTyp( + rsemCannotInstantiate, t)) + result = newOrPrevType(tyError, prev, c) else: result = instGenericContainer(c, n.info, result, @@ -1525,7 +1664,9 @@ proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = # generic/partial specialized parent let tx = result.skipTypes(abstractPtrs, 50) if tx.isNil or isTupleRecursive(tx): - localError(c.config, n.info, "illegal recursion in type '$1'" % typeToString(result[0])) + localReport(c.config, n.info, reportTyp( + rsemIllegalRecursion, result[0])) + return errorType(c) if tx != result and tx.kind == tyObject: if tx[0] != nil: @@ -1569,7 +1710,7 @@ proc semTypeExpr(c: PContext, n: PNode; prev: PType): PType = let alias = maybeAliasType(c, result, prev) if alias != nil: result = alias else: - localError(c.config, n.info, "expected type, but got: " & n.renderTree) + localReport(c.config, n, reportSem rsemTypeExpected) result = errorType(c) proc freshType(c: PContext; res, prev: PType): PType {.inline.} = @@ -1636,7 +1777,7 @@ proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = # see bug #8230 if dummyName.kind == nkEmpty: continue - internalAssert c.config, dummyName.kind == nkIdent + internalAssert(c.config, dummyName.kind == nkIdent, "") var dummyParam = newSym(if modifier == tyTypeDesc: skType else: skVar, dummyName.ident, nextSymId c.idgen, owner, param.info) dummyParam.typ = dummyType @@ -1677,8 +1818,9 @@ proc applyTypeSectionPragmas(c: PContext; pragmas, operand: PNode): PNode = var r = semOverloadedCall(c, x, x, {skMacro, skTemplate}, {efNoUndeclared}) if r != nil: if r.kind == nkError: - localError(c.config, r.info, errorToString(c.config, r)) + localReport(c.config, r) return + doAssert r[0].kind == nkSym let m = r[0].sym case m.kind @@ -1706,7 +1848,7 @@ proc semProcTypeWithScope(c: PContext, n: PNode, n[1] = pragma(c, s, n[1], procTypePragmas) # check if we got any errors and if so report them for e in ifErrorWalkErrors(c.config, n[1]): - messageError(c.config, e) + localReport(c.config, e) when useEffectSystem: setEffectsForProcType(c.graph, result, n[1]) elif c.optionStack.len > 0 and optNimV1Emulation notin c.config.globalOptions: # we construct a fake 'nkProcDef' for the 'mergePragmas' inside 'implicitPragmas'... @@ -1715,7 +1857,7 @@ proc semProcTypeWithScope(c: PContext, n: PNode, s = implicitPragmas(c, s, n.info, {wTags, wRaises}) # check if we got any errors and if so report them for e in ifErrorWalkErrors(c.config, s.ast): - messageError(c.config, e) + localReport(c.config, e) when useEffectSystem: setEffectsForProcType(c.graph, result, s.ast[pragmasPos]) closeScope(c) @@ -1723,7 +1865,7 @@ proc symFromExpectedTypeNode(c: PContext, n: PNode): PSym = if n.kind == nkType: result = symFromType(c, n.typ, n.info) else: - localError(c.config, n.info, errTypeExpected) + localReport(c.config, n, reportSem rsemTypeExpected) result = errorSym(c, n) proc semStaticType(c: PContext, childNode: PNode, prev: PType): PType = @@ -1745,7 +1887,7 @@ proc semTypeOf2(c: PContext; n: PNode; prev: PType): PType = if n.len == 3: let mode = semConstExpr(c, n[2]) if mode.kind != nkIntLit: - localError(c.config, n.info, "typeof: cannot evaluate 'mode' parameter at compile-time") + localReport(c.config, n, reportSem rsemVmCannotEvaluateAtComptime) else: m = mode.intVal let t = semExprWithType(c, n[1], if m == 1: {efInTypeof} else: {}) @@ -1791,7 +1933,8 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = freshType(c, result, prev) result.flags.excl(tfNotNil) else: - localError(c.config, n.info, errGenerated, "invalid type") + localReport(c.config, n, reportSem rsemTypeInvalid) + elif n[0].kind notin nkIdentKinds: result = semTypeExpr(c, n, prev) else: @@ -1802,10 +1945,10 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = t1 = semTypeNode(c, n[1], nil) t2 = semTypeNode(c, n[2], nil) if t1 == nil: - localError(c.config, n[1].info, errTypeExpected) + localReport(c.config, n[1], reportSem rsemTypeExpected) result = newOrPrevType(tyError, prev, c) elif t2 == nil: - localError(c.config, n[2].info, errTypeExpected) + localReport(c.config, n[2], reportSem rsemTypeExpected) result = newOrPrevType(tyError, prev, c) else: result = if op.id == ord(wAnd): makeAndType(c, t1, t2) @@ -1817,13 +1960,9 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = if result.kind == tyTypeDesc and tfUnresolved notin result.flags: result = result.base if n[2].kind != nkNilLit: - localError(c.config, n.info, - "Invalid syntax. When used with a type, 'not' can be followed only by 'nil'") + localReport(c.config, n, reportSem rsemMalformedNotNilType) if notnil notin c.features and strictNotNil notin c.features: - localError(c.config, n.info, - "enable the 'not nil' annotation with {.experimental: \"notnil\".} or " & - " the `strict not nil` annotation with {.experimental: \"strictNotNil\".} " & - " the \"notnil\" one is going to be deprecated, so please use \"strictNotNil\"") + localReport(c.config, n, reportSem rsemEnableNotNilExperimental) let resolvedType = result.skipTypes({tyGenericInst, tyAlias, tySink, tyOwned}) case resolvedType.kind of tyGenericParam, tyTypeDesc, tyFromExpr: @@ -1854,12 +1993,12 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = freshType(c, result, prev) result.flags.incl(tfNotNil) else: - localError(c.config, n.info, errGenerated, "invalid type") + localReport(c.config, n, reportSem rsemTypeInvalid) of 2: let negated = semTypeNode(c, n[1], prev) result = makeNotType(c, negated) else: - localError(c.config, n.info, errGenerated, "invalid type") + localReport(c.config, n, reportSem rsemTypeInvalid) elif op.id == ord(wPtr): result = semAnyRef(c, n, tyPtr, prev) elif op.id == ord(wRef): @@ -1918,7 +2057,8 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = newOrPrevType(tyVar, prev, c) var base = semTypeNode(c, n[1], nil) if base.kind in {tyVar, tyLent}: - localError(c.config, n.info, "type 'var var' is not allowed") + localReport(c.config, n.info, reportTyp(rsemVarVarNotAllowed, prev)) + base = base[0] addSonSkipIntLit(result, base, c.idgen) of mRef: result = semAnyRef(c, n, tyRef, prev) @@ -1928,13 +2068,12 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = of nkDotExpr: let typeExpr = semExpr(c, n) if typeExpr.typ.isNil: - localError(c.config, n.info, "object constructor needs an object type;" & - " for named arguments use '=' instead of ':'") + localReport(c.config, n.info, SemReport(kind: rsemExpectedObjectType)) result = errorType(c) elif typeExpr.typ.kind == tyFromExpr: result = typeExpr.typ elif typeExpr.typ.kind != tyTypeDesc: - localError(c.config, n.info, errTypeExpected) + localReport(c.config, n, reportSem rsemTypeExpected) result = errorType(c) else: result = typeExpr.typ.base @@ -1950,10 +2089,12 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = of nkIdent, nkAccQuoted: var s = semTypeIdent(c, n) if s.typ == nil: - if s.kind != skError: localError(c.config, n.info, errTypeExpected) + if s.kind != skError: + localReport(c.config, n, reportSem rsemTypeExpected) + result = newOrPrevType(tyError, prev, c) elif s.kind == skParam and s.typ.kind == tyTypeDesc: - internalAssert c.config, s.typ.base.kind != tyNone and prev == nil + internalAssert(c.config, s.typ.base.kind != tyNone and prev == nil, "") result = s.typ.base elif prev == nil: result = s.typ @@ -1975,7 +2116,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = if s.kind == skType: s.typ else: - internalAssert c.config, s.typ.base.kind != tyNone and prev == nil + internalAssert(c.config, s.typ.base.kind != tyNone and prev == nil, "") s.typ.base let alias = maybeAliasType(c, t, prev) if alias != nil: @@ -1989,11 +2130,8 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = onUse(n.info, n.sym) else: if s.kind != skError: - if s.typ == nil: - localError(c.config, n.info, "type expected, but symbol '$1' has no type." % [s.name.s]) - else: - localError(c.config, n.info, "type expected, but got symbol '$1' of kind '$2'" % - [s.name.s, s.kind.toHumanStr]) + localReport(c.config, n.info, reportSym(rsemTypeExpected, s)) + result = newOrPrevType(tyError, prev, c) of nkObjectTy: result = semObjectNode(c, n, prev, {}) of nkTupleTy: result = semTuple(c, n, prev) @@ -2028,7 +2166,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = of nkStmtListType: result = semStmtListType(c, n, prev) of nkBlockType: result = semBlockType(c, n, prev) else: - localError(c.config, n.info, "type expected, but got: " & renderTree(n)) + localReport(c.config, n, reportSem rsemTypeExpected) result = newOrPrevType(tyError, prev, c) n.typ = result dec c.inTypeContext @@ -2133,8 +2271,12 @@ proc processMagicType(c: PContext, m: PSym) = of "owned": setMagicType(c.config, m, tyOwned, c.config.target.ptrSize) incl m.typ.flags, tfHasOwned - else: localError(c.config, m.info, errTypeExpected) - else: localError(c.config, m.info, errTypeExpected) + + else: + localReport(c.config, m.info, reportSym(rsemTypeExpected, m)) + + else: + localReport(c.config, m.info, reportSym(rsemTypeExpected, m)) proc semGenericConstraints(c: PContext, x: PType): PType = result = newTypeWithSons(c, tyGenericParam, @[x]) @@ -2148,7 +2290,9 @@ proc semGenericParamList(c: PContext, n: PNode, father: PType = nil): PNode = result = copyNode(n) if n.kind != nkGenericParams: - illFormedAst(n, c.config) + semReportIllformedAst( + c.config, n, "Expected generic parameter list") + return for i in 0.. 4: - localError(m.c.graph.config, body.info, $body & " too nested for type matching") + localReport(m.c.graph.config, body.info, reportAst( + rsemTooNestedConcept, body)) + return nil openScope(c) @@ -735,36 +692,42 @@ proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = addDecl(c, param) var - oldWriteHook: typeof(m.c.config.writelnHook) - diagnostics: CandidateDiagnostics - errorPrefix: string flags: TExprFlags = {} - let collectDiagnostics = m.diagnosticsEnabled or sfExplain in typeClass.sym.flags + diagnostics: seq[SemReport] + + # When concept substitution is performed fake body is supplied and then + # semantic analysis is ran. All errors during matching are ignored unless + # `{.explain.}` annotation is added to the concept, or `--explain` fiag + # is used. - if collectDiagnostics: - oldWriteHook = m.c.config.writelnHook - # XXX: we can't write to m.diagnostics directly, because - # Nim doesn't support capturing var params in closures - diagnostics = @[] + let + storeDiagnostics = m.diagnosticsEnabled or sfExplain in typeClass.sym.flags + tmpHook = c.config.getReportHook() + + if storeDiagnostics: + # If concept need to be explained, all sem errors are temporarily + # captured for error reporting, and then fully written out flags = {efExplain} - m.c.config.writelnHook = proc (s: string) = - if errorPrefix.len == 0: - errorPrefix = typeClass.sym.name.s & ":" - let msg = s.replace("Error:", errorPrefix) - if oldWriteHook != nil: - oldWriteHook msg - let e = newError(body, msg) - diagnostics.add e + c.config.setReportHook( + proc(conf: ConfigRef, report: Report): TErrorHandling = + if report.category == repSem and conf.isCodeError(report): + diagnostics.add report.semReport + ) var checkedBody = c.semTryExpr(c, body.copyTree, flags) - if collectDiagnostics: - m.c.config.writelnHook = oldWriteHook + if storeDiagnostics: + c.config.setReportHook(tmpHook) if checkedBody != nil: for e in m.c.config.walkErrors(checkedBody): - m.diagnostics.add e + m.diagnostics.add c.config.getReport(e).semReport m.diagnosticsEnabled = true + + # REFACTOR(nkError) Until nkError reporting is fully implemented in the + # `sigmatch.matches` we need to rely on the report writer hack that is + # modified during `semTryExpr`, and then moved over to the candidate + # match data. When nkError is implemented this needs to be removed. for d in diagnostics: m.diagnostics.add d m.diagnosticsEnabled = true @@ -899,9 +862,8 @@ proc inferStaticParam*(c: var TCandidate, lhs: PNode, rhs: BiggestInt): bool = proc failureToInferStaticParam(conf: ConfigRef; n: PNode) = let staticParam = n.findUnresolvedStatic - let name = if staticParam != nil: staticParam.sym.name.s - else: "unknown" - localError(conf, n.info, "cannot infer the value of the static param '" & name & "'") + conf.localReport(n.info, reportSym( + rsemCannotInferStaticValue, staticParam.sym, str = "unknown")) proc inferStaticsInRange(c: var TCandidate, inferred, concrete: PType): TTypeRelation = @@ -1039,7 +1001,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, candidate = computedType else: # XXX What is this non-sense? Error reporting in signature matching? - discard "localError(f.n.info, errTypeExpected)" + discard "localReport(f.n.info, errTypeExpected)" else: discard @@ -1530,10 +1492,12 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, x.len - 1 == f.len: for i in 1.. 0 + internalAssert c.c.graph.config, a.len > 0, "[FIXME]" c.typedescMatched = true var aa = a while aa.kind in {tyTypeDesc, tyGenericParam} and aa.len > 0: @@ -1920,7 +1884,10 @@ proc implicitConv(kind: TNodeKind, f: PType, arg: PNode, m: TCandidate, result.typ = errorType(c) else: result.typ = f.skipTypes({tySink}) - if result.typ == nil: internalError(c.graph.config, arg.info, "implicitConv") + + if result.typ == nil: + internalError(c.graph.config, arg.info, "implicitConv") + result.add c.graph.emptyNode result.add arg @@ -2403,8 +2370,8 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int template noMatchDueToError() = ## found an nkError along the way so wrap the call in an error, do not use - ## if the legacy `localError`s etc are being used. - m.call = wrapErrorInSubTree(m.call) + ## if the legacy `localReport`s etc are being used. + m.call = wrapErrorInSubTree(c.config, m.call) noMatch() template checkConstraint(n: untyped) {.dirty.} = @@ -2464,7 +2431,11 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int # check if m.callee has such a param: prepareNamedParam(n[a], c) if n[a].kind == nkError or n[a][0].kind != nkIdent: - localError(c.config, n[a].info, "named parameter has to be an identifier") + localReport(c.config, n[a].info, reportAst( + rsemExpectedIdentifier, n[a], + str = "named parameter has to be an identifier" + )) + noMatch() formal = getNamedParamFromList(m.callee.n, n[a][0].ident) if formal == nil or formal.isError: @@ -2476,7 +2447,7 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int # we used to produce 'errCannotBindXTwice' here but see # bug #3836 of why that is not sound (other overload with # different parameter names could match later on): - when false: localError(n[a].info, errCannotBindXTwice, formal.name.s) + when false: localReport(n[a].info, errCannotBindXTwice, formal.name.s) noMatch() m.baseTypeMatch = false m.typedescMatched = false @@ -2544,7 +2515,7 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int if containsOrIncl(marker, formal.position) and container.isNil: m.firstMismatch.kind = kPositionalAlreadyGiven # positional param already in namedParams: (see above remark) - when false: localError(n[a].info, errCannotBindXTwice, formal.name.s) + when false: localReport(n[a].info, errCannotBindXTwice, formal.name.s) noMatch() if formal.typ.isVarargsUntyped: @@ -2592,8 +2563,12 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int # a container #assert arg.kind == nkHiddenStdConv # for 'nim check' # this assertion can be off - localError(c.config, n[a].info, "cannot convert $1 to $2" % [ - typeToString(n[a].typ), typeToString(formal.typ) ]) + localReport(c.config, n[a].info, + SemReport( + kind: rsemCannotConvertTypes, + typeMismatch: @[c.config.typeMismatch( + formal = formal.typ, actual = n[a].typ)])) + noMatch() checkConstraint(n[a]) @@ -2619,6 +2594,7 @@ proc partialMatch*(c: PContext, n, nOrig: PNode, m: var TCandidate) = matchesAux(c, n, nOrig, m, marker) proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = + # addInNimDebugUtils(c.config, "matches", n, nOrig) if m.magic in {mArrGet, mArrPut}: m.state = csMatch m.call = n @@ -2654,10 +2630,9 @@ proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = # The default param value is set to empty in `instantiateProcType` # when the type of the default expression doesn't match the type # of the instantiated proc param: - localError(c.config, m.call.info, - ("The default parameter '$1' has incompatible type " & - "with the explicitly requested proc instantiation") % - formal.name.s) + c.config.localReport(reportSym( + rsemIncompatibleDefaultExpr, formal)) + if nfDefaultRefsParam in formal.ast.flags: m.call.flags.incl nfDefaultRefsParam var defaultValue = copyTree(formal.ast) @@ -2696,7 +2671,7 @@ proc instTypeBoundOp*(c: PContext; dc: PSym; t: PType; info: TLineInfo; op: TTypeAttachedOp; col: int): PSym {.nosinks.} = var m = newCandidate(c, dc.typ) if col >= dc.typ.len: - localError(c.config, info, "cannot instantiate: '" & dc.name.s & "'") + localReport(c.config, info, reportSym(rsemCannotInstantiate, dc)) return nil var f = dc.typ[col] @@ -2705,7 +2680,7 @@ proc instTypeBoundOp*(c: PContext; dc: PSym; t: PType; info: TLineInfo; else: if f.kind in {tyVar}: f = f.lastSon if typeRel(m, f, t) == isNone: - localError(c.config, info, "cannot instantiate: '" & dc.name.s & "'") + localReport(c.config, info, reportSym(rsemCannotInstantiate, dc)) else: result = c.semGenerateInstance(c, dc, m.bindings, info) if op == attachedDeepCopy: diff --git a/compiler/sinkparameter_inference.nim b/compiler/sinkparameter_inference.nim index fa9f2b445e5..4b88eb25da4 100644 --- a/compiler/sinkparameter_inference.nim +++ b/compiler/sinkparameter_inference.nim @@ -47,8 +47,7 @@ proc checkForSink*(config: ConfigRef; idgen: IdGenerator; owner: PSym; arg: PNod elif sfWasForwarded notin arg.sym.flags: # we only report every potential 'sink' parameter only once: incl arg.sym.flags, sfWasForwarded - message(config, arg.info, hintPerformance, - "could not turn '$1' to a sink parameter" % [arg.sym.name.s]) + localReport(config, arg.info, reportSym(rsemCannotMakeSink, arg.sym)) #echo config $ arg.info, " candidate for a sink parameter here" of nkStmtList, nkStmtListExpr, nkBlockStmt, nkBlockExpr: if not isEmptyType(arg.typ): diff --git a/compiler/sizealignoffsetimpl.nim b/compiler/sizealignoffsetimpl.nim index 44ba3257921..aeb9446eb43 100644 --- a/compiler/sizealignoffsetimpl.nim +++ b/compiler/sizealignoffsetimpl.nim @@ -90,7 +90,8 @@ proc computeSubObjectAlign(conf: ConfigRef; n: PNode): BiggestInt = return align result = max(result, align) else: - internalError(conf, "computeSubObjectAlign") + conf.internalError("computeSubObjectAlign") + of nkRecList: result = 1 for i, child in n.sons: @@ -132,7 +133,9 @@ proc computeObjectOffsetsFoldFunction(conf: ConfigRef; n: PNode, packed: bool, a let align = int(computeSubObjectAlign(conf, n[i].lastSon)) maxChildAlign = alignmentMax(maxChildAlign, align) else: - internalError(conf, "computeObjectOffsetsFoldFunction(record case branch)") + conf.internalError( + "computeObjectOffsetsFoldFunction(record case branch)") + if maxChildAlign == szUnknownSize: setOffsetsToUnknown(n) accum.offset = szUnknownSize @@ -171,7 +174,7 @@ proc computeUnionObjectOffsetsFoldFunction(conf: ConfigRef; n: PNode; packed: bo of nkRecCase: accum.offset = szUnknownSize accum.maxAlign = szUnknownSize - localError(conf, n.info, "Illegal use of ``case`` in union type.") + conf.localReport(n, reportSem(rsemCaseInUnion)) of nkRecList: let accumRoot = accum # copy, because each branch should start af the same offset for child in n.sons: @@ -258,14 +261,14 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = of tyArray: computeSizeAlign(conf, typ[1]) - let elemSize = typ[1].size + let elemSize = typ[1].size let len = lengthOrd(conf, typ[0]) if elemSize < 0: typ.size = elemSize typ.align = int16(elemSize) elif len < 0: typ.size = szUnknownSize - typ.align = szUnknownSize + typ.align = szUnknownSize else: typ.size = toInt64Checked(len * int32(elemSize), szTooBigSize) typ.align = typ[1].align @@ -373,7 +376,7 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = if tfUnion in typ.flags: if accum.offset != 0: let info = if typ.sym != nil: typ.sym.info else: unknownLineInfo - localError(conf, info, "union type may not have an object header") + conf.localReport(info, reportSem(rsemOffsetInUnion)) accum = OffsetAccum(offset: szUnknownSize, maxAlign: szUnknownSize) elif tfPacked in typ.flags: computeUnionObjectOffsetsFoldFunction(conf, typ.n, true, accum) @@ -490,7 +493,7 @@ template foldOffsetOf*(conf: ConfigRef; n: PNode; fallback: PNode): PNode = elif node[1].kind == nkCheckedFieldExpr: dotExpr = node[1][0] else: - localError(config, node.info, "can't compute offsetof on this ast") + config.localReport(node.info, reportAst(rsemCantComputeOffsetof, n)) assert dotExpr != nil let value = dotExpr[0] diff --git a/compiler/spawn.nim b/compiler/spawn.nim index e57686cb4c8..c9ebfb8d070 100644 --- a/compiler/spawn.nim +++ b/compiler/spawn.nim @@ -10,7 +10,7 @@ ## This module implements threadpool's ``spawn``. import ast, types, idents, magicsys, msgs, options, modulegraphs, - lowerings, liftdestructors, renderer + lowerings, liftdestructors, renderer, reports from trees import getMagic, getRoot proc callProc(a: PNode): PNode = @@ -126,7 +126,11 @@ proc createWrapperProc(g: ModuleGraph; f: PNode; threadParam, argsParam: PSym; if spawnKind == srByVar: threadLocalProm = addLocalVar(g, varSection, nil, idgen, result, fv.typ, fv) elif fv != nil: - internalAssert g.config, fv.typ.kind == tyGenericInst + internalAssert( + g.config, + fv.typ.kind == tyGenericInst, + "Expected generic inst type kind, but found " & $fv.typ.kind) + threadLocalProm = addLocalVar(g, varSection, nil, idgen, result, fv.typ, fv) body.add varSection body.add varInit @@ -143,8 +147,9 @@ proc createWrapperProc(g: ModuleGraph; f: PNode; threadParam, argsParam: PSym; elif fv != nil: let fk = flowVarKind(g.config, fv.typ[1]) if fk == fvInvalid: - localError(g.config, f.info, "cannot create a flowVar of type: " & - typeToString(fv.typ[1])) + localReport(g.config, f.info, reportTyp( + rsemCannotCreateFlowVarOfType, fv.typ[1])) + body.add newAsgnStmt(indirectAccess(threadLocalProm.newSymNode, if fk == fvGC: "data" else: "blob", fv.info, g.cache), call) if fk == fvGC: @@ -195,7 +200,8 @@ proc createCastExpr(argsParam: PSym; objType: PType; idgen: IdGenerator): PNode template checkMagicProcs(g: ModuleGraph, n: PNode, formal: PNode) = if (formal.typ.kind == tyVarargs and formal.typ[0].kind in {tyTyped, tyUntyped}) or formal.typ.kind in {tyTyped, tyUntyped}: - localError(g.config, n.info, "'spawn'ed function cannot have a 'typed' or 'untyped' parameter") + localReport(g.config, n.info, reportAst( + rsemCannotSpawnMagicProc, n)) proc setupArgsForConcurrency(g: ModuleGraph; n: PNode; objType: PType; idgen: IdGenerator; owner: PSym; scratchObj: PSym, @@ -209,14 +215,15 @@ proc setupArgsForConcurrency(g: ModuleGraph; n: PNode; objType: PType; var argType = n[i].typ.skipTypes(abstractInst) if i < formals.len: if formals[i].typ.kind in {tyVar, tyLent}: - localError(g.config, n[i].info, "'spawn'ed function cannot have a 'var' parameter") + localReport(g.config, n[i].info, reportAst( + rsemCannotSpawnProcWithVar, formals[i])) checkMagicProcs(g, n[i], formals[i]) if formals[i].typ.kind in {tyTypeDesc, tyStatic}: continue #elif containsTyRef(argType): - # localError(n[i].info, "'spawn'ed function cannot refer to 'ref'/closure") + # localReport(n[i].info, "'spawn'ed function cannot refer to 'ref'/closure") let fieldname = if i < formals.len: formals[i].sym.name else: tmpName var field = newSym(skField, fieldname, nextSymId idgen, objType.owner, n.info, g.config.options) @@ -247,7 +254,7 @@ proc setupArgsForParallelism(g: ModuleGraph; n: PNode; objType: PType; let argType = skipTypes(if i < formals.len: formals[i].typ else: n.typ, abstractInst) #if containsTyRef(argType): - # localError(n.info, "'spawn'ed function cannot refer to 'ref'/closure") + # localReport(n.info, "'spawn'ed function cannot refer to 'ref'/closure") let fieldname = if i < formals.len: formals[i].sym.name else: tmpName var field = newSym(skField, fieldname, nextSymId idgen, objType.owner, n.info, g.config.options) @@ -324,28 +331,34 @@ proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExp let spawnKind = spawnResult(retType, barrier!=nil) case spawnKind of srVoid: - internalAssert g.config, dest == nil + internalAssert g.config, dest == nil, "" result = newNodeI(nkStmtList, n.info) of srFlowVar: - internalAssert g.config, dest == nil + internalAssert g.config, dest == nil, "" result = newNodeIT(nkStmtListExpr, n.info, retType) of srByVar: - if dest == nil: localError(g.config, n.info, "'spawn' must not be discarded") + if dest == nil: localReport(g.config, n, reportSem rsemCannotDiscardSpawn) result = newNodeI(nkStmtList, n.info) if n.kind notin nkCallKinds: - localError(g.config, n.info, "'spawn' takes a call expression; got: " & $n) + localReport(g.config, n, reportSem rsemSpawnRequiresCall) return if optThreadAnalysis in g.config.globalOptions: if {tfThread, tfNoSideEffect} * n[0].typ.flags == {}: - localError(g.config, n.info, "'spawn' takes a GC safe call expression") + localReport(g.config, n.info, reportTyp( + rsemSpawnRequiresGcSafe, n[0].typ, ast = n[0])) var fn = n[0] let name = (if fn.kind == nkSym: fn.sym.name.s else: genPrefix) & "Wrapper" - wrapperProc = newSym(skProc, getIdent(g.cache, name), nextSymId idgen, owner, fn.info, g.config.options) - threadParam = newSym(skParam, getIdent(g.cache, "thread"), nextSymId idgen, wrapperProc, n.info, g.config.options) - argsParam = newSym(skParam, getIdent(g.cache, "args"), nextSymId idgen, wrapperProc, n.info, g.config.options) + wrapperProc = newSym( + skProc, getIdent(g.cache, name), nextSymId idgen, owner, fn.info, g.config.options) + + threadParam = newSym( + skParam, getIdent(g.cache, "thread"), nextSymId idgen, wrapperProc, n.info, g.config.options) + + argsParam = newSym( + skParam, getIdent(g.cache, "args"), nextSymId idgen, wrapperProc, n.info, g.config.options) wrapperProc.flags.incl sfInjectDestructors block: @@ -370,7 +383,8 @@ proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExp # templates and macros are in fact valid here due to the nature of # the transformation: if fn.kind == nkClosure or (fn.typ != nil and fn.typ.callConv == ccClosure): - localError(g.config, n.info, "closure in spawn environment is not allowed") + localReport(g.config, n.info, reportAst(rsemSpawnForbidsClosure, fn)) + if not (fn.kind == nkSym and fn.sym.kind in {skProc, skTemplate, skMacro, skFunc, skMethod, skConverter}): # for indirect calls we pass the function pointer in the scratchObj @@ -381,7 +395,7 @@ proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExp result.add newFastAsgnStmt(newDotExpr(scratchObj, field), n[0]) fn = indirectAccess(castExpr, field, n.info) elif fn.kind == nkSym and fn.sym.kind == skIterator: - localError(g.config, n.info, "iterator in spawn environment is not allowed") + localReport(g.config, n.info, reportAst(rsemSpawnForbidsIterator, fn)) call.add(fn) var varSection = newNodeI(nkVarSection, n.info) @@ -397,7 +411,9 @@ proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExp if barrier != nil: let typ = newType(tyPtr, nextTypeId idgen, owner) typ.rawAddSon(magicsys.getCompilerProc(g, "Barrier").typ) - var field = newSym(skField, getIdent(g.cache, "barrier"), nextSymId idgen, owner, n.info, g.config.options) + var field = newSym( + skField, getIdent(g.cache, "barrier"), nextSymId idgen, owner, n.info, g.config.options) + field.typ = typ objType.addField(field, g.cache, idgen) result.add newFastAsgnStmt(newDotExpr(scratchObj, field), barrier) diff --git a/compiler/suggest.nim b/compiler/suggest.nim index 477e48a148b..5cf8113e169 100644 --- a/compiler/suggest.nim +++ b/compiler/suggest.nim @@ -424,7 +424,7 @@ proc suggestFieldAccess(c: PContext, n, field: PNode, outputs: var Suggestions) t = skipTypes(t[0], skipPtrs) elif typ.kind == tyTuple and typ.n != nil: suggestSymList(c, typ.n, field, n.info, outputs) - + suggestOperations(c, n, field, orig, outputs) if typ != orig: suggestOperations(c, n, field, typ, outputs) @@ -540,29 +540,26 @@ proc extractPragma(s: PSym): PNode = proc warnAboutDeprecated(conf: ConfigRef; info: TLineInfo; s: PSym) = var pragmaNode: PNode pragmaNode = if s.kind == skEnumField: extractPragma(s.owner) else: extractPragma(s) - let name = - if s.kind == skEnumField and sfDeprecated notin s.flags: "enum '" & s.owner.name.s & "' which contains field '" & s.name.s & "'" - else: s.name.s if pragmaNode != nil: for it in pragmaNode: if whichPragma(it) == wDeprecated and it.safeLen == 2 and it[1].kind in {nkStrLit..nkTripleStrLit}: - message(conf, info, warnDeprecated, it[1].strVal & "; " & name & " is deprecated") + localReport(conf, info, reportSym( + rsemDeprecated, s, str = it[1].strVal)) return - message(conf, info, warnDeprecated, name & " is deprecated") + localReport(conf, info, reportSym(rsemDeprecated, s)) proc userError(conf: ConfigRef; info: TLineInfo; s: PSym) = let pragmaNode = extractPragma(s) - template bail(prefix: string) = - localError(conf, info, "$1usage of '$2' is an {.error.} defined at $3" % - [prefix, s.name.s, toFileLineCol(conf, s.ast.info)]) if pragmaNode != nil: for it in pragmaNode: if whichPragma(it) == wError and it.safeLen == 2 and it[1].kind in {nkStrLit..nkTripleStrLit}: - bail(it[1].strVal & "; ") + localReport(conf, info, reportSym( + rsemUsageIsError, s, str = it[1].strVal)) return - bail("") + + localReport(conf, info, reportSym(rsemUsageIsError, s)) proc markOwnerModuleAsUsed(c: PContext; s: PSym) = var module = s @@ -572,8 +569,9 @@ proc markOwnerModuleAsUsed(c: PContext; s: PSym) = var i = 0 while i <= high(c.unusedImports): let candidate = c.unusedImports[i][0] - if candidate == module or c.importModuleMap.getOrDefault(candidate.id, int.low) == module.id or - c.exportIndirections.contains((candidate.id, s.id)): + if candidate == module or + c.importModuleMap.getOrDefault(candidate.id, int.low) == module.id or + c.exportIndirections.contains((candidate.id, s.id)): # mark it as used: c.unusedImports.del(i) else: diff --git a/compiler/syntaxes.nim b/compiler/syntaxes.nim index 03a9702a368..4ef6daeb0de 100644 --- a/compiler/syntaxes.nim +++ b/compiler/syntaxes.nim @@ -11,7 +11,7 @@ import strutils, llstream, ast, idents, lexer, options, msgs, parser, - filters, filter_tmpl, renderer, lineinfos, pathutils + filters, filter_tmpl, renderer, lineinfos, pathutils, reports export Parser, parseAll, parseTopLevelStmt, closeParser @@ -71,7 +71,7 @@ proc getCallee(conf: ConfigRef; n: PNode): PIdent = elif n.kind == nkIdent: result = n.ident else: - localError(conf, n.info, "invalid filter: " & renderTree(n)) + conf.localReport(n.info, ParserReport(kind: rparInvalidFilter, node: n)) proc applyFilter(p: var Parser, n: PNode, filename: AbsoluteFile, stdin: PLLStream): PLLStream = @@ -87,10 +87,9 @@ proc applyFilter(p: var Parser, n: PNode, filename: AbsoluteFile, filterReplace(p.lex.config, stdin, filename, n) if f != filtNone: assert p.lex.config != nil - if p.lex.config.hasHint(hintCodeBegin): - rawMessage(p.lex.config, hintCodeBegin, "") - msgWriteln(p.lex.config, result.s) - rawMessage(p.lex.config, hintCodeEnd, "") + if p.lex.config.hasHint(rlexSyntaxesCode): + p.lex.config.localReport LexerReport( + kind: rlexSyntaxesCode, msg: result.s) proc evalPipe(p: var Parser, n: PNode, filename: AbsoluteFile, start: PLLStream): PLLStream = @@ -123,7 +122,8 @@ proc setupParser*(p: var Parser; fileIdx: FileIndex; cache: IdentCache; let filename = toFullPathConsiderDirty(config, fileIdx) var f: File if not open(f, filename.string): - rawMessage(config, errGenerated, "cannot open file: " & filename.string) + config.localReport InternalReport( + kind: rintCannotOpenFile, file: filename.string) return false openParser(p, fileIdx, llStreamOpen(f), cache, config) result = true diff --git a/compiler/transf.nim b/compiler/transf.nim index 69997a5715f..0573a7f0b7e 100644 --- a/compiler/transf.nim +++ b/compiler/transf.nim @@ -19,7 +19,7 @@ # * transforms 'defer' into a 'try finally' statement import - options, ast, astalgo, trees, msgs, + options, ast, astalgo, trees, msgs, reports, idents, renderer, types, semfold, magicsys, cgmeth, lowerings, liftlocals, modulegraphs, lineinfos, @@ -78,7 +78,9 @@ proc pushTransCon(c: PTransf, t: PTransCon) = c.transCon = t proc popTransCon(c: PTransf) = - if (c.transCon == nil): internalError(c.graph.config, "popTransCon") + if (c.transCon == nil): + internalError(c.graph.config, "popTransCon") + c.transCon = c.transCon.next proc getCurrOwner(c: PTransf): PSym = @@ -134,7 +136,9 @@ proc transformSymAux(c: PTransf, n: PNode): PNode = else: break b = getBody(c.graph, s) - if b.kind != nkSym: internalError(c.graph.config, n.info, "wrong AST for borrowed symbol") + if b.kind != nkSym: + internalError(c.graph.config, n.info, "wrong AST for borrowed symbol") + b = newSymNode(b.sym, n.info) elif c.inlining > 0: # see bug #13596: we use ref-based equality in the DFA for destruction @@ -183,7 +187,8 @@ proc transformVarSection(c: PTransf, v: PNode): PNode = result[i] = it elif it.kind == nkIdentDefs: if it[0].kind == nkSym: - internalAssert(c.graph.config, it.len == 3) + internalAssert(c.graph.config, it.len == 3, + "var section must have three subnodes") let x = freshVar(c, it[0].sym) idNodeTablePut(c.transCon.mapping, it[0].sym, x) var defs = newTransNode(nkIdentDefs, it.info, 3) @@ -202,6 +207,7 @@ proc transformVarSection(c: PTransf, v: PNode): PNode = else: if it.kind != nkVarTuple: internalError(c.graph.config, it.info, "transformVarSection: not nkVarTuple") + var defs = newTransNode(it.kind, it.info, it.len) for j in 0..x+1), - # maybe recoverable by rerun if the parameter is - # the proc's return value - isInferred, # generic proc was matched against a concrete type - isInferredConvertible, # same as above, but requiring proc CC conversion - isGeneric, - isFromIntLit, # conversion *from* int literal; proven safe - isEqual - - ProcConvMismatch* = enum - pcmNoSideEffect - pcmNotGcSafe - pcmLockDifference - pcmNotIterator - pcmDifferentCallConv - proc typeToString*(typ: PType; prefer: TPreferedDesc = preferName): string proc addTypeDeclVerboseMaybe*(result: var string, conf: ConfigRef; typ: PType) = @@ -773,11 +752,17 @@ proc firstOrd*(conf: ConfigRef; t: PType): Int128 = result = firstOrd(conf, lastSon(t)) of tyOrdinal: if t.len > 0: result = firstOrd(conf, lastSon(t)) - else: internalError(conf, "invalid kind for firstOrd(" & $t.kind & ')') + else: + conf.localReport InternalReport( + kind: rintUnreachable, + msg: "invalid kind for firstOrd(" & $t.kind & ')') + of tyUncheckedArray, tyCstring: result = Zero else: - internalError(conf, "invalid kind for firstOrd(" & $t.kind & ')') + conf.localReport InternalReport( + kind: rintUnreachable, + msg: "invalid kind for firstOrd(" & $t.kind & ')') result = Zero proc firstFloat*(t: PType): BiggestFloat = @@ -792,7 +777,9 @@ proc firstFloat*(t: PType): BiggestFloat = tyStatic, tyInferred, tyUserTypeClasses: firstFloat(lastSon(t)) else: - internalError(newPartialConfigRef(), "invalid kind for firstFloat(" & $t.kind & ')') + newPartialConfigRef().localReport InternalReport( + kind: rintUnreachable, + msg: "invalid kind for firstFloat(" & $t.kind & ')') NaN proc lastOrd*(conf: ConfigRef; t: PType): Int128 = @@ -832,11 +819,16 @@ proc lastOrd*(conf: ConfigRef; t: PType): Int128 = of tyProxy: result = Zero of tyOrdinal: if t.len > 0: result = lastOrd(conf, lastSon(t)) - else: internalError(conf, "invalid kind for lastOrd(" & $t.kind & ')') + else: + conf.localReport InternalReport( + kind: rintUnreachable, + msg: "invalid kind for firstOrd(" & $t.kind & ')') of tyUncheckedArray: result = Zero else: - internalError(conf, "invalid kind for lastOrd(" & $t.kind & ')') + conf.localReport InternalReport( + kind: rintUnreachable, + msg: "invalid kind for firstOrd(" & $t.kind & ')') result = Zero proc lastFloat*(t: PType): BiggestFloat = @@ -851,7 +843,9 @@ proc lastFloat*(t: PType): BiggestFloat = tyStatic, tyInferred, tyUserTypeClasses: lastFloat(lastSon(t)) else: - internalError(newPartialConfigRef(), "invalid kind for lastFloat(" & $t.kind & ')') + newPartialConfigRef().localReport InternalReport( + kind: rintUnreachable, + msg: "invalid kind for firstFloat(" & $t.kind & ')') NaN proc floatRangeCheck*(x: BiggestFloat, t: PType): bool = @@ -868,7 +862,9 @@ proc floatRangeCheck*(x: BiggestFloat, t: PType): bool = tyStatic, tyInferred, tyUserTypeClasses: floatRangeCheck(x, lastSon(t)) else: - internalError(newPartialConfigRef(), "invalid kind for floatRangeCheck:" & $t.kind) + newPartialConfigRef().localReport InternalReport( + kind: rintUnreachable, + msg: "invalid kind for floatRangeCheck(" & $t.kind & ')') false proc lengthOrd*(conf: ConfigRef; t: PType): Int128 = @@ -1127,7 +1123,7 @@ proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool = of dcEqOrDistinctOf: a = a.skipDistincts() if a.kind != b.kind: return false - + #[ The following code should not run in the case either side is an generic alias, but it's not presently possible to distinguish the genericinsts from aliases of @@ -1369,15 +1365,6 @@ proc compatibleEffectsAux(se, re: PNode): bool = return false result = true -type - EffectsCompat* = enum - efCompat - efRaisesDiffer - efRaisesUnknown - efTagsDiffer - efTagsUnknown - efLockLevelsDiffer - efEffectsDelayed proc compatibleEffects*(formal, actual: PType): EffectsCompat = # for proc type compatibility checking: @@ -1527,7 +1514,9 @@ proc skipHiddenSubConv*(n: PNode; g: ModuleGraph; idgen: IdGenerator): PNode = else: result = n -proc getProcConvMismatch*(c: ConfigRef, f, a: PType, rel = isNone): (set[ProcConvMismatch], TTypeRelation) = +proc getProcConvMismatch*( + c: ConfigRef, f, a: PType, rel = isNone + ): (set[ProcConvMismatch], TTypeRelation) = ## Returns a set of the reason of mismatch, and the relation for conversion. result[1] = rel if tfNoSideEffect in f.flags and tfNoSideEffect notin a.flags: @@ -1564,71 +1553,51 @@ proc getProcConvMismatch*(c: ConfigRef, f, a: PType, rel = isNone): (set[ProcCon # but it's a pragma mismatch reason which is why it's here result[0].incl pcmLockDifference -proc addPragmaAndCallConvMismatch*(message: var string, formal, actual: PType, conf: ConfigRef) = - assert formal.kind == tyProc and actual.kind == tyProc - let (convMismatch, _) = getProcConvMismatch(conf, formal, actual) - var - gotPragmas = "" - expectedPragmas = "" - for reason in convMismatch: - case reason - of pcmDifferentCallConv: - message.add "\n Calling convention mismatch: got '{.$1.}', but expected '{.$2.}'." % [$actual.callConv, $formal.callConv] - of pcmNoSideEffect: - expectedPragmas.add "noSideEffect, " - of pcmNotGcSafe: - expectedPragmas.add "gcsafe, " - of pcmLockDifference: - gotPragmas.add("locks: " & $actual.lockLevel & ", ") - expectedPragmas.add("locks: " & $formal.lockLevel & ", ") - of pcmNotIterator: discard - - if expectedPragmas.len > 0: - gotPragmas.setLen(max(0, gotPragmas.len - 2)) # Remove ", " - expectedPragmas.setLen(max(0, expectedPragmas.len - 2)) # Remove ", " - message.add "\n Pragma mismatch: got '{.$1.}', but expected '{.$2.}'." % [gotPragmas, expectedPragmas] - - -proc typeMismatch*(conf: ConfigRef; info: TLineInfo, formal, actual: PType, n: PNode): PNode = +proc typeMismatch*( + conf: ConfigRef, formal, actual: PType): SemTypeMismatch = + + result = SemTypeMismatch( + actualType: actual, + formalType: formal, + descriptionStr: typeToString(formal, preferDesc) + ) + +proc typeMismatch*( + conf: ConfigRef, formal: set[TTypeKind], actual: PType): SemTypeMismatch = + + SemTypeMismatch(actualType: actual, formalTypeKind: formal) + +proc typeMismatch*( + conf: ConfigRef; info: TLineInfo, formal, actual: PType, n: PNode): PNode = + ## If formal and actual types are not `tyError`, create a new wrapper + ## `nkError` node and construct type mismatch report for it. result = n if formal.kind != tyError and actual.kind != tyError: - let actualStr = typeToString(actual) - let formalStr = typeToString(formal) - let desc = typeToString(formal, preferDesc) - let x = if formalStr == desc: formalStr else: formalStr & " = " & desc - let verbose = actualStr == formalStr or optDeclaredLocs in conf.globalOptions - var msg = "type mismatch:" - if verbose: msg.add "\n" - if conf.isDefined("nimLegacyTypeMismatch"): - msg.add " got <$1>" % actualStr - else: - msg.add " got '$1' for '$2'" % [actualStr, n.renderTree] - if verbose: - msg.addDeclaredLoc(conf, actual) - msg.add "\n" - msg.add " but expected '$1'" % x - if verbose: msg.addDeclaredLoc(conf, formal) - - if formal.kind == tyProc and actual.kind == tyProc: - msg.addPragmaAndCallConvMismatch(formal, actual, conf) - case compatibleEffects(formal, actual) - of efCompat: discard - of efRaisesDiffer: - msg.add "\n.raise effects differ" - of efRaisesUnknown: - msg.add "\n.raise effect is 'can raise any'" - of efTagsDiffer: - msg.add "\n.tag effects differ" - of efTagsUnknown: - msg.add "\n.tag effect is 'any tag allowed'" - of efLockLevelsDiffer: - msg.add "\nlock levels differ" - of efEffectsDelayed: - msg.add "\n.effectsOf annotations differ" - # localError(conf, info, msg) - result = newError(n, msg) + var rep = SemReport( + kind: rsemTypeMismatch, + ast: n, + typeMismatch: @[typeMismatch(conf, formal, actual)]) + + assert not n.isNil, "Type mismatch requires non-nil AST for expression" + result = newError(conf, n, rsemTypeMismatch, conf.store(info, rep), instLoc()) result.info = info + # conf.localReport(result) + +proc semReportTypeMismatch*( + conf: ConfigRef, + node: PNode, + formal: PType | set[TTypeKind], + actual: PType + ): SemReport = + + result = SemReport( + kind: when formal is PType: rsemTypeMismatch else: rsemTypeKindMismatch, + ast: node, + typeMismatch: @[typeMismatch( + conf, formal = formal, actual = actual)] + ) + proc isTupleRecursive(t: PType, cycleDetector: var IntSet): bool = if t == nil: return false diff --git a/compiler/varpartitions.nim b/compiler/varpartitions.nim index 8f422face8e..0da3ea288b8 100644 --- a/compiler/varpartitions.nim +++ b/compiler/varpartitions.nim @@ -28,7 +28,8 @@ ## See https://nim-lang.github.io/Nim/manual_experimental.html#view-types-algorithm ## for a high-level description of how borrow checking works. -import ast, types, lineinfos, options, msgs, renderer, typeallowed, modulegraphs +import ast, types, lineinfos, options, msgs, renderer, typeallowed, modulegraphs, + reports from trees import getMagic, isNoSideEffectPragma, stupidStmtListExpr from isolation_check import canAlias @@ -82,8 +83,8 @@ type borrowsFrom: seq[int] # indexes into Partitions.s MutationInfo* = object - param: PSym - mutatedHere, connectedVia: TLineInfo + param*: PSym + mutatedHere*, connectedVia*: TLineInfo flags: set[SubgraphFlag] maxMutation, minConnection: AbstractTime mutations: seq[AbstractTime] @@ -525,16 +526,15 @@ proc toString(n: PNode): string = else: result = $n proc borrowFrom(c: var Partitions; dest: PSym; src: PNode) = - const - url = "see https://nim-lang.github.io/Nim/manual_experimental.html#view-types-algorithm-path-expressions for details" - let s = pathExpr(src, c.owner) if s == nil: - localError(c.g.config, src.info, "cannot borrow from " & src.toString & ", it is not a path expression; " & url) + localReport(c.g.config, src.info, reportAst(rsemExpressionIsNotAPath, src)) elif s.kind == nkSym: if dest.kind == skResult: if s.sym.kind != skParam or s.sym.position != 0: - localError(c.g.config, src.info, "'result' must borrow from the first parameter") + localReport( + c.g.config, src.info, + reportSym(rsemResultMustBorrowFirst, s.sym, ast = src)) let vid = variableId(c, dest) if vid >= 0: @@ -560,13 +560,15 @@ proc borrowingCall(c: var Partitions; destType: PType; n: PNode; i: int) = when false: let isView = directViewType(destType) == immutableView if n[0].kind == nkSym and n[0].sym.name.s == "[]=": - localError(c.g.config, n[i].info, "attempt to mutate an immutable view") + localReport(c.g.config, n[i].info, "attempt to mutate an immutable view") for j in i+1..= 0: - if par.s[sid].con.kind == isRootOf and dangerousMutation(par.graphs[par.s[sid].con.graphIndex], par.s[i]): + if par.s[sid].con.kind == isRootOf and + dangerousMutation(par.graphs[par.s[sid].con.graphIndex], par.s[i]): cannotBorrow(config, v, par.graphs[par.s[sid].con.graphIndex]) - if par.s[sid].sym.kind != skParam and par.s[sid].aliveEnd < par.s[rid].aliveEnd: - localError(config, v.info, "'" & v.name.s & "' borrows from location '" & par.s[sid].sym.name.s & - "' which does not live long enough") + + if par.s[sid].sym.kind != skParam and + par.s[sid].aliveEnd < par.s[rid].aliveEnd: + localReport(config, v.info, reportSymbols( + rsemBorrowOutlivesSource, @[v, par.s[sid].sym])) + if viewDoesMutate in par.s[rid].flags and isConstSym(par.s[sid].sym): - localError(config, v.info, "'" & v.name.s & "' borrows from the immutable location '" & - par.s[sid].sym.name.s & "' and attempts to mutate it") + localReport(config, v.info, reportSymbols( + rsemImmutableBorrowMutation, @[v, par.s[sid].sym])) + constViolation = true - if {viewDoesMutate, viewBorrowsFromConst} * par.s[rid].flags == {viewDoesMutate, viewBorrowsFromConst} and + if {viewDoesMutate, viewBorrowsFromConst} * par.s[rid].flags == { + viewDoesMutate, viewBorrowsFromConst} and not constViolation: # we do not track the constant expressions we allow to borrow from so # we can only produce a more generic error message: - localError(config, v.info, "'" & v.name.s & - "' borrows from an immutable location and attempts to mutate it") + localReport(config, v.info, reportSym(rsemImmutableBorrowMutation, v)) #if par.s[rid].con.kind == isRootOf and dangerousMutation(par.graphs[par.s[rid].con.graphIndex], par.s[i]): # cannotBorrow(config, s, par.graphs[par.s[rid].con.graphIndex]) @@ -938,7 +939,8 @@ proc computeCursors*(s: PSym; n: PNode; g: ModuleGraph) = v.sym.flags * {sfThread, sfGlobal} == {} and hasDestructor(v.sym.typ) and v.sym.typ.skipTypes({tyGenericInst, tyAlias}).kind != tyOwned: let rid = root(par, i) - if par.s[rid].con.kind == isRootOf and dangerousMutation(par.graphs[par.s[rid].con.graphIndex], par.s[i]): + if par.s[rid].con.kind == isRootOf and + dangerousMutation(par.graphs[par.s[rid].con.graphIndex], par.s[i]): discard "cannot cursor into a graph that is mutated" else: v.sym.flags.incl sfCursor diff --git a/compiler/vm.nim b/compiler/vm.nim index d7db5b8235f..811f7140cdf 100644 --- a/compiler/vm.nim +++ b/compiler/vm.nim @@ -13,10 +13,12 @@ import std/[strutils, tables, parseutils], - msgs, vmdef, vmgen, nimsets, types, passes, + msgs, vmdef, vmgen, nimsets, types, passes, reports, parser, vmdeps, idents, trees, renderer, options, transf, gorgeimpl, lineinfos, btrees, macrocacheimpl, - modulegraphs, sighashes, int128, vmprofiler + modulegraphs, sighashes, int128, vmprofiler, + debugutils, astalgo, + cli_reporter import ast except getstr from semfold import leValueConv, ordinalValToString @@ -29,58 +31,76 @@ const when hasFFI: import evalffi +const + errIllegalConvFromXtoY = "illegal conversion from '$1' to '$2'" + +proc stackTraceImpl( + c: PCtx, + sframe: PStackFrame, + pc: int, + lineInfo: TLineInfo, + infoOrigin: InstantiationInfo, + recursionLimit: int = 100 + ) = + + proc aux(sframe: PStackFrame, pc, depth: int, res: var SemReport) = + if sframe != nil: + if recursionLimit < depth: + var calls = 0 + var sframe = sframe + while sframe != nil: + inc calls + sframe = sframe.next + + return + + aux(sframe.next, sframe.comesFrom, depth + 1, res) + res.stacktrace.add((sym: sframe.prc, location: c.debug[pc])) + + var res = SemReport(kind: rsemVmStackTrace) + res.currentExceptionA = c.currentExceptionA + res.currentExceptionB = c.currentExceptionB + + aux(sframe, pc, 0, res) -proc stackTraceAux(c: PCtx; x: PStackFrame; pc: int; recursionLimit=100) = - if x != nil: - if recursionLimit == 0: - var calls = 0 - var x = x - while x != nil: - inc calls - x = x.next - msgWriteln(c.config, $calls & " calls omitted\n", {msgNoUnitSep}) - return - stackTraceAux(c, x.next, x.comesFrom, recursionLimit-1) - var info = c.debug[pc] - # we now use a format similar to the one in lib/system/excpt.nim - var s = "" - # todo: factor with quotedFilename - if optExcessiveStackTrace in c.config.globalOptions: - s = toFullPath(c.config, info) - else: - s = toFilename(c.config, info) - var line = toLinenumber(info) - var col = toColumn(info) - if line > 0: - s.add('(') - s.add($line) - s.add(", ") - s.add($(col + ColOffset)) - s.add(')') - if x.prc != nil: - for k in 1..max(1, 25-s.len): s.add(' ') - s.add(x.prc.name.s) - msgWriteln(c.config, s, {msgNoUnitSep}) - -proc stackTraceImpl(c: PCtx, tos: PStackFrame, pc: int, - msg: string, lineInfo: TLineInfo, infoOrigin: InstantiationInfo) {.noinline.} = - # noinline to avoid code bloat - msgWriteln(c.config, "stack trace: (most recent call last)", {msgNoUnitSep}) - stackTraceAux(c, tos, pc) let action = if c.mode == emRepl: doRaise else: doNothing - # XXX test if we want 'globalError' for every mode - let lineInfo = if lineInfo == TLineInfo.default: c.debug[pc] else: lineInfo - liMessage(c.config, lineInfo, errGenerated, msg, action, infoOrigin) -template stackTrace(c: PCtx, tos: PStackFrame, pc: int, - msg: string, lineInfo: TLineInfo = TLineInfo.default) = - stackTraceImpl(c, tos, pc, msg, lineInfo, instantiationInfo(-2, fullPaths = compileOption"excessiveStackTrace")) + let report = wrap(res, infoOrigin, lineInfo) + + c.config.handleReport(report, infoOrigin, action) + + +template stackTrace( + c: PCtx, + tos: PStackFrame, + pc: int, + sem: ReportTypes, + info: TLineInfo, + ) = + stackTraceImpl(c, tos, pc, info, instLoc()) + localReport(c.config, info, sem) + return + +template stackTrace( + c: PCtx, + tos: PStackFrame, + pc: int, + sem: ReportTypes, + ) = + stackTraceImpl(c, tos, pc, c.debug[pc], instLoc()) + localReport(c.config, c.debug[pc], sem) return -proc bailOut(c: PCtx; tos: PStackFrame) = - stackTrace(c, tos, c.exceptionInstr, "unhandled exception: " & - c.currentExceptionA[3].skipColon.strVal & - " [" & c.currentExceptionA[2].skipColon.strVal & "]") +proc reportException(c: PCtx; tos: PStackFrame, raised: PNode) = + # REFACTOR VM implementation relies on the `stackTrace` calling return, + # but in this proc we are retuning only from it's body, so calling + # `reportException()` does not stop vm loops. This needs to be cleaned up + # - invisible injection of the `return` to control flow of execution is + # an absolute monkey-tier hack. + stackTrace( + c, tos, c.exceptionInstr, + reportAst(rsemVmUnhandledException, raised)) + when not defined(nimComputedGoto): {.pragma: computedGoto.} @@ -384,7 +404,9 @@ proc opConv(c: PCtx; dest: var TFullReg, src: TFullReg, desttyp, srctyp: PType): dest.node.strVal = if f.ast.isNil: f.name.s else: f.ast.strVal else: for i in 0.. high(int): - stackTrace(c, tos, pc, formatErrorIndexBound(regs[rc].intVal, high(int))) + stackTrace(c, tos, pc, reportVmIdx(regs[rc].intVal, high(int))) + let idx = regs[rc].intVal.int let src = regs[rb].node if src.kind in {nkStrLit..nkTripleStrLit}: @@ -664,22 +710,22 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[ra].node = newNodeI(nkCharLit, c.debug[pc]) regs[ra].node.intVal = src.strVal[idx].ord else: - stackTrace(c, tos, pc, formatErrorIndexBound(idx, src.strVal.len-1)) + stackTrace(c, tos, pc, reportVmIdx(idx, src.strVal.len - 1)) elif src.kind notin {nkEmpty..nkFloat128Lit} and idx <% src.len: regs[ra].node = src[idx] else: - stackTrace(c, tos, pc, formatErrorIndexBound(idx, src.safeLen-1)) + stackTrace(c, tos, pc, reportVmIdx(idx, src.safeLen-1)) of opcLdArrAddr: # a = addr(b[c]) decodeBC(rkNodeAddr) if regs[rc].intVal > high(int): - stackTrace(c, tos, pc, formatErrorIndexBound(regs[rc].intVal, high(int))) + stackTrace(c, tos, pc, reportVmIdx(regs[rc].intVal, high(int))) let idx = regs[rc].intVal.int let src = if regs[rb].kind == rkNode: regs[rb].node else: regs[rb].nodeAddr[] if src.kind notin {nkEmpty..nkTripleStrLit} and idx <% src.len: regs[ra].nodeAddr = addr src.sons[idx] else: - stackTrace(c, tos, pc, formatErrorIndexBound(idx, src.safeLen-1)) + stackTrace(c, tos, pc, reportVmIdx(idx, src.safeLen-1)) of opcLdStrIdx: decodeBC(rkInt) let idx = regs[rc].intVal.int @@ -687,12 +733,13 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if idx <% s.len: regs[ra].intVal = s[idx].ord else: - stackTrace(c, tos, pc, formatErrorIndexBound(idx, s.len-1)) + stackTrace(c, tos, pc, reportVmIdx(idx, s.len-1)) of opcLdStrIdxAddr: # a = addr(b[c]); similar to opcLdArrAddr decodeBC(rkNode) if regs[rc].intVal > high(int): - stackTrace(c, tos, pc, formatErrorIndexBound(regs[rc].intVal, high(int))) + stackTrace(c, tos, pc, reportVmIdx(regs[rc].intVal, high(int))) + let idx = regs[rc].intVal.int let s = regs[rb].node.strVal.addr # or `byaddr` if idx <% s[].len: @@ -704,7 +751,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = node.flags.incl nfIsPtr regs[ra].node = node else: - stackTrace(c, tos, pc, formatErrorIndexBound(idx, s[].len-1)) + stackTrace(c, tos, pc, reportVmIdx(idx, s[].len-1)) + of opcWrArr: # a[b] = c decodeBC(rkNode) @@ -714,11 +762,13 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if idx <% arr.strVal.len: arr.strVal[idx] = chr(regs[rc].intVal) else: - stackTrace(c, tos, pc, formatErrorIndexBound(idx, arr.strVal.len-1)) + stackTrace(c, tos, pc, reportVmIdx(idx, arr.strVal.len-1)) + elif idx <% arr.len: writeField(arr[idx], regs[rc]) else: - stackTrace(c, tos, pc, formatErrorIndexBound(idx, arr.safeLen-1)) + stackTrace(c, tos, pc, reportVmIdx(idx, arr.safeLen - 1)) + of opcLdObj: # a = b.c decodeBC(rkNode) @@ -728,7 +778,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = # for nkPtrLit, this could be supported in the future, use something like: # derefPtrToReg(src.intVal + offsetof(src.typ, rc), typ_field, regs[ra], isAssign = false) # where we compute the offset in bytes for field rc - stackTrace(c, tos, pc, errNilAccess & " " & $("kind", src.kind, "typ", typeToString(src.typ), "rc", rc)) + stackTrace(c, tos, pc, reportAst(rsemVmNilAccess, src, str = $rc)) of nkObjConstr: let n = src[rc + 1].skipColon regs[ra].node = n @@ -741,7 +791,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let src = if regs[rb].kind == rkNode: regs[rb].node else: regs[rb].nodeAddr[] case src.kind of nkEmpty..nkNilLit: - stackTrace(c, tos, pc, errNilAccess) + stackTrace(c, tos, pc, reportSem(rsemVmNilAccess)) of nkObjConstr: let n = src.sons[rc + 1] if n.kind == nkExprColonExpr: @@ -757,7 +807,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let shiftedRb = rb + ord(regs[ra].node.kind == nkObjConstr) let dest = regs[ra].node if dest.kind == nkNilLit: - stackTrace(c, tos, pc, errNilAccess) + stackTrace(c, tos, pc, reportSem(rsemVmNilAccess)) elif dest[shiftedRb].kind == nkExprColonExpr: writeField(dest[shiftedRb][1], regs[rc]) else: @@ -768,7 +818,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if idx <% regs[ra].node.strVal.len: regs[ra].node.strVal[idx] = chr(regs[rc].intVal) else: - stackTrace(c, tos, pc, formatErrorIndexBound(idx, regs[ra].node.strVal.len-1)) + stackTrace(c, tos, pc, reportVmIdx(idx, regs[ra].node.strVal.len-1)) + of opcAddrReg: decodeB(rkRegisterAddr) regs[ra].regAddr = addr(regs[rb]) @@ -780,7 +831,9 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of rkNodeAddr: # bug #14339 regs[ra].nodeAddr = regs[rb].nodeAddr else: - stackTrace(c, tos, pc, "limited VM support for 'addr', got kind: " & $regs[rb].kind) + stackTrace(c, tos, pc, reportStr( + rsemVmErrInternal, + "limited VM support for 'addr', got kind: " & $regs[rb].kind)) of opcLdDeref: # a = b[] let ra = instr.regA @@ -800,7 +853,9 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = ensureKind(rkNode) regs[ra].node = regs[rb].node else: - stackTrace(c, tos, pc, errNilAccess & " kind: " & $regs[rb].kind) + stackTrace(c, tos, pc, reportStr( + rsemVmNilAccess, " kind: " & $regs[rb].kind)) + of opcWrDeref: # a[] = c; b unused let ra = instr.regA @@ -813,7 +868,9 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = # twice. # TODO: This should likely be handled differently in vmgen. let nAddr = regs[ra].nodeAddr - if nAddr[] == nil: stackTrace(c, tos, pc, "opcWrDeref internal error") # refs bug #16613 + if nAddr[] == nil: + stackTrace(c, tos, pc, reportStr( + rsemVmErrInternal, "opcWrDeref internal error")) # refs bug #16613 if (nfIsRef notin nAddr[].flags and nfIsRef notin n.flags): nAddr[][] = n[] else: nAddr[] = n of rkRegisterAddr: regs[ra].regAddr[] = regs[rc] @@ -822,7 +879,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if not maybeHandlePtr(regs[ra].node, regs[rc], true): regs[ra].node[] = regs[rc].regToNode[] regs[ra].node.flags.incl nfIsRef - else: stackTrace(c, tos, pc, errNilAccess) + else: stackTrace(c, tos, pc, reportSem(rsemVmNilAccess)) of opcAddInt: decodeBC(rkInt) let @@ -832,7 +889,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if (sum xor bVal) >= 0 or (sum xor cVal) >= 0: regs[ra].intVal = sum else: - stackTrace(c, tos, pc, errOverOrUnderflow) + stackTrace(c, tos, pc, reportSem(rsemVmOverOrUnderflow)) of opcAddImmInt: decodeBImm(rkInt) #message(c.config, c.debug[pc], warnUser, "came here") @@ -844,7 +901,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if (sum xor bVal) >= 0 or (sum xor cVal) >= 0: regs[ra].intVal = sum else: - stackTrace(c, tos, pc, errOverOrUnderflow) + stackTrace(c, tos, pc, reportSem(rsemVmOverOrUnderflow)) of opcSubInt: decodeBC(rkInt) let @@ -854,7 +911,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if (diff xor bVal) >= 0 or (diff xor not cVal) >= 0: regs[ra].intVal = diff else: - stackTrace(c, tos, pc, errOverOrUnderflow) + stackTrace(c, tos, pc, reportSem(rsemVmOverOrUnderflow)) of opcSubImmInt: decodeBImm(rkInt) let @@ -864,7 +921,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if (diff xor bVal) >= 0 or (diff xor not cVal) >= 0: regs[ra].intVal = diff else: - stackTrace(c, tos, pc, errOverOrUnderflow) + stackTrace(c, tos, pc, reportSem(rsemVmOverOrUnderflow)) of opcLenSeq: decodeBImm(rkInt) #assert regs[rb].kind == nkBracket @@ -918,15 +975,18 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = elif 32.0 * abs(resAsFloat - floatProd) <= abs(floatProd): regs[ra].intVal = product else: - stackTrace(c, tos, pc, errOverOrUnderflow) + stackTrace(c, tos, pc, reportSem(rsemVmOverOrUnderflow)) of opcDivInt: decodeBC(rkInt) - if regs[rc].intVal == 0: stackTrace(c, tos, pc, errConstantDivisionByZero) + if regs[rc].intVal == 0: + stackTrace(c, tos, pc, reportSem(rsemVmDivisionByConstZero)) else: regs[ra].intVal = regs[rb].intVal div regs[rc].intVal of opcModInt: decodeBC(rkInt) - if regs[rc].intVal == 0: stackTrace(c, tos, pc, errConstantDivisionByZero) - else: regs[ra].intVal = regs[rb].intVal mod regs[rc].intVal + if regs[rc].intVal == 0: + stackTrace(c, tos, pc, reportSem(rsemVmDivisionByConstZero)) + else: + regs[ra].intVal = regs[rb].intVal mod regs[rc].intVal of opcAddFloat: decodeBC(rkFloat) regs[ra].floatVal = regs[rb].floatVal + regs[rc].floatVal @@ -1071,7 +1131,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if val != int64.low: regs[ra].intVal = -val else: - stackTrace(c, tos, pc, errOverOrUnderflow) + stackTrace(c, tos, pc, reportSem(rsemVmOverOrUnderflow)) of opcUnaryMinusFloat: decodeB(rkFloat) assert regs[rb].kind == rkFloat @@ -1132,7 +1192,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if regs[ra].node.kind == nkBracket: regs[ra].node.add(copyValue(regs[rb].regToNode)) else: - stackTrace(c, tos, pc, errNilAccess) + stackTrace(c, tos, pc, reportSem(rsemVmNilAccess)) of opcGetImpl: decodeB(rkNode) var a = regs[rb].node @@ -1142,7 +1202,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = else: copyTree(a.sym.ast) regs[ra].node.flags.incl nfIsRef else: - stackTrace(c, tos, pc, "node is not a symbol") + stackTrace(c, tos, pc, reportSem(rsemVmNodeNotASymbol)) + of opcGetImplTransf: decodeB(rkNode) let a = regs[rb].node @@ -1164,7 +1225,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = else: newSymNode(a.sym.skipGenericOwner) regs[ra].node.flags.incl nfIsRef else: - stackTrace(c, tos, pc, "node is not a symbol") + stackTrace(c, tos, pc, reportSem(rsemVmNodeNotASymbol)) of opcSymIsInstantiationOf: decodeBC(rkInt) let a = regs[rb].node @@ -1175,16 +1236,21 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if sfFromGeneric in a.sym.flags and a.sym.owner == b.sym: 1 else: 0 else: - stackTrace(c, tos, pc, "node is not a proc symbol") + stackTrace(c, tos, pc, reportSem(rsemVmNodeNotAProcSymbol)) of opcEcho: let rb = instr.regB - template fn(s) = msgWriteln(c.config, s, {msgStdout, msgNoUnitSep}) - if rb == 1: fn(regs[ra].node.strVal) + template fn(s: string) = + localReport(c.config, InternalReport(msg: s, kind: rintEchoMessage)) + + if rb == 1: + fn(regs[ra].node.strVal) + else: var outp = "" for i in ra..ra+rb-1: #if regs[i].kind != rkNode: debug regs[i] outp.add(regs[i].node.strVal) + fn(outp) of opcContainsSet: decodeBC(rkInt) @@ -1213,9 +1279,13 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let rc = instr.regC if not (leValueConv(regs[rb].regToNode, regs[ra].regToNode) and leValueConv(regs[ra].regToNode, regs[rc].regToNode)): - stackTrace(c, tos, pc, + stackTrace(c, tos, pc, reportStr( + rsemVmIllegalConv, errIllegalConvFromXtoY % [ - $regs[ra].regToNode, "[" & $regs[rb].regToNode & ".." & $regs[rc].regToNode & "]"]) + $regs[ra].regToNode, + "[" & $regs[rb].regToNode & ".." & $regs[rc].regToNode & "]" + ])) + of opcIndCall, opcIndCallAsgn: # dest = call regStart, n; where regStart = fn, arg1, ... let rb = instr.regB @@ -1231,16 +1301,19 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = currentLineInfo: c.debug[pc])) elif importcCond(c, prc): if compiletimeFFI notin c.config.features: - globalError(c.config, c.debug[pc], "VM not allowed to do FFI, see `compiletimeFFI`") + globalReport(c.config, c.debug[pc], SemReport(kind: rsemVmEnableFFIToImportc)) # we pass 'tos.slots' instead of 'regs' so that the compiler can keep # 'regs' in a register: when hasFFI: if prc.position - 1 < 0: - globalError(c.config, c.debug[pc], - "VM call invalid: prc.position: " & $prc.position) + globalError( + c.config, + c.debug[pc], + reportStr(rsemVmGlobalError, "VM call invalid: prc.position: " & $prc.position)) + let prcValue = c.globals[prc.position-1] if prcValue.kind == nkEmpty: - globalError(c.config, c.debug[pc], "cannot run " & prc.name.s) + globalReport(c.config, c.debug[pc], "cannot run " & prc.name.s) var slots2: TNodeSeq slots2.setLen(tos.slots.len) for i in 0.. max: - stackTrace(c, tos, pc, "unhandled exception: value out of range") + stackTrace(c, tos, pc, reportSem(rsemVmOutOfRange)) of opcNarrowU: decodeB(rkInt) regs[ra].intVal = regs[ra].intVal and ((1'i64 shl rb)-1) @@ -1558,9 +1643,9 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let idx = regs[rc].intVal.int let src = regs[rb].node if src.kind in {nkEmpty..nkNilLit}: - stackTrace(c, tos, pc, "cannot get child of node kind: n" & $src.kind) + stackTrace(c, tos, pc, reportAst(rsemVmCannotGetChild, src)) elif idx >=% src.len: - stackTrace(c, tos, pc, formatErrorIndexBound(idx, src.len-1)) + stackTrace(c, tos, pc, reportVmIdx(idx, src.len - 1)) else: regs[ra].node = src[idx] of opcNSetChild: @@ -1568,20 +1653,21 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let idx = regs[rb].intVal.int var dest = regs[ra].node if nfSem in dest.flags and allowSemcheckedAstModification notin c.config.legacyFeatures: - stackTrace(c, tos, pc, "typechecked nodes may not be modified") + stackTrace(c, tos, pc, reportSem(rsemVmCannotModifyTypechecked)) elif dest.kind in {nkEmpty..nkNilLit}: - stackTrace(c, tos, pc, "cannot set child of node kind: n" & $dest.kind) + stackTrace(c, tos, pc, reportAst(rsemVmCannotSetChild, dest)) elif idx >=% dest.len: - stackTrace(c, tos, pc, formatErrorIndexBound(idx, dest.len-1)) + stackTrace(c, tos, pc, reportVmIdx(idx, dest.len - 1)) else: dest[idx] = regs[rc].node of opcNAdd: decodeBC(rkNode) var u = regs[rb].node if nfSem in u.flags and allowSemcheckedAstModification notin c.config.legacyFeatures: - stackTrace(c, tos, pc, "typechecked nodes may not be modified") + stackTrace(c, tos, pc, reportSem(rsemVmCannotModifyTypechecked)) elif u.kind in {nkEmpty..nkNilLit}: - stackTrace(c, tos, pc, "cannot add to node kind: n" & $u.kind) + echo c.config $ c.debug[pc] + stackTrace(c, tos, pc, reportAst(rsemVmCannotAddChild, u)) else: u.add(regs[rc].node) regs[ra].node = u @@ -1590,9 +1676,9 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let x = regs[rc].node var u = regs[rb].node if nfSem in u.flags and allowSemcheckedAstModification notin c.config.legacyFeatures: - stackTrace(c, tos, pc, "typechecked nodes may not be modified") + stackTrace(c, tos, pc, reportSem(rsemVmCannotModifyTypechecked)) elif u.kind in {nkEmpty..nkNilLit}: - stackTrace(c, tos, pc, "cannot add to node kind: n" & $u.kind) + stackTrace(c, tos, pc, reportAst(rsemVmCannotAddChild, u)) else: for i in 0..Parser->Vm`) + decodeB(rkNode) - # c.debug[pc].line.int - countLines(regs[rb].strVal) ? - var error: string - let ast = parseString(regs[rb].node.strVal, c.cache, c.config, - toFullPath(c.config, c.debug[pc]), c.debug[pc].line.int, - proc (conf: ConfigRef; info: TLineInfo; msg: TMsgKind; arg: string) {.nosinks.} = - if error.len == 0 and msg <= errMax: - error = formatMsg(conf, info, msg, arg)) - if error.len > 0: + + type TemporaryExceptionHack = ref object of CatchableError + + var error = reportEmpty + let oldHook = c.config.structuredReportHook + var ast: PNode + c.config.structuredReportHook = proc( + conf: ConfigRef, report: Report + ): TErrorHandling = + # QUESTION This check might be affected by current severity + # configurations, maybe it makes sense to do a hack-in that would + # ignore all user-provided CLI otions? + if report.category in {repParser, repLexer} and + conf.severity(report) == rsevError: + error = report + raise TemporaryExceptionHack() + + else: + return oldHook(conf, report) + + try: + ast = parseString( + regs[rb].node.strVal, + c.cache, + c.config, + toFullPath(c.config, c.debug[pc]), + c.debug[pc].line.int + ) + + except TemporaryExceptionHack: + discard + + c.config.structuredReportHook = oldHook + + if error.kind > repNone: c.errorFlag = error - elif ast.len != 1: - c.errorFlag = formatMsg(c.config, c.debug[pc], errGenerated, - "expected expression, but got multiple statements") + + # Handling both statement and expression in this case branch, so + # first checking for `parseExpr()` postconditions and then repacking + # the ast as needed. + elif ast.len != 1 and instr.opcode == opcParseExprToAst: + c.errorFlag = SemReport(kind: rsemVmOpcParseExpectedExpression).wrap() + + elif instr.opcode == opcParseStmtToAst: + regs[ra].node = ast + else: + # Seems like parser always generates `stmtList`, so taking first + # node here (checked for correct lenght earlier) regs[ra].node = ast[0] - of opcParseStmtToAst: - decodeB(rkNode) - var error: string - let ast = parseString(regs[rb].node.strVal, c.cache, c.config, - toFullPath(c.config, c.debug[pc]), c.debug[pc].line.int, - proc (conf: ConfigRef; info: TLineInfo; msg: TMsgKind; arg: string) {.nosinks.} = - if error.len == 0 and msg <= errMax: - error = formatMsg(conf, info, msg, arg)) - if error.len > 0: - c.errorFlag = error - else: - regs[ra].node = ast + of opcQueryErrorFlag: + # REFACTOR HACK Only `parseExpr()` and `parseStmt()` appear to be + # using error flag - we might as well set them directly? Anyway, + # previous error formatting reused the same error message as + # generated by reporting system, but now I need to convert the + # `Report` object into string that can be read later by user VM code. + createStr regs[ra] - regs[ra].node.strVal = c.errorFlag - c.errorFlag.setLen 0 + if c.errorFlag.kind != repNone: + # Not sure if there is any better solution - I /do/ want to make + # sure that error reported to the user in the VM is the same as one + # I would report on the CLI, but at the same time this still looks + # like an overly hacky approach + regs[ra].node.strVal = "Error: " & c.config.reportBody(c.errorFlag) + # ^ `reportBody()` only returns main part of + # the report, so need to add `"Error: "` + # manally to stay consistent with the old + # output. + + c.errorFlag = reportEmpty + + of opcCallSite: ensureKind(rkNode) if c.callsite != nil: regs[ra].node = c.callsite - else: stackTrace(c, tos, pc, errFieldXNotFound & "callsite") + else: stackTrace(c, tos, pc, reportStr(rsemVmFieldNotFound, "callsite")) of opcNGetLineInfo: decodeBImm(rkNode) let n = regs[rb].node @@ -1805,7 +1962,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of 2: # getColumn regs[ra].node = newIntNode(nkIntLit, n.info.col) else: - internalAssert c.config, false + internalAssert(c.config, false, "Unexpected opcNGetLineInfo action code") + regs[ra].node.info = n.info regs[ra].node.typ = n.typ of opcNSetLineInfo: @@ -1865,7 +2023,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcStrToIdent: decodeB(rkNode) if regs[rb].node.kind notin {nkStrLit..nkTripleStrLit}: - stackTrace(c, tos, pc, errFieldXNotFound & "strVal") + stackTrace(c, tos, pc, reportStr(rsemVmFieldNotFound, "strVal")) else: regs[ra].node = newNodeI(nkIdent, c.debug[pc]) regs[ra].node.ident = getIdent(c.cache, regs[rb].node.strVal) @@ -1886,9 +2044,12 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let srctyp = c.types[c.code[pc].regBx - wordExcess] if opConv(c, regs[ra], regs[rb], desttyp, srctyp): - stackTrace(c, tos, pc, + stackTrace(c, tos, pc, reportStr( + rsemVmIllegalConv, errIllegalConvFromXtoY % [ - typeToString(srctyp), typeToString(desttyp)]) + typeToString(srctyp), + typeToString(desttyp) + ])) of opcCast: let rb = instr.regB inc pc @@ -1902,7 +2063,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = # asgnRef(regs[ra], dest) putIntoReg(regs[ra], dest) else: - globalError(c.config, c.debug[pc], "cannot evaluate cast") + globalReport(c.config, c.debug[pc], reportSem(rsemVmCannotCast)) + of opcNSetIntVal: decodeB(rkNode) var dest = regs[ra].node @@ -1910,9 +2072,11 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[rb].kind in {rkInt}: dest.intVal = regs[rb].intVal elif dest.kind == nkSym and dest.sym.kind == skEnumField: - stackTrace(c, tos, pc, "`intVal` cannot be changed for an enum symbol.") + stackTrace(c, tos, pc, reportStr( + rsemVmErrInternal, + "`intVal` cannot be changed for an enum symbol.")) else: - stackTrace(c, tos, pc, errFieldXNotFound & "intVal") + stackTrace(c, tos, pc, reportStr(rsemVmFieldNotFound, "intVal")) of opcNSetFloatVal: decodeB(rkNode) var dest = regs[ra].node @@ -1920,26 +2084,32 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[rb].kind in {rkFloat}: dest.floatVal = regs[rb].floatVal else: - stackTrace(c, tos, pc, errFieldXNotFound & "floatVal") + stackTrace(c, tos, pc, reportStr(rsemVmFieldNotFound, "floatVal")) of opcNSetSymbol: decodeB(rkNode) var dest = regs[ra].node if dest.kind == nkSym and regs[rb].node.kind == nkSym: dest.sym = regs[rb].node.sym else: - stackTrace(c, tos, pc, errFieldXNotFound & "symbol") + stackTrace(c, tos, pc, reportStr(rsemVmFieldNotFound, "symbol")) of opcNSetIdent: decodeB(rkNode) var dest = regs[ra].node if dest.kind == nkIdent and regs[rb].node.kind == nkIdent: dest.ident = regs[rb].node.ident else: - stackTrace(c, tos, pc, errFieldXNotFound & "ident") + stackTrace(c, tos, pc, reportStr(rsemVmFieldNotFound, "ident")) of opcNSetType: decodeB(rkNode) let b = regs[rb].node - internalAssert c.config, b.kind == nkSym and b.sym.kind == skType - internalAssert c.config, regs[ra].node != nil + internalAssert( + c.config, + b.kind == nkSym and b.sym.kind == skType, + "Canot set type to a non-skType symbol") + + internalAssert( + c.config, regs[ra].node != nil, "Target node must not be nil") + regs[ra].node.typ = b.sym.typ of opcNSetStrVal: decodeB(rkNode) @@ -1950,7 +2120,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = elif dest.kind == nkCommentStmt and regs[rb].kind in {rkNode}: dest.comment = regs[rb].node.strVal else: - stackTrace(c, tos, pc, errFieldXNotFound & "strVal") + stackTrace(c, tos, pc, reportStr(rsemVmFieldNotFound, "strVal")) of opcNNewNimNode: decodeBC(rkNode) var k = regs[rb].intVal @@ -2044,7 +2214,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if contains(g.cacheSeqs, destKey) and idx <% g.cacheSeqs[destKey].len: regs[ra].node = g.cacheSeqs[destKey][idx.int] else: - stackTrace(c, tos, pc, formatErrorIndexBound(idx, g.cacheSeqs[destKey].len-1)) + stackTrace(c, tos, pc, reportVmIdx(idx, g.cacheSeqs[destKey].len-1)) + of opcNctPut: let g = c.graph let destKey = regs[ra].node.strVal @@ -2056,7 +2227,9 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = g.cacheTables[destKey].add(key, val) recordPut(c, c.debug[pc], destKey, key, val) else: - stackTrace(c, tos, pc, "key already exists: " & key) + stackTrace(c, tos, pc, reportStr( + rsemVmCacheKeyAlreadyExists, destKey)) + of opcNctLen: let g = c.graph decodeB(rkInt) @@ -2072,9 +2245,9 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if contains(g.cacheTables[destKey], key): regs[ra].node = getOrDefault(g.cacheTables[destKey], key) else: - stackTrace(c, tos, pc, "key does not exist: " & key) + stackTrace(c, tos, pc, reportStr(rsemVmMissingCacheKey, destKey)) else: - stackTrace(c, tos, pc, "key does not exist: " & destKey) + stackTrace(c, tos, pc, reportStr(rsemVmMissingCacheKey, destKey)) of opcNctHasNext: let g = c.graph decodeBC(rkInt) @@ -2094,14 +2267,14 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[ra].node = newTree(nkTupleConstr, newStrNode(k, c.debug[pc]), v, newIntNode(nkIntLit, nextIndex)) else: - stackTrace(c, tos, pc, "key does not exist: " & destKey) + stackTrace(c, tos, pc, reportStr(rsemVmMissingCacheKey, destKey)) of opcTypeTrait: # XXX only supports 'name' for now; we can use regC to encode the # type trait operation decodeB(rkNode) var typ = regs[rb].node.typ - internalAssert c.config, typ != nil + internalAssert(c.config, typ != nil, "") while typ.kind == tyTypeDesc and typ.len > 0: typ = typ[0] createStr regs[ra] regs[ra].node.strVal = typ.typeToString(preferExported) @@ -2119,9 +2292,13 @@ proc execProc*(c: PCtx; sym: PSym; args: openArray[PNode]): PNode = c.loopIterations = c.config.maxLoopIterationsVM if sym.kind in routineKinds: if sym.typ.len-1 != args.len: - localError(c.config, sym.info, - "NimScript: expected $# arguments, but got $#" % [ - $(sym.typ.len-1), $args.len]) + localReport(c.config, sym.info, SemReport( + kind: rsemWrongNumberOfArguments, + sym: sym, + countMismatch: ( + expected: toInt128(sym.typ.len - 1), + got: toInt128(args.len)))) + else: let start = genProc(c, sym) @@ -2138,8 +2315,7 @@ proc execProc*(c: PCtx; sym: PSym; args: openArray[PNode]): PNode = result = rawExecute(c, start, tos).regToNode else: - localError(c.config, sym.info, - "NimScript: attempt to call non-routine: " & sym.name.s) + localReport(c.config, sym.info, reportSym(rsemVmCallingNonRoutine, sym)) proc evalStmt*(c: PCtx, n: PNode) = let n = transformExpr(c.graph, c.idgen, c.module, n) @@ -2159,17 +2335,18 @@ proc evalExpr*(c: PCtx, n: PNode): PNode = result = execute(c, start) proc getGlobalValue*(c: PCtx; s: PSym): PNode = - internalAssert c.config, s.kind in {skLet, skVar} and sfGlobal in s.flags + internalAssert(c.config, s.kind in {skLet, skVar} and sfGlobal in s.flags, "") result = c.globals[s.position-1] proc setGlobalValue*(c: PCtx; s: PSym, val: PNode) = ## Does not do type checking so ensure the `val` matches the `s.typ` - internalAssert c.config, s.kind in {skLet, skVar} and sfGlobal in s.flags + internalAssert(c.config, s.kind in {skLet, skVar} and sfGlobal in s.flags, "") c.globals[s.position-1] = val include vmops proc setupGlobalCtx*(module: PSym; graph: ModuleGraph; idgen: IdGenerator) = + addInNimDebugUtils(graph.config, "setupGlobalCtx") if graph.vm.isNil: graph.vm = newCtx(module, graph.cache, graph, idgen) registerAdditionalOps(PCtx graph.vm) @@ -2203,6 +2380,7 @@ const evalPass* = makePass(myOpen, myProcess, myClose) proc evalConstExprAux(module: PSym; idgen: IdGenerator; g: ModuleGraph; prc: PSym, n: PNode, mode: TEvalMode): PNode = + addInNimDebugUtils(g.config, "evalConstExprAux") #if g.config.errorCounter > 0: return n let n = transformExpr(g, idgen, module, n) setupGlobalCtx(module, g, idgen) @@ -2212,7 +2390,9 @@ proc evalConstExprAux(module: PSym; idgen: IdGenerator; let start = genExpr(c, n, requiresValue = mode!=emStaticStmt) if c.code[start].opcode == opcEof: return newNodeI(nkEmpty, n.info) assert c.code[start].opcode != opcEof - when debugEchoCode: c.echoCode start + when debugEchoCode: + c.codeListing(prc, n) + var tos = PStackFrame(prc: prc, comesFrom: 0, next: nil) newSeq(tos.slots, c.prc.regInfo.len) #for i in 0.. 0: return errorNode(idgen, module, n) - # XXX globalError() is ugly here, but I don't know a better solution for now + # XXX globalReport() is ugly here, but I don't know a better solution for now inc(g.config.evalMacroCounter) if g.config.evalMacroCounter > evalMacroLimit: - globalError(g.config, n.info, "macro instantiation too nested") + globalReport(g.config, n.info, reportAst( + rsemMacroInstantiationTooNested, n)) # immediate macros can bypass any type and arity checking so we check the # arity here too: if sym.typ.len > n.safeLen and sym.typ.len > 1: - globalError(g.config, n.info, "in call '$#' got $#, but expected $# argument(s)" % [ - n.renderTree, $(n.safeLen-1), $(sym.typ.len-1)]) + globalReport(g.config, n.info, SemReport( + kind: rsemWrongNumberOfArguments, + ast: n, + countMismatch: ( + expected: toInt128(sym.typ.len - 1), + got: toInt128(n.safeLen - 1)))) setupGlobalCtx(module, g, idgen) var c = PCtx g.vm @@ -2333,13 +2518,19 @@ proc evalMacroCall*(module: PSym; idgen: IdGenerator; g: ModuleGraph; templInstC else: dec(g.config.evalMacroCounter) c.callsite = nil - localError(c.config, n.info, "expected " & $gp.len & - " generic parameter(s)") + localReport(c.config, n.info, SemReport( + kind: rsemWrongNumberOfGenericParams, + countMismatch: ( + expected: toInt128(gp.len), + got: toInt128(idx)))) + # temporary storage: #for i in L..= high(TRegister): - globalError(cc.config, cc.bestEffort, "VM problem: too many registers required") + globalReport(cc.config, cc.bestEffort, SemReport( + kind: rsemTooManyRegistersRequired)) + result = TRegister(max(c.regInfo.len, start)) c.regInfo.setLen int(result)+1 c.regInfo[result] = (inUse: true, kind: k) @@ -261,7 +254,7 @@ proc getTempRange(cc: PCtx; n: int; kind: TSlotKind): TRegister = for k in result..result+n-1: c.regInfo[k] = (inUse: true, kind: kind) return if c.regInfo.len+n >= high(TRegister): - globalError(cc.config, cc.bestEffort, "VM problem: too many registers required") + globalReport(cc.config, cc.bestEffort, reportSem(rsemTooManyRegistersRequired)) result = TRegister(c.regInfo.len) setLen c.regInfo, c.regInfo.len+n for k in result..result+n-1: c.regInfo[k] = (inUse: true, kind: kind) @@ -374,7 +367,7 @@ proc genBreak(c: PCtx; n: PNode) = if c.prc.blocks[i].label == n[0].sym: c.prc.blocks[i].fixups.add lab1 return - globalError(c.config, n.info, "VM problem: cannot find 'break' target") + globalReport(c.config, n.info, reportSem(rsemVmCannotFindBreakTarget)) else: c.prc.blocks[c.prc.blocks.high].fixups.add lab1 @@ -442,7 +435,7 @@ proc rawGenLiteral(c: PCtx; n: PNode): int = #assert(n.kind != nkCall) n.flags.incl nfAllConst c.constants.add n - internalAssert c.config, result < regBxMax + internalAssert c.config, result < regBxMax, "" proc sameConstant*(a, b: PNode): bool = result = false @@ -476,8 +469,7 @@ proc genLiteral(c: PCtx; n: PNode): int = proc unused(c: PCtx; n: PNode; x: TDest) {.inline.} = if x >= 0: - #debug(n) - globalError(c.config, n.info, "not unused") + globalReport(c.config, n.info, reportAst(rsemVmNotUnused, n)) proc genCase(c: PCtx; n: PNode; dest: var TDest) = # if (!expr1) goto lab1; @@ -523,7 +515,7 @@ proc genType(c: PCtx; typ: PType): int = if sameType(t, typ): return i result = c.types.len c.types.add(typ) - internalAssert(c.config, result <= regBxMax) + internalAssert(c.config, result <= regBxMax, "") proc genTry(c: PCtx; n: PNode; dest: var TDest) = if dest < 0 and not isEmptyType(n.typ): dest = getTemp(c, n.typ) @@ -599,7 +591,7 @@ proc genCall(c: PCtx; n: PNode; dest: var TDest) = var r: TRegister = x+i c.gen(n[i], r, {gfIsParam}) if i >= fntyp.len: - internalAssert c.config, tfVarargs in fntyp.flags + internalAssert(c.config, tfVarargs in fntyp.flags, "") c.gABx(n, opcSetType, r, c.genType(n[i].typ)) if dest < 0: c.gABC(n, opcIndCall, 0, x, n.len) @@ -616,11 +608,12 @@ proc needsAsgnPatch(n: PNode): bool = proc genField(c: PCtx; n: PNode): TRegister = if n.kind != nkSym or n.sym.kind != skField: - globalError(c.config, n.info, "no field symbol") + globalReport(c.config, n.info, reportAst(rsemNotAFieldSymbol, n)) + let s = n.sym if s.position > high(typeof(result)): - globalError(c.config, n.info, - "too large offset! cannot generate code for: " & s.name.s) + globalReport(c.config, n.info, reportSym(rsemVmTooLargetOffset, s)) + result = s.position proc genIndex(c: PCtx; n: PNode; arr: PType): TRegister = @@ -666,7 +659,8 @@ proc genAsgnPatch(c: PCtx; le: PNode, value: TRegister) = c.freeTemp(dest) of nkError: # XXX: do a better job with error generation - globalError(c.config, le.info, "cannot generate code for: " & $le) + globalReport(c.config, le.info, reportAst(rsemVmCannotGenerateCode, le)) + else: discard @@ -929,7 +923,10 @@ proc genCastIntFloat(c: PCtx; n: PNode; dest: var TDest) = genLit(c, n[1], dest) else: # todo: support cast from tyInt to tyRef - globalError(c.config, n.info, "VM does not support 'cast' from " & $src.kind & " to " & $dst.kind) + globalReport(c.config, n.info, SemReport( + kind: rsemVmCannotCast, + typeMismatch: @[c.config.typeMismatch( + actual = dst, formal = src)])) proc genVoidABC(c: PCtx, n: PNode, dest: TDest, opcode: TOpcode) = unused(c, n, dest) @@ -953,7 +950,8 @@ proc genBindSym(c: PCtx; n: PNode; dest: var TDest) = if dest < 0: dest = c.getTemp(n.typ) c.gABx(n, opcNBindSym, dest, idx) else: - localError(c.config, n.info, "invalid bindSym usage") + localReport(c.config, n.info, reportAst(rsemVmInvalidBindSym, n)) + else: # experimental bindSym if dest < 0: dest = c.getTemp(n.typ) @@ -1312,10 +1310,13 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = of "getLine": genUnaryABI(c, n, dest, opcNGetLineInfo, 1) of "getColumn": genUnaryABI(c, n, dest, opcNGetLineInfo, 2) of "copyLineInfo": - internalAssert c.config, n.len == 3 + internalAssert(c.config, n.len == 3, "Line info expects tuple with three elements") unused(c, n, dest) genBinaryStmt(c, n, opcNSetLineInfo) - else: internalAssert c.config, false + else: + internalAssert( + c.config, false, "Unexpected mNLineInfo symbol name - " & n[0].sym.name.s) + of mNHint: unused(c, n, dest) genBinaryStmt(c, n, opcNHint) @@ -1338,7 +1339,9 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = c.genCall(n, dest) of mExpandToAst: if n.len != 2: - globalError(c.config, n.info, "expandToAst requires 1 argument") + globalReport(c.config, n.info, reportStr( + rsemVmBadExpandToAst, "expandToAst requires 1 argument")) + let arg = n[1] if arg.kind in nkCallKinds: #if arg[0].kind != nkSym or arg[0].sym.kind notin {skTemplate, skMacro}: @@ -1348,13 +1351,21 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = # do not call clearDest(n, dest) here as getAst has a meta-type as such # produces a value else: - globalError(c.config, n.info, "expandToAst requires a call expression") + globalReport(c.config, n.info, reportStr( + rsemVmBadExpandToAst, "expandToAst requires a call expression")) + of mSizeOf: - globalError(c.config, n.info, sizeOfLikeMsg("sizeof")) + globalReport(c.config, n.info, reportStr( + rsemMissingImportcCompleteStruct, "sizeof")) + of mAlignOf: - globalError(c.config, n.info, sizeOfLikeMsg("alignof")) + globalReport(c.config, n.info, reportStr( + rsemMissingImportcCompleteStruct, "alignof")) + of mOffsetOf: - globalError(c.config, n.info, sizeOfLikeMsg("offsetof")) + globalReport(c.config, n.info, reportStr( + rsemMissingImportcCompleteStruct, "offsetof")) + of mRunnableExamples: discard "just ignore any call to runnableExamples" of mDestroy, mTrace: discard "ignore calls to the default destructor" @@ -1373,7 +1384,9 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = c.genUnaryABC(n, dest, opcNodeId) else: # mGCref, mGCunref, - globalError(c.config, n.info, "cannot generate code for: " & $m) + globalReport(c.config, n.info, reportStr( + rsemVmCannotGenerateCode, $m)) + proc unneededIndirection(n: PNode): bool = n.typ.skipTypes(abstractInstOwned-{tyTypeDesc}).kind == tyRef @@ -1451,8 +1464,17 @@ proc setSlot(c: PCtx; v: PSym) = v.position = getFreeRegister(c, if v.kind == skLet: slotFixedLet else: slotFixedVar, start = 1) proc cannotEval(c: PCtx; n: PNode) {.noinline.} = - globalError(c.config, n.info, "cannot evaluate at compile time: " & - n.renderTree) + globalReport(c.config, n.info, reportAst(rsemVmCannotEvaluateAtComptime, n)) + # HACK REFACTOR FIXME With current compiler 'arhitecture' this call + # MUST raise an exception that is captured by `sem.tryConstExpr` in sem. In + # the future this needs to be removed, `checkCanEval` must return a + # `true/false` bool. + # + # For more elaborate explanation of the related code see the comment + # https://github.com/nim-works/nimskull/pull/94#issuecomment-1006927599 + # + # This code must not be reached + raiseRecoverableError("vmgen.cannotEval failed") proc isOwnedBy(a, b: PSym): bool = var a = a.owner @@ -1510,7 +1532,8 @@ proc genAsgn(c: PCtx; le, ri: PNode; requiresCopy: bool) = case le.kind of nkError: # XXX: do a better job with error generation - globalError(c.config, le.info, "cannot generate code for: " & $le) + globalReport(c.config, le.info, reportAst(rsemVmCannotGenerateCode, le)) + of nkBracketExpr: let dest = c.genx(le[0], {gfNode}) let idx = c.genIndex(le[1], le[0].typ) @@ -1557,8 +1580,11 @@ proc genAsgn(c: PCtx; le, ri: PNode; requiresCopy: bool) = c.freeTemp(val) else: if s.kind == skForVar: c.setSlot s - internalAssert c.config, s.position > 0 or (s.position == 0 and - s.kind in {skParam, skResult}) + internalAssert( + c.config, + s.position > 0 or (s.position == 0 and s.kind in {skParam, skResult}), + "") + var dest: TRegister = s.position + ord(s.kind == skParam) assert le.typ != nil if needsAdditionalCopy(le) and s.kind in {skResult, skVar, skParam}: @@ -1590,11 +1616,9 @@ proc importcSym(c: PCtx; info: TLineInfo; s: PSym) = c.globals.add(importcSymbol(c.config, s)) s.position = c.globals.len else: - localError(c.config, info, - "VM is not allowed to 'importc' without --experimental:compiletimeFFI") + localReport(c.config, info, reportSym(rsemVmEnableFFIToImportc, s)) else: - localError(c.config, info, - "cannot 'importc' variable at compile time; " & s.name.s) + localReport(c.config, info, reportSym(rsemVmCannotImportc, s)) proc getNullValue*(typ: PType, info: TLineInfo; conf: ConfigRef): PNode @@ -1613,6 +1637,7 @@ proc genGlobalInit(c: PCtx; n: PNode; s: PSym) = c.freeTemp(tmp) proc genRdVar(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = + addInNimDebugUtils(c.config, "genRdVar") # gfNodeAddr and gfNode are mutually exclusive assert card(flags * {gfNodeAddr, gfNode}) < 2 let s = n.sym @@ -1697,7 +1722,11 @@ proc genObjAccess(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = c.freeTemp(a) proc genCheckedObjAccessAux(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = - internalAssert c.config, n.kind == nkCheckedFieldExpr + internalAssert( + c.config, + n.kind == nkCheckedFieldExpr, + "genCheckedObjAccessAux requires checked field node") + # nkDotExpr to access the requested field let accessExpr = n[0] # nkCall to check if the discriminant is valid @@ -1709,7 +1738,8 @@ proc genCheckedObjAccessAux(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags # Discriminant symbol let disc = checkExpr[2] - internalAssert c.config, disc.sym.kind == skField + internalAssert( + c.config, disc.sym.kind == skField, "Discriminant symbol must be a field") # Load the object in `dest` c.gen(accessExpr[0], dest, flags) @@ -1743,7 +1773,10 @@ proc genCheckedObjAccess(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = let accessExpr = n[0] # Field symbol var field = accessExpr[1] - internalAssert c.config, field.sym.kind == skField + internalAssert( + c.config, + field.sym.kind == skField, + "Access expression must be a field, but found " & $field.sym.kind) # Load the content now if dest < 0: dest = c.getTemp(n.typ) @@ -1790,7 +1823,9 @@ proc getNullValueAux(t: PType; obj: PNode, result: PNode; conf: ConfigRef; currP result.add field doAssert obj.sym.position == currPosition inc currPosition - else: globalError(conf, result.info, "cannot create null element for: " & $obj) + else: + globalReport(conf, result.info, reportAst( + rsemVmCannotCreateNullElement, obj)) proc getNullValue(typ: PType, info: TLineInfo; conf: ConfigRef): PNode = var t = skipTypes(typ, abstractRange+{tyStatic, tyOwned}-{tyTypeDesc}) @@ -1833,7 +1868,8 @@ proc getNullValue(typ: PType, info: TLineInfo; conf: ConfigRef): PNode = of tySequence, tyOpenArray: result = newNodeIT(nkBracket, info, t) else: - globalError(conf, info, "cannot create null element for: " & $t.kind) + globalReport(conf, info, reportTyp(rsemVmCannotCreateNullElement, t)) + result = newNodeI(nkEmpty, info) proc genVarSection(c: PCtx; n: PNode) = @@ -1945,7 +1981,8 @@ proc genObjConstr(c: PCtx, n: PNode, dest: var TDest) = dest, idx, tmp) c.freeTemp(tmp) else: - globalError(c.config, n.info, "invalid object constructor") + globalReport(c.config, n.info, reportAst( + rsemVmInvalidObjectConstructor, it)) proc genTupleConstr(c: PCtx, n: PNode, dest: var TDest) = if dest < 0: dest = c.getTemp(n.typ) @@ -1988,22 +2025,25 @@ proc procIsCallback(c: PCtx; s: PSym): bool = dec i proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = + addInNimDebugUtils(c.config, "genExpr(PNode/TDest)") when defined(nimCompilerStacktraceHints): setFrameMsg c.config$n.info & " " & $n.kind & " " & $flags case n.kind of nkError: # XXX: do a better job with error generation - globalError(c.config, n.info, "cannot generate code for: " & $n) + globalReport(c.config, n.info, reportAst(rsemVmCannotGenerateCode, n)) + of nkSym: let s = n.sym checkCanEval(c, n) case s.kind of skVar, skForVar, skTemp, skLet, skParam, skResult: genRdVar(c, n, dest, flags) + of skProc, skFunc, skConverter, skMacro, skTemplate, skMethod, skIterator: # 'skTemplate' is only allowed for 'getAst' support: if s.kind == skIterator and s.typ.callConv == TCallingConvention.ccClosure: - globalError(c.config, n.info, "Closure iterators are not supported by VM!") + globalReport(c.config, n.info, reportSym(rsemVmNoClosureIterators, s)) if procIsCallback(c, s): discard elif importcCond(c, s): c.importcSym(n.info, s) genLit(c, n, dest) @@ -2026,17 +2066,23 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = if c.prc.sym != nil and c.prc.sym.kind == skMacro: genRdVar(c, n, dest, flags) else: - globalError(c.config, n.info, "cannot generate code for: " & s.name.s) + globalReport(c.config, n.info, reportSym( + rsemVmCannotGenerateCode, s, + str = "Attempt to generate VM code for generic parameter in non-macro proc" + )) + else: - globalError(c.config, n.info, "cannot generate code for: " & s.name.s) + globalReport(c.config, n.info, reportSym( + rsemVmCannotGenerateCode, s, + str = "Unexpected symbol for VM code - " & $s.kind + )) of nkCallKinds: if n[0].kind == nkSym: let s = n[0].sym if s.magic != mNone: genMagic(c, n, dest, s.magic) elif s.kind == skMethod: - localError(c.config, n.info, "cannot call method " & s.name.s & - " at compile time") + localReport(c.config, n.info, reportSym(rsemVmCannotCallMethod, s)) else: genCall(c, n, dest) clearDest(c, n, dest) @@ -2140,7 +2186,7 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = if n.typ != nil and n.typ.isCompileTimeOnly: genTypeLit(c, n.typ, dest) else: - globalError(c.config, n.info, "cannot generate VM code for " & $n) + globalReport(c.config, n.info, reportAst(rsemVmCannotGenerateCode, n)) proc removeLastEof(c: PCtx) = let last = c.code.len-1 @@ -2157,16 +2203,18 @@ proc genStmt*(c: PCtx; n: PNode): int = c.gen(n, d) c.gABC(n, opcEof) if d >= 0: - globalError(c.config, n.info, "VM problem: dest register is set") + internalError(c.config, n.info, "VM problem: dest register is set") proc genExpr*(c: PCtx; n: PNode, requiresValue = true): int = + addInNimDebugUtils(c.config, "genExpr") c.removeLastEof result = c.code.len var d: TDest = -1 c.gen(n, d) if d < 0: if requiresValue: - globalError(c.config, n.info, "VM problem: dest register is not set") + internalError(c.config, n.info, "VM problem: dest register is not set") + d = 0 c.gABC(n, opcEof, d) @@ -2174,6 +2222,7 @@ proc genExpr*(c: PCtx; n: PNode, requiresValue = true): int = #c.echoCode(result) proc genParams(c: PCtx; params: PNode) = + addInNimDebugUtils(c.config, "genParams") # res.sym.position is already 0 setLen(c.prc.regInfo, max(params.len, 1)) c.prc.regInfo[0] = (inUse: true, kind: slotFixedVar) @@ -2181,10 +2230,17 @@ proc genParams(c: PCtx; params: PNode) = c.prc.regInfo[i] = (inUse: true, kind: slotFixedLet) proc finalJumpTarget(c: PCtx; pc, diff: int) = - internalAssert(c.config, regBxMin < diff and diff < regBxMax) + internalAssert( + c.config, + regBxMin < diff and diff < regBxMax, + "Jump target is not in range of min/max registers - $1 < $2 < $3 failed" % [ + $regBxMin, $diff, $regBxMax]) + let oldInstr = c.code[pc] # opcode and regA stay the same: - c.code[pc] = ((oldInstr.TInstrType and ((regOMask shl regOShift) or (regAMask shl regAShift))).TInstrType or + c.code[pc] = (( + oldInstr.TInstrType and + ((regOMask shl regOShift) or (regAMask shl regAShift))).TInstrType or TInstrType(diff+wordExcess) shl regBxShift).TInstr proc genGenericParams(c: PCtx; gp: PNode) = @@ -2237,6 +2293,7 @@ proc optimizeJumps(c: PCtx; start: int) = else: discard proc genProc(c: PCtx; s: PSym): int = + addInNimDebugUtils(c.config, "genProc") let pos = c.procToCodePos.getOrDefault(s.id) wasNotGenProcBefore = pos == 0 @@ -2247,8 +2304,6 @@ proc genProc(c: PCtx; s: PSym): int = # 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. - #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 if last >= 0 and c.code[last].opcode == opcEof: diff --git a/compiler/vmops.nim b/compiler/vmops.nim index fa9a83655cd..58778e0160b 100644 --- a/compiler/vmops.nim +++ b/compiler/vmops.nim @@ -152,8 +152,11 @@ when defined(nimHasInvariant): of cincludes: copySeq(conf.cIncludes) of clibs: copySeq(conf.cLibs) -proc stackTrace2(c: PCtx, msg: string, n: PNode) = - stackTrace(c, PStackFrame(prc: c.prc.sym, comesFrom: 0, next: nil), c.exceptionInstr, msg, n.info) +proc stackTrace2(c: PCtx, report: SemReport, n: PNode) = + stackTrace( + c, + PStackFrame(prc: c.prc.sym, comesFrom: 0, next: nil), + c.exceptionInstr, report, n.info) proc registerAdditionalOps*(c: PCtx) = @@ -250,13 +253,17 @@ proc registerAdditionalOps*(c: PCtx) = registerCallback c, "stdlib.macros.symBodyHash", proc (a: VmArgs) = let n = getNode(a, 0) if n.kind != nkSym: - stackTrace2(c, "symBodyHash() requires a symbol. '$#' is of kind '$#'" % [$n, $n.kind], n) + stackTrace2(c, reportAst( + rsemVmNodeNotASymbol, n, str = "symBodyHash()"), n) + setResult(a, $symBodyDigest(c.graph, n.sym)) registerCallback c, "stdlib.macros.isExported", proc(a: VmArgs) = let n = getNode(a, 0) if n.kind != nkSym: - stackTrace2(c, "isExported() requires a symbol. '$#' is of kind '$#'" % [$n, $n.kind], n) + stackTrace2(c, reportAst( + rsemVmNodeNotASymbol, n, str = "isExported()"), n) + setResult(a, sfExported in n.sym.flags) registerCallback c, "stdlib.vmutils.vmTrace", proc (a: VmArgs) = diff --git a/compiler/wordrecg.nim b/compiler/wordrecg.nim index 22f6cc71dee..17d515ef724 100644 --- a/compiler/wordrecg.nim +++ b/compiler/wordrecg.nim @@ -7,11 +7,10 @@ # distribution, for details about the copyright. # -# This module contains a word recognizer, i.e. a simple -# procedure which maps special words to an enumeration. -# It is primarily needed because Pascal's case statement -# does not support strings. Without this the code would -# be slow and unreadable. +## This module contains a word recognizer, i.e. a simple procedure which +## maps special words to an enumeration. It is primarily needed because +## Pascal's case statement does not support strings. Without this the code +## would be slow and unreadable. type TSpecialWord* = enum @@ -132,17 +131,27 @@ const const enumUtilsExist = compiles: import std/enumutils +import strutils + when enumUtilsExist: from std/enumutils import genEnumCaseStmt - from strutils import normalize proc findStr*[T: enum](a, b: static[T], s: string, default: T): T = genEnumCaseStmt(T, s, default, ord(a), ord(b), normalize) else: - from strutils import cmpIgnoreStyle - proc findStr*[T: enum](a, b: static[T], s: string, default: T): T {.deprecated.} = + proc findStr*[T: enum](a, b: static[T], s: string, default: T): T = # used for compiler bootstrapping only for i in a..b: if cmpIgnoreStyle($i, s) == 0: return i - result = default \ No newline at end of file + result = default + +func getEnumNames*[E: enum](values: set[E]): seq[string] = + for name in items(values): + result.add $name + +proc findStr*[T: enum](values: set[T], s: string, default: T): T = + for i in items(values): + if cmpIgnoreStyle($i, s) == 0: + return i + result = default diff --git a/doc/intern.rst b/doc/intern.rst index 4bc7d3f4bb3..ac6c96e05cd 100644 --- a/doc/intern.rst +++ b/doc/intern.rst @@ -27,10 +27,13 @@ The |nimskull| project's directory structure is: - ``lib/`` - the standard library, including: - ``pure/`` - modules in the standard library written in pure |nimskull|. + - ``impure/`` - modules in the standard library written in pure - |nimskull| with dependencies written in other languages. + |nimskull| with dependencies written in other languages. + - ``wrappers/`` - modules that wrap dependencies written in other languages. + - ``tests/`` - contains categorized tests for the compiler and standard library. - ``tests/lang`` - tests containing language specification @@ -112,6 +115,7 @@ These procs may not already be imported by the module you're editing. You can import them directly for debugging: .. code-block:: nim + from astalgo import debug from types import typeToString from renderer import renderTree @@ -155,6 +159,42 @@ contextual information is required, in what is typically a local part of the AST being examined. Please help refactor accordingly if you encounter the legacy method. +Reports +------- + +All output generates during compiler runtime is handled using `Report` +type, defined in `reports.nim` module. Every single compilation warning, +hint, error, and lots of other reports are wrapped into several categories +(lexer, parser, sem, internal, external, debug and backend) and passed +around. + +Each error node (`nkError`) stores associated report id that is written out +during error traversal. Postponed reports are stored in the +`MsgConfig.reports` field, which can be asscessed from `ConfigRef.m`. + +For more details on the specific report kinds and categories see the +`report.nim` module (for type definitions), `options.nim` (for writing +storing postponed or writing out activated reports) and `msgs.nim` (for +main logic related to error handing and report submission). + +When report need to be written out it is handed to +`ConfigRef.structuredReportHook` - it can be reimplemented by other +tooling, can generate output information in any format (json, +pretty-printed, S-expression), and filter it out unnecessary reports. +Default implementation of the report hook is provided in the +`cli_reporter.nim` - if you want to improve particular error messages it is +(ideally) the only (compiler) file that you need to edit. + +VM +----- + +For compile-time code execution nim compiler implements register-based VM +with custom instruction set. `vmgen.nim` implements code generation for the +virtual machine, `vm.nim` provides main execution engine. + +Errors generated in the VM are handled using common pipeline - report with +necessary location information is generated. + Bisecting for regressions ========================= @@ -188,12 +228,9 @@ Coding Guidelines * Max line length is 100 characters. * Provide spaces around binary operators if that enhances readability. * Use a space after a colon, but not before it. -* [deprecated] Start types with a capital `T`, unless they are - pointers/references which start with `P`. See also the `API naming design `_ document. - Porting to new platforms ======================== diff --git a/lib/packages/docutils/rst.nim b/lib/packages/docutils/rst.nim index 29234f28ba5..9c4f8cf525a 100644 --- a/lib/packages/docutils/rst.nim +++ b/lib/packages/docutils/rst.nim @@ -198,6 +198,8 @@ import os, strutils, rstast, std/enumutils, algorithm, lists, sequtils, std/private/miscdollars, tables + + from highlite import SourceLanguage, getSourceLanguage type @@ -220,21 +222,21 @@ type # keep the order in sync with compiler/docgen.nim and compiler/lineinfos.nim: MsgKind* = enum ## the possible messages - meCannotOpenFile = "cannot open '$1'", - meExpected = "'$1' expected", + meCannotOpenFile = "cannot open '$1'", + meExpected = "'$1' expected", meGridTableNotImplemented = "grid table is not implemented", - meMarkdownIllformedTable = "illformed delimiter row of a Markdown table", - meNewSectionExpected = "new section expected $1", - meGeneralParseError = "general parse error", - meInvalidDirective = "invalid directive: '$1'", - meInvalidField = "invalid field: $1", - meFootnoteMismatch = "mismatch in number of footnotes and their refs: $1", - mwRedefinitionOfLabel = "redefinition of label '$1'", - mwUnknownSubstitution = "unknown substitution '$1'", - mwBrokenLink = "broken link '$1'", - mwUnsupportedLanguage = "language '$1' not supported", - mwUnsupportedField = "field '$1' not supported", - mwRstStyle = "RST style: $1" + meMarkdownIllformedTable = "illformed delimiter row of a Markdown table", + meNewSectionExpected = "new section expected $1", + meGeneralParseError = "general parse error", + meInvalidDirective = "invalid directive: '$1'", + meInvalidField = "invalid field: $1", + meFootnoteMismatch = "mismatch in number of footnotes and their refs: $1", + mwRedefinitionOfLabel = "redefinition of label '$1'", + mwUnknownSubstitution = "unknown substitution '$1'", + mwBrokenLink = "broken link '$1'", + mwUnsupportedLanguage = "language '$1' not supported", + mwUnsupportedField = "field '$1' not supported", + mwRstStyle = "RST style: $1" MsgHandler* = proc (filename: string, line, col: int, msgKind: MsgKind, arg: string) {.closure, gcsafe.} ## what to do in case of an error @@ -3032,6 +3034,7 @@ proc rstParse*(text, filename: string, tuple[node: PRstNode, filenames: RstFileTable, hasToc: bool] = ## Parses the whole `text`. The result is ready for `rstgen.renderRstToOut`, ## note that 2nd tuple element should be fed to `initRstGenerator` + ## argument `filenames` (it is being filled here at least with `filename` ## and possibly with other files from RST ``.. include::`` statement). var sharedState = newRstSharedState(options, filename, findFile, msgHandler) diff --git a/lib/pure/times.nim b/lib/pure/times.nim index 113f73d2a67..dcff960733e 100644 --- a/lib/pure/times.nim +++ b/lib/pure/times.nim @@ -2044,6 +2044,7 @@ proc format*(dt: DateTime, f: static[string]): string {.raises: [].} = const f2 = initTimeFormat(f) result = dt.format(f2) + proc formatValue*(result: var string; value: DateTime, specifier: string) = ## adapter for strformat. Not intended to be called directly. result.add format(value, diff --git a/nimpretty/nimpretty.nim b/nimpretty/nimpretty.nim index a7940349d24..c745dea6300 100644 --- a/nimpretty/nimpretty.nim +++ b/nimpretty/nimpretty.nim @@ -12,7 +12,9 @@ when not defined(nimpretty): {.error: "This needs to be compiled with --define:nimPretty".} -import ../compiler / [idents, msgs, syntaxes, options, pathutils, layouter] +import ../compiler / [ + idents, msgs, syntaxes, options, pathutils, layouter, cli_reporter + ] import parseopt, strutils, os, sequtils @@ -49,7 +51,7 @@ type maxLineLen*: Positive proc prettyPrint*(infile, outfile: string, opt: PrettyOptions) = - var conf = newConfigRef() + var conf = newConfigRef(cli_reporter.reportHook) let fileIdx = fileInfoIdx(conf, AbsoluteFile infile) let f = splitFile(outfile.expandTilde) conf.outFile = RelativeFile f.name & f.ext diff --git a/nimsuggest/nimsuggest.nim b/nimsuggest/nimsuggest.nim index d42b2cd11bd..050bbb91278 100644 --- a/nimsuggest/nimsuggest.nim +++ b/nimsuggest/nimsuggest.nim @@ -12,15 +12,34 @@ when not defined(nimcore): {.error: "nimcore MUST be defined for Nim's core tooling".} -import strutils, os, parseopt, parseutils, sequtils, net, rdstdin, sexp +import std/[strutils, os, parseopt, parseutils, sequtils, net, rdstdin] +import sexp +import std/options as std_options + # Do NOT import suggest. It will lead to weird bugs with # suggestionResultHook, because suggest.nim is included by sigmatch. # So we import that one instead. -import compiler / [options, commands, modules, sem, - passes, passaux, msgs, - sigmatch, ast, - idents, modulegraphs, prefixmatches, lineinfos, cmdlinehelper, - pathutils] + +import + ../compiler/[ + options, + commands, + modules, + sem, + passes, + passaux, + msgs, + sigmatch, + ast, + reports, + idents, + modulegraphs, + prefixmatches, + lineinfos, + cmdlinehelper, + pathutils, + cli_reporter + ] when defined(windows): import winlean @@ -58,17 +77,13 @@ are supported. """ type Mode = enum mstdin, mtcp, mepc, mcmdsug, mcmdcon - CachedMsg = object - info: TLineInfo - msg: string - sev: Severity - CachedMsgs = seq[CachedMsg] + CachedMsgs = seq[Report] var gPort = 6000.Port gAddress = "" gMode: Mode - gEmitEof: bool # whether we write '!EOF!' dummy lines + gEmitEof: bool ## whether we write '!EOF!' dummy lines gLogging = defined(logging) gRefresh: bool gAutoBind = false @@ -82,13 +97,33 @@ proc writelnToChannel(line: string) = proc sugResultHook(s: Suggest) = results.send(s) -proc errorHook(conf: ConfigRef; info: TLineInfo; msg: string; sev: Severity) = - results.send(Suggest(section: ideChk, filePath: toFullPath(conf, info), - line: toLinenumber(info), column: toColumn(info), doc: msg, - forth: $sev)) - -proc myLog(s: string) = - if gLogging: log(s) +proc myLog(conf: ConfigRef, s: string, flags: MsgFlags = {}) = + if gLogging: + log(s) + +proc reportHook(conf: ConfigRef, report: Report): TErrorHandling = + result = doNothing + case report.category + of repCmd, repDebug, repInternal, repExternal: + myLog(conf, $report) + of repParser, repLexer, repSem: + if report.category == repSem and + report.kind in {rsemProcessing, rsemProcessingStmt}: + # skip processing statements + return + let info = report.location().get(unknownLineInfo) + results.send(Suggest( + section: ideChk, + filePath: toFullPath(conf, info), + line: toLinenumber(info), + column: toColumn(info), + doc: conf.reportShort(report), + forth: $conf.severity(report) + )) + of repBackend: + # xxx: we should never get this, but we might get one as a bug so logging + # for now, alternative is to crash or at least fail tests + myLog(conf, $report) const seps = {':', ';', ' ', '\t'} @@ -163,9 +198,12 @@ proc symFromInfo(graph: ModuleGraph; trackPos: TLineInfo): PSym = proc executeNoHooks(cmd: IdeCmd, file, dirtyfile: AbsoluteFile, line, col: int; graph: ModuleGraph) = let conf = graph.config - myLog("cmd: " & $cmd & ", file: " & file.string & - ", dirtyFile: " & dirtyfile.string & - "[" & $line & ":" & $col & "]") + myLog( + graph.config, + "cmd: " & $cmd & ", file: " & file.string & ", dirtyFile: " & + dirtyfile.string & "[" & $line & ":" & $col & "]" + ) + conf.ideCmd = cmd if cmd == ideUse and conf.suggestVersion != 0: graph.resetAllModules() @@ -197,16 +235,19 @@ proc executeNoHooks(cmd: IdeCmd, file, dirtyfile: AbsoluteFile, line, col: int; if u != nil: listUsages(graph, u) else: - localError(conf, conf.m.trackPos, "found no symbol at this position " & (conf $ conf.m.trackPos)) + localReport(conf, conf.m.trackPos, reportSem(rsemSugNoSymbolAtPosition)) proc execute(cmd: IdeCmd, file, dirtyfile: AbsoluteFile, line, col: int; graph: ModuleGraph) = if cmd == ideChk: - graph.config.structuredErrorHook = errorHook - graph.config.writelnHook = myLog + graph.config.structuredReportHook = nimsuggest.reportHook + graph.config.writeHook = myLog + else: - graph.config.structuredErrorHook = nil - graph.config.writelnHook = myLog + graph.config.structuredReportHook = + proc(conf: ConfigRef, report: Report): TErrorHandling = doNothing + graph.config.writeHook = myLog + executeNoHooks(cmd, file, dirtyfile, line, col, graph) proc executeEpc(cmd: IdeCmd, args: SexpNode; @@ -372,15 +413,9 @@ proc replEpc(x: ThreadParams) {.thread.} = uid = message[1].getNum cmd = message[2].getSymbol args = message[3] + fullCmd = cmd & " " & args.argsToStr - when false: - x.ideCmd[] = parseIdeCmd(message[2].getSymbol) - case x.ideCmd[] - of ideSug, ideCon, ideDef, ideUse, ideDus, ideOutline, ideHighlight: - setVerbosity(0) - else: discard - let fullCmd = cmd & " " & args.argsToStr - myLog "MSG CMD: " & fullCmd + myLog(nil, "MSG CMD: " & fullCmd) requests.send(fullCmd) toEpc(client, uid) of "methods": @@ -459,7 +494,9 @@ proc execCmd(cmd: string; graph: ModuleGraph; cachedMsgs: CachedMsgs) = results.send(Suggest(section: ideProject, filePath: string conf.projectFull)) else: if conf.ideCmd == ideChk: - for cm in cachedMsgs: errorHook(conf, cm.info, cm.msg, cm.sev) + for cm in cachedMsgs: + discard nimsuggest.reportHook(conf, cm) + execute(conf.ideCmd, AbsoluteFile orig, AbsoluteFile dirtyfile, line, col, graph) sentinel() @@ -478,13 +515,13 @@ proc mainThread(graph: ModuleGraph) = for it in conf.searchPaths: log(it.string) - proc wrHook(line: string) {.closure.} = + proc wrHook(conf: ConfigRef, line: string, flag: MsgFlags = {}) {.closure.} = if gMode == mepc: if gLogging: log(line) else: writelnToChannel(line) - conf.writelnHook = wrHook + conf.writeHook = wrHook conf.suggestionResultHook = sugResultHook graph.doStopCompile = proc (): bool = requests.peek() > 0 var idle = 0 @@ -502,10 +539,13 @@ proc mainThread(graph: ModuleGraph) = if idle == 20 and gRefresh: # we use some nimsuggest activity to enable a lazy recompile: conf.ideCmd = ideChk - conf.writelnHook = proc (s: string) = discard + conf.writelnHook = + proc (conf: ConfigRef, s: string, flags: MsgFlags = {}) = discard cachedMsgs.setLen 0 - conf.structuredErrorHook = proc (conf: ConfigRef; info: TLineInfo; msg: string; sev: Severity) = - cachedMsgs.add(CachedMsg(info: info, msg: msg, sev: sev)) + conf.structuredReportHook = + proc (conf: ConfigRef, report: Report): TErrorHandling = + cachedMsgs.add(report) + conf.suggestionResultHook = proc (s: Suggest) = discard recompileFullProject(graph) @@ -528,7 +568,9 @@ proc mainCommand(graph: ModuleGraph) = conf.setErrorMaxHighMaybe # honor --errorMax even if it may not make sense here # do not print errors, but log them conf.writelnHook = myLog - conf.structuredErrorHook = nil + conf.structuredReportHook = + proc(conf: ConfigRef, report: Report): TErrorHandling = + doNothing # compile the project before showing any input so that we already # can answer questions right away: @@ -537,6 +579,8 @@ proc mainCommand(graph: ModuleGraph) = open(requests) open(results) + conf.hintProcessingDots = false # turn off the silly dots + case gMode of mstdin: createThread(inputThread, replStdin, (gPort, gAddress)) of mtcp: createThread(inputThread, replTcp, (gPort, gAddress)) @@ -619,7 +663,7 @@ proc processCmdLine*(pass: TCmdLinePass, cmd: string; conf: ConfigRef) = proc handleCmdLine(cache: IdentCache; conf: ConfigRef) = let self = NimProg( suggestMode: true, - processCmdLine: processCmdLine + processCmdLine: nimsuggest.processCmdLine ) self.initDefinesProg(conf, "nimsuggest") @@ -630,7 +674,9 @@ proc handleCmdLine(cache: IdentCache; conf: ConfigRef) = self.processCmdLineAndProjectPath(conf) if gMode != mstdin: - conf.writelnHook = proc (msg: string) = discard + conf.writelnHook = + proc (conf: ConfigRef, msg: string, flags: MsgFlags) = discard + # Find Nim's prefix dir. # # TODO: Standardize this process. @@ -648,14 +694,14 @@ proc handleCmdLine(cache: IdentCache; conf: ConfigRef) = conf.prefixDir = AbsoluteDir"" #msgs.writelnHook = proc (line: string) = log(line) - myLog("START " & conf.projectFull.string) + myLog(conf, "START " & conf.projectFull.string) var graph = newModuleGraph(cache, conf) if self.loadConfigsAndProcessCmdLine(cache, conf, graph): mainCommand(graph) when isMainModule: - handleCmdLine(newIdentCache(), newConfigRef()) + handleCmdLine(newIdentCache(), newConfigRef(cli_reporter.reportHook)) else: export Suggest export IdeCmd @@ -703,7 +749,7 @@ else: # if processArgument(pass, p, argsCount): break let cache = newIdentCache() - conf = newConfigRef() + conf = newConfigRef(cli_reporter.reportHook) self = NimProg( suggestMode: true, processCmdLine: mockCmdLine @@ -727,7 +773,7 @@ else: conf.prefixDir = AbsoluteDir nimPath #msgs.writelnHook = proc (line: string) = log(line) - myLog("START " & conf.projectFull.string) + myLog(conf, "START " & conf.projectFull.string) var graph = newModuleGraph(cache, conf) if self.loadConfigsAndProcessCmdLine(cache, conf, graph): diff --git a/nimsuggest/tester.nim b/nimsuggest/tester.nim index 1db33706ab7..0b4d88bfade 100644 --- a/nimsuggest/tester.nim +++ b/nimsuggest/tester.nim @@ -174,6 +174,8 @@ proc sexpToAnswer(s: SexpNode): string = doAssert s.kind == SList doAssert s.len >= 3 let m = s[2] + if m.kind == SNil: + return # skip nils if m.kind != SList: echo s doAssert m.kind == SList @@ -229,13 +231,13 @@ proc doReport(filename, answer, resp: string; report: var string) = var hasDiff = false for i in 0..min(resp.len-1, answer.len-1): if resp[i] != answer[i]: - report.add "\n Expected: " & resp.substr(i, i+200) - report.add "\n But got: " & answer.substr(i, i+200) + report.add "\n Expected:\n" & resp.substr(i, i+200) + report.add "\n But got:\n" & answer.substr(i, i+200) hasDiff = true break if not hasDiff: - report.add "\n Expected: " & resp - report.add "\n But got: " & answer + report.add "\n Expected:\n" & resp + report.add "\n But got:\n" & answer proc skipDisabledTest(test: Test): bool = if test.disabled: @@ -271,7 +273,12 @@ proc runEpcTest(filename: string): int = os.sleep(50) inc i let a = outp.readAll().strip() - let port = parseInt(a) + let port = + try: + parseInt(a) + except: + echo "could not parse port from input: ", a + raise socket.connect("localhost", Port(port)) for req, resp in items(s.script): diff --git a/nimsuggest/tests/tchk1.nim b/nimsuggest/tests/tchk1.nim index f8e2989c56c..c9239116483 100644 --- a/nimsuggest/tests/tchk1.nim +++ b/nimsuggest/tests/tchk1.nim @@ -17,11 +17,14 @@ proc main = discard """ $nimsuggest --tester $file >chk $1 -chk;;skUnknown;;;;Hint;;???;;0;;-1;;">> (toplevel): import(dirty): tests/tchk1.nim [Processing]";;0 -chk;;skUnknown;;;;Error;;$file;;12;;0;;"identifier expected, but got \'keyword template\'";;0 +chk;;skUnknown;;;;Error;;$file;;12;;0;;"identifier expected, but got \'template\'";;0 chk;;skUnknown;;;;Error;;$file;;14;;0;;"nestable statement requires indentation";;0 chk;;skUnknown;;;;Error;;$file;;12;;0;;"implementation of \'foo\' expected";;0 chk;;skUnknown;;;;Error;;$file;;17;;0;;"invalid indentation";;0 +chk;;skUnknown;;;;Hint;;$file;;20;;85;;"Hint: line too long [LineTooLong]";;0 +chk;;skUnknown;;;;Hint;;$file;;21;;83;;"Hint: line too long [LineTooLong]";;0 +chk;;skUnknown;;;;Hint;;$file;;28;;97;;"Hint: line too long [LineTooLong]";;0 +chk;;skUnknown;;;;Hint;;$file;;29;;98;;"Hint: line too long [LineTooLong]";;0 chk;;skUnknown;;;;Hint;;$file;;12;;9;;"\'foo\' is declared but not used [XDeclaredButNotUsed]";;0 chk;;skUnknown;;;;Hint;;$file;;14;;5;;"\'main\' is declared but not used [XDeclaredButNotUsed]";;0 """ diff --git a/nimsuggest/tests/tchk_compiles.nim b/nimsuggest/tests/tchk_compiles.nim index c8a3daac49a..6517058eb06 100644 --- a/nimsuggest/tests/tchk_compiles.nim +++ b/nimsuggest/tests/tchk_compiles.nim @@ -4,5 +4,4 @@ discard compiles(2 + "hello") discard """ $nimsuggest --tester $file >chk $1 -chk;;skUnknown;;;;Hint;;???;;0;;-1;;">> (toplevel): import(dirty): tests/tchk_compiles.nim [Processing]";;0 """ diff --git a/nimsuggest/tests/ttempl_inst.nim b/nimsuggest/tests/ttempl_inst.nim index 5f5b10fe903..49022424b2b 100644 --- a/nimsuggest/tests/ttempl_inst.nim +++ b/nimsuggest/tests/ttempl_inst.nim @@ -7,7 +7,5 @@ foo() discard """ $nimsuggest --tester $file >chk $1 -chk;;skUnknown;;;;Hint;;???;;0;;-1;;">> (toplevel): import(dirty): tests/ttempl_inst.nim [Processing]";;0 -chk;;skUnknown;;;;Hint;;$file;;4;;3;;"template/generic instantiation from here";;0 chk;;skUnknown;;;;Warning;;$file;;2;;11;;"foo [User]";;0 """ diff --git a/tests/arc/t14864.nim b/tests/arc/t14864.nim index f59b14d2c41..7c15641d90f 100644 --- a/tests/arc/t14864.nim +++ b/tests/arc/t14864.nim @@ -1,5 +1,6 @@ discard """ cmd: "nim c --gc:arc $file" + joinable: false """ import bmodule diff --git a/tests/arc/t17025.nim b/tests/arc/t17025.nim index a64c59ac1ea..c37360d3d30 100644 --- a/tests/arc/t17025.nim +++ b/tests/arc/t17025.nim @@ -1,5 +1,6 @@ discard """ cmd: "nim c --gc:arc $file" + joinable: false output: ''' {"Package": {"name": "hello"}, "Author": {"name": "name", "qq": "123456789", "email": "email"}} hello @@ -53,4 +54,3 @@ proc main2() = echo pname & "\n" & name & "\n" & qq & "\n" & email main2() - diff --git a/tests/astspec/tastspec.nim b/tests/astspec/tastspec.nim index 34e9ac69035..49db7decf87 100644 --- a/tests/astspec/tastspec.nim +++ b/tests/astspec/tastspec.nim @@ -1,5 +1,6 @@ discard """ action: compile +joinable: false """ # this test should ensure that the AST doesn't change slightly without it getting noticed. diff --git a/tests/ccgbugs/twrong_method.nim b/tests/ccgbugs/twrong_method.nim index 9879c6114a4..b9370f062ac 100644 --- a/tests/ccgbugs/twrong_method.nim +++ b/tests/ccgbugs/twrong_method.nim @@ -1,5 +1,6 @@ discard """ cmd: "nim c -d:release $file" + joinable: false output: '''correct method''' """ # bug #5439 diff --git a/tests/compiler/tnimblecmd.nim b/tests/compiler/tnimblecmd.nim index 53bce462593..b3ed9a29779 100644 --- a/tests/compiler/tnimblecmd.nim +++ b/tests/compiler/tnimblecmd.nim @@ -16,7 +16,7 @@ proc testAddPackageWithoutChecksum = ## sha1 checksum at the end of the name of the Nimble cache directory. ## This way a new compiler will be able to work with an older Nimble. - let conf = newConfigRef() + let conf = newConfigRef(nil) var rr: PackageInfo addPackage conf, rr, "irc-#a111", unknownLineInfo @@ -33,7 +33,7 @@ proc testAddPackageWithoutChecksum = ["irc-#head", "another-0.1", "ab-0.1.3", "justone-1.0"].toHashSet proc testAddPackageWithChecksum = - let conf = newConfigRef() + let conf = newConfigRef(nil) var rr: PackageInfo # in the case of packages with the same version, but different checksums for diff --git a/tests/compilerapi/tcompilerapi.nim b/tests/compilerapi/tcompilerapi.nim index ab995cb6db6..c8d8e7afc75 100644 --- a/tests/compilerapi/tcompilerapi.nim +++ b/tests/compilerapi/tcompilerapi.nim @@ -1,4 +1,5 @@ discard """ + cmd: '''nim c --warnings:off --hints:off $file''' output: '''top level statements are executed! (ival: 10, fval: 2.0) 2.0 @@ -13,16 +14,36 @@ raising VMQuit ## Example program that demonstrates how to use the ## compiler as an API to embed into your own projects. -import "../../compiler" / [ast, vmdef, vm, nimeval, llstream, lineinfos, options] +import "../../compiler" / [ast, vmdef, vm, nimeval, llstream, lineinfos, options, reports] import std / [os] - -proc initInterpreter(script: string): Interpreter = +proc initInterpreter(script: string, hook: ReportHook): Interpreter = let std = findNimStdLibCompileTime() - result = createInterpreter(script, [std, parentDir(currentSourcePath), - std / "pure", std / "core"]) + result = createInterpreter( + scriptName = script, + hook = hook, + searchPaths = [ + std, + parentDir(currentSourcePath), + std / "pure", + std / "core"]) + +type VMQuit = object of CatchableError + +proc vmReport(config: ConfigRef, report: Report): TErrorHandling {.gcsafe.} = + if config.severity(report) == rsevError and + config.errorCounter >= config.errorMax: + + echo "raising VMQuit" + raise newException(VMQuit, "Script error") + + elif report.kind == rintEchoMessage: + echo report.internalReport.msg + + + proc main() = - let i = initInterpreter("myscript.nim") + let i = initInterpreter("myscript.nim", vmReport) i.implementRoutine("*", "exposed", "addFloats", proc (a: VmArgs) = setResult(a, getFloat(a, 0) + getFloat(a, 1) + getFloat(a, 2)) ) @@ -49,7 +70,11 @@ block issue9180: proc evalString(code: string, moduleName = "script.nim") = let stream = llStreamOpen(code) let std = findNimStdLibCompileTime() - var intr = createInterpreter(moduleName, [std, std / "pure", std / "core"]) + var intr = createInterpreter( + scriptName = moduleName, + searchPaths = [std, std / "pure", std / "core"], + hook = vmReport) + intr.evalScript(stream) destroyInterpreter(intr) llStreamClose(stream) @@ -58,14 +83,6 @@ block issue9180: evalString("echo 10+2") block error_hook: - type VMQuit = object of CatchableError - - let i = initInterpreter("invalid.nim") - i.registerErrorHook proc(config: ConfigRef; info: TLineInfo; msg: string; - severity: Severity) {.gcsafe.} = - if severity == Error and config.errorCounter >= config.errorMax: - echo "raising VMQuit" - raise newException(VMQuit, "Script error") - + let i = initInterpreter("invalid.nim", vmReport) doAssertRaises(VMQuit): i.evalScript() diff --git a/tests/compilerunits/confread/cfg_processing/nim.cfg b/tests/compilerunits/confread/cfg_processing/nim.cfg new file mode 100644 index 00000000000..b7f325070fb --- /dev/null +++ b/tests/compilerunits/confread/cfg_processing/nim.cfg @@ -0,0 +1 @@ +@trace "parent+2 config" \ No newline at end of file diff --git a/tests/compilerunits/confread/cfg_processing/parent_directory/nim.cfg b/tests/compilerunits/confread/cfg_processing/parent_directory/nim.cfg new file mode 100644 index 00000000000..9990228867d --- /dev/null +++ b/tests/compilerunits/confread/cfg_processing/parent_directory/nim.cfg @@ -0,0 +1 @@ +@trace "parent+1 config" \ No newline at end of file diff --git a/tests/compilerunits/confread/cfg_processing/parent_directory/project_directory/nim.cfg b/tests/compilerunits/confread/cfg_processing/parent_directory/project_directory/nim.cfg new file mode 100644 index 00000000000..9454136947a --- /dev/null +++ b/tests/compilerunits/confread/cfg_processing/parent_directory/project_directory/nim.cfg @@ -0,0 +1,2 @@ +# Default configuration file reading +@trace "default project configuration file" \ No newline at end of file diff --git a/tests/compilerunits/confread/cfg_processing/parent_directory/project_directory/project_file.nim b/tests/compilerunits/confread/cfg_processing/parent_directory/project_directory/project_file.nim new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/compilerunits/confread/cfg_processing/parent_directory/project_directory/project_file.nim.cfg b/tests/compilerunits/confread/cfg_processing/parent_directory/project_directory/project_file.nim.cfg new file mode 100644 index 00000000000..0ac9437d8a6 --- /dev/null +++ b/tests/compilerunits/confread/cfg_processing/parent_directory/project_directory/project_file.nim.cfg @@ -0,0 +1,2 @@ +# Main project file +@trace "project-specific configuration file" \ No newline at end of file diff --git a/tests/compilerunits/confread/readme.md b/tests/compilerunits/confread/readme.md new file mode 100644 index 00000000000..5373cc37095 --- /dev/null +++ b/tests/compilerunits/confread/readme.md @@ -0,0 +1 @@ +Unit tests for external configuration reads diff --git a/tests/compilerunits/confread/treport_filtering.nim b/tests/compilerunits/confread/treport_filtering.nim new file mode 100644 index 00000000000..a1f02cede76 --- /dev/null +++ b/tests/compilerunits/confread/treport_filtering.nim @@ -0,0 +1,140 @@ +discard """ + description: '''CLI and configuration file testing''' + joinable: false +""" + +## Unit tests for command line and configuration file processing. Tests are +## separated into three stages, mirroring number of steps that are done by +## compiler to process the configuration. +## +## 1. Read only CLI interaface +## 2. Read CLI interface and configuration values +## 3. Full processing of the CLI flags - integration tests for the +## `nim.handleCmdLine()` logic + +import compiler/[ + options, + reports, + commands, + cli_reporter, + idents, + modulegraphs, + nimconf, + cmdlinehelper +] + +import std/[strutils, os, sequtils] + +var reported: seq[Report] + +proc hook(conf: ConfigRef, report: Report): TErrorHandling = + reported.add report + return doNothing + +proc getReports(): seq[Report] = + result = reported + reported = @[] + +proc firstPass*(args: seq[string]): ConfigRef = + ## Create config ref object and run fist CLI pass of on the configuration + result = newConfigRef(hook) + processCmdLine(passCmd1, args.join(" "), result) + +proc cfgPass*(file: string, args: seq[string]): ConfigRef = + doAssert fileExists(file), $file + + let prog = NimProg( + supportsStdinFile: true, + processCmdLine: processCmdLine + ) + + result = newConfigRef(hook) + prog.processCmdLineAndProjectPath( + result, join(args & @[file], " ")) + + var cache = newIdentCache() + var graph = newModuleGraph(cache, result) + loadConfigs(DefaultConfig, cache, result, graph.idgen) + +proc assertInter[T](inters: set[T], want: set[T] = {}) = + doAssert inters == want, $want + +block fist_pass_tests: + block: + let conf = firstPass(@["compile", "--hint=all:off"]) + assertInter(repHintKinds * conf.notes) + + block: + let conf = firstPass(@["compile", "--hint=all:off", "--hint=MsgOrigin:on"]) + assertInter(repHintKinds * conf.notes, {rintMsgOrigin}) + + block: + let conf = firstPass(@[ + "compile", + "--hint=all:off", + "--hint=MsgOrigin:on", + "--hint=all:off", + "--hint=MsgOrigin:on" + ]) + + assertInter(repHintKinds * conf.notes, {rintMsgOrigin}) + +const dir = currentSourcePath().parentDir() + +template assertEq[T](a, b: T) = + doAssert a == b, $a & " != " & $b + +block first_and_cfg_pass: + const + parent = dir / "cfg_processing/parent_directory/project_directory" + file = parent / "project_file.nim" + confread = {rdbgFinishedConfRead, rdbgStartingConfRead} + + proc getTraces(): tuple[reads, trace: seq[DebugReport]] = + for r in getReports(): + case r.kind: + of rdbgStartingConfRead: + result.reads.add r.debugReport + + of rdbgCfgTrace: + result.trace.add r.debugReport + + else: + discard + + + + block: + var conf = cfgPass(file, @["compile"]) + + assertEq(conf.projectName, "project_file") + assertEq(conf.projectFull.string, file) + assertEq(conf.projectPath.string, parent) + + let (reads, trace) = getTraces() + + conf.filenameOption = foCanonical + + let cfgFiles = reads.mapIt(it.filename).filterIt( + # Parent configuration file read is not disabled, so filtering out + # any unwanted interference such as `nimskull/nim.cfg`, + # `tests/config.nims` + "cfg_processing" in it + ) + + assertEq(cfgFiles, @[ + dir / "cfg_processing/nim.cfg", + dir / "cfg_processing/parent_directory/nim.cfg", + dir / "cfg_processing/parent_directory/project_directory/nim.cfg", + dir / "cfg_processing/parent_directory/project_directory/project_file.nim.cfg" + ]) + + assertEq(trace.mapIt(it.str), @[ + "parent+2 config", + "parent+1 config", + "default project configuration file", + "project-specific configuration file" + ]) + + block: + var conf = cfgPass(file, @["compile"]) diff --git a/tests/compilerunits/nim.cfg b/tests/compilerunits/nim.cfg new file mode 100644 index 00000000000..363ff72b224 --- /dev/null +++ b/tests/compilerunits/nim.cfg @@ -0,0 +1 @@ +--path:"$config/../.." \ No newline at end of file diff --git a/tests/compilerunits/readme.md b/tests/compilerunits/readme.md new file mode 100644 index 00000000000..6aab63c286d --- /dev/null +++ b/tests/compilerunits/readme.md @@ -0,0 +1 @@ +Unit tests for different compiler subsystems diff --git a/tests/controlflow/tcontrolflow.nim b/tests/controlflow/tcontrolflow.nim index 258f3f50d2d..892df3333ab 100644 --- a/tests/controlflow/tcontrolflow.nim +++ b/tests/controlflow/tcontrolflow.nim @@ -1,4 +1,5 @@ discard """ + joinable: false output: ''' 10 true true diff --git a/tests/destructor/tgotoexceptions.nim b/tests/destructor/tgotoexceptions.nim index f7659227009..5a769856c7c 100755 --- a/tests/destructor/tgotoexceptions.nim +++ b/tests/destructor/tgotoexceptions.nim @@ -20,6 +20,7 @@ BEFORE EXCEPT: IOError: hi FINALLY ''' + joinable: false cmd: "nim c --gc:arc --exceptions:goto $file" """ diff --git a/tests/destructor/tv2_raise.nim b/tests/destructor/tv2_raise.nim index 66b0aec3034..e60aa939fdb 100644 --- a/tests/destructor/tv2_raise.nim +++ b/tests/destructor/tv2_raise.nim @@ -1,5 +1,6 @@ discard """ valgrind: true + joinable: false cmd: '''nim c -d:nimAllocStats --newruntime $file''' output: '''OK 3 (allocCount: 7, deallocCount: 4)''' diff --git a/tests/effects/tdiagnostic_messages.nim b/tests/effects/tdiagnostic_messages.nim index 2ce4895a38d..b4b41f247b2 100644 --- a/tests/effects/tdiagnostic_messages.nim +++ b/tests/effects/tdiagnostic_messages.nim @@ -1,22 +1,20 @@ discard """ - nimoutFull: true action: "reject" cmd: "nim r --hint:Conf:off $file" nimout: ''' -tdiagnostic_messages.nim(36, 6) Error: 'a' can have side effects -> tdiagnostic_messages.nim(37, 30) Hint: 'a' calls `.sideEffect` 'callWithSideEffects' ->> tdiagnostic_messages.nim(29, 6) Hint: 'callWithSideEffects' called by 'a' ->>> tdiagnostic_messages.nim(31, 34) Hint: 'callWithSideEffects' calls `.sideEffect` 'indirectCallViaVarParam' ->>>> tdiagnostic_messages.nim(25, 6) Hint: 'indirectCallViaVarParam' called by 'callWithSideEffects' ->>>>> tdiagnostic_messages.nim(26, 7) Hint: 'indirectCallViaVarParam' calls routine via hidden pointer indirection ->>> tdiagnostic_messages.nim(32, 33) Hint: 'callWithSideEffects' calls `.sideEffect` 'indirectCallViaPointer' ->>>> tdiagnostic_messages.nim(27, 6) Hint: 'indirectCallViaPointer' called by 'callWithSideEffects' ->>>>> tdiagnostic_messages.nim(28, 32) Hint: 'indirectCallViaPointer' calls routine via pointer indirection ->>> tdiagnostic_messages.nim(33, 10) Hint: 'callWithSideEffects' calls `.sideEffect` 'myEcho' ->>>> tdiagnostic_messages.nim(24, 6) Hint: 'myEcho' called by 'callWithSideEffects' ->>> tdiagnostic_messages.nim(34, 3) Hint: 'callWithSideEffects' accesses global state 'globalVar' ->>>> tdiagnostic_messages.nim(23, 5) Hint: 'globalVar' accessed by 'callWithSideEffects' - +tdiagnostic_messages.nim(34, 6) Error: 'a' can have side effects +> tdiagnostic_messages.nim(35, 30) Hint: 'a' calls `.sideEffect` 'callWithSideEffects' +>> tdiagnostic_messages.nim(27, 6) Hint: 'callWithSideEffects' called by 'a' +>> tdiagnostic_messages.nim(29, 34) Hint: 'callWithSideEffects' calls `.sideEffect` 'indirectCallViaVarParam' +>>> tdiagnostic_messages.nim(23, 6) Hint: 'indirectCallViaVarParam' called by 'callWithSideEffects' +>>> tdiagnostic_messages.nim(24, 7) Hint: 'indirectCallViaVarParam' calls routine via hidden pointer indirection +>> tdiagnostic_messages.nim(30, 33) Hint: 'callWithSideEffects' calls `.sideEffect` 'indirectCallViaPointer' +>>> tdiagnostic_messages.nim(25, 6) Hint: 'indirectCallViaPointer' called by 'callWithSideEffects' +>>> tdiagnostic_messages.nim(26, 32) Hint: 'indirectCallViaPointer' calls routine via pointer indirection +>> tdiagnostic_messages.nim(31, 10) Hint: 'callWithSideEffects' calls `.sideEffect` 'myEcho' +>>> tdiagnostic_messages.nim(22, 6) Hint: 'myEcho' called by 'callWithSideEffects' +>> tdiagnostic_messages.nim(32, 3) Hint: 'callWithSideEffects' accesses global state 'globalVar' +>>> tdiagnostic_messages.nim(21, 5) Hint: 'globalVar' accessed by 'callWithSideEffects' ''' """ diff --git a/tests/effects/teffects1.nim b/tests/effects/teffects1.nim index 82efefe77d3..e01cf7107c4 100644 --- a/tests/effects/teffects1.nim +++ b/tests/effects/teffects1.nim @@ -1,10 +1,5 @@ discard """ - cmd: "nim check $file" - nimout: '''teffects1.nim(22, 28) template/generic instantiation from here -teffects1.nim(23, 13) Error: can raise an unlisted exception: ref IOError -teffects1.nim(22, 29) Hint: 'lier' cannot raise 'IO2Error' [XCannotRaiseY] -teffects1.nim(38, 21) Error: type mismatch: got but expected 'MyProcType = proc (x: int): string{.closure.}' -.raise effects differ''' + cmd: "nim check --hints=on $file" """ {.push warningAsError[Effect]: on.} type diff --git a/tests/effects/tnosideeffect.nim b/tests/effects/tnosideeffect.nim index 9cabb35a2c6..aadbb002be4 100644 --- a/tests/effects/tnosideeffect.nim +++ b/tests/effects/tnosideeffect.nim @@ -14,6 +14,7 @@ block: # `.noSideEffect` accept: func fun1() = discard foo(fn1) + reject: func fun1() = discard foo(fn2) diff --git a/tests/errmsgs/t10734.nim b/tests/errmsgs/t10734.nim index 2adc71ef7ac..4d94986ff3c 100644 --- a/tests/errmsgs/t10734.nim +++ b/tests/errmsgs/t10734.nim @@ -1,13 +1,14 @@ discard """ - cmd: "nim check $file" + cmd: "nim check --hints=on $file" errormsg: "" nimout: ''' -t10734.nim(17, 1) Error: invalid indentation -t10734.nim(17, 6) Error: invalid indentation -t10734.nim(18, 7) Error: expression expected, but found '[EOF]' -t10734.nim(16, 5) Error: 'proc' is not a concrete type; for a callback without parameters use 'proc()' -t10734.nim(17, 6) Error: expression 'p' has no type (or is ambiguous) -t10734.nim(15, 3) Hint: 'T' is declared but not used [XDeclaredButNotUsed] +t10734.nim(18, 1) Error: invalid indentation +t10734.nim(18, 6) Error: invalid indentation +t10734.nim(20, 1) Error: expression expected, but found '[EOF]' +t10734.nim(17, 5) Error: 'proc' is not a concrete type; for a callback without parameters use 'proc()' +t10734.nim(18, 6) Error: undeclared identifier: 'p' +t10734.nim(18, 6) Error: expression has no type: p +t10734.nim(16, 3) Hint: 'T' is declared but not used [XDeclaredButNotUsed] ''' """ @@ -15,4 +16,4 @@ type T = object a: proc p = - case \ No newline at end of file + case diff --git a/tests/errmsgs/t10735.nim b/tests/errmsgs/t10735.nim index 2992caf851f..3fed3a79935 100644 --- a/tests/errmsgs/t10735.nim +++ b/tests/errmsgs/t10735.nim @@ -4,7 +4,7 @@ discard """ nimout: ''' t10735.nim(40, 5) Error: 'let' symbol requires an initialization t10735.nim(41, 10) Error: undeclared identifier: 'pos' -t10735.nim(41, 10) Error: expression 'pos' has no type (or is ambiguous) +t10735.nim(41, 10) Error: expression has no type: pos t10735.nim(41, 9) Error: type mismatch: got but expected one of: proc `[]`(s: string; i: BackwardsIndex): char @@ -31,7 +31,7 @@ template `[]`(s: string; i: int): char first type mismatch at position: 0 expression: `[]`(buf, pos) -t10735.nim(41, 9) Error: expression 'buf[pos]' has no type (or is ambiguous) +t10735.nim(41, 9) Error: expression has no type: `[]`(buf, pos) t10735.nim(41, 9) Error: selector must be of an ordinal type, float, or string ''' joinable: false diff --git a/tests/errmsgs/t5167_5.nim b/tests/errmsgs/t5167_5.nim index a9e2608451f..a11984eb662 100644 --- a/tests/errmsgs/t5167_5.nim +++ b/tests/errmsgs/t5167_5.nim @@ -1,8 +1,8 @@ discard """ cmd: "nim check $file" -errormsg: "'t' has unspecified generic parameters" +action: reject nimout: ''' -t5167_5.nim(10, 16) Error: expression 'system' has no type (or is ambiguous) +t5167_5.nim(10, 16) Error: expression has no type: system t5167_5.nim(21, 9) Error: 't' has unspecified generic parameters ''' """ diff --git a/tests/errmsgs/t9768.nim b/tests/errmsgs/t9768.nim index b72a158c757..15187bf8424 100644 --- a/tests/errmsgs/t9768.nim +++ b/tests/errmsgs/t9768.nim @@ -3,8 +3,8 @@ discard """ file: "system/fatal.nim" nimout: ''' stack trace: (most recent call last) -t9768.nim(28, 33) main -t9768.nim(23, 11) foo1 +t9768.nim(28, 33) main +t9768.nim(23, 11) foo1 ''' """ diff --git a/tests/errmsgs/tproc_mismatch.nim b/tests/errmsgs/tproc_mismatch.nim index 4ddc7635ec5..89cac8b9981 100644 --- a/tests/errmsgs/tproc_mismatch.nim +++ b/tests/errmsgs/tproc_mismatch.nim @@ -1,7 +1,7 @@ discard """ action: reject cmd: '''nim check --hints:off $options $file''' - nimoutFull: true + nimoutFull: false nimout: ''' tproc_mismatch.nim(35, 52) Error: type mismatch: got but expected 'proc (a: int, c: float){.closure, noSideEffect.}' Calling convention mismatch: got '{.cdecl.}', but expected '{.closure.}'. diff --git a/tests/errmsgs/tproc_mismatch_missing_param.nim b/tests/errmsgs/tproc_mismatch_missing_param.nim new file mode 100644 index 00000000000..92c536e7b5f --- /dev/null +++ b/tests/errmsgs/tproc_mismatch_missing_param.nim @@ -0,0 +1,15 @@ +discard """ + action: reject + cmd: '''nim compile --hints:off $options $file''' + nimout: ''' +tproc_mismatch_missing_param.nim(14, 10) Error: type mismatch: got <> +but expected one of: +proc withParam(arg: int) + +expression: withParam() +''' +""" + +proc withParam(arg: int) = discard +withParam() + diff --git a/tests/errmsgs/treportunused.nim b/tests/errmsgs/treportunused.nim index f5ee79afad9..03774b1f056 100644 --- a/tests/errmsgs/treportunused.nim +++ b/tests/errmsgs/treportunused.nim @@ -1,5 +1,5 @@ discard """ - matrix: "--hint:all:off --hint:XDeclaredButNotUsed" + matrix: "--skipUserCfg --hints=on --hint=all:off --hint=XDeclaredButNotUsed:on" nimoutFull: true nimout: ''' treportunused.nim(23, 10) Hint: 's1' is declared but not used [XDeclaredButNotUsed] diff --git a/tests/errmsgs/tsigmatch2.nim b/tests/errmsgs/tsigmatch2.nim index f1b237e56bd..f0b0f6d1d9a 100644 --- a/tests/errmsgs/tsigmatch2.nim +++ b/tests/errmsgs/tsigmatch2.nim @@ -1,5 +1,6 @@ discard """ cmd: "nim check --showAllMismatches:on --hints:off $file" + action: reject nimout: ''' tsigmatch2.nim(40, 14) Error: type mismatch: got but expected one of: @@ -13,7 +14,7 @@ proc foo(i: Foo): string but expression '1.2' is of type: float64 expression: foo(1.2) -tsigmatch2.nim(40, 14) Error: expression 'foo(1.2)' has no type (or is ambiguous) +tsigmatch2.nim(40, 14) Error: expression has no type: foo(1.2) tsigmatch2.nim(46, 7) Error: type mismatch: got but expected one of: proc foo(args: varargs[string, myproc]) @@ -23,7 +24,6 @@ proc foo(args: varargs[string, myproc]) expression: foo 1 ''' - errormsg: "type mismatch" """ @@ -44,4 +44,3 @@ block: let temp = 12.isNil proc foo(args: varargs[string, myproc]) = discard foo 1 -static: echo "done" \ No newline at end of file diff --git a/tests/errmsgs/tundeclared_routine.nim b/tests/errmsgs/tundeclared_routine.nim index 437c2ca429a..9cb74d5eb0e 100644 --- a/tests/errmsgs/tundeclared_routine.nim +++ b/tests/errmsgs/tundeclared_routine.nim @@ -5,14 +5,14 @@ nimout: ''' tundeclared_routine.nim(34, 17) Error: attempting to call routine: 'myiter' found tundeclared_routine.myiter(a: string) [iterator declared in tundeclared_routine.nim(32, 12)] found tundeclared_routine.myiter() [iterator declared in tundeclared_routine.nim(33, 12)] -tundeclared_routine.nim(34, 17) Error: expression 'myiter(1)' has no type (or is ambiguous) +tundeclared_routine.nim(34, 17) Error: expression has no type: myiter(1) tundeclared_routine.nim(39, 28) Error: invalid pragma: myPragma tundeclared_routine.nim(46, 14) Error: undeclared field: 'bar3' for type tundeclared_routine.Foo [type declared in tundeclared_routine.nim(43, 8)] -tundeclared_routine.nim(46, 13) Error: expression 'a.bar3' has no type (or is ambiguous) +tundeclared_routine.nim(46, 13) Error: expression has no type: `.`(a, bar3) tundeclared_routine.nim(51, 14) Error: undeclared field: 'bar4' for type tundeclared_routine.Foo [type declared in tundeclared_routine.nim(49, 8)] -tundeclared_routine.nim(51, 13) Error: expression 'a.bar4' has no type (or is ambiguous) +tundeclared_routine.nim(51, 13) Error: expression has no type: `.`(a, bar4) tundeclared_routine.nim(54, 11) Error: undeclared identifier: 'bad5' -tundeclared_routine.nim(54, 15) Error: expression 'bad5(1)' has no type (or is ambiguous) +tundeclared_routine.nim(54, 15) Error: expression has no type: bad5(1) ''' """ diff --git a/tests/exception/texception_inference.nim b/tests/exception/texception_inference.nim index 7dd01cca1f2..bdb7c863d09 100644 --- a/tests/exception/texception_inference.nim +++ b/tests/exception/texception_inference.nim @@ -1,5 +1,6 @@ discard """ output: '''good''' + joinable: false cmd: "nim c --gc:orc -d:release $file" """ diff --git a/tests/float/tfloatrange.nim b/tests/float/tfloatrange.nim index d345166f4f6..b4f193581f4 100644 --- a/tests/float/tfloatrange.nim +++ b/tests/float/tfloatrange.nim @@ -1,6 +1,7 @@ discard """ cmd: "nim c -d:release --rangeChecks:on $file" disabled: "windows" + joinable: false output: '''StrictPositiveRange float range fail expected @@ -47,4 +48,3 @@ try: discard strictOnlyProc(x4) except: echo "range fail expected" - diff --git a/tests/generics/tlateboundgenericparams.nim b/tests/generics/tlateboundgenericparams.nim index 9f0580fd278..dde390c536f 100644 --- a/tests/generics/tlateboundgenericparams.nim +++ b/tests/generics/tlateboundgenericparams.nim @@ -35,7 +35,9 @@ when true: body template reject(x) = - static: assert(not compiles(x)) + static: + echo "not compiles? ", astToStr(x), " ", not compiles(x) + assert(not compiles(x)) test 1: proc t[T](val: T = defaultInt()) = @@ -142,4 +144,3 @@ when true: foo(10) foo(1) foo(10) - diff --git a/tests/generics/tpointerprocs.nim b/tests/generics/tpointerprocs.nim index 2bcaf15b368..e3b95cceaee 100644 --- a/tests/generics/tpointerprocs.nim +++ b/tests/generics/tpointerprocs.nim @@ -4,8 +4,8 @@ action: "reject" nimout:''' tpointerprocs.nim(15, 11) Error: 'foo' doesn't have a concrete type, due to unspecified generic parameters. tpointerprocs.nim(27, 11) Error: cannot instantiate: 'foo[int]'; got 1 typeof(s) but expected 2 -tpointerprocs.nim(27, 14) Error: expression 'foo[int]' has no type (or is ambiguous) -tpointerprocs.nim(28, 11) Error: expression 'bar' has no type (or is ambiguous) +tpointerprocs.nim(27, 14) Error: expression has no type: foo[int] +tpointerprocs.nim(28, 11) Error: expression has no type: bar ''' """ @@ -25,4 +25,4 @@ block: proc foo(x: int | float, y: int or string): float = result = 1.0 let bar = foo[int] - baz = bar \ No newline at end of file + baz = bar diff --git a/tests/generics/tstatic_constrained.nim b/tests/generics/tstatic_constrained.nim index f07e2682184..a22c471e547 100644 --- a/tests/generics/tstatic_constrained.nim +++ b/tests/generics/tstatic_constrained.nim @@ -17,10 +17,10 @@ but expected: tstatic_constrained.nim(77, 14) Error: cannot instantiate MyType [type declared in tstatic_constrained.nim(71, 5)] got: but expected: -tstatic_constrained.nim(44, 31) Error: object constructor needs an object type [proxy] -tstatic_constrained.nim(44, 31) Error: expression 'MyOtherType[int, 10]()' has no type (or is ambiguous) -tstatic_constrained.nim(45, 34) Error: object constructor needs an object type [proxy] -tstatic_constrained.nim(45, 34) Error: expression 'MyOtherType[byte, 10'u8]()' has no type (or is ambiguous) +tstatic_constrained.nim(44, 31) Error: object constructor needs an object type +tstatic_constrained.nim(44, 31) Error: expression has no type: MyOtherType[int, 10]() +tstatic_constrained.nim(45, 34) Error: object constructor needs an object type +tstatic_constrained.nim(45, 34) Error: expression has no type: MyOtherType[byte, 10'u8]() ''' """ block: diff --git a/tests/magics/t10307.nim b/tests/magics/t10307.nim index b5bbfdfa80b..456f4205f0a 100644 --- a/tests/magics/t10307.nim +++ b/tests/magics/t10307.nim @@ -1,24 +1,14 @@ discard """ cmd: "nim c -d:useGcAssert $file" - output: '''running someProc(true) -res: yes -yes -running someProc(false) -res: - -''' + joinable: false """ -proc someProc(x:bool):cstring = +proc someProc(x:bool): cstring = var res:string = "" if x: res = "yes" - echo "res: ", res GC_ref(res) result = res -echo "running someProc(true)" -echo someProc(true) - -echo "running someProc(false)" -echo someProc(false) +doAssert someProc(true) == "yes".cstring +doAssert someProc(false) == "".cstring diff --git a/tests/misc/trunner.nim b/tests/misc/trunner.nim index f874d38d914..2fa54f24b90 100644 --- a/tests/misc/trunner.nim +++ b/tests/misc/trunner.nim @@ -1,5 +1,4 @@ discard """ - targets: "c cpp" joinable: false """ @@ -104,7 +103,7 @@ elif not defined(nimTestsTrunnerDebugging): of 5: nimcache / htmldocsDirname else: file.parentDir / htmldocsDirname - var cmd = fmt"{nim} doc --index:on --filenames:abs --hint:successX:on --nimcache:{nimcache} {options[i]} {file}" + var cmd = fmt"{nim} doc --index:on --filenames:abs --hints=on --hint:SuccessX:on --nimcache:{nimcache} {options[i]} {file}" removeDir(htmldocsDir) let (outp, exitCode) = execCmdEx(cmd) check exitCode == 0 @@ -233,7 +232,7 @@ sub/mmain.idx""", context check execCmdEx(cmd) == ("witness\n", 0) block: # config.nims, nim.cfg, hintConf, bug #16557 - let cmd = fmt"{nim} r --hint:all:off --hint:conf tests/newconfig/bar/mfoo.nim" + let cmd = fmt"{nim} r --skipUserCfg --hints=on --hint=all:off --hint=conf:on tests/newconfig/bar/mfoo.nim" let (outp, exitCode) = execCmdEx(cmd, options = {poStdErrToStdOut}) doAssert exitCode == 0 let dir = getCurrentDir() @@ -251,7 +250,7 @@ tests/newconfig/bar/mfoo.nims""".splitLines block: # mfoo2.customext let filename = testsDir / "newconfig/foo2/mfoo2.customext" - let cmd = fmt"{nim} e --hint:conf {filename}" + let cmd = fmt"{nim} e --skipUserCfg --hints=on --hint=all:off --hint:conf {filename}" let (outp, exitCode) = execCmdEx(cmd, options = {poStdErrToStdOut}) doAssert exitCode == 0 var expected = &"Hint: used config file '{filename}' [Conf]\n" @@ -265,7 +264,7 @@ tests/newconfig/bar/mfoo.nims""".splitLines check fmt"""{nim} r -b:js {opt} --eval:"echo defined(js)"""".execCmdEx == ("true\n", 0) block: # `hintProcessing` dots should not interfere with `static: echo` + friends - let cmd = fmt"""{nim} r --hint:all:off --hint:processing -f --eval:"static: echo 1+1"""" + let cmd = fmt"""{nim} r --skipUserCfg --hints=on --hint:all:off --hint:processing -f --eval:"static: echo 1+1"""" let (outp, exitCode) = execCmdEx(cmd, options = {poStdErrToStdOut}) template check3(cond) = doAssert cond, $(outp,) doAssert exitCode == 0 @@ -278,32 +277,6 @@ tests/newconfig/bar/mfoo.nims""".splitLines else: check3 "2" in outp - block: # nim secret - let opt = "--hint:all:off --hint:processing" - template check3(cond) = doAssert cond, $(outp,) - for extra in ["", "--stdout"]: - let cmd = fmt"""{nim} secret {opt} {extra}""" - # xxx minor bug: `nim --hint:QuitCalled:off secret` ignores the hint cmdline flag - template run(input2): untyped = - execCmdEx(cmd, options = {poStdErrToStdOut}, input = input2) - block: - let (outp, exitCode) = run """echo 1+2; import strutils; echo strip(" ab "); quit()""" - let lines = outp.splitLines - when not defined(windows): - check3 lines.len == 5 - check3 lines[0].isDots - check3 lines[1].dup(removePrefix(">>> ")) == "3" # prompt depends on `nimUseLinenoise` - check3 lines[2].isDots - check3 lines[3] == "ab" - check3 lines[4] == "" - else: - check3 "3" in outp - check3 "ab" in outp - doAssert exitCode == 0 - block: - let (outp, exitCode) = run "echo 1+2; quit(2)" - check3 "3" in outp - doAssert exitCode == 2 block: # nimBetterRun let file = "misc/mbetterrun.nim" @@ -329,6 +302,7 @@ running: v2 block: # nim dump let cmd = fmt"{nim} dump --dump.format:json -d:D20210428T161003 --hints:off ." + echo cmd let (ret, status) = execCmdEx(cmd) doAssert status == 0 let j = ret.parseJson @@ -341,12 +315,17 @@ running: v2 const nimcache2 = buildDir / "D20210524T212851" removeDir(nimcache2) let input = "tgenscript_fakefile" # no need for a real file, --eval is good enough - let output = runNimCmdChk(input, fmt"""--genscript --nimcache:{nimcache2.quoteShell} --eval:"echo(12345)" """) + let output = runNimCmdChk( + input, fmt"""--genscript --nimcache:{nimcache2.quoteShell} --eval:"echo(12345)" """) + doAssert output.len == 0, output let ext = when defined(windows): ".bat" else: ".sh" let filename = fmt"compile_{input}{ext}" # synchronize with `generateScript` doAssert fileExists(nimcache2/filename), nimcache2/filename - let (outp, status) = execCmdEx(genShellCmd(filename), options = {poStdErrToStdOut}, workingDir = nimcache2) + let cmd = genShellCmd(filename) + let (outp, status) = execCmdEx( + cmd, options = {poStdErrToStdOut}, workingDir = nimcache2) + doAssert status == 0, outp let (outp2, status2) = execCmdEx(nimcache2 / input, options = {poStdErrToStdOut}) doAssert outp2 == "12345\n", outp2 @@ -354,7 +333,10 @@ running: v2 block: # UnusedImport proc fn(opt: string, expected: string) = - let output = runNimCmdChk("pragmas/mused3.nim", fmt"--warning:all:off --warning:UnusedImport --hint:DuplicateModuleImport {opt}") + let output = runNimCmdChk( + "pragmas/mused3.nim", + fmt"--skipUserCfg --warning:all:off --warning:UnusedImport --hint:DuplicateModuleImport {opt}") + doAssert output == expected, opt & "\noutput:\n" & output & "expected:\n" & expected fn("-d:case1"): """ mused3.nim(13, 8) Warning: imported and not used: 'mused3b' [UnusedImport] @@ -378,7 +360,11 @@ mused3.nim(75, 10) Hint: duplicate import of 'mused3a'; previous import here: mu block: # FieldDefect proc fn(opt: string, expected: string) = - let output = runNimCmdChk("misc/mfield_defect.nim", fmt"-r --warning:all:off --declaredlocs {opt}", status = 1) + let output = runNimCmdChk( + "misc/mfield_defect.nim", + fmt"-r --skipUserCfg --warning:all:off --declaredlocs {opt}", + status = 1) + doAssert expected in output, opt & "\noutput:\n" & output & "expected:\n" & expected fn("-d:case1"): """mfield_defect.nim(25, 15) Error: field 'f2' is not accessible for type 'Foo' [discriminant declared in mfield_defect.nim(14, 8)] using 'kind = k3'""" fn("-d:case2 --gc:refc"): """mfield_defect.nim(25, 15) field 'f2' is not accessible for type 'Foo' [discriminant declared in mfield_defect.nim(14, 8)] using 'kind = k3'""" diff --git a/tests/navigator/tnav1.nim b/tests/navigator/tnav1.nim deleted file mode 100644 index b6bbdbf19a4..00000000000 --- a/tests/navigator/tnav1.nim +++ /dev/null @@ -1,33 +0,0 @@ -discard """ - cmd: "nim check $options --defusages:$file,12,7 $file" - nimout: '''def tnav1_temp.nim(11, 10) -usage tnav1_temp.nim(12, 8) - ''' -""" - - -import std / [times] - -proc foo(x: int) = - echo x - -foo(3) -echo "yes", 1 != 3 - -#!EDIT!# -discard """ - cmd: "nim check $options --defusages:$file,15,2 $file" - nimout: '''def tnav1_temp.nim(12, 6) -usage tnav1_temp.nim(15, 1) - ''' -""" - - -import std / [times] - -proc foo(x: int) = - echo x - -foo(3) -echo "yes", 1 != 3 - diff --git a/tests/objects/t17437.nim b/tests/objects/t17437.nim index 57933709cd2..e60536a12d0 100644 --- a/tests/objects/t17437.nim +++ b/tests/objects/t17437.nim @@ -3,10 +3,10 @@ discard """ action: reject nimout: ''' t17437.nim(20, 16) Error: undeclared identifier: 'x' -t17437.nim(20, 16) Error: expression 'x' has no type (or is ambiguous) +t17437.nim(20, 16) Error: expression has no type: x t17437.nim(20, 19) Error: Invalid field assignment 'y' t17437.nim(20, 12) Error: Invalid object constructor: 'V(x: x, y)' -t17437.nim(20, 12) Error: expression 'V(x: x, y)' has no type (or is ambiguous) +t17437.nim(20, 12) Error: expression has no type: V(x: x, y) ''' """ diff --git a/tests/osproc/treadlines.nim b/tests/osproc/treadlines.nim index bb6a7f129a1..9d91c46906b 100644 --- a/tests/osproc/treadlines.nim +++ b/tests/osproc/treadlines.nim @@ -13,7 +13,7 @@ var ps: seq[Process] # compile & run 2 progs in parallel const nim = getCurrentCompilerExe() for prog in ["a", "b"]: ps.add startProcess(nim, "", - ["r", "--hint:Conf:off", "--hint:Processing:off", prog], + ["r", "--hints=off", prog], options = {poUsePath, poDaemon, poStdErrToStdOut}) for p in ps: diff --git a/tests/parallel/tgc_unsafe2.nim b/tests/parallel/tgc_unsafe2.nim index 7d98dafcb04..329c07d0536 100644 --- a/tests/parallel/tgc_unsafe2.nim +++ b/tests/parallel/tgc_unsafe2.nim @@ -1,8 +1,10 @@ discard """ + joinable: false + cmd: '''nim c --hints=on $file''' errormsg: "'consumer' is not GC-safe as it calls 'track'" - nimout: '''tgc_unsafe2.nim(21, 6) Warning: 'trick' is not GC-safe as it accesses 'global' which is a global using GC'ed memory [GcUnsafe2] -tgc_unsafe2.nim(25, 6) Warning: 'track' is not GC-safe as it calls 'trick' [GcUnsafe2] -tgc_unsafe2.nim(27, 6) Error: 'consumer' is not GC-safe as it calls 'track' + nimout: '''tgc_unsafe2.nim(23, 6) Warning: 'trick' is not GC-safe as it accesses 'global' which is a global using GC'ed memory [GcUnsafe2] +tgc_unsafe2.nim(27, 6) Warning: 'track' is not GC-safe as it calls 'trick' [GcUnsafe2] +tgc_unsafe2.nim(29, 6) Error: 'consumer' is not GC-safe as it calls 'track' ''' """ diff --git a/tests/parser/tinvcolonlocation1.nim b/tests/parser/tinvcolonlocation1.nim index 7fca5deb7d7..7cf92652f0e 100644 --- a/tests/parser/tinvcolonlocation1.nim +++ b/tests/parser/tinvcolonlocation1.nim @@ -2,7 +2,7 @@ discard """ errormsg: "expected: ':', but got: 'echo'" file: "tinvcolonlocation1.nim" line: 8 - column: 7 + column: 3 """ try #<- missing ':' echo "try" diff --git a/tests/parser/tinvcolonlocation2.nim b/tests/parser/tinvcolonlocation2.nim index e3de393b87c..ef35aaad2fe 100644 --- a/tests/parser/tinvcolonlocation2.nim +++ b/tests/parser/tinvcolonlocation2.nim @@ -2,7 +2,7 @@ discard """ errormsg: "expected: ':', but got: 'keyword finally'" file: "tinvcolonlocation2.nim" line: 11 - column: 8 + column: 1 """ try: echo "try" diff --git a/tests/parser/tinvcolonlocation3.nim b/tests/parser/tinvcolonlocation3.nim index 46252f24e2b..0ead03bfdf7 100644 --- a/tests/parser/tinvcolonlocation3.nim +++ b/tests/parser/tinvcolonlocation3.nim @@ -2,7 +2,7 @@ discard """ errormsg: "expected: ':', but got: 'echo'" file: "tinvcolonlocation3.nim" line: 12 - column: 7 + column: 3 """ try: echo "try" diff --git a/tests/pragmas/tused2.nim b/tests/pragmas/tused2.nim index f80c198d822..9e0e19fc32a 100644 --- a/tests/pragmas/tused2.nim +++ b/tests/pragmas/tused2.nim @@ -1,5 +1,5 @@ discard """ - matrix: "--hint:all:off --hint:XDeclaredButNotUsed --path:." + matrix: "--skipUserCfg --hints=on --hint=all:off --hint:XDeclaredButNotUsed --path:." joinable: false nimoutFull: true nimout: ''' diff --git a/tests/proc/typed.nim b/tests/proc/typed.nim index 2e811763477..a6a6ccfe827 100644 --- a/tests/proc/typed.nim +++ b/tests/proc/typed.nim @@ -1,5 +1,5 @@ discard """ - errormsg: "'typed' is only allowed in templates and macros" + errormsg: "return type 'typed' is only valid for macros and templates" line: 6 """ diff --git a/tests/range/tsubrange.nim b/tests/range/tsubrange.nim index f778c55ebaa..d57df40272c 100644 --- a/tests/range/tsubrange.nim +++ b/tests/range/tsubrange.nim @@ -1,5 +1,5 @@ discard """ - errormsg: "cannot convert 60 to TRange" + errormsg: "60 can't be converted to TRange" line: 20 """ diff --git a/tests/sets/t2669.nim b/tests/sets/t2669.nim index 0a92818fafc..cb94af048c5 100644 --- a/tests/sets/t2669.nim +++ b/tests/sets/t2669.nim @@ -1,5 +1,5 @@ discard """ -errormsg: "cannot convert 6 to range 1..5(int8)" +errormsg: "6 can't be converted to range 1..5(int8)" line: 6 """ diff --git a/tests/stdlib/tstdlib_various.nim b/tests/stdlib/tstdlib_various.nim index bc90d6ef482..5bdb802f43f 100644 --- a/tests/stdlib/tstdlib_various.nim +++ b/tests/stdlib/tstdlib_various.nim @@ -7,7 +7,7 @@ prefix xyz def definition -Hi Andreas! How do you feel, Rumpf? +Hi user! How do you feel, name? @[0, 2, 1] @[1, 0, 2] @@ -67,7 +67,7 @@ block testequivalence: block tformat: - echo("Hi $1! How do you feel, $2?\n" % ["Andreas", "Rumpf"]) + echo("Hi $1! How do you feel, $2?\n" % ["user", "name"]) @@ -115,7 +115,7 @@ block treguse: write(stdout, y) write(stdout, "this should be the case") var input = "" - if input == "Andreas": + if input == "user": write(stdout, "wow") else: write(stdout, "hugh") diff --git a/tests/stdlib/tvmutils.nim b/tests/stdlib/tvmutils.nim index f43557ad80b..1dcfa543eb9 100644 --- a/tests/stdlib/tvmutils.nim +++ b/tests/stdlib/tvmutils.nim @@ -4,15 +4,15 @@ discard """ 0 1 2 -tvmutils.nim(28, 13) [opcLdImmInt] if i == 4: -tvmutils.nim(28, 10) [opcEqInt] if i == 4: -tvmutils.nim(28, 10) [opcFJmp] if i == 4: -tvmutils.nim(28, 13) [opcLdImmInt] if i == 4: -tvmutils.nim(28, 10) [opcEqInt] if i == 4: -tvmutils.nim(28, 10) [opcFJmp] if i == 4: -tvmutils.nim(29, 7) [opcLdConst] vmTrace(false) -tvmutils.nim(29, 15) [opcLdImmInt] vmTrace(false) -tvmutils.nim(29, 14) [opcIndCall] vmTrace(false) +tvmutils.nim(28, 13) [LdImmInt] if i == 4: +tvmutils.nim(28, 10) [EqInt] if i == 4: +tvmutils.nim(28, 10) [FJmp] if i == 4: +tvmutils.nim(28, 13) [LdImmInt] if i == 4: +tvmutils.nim(28, 10) [EqInt] if i == 4: +tvmutils.nim(28, 10) [FJmp] if i == 4: +tvmutils.nim(29, 7) [LdConst] vmTrace(false) +tvmutils.nim(29, 15) [LdImmInt] vmTrace(false) +tvmutils.nim(29, 14) [IndCall] vmTrace(false) 5 6 ''' diff --git a/tests/stylecheck/tusages.nim b/tests/stylecheck/tusages.nim index 2f99c70c56b..6affd0ed644 100644 --- a/tests/stylecheck/tusages.nim +++ b/tests/stylecheck/tusages.nim @@ -1,6 +1,6 @@ discard """ action: reject - nimout: '''tusages.nim(22, 5) Error: 'BAD_STYLE' should be: 'BADSTYLE' [proc declared in tusages.nim(11, 6)]''' + nimout: '''tusages.nim(22, 5) Error: 'BAD_STYLE' should be: 'BADSTYLE' [proc declared in tusages.nim(11, 6)] [Name]''' matrix: "--styleCheck:error --styleCheck:usages" """ diff --git a/tests/system/tgogc.nim b/tests/system/tgogc.nim index fd45bb1202c..a25844380bc 100644 --- a/tests/system/tgogc.nim +++ b/tests/system/tgogc.nim @@ -1,6 +1,7 @@ discard """ disabled: "windows" cmd: "nim c --gc:go $file" + joinable: false action: "compile" """ # bug #11447 diff --git a/tests/tools/tlinter.nim b/tests/tools/tlinter.nim index a6d45ab3b74..ac69e83a78b 100644 --- a/tests/tools/tlinter.nim +++ b/tests/tools/tlinter.nim @@ -1,5 +1,5 @@ discard """ - cmd: '''nim c --styleCheck:hint $file''' + cmd: '''nim c --styleCheck=hint $file''' nimout: ''' tlinter.nim(21, 14) Hint: 'nosideeffect' should be: 'noSideEffect' [Name] tlinter.nim(21, 28) Hint: 'myown' should be: 'myOwn' [template declared in tlinter.nim(19, 9)] [Name] @@ -35,6 +35,5 @@ proc main = main() type - Foo = object + Foo {.used.} = object meh_field: int - diff --git a/tests/tools/tunused_imports.nim b/tests/tools/tunused_imports.nim index 31d6cf7d7a8..56c70987c14 100644 --- a/tests/tools/tunused_imports.nim +++ b/tests/tools/tunused_imports.nim @@ -1,9 +1,10 @@ discard """ cmd: '''nim c --hint:Processing:off $file''' + joinable: false nimout: ''' -tunused_imports.nim(11, 10) Warning: BEGIN [User] -tunused_imports.nim(36, 10) Warning: END [User] -tunused_imports.nim(34, 8) Warning: imported and not used: 'strutils' [UnusedImport] +tunused_imports.nim(12, 10) Warning: BEGIN [User] +tunused_imports.nim(37, 10) Warning: END [User] +tunused_imports.nim(35, 8) Warning: imported and not used: 'strutils' [UnusedImport] ''' action: "compile" """ diff --git a/tests/typerel/ttypelessemptyset.nim b/tests/typerel/ttypelessemptyset.nim deleted file mode 100644 index 5f49c33fdcd..00000000000 --- a/tests/typerel/ttypelessemptyset.nim +++ /dev/null @@ -1,6 +0,0 @@ -discard """ - errormsg: "internal error: invalid kind for lastOrd(tyEmpty)" -""" -var q = false -discard (if q: {} else: {}) - diff --git a/tests/types/tinheritance_conversion.nim b/tests/types/tinheritance_conversion.nim index a0b4b01ddee..26aa0237227 100644 --- a/tests/types/tinheritance_conversion.nim +++ b/tests/types/tinheritance_conversion.nim @@ -1,11 +1,6 @@ discard """ - cmd: "nim c --hint[Conf]:off --verbosity:0 $file" - nimout: ''' -Hint: Implicit conversion: Receiver 'Base' will not receive fields of sub-type 'Derived' [tinheritance_conversion.nim(30, 15)] [ImplicitObjConv] -Hint: Implicit conversion: Receiver 'Base' will not receive fields of sub-type 'Derived' [tinheritance_conversion.nim(30, 34)] [ImplicitObjConv] -Hint: Implicit conversion: Receiver 'Base' will not receive fields of sub-type 'Derived2' [tinheritance_conversion.nim(38, 3)] [ImplicitObjConv] - -''' + cmd: "nim c --hints=on $file" + joinable: false """ @@ -22,12 +17,19 @@ block: # Value tests proc test(args: varargs[Base]) = for x in args: assert x.field == 0 - + proc test2(base: var Base) = base.field = 400 proc test3(base: Base) = discard var a: Derived = Derived(Base()) a = Derived(Base(Derived2())) - test(Derived(), Base(), Derived()) + test( + Derived(), #[tt.Hint + ^ Implicit conversion: Receiver 'Base' will not receive fields of sub-type 'Derived' [ImplicitObjConv] ]# + Base(), + Derived() #[tt.Hint + ^ Implicit conversion: Receiver 'Base' will not receive fields of sub-type 'Derived' [ImplicitObjConv] ]# + ) + a.field2 = 300 test2(a) assert a.field == 400 @@ -35,7 +37,8 @@ block: # Value tests var b = Derived2(field: 800) b.test2() assert b.field == 400 - b.test3() + b.test3() #[tt.Hint + ^ Implicit conversion: Receiver 'Base' will not receive fields of sub-type 'Derived2' [ImplicitObjConv] ]# @@ -46,7 +49,7 @@ block: # Ref tests Derived = ref object of Base field2: int Derived2 = ref object of Base - + var a: Base = Derived() assert Derived(a) is Derived doAssertRaises(ObjectConversionDefect): discard Derived2(a)[] diff --git a/tests/views/tcan_compile_nim.nim b/tests/views/tcan_compile_nim.nim index e990606cde2..ef79f1b0ffb 100644 --- a/tests/views/tcan_compile_nim.nim +++ b/tests/views/tcan_compile_nim.nim @@ -1,4 +1,4 @@ discard """ - cmd: "nim check --hints:on --experimental:strictFuncs --experimental:views compiler/nim.nim" + cmd: "nim check --warning=GcUnsafe:off --hints:on --experimental:strictFuncs --experimental:views compiler/nim.nim" action: "compile" """ diff --git a/tools/grammar_nanny.nim b/tools/grammar_nanny.nim index 502412c3ceb..93af703c2a7 100644 --- a/tools/grammar_nanny.nim +++ b/tools/grammar_nanny.nim @@ -5,7 +5,7 @@ import std / [strutils, sets] import ".." / compiler / [ llstream, lexer, options, msgs, idents, - lineinfos, pathutils] + lineinfos, pathutils, reports] proc checkGrammarFileImpl(cache: IdentCache, config: ConfigRef) = var f = AbsoluteFile"doc/grammar.txt" @@ -46,7 +46,7 @@ proc checkGrammarFileImpl(cache: IdentCache, config: ConfigRef) = closeLexer(L) else: - rawMessage(config, errGenerated, "cannot open file: " & f.string) + config.localError InternalReport(kind: rintCannotOpenFile, file: f.string) proc checkGrammarFile* = checkGrammarFileImpl(newIdentCache(), newConfigRef())