diff options
Diffstat (limited to 'compiler')
171 files changed, 26617 insertions, 14717 deletions
diff --git a/compiler/aliasanalysis.nim b/compiler/aliasanalysis.nim new file mode 100644 index 000000000..e24c6d8e2 --- /dev/null +++ b/compiler/aliasanalysis.nim @@ -0,0 +1,128 @@ + +import ast + +import std / assertions + +const + PathKinds0* = {nkDotExpr, nkCheckedFieldExpr, + nkBracketExpr, nkDerefExpr, nkHiddenDeref, + nkAddr, nkHiddenAddr, + nkObjDownConv, nkObjUpConv} + PathKinds1* = {nkHiddenStdConv, nkHiddenSubConv} + +proc skipConvDfa*(n: PNode): PNode = + result = n + while true: + case result.kind + of nkObjDownConv, nkObjUpConv: + result = result[0] + of PathKinds1: + result = result[1] + else: break + +proc isAnalysableFieldAccess*(orig: PNode; owner: PSym): bool = + var n = orig + while true: + case n.kind + of PathKinds0 - {nkHiddenDeref, nkDerefExpr}: + n = n[0] + of PathKinds1: + n = n[1] + of nkHiddenDeref, nkDerefExpr: + # We "own" sinkparam[].loc but not ourVar[].location as it is a nasty + # pointer indirection. + # bug #14159, we cannot reason about sinkParam[].location as it can + # still be shared for tyRef. + n = n[0] + return n.kind == nkSym and n.sym.owner == owner and + (n.sym.typ.skipTypes(abstractInst-{tyOwned}).kind in {tyOwned}) + else: break + # XXX Allow closure deref operations here if we know + # the owner controlled the closure allocation? + result = n.kind == nkSym and n.sym.owner == owner and + {sfGlobal, sfThread, sfCursor} * n.sym.flags == {} and + (n.sym.kind != skParam or isSinkParam(n.sym)) # or n.sym.typ.kind == tyVar) + # Note: There is a different move analyzer possible that checks for + # consume(param.key); param.key = newValue for all paths. Then code like + # + # let splited = split(move self.root, x) + # self.root = merge(splited.lower, splited.greater) + # + # could be written without the ``move self.root``. However, this would be + # wrong! Then the write barrier for the ``self.root`` assignment would + # free the old data and all is lost! Lesson: Don't be too smart, trust the + # lower level C++ optimizer to specialize this code. + +type AliasKind* = enum + yes, no, maybe + +proc aliases*(obj, field: PNode): AliasKind = + # obj -> field: + # x -> x: true + # x -> x.f: true + # x.f -> x: false + # x.f -> x.f: true + # x.f -> x.v: false + # x -> x[]: true + # x[] -> x: false + # x -> x[0]: true + # x[0] -> x: false + # x[0] -> x[0]: true + # x[0] -> x[1]: false + # x -> x[i]: true + # x[i] -> x: false + # x[i] -> x[i]: maybe; Further analysis could make this return true when i is a runtime-constant + # x[i] -> x[j]: maybe; also returns maybe if only one of i or j is a compiletime-constant + template collectImportantNodes(result, n) = + var result: seq[PNode] = @[] + var n = n + while true: + case n.kind + of PathKinds0 - {nkDotExpr, nkBracketExpr, nkDerefExpr, nkHiddenDeref}: + n = n[0] + of PathKinds1: + n = n[1] + of nkDotExpr, nkBracketExpr, nkDerefExpr, nkHiddenDeref: + result.add n + n = n[0] + of nkSym: + result.add n + break + else: return no + + collectImportantNodes(objImportantNodes, obj) + collectImportantNodes(fieldImportantNodes, field) + + # If field is less nested than obj, then it cannot be part of/aliased by obj + if fieldImportantNodes.len < objImportantNodes.len: return no + + result = yes + for i in 1..objImportantNodes.len: + # We compare the nodes leading to the location of obj and field + # with each other. + # We continue until they diverge, in which case we return no, or + # until we reach the location of obj, in which case we do not need + # to look further, since field must be part of/aliased by obj now. + # If we encounter an element access using an index which is a runtime value, + # we simply return maybe instead of yes; should further nodes not diverge. + let currFieldPath = fieldImportantNodes[^i] + let currObjPath = objImportantNodes[^i] + + if currFieldPath.kind != currObjPath.kind: + return no + + case currFieldPath.kind + of nkSym: + if currFieldPath.sym != currObjPath.sym: return no + of nkDotExpr: + if currFieldPath[1].sym != currObjPath[1].sym: return no + of nkDerefExpr, nkHiddenDeref: + discard + of nkBracketExpr: + if currFieldPath[1].kind in nkLiterals and currObjPath[1].kind in nkLiterals: + if currFieldPath[1].intVal != currObjPath[1].intVal: + return no + else: + result = maybe + else: assert false # unreachable + diff --git a/compiler/aliases.nim b/compiler/aliases.nim index 0006c9fe6..fa1167753 100644 --- a/compiler/aliases.nim +++ b/compiler/aliases.nim @@ -10,7 +10,12 @@ ## Simple alias analysis for the HLO and the code generators. import - ast, astalgo, types, trees, intsets + ast, astalgo, types, trees + +import std/intsets + +when defined(nimPreviewSlimSystem): + import std/assertions type TAnalysisResult* = enum @@ -46,14 +51,16 @@ proc isPartOfAux(a, b: PType, marker: var IntSet): TAnalysisResult = if compareTypes(a, b, dcEqIgnoreDistinct): return arYes case a.kind of tyObject: - if a[0] != nil: - result = isPartOfAux(a[0].skipTypes(skipPtrs), b, marker) + if a.baseClass != nil: + result = isPartOfAux(a.baseClass.skipTypes(skipPtrs), b, marker) if result == arNo: result = isPartOfAux(a.n, b, marker) of tyGenericInst, tyDistinct, tyAlias, tySink: - result = isPartOfAux(lastSon(a), b, marker) - of tyArray, tySet, tyTuple: - for i in 0..<a.len: - result = isPartOfAux(a[i], b, marker) + result = isPartOfAux(skipModifier(a), b, marker) + of tySet, tyArray: + result = isPartOfAux(a.elementType, b, marker) + of tyTuple: + for aa in a.kids: + result = isPartOfAux(aa, b, marker) if result == arYes: return else: discard @@ -74,24 +81,29 @@ proc isPartOf*(a, b: PNode): TAnalysisResult = ## cases: ## ## YES-cases: + ## ``` ## x <| x # for general trees ## x[] <| x ## x[i] <| x ## x.f <| x + ## ``` ## ## NO-cases: + ## ``` ## x !<| y # depending on type and symbol kind ## x[constA] !<| x[constB] ## x.f !<| x.g ## x.f !<| y.f iff x !<= y + ## ``` ## ## MAYBE-cases: ## + ## ``` ## x[] ?<| y[] iff compatible type ## ## ## x[] ?<| y depending on type - ## + ## ``` if a.kind == b.kind: case a.kind of nkSym: @@ -106,6 +118,8 @@ proc isPartOf*(a, b: PNode): TAnalysisResult = # use expensive type check: if isPartOf(a.sym.typ, b.sym.typ) != arNo: result = arMaybe + else: + result = arNo of nkBracketExpr: result = isPartOf(a[0], b[0]) if a.len >= 2 and b.len >= 2: @@ -141,7 +155,7 @@ proc isPartOf*(a, b: PNode): TAnalysisResult = result = isPartOf(a[1], b[1]) of nkObjUpConv, nkObjDownConv, nkCheckedFieldExpr: result = isPartOf(a[0], b[0]) - else: discard + else: result = arNo # Calls return a new location, so a default of ``arNo`` is fine. else: # go down recursively; this is quite demanding: @@ -157,6 +171,7 @@ proc isPartOf*(a, b: PNode): TAnalysisResult = of DerefKinds: # a* !<| b[] iff + result = arNo if isPartOf(a.typ, b.typ) != arNo: result = isPartOf(a, b[0]) if result == arNo: result = arMaybe @@ -178,7 +193,9 @@ proc isPartOf*(a, b: PNode): TAnalysisResult = if isPartOf(a.typ, b.typ) != arNo: result = isPartOf(a[0], b) if result == arNo: result = arMaybe - else: discard + else: + result = arNo + else: result = arNo of nkObjConstr: result = arNo for i in 1..<b.len: @@ -196,4 +213,6 @@ proc isPartOf*(a, b: PNode): TAnalysisResult = of nkBracket: if b.len > 0: result = isPartOf(a, b[0]) - else: discard + else: + result = arNo + else: result = arNo diff --git a/compiler/ast.nim b/compiler/ast.nim index 1f3d5f129..a342e1ea7 100644 --- a/compiler/ast.nim +++ b/compiler/ast.nim @@ -10,11 +10,19 @@ # abstract syntax tree + symbol table import - lineinfos, hashes, options, ropes, idents, int128 -from strutils import toLowerAscii + lineinfos, options, ropes, idents, int128, wordrecg + +import std/[tables, hashes] +from std/strutils import toLowerAscii + +when defined(nimPreviewSlimSystem): + import std/assertions export int128 +import nodekinds +export nodekinds + type TCallingConvention* = enum ccNimCall = "nimcall" # nimcall, also the default @@ -28,207 +36,12 @@ type ccThisCall = "thiscall" # thiscall (parameters are pushed right-to-left) ccClosure = "closure" # proc has a closure ccNoConvention = "noconv" # needed for generating proper C procs sometimes - -type - TNodeKind* = enum # order is extremely important, because ranges are used - # to check whether a node belongs to a certain class - nkNone, # unknown node kind: indicates an error - # Expressions: - # Atoms: - nkEmpty, # the node is empty - nkIdent, # node is an identifier - nkSym, # node is a symbol - nkType, # node is used for its typ field - - nkCharLit, # a character literal '' - nkIntLit, # an integer literal - nkInt8Lit, - nkInt16Lit, - nkInt32Lit, - nkInt64Lit, - nkUIntLit, # an unsigned integer literal - nkUInt8Lit, - nkUInt16Lit, - nkUInt32Lit, - nkUInt64Lit, - nkFloatLit, # a floating point literal - nkFloat32Lit, - nkFloat64Lit, - nkFloat128Lit, - nkStrLit, # a string literal "" - nkRStrLit, # a raw string literal r"" - nkTripleStrLit, # a triple string literal """ - nkNilLit, # the nil literal - # end of atoms - nkComesFrom, # "comes from" template/macro information for - # better stack trace generation - nkDotCall, # used to temporarily flag a nkCall node; - # this is used - # for transforming ``s.len`` to ``len(s)`` - - nkCommand, # a call like ``p 2, 4`` without parenthesis - nkCall, # a call like p(x, y) or an operation like +(a, b) - nkCallStrLit, # a call with a string literal - # x"abc" has two sons: nkIdent, nkRStrLit - # x"""abc""" has two sons: nkIdent, nkTripleStrLit - nkInfix, # a call like (a + b) - nkPrefix, # a call like !a - nkPostfix, # something like a! (also used for visibility) - nkHiddenCallConv, # an implicit type conversion via a type converter - - nkExprEqExpr, # a named parameter with equals: ''expr = expr'' - nkExprColonExpr, # a named parameter with colon: ''expr: expr'' - nkIdentDefs, # a definition like `a, b: typeDesc = expr` - # either typeDesc or expr may be nil; used in - # formal parameters, var statements, etc. - nkVarTuple, # a ``var (a, b) = expr`` construct - nkPar, # syntactic (); may be a tuple constructor - nkObjConstr, # object constructor: T(a: 1, b: 2) - nkCurly, # syntactic {} - nkCurlyExpr, # an expression like a{i} - nkBracket, # syntactic [] - nkBracketExpr, # an expression like a[i..j, k] - nkPragmaExpr, # an expression like a{.pragmas.} - nkRange, # an expression like i..j - nkDotExpr, # a.b - nkCheckedFieldExpr, # a.b, but b is a field that needs to be checked - nkDerefExpr, # a^ - nkIfExpr, # if as an expression - nkElifExpr, - nkElseExpr, - nkLambda, # lambda expression - nkDo, # lambda block appering as trailing proc param - nkAccQuoted, # `a` as a node - - nkTableConstr, # a table constructor {expr: expr} - nkBind, # ``bind expr`` node - nkClosedSymChoice, # symbol choice node; a list of nkSyms (closed) - nkOpenSymChoice, # symbol choice node; a list of nkSyms (open) - nkHiddenStdConv, # an implicit standard type conversion - nkHiddenSubConv, # an implicit type conversion from a subtype - # to a supertype - nkConv, # a type conversion - nkCast, # a type cast - nkStaticExpr, # a static expr - nkAddr, # a addr expression - nkHiddenAddr, # implicit address operator - nkHiddenDeref, # implicit ^ operator - nkObjDownConv, # down conversion between object types - nkObjUpConv, # up conversion between object types - nkChckRangeF, # range check for floats - nkChckRange64, # range check for 64 bit ints - nkChckRange, # range check for ints - nkStringToCString, # string to cstring - nkCStringToString, # cstring to string - # end of expressions - - nkAsgn, # a = b - nkFastAsgn, # internal node for a fast ``a = b`` - # (no string copy) - nkGenericParams, # generic parameters - nkFormalParams, # formal parameters - nkOfInherit, # inherited from symbol - - nkImportAs, # a 'as' b in an import statement - nkProcDef, # a proc - nkMethodDef, # a method - nkConverterDef, # a converter - nkMacroDef, # a macro - nkTemplateDef, # a template - nkIteratorDef, # an iterator - - nkOfBranch, # used inside case statements - # for (cond, action)-pairs - nkElifBranch, # used in if statements - nkExceptBranch, # an except section - nkElse, # an else part - nkAsmStmt, # an assembler block - nkPragma, # a pragma statement - nkPragmaBlock, # a pragma with a block - nkIfStmt, # an if statement - nkWhenStmt, # a when expression or statement - nkForStmt, # a for statement - nkParForStmt, # a parallel for statement - nkWhileStmt, # a while statement - nkCaseStmt, # a case statement - nkTypeSection, # a type section (consists of type definitions) - nkVarSection, # a var section - nkLetSection, # a let section - nkConstSection, # a const section - nkConstDef, # a const definition - nkTypeDef, # a type definition - nkYieldStmt, # the yield statement as a tree - nkDefer, # the 'defer' statement - nkTryStmt, # a try statement - nkFinally, # a finally section - nkRaiseStmt, # a raise statement - nkReturnStmt, # a return statement - nkBreakStmt, # a break statement - nkContinueStmt, # a continue statement - nkBlockStmt, # a block statement - nkStaticStmt, # a static statement - nkDiscardStmt, # a discard statement - nkStmtList, # a list of statements - nkImportStmt, # an import statement - nkImportExceptStmt, # an import x except a statement - nkExportStmt, # an export statement - nkExportExceptStmt, # an 'export except' statement - nkFromStmt, # a from * import statement - nkIncludeStmt, # an include statement - nkBindStmt, # a bind statement - nkMixinStmt, # a mixin statement - nkUsingStmt, # an using statement - nkCommentStmt, # a comment statement - nkStmtListExpr, # a statement list followed by an expr; this is used - # to allow powerful multi-line templates - nkBlockExpr, # a statement block ending in an expr; this is used - # to allow powerful multi-line templates that open a - # temporary scope - nkStmtListType, # a statement list ending in a type; for macros - nkBlockType, # a statement block ending in a type; for macros - # types as syntactic trees: - - nkWith, # distinct with `foo` - nkWithout, # distinct without `foo` - - nkTypeOfExpr, # type(1+2) - nkObjectTy, # object body - nkTupleTy, # tuple body - nkTupleClassTy, # tuple type class - nkTypeClassTy, # user-defined type class - nkStaticTy, # ``static[T]`` - nkRecList, # list of object parts - nkRecCase, # case section of object - nkRecWhen, # when section of object - nkRefTy, # ``ref T`` - nkPtrTy, # ``ptr T`` - nkVarTy, # ``var T`` - nkConstTy, # ``const T`` - 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 - nkModuleRef # for .rod file support: A (moduleId, itemId) pair - nkReplayAction # for .rod file support: A replay action - nkNilRodNode # for .rod file support: a 'nil' PNode + ccMember = "member" # proc is a (cpp) member TNodeKinds* = set[TNodeKind] type - TSymFlag* = enum # 46 flags! + TSymFlag* = enum # 63 flags! sfUsed, # read access of sym (for warnings) or simply used sfExported, # symbol is exported from module sfFromGeneric, # symbol is instantiation of a generic; this is needed @@ -256,7 +69,8 @@ type # *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 + sfEscapes # param escapes + # currently unimplemented sfDiscriminant, # field is a discriminant in a record/object sfRequiresInit, # field must be initialized during construction sfDeprecated, # symbol is deprecated @@ -279,7 +93,7 @@ type sfNamedParamCall, # symbol needs named parameter call syntax in target # language; for interfacing with Objective C sfDiscardable, # returned value may be discarded implicitly - sfOverriden, # proc is overridden + sfOverridden, # proc is overridden sfCallsite # A flag for template symbols to tell the # compiler it should use line information from # the calling side of the macro, not from the @@ -295,27 +109,42 @@ type sfInjectDestructors # whether the proc needs the 'injectdestructors' transformation sfNeverRaises # proc can never raise an exception, not even OverflowDefect # or out-of-memory + sfSystemRaisesDefect # proc in the system can raise defects sfUsedInFinallyOrExcept # symbol is used inside an 'except' or 'finally' sfSingleUsedTemp # For temporaries that we know will only be used once sfNoalias # 'noalias' annotation, means C's 'restrict' + # for templates and macros, means cannot be called + # as a lone symbol (cannot use alias syntax) + sfEffectsDelayed # an 'effectsDelayed' parameter + sfGeneratedType # A anonymous generic type that is generated by the compiler for + # objects that do not have generic parameters in case one of the + # object fields has one. + # + # This is disallowed but can cause the typechecking to go into + # an infinite loop, this flag is used as a sentinel to stop it. + sfVirtual # proc is a C++ virtual function + sfByCopy # param is marked as pass bycopy + sfMember # proc is a C++ member of a type + sfCodegenDecl # type, proc, global or proc param is marked as codegenDecl + sfWasGenSym # symbol was 'gensym'ed + sfForceLift # variable has to be lifted into closure environment + + sfDirty # template is not hygienic (old styled template) module, + # compiled from a dirty-buffer + sfCustomPragma # symbol is custom pragma template + sfBase, # a base method + sfGoto # var is used for 'goto' code generation + sfAnon, # symbol name that was generated by the compiler + # the compiler will avoid printing such names + # in user messages. + sfAllUntyped # macro or template is immediately expanded in a generic context + sfTemplateRedefinition # symbol is a redefinition of an earlier template TSymFlags* = set[TSymFlag] const sfNoInit* = sfMainModule # don't generate code to init the variable - 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 @@ -323,13 +152,10 @@ const sfCompileToCpp* = sfInfixCall # compile the module as C++ code sfCompileToObjc* = sfNamedParamCall # compile the module as Objective-C code - sfExperimental* = sfOverriden # module uses the .experimental switch - sfGoto* = sfOverriden # var is used for 'goto' code generation + sfExperimental* = sfOverridden # module uses the .experimental switch sfWrittenTo* = sfBorrow # param is assigned to - sfEscapes* = sfProcvar # param escapes - sfBase* = sfDiscriminant - sfIsSelf* = sfOverriden # param is 'self' - sfCustomPragma* = sfRegister # symbol is custom pragma template + # currently unimplemented + sfCppMember* = { sfVirtual, sfMember, sfConstructor } # proc is a C++ member, meaning it will be attached to the type definition const # getting ready for the future expr/stmt merge @@ -342,7 +168,8 @@ const 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 + forbiddenEffects* = 5 # list of illegal effects + effectListLen* = 6 # list of effects list nkLastBlockStmts* = {nkRaiseStmt, nkReturnStmt, nkBreakStmt, nkContinueStmt} # these must be last statements in a block @@ -378,7 +205,7 @@ type tySequence, tyProc, tyPointer, tyOpenArray, - tyString, tyCString, tyForward, + tyString, tyCstring, tyForward, tyInt, tyInt8, tyInt16, tyInt32, tyInt64, # signed integers tyFloat, tyFloat32, tyFloat64, tyFloat128, tyUInt, tyUInt8, tyUInt16, tyUInt32, tyUInt64, @@ -387,7 +214,8 @@ type tyUncheckedArray # An array with boundaries [0,+∞] - tyProxy # used as errornous type (for idetools) + tyError # used as erroneous type (for idetools) + # as an erroneous node should match everything tyBuiltInTypeClass # Type such as the catch-all object, tuple, seq, etc @@ -412,9 +240,9 @@ type tyInferred # In the initial state `base` stores a type class constraining # the types that can be inferred. After a candidate type is - # selected, it's stored in `lastSon`. Between `base` and `lastSon` + # selected, it's stored in `last`. Between `base` and `last` # there may be 0, 2 or more types that were also considered as - # possible candidates in the inference process (i.e. lastSon will + # possible candidates in the inference process (i.e. last will # be updated to store a type best conforming to all candidates) tyAnd, tyOr, tyNot @@ -439,18 +267,16 @@ type 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 + # 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, @@ -461,6 +287,8 @@ const # 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] @@ -491,10 +319,15 @@ type # 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 + nfFirstWrite # this node is a first write + nfHasComment # node has a comment + nfSkipFieldChecking # node skips field visable checking + nfDisabledOpenSym # temporary: node should be nkOpenSym but cannot + # because openSym experimental switch is disabled + # gives warning instead TNodeFlags* = set[TNodeFlag] - TTypeFlag* = enum # keep below 32 for efficiency reasons (now: ~40) + TTypeFlag* = enum # keep below 32 for efficiency reasons (now: 47) tfVarargs, # procedure has C styled varargs # tyArray type represeting a varargs list tfNoSideEffect, # procedure type does not allow side effects @@ -524,7 +357,7 @@ type tfIterator, # type is really an iterator, not a tyProc tfPartial, # type is declared as 'partial' tfNotNil, # type cannot be 'nil' - tfRequiresInit, # type constains a "not nil" constraint somewhere or + tfRequiresInit, # type contains a "not nil" constraint somewhere or # a `requiresInit` field, so the default zero init # is not appropriate tfNeedsFullInit, # object type marked with {.requiresInit.} @@ -561,6 +394,11 @@ type # (for importc types); type is fully specified, allowing to compute # sizeof, alignof, offsetof at CT tfExplicitCallConv + tfIsConstructor + tfEffectSystemWorkaround + tfIsOutParam + tfSendable + tfImplicitStatic TTypeFlags* = set[TTypeFlag] @@ -596,20 +434,23 @@ type # 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} + routineKinds + tfUnion* = tfNoSideEffect tfGcSafe* = tfThread tfObjHasKids* = tfEnumHasHoles tfReturnsNew* = tfInheritable + tfNonConstExpr* = tfExplicitCallConv + ## tyFromExpr where the expression shouldn't be evaluated as a static value skError* = skUnknown var - eqTypeFlags* = {tfIterator, tfNotNil, tfVarIsPtr, tfGcSafe, tfNoSideEffect} + eqTypeFlags* = {tfIterator, tfNotNil, tfVarIsPtr, tfGcSafe, tfNoSideEffect, tfIsOutParam} ## type flags that are essential for type equality. ## This is now a variable because for emulation of version:1.0 we ## might exclude {tfGcSafe, tfNoSideEffect}. @@ -644,7 +485,8 @@ type mUnaryMinusI, mUnaryMinusI64, mAbsI, mNot, mUnaryPlusI, mBitnotI, mUnaryPlusF64, mUnaryMinusF64, - mCharToStr, mBoolToStr, mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, + mCharToStr, mBoolToStr, + mCStrToStr, mStrToStr, mEnumToStr, mAnd, mOr, mImplies, mIff, mExists, mForall, mOld, @@ -657,13 +499,13 @@ type mInSet, mRepr, mExit, mSetLengthStr, mSetLengthSeq, mIsPartOf, mAstToStr, mParallel, - mSwap, mIsNil, mArrToSeq, + mSwap, mIsNil, mArrToSeq, mOpenArrayToSeq, mNewString, mNewStringOfCap, mParseBiggestFloat, - mMove, mWasMoved, mDestroy, - mDefault, mUnown, mIsolate, mAccessEnv, mReset, + mMove, mEnsureMove, mWasMoved, mDup, mDestroy, mTrace, + mDefault, mUnown, mFinished, mIsolate, mAccessEnv, mAccessTypeField, mArray, mOpenArray, mRange, mSet, mSeq, mVarargs, mRef, mPtr, mVar, mDistinct, mVoid, mTuple, - mOrdinal, + mOrdinal, mIterableType, mInt, mInt8, mInt16, mInt32, mInt64, mUInt, mUInt8, mUInt16, mUInt32, mUInt64, mFloat, mFloat32, mFloat64, mFloat128, @@ -680,19 +522,19 @@ type mNctPut, mNctLen, mNctGet, mNctHasNext, mNctNext, mNIntVal, mNFloatVal, mNSymbol, mNIdent, mNGetType, mNStrVal, mNSetIntVal, - mNSetFloatVal, mNSetSymbol, mNSetIdent, mNSetType, mNSetStrVal, mNLineInfo, + mNSetFloatVal, mNSetSymbol, mNSetIdent, mNSetStrVal, mNLineInfo, mNNewNimNode, mNCopyNimNode, mNCopyNimTree, mStrToIdent, mNSigHash, mNSizeOf, mNBindSym, mNCallSite, mEqIdent, mEqNimrodNode, mSameNodeType, mGetImpl, mNGenSym, mNHint, mNWarning, mNError, mInstantiationInfo, mGetTypeInfo, mGetTypeInfoV2, - mNimvm, mIntDefine, mStrDefine, mBoolDefine, mRunnableExamples, + mNimvm, mIntDefine, mStrDefine, mBoolDefine, mGenericDefine, mRunnableExamples, mException, mBuiltinType, mSymOwner, mUncheckedArray, mGetImplTransf, - mSymIsInstantiationOf, mNodeId + mSymIsInstantiationOf, mNodeId, mPrivateAccess, mZeroDefault -# things that we can evaluate safely at compile time, even if not asked for it: const + # things that we can evaluate safely at compile time, even if not asked for it: ctfeWhitelist* = {mNone, mSucc, mPred, mInc, mDec, mOrd, mLengthOpenArray, mLengthStr, mLengthArray, mLengthSeq, @@ -712,19 +554,26 @@ const mEqRef, mEqProc, mLePtr, mLtPtr, mEqCString, mXor, mUnaryMinusI, mUnaryMinusI64, mAbsI, mNot, mUnaryPlusI, mBitnotI, mUnaryPlusF64, mUnaryMinusF64, - mCharToStr, mBoolToStr, mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, + mCharToStr, mBoolToStr, + mCStrToStr, mStrToStr, mEnumToStr, mAnd, mOr, mEqStr, mLeStr, mLtStr, mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, mConStrStr, mAppendStrCh, mAppendStrStr, mAppendSeqElem, - mInSet, mRepr} + mInSet, mRepr, mOpenArrayToSeq} + + generatedMagics* = {mNone, mIsolate, mFinished, mOpenArrayToSeq} + ## magics that are generated as normal procs in the backend type ItemId* = object module*: int32 item*: int32 +proc `$`*(x: ItemId): string = + "(module: " & $x.module & ", item: " & $x.item & ")" + proc `==`*(a, b: ItemId): bool {.inline.} = a.item == b.item and a.module == b.module @@ -735,10 +584,6 @@ proc hash*(x: ItemId): Hash = type - TIdObj* = object of RootObj - itemId*: ItemId - PIdObj* = ref TIdObj - PNode* = ref TNode TNodeSeq* = seq[PNode] PType* = ref TType @@ -762,7 +607,8 @@ type ident*: PIdent else: sons*: TNodeSeq - comment*: string + when defined(nimsuggest): + endInfo*: TLineInfo TStrTable* = object # a table[PIdent] of PSym counter*: int @@ -783,9 +629,6 @@ type 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 @@ -809,7 +652,7 @@ type storage*: TStorageLoc flags*: TLocFlags # location's flags lode*: PNode # Node where the location came from; can be faked - r*: Rope # rope value of location (code generators) + snippet*: Rope # C code snippet of location (code generators) # ---------------- end of backend information ------------------------------ @@ -820,7 +663,7 @@ type # keep in sync with PackedLib kind*: TLibKind generated*: bool # needed for the backends: - isOverriden*: bool + isOverridden*: bool name*: Rope path*: PNode # can be a string literal! @@ -834,20 +677,22 @@ type PInstantiation* = ref TInstantiation - TScope* = object + 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 + TSym* {.acyclic.} = object # Keep in sync with PackedSym + itemId*: ItemId # proc and type instantiations are cached in the generic symbol case kind*: TSymKind of routineKinds: #procInstCache*: seq[PInstantiation] - gcUnsafetyReason*: PSym # for better error messages wrt gcsafe + gcUnsafetyReason*: PSym # for better error messages regarding gcsafe transformedBody*: PNode # cached body after transf pass of skLet, skVar, skField, skForVar: guard*: PSym @@ -858,6 +703,9 @@ type typ*: PType name*: PIdent info*: TLineInfo + when defined(nimsuggest): + endInfo*: TLineInfo + hasUserSpecifiedType*: bool # used for determining whether to display inlay type hints owner*: PSym flags*: TSymFlags ast*: PNode # syntax tree of proc, iterator, etc.: @@ -879,7 +727,9 @@ type # 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 + offset*: int32 # offset of record field + disamb*: int32 # disambiguation number; the basic idea is that + # `<procname>__<module>_<disamb>` is unique loc*: TLoc annex*: PLib # additional fields (seldom used, so we use a # reference to another object to save space) @@ -887,33 +737,35 @@ type 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 + # misused for the codegenDecl and virtual pragmas in the hope # it won't cause problems # for skModule the string literal to output for # deprecated modules. + instantiatedFrom*: PSym # for instances, the generic symbol where it came from. when defined(nimsuggest): allUsages*: seq[TLineInfo] TTypeSeq* = seq[PType] - TLockLevel* = distinct int16 TTypeAttachedOp* = enum ## as usual, order is important here + attachedWasMoved, attachedDestructor, attachedAsgn, + attachedDup, attachedSink, attachedTrace, - attachedDispose, attachedDeepCopy - TType* {.acyclic.} = object of TIdObj # \ + TType* {.acyclic.} = object # \ # types are identical iff they have the # same id; there may be multiple copies of a type # in memory! # Keep in sync with PackedType + itemId*: ItemId kind*: TTypeKind # kind of type callConv*: TCallingConvention # for procs flags*: TTypeFlags # flags of the type - sons*: TTypeSeq # base types, etc. + sons: TTypeSeq # base types, etc. n*: PNode # node for types: # for range types a nkRange node # for record types a nkRecord node @@ -930,7 +782,6 @@ type # -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. @@ -942,24 +793,6 @@ type TPairSeq* = seq[TPair] - TIdPair* = object - key*: PIdObj - val*: RootRef - - TIdPairSeq* = seq[TIdPair] - TIdTable* = object # the same as table[PIdent] of PObject - counter*: int - data*: TIdPairSeq - - TIdNodePair* = object - key*: PIdObj - val*: PNode - - TIdNodePairSeq* = seq[TIdNodePair] - TIdNodeTable* = object # the same as table[PIdObj] of PNode - counter*: int - data*: TIdNodePairSeq - TNodePair* = object h*: Hash # because it is expensive to compute! key*: PNode @@ -979,13 +812,47 @@ type TImplication* = enum impUnknown, impNo, impYes +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. + comments: Table[int, string] # nodeId => comment + useIc*: bool + +var gconfig {.threadvar.}: Gconfig + +proc setUseIc*(useIc: bool) = gconfig.useIc = useIc + +proc comment*(n: PNode): string = + if nfHasComment in n.flags and not gconfig.useIc: + # IC doesn't track comments, see `packed_ast`, so this could fail + result = gconfig.comments[n.nodeId] + else: + result = "" + +proc `comment=`*(n: PNode, a: string) = + let id = n.nodeId + if a.len > 0: + # if needed, we could periodically cleanup gconfig.comments when its size increases, + # to ensure only live nodes (and with nfHasComment) have an entry in gconfig.comments; + # for compiling compiler, the waste is very small: + # num calls to newNodeImpl: 14984160 (num of PNode allocations) + # size of gconfig.comments: 33585 + # num of nodes with comments that were deleted and hence wasted: 3081 + n.flags.incl nfHasComment + gconfig.comments[id] = a + elif nfHasComment in n.flags: + n.flags.excl nfHasComment + gconfig.comments.del(id) + # BUGFIX: a module is overloadable so that a proc can have the # same name as an imported module. This is necessary because of # the poor naming choices in the standard library. const OverloadableSyms* = {skProc, skFunc, skMethod, skIterator, - skConverter, skModule, skTemplate, skMacro} + skConverter, skModule, skTemplate, skMacro, skEnumField} GenericTypes*: TTypeKinds = {tyGenericInvocation, tyGenericBody, tyGenericParam} @@ -999,23 +866,22 @@ const tyBool, tyChar, tyEnum, tyArray, tyObject, tySet, tyTuple, tyRange, tyPtr, tyRef, tyVar, tyLent, tySequence, tyProc, tyPointer, - tyOpenArray, tyString, tyCString, tyInt..tyInt64, tyFloat..tyFloat128, + tyOpenArray, tyString, tyCstring, tyInt..tyInt64, tyFloat..tyFloat128, tyUInt..tyUInt64} IntegralTypes* = {tyBool, tyChar, tyEnum, tyInt..tyInt64, tyFloat..tyFloat128, tyUInt..tyUInt64} # weird name because it contains tyFloat ConstantDataTypes*: TTypeKinds = {tyArray, tySet, tyTuple, tySequence} - NilableTypes*: TTypeKinds = {tyPointer, tyCString, tyRef, tyPtr, + NilableTypes*: TTypeKinds = {tyPointer, tyCstring, tyRef, tyPtr, tyProc, tyError} # TODO PtrLikeKinds*: TTypeKinds = {tyPointer, tyPtr} # for VM - ExportableSymKinds* = {skVar, skConst, skProc, skFunc, skMethod, skType, - skIterator, - skMacro, skTemplate, skConverter, skEnumField, skLet, skStub, skAlias} PersistentNodeFlags*: TNodeFlags = {nfBase2, nfBase8, nfBase16, nfDotSetter, nfDotField, nfIsRef, nfIsPtr, nfPreventCg, nfLL, nfFromTemplate, nfDefaultRefsParam, - nfExecuteOnReload, nfLastRead, nfFirstWrite} + nfExecuteOnReload, nfLastRead, + nfFirstWrite, nfSkipFieldChecking, + nfDisabledOpenSym} namePos* = 0 patternPos* = 1 # empty except for term rewriting macros genericParamsPos* = 2 @@ -1028,10 +894,8 @@ const nfAllFieldsSet* = nfBase2 - nkCallKinds* = {nkCall, nkInfix, nkPrefix, nkPostfix, - nkCommand, nkCallStrLit, nkHiddenCallConv} nkIdentKinds* = {nkIdent, nkSym, nkAccQuoted, nkOpenSymChoice, - nkClosedSymChoice} + nkClosedSymChoice, nkOpenSym} nkPragmaCallKinds* = {nkExprColonExpr, nkCall, nkCallStrLit} nkLiterals* = {nkCharLit..nkTripleStrLit} @@ -1051,28 +915,21 @@ const defaultSize = -1 defaultAlignment = -1 - defaultOffset = -1 - + defaultOffset* = -1 -proc getnimblePkg*(a: PSym): PSym = - result = a - while result != nil: - case result.kind - of skModule: - result = result.owner - assert result.kind == skPackage - of skPackage: - if result.owner == nil: - break - else: - result = result.owner - else: - assert false, $result.kind +proc getPIdent*(a: PNode): PIdent {.inline.} = + ## Returns underlying `PIdent` for `{nkSym, nkIdent}`, or `nil`. + case a.kind + of nkSym: a.sym.name + of nkIdent: a.ident + of nkOpenSymChoice, nkClosedSymChoice: a.sons[0].sym.name + of nkOpenSym: getPIdent(a.sons[0]) + else: nil const moduleShift = when defined(cpu32): 20 else: 24 -template id*(a: PIdObj): int = +template id*(a: PType | PSym): int = let x = a (x.itemId.module.int shl moduleShift) + x.itemId.item.int @@ -1082,15 +939,19 @@ type symId*: int32 typeId*: int32 sealed*: bool + disambTable*: CountTable[PIdent] const PackageModuleId* = -3'i32 proc idGeneratorFromModule*(m: PSym): IdGenerator = assert m.kind == skModule - result = IdGenerator(module: m.itemId.module, symId: m.itemId.item, typeId: 0) + result = IdGenerator(module: m.itemId.module, symId: m.itemId.item, typeId: 0, disambTable: initCountTable[PIdent]()) + +proc idGeneratorForPackage*(nextIdWillBe: int32): IdGenerator = + result = IdGenerator(module: PackageModuleId, symId: nextIdWillBe - 1'i32, typeId: 0, disambTable: initCountTable[PIdent]()) -proc nextSymId*(x: IdGenerator): ItemId {.inline.} = +proc nextSymId(x: IdGenerator): ItemId {.inline.} = assert(not x.sealed) inc x.symId result = ItemId(module: x.module, item: x.symId) @@ -1113,22 +974,14 @@ when false: assert dest.ItemId.item <= src.ItemId.item dest = src -proc getnimblePkgId*(a: PSym): int = - let b = a.getnimblePkg - result = if b == nil: -1 else: b.id - var ggDebug* {.deprecated.}: bool ## convenience switch for trying out things -#var -# gMainPackageId*: int proc isCallExpr*(n: PNode): bool = result = n.kind in nkCallKinds proc discardSons*(father: PNode) -type Indexable = PNode | PType - -proc len*(n: Indexable): int {.inline.} = +proc len*(n: PNode): int {.inline.} = result = n.sons.len proc safeLen*(n: PNode): int {.inline.} = @@ -1142,25 +995,115 @@ proc safeArrLen*(n: PNode): int {.inline.} = elif n.kind in {nkNone..nkFloat128Lit}: result = 0 else: result = n.len -proc add*(father, son: Indexable) = +proc add*(father, son: PNode) = assert son != nil father.sons.add(son) -proc addAllowNil*(father, son: Indexable) {.inline.} = +proc addAllowNil*(father, son: PNode) {.inline.} = father.sons.add(son) -template `[]`*(n: Indexable, i: int): Indexable = n.sons[i] -template `[]=`*(n: Indexable, i: int; x: Indexable) = n.sons[i] = x +template `[]`*(n: PNode, i: int): PNode = n.sons[i] +template `[]=`*(n: PNode, i: int; x: PNode) = n.sons[i] = x -template `[]`*(n: Indexable, i: BackwardsIndex): Indexable = n[n.len - i.int] -template `[]=`*(n: Indexable, i: BackwardsIndex; x: Indexable) = n[n.len - i.int] = x +template `[]`*(n: PNode, i: BackwardsIndex): PNode = n[n.len - i.int] +template `[]=`*(n: PNode, i: BackwardsIndex; x: PNode) = n[n.len - i.int] = x + +proc add*(father, son: PType) = + assert son != nil + father.sons.add(son) + +proc addAllowNil*(father, son: PType) {.inline.} = + father.sons.add(son) + +template `[]`*(n: PType, i: int): PType = n.sons[i] +template `[]=`*(n: PType, i: int; x: PType) = n.sons[i] = x + +template `[]`*(n: PType, i: BackwardsIndex): PType = n[n.len - i.int] +template `[]=`*(n: PType, i: BackwardsIndex; x: PType) = n[n.len - i.int] = x + +proc getDeclPragma*(n: PNode): PNode = + ## return the `nkPragma` node for declaration `n`, or `nil` if no pragma was found. + ## Currently only supports routineDefs + {nkTypeDef}. + case n.kind + of routineDefs: + if n[pragmasPos].kind != nkEmpty: result = n[pragmasPos] + else: result = nil + of nkTypeDef: + #[ + type F3*{.deprecated: "x3".} = int + + TypeSection + TypeDef + PragmaExpr + Postfix + Ident "*" + Ident "F3" + Pragma + ExprColonExpr + Ident "deprecated" + StrLit "x3" + Empty + Ident "int" + ]# + if n[0].kind == nkPragmaExpr: + result = n[0][1] + else: + result = nil + else: + # support as needed for `nkIdentDefs` etc. + result = nil + if result != nil: + assert result.kind == nkPragma, $(result.kind, n.kind) + +proc extractPragma*(s: PSym): PNode = + ## gets the pragma node of routine/type/var/let/const symbol `s` + if s.kind in routineKinds: # bug #24167 + if s.ast[pragmasPos] != nil and s.ast[pragmasPos].kind != nkEmpty: + result = s.ast[pragmasPos] + else: + result = nil + elif s.kind in {skType, skVar, skLet, skConst}: + if s.ast != nil and s.ast.len > 0: + if s.ast[0].kind == nkPragmaExpr and s.ast[0].len > 1: + # s.ast = nkTypedef / nkPragmaExpr / [nkSym, nkPragma] + result = s.ast[0][1] + else: + result = nil + else: + result = nil + else: + result = nil + assert result == nil or result.kind == nkPragma + +proc skipPragmaExpr*(n: PNode): PNode = + ## if pragma expr, give the node the pragmas are applied to, + ## otherwise give node itself + if n.kind == nkPragmaExpr: + result = n[0] + else: + result = n + +proc setInfoRecursive*(n: PNode, info: TLineInfo) = + ## set line info recursively + if n != nil: + for i in 0..<n.safeLen: setInfoRecursive(n[i], info) + n.info = info when defined(useNodeIds): const nodeIdToDebug* = -1 # 2322968 var gNodeId: int -proc newNode*(kind: TNodeKind): PNode = - result = PNode(kind: kind, info: unknownLineInfo) +template newNodeImpl(info2) = + result = PNode(kind: kind, info: info2) + 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 + # has `nfHasComment` set (and an entry in that table). Only `nfHasComment` + # should be used to test whether a PNode has a comment; gconfig.comments + # can contain extra entries for deleted PNode's with comments. + gconfig.comments.del(cast[int](result)) + +template setIdMaybe() = when defined(useNodeIds): result.id = gNodeId if result.id == nodeIdToDebug: @@ -1168,31 +1111,56 @@ proc newNode*(kind: TNodeKind): PNode = writeStackTrace() inc gNodeId +proc newNode*(kind: TNodeKind): PNode = + ## new node with unknown line info, no type, and no children + newNodeImpl(unknownLineInfo) + setIdMaybe() + proc newNodeI*(kind: TNodeKind, info: TLineInfo): PNode = - result = PNode(kind: kind, info: info) - when defined(useNodeIds): - result.id = gNodeId - if result.id == nodeIdToDebug: - echo "KIND ", result.kind - writeStackTrace() - inc gNodeId + ## new node with line info, no type, and no children + newNodeImpl(info) + setIdMaybe() proc newNodeI*(kind: TNodeKind, info: TLineInfo, children: int): PNode = - result = PNode(kind: kind, info: info) + ## new node with line info, type, and children + newNodeImpl(info) if children > 0: newSeq(result.sons, children) - when defined(useNodeIds): - result.id = gNodeId - if result.id == nodeIdToDebug: - echo "KIND ", result.kind - writeStackTrace() - inc gNodeId + setIdMaybe() proc newNodeIT*(kind: TNodeKind, info: TLineInfo, typ: PType): PNode = + ## new node with line info, type, and no children result = newNode(kind) result.info = info result.typ = typ +proc newNode*(kind: TNodeKind, info: TLineInfo): PNode = + ## new node with line info, no type, and no children + newNodeImpl(info) + setIdMaybe() + +proc newAtom*(ident: PIdent, info: TLineInfo): PNode = + result = newNode(nkIdent, info) + result.ident = ident + +proc newAtom*(kind: TNodeKind, intVal: BiggestInt, info: TLineInfo): PNode = + result = newNode(kind, info) + result.intVal = intVal + +proc newAtom*(kind: TNodeKind, floatVal: BiggestFloat, info: TLineInfo): PNode = + result = newNode(kind, info) + result.floatVal = floatVal + +proc newAtom*(kind: TNodeKind; strVal: sink string; info: TLineInfo): PNode = + result = newNode(kind, info) + result.strVal = strVal + +proc newTree*(kind: TNodeKind; info: TLineInfo; children: varargs[PNode]): PNode = + result = newNodeI(kind, info) + if children.len > 0: + result.info = children[0].info + result.sons = @children + proc newTree*(kind: TNodeKind; children: varargs[PNode]): PNode = result = newNode(kind) if children.len > 0: @@ -1212,7 +1180,7 @@ proc newTreeIT*(kind: TNodeKind; info: TLineInfo; typ: PType; children: varargs[ result.sons = @children template previouslyInferred*(t: PType): PType = - if t.sons.len > 1: t.lastSon else: nil + if t.sons.len > 1: t.last else: nil when false: import tables, strutils @@ -1223,11 +1191,15 @@ when false: echo k echo v -proc newSym*(symKind: TSymKind, name: PIdent, id: ItemId, owner: PSym, +proc newSym*(symKind: TSymKind, name: PIdent, idgen: IdGenerator; owner: PSym, info: TLineInfo; options: TOptions = {}): PSym = # generates a symbol and initializes the hash field too + assert not name.isNil + let id = nextSymId idgen result = PSym(name: name, kind: symKind, flags: {}, info: info, itemId: id, - options: options, owner: owner, offset: defaultOffset) + options: options, owner: owner, offset: defaultOffset, + disamb: getOrDefault(idgen.disambTable, name).int32) + idgen.disambTable.inc name when false: if id.module == 48 and id.item == 39: writeStackTrace() @@ -1236,7 +1208,7 @@ proc newSym*(symKind: TSymKind, name: PIdent, id: ItemId, owner: PSym, proc astdef*(s: PSym): PNode = # get only the definition (initializer) portion of the ast - if s.ast != nil and s.ast.kind == nkIdentDefs: + if s.ast != nil and s.ast.kind in {nkIdentDefs, nkConstDef}: s.ast[2] else: s.ast @@ -1286,11 +1258,6 @@ proc copyStrTable*(dest: var TStrTable, src: TStrTable) = setLen(dest.data, src.data.len) for i in 0..high(src.data): dest.data[i] = src.data[i] -proc copyIdTable*(dest: var TIdTable, src: TIdTable) = - dest.counter = src.counter - newSeq(dest.data, src.data.len) - for i in 0..high(src.data): dest.data[i] = src.data[i] - proc copyObjectSet*(dest: var TObjectSet, src: TObjectSet) = dest.counter = src.counter setLen(dest.data, src.data.len) @@ -1320,6 +1287,9 @@ proc newSymNode*(sym: PSym, info: TLineInfo): PNode = result.typ = sym.typ result.info = info +proc newOpenSym*(n: PNode): PNode {.inline.} = + result = newTreeI(nkOpenSym, n.info, n) + proc newIntNode*(kind: TNodeKind, intVal: BiggestInt): PNode = result = newNode(kind) result.intVal = intVal @@ -1328,7 +1298,42 @@ proc newIntNode*(kind: TNodeKind, intVal: Int128): PNode = result = newNode(kind) result.intVal = castToInt64(intVal) -proc lastSon*(n: Indexable): Indexable = n.sons[^1] +proc lastSon*(n: PNode): PNode {.inline.} = n.sons[^1] +template setLastSon*(n: PNode, s: PNode) = n.sons[^1] = s + +template firstSon*(n: PNode): PNode = n.sons[0] +template secondSon*(n: PNode): PNode = n.sons[1] + +template hasSon*(n: PNode): bool = n.len > 0 +template has2Sons*(n: PNode): bool = n.len > 1 + +proc replaceFirstSon*(n, newson: PNode) {.inline.} = + n.sons[0] = newson + +proc replaceSon*(n: PNode; i: int; newson: PNode) {.inline.} = + n.sons[i] = newson + +proc last*(n: PType): PType {.inline.} = n.sons[^1] + +proc elementType*(n: PType): PType {.inline.} = n.sons[^1] +proc skipModifier*(n: PType): PType {.inline.} = n.sons[^1] + +proc indexType*(n: PType): PType {.inline.} = n.sons[0] +proc baseClass*(n: PType): PType {.inline.} = n.sons[0] + +proc base*(t: PType): PType {.inline.} = + result = t.sons[0] + +proc returnType*(n: PType): PType {.inline.} = n.sons[0] +proc setReturnType*(n, r: PType) {.inline.} = n.sons[0] = r +proc setIndexType*(n, idx: PType) {.inline.} = n.sons[0] = idx + +proc firstParamType*(n: PType): PType {.inline.} = n.sons[1] +proc firstGenericParam*(n: PType): PType {.inline.} = n.sons[1] + +proc typeBodyImpl*(n: PType): PType {.inline.} = n.sons[^1] + +proc genericHead*(n: PType): PType {.inline.} = n.sons[0] proc skipTypes*(t: PType, kinds: TTypeKinds): PType = ## Used throughout the compiler code to test whether a type tree contains or @@ -1336,7 +1341,7 @@ proc skipTypes*(t: PType, kinds: TTypeKinds): PType = ## last child nodes of a type tree need to be searched. This is a really hot ## path within the compiler! result = t - while result.kind in kinds: result = lastSon(result) + while result.kind in kinds: result = last(result) proc newIntTypeNode*(intVal: BiggestInt, typ: PType): PNode = let kind = skipTypes(typ, abstractVarRange).kind @@ -1357,7 +1362,7 @@ proc newIntTypeNode*(intVal: BiggestInt, typ: PType): PNode = result = newNode(nkIntLit) of tyStatic: # that's a pre-existing bug, will fix in another PR result = newNode(nkIntLit) - else: doAssert false, $kind + else: raiseAssert $kind result.intVal = intVal result.typ = typ @@ -1386,16 +1391,8 @@ proc newProcNode*(kind: TNodeKind, info: TLineInfo, body: PNode, pragmas, exceptions, body] const - UnspecifiedLockLevel* = TLockLevel(-1'i16) - MaxLockLevel* = 1000'i16 - UnknownLockLevel* = TLockLevel(1001'i16) AttachedOpToStr*: array[TTypeAttachedOp, string] = [ - "=destroy", "=copy", "=sink", "=trace", "=dispose", "=deepcopy"] - -proc `$`*(x: TLockLevel): string = - if x.ord == UnspecifiedLockLevel.ord: result = "<unspecified>" - elif x.ord == UnknownLockLevel.ord: result = "<unknown>" - else: result = $int16(x) + "=wasMoved", "=destroy", "=copy", "=dup", "=sink", "=trace", "=deepcopy"] proc `$`*(s: PSym): string = if s != nil: @@ -1403,27 +1400,140 @@ proc `$`*(s: PSym): string = else: result = "<nil>" -proc newType*(kind: TTypeKind, id: ItemId; owner: PSym): PType = +when false: + iterator items*(t: PType): PType = + for i in 0..<t.sons.len: yield t.sons[i] + + iterator pairs*(n: PType): tuple[i: int, n: PType] = + for i in 0..<n.sons.len: yield (i, n.sons[i]) + +when true: + proc len*(n: PType): int {.inline.} = + result = n.sons.len + +proc sameTupleLengths*(a, b: PType): bool {.inline.} = + result = a.sons.len == b.sons.len + +iterator tupleTypePairs*(a, b: PType): (int, PType, PType) = + for i in 0 ..< a.sons.len: + yield (i, a.sons[i], b.sons[i]) + +iterator underspecifiedPairs*(a, b: PType; start = 0; without = 0): (PType, PType) = + # XXX Figure out with what typekinds this is called. + for i in start ..< min(a.sons.len, b.sons.len) + without: + yield (a.sons[i], b.sons[i]) + +proc signatureLen*(t: PType): int {.inline.} = + result = t.sons.len + +proc paramsLen*(t: PType): int {.inline.} = + result = t.sons.len - 1 + +proc genericParamsLen*(t: PType): int {.inline.} = + assert t.kind == tyGenericInst + result = t.sons.len - 2 # without 'head' and 'body' + +proc genericInvocationParamsLen*(t: PType): int {.inline.} = + assert t.kind == tyGenericInvocation + result = t.sons.len - 1 # without 'head' + +proc kidsLen*(t: PType): int {.inline.} = + result = t.sons.len + +proc genericParamHasConstraints*(t: PType): bool {.inline.} = t.sons.len > 0 + +proc hasElementType*(t: PType): bool {.inline.} = t.sons.len > 0 +proc isEmptyTupleType*(t: PType): bool {.inline.} = t.sons.len == 0 +proc isSingletonTupleType*(t: PType): bool {.inline.} = t.sons.len == 1 + +proc genericConstraint*(t: PType): PType {.inline.} = t.sons[0] + +iterator genericInstParams*(t: PType): (bool, PType) = + for i in 1..<t.sons.len-1: + yield (i!=1, t.sons[i]) + +iterator genericInstParamPairs*(a, b: PType): (int, PType, PType) = + for i in 1..<min(a.sons.len, b.sons.len)-1: + yield (i-1, a.sons[i], b.sons[i]) + +iterator genericInvocationParams*(t: PType): (bool, PType) = + for i in 1..<t.sons.len: + yield (i!=1, t.sons[i]) + +iterator genericInvocationAndBodyElements*(a, b: PType): (PType, PType) = + for i in 1..<a.sons.len: + yield (a.sons[i], b.sons[i-1]) + +iterator genericInvocationParamPairs*(a, b: PType): (bool, PType, PType) = + for i in 1..<a.sons.len: + if i >= b.sons.len: + yield (false, nil, nil) + else: + yield (true, a.sons[i], b.sons[i]) + +iterator genericBodyParams*(t: PType): (int, PType) = + for i in 0..<t.sons.len-1: + yield (i, t.sons[i]) + +iterator userTypeClassInstParams*(t: PType): (bool, PType) = + for i in 1..<t.sons.len-1: + yield (i!=1, t.sons[i]) + +iterator ikids*(t: PType): (int, PType) = + for i in 0..<t.sons.len: yield (i, t.sons[i]) + +const + FirstParamAt* = 1 + FirstGenericParamAt* = 1 + +iterator paramTypes*(t: PType): (int, PType) = + for i in FirstParamAt..<t.sons.len: yield (i, t.sons[i]) + +iterator paramTypePairs*(a, b: PType): (PType, PType) = + for i in FirstParamAt..<a.sons.len: yield (a.sons[i], b.sons[i]) + +template paramTypeToNodeIndex*(x: int): int = x + +iterator kids*(t: PType): PType = + for i in 0..<t.sons.len: yield t.sons[i] + +iterator signature*(t: PType): PType = + # yields return type + parameter types + for i in 0..<t.sons.len: yield t.sons[i] + +proc newType*(kind: TTypeKind; idgen: IdGenerator; owner: PSym; son: sink PType = nil): PType = + let id = nextTypeId idgen result = PType(kind: kind, owner: owner, size: defaultSize, align: defaultAlignment, itemId: id, - lockLevel: UnspecifiedLockLevel, - uniqueId: id) + uniqueId: id, sons: @[]) + if son != nil: result.sons.add son when false: if result.itemId.module == 55 and result.itemId.item == 2: echo "KNID ", kind writeStackTrace() +proc setSons*(dest: PType; sons: sink seq[PType]) {.inline.} = dest.sons = sons +proc setSon*(dest: PType; son: sink PType) {.inline.} = dest.sons = @[son] +proc setSonsLen*(dest: PType; len: int) {.inline.} = setLen(dest.sons, len) proc mergeLoc(a: var TLoc, b: TLoc) = if a.k == low(typeof(a.k)): a.k = b.k if a.storage == low(typeof(a.storage)): a.storage = b.storage a.flags.incl b.flags if a.lode == nil: a.lode = b.lode - if a.r == nil: a.r = b.r + if a.snippet == "": a.snippet = b.snippet -proc newSons*(father: Indexable, length: int) = +proc newSons*(father: PNode, length: int) = setLen(father.sons, length) +proc newSons*(father: PType, length: int) = + setLen(father.sons, length) + +proc truncateInferredTypeCandidates*(t: PType) {.inline.} = + assert t.kind == tyInferred + if t.sons.len > 1: + setLen(t.sons, 1) + proc assignType*(dest, src: PType) = dest.kind = src.kind dest.flags = src.flags @@ -1431,28 +1541,31 @@ proc assignType*(dest, src: PType) = dest.n = src.n dest.size = src.size dest.align = src.align - dest.lockLevel = src.lockLevel # this fixes 'type TLock = TSysLock': if src.sym != nil: if dest.sym != nil: - dest.sym.flags.incl src.sym.flags-{sfExported} + dest.sym.flags.incl src.sym.flags-{sfUsed, sfExported} if dest.sym.annex == nil: dest.sym.annex = src.sym.annex mergeLoc(dest.sym.loc, src.sym.loc) else: dest.sym = src.sym - newSons(dest, src.len) - for i in 0..<src.len: dest[i] = src[i] + newSons(dest, src.sons.len) + for i in 0..<src.sons.len: dest[i] = src[i] -proc copyType*(t: PType, id: ItemId, owner: PSym): PType = - result = newType(t.kind, id, owner) +proc copyType*(t: PType, idgen: IdGenerator, owner: PSym): PType = + result = newType(t.kind, idgen, owner) assignType(result, t) result.sym = t.sym # backend-info should not be copied proc exactReplica*(t: PType): PType = - result = copyType(t, t.itemId, t.owner) + result = PType(kind: t.kind, owner: t.owner, size: defaultSize, + align: defaultAlignment, itemId: t.itemId, + uniqueId: t.uniqueId) + assignType(result, t) + result.sym = t.sym # backend-info should not be copied -proc copySym*(s: PSym; id: ItemId): PSym = - result = newSym(s.kind, s.name, id, s.owner, s.info, s.options) +proc copySym*(s: PSym; idgen: IdGenerator): PSym = + result = newSym(s.kind, s.name, idgen, s.owner, s.info, s.options) #result.ast = nil # BUGFIX; was: s.ast which made problems result.typ = s.typ result.flags = s.flags @@ -1467,9 +1580,9 @@ proc copySym*(s: PSym; id: ItemId): PSym = result.bitsize = s.bitsize result.alignment = s.alignment -proc createModuleAlias*(s: PSym, id: ItemId, newIdent: PIdent, info: TLineInfo; +proc createModuleAlias*(s: PSym, idgen: IdGenerator, newIdent: PIdent, info: TLineInfo; options: TOptions): PSym = - result = newSym(s.kind, newIdent, id, s.owner, info, options) + result = newSym(s.kind, newIdent, idgen, s.owner, info, options) # keep ID! result.ast = s.ast #result.id = s.id # XXX figure out what to do with the ID. @@ -1479,43 +1592,23 @@ proc createModuleAlias*(s: PSym, id: ItemId, newIdent: PIdent, info: TLineInfo; result.loc = s.loc result.annex = s.annex -proc initStrTable*(x: var TStrTable) = - x.counter = 0 - newSeq(x.data, StartSize) - -proc newStrTable*: TStrTable = - initStrTable(result) +proc initStrTable*(): TStrTable = + result = TStrTable(counter: 0) + newSeq(result.data, StartSize) -proc initIdTable*(x: var TIdTable) = - x.counter = 0 - newSeq(x.data, StartSize) +proc initObjectSet*(): TObjectSet = + result = TObjectSet(counter: 0) + newSeq(result.data, StartSize) -proc newIdTable*: TIdTable = - initIdTable(result) - -proc resetIdTable*(x: var TIdTable) = - x.counter = 0 - # clear and set to old initial size: - setLen(x.data, 0) - setLen(x.data, StartSize) - -proc initObjectSet*(x: var TObjectSet) = - x.counter = 0 - newSeq(x.data, StartSize) - -proc initIdNodeTable*(x: var TIdNodeTable) = - x.counter = 0 - newSeq(x.data, StartSize) - -proc initNodeTable*(x: var TNodeTable) = - x.counter = 0 - newSeq(x.data, StartSize) +proc initNodeTable*(): TNodeTable = + result = TNodeTable(counter: 0) + newSeq(result.data, StartSize) proc skipTypes*(t: PType, kinds: TTypeKinds; maxIters: int): PType = result = t var i = maxIters while result.kind in kinds: - result = lastSon(result) + result = last(result) dec i if i == 0: return nil @@ -1523,8 +1616,8 @@ proc skipTypesOrNil*(t: PType, kinds: TTypeKinds): PType = ## same as skipTypes but handles 'nil' result = t while result != nil and result.kind in kinds: - if result.len == 0: return nil - result = lastSon(result) + if result.sons.len == 0: return nil + result = last(result) proc isGCedMem*(t: PType): bool {.inline.} = result = t.kind in {tyString, tyRef, tySequence} or @@ -1543,7 +1636,7 @@ proc propagateToOwner*(owner, elem: PType; propagateHasAsgn = true) = if mask != {} and propagateHasAsgn: let o2 = owner.skipTypes({tyGenericInst, tyAlias, tySink}) if o2.kind in {tyTuple, tyObject, tyArray, - tySequence, tySet, tyDistinct, tyOpenArray, tyVarargs}: + tySequence, tySet, tyDistinct}: o2.flags.incl mask owner.flags.incl mask @@ -1559,9 +1652,6 @@ proc rawAddSon*(father, son: PType; propagateHasAsgn = true) = father.sons.add(son) if not son.isNil: propagateToOwner(father, son, propagateHasAsgn) -proc rawAddSonNoPropagationOfTypeFlags*(father, son: PType) = - father.sons.add(son) - proc addSonNilAllowed*(father, son: PNode) = father.sons.add(son) @@ -1589,11 +1679,13 @@ proc copyNode*(src: PNode): PNode = of nkIdent: result.ident = src.ident of nkStrLit..nkTripleStrLit: result.strVal = src.strVal else: discard + when defined(nimsuggest): + result.endInfo = src.endInfo template transitionNodeKindCommon(k: TNodeKind) = let obj {.inject.} = n[] - n[] = TNode(kind: k, typ: obj.typ, info: obj.info, flags: obj.flags, - comment: obj.comment) + n[] = TNode(kind: k, typ: obj.typ, info: obj.info, flags: obj.flags) + # n.comment = obj.comment # shouldn't be needed, the address doesnt' change when defined(useNodeIds): n.id = obj.id @@ -1605,6 +1697,10 @@ proc transitionIntKind*(n: PNode, kind: range[nkCharLit..nkUInt64Lit]) = transitionNodeKindCommon(kind) n.intVal = obj.intVal +proc transitionIntToFloatKind*(n: PNode, kind: range[nkFloatLit..nkFloat128Lit]) = + transitionNodeKindCommon(kind) + n.floatVal = BiggestFloat(obj.intVal) + proc transitionNoneToSym*(n: PNode) = transitionNodeKindCommon(nkSym) @@ -1637,6 +1733,8 @@ template copyNodeImpl(dst, src, processSonsStmt) = if src == nil: return dst = newNode(src.kind) dst.info = src.info + when defined(nimsuggest): + result.endInfo = src.endInfo dst.typ = src.typ dst.flags = src.flags * PersistentNodeFlags dst.comment = src.comment @@ -1685,6 +1783,7 @@ proc hasNilSon*(n: PNode): bool = result = false proc containsNode*(n: PNode, kinds: TNodeKinds): bool = + result = false if n == nil: return case n.kind of nkEmpty..nkNilLit: result = n.kind in kinds @@ -1694,7 +1793,7 @@ proc containsNode*(n: PNode, kinds: TNodeKinds): bool = proc hasSubnodeWith*(n: PNode, kind: TNodeKind): bool = case n.kind - of nkEmpty..nkNilLit: result = n.kind == kind + of nkEmpty..nkNilLit, nkFormalParams: result = n.kind == kind else: for i in 0..<n.len: if (n[i].kind == kind) or hasSubnodeWith(n[i], kind): @@ -1785,13 +1884,15 @@ proc skipGenericOwner*(s: PSym): PSym = ## Generic instantiations are owned by their originating generic ## symbol. This proc skips such owners and goes straight to the owner ## of the generic itself (the module or the enclosing proc). - result = if s.kind in skProcKinds and sfFromGeneric in s.flags: + result = if s.kind == skModule: + s + elif s.kind in skProcKinds and sfFromGeneric in s.flags and s.owner.kind != skModule: s.owner.owner else: s.owner proc originatingModule*(s: PSym): PSym = - result = s.owner + result = s while result.kind != skModule: result = result.owner proc isRoutine*(s: PSym): bool {.inline.} = @@ -1801,20 +1902,6 @@ proc isCompileTimeProc*(s: PSym): bool {.inline.} = result = s.kind == skMacro or s.kind in {skProc, skFunc} and sfCompileTime in s.flags -proc isRunnableExamples*(n: PNode): bool = - # Templates and generics don't perform symbol lookups. - result = n.kind == nkSym and n.sym.magic == mRunnableExamples or - n.kind == nkIdent and n.ident.s == "runnableExamples" - -proc requiredParams*(s: PSym): int = - # Returns the number of required params (without default values) - # XXX: Perhaps we can store this in the `offset` field of the - # symbol instead? - for i in 1..<s.typ.len: - if s.typ.n[i].sym.ast != nil: - return i - 1 - return s.typ.len - 1 - proc hasPattern*(s: PSym): bool {.inline.} = result = isRoutine(s) and s.ast[patternPos].kind != nkEmpty @@ -1851,25 +1938,43 @@ proc toVar*(typ: PType; kind: TTypeKind; idgen: IdGenerator): PType = ## returned. Otherwise ``typ`` is simply returned as-is. result = typ if typ.kind != kind: - result = newType(kind, nextTypeId(idgen), typ.owner) - rawAddSon(result, typ) + result = newType(kind, idgen, typ.owner, typ) proc toRef*(typ: PType; idgen: IdGenerator): PType = ## If ``typ`` is a tyObject then it is converted into a `ref <typ>` and ## returned. Otherwise ``typ`` is simply returned as-is. result = typ if typ.skipTypes({tyAlias, tyGenericInst}).kind == tyObject: - result = newType(tyRef, nextTypeId(idgen), typ.owner) - rawAddSon(result, typ) + result = newType(tyRef, idgen, typ.owner, typ) proc toObject*(typ: PType): PType = ## If ``typ`` is a tyRef then its immediate son is returned (which in many ## cases should be a ``tyObject``). ## Otherwise ``typ`` is simply returned as-is. let t = typ.skipTypes({tyAlias, tyGenericInst}) - if t.kind == tyRef: t.lastSon + if t.kind == tyRef: t.elementType else: typ +proc toObjectFromRefPtrGeneric*(typ: PType): PType = + #[ + See also `toObject`. + Finds the underlying `object`, even in cases like these: + type + B[T] = object f0: int + A1[T] = ref B[T] + A2[T] = ref object f1: int + A3 = ref object f2: int + A4 = object f3: int + ]# + result = typ + while true: + case result.kind + of tyGenericBody: result = result.last + of tyRef, tyPtr, tyGenericInst, tyGenericInvocation, tyAlias: result = result[0] + # automatic dereferencing is deep, refs #18298. + else: break + # result does not have to be object type + proc isImportedException*(t: PType; conf: ConfigRef): bool = assert t != nil @@ -1877,12 +1982,10 @@ proc isImportedException*(t: PType; conf: ConfigRef): bool = return false let base = t.skipTypes({tyAlias, tyPtr, tyDistinct, tyGenericInst}) - - if base.sym != nil and {sfCompileToCpp, sfImportc} * base.sym.flags != {}: - result = true + result = base.sym != nil and {sfCompileToCpp, sfImportc} * base.sym.flags != {} proc isInfixAs*(n: PNode): bool = - return n.kind == nkInfix and n[0].kind == nkIdent and n[0].ident.s == "as" + return n.kind == nkInfix and n[0].kind == nkIdent and n[0].ident.id == ord(wAs) proc skipColon*(n: PNode): PNode = result = n @@ -1890,10 +1993,12 @@ proc skipColon*(n: PNode): PNode = result = n[1] proc findUnresolvedStatic*(n: PNode): PNode = - # n.typ == nil: see issue #14802 if n.kind == nkSym and n.typ != nil and n.typ.kind == tyStatic and n.typ.n == nil: return n - + if n.typ != nil and n.typ.kind == tyTypeDesc: + let t = skipTypes(n.typ, {tyTypeDesc}) + if t.kind == tyGenericParam and not t.genericParamHasConstraints: + return n for son in n: let n = son.findUnresolvedStatic if n != nil: return n @@ -1922,20 +2027,29 @@ template detailedInfo*(sym: PSym): string = proc isInlineIterator*(typ: PType): bool {.inline.} = typ.kind == tyProc and tfIterator in typ.flags and typ.callConv != ccClosure +proc isIterator*(typ: PType): bool {.inline.} = + typ.kind == tyProc and tfIterator in typ.flags + proc isClosureIterator*(typ: PType): bool {.inline.} = typ.kind == tyProc and tfIterator in typ.flags and typ.callConv == ccClosure proc isClosure*(typ: PType): bool {.inline.} = typ.kind == tyProc and typ.callConv == ccClosure +proc isNimcall*(s: PSym): bool {.inline.} = + s.typ.callConv == ccNimCall + +proc isExplicitCallConv*(s: PSym): bool {.inline.} = + tfExplicitCallConv in s.typ.flags + proc isSinkParam*(s: PSym): bool {.inline.} = s.kind == skParam and (s.typ.kind == tySink or tfHasOwned in s.typ.flags) proc isSinkType*(t: PType): bool {.inline.} = t.kind == tySink or tfHasOwned in t.flags -proc newProcType*(info: TLineInfo; id: ItemId; owner: PSym): PType = - result = newType(tyProc, id, owner) +proc newProcType*(info: TLineInfo; idgen: IdGenerator; owner: PSym): PType = + result = newType(tyProc, idgen, owner) result.n = newNodeI(nkFormalParams, info) rawAddSon(result, nil) # return type # result.n[0] used to be `nkType`, but now it's `nkEffectList` because @@ -1944,7 +2058,7 @@ proc newProcType*(info: TLineInfo; id: ItemId; owner: PSym): PType = result.n.add newNodeI(nkEffectList, info) proc addParam*(procType: PType; param: PSym) = - param.position = procType.len-1 + param.position = procType.sons.len-1 procType.n.add newSymNode(param) rawAddSon(procType, param.typ) @@ -1986,9 +2100,36 @@ proc toHumanStr*(kind: TTypeKind): string = ## strips leading `tk` result = toHumanStrImpl(kind, 2) -proc skipAddr*(n: PNode): PNode {.inline.} = +proc skipHiddenAddr*(n: PNode): PNode {.inline.} = (if n.kind == nkHiddenAddr: n[0] else: n) proc isNewStyleConcept*(n: PNode): bool {.inline.} = assert n.kind == nkTypeClassTy result = n[0].kind == nkEmpty + +proc isOutParam*(t: PType): bool {.inline.} = tfIsOutParam in t.flags + +const + nodesToIgnoreSet* = {nkNone..pred(nkSym), succ(nkSym)..nkNilLit, + nkTypeSection, nkProcDef, nkConverterDef, + nkMethodDef, nkIteratorDef, nkMacroDef, nkTemplateDef, nkLambda, nkDo, + nkFuncDef, nkConstSection, nkConstDef, nkIncludeStmt, nkImportStmt, + nkExportStmt, nkPragma, nkCommentStmt, nkBreakState, + nkTypeOfExpr, nkMixinStmt, nkBindStmt} + +proc isTrue*(n: PNode): bool = + n.kind == nkSym and n.sym.kind == skEnumField and n.sym.position != 0 or + n.kind == nkIntLit and n.intVal != 0 + +type + TypeMapping* = Table[ItemId, PType] + SymMapping* = Table[ItemId, PSym] + +template idTableGet*(tab: typed; key: PSym | PType): untyped = tab.getOrDefault(key.itemId) +template idTablePut*(tab: typed; key, val: PSym | PType) = tab[key.itemId] = val + +template initSymMapping*(): Table[ItemId, PSym] = initTable[ItemId, PSym]() +template initTypeMapping*(): Table[ItemId, PType] = initTable[ItemId, PType]() + +template resetIdTable*(tab: Table[ItemId, PSym]) = tab.clear() +template resetIdTable*(tab: Table[ItemId, PType]) = tab.clear() diff --git a/compiler/astalgo.nim b/compiler/astalgo.nim index 300089d81..7a9892f78 100644 --- a/compiler/astalgo.nim +++ b/compiler/astalgo.nim @@ -12,18 +12,18 @@ # the data structures here are used in various places of the compiler. import - ast, hashes, intsets, strutils, options, lineinfos, ropes, idents, rodutils, + ast, astyaml, options, lineinfos, idents, rodutils, msgs -proc hashNode*(p: RootRef): Hash -proc treeToYaml*(conf: ConfigRef; n: PNode, indent: int = 0, maxRecDepth: int = - 1): Rope - # Convert a tree into its YAML representation; this is used by the - # YAML code generator and it is invaluable for debugging purposes. - # If maxRecDepht <> -1 then it won't print the whole graph. -proc typeToYaml*(conf: ConfigRef; n: PType, indent: int = 0, maxRecDepth: int = - 1): Rope -proc symToYaml*(conf: ConfigRef; n: PSym, indent: int = 0, maxRecDepth: int = - 1): Rope -proc lineInfoToStr*(conf: ConfigRef; info: TLineInfo): Rope +import std/[hashes, intsets] +import std/strutils except addf + +export astyaml.treeToYaml, astyaml.typeToYaml, astyaml.symToYaml, astyaml.lineInfoToStr +when defined(nimPreviewSlimSystem): + import std/assertions + +proc hashNode*(p: RootRef): Hash # these are for debugging only: They are not really deprecated, but I want # the warning so that release versions do not contain debugging statements: @@ -31,15 +31,6 @@ proc debug*(n: PSym; conf: ConfigRef = nil) {.exportc: "debugSym", deprecated.} proc debug*(n: PType; conf: ConfigRef = nil) {.exportc: "debugType", deprecated.} proc debug*(n: PNode; conf: ConfigRef = nil) {.exportc: "debugNode", deprecated.} -proc typekinds*(t: PType) {.deprecated.} = - var t = t - var s = "" - while t != nil and t.len > 0: - s.add $t.kind - s.add " " - t = t.lastSon - echo s - template debug*(x: PSym|PType|PNode) {.deprecated.} = when compiles(c.config): debug(c.config, x) @@ -74,16 +65,6 @@ template mdbg*: bool {.deprecated.} = else: error() -# --------------------------- ident tables ---------------------------------- -proc idTableGet*(t: TIdTable, key: PIdObj): RootRef -proc idTableGet*(t: TIdTable, key: int): RootRef -proc idTablePut*(t: var TIdTable, key: PIdObj, val: RootRef) -proc idTableHasObjectAsKey*(t: TIdTable, key: PIdObj): bool - # checks if `t` contains the `key` (compared by the pointer value, not only - # `key`'s id) -proc idNodeTableGet*(t: TIdNodeTable, key: PIdObj): PNode -proc idNodeTablePut*(t: var TIdNodeTable, key: PIdObj, val: PNode) - # --------------------------------------------------------------------------- proc lookupInRecord*(n: PNode, field: PIdent): PSym @@ -104,7 +85,7 @@ type data*: TIIPairSeq -proc initIiTable*(x: var TIITable) +proc initIITable*(x: var TIITable) proc iiTableGet*(t: TIITable, key: int): int proc iiTablePut*(t: var TIITable, key, val: int) @@ -192,6 +173,7 @@ proc getSymFromList*(list: PNode, ident: PIdent, start: int = 0): PSym = result = nil proc sameIgnoreBacktickGensymInfo(a, b: string): bool = + result = false if a[0] != b[0]: return false var alen = a.len - 1 while alen > 0 and a[alen] != '`': dec(alen) @@ -221,11 +203,11 @@ proc getNamedParamFromList*(list: PNode, ident: PIdent): PSym = ## Named parameters are special because a named parameter can be ## gensym'ed and then they have '\`<number>' suffix that we need to ## ignore, see compiler / evaltempl.nim, snippet: - ## - ## .. code-block:: nim - ## + ## ```nim ## result.add newIdentNode(getIdent(c.ic, x.name.s & "\`gensym" & $x.id), ## if c.instLines: actual.info else: templ.info) + ## ``` + result = nil for i in 1..<list.len: let it = list[i].sym if it.name.id == ident.id or @@ -238,169 +220,7 @@ proc mustRehash(length, counter: int): bool = assert(length > counter) result = (length * 2 < counter * 3) or (length - counter < 4) -proc rspaces(x: int): Rope = - # returns x spaces - result = rope(spaces(x)) - -proc toYamlChar(c: char): string = - case c - of '\0'..'\x1F', '\x7F'..'\xFF': result = "\\u" & strutils.toHex(ord(c), 4) - of '\'', '\"', '\\': result = '\\' & c - else: result = $c - -proc makeYamlString*(s: string): Rope = - # We have to split long strings into many ropes. Otherwise - # this could trigger InternalError(111). See the ropes module for - # further information. - const MaxLineLength = 64 - result = nil - var res = "\"" - for i in 0..<s.len: - if (i + 1) mod MaxLineLength == 0: - res.add('\"') - res.add("\n") - result.add(rope(res)) - res = "\"" # reset - res.add(toYamlChar(s[i])) - res.add('\"') - result.add(rope(res)) - -proc flagsToStr[T](flags: set[T]): Rope = - if flags == {}: - result = rope("[]") - else: - result = nil - for x in items(flags): - if result != nil: result.add(", ") - result.add(makeYamlString($x)) - result = "[" & result & "]" - -proc lineInfoToStr(conf: ConfigRef; info: TLineInfo): Rope = - result = "[$1, $2, $3]" % [makeYamlString(toFilename(conf, info)), - rope(toLinenumber(info)), - rope(toColumn(info))] - -proc treeToYamlAux(conf: ConfigRef; n: PNode, marker: var IntSet, - indent, maxRecDepth: int): Rope -proc symToYamlAux(conf: ConfigRef; n: PSym, marker: var IntSet, - indent, maxRecDepth: int): Rope -proc typeToYamlAux(conf: ConfigRef; n: PType, marker: var IntSet, - indent, maxRecDepth: int): Rope - -proc symToYamlAux(conf: ConfigRef; n: PSym, marker: var IntSet, indent: int, - maxRecDepth: int): Rope = - if n == nil: - result = rope("null") - elif containsOrIncl(marker, n.id): - result = "\"$1\"" % [rope(n.name.s)] - else: - var ast = treeToYamlAux(conf, n.ast, marker, indent + 2, maxRecDepth - 1) - #rope("typ"), typeToYamlAux(conf, n.typ, marker, - # indent + 2, maxRecDepth - 1), - let istr = rspaces(indent + 2) - result = rope("{") - result.addf("$N$1\"kind\": $2", [istr, makeYamlString($n.kind)]) - result.addf("$N$1\"name\": $2", [istr, makeYamlString(n.name.s)]) - result.addf("$N$1\"typ\": $2", [istr, typeToYamlAux(conf, n.typ, marker, indent + 2, maxRecDepth - 1)]) - if conf != nil: - # if we don't pass the config, we probably don't care about the line info - result.addf("$N$1\"info\": $2", [istr, lineInfoToStr(conf, n.info)]) - if card(n.flags) > 0: - result.addf("$N$1\"flags\": $2", [istr, flagsToStr(n.flags)]) - result.addf("$N$1\"magic\": $2", [istr, makeYamlString($n.magic)]) - result.addf("$N$1\"ast\": $2", [istr, ast]) - result.addf("$N$1\"options\": $2", [istr, flagsToStr(n.options)]) - result.addf("$N$1\"position\": $2", [istr, rope(n.position)]) - result.addf("$N$1\"k\": $2", [istr, makeYamlString($n.loc.k)]) - result.addf("$N$1\"storage\": $2", [istr, makeYamlString($n.loc.storage)]) - if card(n.loc.flags) > 0: - result.addf("$N$1\"flags\": $2", [istr, makeYamlString($n.loc.flags)]) - result.addf("$N$1\"r\": $2", [istr, n.loc.r]) - result.addf("$N$1\"lode\": $2", [istr, treeToYamlAux(conf, n.loc.lode, marker, indent + 2, maxRecDepth - 1)]) - result.addf("$N$1}", [rspaces(indent)]) - -proc typeToYamlAux(conf: ConfigRef; n: PType, marker: var IntSet, indent: int, - maxRecDepth: int): Rope = - var sonsRope: Rope - if n == nil: - sonsRope = rope("null") - elif containsOrIncl(marker, n.id): - sonsRope = "\"$1 @$2\"" % [rope($n.kind), rope( - strutils.toHex(cast[ByteAddress](n), sizeof(n) * 2))] - else: - if n.len > 0: - sonsRope = rope("[") - for i in 0..<n.len: - if i > 0: sonsRope.add(",") - sonsRope.addf("$N$1$2", [rspaces(indent + 4), typeToYamlAux(conf, n[i], - marker, indent + 4, maxRecDepth - 1)]) - sonsRope.addf("$N$1]", [rspaces(indent + 2)]) - else: - sonsRope = rope("null") - - let istr = rspaces(indent + 2) - result = rope("{") - result.addf("$N$1\"kind\": $2", [istr, makeYamlString($n.kind)]) - result.addf("$N$1\"sym\": $2", [istr, symToYamlAux(conf, n.sym, marker, indent + 2, maxRecDepth - 1)]) - result.addf("$N$1\"n\": $2", [istr, treeToYamlAux(conf, n.n, marker, indent + 2, maxRecDepth - 1)]) - if card(n.flags) > 0: - result.addf("$N$1\"flags\": $2", [istr, flagsToStr(n.flags)]) - result.addf("$N$1\"callconv\": $2", [istr, makeYamlString($n.callConv)]) - result.addf("$N$1\"size\": $2", [istr, rope(n.size)]) - result.addf("$N$1\"align\": $2", [istr, rope(n.align)]) - result.addf("$N$1\"sons\": $2", [istr, sonsRope]) - -proc treeToYamlAux(conf: ConfigRef; n: PNode, marker: var IntSet, indent: int, - maxRecDepth: int): Rope = - if n == nil: - result = rope("null") - else: - var istr = rspaces(indent + 2) - result = "{$N$1\"kind\": $2" % [istr, makeYamlString($n.kind)] - if maxRecDepth != 0: - if conf != nil: - result.addf(",$N$1\"info\": $2", [istr, lineInfoToStr(conf, n.info)]) - case n.kind - of nkCharLit..nkInt64Lit: - result.addf(",$N$1\"intVal\": $2", [istr, rope(n.intVal)]) - of nkFloatLit, nkFloat32Lit, nkFloat64Lit: - result.addf(",$N$1\"floatVal\": $2", - [istr, rope(n.floatVal.toStrMaxPrecision)]) - of nkStrLit..nkTripleStrLit: - result.addf(",$N$1\"strVal\": $2", [istr, makeYamlString(n.strVal)]) - of nkSym: - result.addf(",$N$1\"sym\": $2", - [istr, symToYamlAux(conf, n.sym, marker, indent + 2, maxRecDepth)]) - of nkIdent: - if n.ident != nil: - result.addf(",$N$1\"ident\": $2", [istr, makeYamlString(n.ident.s)]) - else: - result.addf(",$N$1\"ident\": null", [istr]) - else: - if n.len > 0: - result.addf(",$N$1\"sons\": [", [istr]) - for i in 0..<n.len: - if i > 0: result.add(",") - result.addf("$N$1$2", [rspaces(indent + 4), treeToYamlAux(conf, n[i], - marker, indent + 4, maxRecDepth - 1)]) - result.addf("$N$1]", [istr]) - result.addf(",$N$1\"typ\": $2", - [istr, typeToYamlAux(conf, n.typ, marker, indent + 2, maxRecDepth)]) - result.addf("$N$1}", [rspaces(indent)]) - -proc treeToYaml(conf: ConfigRef; n: PNode, indent: int = 0, maxRecDepth: int = - 1): Rope = - var marker = initIntSet() - result = treeToYamlAux(conf, n, marker, indent, maxRecDepth) - -proc typeToYaml(conf: ConfigRef; n: PType, indent: int = 0, maxRecDepth: int = - 1): Rope = - var marker = initIntSet() - result = typeToYamlAux(conf, n, marker, indent, maxRecDepth) - -proc symToYaml(conf: ConfigRef; n: PSym, indent: int = 0, maxRecDepth: int = - 1): Rope = - var marker = initIntSet() - result = symToYamlAux(conf, n, marker, indent, maxRecDepth) - -import tables +import std/tables const backrefStyle = "\e[90m" const enumStyle = "\e[34m" @@ -564,14 +384,12 @@ proc value(this: var DebugPrinter; value: PType) = this.key "n" this.value value.n - if value.len > 0: - this.key "sons" - this.openBracket - for i in 0..<value.len: - this.value value[i] - if i != value.len - 1: - this.comma - this.closeBracket + this.key "sons" + this.openBracket + for i, a in value.ikids: + if i > 0: this.comma + this.value a + this.closeBracket if value.n != nil: this.key "n" @@ -585,6 +403,9 @@ proc value(this: var DebugPrinter; value: PNode) = this.openCurly this.key "kind" this.value value.kind + if value.comment.len > 0: + this.key "comment" + this.value value.comment when defined(useNodeIds): this.key "id" this.value value.id @@ -637,30 +458,33 @@ proc value(this: var DebugPrinter; value: PNode) = proc debug(n: PSym; conf: ConfigRef) = - var this: DebugPrinter - this.visited = initTable[pointer, int]() - this.renderSymType = true - this.useColor = not defined(windows) + var this = DebugPrinter( + visited: initTable[pointer, int](), + renderSymType: true, + useColor: not defined(windows) + ) this.value(n) echo($this.res) proc debug(n: PType; conf: ConfigRef) = - var this: DebugPrinter - this.visited = initTable[pointer, int]() - this.renderSymType = true - this.useColor = not defined(windows) + var this = DebugPrinter( + visited: initTable[pointer, int](), + renderSymType: true, + useColor: not defined(windows) + ) this.value(n) echo($this.res) proc debug(n: PNode; conf: ConfigRef) = - var this: DebugPrinter - this.visited = initTable[pointer, int]() - #this.renderSymType = true - this.useColor = not defined(windows) + var this = DebugPrinter( + visited: initTable[pointer, int](), + renderSymType: false, + useColor: not defined(windows) + ) this.value(n) echo($this.res) -proc nextTry(h, maxHash: Hash): Hash = +proc nextTry(h, maxHash: Hash): Hash {.inline.} = result = ((5 * h) + 1) and maxHash # For any initial h in range(maxHash), repeating that maxHash times # generates each int in range(maxHash) exactly once (see any text on @@ -759,9 +583,9 @@ proc strTableAdd*(t: var TStrTable, n: PSym) = proc strTableInclReportConflict*(t: var TStrTable, n: PSym; onConflictKeepOld = false): PSym = - # returns true if n is already in the string table: - # It is essential that `n` is written nevertheless! - # This way the newest redefinition is picked by the semantic analyses! + # if `t` has a conflicting symbol (same identifier as `n`), return it + # otherwise return `nil`. Incl `n` to `t` unless `onConflictKeepOld = true` + # and a conflict was found. assert n.name != nil var h: Hash = n.name.h and high(t.data) var replaceSlot = -1 @@ -777,9 +601,10 @@ proc strTableInclReportConflict*(t: var TStrTable, n: PSym; replaceSlot = h h = nextTry(h, high(t.data)) if replaceSlot >= 0: + result = t.data[replaceSlot] # found it if not onConflictKeepOld: t.data[replaceSlot] = n # overwrite it with newer definition! - return t.data[replaceSlot] # found it + return result # but return the old one elif mustRehash(t.data.len, t.counter): strTableEnlarge(t) strTableRawInsert(t.data, n) @@ -808,16 +633,21 @@ type name*: PIdent proc nextIdentIter*(ti: var TIdentIter, tab: TStrTable): PSym = + # hot spots var h = ti.h and high(tab.data) var start = h - result = tab.data[h] - while result != nil: - if result.name.id == ti.name.id: break + var p {.cursor.} = tab.data[h] + while p != nil: + if p.name.id == ti.name.id: break h = nextTry(h, high(tab.data)) if h == start: - result = nil + p = nil break - result = tab.data[h] + p = tab.data[h] + if p != nil: + result = p # increase the count + else: + result = nil ti.h = nextTry(h, high(tab.data)) proc initIdentIter*(ti: var TIdentIter, tab: TStrTable, s: PIdent): PSym = @@ -877,125 +707,12 @@ proc initTabIter*(ti: var TTabIter, tab: TStrTable): PSym = result = nextIter(ti, tab) iterator items*(tab: TStrTable): PSym = - var it: TTabIter + var it: TTabIter = default(TTabIter) var s = initTabIter(it, tab) while s != nil: yield s s = nextIter(it, tab) -proc hasEmptySlot(data: TIdPairSeq): bool = - for h in 0..high(data): - if data[h].key == nil: - return true - result = false - -proc idTableRawGet(t: TIdTable, key: int): int = - var h: Hash - h = key and high(t.data) # start with real hash value - while t.data[h].key != nil: - if t.data[h].key.id == key: - return h - h = nextTry(h, high(t.data)) - result = - 1 - -proc idTableHasObjectAsKey(t: TIdTable, key: PIdObj): bool = - var index = idTableRawGet(t, key.id) - if index >= 0: result = t.data[index].key == key - else: result = false - -proc idTableGet(t: TIdTable, key: PIdObj): RootRef = - var index = idTableRawGet(t, key.id) - if index >= 0: result = t.data[index].val - else: result = nil - -proc idTableGet(t: TIdTable, key: int): RootRef = - var index = idTableRawGet(t, key) - if index >= 0: result = t.data[index].val - else: result = nil - -iterator pairs*(t: TIdTable): tuple[key: int, value: RootRef] = - for i in 0..high(t.data): - if t.data[i].key != nil: - yield (t.data[i].key.id, t.data[i].val) - -proc idTableRawInsert(data: var TIdPairSeq, key: PIdObj, val: RootRef) = - var h: Hash - h = key.id and high(data) - while data[h].key != nil: - assert(data[h].key.id != key.id) - h = nextTry(h, high(data)) - assert(data[h].key == nil) - data[h].key = key - data[h].val = val - -proc idTablePut(t: var TIdTable, key: PIdObj, val: RootRef) = - var - index: int - n: TIdPairSeq - index = idTableRawGet(t, key.id) - if index >= 0: - assert(t.data[index].key != nil) - t.data[index].val = val - else: - if mustRehash(t.data.len, t.counter): - newSeq(n, t.data.len * GrowthFactor) - for i in 0..high(t.data): - if t.data[i].key != nil: - idTableRawInsert(n, t.data[i].key, t.data[i].val) - assert(hasEmptySlot(n)) - swap(t.data, n) - idTableRawInsert(t.data, key, val) - inc(t.counter) - -iterator idTablePairs*(t: TIdTable): tuple[key: PIdObj, val: RootRef] = - for i in 0..high(t.data): - if not isNil(t.data[i].key): yield (t.data[i].key, t.data[i].val) - -proc idNodeTableRawGet(t: TIdNodeTable, key: PIdObj): int = - var h: Hash - h = key.id and high(t.data) # start with real hash value - while t.data[h].key != nil: - if t.data[h].key.id == key.id: - return h - h = nextTry(h, high(t.data)) - result = - 1 - -proc idNodeTableGet(t: TIdNodeTable, key: PIdObj): PNode = - var index: int - index = idNodeTableRawGet(t, key) - if index >= 0: result = t.data[index].val - else: result = nil - -proc idNodeTableRawInsert(data: var TIdNodePairSeq, key: PIdObj, val: PNode) = - var h: Hash - h = key.id and high(data) - while data[h].key != nil: - assert(data[h].key.id != key.id) - h = nextTry(h, high(data)) - assert(data[h].key == nil) - data[h].key = key - data[h].val = val - -proc idNodeTablePut(t: var TIdNodeTable, key: PIdObj, val: PNode) = - var index = idNodeTableRawGet(t, key) - if index >= 0: - assert(t.data[index].key != nil) - t.data[index].val = val - else: - if mustRehash(t.data.len, t.counter): - var n: TIdNodePairSeq - newSeq(n, t.data.len * GrowthFactor) - for i in 0..high(t.data): - if t.data[i].key != nil: - idNodeTableRawInsert(n, t.data[i].key, t.data[i].val) - swap(t.data, n) - idNodeTableRawInsert(t.data, key, val) - inc(t.counter) - -iterator pairs*(t: TIdNodeTable): tuple[key: PIdObj, val: PNode] = - for i in 0..high(t.data): - if not isNil(t.data[i].key): yield (t.data[i].key, t.data[i].val) - proc initIITable(x: var TIITable) = x.counter = 0 newSeq(x.data, StartSize) @@ -1041,15 +758,8 @@ proc iiTablePut(t: var TIITable, key, val: int) = iiTableRawInsert(t.data, key, val) inc(t.counter) -proc isAddrNode*(n: PNode): bool = - case n.kind - of nkAddr, nkHiddenAddr: true - of nkCallKinds: - if n[0].kind == nkSym and n[0].sym.magic == mAddr: true - else: false - else: false - proc listSymbolNames*(symbols: openArray[PSym]): string = + result = "" for sym in symbols: if result.len > 0: result.add ", " diff --git a/compiler/astmsgs.nim b/compiler/astmsgs.nim new file mode 100644 index 000000000..aeeff1fd0 --- /dev/null +++ b/compiler/astmsgs.nim @@ -0,0 +1,45 @@ +# this module avoids ast depending on msgs or vice versa +import std/strutils +import options, ast, msgs + +proc typSym*(t: PType): PSym = + result = t.sym + if result == nil and t.kind == tyGenericInst: # this might need to be refined + result = t.genericHead.sym + +proc addDeclaredLoc*(result: var string, conf: ConfigRef; sym: PSym) = + result.add " [$1 declared in $2]" % [sym.kind.toHumanStr, toFileLineCol(conf, sym.info)] + +proc addDeclaredLocMaybe*(result: var string, conf: ConfigRef; sym: PSym) = + if optDeclaredLocs in conf.globalOptions and sym != nil: + addDeclaredLoc(result, conf, sym) + +proc addDeclaredLoc*(result: var string, conf: ConfigRef; typ: PType) = + # xxx figure out how to resolve `tyGenericParam`, e.g. for + # proc fn[T](a: T, b: T) = discard + # fn(1.1, "a") + let typ = typ.skipTypes(abstractInst + {tyStatic, tySequence, tyArray, tySet, tyUserTypeClassInst, tyVar, tyRef, tyPtr} - {tyRange}) + result.add " [$1" % typ.kind.toHumanStr + if typ.sym != nil: + result.add " declared in " & toFileLineCol(conf, typ.sym.info) + result.add "]" + +proc addTypeNodeDeclaredLoc*(result: var string, conf: ConfigRef; typ: PType) = + result.add " [$1" % typ.kind.toHumanStr + if typ.sym != nil: + result.add " declared in " & toFileLineCol(conf, typ.sym.info) + result.add "]" + +proc addDeclaredLocMaybe*(result: var string, conf: ConfigRef; typ: PType) = + if optDeclaredLocs in conf.globalOptions: addDeclaredLoc(result, conf, typ) + +template quoteExpr*(a: string): untyped = + ## can be used for quoting expressions in error msgs. + "'" & a & "'" + +proc genFieldDefect*(conf: ConfigRef, field: string, disc: PSym): string = + let obj = disc.owner.name.s # `types.typeToString` might be better, eg for generics + result = "field '$#' is not accessible for type '$#'" % [field, obj] + if optDeclaredLocs in conf.globalOptions: + result.add " [discriminant declared in $#]" % toFileLineCol(conf, disc.info) + result.add " using '$# = " % disc.name.s diff --git a/compiler/astyaml.nim b/compiler/astyaml.nim new file mode 100644 index 000000000..b0fa2bfb2 --- /dev/null +++ b/compiler/astyaml.nim @@ -0,0 +1,154 @@ +# +# +# The Nim Compiler +# (c) Copyright 2012 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +# AST YAML printing + +import "."/[ast, lineinfos, msgs, options, rodutils] +import std/[intsets, strutils] + +proc addYamlString*(res: var string; s: string) = + res.add "\"" + for c in s: + case c + of '\0' .. '\x1F', '\x7F' .. '\xFF': + res.add("\\u" & strutils.toHex(ord(c), 4)) + of '\"', '\\': + res.add '\\' & c + else: + res.add c + + res.add('\"') + +proc makeYamlString(s: string): string = + result = "" + result.addYamlString(s) + +proc flagsToStr[T](flags: set[T]): string = + if flags == {}: + result = "[]" + else: + result = "" + for x in items(flags): + if result != "": + result.add(", ") + result.addYamlString($x) + result = "[" & result & "]" + +proc lineInfoToStr*(conf: ConfigRef; info: TLineInfo): string = + result = "[" + result.addYamlString(toFilename(conf, info)) + result.addf ", $1, $2]", [toLinenumber(info), toColumn(info)] + +proc treeToYamlAux(res: var string; conf: ConfigRef; n: PNode; marker: var IntSet; indent, maxRecDepth: int) +proc symToYamlAux(res: var string; conf: ConfigRef; n: PSym; marker: var IntSet; indent, maxRecDepth: int) +proc typeToYamlAux(res: var string; conf: ConfigRef; n: PType; marker: var IntSet; indent, maxRecDepth: int) + +proc symToYamlAux(res: var string; conf: ConfigRef; n: PSym; marker: var IntSet; indent: int; maxRecDepth: int) = + if n == nil: + res.add("null") + elif containsOrIncl(marker, n.id): + res.addYamlString(n.name.s) + else: + let istr = spaces(indent * 4) + + res.addf("kind: $1", [makeYamlString($n.kind)]) + res.addf("\n$1name: $2", [istr, makeYamlString(n.name.s)]) + res.addf("\n$1typ: ", [istr]) + res.typeToYamlAux(conf, n.typ, marker, indent + 1, maxRecDepth - 1) + if conf != nil: + # if we don't pass the config, we probably don't care about the line info + res.addf("\n$1info: $2", [istr, lineInfoToStr(conf, n.info)]) + if card(n.flags) > 0: + res.addf("\n$1flags: $2", [istr, flagsToStr(n.flags)]) + res.addf("\n$1magic: $2", [istr, makeYamlString($n.magic)]) + res.addf("\n$1ast: ", [istr]) + res.treeToYamlAux(conf, n.ast, marker, indent + 1, maxRecDepth - 1) + res.addf("\n$1options: $2", [istr, flagsToStr(n.options)]) + res.addf("\n$1position: $2", [istr, $n.position]) + res.addf("\n$1k: $2", [istr, makeYamlString($n.loc.k)]) + res.addf("\n$1storage: $2", [istr, makeYamlString($n.loc.storage)]) + if card(n.loc.flags) > 0: + res.addf("\n$1flags: $2", [istr, makeYamlString($n.loc.flags)]) + res.addf("\n$1snippet: $2", [istr, n.loc.snippet]) + res.addf("\n$1lode: $2", [istr]) + res.treeToYamlAux(conf, n.loc.lode, marker, indent + 1, maxRecDepth - 1) + +proc typeToYamlAux(res: var string; conf: ConfigRef; n: PType; marker: var IntSet; indent: int; maxRecDepth: int) = + if n == nil: + res.add("null") + elif containsOrIncl(marker, n.id): + res.addf "\"$1 @$2\"" % [$n.kind, strutils.toHex(cast[uint](n), sizeof(n) * 2)] + else: + let istr = spaces(indent * 4) + res.addf("kind: $2", [istr, makeYamlString($n.kind)]) + res.addf("\n$1sym: ") + res.symToYamlAux(conf, n.sym, marker, indent + 1, maxRecDepth - 1) + res.addf("\n$1n: ") + res.treeToYamlAux(conf, n.n, marker, indent + 1, maxRecDepth - 1) + if card(n.flags) > 0: + res.addf("\n$1flags: $2", [istr, flagsToStr(n.flags)]) + res.addf("\n$1callconv: $2", [istr, makeYamlString($n.callConv)]) + res.addf("\n$1size: $2", [istr, $(n.size)]) + res.addf("\n$1align: $2", [istr, $(n.align)]) + if n.hasElementType: + res.addf("\n$1sons:") + for a in n.kids: + res.addf("\n - ") + res.typeToYamlAux(conf, a, marker, indent + 1, maxRecDepth - 1) + +proc treeToYamlAux(res: var string; conf: ConfigRef; n: PNode; marker: var IntSet; indent: int; + maxRecDepth: int) = + if n == nil: + res.add("null") + else: + var istr = spaces(indent * 4) + res.addf("kind: $1" % [makeYamlString($n.kind)]) + + if maxRecDepth != 0: + if conf != nil: + res.addf("\n$1info: $2", [istr, lineInfoToStr(conf, n.info)]) + case n.kind + of nkCharLit .. nkInt64Lit: + res.addf("\n$1intVal: $2", [istr, $(n.intVal)]) + of nkFloatLit, nkFloat32Lit, nkFloat64Lit: + res.addf("\n$1floatVal: $2", [istr, n.floatVal.toStrMaxPrecision]) + of nkStrLit .. nkTripleStrLit: + res.addf("\n$1strVal: $2", [istr, makeYamlString(n.strVal)]) + of nkSym: + res.addf("\n$1sym: ", [istr]) + res.symToYamlAux(conf, n.sym, marker, indent + 1, maxRecDepth) + of nkIdent: + if n.ident != nil: + res.addf("\n$1ident: $2", [istr, makeYamlString(n.ident.s)]) + else: + res.addf("\n$1ident: null", [istr]) + else: + if n.len > 0: + res.addf("\n$1sons: ", [istr]) + for i in 0 ..< n.len: + res.addf("\n$1 - ", [istr]) + res.treeToYamlAux(conf, n[i], marker, indent + 1, maxRecDepth - 1) + if n.typ != nil: + res.addf("\n$1typ: ", [istr]) + res.typeToYamlAux(conf, n.typ, marker, indent + 1, maxRecDepth) + +proc treeToYaml*(conf: ConfigRef; n: PNode; indent: int = 0; maxRecDepth: int = -1): string = + var marker = initIntSet() + result = newStringOfCap(1024) + result.treeToYamlAux(conf, n, marker, indent, maxRecDepth) + +proc typeToYaml*(conf: ConfigRef; n: PType; indent: int = 0; maxRecDepth: int = -1): string = + var marker = initIntSet() + result = newStringOfCap(1024) + result.typeToYamlAux(conf, n, marker, indent, maxRecDepth) + +proc symToYaml*(conf: ConfigRef; n: PSym; indent: int = 0; maxRecDepth: int = -1): string = + var marker = initIntSet() + result = newStringOfCap(1024) + result.symToYamlAux(conf, n, marker, indent, maxRecDepth) diff --git a/compiler/bitsets.nim b/compiler/bitsets.nim index 2e8aa1db6..7d142b01d 100644 --- a/compiler/bitsets.nim +++ b/compiler/bitsets.nim @@ -10,6 +10,9 @@ # this unit handles Nim sets; it implements bit sets # the code here should be reused in the Nim standard library +when defined(nimPreviewSlimSystem): + import std/assertions + type ElemType = byte TBitSet* = seq[ElemType] # we use byte here to avoid issues with @@ -23,53 +26,40 @@ const template modElemSize(arg: untyped): untyped = arg and 7 template divElemSize(arg: untyped): untyped = arg shr 3 -proc bitSetInit*(b: var TBitSet, length: int) -proc bitSetUnion*(x: var TBitSet, y: TBitSet) -proc bitSetDiff*(x: var TBitSet, y: TBitSet) -proc bitSetSymDiff*(x: var TBitSet, y: TBitSet) -proc bitSetIntersect*(x: var TBitSet, y: TBitSet) -proc bitSetIncl*(x: var TBitSet, elem: BiggestInt) -proc bitSetExcl*(x: var TBitSet, elem: BiggestInt) -proc bitSetIn*(x: TBitSet, e: BiggestInt): bool -proc bitSetEquals*(x, y: TBitSet): bool -proc bitSetContains*(x, y: TBitSet): bool -proc bitSetCard*(x: TBitSet): BiggestInt -# implementation - -proc bitSetIn(x: TBitSet, e: BiggestInt): bool = +proc bitSetIn*(x: TBitSet, e: BiggestInt): bool = result = (x[int(e.divElemSize)] and (One shl e.modElemSize)) != Zero -proc bitSetIncl(x: var TBitSet, elem: BiggestInt) = +proc bitSetIncl*(x: var TBitSet, elem: BiggestInt) = assert(elem >= 0) x[int(elem.divElemSize)] = x[int(elem.divElemSize)] or (One shl elem.modElemSize) -proc bitSetExcl(x: var TBitSet, elem: BiggestInt) = +proc bitSetExcl*(x: var TBitSet, elem: BiggestInt) = x[int(elem.divElemSize)] = x[int(elem.divElemSize)] and not(One shl elem.modElemSize) -proc bitSetInit(b: var TBitSet, length: int) = +proc bitSetInit*(b: var TBitSet, length: int) = newSeq(b, length) -proc bitSetUnion(x: var TBitSet, y: TBitSet) = +proc bitSetUnion*(x: var TBitSet, y: TBitSet) = for i in 0..high(x): x[i] = x[i] or y[i] -proc bitSetDiff(x: var TBitSet, y: TBitSet) = +proc bitSetDiff*(x: var TBitSet, y: TBitSet) = for i in 0..high(x): x[i] = x[i] and not y[i] -proc bitSetSymDiff(x: var TBitSet, y: TBitSet) = +proc bitSetSymDiff*(x: var TBitSet, y: TBitSet) = for i in 0..high(x): x[i] = x[i] xor y[i] -proc bitSetIntersect(x: var TBitSet, y: TBitSet) = +proc bitSetIntersect*(x: var TBitSet, y: TBitSet) = for i in 0..high(x): x[i] = x[i] and y[i] -proc bitSetEquals(x, y: TBitSet): bool = +proc bitSetEquals*(x, y: TBitSet): bool = for i in 0..high(x): if x[i] != y[i]: return false result = true -proc bitSetContains(x, y: TBitSet): bool = +proc bitSetContains*(x, y: TBitSet): bool = for i in 0..high(x): if (x[i] and not y[i]) != Zero: return false @@ -96,6 +86,12 @@ const populationCount: array[uint8, uint8] = block: arr -proc bitSetCard(x: TBitSet): BiggestInt = +proc bitSetCard*(x: TBitSet): BiggestInt = + result = 0 for it in x: result.inc int(populationCount[it]) + +proc bitSetToWord*(s: TBitSet; size: int): BiggestUInt = + result = 0 + for j in 0..<size: + if j < s.len: result = result or (BiggestUInt(s[j]) shl (j * 8)) diff --git a/compiler/btrees.nim b/compiler/btrees.nim index 5f78c07fe..3b737b1bc 100644 --- a/compiler/btrees.nim +++ b/compiler/btrees.nim @@ -10,13 +10,16 @@ ## BTree implementation with few features, but good enough for the ## Nim compiler's needs. +when defined(nimPreviewSlimSystem): + import std/assertions + const M = 512 # max children per B-tree node = M-1 # (must be even and greater than 2) Mhalf = M div 2 type - Node[Key, Val] = ref object + Node[Key, Val] {.acyclic.} = ref object entries: int keys: array[M, Key] case isInternal: bool @@ -35,6 +38,7 @@ template less(a, b): bool = cmp(a, b) < 0 template eq(a, b): bool = cmp(a, b) == 0 proc getOrDefault*[Key, Val](b: BTree[Key, Val], key: Key): Val = + result = default(Val) var x = b.root while x.isInternal: for j in 0..<x.entries: @@ -65,7 +69,10 @@ proc copyHalf[Key, Val](h, result: Node[Key, Val]) = result.links[j] = h.links[Mhalf + j] else: for j in 0..<Mhalf: - shallowCopy(result.vals[j], h.vals[Mhalf + j]) + when defined(gcArc) or defined(gcOrc) or defined(gcAtomicArc): + result.vals[j] = move h.vals[Mhalf + j] + else: + shallowCopy(result.vals[j], h.vals[Mhalf + j]) proc split[Key, Val](h: Node[Key, Val]): Node[Key, Val] = ## split node in half @@ -85,7 +92,10 @@ proc insert[Key, Val](h: Node[Key, Val], key: Key, val: Val): Node[Key, Val] = if less(key, h.keys[j]): break inc j for i in countdown(h.entries, j+1): - shallowCopy(h.vals[i], h.vals[i-1]) + when defined(gcArc) or defined(gcOrc) or defined(gcAtomicArc): + h.vals[i] = move h.vals[i-1] + else: + shallowCopy(h.vals[i], h.vals[i-1]) h.vals[j] = val else: var newLink: Node[Key, Val] = nil diff --git a/compiler/cbuilder.nim b/compiler/cbuilder.nim new file mode 100644 index 000000000..bb1bdfe27 --- /dev/null +++ b/compiler/cbuilder.nim @@ -0,0 +1,174 @@ +type + Snippet = string + Builder = string + +template newBuilder(s: string): Builder = + s + +proc addField(obj: var Builder; name, typ: Snippet; isFlexArray: bool = false; initializer: Snippet = "") = + obj.add('\t') + obj.add(typ) + obj.add(" ") + obj.add(name) + if isFlexArray: + obj.add("[SEQ_DECL_SIZE]") + if initializer.len != 0: + obj.add(initializer) + obj.add(";\n") + +proc addField(obj: var Builder; field: PSym; name, typ: Snippet; isFlexArray: bool = false; initializer: Snippet = "") = + ## for fields based on an `skField` symbol + obj.add('\t') + if field.alignment > 0: + obj.add("NIM_ALIGN(") + obj.addInt(field.alignment) + obj.add(") ") + obj.add(typ) + if sfNoalias in field.flags: + obj.add(" NIM_NOALIAS") + obj.add(" ") + obj.add(name) + if isFlexArray: + obj.add("[SEQ_DECL_SIZE]") + if field.bitsize != 0: + obj.add(":") + obj.addInt(field.bitsize) + if initializer.len != 0: + obj.add(initializer) + obj.add(";\n") + +type + BaseClassKind = enum + bcNone, bcCppInherit, bcSupField, bcNoneRtti, bcNoneTinyRtti + StructBuilderInfo = object + baseKind: BaseClassKind + preFieldsLen: int + +proc structOrUnion(t: PType): Snippet = + let t = t.skipTypes({tyAlias, tySink}) + if tfUnion in t.flags: "union" + else: "struct" + +proc ptrType(t: Snippet): Snippet = + t & "*" + +proc startSimpleStruct(obj: var Builder; m: BModule; name: string; baseType: Snippet): StructBuilderInfo = + result = StructBuilderInfo(baseKind: bcNone) + obj.add("struct ") + obj.add(name) + if baseType.len != 0: + if m.compileToCpp: + result.baseKind = bcCppInherit + else: + result.baseKind = bcSupField + if result.baseKind == bcCppInherit: + obj.add(" : public ") + obj.add(baseType) + obj.add(" ") + obj.add("{\n") + result.preFieldsLen = obj.len + if result.baseKind == bcSupField: + obj.addField(name = "Sup", typ = baseType) + +proc finishSimpleStruct(obj: var Builder; m: BModule; info: StructBuilderInfo) = + if info.baseKind == bcNone and info.preFieldsLen == obj.len: + # no fields were added, add dummy field + obj.addField(name = "dummy", typ = "char") + obj.add("};\n") + +template addSimpleStruct(obj: var Builder; m: BModule; name: string; baseType: Snippet; body: typed) = + ## for independent structs, not directly based on a Nim type + let info = startSimpleStruct(obj, m, name, baseType) + body + finishSimpleStruct(obj, m, info) + +proc startStruct(obj: var Builder; m: BModule; t: PType; name: string; baseType: Snippet): StructBuilderInfo = + result = StructBuilderInfo(baseKind: bcNone) + if tfPacked in t.flags: + if hasAttribute in CC[m.config.cCompiler].props: + obj.add(structOrUnion(t)) + obj.add(" __attribute__((__packed__))") + else: + obj.add("#pragma pack(push, 1)\n") + obj.add(structOrUnion(t)) + else: + obj.add(structOrUnion(t)) + obj.add(" ") + obj.add(name) + if t.kind == tyObject: + if t.baseClass == nil: + if lacksMTypeField(t): + result.baseKind = bcNone + elif optTinyRtti in m.config.globalOptions: + result.baseKind = bcNoneTinyRtti + else: + result.baseKind = bcNoneRtti + elif m.compileToCpp: + result.baseKind = bcCppInherit + else: + result.baseKind = bcSupField + elif baseType.len != 0: + if m.compileToCpp: + result.baseKind = bcCppInherit + else: + result.baseKind = bcSupField + if result.baseKind == bcCppInherit: + obj.add(" : public ") + obj.add(baseType) + obj.add(" ") + obj.add("{\n") + result.preFieldsLen = obj.len + case result.baseKind + of bcNone: + # rest of the options add a field or don't need it due to inheritance, + # we need to add the dummy field for uncheckedarray ahead of time + # so that it remains trailing + if t.itemId notin m.g.graph.memberProcsPerType and + t.n != nil and t.n.len == 1 and t.n[0].kind == nkSym and + t.n[0].sym.typ.skipTypes(abstractInst).kind == tyUncheckedArray: + # only consists of flexible array field, add *initial* dummy field + obj.addField(name = "dummy", typ = "char") + of bcCppInherit: discard + of bcNoneRtti: + obj.addField(name = "m_type", typ = ptrType(cgsymValue(m, "TNimType"))) + of bcNoneTinyRtti: + obj.addField(name = "m_type", typ = ptrType(cgsymValue(m, "TNimTypeV2"))) + of bcSupField: + obj.addField(name = "Sup", typ = baseType) + +proc finishStruct(obj: var Builder; m: BModule; t: PType; info: StructBuilderInfo) = + if info.baseKind == bcNone and info.preFieldsLen == obj.len and + t.itemId notin m.g.graph.memberProcsPerType: + # no fields were added, add dummy field + obj.addField(name = "dummy", typ = "char") + obj.add("};\n") + if tfPacked in t.flags and hasAttribute notin CC[m.config.cCompiler].props: + obj.add("#pragma pack(pop)\n") + +template addStruct(obj: var Builder; m: BModule; typ: PType; name: string; baseType: Snippet; body: typed) = + ## for structs built directly from a Nim type + let info = startStruct(obj, m, typ, name, baseType) + body + finishStruct(obj, m, typ, info) + +template addFieldWithStructType(obj: var Builder; m: BModule; parentTyp: PType; fieldName: string, body: typed) = + ## adds a field with a `struct { ... }` type, building it according to `body` + obj.add('\t') + if tfPacked in parentTyp.flags: + if hasAttribute in CC[m.config.cCompiler].props: + obj.add("struct __attribute__((__packed__)) {\n") + else: + obj.add("#pragma pack(push, 1)\nstruct {") + else: + obj.add("struct {\n") + body + obj.add("} ") + obj.add(fieldName) + obj.add(";\n") + if tfPacked in parentTyp.flags and hasAttribute notin CC[m.config.cCompiler].props: + result.add("#pragma pack(pop)\n") + +template addAnonUnion(obj: var Builder; body: typed) = + obj.add "union{\n" + body + obj.add("};\n") diff --git a/compiler/ccgcalls.nim b/compiler/ccgcalls.nim index 64b883087..ac607e3ad 100644 --- a/compiler/ccgcalls.nim +++ b/compiler/ccgcalls.nim @@ -14,15 +14,17 @@ proc canRaiseDisp(p: BProc; n: PNode): bool = if n.kind == nkSym and {sfNeverRaises, sfImportc, sfCompilerProc} * n.sym.flags != {}: result = false elif optPanics in p.config.globalOptions or - (n.kind == nkSym and sfSystemModule in getModule(n.sym).flags): + (n.kind == nkSym and sfSystemModule in getModule(n.sym).flags and + sfSystemRaisesDefect notin n.sym.flags): # we know we can be strict: result = canRaise(n) else: # we have to be *very* conservative: result = canRaiseConservative(n) -proc preventNrvo(p: BProc; le, ri: PNode): bool = +proc preventNrvo(p: BProc; dest, le, ri: PNode): bool = proc locationEscapes(p: BProc; le: PNode; inTryStmt: bool): bool = + result = false var n = le while true: # do NOT follow nkHiddenDeref here! @@ -45,6 +47,7 @@ proc preventNrvo(p: BProc; le, ri: PNode): bool = # cannot analyse the location; assume the worst return true + result = false if le != nil: for i in 1..<ri.len: let r = ri[i] @@ -54,6 +57,11 @@ proc preventNrvo(p: BProc; le, ri: PNode): bool = if canRaise(ri[0]) and locationEscapes(p, le, p.nestedTryStmts.len > 0): message(p.config, le.info, warnObservableStores, $le) + # bug #19613 prevent dangerous aliasing too: + if dest != nil and dest != le: + for i in 1..<ri.len: + let r = ri[i] + if isPartOf(dest, r) != arNo: return true proc hasNoInit(call: PNode): bool {.inline.} = result = call[0].kind == nkSym and sfNoInit in call[0].sym.flags @@ -68,97 +76,130 @@ proc isHarmlessStore(p: BProc; canRaise: bool; d: TLoc): bool = else: result = false +proc cleanupTemp(p: BProc; returnType: PType, tmp: TLoc): bool = + if returnType.kind in {tyVar, tyLent}: + # we don't need to worry about var/lent return types + result = false + elif hasDestructor(returnType) and getAttachedOp(p.module.g.graph, returnType, attachedDestructor) != nil: + let dtor = getAttachedOp(p.module.g.graph, returnType, attachedDestructor) + var op = initLocExpr(p, newSymNode(dtor)) + var callee = rdLoc(op) + let destroy = if dtor.typ.firstParamType.kind == tyVar: + callee & "(&" & rdLoc(tmp) & ")" + else: + callee & "(" & rdLoc(tmp) & ")" + raiseExitCleanup(p, destroy) + result = true + else: + result = false + proc fixupCall(p: BProc, le, ri: PNode, d: var TLoc, callee, params: Rope) = let canRaise = p.config.exc == excGoto and canRaiseDisp(p, ri[0]) genLineDir(p, ri) - var pl = callee & ~"(" & params + var pl = callee & "(" & params # getUniqueType() is too expensive here: var typ = skipTypes(ri[0].typ, abstractInst) - if typ[0] != nil: - if isInvalidReturnType(p.config, typ[0]): - if params != nil: pl.add(~", ") + if typ.returnType != nil: + var flags: TAssignmentFlags = {} + if typ.returnType.kind in {tyOpenArray, tyVarargs}: + # perhaps generate no temp if the call doesn't have side effects + flags.incl needTempForOpenArray + if isInvalidReturnType(p.config, typ): + if params.len != 0: pl.add(", ") # beware of 'result = p(result)'. We may need to allocate a temporary: - if d.k in {locTemp, locNone} or not preventNrvo(p, le, ri): + if d.k in {locTemp, locNone} or not preventNrvo(p, d.lode, le, ri): # Great, we can use 'd': - if d.k == locNone: getTemp(p, typ[0], d, needsInit=true) + if d.k == locNone: d = getTemp(p, typ.returnType, needsInit=true) elif d.k notin {locTemp} and not hasNoInit(ri): # reset before pass as 'result' var: discard "resetLoc(p, d)" pl.add(addrLoc(p.config, d)) - pl.add(~");$n") + pl.add(");\n") line(p, cpsStmts, pl) else: - var tmp: TLoc - getTemp(p, typ[0], tmp, needsInit=true) + var tmp: TLoc = getTemp(p, typ.returnType, needsInit=true) pl.add(addrLoc(p.config, tmp)) - pl.add(~");$n") + pl.add(");\n") line(p, cpsStmts, pl) genAssignment(p, d, tmp, {}) # no need for deep copying if canRaise: raiseExit(p) else: - pl.add(~")") + pl.add(")") if p.module.compileToCpp: if lfSingleUse in d.flags: # do not generate spurious temporaries for C++! For C we're better off # with them to prevent undefined behaviour and because the codegen # is free to emit expressions multiple times! d.k = locCall - d.r = pl + d.snippet = pl excl d.flags, lfSingleUse else: if d.k == locNone and p.splitDecls == 0: - getTempCpp(p, typ[0], d, pl) + d = getTempCpp(p, typ.returnType, pl) else: - if d.k == locNone: getTemp(p, typ[0], d) - var list: TLoc - initLoc(list, locCall, d.lode, OnUnknown) - list.r = pl - genAssignment(p, d, list, {}) # no need for deep copying + if d.k == locNone: d = getTemp(p, typ.returnType) + var list = initLoc(locCall, d.lode, OnUnknown) + list.snippet = pl + genAssignment(p, d, list, {needAssignCall}) # no need for deep copying if canRaise: raiseExit(p) elif isHarmlessStore(p, canRaise, d): - if d.k == locNone: getTemp(p, typ[0], d) + var useTemp = false + if d.k == locNone: + useTemp = true + d = getTemp(p, typ.returnType) assert(d.t != nil) # generate an assignment to d: - var list: TLoc - initLoc(list, locCall, d.lode, OnUnknown) - list.r = pl - genAssignment(p, d, list, {}) # no need for deep copying - if canRaise: raiseExit(p) + var list = initLoc(locCall, d.lode, OnUnknown) + list.snippet = pl + genAssignment(p, d, list, flags+{needAssignCall}) # no need for deep copying + if canRaise: + if not (useTemp and cleanupTemp(p, typ.returnType, d)): + raiseExit(p) else: - var tmp: TLoc - getTemp(p, typ[0], tmp, needsInit=true) - var list: TLoc - initLoc(list, locCall, d.lode, OnUnknown) - list.r = pl - genAssignment(p, tmp, list, {}) # no need for deep copying - if canRaise: raiseExit(p) + var tmp: TLoc = getTemp(p, typ.returnType, needsInit=true) + var list = initLoc(locCall, d.lode, OnUnknown) + list.snippet = pl + genAssignment(p, tmp, list, flags+{needAssignCall}) # no need for deep copying + if canRaise: + if not cleanupTemp(p, typ.returnType, tmp): + raiseExit(p) genAssignment(p, d, tmp, {}) else: - pl.add(~");$n") + pl.add(");\n") line(p, cpsStmts, pl) if canRaise: raiseExit(p) -proc genBoundsCheck(p: BProc; arr, a, b: TLoc) +proc genBoundsCheck(p: BProc; arr, a, b: TLoc; arrTyp: PType) proc reifiedOpenArray(n: PNode): bool {.inline.} = var x = n - while x.kind in {nkAddr, nkHiddenAddr, nkHiddenStdConv, nkHiddenDeref}: - x = x[0] + while true: + case x.kind + of {nkAddr, nkHiddenAddr, nkHiddenDeref}: + x = x[0] + of nkHiddenStdConv: + x = x[1] + else: + break if x.kind == nkSym and x.sym.kind == skParam: result = false else: result = true -proc genOpenArraySlice(p: BProc; q: PNode; formalType, destType: PType): (Rope, Rope) = - var a, b, c: TLoc - initLocExpr(p, q[1], a) - initLocExpr(p, q[2], b) - initLocExpr(p, q[3], c) +proc genOpenArraySlice(p: BProc; q: PNode; formalType, destType: PType; prepareForMutation = false): (Rope, Rope) = + var a = initLocExpr(p, q[1]) + var b = initLocExpr(p, q[2]) + var c = initLocExpr(p, q[3]) + # bug #23321: In the function mapType, ptrs (tyPtr, tyVar, tyLent, tyRef) + # are mapped into ctPtrToArray, the dereference of which is skipped + # in the `genDeref`. We need to skip these ptrs here + let ty = skipTypes(a.t, abstractVar+{tyPtr, tyRef}) # but first produce the required index checks: if optBoundsCheck in p.options: - genBoundsCheck(p, a, b, c) - let ty = skipTypes(a.t, abstractVar+{tyPtr}) + genBoundsCheck(p, a, b, c, ty) + if prepareForMutation: + linefmt(p, cpsStmts, "#nimPrepareStrMutationV2($1);$n", [byRefLoc(p, a)]) let dest = getTypeDesc(p.module, destType) let lengthExpr = "($1)-($2)+1" % [rdLoc(c), rdLoc(b)] case ty.kind @@ -168,8 +209,10 @@ proc genOpenArraySlice(p: BProc; q: PNode; formalType, destType: PType): (Rope, result = ("($3*)(($1)+($2))" % [rdLoc(a), rdLoc(b), dest], lengthExpr) else: + var lit = newRopeAppender() + intLiteral(first, lit) result = ("($4*)($1)+(($2)-($3))" % - [rdLoc(a), rdLoc(b), intLiteral(first), dest], + [rdLoc(a), rdLoc(b), lit, dest], lengthExpr) of tyOpenArray, tyVarargs: if reifiedOpenArray(q[1]): @@ -178,7 +221,7 @@ proc genOpenArraySlice(p: BProc; q: PNode; formalType, destType: PType): (Rope, else: result = ("($3*)($1)+($2)" % [rdLoc(a), rdLoc(b), dest], lengthExpr) - of tyUncheckedArray, tyCString: + of tyUncheckedArray, tyCstring: result = ("($3*)($1)+($2)" % [rdLoc(a), rdLoc(b), dest], lengthExpr) of tyString, tySequence: @@ -187,15 +230,18 @@ proc genOpenArraySlice(p: BProc; q: PNode; formalType, destType: PType): (Rope, optSeqDestructors in p.config.globalOptions: linefmt(p, cpsStmts, "#nimPrepareStrMutationV2($1);$n", [byRefLoc(p, a)]) if atyp.kind in {tyVar} and not compileToCpp(p.module): - result = ("($4*)(*$1)$3+($2)" % [rdLoc(a), rdLoc(b), dataField(p), dest], + result = ("(($5) ? (($4*)(*$1)$3+($2)) : NIM_NIL)" % + [rdLoc(a), rdLoc(b), dataField(p), dest, dataFieldAccessor(p, "*" & rdLoc(a))], lengthExpr) else: - result = ("($4*)$1$3+($2)" % [rdLoc(a), rdLoc(b), dataField(p), dest], + result = ("(($5) ? (($4*)$1$3+($2)) : NIM_NIL)" % + [rdLoc(a), rdLoc(b), dataField(p), dest, dataFieldAccessor(p, rdLoc(a))], lengthExpr) else: + result = ("", "") internalError(p.config, "openArrayLoc: " & typeToString(a.t)) -proc openArrayLoc(p: BProc, formalType: PType, n: PNode): Rope = +proc openArrayLoc(p: BProc, formalType: PType, n: PNode; result: var Rope) = var q = skipConv(n) var skipped = false while q.kind == nkStmtListExpr and q.len > 0: @@ -209,41 +255,43 @@ proc openArrayLoc(p: BProc, formalType: PType, n: PNode): Rope = for i in 0..<q.len-1: genStmts(p, q[i]) q = q.lastSon - let (x, y) = genOpenArraySlice(p, q, formalType, n.typ[0]) - result = x & ", " & y + let (x, y) = genOpenArraySlice(p, q, formalType, n.typ.elementType) + result.add x & ", " & y else: - var a: TLoc - initLocExpr(p, if n.kind == nkHiddenStdConv: n[1] else: n, a) - case skipTypes(a.t, abstractVar).kind + var a = initLocExpr(p, if n.kind == nkHiddenStdConv: n[1] else: n) + case skipTypes(a.t, abstractVar+{tyStatic}).kind of tyOpenArray, tyVarargs: if reifiedOpenArray(n): if a.t.kind in {tyVar, tyLent}: - result = "$1->Field0, $1->Field1" % [rdLoc(a)] + result.add "$1->Field0, $1->Field1" % [rdLoc(a)] else: - result = "$1.Field0, $1.Field1" % [rdLoc(a)] + result.add "$1.Field0, $1.Field1" % [rdLoc(a)] else: - result = "$1, $1Len_0" % [rdLoc(a)] + result.add "$1, $1Len_0" % [rdLoc(a)] of tyString, tySequence: let ntyp = skipTypes(n.typ, abstractInst) if formalType.skipTypes(abstractInst).kind in {tyVar} and ntyp.kind == tyString and optSeqDestructors in p.config.globalOptions: linefmt(p, cpsStmts, "#nimPrepareStrMutationV2($1);$n", [byRefLoc(p, a)]) if ntyp.kind in {tyVar} and not compileToCpp(p.module): - var t: TLoc - t.r = "(*$1)" % [a.rdLoc] - result = "(*$1)$3, $2" % [a.rdLoc, lenExpr(p, t), dataField(p)] + var t = TLoc(snippet: "(*$1)" % [a.rdLoc]) + result.add "($4) ? ((*$1)$3) : NIM_NIL, $2" % + [a.rdLoc, lenExpr(p, t), dataField(p), + dataFieldAccessor(p, "*" & a.rdLoc)] else: - result = "$1$3, $2" % [a.rdLoc, lenExpr(p, a), dataField(p)] + result.add "($4) ? ($1$3) : NIM_NIL, $2" % + [a.rdLoc, lenExpr(p, a), dataField(p), dataFieldAccessor(p, a.rdLoc)] of tyArray: - result = "$1, $2" % [rdLoc(a), rope(lengthOrd(p.config, a.t))] + result.add "$1, $2" % [rdLoc(a), rope(lengthOrd(p.config, a.t))] of tyPtr, tyRef: - case lastSon(a.t).kind + case elementType(a.t).kind of tyString, tySequence: - var t: TLoc - t.r = "(*$1)" % [a.rdLoc] - result = "(*$1)$3, $2" % [a.rdLoc, lenExpr(p, t), dataField(p)] + var t = TLoc(snippet: "(*$1)" % [a.rdLoc]) + result.add "($4) ? ((*$1)$3) : NIM_NIL, $2" % + [a.rdLoc, lenExpr(p, t), dataField(p), + dataFieldAccessor(p, "*" & a.rdLoc)] of tyArray: - result = "$1, $2" % [rdLoc(a), rope(lengthOrd(p.config, lastSon(a.t)))] + result.add "$1, $2" % [rdLoc(a), rope(lengthOrd(p.config, elementType(a.t)))] else: internalError(p.config, "openArrayLoc: " & typeToString(a.t)) else: internalError(p.config, "openArrayLoc: " & typeToString(a.t)) @@ -252,56 +300,79 @@ proc withTmpIfNeeded(p: BProc, a: TLoc, needsTmp: bool): TLoc = # Bug https://github.com/status-im/nimbus-eth2/issues/1549 # Aliasing is preferred over stack overflows. # Also don't regress for non ARC-builds, too risky. - if needsTmp and a.lode.typ != nil and p.config.selectedGC in {gcArc, gcOrc} and + if needsTmp and a.lode.typ != nil and p.config.selectedGC in {gcArc, gcAtomicArc, gcOrc} and getSize(p.config, a.lode.typ) < 1024: - getTemp(p, a.lode.typ, result, needsInit=false) + result = getTemp(p, a.lode.typ, needsInit=false) genAssignment(p, result, a, {}) else: result = a -proc genArgStringToCString(p: BProc, n: PNode, needsTmp: bool): Rope {.inline.} = - var a: TLoc - initLocExpr(p, n[0], a) - ropecg(p.module, "#nimToCStringConv($1)", [withTmpIfNeeded(p, a, needsTmp).rdLoc]) +proc literalsNeedsTmp(p: BProc, a: TLoc): TLoc = + result = getTemp(p, a.lode.typ, needsInit=false) + genAssignment(p, result, a, {}) -proc genArg(p: BProc, n: PNode, param: PSym; call: PNode, needsTmp = false): Rope = +proc genArgStringToCString(p: BProc, n: PNode; result: var Rope; needsTmp: bool) {.inline.} = + var a = initLocExpr(p, n[0]) + appcg(p.module, result, "#nimToCStringConv($1)", [withTmpIfNeeded(p, a, needsTmp).rdLoc]) + +proc genArg(p: BProc, n: PNode, param: PSym; call: PNode; result: var Rope; needsTmp = false) = var a: TLoc if n.kind == nkStringToCString: - result = genArgStringToCString(p, n, needsTmp) + genArgStringToCString(p, n, result, needsTmp) elif skipTypes(param.typ, abstractVar).kind in {tyOpenArray, tyVarargs}: var n = if n.kind != nkHiddenAddr: n else: n[0] - result = openArrayLoc(p, param.typ, n) - elif ccgIntroducedPtr(p.config, param, call[0].typ[0]): - initLocExpr(p, n, a) - result = addrLoc(p.config, withTmpIfNeeded(p, a, needsTmp)) + openArrayLoc(p, param.typ, n, result) + elif ccgIntroducedPtr(p.config, param, call[0].typ.returnType) and + (optByRef notin param.options or not p.module.compileToCpp): + a = initLocExpr(p, n) + if n.kind in {nkCharLit..nkNilLit}: + addAddrLoc(p.config, literalsNeedsTmp(p, a), result) + else: + addAddrLoc(p.config, withTmpIfNeeded(p, a, needsTmp), result) elif p.module.compileToCpp and param.typ.kind in {tyVar} and n.kind == nkHiddenAddr: - initLocExprSingleUse(p, n[0], a) + # bug #23748: we need to introduce a temporary here. The expression type + # will be a reference in C++ and we cannot create a temporary reference + # variable. Thus, we create a temporary pointer variable instead. + let needsIndirect = mapType(p.config, n[0].typ, mapTypeChooser(n[0]) == skParam) != ctArray + if needsIndirect: + n.typ = n.typ.exactReplica + n.typ.flags.incl tfVarIsPtr + a = initLocExprSingleUse(p, n) + a = withTmpIfNeeded(p, a, needsTmp) + if needsIndirect: a.flags.incl lfIndirect # if the proc is 'importc'ed but not 'importcpp'ed then 'var T' still # means '*T'. See posix.nim for lots of examples that do that in the wild. let callee = call[0] if callee.kind == nkSym and {sfImportc, sfInfixCall, sfCompilerProc} * callee.sym.flags == {sfImportc} and - {lfHeader, lfNoDecl} * callee.sym.loc.flags != {}: - result = addrLoc(p.config, a) + {lfHeader, lfNoDecl} * callee.sym.loc.flags != {} and + needsIndirect: + addAddrLoc(p.config, a, result) else: - result = rdLoc(a) + addRdLoc(a, result) else: - initLocExprSingleUse(p, n, a) - result = rdLoc(withTmpIfNeeded(p, a, needsTmp)) + a = initLocExprSingleUse(p, n) + if param.typ.kind in {tyVar, tyPtr, tyRef, tySink}: + let typ = skipTypes(param.typ, abstractPtrs) + if not sameBackendTypePickyAliases(typ, n.typ.skipTypes(abstractPtrs)): + a.snippet = "(($1) ($2))" % + [getTypeDesc(p.module, param.typ), rdCharLoc(a)] + addRdLoc(withTmpIfNeeded(p, a, needsTmp), result) #assert result != nil -proc genArgNoParam(p: BProc, n: PNode, needsTmp = false): Rope = +proc genArgNoParam(p: BProc, n: PNode; result: var Rope; needsTmp = false) = var a: TLoc if n.kind == nkStringToCString: - result = genArgStringToCString(p, n, needsTmp) + genArgStringToCString(p, n, result, needsTmp) else: - initLocExprSingleUse(p, n, a) - result = rdLoc(withTmpIfNeeded(p, a, needsTmp)) + a = initLocExprSingleUse(p, n) + addRdLoc(withTmpIfNeeded(p, a, needsTmp), result) -from dfa import aliases, AliasKind +import aliasanalysis proc potentialAlias(n: PNode, potentialWrites: seq[PNode]): bool = + result = false for p in potentialWrites: if p.aliases(n) != no or n.aliases(p) != no: return true @@ -310,64 +381,86 @@ proc skipTrivialIndirections(n: PNode): PNode = result = n while true: case result.kind - of {nkDerefExpr, nkHiddenDeref, nkAddr, nkHiddenAddr, nkObjDownConv, nkObjUpConv}: + of nkDerefExpr, nkHiddenDeref, nkAddr, nkHiddenAddr, nkObjDownConv, nkObjUpConv: result = result[0] - of {nkHiddenStdConv, nkHiddenSubConv}: + of nkHiddenStdConv, nkHiddenSubConv: result = result[1] else: break -proc getPotentialWrites(n: PNode, mutate = false): seq[PNode] = +proc getPotentialWrites(n: PNode; mutate: bool; result: var seq[PNode]) = case n.kind: - of nkLiterals, nkIdent: discard + of nkLiterals, nkIdent, nkFormalParams: discard of nkSym: if mutate: result.add n - of nkAsgn, nkFastAsgn: - result.add getPotentialWrites(n[0], true) - result.add getPotentialWrites(n[1], mutate) + of nkAsgn, nkFastAsgn, nkSinkAsgn: + getPotentialWrites(n[0], true, result) + getPotentialWrites(n[1], mutate, result) of nkAddr, nkHiddenAddr: - result.add getPotentialWrites(n[0], true) - of nkCallKinds: #TODO: Find out why in f += 1, f is a nkSym and not a nkHiddenAddr - for s in n.sons: - result.add getPotentialWrites(s, true) + getPotentialWrites(n[0], true, result) + of nkBracketExpr, nkDotExpr, nkCheckedFieldExpr: + getPotentialWrites(n[0], mutate, result) + of nkCallKinds: + case n.getMagic: + of mIncl, mExcl, mInc, mDec, mAppendStrCh, mAppendStrStr, mAppendSeqElem, + mAddr, mNew, mNewFinalize, mWasMoved, mDestroy: + getPotentialWrites(n[1], true, result) + for i in 2..<n.len: + getPotentialWrites(n[i], mutate, result) + of mSwap: + for i in 1..<n.len: + getPotentialWrites(n[i], true, result) + else: + for i in 1..<n.len: + getPotentialWrites(n[i], mutate, result) else: - for s in n.sons: - result.add getPotentialWrites(s, mutate) + for s in n: + getPotentialWrites(s, mutate, result) -proc getPotentialReads(n: PNode): seq[PNode] = +proc getPotentialReads(n: PNode; result: var seq[PNode]) = case n.kind: - of nkLiterals, nkIdent: discard + of nkLiterals, nkIdent, nkFormalParams: discard of nkSym: result.add n else: - for s in n.sons: - result.add getPotentialReads(s) + for s in n: + getPotentialReads(s, result) -proc genParams(p: BProc, ri: PNode, typ: PType): Rope = +proc genParams(p: BProc, ri: PNode, typ: PType; result: var Rope) = # We must generate temporaries in cases like #14396 # to keep the strict Left-To-Right evaluation var needTmp = newSeq[bool](ri.len - 1) - var potentialWrites: seq[PNode] + var potentialWrites: seq[PNode] = @[] for i in countdown(ri.len - 1, 1): if ri[i].skipTrivialIndirections.kind == nkSym: needTmp[i - 1] = potentialAlias(ri[i], potentialWrites) else: - for n in getPotentialReads(ri[i]): + #if not ri[i].typ.isCompileTimeOnly: + var potentialReads: seq[PNode] = @[] + getPotentialReads(ri[i], potentialReads) + for n in potentialReads: if not needTmp[i - 1]: needTmp[i - 1] = potentialAlias(n, potentialWrites) - potentialWrites.add getPotentialWrites(ri[i]) - if ri[i].kind == nkHiddenAddr: - # Optimization: don't use a temp, if we would only take the adress anyway - needTmp[i - 1] = false - + getPotentialWrites(ri[i], false, potentialWrites) + when false: + # this optimization is wrong, see bug #23748 + if ri[i].kind in {nkHiddenAddr, nkAddr}: + # Optimization: don't use a temp, if we would only take the address anyway + needTmp[i - 1] = false + + var oldLen = result.len for i in 1..<ri.len: - if i < typ.len: + if i < typ.n.len: assert(typ.n[i].kind == nkSym) let paramType = typ.n[i] if not paramType.typ.isCompileTimeOnly: - if result != nil: result.add(~", ") - result.add(genArg(p, ri[i], paramType.sym, ri, needTmp[i-1])) + if oldLen != result.len: + result.add(", ") + oldLen = result.len + genArg(p, ri[i], paramType.sym, ri, result, needTmp[i-1]) else: - if result != nil: result.add(~", ") - result.add(genArgNoParam(p, ri[i], needTmp[i-1])) + if oldLen != result.len: + result.add(", ") + oldLen = result.len + genArgNoParam(p, ri[i], result, needTmp[i-1]) proc addActualSuffixForHCR(res: var Rope, module: PSym, sym: PSym) = if sym.flags * {sfImportc, sfNonReloadable} == {} and sym.loc.k == locProc and @@ -375,15 +468,14 @@ proc addActualSuffixForHCR(res: var Rope, module: PSym, sym: PSym) = res = res & "_actual".rope proc genPrefixCall(p: BProc, le, ri: PNode, d: var TLoc) = - var op: TLoc # this is a hotspot in the compiler - initLocExpr(p, ri[0], op) + var op = initLocExpr(p, ri[0]) # getUniqueType() is too expensive here: var typ = skipTypes(ri[0].typ, abstractInstOwned) assert(typ.kind == tyProc) - assert(typ.len == typ.n.len) - var params = genParams(p, ri, typ) + var params = newRopeAppender() + genParams(p, ri, typ, params) var callee = rdLoc(op) if p.hcrOn and ri[0].kind == nkSym: @@ -393,20 +485,19 @@ proc genPrefixCall(p: BProc, le, ri: PNode, d: var TLoc) = proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = proc addComma(r: Rope): Rope = - if r == nil: r else: r & ~", " + if r.len == 0: r else: r & ", " const PatProc = "$1.ClE_0? $1.ClP_0($3$1.ClE_0):(($4)($1.ClP_0))($2)" const PatIter = "$1.ClP_0($3$1.ClE_0)" # we know the env exists - var op: TLoc - initLocExpr(p, ri[0], op) + var op = initLocExpr(p, ri[0]) # getUniqueType() is too expensive here: var typ = skipTypes(ri[0].typ, abstractInstOwned) assert(typ.kind == tyProc) - assert(typ.len == typ.n.len) - var pl = genParams(p, ri, typ) + var pl = newRopeAppender() + genParams(p, ri, typ, pl) template genCallPattern {.dirty.} = if tfIterator in typ.flags: @@ -416,47 +507,44 @@ proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = let rawProc = getClosureType(p.module, typ, clHalf) let canRaise = p.config.exc == excGoto and canRaiseDisp(p, ri[0]) - if typ[0] != nil: - if isInvalidReturnType(p.config, typ[0]): - if ri.len > 1: pl.add(~", ") + if typ.returnType != nil: + if isInvalidReturnType(p.config, typ): + if ri.len > 1: pl.add(", ") # beware of 'result = p(result)'. We may need to allocate a temporary: - if d.k in {locTemp, locNone} or not preventNrvo(p, le, ri): + if d.k in {locTemp, locNone} or not preventNrvo(p, d.lode, le, ri): # Great, we can use 'd': if d.k == locNone: - getTemp(p, typ[0], d, needsInit=true) + d = getTemp(p, typ.returnType, needsInit=true) elif d.k notin {locTemp} and not hasNoInit(ri): # reset before pass as 'result' var: discard "resetLoc(p, d)" pl.add(addrLoc(p.config, d)) genCallPattern() + if canRaise: raiseExit(p) else: - var tmp: TLoc - getTemp(p, typ[0], tmp, needsInit=true) + var tmp: TLoc = getTemp(p, typ.returnType, needsInit=true) pl.add(addrLoc(p.config, tmp)) genCallPattern() if canRaise: raiseExit(p) genAssignment(p, d, tmp, {}) # no need for deep copying elif isHarmlessStore(p, canRaise, d): - if d.k == locNone: getTemp(p, typ[0], d) + if d.k == locNone: d = getTemp(p, typ.returnType) assert(d.t != nil) # generate an assignment to d: - var list: TLoc - initLoc(list, locCall, d.lode, OnUnknown) + var list: TLoc = initLoc(locCall, d.lode, OnUnknown) if tfIterator in typ.flags: - list.r = PatIter % [rdLoc(op), pl, pl.addComma, rawProc] + list.snippet = PatIter % [rdLoc(op), pl, pl.addComma, rawProc] else: - list.r = PatProc % [rdLoc(op), pl, pl.addComma, rawProc] + list.snippet = PatProc % [rdLoc(op), pl, pl.addComma, rawProc] genAssignment(p, d, list, {}) # no need for deep copying if canRaise: raiseExit(p) else: - var tmp: TLoc - getTemp(p, typ[0], tmp) + var tmp: TLoc = getTemp(p, typ.returnType) assert(d.t != nil) # generate an assignment to d: - var list: TLoc - initLoc(list, locCall, d.lode, OnUnknown) + var list: TLoc = initLoc(locCall, d.lode, OnUnknown) if tfIterator in typ.flags: - list.r = PatIter % [rdLoc(op), pl, pl.addComma, rawProc] + list.snippet = PatIter % [rdLoc(op), pl, pl.addComma, rawProc] else: - list.r = PatProc % [rdLoc(op), pl, pl.addComma, rawProc] + list.snippet = PatProc % [rdLoc(op), pl, pl.addComma, rawProc] genAssignment(p, tmp, list, {}) if canRaise: raiseExit(p) genAssignment(p, d, tmp, {}) @@ -464,24 +552,30 @@ proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = genCallPattern() if canRaise: raiseExit(p) -proc genOtherArg(p: BProc; ri: PNode; i: int; typ: PType): Rope = - if i < typ.len: +proc genOtherArg(p: BProc; ri: PNode; i: int; typ: PType; result: var Rope; + argsCounter: var int) = + if i < typ.n.len: # 'var T' is 'T&' in C++. This means we ignore the request of # any nkHiddenAddr when it's a 'var T'. let paramType = typ.n[i] assert(paramType.kind == nkSym) if paramType.typ.isCompileTimeOnly: - result = nil - elif typ[i].kind in {tyVar} and ri[i].kind == nkHiddenAddr: - result = genArgNoParam(p, ri[i][0]) + discard + elif paramType.typ.kind in {tyVar} and ri[i].kind == nkHiddenAddr: + if argsCounter > 0: result.add ", " + genArgNoParam(p, ri[i][0], result) + inc argsCounter else: - result = genArgNoParam(p, ri[i]) #, typ.n[i].sym) + if argsCounter > 0: result.add ", " + genArgNoParam(p, ri[i], result) #, typ.n[i].sym) + inc argsCounter else: if tfVarargs notin typ.flags: localError(p.config, ri.info, "wrong argument count") - result = nil else: - result = genArgNoParam(p, ri[i]) + if argsCounter > 0: result.add ", " + genArgNoParam(p, ri[i], result) + inc argsCounter discard """ Dot call syntax in C++ @@ -538,11 +632,11 @@ proc skipAddrDeref(node: PNode): PNode = else: result = node -proc genThisArg(p: BProc; ri: PNode; i: int; typ: PType): Rope = +proc genThisArg(p: BProc; ri: PNode; i: int; typ: PType; result: var Rope) = # for better or worse c2nim translates the 'this' argument to a 'var T'. # However manual wrappers may also use 'ptr T'. In any case we support both # for convenience. - internalAssert p.config, i < typ.len + internalAssert p.config, i < typ.n.len assert(typ.n[i].kind == nkSym) # if the parameter is lying (tyVar) and thus we required an additional deref, # skip the deref: @@ -552,75 +646,72 @@ proc genThisArg(p: BProc; ri: PNode; i: int; typ: PType): Rope = if t.kind in {tyVar}: let x = if ri.kind == nkHiddenAddr: ri[0] else: ri if x.typ.kind == tyPtr: - result = genArgNoParam(p, x) + genArgNoParam(p, x, result) result.add("->") elif x.kind in {nkHiddenDeref, nkDerefExpr} and x[0].typ.kind == tyPtr: - result = genArgNoParam(p, x[0]) + genArgNoParam(p, x[0], result) result.add("->") else: - result = genArgNoParam(p, x) + genArgNoParam(p, x, result) result.add(".") elif t.kind == tyPtr: if ri.kind in {nkAddr, nkHiddenAddr}: - result = genArgNoParam(p, ri[0]) + genArgNoParam(p, ri[0], result) result.add(".") else: - result = genArgNoParam(p, ri) + genArgNoParam(p, ri, result) result.add("->") else: ri = skipAddrDeref(ri) if ri.kind in {nkAddr, nkHiddenAddr}: ri = ri[0] - result = genArgNoParam(p, ri) #, typ.n[i].sym) + genArgNoParam(p, ri, result) #, typ.n[i].sym) result.add(".") -proc genPatternCall(p: BProc; ri: PNode; pat: string; typ: PType): Rope = +proc genPatternCall(p: BProc; ri: PNode; pat: string; typ: PType; result: var Rope) = var i = 0 var j = 1 while i < pat.len: case pat[i] of '@': - var first = true + var argsCounter = 0 for k in j..<ri.len: - let arg = genOtherArg(p, ri, k, typ) - if arg.len > 0: - if not first: - result.add(~", ") - first = false - result.add arg + genOtherArg(p, ri, k, typ, result, argsCounter) inc i of '#': if i+1 < pat.len and pat[i+1] in {'+', '@'}: let ri = ri[j] if ri.kind in nkCallKinds: let typ = skipTypes(ri[0].typ, abstractInst) - if pat[i+1] == '+': result.add genArgNoParam(p, ri[0]) - result.add(~"(") + if pat[i+1] == '+': genArgNoParam(p, ri[0], result) + result.add("(") if 1 < ri.len: - result.add genOtherArg(p, ri, 1, typ) + var argsCounterB = 0 + genOtherArg(p, ri, 1, typ, result, argsCounterB) for k in j+1..<ri.len: - result.add(~", ") - result.add genOtherArg(p, ri, k, typ) - result.add(~")") + var argsCounterB = 0 + genOtherArg(p, ri, k, typ, result, argsCounterB) + result.add(")") else: localError(p.config, ri.info, "call expression expected for C++ pattern") inc i elif i+1 < pat.len and pat[i+1] == '.': - result.add genThisArg(p, ri, j, typ) + genThisArg(p, ri, j, typ, result) inc i elif i+1 < pat.len and pat[i+1] == '[': var arg = ri[j].skipAddrDeref while arg.kind in {nkAddr, nkHiddenAddr, nkObjDownConv}: arg = arg[0] - result.add genArgNoParam(p, arg) + genArgNoParam(p, arg, result) #result.add debugTree(arg, 0, 10) else: - result.add genOtherArg(p, ri, j, typ) + var argsCounter = 0 + genOtherArg(p, ri, j, typ, result, argsCounter) inc j inc i of '\'': - var idx, stars: int + var idx, stars: int = 0 if scanCppGenericSlot(pat, i, idx, stars): var t = resolveStarsInCppType(typ, idx, stars) - if t == nil: result.add(~"void") + if t == nil: result.add("void") else: result.add(getTypeDesc(p.module, t)) else: let start = i @@ -631,117 +722,108 @@ proc genPatternCall(p: BProc; ri: PNode; pat: string; typ: PType): Rope = result.add(substr(pat, start, i - 1)) proc genInfixCall(p: BProc, le, ri: PNode, d: var TLoc) = - var op: TLoc - initLocExpr(p, ri[0], op) + var op = initLocExpr(p, ri[0]) # getUniqueType() is too expensive here: var typ = skipTypes(ri[0].typ, abstractInst) assert(typ.kind == tyProc) - assert(typ.len == typ.n.len) # don't call '$' here for efficiency: - let pat = ri[0].sym.loc.r.data + let pat = $ri[0].sym.loc.snippet internalAssert p.config, pat.len > 0 if pat.contains({'#', '(', '@', '\''}): - var pl = genPatternCall(p, ri, pat, typ) + var pl = newRopeAppender() + genPatternCall(p, ri, pat, typ, pl) # simpler version of 'fixupCall' that works with the pl+params combination: var typ = skipTypes(ri[0].typ, abstractInst) - if typ[0] != nil: + if typ.returnType != nil: if p.module.compileToCpp and lfSingleUse in d.flags: # do not generate spurious temporaries for C++! For C we're better off # with them to prevent undefined behaviour and because the codegen # is free to emit expressions multiple times! d.k = locCall - d.r = pl + d.snippet = pl excl d.flags, lfSingleUse else: - if d.k == locNone: getTemp(p, typ[0], d) + if d.k == locNone: d = getTemp(p, typ.returnType) assert(d.t != nil) # generate an assignment to d: - var list: TLoc - initLoc(list, locCall, d.lode, OnUnknown) - list.r = pl + var list: TLoc = initLoc(locCall, d.lode, OnUnknown) + list.snippet = pl genAssignment(p, d, list, {}) # no need for deep copying else: - pl.add(~";$n") + pl.add(";\n") line(p, cpsStmts, pl) else: - var pl: Rope = nil - #var param = typ.n[1].sym + var pl = newRopeAppender() + var argsCounter = 0 if 1 < ri.len: - pl.add(genThisArg(p, ri, 1, typ)) - pl.add(op.r) - var params: Rope + genThisArg(p, ri, 1, typ, pl) + pl.add(op.snippet) + var params = newRopeAppender() for i in 2..<ri.len: - if params != nil: params.add(~", ") - assert(typ.len == typ.n.len) - params.add(genOtherArg(p, ri, i, typ)) + genOtherArg(p, ri, i, typ, params, argsCounter) fixupCall(p, le, ri, d, pl, params) proc genNamedParamCall(p: BProc, ri: PNode, d: var TLoc) = # generates a crappy ObjC call - var op: TLoc - initLocExpr(p, ri[0], op) - var pl = ~"[" + var op = initLocExpr(p, ri[0]) + var pl = "[" # getUniqueType() is too expensive here: var typ = skipTypes(ri[0].typ, abstractInst) assert(typ.kind == tyProc) - assert(typ.len == typ.n.len) # don't call '$' here for efficiency: - let pat = ri[0].sym.loc.r.data + let pat = $ri[0].sym.loc.snippet internalAssert p.config, pat.len > 0 var start = 3 if ' ' in pat: start = 1 - pl.add(op.r) + pl.add(op.snippet) if ri.len > 1: - pl.add(~": ") - pl.add(genArg(p, ri[1], typ.n[1].sym, ri)) + pl.add(": ") + genArg(p, ri[1], typ.n[1].sym, ri, pl) start = 2 else: if ri.len > 1: - pl.add(genArg(p, ri[1], typ.n[1].sym, ri)) - pl.add(~" ") - pl.add(op.r) + genArg(p, ri[1], typ.n[1].sym, ri, pl) + pl.add(" ") + pl.add(op.snippet) if ri.len > 2: - pl.add(~": ") - pl.add(genArg(p, ri[2], typ.n[2].sym, ri)) + pl.add(": ") + genArg(p, ri[2], typ.n[2].sym, ri, pl) for i in start..<ri.len: - assert(typ.len == typ.n.len) - if i >= typ.len: + if i >= typ.n.len: internalError(p.config, ri.info, "varargs for objective C method?") assert(typ.n[i].kind == nkSym) var param = typ.n[i].sym - pl.add(~" ") + pl.add(" ") pl.add(param.name.s) - pl.add(~": ") - pl.add(genArg(p, ri[i], param, ri)) - if typ[0] != nil: - if isInvalidReturnType(p.config, typ[0]): - if ri.len > 1: pl.add(~" ") + pl.add(": ") + genArg(p, ri[i], param, ri, pl) + if typ.returnType != nil: + if isInvalidReturnType(p.config, typ): + if ri.len > 1: pl.add(" ") # beware of 'result = p(result)'. We always allocate a temporary: if d.k in {locTemp, locNone}: # We already got a temp. Great, special case it: - if d.k == locNone: getTemp(p, typ[0], d, needsInit=true) - pl.add(~"Result: ") + if d.k == locNone: d = getTemp(p, typ.returnType, needsInit=true) + pl.add("Result: ") pl.add(addrLoc(p.config, d)) - pl.add(~"];$n") + pl.add("];\n") line(p, cpsStmts, pl) else: - var tmp: TLoc - getTemp(p, typ[0], tmp, needsInit=true) + var tmp: TLoc = getTemp(p, typ.returnType, needsInit=true) pl.add(addrLoc(p.config, tmp)) - pl.add(~"];$n") + pl.add("];\n") line(p, cpsStmts, pl) genAssignment(p, d, tmp, {}) # no need for deep copying else: - pl.add(~"]") - if d.k == locNone: getTemp(p, typ[0], d) + pl.add("]") + if d.k == locNone: d = getTemp(p, typ.returnType) assert(d.t != nil) # generate an assignment to d: - var list: TLoc - initLoc(list, locCall, ri, OnUnknown) - list.r = pl + var list: TLoc = initLoc(locCall, ri, OnUnknown) + list.snippet = pl genAssignment(p, d, list, {}) # no need for deep copying else: - pl.add(~"];$n") + pl.add("];\n") line(p, cpsStmts, pl) proc notYetAlive(n: PNode): bool {.inline.} = @@ -779,6 +861,5 @@ proc genAsgnCall(p: BProc, le, ri: PNode, d: var TLoc) = genNamedParamCall(p, ri, d) else: genPrefixCall(p, le, ri, d) - postStmtActions(p) proc genCall(p: BProc, e: PNode, d: var TLoc) = genAsgnCall(p, nil, e, d) diff --git a/compiler/ccgexprs.nim b/compiler/ccgexprs.nim index ea09b3400..545d43ae8 100644 --- a/compiler/ccgexprs.nim +++ b/compiler/ccgexprs.nim @@ -9,7 +9,7 @@ # included from cgen.nim -when defined(nimCompilerStackraceHints): +when defined(nimCompilerStacktraceHints): import std/stackframes proc getNullValueAuxT(p: BProc; orig, t: PType; obj, constOrNil: PNode, @@ -18,29 +18,31 @@ proc getNullValueAuxT(p: BProc; orig, t: PType; obj, constOrNil: PNode, # -------------------------- constant expressions ------------------------ -proc int64Literal(i: BiggestInt): Rope = +proc rdSetElemLoc(conf: ConfigRef; a: TLoc, typ: PType; result: var Rope) + +proc int64Literal(i: BiggestInt; result: var Rope) = if i > low(int64): - result = "IL64($1)" % [rope(i)] + result.add "IL64($1)" % [rope(i)] else: - result = ~"(IL64(-9223372036854775807) - IL64(1))" + result.add "(IL64(-9223372036854775807) - IL64(1))" -proc uint64Literal(i: uint64): Rope = rope($i & "ULL") +proc uint64Literal(i: uint64; result: var Rope) = result.add rope($i & "ULL") -proc intLiteral(i: BiggestInt): Rope = +proc intLiteral(i: BiggestInt; result: var Rope) = if i > low(int32) and i <= high(int32): - result = rope(i) + result.add rope(i) elif i == low(int32): # Nim has the same bug for the same reasons :-) - result = ~"(-2147483647 -1)" + result.add "(-2147483647 -1)" elif i > low(int64): - result = "IL64($1)" % [rope(i)] + result.add "IL64($1)" % [rope(i)] else: - result = ~"(IL64(-9223372036854775807) - IL64(1))" + result.add "(IL64(-9223372036854775807) - IL64(1))" -proc intLiteral(i: Int128): Rope = - intLiteral(toInt64(i)) +proc intLiteral(i: Int128; result: var Rope) = + intLiteral(toInt64(i), result) -proc genLiteral(p: BProc, n: PNode, ty: PType): Rope = +proc genLiteral(p: BProc, n: PNode, ty: PType; result: var Rope) = case n.kind of nkCharLit..nkUInt64Lit: var k: TTypeKind @@ -54,62 +56,63 @@ proc genLiteral(p: BProc, n: PNode, ty: PType): Rope = else: k = tyNil # don't go into the case variant that uses 'ty' case k of tyChar, tyNil: - result = intLiteral(n.intVal) + intLiteral(n.intVal, result) of tyBool: - if n.intVal != 0: result = ~"NIM_TRUE" - else: result = ~"NIM_FALSE" - of tyInt64: result = int64Literal(n.intVal) - of tyUInt64: result = uint64Literal(uint64(n.intVal)) - else: - result = "(($1) $2)" % [getTypeDesc(p.module, - ty), intLiteral(n.intVal)] + if n.intVal != 0: result.add "NIM_TRUE" + else: result.add "NIM_FALSE" + of tyInt64: int64Literal(n.intVal, result) + of tyUInt64: uint64Literal(uint64(n.intVal), result) + else: + result.add "((" + result.add getTypeDesc(p.module, ty) + result.add ")" + intLiteral(n.intVal, result) + result.add ")" of nkNilLit: let k = if ty == nil: tyPointer else: skipTypes(ty, abstractVarRange).kind if k == tyProc and skipTypes(ty, abstractVarRange).callConv == ccClosure: let id = nodeTableTestOrSet(p.module.dataCache, n, p.module.labels) - result = p.module.tmpBase & rope(id) + let tmpName = p.module.tmpBase & rope(id) if id == p.module.labels: # not found in cache: inc(p.module.labels) - p.module.s[cfsData].addf( + p.module.s[cfsStrData].addf( "static NIM_CONST $1 $2 = {NIM_NIL,NIM_NIL};$n", - [getTypeDesc(p.module, ty), result]) + [getTypeDesc(p.module, ty), tmpName]) + result.add tmpName elif k in {tyPointer, tyNil, tyProc}: - result = rope("NIM_NIL") + result.add rope("NIM_NIL") else: - result = "(($1) NIM_NIL)" % [getTypeDesc(p.module, ty)] + result.add "(($1) NIM_NIL)" % [getTypeDesc(p.module, ty)] of nkStrLit..nkTripleStrLit: let k = if ty == nil: tyString else: skipTypes(ty, abstractVarRange + {tyStatic, tyUserTypeClass, tyUserTypeClassInst}).kind case k of tyNil: - result = genNilStringLiteral(p.module, n.info) + genNilStringLiteral(p.module, n.info, result) of tyString: # with the new semantics for not 'nil' strings, we can map "" to nil and # save tons of allocations: if n.strVal.len == 0 and optSeqDestructors notin p.config.globalOptions: - result = genNilStringLiteral(p.module, n.info) + genNilStringLiteral(p.module, n.info, result) else: - result = genStringLiteral(p.module, n) + genStringLiteral(p.module, n, result) else: - result = makeCString(n.strVal) + result.add makeCString(n.strVal) of nkFloatLit, nkFloat64Lit: - result = rope(n.floatVal.toStrMaxPrecision) + if ty.kind == tyFloat32: + result.add rope(n.floatVal.float32.toStrMaxPrecision) + else: + result.add rope(n.floatVal.toStrMaxPrecision) of nkFloat32Lit: - result = rope(n.floatVal.toStrMaxPrecision("f")) + result.add rope(n.floatVal.float32.toStrMaxPrecision) else: internalError(p.config, n.info, "genLiteral(" & $n.kind & ')') - result = nil -proc genLiteral(p: BProc, n: PNode): Rope = - result = genLiteral(p, n, n.typ) +proc genLiteral(p: BProc, n: PNode; result: var Rope) = + genLiteral(p, n, n.typ, result) -proc bitSetToWord(s: TBitSet, size: int): BiggestUInt = - result = 0 - for j in 0..<size: - if j < s.len: result = result or (BiggestUInt(s[j]) shl (j * 8)) - -proc genRawSetData(cs: TBitSet, size: int): Rope = +proc genRawSetData(cs: TBitSet, size: int; result: var Rope) = if size > 8: var res = "{\n" for i in 0..<size: @@ -125,23 +128,26 @@ proc genRawSetData(cs: TBitSet, size: int): Rope = else: res.add "}\n" - result = rope(res) + result.add rope(res) else: - result = intLiteral(cast[BiggestInt](bitSetToWord(cs, size))) + intLiteral(cast[BiggestInt](bitSetToWord(cs, size)), result) -proc genSetNode(p: BProc, n: PNode): Rope = +proc genSetNode(p: BProc, n: PNode; result: var Rope) = var size = int(getSize(p.config, n.typ)) let cs = toBitSet(p.config, n) if size > 8: let id = nodeTableTestOrSet(p.module.dataCache, n, p.module.labels) - result = p.module.tmpBase & rope(id) + let tmpName = p.module.tmpBase & rope(id) if id == p.module.labels: # not found in cache: inc(p.module.labels) - p.module.s[cfsData].addf("static NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(p.module, n.typ), result, genRawSetData(cs, size)]) + p.module.s[cfsStrData].addf("static NIM_CONST $1 $2 = ", + [getTypeDesc(p.module, n.typ), tmpName]) + genRawSetData(cs, size, p.module.s[cfsStrData]) + p.module.s[cfsStrData].addf(";$n", []) + result.add tmpName else: - result = genRawSetData(cs, size) + genRawSetData(cs, size, result) proc getStorageLoc(n: PNode): TStorageLoc = ## deadcode @@ -162,7 +168,9 @@ proc getStorageLoc(n: PNode): TStorageLoc = of tyVar, tyLent: result = OnUnknown of tyPtr: result = OnStack of tyRef: result = OnHeap - else: doAssert(false, "getStorageLoc") + else: + result = OnUnknown + doAssert(false, "getStorageLoc") of nkBracketExpr, nkDotExpr, nkObjDownConv, nkObjUpConv: result = getStorageLoc(n[0]) else: result = OnUnknown @@ -204,16 +212,20 @@ proc asgnComplexity(n: PNode): int = # 'case objects' are too difficult to inline their assignment operation: result = 100 of nkRecList: + result = 0 for t in items(n): result += asgnComplexity(t) - else: discard + else: result = 0 + else: + result = 0 proc optAsgnLoc(a: TLoc, t: PType, field: Rope): TLoc = - assert field != nil - result.k = locField - result.storage = a.storage - result.lode = lodeTyp t - result.r = rdLoc(a) & "." & field + assert field != "" + result = TLoc(k: locField, + storage: a.storage, + lode: lodeTyp t, + snippet: rdLoc(a) & "." & field + ) proc genOptAsgnTuple(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = let newflags = @@ -224,8 +236,7 @@ proc genOptAsgnTuple(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = else: flags let t = skipTypes(dest.t, abstractInst).getUniqueType() - for i in 0..<t.len: - let t = t[i] + for i, t in t.ikids: let field = "Field$1" % [i.rope] genAssignment(p, optAsgnLoc(dest, t, field), optAsgnLoc(src, t, field), newflags) @@ -243,9 +254,9 @@ proc genOptAsgnObject(p: BProc, dest, src: TLoc, flags: TAssignmentFlags, case t.kind of nkSym: let field = t.sym - if field.loc.r == nil: fillObjectFields(p.module, typ) - genAssignment(p, optAsgnLoc(dest, field.typ, field.loc.r), - optAsgnLoc(src, field.typ, field.loc.r), newflags) + if field.loc.snippet == "": fillObjectFields(p.module, typ) + genAssignment(p, optAsgnLoc(dest, field.typ, field.loc.snippet), + optAsgnLoc(src, field.typ, field.loc.snippet), newflags) of nkRecList: for child in items(t): genOptAsgnObject(p, dest, src, newflags, child, typ) else: discard @@ -274,21 +285,28 @@ proc genGenericAsgn(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = linefmt(p, cpsStmts, "#genericAssign((void*)$1, (void*)$2, $3);$n", [addrLoc(p.config, dest), addrLoc(p.config, src), genTypeInfoV1(p.module, dest.t, dest.lode.info)]) -proc genOpenArrayConv(p: BProc; d: TLoc; a: TLoc) = +proc genOpenArrayConv(p: BProc; d: TLoc; a: TLoc; flags: TAssignmentFlags) = assert d.k != locNone # getTemp(p, d.t, d) case a.t.skipTypes(abstractVar).kind of tyOpenArray, tyVarargs: if reifiedOpenArray(a.lode): - linefmt(p, cpsStmts, "$1.Field0 = $2.Field0; $1.Field1 = $2.Field1;$n", - [rdLoc(d), a.rdLoc]) + if needTempForOpenArray in flags: + var tmp: TLoc = getTemp(p, a.t) + linefmt(p, cpsStmts, "$2 = $1; $n", + [a.rdLoc, tmp.rdLoc]) + linefmt(p, cpsStmts, "$1.Field0 = $2.Field0; $1.Field1 = $2.Field1;$n", + [rdLoc(d), tmp.rdLoc]) + else: + linefmt(p, cpsStmts, "$1.Field0 = $2.Field0; $1.Field1 = $2.Field1;$n", + [rdLoc(d), a.rdLoc]) else: linefmt(p, cpsStmts, "$1.Field0 = $2; $1.Field1 = $2Len_0;$n", [rdLoc(d), a.rdLoc]) of tySequence: - linefmt(p, cpsStmts, "$1.Field0 = $2$3; $1.Field1 = $4;$n", - [rdLoc(d), a.rdLoc, dataField(p), lenExpr(p, a)]) + linefmt(p, cpsStmts, "$1.Field0 = ($5) ? ($2$3) : NIM_NIL; $1.Field1 = $4;$n", + [rdLoc(d), a.rdLoc, dataField(p), lenExpr(p, a), dataFieldAccessor(p, a.rdLoc)]) of tyArray: linefmt(p, cpsStmts, "$1.Field0 = $2; $1.Field1 = $3;$n", [rdLoc(d), rdLoc(a), rope(lengthOrd(p.config, a.t))]) @@ -297,8 +315,8 @@ proc genOpenArrayConv(p: BProc; d: TLoc; a: TLoc) = if etyp.kind in {tyVar} and optSeqDestructors in p.config.globalOptions: linefmt(p, cpsStmts, "#nimPrepareStrMutationV2($1);$n", [byRefLoc(p, a)]) - linefmt(p, cpsStmts, "$1.Field0 = $2$3; $1.Field1 = $4;$n", - [rdLoc(d), a.rdLoc, dataField(p), lenExpr(p, a)]) + linefmt(p, cpsStmts, "$1.Field0 = ($5) ? ($2$3) : NIM_NIL; $1.Field1 = $4;$n", + [rdLoc(d), a.rdLoc, dataField(p), lenExpr(p, a), dataFieldAccessor(p, a.rdLoc)]) else: internalError(p.config, a.lode.info, "cannot handle " & $a.t.kind) @@ -325,15 +343,14 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = of tyString: if optSeqDestructors in p.config.globalOptions: genGenericAsgn(p, dest, src, flags) - elif (needToCopy notin flags and src.storage != OnStatic) or canMove(p, src.lode, dest): + elif ({needToCopy, needToCopySinkParam} * flags == {} and src.storage != OnStatic) or canMove(p, src.lode, dest): genRefAssign(p, dest, src) else: if (dest.storage == OnStack and p.config.selectedGC != gcGo) or not usesWriteBarrier(p.config): linefmt(p, cpsStmts, "$1 = #copyString($2);$n", [dest.rdLoc, src.rdLoc]) elif dest.storage == OnHeap: # we use a temporary to care for the dreaded self assignment: - var tmp: TLoc - getTemp(p, ty, tmp) + var tmp: TLoc = getTemp(p, ty) linefmt(p, cpsStmts, "$3 = $1; $1 = #copyStringRC1($2);$n", [dest.rdLoc, src.rdLoc, tmp.rdLoc]) linefmt(p, cpsStmts, "if ($1) #nimGCunrefNoCycle($1);$n", [tmp.rdLoc]) @@ -351,7 +368,7 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) of tyTuple: if containsGarbageCollectedRef(dest.t): - if dest.t.len <= 4: genOptAsgnTuple(p, dest, src, flags) + if dest.t.kidsLen <= 4: genOptAsgnTuple(p, dest, src, flags) else: genGenericAsgn(p, dest, src, flags) else: linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) @@ -362,7 +379,8 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = elif not isObjLackingTypeField(ty): genGenericAsgn(p, dest, src, flags) elif containsGarbageCollectedRef(ty): - if ty[0].isNil and asgnComplexity(ty.n) <= 4: + if ty[0].isNil and asgnComplexity(ty.n) <= 4 and + needAssignCall notin flags: # calls might contain side effects discard getTypeDesc(p.module, ty) internalAssert p.config, ty.n != nil genOptAsgnObject(p, dest, src, flags, ty.n, ty) @@ -371,7 +389,7 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = else: linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) of tyArray: - if containsGarbageCollectedRef(dest.t) and p.config.selectedGC notin {gcArc, gcOrc, gcHooks}: + if containsGarbageCollectedRef(dest.t) and p.config.selectedGC notin {gcArc, gcAtomicArc, gcOrc, gcHooks}: genGenericAsgn(p, dest, src, flags) else: linefmt(p, cpsStmts, @@ -381,7 +399,7 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = # open arrays are always on the stack - really? What if a sequence is # passed to an open array? if reifiedOpenArray(dest.lode): - genOpenArrayConv(p, dest, src) + genOpenArrayConv(p, dest, src, flags) elif containsGarbageCollectedRef(dest.t): linefmt(p, cpsStmts, # XXX: is this correct for arrays? "#genericAssignOpenArray((void*)$1, (void*)$2, $1Len_0, $3);$n", @@ -390,7 +408,7 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = else: linefmt(p, cpsStmts, # bug #4799, keep the nimCopyMem for a while - #"#nimCopyMem((void*)$1, (NIM_CONST void*)$2, sizeof($1[0])*$1Len_0);$n", + #"#nimCopyMem((void*)$1, (NIM_CONST void*)$2, sizeof($1[0])*$1Len_0);\n", "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) of tySet: @@ -399,7 +417,7 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = [rdLoc(dest), rdLoc(src), getSize(p.config, dest.t)]) else: linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) - of tyPtr, tyPointer, tyChar, tyBool, tyEnum, tyCString, + of tyPtr, tyPointer, tyChar, tyBool, tyEnum, tyCstring, tyInt..tyUInt64, tyRange, tyVar, tyLent, tyNil: linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) else: internalError(p.config, "genAssignment: " & $ty.kind) @@ -415,8 +433,7 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = proc genDeepCopy(p: BProc; dest, src: TLoc) = template addrLocOrTemp(a: TLoc): Rope = if a.k == locExpr: - var tmp: TLoc - getTemp(p, a.t, tmp) + var tmp: TLoc = getTemp(p, a.t) genAssignment(p, tmp, a, {}) addrLoc(p.config, tmp) else: @@ -439,9 +456,10 @@ proc genDeepCopy(p: BProc; dest, src: TLoc) = [addrLoc(p.config, dest), rdLoc(src), genTypeInfoV1(p.module, dest.t, dest.lode.info)]) of tyOpenArray, tyVarargs: + let source = addrLocOrTemp(src) linefmt(p, cpsStmts, - "#genericDeepCopyOpenArray((void*)$1, (void*)$2, $1Len_0, $3);$n", - [addrLoc(p.config, dest), addrLocOrTemp(src), + "#genericDeepCopyOpenArray((void*)$1, (void*)$2, $2->Field1, $3);$n", + [addrLoc(p.config, dest), source, genTypeInfoV1(p.module, dest.t, dest.lode.info)]) of tySet: if mapSetType(p.config, ty) == ctArray: @@ -449,7 +467,7 @@ proc genDeepCopy(p: BProc; dest, src: TLoc) = [rdLoc(dest), rdLoc(src), getSize(p.config, dest.t)]) else: linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) - of tyPointer, tyChar, tyBool, tyEnum, tyCString, + of tyPointer, tyChar, tyBool, tyEnum, tyCstring, tyInt..tyUInt64, tyRange, tyVar, tyLent: linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) else: internalError(p.config, "genDeepCopy: " & $ty.kind) @@ -462,11 +480,10 @@ proc putLocIntoDest(p: BProc, d: var TLoc, s: TLoc) = d = s # ``d`` is free, so fill it with ``s`` proc putDataIntoDest(p: BProc, d: var TLoc, n: PNode, r: Rope) = - var a: TLoc if d.k != locNone: + var a: TLoc = initLoc(locData, n, OnStatic) # need to generate an assignment here - initLoc(a, locData, n, OnStatic) - a.r = r + a.snippet = r if lfNoDeepCopy in d.flags: genAssignment(p, d, a, {}) else: genAssignment(p, d, a, {needToCopy}) else: @@ -474,14 +491,13 @@ proc putDataIntoDest(p: BProc, d: var TLoc, n: PNode, r: Rope) = # the flags field! d.k = locData d.lode = n - d.r = r + d.snippet = r proc putIntoDest(p: BProc, d: var TLoc, n: PNode, r: Rope; s=OnUnknown) = - var a: TLoc if d.k != locNone: # need to generate an assignment here - initLoc(a, locExpr, n, s) - a.r = r + var a: TLoc = initLoc(locExpr, n, s) + a.snippet = r if lfNoDeepCopy in d.flags: genAssignment(p, d, a, {}) else: genAssignment(p, d, a, {needToCopy}) else: @@ -489,52 +505,45 @@ proc putIntoDest(p: BProc, d: var TLoc, n: PNode, r: Rope; s=OnUnknown) = # the flags field! d.k = locExpr d.lode = n - d.r = r + d.snippet = r proc binaryStmt(p: BProc, e: PNode, d: var TLoc, op: string) = - var a, b: TLoc if d.k != locNone: internalError(p.config, e.info, "binaryStmt") - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) lineCg(p, cpsStmts, "$1 $2 $3;$n", [rdLoc(a), op, rdLoc(b)]) proc binaryStmtAddr(p: BProc, e: PNode, d: var TLoc, cpname: string) = - var a, b: TLoc if d.k != locNone: internalError(p.config, e.info, "binaryStmtAddr") - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) lineCg(p, cpsStmts, "#$1($2, $3);$n", [cpname, byRefLoc(p, a), rdLoc(b)]) template unaryStmt(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a: TLoc if d.k != locNone: internalError(p.config, e.info, "unaryStmt") - initLocExpr(p, e[1], a) + var a: TLoc = initLocExpr(p, e[1]) lineCg(p, cpsStmts, frmt, [rdLoc(a)]) template binaryExpr(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a, b: TLoc assert(e[1].typ != nil) assert(e[2].typ != nil) - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) putIntoDest(p, d, e, ropecg(p.module, frmt, [rdLoc(a), rdLoc(b)])) template binaryExprChar(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a, b: TLoc assert(e[1].typ != nil) assert(e[2].typ != nil) - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) putIntoDest(p, d, e, ropecg(p.module, frmt, [a.rdCharLoc, b.rdCharLoc])) template unaryExpr(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a: TLoc - initLocExpr(p, e[1], a) + var a: TLoc = initLocExpr(p, e[1]) putIntoDest(p, d, e, ropecg(p.module, frmt, [rdLoc(a)])) template unaryExprChar(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a: TLoc - initLocExpr(p, e[1], a) + var a: TLoc = initLocExpr(p, e[1]) putIntoDest(p, d, e, ropecg(p.module, frmt, [rdCharLoc(a)])) template binaryArithOverflowRaw(p: BProc, t: PType, a, b: TLoc; @@ -544,12 +553,21 @@ template binaryArithOverflowRaw(p: BProc, t: PType, a, b: TLoc; else: getTypeDesc(p.module, t) var result = getTempName(p.module) linefmt(p, cpsLocals, "$1 $2;$n", [storage, result]) - lineCg(p, cpsStmts, "if (#$2($3, $4, &$1)) { #raiseOverflow(); $5};$n", - [result, cpname, rdCharLoc(a), rdCharLoc(b), raiseInstr(p)]) + lineCg(p, cpsStmts, "if (#$2($3, $4, &$1)) { #raiseOverflow(); ", + [result, cpname, rdCharLoc(a), rdCharLoc(b)]) + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "};$n", [] + if size < p.config.target.intSize or t.kind in {tyRange, tyEnum}: - linefmt(p, cpsStmts, "if ($1 < $2 || $1 > $3){ #raiseOverflow(); $4}$n", - [result, intLiteral(firstOrd(p.config, t)), intLiteral(lastOrd(p.config, t)), - raiseInstr(p)]) + var first = newRopeAppender() + intLiteral(firstOrd(p.config, t), first) + var last = newRopeAppender() + intLiteral(lastOrd(p.config, t), last) + linefmt(p, cpsStmts, "if ($1 < $2 || $1 > $3){ #raiseOverflow(); ", + [result, first, last]) + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] + result proc binaryArithOverflow(p: BProc, e: PNode, d: var TLoc, m: TMagic) = @@ -565,38 +583,51 @@ proc binaryArithOverflow(p: BProc, e: PNode, d: var TLoc, m: TMagic) = "nimAddInt64", "nimSubInt64" ] opr: array[mAddI..mPred, string] = ["+", "-", "*", "/", "%", "+", "-"] - var a, b: TLoc assert(e[1].typ != nil) assert(e[2].typ != nil) - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) # skipping 'range' is correct here as we'll generate a proper range check # later via 'chckRange' let t = e.typ.skipTypes(abstractRange) - if optOverflowCheck notin p.options: + if optOverflowCheck notin p.options or (m in {mSucc, mPred} and t.kind in {tyUInt..tyUInt64}): let res = "($1)($2 $3 $4)" % [getTypeDesc(p.module, e.typ), rdLoc(a), rope(opr[m]), rdLoc(b)] putIntoDest(p, d, e, res) else: # we handle div by zero here so that we know that the compilerproc's # result is only for overflows. + var needsOverflowCheck = true if m in {mDivI, mModI}: - linefmt(p, cpsStmts, "if ($1 == 0){ #raiseDivByZero(); $2}$n", - [rdLoc(b), raiseInstr(p)]) - - let res = binaryArithOverflowRaw(p, t, a, b, - if t.kind == tyInt64: prc64[m] else: prc[m]) - putIntoDest(p, d, e, "($#)($#)" % [getTypeDesc(p.module, e.typ), res]) + var canBeZero = true + if e[2].kind in {nkIntLit..nkUInt64Lit}: + canBeZero = e[2].intVal == 0 + if e[2].kind in {nkIntLit..nkInt64Lit}: + needsOverflowCheck = e[2].intVal == -1 + if canBeZero: + linefmt(p, cpsStmts, "if ($1 == 0){ #raiseDivByZero(); ", [rdLoc(b)]) + raiseInstr(p, p.s(cpsStmts)) + linefmt(p, cpsStmts, "}$n", []) + if needsOverflowCheck: + let res = binaryArithOverflowRaw(p, t, a, b, + if t.kind == tyInt64: prc64[m] else: prc[m]) + putIntoDest(p, d, e, "($#)($#)" % [getTypeDesc(p.module, e.typ), res]) + else: + let res = "($1)(($2) $3 ($4))" % [getTypeDesc(p.module, e.typ), rdLoc(a), rope(opr[m]), rdLoc(b)] + putIntoDest(p, d, e, res) proc unaryArithOverflow(p: BProc, e: PNode, d: var TLoc, m: TMagic) = - var - a: TLoc - t: PType + var t: PType assert(e[1].typ != nil) - initLocExpr(p, e[1], a) + var a: TLoc = initLocExpr(p, e[1]) t = skipTypes(e.typ, abstractRange) if optOverflowCheck in p.options: - linefmt(p, cpsStmts, "if ($1 == $2){ #raiseOverflow(); $3}$n", - [rdLoc(a), intLiteral(firstOrd(p.config, t)), raiseInstr(p)]) + var first = newRopeAppender() + intLiteral(firstOrd(p.config, t), first) + linefmt(p, cpsStmts, "if ($1 == $2){ #raiseOverflow(); ", + [rdLoc(a), first]) + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] + case m of mUnaryMinusI: putIntoDest(p, d, e, "((NI$2)-($1))" % [rdLoc(a), rope(getSize(p.config, t) * 8)]) @@ -609,12 +640,11 @@ proc unaryArithOverflow(p: BProc, e: PNode, d: var TLoc, m: TMagic) = proc binaryArith(p: BProc, e: PNode, d: var TLoc, op: TMagic) = var - a, b: TLoc - s, k: BiggestInt + s, k: BiggestInt = 0 assert(e[1].typ != nil) assert(e[2].typ != nil) - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) # BUGFIX: cannot use result-type here, as it may be a boolean s = max(getSize(p.config, a.t), getSize(p.config, b.t)) * 8 k = getSize(p.config, a.t) * 8 @@ -668,11 +698,10 @@ proc binaryArith(p: BProc, e: PNode, d: var TLoc, op: TMagic) = assert(false, $op) proc genEqProc(p: BProc, e: PNode, d: var TLoc) = - var a, b: TLoc assert(e[1].typ != nil) assert(e[2].typ != nil) - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) if a.t.skipTypes(abstractInstOwned).callConv == ccClosure: putIntoDest(p, d, e, "($1.ClP_0 == $2.ClP_0 && $1.ClE_0 == $2.ClE_0)" % [rdLoc(a), rdLoc(b)]) @@ -688,10 +717,9 @@ proc genIsNil(p: BProc, e: PNode, d: var TLoc) = proc unaryArith(p: BProc, e: PNode, d: var TLoc, op: TMagic) = var - a: TLoc t: PType assert(e[1].typ != nil) - initLocExpr(p, e[1], a) + var a = initLocExpr(p, e[1]) t = skipTypes(e.typ, abstractRange) template applyFormat(frmt: untyped) = @@ -717,7 +745,7 @@ proc isCppRef(p: BProc; typ: PType): bool {.inline.} = tfVarIsPtr notin skipTypes(typ, abstractInstOwned).flags proc genDeref(p: BProc, e: PNode, d: var TLoc) = - let mt = mapType(p.config, e[0].typ, mapTypeChooser(e[0])) + let mt = mapType(p.config, e[0].typ, mapTypeChooser(e[0]) == skParam) if mt in {ctArray, ctPtrToArray} and lfEnforceDeref notin d.flags: # XXX the amount of hacks for C's arrays is incredible, maybe we should # simply wrap them in a struct? --> Losing auto vectorization then? @@ -728,13 +756,13 @@ proc genDeref(p: BProc, e: PNode, d: var TLoc) = var a: TLoc var typ = e[0].typ if typ.kind in {tyUserTypeClass, tyUserTypeClassInst} and typ.isResolvedUserTypeClass: - typ = typ.lastSon + typ = typ.last typ = typ.skipTypes(abstractInstOwned) if typ.kind in {tyVar} and tfVarIsPtr notin typ.flags and p.module.compileToCpp and e[0].kind == nkHiddenAddr: - initLocExprSingleUse(p, e[0][0], d) + d = initLocExprSingleUse(p, e[0][0]) return else: - initLocExprSingleUse(p, e[0], a) + a = initLocExprSingleUse(p, e[0]) if d.k == locNone: # dest = *a; <-- We do not know that 'dest' is on the heap! # It is completely wrong to set 'd.storage' here, unless it's not yet @@ -771,8 +799,7 @@ proc cowBracket(p: BProc; n: PNode) = if n.kind == nkBracketExpr and optSeqDestructors in p.config.globalOptions: let strCandidate = n[0] if strCandidate.typ.skipTypes(abstractInst).kind == tyString: - var a: TLoc - initLocExpr(p, strCandidate, a) + var a: TLoc = initLocExpr(p, strCandidate) linefmt(p, cpsStmts, "#nimPrepareStrMutationV2($1);$n", [byRefLoc(p, a)]) proc cow(p: BProc; n: PNode) {.inline.} = @@ -781,31 +808,30 @@ proc cow(p: BProc; n: PNode) {.inline.} = proc genAddr(p: BProc, e: PNode, d: var TLoc) = # careful 'addr(myptrToArray)' needs to get the ampersand: if e[0].typ.skipTypes(abstractInstOwned).kind in {tyRef, tyPtr}: - var a: TLoc - initLocExpr(p, e[0], a) - putIntoDest(p, d, e, "&" & a.r, a.storage) + var a: TLoc = initLocExpr(p, e[0]) + putIntoDest(p, d, e, "&" & a.snippet, a.storage) #Message(e.info, warnUser, "HERE NEW &") - elif mapType(p.config, e[0].typ, mapTypeChooser(e[0])) == ctArray or isCppRef(p, e.typ): + elif mapType(p.config, e[0].typ, mapTypeChooser(e[0]) == skParam) == ctArray or isCppRef(p, e.typ): expr(p, e[0], d) + # bug #19497 + d.lode = e else: - var a: TLoc - initLocExpr(p, e[0], a) + var a: TLoc = initLocExpr(p, e[0]) putIntoDest(p, d, e, addrLoc(p.config, a), a.storage) template inheritLocation(d: var TLoc, a: TLoc) = if d.k == locNone: d.storage = a.storage -proc genRecordFieldAux(p: BProc, e: PNode, d, a: var TLoc) = - initLocExpr(p, e[0], a) +proc genRecordFieldAux(p: BProc, e: PNode, d: var TLoc, a: var TLoc) = + a = initLocExpr(p, e[0]) if e[1].kind != nkSym: internalError(p.config, e.info, "genRecordFieldAux") d.inheritLocation(a) discard getTypeDesc(p.module, a.t) # fill the record's fields.loc proc genTupleElem(p: BProc, e: PNode, d: var TLoc) = var - a: TLoc - i: int - initLocExpr(p, e[0], a) + i: int = 0 + var a: TLoc = initLocExpr(p, e[0]) let tupType = a.t.skipTypes(abstractInst+{tyVar}) assert tupType.kind == tyTuple d.inheritLocation(a) @@ -819,8 +845,9 @@ proc genTupleElem(p: BProc, e: PNode, d: var TLoc) = proc lookupFieldAgain(p: BProc, ty: PType; field: PSym; r: var Rope; resTyp: ptr PType = nil): PSym = + result = nil var ty = ty - assert r != nil + assert r != "" while ty != nil: ty = ty.skipTypes(skipPtrs) assert(ty.kind in {tyTuple, tyObject}) @@ -833,7 +860,13 @@ proc lookupFieldAgain(p: BProc, ty: PType; field: PSym; r: var Rope; if result == nil: internalError(p.config, field.info, "genCheckedRecordField") proc genRecordField(p: BProc, e: PNode, d: var TLoc) = - var a: TLoc + var a: TLoc = default(TLoc) + if p.module.compileToCpp and e.kind == nkDotExpr and e[1].kind == nkSym and e[1].typ.kind == tyPtr: + # special case for C++: we need to pull the type of the field as member and friends require the complete type. + let typ = e[1].typ.elementType + if typ.itemId in p.module.g.graph.memberProcsPerType: + discard getTypeDesc(p.module, typ) + genRecordFieldAux(p, e, d, a) var r = rdLoc(a) var f = e[1].sym @@ -841,15 +874,18 @@ proc genRecordField(p: BProc, e: PNode, d: var TLoc) = if ty.kind == tyTuple: # we found a unique tuple type which lacks field information # so we use Field$i - r.addf(".Field$1", [rope(f.position)]) + r.add ".Field" + r.add rope(f.position) putIntoDest(p, d, e, r, a.storage) else: - var rtyp: PType + var rtyp: PType = nil let field = lookupFieldAgain(p, ty, f, r, addr rtyp) - if field.loc.r == nil and rtyp != nil: fillObjectFields(p.module, rtyp) - if field.loc.r == nil: internalError(p.config, e.info, "genRecordField 3 " & typeToString(ty)) - r.addf(".$1", [field.loc.r]) + if field.loc.snippet == "" and rtyp != nil: fillObjectFields(p.module, rtyp) + if field.loc.snippet == "": internalError(p.config, e.info, "genRecordField 3 " & typeToString(ty)) + r.add "." + r.add field.loc.snippet putIntoDest(p, d, e, r, a.storage) + r.freeze proc genInExprAux(p: BProc, e: PNode, a, b, d: var TLoc) @@ -863,67 +899,114 @@ proc genFieldCheck(p: BProc, e: PNode, obj: Rope, field: PSym) = if op.magic == mNot: it = it[1] let disc = it[2].skipConv assert(disc.kind == nkSym) - initLoc(test, locNone, it, OnStack) - initLocExpr(p, it[1], u) - initLoc(v, locExpr, disc, OnUnknown) - v.r = obj - v.r.add(".") - v.r.add(disc.sym.loc.r) + test = initLoc(locNone, it, OnStack) + u = initLocExpr(p, it[1]) + v = initLoc(locExpr, disc, OnUnknown) + v.snippet = newRopeAppender() + v.snippet.add obj + v.snippet.add(".") + v.snippet.add(disc.sym.loc.snippet) genInExprAux(p, it, u, v, test) - let msg = genFieldDefect(field, disc.sym) - let strLit = genStringLiteral(p.module, newStrNode(nkStrLit, msg)) - if op.magic == mNot: - linefmt(p, cpsStmts, - "if ($1){ #raiseFieldError($2); $3}$n", - [rdLoc(test), strLit, raiseInstr(p)]) + var msg = "" + if optDeclaredLocs in p.config.globalOptions: + # xxx this should be controlled by a separate flag, and + # used for other similar defects so that location information is shown + # even without the expensive `--stacktrace`; binary size could be optimized + # by encoding the file names separately from `file(line:col)`, essentially + # passing around `TLineInfo` + the set of files in the project. + msg.add toFileLineCol(p.config, e.info) & " " + msg.add genFieldDefect(p.config, field.name.s, disc.sym) + var strLit = newRopeAppender() + genStringLiteral(p.module, newStrNode(nkStrLit, msg), strLit) + + ## discriminant check + template fun(code) = linefmt(p, cpsStmts, code, [rdLoc(test)]) + if op.magic == mNot: fun("if ($1) ") else: fun("if (!($1)) ") + + ## call raiseFieldError2 on failure + var discIndex = newRopeAppender() + rdSetElemLoc(p.config, v, u.t, discIndex) + if optTinyRtti in p.config.globalOptions: + let base = disc.typ.skipTypes(abstractInst+{tyRange}) + case base.kind + of tyEnum: + const code = "{ #raiseFieldErrorStr($1, $2); " + let toStrProc = getToStringProc(p.module.g.graph, base) + # XXX need to modify this logic for IC. + # need to analyze nkFieldCheckedExpr and marks procs "used" like range checks in dce + var toStr: TLoc = default(TLoc) + expr(p, newSymNode(toStrProc), toStr) + let enumStr = "$1($2)" % [rdLoc(toStr), rdLoc(v)] + linefmt(p, cpsStmts, code, [strLit, enumStr]) + else: + const code = "{ #raiseFieldError2($1, (NI)$2); " + linefmt(p, cpsStmts, code, [strLit, discIndex]) + else: - linefmt(p, cpsStmts, - "if (!($1)){ #raiseFieldError($2); $3}$n", - [rdLoc(test), strLit, raiseInstr(p)]) + # complication needed for signed types + let first = p.config.firstOrd(disc.sym.typ) + var firstLit = newRopeAppender() + int64Literal(cast[int](first), firstLit) + let discName = genTypeInfo(p.config, p.module, disc.sym.typ, e.info) + const code = "{ #raiseFieldError2($1, #reprDiscriminant(((NI)$2) + (NI)$3, $4)); " + linefmt(p, cpsStmts, code, [strLit, discIndex, firstLit, discName]) + + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] proc genCheckedRecordField(p: BProc, e: PNode, d: var TLoc) = assert e[0].kind == nkDotExpr if optFieldCheck in p.options: - var a: TLoc + var a: TLoc = default(TLoc) genRecordFieldAux(p, e[0], d, a) let ty = skipTypes(a.t, abstractInst + tyUserTypeClasses) var r = rdLoc(a) let f = e[0][1].sym let field = lookupFieldAgain(p, ty, f, r) - if field.loc.r == nil: fillObjectFields(p.module, ty) - if field.loc.r == nil: + if field.loc.snippet == "": fillObjectFields(p.module, ty) + if field.loc.snippet == "": internalError(p.config, e.info, "genCheckedRecordField") # generate the checks: genFieldCheck(p, e, r, field) - r.add(ropecg(p.module, ".$1", [field.loc.r])) + r.add(".") + r.add field.loc.snippet putIntoDest(p, d, e[0], r, a.storage) + r.freeze else: genRecordField(p, e[0], d) proc genUncheckedArrayElem(p: BProc, n, x, y: PNode, d: var TLoc) = - var a, b: TLoc - initLocExpr(p, x, a) - initLocExpr(p, y, b) + var a = initLocExpr(p, x) + var b = initLocExpr(p, y) d.inheritLocation(a) putIntoDest(p, d, n, ropecg(p.module, "$1[$2]", [rdLoc(a), rdCharLoc(b)]), a.storage) proc genArrayElem(p: BProc, n, x, y: PNode, d: var TLoc) = - var a, b: TLoc - initLocExpr(p, x, a) - initLocExpr(p, y, b) + var a = initLocExpr(p, x) + var b = initLocExpr(p, y) var ty = skipTypes(a.t, abstractVarRange + abstractPtrs + tyUserTypeClasses) - var first = intLiteral(firstOrd(p.config, ty)) + var first = newRopeAppender() + intLiteral(firstOrd(p.config, ty), first) # emit range check: if optBoundsCheck in p.options and ty.kind != tyUncheckedArray: if not isConstExpr(y): # semantic pass has already checked for const index expressions - if firstOrd(p.config, ty) == 0: + 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)): - linefmt(p, cpsStmts, "if ((NU)($1) > (NU)($2)){ #raiseIndexError2($1, $2); $3}$n", - [rdCharLoc(b), intLiteral(lastOrd(p.config, ty)), raiseInstr(p)]) + var last = newRopeAppender() + intLiteral(lastOrd(p.config, ty), last) + linefmt(p, cpsStmts, "if ((NU)($1) > (NU)($2)){ #raiseIndexError2($1, $2); ", + [rdCharLoc(b), last]) + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] else: - linefmt(p, cpsStmts, "if ($1 < $2 || $1 > $3){ #raiseIndexError3($1, $2, $3); $4}$n", - [rdCharLoc(b), first, intLiteral(lastOrd(p.config, ty)), raiseInstr(p)]) + var last = newRopeAppender() + intLiteral(lastOrd(p.config, ty), last) + linefmt(p, cpsStmts, "if ($1 < $2 || $1 > $3){ #raiseIndexError3($1, $2, $3); ", + [rdCharLoc(b), first, last]) + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] + else: let idx = getOrdValue(y) if idx < firstOrd(p.config, ty) or idx > lastOrd(p.config, ty): @@ -933,74 +1016,94 @@ proc genArrayElem(p: BProc, n, x, y: PNode, d: var TLoc) = ropecg(p.module, "$1[($2)- $3]", [rdLoc(a), rdCharLoc(b), first]), a.storage) proc genCStringElem(p: BProc, n, x, y: PNode, d: var TLoc) = - var a, b: TLoc - initLocExpr(p, x, a) - initLocExpr(p, y, b) + var a = initLocExpr(p, x) + var b = initLocExpr(p, y) inheritLocation(d, a) putIntoDest(p, d, n, ropecg(p.module, "$1[$2]", [rdLoc(a), rdCharLoc(b)]), a.storage) -proc genBoundsCheck(p: BProc; arr, a, b: TLoc) = - let ty = skipTypes(arr.t, abstractVarRange) +proc genBoundsCheck(p: BProc; arr, a, b: TLoc; arrTyp: PType) = + let ty = arrTyp case ty.kind of tyOpenArray, tyVarargs: if reifiedOpenArray(arr.lode): linefmt(p, cpsStmts, "if ($2-$1 != -1 && " & - "((NU)($1) >= (NU)($3.Field1) || (NU)($2) >= (NU)($3.Field1))){ #raiseIndexError(); $4}$n", - [rdLoc(a), rdLoc(b), rdLoc(arr), raiseInstr(p)]) + "($1 < 0 || $1 >= $3.Field1 || $2 < 0 || $2 >= $3.Field1)){ #raiseIndexError4($1, $2, $3.Field1); ", + [rdLoc(a), rdLoc(b), rdLoc(arr)]) else: linefmt(p, cpsStmts, - "if ($2-$1 != -1 && " & - "((NU)($1) >= (NU)($3Len_0) || (NU)($2) >= (NU)($3Len_0))){ #raiseIndexError(); $4}$n", - [rdLoc(a), rdLoc(b), rdLoc(arr), raiseInstr(p)]) + "if ($2-$1 != -1 && ($1 < 0 || $1 >= $3Len_0 || $2 < 0 || $2 >= $3Len_0))" & + "{ #raiseIndexError4($1, $2, $3Len_0); ", + [rdLoc(a), rdLoc(b), rdLoc(arr)]) + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] + of tyArray: - let first = intLiteral(firstOrd(p.config, ty)) + var first = newRopeAppender() + intLiteral(firstOrd(p.config, ty), first) + var last = newRopeAppender() + intLiteral(lastOrd(p.config, ty), last) linefmt(p, cpsStmts, "if ($2-$1 != -1 && " & - "($2-$1 < -1 || $1 < $3 || $1 > $4 || $2 < $3 || $2 > $4)){ #raiseIndexError(); $5}$n", - [rdCharLoc(a), rdCharLoc(b), first, intLiteral(lastOrd(p.config, ty)), raiseInstr(p)]) + "($2-$1 < -1 || $1 < $3 || $1 > $4 || $2 < $3 || $2 > $4)){ #raiseIndexError(); ", + [rdCharLoc(a), rdCharLoc(b), first, last]) + + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] + of tySequence, tyString: linefmt(p, cpsStmts, "if ($2-$1 != -1 && " & - "((NU)($1) >= (NU)$3 || (NU)($2) >= (NU)$3)){ #raiseIndexError(); $4}$n", - [rdLoc(a), rdLoc(b), lenExpr(p, arr), raiseInstr(p)]) + "($1 < 0 || $1 >= $3 || $2 < 0 || $2 >= $3)){ #raiseIndexError4($1, $2, $3); ", + [rdLoc(a), rdLoc(b), lenExpr(p, arr)]) + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] + else: discard proc genOpenArrayElem(p: BProc, n, x, y: PNode, d: var TLoc) = - var a, b: TLoc - initLocExpr(p, x, a) - initLocExpr(p, y, b) + var a = initLocExpr(p, x) + var b = initLocExpr(p, y) if not reifiedOpenArray(x): # emit range check: if optBoundsCheck in p.options: - linefmt(p, cpsStmts, "if ((NU)($1) >= (NU)($2Len_0)){ #raiseIndexError2($1,$2Len_0-1); $3}$n", - [rdLoc(b), rdLoc(a), raiseInstr(p)]) # BUGFIX: ``>=`` and not ``>``! + linefmt(p, cpsStmts, "if ($1 < 0 || $1 >= $2Len_0){ #raiseIndexError2($1,$2Len_0-1); ", + [rdCharLoc(b), rdLoc(a)]) # BUGFIX: ``>=`` and not ``>``! + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] + inheritLocation(d, a) putIntoDest(p, d, n, ropecg(p.module, "$1[$2]", [rdLoc(a), rdCharLoc(b)]), a.storage) else: if optBoundsCheck in p.options: - linefmt(p, cpsStmts, "if ((NU)($1) >= (NU)($2.Field1)){ #raiseIndexError2($1,$2.Field1-1); $3}$n", - [rdLoc(b), rdLoc(a), raiseInstr(p)]) # BUGFIX: ``>=`` and not ``>``! + linefmt(p, cpsStmts, "if ($1 < 0 || $1 >= $2.Field1){ #raiseIndexError2($1,$2.Field1-1); ", + [rdCharLoc(b), rdLoc(a)]) # BUGFIX: ``>=`` and not ``>``! + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] + inheritLocation(d, a) putIntoDest(p, d, n, ropecg(p.module, "$1.Field0[$2]", [rdLoc(a), rdCharLoc(b)]), a.storage) proc genSeqElem(p: BProc, n, x, y: PNode, d: var TLoc) = - var a, b: TLoc - initLocExpr(p, x, a) - initLocExpr(p, y, b) + var a = initLocExpr(p, x) + var b = initLocExpr(p, y) var ty = skipTypes(a.t, abstractVarRange) if ty.kind in {tyRef, tyPtr}: - ty = skipTypes(ty.lastSon, abstractVarRange) # emit range check: + ty = skipTypes(ty.elementType, abstractVarRange) + # emit range check: if optBoundsCheck in p.options: linefmt(p, cpsStmts, - "if ((NU)($1) >= (NU)$2){ #raiseIndexError2($1,$2-1); $3}$n", - [rdLoc(b), lenExpr(p, a), raiseInstr(p)]) + "if ($1 < 0 || $1 >= $2){ #raiseIndexError2($1,$2-1); ", + [rdCharLoc(b), lenExpr(p, a)]) + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] + if d.k == locNone: d.storage = OnHeap if skipTypes(a.t, abstractVar).kind in {tyRef, tyPtr}: - a.r = ropecg(p.module, "(*$1)", [a.r]) + a.snippet = ropecg(p.module, "(*$1)", [a.snippet]) if lfPrepareForMutation in d.flags and ty.kind == tyString and optSeqDestructors in p.config.globalOptions: @@ -1010,13 +1113,13 @@ proc genSeqElem(p: BProc, n, x, y: PNode, d: var TLoc) = proc genBracketExpr(p: BProc; n: PNode; d: var TLoc) = var ty = skipTypes(n[0].typ, abstractVarRange + tyUserTypeClasses) - if ty.kind in {tyRef, tyPtr}: ty = skipTypes(ty.lastSon, abstractVarRange) + if ty.kind in {tyRef, tyPtr}: ty = skipTypes(ty.elementType, abstractVarRange) case ty.kind of tyUncheckedArray: genUncheckedArrayElem(p, n, n[0], n[1], d) of tyArray: genArrayElem(p, n, n[0], n[1], d) of tyOpenArray, tyVarargs: genOpenArrayElem(p, n, n[0], n[1], d) of tySequence, tyString: genSeqElem(p, n, n[0], n[1], d) - of tyCString: genCStringElem(p, n, n[0], n[1], d) + of tyCstring: genCStringElem(p, n, n[0], n[1], d) of tyTuple: genTupleElem(p, n, d) else: internalError(p.config, n.info, "expr(nkBracketExpr, " & $ty.kind & ')') discard getTypeDesc(p.module, n.typ) @@ -1035,8 +1138,7 @@ proc isSimpleExpr(n: PNode): bool = if n[i].kind notin {nkCommentStmt, nkEmpty}: return false result = isSimpleExpr(n.lastSon) else: - if n.isAtom: - result = true + result = n.isAtom proc genAndOr(p: BProc, e: PNode, d: var TLoc, m: TMagic) = # how to generate code? @@ -1061,16 +1163,15 @@ proc genAndOr(p: BProc, e: PNode, d: var TLoc, m: TMagic) = # a = tmp when false: #if isSimpleExpr(e) and p.module.compileToCpp: - var tmpA, tmpB: TLoc #getTemp(p, e.typ, tmpA) #getTemp(p, e.typ, tmpB) - initLocExprSingleUse(p, e[1], tmpA) - initLocExprSingleUse(p, e[2], tmpB) + var tmpA = initLocExprSingleUse(p, e[1]) + var tmpB = initLocExprSingleUse(p, e[2]) tmpB.k = locExpr if m == mOr: - tmpB.r = "((" & rdLoc(tmpA) & ")||(" & rdLoc(tmpB) & "))" + tmpB.snippet = "((" & rdLoc(tmpA) & ")||(" & rdLoc(tmpB) & "))" else: - tmpB.r = "((" & rdLoc(tmpA) & ")&&(" & rdLoc(tmpB) & "))" + tmpB.snippet = "((" & rdLoc(tmpA) & ")&&(" & rdLoc(tmpB) & "))" if d.k == locNone: d = tmpB else: @@ -1078,8 +1179,7 @@ proc genAndOr(p: BProc, e: PNode, d: var TLoc, m: TMagic) = else: var L: TLabel - tmp: TLoc - getTemp(p, e.typ, tmp) # force it into a temp! + var tmp: TLoc = getTemp(p, e.typ) # force it into a temp! inc p.splitDecls expr(p, e[1], tmp) L = getLabel(p) @@ -1101,23 +1201,28 @@ proc genEcho(p: BProc, n: PNode) = internalAssert p.config, n.kind == nkBracket if p.config.target.targetOS == osGenode: # echo directly to the Genode LOG session - var args: Rope = nil + var args: Rope = "" var a: TLoc - for it in n.sons: + for i, it in n.sons: if it.skipConv.kind == nkNilLit: args.add(", \"\"") - else: - initLocExpr(p, it, a) - args.add(ropecg(p.module, ", Genode::Cstring($1->data, $1->len)", [rdLoc(a)])) + elif n.len != 0: + a = initLocExpr(p, it) + if i > 0: + args.add(", ") + case detectStrVersion(p.module) + of 2: + args.add(ropecg(p.module, "Genode::Cstring($1.p->data, $1.len)", [a.rdLoc])) + else: + args.add(ropecg(p.module, "Genode::Cstring($1->data, $1->len)", [a.rdLoc])) p.module.includeHeader("<base/log.h>") p.module.includeHeader("<util/string.h>") - linefmt(p, cpsStmts, """Genode::log(""$1);$n""", [args]) + linefmt(p, cpsStmts, """Genode::log($1);$n""", [args]) else: if n.len == 0: linefmt(p, cpsStmts, "#echoBinSafe(NIM_NIL, $1);$n", [n.len]) else: - var a: TLoc - initLocExpr(p, n, a) + var a: TLoc = initLocExpr(p, n) linefmt(p, cpsStmts, "#echoBinSafe($1, $2);$n", [a.rdLoc, n.len]) when false: p.module.includeHeader("<stdio.h>") @@ -1136,7 +1241,7 @@ proc strLoc(p: BProc; d: TLoc): Rope = proc genStrConcat(p: BProc, e: PNode, d: var TLoc) = # <Nim code> - # s = 'Hello ' & name & ', how do you feel?' & 'z' + # s = "Hello " & name & ", how do you feel?" & 'z' # # <generated C code> # { @@ -1151,14 +1256,14 @@ proc genStrConcat(p: BProc, e: PNode, d: var TLoc) = # appendChar(tmp0, 'z'); # asgn(s, tmp0); # } - var a, tmp: TLoc - getTemp(p, e.typ, tmp) + var a: TLoc + var tmp: TLoc = getTemp(p, e.typ) var L = 0 - var appends: Rope = nil - var lens: Rope = nil + var appends: Rope = "" + var lens: Rope = "" for i in 0..<e.len - 1: # compute the length expression: - initLocExpr(p, e[i + 1], a) + a = initLocExpr(p, e[i + 1]) if skipTypes(e[i + 1].typ, abstractVarRange).kind == tyChar: inc(L) appends.add(ropecg(p.module, "#appendChar($1, $2);$n", [strLoc(p, tmp), rdLoc(a)])) @@ -1169,7 +1274,7 @@ proc genStrConcat(p: BProc, e: PNode, d: var TLoc) = lens.add(lenExpr(p, a)) lens.add(" + ") appends.add(ropecg(p.module, "#appendString($1, $2);$n", [strLoc(p, tmp), rdLoc(a)])) - linefmt(p, cpsStmts, "$1 = #rawNewString($2$3);$n", [tmp.r, lens, L]) + linefmt(p, cpsStmts, "$1 = #rawNewString($2$3);$n", [tmp.snippet, lens, L]) p.s(cpsStmts).add appends if d.k == locNone: d = tmp @@ -1179,7 +1284,7 @@ proc genStrConcat(p: BProc, e: PNode, d: var TLoc) = proc genStrAppend(p: BProc, e: PNode, d: var TLoc) = # <Nim code> - # s &= 'Hello ' & name & ', how do you feel?' & 'z' + # s &= "Hello " & name & ", how do you feel?" & 'z' # // BUG: what if s is on the left side too? # <generated C code> # { @@ -1190,14 +1295,14 @@ proc genStrAppend(p: BProc, e: PNode, d: var TLoc) = # appendChar(s, 'z'); # } var - a, dest, call: TLoc - appends, lens: Rope + a, call: TLoc + appends, lens: Rope = "" assert(d.k == locNone) var L = 0 - initLocExpr(p, e[1], dest) + var dest = initLocExpr(p, e[1]) for i in 0..<e.len - 2: # compute the length expression: - initLocExpr(p, e[i + 2], a) + a = initLocExpr(p, e[i + 2]) if skipTypes(e[i + 2].typ, abstractVarRange).kind == tyChar: inc(L) appends.add(ropecg(p.module, "#appendChar($1, $2);$n", @@ -1214,8 +1319,8 @@ proc genStrAppend(p: BProc, e: PNode, d: var TLoc) = linefmt(p, cpsStmts, "#prepareAdd($1, $2$3);$n", [byRefLoc(p, dest), lens, L]) else: - initLoc(call, locCall, e, OnHeap) - call.r = ropecg(p.module, "#resizeString($1, $2$3)", [rdLoc(dest), lens, L]) + call = initLoc(locCall, e, OnHeap) + call.snippet = ropecg(p.module, "#resizeString($1, $2$3)", [rdLoc(dest), lens, L]) genAssignment(p, dest, call, {}) gcUsage(p.config, e) p.s(cpsStmts).add appends @@ -1224,19 +1329,18 @@ proc genSeqElemAppend(p: BProc, e: PNode, d: var TLoc) = # seq &= x --> # seq = (typeof seq) incrSeq(&seq->Sup, sizeof(x)); # seq->data[seq->len-1] = x; - var a, b, dest, tmpL, call: TLoc - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) let seqType = skipTypes(e[1].typ, {tyVar}) - initLoc(call, locCall, e, OnHeap) + var call = initLoc(locCall, e, OnHeap) if not p.module.compileToCpp: const seqAppendPattern = "($2) #incrSeqV3((TGenericSeq*)($1), $3)" - call.r = ropecg(p.module, seqAppendPattern, [rdLoc(a), + call.snippet = ropecg(p.module, seqAppendPattern, [rdLoc(a), getTypeDesc(p.module, e[1].typ), genTypeInfoV1(p.module, seqType, e.info)]) else: const seqAppendPattern = "($2) #incrSeqV3($1, $3)" - call.r = ropecg(p.module, seqAppendPattern, [rdLoc(a), + call.snippet = ropecg(p.module, seqAppendPattern, [rdLoc(a), getTypeDesc(p.module, e[1].typ), genTypeInfoV1(p.module, seqType, e.info)]) # emit the write barrier if required, but we can always move here, so @@ -1244,43 +1348,33 @@ proc genSeqElemAppend(p: BProc, e: PNode, d: var TLoc) = genRefAssign(p, a, call) #if bt != b.t: # echo "YES ", e.info, " new: ", typeToString(bt), " old: ", typeToString(b.t) - initLoc(dest, locExpr, e[2], OnHeap) - getIntTemp(p, tmpL) - lineCg(p, cpsStmts, "$1 = $2->$3++;$n", [tmpL.r, rdLoc(a), lenField(p)]) - dest.r = ropecg(p.module, "$1$3[$2]", [rdLoc(a), tmpL.r, dataField(p)]) + var dest = initLoc(locExpr, e[2], OnHeap) + var tmpL = getIntTemp(p) + lineCg(p, cpsStmts, "$1 = $2->$3++;$n", [tmpL.snippet, rdLoc(a), lenField(p)]) + dest.snippet = ropecg(p.module, "$1$3[$2]", [rdLoc(a), tmpL.snippet, dataField(p)]) genAssignment(p, dest, b, {needToCopy}) gcUsage(p.config, e) -proc genReset(p: BProc, n: PNode) = - var a: TLoc - initLocExpr(p, n[1], a) - specializeReset(p, a) - when false: - linefmt(p, cpsStmts, "#genericReset((void*)$1, $2);$n", - [addrLoc(p.config, a), - genTypeInfoV1(p.module, skipTypes(a.t, {tyVar}), n.info)]) - proc genDefault(p: BProc; n: PNode; d: var TLoc) = - if d.k == locNone: getTemp(p, n.typ, d, needsInit=true) + if d.k == locNone: d = getTemp(p, n.typ, needsInit=true) else: resetLoc(p, d) proc rawGenNew(p: BProc, a: var TLoc, sizeExpr: Rope; needsInit: bool) = var sizeExpr = sizeExpr let typ = a.t - var b: TLoc - initLoc(b, locExpr, a.lode, OnHeap) + var b: TLoc = initLoc(locExpr, a.lode, OnHeap) let refType = typ.skipTypes(abstractInstOwned) assert refType.kind == tyRef - let bt = refType.lastSon - if sizeExpr.isNil: + let bt = refType.elementType + if sizeExpr == "": sizeExpr = "sizeof($1)" % [getTypeDesc(p.module, bt)] if optTinyRtti in p.config.globalOptions: if needsInit: - b.r = ropecg(p.module, "($1) #nimNewObj($2, NIM_ALIGNOF($3))", + b.snippet = ropecg(p.module, "($1) #nimNewObj($2, NIM_ALIGNOF($3))", [getTypeDesc(p.module, typ), sizeExpr, getTypeDesc(p.module, bt)]) else: - b.r = ropecg(p.module, "($1) #nimNewObjUninit($2, NIM_ALIGNOF($3))", + b.snippet = ropecg(p.module, "($1) #nimNewObjUninit($2, NIM_ALIGNOF($3))", [getTypeDesc(p.module, typ), sizeExpr, getTypeDesc(p.module, bt)]) genAssignment(p, a, b, {}) else: @@ -1294,79 +1388,74 @@ proc rawGenNew(p: BProc, a: var TLoc, sizeExpr: Rope; needsInit: bool) = localError(p.module.config, a.lode.info, "the destructor that is turned into a finalizer needs " & "to have the 'nimcall' calling convention") - var f: TLoc - initLocExpr(p, newSymNode(op), f) + var f: TLoc = initLocExpr(p, newSymNode(op)) p.module.s[cfsTypeInit3].addf("$1->finalizer = (void*)$2;$n", [ti, rdLoc(f)]) if a.storage == OnHeap and usesWriteBarrier(p.config): - if canFormAcycle(a.t): + if canFormAcycle(p.module.g.graph, a.t): linefmt(p, cpsStmts, "if ($1) { #nimGCunrefRC1($1); $1 = NIM_NIL; }$n", [a.rdLoc]) else: linefmt(p, cpsStmts, "if ($1) { #nimGCunrefNoCycle($1); $1 = NIM_NIL; }$n", [a.rdLoc]) if p.config.selectedGC == gcGo: # newObjRC1() would clash with unsureAsgnRef() - which is used by gcGo to # implement the write barrier - b.r = ropecg(p.module, "($1) #newObj($2, $3)", [getTypeDesc(p.module, typ), ti, sizeExpr]) + b.snippet = ropecg(p.module, "($1) #newObj($2, $3)", [getTypeDesc(p.module, typ), ti, sizeExpr]) linefmt(p, cpsStmts, "#unsureAsgnRef((void**) $1, $2);$n", [addrLoc(p.config, a), b.rdLoc]) else: # use newObjRC1 as an optimization - b.r = ropecg(p.module, "($1) #newObjRC1($2, $3)", [getTypeDesc(p.module, typ), ti, sizeExpr]) + b.snippet = ropecg(p.module, "($1) #newObjRC1($2, $3)", [getTypeDesc(p.module, typ), ti, sizeExpr]) linefmt(p, cpsStmts, "$1 = $2;$n", [a.rdLoc, b.rdLoc]) else: - b.r = ropecg(p.module, "($1) #newObj($2, $3)", [getTypeDesc(p.module, typ), ti, sizeExpr]) + b.snippet = ropecg(p.module, "($1) #newObj($2, $3)", [getTypeDesc(p.module, typ), ti, sizeExpr]) genAssignment(p, a, b, {}) # set the object type: genObjectInit(p, cpsStmts, bt, a, constructRefObj) proc genNew(p: BProc, e: PNode) = - var a: TLoc - initLocExpr(p, e[1], a) + var a: TLoc = initLocExpr(p, e[1]) # 'genNew' also handles 'unsafeNew': if e.len == 3: - var se: TLoc - initLocExpr(p, e[2], se) + var se: TLoc = initLocExpr(p, e[2]) rawGenNew(p, a, se.rdLoc, needsInit = true) else: - rawGenNew(p, a, nil, needsInit = true) + rawGenNew(p, a, "", needsInit = true) gcUsage(p.config, e) proc genNewSeqAux(p: BProc, dest: TLoc, length: Rope; lenIsZero: bool) = let seqtype = skipTypes(dest.t, abstractVarRange) - var call: TLoc - initLoc(call, locExpr, dest.lode, OnHeap) + var call: TLoc = initLoc(locExpr, dest.lode, OnHeap) if dest.storage == OnHeap and usesWriteBarrier(p.config): - if canFormAcycle(dest.t): + if canFormAcycle(p.module.g.graph, dest.t): linefmt(p, cpsStmts, "if ($1) { #nimGCunrefRC1($1); $1 = NIM_NIL; }$n", [dest.rdLoc]) else: linefmt(p, cpsStmts, "if ($1) { #nimGCunrefNoCycle($1); $1 = NIM_NIL; }$n", [dest.rdLoc]) if not lenIsZero: if p.config.selectedGC == gcGo: # we need the write barrier - call.r = ropecg(p.module, "($1) #newSeq($2, $3)", [getTypeDesc(p.module, seqtype), + call.snippet = ropecg(p.module, "($1) #newSeq($2, $3)", [getTypeDesc(p.module, seqtype), genTypeInfoV1(p.module, seqtype, dest.lode.info), length]) linefmt(p, cpsStmts, "#unsureAsgnRef((void**) $1, $2);$n", [addrLoc(p.config, dest), call.rdLoc]) else: - call.r = ropecg(p.module, "($1) #newSeqRC1($2, $3)", [getTypeDesc(p.module, seqtype), + call.snippet = ropecg(p.module, "($1) #newSeqRC1($2, $3)", [getTypeDesc(p.module, seqtype), genTypeInfoV1(p.module, seqtype, dest.lode.info), length]) linefmt(p, cpsStmts, "$1 = $2;$n", [dest.rdLoc, call.rdLoc]) else: if lenIsZero: - call.r = rope"NIM_NIL" + call.snippet = rope"NIM_NIL" else: - call.r = ropecg(p.module, "($1) #newSeq($2, $3)", [getTypeDesc(p.module, seqtype), + call.snippet = ropecg(p.module, "($1) #newSeq($2, $3)", [getTypeDesc(p.module, seqtype), genTypeInfoV1(p.module, seqtype, dest.lode.info), length]) genAssignment(p, dest, call, {}) proc genNewSeq(p: BProc, e: PNode) = - var a, b: TLoc - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) if optSeqDestructors in p.config.globalOptions: let seqtype = skipTypes(e[1].typ, abstractVarRange) linefmt(p, cpsStmts, "$1.len = $2; $1.p = ($4*) #newSeqPayload($2, sizeof($3), NIM_ALIGNOF($3));$n", [a.rdLoc, b.rdLoc, - getTypeDesc(p.module, seqtype.lastSon), + getTypeDesc(p.module, seqtype.elementType), getSeqPayloadType(p.module, seqtype)]) else: let lenIsZero = e[2].kind == nkIntLit and e[2].intVal == 0 @@ -1375,15 +1464,15 @@ proc genNewSeq(p: BProc, e: PNode) = proc genNewSeqOfCap(p: BProc; e: PNode; d: var TLoc) = let seqtype = skipTypes(e.typ, abstractVarRange) - var a: TLoc - initLocExpr(p, e[1], a) + var a: TLoc = initLocExpr(p, e[1]) if optSeqDestructors in p.config.globalOptions: - if d.k == locNone: getTemp(p, e.typ, d, needsInit=false) - linefmt(p, cpsStmts, "$1.len = 0; $1.p = ($4*) #newSeqPayload($2, sizeof($3), NIM_ALIGNOF($3));$n", - [d.rdLoc, a.rdLoc, getTypeDesc(p.module, seqtype.lastSon), + if d.k == locNone: d = getTemp(p, e.typ, needsInit=false) + linefmt(p, cpsStmts, "$1.len = 0; $1.p = ($4*) #newSeqPayloadUninit($2, sizeof($3), NIM_ALIGNOF($3));$n", + [d.rdLoc, a.rdLoc, getTypeDesc(p.module, seqtype.elementType), getSeqPayloadType(p.module, seqtype), ]) else: + if d.k == locNone: d = getTemp(p, e.typ, needsInit=false) # bug #22560 putIntoDest(p, d, e, ropecg(p.module, "($1)#nimNewSeqOfCap($2, $3)", [ getTypeDesc(p.module, seqtype), @@ -1398,8 +1487,13 @@ proc rawConstExpr(p: BProc, n: PNode; d: var TLoc) = if id == p.module.labels: # expression not found in the cache: inc(p.module.labels) - p.module.s[cfsData].addf("static NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(p.module, t), d.r, genBracedInit(p, n, isConst = true, t)]) + var data = "static NIM_CONST $1 $2 = " % [getTypeDesc(p.module, t), d.snippet] + # bug #23627; when generating const object fields, it's likely that + # we need to generate type infos for the object, which may be an object with + # custom hooks. We need to generate potential consts in the hooks first. + genBracedInit(p, n, isConst = true, t, data) + data.addf(";$n", []) + p.module.s[cfsData].add data proc handleConstExpr(p: BProc, n: PNode, d: var TLoc): bool = if d.k == locNone and n.len > ord(n.kind == nkObjConstr) and n.isDeepConstExpr: @@ -1408,8 +1502,31 @@ proc handleConstExpr(p: BProc, n: PNode, d: var TLoc): bool = else: result = false + +proc genFieldObjConstr(p: BProc; ty: PType; useTemp, isRef: bool; nField, val, check: PNode; d: var TLoc; r: Rope; info: TLineInfo) = + var tmp2 = TLoc(snippet: r) + let field = lookupFieldAgain(p, ty, nField.sym, tmp2.snippet) + if field.loc.snippet == "": fillObjectFields(p.module, ty) + if field.loc.snippet == "": internalError(p.config, info, "genFieldObjConstr") + if check != nil and optFieldCheck in p.options: + genFieldCheck(p, check, r, field) + tmp2.snippet.add(".") + tmp2.snippet.add(field.loc.snippet) + if useTemp: + tmp2.k = locTemp + tmp2.storage = if isRef: OnHeap else: OnStack + else: + tmp2.k = d.k + tmp2.storage = if isRef: OnHeap else: d.storage + tmp2.lode = val + if nField.typ.skipTypes(abstractVar).kind in {tyOpenArray, tyVarargs}: + var tmp3 = getTemp(p, val.typ) + expr(p, val, tmp3) + genOpenArrayConv(p, tmp2, tmp3, {}) + else: + expr(p, val, tmp2) + proc genObjConstr(p: BProc, e: PNode, d: var TLoc) = - #echo renderTree e, " ", e.isDeepConstExpr # inheritance in C++ does not allow struct initialization so # we skip this step here: if not p.module.compileToCpp and optSeqDestructors notin p.config.globalOptions: @@ -1430,42 +1547,33 @@ proc genObjConstr(p: BProc, e: PNode, d: var TLoc) = (d.k notin {locTemp,locLocalVar,locGlobalVar,locParam,locField}) or (isPartOf(d.lode, e) != arNo) - var tmp: TLoc + var tmp: TLoc = default(TLoc) var r: Rope + let needsZeroMem = p.config.selectedGC notin {gcArc, gcAtomicArc, gcOrc} or nfAllFieldsSet notin e.flags if useTemp: - getTemp(p, t, tmp) + tmp = getTemp(p, t) r = rdLoc(tmp) if isRef: - rawGenNew(p, tmp, nil, needsInit = nfAllFieldsSet notin e.flags) - t = t.lastSon.skipTypes(abstractInstOwned) + rawGenNew(p, tmp, "", needsInit = nfAllFieldsSet notin e.flags) + t = t.elementType.skipTypes(abstractInstOwned) r = "(*$1)" % [r] gcUsage(p.config, e) - else: + elif needsZeroMem: constructLoc(p, tmp) + else: + genObjectInit(p, cpsStmts, t, tmp, constructObj) else: - resetLoc(p, d) + if needsZeroMem: resetLoc(p, d) + else: genObjectInit(p, cpsStmts, d.t, d, if isRef: constructRefObj else: constructObj) r = rdLoc(d) discard getTypeDesc(p.module, t) let ty = getUniqueType(t) for i in 1..<e.len: - let it = e[i] - var tmp2: TLoc - tmp2.r = r - let field = lookupFieldAgain(p, ty, it[0].sym, tmp2.r) - if field.loc.r == nil: fillObjectFields(p.module, ty) - if field.loc.r == nil: internalError(p.config, e.info, "genObjConstr") - if it.len == 3 and optFieldCheck in p.options: - genFieldCheck(p, it[2], r, field) - tmp2.r.add(".") - tmp2.r.add(field.loc.r) - if useTemp: - tmp2.k = locTemp - tmp2.storage = if isRef: OnHeap else: OnStack - else: - tmp2.k = d.k - tmp2.storage = if isRef: OnHeap else: d.storage - tmp2.lode = it[1] - expr(p, it[1], tmp2) + var check: PNode = nil + if e[i].len == 3 and optFieldCheck in p.options: + check = e[i][2] + genFieldObjConstr(p, ty, useTemp, isRef, e[i][0], e[i][1], check, d, r, e.info) + if useTemp: if d.k == locNone: d = tmp @@ -1473,31 +1581,36 @@ proc genObjConstr(p: BProc, e: PNode, d: var TLoc) = genAssignment(p, d, tmp, {}) proc lhsDoesAlias(a, b: PNode): bool = + result = false for y in b: if isPartOf(a, y) != arNo: return true proc genSeqConstr(p: BProc, n: PNode, d: var TLoc) = - var arr, tmp: TLoc + var arr: TLoc + var tmp: TLoc = default(TLoc) # bug #668 let doesAlias = lhsDoesAlias(d.lode, n) let dest = if doesAlias: addr(tmp) else: addr(d) if doesAlias: - getTemp(p, n.typ, tmp) + tmp = getTemp(p, n.typ) elif d.k == locNone: - getTemp(p, n.typ, d) + d = getTemp(p, n.typ) - let l = intLiteral(n.len) + var lit = newRopeAppender() + intLiteral(n.len, lit) if optSeqDestructors in p.config.globalOptions: let seqtype = n.typ linefmt(p, cpsStmts, "$1.len = $2; $1.p = ($4*) #newSeqPayload($2, sizeof($3), NIM_ALIGNOF($3));$n", - [rdLoc dest[], l, getTypeDesc(p.module, seqtype.lastSon), + [rdLoc dest[], lit, getTypeDesc(p.module, seqtype.elementType), getSeqPayloadType(p.module, seqtype)]) else: # generate call to newSeq before adding the elements per hand: - genNewSeqAux(p, dest[], l, n.len == 0) + genNewSeqAux(p, dest[], lit, n.len == 0) for i in 0..<n.len: - initLoc(arr, locExpr, n[i], OnHeap) - arr.r = ropecg(p.module, "$1$3[$2]", [rdLoc(dest[]), intLiteral(i), dataField(p)]) + arr = initLoc(locExpr, n[i], OnHeap) + var lit = newRopeAppender() + intLiteral(i, lit) + arr.snippet = ropecg(p.module, "$1$3[$2]", [rdLoc(dest[]), lit, dataField(p)]) arr.storage = OnHeap # we know that sequences are on the heap expr(p, n[i], arr) gcUsage(p.config, n) @@ -1508,114 +1621,120 @@ proc genSeqConstr(p: BProc, n: PNode, d: var TLoc) = genAssignment(p, d, tmp, {}) proc genArrToSeq(p: BProc, n: PNode, d: var TLoc) = - var elem, a, arr: TLoc + var elem, arr: TLoc if n[1].kind == nkBracket: n[1].typ = n.typ genSeqConstr(p, n[1], d) return if d.k == locNone: - getTemp(p, n.typ, d) + d = getTemp(p, n.typ) + var a = initLocExpr(p, n[1]) # generate call to newSeq before adding the elements per hand: let L = toInt(lengthOrd(p.config, n[1].typ)) if optSeqDestructors in p.config.globalOptions: let seqtype = n.typ linefmt(p, cpsStmts, "$1.len = $2; $1.p = ($4*) #newSeqPayload($2, sizeof($3), NIM_ALIGNOF($3));$n", - [rdLoc d, L, getTypeDesc(p.module, seqtype.lastSon), + [rdLoc d, L, getTypeDesc(p.module, seqtype.elementType), getSeqPayloadType(p.module, seqtype)]) else: - genNewSeqAux(p, d, intLiteral(L), L == 0) - initLocExpr(p, n[1], a) + var lit = newRopeAppender() + intLiteral(L, lit) + genNewSeqAux(p, d, lit, L == 0) # bug #5007; do not produce excessive C source code: if L < 10: for i in 0..<L: - initLoc(elem, locExpr, lodeTyp elemType(skipTypes(n.typ, abstractInst)), OnHeap) - elem.r = ropecg(p.module, "$1$3[$2]", [rdLoc(d), intLiteral(i), dataField(p)]) + elem = initLoc(locExpr, lodeTyp elemType(skipTypes(n.typ, abstractInst)), OnHeap) + var lit = newRopeAppender() + intLiteral(i, lit) + elem.snippet = ropecg(p.module, "$1$3[$2]", [rdLoc(d), lit, dataField(p)]) elem.storage = OnHeap # we know that sequences are on the heap - initLoc(arr, locExpr, lodeTyp elemType(skipTypes(n[1].typ, abstractInst)), a.storage) - arr.r = ropecg(p.module, "$1[$2]", [rdLoc(a), intLiteral(i)]) + arr = initLoc(locExpr, lodeTyp elemType(skipTypes(n[1].typ, abstractInst)), a.storage) + arr.snippet = ropecg(p.module, "$1[$2]", [rdLoc(a), lit]) genAssignment(p, elem, arr, {needToCopy}) else: - var i: TLoc - getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt), i) - linefmt(p, cpsStmts, "for ($1 = 0; $1 < $2; $1++) {$n", [i.r, L]) - initLoc(elem, locExpr, lodeTyp elemType(skipTypes(n.typ, abstractInst)), OnHeap) - elem.r = ropecg(p.module, "$1$3[$2]", [rdLoc(d), rdLoc(i), dataField(p)]) + var i: TLoc = getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt)) + linefmt(p, cpsStmts, "for ($1 = 0; $1 < $2; $1++) {$n", [i.snippet, L]) + elem = initLoc(locExpr, lodeTyp elemType(skipTypes(n.typ, abstractInst)), OnHeap) + elem.snippet = ropecg(p.module, "$1$3[$2]", [rdLoc(d), rdLoc(i), dataField(p)]) elem.storage = OnHeap # we know that sequences are on the heap - initLoc(arr, locExpr, lodeTyp elemType(skipTypes(n[1].typ, abstractInst)), a.storage) - arr.r = ropecg(p.module, "$1[$2]", [rdLoc(a), rdLoc(i)]) + arr = initLoc(locExpr, lodeTyp elemType(skipTypes(n[1].typ, abstractInst)), a.storage) + arr.snippet = ropecg(p.module, "$1[$2]", [rdLoc(a), rdLoc(i)]) genAssignment(p, elem, arr, {needToCopy}) lineF(p, cpsStmts, "}$n", []) proc genNewFinalize(p: BProc, e: PNode) = var - a, b, f: TLoc + b: TLoc refType, bt: PType ti: Rope refType = skipTypes(e[1].typ, abstractVarRange) - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], f) - initLoc(b, locExpr, a.lode, OnHeap) - if optTinyRtti in p.config.globalOptions: - ti = genTypeInfoV2(p.module, refType, e.info) - else: - ti = genTypeInfoV1(p.module, refType, e.info) + var a = initLocExpr(p, e[1]) + var f = initLocExpr(p, e[2]) + b = initLoc(locExpr, a.lode, OnHeap) + ti = genTypeInfo(p.config, p.module, refType, e.info) p.module.s[cfsTypeInit3].addf("$1->finalizer = (void*)$2;$n", [ti, rdLoc(f)]) - b.r = ropecg(p.module, "($1) #newObj($2, sizeof($3))", [ + b.snippet = ropecg(p.module, "($1) #newObj($2, sizeof($3))", [ getTypeDesc(p.module, refType), - ti, getTypeDesc(p.module, skipTypes(refType.lastSon, abstractRange))]) + ti, getTypeDesc(p.module, skipTypes(refType.elementType, abstractRange))]) genAssignment(p, a, b, {}) # set the object type: - bt = skipTypes(refType.lastSon, abstractRange) + bt = skipTypes(refType.elementType, abstractRange) genObjectInit(p, cpsStmts, bt, a, constructRefObj) gcUsage(p.config, e) -proc genOfHelper(p: BProc; dest: PType; a: Rope; info: TLineInfo): Rope = +proc genOfHelper(p: BProc; dest: PType; a: Rope; info: TLineInfo; result: var Rope) = if optTinyRtti in p.config.globalOptions: - result = ropecg(p.module, "#isObj($1.m_type, $2)", - [a, genTypeInfo2Name(p.module, dest)]) + let token = $genDisplayElem(MD5Digest(hashType(dest, p.config))) + appcg(p.module, result, "#isObjDisplayCheck($#.m_type, $#, $#)", [a, getObjDepth(dest), token]) else: # unfortunately 'genTypeInfoV1' sets tfObjHasKids as a side effect, so we # have to call it here first: let ti = genTypeInfoV1(p.module, dest, info) if tfFinal in dest.flags or (objHasKidsValid in p.module.flags and tfObjHasKids notin dest.flags): - result = "$1.m_type == $2" % [a, ti] + result.add "$1.m_type == $2" % [a, ti] else: - discard cgsym(p.module, "TNimType") + cgsym(p.module, "TNimType") inc p.module.labels let cache = "Nim_OfCheck_CACHE" & p.module.labels.rope p.module.s[cfsVars].addf("static TNimType* $#[2];$n", [cache]) - result = ropecg(p.module, "#isObjWithCache($#.m_type, $#, $#)", [a, ti, cache]) - when false: - # former version: - result = ropecg(p.module, "#isObj($1.m_type, $2)", - [a, genTypeInfoV1(p.module, dest, info)]) + appcg(p.module, result, "#isObjWithCache($#.m_type, $#, $#)", [a, ti, cache]) proc genOf(p: BProc, x: PNode, typ: PType, d: var TLoc) = - var a: TLoc - initLocExpr(p, x, a) + var a: TLoc = initLocExpr(p, x) var dest = skipTypes(typ, typedescPtrs) var r = rdLoc(a) - var nilCheck: Rope = nil + var nilCheck: Rope = "" var t = skipTypes(a.t, abstractInstOwned) while t.kind in {tyVar, tyLent, tyPtr, tyRef}: if t.kind notin {tyVar, tyLent}: nilCheck = r if t.kind notin {tyVar, tyLent} or not p.module.compileToCpp: r = ropecg(p.module, "(*$1)", [r]) - t = skipTypes(t.lastSon, typedescInst+{tyOwned}) + t = skipTypes(t.elementType, typedescInst+{tyOwned}) discard getTypeDesc(p.module, t) if not p.module.compileToCpp: - while t.kind == tyObject and t[0] != nil: - r.add(~".Sup") - t = skipTypes(t[0], skipPtrs) + while t.kind == tyObject and t.baseClass != nil: + r.add(".Sup") + t = skipTypes(t.baseClass, skipPtrs) if isObjLackingTypeField(t): globalError(p.config, x.info, "no 'of' operator available for pure objects") - if nilCheck != nil: - r = ropecg(p.module, "(($1) && ($2))", [nilCheck, genOfHelper(p, dest, r, x.info)]) + + var ro = newRopeAppender() + genOfHelper(p, dest, r, x.info, ro) + var ofExpr = newRopeAppender() + ofExpr.add "(" + if nilCheck != "": + ofExpr.add "(" + ofExpr.add nilCheck + ofExpr.add ") && (" + ofExpr.add ro + ofExpr.add "))" else: - r = ropecg(p.module, "($1)", [genOfHelper(p, dest, r, x.info)]) - putIntoDest(p, d, x, r, a.storage) + ofExpr.add ro + ofExpr.add ")" + + putIntoDest(p, d, x, ofExpr, a.storage) proc genOf(p: BProc, n: PNode, d: var TLoc) = genOf(p, n[1], n[2].typ, d) @@ -1623,8 +1742,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") - var a: TLoc - initLocExpr(p, e[1], a) + var a: TLoc = initLocExpr(p, e[1]) var t = skipTypes(e[1].typ, abstractVarRange) case t.kind of tyInt..tyInt64, tyUInt..tyUInt64: @@ -1646,13 +1764,15 @@ proc genRepr(p: BProc, e: PNode, d: var TLoc) = putIntoDest(p, d, e, ropecg(p.module, "#reprSet($1, $2)", [ addrLoc(p.config, a), genTypeInfoV1(p.module, t, e.info)]), a.storage) of tyOpenArray, tyVarargs: - var b: TLoc + var b: TLoc = default(TLoc) case skipTypes(a.t, abstractVarRange).kind of tyOpenArray, tyVarargs: putIntoDest(p, b, e, "$1, $1Len_0" % [rdLoc(a)], a.storage) of tyString, tySequence: putIntoDest(p, b, e, - "$1$3, $2" % [rdLoc(a), lenExpr(p, a), dataField(p)], a.storage) + "($4) ? ($1$3) : NIM_NIL, $2" % + [rdLoc(a), lenExpr(p, a), dataField(p), dataFieldAccessor(p, a.rdLoc)], + a.storage) of tyArray: putIntoDest(p, b, e, "$1, $2" % [rdLoc(a), rope(lengthOrd(p.config, a.t))], a.storage) @@ -1660,7 +1780,7 @@ proc genRepr(p: BProc, e: PNode, d: var TLoc) = putIntoDest(p, d, e, ropecg(p.module, "#reprOpenArray($1, $2)", [rdLoc(b), genTypeInfoV1(p.module, elemType(t), e.info)]), a.storage) - of tyCString, tyArray, tyRef, tyPtr, tyPointer, tyNil, tySequence: + of tyCstring, tyArray, tyRef, tyPtr, tyPointer, tyNil, tySequence: putIntoDest(p, d, e, ropecg(p.module, "#reprAny($1, $2)", [ rdLoc(a), genTypeInfoV1(p.module, t, e.info)]), a.storage) @@ -1672,25 +1792,26 @@ proc genRepr(p: BProc, e: PNode, d: var TLoc) = a.storage) gcUsage(p.config, e) -proc rdMType(p: BProc; a: TLoc; nilCheck: var Rope; enforceV1 = false): Rope = - result = rdLoc(a) +proc rdMType(p: BProc; a: TLoc; nilCheck: var Rope; result: var Rope; enforceV1 = false) = + var derefs = rdLoc(a) var t = skipTypes(a.t, abstractInst) while t.kind in {tyVar, tyLent, tyPtr, tyRef}: - if t.kind notin {tyVar, tyLent}: nilCheck = result + if t.kind notin {tyVar, tyLent}: nilCheck = derefs if t.kind notin {tyVar, tyLent} or not p.module.compileToCpp: - result = "(*$1)" % [result] - t = skipTypes(t.lastSon, abstractInst) + derefs = "(*$1)" % [derefs] + t = skipTypes(t.elementType, abstractInst) + result.add derefs discard getTypeDesc(p.module, t) if not p.module.compileToCpp: - while t.kind == tyObject and t[0] != nil: + while t.kind == tyObject and t.baseClass != nil: result.add(".Sup") - t = skipTypes(t[0], skipPtrs) + t = skipTypes(t.baseClass, skipPtrs) result.add ".m_type" if optTinyRtti in p.config.globalOptions and enforceV1: result.add "->typeInfoV1" proc genGetTypeInfo(p: BProc, e: PNode, d: var TLoc) = - discard cgsym(p.module, "TNimType") + cgsym(p.module, "TNimType") let t = e[1].typ # ordinary static type information putIntoDest(p, d, e, genTypeInfoV1(p.module, t, e.info)) @@ -1701,18 +1822,26 @@ proc genGetTypeInfoV2(p: BProc, e: PNode, d: var TLoc) = # ordinary static type information putIntoDest(p, d, e, genTypeInfoV2(p.module, t, e.info)) else: - var a: TLoc - initLocExpr(p, e[1], a) - var nilCheck = Rope(nil) + var a: TLoc = initLocExpr(p, e[1]) + var nilCheck = "" # use the dynamic type stored at offset 0: - putIntoDest(p, d, e, rdMType(p, a, nilCheck)) + var rt = newRopeAppender() + rdMType(p, a, nilCheck, rt) + putIntoDest(p, d, e, rt) + +proc genAccessTypeField(p: BProc; e: PNode; d: var TLoc) = + var a: TLoc = initLocExpr(p, e[1]) + var nilCheck = "" + # use the dynamic type stored at offset 0: + var rt = newRopeAppender() + rdMType(p, a, nilCheck, rt) + putIntoDest(p, d, e, rt) template genDollar(p: BProc, n: PNode, d: var TLoc, frmt: string) = - var a: TLoc - initLocExpr(p, n[1], a) - a.r = ropecg(p.module, frmt, [rdLoc(a)]) + var a: TLoc = initLocExpr(p, n[1]) + a.snippet = ropecg(p.module, frmt, [rdLoc(a)]) a.flags.excl lfIndirect # this flag should not be propagated here (not just for HCR) - if d.k == locNone: getTemp(p, n.typ, d) + if d.k == locNone: d = getTemp(p, n.typ) genAssignment(p, d, a, {}) gcUsage(p.config, n) @@ -1725,78 +1854,75 @@ proc genArrayLen(p: BProc, e: PNode, d: var TLoc, op: TMagic) = # Bug #9279, len(toOpenArray()) has to work: if a.kind in nkCallKinds and a[0].kind == nkSym and a[0].sym.magic == mSlice: # magic: pass slice to openArray: - var b, c: TLoc - initLocExpr(p, a[2], b) - initLocExpr(p, a[3], c) + var m = initLocExpr(p, a[1]) + var b = initLocExpr(p, a[2]) + var c = initLocExpr(p, a[3]) + if optBoundsCheck in p.options: + genBoundsCheck(p, m, b, c, skipTypes(m.t, abstractVarRange)) if op == mHigh: - putIntoDest(p, d, e, ropecg(p.module, "($2)-($1)", [rdLoc(b), rdLoc(c)])) + putIntoDest(p, d, e, ropecg(p.module, "(($2)-($1))", [rdLoc(b), rdLoc(c)])) else: - putIntoDest(p, d, e, ropecg(p.module, "($2)-($1)+1", [rdLoc(b), rdLoc(c)])) + putIntoDest(p, d, e, ropecg(p.module, "(($2)-($1)+1)", [rdLoc(b), rdLoc(c)])) else: if not reifiedOpenArray(a): if op == mHigh: unaryExpr(p, e, d, "($1Len_0-1)") else: unaryExpr(p, e, d, "$1Len_0") else: - if op == mHigh: unaryExpr(p, e, d, "($1.Field1-1)") - else: unaryExpr(p, e, d, "$1.Field1") - of tyCString: - if op == mHigh: unaryExpr(p, e, d, "($1 ? (#nimCStrLen($1)-1) : -1)") - else: unaryExpr(p, e, d, "($1 ? #nimCStrLen($1) : 0)") + let isDeref = a.kind in {nkHiddenDeref, nkDerefExpr} + if op == mHigh: + if isDeref: + unaryExpr(p, e, d, "($1->Field1-1)") + else: + unaryExpr(p, e, d, "($1.Field1-1)") + else: + if isDeref: + unaryExpr(p, e, d, "$1->Field1") + else: + unaryExpr(p, e, d, "$1.Field1") + of tyCstring: + if op == mHigh: unaryExpr(p, e, d, "(#nimCStrLen($1)-1)") + else: unaryExpr(p, e, d, "#nimCStrLen($1)") of tyString: - var a: TLoc - initLocExpr(p, e[1], a) + var a: TLoc = initLocExpr(p, e[1]) var x = lenExpr(p, a) if op == mHigh: x = "($1-1)" % [x] putIntoDest(p, d, e, x) of tySequence: # we go through a temporary here because people write bullshit code. - var a, tmp: TLoc - initLocExpr(p, e[1], a) - getIntTemp(p, tmp) + var tmp: TLoc = getIntTemp(p) + var a = initLocExpr(p, e[1]) var x = lenExpr(p, a) if op == mHigh: x = "($1-1)" % [x] - lineCg(p, cpsStmts, "$1 = $2;$n", [tmp.r, x]) - putIntoDest(p, d, e, tmp.r) + lineCg(p, cpsStmts, "$1 = $2;$n", [tmp.snippet, x]) + putIntoDest(p, d, e, tmp.snippet) of tyArray: # YYY: length(sideeffect) is optimized away incorrectly? if op == mHigh: putIntoDest(p, d, e, rope(lastOrd(p.config, typ))) else: putIntoDest(p, d, e, rope(lengthOrd(p.config, typ))) else: internalError(p.config, e.info, "genArrayLen()") -proc makePtrType(baseType: PType; idgen: IdGenerator): PType = - result = newType(tyPtr, nextTypeId idgen, baseType.owner) - addSonSkipIntLit(result, baseType, idgen) - -proc makeAddr(n: PNode; idgen: IdGenerator): PNode = - if n.kind == nkHiddenAddr: - result = n - else: - result = newTree(nkHiddenAddr, n) - result.typ = makePtrType(n.typ, idgen) - proc genSetLengthSeq(p: BProc, e: PNode, d: var TLoc) = if optSeqDestructors in p.config.globalOptions: e[1] = makeAddr(e[1], p.module.idgen) genCall(p, e, d) return - var a, b, call: TLoc assert(d.k == locNone) var x = e[1] if x.kind in {nkAddr, nkHiddenAddr}: x = x[0] - initLocExpr(p, x, a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, x) + var b = initLocExpr(p, e[2]) let t = skipTypes(e[1].typ, {tyVar}) - initLoc(call, locCall, e, OnHeap) + var call = initLoc(locCall, e, OnHeap) if not p.module.compileToCpp: - const setLenPattern = "($3) #setLengthSeqV2(&($1)->Sup, $4, $2)" - call.r = ropecg(p.module, setLenPattern, [ + const setLenPattern = "($3) #setLengthSeqV2(($1)?&($1)->Sup:NIM_NIL, $4, $2)" + call.snippet = ropecg(p.module, setLenPattern, [ rdLoc(a), rdLoc(b), getTypeDesc(p.module, t), genTypeInfoV1(p.module, t.skipTypes(abstractInst), e.info)]) else: const setLenPattern = "($3) #setLengthSeqV2($1, $4, $2)" - call.r = ropecg(p.module, setLenPattern, [ + call.snippet = ropecg(p.module, setLenPattern, [ rdLoc(a), rdLoc(b), getTypeDesc(p.module, t), genTypeInfoV1(p.module, t.skipTypes(abstractInst), e.info)]) @@ -1807,13 +1933,12 @@ proc genSetLengthStr(p: BProc, e: PNode, d: var TLoc) = if optSeqDestructors in p.config.globalOptions: binaryStmtAddr(p, e, d, "setLengthStrV2") else: - var a, b, call: TLoc if d.k != locNone: internalError(p.config, e.info, "genSetLengthStr") - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) - initLoc(call, locCall, e, OnHeap) - call.r = ropecg(p.module, "#setLengthStr($1, $2)", [ + var call = initLoc(locCall, e, OnHeap) + call.snippet = ropecg(p.module, "#setLengthStr($1, $2)", [ rdLoc(a), rdLoc(b)]) genAssignment(p, a, call, {}) gcUsage(p.config, e) @@ -1825,22 +1950,24 @@ proc genSwap(p: BProc, e: PNode, d: var TLoc) = # b = temp cowBracket(p, e[1]) cowBracket(p, e[2]) - var a, b, tmp: TLoc - getTemp(p, skipTypes(e[1].typ, abstractVar), tmp) - initLocExpr(p, e[1], a) # eval a - initLocExpr(p, e[2], b) # eval b + var tmp: TLoc = getTemp(p, skipTypes(e[1].typ, abstractVar)) + var a = initLocExpr(p, e[1]) # eval a + var b = initLocExpr(p, e[2]) # eval b genAssignment(p, tmp, a, {}) genAssignment(p, a, b, {}) genAssignment(p, b, tmp, {}) -proc rdSetElemLoc(conf: ConfigRef; a: TLoc, typ: PType): Rope = +proc rdSetElemLoc(conf: ConfigRef; a: TLoc, typ: PType; result: var Rope) = # read a location of an set element; it may need a subtraction operation # before the set operation - result = rdCharLoc(a) + result.add "(" + result.add rdCharLoc(a) let setType = typ.skipTypes(abstractPtrs) assert(setType.kind == tySet) if firstOrd(conf, setType) != 0: - result = "($1- $2)" % [result, rope(firstOrd(conf, setType))] + result.add " - " + result.add rope(firstOrd(conf, setType)) + result.add ")" proc fewCmps(conf: ConfigRef; s: PNode): bool = # this function estimates whether it is better to emit code @@ -1854,7 +1981,9 @@ proc fewCmps(conf: ConfigRef; s: PNode): bool = result = s.len <= 8 # 8 seems to be a good value template binaryExprIn(p: BProc, e: PNode, a, b, d: var TLoc, frmt: string) = - putIntoDest(p, d, e, frmt % [rdLoc(a), rdSetElemLoc(p.config, b, a.t)]) + var elem = newRopeAppender() + rdSetElemLoc(p.config, b, a.t, elem) + putIntoDest(p, d, e, frmt % [rdLoc(a), elem]) proc genInExprAux(p: BProc, e: PNode, a, b, d: var TLoc) = case int(getSize(p.config, skipTypes(e[1].typ, abstractVar))) @@ -1865,11 +1994,12 @@ proc genInExprAux(p: BProc, e: PNode, a, b, d: var TLoc) = else: binaryExprIn(p, e, a, b, d, "(($1[(NU)($2)>>3] &(1U<<((NU)($2)&7U)))!=0)") template binaryStmtInExcl(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a, b: TLoc assert(d.k == locNone) - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) - lineF(p, cpsStmts, frmt, [rdLoc(a), rdSetElemLoc(p.config, b, a.t)]) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) + var elem = newRopeAppender() + rdSetElemLoc(p.config, b, a.t, elem) + lineF(p, cpsStmts, frmt, [rdLoc(a), elem]) proc genInOp(p: BProc, e: PNode, d: var TLoc) = var a, b, x, y: TLoc @@ -1882,31 +2012,31 @@ proc genInOp(p: BProc, e: PNode, d: var TLoc) = e[2][0] else: e[2] - initLocExpr(p, ea, a) - initLoc(b, locExpr, e, OnUnknown) + a = initLocExpr(p, ea) + b = initLoc(locExpr, e, OnUnknown) if e[1].len > 0: - b.r = rope("(") + b.snippet = rope("(") for i in 0..<e[1].len: let it = e[1][i] if it.kind == nkRange: - initLocExpr(p, it[0], x) - initLocExpr(p, it[1], y) - b.r.addf("$1 >= $2 && $1 <= $3", + x = initLocExpr(p, it[0]) + y = initLocExpr(p, it[1]) + b.snippet.addf("$1 >= $2 && $1 <= $3", [rdCharLoc(a), rdCharLoc(x), rdCharLoc(y)]) else: - initLocExpr(p, it, x) - b.r.addf("$1 == $2", [rdCharLoc(a), rdCharLoc(x)]) - if i < e[1].len - 1: b.r.add(" || ") - b.r.add(")") + x = initLocExpr(p, it) + b.snippet.addf("$1 == $2", [rdCharLoc(a), rdCharLoc(x)]) + if i < e[1].len - 1: b.snippet.add(" || ") + b.snippet.add(")") else: # handle the case of an empty set - b.r = rope("0") - putIntoDest(p, d, e, b.r) + b.snippet = rope("0") + putIntoDest(p, d, e, b.snippet) else: assert(e[1].typ != nil) assert(e[2].typ != nil) - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) + a = initLocExpr(p, e[1]) + b = initLocExpr(p, e[2]) genInExprAux(p, e, a, b, d) proc genSetOp(p: BProc, e: PNode, d: var TLoc, op: TMagic) = @@ -1922,7 +2052,8 @@ proc genSetOp(p: BProc, e: PNode, d: var TLoc, op: TMagic) = "&", "|", "& ~"] - var a, b, i: TLoc + var a, b: TLoc + var i: TLoc var setType = skipTypes(e[1].typ, abstractVar) var size = int(getSize(p.config, setType)) case size @@ -1959,14 +2090,13 @@ proc genSetOp(p: BProc, e: PNode, d: var TLoc, op: TMagic) = of mIncl: binaryStmtInExcl(p, e, d, "$1[(NU)($2)>>3] |=(1U<<($2&7U));$n") of mExcl: binaryStmtInExcl(p, e, d, "$1[(NU)($2)>>3] &= ~(1U<<($2&7U));$n") of mCard: - var a: TLoc - initLocExpr(p, e[1], a) + var a: TLoc = initLocExpr(p, e[1]) putIntoDest(p, d, e, ropecg(p.module, "#cardSet($1, $2)", [rdCharLoc(a), size])) of mLtSet, mLeSet: - getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt), i) # our counter - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) - if d.k == locNone: getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyBool), d) + i = getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt)) # our counter + a = initLocExpr(p, e[1]) + b = initLocExpr(p, e[2]) + if d.k == locNone: d = getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyBool)) if op == mLtSet: linefmt(p, cpsStmts, lookupOpr[mLtSet], [rdLoc(i), size, rdLoc(d), rdLoc(a), rdLoc(b)]) @@ -1974,18 +2104,17 @@ proc genSetOp(p: BProc, e: PNode, d: var TLoc, op: TMagic) = linefmt(p, cpsStmts, lookupOpr[mLeSet], [rdLoc(i), size, rdLoc(d), rdLoc(a), rdLoc(b)]) of mEqSet: - var a, b: TLoc assert(e[1].typ != nil) assert(e[2].typ != nil) - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) putIntoDest(p, d, e, ropecg(p.module, "(#nimCmpMem($1, $2, $3)==0)", [a.rdCharLoc, b.rdCharLoc, size])) of mMulSet, mPlusSet, mMinusSet: # we inline the simple for loop for better code generation: - getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt), i) # our counter - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) - if d.k == locNone: getTemp(p, setType, d) + i = getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt)) # our counter + a = initLocExpr(p, e[1]) + b = initLocExpr(p, e[2]) + if d.k == locNone: d = getTemp(p, setType) lineF(p, cpsStmts, "for ($1 = 0; $1 < $2; $1++) $n" & " $3[$1] = $4[$1] $6 $5[$1];$n", [ @@ -2002,8 +2131,7 @@ proc genSomeCast(p: BProc, e: PNode, d: var TLoc) = ValueTypes = {tyTuple, tyObject, tyArray, tyOpenArray, tyVarargs, tyUncheckedArray} # we use whatever C gives us. Except if we have a value-type, we need to go # through its address: - var a: TLoc - initLocExpr(p, e[1], a) + var a: TLoc = initLocExpr(p, e[1]) let etyp = skipTypes(e.typ, abstractRange+{tyOwned}) let srcTyp = skipTypes(e[1].typ, abstractRange) if etyp.kind in ValueTypes and lfIndirect notin a.flags: @@ -2023,6 +2151,11 @@ proc genSomeCast(p: BProc, e: PNode, d: var TLoc) = elif etyp.kind == tyBool and srcTyp.kind in IntegralTypes: putIntoDest(p, d, e, "(($1) != 0)" % [rdCharLoc(a)], a.storage) else: + if etyp.kind == tyPtr: + # generates the definition of structs for casts like cast[ptr object](addr x)[] + let internalType = etyp.skipTypes({tyPtr}) + if internalType.kind == tyObject: + discard getTypeDesc(p.module, internalType) putIntoDest(p, d, e, "(($1) ($2))" % [getTypeDesc(p.module, e.typ), rdCharLoc(a)], a.storage) @@ -2035,10 +2168,17 @@ proc genCast(p: BProc, e: PNode, d: var TLoc) = # 'cast' and some float type involved? --> use a union. inc(p.labels) var lbl = p.labels.rope - var tmp: TLoc - tmp.r = "LOC$1.source" % [lbl] - linefmt(p, cpsLocals, "union { $1 source; $2 dest; } LOC$3;$n", - [getTypeDesc(p.module, e[1].typ), getTypeDesc(p.module, e.typ), lbl]) + var tmp: TLoc = default(TLoc) + tmp.snippet = "LOC$1.source" % [lbl] + let destsize = getSize(p.config, destt) + let srcsize = getSize(p.config, srct) + + if destsize > srcsize: + linefmt(p, cpsLocals, "union { $1 dest; $2 source; } LOC$3;$n #nimZeroMem(&LOC$3, sizeof(LOC$3));$n", + [getTypeDesc(p.module, e.typ), getTypeDesc(p.module, e[1].typ), lbl]) + else: + linefmt(p, cpsLocals, "union { $1 source; $2 dest; } LOC$3;$n", + [getTypeDesc(p.module, e[1].typ), getTypeDesc(p.module, e.typ), lbl]) tmp.k = locExpr tmp.lode = lodeTyp srct tmp.storage = OnStack @@ -2051,9 +2191,8 @@ proc genCast(p: BProc, e: PNode, d: var TLoc) = genSomeCast(p, e, d) proc genRangeChck(p: BProc, n: PNode, d: var TLoc) = - var a: TLoc + var a: TLoc = initLocExpr(p, n[0]) var dest = skipTypes(n.typ, abstractVar) - initLocExpr(p, n[0], a) if optRangeCheck notin p.options or (dest.kind in {tyUInt..tyUInt64} and checkUnsignedConversions notin p.config.legacyFeatures): discard "no need to generate a check because it was disabled" @@ -2062,50 +2201,71 @@ proc genRangeChck(p: BProc, n: PNode, d: var TLoc) = # emit range check: if n0t.kind in {tyUInt, tyUInt64}: - linefmt(p, cpsStmts, "if ($1 > ($6)($3)){ #raiseRangeErrorNoArgs(); $5}$n", - [rdCharLoc(a), genLiteral(p, n[1], dest), genLiteral(p, n[2], dest), - raiser, raiseInstr(p), getTypeDesc(p.module, n0t)]) + var first = newRopeAppender() + genLiteral(p, n[1], dest, first) + var last = newRopeAppender() + genLiteral(p, n[2], dest, last) + linefmt(p, cpsStmts, "if ($1 > ($5)($3)){ #raiseRangeErrorNoArgs(); ", + [rdCharLoc(a), first, last, + raiser, getTypeDesc(p.module, n0t)]) + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] + else: let raiser = case skipTypes(n.typ, abstractVarRange).kind of tyUInt..tyUInt64, tyChar: "raiseRangeErrorU" of tyFloat..tyFloat128: "raiseRangeErrorF" else: "raiseRangeErrorI" - discard cgsym(p.module, raiser) + cgsym(p.module, raiser) let boundaryCast = - if n0t.skipTypes(abstractVarRange).kind in {tyUInt, tyUInt32, tyUInt64} or - (n0t.sym != nil and sfSystemModule in n0t.sym.owner.flags and n0t.sym.name.s == "csize"): + if n0t.skipTypes(abstractVarRange).kind in {tyUInt, tyUInt32, tyUInt64}: "(NI64)" else: "" - linefmt(p, cpsStmts, "if ($6($1) < $2 || $6($1) > $3){ $4($1, $2, $3); $5}$n", - [rdCharLoc(a), genLiteral(p, n[1], dest), genLiteral(p, n[2], dest), - raiser, raiseInstr(p), boundaryCast]) - putIntoDest(p, d, n, "(($1) ($2))" % + var first = newRopeAppender() + genLiteral(p, n[1], dest, first) + var last = newRopeAppender() + genLiteral(p, n[2], dest, last) + linefmt(p, cpsStmts, "if ($5($1) < $2 || $5($1) > $3){ $4($1, $2, $3); ", + [rdCharLoc(a), first, last, + raiser, boundaryCast]) + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] + + if sameBackendTypeIgnoreRange(dest, n[0].typ): + # don't cast so an address can be taken for `var` conversions + putIntoDest(p, d, n, "($1)" % [rdCharLoc(a)], a.storage) + else: + putIntoDest(p, d, n, "(($1) ($2))" % [getTypeDesc(p.module, dest), rdCharLoc(a)], a.storage) proc genConv(p: BProc, e: PNode, d: var TLoc) = let destType = e.typ.skipTypes({tyVar, tyLent, tyGenericInst, tyAlias, tySink}) - if sameBackendType(destType, e[1].typ): + if sameBackendTypeIgnoreRange(destType, e[1].typ): expr(p, e[1], d) else: genSomeCast(p, e, d) proc convStrToCStr(p: BProc, n: PNode, d: var TLoc) = - var a: TLoc - initLocExpr(p, n[0], a) + var a: TLoc = initLocExpr(p, n[0]) putIntoDest(p, d, n, ropecg(p.module, "#nimToCStringConv($1)", [rdLoc(a)]), # "($1 ? $1->data : (NCSTRING)\"\")" % [a.rdLoc], a.storage) proc convCStrToStr(p: BProc, n: PNode, d: var TLoc) = - var a: TLoc - initLocExpr(p, n[0], a) - putIntoDest(p, d, n, - ropecg(p.module, "#cstrToNimstr($1)", [rdLoc(a)]), - a.storage) + var a: TLoc = initLocExpr(p, n[0]) + if p.module.compileToCpp: + # fixes for const qualifier; bug #12703; bug #19588 + putIntoDest(p, d, n, + ropecg(p.module, "#cstrToNimstr((NCSTRING) $1)", [rdLoc(a)]), + a.storage) + else: + putIntoDest(p, d, n, + ropecg(p.module, "#cstrToNimstr($1)", [rdLoc(a)]), + a.storage) gcUsage(p.config, n) proc genStrEquals(p: BProc, e: PNode, d: var TLoc) = @@ -2113,11 +2273,11 @@ proc genStrEquals(p: BProc, e: PNode, d: var TLoc) = var a = e[1] var b = e[2] if a.kind in {nkStrLit..nkTripleStrLit} and a.strVal == "": - initLocExpr(p, e[2], x) + x = initLocExpr(p, e[2]) putIntoDest(p, d, e, ropecg(p.module, "($1 == 0)", [lenExpr(p, x)])) elif b.kind in {nkStrLit..nkTripleStrLit} and b.strVal == "": - initLocExpr(p, e[1], x) + x = initLocExpr(p, e[1]) putIntoDest(p, d, e, ropecg(p.module, "($1 == 0)", [lenExpr(p, x)])) else: @@ -2126,49 +2286,80 @@ proc genStrEquals(p: BProc, e: PNode, d: var TLoc) = proc binaryFloatArith(p: BProc, e: PNode, d: var TLoc, m: TMagic) = if {optNaNCheck, optInfCheck} * p.options != {}: const opr: array[mAddF64..mDivF64, string] = ["+", "-", "*", "/"] - var a, b: TLoc assert(e[1].typ != nil) assert(e[2].typ != nil) - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) putIntoDest(p, d, e, ropecg(p.module, "(($4)($2) $1 ($4)($3))", [opr[m], rdLoc(a), rdLoc(b), getSimpleTypeDesc(p.module, e[1].typ)])) if optNaNCheck in p.options: - linefmt(p, cpsStmts, "if ($1 != $1){ #raiseFloatInvalidOp(); $2}$n", [rdLoc(d), raiseInstr(p)]) + linefmt(p, cpsStmts, "if ($1 != $1){ #raiseFloatInvalidOp(); ", [rdLoc(d)]) + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] + if optInfCheck in p.options: - linefmt(p, cpsStmts, "if ($1 != 0.0 && $1*0.5 == $1) { #raiseFloatOverflow($1); $2}$n", [rdLoc(d), raiseInstr(p)]) + linefmt(p, cpsStmts, "if ($1 != 0.0 && $1*0.5 == $1) { #raiseFloatOverflow($1); ", [rdLoc(d)]) + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] + else: binaryArith(p, e, d, m) -proc skipAddr(n: PNode): PNode = - result = if n.kind in {nkAddr, nkHiddenAddr}: n[0] else: n - proc genWasMoved(p: BProc; n: PNode) = var a: TLoc let n1 = n[1].skipAddr if p.withinBlockLeaveActions > 0 and notYetAlive(n1): discard else: - initLocExpr(p, n1, a) + a = initLocExpr(p, n1, {lfEnforceDeref}) resetLoc(p, a) #linefmt(p, cpsStmts, "#nimZeroMem((void*)$1, sizeof($2));$n", # [addrLoc(p.config, a), getTypeDesc(p.module, a.t)]) proc genMove(p: BProc; n: PNode; d: var TLoc) = - var a: TLoc - initLocExpr(p, n[1].skipAddr, a) + var a: TLoc = initLocExpr(p, n[1].skipAddr) if n.len == 4: # generated by liftdestructors: - var src: TLoc - initLocExpr(p, n[2], src) + var src: TLoc = initLocExpr(p, n[2]) linefmt(p, cpsStmts, "if ($1.p != $2.p) {", [rdLoc(a), rdLoc(src)]) genStmts(p, n[3]) linefmt(p, cpsStmts, "}$n$1.len = $2.len; $1.p = $2.p;$n", [rdLoc(a), rdLoc(src)]) else: - if d.k == locNone: getTemp(p, n.typ, d) - genAssignment(p, d, a, {}) - resetLoc(p, a) + if d.k == locNone: d = getTemp(p, n.typ) + if p.config.selectedGC in {gcArc, gcAtomicArc, gcOrc}: + genAssignment(p, d, a, {}) + var op = getAttachedOp(p.module.g.graph, n.typ, attachedWasMoved) + if op == nil: + resetLoc(p, a) + else: + var b = initLocExpr(p, newSymNode(op)) + case skipTypes(a.t, abstractVar+{tyStatic}).kind + of tyOpenArray, tyVarargs: # todo fixme generated `wasMoved` hooks for + # openarrays, but it probably shouldn't? + var s: string + if reifiedOpenArray(a.lode): + if a.t.kind in {tyVar, tyLent}: + s = "$1->Field0, $1->Field1" % [rdLoc(a)] + else: + s = "$1.Field0, $1.Field1" % [rdLoc(a)] + else: + s = "$1, $1Len_0" % [rdLoc(a)] + linefmt(p, cpsStmts, "$1($2);$n", [rdLoc(b), s]) + else: + if p.module.compileToCpp: + linefmt(p, cpsStmts, "$1($2);$n", [rdLoc(b), rdLoc(a)]) + else: + linefmt(p, cpsStmts, "$1($2);$n", [rdLoc(b), byRefLoc(p, a)]) + else: + if n[1].kind == nkSym and isSinkParam(n[1].sym): + var tmp = getTemp(p, n[1].typ.skipTypes({tySink})) + genAssignment(p, tmp, a, {needToCopySinkParam}) + genAssignment(p, d, tmp, {}) + resetLoc(p, tmp) + else: + genAssignment(p, d, a, {}) + resetLoc(p, a) proc genDestroy(p: BProc; n: PNode) = if optSeqDestructors in p.config.globalOptions: @@ -2176,8 +2367,7 @@ proc genDestroy(p: BProc; n: PNode) = let t = arg.typ.skipTypes(abstractInst) case t.kind of tyString: - var a: TLoc - initLocExpr(p, arg, a) + var a: TLoc = initLocExpr(p, arg) if optThreads in p.config.globalOptions: linefmt(p, cpsStmts, "if ($1.p && !($1.p->cap & NIM_STRLIT_FLAG)) {$n" & " #deallocShared($1.p);$n" & @@ -2187,12 +2377,11 @@ proc genDestroy(p: BProc; n: PNode) = " #dealloc($1.p);$n" & "}$n", [rdLoc(a)]) of tySequence: - var a: TLoc - initLocExpr(p, arg, a) + var a: TLoc = initLocExpr(p, arg) linefmt(p, cpsStmts, "if ($1.p && !($1.p->cap & NIM_STRLIT_FLAG)) {$n" & " #alignedDealloc($1.p, NIM_ALIGNOF($2));$n" & "}$n", - [rdLoc(a), getTypeDesc(p.module, t.lastSon)]) + [rdLoc(a), getTypeDesc(p.module, t.elementType)]) else: discard "nothing to do" else: let t = n[1].typ.skipTypes(abstractVar) @@ -2203,10 +2392,9 @@ proc genDestroy(p: BProc; n: PNode) = proc genDispose(p: BProc; n: PNode) = when false: - let elemType = n[1].typ.skipTypes(abstractVar).lastSon + let elemType = n[1].typ.skipTypes(abstractVar).elementType - var a: TLoc - initLocExpr(p, n[1].skipAddr, a) + var a: TLoc = initLocExpr(p, n[1].skipAddr) if isFinal(elemType): if elemType.destructor != nil: @@ -2219,8 +2407,11 @@ proc genDispose(p: BProc; n: PNode) = lineCg(p, cpsStmts, ["#nimDestroyAndDispose($#)", rdLoc(a)]) proc genSlice(p: BProc; e: PNode; d: var TLoc) = - let (x, y) = genOpenArraySlice(p, e, e.typ, e.typ.lastSon) - if d.k == locNone: getTemp(p, e.typ, d) + let (x, y) = genOpenArraySlice(p, e, e.typ, e.typ.elementType, + prepareForMutation = e[1].kind == nkHiddenDeref and + e[1].typ.skipTypes(abstractInst).kind == tyString and + p.config.selectedGC in {gcArc, gcAtomicArc, gcOrc}) + if d.k == locNone: d = getTemp(p, e.typ) 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'; " & @@ -2255,11 +2446,10 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = if optOverflowCheck notin p.options or underlying.kind in {tyUInt..tyUInt64}: binaryStmt(p, e, d, opr[op]) else: - var a, b: TLoc assert(e[1].typ != nil) assert(e[2].typ != nil) - initLocExpr(p, e[1], a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) let ranged = skipTypes(e[1].typ, {tyGenericInst, tyAlias, tySink, tyVar, tyLent, tyDistinct}) let res = binaryArithOverflowRaw(p, ranged, a, b, @@ -2273,11 +2463,10 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = if optSeqDestructors in p.config.globalOptions: binaryStmtAddr(p, e, d, "nimAddCharV1") else: - var dest, b, call: TLoc - initLoc(call, locCall, e, OnHeap) - initLocExpr(p, e[1], dest) - initLocExpr(p, e[2], b) - call.r = ropecg(p.module, "#addChar($1, $2)", [rdLoc(dest), rdLoc(b)]) + var call = initLoc(locCall, e, OnHeap) + var dest = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) + call.snippet = ropecg(p.module, "#addChar($1, $2)", [rdLoc(dest), rdLoc(b)]) genAssignment(p, dest, call, {}) of mAppendStrStr: genStrAppend(p, e, d) of mAppendSeqElem: @@ -2290,14 +2479,16 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = of mLeStr: binaryExpr(p, e, d, "(#cmpStrings($1, $2) <= 0)") of mLtStr: binaryExpr(p, e, d, "(#cmpStrings($1, $2) < 0)") of mIsNil: genIsNil(p, e, d) - of mIntToStr: genDollar(p, e, d, "#nimIntToStr($1)") - of mInt64ToStr: genDollar(p, e, d, "#nimInt64ToStr($1)") of mBoolToStr: genDollar(p, e, d, "#nimBoolToStr($1)") of mCharToStr: genDollar(p, e, d, "#nimCharToStr($1)") - of mFloatToStr: genDollar(p, e, d, "#nimFloatToStr($1)") - of mCStrToStr: genDollar(p, e, d, "#cstrToNimstr($1)") + of mCStrToStr: + if p.module.compileToCpp: + # fixes for const qualifier; bug #12703; bug #19588 + genDollar(p, e, d, "#cstrToNimstr((NCSTRING) $1)") + else: + genDollar(p, e, d, "#cstrToNimstr($1)") of mStrToStr, mUnown: expr(p, e[1], d) - of mIsolate: genCall(p, e, d) + of generatedMagics: genCall(p, e, d) of mEnumToStr: if optTinyRtti in p.config.globalOptions: genEnumToStr(p, e, d) @@ -2307,20 +2498,24 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = of mNew: genNew(p, e) of mNewFinalize: if optTinyRtti in p.config.globalOptions: - var a: TLoc - initLocExpr(p, e[1], a) - rawGenNew(p, a, nil, needsInit = true) + var a: TLoc = initLocExpr(p, e[1]) + rawGenNew(p, a, "", needsInit = true) gcUsage(p.config, e) else: genNewFinalize(p, e) - of mNewSeq: genNewSeq(p, e) + of mNewSeq: + if optSeqDestructors in p.config.globalOptions: + e[1] = makeAddr(e[1], p.module.idgen) + genCall(p, e, d) + else: + genNewSeq(p, e) of mNewSeqOfCap: genNewSeqOfCap(p, e, d) of mSizeOf: let t = e[1].typ.skipTypes({tyTypeDesc}) - putIntoDest(p, d, e, "((NI)sizeof($1))" % [getTypeDesc(p.module, t, skVar)]) + putIntoDest(p, d, e, "((NI)sizeof($1))" % [getTypeDesc(p.module, t, dkVar)]) of mAlignOf: let t = e[1].typ.skipTypes({tyTypeDesc}) - putIntoDest(p, d, e, "((NI)NIM_ALIGNOF($1))" % [getTypeDesc(p.module, t, skVar)]) + putIntoDest(p, d, e, "((NI)NIM_ALIGNOF($1))" % [getTypeDesc(p.module, t, dkVar)]) of mOffsetOf: var dotExpr: PNode if e[1].kind == nkDotExpr: @@ -2328,20 +2523,25 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = elif e[1].kind == nkCheckedFieldExpr: dotExpr = e[1][0] else: + dotExpr = nil internalError(p.config, e.info, "unknown ast") let t = dotExpr[0].typ.skipTypes({tyTypeDesc}) - let tname = getTypeDesc(p.module, t, skVar) + let tname = getTypeDesc(p.module, t, dkVar) let member = if t.kind == tyTuple: "Field" & rope(dotExpr[1].sym.position) - else: dotExpr[1].sym.loc.r + else: dotExpr[1].sym.loc.snippet putIntoDest(p,d,e, "((NI)offsetof($1, $2))" % [tname, member]) of mChr: genSomeCast(p, e, d) of mOrd: genOrd(p, e, d) of mLengthArray, mHigh, mLengthStr, mLengthSeq, mLengthOpenArray: genArrayLen(p, e, d, op) - of mGCref: unaryStmt(p, e, d, "if ($1) { #nimGCref($1); }$n") - of mGCunref: unaryStmt(p, e, d, "if ($1) { #nimGCunref($1); }$n") + of mGCref: + # only a magic for the old GCs + unaryStmt(p, e, d, "if ($1) { #nimGCref($1); }$n") + of mGCunref: + # only a magic for the old GCs + unaryStmt(p, e, d, "if ($1) { #nimGCunref($1); }$n") of mSetLengthStr: genSetLengthStr(p, e, d) of mSetLengthSeq: genSetLengthSeq(p, e, d) of mIncl, mExcl, mCard, mLtSet, mLeSet, mEqSet, mMulSet, mPlusSet, mMinusSet, @@ -2353,8 +2553,8 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = # - not sure, and it wouldn't work if the symbol behind the magic isn't # somehow forward-declared from some other usage, but it is *possible* if lfNoDecl notin opr.loc.flags: - let prc = magicsys.getCompilerProc(p.module.g.graph, $opr.loc.r) - assert prc != nil, $opr.loc.r + let prc = magicsys.getCompilerProc(p.module.g.graph, $opr.loc.snippet) + assert prc != nil, $opr.loc.snippet # HACK: # Explicitly add this proc as declared here so the cgsym call doesn't # add a forward declaration - without this we could end up with the same @@ -2367,46 +2567,50 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = let wasDeclared = containsOrIncl(p.module.declaredProtos, prc.id) # Make the function behind the magic get actually generated - this will # not lead to a forward declaration! The genCall will lead to one. - discard cgsym(p.module, $opr.loc.r) + cgsym(p.module, $opr.loc.snippet) # make sure we have pointer-initialising code for hot code reloading if not wasDeclared and p.hcrOn: p.module.s[cfsDynLibInit].addf("\t$1 = ($2) hcrGetProc($3, \"$1\");$n", [mangleDynLibProc(prc), getTypeDesc(p.module, prc.loc.t), getModuleDllPath(p.module, prc)]) genCall(p, e, d) - of mDefault: genDefault(p, e, d) - of mReset: genReset(p, e) + of mDefault, mZeroDefault: genDefault(p, e, d) 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)) of mSpawn: when defined(leanCompiler): - quit "compiler built without support for the 'spawn' statement" + 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) expr(p, n, d) of mParallel: when defined(leanCompiler): - quit "compiler built without support for the 'parallel' statement" + p.config.quitOrRaise "compiler built without support for the 'parallel' statement" else: let n = semparallel.liftParallel(p.module.g.graph, p.module.idgen, p.module.module, e) expr(p, n, d) of mDeepCopy: - if p.config.selectedGC in {gcArc, gcOrc} and optEnableDeepCopy notin p.config.globalOptions: + if p.config.selectedGC in {gcArc, gcAtomicArc, 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") + "for --mm:arc|atomicArc|orc 'deepcopy' support has to be enabled with --deepcopy:on") - var a, b: TLoc let x = if e[1].kind in {nkAddr, nkHiddenAddr}: e[1][0] else: e[1] - initLocExpr(p, x, a) - initLocExpr(p, e[2], b) + var a = initLocExpr(p, x) + var b = initLocExpr(p, e[2]) genDeepCopy(p, a, b) of mDotDot, mEqCString: genCall(p, e, d) of mWasMoved: genWasMoved(p, e) of mMove: genMove(p, e, d) of mDestroy: genDestroy(p, e) of mAccessEnv: unaryExpr(p, e, d, "$1.ClE_0") + of mAccessTypeField: genAccessTypeField(p, e, d) of mSlice: genSlice(p, e, d) + of mTrace: discard "no code to generate" + of mEnsureMove: + expr(p, e[1], d) + of mDup: + expr(p, e[1], d) else: when defined(debugMagics): echo p.prc.name.s, " ", p.prc.id, " ", p.prc.flags, " ", p.prc.ast[genericParamsPos].kind @@ -2418,60 +2622,90 @@ proc genSetConstr(p: BProc, e: PNode, d: var TLoc) = # nimZeroMem(tmp, sizeof(tmp)); inclRange(tmp, a, b); incl(tmp, c); # incl(tmp, d); incl(tmp, e); inclRange(tmp, f, g); var - a, b, idx: TLoc + a, b: TLoc + var idx: TLoc if nfAllConst in e.flags: - putIntoDest(p, d, e, genSetNode(p, e)) + var elem = newRopeAppender() + genSetNode(p, e, elem) + putIntoDest(p, d, e, elem) else: - if d.k == locNone: getTemp(p, e.typ, d) + if d.k == locNone: d = getTemp(p, e.typ) if getSize(p.config, e.typ) > 8: # big set: linefmt(p, cpsStmts, "#nimZeroMem($1, sizeof($2));$n", [rdLoc(d), getTypeDesc(p.module, e.typ)]) for it in e.sons: if it.kind == nkRange: - getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt), idx) # our counter - initLocExpr(p, it[0], a) - initLocExpr(p, it[1], b) + idx = getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt)) # our counter + a = initLocExpr(p, it[0]) + b = initLocExpr(p, it[1]) + var aa = newRopeAppender() + rdSetElemLoc(p.config, a, e.typ, aa) + var bb = newRopeAppender() + rdSetElemLoc(p.config, b, e.typ, bb) lineF(p, cpsStmts, "for ($1 = $3; $1 <= $4; $1++) $n" & "$2[(NU)($1)>>3] |=(1U<<((NU)($1)&7U));$n", [rdLoc(idx), rdLoc(d), - rdSetElemLoc(p.config, a, e.typ), rdSetElemLoc(p.config, b, e.typ)]) + aa, bb]) else: - initLocExpr(p, it, a) + a = initLocExpr(p, it) + var aa = newRopeAppender() + rdSetElemLoc(p.config, a, e.typ, aa) lineF(p, cpsStmts, "$1[(NU)($2)>>3] |=(1U<<((NU)($2)&7U));$n", - [rdLoc(d), rdSetElemLoc(p.config, a, e.typ)]) + [rdLoc(d), aa]) else: # small set var ts = "NU" & $(getSize(p.config, e.typ) * 8) lineF(p, cpsStmts, "$1 = 0;$n", [rdLoc(d)]) for it in e.sons: if it.kind == nkRange: - getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt), idx) # our counter - initLocExpr(p, it[0], a) - initLocExpr(p, it[1], b) + idx = getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt)) # our counter + a = initLocExpr(p, it[0]) + b = initLocExpr(p, it[1]) + var aa = newRopeAppender() + rdSetElemLoc(p.config, a, e.typ, aa) + var bb = newRopeAppender() + rdSetElemLoc(p.config, b, e.typ, bb) + lineF(p, cpsStmts, "for ($1 = $3; $1 <= $4; $1++) $n" & "$2 |=(($5)(1)<<(($1)%(sizeof($5)*8)));$n", [ - rdLoc(idx), rdLoc(d), rdSetElemLoc(p.config, a, e.typ), - rdSetElemLoc(p.config, b, e.typ), rope(ts)]) + rdLoc(idx), rdLoc(d), aa, bb, rope(ts)]) else: - initLocExpr(p, it, a) + a = initLocExpr(p, it) + var aa = newRopeAppender() + rdSetElemLoc(p.config, a, e.typ, aa) lineF(p, cpsStmts, "$1 |=(($3)(1)<<(($2)%(sizeof($3)*8)));$n", - [rdLoc(d), rdSetElemLoc(p.config, a, e.typ), rope(ts)]) + [rdLoc(d), aa, rope(ts)]) proc genTupleConstr(p: BProc, n: PNode, d: var TLoc) = var rec: TLoc if not handleConstExpr(p, n, d): let t = n.typ discard getTypeDesc(p.module, t) # so that any fields are initialized - if d.k == locNone: getTemp(p, t, d) + + var tmp: TLoc = default(TLoc) + # bug #16331 + let doesAlias = lhsDoesAlias(d.lode, n) + let dest = if doesAlias: addr(tmp) else: addr(d) + if doesAlias: + tmp = getTemp(p, n.typ) + elif d.k == locNone: + d = getTemp(p, n.typ) + for i in 0..<n.len: var it = n[i] if it.kind == nkExprColonExpr: it = it[1] - initLoc(rec, locExpr, it, d.storage) - rec.r = "$1.Field$2" % [rdLoc(d), rope(i)] + rec = initLoc(locExpr, it, dest[].storage) + rec.snippet = "$1.Field$2" % [rdLoc(dest[]), rope(i)] rec.flags.incl(lfEnforceDeref) expr(p, it, rec) + if doesAlias: + if d.k == locNone: + d = tmp + else: + genAssignment(p, d, tmp, {}) + proc isConstClosure(n: PNode): bool {.inline.} = result = n[0].kind == nkSym and isRoutine(n[0].sym) and n[1].kind == nkNilLit @@ -2482,13 +2716,15 @@ proc genClosure(p: BProc, n: PNode, d: var TLoc) = if isConstClosure(n): inc(p.module.labels) var tmp = "CNSTCLOSURE" & rope(p.module.labels) - p.module.s[cfsData].addf("static NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(p.module, n.typ), tmp, genBracedInit(p, n, isConst = true, n.typ)]) + var data = "static NIM_CONST $1 $2 = " % [getTypeDesc(p.module, n.typ), tmp] + genBracedInit(p, n, isConst = true, n.typ, data) + data.addf(";$n", []) + p.module.s[cfsData].add data putIntoDest(p, d, n, tmp, OnStatic) else: - var tmp, a, b: TLoc - initLocExpr(p, n[0], a) - initLocExpr(p, n[1], b) + var tmp: TLoc + var a = initLocExpr(p, n[0]) + var b = initLocExpr(p, n[1]) if n[0].skipConv.kind == nkClosure: internalError(p.config, n.info, "closure to closure created") # tasyncawait.nim breaks with this optimization: @@ -2497,7 +2733,7 @@ proc genClosure(p: BProc, n: PNode, d: var TLoc) = linefmt(p, cpsStmts, "$1.ClP_0 = $2; $1.ClE_0 = $3;$n", [d.rdLoc, a.rdLoc, b.rdLoc]) else: - getTemp(p, n.typ, tmp) + tmp = getTemp(p, n.typ) linefmt(p, cpsStmts, "$1.ClP_0 = $2; $1.ClE_0 = $3;$n", [tmp.rdLoc, a.rdLoc, b.rdLoc]) putLocIntoDest(p, d, tmp) @@ -2505,15 +2741,17 @@ proc genClosure(p: BProc, n: PNode, d: var TLoc) = proc genArrayConstr(p: BProc, n: PNode, d: var TLoc) = var arr: TLoc if not handleConstExpr(p, n, d): - if d.k == locNone: getTemp(p, n.typ, d) + if d.k == locNone: d = getTemp(p, n.typ) for i in 0..<n.len: - initLoc(arr, locExpr, lodeTyp elemType(skipTypes(n.typ, abstractInst)), d.storage) - arr.r = "$1[$2]" % [rdLoc(d), intLiteral(i)] + arr = initLoc(locExpr, lodeTyp elemType(skipTypes(n.typ, abstractInst)), d.storage) + var lit = newRopeAppender() + intLiteral(i, lit) + arr.snippet = "$1[$2]" % [rdLoc(d), lit] expr(p, n[i], arr) proc genComplexConst(p: BProc, sym: PSym, d: var TLoc) = requestConstImpl(p, sym) - assert((sym.loc.r != nil) and (sym.loc.t != nil)) + assert((sym.loc.snippet != "") and (sym.loc.t != nil)) putLocIntoDest(p, d, sym.loc) template genStmtListExprImpl(exprOrStmt) {.dirty.} = @@ -2521,11 +2759,11 @@ template genStmtListExprImpl(exprOrStmt) {.dirty.} = let hasNimFrame = p.prc != nil and sfSystemModule notin p.module.module.flags and optStackTrace in p.prc.options - var frameName: Rope = nil + var frameName: Rope = "" for i in 0..<n.len - 1: let it = n[i] if it.kind == nkComesFrom: - if hasNimFrame and frameName == nil: + if hasNimFrame and frameName == "": inc p.labels frameName = "FR" & rope(p.labels) & "_" let theMacro = it[0].sym @@ -2535,7 +2773,7 @@ template genStmtListExprImpl(exprOrStmt) {.dirty.} = else: genStmts(p, it) if n.len > 0: exprOrStmt - if frameName != nil: + if frameName != "": p.s(cpsStmts).add deinitFrameNoDebug(p, frameName) proc genStmtListExpr(p: BProc, n: PNode, d: var TLoc) = @@ -2549,22 +2787,32 @@ proc genStmtList(p: BProc, n: PNode) = from parampatterns import isLValue proc upConv(p: BProc, n: PNode, d: var TLoc) = - var a: TLoc - initLocExpr(p, n[0], a) + var a: TLoc = initLocExpr(p, n[0]) let dest = skipTypes(n.typ, abstractPtrs) if optObjCheck in p.options and not isObjLackingTypeField(dest): - var nilCheck = Rope(nil) - let r = rdMType(p, a, nilCheck) - let checkFor = if optTinyRtti in p.config.globalOptions: - genTypeInfo2Name(p.module, dest) - else: - genTypeInfoV1(p.module, dest, n.info) - if nilCheck != nil: - linefmt(p, cpsStmts, "if ($1 && !#isObj($2, $3)){ #raiseObjectConversionError(); $4}$n", - [nilCheck, r, checkFor, raiseInstr(p)]) - else: - linefmt(p, cpsStmts, "if (!#isObj($1, $2)){ #raiseObjectConversionError(); $3}$n", - [r, checkFor, raiseInstr(p)]) + var nilCheck = "" + var r = newRopeAppender() + rdMType(p, a, nilCheck, r) + if optTinyRtti in p.config.globalOptions: + let checkFor = $getObjDepth(dest) + let token = $genDisplayElem(MD5Digest(hashType(dest, p.config))) + if nilCheck != "": + linefmt(p, cpsStmts, "if ($1 && !#isObjDisplayCheck($2, $3, $4)){ #raiseObjectConversionError(); ", + [nilCheck, r, checkFor, token]) + else: + linefmt(p, cpsStmts, "if (!#isObjDisplayCheck($1, $2, $3)){ #raiseObjectConversionError(); ", + [r, checkFor, token]) + else: + let checkFor = genTypeInfoV1(p.module, dest, n.info) + if nilCheck != "": + linefmt(p, cpsStmts, "if ($1 && !#isObj($2, $3)){ #raiseObjectConversionError(); ", + [nilCheck, r, checkFor]) + else: + linefmt(p, cpsStmts, "if (!#isObj($1, $2)){ #raiseObjectConversionError(); ", + [r, checkFor]) + raiseInstr(p, p.s(cpsStmts)) + linefmt p, cpsStmts, "}$n", [] + if n[0].typ.kind != tyObject: if n.isLValue: putIntoDest(p, d, n, @@ -2590,16 +2838,14 @@ proc downConv(p: BProc, n: PNode, d: var TLoc) = # (see bug #837). However sometimes using a temporary is not correct: # init(TFigure(my)) # where it is passed to a 'var TFigure'. We test # this by ensuring the destination is also a pointer: - var a: TLoc - initLocExpr(p, arg, a) + var a: TLoc = initLocExpr(p, arg) putIntoDest(p, d, n, "(*(($1*) (&($2))))" % [getTypeDesc(p.module, n.typ), rdLoc(a)], a.storage) elif p.module.compileToCpp: # C++ implicitly downcasts for us expr(p, arg, d) else: - var a: TLoc - initLocExpr(p, arg, a) + var a: TLoc = initLocExpr(p, arg) var r = rdLoc(a) & (if isRef: "->Sup" else: ".Sup") for i in 2..abs(inheritanceDiff(dest, src)): r.add(".Sup") putIntoDest(p, d, n, if isRef: "&" & r else: r, a.storage) @@ -2613,8 +2859,10 @@ proc exprComplexConst(p: BProc, n: PNode, d: var TLoc) = if id == p.module.labels: # expression not found in the cache: inc(p.module.labels) - p.module.s[cfsData].addf("static NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(p.module, t, skConst), tmp, genBracedInit(p, n, isConst = true, t)]) + p.module.s[cfsData].addf("static NIM_CONST $1 $2 = ", + [getTypeDesc(p.module, t, dkConst), tmp]) + genBracedInit(p, n, isConst = true, t, p.module.s[cfsData]) + p.module.s[cfsData].addf(";$n", []) if d.k == locNone: fillLoc(d, locData, n, tmp, OnStatic) @@ -2629,42 +2877,48 @@ proc genConstSetup(p: BProc; sym: PSym): bool = let m = p.module useHeader(m, sym) if sym.loc.k == locNone: - fillLoc(sym.loc, locData, sym.ast, mangleName(p.module, sym), OnStatic) + fillBackendName(p.module, sym) + fillLoc(sym.loc, locData, sym.astdef, OnStatic) if m.hcrOn: incl(sym.loc.flags, lfIndirect) result = lfNoDecl notin sym.loc.flags proc genConstHeader(m, q: BModule; p: BProc, sym: PSym) = - assert(sym.loc.r != nil) + if sym.loc.snippet == "": + if not genConstSetup(p, sym): return + assert(sym.loc.snippet != "", $sym.name.s & $sym.itemId) if m.hcrOn: - m.s[cfsVars].addf("static $1* $2;$n", [getTypeDesc(m, sym.loc.t, skVar), sym.loc.r]); + m.s[cfsVars].addf("static $1* $2;$n", [getTypeDesc(m, sym.loc.t, dkVar), sym.loc.snippet]); m.initProc.procSec(cpsLocals).addf( - "\t$1 = ($2*)hcrGetGlobal($3, \"$1\");$n", [sym.loc.r, - getTypeDesc(m, sym.loc.t, skVar), getModuleDllPath(q, sym)]) + "\t$1 = ($2*)hcrGetGlobal($3, \"$1\");$n", [sym.loc.snippet, + getTypeDesc(m, sym.loc.t, dkVar), getModuleDllPath(q, sym)]) else: let headerDecl = "extern NIM_CONST $1 $2;$n" % - [getTypeDesc(m, sym.loc.t, skVar), sym.loc.r] + [getTypeDesc(m, sym.loc.t, dkVar), sym.loc.snippet] m.s[cfsData].add(headerDecl) if sfExportc in sym.flags and p.module.g.generatedHeader != nil: p.module.g.generatedHeader.s[cfsData].add(headerDecl) proc genConstDefinition(q: BModule; p: BProc; sym: PSym) = # add a suffix for hcr - will later init the global pointer with this data - let actualConstName = if q.hcrOn: sym.loc.r & "_const" else: sym.loc.r - q.s[cfsData].addf("N_LIB_PRIVATE NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(q, sym.typ), actualConstName, - genBracedInit(q.initProc, sym.ast, isConst = true, sym.typ)]) + let actualConstName = if q.hcrOn: sym.loc.snippet & "_const" else: sym.loc.snippet + var data = newRopeAppender() + data.addf("N_LIB_PRIVATE NIM_CONST $1 $2 = ", + [getTypeDesc(q, sym.typ), actualConstName]) + genBracedInit(q.initProc, sym.astdef, isConst = true, sym.typ, data) + data.addf(";$n", []) + q.s[cfsData].add data if q.hcrOn: # generate the global pointer with the real name - q.s[cfsVars].addf("static $1* $2;$n", [getTypeDesc(q, sym.loc.t, skVar), sym.loc.r]) + q.s[cfsVars].addf("static $1* $2;$n", [getTypeDesc(q, sym.loc.t, dkVar), sym.loc.snippet]) # register it (but ignore the boolean result of hcrRegisterGlobal) q.initProc.procSec(cpsLocals).addf( "\thcrRegisterGlobal($1, \"$2\", sizeof($3), NULL, (void**)&$2);$n", - [getModuleDllPath(q, sym), sym.loc.r, rdLoc(sym.loc)]) + [getModuleDllPath(q, sym), sym.loc.snippet, rdLoc(sym.loc)]) # always copy over the contents of the actual constant with the _const # suffix ==> this means that the constant is reloadable & updatable! q.initProc.procSec(cpsLocals).add(ropecg(q, "\t#nimCopyMem((void*)$1, (NIM_CONST void*)&$2, sizeof($3));$n", - [sym.loc.r, actualConstName, rdLoc(sym.loc)])) + [sym.loc.snippet, actualConstName, rdLoc(sym.loc)])) proc genConstStmt(p: BProc, n: PNode) = # This code is only used in the new DCE implementation. @@ -2677,7 +2931,7 @@ proc genConstStmt(p: BProc, n: PNode) = genConstDefinition(m, p, sym) proc expr(p: BProc, n: PNode, d: var TLoc) = - when defined(nimCompilerStackraceHints): + when defined(nimCompilerStacktraceHints): setFrameMsg p.config$n.info & " " & $n.kind p.currLineInfo = n.info @@ -2704,15 +2958,17 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = genProcPrototype(p.module, sym) else: genProc(p.module, sym) - if sym.loc.r == nil or sym.loc.lode == nil: + if sym.loc.snippet == "" or sym.loc.lode == nil: internalError(p.config, n.info, "expr: proc not init " & sym.name.s) putLocIntoDest(p, d, sym.loc) of skConst: if isSimpleConst(sym.typ): - putIntoDest(p, d, n, genLiteral(p, sym.ast, sym.typ), OnStatic) + var lit = newRopeAppender() + genLiteral(p, sym.astdef, sym.typ, lit) + putIntoDest(p, d, n, lit, OnStatic) elif useAliveDataFromDce in p.module.flags: genConstHeader(p.module, p.module, p, sym) - assert((sym.loc.r != nil) and (sym.loc.t != nil)) + assert((sym.loc.snippet != "") and (sym.loc.t != nil)) putLocIntoDest(p, d, sym.loc) else: genComplexConst(p, sym, d) @@ -2727,14 +2983,14 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = if sfCompileTime in sym.flags: genSingleVar(p, sym, n, astdef(sym)) - if sym.loc.r == nil or sym.loc.t == nil: + if sym.loc.snippet == "" or sym.loc.t == nil: #echo "FAILED FOR PRCO ", p.prc.name.s #echo renderTree(p.prc.ast, {renderIds}) internalError p.config, n.info, "expr: var not init " & sym.name.s & "_" & $sym.id if sfThread in sym.flags: accessThreadLocalVar(p, sym) if emulatedThreadVars(p.config): - putIntoDest(p, d, sym.loc.lode, "NimTV_->" & sym.loc.r) + putIntoDest(p, d, sym.loc.lode, "NimTV_->" & sym.loc.snippet) else: putLocIntoDest(p, d, sym.loc) else: @@ -2742,17 +2998,17 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = of skTemp: when false: # this is more harmful than helpful. - if sym.loc.r == nil: + if sym.loc.snippet == "": # we now support undeclared 'skTemp' variables for easier # transformations in other parts of the compiler: assignLocalVar(p, n) - if sym.loc.r == nil or sym.loc.t == nil: + if sym.loc.snippet == "" or sym.loc.t == nil: #echo "FAILED FOR PRCO ", p.prc.name.s #echo renderTree(p.prc.ast, {renderIds}) internalError(p.config, n.info, "expr: temp not init " & sym.name.s & "_" & $sym.id) putLocIntoDest(p, d, sym.loc) of skParam: - if sym.loc.r == nil or sym.loc.t == nil: + if sym.loc.snippet == "" or sym.loc.t == nil: # echo "FAILED FOR PRCO ", p.prc.name.s # debug p.prc.typ.n # echo renderTree(p.prc.ast, {renderIds}) @@ -2761,19 +3017,24 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = else: internalError(p.config, n.info, "expr(" & $sym.kind & "); unknown symbol") of nkNilLit: if not isEmptyType(n.typ): - putIntoDest(p, d, n, genLiteral(p, n)) + var lit = newRopeAppender() + genLiteral(p, n, lit) + putIntoDest(p, d, n, lit) of nkStrLit..nkTripleStrLit: - putDataIntoDest(p, d, n, genLiteral(p, n)) - of nkIntLit..nkUInt64Lit, - nkFloatLit..nkFloat128Lit, nkCharLit: - putIntoDest(p, d, n, genLiteral(p, n)) + var lit = newRopeAppender() + genLiteral(p, n, lit) + putDataIntoDest(p, d, n, lit) + of nkIntLit..nkUInt64Lit, nkFloatLit..nkFloat128Lit, nkCharLit: + var lit = newRopeAppender() + genLiteral(p, n, lit) + putIntoDest(p, d, n, lit) of nkCall, nkHiddenCallConv, nkInfix, nkPrefix, nkPostfix, nkCommand, nkCallStrLit: genLineDir(p, n) # may be redundant, it is generated in fixupCall as well let op = n[0] if n.typ.isNil: # discard the value: - var a: TLoc + var a: TLoc = default(TLoc) if op.kind == nkSym and op.sym.magic != mNone: genMagicExpr(p, n, a, op.sym.magic) else: @@ -2786,7 +3047,9 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = genCall(p, n, d) of nkCurly: if isDeepConstExpr(n) and n.len != 0: - putIntoDest(p, d, n, genSetNode(p, n)) + var lit = newRopeAppender() + genSetNode(p, n, lit) + putIntoDest(p, d, n, lit) else: genSetConstr(p, n, d) of nkBracket: @@ -2806,7 +3069,16 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = of nkObjConstr: genObjConstr(p, n, d) of nkCast: genCast(p, n, d) of nkHiddenStdConv, nkHiddenSubConv, nkConv: genConv(p, n, d) - of nkHiddenAddr, nkAddr: genAddr(p, n, d) + of nkHiddenAddr: + if n[0].kind == nkDerefExpr: + # addr ( deref ( x )) --> x + var x = n[0][0] + if n.typ.skipTypes(abstractVar).kind != tyOpenArray: + x.typ = n.typ + expr(p, x, d) + return + genAddr(p, n, d) + of nkAddr: genAddr(p, n, d) of nkBracketExpr: genBracketExpr(p, n, d) of nkDerefExpr, nkHiddenDeref: genDeref(p, n, d) of nkDotExpr: genRecordField(p, n, d) @@ -2826,7 +3098,7 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = of nkLambdaKinds: var sym = n[namePos].sym genProc(p.module, sym) - if sym.loc.r == nil or sym.loc.lode == nil: + if sym.loc.snippet == "" or sym.loc.lode == nil: internalError(p.config, n.info, "expr: proc not init " & sym.name.s) putLocIntoDest(p, d, sym.loc) of nkClosure: genClosure(p, n, d) @@ -2846,7 +3118,7 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = cow(p, n[1]) if nfPreventCg notin n.flags: genAsgn(p, n, fastAsgn=false) - of nkFastAsgn: + of nkFastAsgn, nkSinkAsgn: cow(p, n[1]) if nfPreventCg notin n.flags: # transf is overly aggressive with 'nkFastAsgn', so we work around here. @@ -2856,9 +3128,8 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = let ex = n[0] if ex.kind != nkEmpty: genLineDir(p, n) - var a: TLoc - initLocExprSingleUse(p, ex, a) - line(p, cpsStmts, "(void)(" & a.r & ");\L") + var a: TLoc = initLocExprSingleUse(p, ex) + line(p, cpsStmts, "(void)(" & a.snippet & ");\L") of nkAsmStmt: genAsmStmt(p, n) of nkTryStmt, nkHiddenTryStmt: case p.config.exc @@ -2878,12 +3149,27 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = nkFromStmt, nkTemplateDef, nkMacroDef, nkStaticStmt: discard of nkPragma: genPragma(p, n) - of nkPragmaBlock: expr(p, n.lastSon, d) + of nkPragmaBlock: + var inUncheckedAssignSection = 0 + let pragmaList = n[0] + for pi in pragmaList: + if whichPragma(pi) == wCast: + case whichPragma(pi[1]) + of wUncheckedAssign: + inUncheckedAssignSection = 1 + else: + discard + + inc p.inUncheckedAssignSection, inUncheckedAssignSection + expr(p, n.lastSon, d) + dec p.inUncheckedAssignSection, inUncheckedAssignSection + of nkProcDef, nkFuncDef, nkMethodDef, nkConverterDef: if n[genericParamsPos].kind == nkEmpty: var prc = n[namePos].sym if useAliveDataFromDce in p.module.flags: - if p.module.alive.contains(prc.itemId.item) and prc.magic in {mNone, mIsolate}: + if p.module.alive.contains(prc.itemId.item) and + prc.magic in generatedMagics: genProc(p.module, prc) elif prc.skipGenericOwner.kind == skModule and sfCompileTime notin prc.flags: if ({sfExportc, sfCompilerProc} * prc.flags == {sfExportc}) or @@ -2904,69 +3190,57 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = of nkMixinStmt, nkBindStmt: discard else: internalError(p.config, n.info, "expr(" & $n.kind & "); unknown node kind") -proc genNamedConstExpr(p: BProc, n: PNode; isConst: bool): Rope = - if n.kind == nkExprColonExpr: result = genBracedInit(p, n[1], isConst, n[0].typ) - else: result = genBracedInit(p, n, isConst, n.typ) - -proc getDefaultValue(p: BProc; typ: PType; info: TLineInfo): Rope = +proc getDefaultValue(p: BProc; typ: PType; info: TLineInfo; result: var Rope) = var t = skipTypes(typ, abstractRange+{tyOwned}-{tyTypeDesc}) case t.kind - of tyBool: result = rope"NIM_FALSE" - of tyEnum, tyChar, tyInt..tyInt64, tyUInt..tyUInt64: result = rope"0" - of tyFloat..tyFloat128: result = rope"0.0" - of tyCString, tyVar, tyLent, tyPointer, tyPtr, tyUntyped, + of tyBool: result.add rope"NIM_FALSE" + of tyEnum, tyChar, tyInt..tyInt64, tyUInt..tyUInt64: result.add rope"0" + of tyFloat..tyFloat128: result.add rope"0.0" + of tyCstring, tyVar, tyLent, tyPointer, tyPtr, tyUntyped, tyTyped, tyTypeDesc, tyStatic, tyRef, tyNil: - result = rope"NIM_NIL" + result.add rope"NIM_NIL" of tyString, tySequence: if optSeqDestructors in p.config.globalOptions: - result = rope"{0, NIM_NIL}" + result.add "{0, NIM_NIL}" else: - result = rope"NIM_NIL" + result.add "NIM_NIL" of tyProc: if t.callConv != ccClosure: - result = rope"NIM_NIL" + result.add "NIM_NIL" else: - result = rope"{NIM_NIL, NIM_NIL}" + result.add "{NIM_NIL, NIM_NIL}" of tyObject: var count = 0 result.add "{" getNullValueAuxT(p, t, t, t.n, nil, result, count, true, info) result.add "}" of tyTuple: - result = rope"{" - for i in 0..<t.len: + result.add "{" + if p.vccAndC and t.isEmptyTupleType: + result.add "0" + for i, a in t.ikids: if i > 0: result.add ", " - result.add getDefaultValue(p, t[i], info) + getDefaultValue(p, a, info, result) result.add "}" of tyArray: - result = rope"{" - for i in 0..<toInt(lengthOrd(p.config, t.sons[0])): + result.add "{" + for i in 0..<toInt(lengthOrd(p.config, t.indexType)): if i > 0: result.add ", " - result.add getDefaultValue(p, t.sons[1], info) + getDefaultValue(p, t.elementType, info, result) result.add "}" #result = rope"{}" of tyOpenArray, tyVarargs: - result = rope"{NIM_NIL, 0}" + result.add "{NIM_NIL, 0}" of tySet: - if mapSetType(p.config, t) == ctArray: result = rope"{}" - else: result = rope"0" + if mapSetType(p.config, t) == ctArray: result.add "{}" + else: result.add "0" else: globalError(p.config, info, "cannot create null element for: " & $t.kind) -proc caseObjDefaultBranch(obj: PNode; branch: Int128): int = - for i in 1 ..< obj.len: - for j in 0 .. obj[i].len - 2: - if obj[i][j].kind == nkRange: - let x = getOrdValue(obj[i][j][0]) - let y = getOrdValue(obj[i][j][1]) - if branch >= x and branch <= y: - return i - elif getOrdValue(obj[i][j]) == branch: - return i - if obj[i].len == 1: - # else branch - return i - assert(false, "unreachable") +proc isEmptyCaseObjectBranch(n: PNode): bool = + for it in n: + if it.kind == nkSym and not isEmptyType(it.sym.typ): return false + return true proc getNullValueAux(p: BProc; t: PType; obj, constOrNil: PNode, result: var Rope; count: var int; @@ -2977,7 +3251,8 @@ proc getNullValueAux(p: BProc; t: PType; obj, constOrNil: PNode, getNullValueAux(p, t, it, constOrNil, result, count, isConst, info) of nkRecCase: getNullValueAux(p, t, obj[0], constOrNil, result, count, isConst, info) - if count > 0: result.add ", " + var res = "" + if count > 0: res.add ", " var branch = Zero if constOrNil != nil: ## find kind value, default is zero if not specified @@ -2991,18 +3266,21 @@ proc getNullValueAux(p: BProc; t: PType; obj, constOrNil: PNode, break let selectedBranch = caseObjDefaultBranch(obj, branch) - result.add "{" + res.add "{" var countB = 0 let b = lastSon(obj[selectedBranch]) # designated initilization is the only way to init non first element of unions # branches are allowed to have no members (b.len == 0), in this case they don't need initializer - if b.kind == nkRecList and b.len > 0: - result.add "._" & mangleRecFieldName(p.module, obj[0].sym) & "_" & $selectedBranch & " = {" - getNullValueAux(p, t, b, constOrNil, result, countB, isConst, info) - result.add "}" + if b.kind == nkRecList and not isEmptyCaseObjectBranch(b): + res.add "._" & mangleRecFieldName(p.module, obj[0].sym) & "_" & $selectedBranch & " = {" + getNullValueAux(p, t, b, constOrNil, res, countB, isConst, info) + res.add "}" elif b.kind == nkSym: - result.add "." & mangleRecFieldName(p.module, b.sym) & " = " - getNullValueAux(p, t, b, constOrNil, result, countB, isConst, info) + res.add "." & mangleRecFieldName(p.module, b.sym) & " = " + getNullValueAux(p, t, b, constOrNil, res, countB, isConst, info) + else: + return + result.add res result.add "}" of nkSym: @@ -3012,21 +3290,22 @@ proc getNullValueAux(p: BProc; t: PType; obj, constOrNil: PNode, if constOrNil != nil: for i in 1..<constOrNil.len: if constOrNil[i].kind == nkExprColonExpr: + assert constOrNil[i][0].kind == nkSym, "illformed object constr; the field is not a sym" if constOrNil[i][0].sym.name.id == field.name.id: - result.add genBracedInit(p, constOrNil[i][1], isConst, field.typ) + genBracedInit(p, constOrNil[i][1], isConst, field.typ, result) return elif i == field.position: - result.add genBracedInit(p, constOrNil[i], isConst, field.typ) + genBracedInit(p, constOrNil[i], isConst, field.typ, result) return # not found, produce default value: - result.add getDefaultValue(p, field.typ, info) + getDefaultValue(p, field.typ, info, result) else: localError(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; isConst: bool, info: TLineInfo) = - var base = t[0] + var base = t.baseClass let oldRes = result let oldcount = count if base != nil: @@ -3044,36 +3323,40 @@ proc getNullValueAuxT(p: BProc; orig, t: PType; obj, constOrNil: PNode, # do not emit '{}' as that is not valid C: if oldcount == count: result = oldRes -proc genConstObjConstr(p: BProc; n: PNode; isConst: bool): Rope = - result = nil +proc genConstObjConstr(p: BProc; n: PNode; isConst: bool; result: var Rope) = let t = n.typ.skipTypes(abstractInstOwned) var count = 0 #if not isObjLackingTypeField(t) and not p.module.compileToCpp: # result.addf("{$1}", [genTypeInfo(p.module, t)]) # inc count + result.add "{" if t.kind == tyObject: getNullValueAuxT(p, t, t, t.n, n, result, count, isConst, n.info) - result = "{$1}$n" % [result] + result.add("}\n") -proc genConstSimpleList(p: BProc, n: PNode; isConst: bool): Rope = - result = rope("{") +proc genConstSimpleList(p: BProc, n: PNode; isConst: bool; result: var Rope) = + result.add "{" + if p.vccAndC and n.len == 0 and n.typ.kind == tyArray: + getDefaultValue(p, n.typ.elementType, n.info, result) for i in 0..<n.len: let it = n[i] if i > 0: result.add ",\n" - if it.kind == nkExprColonExpr: result.add genBracedInit(p, it[1], isConst, it[0].typ) - else: result.add genBracedInit(p, it, isConst, it.typ) + if it.kind == nkExprColonExpr: genBracedInit(p, it[1], isConst, it[0].typ, result) + else: genBracedInit(p, it, isConst, it.typ, result) result.add("}\n") -proc genConstTuple(p: BProc, n: PNode; isConst: bool; tup: PType): Rope = - result = rope("{") +proc genConstTuple(p: BProc, n: PNode; isConst: bool; tup: PType; result: var Rope) = + result.add "{" + if p.vccAndC and n.len == 0: + result.add "0" for i in 0..<n.len: let it = n[i] if i > 0: result.add ",\n" - if it.kind == nkExprColonExpr: result.add genBracedInit(p, it[1], isConst, tup[i]) - else: result.add genBracedInit(p, it, isConst, tup[i]) + if it.kind == nkExprColonExpr: genBracedInit(p, it[1], isConst, tup[i], result) + else: genBracedInit(p, it, isConst, tup[i], result) result.add("}\n") -proc genConstSeq(p: BProc, n: PNode, t: PType; isConst: bool): Rope = +proc genConstSeq(p: BProc, n: PNode, t: PType; isConst: bool; result: var Rope) = var data = "{{$1, $1 | NIM_STRLIT_FLAG}" % [n.len.rope] let base = t.skipTypes(abstractInst)[0] if n.len > 0: @@ -3081,44 +3364,45 @@ proc genConstSeq(p: BProc, n: PNode, t: PType; isConst: bool): Rope = data.add(", {") for i in 0..<n.len: if i > 0: data.addf(",$n", []) - data.add genBracedInit(p, n[i], isConst, base) + genBracedInit(p, n[i], isConst, base, data) data.add("}") data.add("}") - result = getTempName(p.module) + let tmpName = getTempName(p.module) - appcg(p.module, cfsData, + appcg(p.module, cfsStrData, "static $5 struct {$n" & " #TGenericSeq Sup;$n" & " $1 data[$2];$n" & "} $3 = $4;$n", [ - getTypeDesc(p.module, base), n.len, result, data, + getTypeDesc(p.module, base), n.len, tmpName, data, if isConst: "NIM_CONST" else: ""]) - result = "(($1)&$2)" % [getTypeDesc(p.module, t), result] + result.add "(($1)&$2)" % [getTypeDesc(p.module, t), tmpName] -proc genConstSeqV2(p: BProc, n: PNode, t: PType; isConst: bool): Rope = +proc genConstSeqV2(p: BProc, n: PNode, t: PType; isConst: bool; result: var Rope) = let base = t.skipTypes(abstractInst)[0] - var data = rope"{" - for i in 0..<n.len: - if i > 0: data.addf(",$n", []) - data.add genBracedInit(p, n[i], isConst, base) - data.add("}") + var data = rope"" + if n.len > 0: + data.add(", {") + for i in 0..<n.len: + if i > 0: data.addf(",$n", []) + genBracedInit(p, n[i], isConst, base, data) + data.add("}") let payload = getTempName(p.module) - - appcg(p.module, cfsData, + appcg(p.module, cfsStrData, "static $5 struct {$n" & " NI cap; $1 data[$2];$n" & - "} $3 = {$2 | NIM_STRLIT_FLAG, $4};$n", [ + "} $3 = {$2 | NIM_STRLIT_FLAG$4};$n", [ getTypeDesc(p.module, base), n.len, payload, data, if isConst: "const" else: ""]) - result = "{$1, ($2*)&$3}" % [rope(n.len), getSeqPayloadType(p.module, t), payload] + result.add "{$1, ($2*)&$3}" % [rope(n.len), getSeqPayloadType(p.module, t), payload] -proc genBracedInit(p: BProc, n: PNode; isConst: bool; optionalType: PType): Rope = +proc genBracedInit(p: BProc, n: PNode; isConst: bool; optionalType: PType; result: var Rope) = case n.kind of nkHiddenStdConv, nkHiddenSubConv: - result = genBracedInit(p, n[1], isConst, n.typ) + genBracedInit(p, n[1], isConst, n.typ, result) else: var ty = tyNone var typ: PType = nil @@ -3133,12 +3417,12 @@ proc genBracedInit(p: BProc, n: PNode; isConst: bool; optionalType: PType): Rope case ty of tySet: let cs = toBitSet(p.config, n) - result = genRawSetData(cs, int(getSize(p.config, n.typ))) + genRawSetData(cs, int(getSize(p.config, n.typ)), result) of tySequence: if optSeqDestructors in p.config.globalOptions: - result = genConstSeqV2(p, n, typ, isConst) + genConstSeqV2(p, n, typ, isConst, result) else: - result = genConstSeq(p, n, typ, isConst) + genConstSeq(p, n, typ, isConst, result) of tyProc: if typ.callConv == ccClosure and n.safeLen > 1 and n[1].kind == nkNilLit: # n.kind could be: nkClosure, nkTupleConstr and maybe others; `n.safeLen` @@ -3151,44 +3435,41 @@ proc genBracedInit(p: BProc, n: PNode; isConst: bool; optionalType: PType): Rope # leading to duplicate code like this: # "{NIM_NIL,NIM_NIL}, {NIM_NIL,NIM_NIL}" if n[0].kind == nkNilLit: - result = ~"{NIM_NIL,NIM_NIL}" + result.add "{NIM_NIL,NIM_NIL}" else: - var d: TLoc - initLocExpr(p, n[0], d) - result = "{(($1) $2),NIM_NIL}" % [getClosureType(p.module, typ, clHalfWithEnv), rdLoc(d)] + var d: TLoc = initLocExpr(p, n[0]) + result.add "{(($1) $2),NIM_NIL}" % [getClosureType(p.module, typ, clHalfWithEnv), rdLoc(d)] else: - var d: TLoc - initLocExpr(p, n, d) - result = rdLoc(d) + var d: TLoc = initLocExpr(p, n) + result.add rdLoc(d) of tyArray, tyVarargs: - result = genConstSimpleList(p, n, isConst) + genConstSimpleList(p, n, isConst, result) of tyTuple: - result = genConstTuple(p, n, isConst, typ) + genConstTuple(p, n, isConst, typ, result) of tyOpenArray: if n.kind != nkBracket: internalError(p.config, n.info, "const openArray expression is not an array construction") - let data = genConstSimpleList(p, n, isConst) + var data = newRopeAppender() + genConstSimpleList(p, n, isConst, data) let payload = getTempName(p.module) - let ctype = getTypeDesc(p.module, typ[0]) + let ctype = getTypeDesc(p.module, typ.elementType) let arrLen = n.len - appcg(p.module, cfsData, + appcg(p.module, cfsStrData, "static $5 $1 $3[$2] = $4;$n", [ ctype, arrLen, payload, data, if isConst: "const" else: ""]) - result = "{($1*)&$2, $3}" % [ctype, payload, rope arrLen] + result.add "{($1*)&$2, $3}" % [ctype, payload, rope arrLen] of tyObject: - result = genConstObjConstr(p, n, isConst) - of tyString, tyCString: + genConstObjConstr(p, n, isConst, result) + of tyString, tyCstring: if optSeqDestructors in p.config.globalOptions and n.kind != nkNilLit and ty == tyString: - result = genStringLiteralV2Const(p.module, n, isConst) + genStringLiteralV2Const(p.module, n, isConst, result) else: - var d: TLoc - initLocExpr(p, n, d) - result = rdLoc(d) + var d: TLoc = initLocExpr(p, n) + result.add rdLoc(d) else: - var d: TLoc - initLocExpr(p, n, d) - result = rdLoc(d) + var d: TLoc = initLocExpr(p, n) + result.add rdLoc(d) diff --git a/compiler/ccgliterals.nim b/compiler/ccgliterals.nim index ee56da586..cbef6771f 100644 --- a/compiler/ccgliterals.nim +++ b/compiler/ccgliterals.nim @@ -21,7 +21,7 @@ template detectVersion(field, corename) = if core == nil or core.kind != skConst: m.g.field = 1 else: - m.g.field = toInt(ast.getInt(core.ast)) + m.g.field = toInt(ast.getInt(core.astdef)) result = m.g.field proc detectStrVersion(m: BModule): int = @@ -32,82 +32,87 @@ proc detectSeqVersion(m: BModule): int = # ----- Version 1: GC'ed strings and seqs -------------------------------- -proc genStringLiteralDataOnlyV1(m: BModule, s: string): Rope = - discard cgsym(m, "TGenericSeq") - result = getTempName(m) - m.s[cfsData].addf("STRING_LITERAL($1, $2, $3);$n", - [result, makeCString(s), rope(s.len)]) +proc genStringLiteralDataOnlyV1(m: BModule, s: string; result: var Rope) = + cgsym(m, "TGenericSeq") + let tmp = getTempName(m) + result.add tmp + m.s[cfsStrData].addf("STRING_LITERAL($1, $2, $3);$n", + [tmp, makeCString(s), rope(s.len)]) -proc genStringLiteralV1(m: BModule; n: PNode): Rope = +proc genStringLiteralV1(m: BModule; n: PNode; result: var Rope) = if s.isNil: - result = ropecg(m, "((#NimStringDesc*) NIM_NIL)", []) + appcg(m, result, "((#NimStringDesc*) NIM_NIL)", []) else: let id = nodeTableTestOrSet(m.dataCache, n, m.labels) if id == m.labels: # string literal not found in the cache: - result = ropecg(m, "((#NimStringDesc*) &$1)", - [genStringLiteralDataOnlyV1(m, n.strVal)]) + appcg(m, result, "((#NimStringDesc*) &", []) + genStringLiteralDataOnlyV1(m, n.strVal, result) + result.add ")" else: - result = ropecg(m, "((#NimStringDesc*) &$1$2)", + appcg(m, result, "((#NimStringDesc*) &$1$2)", [m.tmpBase, id]) # ------ Version 2: destructor based strings and seqs ----------------------- proc genStringLiteralDataOnlyV2(m: BModule, s: string; result: Rope; isConst: bool) = - m.s[cfsData].addf("static $4 struct {$n" & + m.s[cfsStrData].addf("static $4 struct {$n" & " NI cap; NIM_CHAR data[$2+1];$n" & "} $1 = { $2 | NIM_STRLIT_FLAG, $3 };$n", [result, rope(s.len), makeCString(s), rope(if isConst: "const" else: "")]) -proc genStringLiteralV2(m: BModule; n: PNode; isConst: bool): Rope = +proc genStringLiteralV2(m: BModule; n: PNode; isConst: bool; result: var Rope) = let id = nodeTableTestOrSet(m.dataCache, n, m.labels) if id == m.labels: let pureLit = getTempName(m) genStringLiteralDataOnlyV2(m, n.strVal, pureLit, isConst) - result = getTempName(m) - discard cgsym(m, "NimStrPayload") - discard cgsym(m, "NimStringV2") + let tmp = getTempName(m) + result.add tmp + cgsym(m, "NimStrPayload") + cgsym(m, "NimStringV2") # string literal not found in the cache: - m.s[cfsData].addf("static $4 NimStringV2 $1 = {$2, (NimStrPayload*)&$3};$n", - [result, rope(n.strVal.len), pureLit, rope(if isConst: "const" else: "")]) + m.s[cfsStrData].addf("static $4 NimStringV2 $1 = {$2, (NimStrPayload*)&$3};$n", + [tmp, rope(n.strVal.len), pureLit, rope(if isConst: "const" else: "")]) else: - result = getTempName(m) - m.s[cfsData].addf("static $4 NimStringV2 $1 = {$2, (NimStrPayload*)&$3};$n", - [result, rope(n.strVal.len), m.tmpBase & rope(id), + let tmp = getTempName(m) + result.add tmp + m.s[cfsStrData].addf("static $4 NimStringV2 $1 = {$2, (NimStrPayload*)&$3};$n", + [tmp, rope(n.strVal.len), m.tmpBase & rope(id), rope(if isConst: "const" else: "")]) -proc genStringLiteralV2Const(m: BModule; n: PNode; isConst: bool): Rope = +proc genStringLiteralV2Const(m: BModule; n: PNode; isConst: bool; result: var Rope) = let id = nodeTableTestOrSet(m.dataCache, n, m.labels) var pureLit: Rope if id == m.labels: pureLit = getTempName(m) - discard cgsym(m, "NimStrPayload") - discard cgsym(m, "NimStringV2") + cgsym(m, "NimStrPayload") + cgsym(m, "NimStringV2") # string literal not found in the cache: genStringLiteralDataOnlyV2(m, n.strVal, pureLit, isConst) else: pureLit = m.tmpBase & rope(id) - result = "{$1, (NimStrPayload*)&$2}" % [rope(n.strVal.len), pureLit] + result.addf "{$1, (NimStrPayload*)&$2}", [rope(n.strVal.len), pureLit] # ------ Version selector --------------------------------------------------- proc genStringLiteralDataOnly(m: BModule; s: string; info: TLineInfo; - isConst: bool): Rope = + isConst: bool; result: var Rope) = case detectStrVersion(m) - of 0, 1: result = genStringLiteralDataOnlyV1(m, s) + of 0, 1: genStringLiteralDataOnlyV1(m, s, result) of 2: - result = getTempName(m) - genStringLiteralDataOnlyV2(m, s, result, isConst) + let tmp = getTempName(m) + genStringLiteralDataOnlyV2(m, s, tmp, isConst) + result.add tmp else: localError(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)", []) +proc genNilStringLiteral(m: BModule; info: TLineInfo; result: var Rope) = + appcg(m, result, "((#NimStringDesc*) NIM_NIL)", []) -proc genStringLiteral(m: BModule; n: PNode): Rope = +proc genStringLiteral(m: BModule; n: PNode; result: var Rope) = case detectStrVersion(m) - of 0, 1: result = genStringLiteralV1(m, n) - of 2: result = genStringLiteralV2(m, n, isConst = true) + of 0, 1: genStringLiteralV1(m, n, result) + of 2: genStringLiteralV2(m, n, isConst = true, result) else: localError(m.config, n.info, "cannot determine how to produce code for string literal") diff --git a/compiler/ccgmerge_unused.nim b/compiler/ccgmerge_unused.nim index c7d19da7a..a1413034f 100644 --- a/compiler/ccgmerge_unused.nim +++ b/compiler/ccgmerge_unused.nim @@ -19,13 +19,11 @@ import const CFileSectionNames: array[TCFileSection, string] = [ - cfsMergeInfo: "", cfsHeaders: "NIM_merge_HEADERS", cfsFrameDefines: "NIM_merge_FRAME_DEFINES", cfsForwardTypes: "NIM_merge_FORWARD_TYPES", cfsTypes: "NIM_merge_TYPES", cfsSeqTypes: "NIM_merge_SEQ_TYPES", - cfsFieldInfo: "NIM_merge_FIELD_INFO", cfsTypeInfo: "NIM_merge_TYPE_INFO", cfsProcHeaders: "NIM_merge_PROC_HEADERS", cfsData: "NIM_merge_DATA", @@ -34,11 +32,8 @@ const cfsInitProc: "NIM_merge_INIT_PROC", cfsDatInitProc: "NIM_merge_DATINIT_PROC", cfsTypeInit1: "NIM_merge_TYPE_INIT1", - cfsTypeInit2: "NIM_merge_TYPE_INIT2", cfsTypeInit3: "NIM_merge_TYPE_INIT3", - cfsDebugInit: "NIM_merge_DEBUG_INIT", - cfsDynLibInit: "NIM_merge_DYNLIB_INIT", - cfsDynLibDeinit: "NIM_merge_DYNLIB_DEINIT", + cfsDynLibInit: "NIM_merge_DYNLIB_INIT" ] CProcSectionNames: array[TCProcSection, string] = [ cpsLocals: "NIM_merge_PROC_LOCALS", diff --git a/compiler/ccgreset.nim b/compiler/ccgreset.nim index ef1505f57..6caeb8084 100644 --- a/compiler/ccgreset.nim +++ b/compiler/ccgreset.nim @@ -24,10 +24,10 @@ proc specializeResetN(p: BProc, accessor: Rope, n: PNode; of nkRecCase: if (n[0].kind != nkSym): internalError(p.config, n.info, "specializeResetN") let disc = n[0].sym - if disc.loc.r == nil: fillObjectFields(p.module, typ) + if disc.loc.snippet == "": fillObjectFields(p.module, typ) if disc.loc.t == nil: internalError(p.config, n.info, "specializeResetN()") - lineF(p, cpsStmts, "switch ($1.$2) {$n", [accessor, disc.loc.r]) + lineF(p, cpsStmts, "switch ($1.$2) {$n", [accessor, disc.loc.snippet]) for i in 1..<n.len: let branch = n[i] assert branch.kind in {nkOfBranch, nkElse} @@ -38,14 +38,14 @@ proc specializeResetN(p: BProc, accessor: Rope, n: PNode; specializeResetN(p, accessor, lastSon(branch), typ) lineF(p, cpsStmts, "break;$n", []) lineF(p, cpsStmts, "} $n", []) - specializeResetT(p, "$1.$2" % [accessor, disc.loc.r], disc.loc.t) + specializeResetT(p, "$1.$2" % [accessor, disc.loc.snippet], disc.loc.t) of nkSym: let field = n.sym if field.typ.kind == tyVoid: return - if field.loc.r == nil: fillObjectFields(p.module, typ) + if field.loc.snippet == "": fillObjectFields(p.module, typ) if field.loc.t == nil: internalError(p.config, n.info, "specializeResetN()") - specializeResetT(p, "$1.$2" % [accessor, field.loc.r], field.loc.t) + specializeResetT(p, "$1.$2" % [accessor, field.loc.snippet], field.loc.t) else: internalError(p.config, n.info, "specializeResetN()") proc specializeResetT(p: BProc, accessor: Rope, typ: PType) = @@ -54,25 +54,23 @@ proc specializeResetT(p: BProc, accessor: Rope, typ: PType) = case typ.kind of tyGenericInst, tyGenericBody, tyTypeDesc, tyAlias, tyDistinct, tyInferred, tySink, tyOwned: - specializeResetT(p, accessor, lastSon(typ)) + specializeResetT(p, accessor, skipModifier(typ)) of tyArray: - let arraySize = lengthOrd(p.config, typ[0]) - var i: TLoc - getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt), i) + let arraySize = lengthOrd(p.config, typ.indexType) + var i: TLoc = getTemp(p, getSysType(p.module.g.graph, unknownLineInfo, tyInt)) linefmt(p, cpsStmts, "for ($1 = 0; $1 < $2; $1++) {$n", - [i.r, arraySize]) - specializeResetT(p, ropecg(p.module, "$1[$2]", [accessor, i.r]), typ[1]) + [i.snippet, arraySize]) + specializeResetT(p, ropecg(p.module, "$1[$2]", [accessor, i.snippet]), typ.elementType) lineF(p, cpsStmts, "}$n", []) of tyObject: - for i in 0..<typ.len: - var x = typ[i] - if x != nil: x = x.skipTypes(skipPtrs) - specializeResetT(p, accessor.parentObj(p.module), x) + var x = typ.baseClass + if x != nil: x = x.skipTypes(skipPtrs) + specializeResetT(p, accessor.parentObj(p.module), x) if typ.n != nil: specializeResetN(p, accessor, typ.n, typ) of tyTuple: let typ = getUniqueType(typ) - for i in 0..<typ.len: - specializeResetT(p, ropecg(p.module, "$1.Field$2", [accessor, i]), typ[i]) + for i, a in typ.ikids: + specializeResetT(p, ropecg(p.module, "$1.Field$2", [accessor, i]), a) of tyString, tyRef, tySequence: lineCg(p, cpsStmts, "#unsureAsgnRef((void**)&$1, NIM_NIL);$n", [accessor]) @@ -83,11 +81,24 @@ proc specializeResetT(p: BProc, accessor: Rope, typ: PType) = lineCg(p, cpsStmts, "$1.ClP_0 = NIM_NIL;$n", [accessor]) else: lineCg(p, cpsStmts, "$1 = NIM_NIL;$n", [accessor]) - of tyChar, tyBool, tyEnum, tyInt..tyUInt64: + of tyChar, tyBool, tyEnum, tyRange, tyInt..tyUInt64: lineCg(p, cpsStmts, "$1 = 0;$n", [accessor]) - of tyCString, tyPointer, tyPtr, tyVar, tyLent: + of tyCstring, tyPointer, tyPtr, tyVar, tyLent: lineCg(p, cpsStmts, "$1 = NIM_NIL;$n", [accessor]) - else: + of tySet: + case mapSetType(p.config, typ) + of ctArray: + lineCg(p, cpsStmts, "#nimZeroMem($1, sizeof($2));$n", + [accessor, getTypeDesc(p.module, typ)]) + of ctInt8, ctInt16, ctInt32, ctInt64: + lineCg(p, cpsStmts, "$1 = 0;$n", [accessor]) + else: + raiseAssert "unexpected set type kind" + of tyNone, tyEmpty, tyNil, tyUntyped, tyTyped, tyGenericInvocation, + tyGenericParam, tyOrdinal, tyOpenArray, tyForward, tyVarargs, + tyUncheckedArray, tyError, tyBuiltInTypeClass, tyUserTypeClass, + tyUserTypeClassInst, tyCompositeTypeClass, tyAnd, tyOr, tyNot, + tyAnything, tyStatic, tyFromExpr, tyConcept, tyVoid, tyIterable: discard proc specializeReset(p: BProc, a: TLoc) = diff --git a/compiler/ccgstmts.nim b/compiler/ccgstmts.nim index 6cbff6ee9..883108f2c 100644 --- a/compiler/ccgstmts.nim +++ b/compiler/ccgstmts.nim @@ -8,46 +8,58 @@ # # included from cgen.nim - const RangeExpandLimit = 256 # do not generate ranges # over 'RangeExpandLimit' elements stringCaseThreshold = 8 # above X strings a hash-switch for strings is generated -proc getTraverseProc(p: BProc, v: PSym): Rope = - if p.config.selectedGC in {gcMarkAndSweep, gcHooks, gcV2, gcRefc} and +proc registerTraverseProc(p: BProc, v: PSym) = + var traverseProc = "" + if p.config.selectedGC in {gcMarkAndSweep, gcHooks, gcRefc} and optOwnedRefs notin p.config.globalOptions and containsGarbageCollectedRef(v.loc.t): # we register a specialized marked proc here; this has the advantage # that it works out of the box for thread local storage then :-) - result = genTraverseProcForGlobal(p.module, v, v.info) + traverseProc = genTraverseProcForGlobal(p.module, v, v.info) -proc registerTraverseProc(p: BProc, v: PSym, traverseProc: Rope) = - if sfThread in v.flags: - appcg(p.module, p.module.preInitProc.procSec(cpsInit), - "$n\t#nimRegisterThreadLocalMarker($1);$n$n", [traverseProc]) - else: - appcg(p.module, p.module.preInitProc.procSec(cpsInit), - "$n\t#nimRegisterGlobalMarker($1);$n$n", [traverseProc]) + if traverseProc.len != 0 and not p.hcrOn: + if sfThread in v.flags: + appcg(p.module, p.module.preInitProc.procSec(cpsInit), + "$n\t#nimRegisterThreadLocalMarker($1);$n$n", [traverseProc]) + else: + appcg(p.module, p.module.preInitProc.procSec(cpsInit), + "$n\t#nimRegisterGlobalMarker($1);$n$n", [traverseProc]) proc isAssignedImmediately(conf: ConfigRef; n: PNode): bool {.inline.} = - if n.kind == nkEmpty: return false - if isInvalidReturnType(conf, n.typ): - # var v = f() - # is transformed into: var v; f(addr v) - # where 'f' **does not** initialize the result! - return false - result = true + if n.kind == nkEmpty: + result = false + elif n.kind in nkCallKinds and n[0] != nil and n[0].typ != nil and n[0].typ.skipTypes(abstractInst).kind == tyProc: + if n[0].kind == nkSym and sfConstructor in n[0].sym.flags: + result = true + elif isInvalidReturnType(conf, n[0].typ, true): + # var v = f() + # is transformed into: var v; f(addr v) + # where 'f' **does not** initialize the result! + result = false + else: + result = true + elif isInvalidReturnType(conf, n.typ, false): + result = false + else: + result = true proc inExceptBlockLen(p: BProc): int = + result = 0 for x in p.nestedTryStmts: if x.inExcept: result.inc proc startBlockInternal(p: BProc): int {.discardable.} = inc(p.labels) result = p.blocks.len - setLen(p.blocks, result + 1) + + p.blocks.add initBlock() + p.blocks[result].id = p.labels p.blocks[result].nestedTryStmts = p.nestedTryStmts.len.int16 p.blocks[result].nestedExceptStmts = p.inExceptBlockLen.int16 @@ -60,7 +72,6 @@ template startBlock(p: BProc, start: FormatStr = "{$n", proc endBlock(p: BProc) proc genVarTuple(p: BProc, n: PNode) = - var tup, field: TLoc if n.kind != nkVarTuple: internalError(p.config, n.info, "genVarTuple") # if we have a something that's been captured, use the lowering instead: @@ -71,8 +82,8 @@ proc genVarTuple(p: BProc, n: PNode) = # check only the first son var forHcr = treatGlobalDifferentlyForHCR(p.module, n[0].sym) - let hcrCond = if forHcr: getTempName(p.module) else: nil - var hcrGlobals: seq[tuple[loc: TLoc, tp: Rope]] + let hcrCond = if forHcr: getTempName(p.module) else: "" + var hcrGlobals: seq[tuple[loc: TLoc, tp: Rope]] = @[] # determine if the tuple is constructed at top-level scope or inside of a block (if/while/block) let isGlobalInBlock = forHcr and p.blocks.len > 2 # do not close and reopen blocks if this is a 'global' but inside of a block (if/while/block) @@ -84,31 +95,28 @@ proc genVarTuple(p: BProc, n: PNode) = startBlock(p) genLineDir(p, n) - initLocExpr(p, n[^1], tup) + var tup = initLocExpr(p, n[^1]) var t = tup.t.skipTypes(abstractInst) for i in 0..<n.len-2: let vn = n[i] let v = vn.sym if sfCompileTime in v.flags: continue - var traverseProc: Rope if sfGlobal in v.flags: - assignGlobalVar(p, vn, nil) + assignGlobalVar(p, vn, "") genObjectInit(p, cpsInit, v.typ, v.loc, constructObj) - traverseProc = getTraverseProc(p, v) - if traverseProc != nil and not p.hcrOn: - registerTraverseProc(p, v, traverseProc) + registerTraverseProc(p, v) else: assignLocalVar(p, vn) initLocalVar(p, v, immediateAsgn=isAssignedImmediately(p.config, n[^1])) - initLoc(field, locExpr, vn, tup.storage) + var field = initLoc(locExpr, vn, tup.storage) if t.kind == tyTuple: - field.r = "$1.Field$2" % [rdLoc(tup), rope(i)] + field.snippet = "$1.Field$2" % [rdLoc(tup), rope(i)] else: if t.n[i].kind != nkSym: internalError(p.config, n.info, "genVarTuple") - field.r = "$1.$2" % [rdLoc(tup), mangleRecFieldName(p.module, t.n[i].sym)] + field.snippet = "$1.$2" % [rdLoc(tup), mangleRecFieldName(p.module, t.n[i].sym)] putLocIntoDest(p, v.loc, field) if forHcr or isGlobalInBlock: - hcrGlobals.add((loc: v.loc, tp: if traverseProc == nil: ~"NULL" else: traverseProc)) + hcrGlobals.add((loc: v.loc, tp: "NULL")) if forHcr: # end the block where the tuple gets initialized @@ -120,7 +128,7 @@ proc genVarTuple(p: BProc, n: PNode) = lineCg(p, cpsLocals, "NIM_BOOL $1 = NIM_FALSE;$n", [hcrCond]) for curr in hcrGlobals: lineCg(p, cpsLocals, "$1 |= hcrRegisterGlobal($4, \"$2\", sizeof($3), $5, (void**)&$2);$N", - [hcrCond, curr.loc.r, rdLoc(curr.loc), getModuleDllPath(p.module, n[0].sym), curr.tp]) + [hcrCond, curr.loc.snippet, rdLoc(curr.loc), getModuleDllPath(p.module, n[0].sym), curr.tp]) proc loadInto(p: BProc, le, ri: PNode, a: var TLoc) {.inline.} = @@ -138,12 +146,12 @@ proc loadInto(p: BProc, le, ri: PNode, a: var TLoc) {.inline.} = a.flags.incl(lfEnforceDeref) expr(p, ri, a) -proc assignLabel(b: var TBlock): Rope {.inline.} = +proc assignLabel(b: var TBlock; result: var Rope) {.inline.} = b.label = "LA" & b.id.rope - result = b.label + result.add b.label -proc blockBody(b: var TBlock): Rope = - result = b.sections[cpsLocals] +proc blockBody(b: var TBlock; result: var Rope) = + result.add b.sections[cpsLocals] if b.frameLen > 0: result.addf("FR_.len+=$1;$n", [b.frameLen.rope]) result.add(b.sections[cpsInit]) @@ -152,7 +160,7 @@ proc blockBody(b: var TBlock): Rope = proc endBlock(p: BProc, blockEnd: Rope) = let topBlock = p.blocks.len-1 # the block is merged into the parent block - p.blocks[topBlock-1].sections[cpsStmts].add(p.blocks[topBlock].blockBody) + p.blocks[topBlock].blockBody(p.blocks[topBlock-1].sections[cpsStmts]) setLen(p.blocks, topBlock) # this is done after the block is popped so $n is # properly indented when pretty printing is enabled @@ -161,10 +169,10 @@ proc endBlock(p: BProc, blockEnd: Rope) = proc endBlock(p: BProc) = let topBlock = p.blocks.len - 1 let frameLen = p.blocks[topBlock].frameLen - var blockEnd: Rope + var blockEnd: Rope = "" if frameLen > 0: blockEnd.addf("FR_.len-=$1;$n", [frameLen.rope]) - if p.blocks[topBlock].label != nil: + if p.blocks[topBlock].label.len != 0: blockEnd.addf("} $1: ;$n", [p.blocks[topBlock].label]) else: blockEnd.addf("}$n", []) @@ -236,8 +244,7 @@ proc genGotoState(p: BProc, n: PNode) = # switch (x.state) { # case 0: goto STATE0; # ... - var a: TLoc - initLocExpr(p, n[0], a) + var a: TLoc = initLocExpr(p, n[0]) lineF(p, cpsStmts, "switch ($1) {$n", [rdLoc(a)]) p.flags.incl beforeRetNeeded lineF(p, cpsStmts, "case -1:$n", []) @@ -256,15 +263,15 @@ proc genGotoState(p: BProc, n: PNode) = proc genBreakState(p: BProc, n: PNode, d: var TLoc) = var a: TLoc - initLoc(d, locExpr, n, OnUnknown) + d = initLoc(locExpr, n, OnUnknown) if n[0].kind == nkClosure: - initLocExpr(p, n[0][1], a) - d.r = "(((NI*) $1)[1] < 0)" % [rdLoc(a)] + a = initLocExpr(p, n[0][1]) + d.snippet = "(((NI*) $1)[1] < 0)" % [rdLoc(a)] else: - initLocExpr(p, n[0], a) + a = initLocExpr(p, n[0]) # the environment is guaranteed to contain the 'state' field at offset 1: - d.r = "((((NI*) $1.ClE_0)[1]) < 0)" % [rdLoc(a)] + d.snippet = "((((NI*) $1.ClE_0)[1]) < 0)" % [rdLoc(a)] proc genGotoVar(p: BProc; value: PNode) = if value.kind notin {nkCharLit..nkUInt64Lit}: @@ -272,26 +279,59 @@ proc genGotoVar(p: BProc; value: PNode) = else: lineF(p, cpsStmts, "goto NIMSTATE_$#;$n", [value.intVal.rope]) -proc genBracedInit(p: BProc, n: PNode; isConst: bool; optionalType: PType): Rope +proc genBracedInit(p: BProc, n: PNode; isConst: bool; optionalType: PType; result: var Rope) -proc potentialValueInit(p: BProc; v: PSym; value: PNode): Rope = +proc potentialValueInit(p: BProc; v: PSym; value: PNode; result: var Rope) = if lfDynamicLib in v.loc.flags or sfThread in v.flags or p.hcrOn: - result = nil + discard "nothing to do" elif sfGlobal in v.flags and value != nil and isDeepConstExpr(value, p.module.compileToCpp) and p.withinLoop == 0 and not containsGarbageCollectedRef(v.typ): #echo "New code produced for ", v.name.s, " ", p.config $ value.info - result = genBracedInit(p, value, isConst = false, v.typ) + genBracedInit(p, value, isConst = false, v.typ, result) + +proc genCppParamsForCtor(p: BProc; call: PNode; didGenTemp: var bool): string = + result = "" + var argsCounter = 0 + let typ = skipTypes(call[0].typ, abstractInst) + assert(typ.kind == tyProc) + for i in 1..<call.len: + #if it's a type we can just generate here another initializer as we are in an initializer context + if call[i].kind == nkCall and call[i][0].kind == nkSym and call[i][0].sym.kind == skType: + if argsCounter > 0: result.add "," + result.add genCppInitializer(p.module, p, call[i][0].sym.typ, didGenTemp) + else: + #We need to test for temp in globals, see: #23657 + let param = + if typ[i].kind in {tyVar} and call[i].kind == nkHiddenAddr: + call[i][0] + else: + call[i] + if param.kind != nkBracketExpr or param.typ.kind in + {tyRef, tyPtr, tyUncheckedArray, tyArray, tyOpenArray, + tyVarargs, tySequence, tyString, tyCstring, tyTuple}: + let tempLoc = initLocExprSingleUse(p, param) + didGenTemp = didGenTemp or tempLoc.k == locTemp + genOtherArg(p, call, i, typ, result, argsCounter) + +proc genCppVarForCtor(p: BProc; call: PNode; decl: var Rope, didGenTemp: var bool) = + let params = genCppParamsForCtor(p, call, didGenTemp) + if params.len == 0: + decl = runtimeFormat("$#;\n", [decl]) else: - result = nil + decl = runtimeFormat("$#($#);\n", [decl, params]) proc genSingleVar(p: BProc, v: PSym; vn, value: PNode) = if sfGoto in v.flags: # translate 'var state {.goto.} = X' into 'goto LX': genGotoVar(p, value) return + let imm = isAssignedImmediately(p.config, value) + let isCppCtorCall = p.module.compileToCpp and imm and + value.kind in nkCallKinds and value[0].kind == nkSym and + v.typ.kind != tyPtr and sfConstructor in value[0].sym.flags var targetProc = p - var traverseProc: Rope - let valueAsRope = potentialValueInit(p, v, value) + var valueAsRope = "" + potentialValueInit(p, v, value, valueAsRope) if sfGlobal in v.flags: if v.flags * {sfImportc, sfExportc} == {sfImportc} and value.kind == nkEmpty and @@ -300,61 +340,63 @@ proc genSingleVar(p: BProc, v: PSym; vn, value: PNode) = if sfPure in v.flags: # v.owner.kind != skModule: targetProc = p.module.preInitProc - assignGlobalVar(targetProc, vn, valueAsRope) + if isCppCtorCall and not containsHiddenPointer(v.typ): + var didGenTemp = false + callGlobalVarCppCtor(targetProc, v, vn, value, didGenTemp) + if didGenTemp: + message(p.config, vn.info, warnGlobalVarConstructorTemporary, vn.sym.name.s) + #We fail to call the constructor in the global scope so we do the call inside the main proc + assignGlobalVar(targetProc, vn, valueAsRope) + var loc = initLocExprSingleUse(targetProc, value) + genAssignment(targetProc, v.loc, loc, {}) + else: + assignGlobalVar(targetProc, vn, valueAsRope) + # XXX: be careful here. # Global variables should not be zeromem-ed within loops # (see bug #20). # That's why we are doing the construction inside the preInitProc. # genObjectInit relies on the C runtime's guarantees that # global variables will be initialized to zero. - if valueAsRope == nil: + if valueAsRope.len == 0: var loc = v.loc - # When the native TLS is unavailable, a global thread-local variable needs # one more layer of indirection in order to access the TLS block. # Only do this for complex types that may need a call to `objectInit` if sfThread in v.flags and emulatedThreadVars(p.config) and isComplexValueType(v.typ): - initLocExprSingleUse(p.module.preInitProc, vn, loc) + loc = initLocExprSingleUse(p.module.preInitProc, vn) genObjectInit(p.module.preInitProc, cpsInit, v.typ, loc, constructObj) # Alternative construction using default constructor (which may zeromem): # if sfImportc notin v.flags: constructLoc(p.module.preInitProc, v.loc) if sfExportc in v.flags and p.module.g.generatedHeader != nil: genVarPrototype(p.module.g.generatedHeader, vn) - traverseProc = getTraverseProc(p, v) - if traverseProc != nil and not p.hcrOn: - registerTraverseProc(p, v, traverseProc) + registerTraverseProc(p, v) else: - let imm = isAssignedImmediately(p.config, value) if imm and p.module.compileToCpp and p.splitDecls == 0 and - not containsHiddenPointer(v.typ): + not containsHiddenPointer(v.typ) and + nimErrorFlagAccessed notin p.flags: # C++ really doesn't like things like 'Foo f; f = x' as that invokes a # parameterless constructor followed by an assignment operator. So we # generate better code here: 'Foo f = x;' genLineDir(p, vn) - let decl = localVarDecl(p, vn) + var decl = localVarDecl(p, vn) var tmp: TLoc - if value.kind in nkCallKinds and value[0].kind == nkSym and - sfConstructor in value[0].sym.flags: - var params: Rope - let typ = skipTypes(value[0].typ, abstractInst) - assert(typ.kind == tyProc) - for i in 1..<value.len: - if params != nil: params.add(~", ") - assert(typ.len == typ.n.len) - params.add(genOtherArg(p, value, i, typ)) - if params == nil: - lineF(p, cpsStmts, "$#;$n", [decl]) - else: - lineF(p, cpsStmts, "$#($#);$n", [decl, params]) + if isCppCtorCall: + var didGenTemp = false + genCppVarForCtor(p, value, decl, didGenTemp) + line(p, cpsStmts, decl) else: - initLocExprSingleUse(p, value, tmp) - lineF(p, cpsStmts, "$# = $#;$n", [decl, tmp.rdLoc]) + tmp = initLocExprSingleUse(p, value) + if value.kind == nkEmpty: + lineF(p, cpsStmts, "$#;\n", [decl]) + else: + lineF(p, cpsStmts, "$# = $#;\n", [decl, tmp.rdLoc]) return assignLocalVar(p, vn) initLocalVar(p, v, imm) - if traverseProc == nil: traverseProc = ~"NULL" + let traverseProc = "NULL" # If the var is in a block (control flow like if/while or a block) in global scope just # register the so called "global" so it can be used later on. There is no need to close # and reopen of if (nim_hcr_do_init_) blocks because we are in one already anyway. @@ -363,7 +405,7 @@ proc genSingleVar(p: BProc, v: PSym; vn, value: PNode) = # put it in the locals section - mainly because of loops which # use the var in a call to resetLoc() in the statements section lineCg(targetProc, cpsLocals, "hcrRegisterGlobal($3, \"$1\", sizeof($2), $4, (void**)&$1);$n", - [v.loc.r, rdLoc(v.loc), getModuleDllPath(p.module, v), traverseProc]) + [v.loc.snippet, rdLoc(v.loc), getModuleDllPath(p.module, v), traverseProc]) # nothing special left to do later on - let's avoid closing and reopening blocks forHcr = false @@ -372,11 +414,12 @@ proc genSingleVar(p: BProc, v: PSym; vn, value: PNode) = # be able to re-run it but without the top level code - just the init of globals if forHcr: lineCg(targetProc, cpsStmts, "if (hcrRegisterGlobal($3, \"$1\", sizeof($2), $4, (void**)&$1))$N", - [v.loc.r, rdLoc(v.loc), getModuleDllPath(p.module, v), traverseProc]) + [v.loc.snippet, rdLoc(v.loc), getModuleDllPath(p.module, v), traverseProc]) startBlock(targetProc) - if value.kind != nkEmpty and valueAsRope == nil: + if value.kind != nkEmpty and valueAsRope.len == 0: genLineDir(targetProc, vn) - loadInto(targetProc, vn, value, v.loc) + if not isCppCtorCall: + loadInto(targetProc, vn, value, v.loc) if forHcr: endBlock(targetProc) @@ -393,12 +436,11 @@ proc genSingleVar(p: BProc, a: PNode) = proc genClosureVar(p: BProc, a: PNode) = var immediateAsgn = a[2].kind != nkEmpty - var v: TLoc - initLocExpr(p, a[0], v) + var v: TLoc = initLocExpr(p, a[0]) genLineDir(p, a) if immediateAsgn: loadInto(p, a[0], a[2], v) - else: + elif sfNoInit notin a[0][1].sym.flags: constructLoc(p, v) proc genVarStmt(p: BProc, n: PNode) = @@ -429,7 +471,7 @@ proc genIf(p: BProc, n: PNode, d: var TLoc) = a: TLoc lelse: TLabel if not isEmptyType(n.typ) and d.k == locNone: - getTemp(p, n.typ, d) + d = getTemp(p, n.typ) genLineDir(p, n) let lend = getLabel(p) for it in n.sons: @@ -437,7 +479,7 @@ proc genIf(p: BProc, n: PNode, d: var TLoc) = if d.k == locTemp and isEmptyType(n.typ): d.k = locNone if it.len == 2: startBlock(p) - initLocExprSingleUse(p, it[0], a) + a = initLocExprSingleUse(p, it[0]) lelse = getLabel(p) inc(p.labels) lineF(p, cpsStmts, "if (!$1) goto $2;$n", @@ -505,7 +547,7 @@ proc genComputedGoto(p: BProc; n: PNode) = # wrapped inside stmt lists by inject destructors won't be recognised let n = n.flattenStmts() var casePos = -1 - var arraySize: int + var arraySize: int = 0 for i in 0..<n.len: let it = n[i] if it.kind == nkCaseStmt: @@ -539,8 +581,7 @@ proc genComputedGoto(p: BProc; n: PNode) = genStmts(p, n[j]) let caseStmt = n[casePos] - var a: TLoc - initLocExpr(p, caseStmt[0], a) + var a: TLoc = initLocExpr(p, caseStmt[0]) # first goto: lineF(p, cpsStmts, "goto *$#[$#];$n", [tmp, a.rdLoc]) @@ -553,7 +594,9 @@ proc genComputedGoto(p: BProc; n: PNode) = return let val = getOrdValue(it[j]) - lineF(p, cpsStmts, "TMP$#_:$n", [intLiteral(toInt64(val)+id+1)]) + var lit = newRopeAppender() + intLiteral(toInt64(val)+id+1, lit) + lineF(p, cpsStmts, "TMP$#_:$n", [lit]) genStmts(p, it.lastSon) @@ -576,8 +619,7 @@ proc genComputedGoto(p: BProc; n: PNode) = else: genStmts(p, it) - var a: TLoc - initLocExpr(p, caseStmt[0], a) + var a: TLoc = initLocExpr(p, caseStmt[0]) lineF(p, cpsStmts, "goto *$#[$#];$n", [tmp, a.rdLoc]) endBlock(p) @@ -605,10 +647,11 @@ proc genWhileStmt(p: BProc, t: PNode) = else: p.breakIdx = startBlock(p, "while (1) {$n") p.blocks[p.breakIdx].isLoop = true - initLocExpr(p, t[0], a) + a = initLocExpr(p, t[0]) if (t[0].kind != nkIntLit) or (t[0].intVal == 0): - let label = assignLabel(p.blocks[p.breakIdx]) - lineF(p, cpsStmts, "if (!$1) goto $2;$n", [rdLoc(a), label]) + lineF(p, cpsStmts, "if (!$1) goto ", [rdLoc(a)]) + assignLabel(p.blocks[p.breakIdx], p.s(cpsStmts)) + appcg(p, cpsStmts, ";$n", []) genStmts(p, loopBody) if optProfiler in p.options: @@ -623,7 +666,7 @@ proc genBlock(p: BProc, n: PNode, d: var TLoc) = # bug #4505: allocate the temp in the outer scope # so that it can escape the generated {}: if d.k == locNone: - getTemp(p, n.typ, d) + d = getTemp(p, n.typ) d.flags.incl(lfEnforceDeref) preserveBreakIdx: p.breakIdx = startBlock(p) @@ -643,14 +686,13 @@ proc genParForStmt(p: BProc, t: PNode) = preserveBreakIdx: let forLoopVar = t[0].sym - var rangeA, rangeB: TLoc assignLocalVar(p, t[0]) #initLoc(forLoopVar.loc, locLocalVar, forLoopVar.typ, onStack) #discard mangleName(forLoopVar) let call = t[1] - assert(call.len in {4, 5}) - initLocExpr(p, call[1], rangeA) - initLocExpr(p, call[2], rangeB) + assert(call.len == 4 or call.len == 5) + var rangeA = initLocExpr(p, call[1]) + var rangeB = initLocExpr(p, call[2]) # $n at the beginning because of #9710 if call.len == 4: # procName(a, b, annotation) @@ -667,8 +709,7 @@ proc genParForStmt(p: BProc, t: PNode) = rangeA.rdLoc, rangeB.rdLoc, call[3].getStr.rope]) else: # `||`(a, b, step, annotation) - var step: TLoc - initLocExpr(p, call[3], step) + var step: TLoc = initLocExpr(p, call[3]) lineF(p, cpsStmts, "$n#pragma omp $5$n" & "for ($1 = $2; $1 <= $3; $1 += $4)", [forLoopVar.loc.rdLoc, @@ -695,12 +736,12 @@ proc genBreakStmt(p: BProc, t: PNode) = while idx >= 0 and not p.blocks[idx].isLoop: dec idx if idx < 0 or not p.blocks[idx].isLoop: internalError(p.config, t.info, "no loop to break") - let label = assignLabel(p.blocks[idx]) + p.blocks[idx].label = "LA" & p.blocks[idx].id.rope blockLeaveActions(p, p.nestedTryStmts.len - p.blocks[idx].nestedTryStmts, p.inExceptBlockLen - p.blocks[idx].nestedExceptStmts) genLineDir(p, t) - lineF(p, cpsStmts, "goto $1;$n", [label]) + lineF(p, cpsStmts, "goto $1;$n", [p.blocks[idx].label]) proc raiseExit(p: BProc) = assert p.config.exc == excGoto @@ -714,6 +755,18 @@ proc raiseExit(p: BProc) = lineCg(p, cpsStmts, "if (NIM_UNLIKELY(*nimErr_)) goto LA$1_;$n", [p.nestedTryStmts[^1].label]) +proc raiseExitCleanup(p: BProc, destroy: string) = + assert p.config.exc == excGoto + if nimErrorFlagDisabled notin p.flags: + p.flags.incl nimErrorFlagAccessed + if p.nestedTryStmts.len == 0: + p.flags.incl beforeRetNeeded + # easy case, simply goto 'ret': + lineCg(p, cpsStmts, "if (NIM_UNLIKELY(*nimErr_)) {$1; goto BeforeRet_;}$n", [destroy]) + else: + lineCg(p, cpsStmts, "if (NIM_UNLIKELY(*nimErr_)) {$2; goto LA$1_;}$n", + [p.nestedTryStmts[^1].label, destroy]) + proc finallyActions(p: BProc) = if p.config.exc != excGoto and p.nestedTryStmts.len > 0 and p.nestedTryStmts[^1].inExcept: # if the current try stmt have a finally block, @@ -722,34 +775,35 @@ proc finallyActions(p: BProc) = if finallyBlock != nil: genSimpleBlock(p, finallyBlock[0]) -proc raiseInstr(p: BProc): Rope = +proc raiseInstr(p: BProc; result: var Rope) = if p.config.exc == excGoto: let L = p.nestedTryStmts.len if L == 0: p.flags.incl beforeRetNeeded # easy case, simply goto 'ret': - result = ropecg(p.module, "goto BeforeRet_;$n", []) + result.add ropecg(p.module, "goto BeforeRet_;$n", []) else: # raise inside an 'except' must go to the finally block, # raise outside an 'except' block must go to the 'except' list. - result = ropecg(p.module, "goto LA$1_;$n", + result.add ropecg(p.module, "goto LA$1_;$n", [p.nestedTryStmts[L-1].label]) # + ord(p.nestedTryStmts[L-1].inExcept)]) - else: - result = nil proc genRaiseStmt(p: BProc, t: PNode) = if t[0].kind != nkEmpty: - var a: TLoc - initLocExprSingleUse(p, t[0], a) + var a: TLoc = initLocExprSingleUse(p, t[0]) finallyActions(p) var e = rdLoc(a) discard getTypeDesc(p.module, t[0].typ) var typ = skipTypes(t[0].typ, abstractPtrs) - # XXX For reasons that currently escape me, this is only required by the new - # C++ based exception handling: - if p.config.exc == excCpp: + case p.config.exc + of excCpp: blockLeaveActions(p, howManyTrys = 0, howManyExcepts = p.inExceptBlockLen) + of excGoto: + blockLeaveActions(p, howManyTrys = 0, + howManyExcepts = (if p.nestedTryStmts.len > 0 and p.nestedTryStmts[^1].inExcept: 1 else: 0)) + else: + discard genLineDir(p, t) if isImportedException(typ, p.config): lineF(p, cpsStmts, "throw $1;$n", [e]) @@ -763,26 +817,20 @@ proc genRaiseStmt(p: BProc, t: PNode) = else: finallyActions(p) genLineDir(p, t) - # reraise the last exception: - if p.config.exc == excCpp: - line(p, cpsStmts, ~"throw;$n") - else: - linefmt(p, cpsStmts, "#reraiseException();$n", []) - let gotoInstr = raiseInstr(p) - if gotoInstr != nil: - line(p, cpsStmts, gotoInstr) + linefmt(p, cpsStmts, "#reraiseException();$n", []) + raiseInstr(p, p.s(cpsStmts)) template genCaseGenericBranch(p: BProc, b: PNode, e: TLoc, rangeFormat, eqFormat: FormatStr, labl: TLabel) = var x, y: TLoc for i in 0..<b.len - 1: if b[i].kind == nkRange: - initLocExpr(p, b[i][0], x) - initLocExpr(p, b[i][1], y) + x = initLocExpr(p, b[i][0]) + y = initLocExpr(p, b[i][1]) lineCg(p, cpsStmts, rangeFormat, [rdCharLoc(e), rdCharLoc(x), rdCharLoc(y), labl]) else: - initLocExpr(p, b[i], x) + x = initLocExpr(p, b[i]) lineCg(p, cpsStmts, eqFormat, [rdCharLoc(e), rdCharLoc(x), labl]) proc genCaseSecondPass(p: BProc, t: PNode, d: var TLoc, @@ -824,23 +872,32 @@ template genIfForCaseUntil(p: BProc, t: PNode, d: var TLoc, template genCaseGeneric(p: BProc, t: PNode, d: var TLoc, rangeFormat, eqFormat: FormatStr) = - var a: TLoc - initLocExpr(p, t[0], a) + var a: TLoc = initLocExpr(p, t[0]) var lend = genIfForCaseUntil(p, t, d, rangeFormat, eqFormat, t.len-1, a) fixLabel(p, lend) proc genCaseStringBranch(p: BProc, b: PNode, e: TLoc, labl: TLabel, + stringKind: TTypeKind, branches: var openArray[Rope]) = var x: TLoc for i in 0..<b.len - 1: assert(b[i].kind != nkRange) - initLocExpr(p, b[i], x) - assert(b[i].kind in {nkStrLit..nkTripleStrLit}) - var j = int(hashString(p.config, b[i].strVal) and high(branches)) - appcg(p.module, branches[j], "if (#eqStrings($1, $2)) goto $3;$n", + x = initLocExpr(p, b[i]) + var j: int = 0 + case b[i].kind + of nkStrLit..nkTripleStrLit: + j = int(hashString(p.config, b[i].strVal) and high(branches)) + of nkNilLit: j = 0 + else: + assert false, "invalid string case branch node kind" + if stringKind == tyCstring: + appcg(p.module, branches[j], "if (#eqCstrings($1, $2)) goto $3;$n", + [rdLoc(e), rdLoc(x), labl]) + else: + appcg(p.module, branches[j], "if (#eqStrings($1, $2)) goto $3;$n", [rdLoc(e), rdLoc(x), labl]) -proc genStringCase(p: BProc, t: PNode, d: var TLoc) = +proc genStringCase(p: BProc, t: PNode, stringKind: TTypeKind, d: var TLoc) = # count how many constant strings there are in the case: var strings = 0 for i in 1..<t.len: @@ -849,24 +906,29 @@ proc genStringCase(p: BProc, t: PNode, d: var TLoc) = var bitMask = math.nextPowerOfTwo(strings) - 1 var branches: seq[Rope] newSeq(branches, bitMask + 1) - var a: TLoc - initLocExpr(p, t[0], a) # fist pass: generate ifs+goto: + var a: TLoc = initLocExpr(p, t[0]) # first pass: generate ifs+goto: var labId = p.labels for i in 1..<t.len: inc(p.labels) if t[i].kind == nkOfBranch: genCaseStringBranch(p, t[i], a, "LA" & rope(p.labels) & "_", - branches) + stringKind, branches) else: # else statement: nothing to do yet # but we reserved a label, which we use later discard - linefmt(p, cpsStmts, "switch (#hashString($1) & $2) {$n", - [rdLoc(a), bitMask]) + if stringKind == tyCstring: + linefmt(p, cpsStmts, "switch (#hashCstring($1) & $2) {$n", + [rdLoc(a), bitMask]) + else: + linefmt(p, cpsStmts, "switch (#hashString($1) & $2) {$n", + [rdLoc(a), bitMask]) for j in 0..high(branches): - if branches[j] != nil: + if branches[j] != "": + var lit = newRopeAppender() + intLiteral(j, lit) lineF(p, cpsStmts, "case $1: $n$2break;$n", - [intLiteral(j), branches[j]]) + [lit, branches[j]]) lineF(p, cpsStmts, "}$n", []) # else statement: if t[^1].kind != nkOfBranch: lineF(p, cpsStmts, "goto LA$1_;$n", [rope(p.labels)]) @@ -874,9 +936,13 @@ proc genStringCase(p: BProc, t: PNode, d: var TLoc) = var lend = genCaseSecondPass(p, t, d, labId, t.len-1) fixLabel(p, lend) else: - genCaseGeneric(p, t, d, "", "if (#eqStrings($1, $2)) goto $3;$n") + if stringKind == tyCstring: + genCaseGeneric(p, t, d, "", "if (#eqCstrings($1, $2)) goto $3;$n") + else: + genCaseGeneric(p, t, d, "", "if (#eqStrings($1, $2)) goto $3;$n") proc branchHasTooBigRange(b: PNode): bool = + result = false for it in b: # last son is block if (it.kind == nkRange) and @@ -884,6 +950,7 @@ proc branchHasTooBigRange(b: PNode): bool = return true proc ifSwitchSplitPoint(p: BProc, n: PNode): int = + result = 0 for i in 1..<n.len: var branch = n[i] var stmtBlock = lastSon(branch) @@ -897,28 +964,33 @@ proc genCaseRange(p: BProc, branch: PNode) = for j in 0..<branch.len-1: if branch[j].kind == nkRange: if hasSwitchRange in CC[p.config.cCompiler].props: - lineF(p, cpsStmts, "case $1 ... $2:$n", [ - genLiteral(p, branch[j][0]), - genLiteral(p, branch[j][1])]) + var litA = newRopeAppender() + var litB = newRopeAppender() + genLiteral(p, branch[j][0], litA) + genLiteral(p, branch[j][1], litB) + lineF(p, cpsStmts, "case $1 ... $2:$n", [litA, litB]) else: var v = copyNode(branch[j][0]) while v.intVal <= branch[j][1].intVal: - lineF(p, cpsStmts, "case $1:$n", [genLiteral(p, v)]) + var litA = newRopeAppender() + genLiteral(p, v, litA) + lineF(p, cpsStmts, "case $1:$n", [litA]) inc(v.intVal) else: - lineF(p, cpsStmts, "case $1:$n", [genLiteral(p, branch[j])]) + var litA = newRopeAppender() + genLiteral(p, branch[j], litA) + lineF(p, cpsStmts, "case $1:$n", [litA]) proc genOrdinalCase(p: BProc, n: PNode, d: var TLoc) = # analyse 'case' statement: var splitPoint = ifSwitchSplitPoint(p, n) # generate if part (might be empty): - var a: TLoc - initLocExpr(p, n[0], a) + var a: TLoc = initLocExpr(p, n[0]) var lend = if splitPoint > 0: genIfForCaseUntil(p, n, d, rangeFormat = "if ($1 >= $2 && $1 <= $3) goto $4;$n", eqFormat = "if ($1 == $2) goto $3;$n", - splitPoint, a) else: nil + splitPoint, a) else: "" # generate switch part (might be empty): if splitPoint+1 < n.len: @@ -936,18 +1008,23 @@ proc genOrdinalCase(p: BProc, n: PNode, d: var TLoc) = hasDefault = true exprBlock(p, branch.lastSon, d) lineF(p, cpsStmts, "break;$n", []) - if (hasAssume in CC[p.config.cCompiler].props) and not hasDefault: - lineF(p, cpsStmts, "default: __assume(0);$n", []) + if not hasDefault: + if hasBuiltinUnreachable in CC[p.config.cCompiler].props: + lineF(p, cpsStmts, "default: __builtin_unreachable();$n", []) + elif hasAssume in CC[p.config.cCompiler].props: + lineF(p, cpsStmts, "default: __assume(0);$n", []) lineF(p, cpsStmts, "}$n", []) - if lend != nil: fixLabel(p, lend) + if lend != "": fixLabel(p, lend) proc genCase(p: BProc, t: PNode, d: var TLoc) = genLineDir(p, t) if not isEmptyType(t.typ) and d.k == locNone: - getTemp(p, t.typ, d) + d = getTemp(p, t.typ) case skipTypes(t[0].typ, abstractVarRange).kind of tyString: - genStringCase(p, t, d) + genStringCase(p, t, tyString, d) + of tyCstring: + genStringCase(p, t, tyCstring, d) of tyFloat..tyFloat128: genCaseGeneric(p, t, d, "if ($1 >= $2 && $1 <= $3) goto $4;$n", "if ($1 == $2) goto $3;$n") @@ -968,7 +1045,7 @@ proc genRestoreFrameAfterException(p: BProc) = proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = #[ code to generate: - std::exception_ptr error = nullptr; + std::exception_ptr error; try { body; } catch (Exception e) { @@ -993,13 +1070,13 @@ proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = p.module.includeHeader("<exception>") if not isEmptyType(t.typ) and d.k == locNone: - getTemp(p, t.typ, d) + d = getTemp(p, t.typ) genLineDir(p, t) inc(p.labels, 2) let etmp = p.labels - - p.procSec(cpsInit).add(ropecg(p.module, "\tstd::exception_ptr T$1_ = nullptr;", [etmp])) + #init on locals, fixes #23306 + lineCg(p, cpsLocals, "std::exception_ptr T$1_;$n", [etmp]) let fin = if t[^1].kind == nkFinally: t[^1] else: nil p.nestedTryStmts.add((fin, false, 0.Natural)) @@ -1033,12 +1110,11 @@ proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = if hasIf: lineF(p, cpsStmts, "else ", []) startBlock(p) # we handled the error: - linefmt(p, cpsStmts, "T$1_ = nullptr;$n", [etmp]) expr(p, t[i][0], d) linefmt(p, cpsStmts, "#popCurrentException();$n", []) endBlock(p) else: - var orExpr = Rope(nil) + var orExpr = newRopeAppender() var exvar = PNode(nil) for j in 0..<t[i].len - 1: var typeNode = t[i][j] @@ -1049,22 +1125,24 @@ proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = if isImportedException(typeNode.typ, p.config): hasImportedCppExceptions = true else: - if orExpr != nil: orExpr.add("||") - let checkFor = if optTinyRtti in p.config.globalOptions: - genTypeInfo2Name(p.module, typeNode.typ) - else: - genTypeInfoV1(p.module, typeNode.typ, typeNode.info) + if orExpr.len != 0: orExpr.add("||") let memberName = if p.module.compileToCpp: "m_type" else: "Sup.m_type" - appcg(p.module, orExpr, "#isObj(#nimBorrowCurrentException()->$1, $2)", [memberName, checkFor]) + if optTinyRtti in p.config.globalOptions: + let checkFor = $getObjDepth(typeNode.typ) + appcg(p.module, orExpr, "#isObjDisplayCheck(#nimBorrowCurrentException()->$1, $2, $3)", [memberName, checkFor, $genDisplayElem(MD5Digest(hashType(typeNode.typ, p.config)))]) + else: + let checkFor = genTypeInfoV1(p.module, typeNode.typ, typeNode.info) + appcg(p.module, orExpr, "#isObj(#nimBorrowCurrentException()->$1, $2)", [memberName, checkFor]) - if orExpr != nil: + if orExpr.len != 0: if hasIf: startBlock(p, "else if ($1) {$n", [orExpr]) else: startBlock(p, "if ($1) {$n", [orExpr]) hasIf = true if exvar != nil: - fillLoc(exvar.sym.loc, locTemp, exvar, mangleLocalName(p, exvar.sym), OnStack) + fillLocalName(p, exvar.sym) + fillLoc(exvar.sym.loc, locTemp, exvar, OnStack) linefmt(p, cpsStmts, "$1 $2 = T$3_;$n", [getTypeDesc(p.module, exvar.sym.typ), rdLoc(exvar.sym.loc), rope(etmp+1)]) # we handled the error: @@ -1094,7 +1172,7 @@ proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = if t[i].len == 1: # general except section: - startBlock(p, "catch (...) {", []) + startBlock(p, "catch (...) {$n", []) genExceptBranchBody(t[i][0]) endBlock(p) catchAllPresent = true @@ -1105,7 +1183,8 @@ proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = typeNode = t[i][j][1] if isImportedException(typeNode.typ, p.config): let exvar = t[i][j][2] # ex1 in `except ExceptType as ex1:` - fillLoc(exvar.sym.loc, locTemp, exvar, mangleLocalName(p, exvar.sym), OnStack) + fillLocalName(p, exvar.sym) + fillLoc(exvar.sym.loc, locTemp, exvar, OnStack) startBlock(p, "catch ($1& $2) {$n", getTypeDesc(p.module, typeNode.typ), rdLoc(exvar.sym.loc)) genExceptBranchBody(t[i][^1]) # exception handler body will duplicated for every type endBlock(p) @@ -1119,7 +1198,7 @@ proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = # general finally block: if t.len > 0 and t[^1].kind == nkFinally: if not catchAllPresent: - startBlock(p, "catch (...) {", []) + startBlock(p, "catch (...) {$n", []) genRestoreFrameAfterException(p) linefmt(p, cpsStmts, "T$1_ = std::current_exception();$n", [etmp]) endBlock(p) @@ -1156,9 +1235,9 @@ proc genTryCppOld(p: BProc, t: PNode, d: var TLoc) = expr(p, body, d) if not isEmptyType(t.typ) and d.k == locNone: - getTemp(p, t.typ, d) + d = getTemp(p, t.typ) genLineDir(p, t) - discard cgsym(p.module, "popCurrentExceptionEx") + cgsym(p.module, "popCurrentExceptionEx") let fin = if t[^1].kind == nkFinally: t[^1] else: nil p.nestedTryStmts.add((fin, false, 0.Natural)) startBlock(p, "try {$n") @@ -1184,7 +1263,8 @@ proc genTryCppOld(p: BProc, t: PNode, d: var TLoc) = for j in 0..<t[i].len-1: if t[i][j].isInfixAs(): let exvar = t[i][j][2] # ex1 in `except ExceptType as ex1:` - fillLoc(exvar.sym.loc, locTemp, exvar, mangleLocalName(p, exvar.sym), OnUnknown) + fillLocalName(p, exvar.sym) + fillLoc(exvar.sym.loc, locTemp, exvar, OnUnknown) startBlock(p, "catch ($1& $2) {$n", getTypeDesc(p.module, t[i][j][1].typ), rdLoc(exvar.sym.loc)) else: startBlock(p, "catch ($1&) {$n", getTypeDesc(p.module, t[i][j].typ)) @@ -1199,7 +1279,7 @@ proc genTryCppOld(p: BProc, t: PNode, d: var TLoc) = # finally requires catch all presence startBlock(p, "catch (...) {$n") genStmts(p, t[^1][0]) - line(p, cpsStmts, ~"throw;$n") + line(p, cpsStmts, "throw;\n") endBlock(p) genSimpleBlock(p, t[^1][0]) @@ -1233,7 +1313,7 @@ proc genTryGoto(p: BProc; t: PNode; d: var TLoc) = p.flags.incl nimErrorFlagAccessed if not isEmptyType(t.typ) and d.k == locNone: - getTemp(p, t.typ, d) + d = getTemp(p, t.typ) expr(p, t[0], d) @@ -1261,16 +1341,18 @@ proc genTryGoto(p: BProc; t: PNode; d: var TLoc) = linefmt(p, cpsStmts, "*nimErr_ = NIM_FALSE;$n", []) expr(p, t[i][0], d) else: - var orExpr: Rope = nil + var orExpr = newRopeAppender() for j in 0..<t[i].len - 1: assert(t[i][j].kind == nkType) - if orExpr != nil: orExpr.add("||") - let checkFor = if optTinyRtti in p.config.globalOptions: - genTypeInfo2Name(p.module, t[i][j].typ) - else: - genTypeInfoV1(p.module, t[i][j].typ, t[i][j].info) + if orExpr.len != 0: orExpr.add("||") let memberName = if p.module.compileToCpp: "m_type" else: "Sup.m_type" - appcg(p.module, orExpr, "#isObj(#nimBorrowCurrentException()->$1, $2)", [memberName, checkFor]) + if optTinyRtti in p.config.globalOptions: + let checkFor = $getObjDepth(t[i][j].typ) + appcg(p.module, orExpr, "#isObjDisplayCheck(#nimBorrowCurrentException()->$1, $2, $3)", + [memberName, checkFor, $genDisplayElem(MD5Digest(hashType(t[i][j].typ, p.config)))]) + else: + let checkFor = genTypeInfoV1(p.module, t[i][j].typ, t[i][j].info) + appcg(p.module, orExpr, "#isObj(#nimBorrowCurrentException()->$1, $2)", [memberName, checkFor]) if i > 1: line(p, cpsStmts, "else ") startBlock(p, "if ($1) {$n", [orExpr]) @@ -1338,7 +1420,7 @@ proc genTrySetjmp(p: BProc, t: PNode, d: var TLoc) = # propagateCurrentException(); # if not isEmptyType(t.typ) and d.k == locNone: - getTemp(p, t.typ, d) + d = getTemp(p, t.typ) let quirkyExceptions = p.config.exc == excQuirky or (t.kind == nkHiddenTryStmt and sfSystemModule in p.module.module.flags) if not quirkyExceptions: @@ -1346,8 +1428,8 @@ proc genTrySetjmp(p: BProc, t: PNode, d: var TLoc) = else: p.flags.incl noSafePoints genLineDir(p, t) - discard cgsym(p.module, "Exception") - var safePoint: Rope + cgsym(p.module, "Exception") + var safePoint: Rope = "" if not quirkyExceptions: safePoint = getTempName(p.module) linefmt(p, cpsLocals, "#TSafePoint $1;$n", [safePoint]) @@ -1356,8 +1438,24 @@ proc genTrySetjmp(p: BProc, t: PNode, d: var TLoc) = linefmt(p, cpsStmts, "$1.status = setjmp($1.context);$n", [safePoint]) elif isDefined(p.config, "nimSigSetjmp"): linefmt(p, cpsStmts, "$1.status = sigsetjmp($1.context, 0);$n", [safePoint]) + elif isDefined(p.config, "nimBuiltinSetjmp"): + linefmt(p, cpsStmts, "$1.status = __builtin_setjmp($1.context);$n", [safePoint]) elif isDefined(p.config, "nimRawSetjmp"): - linefmt(p, cpsStmts, "$1.status = _setjmp($1.context);$n", [safePoint]) + if isDefined(p.config, "mswindows"): + if isDefined(p.config, "vcc") or isDefined(p.config, "clangcl"): + # For the vcc compiler, use `setjmp()` with one argument. + # See https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/setjmp?view=msvc-170 + linefmt(p, cpsStmts, "$1.status = setjmp($1.context);$n", [safePoint]) + else: + # The Windows `_setjmp()` takes two arguments, with the second being an + # undocumented buffer used by the SEH mechanism for stack unwinding. + # Mingw-w64 has been trying to get it right for years, but it's still + # prone to stack corruption during unwinding, so we disable that by setting + # it to NULL. + # More details: https://github.com/status-im/nimbus-eth2/issues/3121 + linefmt(p, cpsStmts, "$1.status = _setjmp($1.context, 0);$n", [safePoint]) + else: + linefmt(p, cpsStmts, "$1.status = _setjmp($1.context);$n", [safePoint]) else: linefmt(p, cpsStmts, "$1.status = setjmp($1.context);$n", [safePoint]) lineCg(p, cpsStmts, "if ($1.status == 0) {$n", [safePoint]) @@ -1389,16 +1487,18 @@ proc genTrySetjmp(p: BProc, t: PNode, d: var TLoc) = linefmt(p, cpsStmts, "#popCurrentException();$n", []) endBlock(p) else: - var orExpr: Rope = nil + var orExpr = newRopeAppender() for j in 0..<t[i].len - 1: assert(t[i][j].kind == nkType) - if orExpr != nil: orExpr.add("||") - let checkFor = if optTinyRtti in p.config.globalOptions: - genTypeInfo2Name(p.module, t[i][j].typ) - else: - genTypeInfoV1(p.module, t[i][j].typ, t[i][j].info) + if orExpr.len != 0: orExpr.add("||") let memberName = if p.module.compileToCpp: "m_type" else: "Sup.m_type" - appcg(p.module, orExpr, "#isObj(#nimBorrowCurrentException()->$1, $2)", [memberName, checkFor]) + if optTinyRtti in p.config.globalOptions: + let checkFor = $getObjDepth(t[i][j].typ) + appcg(p.module, orExpr, "#isObjDisplayCheck(#nimBorrowCurrentException()->$1, $2, $3)", + [memberName, checkFor, $genDisplayElem(MD5Digest(hashType(t[i][j].typ, p.config)))]) + else: + let checkFor = genTypeInfoV1(p.module, t[i][j].typ, t[i][j].info) + appcg(p.module, orExpr, "#isObj(#nimBorrowCurrentException()->$1, $2)", [memberName, checkFor]) if i > 1: line(p, cpsStmts, "else ") startBlock(p, "if ($1) {$n", [orExpr]) @@ -1424,35 +1524,33 @@ proc genTrySetjmp(p: BProc, t: PNode, d: var TLoc) = if not quirkyExceptions: linefmt(p, cpsStmts, "if ($1.status != 0) #reraiseException();$n", [safePoint]) -proc genAsmOrEmitStmt(p: BProc, t: PNode, isAsmStmt=false): Rope = +proc genAsmOrEmitStmt(p: BProc, t: PNode, isAsmStmt=false; result: var Rope) = var res = "" - for it in t.sons: + let offset = + if isAsmStmt: 1 # first son is pragmas + else: 0 + + for i in offset..<t.len: + let it = t[i] case it.kind of nkStrLit..nkTripleStrLit: res.add(it.strVal) of nkSym: var sym = it.sym if sym.kind in {skProc, skFunc, skIterator, skMethod}: - var a: TLoc - initLocExpr(p, it, a) + var a: TLoc = initLocExpr(p, it) res.add($rdLoc(a)) elif sym.kind == skType: res.add($getTypeDesc(p.module, sym.typ)) else: discard getTypeDesc(p.module, skipTypes(sym.typ, abstractPtrs)) - var r = sym.loc.r - if r == nil: - # if no name has already been given, - # it doesn't matter much: - r = mangleName(p.module, sym) - sym.loc.r = r # but be consequent! - res.add($r) + fillBackendName(p.module, sym) + res.add($sym.loc.snippet) of nkTypeOfExpr: res.add($getTypeDesc(p.module, it.typ)) else: discard getTypeDesc(p.module, skipTypes(it.typ, abstractPtrs)) - var a: TLoc - initLocExpr(p, it, a) + var a: TLoc = initLocExpr(p, it) res.add($a.rdLoc) if isAsmStmt and hasGnuAsm in CC[p.config.cCompiler].props: @@ -1471,12 +1569,28 @@ proc genAsmOrEmitStmt(p: BProc, t: PNode, isAsmStmt=false): Rope = result.add("\\n\"\n") else: res.add("\L") - result = res.rope + result.add res.rope proc genAsmStmt(p: BProc, t: PNode) = assert(t.kind == nkAsmStmt) genLineDir(p, t) - var s = genAsmOrEmitStmt(p, t, isAsmStmt=true) + var s = newRopeAppender() + + var asmSyntax = "" + if (let p = t[0]; p.kind == nkPragma): + for i in p: + if whichPragma(i) == wAsmSyntax: + asmSyntax = i[1].strVal + + if asmSyntax != "" and + not ( + asmSyntax == "gcc" and hasGnuAsm in CC[p.config.cCompiler].props or + asmSyntax == "vcc" and hasGnuAsm notin CC[p.config.cCompiler].props): + localError( + p.config, t.info, + "Your compiler does not support the specified inline assembler") + + genAsmOrEmitStmt(p, t, isAsmStmt=true, s) # see bug #2362, "top level asm statements" seem to be a mis-feature # but even if we don't do this, the example in #2362 cannot possibly # work: @@ -1484,18 +1598,20 @@ proc genAsmStmt(p: BProc, t: PNode) = # top level asm statement? p.module.s[cfsProcHeaders].add runtimeFormat(CC[p.config.cCompiler].asmStmtFrmt, [s]) else: - p.s(cpsStmts).add indentLine(p, runtimeFormat(CC[p.config.cCompiler].asmStmtFrmt, [s])) + addIndent p, p.s(cpsStmts) + p.s(cpsStmts).add runtimeFormat(CC[p.config.cCompiler].asmStmtFrmt, [s]) proc determineSection(n: PNode): TCFileSection = result = cfsProcHeaders if n.len >= 1 and n[0].kind in {nkStrLit..nkTripleStrLit}: let sec = n[0].strVal - if sec.startsWith("/*TYPESECTION*/"): result = cfsTypes + if sec.startsWith("/*TYPESECTION*/"): result = cfsForwardTypes # TODO WORKAROUND elif sec.startsWith("/*VARSECTION*/"): result = cfsVars elif sec.startsWith("/*INCLUDESECTION*/"): result = cfsHeaders proc genEmit(p: BProc, t: PNode) = - var s = genAsmOrEmitStmt(p, t[1]) + var s = newRopeAppender() + genAsmOrEmitStmt(p, t[1], false, s) if p.prc == nil: # top level emit pragma? let section = determineSection(t[1]) @@ -1506,14 +1622,14 @@ proc genEmit(p: BProc, t: PNode) = line(p, cpsStmts, s) proc genPragma(p: BProc, n: PNode) = - for it in n.sons: + for i in 0..<n.len: + let it = n[i] case whichPragma(it) of wEmit: genEmit(p, it) - of wInjectStmt: - var p = newProc(nil, p.module) - p.options.excl {optLineTrace, optStackTrace} - genStmts(p, it[1]) - p.module.injectStmt = p.s(cpsStmts) + of wPush: + processPushBackendOption(p.config, p.optionsStack, p.options, n, i+1) + of wPop: + processPopBackendOption(p.config, p.optionsStack, p.options) else: discard @@ -1525,10 +1641,14 @@ proc genDiscriminantCheck(p: BProc, a, tmp: TLoc, objtype: PType, if not containsOrIncl(p.module.declaredThings, field.id): appcg(p.module, cfsVars, "extern $1", [discriminatorTableDecl(p.module, t, field)]) + var lit = newRopeAppender() + intLiteral(toInt64(lengthOrd(p.config, field.typ))+1, lit) lineCg(p, cpsStmts, "#FieldDiscriminantCheck((NI)(NU)($1), (NI)(NU)($2), $3, $4);$n", [rdLoc(a), rdLoc(tmp), discriminatorTableName(p.module, t, field), - intLiteral(toInt64(lengthOrd(p.config, field.typ))+1)]) + lit]) + if p.config.exc == excGoto: + raiseExit(p) when false: proc genCaseObjDiscMapping(p: BProc, e: PNode, t: PType, field: PSym; d: var TLoc) = @@ -1547,13 +1667,12 @@ when false: expr(p, call, d) proc asgnFieldDiscriminant(p: BProc, e: PNode) = - var a, tmp: TLoc var dotExpr = e[0] if dotExpr.kind == nkCheckedFieldExpr: dotExpr = dotExpr[0] - initLocExpr(p, e[0], a) - getTemp(p, a.t, tmp) + var a = initLocExpr(p, e[0]) + var tmp: TLoc = getTemp(p, a.t) expr(p, e[1], tmp) - if optTinyRtti notin p.config.globalOptions: + if p.inUncheckedAssignSection == 0: let field = dotExpr[1].sym genDiscriminantCheck(p, a, tmp, dotExpr[0].typ, field) message(p.config, e.info, warnCaseTransition) @@ -1569,11 +1688,11 @@ proc genAsgn(p: BProc, e: PNode, fastAsgn: bool) = else: let le = e[0] let ri = e[1] - var a: TLoc - discard getTypeDesc(p.module, le.typ.skipTypes(skipPtrs), skVar) - initLoc(a, locNone, le, OnUnknown) + var a: TLoc = initLoc(locNone, le, OnUnknown) + discard getTypeDesc(p.module, le.typ.skipTypes(skipPtrs), dkVar) a.flags.incl(lfEnforceDeref) a.flags.incl(lfPrepareForMutation) + genLineDir(p, le) # it can be a nkBracketExpr, which may raise expr(p, le, a) a.flags.excl(lfPrepareForMutation) if fastAsgn: incl(a.flags, lfNoDeepCopy) @@ -1582,7 +1701,7 @@ proc genAsgn(p: BProc, e: PNode, fastAsgn: bool) = loadInto(p, le, ri, a) proc genStmts(p: BProc, t: PNode) = - var a: TLoc + var a: TLoc = default(TLoc) let isPush = p.config.hasHint(hintExtendedContext) if isPush: pushInfoContext(p.config, t.info) diff --git a/compiler/ccgthreadvars.nim b/compiler/ccgthreadvars.nim index fbe8bce9e..1f551f022 100644 --- a/compiler/ccgthreadvars.nim +++ b/compiler/ccgthreadvars.nim @@ -30,7 +30,7 @@ proc declareThreadVar(m: BModule, s: PSym, isExtern: bool) = # allocator for it :-( if not containsOrIncl(m.g.nimtvDeclared, s.id): m.g.nimtvDeps.add(s.loc.t) - m.g.nimtv.addf("$1 $2;$n", [getTypeDesc(m, s.loc.t), s.loc.r]) + m.g.nimtv.addf("$1 $2;$n", [getTypeDesc(m, s.loc.t), s.loc.snippet]) else: if isExtern: m.s[cfsVars].add("extern ") elif lfExportLib in s.loc.flags: m.s[cfsVars].add("N_LIB_EXPORT_VAR ") @@ -41,16 +41,16 @@ proc declareThreadVar(m: BModule, s: PSym, isExtern: bool) = m.s[cfsVars].add("NIM_THREAD_LOCAL ") else: m.s[cfsVars].add("NIM_THREADVAR ") m.s[cfsVars].add(getTypeDesc(m, s.loc.t)) - m.s[cfsVars].addf(" $1;$n", [s.loc.r]) + m.s[cfsVars].addf(" $1;$n", [s.loc.snippet]) proc generateThreadLocalStorage(m: BModule) = - if m.g.nimtv != nil and (usesThreadVars in m.flags or sfMainModule in m.module.flags): + if m.g.nimtv != "" and (usesThreadVars in m.flags or sfMainModule in m.module.flags): for t in items(m.g.nimtvDeps): discard getTypeDesc(m, t) finishTypeDescriptions(m) m.s[cfsSeqTypes].addf("typedef struct {$1} NimThreadVars;$n", [m.g.nimtv]) proc generateThreadVarsSize(m: BModule) = - if m.g.nimtv != nil: + if m.g.nimtv != "": let externc = if m.config.backend == backendCpp or sfCompileToCpp in m.module.flags: "extern \"C\" " else: "" diff --git a/compiler/ccgtrav.nim b/compiler/ccgtrav.nim index 29b93e530..ed4c79d9a 100644 --- a/compiler/ccgtrav.nim +++ b/compiler/ccgtrav.nim @@ -21,7 +21,7 @@ const proc genTraverseProc(c: TTraversalClosure, accessor: Rope, typ: PType) proc genCaseRange(p: BProc, branch: PNode) -proc getTemp(p: BProc, t: PType, result: var TLoc; needsInit=false) +proc getTemp(p: BProc, t: PType, needsInit=false): TLoc proc genTraverseProc(c: TTraversalClosure, accessor: Rope, n: PNode; typ: PType) = @@ -34,10 +34,10 @@ proc genTraverseProc(c: TTraversalClosure, accessor: Rope, n: PNode; if (n[0].kind != nkSym): internalError(c.p.config, n.info, "genTraverseProc") var p = c.p let disc = n[0].sym - if disc.loc.r == nil: fillObjectFields(c.p.module, typ) + if disc.loc.snippet == "": fillObjectFields(c.p.module, typ) if disc.loc.t == nil: internalError(c.p.config, n.info, "genTraverseProc()") - lineF(p, cpsStmts, "switch ($1.$2) {$n", [accessor, disc.loc.r]) + lineF(p, cpsStmts, "switch ($1.$2) {$n", [accessor, disc.loc.snippet]) for i in 1..<n.len: let branch = n[i] assert branch.kind in {nkOfBranch, nkElse} @@ -51,10 +51,10 @@ proc genTraverseProc(c: TTraversalClosure, accessor: Rope, n: PNode; of nkSym: let field = n.sym if field.typ.kind == tyVoid: return - if field.loc.r == nil: fillObjectFields(c.p.module, typ) + if field.loc.snippet == "": fillObjectFields(c.p.module, typ) if field.loc.t == nil: internalError(c.p.config, n.info, "genTraverseProc()") - genTraverseProc(c, "$1.$2" % [accessor, field.loc.r], field.loc.t) + genTraverseProc(c, "$1.$2" % [accessor, field.loc.snippet], field.loc.t) else: internalError(c.p.config, n.info, "genTraverseProc()") proc parentObj(accessor: Rope; m: BModule): Rope {.inline.} = @@ -71,37 +71,36 @@ proc genTraverseProc(c: TTraversalClosure, accessor: Rope, typ: PType) = case typ.kind of tyGenericInst, tyGenericBody, tyTypeDesc, tyAlias, tyDistinct, tyInferred, tySink, tyOwned: - genTraverseProc(c, accessor, lastSon(typ)) + genTraverseProc(c, accessor, skipModifier(typ)) of tyArray: - let arraySize = lengthOrd(c.p.config, typ[0]) - var i: TLoc - getTemp(p, getSysType(c.p.module.g.graph, unknownLineInfo, tyInt), i) - let oldCode = p.s(cpsStmts) + let arraySize = lengthOrd(c.p.config, typ.indexType) + var i: TLoc = getTemp(p, getSysType(c.p.module.g.graph, unknownLineInfo, tyInt)) + var oldCode = p.s(cpsStmts) + freeze oldCode linefmt(p, cpsStmts, "for ($1 = 0; $1 < $2; $1++) {$n", - [i.r, arraySize]) + [i.snippet, arraySize]) let oldLen = p.s(cpsStmts).len - genTraverseProc(c, ropecg(c.p.module, "$1[$2]", [accessor, i.r]), typ[1]) + genTraverseProc(c, ropecg(c.p.module, "$1[$2]", [accessor, i.snippet]), typ.elementType) if p.s(cpsStmts).len == oldLen: # do not emit dummy long loops for faster debug builds: p.s(cpsStmts) = oldCode else: lineF(p, cpsStmts, "}$n", []) of tyObject: - for i in 0..<typ.len: - var x = typ[i] - if x != nil: x = x.skipTypes(skipPtrs) - genTraverseProc(c, accessor.parentObj(c.p.module), x) + var x = typ.baseClass + if x != nil: x = x.skipTypes(skipPtrs) + genTraverseProc(c, accessor.parentObj(c.p.module), x) if typ.n != nil: genTraverseProc(c, accessor, typ.n, typ) of tyTuple: let typ = getUniqueType(typ) - for i in 0..<typ.len: - genTraverseProc(c, ropecg(c.p.module, "$1.Field$2", [accessor, i]), typ[i]) + for i, a in typ.ikids: + genTraverseProc(c, ropecg(c.p.module, "$1.Field$2", [accessor, i]), a) of tyRef: lineCg(p, cpsStmts, visitorFrmt, [accessor, c.visitorFrmt]) of tySequence: if optSeqDestructors notin c.p.module.config.globalOptions: lineCg(p, cpsStmts, visitorFrmt, [accessor, c.visitorFrmt]) - elif containsGarbageCollectedRef(typ.lastSon): + elif containsGarbageCollectedRef(typ.elementType): # destructor based seqs are themselves not traced but their data is, if # they contain a GC'ed type: lineCg(p, cpsStmts, "#nimGCvisitSeq((void*)$1, $2);$n", [accessor, c.visitorFrmt]) @@ -118,16 +117,15 @@ proc genTraverseProc(c: TTraversalClosure, accessor: Rope, typ: PType) = proc genTraverseProcSeq(c: TTraversalClosure, accessor: Rope, typ: PType) = var p = c.p assert typ.kind == tySequence - var i: TLoc - getTemp(p, getSysType(c.p.module.g.graph, unknownLineInfo, tyInt), i) - let oldCode = p.s(cpsStmts) - var a: TLoc - a.r = accessor + var i = getTemp(p, getSysType(c.p.module.g.graph, unknownLineInfo, tyInt)) + var oldCode = p.s(cpsStmts) + freeze oldCode + var a = TLoc(snippet: accessor) lineF(p, cpsStmts, "for ($1 = 0; $1 < $2; $1++) {$n", - [i.r, lenExpr(c.p, a)]) + [i.snippet, lenExpr(c.p, a)]) let oldLen = p.s(cpsStmts).len - genTraverseProc(c, "$1$3[$2]" % [accessor, i.r, dataField(c.p)], typ[0]) + genTraverseProc(c, "$1$3[$2]" % [accessor, i.snippet, dataField(c.p)], typ.elementType) if p.s(cpsStmts).len == oldLen: # do not emit dummy long loops for faster debug builds: p.s(cpsStmts) = oldCode @@ -135,7 +133,6 @@ proc genTraverseProcSeq(c: TTraversalClosure, accessor: Rope, typ: PType) = lineF(p, cpsStmts, "}$n", []) proc genTraverseProc(m: BModule, origTyp: PType; sig: SigHash): Rope = - var c: TTraversalClosure var p = newProc(nil, m) result = "Marker_" & getTypeName(m, origTyp, sig) let @@ -148,18 +145,19 @@ proc genTraverseProc(m: BModule, origTyp: PType; sig: SigHash): Rope = lineF(p, cpsLocals, "$1 a;$n", [t]) lineF(p, cpsInit, "a = ($1)p;$n", [t]) - c.p = p - c.visitorFrmt = "op" # "#nimGCvisit((void*)$1, op);$n" + var c = TTraversalClosure(p: p, + visitorFrmt: "op" # "#nimGCvisit((void*)$1, op);$n" + ) assert typ.kind != tyTypeDesc if typ.kind == tySequence: genTraverseProcSeq(c, "a".rope, typ) else: - if skipTypes(typ[0], typedescInst+{tyOwned}).kind == tyArray: + if skipTypes(typ.elementType, typedescInst+{tyOwned}).kind == tyArray: # C's arrays are broken beyond repair: - genTraverseProc(c, "a".rope, typ[0]) + genTraverseProc(c, "a".rope, typ.elementType) else: - genTraverseProc(c, "(*a)".rope, typ[0]) + genTraverseProc(c, "(*a)".rope, typ.elementType) let generatedProc = "$1 {$n$2$3$4}\n" % [header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)] @@ -175,7 +173,6 @@ proc genTraverseProc(m: BModule, origTyp: PType; sig: SigHash): Rope = proc genTraverseProcForGlobal(m: BModule, s: PSym; info: TLineInfo): Rope = discard genTypeInfoV1(m, s.loc.t, info) - var c: TTraversalClosure var p = newProc(nil, m) var sLoc = rdLoc(s.loc) result = getTempName(m) @@ -184,8 +181,10 @@ proc genTraverseProcForGlobal(m: BModule, s: PSym; info: TLineInfo): Rope = accessThreadLocalVar(p, s) sLoc = "NimTV_->" & sLoc - c.visitorFrmt = "0" # "#nimGCvisit((void*)$1, 0);$n" - c.p = p + var c = TTraversalClosure(p: p, + visitorFrmt: "0" # "#nimGCvisit((void*)$1, 0);$n" + ) + let header = "static N_NIMCALL(void, $1)(void)" % [result] genTraverseProc(c, sLoc, s.loc.t) diff --git a/compiler/ccgtypes.nim b/compiler/ccgtypes.nim index e17a55542..2c2556336 100644 --- a/compiler/ccgtypes.nim +++ b/compiler/ccgtypes.nim @@ -11,10 +11,29 @@ # ------------------------- Name Mangling -------------------------------- -import sighashes, modulegraphs -from lowerings import createObj +import sighashes, modulegraphs, std/strscans +import ../dist/checksums/src/checksums/md5 +import std/sequtils -proc genProcHeader(m: BModule, prc: PSym, asPtr: bool = false): Rope +type + TypeDescKind = enum + dkParam #skParam + dkRefParam #param passed by ref when {.byref.} is used. Cpp only. C goes straight to dkParam and is handled as a regular pointer + dkRefGenericParam #param passed by ref when {.byref.} is used that is also a generic. Cpp only. C goes straight to dkParam and is handled as a regular pointer + dkVar #skVar + dkField #skField + dkResult #skResult + dkConst #skConst + dkOther #skType, skTemp, skLet and skForVar so far + +proc descKindFromSymKind(kind: TSymKind): TypeDescKind = + case kind + of skParam: dkParam + of skVar: dkVar + of skField: dkField + of skResult: dkResult + of skConst: dkConst + else: dkOther proc isKeyword(w: PIdent): bool = # Nim and C++ share some keywords @@ -36,27 +55,39 @@ proc mangleField(m: BModule; name: PIdent): string = if isKeyword(name): result.add "_0" -proc mangleName(m: BModule; s: PSym): Rope = - result = s.loc.r - if result == nil: - result = s.name.s.mangle.rope - result.add "_" - result.add m.g.graph.ifaces[s.itemId.module].uniqueName - result.add "_" - result.add rope s.itemId.item +proc mangleProc(m: BModule; s: PSym; makeUnique: bool): string = + result = "_Z" # Common prefix in Itanium ABI + result.add encodeSym(m, s, makeUnique) + if s.typ.len > 1: #we dont care about the return param + for i in 1..<s.typ.len: + if s.typ[i].isNil: continue + result.add encodeType(m, s.typ[i]) + + if result in m.g.mangledPrcs: + result = mangleProc(m, s, true) + else: + m.g.mangledPrcs.incl(result) + +proc fillBackendName(m: BModule; s: PSym) = + if s.loc.snippet == "": + var result: Rope + if not m.compileToCpp and s.kind in routineKinds and optCDebug in m.g.config.globalOptions and + m.g.config.symbolFiles == disabledSf: + result = mangleProc(m, s, false).rope + else: + result = s.name.s.mangle.rope + result.add mangleProcNameExt(m.g.graph, s) if m.hcrOn: - result.add "_" - result.add(idOrSig(s, m.module.name.s.mangle, m.sigConflicts)) - s.loc.r = result + result.add '_' + result.add(idOrSig(s, m.module.name.s.mangle, m.sigConflicts, m.config)) + s.loc.snippet = result writeMangledName(m.ndi, s, m.config) -proc mangleParamName(m: BModule; s: PSym): Rope = - ## we cannot use 'sigConflicts' here since we have a BModule, not a BProc. - ## Fortunately C's scoping rules are sane enough so that that doesn't - ## cause any trouble. - result = s.loc.r - if result == nil: +proc fillParamName(m: BModule; s: PSym) = + if s.loc.snippet == "": var res = s.name.s.mangle + res.add mangleParamExt(s) + #res.add idOrSig(s, res, m.sigConflicts, m.config) # Take into account if HCR is on because of the following scenario: # if a module gets imported and it has some more importc symbols in it, # some param names might receive the "_0" suffix to distinguish from what @@ -73,28 +104,23 @@ proc mangleParamName(m: BModule; s: PSym): Rope = # and a function called in main or proxy uses `socket` as a parameter name. # That would lead to either needing to reload `proxy` or to overwrite the # executable file for the main module, which is running (or both!) -> error. - if m.hcrOn or isKeyword(s.name) or m.g.config.cppDefines.contains(res): - res.add "_0" - result = res.rope - s.loc.r = result + s.loc.snippet = res.rope writeMangledName(m.ndi, s, m.config) -proc mangleLocalName(p: BProc; s: PSym): Rope = +proc fillLocalName(p: BProc; s: PSym) = assert s.kind in skLocalVars+{skTemp} #assert sfGlobal notin s.flags - result = s.loc.r - if result == nil: + if s.loc.snippet == "": var key = s.name.s.mangle - shallow(key) let counter = p.sigConflicts.getOrDefault(key) - result = key.rope + var result = key.rope if s.kind == skTemp: # speed up conflict search for temps (these are quite common): if counter != 0: result.add "_" & rope(counter+1) elif counter != 0 or isKeyword(s.name) or p.module.g.config.cppDefines.contains(key): result.add "_" & rope(counter+1) p.sigConflicts.inc(key) - s.loc.r = result + s.loc.snippet = result if s.kind != skTemp: writeMangledName(p.module.ndi, s, p.config) proc scopeMangledParam(p: BProc; param: PSym) = @@ -103,7 +129,6 @@ proc scopeMangledParam(p: BProc; param: PSym) = ## generate unique identifiers reliably (consider that ``var a = a`` is ## even an idiom in Nim). var key = param.name.s.mangle - shallow(key) p.sigConflicts.inc(key) const @@ -111,33 +136,35 @@ const tyDistinct, tyRange, tyStatic, tyAlias, tySink, tyInferred, tyOwned} -proc typeName(typ: PType): Rope = +proc typeName(typ: PType; result: var Rope) = let typ = typ.skipTypes(irrelevantForBackend) - result = - if typ.sym != nil and typ.kind in {tyObject, tyEnum}: - rope($typ.kind & '_' & typ.sym.name.s.mangle) - else: - rope($typ.kind) + result.add $typ.kind + if typ.sym != nil and typ.kind in {tyObject, tyEnum}: + result.add "_" + result.add typ.sym.name.s.mangle proc getTypeName(m: BModule; typ: PType; sig: SigHash): Rope = var t = typ while true: if t.sym != nil and {sfImportc, sfExportc} * t.sym.flags != {}: - return t.sym.loc.r + return t.sym.loc.snippet if t.kind in irrelevantForBackend: - t = t.lastSon + t = t.skipModifier else: break - let typ = if typ.kind in {tyAlias, tySink, tyOwned}: typ.lastSon else: typ - if typ.loc.r == nil: - typ.loc.r = typ.typeName & $sig + let typ = if typ.kind in {tyAlias, tySink, tyOwned}: typ.elementType else: typ + if typ.loc.snippet == "": + typ.typeName(typ.loc.snippet) + typ.loc.snippet.add $sig else: when defined(debugSigHashes): # check consistency: - assert($typ.loc.r == $(typ.typeName & $sig)) - result = typ.loc.r - if result == nil: internalError(m.config, "getTypeName: " & $typ.kind) + var tn = newRopeAppender() + typ.typeName(tn) + assert($typ.loc.snippet == $(tn & $sig)) + result = typ.loc.snippet + if result == "": internalError(m.config, "getTypeName: " & $typ.kind) proc mapSetType(conf: ConfigRef; typ: PType): TCTypeKind = case int(getSize(conf, typ)) @@ -147,7 +174,7 @@ proc mapSetType(conf: ConfigRef; typ: PType): TCTypeKind = of 8: result = ctInt64 else: result = ctArray -proc mapType(conf: ConfigRef; typ: PType; kind: TSymKind): TCTypeKind = +proc mapType(conf: ConfigRef; typ: PType; isParam: bool): TCTypeKind = ## Maps a Nim type to a C type case typ.kind of tyNone, tyTyped: result = ctVoid @@ -156,16 +183,16 @@ proc mapType(conf: ConfigRef; typ: PType; kind: TSymKind): TCTypeKind = of tyNil: result = ctPtr of tySet: result = mapSetType(conf, typ) of tyOpenArray, tyVarargs: - if kind == skParam: result = ctArray + if isParam: result = ctArray else: result = ctStruct of tyArray, tyUncheckedArray: result = ctArray of tyObject, tyTuple: result = ctStruct of tyUserTypeClasses: doAssert typ.isResolvedUserTypeClass - return mapType(conf, typ.lastSon, kind) + result = mapType(conf, typ.skipModifier, isParam) of tyGenericBody, tyGenericInst, tyGenericParam, tyDistinct, tyOrdinal, tyTypeDesc, tyAlias, tySink, tyInferred, tyOwned: - result = mapType(conf, lastSon(typ), kind) + result = mapType(conf, skipModifier(typ), isParam) of tyEnum: if firstOrd(conf, typ) < 0: result = ctInt32 @@ -176,9 +203,9 @@ proc mapType(conf: ConfigRef; typ: PType; kind: TSymKind): TCTypeKind = of 4: result = ctInt32 of 8: result = ctInt64 else: result = ctInt32 - of tyRange: result = mapType(conf, typ[0], kind) + of tyRange: result = mapType(conf, typ.elementType, isParam) of tyPtr, tyVar, tyLent, tyRef: - var base = skipTypes(typ.lastSon, typedescInst) + var base = skipTypes(typ.elementType, typedescInst) case base.kind of tyOpenArray, tyArray, tyVarargs, tyUncheckedArray: result = ctPtrToArray of tySet: @@ -189,18 +216,23 @@ proc mapType(conf: ConfigRef; typ: PType; kind: TSymKind): TCTypeKind = of tySequence: result = ctNimSeq of tyProc: result = if typ.callConv != ccClosure: ctProc else: ctStruct of tyString: result = ctNimStr - of tyCString: result = ctCString + of tyCstring: result = ctCString of tyInt..tyUInt64: result = TCTypeKind(ord(typ.kind) - ord(tyInt) + ord(ctInt)) of tyStatic: - if typ.n != nil: result = mapType(conf, lastSon typ, kind) - else: doAssert(false, "mapType") - else: doAssert(false, "mapType") + if typ.n != nil: result = mapType(conf, typ.skipModifier, isParam) + else: + result = ctVoid + doAssert(false, "mapType: " & $typ.kind) + else: + result = ctVoid + doAssert(false, "mapType: " & $typ.kind) + proc mapReturnType(conf: ConfigRef; typ: PType): TCTypeKind = #if skipTypes(typ, typedescInst).kind == tyArray: result = ctPtr #else: - result = mapType(conf, typ, skResult) + result = mapType(conf, typ, false) proc isImportedType(t: PType): bool = result = t.sym != nil and sfImportc in t.sym.flags @@ -210,28 +242,47 @@ proc isImportedCppType(t: PType): bool = result = (t.sym != nil and sfInfixCall in t.sym.flags) or (x.sym != nil and sfInfixCall in x.sym.flags) -proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet; kind: TSymKind): Rope +proc isOrHasImportedCppType(typ: PType): bool = + searchTypeFor(typ.skipTypes({tyRef}), isImportedCppType) + +proc hasNoInit(t: PType): bool = + result = t.sym != nil and sfNoInit in t.sym.flags + +proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDescKind): Rope proc isObjLackingTypeField(typ: PType): bool {.inline.} = result = (typ.kind == tyObject) and ((tfFinal in typ.flags) and - (typ[0] == nil) or isPureObject(typ)) + (typ.baseClass == nil) or isPureObject(typ)) -proc isInvalidReturnType(conf: ConfigRef; rettype: PType): bool = +proc isInvalidReturnType(conf: ConfigRef; typ: PType, isProc = true): bool = # Arrays and sets cannot be returned by a C procedure, because C is # such a poor programming language. # We exclude records with refs too. This enhances efficiency and # is necessary for proper code generation of assignments. - if rettype == nil: result = true + var rettype = typ + var isAllowedCall = true + if isProc: + rettype = rettype[0] + isAllowedCall = typ.callConv in {ccClosure, ccInline, ccNimCall} + if rettype == nil or (isAllowedCall and + getSize(conf, rettype) > conf.target.floatSize*3): + result = true else: - case mapType(conf, rettype, skResult) + case mapType(conf, rettype, false) of ctArray: result = not (skipTypes(rettype, typedescInst).kind in {tyVar, tyLent, tyRef, tyPtr}) of ctStruct: let t = skipTypes(rettype, typedescInst) - if rettype.isImportedCppType or t.isImportedCppType: return false - result = containsGarbageCollectedRef(t) or - (t.kind == tyObject and not isObjLackingTypeField(t)) + if rettype.isImportedCppType or t.isImportedCppType or + (typ.callConv == ccCDecl and conf.selectedGC in {gcArc, gcAtomicArc, gcOrc}): + # prevents nrvo for cdecl procs; # bug #23401 + result = false + else: + result = containsGarbageCollectedRef(t) or + (t.kind == tyObject and not isObjLackingTypeField(t)) or + (getSize(conf, rettype) == szUnknownSize and (t.sym == nil or sfImportc notin t.sym.flags)) + else: result = false const @@ -239,7 +290,9 @@ const "N_STDCALL", "N_CDECL", "N_SAFECALL", "N_SYSCALL", # this is probably not correct for all platforms, # but one can #define it to what one wants - "N_INLINE", "N_NOINLINE", "N_FASTCALL", "N_THISCALL", "N_CLOSURE", "N_NOCONV"] + "N_INLINE", "N_NOINLINE", "N_FASTCALL", "N_THISCALL", "N_CLOSURE", "N_NOCONV", + "N_NOCONV" #ccMember is N_NOCONV + ] proc cacheGetType(tab: TypeCache; sig: SigHash): Rope = # returns nil if we need to declare this type @@ -247,7 +300,7 @@ proc cacheGetType(tab: TypeCache; sig: SigHash): Rope = # linear search is not necessary anymore: result = tab.getOrDefault(sig) -proc addAbiCheck(m: BModule, t: PType, name: Rope) = +proc addAbiCheck(m: BModule; t: PType, name: Rope) = if isDefined(m.config, "checkAbi") and (let size = getSize(m.config, t); size != szUnknownSize): var msg = "backend & Nim disagree on size for: " msg.addTypeHeader(m.config, t) @@ -256,49 +309,23 @@ proc addAbiCheck(m: BModule, t: PType, name: Rope) = m.s[cfsTypeInfo].addf("NIM_STATIC_ASSERT(sizeof($1) == $2, $3);$n", [name, rope(size), msg2.rope]) # see `testCodegenABICheck` for example error message it generates -proc ccgIntroducedPtr(conf: ConfigRef; s: PSym, retType: PType): bool = - var pt = skipTypes(s.typ, typedescInst) - assert skResult != s.kind - if tfByRef in pt.flags: return true - elif tfByCopy in pt.flags: return false - case pt.kind - of tyObject: - if s.typ.sym != nil and sfForward in s.typ.sym.flags: - # forwarded objects are *always* passed by pointers for consistency! - result = true - elif (optByRef in s.options) or (getSize(conf, pt) > conf.target.floatSize * 3): - result = true # requested anyway - elif (tfFinal in pt.flags) and (pt[0] == nil): - result = false # no need, because no subtyping possible - else: - result = true # ordinary objects are always passed by reference, - # otherwise casting doesn't work - of tyTuple: - result = (getSize(conf, pt) > conf.target.floatSize*3) or (optByRef in s.options) - else: - result = false - # first parameter and return type is 'lent T'? --> use pass by pointer - if s.position == 0 and retType != nil and retType.kind == tyLent: - result = not (pt.kind in {tyVar, tyArray, tyOpenArray, tyVarargs, tyRef, tyPtr, tyPointer} or - pt.kind == tySet and mapSetType(conf, pt) == ctArray) - -proc fillResult(conf: ConfigRef; param: PNode) = - fillLoc(param.sym.loc, locParam, param, ~"Result", +proc fillResult(conf: ConfigRef; param: PNode, proctype: PType) = + fillLoc(param.sym.loc, locParam, param, "Result", OnStack) let t = param.sym.typ - if mapReturnType(conf, t) != ctArray and isInvalidReturnType(conf, t): + if mapReturnType(conf, t) != ctArray and isInvalidReturnType(conf, proctype): incl(param.sym.loc.flags, lfIndirect) param.sym.loc.storage = OnUnknown proc typeNameOrLiteral(m: BModule; t: PType, literal: string): Rope = if t.sym != nil and sfImportc in t.sym.flags and t.sym.magic == mNone: useHeader(m, t.sym) - result = t.sym.loc.r + result = t.sym.loc.snippet else: result = rope(literal) -proc getSimpleTypeDesc(m: BModule, typ: PType): Rope = +proc getSimpleTypeDesc(m: BModule; typ: PType): Rope = const NumericalTypeToStr: array[tyInt..tyUInt64, string] = [ "NI", "NI8", "NI16", "NI32", "NI64", @@ -310,51 +337,46 @@ proc getSimpleTypeDesc(m: BModule, typ: PType): Rope = of tyString: case detectStrVersion(m) of 2: - discard cgsym(m, "NimStrPayload") - discard cgsym(m, "NimStringV2") + cgsym(m, "NimStrPayload") + cgsym(m, "NimStringV2") result = typeNameOrLiteral(m, typ, "NimStringV2") else: - discard cgsym(m, "NimStringDesc") + cgsym(m, "NimStringDesc") result = typeNameOrLiteral(m, typ, "NimStringDesc*") - of tyCString: result = typeNameOrLiteral(m, typ, "NCSTRING") + of tyCstring: result = typeNameOrLiteral(m, typ, "NCSTRING") of tyBool: result = typeNameOrLiteral(m, typ, "NIM_BOOL") of tyChar: result = typeNameOrLiteral(m, typ, "NIM_CHAR") of tyNil: result = typeNameOrLiteral(m, typ, "void*") of tyInt..tyUInt64: result = typeNameOrLiteral(m, typ, NumericalTypeToStr[typ.kind]) - of tyDistinct, tyRange, tyOrdinal: result = getSimpleTypeDesc(m, typ[0]) + of tyDistinct, tyRange, tyOrdinal: result = getSimpleTypeDesc(m, typ.skipModifier) of tyStatic: - if typ.n != nil: result = getSimpleTypeDesc(m, lastSon typ) - else: internalError(m.config, "tyStatic for getSimpleTypeDesc") + if typ.n != nil: result = getSimpleTypeDesc(m, skipModifier typ) + else: + result = "" + internalError(m.config, "tyStatic for getSimpleTypeDesc") of tyGenericInst, tyAlias, tySink, tyOwned: - result = getSimpleTypeDesc(m, lastSon typ) - else: result = nil + result = getSimpleTypeDesc(m, skipModifier typ) + else: result = "" - if result != nil and typ.isImportedType(): - let sig = hashType typ - if cacheGetType(m.typeCache, sig) == nil: + if result != "" and typ.isImportedType(): + let sig = hashType(typ, m.config) + if cacheGetType(m.typeCache, sig) == "": m.typeCache[sig] = result -proc pushType(m: BModule, typ: PType) = +proc pushType(m: BModule; typ: PType) = for i in 0..high(m.typeStack): # pointer equality is good enough here: if m.typeStack[i] == typ: return m.typeStack.add(typ) -proc getTypePre(m: BModule, typ: PType; sig: SigHash): Rope = +proc getTypePre(m: BModule; typ: PType; sig: SigHash): Rope = if typ == nil: result = rope("void") else: result = getSimpleTypeDesc(m, typ) - if result == nil: result = cacheGetType(m.typeCache, sig) - -proc structOrUnion(t: PType): Rope = - let cachedUnion = rope("union") - let cachedStruct = rope("struct") - let t = t.skipTypes({tyAlias, tySink}) - if tfUnion in t.flags: cachedUnion - else: cachedStruct + if result == "": result = cacheGetType(m.typeCache, sig) -proc addForwardStructFormat(m: BModule, structOrUnion: Rope, typename: Rope) = +proc addForwardStructFormat(m: BModule; structOrUnion: Rope, typename: Rope) = if m.compileToCpp: m.s[cfsForwardTypes].addf "$1 $2;$n", [structOrUnion, typename] else: @@ -364,11 +386,11 @@ proc seqStar(m: BModule): string = if optSeqDestructors in m.config.globalOptions: result = "" else: result = "*" -proc getTypeForward(m: BModule, typ: PType; sig: SigHash): Rope = +proc getTypeForward(m: BModule; typ: PType; sig: SigHash): Rope = result = cacheGetType(m.forwTypeCache, sig) - if result != nil: return + if result != "": return result = getTypePre(m, typ, sig) - if result != nil: return + if result != "": return let concrete = typ.skipTypes(abstractInst) case concrete.kind of tySequence, tyTuple, tyObject: @@ -381,7 +403,7 @@ proc getTypeForward(m: BModule, typ: PType; sig: SigHash): Rope = doAssert m.forwTypeCache[sig] == result else: internalError(m.config, "getTypeForward(" & $typ.kind & ')') -proc getTypeDescWeak(m: BModule; t: PType; check: var IntSet; kind: TSymKind): Rope = +proc getTypeDescWeak(m: BModule; t: PType; check: var IntSet; kind: TypeDescKind): Rope = ## like getTypeDescAux but creates only a *weak* dependency. In other words ## we know we only need a pointer to it so we only generate a struct forward ## declaration: @@ -391,16 +413,16 @@ proc getTypeDescWeak(m: BModule; t: PType; check: var IntSet; kind: TSymKind): R if isImportedCppType(etB) and t.kind == tyGenericInst: result = getTypeDescAux(m, t, check, kind) else: - result = getTypeForward(m, t, hashType(t)) + result = getTypeForward(m, t, hashType(t, m.config)) pushType(m, t) of tySequence: - let sig = hashType(t) + let sig = hashType(t, m.config) if optSeqDestructors in m.config.globalOptions: if skipTypes(etB[0], typedescInst).kind == tyEmpty: internalError(m.config, "cannot map the empty seq type to a C type") result = cacheGetType(m.forwTypeCache, sig) - if result == nil: + if result == "": result = getTypeName(m, t, sig) if not isImportedType(t): m.forwTypeCache[sig] = result @@ -408,38 +430,34 @@ proc getTypeDescWeak(m: BModule; t: PType; check: var IntSet; kind: TSymKind): R let payload = result & "_Content" addForwardStructFormat(m, rope"struct", payload) - if cacheGetType(m.typeCache, sig) == nil: + if cacheGetType(m.typeCache, sig) == "": m.typeCache[sig] = result #echo "adding ", sig, " ", typeToString(t), " ", m.module.name.s appcg(m, m.s[cfsTypes], - "struct $1 {$N" & - " NI len; $1_Content* p;$N" & - "};$N", [result]) + "struct $1 {\n" & + " NI len; $1_Content* p;\n" & + "};\n", [result]) + pushType(m, t) else: result = getTypeForward(m, t, sig) & seqStar(m) - pushType(m, t) + pushType(m, t) else: result = getTypeDescAux(m, t, check, kind) proc getSeqPayloadType(m: BModule; t: PType): Rope = var check = initIntSet() - result = getTypeDescWeak(m, t, check, skParam) & "_Content" + result = getTypeDescWeak(m, t, check, dkParam) & "_Content" #result = getTypeForward(m, t, hashType(t)) & "_Content" proc seqV2ContentType(m: BModule; t: PType; check: var IntSet) = - let sig = hashType(t) + let sig = hashType(t, m.config) let result = cacheGetType(m.typeCache, sig) - if result == nil: - discard getTypeDescAux(m, t, check, skVar) + if result == "": + discard getTypeDescAux(m, t, check, dkVar) else: - # little hack for now to prevent multiple definitions of the same - # Seq_Content: - appcg(m, m.s[cfsTypes], """$N -$3ifndef $2_Content_PP -$3define $2_Content_PP -struct $2_Content { NI cap; $1 data[SEQ_DECL_SIZE];}; -$3endif$N - """, [getTypeDescAux(m, t.skipTypes(abstractInst)[0], check, skVar), result, rope"#"]) + appcg(m, m.s[cfsTypes], """ +struct $2_Content { NI cap; $1 data[SEQ_DECL_SIZE]; }; +""", [getTypeDescAux(m, t.skipTypes(abstractInst)[0], check, dkVar), result]) proc paramStorageLoc(param: PSym): TStorageLoc = if param.typ.skipTypes({tyVar, tyLent, tyTypeDesc}).kind notin { @@ -448,214 +466,344 @@ proc paramStorageLoc(param: PSym): TStorageLoc = else: result = OnUnknown -proc genProcParams(m: BModule, t: PType, rettype, params: var Rope, +macro unrollChars(x: static openArray[char], name, body: untyped) = + result = newStmtList() + for a in x: + result.add(newBlockStmt(newStmtList( + newConstStmt(name, newLit(a)), + copy body + ))) + +proc multiFormat*(frmt: var string, chars: static openArray[char], args: openArray[seq[string]]) = + var res: string + unrollChars(chars, c): + res = "" + let arg = args[find(chars, c)] + var i = 0 + var num = 0 + while i < frmt.len: + if frmt[i] == c: + inc(i) + case frmt[i] + of c: + res.add(c) + inc(i) + of '0'..'9': + var j = 0 + while true: + j = j * 10 + ord(frmt[i]) - ord('0') + inc(i) + if i >= frmt.len or frmt[i] notin {'0'..'9'}: break + num = j + if j > high(arg) + 1: + raiseAssert "invalid format string: " & frmt + else: + res.add(arg[j-1]) + else: + raiseAssert "invalid format string: " & frmt + var start = i + while i < frmt.len: + if frmt[i] != c: inc(i) + else: break + if i - 1 >= start: + res.add(substr(frmt, start, i - 1)) + frmt = res + +template cgDeclFrmt*(s: PSym): string = + s.constraint.strVal + +proc genMemberProcParams(m: BModule; prc: PSym, superCall, rettype, name, params: var string, check: var IntSet, declareEnvironment=true; - weakDep=false) = - params = nil - if t[0] == nil or isInvalidReturnType(m.config, t[0]): - rettype = ~"void" + weakDep=false;) = + let t = prc.typ + let isCtor = sfConstructor in prc.flags + if isCtor or (name[0] == '~' and sfMember in prc.flags): + # destructors can't have void + rettype = "" + elif t.returnType == nil or isInvalidReturnType(m.config, t): + rettype = "void" else: - rettype = getTypeDescAux(m, t[0], check, skResult) + if rettype == "": + rettype = getTypeDescAux(m, t.returnType, check, dkResult) + else: + rettype = runtimeFormat(rettype.replace("'0", "$1"), [getTypeDescAux(m, t.returnType, check, dkResult)]) + var types, names, args: seq[string] = @[] + if not isCtor: + var this = t.n[1].sym + fillParamName(m, this) + fillLoc(this.loc, locParam, t.n[1], + this.paramStorageLoc) + if this.typ.kind == tyPtr: + this.loc.snippet = "this" + else: + this.loc.snippet = "(*this)" + names.add this.loc.snippet + types.add getTypeDescWeak(m, this.typ, check, dkParam) + + let firstParam = if isCtor: 1 else: 2 + for i in firstParam..<t.n.len: + if t.n[i].kind != nkSym: internalError(m.config, t.n.info, "genMemberProcParams") + var param = t.n[i].sym + var descKind = dkParam + if optByRef in param.options: + if param.typ.kind == tyGenericInst: + descKind = dkRefGenericParam + else: + descKind = dkRefParam + var typ, name: string + fillParamName(m, param) + fillLoc(param.loc, locParam, t.n[i], + param.paramStorageLoc) + if ccgIntroducedPtr(m.config, param, t.returnType) and descKind == dkParam: + typ = getTypeDescWeak(m, param.typ, check, descKind) & "*" + incl(param.loc.flags, lfIndirect) + param.loc.storage = OnUnknown + elif weakDep: + typ = getTypeDescWeak(m, param.typ, check, descKind) + else: + typ = getTypeDescAux(m, param.typ, check, descKind) + if sfNoalias in param.flags: + typ.add("NIM_NOALIAS ") + + name = param.loc.snippet + types.add typ + names.add name + if sfCodegenDecl notin param.flags: + args.add types[^1] & " " & names[^1] + else: + args.add runtimeFormat(param.cgDeclFrmt, [types[^1], names[^1]]) + + multiFormat(params, @['\'', '#'], [types, names]) + multiFormat(superCall, @['\'', '#'], [types, names]) + multiFormat(name, @['\'', '#'], [types, names]) #so we can ~'1 on members + if params == "()": + if types.len == 0: + params = "(void)" + else: + params = "(" & args.join(", ") & ")" + if tfVarargs in t.flags: + if params != "(": + params[^1] = ',' + else: + params.delete(params.len()-1..params.len()-1) + params.add("...)") + +proc genProcParams(m: BModule; t: PType, rettype, params: var Rope, + check: var IntSet, declareEnvironment=true; + weakDep=false;) = + params = "(" + if t.returnType == nil or isInvalidReturnType(m.config, t): + rettype = "void" + else: + rettype = getTypeDescAux(m, t.returnType, check, dkResult) for i in 1..<t.n.len: if t.n[i].kind != nkSym: internalError(m.config, t.n.info, "genProcParams") var param = t.n[i].sym + var descKind = dkParam + if m.config.backend == backendCpp and optByRef in param.options: + if param.typ.kind == tyGenericInst: + descKind = dkRefGenericParam + else: + descKind = dkRefParam if isCompileTimeOnly(param.typ): continue - if params != nil: params.add(~", ") - fillLoc(param.loc, locParam, t.n[i], mangleParamName(m, param), + if params != "(": params.add(", ") + fillParamName(m, param) + fillLoc(param.loc, locParam, t.n[i], param.paramStorageLoc) - if ccgIntroducedPtr(m.config, param, t[0]): - params.add(getTypeDescWeak(m, param.typ, check, skParam)) - params.add(~"*") + var typ: Rope + if ccgIntroducedPtr(m.config, param, t.returnType) and descKind == dkParam: + typ = (getTypeDescWeak(m, param.typ, check, descKind)) + typ.add("*") incl(param.loc.flags, lfIndirect) param.loc.storage = OnUnknown elif weakDep: - params.add(getTypeDescWeak(m, param.typ, check, skParam)) + typ = (getTypeDescWeak(m, param.typ, check, descKind)) else: - params.add(getTypeDescAux(m, param.typ, check, skParam)) - params.add(~" ") + typ = (getTypeDescAux(m, param.typ, check, descKind)) + typ.add(" ") if sfNoalias in param.flags: - params.add(~"NIM_NOALIAS ") - params.add(param.loc.r) + typ.add("NIM_NOALIAS ") + if sfCodegenDecl notin param.flags: + params.add(typ) + params.add(param.loc.snippet) + else: + params.add runtimeFormat(param.cgDeclFrmt, [typ, param.loc.snippet]) # declare the len field for open arrays: - var arr = param.typ - if arr.kind in {tyVar, tyLent, tySink}: arr = arr.lastSon + var arr = param.typ.skipTypes({tyGenericInst}) + if arr.kind in {tyVar, tyLent, tySink}: arr = arr.elementType var j = 0 while arr.kind in {tyOpenArray, tyVarargs}: # this fixes the 'sort' bug: if param.typ.kind in {tyVar, tyLent}: param.loc.storage = OnUnknown # need to pass hidden parameter: - params.addf(", NI $1Len_$2", [param.loc.r, j.rope]) + params.addf(", NI $1Len_$2", [param.loc.snippet, j.rope]) inc(j) arr = arr[0].skipTypes({tySink}) - if t[0] != nil and isInvalidReturnType(m.config, t[0]): - var arr = t[0] - if params != nil: params.add(", ") - if mapReturnType(m.config, t[0]) != ctArray: - params.add(getTypeDescWeak(m, arr, check, skResult)) - params.add("*") + if t.returnType != nil and isInvalidReturnType(m.config, t): + var arr = t.returnType + if params != "(": params.add(", ") + if mapReturnType(m.config, arr) != ctArray: + if isHeaderFile in m.flags: + # still generates types for `--header` + params.add(getTypeDescAux(m, arr, check, dkResult)) + params.add("*") + else: + params.add(getTypeDescWeak(m, arr, check, dkResult)) + params.add("*") else: - params.add(getTypeDescAux(m, arr, check, skResult)) + params.add(getTypeDescAux(m, arr, check, dkResult)) params.addf(" Result", []) if t.callConv == ccClosure and declareEnvironment: - if params != nil: params.add(", ") + if params != "(": params.add(", ") params.add("void* ClE_0") if tfVarargs in t.flags: - if params != nil: params.add(", ") + if params != "(": params.add(", ") params.add("...") - if params == nil: params.add("void)") + if params == "(": params.add("void)") else: params.add(")") - params = "(" & params proc mangleRecFieldName(m: BModule; field: PSym): Rope = if {sfImportc, sfExportc} * field.flags != {}: - result = field.loc.r + result = field.loc.snippet else: result = rope(mangleField(m, field.name)) - if result == nil: internalError(m.config, field.info, "mangleRecFieldName") - -proc genRecordFieldsAux(m: BModule, n: PNode, + if result == "": internalError(m.config, field.info, "mangleRecFieldName") + +proc hasCppCtor(m: BModule; typ: PType): bool = + result = false + if m.compileToCpp and typ != nil and typ.itemId in m.g.graph.memberProcsPerType: + for prc in m.g.graph.memberProcsPerType[typ.itemId]: + if sfConstructor in prc.flags: + return true + +proc genCppParamsForCtor(p: BProc; call: PNode; didGenTemp: var bool): string + +proc genCppInitializer(m: BModule, prc: BProc; typ: PType; didGenTemp: var bool): string = + #To avoid creating a BProc per test when called inside a struct nil BProc is allowed + result = "{}" + if typ.itemId in m.g.graph.initializersPerType: + let call = m.g.graph.initializersPerType[typ.itemId] + if call != nil: + var p = prc + if p == nil: + p = BProc(module: m) + result = "{" & genCppParamsForCtor(p, call, didGenTemp) & "}" + if prc == nil: + assert p.blocks.len == 0, "BProc belongs to a struct doesnt have blocks" + +proc genRecordFieldsAux(m: BModule; n: PNode, rectype: PType, - check: var IntSet, unionPrefix = ""): Rope = - result = nil + check: var IntSet; result: var Builder; unionPrefix = "") = case n.kind of nkRecList: for i in 0..<n.len: - result.add(genRecordFieldsAux(m, n[i], rectype, check, unionPrefix)) + genRecordFieldsAux(m, n[i], rectype, check, result, unionPrefix) of nkRecCase: if n[0].kind != nkSym: internalError(m.config, n.info, "genRecordFieldsAux") - result.add(genRecordFieldsAux(m, n[0], rectype, check, unionPrefix)) + genRecordFieldsAux(m, n[0], rectype, check, result, unionPrefix) # prefix mangled name with "_U" to avoid clashes with other field names, # since identifiers are not allowed to start with '_' - var unionBody: Rope = nil + var unionBody: Rope = "" for i in 1..<n.len: case n[i].kind of nkOfBranch, nkElse: let k = lastSon(n[i]) if k.kind != nkSym: let structName = "_" & mangleRecFieldName(m, n[0].sym) & "_" & $i - let a = genRecordFieldsAux(m, k, rectype, check, unionPrefix & $structName & ".") - if a != nil: - if tfPacked notin rectype.flags: - unionBody.add("struct {") - else: - if hasAttribute in CC[m.config.cCompiler].props: - unionBody.add("struct __attribute__((__packed__)){") - else: - unionBody.addf("#pragma pack(push, 1)$nstruct{", []) - unionBody.add(a) - unionBody.addf("} $1;$n", [structName]) - if tfPacked in rectype.flags and hasAttribute notin CC[m.config.cCompiler].props: - unionBody.addf("#pragma pack(pop)$n", []) + var a = newBuilder("") + genRecordFieldsAux(m, k, rectype, check, a, unionPrefix & $structName & ".") + if a.len != 0: + unionBody.addFieldWithStructType(m, rectype, structName): + unionBody.add(a) else: - unionBody.add(genRecordFieldsAux(m, k, rectype, check, unionPrefix)) + genRecordFieldsAux(m, k, rectype, check, unionBody, unionPrefix) else: internalError(m.config, "genRecordFieldsAux(record case branch)") - if unionBody != nil: - result.addf("union{$n$1};$n", [unionBody]) + if unionBody.len != 0: + result.addAnonUnion: + result.add(unionBody) of nkSym: let field = n.sym if field.typ.kind == tyVoid: return #assert(field.ast == nil) let sname = mangleRecFieldName(m, field) fillLoc(field.loc, locField, n, unionPrefix & sname, OnUnknown) - if field.alignment > 0: - result.addf "NIM_ALIGN($1) ", [rope(field.alignment)] # for importcpp'ed objects, we only need to set field.loc, but don't # have to recurse via 'getTypeDescAux'. And not doing so prevents problems # with heavily templatized C++ code: if not isImportedCppType(rectype): - let noAlias = if sfNoalias in field.flags: ~" NIM_NOALIAS" else: nil - let fieldType = field.loc.lode.typ.skipTypes(abstractInst) + var typ: Rope = "" + var isFlexArray = false + var initializer = "" if fieldType.kind == tyUncheckedArray: - result.addf("$1 $2[SEQ_DECL_SIZE];$n", - [getTypeDescAux(m, fieldType.elemType, check, skField), sname]) + typ = getTypeDescAux(m, fieldType.elemType, check, dkField) + isFlexArray = true elif fieldType.kind == tySequence: # we need to use a weak dependency here for trecursive_table. - result.addf("$1$3 $2;$n", [getTypeDescWeak(m, field.loc.t, check, skField), sname, noAlias]) - elif field.bitsize != 0: - result.addf("$1$4 $2:$3;$n", [getTypeDescAux(m, field.loc.t, check, skField), sname, rope($field.bitsize), noAlias]) + typ = getTypeDescWeak(m, field.loc.t, check, dkField) else: + typ = getTypeDescAux(m, field.loc.t, check, dkField) # don't use fieldType here because we need the # tyGenericInst for C++ template support - result.addf("$1$3 $2;$n", [getTypeDescAux(m, field.loc.t, check, skField), sname, noAlias]) + let noInit = sfNoInit in field.flags or (field.typ.sym != nil and sfNoInit in field.typ.sym.flags) + if not noInit and (fieldType.isOrHasImportedCppType() or hasCppCtor(m, field.owner.typ)): + var didGenTemp = false + initializer = genCppInitializer(m, nil, fieldType, didGenTemp) + result.addField(field, sname, typ, isFlexArray, initializer) else: internalError(m.config, n.info, "genRecordFieldsAux()") -proc getRecordFields(m: BModule, typ: PType, check: var IntSet): Rope = - result = genRecordFieldsAux(m, typ.n, typ, check) +proc genMemberProcHeader(m: BModule; prc: PSym; result: var Rope; asPtr: bool = false, isFwdDecl:bool = false) + +proc addRecordFields(result: var Builder; m: BModule; typ: PType, check: var IntSet) = + genRecordFieldsAux(m, typ.n, typ, check, result) + if typ.itemId in m.g.graph.memberProcsPerType: + let procs = m.g.graph.memberProcsPerType[typ.itemId] + var isDefaultCtorGen, isCtorGen: bool = false + for prc in procs: + var header: Rope = "" + if sfConstructor in prc.flags: + isCtorGen = true + if prc.typ.n.len == 1: + isDefaultCtorGen = true + if lfNoDecl in prc.loc.flags: continue + genMemberProcHeader(m, prc, header, false, true) + result.addf "$1;$n", [header] + if isCtorGen and not isDefaultCtorGen: + var ch: IntSet = default(IntSet) + result.addf "$1() = default;$n", [getTypeDescAux(m, typ, ch, dkOther)] proc fillObjectFields*(m: BModule; typ: PType) = # sometimes generic objects are not consistently merged. We patch over # this fact here. var check = initIntSet() - discard getRecordFields(m, typ, check) + var ignored = newBuilder("") + addRecordFields(ignored, m, typ, check) proc mangleDynLibProc(sym: PSym): Rope -proc getRecordDesc(m: BModule, typ: PType, name: Rope, +proc getRecordDesc(m: BModule; typ: PType, name: Rope, check: var IntSet): Rope = # declare the record: - var hasField = false - - if tfPacked in typ.flags: - if hasAttribute in CC[m.config.cCompiler].props: - result = structOrUnion(typ) & " __attribute__((__packed__))" - else: - result = "#pragma pack(push, 1)\L" & structOrUnion(typ) + var baseType: string = "" + if typ.baseClass != nil: + baseType = getTypeDescAux(m, typ.baseClass.skipTypes(skipPtrs), check, dkField) + if typ.sym == nil or sfCodegenDecl notin typ.sym.flags: + result = newBuilder("") + result.addStruct(m, typ, name, baseType): + result.addRecordFields(m, typ, check) else: - result = structOrUnion(typ) + var desc = newBuilder("") + desc.addRecordFields(m, typ, check) + result = runtimeFormat(typ.sym.cgDeclFrmt, [name, desc, baseType]) - result.add " " - result.add name - - if typ.kind == tyObject: - if typ[0] == nil: - if (typ.sym != nil and sfPure in typ.sym.flags) or tfFinal in typ.flags: - appcg(m, result, " {$n", []) - else: - if optTinyRtti in m.config.globalOptions: - appcg(m, result, " {$n#TNimTypeV2* m_type;$n", []) - else: - appcg(m, result, " {$n#TNimType* m_type;$n", []) - hasField = true - elif m.compileToCpp: - appcg(m, result, " : public $1 {$n", - [getTypeDescAux(m, typ[0].skipTypes(skipPtrs), check, skField)]) - if typ.isException and m.config.exc == excCpp: - when false: - appcg(m, result, "virtual void raise() { throw *this; }$n", []) # required for polymorphic exceptions - if typ.sym.magic == mException: - # Add cleanup destructor to Exception base class - appcg(m, result, "~$1();$n", [name]) - # define it out of the class body and into the procs section so we don't have to - # artificially forward-declare popCurrentExceptionEx (very VERY troublesome for HCR) - appcg(m, cfsProcs, "inline $1::~$1() {if(this->raiseId) #popCurrentExceptionEx(this->raiseId);}$n", [name]) - hasField = true - else: - appcg(m, result, " {$n $1 Sup;$n", - [getTypeDescAux(m, typ[0].skipTypes(skipPtrs), check, skField)]) - hasField = true - else: - result.addf(" {$n", [name]) - - let desc = getRecordFields(m, typ, check) - if desc == nil and not hasField: - result.addf("char dummy;$n", []) - else: - result.add(desc) - result.add("};\L") - if tfPacked in typ.flags and hasAttribute notin CC[m.config.cCompiler].props: - result.add "#pragma pack(pop)\L" - -proc getTupleDesc(m: BModule, typ: PType, name: Rope, +proc getTupleDesc(m: BModule; typ: PType, name: Rope, check: var IntSet): Rope = - result = "$1 $2 {$n" % [structOrUnion(typ), name] - var desc: Rope = nil - for i in 0..<typ.len: - desc.addf("$1 Field$2;$n", - [getTypeDescAux(m, typ[i], check, skField), rope(i)]) - if desc == nil: result.add("char dummy;\L") - else: result.add(desc) - result.add("};\L") + result = newBuilder("") + result.addStruct(m, typ, name, ""): + for i, a in typ.ikids: + result.addField( + name = "Field" & $i, + typ = getTypeDescAux(m, a, check, dkField)) proc scanCppGenericSlot(pat: string, cursor, outIdx, outStars: var int): bool = # A helper proc for handling cppimport patterns, involving numeric @@ -677,31 +825,30 @@ proc scanCppGenericSlot(pat: string, cursor, outIdx, outStars: var int): bool = proc resolveStarsInCppType(typ: PType, idx, stars: int): PType = # Make sure the index refers to one of the generic params of the type. # XXX: we should catch this earlier and report it as a semantic error. - if idx >= typ.len: - doAssert false, "invalid apostrophe type parameter index" + if idx >= typ.kidsLen: + raiseAssert "invalid apostrophe type parameter index" result = typ[idx] for i in 1..stars: - if result != nil and result.len > 0: - result = if result.kind == tyGenericInst: result[1] + if result != nil and result.kidsLen > 0: + result = if result.kind == tyGenericInst: result[FirstGenericParamAt] else: result.elemType -proc getOpenArrayDesc(m: BModule, t: PType, check: var IntSet; kind: TSymKind): Rope = - let sig = hashType(t) - if kind == skParam: - result = getTypeDescWeak(m, t[0], check, kind) & "*" +proc getOpenArrayDesc(m: BModule; t: PType, check: var IntSet; kind: TypeDescKind): Rope = + let sig = hashType(t, m.config) + if kind == dkParam: + result = getTypeDescWeak(m, t.elementType, check, kind) & "*" else: result = cacheGetType(m.typeCache, sig) - if result == nil: + if result == "": result = getTypeName(m, t, sig) m.typeCache[sig] = result - let elemType = getTypeDescWeak(m, t[0], check, kind) + let elemType = getTypeDescWeak(m, t.elementType, check, kind) m.s[cfsTypes].addf("typedef struct {$n$2* Field0;$nNI Field1;$n} $1;$n", [result, elemType]) -proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet; kind: TSymKind): Rope = +proc getTypeDescAux(m: BModule; origTyp: PType, check: var IntSet; kind: TypeDescKind): Rope = # returns only the type's name - var t = origTyp.skipTypes(irrelevantForBackend-{tyOwned}) if containsOrIncl(check, t.id): if not (isImportedCppType(origTyp) or isImportedCppType(t)): @@ -711,23 +858,25 @@ proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet; kind: TSymKin # C type generation into an analysis and a code generation phase somehow. if t.sym != nil: useHeader(m, t.sym) if t != origTyp and origTyp.sym != nil: useHeader(m, origTyp.sym) - let sig = hashType(origTyp) + let sig = hashType(origTyp, m.config) + result = getTypePre(m, t, sig) defer: # defer is the simplest in this case if isImportedType(t) and not m.typeABICache.containsOrIncl(sig): addAbiCheck(m, t, result) - result = getTypePre(m, t, sig) - if result != nil and t.kind != tyOpenArray: + if result != "" and t.kind != tyOpenArray: excl(check, t.id) + if kind == dkRefParam or kind == dkRefGenericParam and origTyp.kind == tyGenericInst: + result.add("&") return case t.kind of tyRef, tyPtr, tyVar, tyLent: var star = if t.kind in {tyVar} and tfVarIsPtr notin origTyp.flags and compileToCpp(m): "&" else: "*" - var et = origTyp.skipTypes(abstractInst).lastSon + var et = origTyp.skipTypes(abstractInst).elementType var etB = et.skipTypes(abstractInst) - if mapType(m.config, t, kind) == ctPtrToArray and (etB.kind != tyOpenArray or kind == skParam): + if mapType(m.config, t, kind == dkParam) == ctPtrToArray and (etB.kind != tyOpenArray or kind == dkParam): if etB.kind == tySet: et = getSysType(m.g.graph, unknownLineInfo, tyUInt8) else: @@ -740,7 +889,7 @@ proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet; kind: TSymKin result = getTypeDescAux(m, et, check, kind) & star else: # no restriction! We have a forward declaration for structs - let name = getTypeForward(m, et, hashType et) + let name = getTypeForward(m, et, hashType(et, m.config)) result = name & star m.typeCache[sig] = result of tySequence: @@ -749,7 +898,7 @@ proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet; kind: TSymKin m.typeCache[sig] = result else: # no restriction! We have a forward declaration for structs - let name = getTypeForward(m, et, hashType et) + let name = getTypeForward(m, et, hashType(et, m.config)) result = name & seqStar(m) & star m.typeCache[sig] = result pushType(m, et) @@ -761,7 +910,7 @@ proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet; kind: TSymKin result = getOpenArrayDesc(m, t, check, kind) of tyEnum: result = cacheGetType(m.typeCache, sig) - if result == nil: + if result == "": result = getTypeName(m, origTyp, sig) if not (isImportedCppType(t) or (sfImportc in t.sym.flags and t.sym.magic == mNone)): @@ -791,7 +940,7 @@ proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet; kind: TSymKin of tyProc: result = getTypeName(m, origTyp, sig) m.typeCache[sig] = result - var rettype, desc: Rope + var rettype, desc: Rope = "" genProcParams(m, t, rettype, desc, check, true, true) if not isImportedType(t): if t.callConv != ccClosure: # procedure vars may need a closure! @@ -809,27 +958,23 @@ proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet; kind: TSymKin # we cannot use getTypeForward here because then t would be associated # with the name of the struct, not with the pointer to the struct: result = cacheGetType(m.forwTypeCache, sig) - if result == nil: + if result == "": result = getTypeName(m, origTyp, sig) if not isImportedType(t): addForwardStructFormat(m, structOrUnion(t), result) m.forwTypeCache[sig] = result - assert(cacheGetType(m.typeCache, sig) == nil) + assert(cacheGetType(m.typeCache, sig) == "") m.typeCache[sig] = result & seqStar(m) if not isImportedType(t): - if skipTypes(t[0], typedescInst).kind != tyEmpty: - const - cppSeq = "struct $2 : #TGenericSeq {$n" - cSeq = "struct $2 {$n" & - " #TGenericSeq Sup;$n" - if m.compileToCpp: - appcg(m, m.s[cfsSeqTypes], - cppSeq & " $1 data[SEQ_DECL_SIZE];$n" & - "};$n", [getTypeDescAux(m, t[0], check, kind), result]) - else: - appcg(m, m.s[cfsSeqTypes], - cSeq & " $1 data[SEQ_DECL_SIZE];$n" & - "};$n", [getTypeDescAux(m, t[0], check, kind), result]) + if skipTypes(t.elementType, typedescInst).kind != tyEmpty: + var struct = newBuilder("") + let baseType = cgsymValue(m, "TGenericSeq") + struct.addSimpleStruct(m, name = result, baseType = baseType): + struct.addField( + name = "data", + typ = getTypeDescAux(m, t.elementType, check, kind), + isFlexArray = true) + m.s[cfsSeqTypes].add struct else: result = rope("TGenericSeq") result.add(seqStar(m)) @@ -837,7 +982,7 @@ proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet; kind: TSymKin result = getTypeName(m, origTyp, sig) m.typeCache[sig] = result if not isImportedType(t): - let foo = getTypeDescAux(m, t[0], check, kind) + let foo = getTypeDescAux(m, t.elementType, check, kind) m.s[cfsTypes].addf("typedef $1 $2[1];$n", [foo, result]) of tyArray: var n: BiggestInt = toInt64(lengthOrd(m.config, t)) @@ -845,44 +990,46 @@ proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet; kind: TSymKin result = getTypeName(m, origTyp, sig) m.typeCache[sig] = result if not isImportedType(t): - let foo = getTypeDescAux(m, t[1], check, kind) + let e = getTypeDescAux(m, t.elementType, check, kind) m.s[cfsTypes].addf("typedef $1 $2[$3];$n", - [foo, result, rope(n)]) + [e, result, rope(n)]) of tyObject, tyTuple: - if isImportedCppType(t) and origTyp.kind == tyGenericInst: - let cppName = getTypeName(m, t, sig) + let tt = origTyp.skipTypes({tyDistinct}) + if isImportedCppType(t) and tt.kind == tyGenericInst: + let cppNameAsRope = getTypeName(m, t, sig) + let cppName = $cppNameAsRope var i = 0 var chunkStart = 0 template addResultType(ty: untyped) = if ty == nil or ty.kind == tyVoid: - result.add(~"void") + result.add("void") elif ty.kind == tyStatic: internalAssert m.config, ty.n != nil result.add ty.n.renderTree else: result.add getTypeDescAux(m, ty, check, kind) - while i < cppName.data.len: - if cppName.data[i] == '\'': + while i < cppName.len: + if cppName[i] == '\'': var chunkEnd = i-1 - var idx, stars: int - if scanCppGenericSlot(cppName.data, i, idx, stars): - result.add cppName.data.substr(chunkStart, chunkEnd) + var idx, stars: int = 0 + if scanCppGenericSlot(cppName, i, idx, stars): + result.add cppName.substr(chunkStart, chunkEnd) chunkStart = i - let typeInSlot = resolveStarsInCppType(origTyp, idx + 1, stars) + let typeInSlot = resolveStarsInCppType(tt, idx + 1, stars) addResultType(typeInSlot) else: inc i if chunkStart != 0: - result.add cppName.data.substr(chunkStart) + result.add cppName.substr(chunkStart) else: - result = cppName & "<" - for i in 1..<origTyp.len-1: - if i > 1: result.add(" COMMA ") - addResultType(origTyp[i]) + result = cppNameAsRope & "<" + for needsComma, a in tt.genericInstParams: + if needsComma: result.add(" COMMA ") + addResultType(a) result.add("> ") # always call for sideeffects: assert t.kind != tyTuple @@ -890,13 +1037,13 @@ proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet; kind: TSymKin # The resulting type will include commas and these won't play well # with the C macros for defining procs such as N_NIMCALL. We must # create a typedef for the type and use it in the proc signature: - let typedefName = ~"TY" & $sig + let typedefName = "TY" & $sig m.s[cfsTypes].addf("typedef $1 $2;$n", [result, typedefName]) m.typeCache[sig] = typedefName result = typedefName else: result = cacheGetType(m.forwTypeCache, sig) - if result == nil: + if result == "": result = getTypeName(m, origTyp, sig) m.forwTypeCache[sig] = result if not isImportedType(t): @@ -912,7 +1059,9 @@ proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet; kind: TSymKin discard # addAbiCheck(m, t, result) # already handled elsewhere of tySet: # Don't use the imported name as it may be scoped: 'Foo::SomeKind' - result = $t.kind & '_' & t.lastSon.typeName & $t.lastSon.hashType + result = rope("tySet_") + t.elementType.typeName(result) + result.add $t.elementType.hashType(m.config) m.typeCache[sig] = result if not isImportedType(t): let s = int(getSize(m.config, t)) @@ -922,14 +1071,15 @@ proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet; kind: TSymKin [result, rope(getSize(m.config, t))]) of tyGenericInst, tyDistinct, tyOrdinal, tyTypeDesc, tyAlias, tySink, tyOwned, tyUserTypeClass, tyUserTypeClassInst, tyInferred: - result = getTypeDescAux(m, lastSon(t), check, kind) + result = getTypeDescAux(m, skipModifier(t), check, kind) else: internalError(m.config, "getTypeDescAux(" & $t.kind & ')') - result = nil + result = "" # fixes bug #145: excl(check, t.id) -proc getTypeDesc(m: BModule, typ: PType; kind = skParam): Rope = + +proc getTypeDesc(m: BModule; typ: PType; kind = dkParam): Rope = var check = initIntSet() result = getTypeDescAux(m, typ, check, kind) @@ -939,11 +1089,11 @@ type clHalfWithEnv, ## fn(args, void* env) type with trailing 'void* env' parameter clFull ## struct {fn(args, void* env), env} -proc getClosureType(m: BModule, t: PType, kind: TClosureTypeKind): Rope = +proc getClosureType(m: BModule; t: PType, kind: TClosureTypeKind): Rope = assert t.kind == tyProc var check = initIntSet() result = getTempName(m) - var rettype, desc: Rope + var rettype, desc: Rope = "" genProcParams(m, t, rettype, desc, check, declareEnvironment=kind != clHalf) if not isImportedType(t): if t.callConv != ccClosure or kind != clFull: @@ -963,59 +1113,128 @@ proc finishTypeDescriptions(m: BModule) = if optSeqDestructors in m.config.globalOptions and t.skipTypes(abstractInst).kind == tySequence: seqV2ContentType(m, t, check) else: - discard getTypeDescAux(m, t, check, skParam) + discard getTypeDescAux(m, t, check, dkParam) inc(i) m.typeStack.setLen 0 -template cgDeclFrmt*(s: PSym): string = - s.constraint.strVal - -proc isReloadable(m: BModule, prc: PSym): bool = +proc isReloadable(m: BModule; prc: PSym): bool = return m.hcrOn and sfNonReloadable notin prc.flags -proc isNonReloadable(m: BModule, prc: PSym): bool = +proc isNonReloadable(m: BModule; prc: PSym): bool = return m.hcrOn and sfNonReloadable in prc.flags -proc genProcHeader(m: BModule, prc: PSym, asPtr: bool = false): Rope = - var - rettype, params: Rope - # using static is needed for inline procs - if lfExportLib in prc.loc.flags: - if isHeaderFile in m.flags: - result.add "N_LIB_IMPORT " +proc parseVFunctionDecl(val: string; name, params, retType, superCall: var string; isFnConst, isOverride, isMemberVirtual, isStatic: var bool; isCtor: bool, isFunctor=false) = + var afterParams: string = "" + if scanf(val, "$*($*)$s$*", name, params, afterParams): + if name.strip() == "operator" and params == "": #isFunctor? + parseVFunctionDecl(afterParams, name, params, retType, superCall, isFnConst, isOverride, isMemberVirtual, isStatic, isCtor, true) + return + if name.find("static ") > -1: + isStatic = true + name = name.replace("static ", "") + isFnConst = afterParams.find("const") > -1 + isOverride = afterParams.find("override") > -1 + isMemberVirtual = name.find("virtual ") > -1 + if isMemberVirtual: + name = name.replace("virtual ", "") + if isFunctor: + name = "operator ()" + if isCtor: + discard scanf(afterParams, ":$s$*", superCall) else: - result.add "N_LIB_EXPORT " - elif prc.typ.callConv == ccInline or asPtr or isNonReloadable(m, prc): - result.add "static " - elif sfImportc notin prc.flags: - result.add "N_LIB_PRIVATE " + discard scanf(afterParams, "->$s$* ", retType) + + params = "(" & params & ")" + +proc genMemberProcHeader(m: BModule; prc: PSym; result: var Rope; asPtr: bool = false, isFwdDecl: bool = false) = + assert sfCppMember * prc.flags != {} + let isCtor = sfConstructor in prc.flags + var check = initIntSet() + fillBackendName(m, prc) + fillLoc(prc.loc, locProc, prc.ast[namePos], OnUnknown) + var memberOp = "#." #only virtual + var typ: PType + if isCtor: + typ = prc.typ.returnType + else: + typ = prc.typ.firstParamType + if typ.kind == tyPtr: + typ = typ.elementType + memberOp = "#->" + var typDesc = getTypeDescWeak(m, typ, check, dkParam) + let asPtrStr = rope(if asPtr: "_PTR" else: "") + var name, params, rettype, superCall: string = "" + var isFnConst, isOverride, isMemberVirtual, isStatic: bool = false + parseVFunctionDecl(prc.constraint.strVal, name, params, rettype, superCall, isFnConst, isOverride, isMemberVirtual, isStatic, isCtor) + genMemberProcParams(m, prc, superCall, rettype, name, params, check, true, false) + let isVirtual = sfVirtual in prc.flags or isMemberVirtual + var fnConst, override: string = "" + if isCtor: + name = typDesc + if isFnConst: + fnConst = " const" + if isFwdDecl: + if isStatic: + result.add "static " + if isVirtual: + rettype = "virtual " & rettype + if isOverride: + override = " override" + superCall = "" + else: + if not isCtor: + prc.loc.snippet = "$1$2(@)" % [memberOp, name] + elif superCall != "": + superCall = " : " & superCall + + name = "$1::$2" % [typDesc, name] + + result.add "N_LIB_PRIVATE " + result.addf("$1$2($3, $4)$5$6$7$8", + [rope(CallingConvToStr[prc.typ.callConv]), asPtrStr, rettype, name, + params, fnConst, override, superCall]) + +proc genProcHeader(m: BModule; prc: PSym; result: var Rope; asPtr: bool = false) = + # using static is needed for inline procs var check = initIntSet() - fillLoc(prc.loc, locProc, prc.ast[namePos], mangleName(m, prc), OnUnknown) - genProcParams(m, prc.typ, rettype, params, check) + fillBackendName(m, prc) + fillLoc(prc.loc, locProc, prc.ast[namePos], OnUnknown) + var rettype, params: Rope = "" + genProcParams(m, prc.typ, rettype, params, check, true, false) # handle the 2 options for hotcodereloading codegen - function pointer # (instead of forward declaration) or header for function body with "_actual" postfix let asPtrStr = rope(if asPtr: "_PTR" else: "") - var name = prc.loc.r - if isReloadable(m, prc) and not asPtr: + var name = prc.loc.snippet + if not asPtr and isReloadable(m, prc): name.add("_actual") # careful here! don't access ``prc.ast`` as that could reload large parts of # the object graph! - if prc.constraint.isNil: + if sfCodegenDecl notin prc.flags: + if lfExportLib in prc.loc.flags: + if isHeaderFile in m.flags: + result.add "N_LIB_IMPORT " + else: + result.add "N_LIB_EXPORT " + elif prc.typ.callConv == ccInline or asPtr or isNonReloadable(m, prc): + result.add "static " + elif sfImportc notin prc.flags: + result.add "N_LIB_PRIVATE " result.addf("$1$2($3, $4)$5", [rope(CallingConvToStr[prc.typ.callConv]), asPtrStr, rettype, name, params]) else: let asPtrStr = if asPtr: (rope("(*") & name & ")") else: name - result = runtimeFormat(prc.cgDeclFrmt, [rettype, asPtrStr, params]) + result.add runtimeFormat(prc.cgDeclFrmt, [rettype, asPtrStr, params]) + # ------------------ type info generation ------------------------------------- -proc genTypeInfoV1(m: BModule, t: PType; info: TLineInfo): Rope +proc genTypeInfoV1(m: BModule; t: PType; info: TLineInfo): Rope proc getNimNode(m: BModule): Rope = result = "$1[$2]" % [m.typeNodesName, rope(m.typeNodes)] inc(m.typeNodes) -proc tiNameForHcr(m: BModule, name: Rope): Rope = +proc tiNameForHcr(m: BModule; name: Rope): Rope = return if m.hcrOn: "(*".rope & name & ")" else: name proc genTypeInfoAuxBase(m: BModule; typ, origType: PType; @@ -1033,7 +1252,7 @@ proc genTypeInfoAuxBase(m: BModule; typ, origType: PType; if tfIncompleteStruct in typ.flags: size = rope"void*" else: - size = getTypeDesc(m, origType, skVar) + size = getTypeDesc(m, origType, dkVar) m.s[cfsTypeInit3].addf( "$1.size = sizeof($2);$n$1.align = NIM_ALIGNOF($2);$n$1.kind = $3;$n$1.base = $4;$n", [nameHcr, size, rope(nimtypeKind), base] @@ -1041,11 +1260,11 @@ proc genTypeInfoAuxBase(m: BModule; typ, origType: PType; # compute type flags for GC optimization var flags = 0 if not containsGarbageCollectedRef(typ): flags = flags or 1 - if not canFormAcycle(typ): flags = flags or 2 - #else MessageOut("can contain a cycle: " & typeToString(typ)) + if not canFormAcycle(m.g.graph, typ): flags = flags or 2 + #else echo("can contain a cycle: " & typeToString(typ)) if flags != 0: m.s[cfsTypeInit3].addf("$1.flags = $2;$n", [nameHcr, rope(flags)]) - discard cgsym(m, "TNimType") + cgsym(m, "TNimType") if isDefined(m.config, "nimTypeNames"): var typename = typeToString(if origType.typeInst != nil: origType.typeInst else: origType, preferName) @@ -1053,22 +1272,22 @@ proc genTypeInfoAuxBase(m: BModule; typ, origType: PType; typename = "anon ref object from " & m.config$origType.skipTypes(skipPtrs).sym.info m.s[cfsTypeInit3].addf("$1.name = $2;$n", [nameHcr, makeCString typename]) - discard cgsym(m, "nimTypeRoot") + cgsym(m, "nimTypeRoot") m.s[cfsTypeInit3].addf("$1.nextType = nimTypeRoot; nimTypeRoot=&$1;$n", [nameHcr]) if m.hcrOn: - m.s[cfsData].addf("static TNimType* $1;$n", [name]) + m.s[cfsStrData].addf("static TNimType* $1;$n", [name]) m.hcrCreateTypeInfosProc.addf("\thcrRegisterGlobal($2, \"$1\", sizeof(TNimType), NULL, (void**)&$1);$n", [name, getModuleDllPath(m, m.module)]) else: - m.s[cfsData].addf("N_LIB_PRIVATE TNimType $1;$n", [name]) + m.s[cfsStrData].addf("N_LIB_PRIVATE TNimType $1;$n", [name]) -proc genTypeInfoAux(m: BModule, typ, origType: PType, name: Rope; +proc genTypeInfoAux(m: BModule; typ, origType: PType, name: Rope; info: TLineInfo) = var base: Rope - if typ.len > 0 and typ.lastSon != nil: - var x = typ.lastSon + if typ.hasElementType and typ.last != nil: + var x = typ.last if typ.kind == tyObject: x = x.skipTypes(skipPtrs) if typ.kind == tyPtr and x.kind == tyObject and incompleteType(x): base = rope("0") @@ -1078,23 +1297,23 @@ proc genTypeInfoAux(m: BModule, typ, origType: PType, name: Rope; base = rope("0") genTypeInfoAuxBase(m, typ, origType, name, base, info) -proc discriminatorTableName(m: BModule, objtype: PType, d: PSym): Rope = +proc discriminatorTableName(m: BModule; objtype: PType, d: PSym): Rope = # bugfix: we need to search the type that contains the discriminator: var objtype = objtype.skipTypes(abstractPtrs) while lookupInRecord(objtype.n, d.name) == nil: objtype = objtype[0].skipTypes(abstractPtrs) if objtype.sym == nil: internalError(m.config, d.info, "anonymous obj with discriminator") - result = "NimDT_$1_$2" % [rope($hashType(objtype)), rope(d.name.s.mangle)] + result = "NimDT_$1_$2" % [rope($hashType(objtype, m.config)), rope(d.name.s.mangle)] proc rope(arg: Int128): Rope = rope($arg) -proc discriminatorTableDecl(m: BModule, objtype: PType, d: PSym): Rope = - discard cgsym(m, "TNimNode") +proc discriminatorTableDecl(m: BModule; objtype: PType, d: PSym): Rope = + cgsym(m, "TNimNode") var tmp = discriminatorTableName(m, objtype, d) result = "TNimNode* $1[$2];$n" % [tmp, rope(lengthOrd(m.config, d.typ)+1)] -proc genTNimNodeArray(m: BModule, name: Rope, size: Rope) = +proc genTNimNodeArray(m: BModule; name: Rope, size: Rope) = if m.hcrOn: m.s[cfsData].addf("static TNimNode** $1;$n", [name]) m.hcrCreateTypeInfosProc.addf("\thcrRegisterGlobal($3, \"$1\", sizeof(TNimNode*) * $2, NULL, (void**)&$1);$n", @@ -1102,7 +1321,7 @@ proc genTNimNodeArray(m: BModule, name: Rope, size: Rope) = else: m.s[cfsTypeInit1].addf("static TNimNode* $1[$2];$n", [name, size]) -proc genObjectFields(m: BModule, typ, origType: PType, n: PNode, expr: Rope; +proc genObjectFields(m: BModule; typ, origType: PType, n: PNode, expr: Rope; info: TLineInfo) = case n.kind of nkRecList: @@ -1125,13 +1344,13 @@ proc genObjectFields(m: BModule, typ, origType: PType, n: PNode, expr: Rope; var tmp = discriminatorTableName(m, typ, field) var L = lengthOrd(m.config, field.typ) assert L > 0 - if field.loc.r == nil: fillObjectFields(m, typ) + if field.loc.snippet == "": fillObjectFields(m, typ) if field.loc.t == nil: internalError(m.config, n.info, "genObjectFields") m.s[cfsTypeInit3].addf("$1.kind = 3;$n" & "$1.offset = offsetof($2, $3);$n" & "$1.typ = $4;$n" & "$1.name = $5;$n" & "$1.sons = &$6[0];$n" & - "$1.len = $7;$n", [expr, getTypeDesc(m, origType, skVar), field.loc.r, + "$1.len = $7;$n", [expr, getTypeDesc(m, origType, dkVar), field.loc.snippet, genTypeInfoV1(m, field.typ, info), makeCString(field.name.s), tmp, rope(L)]) @@ -1163,56 +1382,53 @@ proc genObjectFields(m: BModule, typ, origType: PType, n: PNode, expr: Rope; # Do not produce code for void types if isEmptyType(field.typ): return if field.bitsize == 0: - if field.loc.r == nil: fillObjectFields(m, typ) + if field.loc.snippet == "": fillObjectFields(m, typ) if field.loc.t == nil: internalError(m.config, n.info, "genObjectFields") m.s[cfsTypeInit3].addf("$1.kind = 1;$n" & "$1.offset = offsetof($2, $3);$n" & "$1.typ = $4;$n" & - "$1.name = $5;$n", [expr, getTypeDesc(m, origType, skVar), - field.loc.r, genTypeInfoV1(m, field.typ, info), makeCString(field.name.s)]) + "$1.name = $5;$n", [expr, getTypeDesc(m, origType, dkVar), + field.loc.snippet, genTypeInfoV1(m, field.typ, info), makeCString(field.name.s)]) else: internalError(m.config, n.info, "genObjectFields") -proc genObjectInfo(m: BModule, typ, origType: PType, name: Rope; info: TLineInfo) = - if typ.kind == tyObject: - if incompleteType(typ): - localError(m.config, info, "request for RTTI generation for incomplete object: " & - typeToString(typ)) - genTypeInfoAux(m, typ, origType, name, info) - else: - genTypeInfoAuxBase(m, typ, origType, name, rope("0"), info) +proc genObjectInfo(m: BModule; typ, origType: PType, name: Rope; info: TLineInfo) = + assert typ.kind == tyObject + if incompleteType(typ): + localError(m.config, info, "request for RTTI generation for incomplete object: " & + typeToString(typ)) + genTypeInfoAux(m, typ, origType, name, info) var tmp = getNimNode(m) - if not isImportedType(typ): + if (not isImportedType(typ)) or tfCompleteStruct in typ.flags: genObjectFields(m, typ, origType, typ.n, tmp, info) m.s[cfsTypeInit3].addf("$1.node = &$2;$n", [tiNameForHcr(m, name), tmp]) - var t = typ[0] + var t = typ.baseClass while t != nil: t = t.skipTypes(skipPtrs) t.flags.incl tfObjHasKids - t = t[0] + t = t.baseClass -proc genTupleInfo(m: BModule, typ, origType: PType, name: Rope; info: TLineInfo) = +proc genTupleInfo(m: BModule; typ, origType: PType, name: Rope; info: TLineInfo) = genTypeInfoAuxBase(m, typ, typ, name, rope("0"), info) var expr = getNimNode(m) - if typ.len > 0: - var tmp = getTempName(m) & "_" & $typ.len - genTNimNodeArray(m, tmp, rope(typ.len)) - for i in 0..<typ.len: - var a = typ[i] + if not typ.isEmptyTupleType: + var tmp = getTempName(m) & "_" & $typ.kidsLen + genTNimNodeArray(m, tmp, rope(typ.kidsLen)) + for i, a in typ.ikids: var tmp2 = getNimNode(m) m.s[cfsTypeInit3].addf("$1[$2] = &$3;$n", [tmp, rope(i), tmp2]) m.s[cfsTypeInit3].addf("$1.kind = 1;$n" & "$1.offset = offsetof($2, Field$3);$n" & "$1.typ = $4;$n" & "$1.name = \"Field$3\";$n", - [tmp2, getTypeDesc(m, origType, skVar), rope(i), genTypeInfoV1(m, a, info)]) + [tmp2, getTypeDesc(m, origType, dkVar), rope(i), genTypeInfoV1(m, a, info)]) m.s[cfsTypeInit3].addf("$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n", - [expr, rope(typ.len), tmp]) + [expr, rope(typ.kidsLen), tmp]) else: m.s[cfsTypeInit3].addf("$1.len = $2; $1.kind = 2;$n", - [expr, rope(typ.len)]) + [expr, rope(typ.kidsLen)]) m.s[cfsTypeInit3].addf("$1.node = &$2;$n", [tiNameForHcr(m, name), expr]) -proc genEnumInfo(m: BModule, typ: PType, name: Rope; info: TLineInfo) = +proc genEnumInfo(m: BModule; typ: PType, name: Rope; info: TLineInfo) = # Type information for enumerations is quite heavy, so we do some # optimizations here: The ``typ`` field is never set, as it is redundant # anyway. We generate a cstring array and a loop over it. Exceptional @@ -1220,7 +1436,7 @@ proc genEnumInfo(m: BModule, typ: PType, name: Rope; info: TLineInfo) = genTypeInfoAux(m, typ, typ, name, info) var nodePtrs = getTempName(m) & "_" & $typ.n.len genTNimNodeArray(m, nodePtrs, rope(typ.n.len)) - var enumNames, specialCases: Rope + var enumNames, specialCases: Rope = "" var firstNimNode = m.typeNodes var hasHoles = false for i in 0..<typ.n.len: @@ -1253,21 +1469,21 @@ proc genEnumInfo(m: BModule, typ: PType, name: Rope; info: TLineInfo) = # 1 << 2 is {ntfEnumHole} m.s[cfsTypeInit3].addf("$1.flags = 1<<2;$n", [tiNameForHcr(m, name)]) -proc genSetInfo(m: BModule, typ: PType, name: Rope; info: TLineInfo) = - assert(typ[0] != nil) +proc genSetInfo(m: BModule; typ: PType, name: Rope; info: TLineInfo) = + assert(typ.elementType != nil) genTypeInfoAux(m, typ, typ, name, info) var tmp = getNimNode(m) - m.s[cfsTypeInit3].addf("$1.len = $2; $1.kind = 0;$n" & "$3.node = &$1;$n", + m.s[cfsTypeInit3].addf("$1.len = $2; $1.kind = 0;$n$3.node = &$1;$n", [tmp, rope(firstOrd(m.config, typ)), tiNameForHcr(m, name)]) -proc genArrayInfo(m: BModule, typ: PType, name: Rope; info: TLineInfo) = - genTypeInfoAuxBase(m, typ, typ, name, genTypeInfoV1(m, typ[1], info), info) +proc genArrayInfo(m: BModule; typ: PType, name: Rope; info: TLineInfo) = + genTypeInfoAuxBase(m, typ, typ, name, genTypeInfoV1(m, typ.elementType, info), info) proc fakeClosureType(m: BModule; owner: PSym): PType = # we generate the same RTTI as for a tuple[pointer, ref tuple[]] - result = newType(tyTuple, nextTypeId m.idgen, owner) - result.rawAddSon(newType(tyPointer, nextTypeId m.idgen, owner)) - var r = newType(tyRef, nextTypeId m.idgen, owner) + result = newType(tyTuple, m.idgen, owner) + result.rawAddSon(newType(tyPointer, m.idgen, owner)) + var r = newType(tyRef, m.idgen, owner) let obj = createObj(m.g.graph, m.idgen, owner, owner.info, final=false) r.rawAddSon(obj) result.rawAddSon(r) @@ -1277,43 +1493,81 @@ include ccgtrav proc genDeepCopyProc(m: BModule; s: PSym; result: Rope) = genProc(m, s) m.s[cfsTypeInit3].addf("$1.deepcopy =(void* (N_RAW_NIMCALL*)(void*))$2;$n", - [result, s.loc.r]) + [result, s.loc.snippet]) -proc declareNimType(m: BModule, name: string; str: Rope, module: int) = +proc declareNimType(m: BModule; name: string; str: Rope, module: int) = let nr = rope(name) if m.hcrOn: - m.s[cfsData].addf("static $2* $1;$n", [str, nr]) + m.s[cfsStrData].addf("static $2* $1;$n", [str, nr]) m.s[cfsTypeInit1].addf("\t$1 = ($3*)hcrGetGlobal($2, \"$1\");$n", [str, getModuleDllPath(m, module), nr]) else: - m.s[cfsData].addf("extern $2 $1;$n", [str, nr]) + m.s[cfsStrData].addf("extern $2 $1;$n", [str, nr]) proc genTypeInfo2Name(m: BModule; t: PType): Rope = - var res = "|" var it = t - while it != nil: - it = it.skipTypes(skipPtrs) - if it.sym != nil: - var m = it.sym.owner - while m != nil and m.kind != skModule: m = m.owner - if m == nil or sfSystemModule in m.flags: - # produce short names for system types: - res.add it.sym.name.s - else: - var p = m.owner - if p != nil and p.kind == skPackage: - res.add p.name.s & "." - res.add m.name.s & "." - res.add it.sym.name.s + it = it.skipTypes(skipPtrs) + if it.sym != nil and tfFromGeneric notin it.flags: + var m = it.sym.owner + while m != nil and m.kind != skModule: m = m.owner + if m == nil or sfSystemModule in m.flags: + # produce short names for system types: + result = it.sym.name.s else: - res.add $hashType(it) - res.add "|" - it = it[0] - result = makeCString(res) + var p = m.owner + result = "" + if p != nil and p.kind == skPackage: + result.add p.name.s & "." + result.add m.name.s & "." + result.add it.sym.name.s + else: + result = $hashType(it, m.config) + result = makeCString(result) proc isTrivialProc(g: ModuleGraph; s: PSym): bool {.inline.} = getBody(g, s).len == 0 -proc genHook(m: BModule; t: PType; info: TLineInfo; op: TTypeAttachedOp): Rope = +proc generateRttiDestructor(g: ModuleGraph; typ: PType; owner: PSym; kind: TTypeAttachedOp; + info: TLineInfo; idgen: IdGenerator; theProc: PSym): PSym = + # the wrapper is roughly like: + # proc rttiDestroy(x: pointer) = + # `=destroy`(cast[ptr T](x)[]) + let procname = getIdent(g.cache, "rttiDestroy") + result = newSym(skProc, procname, idgen, owner, info) + let dest = newSym(skParam, getIdent(g.cache, "dest"), idgen, result, info) + + dest.typ = getSysType(g, info, tyPointer) + + result.typ = newProcType(info, idgen, owner) + result.typ.addParam dest + + var n = newNodeI(nkProcDef, info, bodyPos+1) + for i in 0..<n.len: n[i] = newNodeI(nkEmpty, info) + n[namePos] = newSymNode(result) + n[paramsPos] = result.typ.n + let body = newNodeI(nkStmtList, info) + let castType = makePtrType(typ, idgen) + if theProc.typ.firstParamType.kind != tyVar: + body.add newTreeI(nkCall, info, newSymNode(theProc), newDeref(newTreeIT( + nkCast, info, castType, newNodeIT(nkType, info, castType), + newSymNode(dest) + )) + ) + else: + let addrOf = newNodeIT(nkHiddenAddr, info, theProc.typ.firstParamType) + addrOf.add newDeref(newTreeIT( + nkCast, info, castType, newNodeIT(nkType, info, castType), + newSymNode(dest) + )) + body.add newTreeI(nkCall, info, newSymNode(theProc), + addrOf + ) + n[bodyPos] = body + result.ast = n + + incl result.flags, sfFromGeneric + incl result.flags, sfGeneratedOp + +proc genHook(m: BModule; t: PType; info: TLineInfo; op: TTypeAttachedOp; result: var Rope) = let theProc = getAttachedOp(m.g.graph, t, op) if theProc != nil and not isTrivialProc(m.g.graph, theProc): # the prototype of a destructor is ``=destroy(x: var T)`` and that of a @@ -1323,8 +1577,18 @@ proc genHook(m: BModule; t: PType; info: TLineInfo; op: TTypeAttachedOp): Rope = localError(m.config, info, theProc.name.s & " needs to have the 'nimcall' calling convention") - genProc(m, theProc) - result = theProc.loc.r + if op == attachedDestructor: + let wrapper = generateRttiDestructor(m.g.graph, t, theProc.owner, attachedDestructor, + theProc.info, m.idgen, theProc) + genProc(m, wrapper) + result.add wrapper.loc.snippet + else: + genProc(m, theProc) + result.add theProc.loc.snippet + + when false: + if not canFormAcycle(m.g.graph, t) and op == attachedTrace: + echo "ayclic but has this =trace ", t, " ", theProc.ast else: when false: if op == attachedTrace and m.config.selectedGC == gcOrc and @@ -1332,49 +1596,159 @@ proc genHook(m: BModule; t: PType; info: TLineInfo; op: TTypeAttachedOp): Rope = # unfortunately this check is wrong for an object type that only contains # .cursor fields like 'Node' inside 'cycleleak'. internalError(m.config, info, "no attached trace proc found") - result = rope("NIM_NIL") - -proc genTypeInfoV2Impl(m: BModule, t, origType: PType, name: Rope; info: TLineInfo) = - var typeName: Rope - if t.kind in {tyObject, tyDistinct}: - if incompleteType(t): - localError(m.config, info, "request for RTTI generation for incomplete object: " & - typeToString(t)) - typeName = genTypeInfo2Name(m, t) - else: - typeName = rope("NIM_NIL") + result.add rope("NIM_NIL") + +proc getObjDepth(t: PType): int16 = + var x = t + result = -1 + while x != nil: + x = skipTypes(x, skipPtrs) + x = x[0] + inc(result) + +proc genDisplayElem(d: MD5Digest): uint32 = + result = 0 + for i in 0..3: + result += uint32(d[i]) + result = result shl 8 + +proc genDisplay(m: BModule; t: PType, depth: int): Rope = + result = Rope"{" + var x = t + var seqs = newSeq[string](depth+1) + var i = 0 + while x != nil: + x = skipTypes(x, skipPtrs) + seqs[i] = $genDisplayElem(MD5Digest(hashType(x, m.config))) + x = x[0] + inc i + + for i in countdown(depth, 1): + result.add seqs[i] & ", " + result.add seqs[0] + result.add "}" + +proc genVTable(seqs: seq[PSym]): string = + result = "{" + for i in 0..<seqs.len: + if i > 0: result.add ", " + result.add "(void *) " & seqs[i].loc.snippet + result.add "}" + +proc genTypeInfoV2OldImpl(m: BModule; t, origType: PType, name: Rope; info: TLineInfo) = + cgsym(m, "TNimTypeV2") + m.s[cfsStrData].addf("N_LIB_PRIVATE TNimTypeV2 $1;$n", [name]) - discard cgsym(m, "TNimTypeV2") - m.s[cfsData].addf("N_LIB_PRIVATE TNimTypeV2 $1;$n", [name]) - let destroyImpl = genHook(m, t, info, attachedDestructor) - let traceImpl = genHook(m, t, info, attachedTrace) - let disposeImpl = genHook(m, t, info, attachedDispose) + var flags = 0 + if not canFormAcycle(m.g.graph, t): flags = flags or 1 + + var typeEntry = newRopeAppender() + addf(typeEntry, "$1.destructor = (void*)", [name]) + genHook(m, t, info, attachedDestructor, typeEntry) + + addf(typeEntry, "; $1.traceImpl = (void*)", [name]) + genHook(m, t, info, attachedTrace, typeEntry) + + let objDepth = if t.kind == tyObject: getObjDepth(t) else: -1 - addf(m.s[cfsTypeInit3], "$1.destructor = (void*)$2; $1.size = sizeof($3); $1.align = NIM_ALIGNOF($3); $1.name = $4;$n; $1.traceImpl = (void*)$5; $1.disposeImpl = (void*)$6;", [ - name, destroyImpl, getTypeDesc(m, t), typeName, - traceImpl, disposeImpl]) + if t.kind in {tyObject, tyDistinct} and incompleteType(t): + localError(m.config, info, "request for RTTI generation for incomplete object: " & + typeToString(t)) - if t.kind == tyObject and t.len > 0 and t[0] != nil and optEnableDeepCopy in m.config.globalOptions: + if isDefined(m.config, "nimTypeNames"): + var typeName: Rope + if t.kind in {tyObject, tyDistinct}: + typeName = genTypeInfo2Name(m, t) + else: + typeName = rope("NIM_NIL") + addf(typeEntry, "; $1.name = $2", [name, typeName]) + addf(typeEntry, "; $1.size = sizeof($2); $1.align = (NI16) NIM_ALIGNOF($2); $1.depth = $3; $1.flags = $4;", + [name, getTypeDesc(m, t), rope(objDepth), rope(flags)]) + + if objDepth >= 0: + let objDisplay = genDisplay(m, t, objDepth) + let objDisplayStore = getTempName(m) + m.s[cfsVars].addf("static $1 $2[$3] = $4;$n", [getTypeDesc(m, getSysType(m.g.graph, unknownLineInfo, tyUInt32), dkVar), objDisplayStore, rope(objDepth+1), objDisplay]) + addf(typeEntry, "$1.display = $2;$n", [name, rope(objDisplayStore)]) + + let dispatchMethods = toSeq(getMethodsPerType(m.g.graph, t)) + if dispatchMethods.len > 0: + let vTablePointerName = getTempName(m) + m.s[cfsVars].addf("static void* $1[$2] = $3;$n", [vTablePointerName, rope(dispatchMethods.len), genVTable(dispatchMethods)]) + for i in dispatchMethods: + genProcPrototype(m, i) + addf(typeEntry, "$1.vTable = $2;$n", [name, vTablePointerName]) + + m.s[cfsTypeInit3].add typeEntry + + if t.kind == tyObject and t.baseClass != nil and optEnableDeepCopy in m.config.globalOptions: discard genTypeInfoV1(m, t, info) -proc moduleOpenForCodegen(m: BModule; module: int32): bool {.inline.} = - result = module < m.g.modules.len and m.g.modules[module] != nil +proc genTypeInfoV2Impl(m: BModule; t, origType: PType, name: Rope; info: TLineInfo) = + cgsym(m, "TNimTypeV2") + m.s[cfsStrData].addf("N_LIB_PRIVATE TNimTypeV2 $1;$n", [name]) + + var flags = 0 + if not canFormAcycle(m.g.graph, t): flags = flags or 1 + + var typeEntry = newRopeAppender() + addf(typeEntry, "N_LIB_PRIVATE TNimTypeV2 $1 = {", [name]) + add(typeEntry, ".destructor = (void*)") + genHook(m, t, info, attachedDestructor, typeEntry) + + let objDepth = if t.kind == tyObject: getObjDepth(t) else: -1 + + if t.kind in {tyObject, tyDistinct} and incompleteType(t): + localError(m.config, info, "request for RTTI generation for incomplete object: " & + typeToString(t)) + + addf(typeEntry, ", .size = sizeof($1), .align = (NI16) NIM_ALIGNOF($1), .depth = $2", + [getTypeDesc(m, t), rope(objDepth)]) + + if objDepth >= 0: + let objDisplay = genDisplay(m, t, objDepth) + let objDisplayStore = getTempName(m) + m.s[cfsVars].addf("static NIM_CONST $1 $2[$3] = $4;$n", [getTypeDesc(m, getSysType(m.g.graph, unknownLineInfo, tyUInt32), dkVar), objDisplayStore, rope(objDepth+1), objDisplay]) + addf(typeEntry, ", .display = $1", [rope(objDisplayStore)]) + if isDefined(m.config, "nimTypeNames"): + var typeName: Rope + if t.kind in {tyObject, tyDistinct}: + typeName = genTypeInfo2Name(m, t) + else: + typeName = rope("NIM_NIL") + addf(typeEntry, ", .name = $1", [typeName]) + add(typeEntry, ", .traceImpl = (void*)") + genHook(m, t, info, attachedTrace, typeEntry) + + let dispatchMethods = toSeq(getMethodsPerType(m.g.graph, t)) + if dispatchMethods.len > 0: + addf(typeEntry, ", .flags = $1", [rope(flags)]) + for i in dispatchMethods: + genProcPrototype(m, i) + addf(typeEntry, ", .vTable = $1};$n", [genVTable(dispatchMethods)]) + m.s[cfsVars].add typeEntry + else: + addf(typeEntry, ", .flags = $1};$n", [rope(flags)]) + m.s[cfsVars].add typeEntry + + if t.kind == tyObject and t.baseClass != nil and optEnableDeepCopy in m.config.globalOptions: + discard genTypeInfoV1(m, t, info) -proc genTypeInfoV2(m: BModule, t: PType; info: TLineInfo): Rope = +proc genTypeInfoV2(m: BModule; t: PType; info: TLineInfo): Rope = let origType = t # distinct types can have their own destructors var t = skipTypes(origType, irrelevantForBackend + tyUserTypeClasses - {tyDistinct}) let prefixTI = if m.hcrOn: "(" else: "(&" - let sig = hashType(origType) + let sig = hashType(origType, m.config) result = m.typeInfoMarkerV2.getOrDefault(sig) - if result != nil: + if result != "": return prefixTI.rope & result & ")".rope let marker = m.g.typeInfoMarkerV2.getOrDefault(sig) - if marker.str != nil: - discard cgsym(m, "TNimTypeV2") + if marker.str != "": + cgsym(m, "TNimTypeV2") declareNimType(m, "TNimTypeV2", marker.str, marker.owner) # also store in local type section: m.typeInfoMarkerV2[sig] = marker.str @@ -1384,23 +1758,26 @@ proc genTypeInfoV2(m: BModule, t: PType; info: TLineInfo): Rope = m.typeInfoMarkerV2[sig] = result let owner = t.skipTypes(typedescPtrs).itemId.module - if owner != m.module.position and moduleOpenForCodegen(m, owner): + if owner != m.module.position and moduleOpenForCodegen(m.g.graph, FileIndex owner): # make sure the type info is created in the owner module discard genTypeInfoV2(m.g.modules[owner], origType, info) # reference the type info as extern here - discard cgsym(m, "TNimTypeV2") + cgsym(m, "TNimTypeV2") declareNimType(m, "TNimTypeV2", result, owner) return prefixTI.rope & result & ")".rope m.g.typeInfoMarkerV2[sig] = (str: result, owner: owner) - genTypeInfoV2Impl(m, t, origType, result, info) + if m.compileToCpp or m.hcrOn: + genTypeInfoV2OldImpl(m, t, origType, result, info) + else: + genTypeInfoV2Impl(m, t, origType, result, info) result = prefixTI.rope & result & ")".rope proc openArrayToTuple(m: BModule; t: PType): PType = - result = newType(tyTuple, nextTypeId m.idgen, t.owner) - let p = newType(tyPtr, nextTypeId m.idgen, t.owner) - let a = newType(tyUncheckedArray, nextTypeId m.idgen, t.owner) - a.add t.lastSon + result = newType(tyTuple, m.idgen, t.owner) + let p = newType(tyPtr, m.idgen, t.owner) + let a = newType(tyUncheckedArray, m.idgen, t.owner) + a.add t.elementType p.add a result.add p result.add getSysType(m.g.graph, t.owner.info, tyInt) @@ -1410,8 +1787,7 @@ proc typeToC(t: PType): string = ## to be unique. let s = typeToString(t) result = newStringOfCap(s.len) - for i in 0..<s.len: - let c = s[i] + for c in s: case c of 'a'..'z': result.add c @@ -1432,21 +1808,21 @@ proc typeToC(t: PType): string = # be clashes with our special meanings result.addInt ord(c) -proc genTypeInfoV1(m: BModule, t: PType; info: TLineInfo): Rope = +proc genTypeInfoV1(m: BModule; t: PType; info: TLineInfo): Rope = let origType = t var t = skipTypes(origType, irrelevantForBackend + tyUserTypeClasses) let prefixTI = if m.hcrOn: "(" else: "(&" - let sig = hashType(origType) + let sig = hashType(origType, m.config) result = m.typeInfoMarker.getOrDefault(sig) - if result != nil: + if result != "": return prefixTI.rope & result & ")".rope let marker = m.g.typeInfoMarker.getOrDefault(sig) - if marker.str != nil: - discard cgsym(m, "TNimType") - discard cgsym(m, "TNimNode") + if marker.str != "": + cgsym(m, "TNimType") + cgsym(m, "TNimNode") declareNimType(m, "TNimType", marker.str, marker.owner) # also store in local type section: m.typeInfoMarker[sig] = marker.str @@ -1457,18 +1833,18 @@ proc genTypeInfoV1(m: BModule, t: PType; info: TLineInfo): Rope = let old = m.g.graph.emittedTypeInfo.getOrDefault($result) if old != FileIndex(0): - discard cgsym(m, "TNimType") - discard cgsym(m, "TNimNode") + cgsym(m, "TNimType") + cgsym(m, "TNimNode") declareNimType(m, "TNimType", result, old.int) return prefixTI.rope & result & ")".rope var owner = t.skipTypes(typedescPtrs).itemId.module - if owner != m.module.position and moduleOpenForCodegen(m, owner): + if owner != m.module.position and moduleOpenForCodegen(m.g.graph, FileIndex owner): # make sure the type info is created in the owner module discard genTypeInfoV1(m.g.modules[owner], origType, info) # reference the type info as extern here - discard cgsym(m, "TNimType") - discard cgsym(m, "TNimNode") + cgsym(m, "TNimType") + cgsym(m, "TNimNode") declareNimType(m, "TNimType", result, owner) return prefixTI.rope & result & ")".rope else: @@ -1479,14 +1855,14 @@ proc genTypeInfoV1(m: BModule, t: PType; info: TLineInfo): Rope = case t.kind of tyEmpty, tyVoid: result = rope"0" - of tyPointer, tyBool, tyChar, tyCString, tyString, tyInt..tyUInt64, tyVar, tyLent: + of tyPointer, tyBool, tyChar, tyCstring, tyString, tyInt..tyUInt64, tyVar, tyLent: genTypeInfoAuxBase(m, t, t, result, rope"0", info) of tyStatic: - if t.n != nil: result = genTypeInfoV1(m, lastSon t, info) + if t.n != nil: result = genTypeInfoV1(m, skipModifier t, info) else: internalError(m.config, "genTypeInfoV1(" & $t.kind & ')') of tyUserTypeClasses: internalAssert m.config, t.isResolvedUserTypeClass - return genTypeInfoV1(m, t.lastSon, info) + return genTypeInfoV1(m, t.skipModifier, info) of tyProc: if t.callConv != ccClosure: genTypeInfoAuxBase(m, t, t, result, rope"0", info) @@ -1495,12 +1871,12 @@ proc genTypeInfoV1(m: BModule, t: PType; info: TLineInfo): Rope = genTupleInfo(m, x, x, result, info) of tySequence: genTypeInfoAux(m, t, t, result, info) - if m.config.selectedGC in {gcMarkAndSweep, gcRefc, gcV2, gcGo}: + if m.config.selectedGC in {gcMarkAndSweep, gcRefc, gcGo}: let markerProc = genTraverseProc(m, origType, sig) m.s[cfsTypeInit3].addf("$1.marker = $2;$n", [tiNameForHcr(m, result), markerProc]) of tyRef: genTypeInfoAux(m, t, t, result, info) - if m.config.selectedGC in {gcMarkAndSweep, gcRefc, gcV2, gcGo}: + if m.config.selectedGC in {gcMarkAndSweep, gcRefc, gcGo}: let markerProc = genTraverseProc(m, origType, sig) m.s[cfsTypeInit3].addf("$1.marker = $2;$n", [tiNameForHcr(m, result), markerProc]) of tyPtr, tyRange, tyUncheckedArray: genTypeInfoAux(m, t, t, result, info) @@ -1533,5 +1909,23 @@ proc genTypeInfoV1(m: BModule, t: PType; info: TLineInfo): Rope = result = prefixTI.rope & result & ")".rope +proc genTypeInfo*(config: ConfigRef, m: BModule; t: PType; info: TLineInfo): Rope = + if optTinyRtti in config.globalOptions: + result = genTypeInfoV2(m, t, info) + else: + result = genTypeInfoV1(m, t, info) + proc genTypeSection(m: BModule, n: PNode) = - discard + var intSet = initIntSet() + for i in 0..<n.len: + if len(n[i]) == 0: continue + if n[i][0].kind != nkPragmaExpr: continue + for p in 0..<n[i][0].len: + if (n[i][0][p].kind notin {nkSym, nkPostfix}): continue + var s = n[i][0][p] + if s.kind == nkPostfix: + s = n[i][0][p][1] + if {sfExportc, sfCompilerProc} * s.sym.flags == {sfExportc}: + discard getTypeDescAux(m, s.typ, intSet, descKindFromSymKind(s.sym.kind)) + if m.g.generatedHeader != nil: + discard getTypeDescAux(m.g.generatedHeader, s.typ, intSet, descKindFromSymKind(s.sym.kind)) diff --git a/compiler/ccgutils.nim b/compiler/ccgutils.nim index f2a8c1e36..c0e574186 100644 --- a/compiler/ccgutils.nim +++ b/compiler/ccgutils.nim @@ -10,19 +10,27 @@ # This module declares some helpers for the C code generator. import - ast, hashes, strutils, msgs, wordrecg, - platform, trees, options + ast, types, msgs, wordrecg, + platform, trees, options, cgendata, mangleutils + +import std/[hashes, strutils, formatfloat] + +when defined(nimPreviewSlimSystem): + import std/assertions proc getPragmaStmt*(n: PNode, w: TSpecialWord): PNode = case n.kind of nkStmtList: + result = nil for i in 0..<n.len: result = getPragmaStmt(n[i], w) if result != nil: break of nkPragma: + result = nil for i in 0..<n.len: if whichPragma(n[i]) == w: return n[i] - else: discard + else: + result = nil proc stmtsContainPragma*(n: PNode, w: TSpecialWord): bool = result = getPragmaStmt(n, w) != nil @@ -50,7 +58,7 @@ proc hashString*(conf: ConfigRef; s: string): BiggestInt = a = a + (a shl 3) a = a xor (a shr 11) a = a + (a shl 15) - result = cast[Hash](a) + result = cast[Hash](uint(a)) template getUniqueType*(key: PType): PType = key @@ -60,49 +68,103 @@ proc makeSingleLineCString*(s: string): string = c.toCChar(result) result.add('\"') -proc mangle*(name: string): string = - result = newStringOfCap(name.len) - var start = 0 - if name[0] in Digits: - result.add("X" & name[0]) - start = 1 - var requiresUnderscore = false - template special(x) = - result.add x - requiresUnderscore = true - for i in start..<name.len: - let c = name[i] - case c - of 'a'..'z', '0'..'9', 'A'..'Z': - result.add(c) - of '_': - # we generate names like 'foo_9' for scope disambiguations and so - # disallow this here: - if i > 0 and i < name.len-1 and name[i+1] in Digits: - discard - else: - result.add(c) - of '$': special "dollar" - of '%': special "percent" - of '&': special "amp" - of '^': special "roof" - of '!': special "emark" - of '?': special "qmark" - of '*': special "star" - of '+': special "plus" - of '-': special "minus" - of '/': special "slash" - of '\\': special "backslash" - of '=': special "eq" - of '<': special "lt" - of '>': special "gt" - of '~': special "tilde" - of ':': special "colon" - of '.': special "dot" - of '@': special "at" - of '|': special "bar" +proc mapSetType(conf: ConfigRef; typ: PType): TCTypeKind = + case int(getSize(conf, typ)) + of 1: result = ctInt8 + of 2: result = ctInt16 + of 4: result = ctInt32 + of 8: result = ctInt64 + else: result = ctArray + +proc ccgIntroducedPtr*(conf: ConfigRef; s: PSym, retType: PType): bool = + var pt = skipTypes(s.typ, typedescInst) + assert skResult != s.kind + + #note precedence: params override types + if optByRef in s.options: return true + elif sfByCopy in s.flags: return false + elif tfByRef in pt.flags: return true + elif tfByCopy in pt.flags: return false + case pt.kind + of tyObject: + if s.typ.sym != nil and sfForward in s.typ.sym.flags: + # forwarded objects are *always* passed by pointers for consistency! + result = true + elif s.typ.kind == tySink and conf.selectedGC notin {gcArc, gcAtomicArc, gcOrc, gcHooks}: + # bug #23354: + result = false + elif (optByRef in s.options) or (getSize(conf, pt) > conf.target.floatSize * 3): + result = true # requested anyway + elif (tfFinal in pt.flags) and (pt[0] == nil): + result = false # no need, because no subtyping possible else: - result.add("X" & toHex(ord(c), 2)) - requiresUnderscore = true - if requiresUnderscore: - result.add "_" + result = true # ordinary objects are always passed by reference, + # otherwise casting doesn't work + of tyTuple: + result = (getSize(conf, pt) > conf.target.floatSize*3) or (optByRef in s.options) + else: + result = false + # first parameter and return type is 'lent T'? --> use pass by pointer + if s.position == 0 and retType != nil and retType.kind == tyLent: + result = not (pt.kind in {tyVar, tyArray, tyOpenArray, tyVarargs, tyRef, tyPtr, tyPointer} or + pt.kind == tySet and mapSetType(conf, pt) == ctArray) + +proc encodeName*(name: string): string = + result = mangle(name) + result = $result.len & result + +proc makeUnique(m: BModule; s: PSym, name: string = ""): string = + result = if name == "": s.name.s else: name + result.add "__" + result.add m.g.graph.ifaces[s.itemId.module].uniqueName + result.add "_u" + result.add $s.itemId.item + +proc encodeSym*(m: BModule; s: PSym; makeUnique: bool = false): string = + #Module::Type + var name = s.name.s + if makeUnique: + name = makeUnique(m, s, name) + "N" & encodeName(s.skipGenericOwner.name.s) & encodeName(name) & "E" + +proc encodeType*(m: BModule; t: PType): string = + result = "" + var kindName = ($t.kind)[2..^1] + kindName[0] = toLower($kindName[0])[0] + case t.kind + of tyObject, tyEnum, tyDistinct, tyUserTypeClass, tyGenericParam: + result = encodeSym(m, t.sym) + of tyGenericInst, tyUserTypeClassInst, tyGenericBody: + result = encodeName(t[0].sym.name.s) + result.add "I" + for i in 1..<t.len - 1: + result.add encodeType(m, t[i]) + result.add "E" + of tySequence, tyOpenArray, tyArray, tyVarargs, tyTuple, tyProc, tySet, tyTypeDesc, + tyPtr, tyRef, tyVar, tyLent, tySink, tyStatic, tyUncheckedArray, tyOr, tyAnd, tyBuiltInTypeClass: + result = + case t.kind: + of tySequence: encodeName("seq") + else: encodeName(kindName) + result.add "I" + for i in 0..<t.len: + let s = t[i] + if s.isNil: continue + result.add encodeType(m, s) + result.add "E" + of tyRange: + var val = "range_" + if t.n[0].typ.kind in {tyFloat..tyFloat128}: + val.addFloat t.n[0].floatVal + val.add "_" + val.addFloat t.n[1].floatVal + else: + val.add $t.n[0].intVal & "_" & $t.n[1].intVal + result = encodeName(val) + of tyString..tyUInt64, tyPointer, tyBool, tyChar, tyVoid, tyAnything, tyNil, tyEmpty: + result = encodeName(kindName) + of tyAlias, tyInferred, tyOwned: + result = encodeType(m, t.elementType) + else: + assert false, "encodeType " & $t.kind + diff --git a/compiler/cgen.nim b/compiler/cgen.nim index b88999088..091f5c842 100644 --- a/compiler/cgen.nim +++ b/compiler/cgen.nim @@ -10,22 +10,34 @@ ## This module implements the C code generator. import - ast, astalgo, hashes, trees, platform, magicsys, extccomp, options, intsets, + ast, astalgo, trees, platform, magicsys, extccomp, options, nversion, nimsets, msgs, bitsets, idents, types, - ccgutils, os, ropes, math, passes, wordrecg, treetab, cgmeth, + ccgutils, ropes, wordrecg, treetab, cgmeth, rodutils, renderer, cgendata, aliases, - lowerings, tables, sets, ndi, lineinfos, pathutils, transf, - injectdestructors + lowerings, ndi, lineinfos, pathutils, transf, + injectdestructors, astmsgs, modulepaths, pushpoppragmas, + mangleutils + +from expanddefaults import caseObjDefaultBranch + +import pipelineutils + +when defined(nimPreviewSlimSystem): + import std/assertions when not defined(leanCompiler): import spawn, semparallel -import strutils except `%` # collides with ropes.`%` +import std/strutils except `%`, addf # collides with ropes.`%` -from modulegraphs import ModuleGraph, PPassContext -from lineinfos import - warnGcMem, errXMustBeCompileTime, hintDependency, errGenerated, errCannotOpenFile -import dynlib +from ic / ic import ModuleBackendFlag +import std/[dynlib, math, tables, sets, os, intsets, hashes] + +const + # we use some ASCII control characters to insert directives that will be converted to real code in a postprocessing pass + postprocessDirStart = '\1' + postprocessDirSep = '\31' + postprocessDirEnd = '\23' when not declared(dynlib.libCandidates): proc libCandidates(s: string, dest: var seq[string]) = @@ -50,23 +62,32 @@ proc addForwardedProc(m: BModule, prc: PSym) = m.g.forwardedProcs.add(prc) proc findPendingModule(m: BModule, s: PSym): BModule = - let ms = s.itemId.module #getModule(s) - result = m.g.modules[ms] + # TODO fixme + if m.config.symbolFiles == v2Sf: + let ms = s.itemId.module #getModule(s) + result = m.g.modules[ms] + else: + var ms = getModule(s) + result = m.g.modules[ms.position] + +proc initLoc(k: TLocKind, lode: PNode, s: TStorageLoc, flags: TLocFlags = {}): TLoc = + result = TLoc(k: k, storage: s, lode: lode, + snippet: "", flags: flags) -proc initLoc(result: var TLoc, k: TLocKind, lode: PNode, s: TStorageLoc) = - result.k = k - result.storage = s - result.lode = lode - result.r = nil - result.flags = {} +proc fillLoc(a: var TLoc, k: TLocKind, lode: PNode, r: Rope, s: TStorageLoc) {.inline.} = + # fills the loc if it is not already initialized + if a.k == locNone: + a.k = k + a.lode = lode + a.storage = s + if a.snippet == "": a.snippet = r -proc fillLoc(a: var TLoc, k: TLocKind, lode: PNode, r: Rope, s: TStorageLoc) = +proc fillLoc(a: var TLoc, k: TLocKind, lode: PNode, s: TStorageLoc) {.inline.} = # fills the loc if it is not already initialized if a.k == locNone: a.k = k a.lode = lode a.storage = s - if a.r == nil: a.r = r proc t(a: TLoc): PType {.inline.} = if a.lode.kind == nkSym: @@ -90,7 +111,8 @@ proc useHeader(m: BModule, sym: PSym) = let str = getStr(sym.annex.path) m.includeHeader(str) -proc cgsym(m: BModule, name: string): Rope +proc cgsym(m: BModule, name: string) +proc cgsymValue(m: BModule, name: string): Rope proc getCFile(m: BModule): AbsoluteFile @@ -105,11 +127,7 @@ proc getModuleDllPath(m: BModule, module: int): Rope = proc getModuleDllPath(m: BModule, s: PSym): Rope = result = getModuleDllPath(m.g.modules[s.itemId.module]) -import macros - -proc cgFormatValue(result: var string; value: Rope) = - for str in leaves(value): - result.add str +import std/macros proc cgFormatValue(result: var string; value: string) = result.add value @@ -156,6 +174,11 @@ macro ropecg(m: BModule, frmt: static[FormatStr], args: untyped): Rope = inc(i) result.add newCall(formatValue, resVar, args[num]) inc(num) + of '^': + flushStrLit() + inc(i) + result.add newCall(formatValue, resVar, args[^1]) + inc(num) of '0'..'9': var j = 0 while true: @@ -186,7 +209,7 @@ macro ropecg(m: BModule, frmt: static[FormatStr], args: untyped): Rope = var ident = newLit(substr(frmt, i, j-1)) i = j flushStrLit() - result.add newCall(formatValue, resVar, newCall(ident"cgsym", m, ident)) + result.add newCall(formatValue, resVar, newCall(ident"cgsymValue", m, ident)) elif frmt[i] == '#' and frmt[i+1] == '$': inc(i, 2) var j = 0 @@ -195,21 +218,24 @@ macro ropecg(m: BModule, frmt: static[FormatStr], args: untyped): Rope = inc(i) let ident = args[j-1] flushStrLit() - result.add newCall(formatValue, resVar, newCall(ident"cgsym", m, ident)) - var start = i - while i < frmt.len: - if frmt[i] != '$' and frmt[i] != '#': inc(i) - else: break - if i - 1 >= start: - strLit.add(substr(frmt, start, i - 1)) + result.add newCall(formatValue, resVar, newCall(ident"cgsymValue", m, ident)) + elif frmt[i] == '#' and frmt[i+1] == '#': + inc(i, 2) + strLit.add("#") + else: + strLit.add(frmt[i]) + inc(i) flushStrLit() result.add newCall(ident"rope", resVar) -proc indentLine(p: BProc, r: Rope): Rope = - result = r - for i in 0..<p.blocks.len: - prepend(result, "\t".rope) +proc addIndent(p: BProc; result: var Rope) = + var i = result.len + let newLen = i + p.blocks.len + result.setLen newLen + while i < newLen: + result[i] = '\t' + inc i template appcg(m: BModule, c: var Rope, frmt: FormatStr, args: untyped) = @@ -223,36 +249,51 @@ template appcg(p: BProc, sec: TCProcSection, frmt: FormatStr, args: untyped) = p.s(sec).add(ropecg(p.module, frmt, args)) -template line(p: BProc, sec: TCProcSection, r: Rope) = - p.s(sec).add(indentLine(p, r)) - template line(p: BProc, sec: TCProcSection, r: string) = - p.s(sec).add(indentLine(p, r.rope)) + addIndent p, p.s(sec) + p.s(sec).add(r) template lineF(p: BProc, sec: TCProcSection, frmt: FormatStr, args: untyped) = - p.s(sec).add(indentLine(p, frmt % args)) + addIndent p, p.s(sec) + p.s(sec).add(frmt % args) template lineCg(p: BProc, sec: TCProcSection, frmt: FormatStr, args: untyped) = - p.s(sec).add(indentLine(p, ropecg(p.module, frmt, args))) + addIndent p, p.s(sec) + p.s(sec).add(ropecg(p.module, frmt, args)) template linefmt(p: BProc, sec: TCProcSection, frmt: FormatStr, args: untyped) = - p.s(sec).add(indentLine(p, ropecg(p.module, frmt, args))) + addIndent p, p.s(sec) + p.s(sec).add(ropecg(p.module, frmt, args)) proc safeLineNm(info: TLineInfo): int = result = toLinenumber(info) if result < 0: result = 0 # negative numbers are not allowed in #line -proc genCLineDir(r: var Rope, filename: string, line: int; conf: ConfigRef) = +proc genPostprocessDir(field1, field2, field3: string): string = + result = postprocessDirStart & field1 & postprocessDirSep & field2 & postprocessDirSep & field3 & postprocessDirEnd + +proc genCLineDir(r: var Rope, fileIdx: FileIndex, line: int; conf: ConfigRef) = assert line >= 0 if optLineDir in conf.options and line > 0: - r.addf("$N#line $2 $1$N", - [rope(makeSingleLineCString(filename)), rope(line)]) + if fileIdx == InvalidFileIdx: + r.add(rope("\n#line " & $line & " \"generated_not_to_break_here\"\n")) + else: + r.add(rope("\n#line " & $line & " FX_" & $fileIdx.int32 & "\n")) + +proc genCLineDir(r: var Rope, fileIdx: FileIndex, line: int; p: BProc; info: TLineInfo; lastFileIndex: FileIndex) = + assert line >= 0 + if optLineDir in p.config.options and line > 0: + if fileIdx == InvalidFileIdx: + r.add(rope("\n#line " & $line & " \"generated_not_to_break_here\"\n")) + else: + r.add(rope("\n#line " & $line & " FX_" & $fileIdx.int32 & "\n")) proc genCLineDir(r: var Rope, info: TLineInfo; conf: ConfigRef) = - genCLineDir(r, toFullPath(conf, info), info.safeLineNm, conf) + if optLineDir in conf.options: + genCLineDir(r, info.fileIndex, info.safeLineNm, conf) proc freshLineInfo(p: BProc; info: TLineInfo): bool = if p.lastLineInfo.line != info.line or @@ -260,26 +301,34 @@ proc freshLineInfo(p: BProc; info: TLineInfo): bool = p.lastLineInfo.line = info.line p.lastLineInfo.fileIndex = info.fileIndex result = true + else: + result = false + +proc genCLineDir(r: var Rope, p: BProc, info: TLineInfo; conf: ConfigRef) = + if optLineDir in conf.options: + let lastFileIndex = p.lastLineInfo.fileIndex + if freshLineInfo(p, info): + genCLineDir(r, info.fileIndex, info.safeLineNm, p, info, lastFileIndex) proc genLineDir(p: BProc, t: PNode) = + if p == p.module.preInitProc: return let line = t.info.safeLineNm if optEmbedOrigSrc in p.config.globalOptions: - p.s(cpsStmts).add(~"//" & sourceLine(p.config, t.info) & "\L") - genCLineDir(p.s(cpsStmts), toFullPath(p.config, t.info), line, p.config) + p.s(cpsStmts).add("//" & sourceLine(p.config, t.info) & "\L") + let lastFileIndex = p.lastLineInfo.fileIndex + let freshLine = freshLineInfo(p, t.info) + if freshLine: + genCLineDir(p.s(cpsStmts), t.info.fileIndex, line, p, t.info, lastFileIndex) if ({optLineTrace, optStackTrace} * p.options == {optLineTrace, optStackTrace}) and (p.prc == nil or sfPure notin p.prc.flags) and t.info.fileIndex != InvalidFileIdx: - if freshLineInfo(p, t.info): - linefmt(p, cpsStmts, "nimln_($1, $2);$n", - [line, quotedFilename(p.config, t.info)]) - -proc postStmtActions(p: BProc) {.inline.} = - p.s(cpsStmts).add(p.module.injectStmt) + if freshLine: + line(p, cpsStmts, genPostprocessDir("nimln", $line, $t.info.fileIndex.int32)) proc accessThreadLocalVar(p: BProc, s: PSym) proc emulatedThreadVars(conf: ConfigRef): bool {.inline.} proc genProc(m: BModule, prc: PSym) -proc raiseInstr(p: BProc): Rope +proc raiseInstr(p: BProc; result: var Rope) template compileToCpp(m: BModule): untyped = m.config.backend == backendCpp or sfCompileToCpp in m.module.flags @@ -290,10 +339,18 @@ proc getTempName(m: BModule): Rope = proc rdLoc(a: TLoc): Rope = # 'read' location (deref if indirect) - result = a.r - if lfIndirect in a.flags: result = "(*$1)" % [result] + if lfIndirect in a.flags: + result = "(*" & a.snippet & ")" + else: + result = a.snippet -proc lenField(p: BProc): Rope = +proc addRdLoc(a: TLoc; result: var Rope) = + if lfIndirect in a.flags: + result.add "(*" & a.snippet & ")" + else: + result.add a.snippet + +proc lenField(p: BProc): Rope {.inline.} = result = rope(if p.module.compileToCpp: "len" else: "Sup.len") proc lenExpr(p: BProc; a: TLoc): Rope = @@ -302,12 +359,21 @@ proc lenExpr(p: BProc; a: TLoc): Rope = else: result = "($1 ? $1->$2 : 0)" % [rdLoc(a), lenField(p)] +proc dataFieldAccessor(p: BProc, sym: Rope): Rope = + if optSeqDestructors in p.config.globalOptions: + result = "(" & sym & ").p" + else: + result = sym + proc dataField(p: BProc): Rope = if optSeqDestructors in p.config.globalOptions: result = rope".p->data" else: result = rope"->data" +proc genProcPrototype(m: BModule, sym: PSym) + +include cbuilder include ccgliterals include ccgtypes @@ -318,16 +384,24 @@ template mapTypeChooser(n: PNode): TSymKind = template mapTypeChooser(a: TLoc): TSymKind = mapTypeChooser(a.lode) +proc addAddrLoc(conf: ConfigRef; a: TLoc; result: var Rope) = + if lfIndirect notin a.flags and mapType(conf, a.t, mapTypeChooser(a) == skParam) != ctArray: + result.add "(&" & a.snippet & ")" + else: + result.add a.snippet + proc addrLoc(conf: ConfigRef; a: TLoc): Rope = - result = a.r - if lfIndirect notin a.flags and mapType(conf, a.t, mapTypeChooser(a)) != ctArray: - result = "(&" & result & ")" + if lfIndirect notin a.flags and mapType(conf, a.t, mapTypeChooser(a) == skParam) != ctArray: + result = "(&" & a.snippet & ")" + else: + result = a.snippet proc byRefLoc(p: BProc; a: TLoc): Rope = - result = a.r - if lfIndirect notin a.flags and mapType(p.config, a.t, mapTypeChooser(a)) != ctArray and not + if lfIndirect notin a.flags and mapType(p.config, a.t, mapTypeChooser(a) == skParam) != ctArray and not p.module.compileToCpp: - result = "(&" & result & ")" + result = "(&" & a.snippet & ")" + else: + result = a.snippet proc rdCharLoc(a: TLoc): Rope = # read a location that may need a char-cast: @@ -338,6 +412,9 @@ proc rdCharLoc(a: TLoc): Rope = type TAssignmentFlag = enum needToCopy + needToCopySinkParam + needTempForOpenArray + needAssignCall TAssignmentFlags = set[TAssignmentFlag] proc genObjConstr(p: BProc, e: PNode, d: var TLoc) @@ -369,13 +446,13 @@ proc genObjectInit(p: BProc, section: TCProcSection, t: PType, a: var TLoc, linefmt(p, section, "$1.m_type = $2;$n", [r, genTypeInfoV1(p.module, t, a.lode.info)]) of frEmbedded: if optTinyRtti in p.config.globalOptions: - var tmp: TLoc + var tmp: TLoc = default(TLoc) if mode == constructRefObj: let objType = t.skipTypes(abstractInst+{tyRef}) rawConstExpr(p, newNodeIT(nkType, a.lode.info, objType), tmp) linefmt(p, cpsStmts, "#nimCopyMem((void*)$1, (NIM_CONST void*)&$2, sizeof($3));$n", - [rdLoc(a), rdLoc(tmp), getTypeDesc(p.module, objType, mapTypeChooser(a))]) + [rdLoc(a), rdLoc(tmp), getTypeDesc(p.module, objType, descKindFromSymKind mapTypeChooser(a))]) else: rawConstExpr(p, newNodeIT(nkType, a.lode.info, t), tmp) genAssignment(p, a, tmp, {}) @@ -406,9 +483,12 @@ include ccgreset proc resetLoc(p: BProc, loc: var TLoc) = let containsGcRef = optSeqDestructors notin p.config.globalOptions and containsGarbageCollectedRef(loc.t) let typ = skipTypes(loc.t, abstractVarRange) - if isImportedCppType(typ): return + if isImportedCppType(typ): + var didGenTemp = false + linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(loc), genCppInitializer(p.module, p, typ, didGenTemp)]) + return if optSeqDestructors in p.config.globalOptions and typ.kind in {tyString, tySequence}: - assert rdLoc(loc) != nil + assert loc.snippet != "" let atyp = skipTypes(loc.t, abstractInst) if atyp.kind in {tyVar, tyLent}: @@ -417,9 +497,8 @@ proc resetLoc(p: BProc, loc: var TLoc) = linefmt(p, cpsStmts, "$1.len = 0; $1.p = NIM_NIL;$n", [rdLoc(loc)]) elif not isComplexValueType(typ): if containsGcRef: - var nilLoc: TLoc - initLoc(nilLoc, locTemp, loc.lode, OnStack) - nilLoc.r = rope("NIM_NIL") + var nilLoc: TLoc = initLoc(locTemp, loc.lode, OnStack) + nilLoc.snippet = rope("NIM_NIL") genRefAssign(p, loc, nilLoc) else: linefmt(p, cpsStmts, "$1 = 0;$n", [rdLoc(loc)]) @@ -435,9 +514,17 @@ proc resetLoc(p: BProc, loc: var TLoc) = else: # array passed as argument decayed into pointer, bug #7332 # so we use getTypeDesc here rather than rdLoc(loc) - linefmt(p, cpsStmts, "#nimZeroMem((void*)$1, sizeof($2));$n", - [addrLoc(p.config, loc), - getTypeDesc(p.module, loc.t, mapTypeChooser(loc))]) + let tyDesc = getTypeDesc(p.module, loc.t, descKindFromSymKind mapTypeChooser(loc)) + if p.module.compileToCpp and isOrHasImportedCppType(typ): + if lfIndirect in loc.flags: + #C++ cant be just zeroed. We need to call the ctors + var tmp = getTemp(p, loc.t) + linefmt(p, cpsStmts,"#nimCopyMem((void*)$1, (NIM_CONST void*)$2, sizeof($3));$n", + [addrLoc(p.config, loc), addrLoc(p.config, tmp), tyDesc]) + else: + linefmt(p, cpsStmts, "#nimZeroMem((void*)$1, sizeof($2));$n", + [addrLoc(p.config, loc), tyDesc]) + # XXX: We can be extra clever here and call memset only # on the bytes following the m_type field? genObjectInit(p, cpsStmts, loc.t, loc, constructObj) @@ -447,15 +534,20 @@ proc constructLoc(p: BProc, loc: var TLoc, isTemp = false) = if optSeqDestructors in p.config.globalOptions and skipTypes(typ, abstractInst + {tyStatic}).kind in {tyString, tySequence}: linefmt(p, cpsStmts, "$1.len = 0; $1.p = NIM_NIL;$n", [rdLoc(loc)]) elif not isComplexValueType(typ): - linefmt(p, cpsStmts, "$1 = ($2)0;$n", [rdLoc(loc), - getTypeDesc(p.module, typ, mapTypeChooser(loc))]) + if containsGarbageCollectedRef(loc.t): + var nilLoc: TLoc = initLoc(locTemp, loc.lode, OnStack) + nilLoc.snippet = rope("NIM_NIL") + genRefAssign(p, loc, nilLoc) + else: + linefmt(p, cpsStmts, "$1 = ($2)0;$n", [rdLoc(loc), + getTypeDesc(p.module, typ, descKindFromSymKind mapTypeChooser(loc))]) else: - if not isTemp or containsGarbageCollectedRef(loc.t): + if (not isTemp or containsGarbageCollectedRef(loc.t)) and not hasNoInit(loc.t): # don't use nimZeroMem for temporary values for performance if we can # avoid it: - if not isImportedCppType(typ): + if not isOrHasImportedCppType(typ): linefmt(p, cpsStmts, "#nimZeroMem((void*)$1, sizeof($2));$n", - [addrLoc(p.config, loc), getTypeDesc(p.module, typ, mapTypeChooser(loc))]) + [addrLoc(p.config, loc), getTypeDesc(p.module, typ, descKindFromSymKind mapTypeChooser(loc))]) genObjectInit(p, cpsStmts, loc.t, loc, constructObj) proc initLocalVar(p: BProc, v: PSym, immediateAsgn: bool) = @@ -470,14 +562,16 @@ proc initLocalVar(p: BProc, v: PSym, immediateAsgn: bool) = if not immediateAsgn: constructLoc(p, v.loc) -proc getTemp(p: BProc, t: PType, result: var TLoc; needsInit=false) = +proc getTemp(p: BProc, t: PType, needsInit=false): TLoc = inc(p.labels) - result.r = "T" & rope(p.labels) & "_" - linefmt(p, cpsLocals, "$1 $2;$n", [getTypeDesc(p.module, t, skVar), result.r]) - result.k = locTemp - result.lode = lodeTyp t - result.storage = OnStack - result.flags = {} + result = TLoc(snippet: "T" & rope(p.labels) & "_", k: locTemp, lode: lodeTyp t, + storage: OnStack, flags: {}) + if p.module.compileToCpp and isOrHasImportedCppType(t): + var didGenTemp = false + linefmt(p, cpsLocals, "$1 $2$3;$n", [getTypeDesc(p.module, t, dkVar), result.snippet, + genCppInitializer(p.module, p, t, didGenTemp)]) + else: + linefmt(p, cpsLocals, "$1 $2;$n", [getTypeDesc(p.module, t, dkVar), result.snippet]) constructLoc(p, result, not needsInit) when false: # XXX Introduce a compiler switch in order to detect these easily. @@ -488,49 +582,53 @@ proc getTemp(p: BProc, t: PType, result: var TLoc; needsInit=false) = echo "ENORMOUS TEMPORARY! ", p.config $ p.lastLineInfo writeStackTrace() -proc getTempCpp(p: BProc, t: PType, result: var TLoc; value: Rope) = +proc getTempCpp(p: BProc, t: PType, value: Rope): TLoc = inc(p.labels) - result.r = "T" & rope(p.labels) & "_" - linefmt(p, cpsStmts, "$1 $2 = $3;$n", [getTypeDesc(p.module, t, skVar), result.r, value]) - result.k = locTemp - result.lode = lodeTyp t - result.storage = OnStack - result.flags = {} - -proc getIntTemp(p: BProc, result: var TLoc) = + result = TLoc(snippet: "T" & rope(p.labels) & "_", k: locTemp, lode: lodeTyp t, + storage: OnStack, flags: {}) + linefmt(p, cpsStmts, "auto $1 = $2;$n", [result.snippet, value]) + +proc getIntTemp(p: BProc): TLoc = inc(p.labels) - result.r = "T" & rope(p.labels) & "_" - linefmt(p, cpsLocals, "NI $1;$n", [result.r]) - result.k = locTemp - result.storage = OnStack - result.lode = lodeTyp getSysType(p.module.g.graph, unknownLineInfo, tyInt) - result.flags = {} + result = TLoc(snippet: "T" & rope(p.labels) & "_", k: locTemp, + storage: OnStack, lode: lodeTyp getSysType(p.module.g.graph, unknownLineInfo, tyInt), + flags: {}) + linefmt(p, cpsLocals, "NI $1;$n", [result.snippet]) proc localVarDecl(p: BProc; n: PNode): Rope = + result = "" let s = n.sym if s.loc.k == locNone: - fillLoc(s.loc, locLocalVar, n, mangleLocalName(p, s), OnStack) + fillLocalName(p, s) + fillLoc(s.loc, locLocalVar, n, OnStack) if s.kind == skLet: incl(s.loc.flags, lfNoDeepCopy) if s.kind in {skLet, skVar, skField, skForVar} and s.alignment > 0: result.addf("NIM_ALIGN($1) ", [rope(s.alignment)]) - result.add getTypeDesc(p.module, s.typ, skVar) - if s.constraint.isNil: + + genCLineDir(result, p, n.info, p.config) + + result.add getTypeDesc(p.module, s.typ, dkVar) + if sfCodegenDecl notin s.flags: if sfRegister in s.flags: result.add(" register") #elif skipTypes(s.typ, abstractInst).kind in GcTypeKinds: # decl.add(" GC_GUARD") if sfVolatile in s.flags: result.add(" volatile") if sfNoalias in s.flags: result.add(" NIM_NOALIAS") result.add(" ") - result.add(s.loc.r) + result.add(s.loc.snippet) else: - result = runtimeFormat(s.cgDeclFrmt, [result, s.loc.r]) + result = runtimeFormat(s.cgDeclFrmt, [result, s.loc.snippet]) proc assignLocalVar(p: BProc, n: PNode) = #assert(s.loc.k == locNone) # not yet assigned # this need not be fulfilled for inline procs; they are regenerated # for each module that uses them! - let nl = if optLineDir in p.config.options: "" else: "\L" - let decl = localVarDecl(p, n) & ";" & nl + let nl = if optLineDir in p.config.options: "" else: "\n" + var decl = localVarDecl(p, n) + if p.module.compileToCpp and isOrHasImportedCppType(n.typ): + var didGenTemp = false + decl.add genCppInitializer(p.module, p, n.typ, didGenTemp) + decl.add ";" & nl line(p, cpsLocals, decl) include ccgthreadvars @@ -543,10 +641,34 @@ proc treatGlobalDifferentlyForHCR(m: BModule, s: PSym): bool = # and s.owner.kind == skModule # owner isn't always a module (global pragma on local var) # and s.loc.k == locGlobalVar # loc isn't always initialized when this proc is used +proc genGlobalVarDecl(p: BProc, n: PNode; td, value: Rope; decl: var Rope) = + let s = n.sym + if sfCodegenDecl notin s.flags: + if s.kind in {skLet, skVar, skField, skForVar} and s.alignment > 0: + decl.addf "NIM_ALIGN($1) ", [rope(s.alignment)] + if p.hcrOn: decl.add("static ") + elif sfImportc in s.flags: decl.add("extern ") + elif lfExportLib in s.loc.flags: decl.add("N_LIB_EXPORT_VAR ") + else: decl.add("N_LIB_PRIVATE ") + if s.kind == skLet and value != "": decl.add("NIM_CONST ") + decl.add(td) + if p.hcrOn: decl.add("*") + if sfRegister in s.flags: decl.add(" register") + if sfVolatile in s.flags: decl.add(" volatile") + if sfNoalias in s.flags: decl.add(" NIM_NOALIAS") + else: + if value != "": + decl = runtimeFormat(s.cgDeclFrmt & " = $#;$n", [td, s.loc.snippet, value]) + else: + decl = runtimeFormat(s.cgDeclFrmt & ";$n", [td, s.loc.snippet]) + +proc genCppVarForCtor(p: BProc; call: PNode; decl: var Rope; didGenTemp: var bool) + proc assignGlobalVar(p: BProc, n: PNode; value: Rope) = let s = n.sym if s.loc.k == locNone: - fillLoc(s.loc, locGlobalVar, n, mangleName(p.module, s), OnHeap) + fillBackendName(p.module, s) + fillLoc(s.loc, locGlobalVar, n, OnHeap) if treatGlobalDifferentlyForHCR(p.module, s): incl(s.loc.flags, lfIndirect) if lfDynamicLib in s.loc.flags: @@ -554,8 +676,8 @@ proc assignGlobalVar(p: BProc, n: PNode; value: Rope) = if q != nil and not containsOrIncl(q.declaredThings, s.id): varInDynamicLib(q, s) else: - s.loc.r = mangleDynLibProc(s) - if value != nil: + s.loc.snippet = mangleDynLibProc(s) + if value != "": internalError(p.config, n.info, ".dynlib variables cannot have a value") return useHeader(p.module, s) @@ -563,71 +685,86 @@ proc assignGlobalVar(p: BProc, n: PNode; value: Rope) = if not containsOrIncl(p.module.declaredThings, s.id): if sfThread in s.flags: declareThreadVar(p.module, s, sfImportc in s.flags) - if value != nil: + if value != "": internalError(p.config, n.info, ".threadvar variables cannot have a value") else: - var decl: Rope = nil - var td = getTypeDesc(p.module, s.loc.t, skVar) + var decl: Rope = "" + let td = getTypeDesc(p.module, s.loc.t, dkVar) + genGlobalVarDecl(p, n, td, value, decl) if s.constraint.isNil: - if s.kind in {skLet, skVar, skField, skForVar} and s.alignment > 0: - decl.addf "NIM_ALIGN($1) ", [rope(s.alignment)] - if p.hcrOn: decl.add("static ") - elif sfImportc in s.flags: decl.add("extern ") - elif lfExportLib in s.loc.flags: decl.add("N_LIB_EXPORT_VAR ") - else: decl.add("N_LIB_PRIVATE ") - if s.kind == skLet and value != nil: decl.add("NIM_CONST ") - decl.add(td) - if p.hcrOn: decl.add("*") - if sfRegister in s.flags: decl.add(" register") - if sfVolatile in s.flags: decl.add(" volatile") - if sfNoalias in s.flags: decl.add(" NIM_NOALIAS") - if value != nil: - decl.addf(" $1 = $2;$n", [s.loc.r, value]) + if value != "": + if p.module.compileToCpp and value.startsWith "{{}": + # TODO: taking this branch, re"\{\{\}(,\s\{\})*\}" might be emitted, resulting in + # either warnings (GCC 12.2+) or errors (Clang 15, MSVC 19.3+) of C++11+ compilers **when + # explicit constructors are around** due to overload resolution rules in place [^0][^1][^2] + # *Workaround* here: have C++'s static initialization mechanism do the default init work, + # for us lacking a deeper knowledge of an imported object's constructors' ex-/implicitness + # (so far) *and yet* trying to achieve default initialization. + # Still, generating {}s in genConstObjConstr() just to omit them here is faaaar from ideal; + # need to figure out a better way, possibly by keeping around more data about the + # imported objects' contructors? + # + # [^0]: https://en.cppreference.com/w/cpp/language/aggregate_initialization + # [^1]: https://cplusplus.github.io/CWG/issues/1518.html + # [^2]: https://eel.is/c++draft/over.match.ctor + decl.addf(" $1;$n", [s.loc.snippet]) + else: + decl.addf(" $1 = $2;$n", [s.loc.snippet, value]) else: - decl.addf(" $1;$n", [s.loc.r]) - else: - if value != nil: - decl = runtimeFormat(s.cgDeclFrmt & " = $#;$n", [td, s.loc.r, value]) - else: - decl = runtimeFormat(s.cgDeclFrmt & ";$n", [td, s.loc.r]) + decl.addf(" $1;$n", [s.loc.snippet]) + p.module.s[cfsVars].add(decl) - if p.withinLoop > 0 and value == nil: + if p.withinLoop > 0 and value == "": # fixes tests/run/tzeroarray: resetLoc(p, s.loc) +proc callGlobalVarCppCtor(p: BProc; v: PSym; vn, value: PNode; didGenTemp: var bool) = + let s = vn.sym + fillBackendName(p.module, s) + fillLoc(s.loc, locGlobalVar, vn, OnHeap) + var decl: Rope = "" + let td = getTypeDesc(p.module, vn.sym.typ, dkVar) + genGlobalVarDecl(p, vn, td, "", decl) + decl.add " " & $s.loc.snippet + genCppVarForCtor(p, value, decl, didGenTemp) + if didGenTemp: return # generated in the caller + p.module.s[cfsVars].add decl + proc assignParam(p: BProc, s: PSym, retType: PType) = - assert(s.loc.r != nil) + assert(s.loc.snippet != "") scopeMangledParam(p, s) proc fillProcLoc(m: BModule; n: PNode) = let sym = n.sym if sym.loc.k == locNone: - fillLoc(sym.loc, locProc, n, mangleName(m, sym), OnStack) + fillBackendName(m, sym) + fillLoc(sym.loc, locProc, n, OnStack) proc getLabel(p: BProc): TLabel = inc(p.labels) result = "LA" & rope(p.labels) & "_" proc fixLabel(p: BProc, labl: TLabel) = - lineF(p, cpsStmts, "$1: ;$n", [labl]) + p.s(cpsStmts).add("$1: ;$n" % [labl]) proc genVarPrototype(m: BModule, n: PNode) proc requestConstImpl(p: BProc, sym: PSym) proc genStmts(p: BProc, t: PNode) proc expr(p: BProc, n: PNode, d: var TLoc) -proc genProcPrototype(m: BModule, sym: PSym) + proc putLocIntoDest(p: BProc, d: var TLoc, s: TLoc) -proc intLiteral(i: BiggestInt): Rope -proc genLiteral(p: BProc, n: PNode): Rope -proc genOtherArg(p: BProc; ri: PNode; i: int; typ: PType): Rope +proc intLiteral(i: BiggestInt; result: var Rope) +proc genLiteral(p: BProc, n: PNode; result: var Rope) +proc genOtherArg(p: BProc; ri: PNode; i: int; typ: PType; result: var Rope; argsCounter: var int) proc raiseExit(p: BProc) +proc raiseExitCleanup(p: BProc, destroy: string) -proc initLocExpr(p: BProc, e: PNode, result: var TLoc) = - initLoc(result, locNone, e, OnUnknown) +proc initLocExpr(p: BProc, e: PNode, flags: TLocFlags = {}): TLoc = + result = initLoc(locNone, e, OnUnknown, flags) expr(p, e, result) -proc initLocExprSingleUse(p: BProc, e: PNode, result: var TLoc) = - initLoc(result, locNone, e, OnUnknown) +proc initLocExprSingleUse(p: BProc, e: PNode): TLoc = + result = initLoc(locNone, e, OnUnknown) if e.kind in nkCallKinds and (e[0].kind != nkSym or e[0].sym.magic == mNone): # We cannot check for tfNoSideEffect here because of mutable parameters. discard "bug #8202; enforce evaluation order for nested calls for C++ too" @@ -643,25 +780,25 @@ include ccgcalls, "ccgstmts.nim" proc initFrame(p: BProc, procname, filename: Rope): Rope = const frameDefines = """ - $1 define nimfr_(proc, file) \ - TFrame FR_; \ - FR_.procname = proc; FR_.filename = file; FR_.line = 0; FR_.len = 0; #nimFrame(&FR_); +$1define nimfr_(proc, file) \ + TFrame FR_; \ + FR_.procname = proc; FR_.filename = file; FR_.line = 0; FR_.len = 0; #nimFrame(&FR_); - $1 define nimfrs_(proc, file, slots, length) \ - struct {TFrame* prev;NCSTRING procname;NI line;NCSTRING filename; NI len; VarSlot s[slots];} FR_; \ - FR_.procname = proc; FR_.filename = file; FR_.line = 0; FR_.len = length; #nimFrame((TFrame*)&FR_); +$1define nimln_(n) \ + FR_.line = n; - $1 define nimln_(n, file) \ - FR_.line = n; FR_.filename = file; - """ +$1define nimlf_(n, file) \ + FR_.line = n; FR_.filename = file; + +""" if p.module.s[cfsFrameDefines].len == 0: appcg(p.module, p.module.s[cfsFrameDefines], frameDefines, ["#"]) - discard cgsym(p.module, "nimFrame") + cgsym(p.module, "nimFrame") result = ropecg(p.module, "\tnimfr_($1, $2);$n", [procname, filename]) proc initFrameNoDebug(p: BProc; frame, procname, filename: Rope; line: int): Rope = - discard cgsym(p.module, "nimFrame") + cgsym(p.module, "nimFrame") p.blocks[0].sections[cpsLocals].addf("TFrame $1;$n", [frame]) result = ropecg(p.module, "\t$1.procname = $2; $1.filename = $3; " & " $1.line = $4; $1.len = -1; nimFrame(&$1);$n", @@ -688,33 +825,36 @@ proc loadDynamicLib(m: BModule, lib: PLib) = if not lib.generated: lib.generated = true var tmp = getTempName(m) - assert(lib.name == nil) + assert(lib.name == "") lib.name = tmp # BUGFIX: cgsym has awful side-effects m.s[cfsVars].addf("static void* $1;$n", [tmp]) if lib.path.kind in {nkStrLit..nkTripleStrLit}: var s: TStringSeq = @[] libCandidates(lib.path.strVal, s) rawMessage(m.config, hintDependency, lib.path.strVal) - var loadlib: Rope = nil + var loadlib: Rope = "" for i in 0..high(s): inc(m.labels) if i > 0: loadlib.add("||") let n = newStrNode(nkStrLit, s[i]) n.info = lib.path.info - appcg(m, loadlib, "($1 = #nimLoadLibrary($2))$n", - [tmp, genStringLiteral(m, n)]) + appcg(m, loadlib, "($1 = #nimLoadLibrary(", [tmp]) + genStringLiteral(m, n, loadlib) + loadlib.addf "))$n", [] appcg(m, m.s[cfsDynLibInit], - "if (!($1)) #nimLoadLibraryError($2);$n", - [loadlib, genStringLiteral(m, lib.path)]) + "if (!($1)) #nimLoadLibraryError(", + [loadlib]) + genStringLiteral(m, lib.path, m.s[cfsDynLibInit]) + m.s[cfsDynLibInit].addf ");$n", [] + else: var p = newProc(nil, m) p.options.excl optStackTrace p.flags.incl nimErrorFlagDisabled - var dest: TLoc - initLoc(dest, locTemp, lib.path, OnStack) - dest.r = getTempName(m) + var dest: TLoc = initLoc(locTemp, lib.path, OnStack) + dest.snippet = getTempName(m) appcg(m, m.s[cfsDynLibInit],"$1 $2;$n", - [getTypeDesc(m, lib.path.typ, skVar), rdLoc(dest)]) + [getTypeDesc(m, lib.path.typ, dkVar), rdLoc(dest)]) expr(p, lib.path, dest) m.s[cfsVars].add(p.s(cpsLocals)) @@ -724,13 +864,13 @@ proc loadDynamicLib(m: BModule, lib: PLib) = "if (!($1 = #nimLoadLibrary($2))) #nimLoadLibraryError($2);$n", [tmp, rdLoc(dest)]) - if lib.name == nil: internalError(m.config, "loadDynamicLib") + if lib.name == "": internalError(m.config, "loadDynamicLib") proc mangleDynLibProc(sym: PSym): Rope = # we have to build this as a single rope in order not to trip the # optimization in genInfixCall, see test tests/cpp/t8241.nim if sfCompilerProc in sym.flags: - # NOTE: sym.loc.r is the external name! + # NOTE: sym.loc.snippet is the external name! result = rope(sym.name.s) else: result = rope(strutils.`%`("Dl_$1_", $sym.id)) @@ -738,23 +878,22 @@ proc mangleDynLibProc(sym: PSym): Rope = proc symInDynamicLib(m: BModule, sym: PSym) = var lib = sym.annex let isCall = isGetProcAddr(lib) - var extname = sym.loc.r + var extname = sym.loc.snippet if not isCall: loadDynamicLib(m, lib) var tmp = mangleDynLibProc(sym) - sym.loc.r = tmp # from now on we only need the internal name + sym.loc.snippet = tmp # from now on we only need the internal name sym.typ.sym = nil # generate a new name inc(m.labels, 2) if isCall: let n = lib.path - var a: TLoc - initLocExpr(m.initProc, n[0], a) + var a: TLoc = initLocExpr(m.initProc, n[0]) var params = rdLoc(a) & "(" for i in 1..<n.len-1: - initLocExpr(m.initProc, n[i], a) + a = initLocExpr(m.initProc, n[i]) params.add(rdLoc(a)) params.add(", ") let load = "\t$1 = ($2) ($3$4));$n" % - [tmp, getTypeDesc(m, sym.typ, skVar), params, makeCString($extname)] + [tmp, getTypeDesc(m, sym.typ, dkVar), params, makeCString($extname)] var last = lastSon(n) if last.kind == nkHiddenStdConv: last = last[1] internalAssert(m.config, last.kind == nkStrLit) @@ -768,46 +907,55 @@ proc symInDynamicLib(m: BModule, sym: PSym) = else: appcg(m, m.s[cfsDynLibInit], "\t$1 = ($2) #nimGetProcAddr($3, $4);$n", - [tmp, getTypeDesc(m, sym.typ, skVar), lib.name, makeCString($extname)]) - m.s[cfsVars].addf("$2 $1;$n", [sym.loc.r, getTypeDesc(m, sym.loc.t, skVar)]) + [tmp, getTypeDesc(m, sym.typ, dkVar), lib.name, makeCString($extname)]) + m.s[cfsVars].addf("$2 $1;$n", [sym.loc.snippet, getTypeDesc(m, sym.loc.t, dkVar)]) proc varInDynamicLib(m: BModule, sym: PSym) = var lib = sym.annex - var extname = sym.loc.r + var extname = sym.loc.snippet loadDynamicLib(m, lib) incl(sym.loc.flags, lfIndirect) var tmp = mangleDynLibProc(sym) - sym.loc.r = tmp # from now on we only need the internal name + sym.loc.snippet = tmp # from now on we only need the internal name inc(m.labels, 2) appcg(m, m.s[cfsDynLibInit], "$1 = ($2*) #nimGetProcAddr($3, $4);$n", - [tmp, getTypeDesc(m, sym.typ, skVar), lib.name, makeCString($extname)]) + [tmp, getTypeDesc(m, sym.typ, dkVar), lib.name, makeCString($extname)]) m.s[cfsVars].addf("$2* $1;$n", - [sym.loc.r, getTypeDesc(m, sym.loc.t, skVar)]) + [sym.loc.snippet, getTypeDesc(m, sym.loc.t, dkVar)]) proc symInDynamicLibPartial(m: BModule, sym: PSym) = - sym.loc.r = mangleDynLibProc(sym) + sym.loc.snippet = mangleDynLibProc(sym) sym.typ.sym = nil # generate a new name -proc cgsym(m: BModule, name: string): Rope = +proc cgsymImpl(m: BModule; sym: PSym) {.inline.} = + case sym.kind + of skProc, skFunc, skMethod, skConverter, skIterator: genProc(m, sym) + of skVar, skResult, skLet: genVarPrototype(m, newSymNode sym) + of skType: discard getTypeDesc(m, sym.typ) + else: internalError(m.config, "cgsym: " & $sym.kind) + +proc cgsym(m: BModule, name: string) = + let sym = magicsys.getCompilerProc(m.g.graph, name) + if sym != nil: + cgsymImpl m, sym + else: + rawMessage(m.config, errGenerated, "system module needs: " & name) + +proc cgsymValue(m: BModule, name: string): Rope = let sym = magicsys.getCompilerProc(m.g.graph, name) if sym != nil: - case sym.kind - of skProc, skFunc, skMethod, skConverter, skIterator: genProc(m, sym) - of skVar, skResult, skLet: genVarPrototype(m, newSymNode sym) - of skType: discard getTypeDesc(m, sym.typ) - else: internalError(m.config, "cgsym: " & name & ": " & $sym.kind) + cgsymImpl m, sym else: - # we used to exclude the system module from this check, but for DLL - # generation support this sloppyness leads to hard to detect bugs, so - # we're picky here for the system module too: rawMessage(m.config, errGenerated, "system module needs: " & name) - result = sym.loc.r + result = sym.loc.snippet if m.hcrOn and sym != nil and sym.kind in {skProc..skIterator}: result.addActualSuffixForHCR(m.module, sym) proc generateHeaders(m: BModule) = - m.s[cfsHeaders].add("\L#include \"nimbase.h\"\L") + var nimbase = m.config.nimbasePattern + if nimbase == "": nimbase = "nimbase.h" + m.s[cfsHeaders].addf("\L#include \"$1\"\L", [nimbase]) for it in m.headerFiles: if it[0] == '#': @@ -831,12 +979,12 @@ proc generateHeaders(m: BModule) = #undef unix """) -proc openNamespaceNim(namespace: string): Rope = +proc openNamespaceNim(namespace: string; result: var Rope) = result.add("namespace ") result.add(namespace) result.add(" {\L") -proc closeNamespaceNim(): Rope = +proc closeNamespaceNim(result: var Rope) = result.add("}\L") proc closureSetup(p: BProc, prc: PSym) = @@ -856,24 +1004,34 @@ proc closureSetup(p: BProc, prc: PSym) = linefmt(p, cpsStmts, "$1 = ($2) ClE_0;$n", [rdLoc(env.loc), getTypeDesc(p.module, env.typ)]) +const harmless = {nkConstSection, nkTypeSection, nkEmpty, nkCommentStmt, nkTemplateDef, + nkMacroDef, nkMixinStmt, nkBindStmt, nkFormalParams} + + declarativeDefs + proc containsResult(n: PNode): bool = - if n.kind == nkSym and n.sym.kind == skResult: - result = true + result = false + case n.kind + of succ(nkEmpty)..pred(nkSym), succ(nkSym)..nkNilLit, harmless: + discard + of nkReturnStmt: + for i in 0..<n.len: + if containsResult(n[i]): return true + result = n.len > 0 and n[0].kind == nkEmpty + of nkSym: + if n.sym.kind == skResult: + result = true else: - for i in 0..<n.safeLen: + for i in 0..<n.len: if containsResult(n[i]): return true -const harmless = {nkConstSection, nkTypeSection, nkEmpty, nkCommentStmt, nkTemplateDef, - nkMacroDef, nkMixinStmt, nkBindStmt} + - declarativeDefs - proc easyResultAsgn(n: PNode): PNode = + result = nil case n.kind of nkStmtList, nkStmtListExpr: var i = 0 while i < n.len and n[i].kind in harmless: inc i if i < n.len: result = easyResultAsgn(n[i]) - of nkAsgn, nkFastAsgn: + of nkAsgn, nkFastAsgn, nkSinkAsgn: if n[0].kind == nkSym and n[0].sym.kind == skResult and not containsResult(n[1]): incl n.flags, nfPreventCg return n[1] @@ -886,7 +1044,7 @@ proc easyResultAsgn(n: PNode): PNode = type InitResultEnum = enum Unknown, InitSkippable, InitRequired -proc allPathsAsgnResult(n: PNode): InitResultEnum = +proc allPathsAsgnResult(p: BProc; n: PNode): InitResultEnum = # Exceptions coming from calls don't have not be considered here: # # proc bar(): string = raise newException(...) @@ -901,7 +1059,7 @@ proc allPathsAsgnResult(n: PNode): InitResultEnum = # echo "a was not written to" # template allPathsInBranch(it) = - let a = allPathsAsgnResult(it) + let a = allPathsAsgnResult(p, it) case a of InitRequired: return InitRequired of InitSkippable: discard @@ -913,14 +1071,20 @@ proc allPathsAsgnResult(n: PNode): InitResultEnum = case n.kind of nkStmtList, nkStmtListExpr: for it in n: - result = allPathsAsgnResult(it) + result = allPathsAsgnResult(p, it) if result != Unknown: return result - of nkAsgn, nkFastAsgn: + of nkAsgn, nkFastAsgn, nkSinkAsgn: if n[0].kind == nkSym and n[0].sym.kind == skResult: - if not containsResult(n[1]): result = InitSkippable + if not containsResult(n[1]): + if allPathsAsgnResult(p, n[1]) == InitRequired: + result = InitRequired + else: + result = InitSkippable else: result = InitRequired elif containsResult(n): result = InitRequired + else: + result = allPathsAsgnResult(p, n[1]) of nkReturnStmt: if n.len > 0: if n[0].kind == nkEmpty and result != InitSkippable: @@ -929,7 +1093,7 @@ proc allPathsAsgnResult(n: PNode): InitResultEnum = # initialized. This avoids cases like #9286 where this heuristic lead to # wrong code being generated. result = InitRequired - else: result = allPathsAsgnResult(n[0]) + else: result = allPathsAsgnResult(p, n[0]) of nkIfStmt, nkIfExpr: var exhaustive = false result = InitSkippable @@ -946,7 +1110,7 @@ proc allPathsAsgnResult(n: PNode): InitResultEnum = if containsResult(n[0]): return InitRequired result = InitSkippable var exhaustive = skipTypes(n[0].typ, - abstractVarRange-{tyTypeDesc}).kind notin {tyFloat..tyFloat128, tyString} + abstractVarRange-{tyTypeDesc}).kind notin {tyFloat..tyFloat128, tyString, tyCstring} for i in 1..<n.len: let it = n[i] allPathsInBranch(it.lastSon) @@ -955,9 +1119,9 @@ proc allPathsAsgnResult(n: PNode): InitResultEnum = of nkWhileStmt: # some dubious code can assign the result in the 'while' # condition and that would be fine. Everything else isn't: - result = allPathsAsgnResult(n[0]) + result = allPathsAsgnResult(p, n[0]) if result == Unknown: - result = allPathsAsgnResult(n[1]) + result = allPathsAsgnResult(p, n[1]) # we cannot assume that the 'while' loop is really executed at least once: if result == InitSkippable: result = Unknown of harmless: @@ -982,9 +1146,21 @@ proc allPathsAsgnResult(n: PNode): InitResultEnum = allPathsInBranch(n[0]) for i in 1..<n.len: if n[i].kind == nkFinally: - result = allPathsAsgnResult(n[i].lastSon) + result = allPathsAsgnResult(p, n[i].lastSon) else: allPathsInBranch(n[i].lastSon) + of nkCallKinds: + if canRaiseDisp(p, n[0]): + result = InitRequired + else: + for i in 0..<n.safeLen: + allPathsInBranch(n[i]) + of nkRaiseStmt: + result = InitRequired + of nkChckRangeF, nkChckRange64, nkChckRange: + # TODO: more checks might need to be covered like overflow, indexDefect etc. + # bug #22852 + result = InitRequired else: for i in 0..<n.safeLen: allPathsInBranch(n[i]) @@ -992,14 +1168,14 @@ proc allPathsAsgnResult(n: PNode): InitResultEnum = proc getProcTypeCast(m: BModule, prc: PSym): Rope = result = getTypeDesc(m, prc.loc.t) if prc.typ.callConv == ccClosure: - var rettype, params: Rope + var rettype, params: Rope = "" var check = initIntSet() genProcParams(m, prc.typ, rettype, params, check) result = "$1(*)$2" % [rettype, params] proc genProcBody(p: BProc; procBody: PNode) = genStmts(p, procBody) # modifies p.locals, p.init, etc. - if {nimErrorFlagAccessed, nimErrorFlagDeclared} * p.flags == {nimErrorFlagAccessed}: + if {nimErrorFlagAccessed, nimErrorFlagDeclared, nimErrorFlagDisabled} * p.flags == {nimErrorFlagAccessed}: p.flags.incl nimErrorFlagDeclared p.blocks[0].sections[cpsLocals].add(ropecg(p.module, "NIM_BOOL* nimErr_;$n", [])) p.blocks[0].sections[cpsInit].add(ropecg(p.module, "nimErr_ = #nimErrorFlag();$n", [])) @@ -1007,37 +1183,54 @@ proc genProcBody(p: BProc; procBody: PNode) = proc isNoReturn(m: BModule; s: PSym): bool {.inline.} = sfNoReturn in s.flags and m.config.exc != excGoto -proc genProcAux(m: BModule, prc: PSym) = +proc genProcAux*(m: BModule, prc: PSym) = var p = newProc(prc, m) - var header = genProcHeader(m, prc) - var returnStmt: Rope = nil + var header = newRopeAppender() + let isCppMember = m.config.backend == backendCpp and sfCppMember * prc.flags != {} + if isCppMember: + genMemberProcHeader(m, prc, header) + else: + genProcHeader(m, prc, header) + var returnStmt: Rope = "" assert(prc.ast != nil) - var procBody = transformBody(m.g.graph, m.idgen, prc, cache = false) + var procBody = transformBody(m.g.graph, m.idgen, prc, {}) if sfInjectDestructors in prc.flags: procBody = injectDestructorCalls(m.g.graph, m.idgen, prc, procBody) - if sfPure notin prc.flags and prc.typ[0] != nil: + let tmpInfo = prc.info + discard freshLineInfo(p, prc.info) + + if sfPure notin prc.flags and prc.typ.returnType != nil: if resultPos >= prc.ast.len: internalError(m.config, prc.info, "proc has no result symbol") let resNode = prc.ast[resultPos] let res = resNode.sym # get result symbol - if not isInvalidReturnType(m.config, prc.typ[0]): + if not isInvalidReturnType(m.config, prc.typ) and sfConstructor notin prc.flags: if sfNoInit in prc.flags: incl(res.flags, sfNoInit) if sfNoInit in prc.flags and p.module.compileToCpp and (let val = easyResultAsgn(procBody); val != nil): var decl = localVarDecl(p, resNode) - var a: TLoc - initLocExprSingleUse(p, val, a) + var a: TLoc = initLocExprSingleUse(p, val) linefmt(p, cpsStmts, "$1 = $2;$n", [decl, rdLoc(a)]) else: # declare the result symbol: assignLocalVar(p, resNode) - assert(res.loc.r != nil) - initLocalVar(p, res, immediateAsgn=false) + assert(res.loc.snippet != "") + if p.config.selectedGC in {gcArc, gcAtomicArc, gcOrc} and + allPathsAsgnResult(p, procBody) == InitSkippable: + # In an ideal world the codegen could rely on injectdestructors doing its job properly + # and then the analysis step would not be required. + discard "result init optimized out" + else: + initLocalVar(p, res, immediateAsgn=false) returnStmt = ropecg(p.module, "\treturn $1;$n", [rdLoc(res.loc)]) + elif sfConstructor in prc.flags: + resNode.sym.loc.flags.incl lfIndirect + fillLoc(resNode.sym.loc, locParam, resNode, "this", OnHeap) + prc.loc.snippet = getTypeDesc(m, resNode.sym.loc.t, dkVar) else: - fillResult(p.config, resNode) - assignParam(p, res, prc.typ[0]) + fillResult(p.config, resNode, prc.typ) + assignParam(p, res, prc.typ.returnType) # We simplify 'unsureAsgn(result, nil); unsureAsgn(result, x)' # to 'unsureAsgn(result, x)' # Sketch why this is correct: If 'result' points to a stack location @@ -1045,7 +1238,7 @@ proc genProcAux(m: BModule, prc: PSym) = # global is either 'nil' or points to valid memory and so the RC operation # succeeds without touching not-initialized memory. if sfNoInit in prc.flags: discard - elif allPathsAsgnResult(procBody) == InitSkippable: discard + elif allPathsAsgnResult(p, procBody) == InitSkippable: discard else: resetLoc(p, res.loc) if skipTypes(res.typ, abstractInst).kind == tyArray: @@ -1055,17 +1248,19 @@ proc genProcAux(m: BModule, prc: PSym) = for i in 1..<prc.typ.n.len: let param = prc.typ.n[i].sym if param.typ.isCompileTimeOnly: continue - assignParam(p, param, prc.typ[0]) + assignParam(p, param, prc.typ.returnType) closureSetup(p, prc) genProcBody(p, procBody) - var generatedProc: Rope + prc.info = tmpInfo + + var generatedProc: Rope = "" generatedProc.genCLineDir prc.info, m.config if isNoReturn(p.module, prc): - if hasDeclspec in extccomp.CC[p.config.cCompiler].props: + if hasDeclspec in extccomp.CC[p.config.cCompiler].props and not isCppMember: header = "__declspec(noreturn) " & header if sfPure in prc.flags: - if hasDeclspec in extccomp.CC[p.config.cCompiler].props: + if hasDeclspec in extccomp.CC[p.config.cCompiler].props and not isCppMember: header = "__declspec(naked) " & header generatedProc.add ropecg(p.module, "$1 {$n$2$3$4}$N$N", [header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)]) @@ -1090,14 +1285,14 @@ proc genProcAux(m: BModule, prc: PSym) = if beforeRetNeeded in p.flags: generatedProc.add("{") generatedProc.add(p.s(cpsInit)) generatedProc.add(p.s(cpsStmts)) - if beforeRetNeeded in p.flags: generatedProc.add(~"\t}BeforeRet_: ;$n") + if beforeRetNeeded in p.flags: generatedProc.add("\t}BeforeRet_: ;\n") if optStackTrace in prc.options: generatedProc.add(deinitFrame(p)) generatedProc.add(returnStmt) - generatedProc.add(~"}$N") + generatedProc.add("}\n") m.s[cfsProcs].add(generatedProc) if isReloadable(m, prc): m.s[cfsDynLibInit].addf("\t$1 = ($3) hcrRegisterProc($4, \"$1\", (void*)$2);$n", - [prc.loc.r, prc.loc.r & "_actual", getProcTypeCast(m, prc), getModuleDllPath(m, prc)]) + [prc.loc.snippet, prc.loc.snippet & "_actual", getProcTypeCast(m, prc), getModuleDllPath(m, prc)]) proc requiresExternC(m: BModule; sym: PSym): bool {.inline.} = result = (sfCompileToCpp in m.module.flags and @@ -1110,7 +1305,7 @@ proc requiresExternC(m: BModule; sym: PSym): bool {.inline.} = proc genProcPrototype(m: BModule, sym: PSym) = useHeader(m, sym) - if lfNoDecl in sym.loc.flags: return + if lfNoDecl in sym.loc.flags or sfCppMember * sym.flags != {}: return if lfDynamicLib in sym.loc.flags: if sym.itemId.module != m.module.position and not containsOrIncl(m.declaredThings, sym.id): @@ -1122,7 +1317,8 @@ proc genProcPrototype(m: BModule, sym: PSym) = [mangleDynLibProc(sym), getTypeDesc(m, sym.loc.t), getModuleDllPath(m, sym)]) elif not containsOrIncl(m.declaredProtos, sym.id): let asPtr = isReloadable(m, sym) - var header = genProcHeader(m, sym, asPtr) + var header = newRopeAppender() + genProcHeader(m, sym, header, asPtr) if not asPtr: if isNoReturn(m, sym) and hasDeclspec in extccomp.CC[m.config.cCompiler].props: header = "__declspec(noreturn) " & header @@ -1140,11 +1336,25 @@ proc genProcNoForward(m: BModule, prc: PSym) = fillProcLoc(m, prc.ast[namePos]) useHeader(m, prc) # dependency to a compilerproc: - discard cgsym(m, prc.name.s) + cgsym(m, prc.name.s) return if lfNoDecl in prc.loc.flags: fillProcLoc(m, prc.ast[namePos]) genProcPrototype(m, prc) + elif lfDynamicLib in prc.loc.flags: + var q = findPendingModule(m, prc) + fillProcLoc(q, prc.ast[namePos]) + genProcPrototype(m, prc) + if q != nil and not containsOrIncl(q.declaredThings, prc.id): + symInDynamicLib(q, prc) + # register the procedure even though it is in a different dynamic library and will not be + # reloadable (and has no _actual suffix) - other modules will need to be able to get it through + # the hcr dynlib (also put it in the DynLibInit section - right after it gets loaded) + if isReloadable(q, prc): + q.s[cfsDynLibInit].addf("\t$1 = ($2) hcrRegisterProc($3, \"$1\", (void*)$1);$n", + [prc.loc.snippet, getTypeDesc(q, prc.loc.t), getModuleDllPath(m, q.module)]) + else: + symInDynamicLibPartial(m, prc) elif prc.typ.callConv == ccInline: # We add inline procs to the calling module to enable C based inlining. # This also means that a check with ``q.declaredThings`` is wrong, we need @@ -1159,24 +1369,10 @@ proc genProcNoForward(m: BModule, prc: PSym) = #elif {sfExportc, sfImportc} * prc.flags == {}: # # reset name to restore consistency in case of hashing collisions: # echo "resetting ", prc.id, " by ", m.module.name.s - # prc.loc.r = nil - # prc.loc.r = mangleName(m, prc) + # prc.loc.snippet = nil + # prc.loc.snippet = mangleName(m, prc) genProcPrototype(m, prc) genProcAux(m, prc) - elif lfDynamicLib in prc.loc.flags: - var q = findPendingModule(m, prc) - fillProcLoc(q, prc.ast[namePos]) - genProcPrototype(m, prc) - if q != nil and not containsOrIncl(q.declaredThings, prc.id): - symInDynamicLib(q, prc) - # register the procedure even though it is in a different dynamic library and will not be - # reloadable (and has no _actual suffix) - other modules will need to be able to get it through - # the hcr dynlib (also put it in the DynLibInit section - right after it gets loaded) - if isReloadable(q, prc): - q.s[cfsDynLibInit].addf("\t$1 = ($2) hcrRegisterProc($3, \"$1\", (void*)$1);$n", - [prc.loc.r, getTypeDesc(q, prc.loc.t), getModuleDllPath(m, q.module)]) - else: - symInDynamicLibPartial(m, prc) elif sfImportc notin prc.flags: var q = findPendingModule(m, prc) fillProcLoc(q, prc.ast[namePos]) @@ -1186,7 +1382,7 @@ proc genProcNoForward(m: BModule, prc: PSym) = if isReloadable(m, prc) and prc.id notin m.declaredProtos and q != nil and q.module.id != m.module.id: m.s[cfsDynLibInit].addf("\t$1 = ($2) hcrGetProc($3, \"$1\");$n", - [prc.loc.r, getProcTypeCast(m, prc), getModuleDllPath(m, prc)]) + [prc.loc.snippet, getProcTypeCast(m, prc), getModuleDllPath(m, prc)]) genProcPrototype(m, prc) if q != nil and not containsOrIncl(q.declaredThings, prc.id): # make sure there is a "prototype" in the external module @@ -1231,31 +1427,32 @@ proc genVarPrototype(m: BModule, n: PNode) = #assert(sfGlobal in sym.flags) let sym = n.sym useHeader(m, sym) - fillLoc(sym.loc, locGlobalVar, n, mangleName(m, sym), OnHeap) + fillBackendName(m, sym) + fillLoc(sym.loc, locGlobalVar, n, OnHeap) if treatGlobalDifferentlyForHCR(m, sym): incl(sym.loc.flags, lfIndirect) if (lfNoDecl in sym.loc.flags) or contains(m.declaredThings, sym.id): return if sym.owner.id != m.module.id: # else we already have the symbol generated! - assert(sym.loc.r != nil) + assert(sym.loc.snippet != "") + incl(m.declaredThings, sym.id) if sfThread in sym.flags: declareThreadVar(m, sym, true) else: - incl(m.declaredThings, sym.id) if sym.kind in {skLet, skVar, skField, skForVar} and sym.alignment > 0: m.s[cfsVars].addf "NIM_ALIGN($1) ", [rope(sym.alignment)] m.s[cfsVars].add(if m.hcrOn: "static " else: "extern ") - m.s[cfsVars].add(getTypeDesc(m, sym.loc.t, skVar)) + m.s[cfsVars].add(getTypeDesc(m, sym.loc.t, dkVar)) if m.hcrOn: m.s[cfsVars].add("*") if lfDynamicLib in sym.loc.flags: m.s[cfsVars].add("*") if sfRegister in sym.flags: m.s[cfsVars].add(" register") if sfVolatile in sym.flags: m.s[cfsVars].add(" volatile") if sfNoalias in sym.flags: m.s[cfsVars].add(" NIM_NOALIAS") - m.s[cfsVars].addf(" $1;$n", [sym.loc.r]) + m.s[cfsVars].addf(" $1;$n", [sym.loc.snippet]) if m.hcrOn: m.initProc.procSec(cpsLocals).addf( - "\t$1 = ($2*)hcrGetGlobal($3, \"$1\");$n", [sym.loc.r, - getTypeDesc(m, sym.loc.t, skVar), getModuleDllPath(m, sym)]) + "\t$1 = ($2*)hcrGetGlobal($3, \"$1\");$n", [sym.loc.snippet, + getTypeDesc(m, sym.loc.t, dkVar), getModuleDllPath(m, sym)]) proc addNimDefines(result: var Rope; conf: ConfigRef) {.inline.} = result.addf("#define NIM_INTBITS $1\L", [ @@ -1285,23 +1482,27 @@ proc getFileHeader(conf: ConfigRef; cfile: Cfile): Rope = if conf.hcrOn: result.add("#define NIM_HOT_CODE_RELOADING\L") addNimDefines(result, conf) -proc getSomeNameForModule(m: PSym): Rope = - assert m.kind == skModule - assert m.owner.kind == skPackage - if {sfSystemModule, sfMainModule} * m.flags == {}: - result = m.owner.name.s.mangle.rope - result.add "_" - result.add m.name.s.mangle +proc getSomeNameForModule(conf: ConfigRef, filename: AbsoluteFile): Rope = + ## Returns a mangled module name. + result = mangleModuleName(conf, filename).mangle + +proc getSomeNameForModule(m: BModule): Rope = + ## Returns a mangled module name. + assert m.module.kind == skModule + assert m.module.owner.kind == skPackage + result = mangleModuleName(m.g.config, m.filename).mangle proc getSomeInitName(m: BModule, suffix: string): Rope = if not m.hcrOn: - result = getSomeNameForModule(m.module) + result = getSomeNameForModule(m) + else: + result = "" result.add suffix proc getInitName(m: BModule): Rope = if sfMainModule in m.module.flags: # generate constant name for main module, for "easy" debugging. - result = rope"NimMainModule" + result = rope(m.config.nimMainPrefix) & rope"NimMainModule" else: result = getSomeInitName(m, "Init000") @@ -1314,67 +1515,84 @@ proc genMainProc(m: BModule) = ## this function is called in cgenWriteModules after all modules are closed, ## it means raising dependency on the symbols is too late as it will not propagate ## into other modules, only simple rope manipulations are allowed - - var preMainCode: Rope + var preMainCode: Rope = "" if m.hcrOn: proc loadLib(handle: string, name: string): Rope = + result = "" let prc = magicsys.getCompilerProc(m.g.graph, name) assert prc != nil let n = newStrNode(nkStrLit, prc.annex.path.strVal) n.info = prc.annex.path.info + var strLit = newRopeAppender() + genStringLiteral(m, n, strLit) appcg(m, result, "\tif (!($1 = #nimLoadLibrary($2)))$N" & "\t\t#nimLoadLibraryError($2);$N", - [handle, genStringLiteral(m, n)]) + [handle, strLit]) preMainCode.add(loadLib("hcr_handle", "hcrGetProc")) - preMainCode.add("\tvoid* rtl_handle;\L") - preMainCode.add(loadLib("rtl_handle", "nimGC_setStackBottom")) - preMainCode.add(hcrGetProcLoadCode(m, "nimGC_setStackBottom", "nimrtl_", "rtl_handle", "nimGetProcAddr")) - preMainCode.add("\tinner = PreMain;\L") - preMainCode.add("\tinitStackBottomWith_actual((void *)&inner);\L") - preMainCode.add("\t(*inner)();\L") + if m.config.selectedGC in {gcArc, gcAtomicArc, gcOrc}: + preMainCode.add("\t$1PreMain();\L" % [rope m.config.nimMainPrefix]) + else: + preMainCode.add("\tvoid* rtl_handle;\L") + preMainCode.add(loadLib("rtl_handle", "nimGC_setStackBottom")) + preMainCode.add(hcrGetProcLoadCode(m, "nimGC_setStackBottom", "nimrtl_", "rtl_handle", "nimGetProcAddr")) + preMainCode.add("\tinner = $1PreMain;\L" % [rope m.config.nimMainPrefix]) + preMainCode.add("\tinitStackBottomWith_actual((void *)&inner);\L") + preMainCode.add("\t(*inner)();\L") else: - preMainCode.add("\tPreMain();\L") + preMainCode.add("\t$1PreMain();\L" % [rope m.config.nimMainPrefix]) - const - # not a big deal if we always compile these 3 global vars... makes the HCR code easier - PosixCmdLine = - "N_LIB_PRIVATE int cmdCount;$N" & - "N_LIB_PRIVATE char** cmdLine;$N" & - "N_LIB_PRIVATE char** gEnv;$N" + var posixCmdLine: Rope = "" + if optNoMain notin m.config.globalOptions: + posixCmdLine.add "N_LIB_PRIVATE int cmdCount;\L" + posixCmdLine.add "N_LIB_PRIVATE char** cmdLine;\L" + posixCmdLine.add "N_LIB_PRIVATE char** gEnv;\L" + const # The use of a volatile function pointer to call Pre/NimMainInner # prevents inlining of the NimMainInner function and dependent # functions, which might otherwise merge their stack frames. + PreMainBody = "$N" & - "N_LIB_PRIVATE void PreMainInner(void) {$N" & + "N_LIB_PRIVATE void $3PreMainInner(void) {$N" & "$2" & "}$N$N" & - PosixCmdLine & - "N_LIB_PRIVATE void PreMain(void) {$N" & + "$4" & + "N_LIB_PRIVATE void $3PreMain(void) {$N" & + "##if $5$N" & # 1 for volatile call, 0 for non-volatile "\tvoid (*volatile inner)(void);$N" & - "\tinner = PreMainInner;$N" & + "\tinner = $3PreMainInner;$N" & "$1" & "\t(*inner)();$N" & + "##else$N" & + "$1" & + "\t$3PreMainInner();$N" & + "##endif$N" & "}$N$N" MainProcs = - "\tNimMain();$N" + "\t$^NimMain();$N" MainProcsWithResult = MainProcs & ("\treturn $1nim_program_result;$N") - NimMainInner = "N_LIB_PRIVATE N_CDECL(void, NimMainInner)(void) {$N" & + NimMainInner = "N_LIB_PRIVATE N_CDECL(void, $5NimMainInner)(void) {$N" & "$1" & "}$N$N" NimMainProc = - "N_CDECL(void, NimMain)(void) {$N" & - "\tvoid (*volatile inner)(void);$N" & - "$4" & - "\tinner = NimMainInner;$N" & - "$2" & - "\t(*inner)();$N" & + "N_CDECL(void, $5NimMain)(void) {$N" & + "##if $6$N" & # 1 for volatile call, 0 for non-volatile + "\tvoid (*volatile inner)(void);$N" & + "$4" & + "\tinner = $5NimMainInner;$N" & + "$2" & + "\t(*inner)();$N" & + "##else$N" & + "$4" & + "$2" & + "\t$5NimMainInner();$N" & + "##endif$N" & "}$N$N" NimMainBody = NimMainInner & NimMainProc @@ -1405,7 +1623,7 @@ proc genMainProc(m: BModule) = WinCDllMain = "BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fwdreason, $N" & " LPVOID lpvReserved) {$N" & - "\tif(fwdreason == DLL_PROCESS_ATTACH) {$N" & MainProcs & "}$N" & + "\tif (fwdreason == DLL_PROCESS_ATTACH) {$N" & MainProcs & "\t}$N" & "\treturn 1;$N}$N$N" PosixNimDllMain = WinNimDllMain @@ -1417,7 +1635,7 @@ proc genMainProc(m: BModule) = GenodeNimMain = "extern Genode::Env *nim_runtime_env;$N" & - "extern void nim_component_construct(Genode::Env*);$N$N" & + "extern \"C\" void nim_component_construct(Genode::Env*);$N$N" & NimMainBody ComponentConstruct = @@ -1439,67 +1657,91 @@ proc genMainProc(m: BModule) = m.includeHeader("<libc/component.h>") let initStackBottomCall = - if m.config.target.targetOS == osStandalone or m.config.selectedGC == gcNone: "".rope + if m.config.target.targetOS == osStandalone or m.config.selectedGC in {gcNone, gcArc, gcAtomicArc, gcOrc}: "".rope else: ropecg(m, "\t#initStackBottomWith((void *)&inner);$N", []) inc(m.labels) - appcg(m, m.s[cfsProcs], PreMainBody, [m.g.mainDatInit, m.g.otherModsInit]) + + let isVolatile = if m.config.selectedGC notin {gcNone, gcArc, gcAtomicArc, gcOrc}: "1" else: "0" + appcg(m, m.s[cfsProcs], PreMainBody, [m.g.mainDatInit, m.g.otherModsInit, m.config.nimMainPrefix, posixCmdLine, isVolatile]) if m.config.target.targetOS == osWindows and m.config.globalOptions * {optGenGuiApp, optGenDynLib} != {}: if optGenGuiApp in m.config.globalOptions: const nimMain = WinNimMain appcg(m, m.s[cfsProcs], nimMain, - [m.g.mainModInit, initStackBottomCall, m.labels, preMainCode]) + [m.g.mainModInit, initStackBottomCall, m.labels, preMainCode, m.config.nimMainPrefix, isVolatile]) else: const nimMain = WinNimDllMain appcg(m, m.s[cfsProcs], nimMain, - [m.g.mainModInit, initStackBottomCall, m.labels, preMainCode]) + [m.g.mainModInit, initStackBottomCall, m.labels, preMainCode, m.config.nimMainPrefix, isVolatile]) elif m.config.target.targetOS == osGenode: const nimMain = GenodeNimMain appcg(m, m.s[cfsProcs], nimMain, - [m.g.mainModInit, initStackBottomCall, m.labels, preMainCode]) + [m.g.mainModInit, initStackBottomCall, m.labels, preMainCode, m.config.nimMainPrefix, isVolatile]) elif optGenDynLib in m.config.globalOptions: const nimMain = PosixNimDllMain appcg(m, m.s[cfsProcs], nimMain, - [m.g.mainModInit, initStackBottomCall, m.labels, preMainCode]) - elif m.config.target.targetOS == osStandalone: - const nimMain = NimMainBody - appcg(m, m.s[cfsProcs], nimMain, - [m.g.mainModInit, initStackBottomCall, m.labels, preMainCode]) + [m.g.mainModInit, initStackBottomCall, m.labels, preMainCode, m.config.nimMainPrefix, isVolatile]) else: const nimMain = NimMainBody appcg(m, m.s[cfsProcs], nimMain, - [m.g.mainModInit, initStackBottomCall, m.labels, preMainCode]) - + [m.g.mainModInit, initStackBottomCall, m.labels, preMainCode, m.config.nimMainPrefix, isVolatile]) if optNoMain notin m.config.globalOptions: if m.config.cppCustomNamespace.len > 0: - m.s[cfsProcs].add closeNamespaceNim() & "using namespace " & m.config.cppCustomNamespace & ";\L" + closeNamespaceNim(m.s[cfsProcs]) + m.s[cfsProcs].add "using namespace " & m.config.cppCustomNamespace & ";\L" if m.config.target.targetOS == osWindows and m.config.globalOptions * {optGenGuiApp, optGenDynLib} != {}: if optGenGuiApp in m.config.globalOptions: const otherMain = WinCMain - appcg(m, m.s[cfsProcs], otherMain, [if m.hcrOn: "*" else: ""]) + appcg(m, m.s[cfsProcs], otherMain, [if m.hcrOn: "*" else: "", m.config.nimMainPrefix]) else: const otherMain = WinCDllMain - appcg(m, m.s[cfsProcs], otherMain, []) + appcg(m, m.s[cfsProcs], otherMain, [m.config.nimMainPrefix]) elif m.config.target.targetOS == osGenode: const otherMain = ComponentConstruct - appcg(m, m.s[cfsProcs], otherMain, []) + appcg(m, m.s[cfsProcs], otherMain, [m.config.nimMainPrefix]) elif optGenDynLib in m.config.globalOptions: const otherMain = PosixCDllMain - appcg(m, m.s[cfsProcs], otherMain, []) + appcg(m, m.s[cfsProcs], otherMain, [m.config.nimMainPrefix]) elif m.config.target.targetOS == osStandalone: const otherMain = StandaloneCMain - appcg(m, m.s[cfsProcs], otherMain, []) + appcg(m, m.s[cfsProcs], otherMain, [m.config.nimMainPrefix]) else: const otherMain = PosixCMain - appcg(m, m.s[cfsProcs], otherMain, [if m.hcrOn: "*" else: ""]) - + appcg(m, m.s[cfsProcs], otherMain, [if m.hcrOn: "*" else: "", m.config.nimMainPrefix]) if m.config.cppCustomNamespace.len > 0: - m.s[cfsProcs].add openNamespaceNim(m.config.cppCustomNamespace) + openNamespaceNim(m.config.cppCustomNamespace, m.s[cfsProcs]) + +proc registerInitProcs*(g: BModuleList; m: PSym; flags: set[ModuleBackendFlag]) = + ## Called from the IC backend. + if HasDatInitProc in flags: + let datInit = getSomeNameForModule(g.config, g.config.toFullPath(m.info.fileIndex).AbsoluteFile) & "DatInit000" + g.mainModProcs.addf("N_LIB_PRIVATE N_NIMCALL(void, $1)(void);$N", [datInit]) + g.mainDatInit.addf("\t$1();$N", [datInit]) + if HasModuleInitProc in flags: + let init = getSomeNameForModule(g.config, g.config.toFullPath(m.info.fileIndex).AbsoluteFile) & "Init000" + g.mainModProcs.addf("N_LIB_PRIVATE N_NIMCALL(void, $1)(void);$N", [init]) + let initCall = "\t$1();$N" % [init] + if sfMainModule in m.flags: + g.mainModInit.add(initCall) + elif sfSystemModule in m.flags: + g.mainDatInit.add(initCall) # systemInit must called right after systemDatInit if any + else: + g.otherModsInit.add(initCall) + +proc whichInitProcs*(m: BModule): set[ModuleBackendFlag] = + # called from IC. + result = {} + if m.hcrOn or m.preInitProc.s(cpsInit).len > 0 or m.preInitProc.s(cpsStmts).len > 0: + result.incl HasModuleInitProc + for i in cfsTypeInit1..cfsDynLibInit: + if m.s[i].len != 0: + result.incl HasDatInitProc + break proc registerModuleToMain(g: BModuleList; m: BModule) = let @@ -1518,7 +1760,7 @@ proc registerModuleToMain(g: BModuleList; m: BModule) = hcrModuleMeta.addf("\t\"\"};$n", []) hcrModuleMeta.addf("$nN_LIB_EXPORT N_NIMCALL(void**, HcrGetImportedModules)() { return (void**)hcr_module_list; }$n", []) hcrModuleMeta.addf("$nN_LIB_EXPORT N_NIMCALL(char*, HcrGetSigHash)() { return \"$1\"; }$n$n", - [($sigHash(m.module)).rope]) + [($sigHash(m.module, m.config)).rope]) if sfMainModule in m.module.flags: g.mainModProcs.add(hcrModuleMeta) g.mainModProcs.addf("static void* hcr_handle;$N", []) @@ -1559,7 +1801,7 @@ proc registerModuleToMain(g: BModuleList; m: BModule) = if sfSystemModule in m.module.flags: if emulatedThreadVars(m.config) and m.config.target.targetOS != osStandalone: g.mainDatInit.add(ropecg(m, "\t#initThreadVarsEmulation();$N", [])) - if m.config.target.targetOS != osStandalone and m.config.selectedGC notin {gcNone, gcArc, gcOrc}: + if m.config.target.targetOS != osStandalone and m.config.selectedGC notin {gcNone, gcArc, gcAtomicArc, gcOrc}: g.mainDatInit.add(ropecg(m, "\t#initStackBottomWith((void *)&inner);$N", [])) if m.s[cfsInitProc].len > 0: @@ -1584,7 +1826,7 @@ proc genDatInitCode(m: BModule) = # we don't want to break into such init code - could happen if a line # directive from a function written by the user spills after itself - genCLineDir(prc, "generated_not_to_break_here", 999999, m.config) + genCLineDir(prc, InvalidFileIdx, 999999, m.config) for i in cfsTypeInit1..cfsDynLibInit: if m.s[i].len != 0: @@ -1595,6 +1837,7 @@ proc genDatInitCode(m: BModule) = if moduleDatInitRequired: m.s[cfsDatInitProc].add(prc) + #rememberFlag(m.g.graph, m.module, HasDatInitProc) # Very similar to the contents of symInDynamicLib - basically only the # things needed for the hot code reloading runtime procs to be loaded @@ -1605,14 +1848,14 @@ proc hcrGetProcLoadCode(m: BModule, sym, prefix, handle, getProcFunc: string): R var extname = prefix & sym var tmp = mangleDynLibProc(prc) - prc.loc.r = tmp + prc.loc.snippet = tmp prc.typ.sym = nil if not containsOrIncl(m.declaredThings, prc.id): - m.s[cfsVars].addf("static $2 $1;$n", [prc.loc.r, getTypeDesc(m, prc.loc.t, skVar)]) + m.s[cfsVars].addf("static $2 $1;$n", [prc.loc.snippet, getTypeDesc(m, prc.loc.t, dkVar)]) result = "\t$1 = ($2) $3($4, $5);$n" % - [tmp, getTypeDesc(m, prc.typ, skVar), getProcFunc.rope, handle.rope, makeCString(prefix & sym)] + [tmp, getTypeDesc(m, prc.typ, dkVar), getProcFunc.rope, handle.rope, makeCString(prefix & sym)] proc genInitCode(m: BModule) = ## this function is called in cgenWriteModules after all modules are closed, @@ -1624,7 +1867,7 @@ proc genInitCode(m: BModule) = [rope(if m.hcrOn: "N_LIB_EXPORT" else: "N_LIB_PRIVATE"), initname] # we don't want to break into such init code - could happen if a line # directive from a function written by the user spills after itself - genCLineDir(prc, "generated_not_to_break_here", 999999, m.config) + genCLineDir(prc, InvalidFileIdx, 999999, m.config) if m.typeNodes > 0: if m.hcrOn: appcg(m, m.s[cfsTypeInit1], "\t#TNimNode* $1;$N", [m.typeNodesName]) @@ -1654,7 +1897,7 @@ proc genInitCode(m: BModule) = # Give this small function its own scope prc.addf("{$N", []) # Keep a bogus frame in case the code needs one - prc.add(~"\tTFrame FR_; FR_.len = 0;$N") + prc.add("\tTFrame FR_; FR_.len = 0;\n") writeSection(preInitProc, cpsLocals) writeSection(preInitProc, cpsInit, m.hcrOn) @@ -1680,15 +1923,15 @@ proc genInitCode(m: BModule) = var procname = makeCString(m.module.name.s) prc.add(initFrame(m.initProc, procname, quotedFilename(m.config, m.module.info))) else: - prc.add(~"\tTFrame FR_; FR_.len = 0;$N") + prc.add("\tTFrame FR_; FR_.len = 0;\n") writeSection(initProc, cpsInit, m.hcrOn) writeSection(initProc, cpsStmts) if beforeRetNeeded in m.initProc.flags: - prc.add(~"\tBeforeRet_: ;$n") + prc.add("\tBeforeRet_: ;\n") - if sfMainModule in m.module.flags and m.config.exc == excGoto: + if m.config.exc == excGoto: if getCompilerProc(m.g.graph, "nimTestErrorFlag") != nil: m.appcg(prc, "\t#nimTestErrorFlag();$n", []) @@ -1717,7 +1960,7 @@ proc genInitCode(m: BModule) = m.s[cfsInitProc].addf("}$N$N", []) for i, el in pairs(m.extensionLoaders): - if el != nil: + if el != "": let ex = "NIM_EXTERNC N_NIMCALL(void, nimLoadProcs$1)(void) {$2}$N$N" % [(i.ord - '0'.ord).rope, el] moduleInitRequired = true @@ -1725,6 +1968,7 @@ proc genInitCode(m: BModule) = if moduleInitRequired or sfMainModule in m.module.flags: m.s[cfsInitProc].add(prc) + #rememberFlag(m.g.graph, m.module, HasModuleInitProc) genDatInitCode(m) @@ -1735,6 +1979,40 @@ proc genInitCode(m: BModule) = registerModuleToMain(m.g, m) +proc postprocessCode(conf: ConfigRef, r: var Rope) = + # find the first directive + var f = r.find(postprocessDirStart) + if f == -1: + return + + var + nimlnDirLastF = "" + + var res: Rope = r.substr(0, f - 1) + while f != -1: + var + e = r.find(postprocessDirEnd, f + 1) + dir = r.substr(f + 1, e - 1).split(postprocessDirSep) + case dir[0] + of "nimln": + if dir[2] == nimlnDirLastF: + res.add("nimln_(" & dir[1] & ");") + else: + res.add("nimlf_(" & dir[1] & ", " & quotedFilename(conf, dir[2].parseInt.FileIndex) & ");") + nimlnDirLastF = dir[2] + else: + raiseAssert "unexpected postprocess directive" + + # find the next directive + f = r.find(postprocessDirStart, e + 1) + # copy the code until the next directive + if f != -1: + res.add(r.substr(e + 1, f - 1)) + else: + res.add(r.substr(e + 1)) + + r = res + proc genModule(m: BModule, cfile: Cfile): Rope = var moduleIsEmpty = true @@ -1744,11 +2022,9 @@ proc genModule(m: BModule, cfile: Cfile): Rope = generateHeaders(m) result.add(m.s[cfsHeaders]) if m.config.cppCustomNamespace.len > 0: - result.add openNamespaceNim(m.config.cppCustomNamespace) + openNamespaceNim(m.config.cppCustomNamespace, result) if m.s[cfsFrameDefines].len > 0: result.add(m.s[cfsFrameDefines]) - else: - result.add("#define nimfr_(x, y)\n#define nimln_(x, y)\n") for i in cfsForwardTypes..cfsProcs: if m.s[i].len > 0: @@ -1763,10 +2039,18 @@ proc genModule(m: BModule, cfile: Cfile): Rope = result.add(m.s[cfsDatInitProc]) if m.config.cppCustomNamespace.len > 0: - result.add closeNamespaceNim() + closeNamespaceNim(result) + + if optLineDir in m.config.options: + var srcFileDefs = "" + for fi in 0..m.config.m.fileInfos.high: + srcFileDefs.add("#define FX_" & $fi & " " & makeSingleLineCString(toFullPath(m.config, fi.FileIndex)) & "\n") + result = srcFileDefs & result if moduleIsEmpty: - result = nil + result = "" + + postprocessCode(m.config, result) proc initProcOptions(m: BModule): TOptions = let opts = m.config.options @@ -1787,11 +2071,12 @@ proc rawNewModule(g: BModuleList; module: PSym, filename: AbsoluteFile): BModule result.typeInfoMarker = initTable[SigHash, Rope]() result.sigConflicts = initCountTable[SigHash]() result.initProc = newProc(nil, result) + for i in low(result.s)..high(result.s): result.s[i] = newRopeAppender() result.initProc.options = initProcOptions(result) result.preInitProc = newProc(nil, result) result.preInitProc.flags.incl nimErrorFlagDisabled result.preInitProc.labels = 100_000 # little hack so that unique temporaries are generated - initNodeTable(result.dataCache) + result.dataCache = initNodeTable() result.typeStack = @[] result.typeNodesName = getTempName(result) result.nimTypesName = getTempName(result) @@ -1820,10 +2105,7 @@ template injectG() {.dirty.} = graph.backend = newModuleList(graph) let g = BModuleList(graph.backend) -when not defined(nimHasSinkInference): - {.pragma: nosinks.} - -proc myOpen(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext {.nosinks.} = +proc setupCgen*(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = injectG() result = newModule(g, module, graph.config) result.idgen = idgen @@ -1844,13 +2126,14 @@ proc writeHeader(m: BModule) = generateThreadLocalStorage(m) for i in cfsHeaders..cfsProcs: result.add(m.s[i]) - if m.config.cppCustomNamespace.len > 0 and i == cfsHeaders: result.add openNamespaceNim(m.config.cppCustomNamespace) + if m.config.cppCustomNamespace.len > 0 and i == cfsHeaders: + openNamespaceNim(m.config.cppCustomNamespace, result) result.add(m.s[cfsInitProc]) if optGenDynLib in m.config.globalOptions: result.add("N_LIB_IMPORT ") - result.addf("N_CDECL(void, NimMain)(void);$n", []) - if m.config.cppCustomNamespace.len > 0: result.add closeNamespaceNim() + result.addf("N_CDECL(void, $1NimMain)(void);$n", [rope m.config.nimMainPrefix]) + if m.config.cppCustomNamespace.len > 0: closeNamespaceNim(result) result.addf("#endif /* $1 */$n", [guard]) if not writeRope(result, m.filename): rawMessage(m.config, errCannotOpenFile, m.filename.string) @@ -1860,7 +2143,7 @@ proc getCFile(m: BModule): AbsoluteFile = if m.compileToCpp: ".nim.cpp" elif m.config.backend == backendObjc or sfCompileToObjc in m.module.flags: ".nim.m" else: ".nim.c" - result = changeFileExt(completeCfilePath(m.config, withPackageName(m.config, m.cfilename)), ext) + result = changeFileExt(completeCfilePath(m.config, mangleModuleName(m.config, m.cfilename).AbsoluteFile), ext) when false: proc myOpenCached(graph: ModuleGraph; module: PSym, rd: PRodReader): PPassContext = @@ -1890,7 +2173,7 @@ proc addHcrInitGuards(p: BProc, n: PNode, inInitGuard: var bool) = proc genTopLevelStmt*(m: BModule; n: PNode) = ## Also called from `ic/cbackend.nim`. - if passes.skipCodegen(m.config, n): return + if pipelineutils.skipCodegen(m.config, n): return m.initProc.options = initProcOptions(m) #softRnl = if optLineDir in m.config.options: noRnl else: rnl # XXX replicate this logic! @@ -1903,12 +2186,6 @@ proc genTopLevelStmt*(m: BModule; n: PNode) = else: genProcBody(m.initProc, transformedN) -proc myProcess(b: PPassContext, n: PNode): PNode = - result = n - if b != nil: - var m = BModule(b) - genTopLevelStmt(m, n) - proc shouldRecompile(m: BModule; code: Rope, cfile: Cfile): bool = if optForceFullMake notin m.config.globalOptions: if not moduleHasChanged(m.g.graph, m.module): @@ -1954,7 +2231,7 @@ proc writeModule(m: BModule, pending: bool) = var cf = Cfile(nimname: m.module.name.s, cname: cfile, obj: completeCfilePath(m.config, toObjFile(m.config, cfile)), flags: {}) var code = genModule(m, cf) - if code != nil or m.config.symbolFiles != disabledSf: + if code != "" or m.config.symbolFiles != disabledSf: when hasTinyCBackend: if m.config.cmd == cmdTcc: tccgen.compileCCode($code, m.config) @@ -1974,18 +2251,41 @@ proc updateCachedModule(m: BModule) = cf.flags = {CfileFlag.Cached} addFileToCompile(m.config, cf) +proc generateLibraryDestroyGlobals(graph: ModuleGraph; m: BModule; body: PNode; isDynlib: bool): PSym = + let procname = getIdent(graph.cache, "NimDestroyGlobals") + result = newSym(skProc, procname, m.idgen, m.module.owner, m.module.info) + result.typ = newProcType(m.module.info, m.idgen, m.module.owner) + result.typ.callConv = ccCDecl + incl result.flags, sfExportc + result.loc.snippet = "NimDestroyGlobals" + if isDynlib: + incl(result.loc.flags, lfExportLib) + + let theProc = newNodeI(nkProcDef, m.module.info, bodyPos+1) + for i in 0..<theProc.len: theProc[i] = newNodeI(nkEmpty, m.module.info) + theProc[namePos] = newSymNode(result) + theProc[bodyPos] = body + result.ast = theProc + proc finalCodegenActions*(graph: ModuleGraph; m: BModule; n: PNode) = ## Also called from IC. if sfMainModule in m.module.flags: # phase ordering problem here: We need to announce this # dependency to 'nimTestErrorFlag' before system.c has been written to disk. if m.config.exc == excGoto and getCompilerProc(graph, "nimTestErrorFlag") != nil: - discard cgsym(m, "nimTestErrorFlag") + cgsym(m, "nimTestErrorFlag") if {optGenStaticLib, optGenDynLib, optNoMain} * m.config.globalOptions == {}: for i in countdown(high(graph.globalDestructors), 0): n.add graph.globalDestructors[i] - if passes.skipCodegen(m.config, n): return + else: + var body = newNodeI(nkStmtList, m.module.info) + for i in countdown(high(graph.globalDestructors), 0): + body.add graph.globalDestructors[i] + body.flags.incl nfTransf # should not be further transformed + let dtor = generateLibraryDestroyGlobals(graph, m, body, optGenDynLib in m.config.globalOptions) + genProcAux(m, dtor) + if pipelineutils.skipCodegen(m.config, n): return if moduleHasChanged(graph, m.module): # if the module is cached, we don't regenerate the main proc # nor the dispatchers? But if the dispatchers changed? @@ -1996,7 +2296,10 @@ proc finalCodegenActions*(graph: ModuleGraph; m: BModule; n: PNode) = if m.hcrOn: # make sure this is pulled in (meaning hcrGetGlobal() is called for it during init) - discard cgsym(m, "programResult") + let sym = magicsys.getCompilerProc(m.g.graph, "programResult") + # ignore when not available, could be a module imported early in `system` + if sym != nil: + cgsymImpl m, sym if m.inHcrInitGuard: endBlock(m.initProc) @@ -2006,32 +2309,29 @@ proc finalCodegenActions*(graph: ModuleGraph; m: BModule; n: PNode) = # so it can load the HCR runtime and later pass the library handle to the HCR runtime which # will in turn pass it to the other modules it initializes so they can initialize the # register/get procs so they don't have to have the definitions of these functions as well - discard cgsym(m, "nimLoadLibrary") - discard cgsym(m, "nimLoadLibraryError") - discard cgsym(m, "nimGetProcAddr") - discard cgsym(m, "procAddrError") - discard cgsym(m, "rawWrite") + cgsym(m, "nimLoadLibrary") + cgsym(m, "nimLoadLibraryError") + cgsym(m, "nimGetProcAddr") + cgsym(m, "procAddrError") + cgsym(m, "rawWrite") # raise dependencies on behalf of genMainProc - if m.config.target.targetOS != osStandalone and m.config.selectedGC != gcNone: - discard cgsym(m, "initStackBottomWith") + if m.config.target.targetOS != osStandalone and m.config.selectedGC notin {gcNone, gcArc, gcAtomicArc, gcOrc}: + cgsym(m, "initStackBottomWith") if emulatedThreadVars(m.config) and m.config.target.targetOS != osStandalone: - discard cgsym(m, "initThreadVarsEmulation") + cgsym(m, "initThreadVarsEmulation") if m.g.forwardedProcs.len == 0: incl m.flags, objHasKidsValid - let disp = generateMethodDispatchers(graph) - for x in disp: genProcAux(m, x.sym) + if optMultiMethods in m.g.config.globalOptions or + m.g.config.selectedGC notin {gcArc, gcOrc, gcAtomicArc} or + vtables notin m.g.config.features: + generateIfMethodDispatchers(graph, m.idgen) + let mm = m m.g.modulesClosed.add mm - -proc myClose(graph: ModuleGraph; b: PPassContext, n: PNode): PNode = - result = n - if b == nil: return - finalCodegenActions(graph, BModule(b), n) - proc genForwardedProcs(g: BModuleList) = # Forward declared proc:s lack bodies when first encountered, so they're given # a second pass here @@ -2058,5 +2358,3 @@ proc cgenWriteModules*(backend: RootRef, config: ConfigRef) = m.writeModule(pending=true) writeMapping(config, g.mapping) if g.generatedHeader != nil: writeHeader(g.generatedHeader) - -const cgenPass* = makePass(myOpen, myProcess, myClose) diff --git a/compiler/cgendata.nim b/compiler/cgendata.nim index 3678adacf..5368e9dc7 100644 --- a/compiler/cgendata.nim +++ b/compiler/cgendata.nim @@ -10,13 +10,14 @@ ## This module contains the data structures for the C code generation phase. import - ast, ropes, options, intsets, - tables, ndi, lineinfos, pathutils, modulegraphs, sets + ast, ropes, options, + ndi, lineinfos, pathutils, modulegraphs + +import std/[intsets, tables, sets] type TLabel* = Rope # for the C generator a label is just a rope TCFileSection* = enum # the sections a generated C file consists of - cfsMergeInfo, # section containing merge information cfsHeaders, # section for C include file headers cfsFrameDefines # section for nim frame macros cfsForwardTypes, # section for C forward typedefs @@ -24,21 +25,17 @@ type cfsSeqTypes, # section for sequence types only # this is needed for strange type generation # reasons - cfsFieldInfo, # section for field information cfsTypeInfo, # section for type information (ag ABI checks) cfsProcHeaders, # section for C procs prototypes + cfsStrData, # section for constant string literals cfsData, # section for C constant data cfsVars, # section for C variable declarations cfsProcs, # section for C procs that are not inline cfsInitProc, # section for the C init proc cfsDatInitProc, # section for the C datInit proc cfsTypeInit1, # section 1 for declarations of type information - cfsTypeInit2, # section 2 for init of type information cfsTypeInit3, # section 3 for init of type information - cfsDebugInit, # section for init of debug information cfsDynLibInit, # section for init of dynamic library binding - cfsDynLibDeinit # section for deinitialization of dynamic - # libraries TCTypeKind* = enum # describes the type kind of a C type ctVoid, ctChar, ctBool, ctInt, ctInt8, ctInt16, ctInt32, ctInt64, @@ -91,6 +88,7 @@ type options*: TOptions # options that should be used for code # generation; this is the same as prc.options # unless prc == nil + optionsStack*: seq[(TOptions, TNoteKinds)] module*: BModule # used to prevent excessive parameter passing withinLoop*: int # > 0 if we are within a loop splitDecls*: int # > 0 if we are in some context for C++ that @@ -99,6 +97,7 @@ type withinTryWithExcept*: int # required for goto based exception handling withinBlockLeaveActions*: int # complex to explain sigConflicts*: CountTable[string] + inUncheckedAssignSection*: int TTypeSeq* = seq[PType] TypeCache* = Table[SigHash, Rope] @@ -138,6 +137,7 @@ type # unconditionally... # nimtvDeps is VERY hard to cache because it's # not a list of IDs nor can it be made to be one. + mangledPrcs*: HashSet[string] TCGen = object of PPassContext # represents a C source file s*: TCFileSections # sections of the C file @@ -151,7 +151,7 @@ type typeABICache*: HashSet[SigHash] # cache for ABI checks; reusing typeCache # would be ideal but for some reason enums # don't seem to get cached so it'd generate - # 1 ABI check per occurence in code + # 1 ABI check per occurrence in code forwTypeCache*: TypeCache # cache for forward declarations of types declaredThings*: IntSet # things we have declared in this .c file declaredProtos*: IntSet # prototypes we have declared in this .c file @@ -170,13 +170,13 @@ type labels*: Natural # for generating unique module-scope names extensionLoaders*: array['0'..'9', Rope] # special procs for the # OpenGL wrapper - injectStmt*: Rope sigConflicts*: CountTable[SigHash] g*: BModuleList ndi*: NdiFile template config*(m: BModule): ConfigRef = m.g.config template config*(p: BProc): ConfigRef = p.module.g.config +template vccAndC*(p: BProc): bool = p.module.config.cCompiler == ccVcc and p.module.config.backend == backendC proc includeHeader*(this: BModule; header: string) = if not this.headerFiles.contains header: @@ -190,16 +190,23 @@ proc procSec*(p: BProc, s: TCProcSection): var Rope {.inline.} = # top level proc sections result = p.blocks[0].sections[s] +proc initBlock*(): TBlock = + result = TBlock() + for i in low(result.sections)..high(result.sections): + result.sections[i] = newRopeAppender() + proc newProc*(prc: PSym, module: BModule): BProc = - new(result) - result.prc = prc - result.module = module - result.options = if prc != nil: prc.options - else: module.config.options - newSeq(result.blocks, 1) - result.nestedTryStmts = @[] - result.finallySafePoints = @[] - result.sigConflicts = initCountTable[string]() + result = BProc( + prc: prc, + module: module, + optionsStack: if module.initProc != nil: module.initProc.optionsStack + else: @[], + options: if prc != nil: prc.options + else: module.config.options, + blocks: @[initBlock()], + sigConflicts: initCountTable[string]()) + if optQuirky in result.options: + result.flags = {nimErrorFlagDisabled} proc newModuleList*(g: ModuleGraph): BModuleList = BModuleList(typeInfoMarker: initTable[SigHash, tuple[str: Rope, owner: int32]](), diff --git a/compiler/cgmeth.nim b/compiler/cgmeth.nim index 484bc9d97..ca97d0494 100644 --- a/compiler/cgmeth.nim +++ b/compiler/cgmeth.nim @@ -10,8 +10,15 @@ ## This module implements code generation for methods. import - intsets, options, ast, msgs, idents, renderer, types, magicsys, - sempass2, strutils, modulegraphs, lineinfos + options, ast, msgs, idents, renderer, types, magicsys, + sempass2, modulegraphs, lineinfos, astalgo + +import std/intsets + +when defined(nimPreviewSlimSystem): + import std/assertions + +import std/[tables] proc genConv(n: PNode, d: PType, downcast: bool; conf: ConfigRef): PNode = var dest = skipTypes(d, abstractPtrs) @@ -40,12 +47,15 @@ proc getDispatcher*(s: PSym): PSym = if dispatcherPos < s.ast.len: result = s.ast[dispatcherPos].sym doAssert sfDispatcher in result.flags + else: + result = nil proc methodCall*(n: PNode; conf: ConfigRef): PNode = result = n # replace ordinary method by dispatcher method: let disp = getDispatcher(result[0].sym) if disp != nil: + result[0].typ = disp.typ result[0].sym = disp # change the arguments to up/downcasts to fit the dispatcher's parameters: for i in 1..<result.len: @@ -57,22 +67,25 @@ type MethodResult = enum No, Invalid, Yes proc sameMethodBucket(a, b: PSym; multiMethods: bool): MethodResult = + result = No if a.name.id != b.name.id: return - if a.typ.len != b.typ.len: + if a.typ.signatureLen != b.typ.signatureLen: return - for i in 1..<a.typ.len: - var aa = a.typ[i] - var bb = b.typ[i] + var i = 0 + for x, y in paramTypePairs(a.typ, b.typ): + inc i + var aa = x + var bb = y while true: aa = skipTypes(aa, {tyGenericInst, tyAlias}) bb = skipTypes(bb, {tyGenericInst, tyAlias}) if aa.kind == bb.kind and aa.kind in {tyVar, tyPtr, tyRef, tyLent, tySink}: - aa = aa.lastSon - bb = bb.lastSon + aa = aa.elementType + bb = bb.elementType else: break - if sameType(a.typ[i], b.typ[i]): + if sameType(x, y): if aa.kind == tyObject and result != Invalid: result = Yes elif aa.kind == tyObject and bb.kind == tyObject and (i == 1 or multiMethods): @@ -90,10 +103,11 @@ proc sameMethodBucket(a, b: PSym; multiMethods: bool): MethodResult = return No if result == Yes: # check for return type: - if not sameTypeOrNil(a.typ[0], b.typ[0]): - if b.typ[0] != nil and b.typ[0].kind == tyUntyped: + # ignore flags of return types; # bug #22673 + if not sameTypeOrNil(a.typ.returnType, b.typ.returnType, {IgnoreFlags}): + if b.typ.returnType != nil and b.typ.returnType.kind == tyUntyped: # infer 'auto' from the base to make it consistent: - b.typ[0] = a.typ[0] + b.typ.setReturnType a.typ.returnType else: return No @@ -108,21 +122,21 @@ proc attachDispatcher(s: PSym, dispatcher: PNode) = s.ast[dispatcherPos] = dispatcher proc createDispatcher(s: PSym; g: ModuleGraph; idgen: IdGenerator): PSym = - var disp = copySym(s, nextSymId(idgen)) + var disp = copySym(s, idgen) incl(disp.flags, sfDispatcher) excl(disp.flags, sfExported) let old = disp.typ - disp.typ = copyType(disp.typ, nextTypeId(idgen), disp.typ.owner) + disp.typ = copyType(disp.typ, idgen, disp.typ.owner) copyTypeProps(g, idgen.module, disp.typ, old) # we can't inline the dispatcher itself (for now): if disp.typ.callConv == ccInline: disp.typ.callConv = ccNimCall disp.ast = copyTree(s.ast) disp.ast[bodyPos] = newNodeI(nkEmpty, s.info) - disp.loc.r = nil - if s.typ[0] != nil: + disp.loc.snippet = "" + if s.typ.returnType != nil: if disp.ast.len > resultPos: - disp.ast[resultPos].sym = copySym(s.ast[resultPos].sym, nextSymId(idgen)) + disp.ast[resultPos].sym = copySym(s.ast[resultPos].sym, idgen) else: # We've encountered a method prototype without a filled-in # resultPos slot. We put a placeholder in there that will @@ -143,25 +157,16 @@ proc fixupDispatcher(meth, disp: PSym; conf: ConfigRef) = disp.ast[resultPos].kind == nkEmpty: disp.ast[resultPos] = copyTree(meth.ast[resultPos]) - # The following code works only with lock levels, so we disable - # it when they're not available. - when declared(TLockLevel): - proc `<`(a, b: TLockLevel): bool {.borrow.} - proc `==`(a, b: TLockLevel): bool {.borrow.} - if disp.typ.lockLevel == UnspecifiedLockLevel: - disp.typ.lockLevel = meth.typ.lockLevel - elif meth.typ.lockLevel != UnspecifiedLockLevel and - meth.typ.lockLevel != disp.typ.lockLevel: - message(conf, meth.info, warnLockLevel, - "method has lock level $1, but another method has $2" % - [$meth.typ.lockLevel, $disp.typ.lockLevel]) - # XXX The following code silences a duplicate warning in - # checkMethodeffects() in sempass2.nim for now. - if disp.typ.lockLevel < meth.typ.lockLevel: - disp.typ.lockLevel = meth.typ.lockLevel - proc methodDef*(g: ModuleGraph; idgen: IdGenerator; s: PSym) = - var witness: PSym + var witness: PSym = nil + if s.typ.firstParamType.owner.getModule != s.getModule and vtables in g.config.features and not + g.config.isDefined("nimInternalNonVtablesTesting"): + localError(g.config, s.info, errGenerated, "method `" & s.name.s & + "` can be defined only in the same module with its type (" & s.typ.firstParamType.typeToString() & ")") + if sfImportc in s.flags: + localError(g.config, s.info, errGenerated, "method `" & s.name.s & + "` is not allowed to have 'importc' pragmas") + for i in 0..<g.methods.len: let disp = g.methods[i].dispatcher case sameMethodBucket(disp, s, multimethods = optMultiMethods in g.config.globalOptions) @@ -180,6 +185,11 @@ proc methodDef*(g: ModuleGraph; idgen: IdGenerator; s: PSym) = of Invalid: if witness.isNil: witness = g.methods[i].methods[0] # create a new dispatcher: + # stores the id and the position + if s.typ.firstParamType.skipTypes(skipPtrs).itemId notin g.bucketTable: + g.bucketTable[s.typ.firstParamType.skipTypes(skipPtrs).itemId] = 1 + else: + g.bucketTable.inc(s.typ.firstParamType.skipTypes(skipPtrs).itemId) g.methods.add((methods: @[s], dispatcher: createDispatcher(s, g, idgen))) #echo "adding ", s.info if witness != nil: @@ -188,8 +198,9 @@ proc methodDef*(g: ModuleGraph; idgen: IdGenerator; s: PSym) = elif sfBase notin s.flags: message(g.config, s.info, warnUseBase) -proc relevantCol(methods: seq[PSym], col: int): bool = +proc relevantCol*(methods: seq[PSym], col: int): bool = # returns true iff the position is relevant + result = false var t = methods[0].typ[col].skipTypes(skipPtrs) if t.kind == tyObject: for i in 1..high(methods): @@ -198,7 +209,8 @@ proc relevantCol(methods: seq[PSym], col: int): bool = return true proc cmpSignatures(a, b: PSym, relevantCols: IntSet): int = - for col in 1..<a.typ.len: + result = 0 + for col in FirstParamAt..<a.typ.signatureLen: if contains(relevantCols, col): var aa = skipTypes(a.typ[col], skipPtrs) var bb = skipTypes(b.typ[col], skipPtrs) @@ -206,7 +218,7 @@ proc cmpSignatures(a, b: PSym, relevantCols: IntSet): int = if (d != high(int)) and d != 0: return d -proc sortBucket(a: var seq[PSym], relevantCols: IntSet) = +proc sortBucket*(a: var seq[PSym], relevantCols: IntSet) = # we use shellsort here; fast and simple var n = a.len var h = 1 @@ -225,16 +237,16 @@ proc sortBucket(a: var seq[PSym], relevantCols: IntSet) = a[j] = v if h == 1: break -proc genDispatcher(g: ModuleGraph; methods: seq[PSym], relevantCols: IntSet): PSym = +proc genIfDispatcher*(g: ModuleGraph; methods: seq[PSym], relevantCols: IntSet; idgen: IdGenerator): PSym = var base = methods[0].ast[dispatcherPos].sym result = base - var paramLen = base.typ.len + var paramLen = base.typ.signatureLen var nilchecks = newNodeI(nkStmtList, base.info) var disp = newNodeI(nkIfStmt, base.info) var ands = getSysMagic(g, unknownLineInfo, "and", mAnd) var iss = getSysMagic(g, unknownLineInfo, "of", mOf) let boolType = getSysType(g, unknownLineInfo, tyBool) - for col in 1..<paramLen: + for col in FirstParamAt..<paramLen: if contains(relevantCols, col): let param = base.typ.n[col].sym if param.typ.skipTypes(abstractInst).kind in {tyRef, tyPtr}: @@ -243,7 +255,7 @@ proc genDispatcher(g: ModuleGraph; methods: seq[PSym], relevantCols: IntSet): PS for meth in 0..high(methods): var curr = methods[meth] # generate condition: var cond: PNode = nil - for col in 1..<paramLen: + for col in FirstParamAt..<paramLen: if contains(relevantCols, col): var isn = newNodeIT(nkCall, base.info, boolType) isn.add newSymNode(iss) @@ -258,7 +270,7 @@ proc genDispatcher(g: ModuleGraph; methods: seq[PSym], relevantCols: IntSet): PS cond = a else: cond = isn - let retTyp = base.typ[0] + let retTyp = base.typ.returnType let call = newNodeIT(nkCall, base.info, retTyp) call.add newSymNode(curr) for col in 1..<paramLen: @@ -284,14 +296,13 @@ proc genDispatcher(g: ModuleGraph; methods: seq[PSym], relevantCols: IntSet): PS nilchecks.flags.incl nfTransf # should not be further transformed result.ast[bodyPos] = nilchecks -proc generateMethodDispatchers*(g: ModuleGraph): PNode = - result = newNode(nkStmtList) +proc generateIfMethodDispatchers*(g: ModuleGraph, idgen: IdGenerator) = for bucket in 0..<g.methods.len: var relevantCols = initIntSet() - for col in 1..<g.methods[bucket].methods[0].typ.len: + for col in FirstParamAt..<g.methods[bucket].methods[0].typ.signatureLen: if relevantCol(g.methods[bucket].methods, col): incl(relevantCols, col) if optMultiMethods notin g.config.globalOptions: # if multi-methods are not enabled, we are interested only in the first field break sortBucket(g.methods[bucket].methods, relevantCols) - result.add newSymNode(genDispatcher(g, g.methods[bucket].methods, relevantCols)) + g.addDispatchers genIfDispatcher(g, g.methods[bucket].methods, relevantCols, idgen) diff --git a/compiler/closureiters.nim b/compiler/closureiters.nim index e474e5ba2..8bdd04ca7 100644 --- a/compiler/closureiters.nim +++ b/compiler/closureiters.nim @@ -18,7 +18,8 @@ # dec a # # Should be transformed to: -# STATE0: +# case :state +# of 0: # if a > 0: # echo "hi" # :state = 1 # Next state @@ -26,19 +27,14 @@ # else: # :state = 2 # Next state # break :stateLoop # Proceed to the next state -# STATE1: +# of 1: # dec a # :state = 0 # Next state # break :stateLoop # Proceed to the next state -# STATE2: +# of 2: # :state = -1 # End of execution - -# The transformation should play well with lambdalifting, however depending -# on situation, it can be called either before or after lambdalifting -# transformation. As such we behave slightly differently, when accessing -# iterator state, or using temp variables. If lambdalifting did not happen, -# we just create local variables, so that they will be lifted further on. -# Otherwise, we utilize existing env, created by lambdalifting. +# else: +# return # Lambdalifting treats :state variable specially, it should always end up # as the first field in env. Currently C codegen depends on this behavior. @@ -104,12 +100,13 @@ # Is transformed to (yields are left in place for example simplicity, # in reality the code is subdivided even more, as described above): # -# STATE0: # Try +# case :state +# of 0: # Try # yield 0 # raise ... # :state = 2 # What would happen should we not raise # break :stateLoop -# STATE1: # Except +# of 1: # Except # yield 1 # :tmpResult = 3 # Return # :unrollFinally = true # Return @@ -117,32 +114,41 @@ # break :stateLoop # :state = 2 # What would happen should we not return # break :stateLoop -# STATE2: # Finally +# of 2: # Finally # yield 2 # if :unrollFinally: # This node is created by `newEndFinallyNode` # if :curExc.isNil: -# return :tmpResult +# if nearestFinally == 0: +# return :tmpResult +# else: +# :state = nearestFinally # bubble up # else: # closureIterSetupExc(nil) # raise # state = -1 # Goto next state. In this case we just exit # break :stateLoop +# else: +# return import ast, msgs, idents, renderer, magicsys, lowerings, lambdalifting, modulegraphs, lineinfos, - tables, options + options + +import std/tables + +when defined(nimPreviewSlimSystem): + import std/assertions type Ctx = object g: ModuleGraph fn: PSym - stateVarSym: PSym # :state variable. nil if env already introduced by lambdalifting tmpResultSym: PSym # Used when we return, but finally has to interfere unrollFinallySym: PSym # Indicates that we're unrolling finally states (either exception happened or premature return) curExcSym: PSym # Current exception - states: seq[PNode] # The resulting states. Every state is an nkState node. + states: seq[tuple[label: int, body: PNode]] # The resulting states. blockLevel: int # Temp used to transform break and continue stmts stateLoopLabel: PSym # Label to break on, when jumping between states. exitStateIdx: int # index of the last state @@ -154,15 +160,23 @@ type nearestFinally: int # Index of the nearest finally block. For try/except it # is their finally. For finally it is parent finally. Otherwise -1 idgen: IdGenerator + varStates: Table[ItemId, int] # Used to detect if local variable belongs to multiple states + stateVarSym: PSym # :state variable. nil if env already introduced by lambdalifting + # remove if -d:nimOptIters is default, treating it as always nil + nimOptItersEnabled: bool # tracks if -d:nimOptIters is enabled + # should be default when issues are fixed, see #24094 const nkSkip = {nkEmpty..nkNilLit, nkTemplateDef, nkTypeSection, nkStaticStmt, nkCommentStmt, nkMixinStmt, nkBindStmt} + procDefs + emptyStateLabel = -1 + localNotSeen = -1 + localRequiresLifting = -2 proc newStateAccess(ctx: var Ctx): PNode = if ctx.stateVarSym.isNil: result = rawIndirectAccess(newSymNode(getEnvParam(ctx.fn)), - getStateField(ctx.g, ctx.fn), ctx.fn.info) + getStateField(ctx.g, ctx.fn), ctx.fn.info) else: result = newSymNode(ctx.stateVarSym) @@ -177,9 +191,10 @@ proc newStateAssgn(ctx: var Ctx, stateNo: int = -2): PNode = ctx.newStateAssgn(newIntTypeNode(stateNo, ctx.g.getSysType(TLineInfo(), tyInt))) proc newEnvVar(ctx: var Ctx, name: string, typ: PType): PSym = - result = newSym(skVar, getIdent(ctx.g.cache, name), nextSymId(ctx.idgen), ctx.fn, ctx.fn.info) + result = newSym(skVar, getIdent(ctx.g.cache, name), ctx.idgen, ctx.fn, ctx.fn.info) result.typ = typ - assert(not typ.isNil) + result.flags.incl sfNoInit + assert(not typ.isNil, "Env var needs a type") if not ctx.stateVarSym.isNil: # We haven't gone through labmda lifting yet, so just create a local var, @@ -190,7 +205,7 @@ proc newEnvVar(ctx: var Ctx, name: string, typ: PType): PSym = else: let envParam = getEnvParam(ctx.fn) # let obj = envParam.typ.lastSon - result = addUniqueField(envParam.typ.lastSon, result, ctx.g.cache, ctx.idgen) + result = addUniqueField(envParam.typ.elementType, result, ctx.g.cache, ctx.idgen) proc newEnvVarAccess(ctx: Ctx, s: PSym): PNode = if ctx.stateVarSym.isNil: @@ -198,9 +213,12 @@ proc newEnvVarAccess(ctx: Ctx, s: PSym): PNode = else: result = newSymNode(s) +proc newTempVarAccess(ctx: Ctx, s: PSym): PNode = + result = newSymNode(s, ctx.fn.info) + proc newTmpResultAccess(ctx: var Ctx): PNode = if ctx.tmpResultSym.isNil: - ctx.tmpResultSym = ctx.newEnvVar(":tmpResult", ctx.fn.typ[0]) + ctx.tmpResultSym = ctx.newEnvVar(":tmpResult", ctx.fn.typ.returnType) ctx.newEnvVarAccess(ctx.tmpResultSym) proc newUnrollFinallyAccess(ctx: var Ctx, info: TLineInfo): PNode = @@ -220,10 +238,7 @@ proc newState(ctx: var Ctx, n, gotoOut: PNode): int = result = ctx.states.len let resLit = ctx.g.newIntLit(n.info, result) - let s = newNodeI(nkState, n.info) - s.add(resLit) - s.add(n) - ctx.states.add(s) + ctx.states.add((result, n)) ctx.exceptionTable.add(ctx.curExcHandlingState) if not gotoOut.isNil: @@ -242,9 +257,26 @@ proc addGotoOut(n: PNode, gotoOut: PNode): PNode = if result.len == 0 or result[^1].kind != nkGotoState: result.add(gotoOut) -proc newTempVar(ctx: var Ctx, typ: PType): PSym = - result = ctx.newEnvVar(":tmpSlLower" & $ctx.tempVarId, typ) +proc newTempVarDef(ctx: Ctx, s: PSym, initialValue: PNode): PNode = + var v = initialValue + if v == nil: + v = ctx.g.emptyNode + newTree(nkVarSection, newTree(nkIdentDefs, newSymNode(s), ctx.g.emptyNode, v)) + +proc newEnvVarAsgn(ctx: Ctx, s: PSym, v: PNode): PNode + +proc newTempVar(ctx: var Ctx, typ: PType, parent: PNode, initialValue: PNode = nil): PSym = + if ctx.nimOptItersEnabled: + result = newSym(skVar, getIdent(ctx.g.cache, ":tmpSlLower" & $ctx.tempVarId), ctx.idgen, ctx.fn, ctx.fn.info) + else: + result = ctx.newEnvVar(":tmpSlLower" & $ctx.tempVarId, typ) inc ctx.tempVarId + result.typ = typ + assert(not typ.isNil, "Temp var needs a type") + if ctx.nimOptItersEnabled: + parent.add(ctx.newTempVarDef(result, initialValue)) + elif initialValue != nil: + parent.add(ctx.newEnvVarAsgn(result, initialValue)) proc hasYields(n: PNode): bool = # TODO: This is very inefficient. It traverses the node, looking for nkYieldStmt. @@ -252,10 +284,11 @@ proc hasYields(n: PNode): bool = of nkYieldStmt: result = true of nkSkip: - discard + result = false else: - for c in n: - if c.hasYields: + result = false + for i in ord(n.kind == nkCast)..<n.len: + if n[i].hasYields: result = true break @@ -319,7 +352,7 @@ proc collectExceptState(ctx: var Ctx, n: PNode): PNode {.inline.} = var ifBranch: PNode if c.len > 1: - var cond: PNode + var cond: PNode = nil for i in 0..<c.len - 1: assert(c[i].kind == nkType) let nextCond = newTree(nkCall, @@ -382,26 +415,29 @@ proc getFinallyNode(ctx: var Ctx, n: PNode): PNode = proc hasYieldsInExpressions(n: PNode): bool = case n.kind of nkSkip: - discard + result = false of nkStmtListExpr: if isEmptyType(n.typ): + result = false for c in n: if c.hasYieldsInExpressions: return true else: result = n.hasYields of nkCast: + result = false for i in 1..<n.len: if n[i].hasYieldsInExpressions: return true else: + result = false for c in n: if c.hasYieldsInExpressions: return true proc exprToStmtList(n: PNode): tuple[s, res: PNode] = assert(n.kind == nkStmtListExpr) - result.s = newNodeI(nkStmtList, n.info) + result = (newNodeI(nkStmtList, n.info), nil) result.s.sons = @[] var n = n @@ -412,28 +448,50 @@ proc exprToStmtList(n: PNode): tuple[s, res: PNode] = result.res = n +proc newTempVarAsgn(ctx: Ctx, s: PSym, v: PNode): PNode = + if isEmptyType(v.typ): + result = v + else: + result = newTree(nkFastAsgn, ctx.newTempVarAccess(s), v) + result.info = v.info proc newEnvVarAsgn(ctx: Ctx, s: PSym, v: PNode): PNode = - result = newTree(nkFastAsgn, ctx.newEnvVarAccess(s), v) - result.info = v.info + # unused with -d:nimOptIters + if isEmptyType(v.typ): + result = v + else: + result = newTree(nkFastAsgn, ctx.newEnvVarAccess(s), v) + result.info = v.info proc addExprAssgn(ctx: Ctx, output, input: PNode, sym: PSym) = + var input = input if input.kind == nkStmtListExpr: let (st, res) = exprToStmtList(input) output.add(st) - output.add(ctx.newEnvVarAsgn(sym, res)) + input = res + if ctx.nimOptItersEnabled: + output.add(ctx.newTempVarAsgn(sym, input)) else: output.add(ctx.newEnvVarAsgn(sym, input)) proc convertExprBodyToAsgn(ctx: Ctx, exprBody: PNode, res: PSym): PNode = result = newNodeI(nkStmtList, exprBody.info) - if exprBody.typ != nil: - ctx.addExprAssgn(result, exprBody, res) + ctx.addExprAssgn(result, exprBody, res) proc newNotCall(g: ModuleGraph; e: PNode): PNode = result = newTree(nkCall, newSymNode(g.getSysMagic(e.info, "not", mNot), e.info), e) result.typ = g.getSysType(e.info, tyBool) +proc boolLit(g: ModuleGraph; info: TLineInfo; value: bool): PNode = + result = newIntLit(g, info, ord value) + result.typ = getSysType(g, info, tyBool) + +proc captureVar(c: var Ctx, s: PSym) = + if c.varStates.getOrDefault(s.itemId) != localRequiresLifting: + c.varStates[s.itemId] = localRequiresLifting # Mark this variable for lifting + let e = getEnvParam(c.fn) + discard addField(e.typ.elementType, s, c.g.cache, c.idgen) + proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = result = n case n.kind @@ -487,12 +545,12 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = if ns: needsSplit = true - var tmp: PSym + var tmp: PSym = nil let isExpr = not isEmptyType(n.typ) if isExpr: - tmp = ctx.newTempVar(n.typ) result = newNodeI(nkStmtListExpr, n.info) result.typ = n.typ + tmp = ctx.newTempVar(n.typ, result) else: result = newNodeI(nkStmtList, n.info) @@ -543,7 +601,11 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = else: internalError(ctx.g.config, "lowerStmtListExpr(nkIf): " & $branch.kind) - if isExpr: result.add(ctx.newEnvVarAccess(tmp)) + if isExpr: + if ctx.nimOptItersEnabled: + result.add(ctx.newTempVarAccess(tmp)) + else: + result.add(ctx.newEnvVarAccess(tmp)) of nkTryStmt, nkHiddenTryStmt: var ns = false @@ -557,7 +619,7 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = if isExpr: result = newNodeI(nkStmtListExpr, n.info) result.typ = n.typ - let tmp = ctx.newTempVar(n.typ) + let tmp = ctx.newTempVar(n.typ, result) n[0] = ctx.convertExprBodyToAsgn(n[0], tmp) for i in 1..<n.len: @@ -573,7 +635,10 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = else: internalError(ctx.g.config, "lowerStmtListExpr(nkTryStmt): " & $branch.kind) result.add(n) - result.add(ctx.newEnvVarAccess(tmp)) + if ctx.nimOptItersEnabled: + result.add(ctx.newTempVarAccess(tmp)) + else: + result.add(ctx.newEnvVarAccess(tmp)) of nkCaseStmt: var ns = false @@ -586,9 +651,9 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = let isExpr = not isEmptyType(n.typ) if isExpr: - let tmp = ctx.newTempVar(n.typ) result = newNodeI(nkStmtListExpr, n.info) result.typ = n.typ + let tmp = ctx.newTempVar(n.typ, result) if n[0].kind == nkStmtListExpr: let (st, ex) = exprToStmtList(n[0]) @@ -605,7 +670,16 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = else: internalError(ctx.g.config, "lowerStmtListExpr(nkCaseStmt): " & $branch.kind) result.add(n) - result.add(ctx.newEnvVarAccess(tmp)) + if ctx.nimOptItersEnabled: + result.add(ctx.newTempVarAccess(tmp)) + else: + result.add(ctx.newEnvVarAccess(tmp)) + elif n[0].kind == nkStmtListExpr: + result = newNodeI(nkStmtList, n.info) + let (st, ex) = exprToStmtList(n[0]) + result.add(st) + n[0] = ex + result.add(n) of nkCallKinds, nkChckRange, nkChckRangeF, nkChckRange64: var ns = false @@ -629,10 +703,14 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = result.add(st) cond = ex - let tmp = ctx.newTempVar(cond.typ) - result.add(ctx.newEnvVarAsgn(tmp, cond)) + let tmp = ctx.newTempVar(cond.typ, result, cond) + # result.add(ctx.newTempVarAsgn(tmp, cond)) - var check = ctx.newEnvVarAccess(tmp) + var check: PNode + if ctx.nimOptItersEnabled: + check = ctx.newTempVarAccess(tmp) + else: + check = ctx.newEnvVarAccess(tmp) if n[0].sym.magic == mOr: check = ctx.g.newNotCall(check) @@ -642,12 +720,18 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = let (st, ex) = exprToStmtList(cond) ifBody.add(st) cond = ex - ifBody.add(ctx.newEnvVarAsgn(tmp, cond)) + if ctx.nimOptItersEnabled: + ifBody.add(ctx.newTempVarAsgn(tmp, cond)) + else: + ifBody.add(ctx.newEnvVarAsgn(tmp, cond)) let ifBranch = newTree(nkElifBranch, check, ifBody) let ifNode = newTree(nkIfStmt, ifBranch) result.add(ifNode) - result.add(ctx.newEnvVarAccess(tmp)) + if ctx.nimOptItersEnabled: + result.add(ctx.newTempVarAccess(tmp)) + else: + result.add(ctx.newEnvVarAccess(tmp)) else: for i in 0..<n.len: if n[i].kind == nkStmtListExpr: @@ -656,9 +740,12 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = n[i] = ex if n[i].kind in nkCallKinds: # XXX: This should better be some sort of side effect tracking - let tmp = ctx.newTempVar(n[i].typ) - result.add(ctx.newEnvVarAsgn(tmp, n[i])) - n[i] = ctx.newEnvVarAccess(tmp) + let tmp = ctx.newTempVar(n[i].typ, result, n[i]) + # result.add(ctx.newTempVarAsgn(tmp, n[i])) + if ctx.nimOptItersEnabled: + n[i] = ctx.newTempVarAccess(tmp) + else: + n[i] = ctx.newEnvVarAccess(tmp) result.add(n) @@ -674,6 +761,12 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = let (st, ex) = exprToStmtList(c[^1]) result.add(st) c[^1] = ex + for i in 0 .. c.len - 3: + if c[i].kind == nkSym: + let s = c[i].sym + if sfForceLift in s.flags: + ctx.captureVar(s) + result.add(varSect) of nkDiscardStmt, nkReturnStmt, nkRaiseStmt: @@ -704,7 +797,7 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = n[^1] = ex result.add(n) - of nkAsgn, nkFastAsgn: + of nkAsgn, nkFastAsgn, nkSinkAsgn: var ns = false for i in 0..<n.len: n[i] = ctx.lowerStmtListExprs(n[i], ns) @@ -759,7 +852,7 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = let check = newTree(nkIfStmt, branch) let newBody = newTree(nkStmtList, st, check, n[1]) - n[0] = newSymNode(ctx.g.getSysSym(n[0].info, "true")) + n[0] = ctx.g.boolLit(n[0].info, true) n[1] = newBody of nkDotExpr, nkCheckedFieldExpr: @@ -796,7 +889,10 @@ proc newEndFinallyNode(ctx: var Ctx, info: TLineInfo): PNode = # Generate the following code: # if :unrollFinally: # if :curExc.isNil: - # return :tmpResult + # if nearestFinally == 0: + # return :tmpResult + # else: + # :state = nearestFinally # bubble up # else: # raise let curExc = ctx.newCurExcAccess() @@ -805,11 +901,20 @@ proc newEndFinallyNode(ctx: var Ctx, info: TLineInfo): PNode = let cmp = newTree(nkCall, newSymNode(ctx.g.getSysMagic(info, "==", mEqRef), info), curExc, nilnode) cmp.typ = ctx.g.getSysType(info, tyBool) - let asgn = newTree(nkFastAsgn, - newSymNode(getClosureIterResult(ctx.g, ctx.fn, ctx.idgen), info), - ctx.newTmpResultAccess()) + let retStmt = + if ctx.nearestFinally == 0: + # last finally, we can return + let retValue = if ctx.fn.typ.returnType.isNil: + ctx.g.emptyNode + else: + newTree(nkFastAsgn, + newSymNode(getClosureIterResult(ctx.g, ctx.fn, ctx.idgen), info), + ctx.newTmpResultAccess()) + newTree(nkReturnStmt, retValue) + else: + # bubble up to next finally + newTree(nkGotoState, ctx.g.newIntLit(info, ctx.nearestFinally)) - let retStmt = newTree(nkReturnStmt, asgn) let branch = newTree(nkElifBranch, cmp, retStmt) let nullifyExc = newTree(nkCall, newSymNode(ctx.g.getCompilerProc("closureIterSetupExc")), nilnode) @@ -829,7 +934,9 @@ proc transformReturnsInTry(ctx: var Ctx, n: PNode): PNode = case n.kind of nkReturnStmt: # We're somewhere in try, transform to finally unrolling - assert(ctx.nearestFinally != 0) + if ctx.nearestFinally == 0: + # return is within the finally + return result = newNodeI(nkStmtList, n.info) @@ -842,7 +949,7 @@ proc transformReturnsInTry(ctx: var Ctx, n: PNode): PNode = if n[0].kind != nkEmpty: let asgnTmpResult = newNodeI(nkAsgn, n.info) asgnTmpResult.add(ctx.newTmpResultAccess()) - let x = if n[0].kind in {nkAsgn, nkFastAsgn}: n[0][1] else: n[0] + let x = if n[0].kind in {nkAsgn, nkFastAsgn, nkSinkAsgn}: n[0][1] else: n[0] asgnTmpResult.add(x) result.add(asgnTmpResult) @@ -853,6 +960,13 @@ proc transformReturnsInTry(ctx: var Ctx, n: PNode): PNode = of nkSkip: discard + of nkTryStmt: + if n.hasYields: + # the inner try will handle these transformations + discard + else: + for i in 0..<n.len: + n[i] = ctx.transformReturnsInTry(n[i]) else: for i in 0..<n.len: n[i] = ctx.transformReturnsInTry(n[i]) @@ -1092,10 +1206,10 @@ proc skipEmptyStates(ctx: Ctx, stateIdx: int): int = let label = stateIdx if label == ctx.exitStateIdx: break var newLabel = label - if label == -1: + if label == emptyStateLabel: newLabel = ctx.exitStateIdx else: - let fs = skipStmtList(ctx, ctx.states[label][1]) + let fs = skipStmtList(ctx, ctx.states[label].body) if fs.kind == nkGotoState: newLabel = fs[0].intVal.int if label == newLabel: break @@ -1104,7 +1218,7 @@ proc skipEmptyStates(ctx: Ctx, stateIdx: int): int = if maxJumps == 0: assert(false, "Internal error") - result = ctx.states[stateIdx][0].intVal.int + result = ctx.states[stateIdx].label proc skipThroughEmptyStates(ctx: var Ctx, n: PNode): PNode= result = n @@ -1119,10 +1233,10 @@ proc skipThroughEmptyStates(ctx: var Ctx, n: PNode): PNode= n[i] = ctx.skipThroughEmptyStates(n[i]) proc newArrayType(g: ModuleGraph; n: int, t: PType; idgen: IdGenerator; owner: PSym): PType = - result = newType(tyArray, nextTypeId(idgen), owner) + result = newType(tyArray, idgen, owner) - let rng = newType(tyRange, nextTypeId(idgen), owner) - rng.n = newTree(nkRange, g.newIntLit(owner.info, 0), g.newIntLit(owner.info, n)) + let rng = newType(tyRange, idgen, owner) + rng.n = newTree(nkRange, g.newIntLit(owner.info, 0), g.newIntLit(owner.info, n - 1)) rng.rawAddSon(t) result.rawAddSon(rng) @@ -1222,11 +1336,10 @@ proc wrapIntoTryExcept(ctx: var Ctx, n: PNode): PNode {.inline.} = proc wrapIntoStateLoop(ctx: var Ctx, n: PNode): PNode = # while true: # block :stateLoop: - # gotoState :state # local vars decl (if needed) # body # Might get wrapped in try-except let loopBody = newNodeI(nkStmtList, n.info) - result = newTree(nkWhileStmt, newSymNode(ctx.g.getSysSym(n.info, "true")), loopBody) + result = newTree(nkWhileStmt, ctx.g.boolLit(n.info, true), loopBody) result.info = n.info let localVars = newNodeI(nkStmtList, n.info) @@ -1241,11 +1354,7 @@ proc wrapIntoStateLoop(ctx: var Ctx, n: PNode): PNode = let blockStmt = newNodeI(nkBlockStmt, n.info) blockStmt.add(newSymNode(ctx.stateLoopLabel)) - let gs = newNodeI(nkGotoState, n.info) - gs.add(ctx.newStateAccess()) - gs.add(ctx.g.newIntLit(n.info, ctx.states.len - 1)) - - var blockBody = newTree(nkStmtList, gs, localVars, n) + var blockBody = newTree(nkStmtList, localVars, n) if ctx.hasExceptions: blockBody = ctx.wrapIntoTryExcept(blockBody) @@ -1258,29 +1367,28 @@ proc deleteEmptyStates(ctx: var Ctx) = # Apply new state indexes and mark unused states with -1 var iValid = 0 - for i, s in ctx.states: - let body = skipStmtList(ctx, s[1]) + for i, s in ctx.states.mpairs: + let body = skipStmtList(ctx, s.body) if body.kind == nkGotoState and i != ctx.states.len - 1 and i != 0: # This is an empty state. Mark with -1. - s[0].intVal = -1 + s.label = emptyStateLabel else: - s[0].intVal = iValid + s.label = iValid inc iValid for i, s in ctx.states: - let body = skipStmtList(ctx, s[1]) + let body = skipStmtList(ctx, s.body) if body.kind != nkGotoState or i == 0: - discard ctx.skipThroughEmptyStates(s) + discard ctx.skipThroughEmptyStates(s.body) let excHandlState = ctx.exceptionTable[i] if excHandlState < 0: ctx.exceptionTable[i] = -ctx.skipEmptyStates(-excHandlState) elif excHandlState != 0: ctx.exceptionTable[i] = ctx.skipEmptyStates(excHandlState) - var i = 0 + var i = 1 # ignore the entry and the exit while i < ctx.states.len - 1: - let fs = skipStmtList(ctx, ctx.states[i][1]) - if fs.kind == nkGotoState and i != 0: + if ctx.states[i].label == emptyStateLabel: ctx.states.delete(i) ctx.exceptionTable.delete(i) else: @@ -1315,7 +1423,7 @@ proc freshVars(n: PNode; c: var FreshVarsContext): PNode = let idefs = copyNode(it) for v in 0..it.len-3: if it[v].kind == nkSym: - let x = copySym(it[v].sym, nextSymId(c.idgen)) + let x = copySym(it[v].sym, c.idgen) c.tab[it[v].sym.id] = x idefs.add newSymNode(x) else: @@ -1326,6 +1434,7 @@ proc freshVars(n: PNode; c: var FreshVarsContext): PNode = else: result.add it of nkRaiseStmt: + result = nil localError(c.config, c.info, "unsupported control flow: 'finally: ... raise' duplicated because of 'break'") else: result = n @@ -1339,20 +1448,24 @@ proc preprocess(c: var PreprocessContext; n: PNode): PNode = # detect: 'finally: raises X' which is currently not supported. We produce # an error for this case for now. All this will be done properly with Yuriy's # patch. + result = n case n.kind of nkTryStmt: let f = n.lastSon + var didAddSomething = false if f.kind == nkFinally: c.finallys.add f.lastSon + didAddSomething = true for i in 0 ..< n.len: result[i] = preprocess(c, n[i]) - if f.kind == nkFinally: + if didAddSomething: discard c.finallys.pop() of nkWhileStmt, nkBlockStmt: + if not n.hasYields: return n c.blocks.add((n, c.finallys.len)) for i in 0 ..< n.len: result[i] = preprocess(c, n[i]) @@ -1376,7 +1489,7 @@ proc preprocess(c: var PreprocessContext; n: PNode): PNode = result = newNodeI(nkStmtList, n.info) for i in countdown(c.finallys.high, fin): var vars = FreshVarsContext(tab: initTable[int, PSym](), config: c.config, info: n.info, idgen: c.idgen) - result.add freshVars(preprocess(c, c.finallys[i]), vars) + result.add freshVars(copyTree(c.finallys[i]), vars) c.idgen = vars.idgen result.add n of nkSkip: discard @@ -1384,19 +1497,78 @@ proc preprocess(c: var PreprocessContext; n: PNode): PNode = for i in 0 ..< n.len: result[i] = preprocess(c, n[i]) +proc detectCapturedVars(c: var Ctx, n: PNode, stateIdx: int) = + case n.kind + of nkSym: + let s = n.sym + if s.kind in {skResult, skVar, skLet, skForVar, skTemp} and sfGlobal notin s.flags and s.owner == c.fn: + let vs = c.varStates.getOrDefault(s.itemId, localNotSeen) + if vs == localNotSeen: # First seing this variable + c.varStates[s.itemId] = stateIdx + elif vs == localRequiresLifting: + discard # Sym already marked + elif vs != stateIdx: + c.captureVar(s) + of nkReturnStmt: + if n[0].kind in {nkAsgn, nkFastAsgn, nkSinkAsgn}: + # we have a `result = result` expression produced by the closure + # transform, let's not touch the LHS in order to make the lifting pass + # correct when `result` is lifted + detectCapturedVars(c, n[0][1], stateIdx) + else: + detectCapturedVars(c, n[0], stateIdx) + else: + for i in 0 ..< n.safeLen: + detectCapturedVars(c, n[i], stateIdx) + +proc detectCapturedVars(c: var Ctx) = + for i, s in c.states: + detectCapturedVars(c, s.body, i) + +proc liftLocals(c: var Ctx, n: PNode): PNode = + result = n + case n.kind + of nkSym: + let s = n.sym + if c.varStates.getOrDefault(s.itemId) == localRequiresLifting: + # lift + let e = getEnvParam(c.fn) + let field = getFieldFromObj(e.typ.elementType, s) + assert(field != nil) + result = rawIndirectAccess(newSymNode(e), field, n.info) + # elif c.varStates.getOrDefault(s.itemId, localNotSeen) != localNotSeen: + # echo "Not lifting ", s.name.s + + of nkReturnStmt: + if n[0].kind in {nkAsgn, nkFastAsgn, nkSinkAsgn}: + # we have a `result = result` expression produced by the closure + # transform, let's not touch the LHS in order to make the lifting pass + # correct when `result` is lifted + n[0][1] = liftLocals(c, n[0][1]) + else: + n[0] = liftLocals(c, n[0]) + else: + for i in 0 ..< n.safeLen: + n[i] = liftLocals(c, n[i]) + proc transformClosureIterator*(g: ModuleGraph; idgen: IdGenerator; fn: PSym, n: PNode): PNode = - var ctx: Ctx - ctx.g = g - ctx.fn = fn - ctx.idgen = idgen + var ctx = Ctx(g: g, fn: fn, idgen: idgen, + # should be default when issues are fixed, see #24094: + nimOptItersEnabled: isDefined(g.config, "nimOptIters")) if getEnvParam(fn).isNil: - # Lambda lifting was not done yet. Use temporary :state sym, which will - # be handled specially by lambda lifting. Local temp vars (if needed) - # should follow the same logic. - ctx.stateVarSym = newSym(skVar, getIdent(ctx.g.cache, ":state"), nextSymId(idgen), fn, fn.info) - ctx.stateVarSym.typ = g.createClosureIterStateType(fn, idgen) - ctx.stateLoopLabel = newSym(skLabel, getIdent(ctx.g.cache, ":stateLoop"), nextSymId(idgen), fn, fn.info) + if ctx.nimOptItersEnabled: + # The transformation should always happen after at least partial lambdalifting + # is performed, so that the closure iter environment is always created upfront. + doAssert(false, "Env param not created before iter transformation") + else: + # Lambda lifting was not done yet. Use temporary :state sym, which will + # be handled specially by lambda lifting. Local temp vars (if needed) + # should follow the same logic. + ctx.stateVarSym = newSym(skVar, getIdent(ctx.g.cache, ":state"), idgen, fn, fn.info) + ctx.stateVarSym.typ = g.createClosureIterStateType(fn, idgen) + + ctx.stateLoopLabel = newSym(skLabel, getIdent(ctx.g.cache, ":stateLoop"), idgen, fn, fn.info) var pc = PreprocessContext(finallys: @[], config: g.config, idgen: idgen) var n = preprocess(pc, n.toStmtList) #echo "transformed into ", n @@ -1417,21 +1589,30 @@ proc transformClosureIterator*(g: ModuleGraph; idgen: IdGenerator; fn: PSym, n: # Optimize empty states away ctx.deleteEmptyStates() - # Make new body by concatenating the list of states - result = newNodeI(nkStmtList, n.info) + let caseDispatcher = newTreeI(nkCaseStmt, n.info, + ctx.newStateAccess()) + + if ctx.nimOptItersEnabled: + # Lamdalifting will not touch our locals, it is our responsibility to lift those that + # need it. + detectCapturedVars(ctx) + for s in ctx.states: - assert(s.len == 2) - let body = s[1] - s.sons.del(1) - result.add(s) - result.add(body) + let body = ctx.transformStateAssignments(s.body) + caseDispatcher.add newTreeI(nkOfBranch, body.info, g.newIntLit(body.info, s.label), body) + + caseDispatcher.add newTreeI(nkElse, n.info, newTreeI(nkReturnStmt, n.info, g.emptyNode)) + + result = wrapIntoStateLoop(ctx, caseDispatcher) + if ctx.nimOptItersEnabled: + result = liftLocals(ctx, result) - result = ctx.transformStateAssignments(result) - result = ctx.wrapIntoStateLoop(result) + when false: + echo "TRANSFORM TO STATES: " + echo renderTree(result) - # echo "TRANSFORM TO STATES: " - # echo renderTree(result) + echo "exception table:" + for i, e in ctx.exceptionTable: + echo i, " -> ", e - # echo "exception table:" - # for i, e in ctx.exceptionTable: - # echo i, " -> ", e + echo "ENV: ", renderTree(getEnvParam(fn).typ.elementType.n) diff --git a/compiler/cmdlinehelper.nim b/compiler/cmdlinehelper.nim index c6a0f200a..e51248639 100644 --- a/compiler/cmdlinehelper.nim +++ b/compiler/cmdlinehelper.nim @@ -7,11 +7,13 @@ # distribution, for details about the copyright. # -## Helpers for binaries that use compiler passes, e.g.: nim, nimsuggest, nimfix +## Helpers for binaries that use compiler passes, e.g.: nim, nimsuggest import options, idents, nimconf, extccomp, commands, msgs, - lineinfos, modulegraphs, condsyms, os, pathutils, parseopt + lineinfos, modulegraphs, condsyms, pathutils + +import std/[os, parseopt] proc prependCurDir*(f: AbsoluteFile): AbsoluteFile = when defined(unix): @@ -44,14 +46,7 @@ proc processCmdLineAndProjectPath*(self: NimProg, conf: ConfigRef) = elif self.supportsStdinFile and conf.projectName == "-": handleStdinInput(conf) elif conf.projectName != "": - try: - conf.projectFull = canonicalizePath(conf, AbsoluteFile conf.projectName) - except OSError: - conf.projectFull = AbsoluteFile conf.projectName - let p = splitFile(conf.projectFull) - let dir = if p.dir.isEmpty: AbsoluteDir getCurrentDir() else: p.dir - conf.projectPath = AbsoluteDir canonicalizePath(conf, AbsoluteFile dir) - conf.projectName = p.name + setFromProjectName(conf, conf.projectName) else: conf.projectPath = AbsoluteDir canonicalizePath(conf, AbsoluteFile getCurrentDir()) @@ -62,6 +57,11 @@ proc loadConfigsAndProcessCmdLine*(self: NimProg, cache: IdentCache; conf: Confi if conf.cmd == cmdNimscript: incl(conf.globalOptions, optWasNimscript) loadConfigs(DefaultConfig, cache, conf, graph.idgen) # load all config files + # restores `conf.notes` after loading config files + # because it has overwrites the notes when compiling the system module which + # is a foreign module compared to the project + if conf.cmd in cmdBackends: + conf.notes = conf.mainPackageNotes if not self.suggestMode: let scriptFile = conf.projectFull.changeFileExt("nims") @@ -71,7 +71,8 @@ proc loadConfigsAndProcessCmdLine*(self: NimProg, cache: IdentCache; conf: Confi if conf.cmd == cmdNimscript: return false # now process command line arguments again, because some options in the # command line can overwrite the config file's settings - extccomp.initVars(conf) + if conf.backend != backendJs: # bug #19059 + extccomp.initVars(conf) self.processCmdLine(passCmd2, "", conf) if conf.cmd == cmdNone: rawMessage(conf, errGenerated, "command missing") diff --git a/compiler/commands.nim b/compiler/commands.nim index f36a4f515..cbf915ca6 100644 --- a/compiler/commands.nim +++ b/compiler/commands.nim @@ -9,7 +9,6 @@ # This module handles the parsing of command line arguments. - # We do this here before the 'import' statement so 'defined' does not get # confused with 'TGCMode.gcMarkAndSweep' etc. template bootSwitch(name, expr, userString) = @@ -25,18 +24,20 @@ bootSwitch(usedMarkAndSweep, defined(gcmarkandsweep), "--gc:markAndSweep") bootSwitch(usedGoGC, defined(gogc), "--gc:go") bootSwitch(usedNoGC, defined(nogc), "--gc:none") +import std/[setutils, os, strutils, parseutils, parseopt, sequtils, strtabs, enumutils] import - os, msgs, options, nversion, condsyms, strutils, extccomp, platform, - wordrecg, parseutils, nimblecmd, parseopt, sequtils, lineinfos, - pathutils, strtabs + msgs, options, nversion, condsyms, extccomp, platform, + wordrecg, nimblecmd, lineinfos, pathutils + +import std/pathnorm + +from ast import setUseIc, eqTypeFlags, tfGcSafe, tfNoSideEffect -from ast import eqTypeFlags, tfGcSafe, tfNoSideEffect +when defined(nimPreviewSlimSystem): + import std/assertions # but some have deps to imported modules. Yay. bootSwitch(usedTinyC, hasTinyCBackend, "-d:tinyc") -bootSwitch(usedNativeStacktrace, - defined(nativeStackTrace) and nativeStackTraceSupported, - "-d:nativeStackTrace") bootSwitch(usedFFI, hasFFI, "-d:nimHasLibFFI") type @@ -101,7 +102,7 @@ proc writeVersionInfo(conf: ConfigRef; pass: TCmdLinePass) = msgWriteln(conf, "git hash: " & gitHash, {msgStdout}) msgWriteln(conf, "active boot switches:" & usedRelease & usedDanger & - usedTinyC & useLinenoise & usedNativeStacktrace & + usedTinyC & useLinenoise & usedFFI & usedBoehm & usedMarkAndSweep & usedGoGC & usedNoGC, {msgStdout}) msgQuit(0) @@ -117,7 +118,7 @@ const errInvalidCmdLineOption = "invalid command line option: '$1'" errOnOrOffExpectedButXFound = "'on' or 'off' expected, but '$1' found" errOnOffOrListExpectedButXFound = "'on', 'off' or 'list' expected, but '$1' found" - errOffHintsError = "'off', 'hint' or 'error' expected, but '$1' found" + errOffHintsError = "'off', 'hint', 'error' or 'usages' expected, but '$1' found" proc invalidCmdLineOption(conf: ConfigRef; pass: TCmdLinePass, switch: string, info: TLineInfo) = if switch == " ": localError(conf, info, errInvalidCmdLineOption % "-") @@ -141,10 +142,19 @@ proc splitSwitch(conf: ConfigRef; switch: string, cmd, arg: var string, pass: TC elif switch[i] == '[': arg = substr(switch, i) else: invalidCmdLineOption(conf, pass, switch, info) +template switchOn(arg: string): bool = + # xxx use `switchOn` wherever appropriate + case arg.normalize + of "", "on": true + of "off": false + else: + localError(conf, info, errOnOrOffExpectedButXFound % arg) + false + proc processOnOffSwitch(conf: ConfigRef; op: TOptions, arg: string, pass: TCmdLinePass, info: TLineInfo) = case arg.normalize - of "","on": conf.options.incl op + of "", "on": conf.options.incl op of "off": conf.options.excl op else: localError(conf, info, errOnOrOffExpectedButXFound % arg) @@ -176,7 +186,7 @@ proc processSpecificNote*(arg: string, state: TSpecialWord, pass: TCmdLinePass, info: TLineInfo; orig: string; conf: ConfigRef) = var id = "" # arg = key or [key] or key:val or [key]:val; with val=on|off var i = 0 - var n = hintMin + var notes: set[TMsgKind] = {} var isBracket = false if i < arg.len and arg[i] == '[': isBracket = true @@ -191,37 +201,42 @@ proc processSpecificNote*(arg: string, state: TSpecialWord, pass: TCmdLinePass, if i == arg.len: discard elif i < arg.len and (arg[i] in {':', '='}): inc(i) else: invalidCmdLineOption(conf, pass, orig, info) - # unfortunately, hintUser and warningUser clash - if state in {wHint, wHintAsError}: - let x = findStr(hintMin, hintMax, id, errUnknown) - if x != errUnknown: n = TNoteKind(x) - else: localError(conf, info, "unknown hint: " & id) - else: - let x = findStr(warnMin, warnMax, id, errUnknown) - if x != errUnknown: n = TNoteKind(x) - else: localError(conf, info, "unknown warning: " & id) + let isSomeHint = state in {wHint, wHintAsError} + template findNote(noteMin, noteMax, name) = + # unfortunately, hintUser and warningUser clash, otherwise implementation would simplify a bit + let x = findStr(noteMin, noteMax, id, errUnknown) + if x != errUnknown: notes = {TNoteKind(x)} + else: + if isSomeHint: + message(conf, info, hintUnknownHint, id) + else: + localError(conf, info, "unknown $#: $#" % [name, id]) + case id.normalize + of "all": # other note groups would be easy to support via additional cases + notes = if isSomeHint: {hintMin..hintMax} else: {warnMin..warnMax} + elif isSomeHint: findNote(hintMin, hintMax, "hint") + else: findNote(warnMin, warnMax, "warning") var val = substr(arg, i).normalize if val == "": val = "on" if val notin ["on", "off"]: + # xxx in future work we should also allow users to have control over `foreignPackageNotes` + # so that they can enable `hints|warnings|warningAsErrors` for all the code they depend on. localError(conf, info, errOnOrOffExpectedButXFound % arg) - elif n notin conf.cmdlineNotes or pass == passCmd1: - if pass == passCmd1: incl(conf.cmdlineNotes, n) - incl(conf.modifiedyNotes, n) - case val - of "on": - if state in {wWarningAsError, wHintAsError}: - incl(conf.warningAsErrors, n) # xxx rename warningAsErrors to noteAsErrors - else: - incl(conf.notes, n) - incl(conf.mainPackageNotes, n) - of "off": - if state in {wWarningAsError, wHintAsError}: - excl(conf.warningAsErrors, n) - else: - excl(conf.notes, n) - excl(conf.mainPackageNotes, n) - excl(conf.foreignPackageNotes, n) + else: + let isOn = val == "on" + if isOn and id.normalize == "all": + localError(conf, info, "only 'all:off' is supported") + for n in notes: + if n notin conf.cmdlineNotes or pass == passCmd1: + if pass == passCmd1: incl(conf.cmdlineNotes, n) + incl(conf.modifiedyNotes, n) + if state in {wWarningAsError, wHintAsError}: + conf.warningAsErrors[n] = isOn # xxx rename warningAsErrors to noteAsErrors + else: + conf.notes[n] = isOn + conf.mainPackageNotes[n] = isOn + if not isOn: excl(conf.foreignPackageNotes, n) proc processCompile(conf: ConfigRef; filename: string) = var found = findFile(conf, filename) @@ -229,10 +244,11 @@ proc processCompile(conf: ConfigRef; filename: string) = extccomp.addExternalFileToCompile(conf, found) const - errNoneBoehmRefcExpectedButXFound = "'arc', 'orc', 'markAndSweep', 'boehm', 'go', 'none', 'regions', or 'refc' expected, but '$1' found" + errNoneBoehmRefcExpectedButXFound = "'arc', 'orc', 'atomicArc', 'markAndSweep', 'boehm', 'go', 'none', 'regions', or 'refc' expected, but '$1' found" errNoneSpeedOrSizeExpectedButXFound = "'none', 'speed' or 'size' expected, but '$1' found" - errGuiConsoleOrLibExpectedButXFound = "'gui', 'console' or 'lib' expected, but '$1' found" - errInvalidExceptionSystem = "'goto', 'setjump', 'cpp' or 'quirky' expected, but '$1' found" + errGuiConsoleOrLibExpectedButXFound = "'gui', 'console', 'lib' or 'staticlib' expected, but '$1' found" + errInvalidExceptionSystem = "'goto', 'setjmp', 'cpp' or 'quirky' expected, but '$1' found" + errInvalidFeatureButXFound = Feature.toSeq.map(proc(val:Feature): string = "'$1'" % $val).join(", ") & " expected, but '$1' found" template warningOptionNoop(switch: string) = warningDeprecated(conf, info, "'$#' is deprecated, now a noop" % switch) @@ -242,7 +258,7 @@ template deprecatedAlias(oldName, newName: string) = proc testCompileOptionArg*(conf: ConfigRef; switch, arg: string, info: TLineInfo): bool = case switch.normalize - of "gc": + of "gc", "mm": case arg.normalize of "boehm": result = conf.selectedGC == gcBoehm of "refc": result = conf.selectedGC == gcRefc @@ -253,14 +269,18 @@ proc testCompileOptionArg*(conf: ConfigRef; switch, arg: string, info: TLineInfo of "go": result = conf.selectedGC == gcGo of "none": result = conf.selectedGC == gcNone of "stack", "regions": result = conf.selectedGC == gcRegions - of "v2", "generational": warningOptionNoop(arg) - else: localError(conf, info, errNoneBoehmRefcExpectedButXFound % arg) + of "atomicarc": result = conf.selectedGC == gcAtomicArc + else: + result = false + localError(conf, info, errNoneBoehmRefcExpectedButXFound % arg) of "opt": case arg.normalize of "speed": result = contains(conf.options, optOptimizeSpeed) of "size": result = contains(conf.options, optOptimizeSize) of "none": result = conf.options * {optOptimizeSpeed, optOptimizeSize} == {} - else: localError(conf, info, errNoneSpeedOrSizeExpectedButXFound % arg) + else: + result = false + localError(conf, info, errNoneSpeedOrSizeExpectedButXFound % arg) of "verbosity": result = $conf.verbosity == arg of "app": case arg.normalize @@ -270,7 +290,9 @@ proc testCompileOptionArg*(conf: ConfigRef; switch, arg: string, info: TLineInfo not contains(conf.globalOptions, optGenGuiApp) of "staticlib": result = contains(conf.globalOptions, optGenStaticLib) and not contains(conf.globalOptions, optGenGuiApp) - else: localError(conf, info, errGuiConsoleOrLibExpectedButXFound % arg) + else: + result = false + localError(conf, info, errGuiConsoleOrLibExpectedButXFound % arg) of "dynliboverride": result = isDynlibOverride(conf, arg) of "exceptions": @@ -279,8 +301,18 @@ proc testCompileOptionArg*(conf: ConfigRef; switch, arg: string, info: TLineInfo of "setjmp": result = conf.exc == excSetjmp of "quirky": result = conf.exc == excQuirky of "goto": result = conf.exc == excGoto - else: localError(conf, info, errInvalidExceptionSystem % arg) - else: invalidCmdLineOption(conf, passCmd1, switch, info) + else: + result = false + localError(conf, info, errInvalidExceptionSystem % arg) + of "experimental": + try: + result = conf.features.contains parseEnum[Feature](arg) + except ValueError: + result = false + localError(conf, info, errInvalidFeatureButXFound % arg) + else: + result = false + invalidCmdLineOption(conf, passCmd1, switch, info) proc testCompileOption*(conf: ConfigRef; switch: string, info: TLineInfo): bool = case switch.normalize @@ -318,6 +350,7 @@ proc testCompileOption*(conf: ConfigRef; switch: string, info: TLineInfo): bool of "run", "r": result = contains(conf.globalOptions, optRun) of "symbolfiles": result = conf.symbolFiles != disabledSf of "genscript": result = contains(conf.globalOptions, optGenScript) + of "gencdeps": result = contains(conf.globalOptions, optGenCDeps) of "threads": result = contains(conf.globalOptions, optThreads) of "tlsemulation": result = contains(conf.globalOptions, optTlsEmulation) of "implicitstatic": result = contains(conf.options, optImplicitStatic) @@ -325,8 +358,14 @@ proc testCompileOption*(conf: ConfigRef; switch: string, info: TLineInfo): bool if switch.normalize == "patterns": deprecatedAlias(switch, "trmacros") result = contains(conf.options, optTrMacros) of "excessivestacktrace": result = contains(conf.globalOptions, optExcessiveStackTrace) - of "nilseqs", "nilchecks", "taintmode": warningOptionNoop(switch) - else: invalidCmdLineOption(conf, passCmd1, switch, info) + of "nilseqs", "nilchecks", "taintmode": + warningOptionNoop(switch) + result = false + of "panics": result = contains(conf.globalOptions, optPanics) + of "jsbigint64": result = contains(conf.globalOptions, optJsBigInt64) + else: + result = false + invalidCmdLineOption(conf, passCmd1, switch, info) proc processPath(conf: ConfigRef; path: string, info: TLineInfo, notRelativeToProj = false): AbsoluteDir = @@ -359,31 +398,53 @@ proc processCfgPath(conf: ConfigRef; path: string, info: TLineInfo): AbsoluteDir const errInvalidNumber = "$1 is not a valid number" +proc makeAbsolute(s: string): AbsoluteFile = + if isAbsolute(s): + AbsoluteFile pathnorm.normalizePath(s) + else: + AbsoluteFile pathnorm.normalizePath(os.getCurrentDir() / s) + +proc setTrackingInfo(conf: ConfigRef; dirty, file, line, column: string, + info: TLineInfo) = + ## set tracking info, common code for track, trackDirty, & ideTrack + var ln: int = 0 + var col: int = 0 + if parseUtils.parseInt(line, ln) <= 0: + localError(conf, info, errInvalidNumber % line) + if parseUtils.parseInt(column, col) <= 0: + localError(conf, info, errInvalidNumber % column) + + let a = makeAbsolute(file) + if dirty == "": + conf.m.trackPos = newLineInfo(conf, a, ln, col) + else: + let dirtyOriginalIdx = fileInfoIdx(conf, a) + if dirtyOriginalIdx.int32 >= 0: + msgs.setDirtyFile(conf, dirtyOriginalIdx, makeAbsolute(dirty)) + conf.m.trackPos = newLineInfo(dirtyOriginalIdx, ln, col) + 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") - var line, column: int - if parseUtils.parseInt(a[2], line) <= 0: - localError(conf, info, errInvalidNumber % a[1]) - if parseUtils.parseInt(a[3], column) <= 0: - localError(conf, info, errInvalidNumber % a[2]) - - let dirtyOriginalIdx = fileInfoIdx(conf, AbsoluteFile a[1]) - if dirtyOriginalIdx.int32 >= 0: - msgs.setDirtyFile(conf, dirtyOriginalIdx, AbsoluteFile a[0]) - - conf.m.trackPos = newLineInfo(dirtyOriginalIdx, line, column) + 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") - var line, column: int - if parseUtils.parseInt(a[1], line) <= 0: - localError(conf, info, errInvalidNumber % a[1]) - if parseUtils.parseInt(a[2], column) <= 0: - localError(conf, info, errInvalidNumber % a[2]) - conf.m.trackPos = newLineInfo(conf, AbsoluteFile a[0], line, column) + setTrackingInfo(conf, "", a[0], a[1], a[2], info) + +proc trackIde(conf: ConfigRef; cmd: IdeCmd, arg: string, info: TLineInfo) = + ## set the tracking info related to an ide cmd, supports optional dirty file + var a = arg.split(',') + case a.len + of 4: + setTrackingInfo(conf, a[0], a[1], a[2], a[3], info) + of 3: + setTrackingInfo(conf, "", a[0], a[1], a[2], info) + else: + localError(conf, info, "[DIRTY_BUFFER,]ORIGINAL_FILE,LINE,COLUMN expected") + conf.ideCmd = cmd proc dynlibOverride(conf: ConfigRef; switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = if pass in {passCmd2, passPP}: @@ -412,12 +473,16 @@ proc parseCommand*(command: string): Command = of "objc", "compiletooc": cmdCompileToOC of "js", "compiletojs": cmdCompileToJS of "r": cmdCrun + of "m": cmdM of "run": cmdTcc of "check": cmdCheck of "e": cmdNimscript of "doc0": cmdDoc0 - of "doc2", "doc": cmdDoc2 + of "doc2", "doc": cmdDoc + of "doc2tex": cmdDoc2tex of "rst2html": cmdRst2html + of "md2tex": cmdMd2tex + of "md2html": cmdMd2html of "rst2tex": cmdRst2tex of "jsondoc0": cmdJsondoc0 of "jsondoc2", "jsondoc": cmdJsondoc @@ -449,15 +514,121 @@ proc setCommandEarly*(conf: ConfigRef, command: string) = # command early customizations # 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. + of cmdRst2html, cmdRst2tex, cmdMd2html, cmdMd2tex: + # xxx see whether to add others: cmdGendepend, etc. conf.foreignPackageNotes = {hintSuccessX} else: conf.foreignPackageNotes = foreignPackageNotesDefault +proc specialDefine(conf: ConfigRef, key: string; pass: TCmdLinePass) = + # Keep this syncronized with the default config/nim.cfg! + if cmpIgnoreStyle(key, "nimQuirky") == 0: + 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.globalOptions.excl {optExcessiveStackTrace, optCDebug} + conf.options.incl optOptimizeSpeed + if cmpIgnoreStyle(key, "danger") == 0 or cmpIgnoreStyle(key, "quick") == 0: + if pass in {passCmd1, passPP}: + conf.options.excl {optObjCheck, optFieldCheck, optRangeCheck, optBoundsCheck, + optOverflowCheck, optAssert, optStackTrace, optLineTrace, optLineDir} + conf.globalOptions.excl {optCDebug} + +proc initOrcDefines*(conf: ConfigRef) = + conf.selectedGC = gcOrc + defineSymbol(conf.symbols, "gcorc") + defineSymbol(conf.symbols, "gcdestructors") + incl conf.globalOptions, optSeqDestructors + incl conf.globalOptions, optTinyRtti + defineSymbol(conf.symbols, "nimSeqsV2") + defineSymbol(conf.symbols, "nimV2") + if conf.exc == excNone and conf.backend != backendCpp: + conf.exc = excGoto + +proc registerArcOrc(pass: TCmdLinePass, conf: ConfigRef) = + defineSymbol(conf.symbols, "gcdestructors") + incl conf.globalOptions, optSeqDestructors + incl conf.globalOptions, optTinyRtti + if pass in {passCmd2, passPP}: + defineSymbol(conf.symbols, "nimSeqsV2") + defineSymbol(conf.symbols, "nimV2") + if conf.exc == excNone and conf.backend != backendCpp: + conf.exc = excGoto + +proc unregisterArcOrc*(conf: ConfigRef) = + undefSymbol(conf.symbols, "gcdestructors") + undefSymbol(conf.symbols, "gcarc") + undefSymbol(conf.symbols, "gcorc") + undefSymbol(conf.symbols, "gcatomicarc") + undefSymbol(conf.symbols, "nimSeqsV2") + undefSymbol(conf.symbols, "nimV2") + excl conf.globalOptions, optSeqDestructors + excl conf.globalOptions, optTinyRtti + +proc processMemoryManagementOption(switch, arg: string, pass: TCmdLinePass, + info: TLineInfo; conf: ConfigRef) = + if conf.backend == backendJs: return # for: bug #16033 + expectArg(conf, switch, arg, pass, info) + if pass in {passCmd2, passPP}: + case arg.normalize + of "boehm": + unregisterArcOrc(conf) + conf.selectedGC = gcBoehm + defineSymbol(conf.symbols, "boehmgc") + incl conf.globalOptions, optTlsEmulation # Boehm GC doesn't scan the real TLS + of "refc": + unregisterArcOrc(conf) + defineSymbol(conf.symbols, "gcrefc") + conf.selectedGC = gcRefc + of "markandsweep": + unregisterArcOrc(conf) + conf.selectedGC = gcMarkAndSweep + defineSymbol(conf.symbols, "gcmarkandsweep") + of "destructors", "arc": + conf.selectedGC = gcArc + defineSymbol(conf.symbols, "gcarc") + registerArcOrc(pass, conf) + of "orc": + conf.selectedGC = gcOrc + defineSymbol(conf.symbols, "gcorc") + registerArcOrc(pass, conf) + of "atomicarc": + conf.selectedGC = gcAtomicArc + defineSymbol(conf.symbols, "gcatomicarc") + registerArcOrc(pass, conf) + of "hooks": + conf.selectedGC = gcHooks + defineSymbol(conf.symbols, "gchooks") + incl conf.globalOptions, optSeqDestructors + processOnOffSwitchG(conf, {optSeqDestructors}, arg, pass, info) + if pass in {passCmd2, passPP}: + defineSymbol(conf.symbols, "nimSeqsV2") + of "go": + unregisterArcOrc(conf) + conf.selectedGC = gcGo + defineSymbol(conf.symbols, "gogc") + of "none": + unregisterArcOrc(conf) + conf.selectedGC = gcNone + defineSymbol(conf.symbols, "nogc") + of "stack", "regions": + unregisterArcOrc(conf) + conf.selectedGC = gcRegions + defineSymbol(conf.symbols, "gcregions") + else: localError(conf, info, errNoneBoehmRefcExpectedButXFound % arg) + +proc pathRelativeToConfig(arg: string, pass: TCmdLinePass, conf: ConfigRef): string = + if pass == passPP and not isAbsolute(arg): + assert isAbsolute(conf.currentConfigDir), "something is wrong with currentConfigDir" + result = conf.currentConfigDir / arg + else: + result = arg + proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; conf: ConfigRef) = - var - key, val: string + var key = "" + var val = "" case switch.normalize of "eval": expectArg(conf, switch, arg, pass, info) @@ -472,17 +643,17 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; for path in nimbleSubs(conf, arg): addPath(conf, if pass == passPP: processCfgPath(conf, path, info) else: processPath(conf, path, info), info) - of "nimblepath", "babelpath": - if switch.normalize == "babelpath": deprecatedAlias(switch, "nimblepath") + of "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) let nimbleDir = AbsoluteDir getEnv("NIMBLE_DIR") if not nimbleDir.isEmpty and pass == passPP: + path = nimbleDir / RelativeDir"pkgs2" + nimblePath(conf, path, info) path = nimbleDir / RelativeDir"pkgs" nimblePath(conf, path, info) - of "nonimblepath", "nobabelpath": - if switch.normalize == "nobabelpath": deprecatedAlias(switch, "nonimblepath") + of "nonimblepath": expectNoArg(conf, switch, arg, pass, info) disableNimblePath(conf) of "clearnimblepath": @@ -495,7 +666,11 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; conf.lazyPaths.keepItIf(it != path) of "nimcache": expectArg(conf, switch, arg, pass, info) - conf.nimcacheDir = processPath(conf, arg, info, notRelativeToProj=true) + var arg = arg + # 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, pathRelativeToConfig(arg, pass, conf), info, notRelativeToProj=true) of "out", "o": expectArg(conf, switch, arg, pass, info) let f = splitFile(processPath(conf, arg, info, notRelativeToProj=true).string) @@ -514,18 +689,21 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; of "backend", "b": let backend = parseEnum(arg.normalize, TBackend.default) if backend == TBackend.default: localError(conf, info, "invalid backend: '$1'" % arg) + if backend == backendJs: # bug #21209 + conf.globalOptions.excl {optThreadAnalysis, optThreads} + if optRun in conf.globalOptions: + # for now, -r uses nodejs, so define nodejs + defineSymbol(conf.symbols, "nodejs") conf.backend = backend of "doccmd": conf.docCmd = arg of "define", "d": expectArg(conf, switch, arg, pass, info) if {':', '='} in arg: splitSwitch(conf, arg, key, val, pass, info) - if cmpIgnoreStyle(key, "nimQuirky") == 0: - conf.exc = excQuirky + specialDefine(conf, key, pass) defineSymbol(conf.symbols, key, val) else: - if cmpIgnoreStyle(arg, "nimQuirky") == 0: - conf.exc = excQuirky + specialDefine(conf, arg, pass) defineSymbol(conf.symbols, arg) of "undef", "u": expectArg(conf, switch, arg, pass, info) @@ -552,59 +730,10 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; of "project": processOnOffSwitchG(conf, {optWholeProject, optGenIndex}, arg, pass, info) of "gc": - if conf.backend == backendJs: return # for: bug #16033 - expectArg(conf, switch, arg, pass, info) - if pass in {passCmd2, passPP}: - case arg.normalize - of "boehm": - conf.selectedGC = gcBoehm - defineSymbol(conf.symbols, "boehmgc") - incl conf.globalOptions, optTlsEmulation # Boehm GC doesn't scan the real TLS - of "refc": - conf.selectedGC = gcRefc - of "markandsweep": - conf.selectedGC = gcMarkAndSweep - defineSymbol(conf.symbols, "gcmarkandsweep") - of "destructors", "arc": - conf.selectedGC = gcArc - defineSymbol(conf.symbols, "gcdestructors") - defineSymbol(conf.symbols, "gcarc") - incl conf.globalOptions, optSeqDestructors - incl conf.globalOptions, optTinyRtti - if pass in {passCmd2, passPP}: - defineSymbol(conf.symbols, "nimSeqsV2") - defineSymbol(conf.symbols, "nimV2") - if conf.exc == excNone and conf.backend != backendCpp: - conf.exc = excGoto - of "orc": - conf.selectedGC = gcOrc - defineSymbol(conf.symbols, "gcdestructors") - defineSymbol(conf.symbols, "gcorc") - incl conf.globalOptions, optSeqDestructors - incl conf.globalOptions, optTinyRtti - if pass in {passCmd2, passPP}: - defineSymbol(conf.symbols, "nimSeqsV2") - defineSymbol(conf.symbols, "nimV2") - if conf.exc == excNone and conf.backend != backendCpp: - conf.exc = excGoto - of "hooks": - conf.selectedGC = gcHooks - defineSymbol(conf.symbols, "gchooks") - incl conf.globalOptions, optSeqDestructors - processOnOffSwitchG(conf, {optSeqDestructors}, arg, pass, info) - if pass in {passCmd2, passPP}: - defineSymbol(conf.symbols, "nimSeqsV2") - of "go": - conf.selectedGC = gcGo - defineSymbol(conf.symbols, "gogc") - of "none": - conf.selectedGC = gcNone - defineSymbol(conf.symbols, "nogc") - of "stack", "regions": - conf.selectedGC = gcRegions - defineSymbol(conf.symbols, "gcregions") - of "v2": warningOptionNoop(arg) - else: localError(conf, info, errNoneBoehmRefcExpectedButXFound % arg) + warningDeprecated(conf, info, "`gc:option` is deprecated; use `mm:option` instead") + processMemoryManagementOption(switch, arg, pass, info, conf) + of "mm": + processMemoryManagementOption(switch, arg, pass, info, conf) of "warnings", "w": if processOnOffSwitchOrList(conf, {optWarns}, arg, pass, info): listWarnings(conf) of "warning": processSpecificNote(arg, wWarning, pass, info, switch, conf) @@ -672,10 +801,13 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; of "linedir": processOnOffSwitch(conf, {optLineDir}, arg, pass, info) of "assertions", "a": processOnOffSwitch(conf, {optAssert}, arg, pass, info) of "threads": - if conf.backend == backendJs: discard + if conf.backend == backendJs or conf.cmd == cmdNimscript: discard else: processOnOffSwitchG(conf, {optThreads}, arg, pass, info) #if optThreads in conf.globalOptions: conf.setNote(warnGcUnsafe) - of "tlsemulation": processOnOffSwitchG(conf, {optTlsEmulation}, arg, pass, info) + of "tlsemulation": + processOnOffSwitchG(conf, {optTlsEmulation}, arg, pass, info) + if optTlsEmulation in conf.globalOptions: + conf.legacyFeatures.incl emitGenerics of "implicitstatic": processOnOffSwitch(conf, {optImplicitStatic}, arg, pass, info) of "patterns", "trmacros": @@ -712,6 +844,7 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; defineSymbol(conf.symbols, "dll") of "staticlib": incl(conf.globalOptions, optGenStaticLib) + incl(conf.globalOptions, optNoMain) excl(conf.globalOptions, optGenGuiApp) defineSymbol(conf.symbols, "library") defineSymbol(conf.symbols, "staticlib") @@ -731,12 +864,20 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; of "clib": expectArg(conf, switch, arg, pass, info) if pass in {passCmd2, passPP}: - conf.cLinkedLibs.add processPath(conf, arg, info).string + conf.cLinkedLibs.add arg of "header": if conf != nil: conf.headerFile = arg incl(conf.globalOptions, optGenIndex) + of "nimbasepattern": + if conf != nil: conf.nimbasePattern = arg of "index": - processOnOffSwitchG(conf, {optGenIndex}, arg, pass, info) + case arg.normalize + of "", "on": conf.globalOptions.incl {optGenIndex} + of "only": conf.globalOptions.incl {optGenIndexOnly, optGenIndex} + of "off": conf.globalOptions.excl {optGenIndex, optGenIndexOnly} + else: localError(conf, info, errOnOrOffExpectedButXFound % arg) + of "noimportdoc": + processOnOffSwitchG(conf, {optNoImportdoc}, arg, pass, info) of "import": expectArg(conf, switch, arg, pass, info) if pass in {passCmd2, passPP}: @@ -769,21 +910,28 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; setTarget(conf.target, conf.target.targetOS, cpu) of "run", "r": processOnOffSwitchG(conf, {optRun}, arg, pass, info) + if conf.backend == backendJs: + # for now, -r uses nodejs, so define nodejs + defineSymbol(conf.symbols, "nodejs") of "maxloopiterationsvm": expectArg(conf, switch, arg, pass, info) - conf.maxLoopIterationsVM = parseInt(arg) + var value: int = 10_000_000 + discard parseSaturatedNatural(arg, value) + if not value > 0: localError(conf, info, "maxLoopIterationsVM must be a positive integer greater than zero") + conf.maxLoopIterationsVM = value of "errormax": expectArg(conf, switch, arg, pass, info) # Note: `nim check` (etc) can overwrite this. # `0` is meaningless, give it a useful meaning as in clang's -ferror-limit # If user doesn't set this flag and the code doesn't either, it'd # have the same effect as errorMax = 1 - let ret = parseInt(arg) - conf.errorMax = if ret == 0: high(int) else: ret + var value: int = 0 + discard parseSaturatedNatural(arg, value) + conf.errorMax = if value == 0: high(int) else: value of "verbosity": expectArg(conf, switch, arg, pass, info) let verbosity = parseInt(arg) - if verbosity notin {0..3}: + if verbosity notin 0..3: localError(conf, info, "invalid verbosity level: '$1'" % arg) conf.verbosity = verbosity var verb = NotesVerbosity[conf.verbosity] @@ -793,7 +941,9 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; conf.mainPackageNotes = conf.notes of "parallelbuild": expectArg(conf, switch, arg, pass, info) - conf.numberOfProcessors = parseInt(arg) + var value: int = 0 + discard parseSaturatedNatural(arg, value) + conf.numberOfProcessors = value of "version", "v": expectNoArg(conf, switch, arg, pass, info) writeVersionInfo(conf, pass) @@ -818,6 +968,7 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; of "v2": conf.symbolFiles = v2Sf of "stress": conf.symbolFiles = stressTest else: localError(conf, info, "invalid option for --incremental: " & arg) + setUseIc(conf.symbolFiles != disabledSf) of "skipcfg": processOnOffSwitchG(conf, {optSkipSystemConfigFile}, arg, pass, info) of "skipprojcfg": @@ -830,6 +981,8 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; if switch.normalize == "gendeps": deprecatedAlias(switch, "genscript") processOnOffSwitchG(conf, {optGenScript}, arg, pass, info) processOnOffSwitchG(conf, {optCompileOnly}, arg, pass, info) + of "gencdeps": + processOnOffSwitchG(conf, {optGenCDeps}, arg, pass, info) of "colors": processOnOffSwitchG(conf, {optUseColors}, arg, pass, info) of "lib": expectArg(conf, switch, arg, pass, info) @@ -839,8 +992,9 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; splitSwitch(conf, arg, key, val, pass, info) os.putEnv(key, val) of "cc": - expectArg(conf, switch, arg, pass, info) - setCC(conf, arg, info) + if conf.backend != backendJs: # bug #19330 + expectArg(conf, switch, arg, pass, info) + setCC(conf, arg, info) of "track": expectArg(conf, switch, arg, pass, info) track(conf, arg, info) @@ -851,18 +1005,40 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; expectNoArg(conf, switch, arg, pass, info) conf.ideCmd = ideSug of "def": - expectNoArg(conf, switch, arg, pass, info) - conf.ideCmd = ideDef + expectArg(conf, switch, arg, pass, info) + trackIde(conf, ideDef, arg, info) of "context": expectNoArg(conf, switch, arg, pass, info) conf.ideCmd = ideCon of "usages": - expectNoArg(conf, switch, arg, pass, info) - conf.ideCmd = ideUse + expectArg(conf, switch, arg, pass, info) + trackIde(conf, ideUse, arg, info) + of "defusages": + expectArg(conf, switch, arg, pass, info) + trackIde(conf, ideDus, arg, info) of "stdout": processOnOffSwitchG(conf, {optStdout}, arg, pass, info) + 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) + of "processing": + incl(conf.notes, hintProcessing) + incl(conf.mainPackageNotes, hintProcessing) + 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) + of "unitsep": + conf.unitSep = if switchOn(arg): "\31" else: "" of "listfullpaths": - processOnOffSwitchG(conf, {optListFullPaths}, arg, pass, info) + # xxx in future work, use `warningDeprecated` + conf.filenameOption = if switchOn(arg): foAbs else: foCanonical of "spellsuggest": if arg.len == 0: conf.spellSuggestMax = spellSuggestSecretSauce elif arg == "auto": conf.spellSuggestMax = spellSuggestSecretSauce @@ -890,6 +1066,9 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; expectNoArg(conf, switch, arg, pass, info) conf.exc = low(ExceptionSystem) defineSymbol(conf.symbols, "noCppExceptions") + of "shownonexports": + expectNoArg(conf, switch, arg, pass, info) + showNonExportedFields(conf) of "exceptions": case arg.normalize of "cpp": conf.exc = excCpp @@ -924,6 +1103,7 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; of "off": conf.globalOptions = conf.globalOptions - {optStyleHint, optStyleError} 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) of "showallmismatches": processOnOffSwitchG(conf, {optShowAllMismatches}, arg, pass, info) @@ -943,25 +1123,6 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; of "expandarc": expectArg(conf, switch, arg, pass, info) conf.arcToExpand[arg] = "T" - of "useversion": - expectArg(conf, switch, arg, pass, info) - case arg - of "1.0": - defineSymbol(conf.symbols, "NimMajor", "1") - defineSymbol(conf.symbols, "NimMinor", "0") - # old behaviors go here: - defineSymbol(conf.symbols, "nimOldRelativePathBehavior") - undefSymbol(conf.symbols, "nimDoesntTrackDefects") - ast.eqTypeFlags.excl {tfGcSafe, tfNoSideEffect} - conf.globalOptions.incl optNimV1Emulation - of "1.2": - defineSymbol(conf.symbols, "NimMajor", "1") - defineSymbol(conf.symbols, "NimMinor", "2") - conf.globalOptions.incl optNimV12Emulation - else: - localError(conf, info, "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) of "profilevm": @@ -975,6 +1136,8 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; processOnOffSwitchG(conf, {optPanics}, arg, pass, info) if optPanics in conf.globalOptions: defineSymbol(conf.symbols, "nimPanics") + of "jsbigint64": + processOnOffSwitchG(conf, {optJsBigInt64}, arg, pass, info) of "sourcemap": # xxx document in --fullhelp conf.globalOptions.incl optSourcemap conf.options.incl optLineDir @@ -982,13 +1145,15 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; processOnOffSwitchG(conf, {optEnableDeepCopy}, arg, pass, info) 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", "symbol", "taintmode", "cs", "deadcodeelim": warningOptionNoop(switch) + of "nimmainprefix": conf.nimMainPrefix = arg else: if strutils.find(switch, '.') >= 0: options.setConfigVar(conf, switch, arg) else: invalidCmdLineOption(conf, pass, switch, info) proc processCommand*(switch: string, pass: TCmdLinePass; config: ConfigRef) = - var cmd, arg: string + var cmd = "" + var arg = "" splitSwitch(config, switch, cmd, arg, pass, gCmdLineInfo) processSwitch(cmd, arg, pass, gCmdLineInfo, config) @@ -1015,13 +1180,20 @@ proc processArgument*(pass: TCmdLinePass; p: OptParser; config.projectName = unixToNativePath(p.key) config.arguments = cmdLineRest(p) result = true - elif pass != passCmd2: setCommandEarly(config, p.key) + elif pass != passCmd2: + setCommandEarly(config, p.key) + result = false + else: result = false else: if pass == passCmd1: config.commandArgs.add p.key if argsCount == 1: + if p.key.endsWith(".nims"): + incl(config.globalOptions, optWasNimscript) # support UNIX style filenames everywhere for portable build scripts: if config.projectName.len == 0: config.projectName = unixToNativePath(p.key) config.arguments = cmdLineRest(p) result = true + else: + result = false inc argsCount diff --git a/compiler/compiler.nimble b/compiler/compiler.nimble new file mode 100644 index 000000000..ef3f343e1 --- /dev/null +++ b/compiler/compiler.nimble @@ -0,0 +1,28 @@ +include "../lib/system/compilation.nim" +version = $NimMajor & "." & $NimMinor & "." & $NimPatch +author = "Andreas Rumpf" +description = "Compiler package providing the compiler sources as a library." +license = "MIT" +skipDirs = @["."] +installDirs = @["compiler"] + +import os + +var compilerDir = "" + +before install: + rmDir("compiler") + + let + files = listFiles(".") + dirs = listDirs(".") + + mkDir("compiler") + + for f in files: + cpFile(f, "compiler" / f) + + for d in dirs: + cpDir(d, "compiler" / d) + +requires "nim" diff --git a/compiler/concepts.nim b/compiler/concepts.nim index 54579f73f..d48bacdc5 100644 --- a/compiler/concepts.nim +++ b/compiler/concepts.nim @@ -11,10 +11,12 @@ ## 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 -from magicsys import addSonSkipIntLit +import std/intsets + +when defined(nimPreviewSlimSystem): + import std/assertions const logBindings = false @@ -23,30 +25,18 @@ const ## -------------------------------------- proc declareSelf(c: PContext; info: TLineInfo) = - ## adds the magical 'Self' symbols to the current scope. + ## Adds the magical 'Self' symbols to the current scope. let ow = getCurrOwner(c) - let s = newSym(skType, getIdent(c.cache, "Self"), nextSymId(c.idgen), ow, info) - s.typ = newType(tyTypeDesc, nextTypeId(c.idgen), ow) + let s = newSym(skType, getIdent(c.cache, "Self"), c.idgen, ow, info) + s.typ = newType(tyTypeDesc, c.idgen, ow) s.typ.flags.incl {tfUnresolved, tfPacked} - s.typ.add newType(tyEmpty, nextTypeId(c.idgen), ow) + s.typ.add newType(tyEmpty, c.idgen, ow) addDecl(c, s, info) -proc isSelf*(t: PType): bool {.inline.} = - ## is this the magical 'Self' type? - t.kind == tyTypeDesc and tfPacked in t.flags - -proc makeTypeDesc*(c: PContext, typ: PType): PType = - if typ.kind == tyTypeDesc and not isSelf(typ): - result = typ - else: - result = newTypeS(tyTypeDesc, c) - incl result.flags, tfCheckedForDestructor - result.addSonSkipIntLit(typ, c.idgen) - proc semConceptDecl(c: PContext; n: PNode): PNode = ## Recursive helper for semantic checking for the concept declaration. - ## Currently we only support lists of statements containing 'proc' - ## declarations and the like. + ## Currently we only support (possibly empty) lists of statements + ## containing 'proc' declarations and the like. case n.kind of nkStmtList, nkStmtListExpr: result = shallowCopy(n) @@ -59,8 +49,10 @@ proc semConceptDecl(c: PContext; n: PNode): PNode = for i in 0..<n.len-1: result[i] = n[i] result[^1] = semConceptDecl(c, n[^1]) + of nkCommentStmt: + result = n else: - localError(c.config, n.info, "unexpected construct in the new-styled concept " & renderTree(n)) + localError(c.config, n.info, "unexpected construct in the new-styled concept: " & renderTree(n)) result = n proc semConceptDeclaration*(c: PContext; n: PNode): PNode = @@ -97,14 +89,14 @@ proc existingBinding(m: MatchCon; key: PType): PType = proc conceptMatchNode(c: PContext; n: PNode; m: var MatchCon): bool proc matchType(c: PContext; f, a: PType; m: var MatchCon): bool = - ## the heart of the concept matching process. 'f' is the formal parameter of some + ## The heart of the concept matching process. 'f' is the formal parameter of some ## routine inside the concept that we're looking for. 'a' is the formal parameter ## of a routine that might match. const ignorableForArgType = {tyVar, tySink, tyLent, tyOwned, tyGenericInst, tyAlias, tyInferred} case f.kind of tyAlias: - result = matchType(c, f.lastSon, a, m) + result = matchType(c, f.skipModifier, a, m) of tyTypeDesc: if isSelf(f): #let oldLen = m.inferred.len @@ -113,15 +105,19 @@ proc matchType(c: PContext; f, a: PType; m: var MatchCon): bool = #m.inferred.setLen oldLen #echo "A for ", result, " to ", typeToString(a), " to ", typeToString(m.potentialImplementation) else: - if a.kind == tyTypeDesc and f.len == a.len: - for i in 0..<a.len: - if not matchType(c, f[i], a[i], m): return false - return true + if a.kind == tyTypeDesc and f.hasElementType == a.hasElementType: + if f.hasElementType: + result = matchType(c, f.elementType, a.elementType, m) + else: + result = true # both lack it + else: + result = false of tyGenericInvocation: - if a.kind == tyGenericInst and a[0].kind == tyGenericBody: - if sameType(f[0], a[0]) and f.len == a.len-1: - for i in 1 ..< f.len: + result = false + if a.kind == tyGenericInst and a.genericHead.kind == tyGenericBody: + if sameType(f.genericHead, a.genericHead) and f.kidsLen == a.kidsLen-1: + for i in FirstGenericParamAt ..< f.kidsLen: if not matchType(c, f[i], a[i], m): return false return true of tyGenericParam: @@ -131,17 +127,17 @@ proc matchType(c: PContext; f, a: PType; m: var MatchCon): bool = else: let old = existingBinding(m, f) if old == nil: - if f.len > 0 and f[0].kind != tyNone: + if f.hasElementType and f.elementType.kind != tyNone: # also check the generic's constraints: let oldLen = m.inferred.len - result = matchType(c, f[0], a, m) + result = matchType(c, f.elementType, a, m) m.inferred.setLen oldLen if result: when logBindings: echo "A adding ", f, " ", ak m.inferred.add((f, ak)) - elif m.magic == mArrGet and ak.kind in {tyArray, tyOpenArray, tySequence, tyVarargs, tyCString, tyString}: + elif m.magic == mArrGet and ak.kind in {tyArray, tyOpenArray, tySequence, tyVarargs, tyCstring, tyString}: when logBindings: echo "B adding ", f, " ", lastSon ak - m.inferred.add((f, lastSon ak)) + m.inferred.add((f, last ak)) result = true else: when logBindings: echo "C adding ", f, " ", ak @@ -152,25 +148,27 @@ proc matchType(c: PContext; f, a: PType; m: var MatchCon): bool = result = matchType(c, old, ak, m) if m.magic == mArrPut and ak.kind == tyGenericParam: result = true + else: + result = false #echo "B for ", result, " to ", typeToString(a), " to ", typeToString(m.potentialImplementation) of tyVar, tySink, tyLent, tyOwned: # modifiers in the concept must be there in the actual implementation # too but not vice versa. if a.kind == f.kind: - result = matchType(c, f.sons[0], a.sons[0], m) + result = matchType(c, f.elementType, a.elementType, m) elif m.magic == mArrPut: - result = matchType(c, f.sons[0], a, m) + result = matchType(c, f.elementType, a, m) else: result = false of tyEnum, tyObject, tyDistinct: result = sameType(f, a) - of tyEmpty, tyString, tyCString, tyPointer, tyNil, tyUntyped, tyTyped, tyVoid: + of tyEmpty, tyString, tyCstring, tyPointer, tyNil, tyUntyped, tyTyped, tyVoid: result = a.skipTypes(ignorableForArgType).kind == f.kind of tyBool, tyChar, tyInt..tyUInt64: let ak = a.skipTypes(ignorableForArgType) result = ak.kind == f.kind or ak.kind == tyOrdinal or - (ak.kind == tyGenericParam and ak.len > 0 and ak[0].kind == tyOrdinal) + (ak.kind == tyGenericParam and ak.hasElementType and ak.elementType.kind == tyOrdinal) of tyConcept: let oldLen = m.inferred.len let oldPotentialImplementation = m.potentialImplementation @@ -181,9 +179,11 @@ proc matchType(c: PContext; f, a: PType; m: var MatchCon): bool = m.inferred.setLen oldLen of tyArray, tyTuple, tyVarargs, tyOpenArray, tyRange, tySequence, tyRef, tyPtr, tyGenericInst: + # ^ XXX Rewrite this logic, it's more complex than it needs to be. + result = false let ak = a.skipTypes(ignorableForArgType - {f.kind}) - if ak.kind == f.kind and f.len == ak.len: - for i in 0..<ak.len: + if ak.kind == f.kind and f.kidsLen == ak.kidsLen: + for i in 0..<ak.kidsLen: if not matchType(c, f[i], ak[i], m): return false return true of tyOr: @@ -192,29 +192,30 @@ proc matchType(c: PContext; f, a: PType; m: var MatchCon): bool = # say the concept requires 'int|float|string' if the potentialImplementation # says 'int|string' that is good enough. var covered = 0 - for i in 0..<f.len: - for j in 0..<a.len: + for ff in f.kids: + for aa in a.kids: let oldLenB = m.inferred.len - let r = matchType(c, f[i], a[j], m) + let r = matchType(c, ff, aa, m) if r: inc covered break m.inferred.setLen oldLenB - result = covered >= a.len + result = covered >= a.kidsLen if not result: m.inferred.setLen oldLen else: - for i in 0..<f.len: - result = matchType(c, f[i], a, m) + result = false + for ff in f.kids: + result = matchType(c, ff, a, m) if result: break # and remember the binding! m.inferred.setLen oldLen of tyNot: if a.kind == tyNot: - result = matchType(c, f[0], a[0], m) + result = matchType(c, f.elementType, a.elementType, m) else: let oldLen = m.inferred.len - result = not matchType(c, f[0], a, m) + result = not matchType(c, f.elementType, a, m) m.inferred.setLen oldLen of tyAnything: result = true @@ -253,7 +254,7 @@ proc matchSym(c: PContext; candidate: PSym, n: PNode; m: var MatchCon): bool = m.inferred.setLen oldLen return false - if not matchReturnType(c, n[0].sym.typ.sons[0], candidate.typ.sons[0], m): + if not matchReturnType(c, n[0].sym.typ.returnType, candidate.typ.returnType, m): m.inferred.setLen oldLen return false @@ -270,7 +271,7 @@ proc matchSym(c: PContext; candidate: PSym, n: PNode; m: var MatchCon): bool = proc matchSyms(c: PContext, n: PNode; kinds: set[TSymKind]; m: var MatchCon): bool = ## Walk the current scope, extract candidates which the same name as 'n[namePos]', ## 'n' is the nkProcDef or similar from the concept that we try to match. - let candidates = searchInScopesFilterBy(c, n[namePos].sym.name, kinds) + let candidates = searchInScopesAllCandidatesFilterBy(c, n[namePos].sym.name, kinds) for candidate in candidates: #echo "considering ", typeToString(candidate.typ), " ", candidate.magic m.magic = candidate.magic @@ -302,17 +303,19 @@ proc conceptMatchNode(c: PContext; n: PNode; m: var MatchCon): bool = result = matchSyms(c, n, {skMethod}, m) of nkIteratorDef: result = matchSyms(c, n, {skIterator}, m) + of nkCommentStmt: + result = true else: # error was reported earlier. result = false -proc conceptMatch*(c: PContext; concpt, arg: PType; bindings: var TIdTable; invocation: PType): bool = +proc conceptMatch*(c: PContext; concpt, arg: PType; bindings: var TypeMapping; invocation: PType): bool = ## Entry point from sigmatch. 'concpt' is the concept we try to match (here still a PType but - ## we extract its AST via 'concpt.n.lastSon'). 'arg' is the type that might fullfill the + ## we extract its AST via 'concpt.n.lastSon'). 'arg' is the type that might fulfill the ## concept's requirements. If so, we return true and fill the 'bindings' with pairs of ## (typeVar, instance) pairs. ('typeVar' is usually simply written as a generic 'T'.) ## 'invocation' can be nil for atomic concepts. For non-atomic concepts, it contains the - ## 'C[S, T]' parent type that we look for. We need this because we need to store bindings + ## `C[S, T]` parent type that we look for. We need this because we need to store bindings ## for 'S' and 'T' inside 'bindings' on a successful match. It is very important that ## we do not add any bindings at all on an unsuccessful match! var m = MatchCon(inferred: @[], potentialImplementation: arg) @@ -333,8 +336,8 @@ proc conceptMatch*(c: PContext; concpt, arg: PType; bindings: var TIdTable; invo # we have a match, so bind 'arg' itself to 'concpt': bindings.idTablePut(concpt, arg) # invocation != nil means we have a non-atomic concept: - if invocation != nil and arg.kind == tyGenericInst and invocation.len == arg.len-1: + if invocation != nil and arg.kind == tyGenericInst and invocation.kidsLen == arg.kidsLen-1: # bind even more generic parameters assert invocation.kind == tyGenericInvocation - for i in 1 ..< invocation.len: + for i in FirstGenericParamAt ..< invocation.kidsLen: bindings.idTablePut(invocation[i], arg[i]) diff --git a/compiler/condsyms.nim b/compiler/condsyms.nim index aa955e763..5043fc5d4 100644 --- a/compiler/condsyms.nim +++ b/compiler/condsyms.nim @@ -10,7 +10,7 @@ # This module handles the conditional symbols. import - strtabs + std/strtabs from options import Feature from lineinfos import hintMin, hintMax, warnMin, warnMax @@ -25,7 +25,7 @@ proc undefSymbol*(symbols: StringTableRef; symbol: string) = # result = if isDefined(symbol): gSymbols[symbol] else: nil iterator definedSymbolNames*(symbols: StringTableRef): string = - for key, val in pairs(symbols): + for key in keys(symbols): yield key proc countDefinedSymbols*(symbols: StringTableRef): int = @@ -45,10 +45,8 @@ proc initDefines*(symbols: StringTableRef) = defineSymbol("nimNewTypedesc") # deadcode defineSymbol("nimrequiresnimframe") # deadcode defineSymbol("nimparsebiggestfloatmagic") # deadcode - defineSymbol("nimalias") # deadcode defineSymbol("nimlocks") # deadcode - defineSymbol("nimnode") # deadcode pending `nimnode` reference in opengl package - # refs https://github.com/nim-lang/opengl/pull/79 + defineSymbol("nimnode") # deadcode defineSymbol("nimvarargstyped") # deadcode defineSymbol("nimtypedescfixed") # deadcode defineSymbol("nimKnowsNimvm") # deadcode @@ -70,7 +68,7 @@ proc initDefines*(symbols: StringTableRef) = defineSymbol("nimVmExportFixed") # deadcode defineSymbol("nimHasSymOwnerInMacro") # deadcode defineSymbol("nimNewRuntime") # deadcode - defineSymbol("nimIncrSeqV3") # xxx: turn this into deadcode + defineSymbol("nimIncrSeqV3") # deadcode defineSymbol("nimAshr") # deadcode defineSymbol("nimNoNilSeqs") # deadcode defineSymbol("nimNoNilSeqs2") # deadcode @@ -84,10 +82,24 @@ proc initDefines*(symbols: StringTableRef) = defineSymbol("nimHasSignatureHashInMacro") # deadcode defineSymbol("nimHasDefault") # deadcode defineSymbol("nimMacrosSizealignof") # deadcode + defineSymbol("nimNoZeroExtendMagic") # deadcode + defineSymbol("nimMacrosGetNodeId") # deadcode + defineSymbol("nimFixedForwardGeneric") # deadcode + defineSymbol("nimToOpenArrayCString") # deadcode + defineSymbol("nimHasUsed") # deadcode + defineSymbol("nimnomagic64") # deadcode + defineSymbol("nimNewShiftOps") # deadcode + defineSymbol("nimHasCursor") # deadcode + defineSymbol("nimAlignPragma") # deadcode + defineSymbol("nimHasExceptionsQuery") # deadcode + defineSymbol("nimHasIsNamedTuple") # deadcode + defineSymbol("nimHashOrdinalFixed") # deadcode + defineSymbol("nimHasSinkInference") # deadcode + defineSymbol("nimNewIntegerOps") # deadcode + defineSymbol("nimHasInvariant") # deadcode + + - # > 0.20.0 - defineSymbol("nimNoZeroExtendMagic") - defineSymbol("nimMacrosGetNodeId") for f in Feature: defineSymbol("nimHas" & $f) @@ -98,31 +110,18 @@ proc initDefines*(symbols: StringTableRef) = defineSymbol("nimFixedOwned") defineSymbol("nimHasStyleChecks") - defineSymbol("nimToOpenArrayCString") - defineSymbol("nimHasUsed") - defineSymbol("nimFixedForwardGeneric") - defineSymbol("nimnomagic64") - defineSymbol("nimNewShiftOps") - defineSymbol("nimHasCursor") - defineSymbol("nimAlignPragma") - defineSymbol("nimHasExceptionsQuery") - defineSymbol("nimHasIsNamedTuple") - defineSymbol("nimHashOrdinalFixed") when defined(nimHasLibFFI): # Renaming as we can't conflate input vs output define flags; e.g. this # will report the right thing regardless of whether user adds # `-d:nimHasLibFFI` in his user config. - defineSymbol("nimHasLibFFIEnabled") + defineSymbol("nimHasLibFFIEnabled") # deadcode - defineSymbol("nimHasSinkInference") - defineSymbol("nimNewIntegerOps") - defineSymbol("nimHasInvariant") - defineSymbol("nimHasStacktraceMsgs") + defineSymbol("nimHasStacktraceMsgs") # deadcode defineSymbol("nimDoesntTrackDefects") - defineSymbol("nimHasLentIterators") - defineSymbol("nimHasDeclaredMagic") - defineSymbol("nimHasStacktracesModule") + defineSymbol("nimHasLentIterators") # deadcode + defineSymbol("nimHasDeclaredMagic") # deadcode + defineSymbol("nimHasStacktracesModule") # deadcode defineSymbol("nimHasEffectTraitsModule") defineSymbol("nimHasCastPragmaBlocks") defineSymbol("nimHasDeclaredLocs") @@ -130,3 +129,43 @@ proc initDefines*(symbols: StringTableRef) = defineSymbol("nimHasWarningAsError") defineSymbol("nimHasHintAsError") defineSymbol("nimHasSpellSuggest") + defineSymbol("nimHasCustomLiterals") + defineSymbol("nimHasUnifiedTuple") + defineSymbol("nimHasIterable") + defineSymbol("nimHasTypeofVoid") # deadcode + defineSymbol("nimHasDragonBox") # deadcode + defineSymbol("nimHasHintAll") + defineSymbol("nimHasTrace") + defineSymbol("nimHasEffectsOf") + + defineSymbol("nimHasEnforceNoRaises") + defineSymbol("nimHasTopDownInference") + defineSymbol("nimHasTemplateRedefinitionPragma") + defineSymbol("nimHasCstringCase") + defineSymbol("nimHasCallsitePragma") + + defineSymbol("nimHasWarnCastSizes") # deadcode + defineSymbol("nimHasOutParams") + defineSymbol("nimHasSystemRaisesDefect") + defineSymbol("nimHasWarnUnnamedBreak") + defineSymbol("nimHasGenericDefine") + defineSymbol("nimHasDefineAliases") + defineSymbol("nimHasWarnBareExcept") + defineSymbol("nimHasDup") + defineSymbol("nimHasChecksums") + defineSymbol("nimHasSendable") + defineSymbol("nimAllowNonVarDestructor") + defineSymbol("nimHasQuirky") + defineSymbol("nimHasEnsureMove") + defineSymbol("nimHasNoReturnError") + + defineSymbol("nimUseStrictDefs") + defineSymbol("nimHasNolineTooLong") + + defineSymbol("nimHasCastExtendedVm") + defineSymbol("nimHasWarnStdPrefix") + + defineSymbol("nimHasVtables") + defineSymbol("nimHasGenericsOpenSym2") + defineSymbol("nimHasGenericsOpenSym3") + defineSymbol("nimHasJsNoLambdaLifting") diff --git a/compiler/debugutils.nim b/compiler/debugutils.nim new file mode 100644 index 000000000..adbb0517f --- /dev/null +++ b/compiler/debugutils.nim @@ -0,0 +1,72 @@ +##[ +Utilities to help with debugging nim compiler. + +Experimental API, subject to change. +]## + +#[ +## example +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 +]# + +import options +import std/wrapnils +export wrapnils + # allows using things like: `?.n.sym.typ.len` + +import std/stackframes +export stackframes + # allows using things like: `setFrameMsg c.config$n.info & " " & $n.kind` + # which doesn't log, but augments stacktrace with side channel information + +var conf0: ConfigRef + +proc onNewConfigRef*(conf: ConfigRef) {.inline.} = + ## Caches `conf`, which can be retrieved with `getConfigRef`. + ## This avoids having to forward `conf` all the way down the call chain to + ## procs that need it during a debugging session. + conf0 = conf + +proc getConfigRef*(): ConfigRef = + ## nil, if -d:nimDebugUtils wasn't specified + result = conf0 + +proc isCompilerDebug*(): bool = + ##[ + Provides a simple way for user code to enable/disable logging in the compiler + in a granular way. This can then be used in the compiler as follows: + ```nim + if isCompilerDebug(): + echo ?.n.sym.typ.len + ``` + ]## + runnableExamples: + proc main = + echo 2 + {.define(nimCompilerDebug).} + echo 3.5 # code section in which `isCompilerDebug` will be true + {.undef(nimCompilerDebug).} + echo 'x' + conf0.isDefined("nimCompilerDebug") + +proc enteringDebugSection*() {.exportc, dynlib.} = + ## Provides a way for native debuggers to enable breakpoints, watchpoints, etc + ## when code of interest is being compiled. + ## + ## Set your debugger to break on entering `nimCompilerIsEnteringDebugSection` + ## and then execute a desired command. + discard + +proc exitingDebugSection*() {.exportc, dynlib.} = + ## Provides a way for native debuggers to disable breakpoints, watchpoints, etc + ## when code of interest is no longer being compiled. + ## + ## Set your debugger to break on entering `exitingDebugSection` + ## and then execute a desired command. + discard diff --git a/compiler/depends.nim b/compiler/depends.nim index 7225b6b47..638f1eb51 100644 --- a/compiler/depends.nim +++ b/compiler/depends.nim @@ -9,10 +9,17 @@ # This module implements a dependency file generator. -import - options, ast, ropes, idents, passes, modulepaths, pathutils +import options, ast, ropes, pathutils, msgs, lineinfos + +import modulegraphs + +import std/[os, parseutils] +import std/strutils except addf +import std/private/globs + +when defined(nimPreviewSlimSystem): + import std/assertions -from modulegraphs import ModuleGraph, PPassContext type TGen = object of PPassContext @@ -25,21 +32,67 @@ type dotGraph: Rope proc addDependencyAux(b: Backend; importing, imported: string) = - b.dotGraph.addf("$1 -> \"$2\";$n", [rope(importing), rope(imported)]) + b.dotGraph.addf("\"$1\" -> \"$2\";$n", [rope(importing), rope(imported)]) # s1 -> s2_4[label="[0-9]"]; -proc addDotDependency(c: PPassContext, n: PNode): PNode = +proc toNimblePath(s: string, isStdlib: bool): string = + const stdPrefix = "std/" + const pkgPrefix = "pkg/" + if isStdlib: + let sub = "lib/" + var start = s.find(sub) + if start < 0: + raiseAssert "unreachable" + else: + start += sub.len + let base = s[start..^1] + + if base.startsWith("system") or base.startsWith("std"): + result = base + else: + for dir in stdlibDirs: + if base.startsWith(dir): + return stdPrefix & base.splitFile.name + + result = stdPrefix & base + else: + var sub = getEnv("NIMBLE_DIR") + if sub.len == 0: + sub = ".nimble/pkgs/" + else: + sub.add "/pkgs/" + var start = s.find(sub) + if start < 0: + sub[^1] = '2' + sub.add '/' + start = s.find(sub) # /pkgs2 + if start < 0: + return s + + start += sub.len + start += skipUntil(s, '/', start) + start += 1 + result = pkgPrefix & s[start..^1] + +proc addDependency(c: PPassContext, g: PGen, b: Backend, n: PNode) = + doAssert n.kind == nkSym, $n.kind + + let path = splitFile(toProjPath(g.config, n.sym.position.FileIndex)) + let modulePath = splitFile(toProjPath(g.config, g.module.position.FileIndex)) + let parent = nativeToUnixPath(modulePath.dir / modulePath.name).toNimblePath(belongsToStdlib(g.graph, g.module)) + let child = nativeToUnixPath(path.dir / path.name).toNimblePath(belongsToStdlib(g.graph, n.sym)) + addDependencyAux(b, parent, child) + +proc addDotDependency*(c: PPassContext, n: PNode): PNode = result = n let g = PGen(c) let b = Backend(g.graph.backend) case n.kind of nkImportStmt: for i in 0..<n.len: - var imported = getModuleName(g.config, n[i]) - addDependencyAux(b, g.module.name.s, imported) + addDependency(c, g, b, n[i]) of nkFromStmt, nkImportExceptStmt: - var imported = getModuleName(g.config, n[0]) - addDependencyAux(b, g.module.name.s, imported) + addDependency(c, g, b, n[0]) of nkStmtList, nkBlockStmt, nkStmtListExpr, nkBlockExpr: for i in 0..<n.len: discard addDotDependency(c, n[i]) else: @@ -51,18 +104,7 @@ proc generateDot*(graph: ModuleGraph; project: AbsoluteFile) = rope(project.splitFile.name), b.dotGraph], changeFileExt(project, "dot")) -when not defined(nimHasSinkInference): - {.pragma: nosinks.} - -proc myOpen(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext {.nosinks.} = - var g: PGen - new(g) - g.module = module - g.config = graph.config - g.graph = graph +proc setupDependPass*(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = + result = PGen(module: module, config: graph.config, graph: graph) if graph.backend == nil: - graph.backend = Backend(dotGraph: nil) - result = g - -const gendependPass* = makePass(open = myOpen, process = addDotDependency) - + graph.backend = Backend(dotGraph: "") diff --git a/compiler/dfa.nim b/compiler/dfa.nim index c7a9d4694..5534d07e7 100644 --- a/compiler/dfa.nim +++ b/compiler/dfa.nim @@ -9,37 +9,34 @@ ## Data flow analysis for Nim. ## We transform the AST into a linear list of instructions first to -## make this easier to handle: There are only 2 different branching +## make this easier to handle: There are only 3 different branching ## instructions: 'goto X' is an unconditional goto, 'fork X' ## is a conditional goto (either the next instruction or 'X' can be -## taken). Exhaustive case statements are translated +## taken), 'loop X' is the only jump that jumps back. +## +## Exhaustive case statements are translated ## so that the last branch is transformed into an 'else' branch. ## ``return`` and ``break`` are all covered by 'goto'. ## -## Control flow through exception handling: -## Contrary to popular belief, exception handling doesn't cause -## many problems for this DFA representation, ``raise`` is a statement -## that ``goes to`` the outer ``finally`` or ``except`` if there is one, -## otherwise it is the same as ``return``. Every call is treated as -## a call that can potentially ``raise``. However, without a surrounding -## ``try`` we don't emit these ``fork ReturnLabel`` instructions in order -## to speed up the dataflow analysis passes. -## ## The data structures and algorithms used here are inspired by ## "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, types, intsets, lineinfos, renderer +import ast, lineinfos, renderer, aliasanalysis import std/private/asciitables +import std/intsets + +when defined(nimPreviewSlimSystem): + import std/assertions type InstrKind* = enum - goto, fork, def, use + goto, loop, fork, def, use Instr* = object - n*: PNode # contains the def/use location. case kind*: InstrKind - of goto, fork: dest*: int - else: discard + of goto, fork, loop: dest*: int + of def, use: + n*: PNode # contains the def/use location. ControlFlowGraph* = seq[Instr] @@ -49,24 +46,26 @@ type case isTryBlock: bool of false: label: PSym - breakFixups: seq[(TPosition, seq[PNode])] #Contains the gotos for the breaks along with their pending finales + breakFixups: seq[(TPosition, seq[PNode])] # Contains the gotos for the breaks along with their pending finales of true: finale: PNode - raiseFixups: seq[TPosition] #Contains the gotos for the raises + raiseFixups: seq[TPosition] # Contains the gotos for the raises Con = object code: ControlFlowGraph - inTryStmt: int + inTryStmt, interestingInstructions: int blocks: seq[TBlock] owner: PSym + root: PSym proc codeListing(c: ControlFlowGraph, start = 0; last = -1): string = # for debugging purposes # first iteration: compute all necessary labels: + result = "" var jumpTargets = initIntSet() let last = if last < 0: c.len-1 else: min(last, c.len-1) for i in start..last: - if c[i].kind in {goto, fork}: + if c[i].kind in {goto, fork, loop}: jumpTargets.incl(i+c[i].dest) var i = start while i <= last: @@ -77,12 +76,12 @@ proc codeListing(c: ControlFlowGraph, start = 0; last = -1): string = case c[i].kind of def, use: result.add renderTree(c[i].n) - of goto, fork: + result.add("\t#") + result.add($c[i].n.info.line) + result.add("\n") + of goto, fork, loop: result.add "L" result.addInt c[i].dest+i - result.add("\t#") - result.add($c[i].n.info.line) - result.add("\n") inc i if i in jumpTargets: result.add("L" & $i & ": End\n") @@ -90,181 +89,13 @@ proc echoCfg*(c: ControlFlowGraph; start = 0; last = -1) {.deprecated.} = ## echos the ControlFlowGraph for debugging purposes. echo codeListing(c, start, last).alignTable -proc forkI(c: var Con; n: PNode): TPosition = +proc forkI(c: var Con): TPosition = result = TPosition(c.code.len) - c.code.add Instr(n: n, kind: fork, dest: 0) + c.code.add Instr(kind: fork, dest: 0) -proc gotoI(c: var Con; n: PNode): TPosition = +proc gotoI(c: var Con): TPosition = result = TPosition(c.code.len) - c.code.add Instr(n: n, kind: goto, dest: 0) - -#[ - -Join is no more -=============== -Instead of generating join instructions we adapt our traversal of the CFG. - -When encountering a fork we split into two paths, we follow the path -starting at "pc + 1" until it encounters the joinpoint: "pc + forkInstr.dest". -If we encounter gotos that would jump further than the current joinpoint, -as can happen with gotos generated by unstructured controlflow such as break, raise or return, -we simply suspend following the current path, and follow the other path until the new joinpoint -which is simply the instruction pointer returned to us by the now suspended path. -If the path we are following now, also encounters a goto that exceeds the joinpoint -we repeat the process; suspending the current path and evaluating the other one with a new joinpoint. -If we eventually reach a common joinpoint we join the two paths. -This new "ping-pong" approach has the obvious advantage of not requiring join instructions, as such -cutting down on the CFG size but is also mandatory for correctly handling complicated cases -of unstructured controlflow. - - -Design of join -============== - -block: - if cond: break - def(x) - -use(x) - -Generates: - -L0: fork lab1 - join L0 # patched. - goto Louter -lab1: - def x - join L0 -Louter: - use x - - -block outer: - while a: - while b: - if foo: - if bar: - break outer # --> we need to 'join' every pushed 'fork' here - - -This works and then our abstract interpretation needs to deal with 'fork' -differently. It really causes a split in execution. Two threads are -"spawned" and both need to reach the 'join L' instruction. Afterwards -the abstract interpretations are joined and execution resumes single -threaded. - - -Abstract Interpretation ------------------------ - -proc interpret(pc, state, comesFrom): state = - result = state - # we need an explicit 'create' instruction (an explicit heap), in order - # to deal with 'var x = create(); var y = x; var z = y; destroy(z)' - while true: - case pc - of fork: - let a = interpret(pc+1, result, pc) - let b = interpret(forkTarget, result, pc) - result = a ++ b # ++ is a union operation - inc pc - of join: - if joinTarget == comesFrom: return result - else: inc pc - of use X: - if not result.contains(x): - error "variable not initialized " & x - inc pc - of def X: - if not result.contains(x): - result.incl X - else: - error "overwrite of variable causes memory leak " & x - inc pc - of destroy X: - result.excl X - -This is correct but still can lead to false positives: - -proc p(cond: bool) = - if cond: - new(x) - otherThings() - if cond: - destroy x - -Is not a leak. We should find a way to model *data* flow, not just -control flow. One solution is to rewrite the 'if' without a fork -instruction. The unstructured aspect can now be easily dealt with -the 'goto' and 'join' instructions. - -proc p(cond: bool) = - L0: fork Lend - new(x) - # do not 'join' here! - - Lend: - otherThings() - join L0 # SKIP THIS FOR new(x) SOMEHOW - destroy x - join L0 # but here. - - - -But if we follow 'goto Louter' we will never come to the join point. -We restore the bindings after popping pc from the stack then there -"no" problem?! - - -while cond: - prelude() - if not condB: break - postlude() - ----> -var setFlag = true -while cond and not setFlag: - prelude() - if not condB: - setFlag = true # BUT: Dependency - if not setFlag: # HERE - postlude() - ----> -var setFlag = true -while cond and not setFlag: - prelude() - if not condB: - postlude() - setFlag = true - - -------------------------------------------------- - -while cond: - prelude() - if more: - if not condB: break - stuffHere() - postlude() - ---> -var setFlag = true -while cond and not setFlag: - prelude() - if more: - if not condB: - setFlag = false - else: - stuffHere() - postlude() - else: - postlude() - -This is getting complicated. Instead we keep the whole 'join' idea but -duplicate the 'join' instructions on breaks and return exits! - -]# + c.code.add Instr(kind: goto, dest: 0) proc genLabel(c: Con): TPosition = TPosition(c.code.len) @@ -272,8 +103,8 @@ template checkedDistance(dist): int = doAssert low(int) div 2 + 1 < dist and dist < high(int) div 2 dist -proc jmpBack(c: var Con, n: PNode, p = TPosition(0)) = - c.code.add Instr(n: n, kind: goto, dest: checkedDistance(p.int - c.code.len)) +proc jmpBack(c: var Con, p = TPosition(0)) = + c.code.add Instr(kind: loop, dest: checkedDistance(p.int - c.code.len)) proc patch(c: var Con, p: TPosition) = # patch with current index @@ -282,13 +113,13 @@ proc patch(c: var Con, p: TPosition) = proc gen(c: var Con; n: PNode) proc popBlock(c: var Con; oldLen: int) = - var exits: seq[TPosition] - exits.add c.gotoI(newNode(nkEmpty)) + var exits: seq[TPosition] = @[] + exits.add c.gotoI() for f in c.blocks[oldLen].breakFixups: c.patch(f[0]) for finale in f[1]: c.gen(finale) - exits.add c.gotoI(newNode(nkEmpty)) + exits.add c.gotoI() for e in exits: c.patch e c.blocks.setLen(oldLen) @@ -299,89 +130,28 @@ template withBlock(labl: PSym; body: untyped) = body popBlock(c, oldLen) -proc isTrue(n: PNode): bool = - n.kind == nkSym and n.sym.kind == skEnumField and n.sym.position != 0 or - n.kind == nkIntLit and n.intVal != 0 - -when true: - proc genWhile(c: var Con; n: PNode) = - # We unroll every loop 3 times. We emulate 0, 1, 2 iterations - # through the loop. We need to prove this is correct for our - # purposes. But Herb Sutter claims it is. (Proof by authority.) - #[ - while cond: - body - - Becomes: - - block: - if cond: - body - if cond: - body - if cond: - body - - We still need to ensure 'break' resolves properly, so an AST to AST - translation is impossible. - - So the code to generate is: - - cond - fork L4 # F1 - body - cond - fork L5 # F2 - body - cond - fork L6 # F3 - body - L6: - join F3 - L5: - join F2 - L4: - join F1 - ]# +template forkT(body) = + let lab1 = c.forkI() + body + c.patch(lab1) + +proc genWhile(c: var Con; n: PNode) = + # lab1: + # cond, tmp + # fork tmp, lab2 + # body + # jmp lab1 + # lab2: + let lab1 = c.genLabel + withBlock(nil): if isTrue(n[0]): - # 'while true' is an idiom in Nim and so we produce - # better code for it: - withBlock(nil): - for i in 0..2: - c.gen(n[1]) + c.gen(n[1]) + c.jmpBack(lab1) else: - withBlock(nil): - var endings: array[3, TPosition] - for i in 0..2: - c.gen(n[0]) - endings[i] = c.forkI(n) - c.gen(n[1]) - for i in countdown(endings.high, 0): - c.patch(endings[i]) - -else: - proc genWhile(c: var Con; n: PNode) = - # lab1: - # cond, tmp - # fork tmp, lab2 - # body - # jmp lab1 - # lab2: - let lab1 = c.genLabel - withBlock(nil): - if isTrue(n[0]): + c.gen(n[0]) + forkT: c.gen(n[1]) - c.jmpBack(n, lab1) - else: - c.gen(n[0]) - forkT(n): - c.gen(n[1]) - c.jmpBack(n, lab1) - -template forkT(n, body) = - let lab1 = c.forkI(n) - body - c.patch(lab1) + c.jmpBack(lab1) proc genIf(c: var Con, n: PNode) = #[ @@ -411,34 +181,32 @@ proc genIf(c: var Con, n: PNode) = goto Lend3 L3: D - goto Lend3 # not eliminated to simplify the join generation - Lend3: - join F3 - Lend2: - join F2 - Lend: - join F1 - ]# var endings: seq[TPosition] = @[] + let oldInteresting = c.interestingInstructions + let oldLen = c.code.len + for i in 0..<n.len: let it = n[i] c.gen(it[0]) if it.len == 2: - forkT(it[1]): - c.gen(it[1]) - endings.add c.gotoI(it[1]) - for i in countdown(endings.high, 0): - c.patch(endings[i]) + forkT: + c.gen(it.lastSon) + endings.add c.gotoI() + + if oldInteresting == c.interestingInstructions: + setLen c.code, oldLen + else: + for i in countdown(endings.high, 0): + c.patch(endings[i]) proc genAndOr(c: var Con; n: PNode) = # asgn dest, a # fork lab1 # asgn dest, b # lab1: - # join F1 c.gen(n[1]) - forkT(n): + forkT: c.gen(n[2]) proc genCase(c: var Con; n: PNode) = @@ -453,39 +221,40 @@ proc genCase(c: var Con; n: PNode) = # elsePart # Lend: let isExhaustive = skipTypes(n[0].typ, - abstractVarRange-{tyTypeDesc}).kind notin {tyFloat..tyFloat128, tyString} + abstractVarRange-{tyTypeDesc}).kind notin {tyFloat..tyFloat128, tyString, tyCstring} - # we generate endings as a set of chained gotos, this is a bit awkward but it - # ensures when recursively traversing the CFG for various analysis, we don't - # artificially extended the life of each branch (for the purposes of DFA) - # beyond the minimum amount. var endings: seq[TPosition] = @[] c.gen(n[0]) + let oldInteresting = c.interestingInstructions + let oldLen = c.code.len for i in 1..<n.len: let it = n[i] if it.len == 1 or (i == n.len-1 and isExhaustive): # treat the last branch as 'else' if this is an exhaustive case statement. c.gen(it.lastSon) - if endings.len != 0: - c.patch(endings[^1]) else: - forkT(it.lastSon): + forkT: c.gen(it.lastSon) - if endings.len != 0: - c.patch(endings[^1]) - endings.add c.gotoI(it.lastSon) + endings.add c.gotoI() + + if oldInteresting == c.interestingInstructions: + setLen c.code, oldLen + else: + for i in countdown(endings.high, 0): + c.patch(endings[i]) proc genBlock(c: var Con; n: PNode) = withBlock(n[0].sym): c.gen(n[1]) proc genBreakOrRaiseAux(c: var Con, i: int, n: PNode) = - let lab1 = c.gotoI(n) + let lab1 = c.gotoI() if c.blocks[i].isTryBlock: c.blocks[i].raiseFixups.add lab1 else: - var trailingFinales: seq[PNode] - if c.inTryStmt > 0: #Ok, we are in a try, lets see which (if any) try's we break out from: + var trailingFinales: seq[PNode] = @[] + if c.inTryStmt > 0: + # Ok, we are in a try, lets see which (if any) try's we break out from: for b in countdown(c.blocks.high, i): if c.blocks[b].isTryBlock: trailingFinales.add c.blocks[b].finale @@ -493,6 +262,7 @@ proc genBreakOrRaiseAux(c: var Con, i: int, n: PNode) = c.blocks[i].breakFixups.add (lab1, trailingFinales) proc genBreak(c: var Con; n: PNode) = + inc c.interestingInstructions if n[0].kind == nkSym: for i in countdown(c.blocks.high, 0): if not c.blocks[i].isTryBlock and c.blocks[i].label == n[0].sym: @@ -523,9 +293,9 @@ proc genTry(c: var Con; n: PNode) = for i in 1..<n.len: let it = n[i] if it.kind != nkFinally: - forkT(it): + forkT: c.gen(it.lastSon) - endings.add c.gotoI(it) + endings.add c.gotoI() for i in countdown(endings.high, 0): c.patch(endings[i]) @@ -533,26 +303,28 @@ proc genTry(c: var Con; n: PNode) = if fin.kind == nkFinally: c.gen(fin[0]) -template genNoReturn(c: var Con; n: PNode) = +template genNoReturn(c: var Con) = # leave the graph - c.code.add Instr(n: n, kind: goto, dest: high(int) - c.code.len) + c.code.add Instr(kind: goto, dest: high(int) - c.code.len) proc genRaise(c: var Con; n: PNode) = + inc c.interestingInstructions gen(c, n[0]) if c.inTryStmt > 0: for i in countdown(c.blocks.high, 0): if c.blocks[i].isTryBlock: genBreakOrRaiseAux(c, i, n) return - assert false #Unreachable + assert false # Unreachable else: - genNoReturn(c, n) + genNoReturn(c) proc genImplicitReturn(c: var Con) = if c.owner.kind in {skProc, skFunc, skMethod, skIterator, skConverter} and resultPos < c.owner.ast.len: gen(c, c.owner.ast[resultPos]) proc genReturn(c: var Con; n: PNode) = + inc c.interestingInstructions if n[0].kind != nkEmpty: gen(c, n[0]) else: @@ -561,124 +333,6 @@ proc genReturn(c: var Con; n: PNode) = const InterestingSyms = {skVar, skResult, skLet, skParam, skForVar, skTemp} - PathKinds0 = {nkDotExpr, nkCheckedFieldExpr, - nkBracketExpr, nkDerefExpr, nkHiddenDeref, - nkAddr, nkHiddenAddr, - nkObjDownConv, nkObjUpConv} - PathKinds1 = {nkHiddenStdConv, nkHiddenSubConv} - -proc skipConvDfa*(n: PNode): PNode = - result = n - while true: - case result.kind - of nkObjDownConv, nkObjUpConv: - result = result[0] - of PathKinds1: - result = result[1] - else: break - -type AliasKind* = enum - yes, no, maybe - -proc aliases*(obj, field: PNode): AliasKind = - # obj -> field: - # x -> x: true - # x -> x.f: true - # x.f -> x: false - # x.f -> x.f: true - # x.f -> x.v: false - # x -> x[0]: true - # x[0] -> x: false - # x[0] -> x[0]: true - # x[0] -> x[1]: false - # x -> x[i]: true - # x[i] -> x: false - # x[i] -> x[i]: maybe; Further analysis could make this return true when i is a runtime-constant - # x[i] -> x[j]: maybe; also returns maybe if only one of i or j is a compiletime-constant - template collectImportantNodes(result, n) = - var result: seq[PNode] - var n = n - while true: - case n.kind - of PathKinds0 - {nkDotExpr, nkCheckedFieldExpr, nkBracketExpr}: - n = n[0] - of PathKinds1: - n = n[1] - of nkDotExpr, nkCheckedFieldExpr, nkBracketExpr: - result.add n - n = n[0] - of nkSym: - result.add n; break - else: return no - - collectImportantNodes(objImportantNodes, obj) - collectImportantNodes(fieldImportantNodes, field) - - # If field is less nested than obj, then it cannot be part of/aliased by obj - if fieldImportantNodes.len < objImportantNodes.len: return no - - result = yes - for i in 1..objImportantNodes.len: - # We compare the nodes leading to the location of obj and field - # with each other. - # We continue until they diverge, in which case we return no, or - # until we reach the location of obj, in which case we do not need - # to look further, since field must be part of/aliased by obj now. - # If we encounter an element access using an index which is a runtime value, - # we simply return maybe instead of yes; should further nodes not diverge. - let currFieldPath = fieldImportantNodes[^i] - let currObjPath = objImportantNodes[^i] - - if currFieldPath.kind != currObjPath.kind: - return no - - case currFieldPath.kind - of nkSym: - if currFieldPath.sym != currObjPath.sym: return no - of nkDotExpr: - if currFieldPath[1].sym != currObjPath[1].sym: return no - of nkCheckedFieldExpr: - if currFieldPath[0][1].sym != currObjPath[0][1].sym: return no - of nkBracketExpr: - if currFieldPath[1].kind in nkLiterals and currObjPath[1].kind in nkLiterals: - if currFieldPath[1].intVal != currObjPath[1].intVal: - return no - else: - result = maybe - else: assert false # unreachable - -proc isAnalysableFieldAccess*(orig: PNode; owner: PSym): bool = - var n = orig - while true: - case n.kind - of PathKinds0 - {nkHiddenDeref, nkDerefExpr}: - n = n[0] - of PathKinds1: - n = n[1] - of nkHiddenDeref, nkDerefExpr: - # We "own" sinkparam[].loc but not ourVar[].location as it is a nasty - # pointer indirection. - # bug #14159, we cannot reason about sinkParam[].location as it can - # still be shared for tyRef. - n = n[0] - return n.kind == nkSym and n.sym.owner == owner and - (n.sym.typ.skipTypes(abstractInst-{tyOwned}).kind in {tyOwned}) - else: break - # XXX Allow closure deref operations here if we know - # the owner controlled the closure allocation? - result = n.kind == nkSym and n.sym.owner == owner and - {sfGlobal, sfThread, sfCursor} * n.sym.flags == {} and - (n.sym.kind != skParam or isSinkParam(n.sym)) # or n.sym.typ.kind == tyVar) - # Note: There is a different move analyzer possible that checks for - # consume(param.key); param.key = newValue for all paths. Then code like - # - # let splited = split(move self.root, x) - # self.root = merge(splited.lower, splited.greater) - # - # could be written without the ``move self.root``. However, this would be - # wrong! Then the write barrier for the ``self.root`` assignment would - # free the old data and all is lost! Lesson: Don't be too smart, trust the - # lower level C++ optimizer to specialize this code. proc skipTrivials(c: var Con, n: PNode): PNode = result = n @@ -696,16 +350,20 @@ proc skipTrivials(c: var Con, n: PNode): PNode = proc genUse(c: var Con; orig: PNode) = let n = c.skipTrivials(orig) - if n.kind == nkSym and n.sym.kind in InterestingSyms: - c.code.add Instr(n: orig, kind: use) - elif n.kind in nkCallKinds: + if n.kind == nkSym: + if n.sym.kind in InterestingSyms and n.sym == c.root: + c.code.add Instr(kind: use, n: orig) + inc c.interestingInstructions + else: gen(c, n) proc genDef(c: var Con; orig: PNode) = let n = c.skipTrivials(orig) if n.kind == nkSym and n.sym.kind in InterestingSyms: - c.code.add Instr(n: orig, kind: def) + if n.sym == c.root: + c.code.add Instr(kind: def, n: orig) + inc c.interestingInstructions proc genCall(c: var Con; n: PNode) = gen(c, n[0]) @@ -713,18 +371,17 @@ proc genCall(c: var Con; n: PNode) = if t != nil: t = t.skipTypes(abstractInst) for i in 1..<n.len: gen(c, n[i]) - when false: - if t != nil and i < t.len and t[i].kind == tyOut: - # Pass by 'out' is a 'must def'. Good enough for a move optimizer. - genDef(c, n[i]) + if t != nil and i < t.signatureLen and isOutParam(t[i]): + # Pass by 'out' is a 'must def'. Good enough for a move optimizer. + genDef(c, n[i]) # every call can potentially raise: if c.inTryStmt > 0 and canRaiseConservative(n[0]): + inc c.interestingInstructions # we generate the instruction sequence: # fork lab1 # goto exceptionHandler (except or finally) # lab1: - # join F1 - forkT(n): + forkT: for i in countdown(c.blocks.high, 0): if c.blocks[i].isTryBlock: genBreakOrRaiseAux(c, i, n) @@ -762,12 +419,18 @@ proc gen(c: var Con; n: PNode) = else: genCall(c, n) if sfNoReturn in n[0].sym.flags: - genNoReturn(c, n) + genNoReturn(c) else: genCall(c, n) of nkCharLit..nkNilLit: discard - of nkAsgn, nkFastAsgn: + of nkAsgn, nkFastAsgn, nkSinkAsgn: gen(c, n[1]) + + if n[0].kind in PathKinds0: + let a = c.skipTrivials(n[0]) + if a.kind in nkCallKinds: + gen(c, a) + # watch out: 'obj[i].f2 = value' sets 'f2' but # "uses" 'i'. But we are only talking about builtin array indexing so # it doesn't matter and 'x = 34' is NOT a usage of 'x'. @@ -794,16 +457,35 @@ proc gen(c: var Con; n: PNode) = of nkConv, nkExprColonExpr, nkExprEqExpr, nkCast, PathKinds1: gen(c, n[1]) of nkVarSection, nkLetSection: genVarSection(c, n) - of nkDefer: doAssert false, "dfa construction pass requires the elimination of 'defer'" + of nkDefer: raiseAssert "dfa construction pass requires the elimination of 'defer'" else: discard -proc constructCfg*(s: PSym; body: PNode): ControlFlowGraph = +when false: + proc optimizeJumps(c: var ControlFlowGraph) = + for i in 0..<c.len: + case c[i].kind + of goto, fork: + var pc = i + c[i].dest + if pc < c.len and c[pc].kind == goto: + while pc < c.len and c[pc].kind == goto: + let newPc = pc + c[pc].dest + if newPc > pc: + pc = newPc + else: + break + c[i].dest = pc - i + of loop, def, use: discard + +proc constructCfg*(s: PSym; body: PNode; root: PSym): ControlFlowGraph = ## constructs a control flow graph for ``body``. - var c = Con(code: @[], blocks: @[], owner: s) + var c = Con(code: @[], blocks: @[], owner: s, root: root) withBlock(s): gen(c, body) - genImplicitReturn(c) - when defined(gcArc) or defined(gcOrc): + if root.kind == skResult: + genImplicitReturn(c) + when defined(gcArc) or defined(gcOrc) or defined(gcAtomicArc): result = c.code # will move else: shallowCopy(result, c.code) + when false: + optimizeJumps result diff --git a/compiler/docgen.nim b/compiler/docgen.nim index dded231d7..8e5f5e4e7 100644 --- a/compiler/docgen.nim +++ b/compiler/docgen.nim @@ -7,19 +7,28 @@ # distribution, for details about the copyright. # -# This is the documentation generator. Cross-references are generated -# by knowing how the anchors are going to be named. +## This is the Nim documentation generator. Cross-references are generated +## by knowing how the anchors are going to be named. +## +## .. importdoc:: ../docgen.md +## +## For corresponding users' documentation see [Nim DocGen Tools Guide]. import - ast, strutils, strtabs, options, msgs, os, ropes, idents, - wordrecg, syntaxes, renderer, lexer, packages/docutils/rstast, - packages/docutils/rst, packages/docutils/rstgen, - json, xmltree, trees, types, - typesrenderer, astalgo, lineinfos, intsets, - pathutils, trees, tables, nimpaths, renderverbatim, osproc + ast, options, msgs, idents, + wordrecg, syntaxes, renderer, lexer, + packages/docutils/[rst, rstidx, rstgen, dochelpers], + trees, types, + typesrenderer, astalgo, lineinfos, + pathutils, nimpaths, renderverbatim, packages +import packages/docutils/rstast except FileIndex, TLineInfo -from uri import encodeUrl -from std/private/globs import nativeToUnixPath +import std/[os, strutils, strtabs, algorithm, json, osproc, tables, intsets, xmltree, sequtils] +from std/uri import encodeUrl +from nodejs import findNodeJs + +when defined(nimPreviewSlimSystem): + import std/[assertions, syncio] const @@ -28,25 +37,66 @@ const DocColOffset = "## ".len # assuming that a space was added after ## type - TSections = array[TSymKind, Rope] + ItemFragment = object ## A fragment from each item will be eventually + ## constructed by converting `rst` fields to strings. + case isRst: bool + of true: + rst: PRstNode + of false: ## contains ready markup e.g. from runnableExamples + str: string + ItemPre = seq[ItemFragment] ## A pre-processed item. + Item = object ## Any item in documentation, e.g. symbol + ## entry. Configuration variable ``doc.item`` + ## is used for its HTML rendering. + descRst: ItemPre ## Description of the item (may contain + ## runnableExamples). + substitutions: seq[string] ## Variable names in `doc.item`... + sortName: string ## The string used for sorting in output + info: rstast.TLineInfo ## place where symbol was defined (for messages) + anchor: string ## e.g. HTML anchor + name: string ## short name of the symbol, not unique + ## (includes backticks ` if present) + detailedName: string ## longer name like `proc search(x: int): int` + ModSection = object ## Section like Procs, Types, etc. + secItems: Table[string, seq[Item]] + ## Map basic name -> pre-processed items. + finalMarkup: string ## The items, after RST pass 2 and rendering. + ModSections = array[TSymKind, ModSection] + TocItem = object ## HTML TOC item + content: string + sortName: string + TocSectionsFinal = array[TSymKind, string] ExampleGroup = ref object ## a group of runnableExamples with same rdoccmd rdoccmd: string ## from 1st arg in `runnableExamples(rdoccmd): body` docCmd: string ## from user config, e.g. --doccmd:-d:foo code: string ## contains imports; each import contains `body` index: int ## group index + JsonItem = object # pre-processed item: `rst` should be finalized + json: JsonNode + rst: PRstNode + rstField: string TDocumentor = object of rstgen.RstGenerator - modDesc: Rope # module description + modDescPre: ItemPre # module description, not finalized + modDescFinal: string # module description, after RST pass 2 and rendering module: PSym - modDeprecationMsg: Rope - toc, toc2, section: TSections - tocTable: array[TSymKind, Table[string, Rope]] + modDeprecationMsg: string + section: ModSections # entries of ``.nim`` file (for `proc`s, etc) + tocSimple: array[TSymKind, seq[TocItem]] + # TOC entries for non-overloadable symbols (e.g. types, constants)... + tocTable: array[TSymKind, Table[string, seq[TocItem]]] + # ...otherwise (e.g. procs) + toc2: TocSectionsFinal # TOC `content`, which is probably wrapped + # in `doc.section.toc2` + toc: TocSectionsFinal # final TOC (wrapped in `doc.section.toc`) indexValFilename: string analytics: string # Google Analytics javascript, "" if doesn't exist seenSymbols: StringTableRef # avoids duplicate symbol generation for HTML. - jArray: JsonNode + jEntriesPre: seq[JsonItem] # pre-processed RST + JSON content + jEntriesFinal: JsonNode # final JSON after RST pass 2 and rendering types: TStrTable - isPureRst: bool + sharedState: PRstSharedState + standaloneDoc: bool # is markup (.rst/.md) document? conf*: ConfigRef cache*: IdentCache exampleCounter: int @@ -55,29 +105,76 @@ type thisDir*: AbsoluteDir exampleGroups: OrderedTable[string, ExampleGroup] wroteSupportFiles*: bool + nimToRstFid: Table[lineinfos.FileIndex, rstast.FileIndex] + ## map Nim FileIndex -> RST one, it's needed because we keep them separate PDoc* = ref TDocumentor ## Alias to type less. +proc add(dest: var ItemPre, rst: PRstNode) = dest.add ItemFragment(isRst: true, rst: rst) +proc add(dest: var ItemPre, str: string) = dest.add ItemFragment(isRst: false, str: str) + +proc addRstFileIndex(d: PDoc, fileIndex: lineinfos.FileIndex): rstast.FileIndex = + let invalid = rstast.FileIndex(-1) + result = d.nimToRstFid.getOrDefault(fileIndex, default = invalid) + if result == invalid: + let fname = toFullPath(d.conf, fileIndex) + result = addFilename(d.sharedState, fname) + d.nimToRstFid[fileIndex] = result + +proc addRstFileIndex(d: PDoc, info: lineinfos.TLineInfo): rstast.FileIndex = + addRstFileIndex(d, info.fileIndex) + +proc cmpDecimalsIgnoreCase(a, b: string): int = + ## For sorting with correct handling of cases like 'uint8' and 'uint16'. + ## Also handles leading zeros well (however note that leading zeros are + ## significant when lengths of numbers mismatch, e.g. 'bar08' > 'bar8' !). + runnableExamples: + doAssert cmpDecimalsIgnoreCase("uint8", "uint16") < 0 + doAssert cmpDecimalsIgnoreCase("val00032", "val16suffix") > 0 + doAssert cmpDecimalsIgnoreCase("val16suffix", "val16") > 0 + doAssert cmpDecimalsIgnoreCase("val_08_32", "val_08_8") > 0 + doAssert cmpDecimalsIgnoreCase("val_07_32", "val_08_8") < 0 + doAssert cmpDecimalsIgnoreCase("ab8", "ab08") < 0 + doAssert cmpDecimalsIgnoreCase("ab8de", "ab08c") < 0 # sanity check + let aLen = a.len + let bLen = b.len + var + iA = 0 + iB = 0 + while iA < aLen and iB < bLen: + if isDigit(a[iA]) and isDigit(b[iB]): + var + limitA = iA # index after the last (least significant) digit + limitB = iB + while limitA < aLen and isDigit(a[limitA]): inc limitA + while limitB < bLen and isDigit(b[limitB]): inc limitB + var pos = max(limitA-iA, limitB-iA) + while pos > 0: + if limitA-pos < iA: # digit in `a` is 0 effectively + result = ord('0') - ord(b[limitB-pos]) + elif limitB-pos < iB: # digit in `b` is 0 effectively + result = ord(a[limitA-pos]) - ord('0') + else: + result = ord(a[limitA-pos]) - ord(b[limitB-pos]) + if result != 0: return + dec pos + result = (limitA - iA) - (limitB - iB) # consider 'bar08' > 'bar8' + if result != 0: return + iA = limitA + iB = limitB + else: + result = ord(toLowerAscii(a[iA])) - ord(toLowerAscii(b[iB])) + if result != 0: return + inc iA + inc iB + result = (aLen - iA) - (bLen - iB) + proc prettyString(a: object): string = # xxx pending std/prettyprint refs https://github.com/nim-lang/RFCs/issues/203#issuecomment-602534906 + result = "" for k, v in fieldPairs(a): result.add k & ": " & $v & "\n" -proc canonicalImport*(conf: ConfigRef, file: AbsoluteFile): string = - ##[ - Shows the canonical module import, e.g.: - system, std/tables, fusion/pointers, system/assertions, std/private/asciitables - ]## - var ret = getRelativePathFromConfigPath(conf, file, isTitle = true) - let dir = getNimbleFile(conf, $file).parentDir.AbsoluteDir - if not dir.isEmpty: - let relPath = relativeTo(file, dir) - if not relPath.isEmpty and (ret.isEmpty or relPath.string.len < ret.string.len): - ret = relPath - if ret.isEmpty: - ret = relativeTo(file, conf.projectPath) - result = ret.string.nativeToUnixPath.changeFileExt("") - proc presentationPath*(conf: ConfigRef, file: AbsoluteFile): RelativeFile = ## returns a relative file that will be appended to outDir let file2 = $file @@ -103,7 +200,7 @@ proc presentationPath*(conf: ConfigRef, file: AbsoluteFile): RelativeFile = if result.isEmpty: bail() elif conf.docRoot.len > 0: # we're (currently) requiring `isAbsolute` to avoid confusion when passing - # a relative path (would it be relative wrt $PWD or to projectfile) + # 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 # needed because `canonicalizePath` called on `file` @@ -120,12 +217,16 @@ proc whichType(d: PDoc; n: PNode): PSym = if n.kind == nkSym: if d.types.strTableContains(n.sym): result = n.sym + else: + result = nil else: + result = nil for i in 0..<n.safeLen: let x = whichType(d, n[i]) if x != nil: return x proc attachToType(d: PDoc; p: PSym): PSym = + result = nil let params = p.ast[paramsPos] template check(i) = result = whichType(d, params[i]) @@ -137,7 +238,7 @@ proc attachToType(d: PDoc; p: PSym): PSym = if params.len > 0: check(0) for i in 2..<params.len: check(i) -template declareClosures = +template declareClosures(currentFilename: AbsoluteFile, destFile: string) = proc compilerMsgHandler(filename: string, line, col: int, msgKind: rst.MsgKind, arg: string) {.gcsafe.} = # translate msg kind: @@ -145,19 +246,35 @@ template declareClosures = case msgKind of meCannotOpenFile: k = errCannotOpenFile of meExpected: k = errXExpected - of meGridTableNotImplemented: k = errGridTableNotImplemented - of meMarkdownIllformedTable: k = errMarkdownIllformedTable - of meNewSectionExpected: k = errNewSectionExpected - of meGeneralParseError: k = errGeneralParseError - of meInvalidDirective: k = errInvalidDirectiveX - of meFootnoteMismatch: k = errFootnoteMismatch - of mwRedefinitionOfLabel: k = warnRedefinitionOfLabel - of mwUnknownSubstitution: k = warnUnknownSubstitutionX - of mwUnsupportedLanguage: k = warnLanguageXNotSupported - of mwUnsupportedField: k = warnFieldXNotSupported + of meMissingClosing: k = errRstMissingClosing + of meGridTableNotImplemented: k = errRstGridTableNotImplemented + of meMarkdownIllformedTable: k = errRstMarkdownIllformedTable + of meIllformedTable: k = errRstIllformedTable + of meNewSectionExpected: k = errRstNewSectionExpected + of meGeneralParseError: k = errRstGeneralParseError + of meInvalidDirective: k = errRstInvalidDirectiveX + of meInvalidField: k = errRstInvalidField + of meFootnoteMismatch: k = errRstFootnoteMismatch + of meSandboxedDirective: k = errRstSandboxedDirective + of mwRedefinitionOfLabel: k = warnRstRedefinitionOfLabel + of mwUnknownSubstitution: k = warnRstUnknownSubstitutionX + of mwAmbiguousLink: k = warnRstAmbiguousLink + of mwBrokenLink: k = warnRstBrokenLink + of mwUnsupportedLanguage: k = warnRstLanguageXNotSupported + of mwUnsupportedField: k = warnRstFieldXNotSupported + of mwUnusedImportdoc: k = warnRstUnusedImportdoc of mwRstStyle: k = warnRstStyle {.gcsafe.}: - globalError(conf, newLineInfo(conf, AbsoluteFile filename, line, col), k, arg) + let errorsAsWarnings = (roPreferMarkdown in d.sharedState.options) and + not d.standaloneDoc # not tolerate errors in .rst/.md files + if whichMsgClass(msgKind) == mcError and errorsAsWarnings: + liMessage(conf, newLineInfo(conf, AbsoluteFile filename, line, col), + k, arg, doNothing, instLoc(), ignoreError=true) + # when our Markdown parser fails, we currently can only terminate the + # parsing (and then we will return monospaced text instead of markup): + raiseRecoverableError("") + else: + globalError(conf, newLineInfo(conf, AbsoluteFile filename, line, col), k, arg) proc docgenFindFile(s: string): string {.gcsafe.} = result = options.findFile(conf, s).string @@ -165,13 +282,30 @@ template declareClosures = result = getCurrentDir() / s if not fileExists(result): result = "" -proc parseRst(text, filename: string, - line, column: int, hasToc: var bool, - rstOptions: RstParseOptions; - conf: ConfigRef): PRstNode = - declareClosures() - result = rstParse(text, filename, line, column, hasToc, rstOptions, - docgenFindFile, compilerMsgHandler) + proc docgenFindRefFile(targetRelPath: string): + tuple[targetPath: string, linkRelPath: string] {.gcsafe.} = + let fromDir = splitFile(destFile).dir # dir where we reference from + let basedir = os.splitFile(currentFilename.string).dir + let outDirPath: RelativeFile = + presentationPath(conf, AbsoluteFile(basedir / targetRelPath)) + # use presentationPath because `..` path can be be mangled to `_._` + result = (string(conf.outDir / outDirPath), "") + if not fileExists(result.targetPath): + # this can happen if targetRelPath goes to parent directory `OUTDIR/..`. + # Trying it, this may cause ambiguities, but allows us to insert + # "packages" into each other, which is actually used in Nim repo itself. + let destPath = fromDir / targetRelPath + if destPath != result.targetPath and fileExists(destPath): + result.targetPath = destPath + + result.linkRelPath = relativePath(result.targetPath.splitFile.dir, + fromDir).replace('\\', '/') + + +proc parseRst(text: string, + line, column: int, + conf: ConfigRef, sharedState: PRstSharedState): PRstNode = + result = rstParsePass1(text, line, column, sharedState) proc getOutFile2(conf: ConfigRef; filename: RelativeFile, ext: string, guessTarget: bool): AbsoluteFile = @@ -184,17 +318,39 @@ proc getOutFile2(conf: ConfigRef; filename: RelativeFile, else: result = getOutFile(conf, filename, ext) -proc newDocumentor*(filename: AbsoluteFile; cache: IdentCache; conf: ConfigRef, outExt: string = HtmlExt, module: PSym = nil): PDoc = - declareClosures() +proc isLatexCmd(conf: ConfigRef): bool = + conf.cmd in {cmdRst2tex, cmdMd2tex, cmdDoc2tex} + +proc newDocumentor*(filename: AbsoluteFile; cache: IdentCache; conf: ConfigRef, + outExt: string = HtmlExt, module: PSym = nil, + standaloneDoc = false, preferMarkdown = true, + hasToc = true): PDoc = + let destFile = getOutFile2(conf, presentationPath(conf, filename), outExt, false).string new(result) + let d = result # pass `d` to `declareClosures`: + declareClosures(currentFilename = filename, destFile = destFile) result.module = module result.conf = conf result.cache = cache result.outDir = conf.outDir.string - initRstGenerator(result[], (if conf.cmd != cmdRst2tex: outHtml else: outLatex), - conf.configVars, filename.string, {roSupportRawDirective, roSupportMarkdown}, + result.standaloneDoc = standaloneDoc + var options= {roSupportRawDirective, roSupportMarkdown, roSandboxDisabled} + if preferMarkdown: + options.incl roPreferMarkdown + if not standaloneDoc: options.incl roNimFile + # (options can be changed dynamically in `setDoctype` by `{.doctype.}`) + result.hasToc = hasToc + result.sharedState = newRstSharedState( + options, filename.string, + docgenFindFile, docgenFindRefFile, compilerMsgHandler, hasToc) + initRstGenerator(result[], (if conf.isLatexCmd: outLatex else: outHtml), + conf.configVars, filename.string, docgenFindFile, compilerMsgHandler) + if conf.configVars.hasKey("doc.googleAnalytics") and + conf.configVars.hasKey("doc.plausibleAnalytics"): + raiseAssert "Either use googleAnalytics or plausibleAnalytics" + if conf.configVars.hasKey("doc.googleAnalytics"): result.analytics = """ <script> @@ -208,18 +364,22 @@ proc newDocumentor*(filename: AbsoluteFile; cache: IdentCache; conf: ConfigRef, </script> """ % [conf.configVars.getOrDefault"doc.googleAnalytics"] + elif conf.configVars.hasKey("doc.plausibleAnalytics"): + result.analytics = """ + <script defer data-domain="$1" src="https://plausible.io/js/plausible.js"></script> + """ % [conf.configVars.getOrDefault"doc.plausibleAnalytics"] else: result.analytics = "" result.seenSymbols = newStringTable(modeCaseInsensitive) result.id = 100 - result.jArray = newJArray() - initStrTable result.types + result.jEntriesFinal = newJArray() + result.types = initStrTable() result.onTestSnippet = - proc (gen: var RstGenerator; filename, cmd: string; status: int; content: string) = + proc (gen: var RstGenerator; filename, cmd: string; status: int; content: string) {.gcsafe.} = if conf.docCmd == docCmdSkip: return inc(gen.id) - var d = TDocumentor(gen) + var d = (ptr TDocumentor)(addr gen) var outp: AbsoluteFile if filename.len == 0: let nameOnly = splitFile(d.filename).name @@ -235,7 +395,7 @@ proc newDocumentor*(filename: AbsoluteFile; cache: IdentCache; conf: ConfigRef, # Make sure the destination directory exists createDir(outp.splitFile.dir) # Include the current file if we're parsing a nim file - let importStmt = if d.isPureRst: "" else: "import \"$1\"\n" % [d.filename.replace("\\", "/")] + let importStmt = if d.standaloneDoc: "" else: "import \"$1\"\n" % [d.filename.replace("\\", "/")] writeFile(outp, importStmt & content) proc interpSnippetCmd(cmd: string): string = @@ -257,11 +417,12 @@ proc newDocumentor*(filename: AbsoluteFile; cache: IdentCache; conf: ConfigRef, if gotten != status: rawMessage(conf, errGenerated, "snippet failed: cmd: '$1' status: $2 expected: $3 output: $4" % [cmd, $gotten, $status, output]) result.emitted = initIntSet() - result.destFile = getOutFile2(conf, presentationPath(conf, filename), outExt, false).string + result.destFile = destFile result.thisDir = result.destFile.AbsoluteFile.splitFile.dir -template dispA(conf: ConfigRef; dest: var Rope, xml, tex: string, args: openArray[Rope]) = - if conf.cmd != cmdRst2tex: dest.addf(xml, args) +template dispA(conf: ConfigRef; dest: var string, xml, tex: string, + args: openArray[string]) = + if not conf.isLatexCmd: dest.addf(xml, args) else: dest.addf(tex, args) proc getVarIdx(varnames: openArray[string], id: string): int = @@ -270,84 +431,25 @@ proc getVarIdx(varnames: openArray[string], id: string): int = return i result = -1 -proc ropeFormatNamedVars(conf: ConfigRef; frmt: FormatStr, - varnames: openArray[string], - varvalues: openArray[Rope]): Rope = - var i = 0 - result = nil - var num = 0 - while i < frmt.len: - if frmt[i] == '$': - inc(i) # skip '$' - case frmt[i] - of '#': - result.add(varvalues[num]) - inc(num) - inc(i) - of '$': - result.add("$") - inc(i) - of '0'..'9': - var j = 0 - while true: - j = (j * 10) + ord(frmt[i]) - ord('0') - inc(i) - if (i > frmt.len + 0 - 1) or not (frmt[i] in {'0'..'9'}): break - if j > high(varvalues) + 1: - rawMessage(conf, errGenerated, "Invalid format string; too many $s: " & frmt) - num = j - result.add(varvalues[j - 1]) - of 'A'..'Z', 'a'..'z', '\x80'..'\xFF': - var id = "" - while true: - id.add(frmt[i]) - inc(i) - if not (frmt[i] in {'A'..'Z', '_', 'a'..'z', '\x80'..'\xFF'}): break - var idx = getVarIdx(varnames, id) - if idx >= 0: result.add(varvalues[idx]) - else: rawMessage(conf, errGenerated, "unknown substition variable: " & id) - of '{': - var id = "" - inc(i) - while i < frmt.len and frmt[i] != '}': - id.add(frmt[i]) - inc(i) - if i >= frmt.len: - rawMessage(conf, errGenerated, "expected closing '}'") - else: - inc(i) # skip } - # search for the variable: - let idx = getVarIdx(varnames, id) - if idx >= 0: result.add(varvalues[idx]) - else: rawMessage(conf, errGenerated, "unknown substition variable: " & id) - else: - result.add("$") - var start = i - while i < frmt.len: - if frmt[i] != '$': inc(i) - else: break - if i - 1 >= start: result.add(substr(frmt, start, i - 1)) - -proc genComment(d: PDoc, n: PNode): string = - result = "" +proc genComment(d: PDoc, n: PNode): PRstNode = if n.comment.len > 0: - let comment = n.comment - when false: - # RFC: to preseve newlines in comments, this would work: - comment = comment.replace("\n", "\n\n") - renderRstToOut(d[], - parseRst(comment, toFullPath(d.conf, n.info), - toLinenumber(n.info), - toColumn(n.info) + DocColOffset, - (var dummy: bool; dummy), d.options, d.conf), - result) - -proc genRecCommentAux(d: PDoc, n: PNode): Rope = + d.sharedState.currFileIdx = addRstFileIndex(d, n.info) + try: + result = parseRst(n.comment, + toLinenumber(n.info), + toColumn(n.info) + DocColOffset, + d.conf, d.sharedState) + except ERecoverableError: + result = newRstNode(rnLiteralBlock, @[newRstLeaf(n.comment)]) + else: + result = nil + +proc genRecCommentAux(d: PDoc, n: PNode): PRstNode = if n == nil: return nil - result = genComment(d, n).rope + result = genComment(d, n) if result == nil: - if n.kind in {nkStmtList, nkStmtListExpr, nkTypeDef, nkConstDef, - nkObjectTy, nkRefTy, nkPtrTy, nkAsgn, nkFastAsgn, nkHiddenStdConv}: + if n.kind in {nkStmtList, nkStmtListExpr, nkTypeDef, nkConstDef, nkTypeClassTy, + nkObjectTy, nkRefTy, nkPtrTy, nkAsgn, nkFastAsgn, nkSinkAsgn, nkHiddenStdConv}: # notin {nkEmpty..nkNilLit, nkEnumTy, nkTupleTy}: for i in 0..<n.len: result = genRecCommentAux(d, n[i]) @@ -355,9 +457,9 @@ proc genRecCommentAux(d: PDoc, n: PNode): Rope = else: n.comment = "" -proc genRecComment(d: PDoc, n: PNode): Rope = +proc genRecComment(d: PDoc, n: PNode): PRstNode = if n == nil: return nil - result = genComment(d, n).rope + result = genComment(d, n) if result == nil: if n.kind in {nkProcDef, nkFuncDef, nkMethodDef, nkIteratorDef, nkMacroDef, nkTemplateDef, nkConverterDef}: @@ -375,13 +477,11 @@ proc getPlainDocstring(n: PNode): string = elif startsWith(n.comment, "##"): result = n.comment else: + result = "" for i in 0..<n.safeLen: result = getPlainDocstring(n[i]) if result.len > 0: return -proc belongsToPackage(conf: ConfigRef; module: PSym): bool = - result = module.kind == skModule and module.getnimblePkgId == conf.mainPackageId - proc externalDep(d: PDoc; module: PSym): string = if optWholeProject in d.conf.globalOptions or d.conf.docRoot.len > 0: let full = AbsoluteFile toFullPath(d.conf, FileIndex module.position) @@ -390,15 +490,15 @@ proc externalDep(d: PDoc; module: PSym): string = else: result = extractFilename toFullPath(d.conf, FileIndex module.position) -proc nodeToHighlightedHtml(d: PDoc; n: PNode; result: var Rope; renderFlags: TRenderFlags = {}; - procLink: Rope) = - var r: TSrcGen +proc nodeToHighlightedHtml(d: PDoc; n: PNode; result: var string; + renderFlags: TRenderFlags = {}; + procLink: string) = + var r: TSrcGen = initTokRender(n, renderFlags) var literal = "" - initTokRender(r, n, renderFlags) var kind = tkEof var tokenPos = 0 var procTokenPos = 0 - template escLit(): untyped = rope(esc(d.target, literal)) + template escLit(): untyped = esc(d.target, literal) while true: getNextTok(r, kind, literal) inc tokenPos @@ -412,11 +512,11 @@ proc nodeToHighlightedHtml(d: PDoc; n: PNode; result: var Rope; renderFlags: TRe if kind in {tkProc, tkMethod, tkIterator, tkMacro, tkTemplate, tkFunc, tkConverter}: procTokenPos = tokenPos dispA(d.conf, result, "<span class=\"Keyword\">$1</span>", "\\spanKeyword{$1}", - [rope(literal)]) + [literal]) of tkOpr: dispA(d.conf, result, "<span class=\"Operator\">$1</span>", "\\spanOperator{$1}", [escLit]) - of tkStrLit..tkTripleStrLit: + of tkStrLit..tkTripleStrLit, tkCustomLit: dispA(d.conf, result, "<span class=\"StringLit\">$1</span>", "\\spanStringLit{$1}", [escLit]) of tkCharLit: @@ -431,37 +531,37 @@ proc nodeToHighlightedHtml(d: PDoc; n: PNode; result: var Rope; renderFlags: TRe of tkSymbol: let s = getTokSym(r) # -2 because of the whitespace in between: - if procTokenPos == tokenPos-2 and procLink != nil: + if procTokenPos == tokenPos-2 and procLink != "": dispA(d.conf, result, "<a href=\"#$2\"><span class=\"Identifier\">$1</span></a>", "\\spanIdentifier{$1}", [escLit, procLink]) elif s != nil and s.kind in {skType, skVar, skLet, skConst} and sfExported in s.flags and s.owner != nil and - belongsToPackage(d.conf, s.owner) and d.target == outHtml: + belongsToProjectPackage(d.conf, s.owner) and d.target == outHtml: let external = externalDep(d, s.owner) result.addf "<a href=\"$1#$2\"><span class=\"Identifier\">$3</span></a>", - [rope changeFileExt(external, "html"), rope literal, + [changeFileExt(external, "html"), literal, escLit] else: dispA(d.conf, result, "<span class=\"Identifier\">$1</span>", "\\spanIdentifier{$1}", [escLit]) of tkSpaces, tkInvalid: result.add(literal) - of tkCurlyDotLe: + of tkHideableStart: template fun(s) = dispA(d.conf, result, s, "\\spanOther{$1}", [escLit]) if renderRunnableExamples in renderFlags: fun "$1" - else: fun: "<span>" & # This span is required for the JS to work properly - """<span class="Other">{</span><span class="Other pragmadots">...</span><span class="Other">}</span> + else: + # 1st span is required for the JS to work properly + fun """ +<span> +<span class="Other pragmadots">...</span> </span> -<span class="pragmawrap"> -<span class="Other">$1</span> -<span class="pragma">""".replace("\n", "") # Must remove newlines because wrapped in a <pre> - of tkCurlyDotRi: +<span class="pragmawrap">""".replace("\n", "") # Must remove newlines because wrapped in a <pre> + of tkHideableEnd: template fun(s) = dispA(d.conf, result, s, "\\spanOther{$1}", [escLit]) if renderRunnableExamples in renderFlags: fun "$1" - else: fun """ -</span> -<span class="Other">$1</span> -</span>""".replace("\n", "") + else: fun "</span>" + of tkCurlyDotLe: dispA(d.conf, result, "$1", "\\spanOther{$1}", [escLit]) + of tkCurlyDotRi: dispA(d.conf, result, "$1", "\\spanOther{$1}", [escLit]) of tkParLe, tkParRi, tkBracketLe, tkBracketRi, tkCurlyLe, tkCurlyRi, tkBracketDotLe, tkBracketDotRi, tkParDotLe, tkParDotRi, tkComma, tkSemiColon, tkColon, tkEquals, tkDot, tkDotDot, @@ -486,26 +586,37 @@ proc runAllExamples(d: PDoc) = # most useful semantics is that `docCmd` comes after `rdoccmd`, so that we can (temporarily) override # via command line # D20210224T221756:here - let cmd = "$nim $backend -r --lib:$libpath --warning:UnusedImport:off --path:$path --nimcache:$nimcache $rdoccmd $docCmd $file" % [ + var pathArgs = "--path:$path" % [ "path", quoteShell(d.conf.projectPath) ] + for p in d.conf.searchPaths: + pathArgs = "$args --path:$path" % [ "args", pathArgs, "path", quoteShell(p) ] + let cmd = "$nim $backend -r --lib:$libpath --warning:UnusedImport:off $pathArgs --nimcache:$nimcache $rdoccmd $docCmd $file" % [ "nim", quoteShell(os.getAppFilename()), "backend", $d.conf.backend, - "path", quoteShell(d.conf.projectPath), + "pathArgs", pathArgs, "libpath", quoteShell(d.conf.libpath), "nimcache", quoteShell(outputDir), "file", quoteShell(outp), "rdoccmd", group.rdoccmd, "docCmd", group.docCmd, ] - if os.execShellCmd(cmd) != 0: - quit "[runnableExamples] failed: generated file: '$1' group: '$2' cmd: $3" % [outp.string, group[].prettyString, cmd] + if d.conf.backend == backendJs and findNodeJs() == "": + discard "ignore JS runnableExample" + elif os.execShellCmd(cmd) != 0: + d.conf.quitOrRaise "[runnableExamples] failed: generated file: '$1' group: '$2' cmd: $3" % [outp.string, group[].prettyString, cmd] else: # keep generated source file `outp` to allow inspection. rawMessage(d.conf, hintSuccess, ["runnableExamples: " & outp.string]) # removeFile(outp.changeFileExt(ExeExt)) # it's in nimcache, no need to remove -proc quoted(a: string): string = result.addQuoted(a) +proc quoted(a: string): string = + result = "" + result.addQuoted(a) -proc prepareExample(d: PDoc; n: PNode): tuple[rdoccmd: string, code: string] = +proc toInstantiationInfo(conf: ConfigRef, info: TLineInfo): (string, int, int) = + # xxx expose in compiler/lineinfos.nim + (conf.toMsgFilename(info), info.line.int, info.col.int + ColOffset) + +proc prepareExample(d: PDoc; n: PNode, topLevel: bool): tuple[rdoccmd: string, code: string] = ## returns `rdoccmd` and source code for this runnableExamples var rdoccmd = "" if n.len < 2 or n.len > 3: globalError(d.conf, n.info, "runnableExamples invalid") @@ -526,13 +637,14 @@ proc prepareExample(d: PDoc; n: PNode): tuple[rdoccmd: string, code: string] = let outputDir = d.exampleOutputDir createDir(outputDir) inc d.exampleCounter - let outp = outputDir / RelativeFile(extractFilename(d.filename.changeFileExt"" & ("_examples$1.nim" % $d.exampleCounter))) + let outp = outputDir / RelativeFile("$#_examples_$#.nim" % [d.filename.extractFilename.changeFileExt"", $d.exampleCounter]) if useRenderModule: var docComment = newTree(nkCommentStmt) docComment.comment = comment var runnableExamples = newTree(nkStmtList, docComment, + newTree(nkImportStmt, newStrNode(nkStrLit, "std/assertions")), newTree(nkImportStmt, newStrNode(nkStrLit, d.filename))) runnableExamples.info = n.info for a in n.lastSon: runnableExamples.add a @@ -544,19 +656,36 @@ proc prepareExample(d: PDoc; n: PNode): tuple[rdoccmd: string, code: string] = renderModule(runnableExamples, outp.string, conf = d.conf) else: - let code2 = """ + var code2 = code + if code.len > 0 and "codeReordering" notin code: + let codeIndent = extractRunnableExamplesSource(d.conf, n, indent = 2) + # hacky but simplest solution, until we devise a way to make `{.line.}` + # work without introducing a scope + code2 = """ +{.line: $#.}: +$# +""" % [$toInstantiationInfo(d.conf, n.info), codeIndent] + code2 = """ #[ -$1 +$# ]# -import $2 -$3 -""" % [comment, d.filename.quoted, code] +import std/assertions +import $# +$# +""" % [comment, d.filename.quoted, code2] writeFile(outp.string, code2) if rdoccmd notin d.exampleGroups: d.exampleGroups[rdoccmd] = ExampleGroup(rdoccmd: rdoccmd, docCmd: d.conf.docCmd, index: d.exampleGroups.len) d.exampleGroups[rdoccmd].code.add "import $1\n" % outp.string.quoted - result = (rdoccmd, code) + + var codeShown: string + if topLevel: # refs https://github.com/nim-lang/RFCs/issues/352 + let title = canonicalImport(d.conf, AbsoluteFile d.filename) + codeShown = "import $#\n$#" % [title, code] + else: + codeShown = code + result = (rdoccmd, codeShown) when false: proc extractImports(n: PNode; result: PNode) = if n.kind in {nkImportStmt, nkImportExceptStmt, nkFromStmt}: @@ -576,7 +705,9 @@ type RunnableState = enum rsRunnable rsDone -proc getAllRunnableExamplesImpl(d: PDoc; n: PNode, dest: var Rope, state: RunnableState): RunnableState = +proc getAllRunnableExamplesImpl(d: PDoc; n: PNode, dest: var ItemPre, + state: RunnableState, topLevel: bool): + RunnableState = ##[ Simple state machine to tell whether we render runnableExamples and doc comments. This is to ensure that we can interleave runnableExamples and doc comments freely; @@ -600,20 +731,25 @@ proc getAllRunnableExamplesImpl(d: PDoc; n: PNode, dest: var Rope, state: Runnab return rsComment of nkCallKinds: if isRunnableExamples(n[0]) and - n.len >= 2 and n.lastSon.kind == nkStmtList and state in {rsStart, rsComment, rsRunnable}: - let (rdoccmd, code) = prepareExample(d, n) - var msg = "Example:" - if rdoccmd.len > 0: msg.add " cmd: " & rdoccmd - dispA(d.conf, dest, "\n<p><strong class=\"examples_text\">$1</strong></p>\n", - "\n\\textbf{$1}\n", [msg.rope]) - inc d.listingCounter - let id = $d.listingCounter - dest.add(d.config.getOrDefault"doc.listing_start" % [id, "langNim", ""]) - var dest2 = "" - renderNimCode(dest2, code, isLatex = d.conf.cmd == cmdRst2tex) - dest.add dest2 - dest.add(d.config.getOrDefault"doc.listing_end" % id) - return rsRunnable + n.len >= 2 and n.lastSon.kind == nkStmtList: + if state in {rsStart, rsComment, rsRunnable}: + let (rdoccmd, code) = prepareExample(d, n, topLevel) + var msg = "Example:" + if rdoccmd.len > 0: msg.add " cmd: " & rdoccmd + var s: string = "" + dispA(d.conf, s, "\n<p><strong class=\"examples_text\">$1</strong></p>\n", + "\n\n\\textbf{$1}\n", [msg]) + dest.add s + inc d.listingCounter + let id = $d.listingCounter + dest.add(d.config.getOrDefault"doc.listing_start" % [id, "langNim", ""]) + var dest2 = "" + renderNimCode(dest2, code, d.target) + dest.add dest2 + 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") else: discard return rsDone # change this to `rsStart` if you want to keep generating doc comments @@ -649,22 +785,22 @@ proc getRoutineBody(n: PNode): PNode = doAssert result.len == 2 result = result[1] -proc getAllRunnableExamples(d: PDoc, n: PNode, dest: var Rope) = +proc getAllRunnableExamples(d: PDoc, n: PNode, dest: var ItemPre) = var n = n var state = rsStart - template fn(n2) = - state = getAllRunnableExamplesImpl(d, n2, dest, state) - dest.add genComment(d, n).rope + template fn(n2, topLevel) = + state = getAllRunnableExamplesImpl(d, n2, dest, state, topLevel) + dest.add genComment(d, n) case n.kind of routineDefs: n = n.getRoutineBody case n.kind - of nkCommentStmt, nkCallKinds: fn(n) + of nkCommentStmt, nkCallKinds: fn(n, topLevel = false) else: for i in 0..<n.safeLen: - fn(n[i]) - if state == rsDone: return - else: fn(n) + fn(n[i], topLevel = false) + if state == rsDone: discard # check all sons + else: fn(n, topLevel = true) proc isVisible(d: PDoc; n: PNode): bool = result = false @@ -685,21 +821,24 @@ proc isVisible(d: PDoc; n: PNode): bool = elif n.kind == nkPragmaExpr: result = isVisible(d, n[0]) -proc getName(d: PDoc, n: PNode, splitAfter = -1): string = +proc getName(n: PNode): string = case n.kind - of nkPostfix: result = getName(d, n[1], splitAfter) - of nkPragmaExpr: result = getName(d, n[0], splitAfter) - of nkSym: result = esc(d.target, n.sym.renderDefinitionName, splitAfter) - of nkIdent: result = esc(d.target, n.ident.s, splitAfter) + of nkPostfix: result = getName(n[1]) + of nkPragmaExpr: result = getName(n[0]) + of nkSym: result = n.sym.renderDefinitionName + of nkIdent: result = n.ident.s of nkAccQuoted: - result = esc(d.target, "`") - for i in 0..<n.len: result.add(getName(d, n[i], splitAfter)) - result.add esc(d.target, "`") - of nkOpenSymChoice, nkClosedSymChoice: - result = getName(d, n[0], splitAfter) + result = "`" + for i in 0..<n.len: result.add(getName(n[i])) + result = "`" + of nkOpenSymChoice, nkClosedSymChoice, nkOpenSym: + result = getName(n[0]) else: result = "" +proc getNameEsc(d: PDoc, n: PNode): string = + esc(d.target, getName(n)) + proc getNameIdent(cache: IdentCache; n: PNode): PIdent = case n.kind of nkPostfix: result = getNameIdent(cache, n[1]) @@ -710,7 +849,7 @@ proc getNameIdent(cache: IdentCache; n: PNode): PIdent = var r = "" for i in 0..<n.len: r.add(getNameIdent(cache, n[i]).s) result = getIdent(cache, r) - of nkOpenSymChoice, nkClosedSymChoice: + of nkOpenSymChoice, nkClosedSymChoice, nkOpenSym: result = getNameIdent(cache, n[0]) else: result = nil @@ -724,7 +863,7 @@ proc getRstName(n: PNode): PRstNode = of nkAccQuoted: result = getRstName(n[0]) for i in 1..<n.len: result.text.add(getRstName(n[i]).text) - of nkOpenSymChoice, nkClosedSymChoice: + of nkOpenSymChoice, nkClosedSymChoice, nkOpenSym: result = getRstName(n[0]) else: result = nil @@ -758,7 +897,7 @@ proc complexName(k: TSymKind, n: PNode, baseName: string): string = ## types will be added with a preceding dash. Return types won't be added. ## ## If you modify the output of this proc, please update the anchor generation - ## section of ``doc/docgen.txt``. + ## section of ``doc/docgen.rst``. result = baseName case k of skProc, skFunc: discard @@ -774,14 +913,6 @@ proc complexName(k: TSymKind, n: PNode, baseName: string): string = result.add(defaultParamSeparator) result.add(params) -proc isCallable(n: PNode): bool = - ## Returns true if `n` contains a callable node. - case n.kind - of nkProcDef, nkMethodDef, nkIteratorDef, nkMacroDef, nkTemplateDef, - nkConverterDef, nkFuncDef: result = true - else: - result = false - proc docstringSummary(rstText: string): string = ## Returns just the first line or a brief chunk of text from a rst string. ## @@ -798,7 +929,7 @@ proc docstringSummary(rstText: string): string = result = rstText.substr(2).strip var pos = result.find('\L') if pos > 0: - result.delete(pos, result.len - 1) + result.setLen(pos - 1) result.add("…") if pos < maxDocstringChars: return @@ -806,31 +937,32 @@ proc docstringSummary(rstText: string): string = pos = result.find({'.', ',', ':'}) let last = result.len - 1 if pos > 0 and pos < last: - result.delete(pos, last) + result.setLen(pos - 1) result.add("…") -proc genDeprecationMsg(d: PDoc, n: PNode): Rope = +proc genDeprecationMsg(d: PDoc, n: PNode): string = ## Given a nkPragma wDeprecated node output a well-formatted section if n == nil: return case n.safeLen: of 0: # Deprecated w/o any message - result = ropeFormatNamedVars(d.conf, - getConfigVar(d.conf, "doc.deprecationmsg"), ["label", "message"], - [~"Deprecated", nil]) + result = getConfigVar(d.conf, "doc.deprecationmsg") % [ + "label" , "Deprecated", "message", ""] of 2: # Deprecated w/ a message if n[1].kind in {nkStrLit..nkTripleStrLit}: - result = ropeFormatNamedVars(d.conf, - getConfigVar(d.conf, "doc.deprecationmsg"), ["label", "message"], - [~"Deprecated:", rope(xmltree.escape(n[1].strVal))]) + result = getConfigVar(d.conf, "doc.deprecationmsg") % [ + "label", "Deprecated:", "message", xmltree.escape(n[1].strVal)] + else: + result = "" else: - doAssert false + raiseAssert "unreachable" type DocFlags = enum kDefault kForceExport -proc genSeeSrcRope(d: PDoc, path: string, line: int): Rope = +proc genSeeSrc(d: PDoc, path: string, line: int): string = + result = "" let docItemSeeSrc = getConfigVar(d.conf, "doc.item.seesrc") if docItemSeeSrc.len > 0: let path = relativeTo(AbsoluteFile path, AbsoluteDir getCurrentDir(), '/') @@ -846,119 +978,214 @@ proc genSeeSrcRope(d: PDoc, path: string, line: int): Rope = else: "version-$1-$2" % [$NimMajor, $NimMinor] let commit = getConfigVar(d.conf, "git.commit", defaultBranch) let develBranch = getConfigVar(d.conf, "git.devel", "devel") - dispA(d.conf, result, "$1", "", [ropeFormatNamedVars(d.conf, docItemSeeSrc, - ["path", "line", "url", "commit", "devel"], [rope path.string, - rope($line), rope gitUrl, rope commit, rope develBranch])]) + dispA(d.conf, result, "$1", "", [docItemSeeSrc % [ + "path", path.string, "line", $line, "url", gitUrl, + "commit", commit, "devel", develBranch]]) + +proc symbolPriority(k: TSymKind): int = + result = case k + of skMacro: -3 + of skTemplate: -2 + of skIterator: -1 + else: 0 # including skProc which have higher priority + # documentation itself has even higher priority 1 + +proc getTypeKind(n: PNode): string = + case n[2].kind + of nkEnumTy: "enum" + of nkObjectTy: "object" + of nkTupleTy: "tuple" + else: "" + +proc toLangSymbol(k: TSymKind, n: PNode, baseName: string): LangSymbol = + ## Converts symbol info (names/types/parameters) in `n` into format + ## `LangSymbol` convenient for ``rst.nim``/``dochelpers.nim``. + result = LangSymbol(name: baseName.nimIdentNormalize, + symKind: k.toHumanStr + ) + if k in routineKinds: + var + paramTypes: seq[string] = @[] + renderParamTypes(paramTypes, n[paramsPos], toNormalize=true) + let paramNames = renderParamNames(n[paramsPos], toNormalize=true) + # In some rare cases (system.typeof) parameter type is not set for default: + doAssert paramTypes.len <= paramNames.len + for i in 0 ..< paramNames.len: + if i < paramTypes.len: + result.parameters.add (paramNames[i], paramTypes[i]) + else: + result.parameters.add (paramNames[i], "") + result.parametersProvided = true + + result.outType = renderOutType(n[paramsPos], toNormalize=true) -proc genItem(d: PDoc, n, nameNode: PNode, k: TSymKind, docFlags: DocFlags) = + if k in {skProc, skFunc, skType, skIterator}: + # Obtain `result.generics` + # Use `n[miscPos]` since n[genericParamsPos] does not contain constraints + var genNode: PNode = nil + if k == skType: + genNode = n[1] # FIXME: what is index 1? + else: + if n[miscPos].kind != nkEmpty: + genNode = n[miscPos][1] # FIXME: what is index 1? + if genNode != nil: + var literal = "" + var r: TSrcGen = initTokRender(genNode, {renderNoBody, renderNoComments, + renderNoPragmas, renderNoProcDefs, renderExpandUsing, renderNoPostfix}) + var kind = tkEof + while true: + getNextTok(r, kind, literal) + if kind == tkEof: + break + if kind != tkSpaces: + result.generics.add(literal.nimIdentNormalize) + + if k == skType: result.symTypeKind = getTypeKind(n) + +proc genItem(d: PDoc, n, nameNode: PNode, k: TSymKind, docFlags: DocFlags, nonExports: bool = false) = if (docFlags != kForceExport) and not isVisible(d, nameNode): return let - name = getName(d, nameNode) - nameRope = name.rope + name = getName(nameNode) + nameEsc = esc(d.target, name) var plainDocstring = getPlainDocstring(n) # call here before genRecComment! - var result: Rope = nil + var result = "" var literal, plainName = "" var kind = tkEof - var comm: Rope = nil + var comm: ItemPre = default(ItemPre) if n.kind in routineDefs: getAllRunnableExamples(d, n, comm) else: comm.add genRecComment(d, n) - var r: TSrcGen # Obtain the plain rendered string for hyperlink titles. - initTokRender(r, n, {renderNoBody, renderNoComments, renderDocComments, - renderNoPragmas, renderNoProcDefs}) + var r: TSrcGen = initTokRender(n, {renderNoBody, renderNoComments, renderDocComments, + renderNoPragmas, renderNoProcDefs, renderExpandUsing, renderNoPostfix}) while true: getNextTok(r, kind, literal) if kind == tkEof: break plainName.add(literal) - var pragmaNode: PNode = nil - if n.isCallable and n[pragmasPos].kind != nkEmpty: - pragmaNode = findPragma(n[pragmasPos], wDeprecated) + var pragmaNode = getDeclPragma(n) + if pragmaNode != nil: pragmaNode = findPragma(pragmaNode, wDeprecated) inc(d.id) let - plainNameRope = rope(xmltree.escape(plainName.strip)) + plainNameEsc = esc(d.target, plainName.strip) + typeDescr = + if k == skType and getTypeKind(n) != "": getTypeKind(n) + else: k.toHumanStr + detailedName = typeDescr & " " & ( + if k in routineKinds: plainName else: name) + uniqueName = if k in routineKinds: plainNameEsc else: nameEsc + sortName = if k in routineKinds: plainName.strip else: name cleanPlainSymbol = renderPlainSymbolName(nameNode) complexSymbol = complexName(k, n, cleanPlainSymbol) - plainSymbolRope = rope(cleanPlainSymbol) - plainSymbolEncRope = rope(encodeUrl(cleanPlainSymbol)) - itemIDRope = rope(d.id) + plainSymbolEnc = encodeUrl(cleanPlainSymbol, usePlus = false) symbolOrId = d.newUniquePlainSymbol(complexSymbol) - symbolOrIdRope = symbolOrId.rope - symbolOrIdEncRope = encodeUrl(symbolOrId).rope - deprecationMsgRope = genDeprecationMsg(d, pragmaNode) - - nodeToHighlightedHtml(d, n, result, {renderNoBody, renderNoComments, - renderDocComments, renderSyms}, symbolOrIdEncRope) - - let seeSrcRope = genSeeSrcRope(d, toFullPath(d.conf, n.info), n.info.line.int) - d.section[k].add(ropeFormatNamedVars(d.conf, getConfigVar(d.conf, "doc.item"), - ["name", "header", "desc", "itemID", "header_plain", "itemSym", - "itemSymOrID", "itemSymEnc", "itemSymOrIDEnc", "seeSrc", "deprecationMsg"], - [nameRope, result, comm, itemIDRope, plainNameRope, plainSymbolRope, - symbolOrIdRope, plainSymbolEncRope, symbolOrIdEncRope, seeSrcRope, - deprecationMsgRope])) + symbolOrIdEnc = encodeUrl(symbolOrId, usePlus = false) + deprecationMsg = genDeprecationMsg(d, pragmaNode) + rstLangSymbol = toLangSymbol(k, n, cleanPlainSymbol) + symNameNode = + if nameNode.kind == nkPostfix: nameNode[1] + else: nameNode + + # we generate anchors automatically for subsequent use in doc comments + let lineinfo = rstast.TLineInfo( + line: nameNode.info.line, col: nameNode.info.col, + fileIndex: addRstFileIndex(d, nameNode.info)) + addAnchorNim(d.sharedState, external = false, refn = symbolOrId, + tooltip = detailedName, langSym = rstLangSymbol, + priority = symbolPriority(k), info = lineinfo, + module = addRstFileIndex(d, FileIndex d.module.position)) + + var renderFlags = {renderNoBody, renderNoComments, renderDocComments, + renderSyms, renderExpandUsing, renderNoPostfix} + if nonExports: + renderFlags.incl renderNonExportedFields + nodeToHighlightedHtml(d, n, result, renderFlags, symbolOrIdEnc) + + let seeSrc = genSeeSrc(d, toFullPath(d.conf, n.info), n.info.line.int) + + d.section[k].secItems.mgetOrPut(cleanPlainSymbol, newSeq[Item]()).add Item( + descRst: comm, + sortName: sortName, + info: lineinfo, + anchor: symbolOrId, + detailedName: detailedName, + name: name, + substitutions: @[ + "uniqueName", uniqueName, + "header", result, "itemID", $d.id, + "header_plain", plainNameEsc, "itemSym", cleanPlainSymbol, + "itemSymEnc", plainSymbolEnc, + "itemSymOrIDEnc", symbolOrIdEnc, "seeSrc", seeSrc, + "deprecationMsg", deprecationMsg]) let external = d.destFile.AbsoluteFile.relativeTo(d.conf.outDir, '/').changeFileExt(HtmlExt).string - var attype: Rope - if k in routineKinds and nameNode.kind == nkSym: + var attype = "" + if k in routineKinds and symNameNode.kind == nkSym: let att = attachToType(d, nameNode.sym) if att != nil: - attype = rope esc(d.target, att.name.s) - elif k == skType and nameNode.kind == nkSym and nameNode.sym.typ.kind in {tyEnum, tyBool}: - let etyp = nameNode.sym.typ + attype = esc(d.target, att.name.s) + elif k == skType and symNameNode.kind == nkSym and + symNameNode.sym.typ.kind in {tyEnum, tyBool}: + let etyp = symNameNode.sym.typ for e in etyp.n: if e.sym.kind != skEnumField: continue let plain = renderPlainSymbolName(e) let symbolOrId = d.newUniquePlainSymbol(plain) - setIndexTerm(d[], external, symbolOrId, plain, nameNode.sym.name.s & '.' & plain, - xmltree.escape(getPlainDocstring(e).docstringSummary)) - - d.toc[k].add(ropeFormatNamedVars(d.conf, getConfigVar(d.conf, "doc.item.toc"), - ["name", "header_plain", "itemSymOrIDEnc"], - [nameRope, plainNameRope, symbolOrIdEncRope])) - - d.tocTable[k].mgetOrPut(cleanPlainSymbol, nil).add(ropeFormatNamedVars( - d.conf, getConfigVar(d.conf, "doc.item.tocTable"), - ["name", "header_plain", "itemSymOrID", "itemSymOrIDEnc"], - [nameRope, plainNameRope, rope(symbolOrId.replace(",", ",<wbr>")), symbolOrIdEncRope])) - - # Ironically for types the complexSymbol is *cleaner* than the plainName - # because it doesn't include object fields or documentation comments. So we - # use the plain one for callable elements, and the complex for the rest. - var linkTitle = changeFileExt(extractFilename(d.filename), "") & ": " - if n.isCallable: linkTitle.add(xmltree.escape(plainName.strip)) - else: linkTitle.add(xmltree.escape(complexSymbol.strip)) - - setIndexTerm(d[], external, symbolOrId, name, linkTitle, - xmltree.escape(plainDocstring.docstringSummary)) - if k == skType and nameNode.kind == nkSym: - d.types.strTableAdd nameNode.sym - -proc genJsonItem(d: PDoc, n, nameNode: PNode, k: TSymKind): JsonNode = + setIndexTerm(d[], ieNim, htmlFile = external, id = symbolOrId, + term = plain, linkTitle = symNameNode.sym.name.s & '.' & plain, + linkDesc = xmltree.escape(getPlainDocstring(e).docstringSummary), + line = n.info.line.int) + + d.tocSimple[k].add TocItem( + sortName: sortName, + content: getConfigVar(d.conf, "doc.item.toc") % [ + "name", name, "header_plain", plainNameEsc, + "itemSymOrIDEnc", symbolOrIdEnc]) + + d.tocTable[k].mgetOrPut(cleanPlainSymbol, newSeq[TocItem]()).add TocItem( + sortName: sortName, + content: getConfigVar(d.conf, "doc.item.tocTable") % [ + "name", name, "header_plain", plainNameEsc, + "itemSymOrID", symbolOrId.replace(",", ",<wbr>"), + "itemSymOrIDEnc", symbolOrIdEnc]) + + setIndexTerm(d[], ieNim, htmlFile = external, id = symbolOrId, term = name, + linkTitle = detailedName, + linkDesc = xmltree.escape(plainDocstring.docstringSummary), + line = n.info.line.int) + if k == skType and symNameNode.kind == nkSym: + d.types.strTableAdd symNameNode.sym + +proc genJsonItem(d: PDoc, n, nameNode: PNode, k: TSymKind, nonExports = false): JsonItem = if not isVisible(d, nameNode): return var - name = getName(d, nameNode) - comm = $genRecComment(d, n) + name = getNameEsc(d, nameNode) + comm = genRecComment(d, n) r: TSrcGen - initTokRender(r, n, {renderNoBody, renderNoComments, renderDocComments}) - result = %{ "name": %name, "type": %($k), "line": %n.info.line.int, - "col": %n.info.col} - if comm.len > 0: - result["description"] = %comm + renderFlags = {renderNoBody, renderNoComments, renderDocComments, + renderExpandUsing, renderNoPostfix} + if nonExports: + renderFlags.incl renderNonExportedFields + r = initTokRender(n, renderFlags) + result = JsonItem(json: %{ "name": %name, "type": %($k), "line": %n.info.line.int, + "col": %n.info.col} + ) + if comm != nil: + result.rst = comm + result.rstField = "description" if r.buf.len > 0: - result["code"] = %r.buf + result.json["code"] = %r.buf if k in routineKinds: - result["signature"] = newJObject() + result.json["signature"] = newJObject() if n[paramsPos][0].kind != nkEmpty: - result["signature"]["return"] = %($n[paramsPos][0]) + result.json["signature"]["return"] = %($n[paramsPos][0]) if n[paramsPos].len > 1: - result["signature"]["arguments"] = newJArray() + result.json["signature"]["arguments"] = newJArray() for paramIdx in 1 ..< n[paramsPos].len: for identIdx in 0 ..< n[paramsPos][paramIdx].len - 2: let @@ -966,22 +1193,61 @@ proc genJsonItem(d: PDoc, n, nameNode: PNode, k: TSymKind): JsonNode = paramType = $n[paramsPos][paramIdx][^2] if n[paramsPos][paramIdx][^1].kind != nkEmpty: let paramDefault = $n[paramsPos][paramIdx][^1] - result["signature"]["arguments"].add %{"name": %paramName, "type": %paramType, "default": %paramDefault} + result.json["signature"]["arguments"].add %{"name": %paramName, "type": %paramType, "default": %paramDefault} else: - result["signature"]["arguments"].add %{"name": %paramName, "type": %paramType} + result.json["signature"]["arguments"].add %{"name": %paramName, "type": %paramType} if n[pragmasPos].kind != nkEmpty: - result["signature"]["pragmas"] = newJArray() + result.json["signature"]["pragmas"] = newJArray() for pragma in n[pragmasPos]: - result["signature"]["pragmas"].add %($pragma) + result.json["signature"]["pragmas"].add %($pragma) if n[genericParamsPos].kind != nkEmpty: - result["signature"]["genericParams"] = newJArray() + result.json["signature"]["genericParams"] = newJArray() for genericParam in n[genericParamsPos]: var param = %{"name": %($genericParam)} - if genericParam.sym.typ.sons.len > 0: + if genericParam.sym.typ.len > 0: param["types"] = newJArray() - for kind in genericParam.sym.typ.sons: - param["types"].add %($kind) - result["signature"]["genericParams"].add param + param["types"] = %($genericParam.sym.typ.elementType) + result.json["signature"]["genericParams"].add param + if optGenIndex in d.conf.globalOptions: + genItem(d, n, nameNode, k, kForceExport) + +proc setDoctype(d: PDoc, n: PNode) = + ## Processes `{.doctype.}` pragma changing Markdown/RST parsing options. + if n == nil: + return + if n.len != 2: + localError(d.conf, n.info, errUser, + "doctype pragma takes exactly 1 argument" + ) + return + var dt = "" + case n[1].kind + of nkStrLit: + dt = toLowerAscii(n[1].strVal) + of nkIdent: + dt = toLowerAscii(n[1].ident.s) + else: + localError(d.conf, n.info, errUser, + "unknown argument type $1 provided to doctype" % [$n[1].kind] + ) + return + case dt + of "markdown": + d.sharedState.options.incl roSupportMarkdown + d.sharedState.options.incl roPreferMarkdown + of "rstmarkdown": + d.sharedState.options.incl roSupportMarkdown + d.sharedState.options.excl roPreferMarkdown + of "rst": + d.sharedState.options.excl roSupportMarkdown + d.sharedState.options.excl roPreferMarkdown + else: + localError(d.conf, n.info, errUser, + ( + "unknown doctype value \"$1\", should be from " & + "\"RST\", \"Markdown\", \"RstMarkdown\"" + ) % [dt] + ) proc checkForFalse(n: PNode): bool = result = n.kind == nkIdent and cmpIgnoreStyle(n.ident.s, "false") == 0 @@ -998,42 +1264,44 @@ proc traceDeps(d: PDoc, it: PNode) = for x in it[2]: a[2] = x traceDeps(d, a) - elif it.kind == nkSym and belongsToPackage(d.conf, it.sym): + elif it.kind == nkSym and belongsToProjectPackage(d.conf, it.sym): let external = externalDep(d, it.sym) - if d.section[k] != nil: d.section[k].add(", ") - dispA(d.conf, d.section[k], + if d.section[k].finalMarkup != "": d.section[k].finalMarkup.add(", ") + dispA(d.conf, d.section[k].finalMarkup, "<a class=\"reference external\" href=\"$2\">$1</a>", - "$1", [rope esc(d.target, external.prettyLink), - rope changeFileExt(external, "html")]) + "$1", [esc(d.target, external.prettyLink), + changeFileExt(external, "html")]) proc exportSym(d: PDoc; s: PSym) = const k = exportSection - if s.kind == skModule and belongsToPackage(d.conf, s): + if s.kind == skModule and belongsToProjectPackage(d.conf, s): let external = externalDep(d, s) - if d.section[k] != nil: d.section[k].add(", ") - dispA(d.conf, d.section[k], + if d.section[k].finalMarkup != "": d.section[k].finalMarkup.add(", ") + dispA(d.conf, d.section[k].finalMarkup, "<a class=\"reference external\" href=\"$2\">$1</a>", - "$1", [rope esc(d.target, external.prettyLink), - rope changeFileExt(external, "html")]) + "$1", [esc(d.target, external.prettyLink), + changeFileExt(external, "html")]) elif s.kind != skModule and s.owner != nil: let module = originatingModule(s) - if belongsToPackage(d.conf, module): + if belongsToProjectPackage(d.conf, module): let complexSymbol = complexName(s.kind, s.ast, s.name.s) - symbolOrIdRope = rope(d.newUniquePlainSymbol(complexSymbol)) + symbolOrId = d.newUniquePlainSymbol(complexSymbol) external = externalDep(d, module) - if d.section[k] != nil: d.section[k].add(", ") + if d.section[k].finalMarkup != "": d.section[k].finalMarkup.add(", ") # XXX proper anchor generation here - dispA(d.conf, d.section[k], + dispA(d.conf, d.section[k].finalMarkup, "<a href=\"$2#$3\"><span class=\"Identifier\">$1</span></a>", - "$1", [rope esc(d.target, s.name.s), - rope changeFileExt(external, "html"), - symbolOrIdRope]) + "$1", [esc(d.target, s.name.s), + changeFileExt(external, "html"), + symbolOrId]) proc documentNewEffect(cache: IdentCache; n: PNode): PNode = let s = n[namePos].sym if tfReturnsNew in s.typ.flags: result = newIdentNode(getIdent(cache, "new"), n.info) + else: + result = nil proc documentEffect(cache: IdentCache; n, x: PNode, effectType: TSpecialWord, idx: int): PNode = let spec = effectSpec(x, effectType) @@ -1043,10 +1311,11 @@ proc documentEffect(cache: IdentCache; n, x: PNode, effectType: TSpecialWord, id let actual = s.typ.n[0] if actual.len != effectListLen: return let real = actual[idx] - + if real == nil: return + let realLen = real.len # warning: hack ahead: - var effects = newNodeI(nkBracket, n.info, real.len) - for i in 0..<real.len: + var effects = newNodeI(nkBracket, n.info, realLen) + for i in 0..<realLen: var t = typeToString(real[i].typ) if t.startsWith("ref "): t = substr(t, 4) effects[i] = newIdentNode(getIdent(cache, t), n.info) @@ -1055,6 +1324,8 @@ proc documentEffect(cache: IdentCache; n, x: PNode, effectType: TSpecialWord, id result = newTreeI(nkExprColonExpr, n.info, newIdentNode(getIdent(cache, $effectType), n.info), effects) + else: + result = nil proc documentWriteEffect(cache: IdentCache; n: PNode; flag: TSymFlag; pragmaName: string): PNode = let s = n[namePos].sym @@ -1068,6 +1339,8 @@ proc documentWriteEffect(cache: IdentCache; n: PNode; flag: TSymFlag; pragmaName if effects.len > 0: result = newTreeI(nkExprColonExpr, n.info, newIdentNode(getIdent(cache, pragmaName), n.info), effects) + else: + result = nil proc documentRaises*(cache: IdentCache; n: PNode) = if n[namePos].kind != nkSym: return @@ -1077,8 +1350,9 @@ proc documentRaises*(cache: IdentCache; n: PNode) = let p3 = documentWriteEffect(cache, n, sfWrittenTo, "writes") let p4 = documentNewEffect(cache, n) let p5 = documentWriteEffect(cache, n, sfEscapes, "escapes") + let p6 = documentEffect(cache, n, pragmas, wForbids, forbiddenEffects) - if p1 != nil or p2 != nil or p3 != nil or p4 != nil or p5 != nil: + if p1 != nil or p2 != nil or p3 != nil or p4 != nil or p5 != nil or p6 != nil: if pragmas.kind == nkEmpty: n[pragmasPos] = newNodeI(nkPragma, n.info) if p1 != nil: n[pragmasPos].add p1 @@ -1086,15 +1360,22 @@ proc documentRaises*(cache: IdentCache; n: PNode) = if p3 != nil: n[pragmasPos].add p3 if p4 != nil: n[pragmasPos].add p4 if p5 != nil: n[pragmasPos].add p5 + if p6 != nil: n[pragmasPos].add p6 -proc generateDoc*(d: PDoc, n, orig: PNode, docFlags: DocFlags = kDefault) = +proc generateDoc*(d: PDoc, n, orig: PNode, config: ConfigRef, docFlags: DocFlags = kDefault) = + ## Goes through nim nodes recursively and collects doc comments. + ## Main function for `doc`:option: command, + ## which is implemented in ``docgen2.nim``. template genItemAux(skind) = genItem(d, n, n[namePos], skind, docFlags) + let showNonExports = optShowNonExportedFields in config.globalOptions case n.kind of nkPragma: let pragmaNode = findPragma(n, wDeprecated) d.modDeprecationMsg.add(genDeprecationMsg(d, pragmaNode)) - of nkCommentStmt: d.modDesc.add(genComment(d, n)) + let doctypeNode = findPragma(n, wDoctype) + setDoctype(d, doctypeNode) + of nkCommentStmt: d.modDescPre.add(genComment(d, n)) of nkProcDef, nkFuncDef: when useEffectSystem: documentRaises(d.cache, n) genItemAux(skProc) @@ -1114,40 +1395,185 @@ proc generateDoc*(d: PDoc, n, orig: PNode, docFlags: DocFlags = kDefault) = if n[i].kind != nkCommentStmt: # order is always 'type var let const': genItem(d, n[i], n[i][0], - succ(skType, ord(n.kind)-ord(nkTypeSection)), docFlags) + succ(skType, ord(n.kind)-ord(nkTypeSection)), docFlags, showNonExports) of nkStmtList: - for i in 0..<n.len: generateDoc(d, n[i], orig) + for i in 0..<n.len: generateDoc(d, n[i], orig, config) of nkWhenStmt: # generate documentation for the first branch only: if not checkForFalse(n[0][0]): - generateDoc(d, lastSon(n[0]), orig) + generateDoc(d, lastSon(n[0]), orig, config) of nkImportStmt: for it in n: traceDeps(d, it) of nkExportStmt: for it in n: - if it.kind == nkSym: + # bug #23051; don't generate documentation for exported symbols again + if it.kind == nkSym and sfExported notin it.sym.flags: if d.module != nil and d.module == it.sym.owner: - generateDoc(d, it.sym.ast, orig, kForceExport) + generateDoc(d, it.sym.ast, orig, config, kForceExport) elif it.sym.ast != nil: exportSym(d, it.sym) of nkExportExceptStmt: discard "transformed into nkExportStmt by semExportExcept" of nkFromStmt, nkImportExceptStmt: traceDeps(d, n[0]) of nkCallKinds: - var comm: Rope = nil + var comm: ItemPre = default(ItemPre) getAllRunnableExamples(d, n, comm) - if comm != nil: d.modDesc.add(comm) + if comm.len != 0: d.modDescPre.add(comm) else: discard -proc add(d: PDoc; j: JsonNode) = - if j != nil: d.jArray.add j +proc overloadGroupName(s: string, k: TSymKind): string = + ## Turns a name like `f` into anchor `f-procs-all` + s & "-" & k.toHumanStr & "s-all" + +proc setIndexTitle(d: PDoc, useMetaTitle: bool) = + let titleKind = if d.standaloneDoc: ieMarkupTitle else: ieNimTitle + let external = AbsoluteFile(d.destFile) + .relativeTo(d.conf.outDir, '/') + .changeFileExt(HtmlExt) + .string + var term, linkTitle: string + if useMetaTitle and d.meta[metaTitle].len != 0: + term = d.meta[metaTitleRaw] + linkTitle = d.meta[metaTitleRaw] + else: + let filename = extractFilename(d.filename) + term = + if d.standaloneDoc: filename # keep .rst/.md extension + else: changeFileExt(filename, "") # rm .nim extension + linkTitle = + if d.standaloneDoc: term # keep .rst/.md extension + else: canonicalImport(d.conf, AbsoluteFile d.filename) + if not d.standaloneDoc: + linkTitle = "module " & linkTitle + setIndexTerm(d[], titleKind, htmlFile = external, id = "", + term = term, linkTitle = linkTitle) + +proc finishGenerateDoc*(d: var PDoc) = + ## Perform 2nd RST pass for resolution of links/footnotes/headings... + # copy file map `filenames` to ``rstgen.nim`` for its warnings + d.filenames = d.sharedState.filenames + + # Main title/subtitle are allowed only in the first RST fragment of document + var firstRst = PRstNode(nil) + for fragment in d.modDescPre: + if fragment.isRst: + firstRst = fragment.rst + break + d.hasToc = d.hasToc or d.sharedState.hasToc + # in --index:only mode we do NOT want to load other .idx, only write ours: + let importdoc = optGenIndexOnly notin d.conf.globalOptions and + optNoImportdoc notin d.conf.globalOptions + preparePass2(d.sharedState, firstRst, importdoc) + + if optGenIndexOnly in d.conf.globalOptions: + # Top-level doc.comments may contain titles and :idx: statements: + for fragment in d.modDescPre: + if fragment.isRst: + traverseForIndex(d[], fragment.rst) + setIndexTitle(d, useMetaTitle = d.standaloneDoc) + # Symbol-associated doc.comments may contain :idx: statements: + for k in TSymKind: + for _, overloadChoices in d.section[k].secItems: + for item in overloadChoices: + for fragment in item.descRst: + if fragment.isRst: + traverseForIndex(d[], fragment.rst) + + # add anchors to overload groups before RST resolution + for k in TSymKind: + if k in routineKinds: + for plainName, overloadChoices in d.section[k].secItems: + if overloadChoices.len > 1: + let refn = overloadGroupName(plainName, k) + let tooltip = "$1 ($2 overloads)" % [ + k.toHumanStr & " " & plainName, $overloadChoices.len] + let name = nimIdentBackticksNormalize(plainName) + # save overload group to ``.idx`` + let external = d.destFile.AbsoluteFile.relativeTo(d.conf.outDir, '/'). + changeFileExt(HtmlExt).string + setIndexTerm(d[], ieNimGroup, htmlFile = external, id = refn, + term = name, linkTitle = k.toHumanStr, + linkDesc = "", line = overloadChoices[0].info.line.int) + if optGenIndexOnly in d.conf.globalOptions: continue + addAnchorNim(d.sharedState, external=false, refn, tooltip, + LangSymbol(symKind: k.toHumanStr, + name: name, + isGroup: true), + priority = symbolPriority(k), + # select index `0` just to have any meaningful warning: + info = overloadChoices[0].info, + module = addRstFileIndex(d, FileIndex d.module.position)) + + if optGenIndexOnly in d.conf.globalOptions: + return + + # Finalize fragments of ``.nim`` or ``.rst`` file + proc renderItemPre(d: PDoc, fragments: ItemPre, result: var string) = + for f in fragments: + case f.isRst: + of true: + var resolved = resolveSubs(d.sharedState, f.rst) + renderRstToOut(d[], resolved, result) + of false: result &= f.str + proc cmp(x, y: Item): int = cmpDecimalsIgnoreCase(x.sortName, y.sortName) + for k in TSymKind: + # add symbols to section for each `k`, while optionally wrapping + # overloadable items with the same basic name by ``doc.item2`` + let overloadableNames = toSeq(keys(d.section[k].secItems)) + for plainName in overloadableNames.sorted(cmpDecimalsIgnoreCase): + var overloadChoices = d.section[k].secItems[plainName] + overloadChoices.sort(cmp) + var nameContent = "" + for item in overloadChoices: + var itemDesc: string = "" + renderItemPre(d, item.descRst, itemDesc) + nameContent.add( + getConfigVar(d.conf, "doc.item") % ( + item.substitutions & @[ + "desc", itemDesc, + "name", item.name, + "itemSymOrID", item.anchor])) + if k in routineKinds: + let plainNameEsc1 = esc(d.target, plainName.strip) + let plainNameEsc2 = esc(d.target, plainName.strip, escMode=emUrl) + d.section[k].finalMarkup.add( + getConfigVar(d.conf, "doc.item2") % ( + @["header_plain", plainNameEsc1, + "overloadGroupName", overloadGroupName(plainNameEsc2, k), + "content", nameContent])) + else: + d.section[k].finalMarkup.add(nameContent) + d.section[k].secItems.clear + renderItemPre(d, d.modDescPre, d.modDescFinal) + d.modDescPre.setLen 0 + + # Finalize fragments of ``.json`` file + for i, entry in d.jEntriesPre: + if entry.rst != nil: + let resolved = resolveSubs(d.sharedState, entry.rst) + var str: string = "" + renderRstToOut(d[], resolved, str) + entry.json[entry.rstField] = %str + d.jEntriesPre[i].rst = nil + + d.jEntriesFinal.add entry.json # generates docs + + setIndexTitle(d, useMetaTitle = d.standaloneDoc) + completePass2(d.sharedState) -proc generateJson*(d: PDoc, n: PNode, includeComments: bool = true) = +proc add(d: PDoc; j: JsonItem) = + if j.json != nil or j.rst != nil: d.jEntriesPre.add j + +proc generateJson*(d: PDoc, n: PNode, config: ConfigRef, includeComments: bool = true) = case n.kind + of nkPragma: + let doctypeNode = findPragma(n, wDoctype) + setDoctype(d, doctypeNode) of nkCommentStmt: if includeComments: - d.add %*{"comment": genComment(d, n)} + d.add JsonItem(rst: genComment(d, n), rstField: "comment", + json: %Table[string, string]()) else: - d.modDesc.add(genComment(d, n)) + d.modDescPre.add(genComment(d, n)) of nkProcDef, nkFuncDef: when useEffectSystem: documentRaises(d.cache, n) d.add genJsonItem(d, n, n[namePos], skProc) @@ -1169,20 +1595,20 @@ proc generateJson*(d: PDoc, n: PNode, includeComments: bool = true) = if n[i].kind != nkCommentStmt: # order is always 'type var let const': d.add genJsonItem(d, n[i], n[i][0], - succ(skType, ord(n.kind)-ord(nkTypeSection))) + succ(skType, ord(n.kind)-ord(nkTypeSection)), optShowNonExportedFields in config.globalOptions) of nkStmtList: for i in 0..<n.len: - generateJson(d, n[i], includeComments) + generateJson(d, n[i], config, includeComments) of nkWhenStmt: # generate documentation for the first branch only: if not checkForFalse(n[0][0]): - generateJson(d, lastSon(n[0]), includeComments) + generateJson(d, lastSon(n[0]), config, includeComments) else: discard proc genTagsItem(d: PDoc, n, nameNode: PNode, k: TSymKind): string = - result = getName(d, nameNode) & "\n" + result = getNameEsc(d, nameNode) & "\n" -proc generateTags*(d: PDoc, n: PNode, r: var Rope) = +proc generateTags*(d: PDoc, n: PNode, r: var string) = case n.kind of nkCommentStmt: if startsWith(n.comment, "##"): @@ -1227,85 +1653,116 @@ proc genSection(d: PDoc, kind: TSymKind, groupedToc = false) = "Imports", "Types", "Vars", "Lets", "Consts", "Vars", "Procs", "Funcs", "Methods", "Iterators", "Converters", "Macros", "Templates", "Exports" ] - if d.section[kind] == nil: return - var title = sectionNames[kind].rope - d.section[kind] = ropeFormatNamedVars(d.conf, getConfigVar(d.conf, "doc.section"), [ - "sectionid", "sectionTitle", "sectionTitleID", "content"], [ - ord(kind).rope, title, rope(ord(kind) + 50), d.section[kind]]) + if d.section[kind].finalMarkup == "": return + var title = sectionNames[kind] + d.section[kind].finalMarkup = getConfigVar(d.conf, "doc.section") % [ + "sectionid", $ord(kind), "sectionTitle", title, + "sectionTitleID", $(ord(kind) + 50), "content", d.section[kind].finalMarkup] - var tocSource = d.toc + proc cmp(x, y: TocItem): int = cmpDecimalsIgnoreCase(x.sortName, y.sortName) if groupedToc: - for p in d.tocTable[kind].keys: - d.toc2[kind].add ropeFormatNamedVars(d.conf, getConfigVar(d.conf, "doc.section.toc2"), [ - "sectionid", "sectionTitle", "sectionTitleID", "content", "plainName"], [ - ord(kind).rope, title, rope(ord(kind) + 50), d.tocTable[kind][p], p.rope]) - tocSource = d.toc2 + let overloadableNames = toSeq(keys(d.tocTable[kind])) + for plainName in overloadableNames.sorted(cmpDecimalsIgnoreCase): + var overloadChoices = d.tocTable[kind][plainName] + overloadChoices.sort(cmp) + var content: string = "" + for item in overloadChoices: + content.add item.content + d.toc2[kind].add getConfigVar(d.conf, "doc.section.toc2") % [ + "sectionid", $ord(kind), "sectionTitle", title, + "sectionTitleID", $(ord(kind) + 50), + "content", content, "plainName", plainName] + else: + for item in d.tocSimple[kind].sorted(cmp): + d.toc2[kind].add item.content - d.toc[kind] = ropeFormatNamedVars(d.conf, getConfigVar(d.conf, "doc.section.toc"), [ - "sectionid", "sectionTitle", "sectionTitleID", "content"], [ - ord(kind).rope, title, rope(ord(kind) + 50), tocSource[kind]]) + let sectionValues = @[ + "sectionID", $ord(kind), "sectionTitleID", $(ord(kind) + 50), + "sectionTitle", title + ] -proc relLink(outDir: AbsoluteDir, destFile: AbsoluteFile, linkto: RelativeFile): Rope = - rope($relativeTo(outDir / linkto, destFile.splitFile().dir, '/')) + # Check if the toc has any children + if d.toc2[kind] != "": + # Use the dropdown version instead and store the children in the dropdown + d.toc[kind] = getConfigVar(d.conf, "doc.section.toc") % (sectionValues & @[ + "content", d.toc2[kind] + ]) + else: + # Just have the link + d.toc[kind] = getConfigVar(d.conf, "doc.section.toc_item") % sectionValues -proc genOutFile(d: PDoc, groupedToc = false): Rope = +proc relLink(outDir: AbsoluteDir, destFile: AbsoluteFile, linkto: RelativeFile): string = + $relativeTo(outDir / linkto, destFile.splitFile().dir, '/') + +proc genOutFile(d: PDoc, groupedToc = false): string = var - code, content: Rope + code, content: string = "" title = "" var j = 0 - var tmp = "" - renderTocEntries(d[], j, 1, tmp) - var toc = tmp.rope + var toc = "" + renderTocEntries(d[], j, 1, toc) for i in TSymKind: var shouldSort = i in routineKinds and groupedToc genSection(d, i, shouldSort) toc.add(d.toc[i]) - if toc != nil: - toc = ropeFormatNamedVars(d.conf, getConfigVar(d.conf, "doc.toc"), ["content"], [toc]) - for i in TSymKind: code.add(d.section[i]) + if toc != "" or d.target == outLatex: + # for Latex $doc.toc will automatically generate TOC if `d.hasToc` is set + toc = getConfigVar(d.conf, "doc.toc") % ["content", toc] + for i in TSymKind: code.add(d.section[i].finalMarkup) # Extract the title. Non API modules generate an entry in the index table. if d.meta[metaTitle].len != 0: title = d.meta[metaTitle] - let external = presentationPath(d.conf, AbsoluteFile d.filename).changeFileExt(HtmlExt).string.nativeToUnixPath - setIndexTerm(d[], external, "", title) else: - # Modules get an automatic title for the HTML, but no entry in the index. title = canonicalImport(d.conf, AbsoluteFile d.filename) - var subtitle = "".rope + title = esc(d.target, title) + var subtitle = "" if d.meta[metaSubtitle] != "": dispA(d.conf, subtitle, "<h2 class=\"subtitle\">$1</h2>", - "\\\\\\vspace{0.5em}\\large $1", [d.meta[metaSubtitle].rope]) + "\\\\\\vspace{0.5em}\\large $1", [esc(d.target, d.meta[metaSubtitle])]) var groupsection = getConfigVar(d.conf, "doc.body_toc_groupsection") - let bodyname = if d.hasToc and not d.isPureRst: + let bodyname = if d.hasToc and not d.standaloneDoc and not d.conf.isLatexCmd: groupsection.setLen 0 "doc.body_toc_group" elif d.hasToc: "doc.body_toc" else: "doc.body_no_toc" - let seeSrcRope = genSeeSrcRope(d, d.filename, 1) - content = ropeFormatNamedVars(d.conf, getConfigVar(d.conf, bodyname), ["title", "subtitle", - "tableofcontents", "moduledesc", "date", "time", "content", "deprecationMsg", "theindexhref", "body_toc_groupsection", "seeSrc"], - [title.rope, subtitle, toc, d.modDesc, rope(getDateStr()), - rope(getClockStr()), code, d.modDeprecationMsg, relLink(d.conf.outDir, d.destFile.AbsoluteFile, theindexFname.RelativeFile), groupsection.rope, seeSrcRope]) + let seeSrc = genSeeSrc(d, d.filename, 1) + content = getConfigVar(d.conf, bodyname) % [ + "title", title, "subtitle", subtitle, + "tableofcontents", toc, "moduledesc", d.modDescFinal, "date", getDateStr(), + "time", getClockStr(), "content", code, + "deprecationMsg", d.modDeprecationMsg, + "theindexhref", relLink(d.conf.outDir, d.destFile.AbsoluteFile, + theindexFname.RelativeFile), + "body_toc_groupsection", groupsection, "seeSrc", seeSrc] if optCompileOnly notin d.conf.globalOptions: # XXX what is this hack doing here? 'optCompileOnly' means raw output!? - code = ropeFormatNamedVars(d.conf, getConfigVar(d.conf, "doc.file"), [ - "nimdoccss", "dochackjs", "title", "subtitle", "tableofcontents", "moduledesc", "date", "time", - "content", "author", "version", "analytics", "deprecationMsg"], - [relLink(d.conf.outDir, d.destFile.AbsoluteFile, nimdocOutCss.RelativeFile), - relLink(d.conf.outDir, d.destFile.AbsoluteFile, docHackJsFname.RelativeFile), - title.rope, subtitle, toc, d.modDesc, rope(getDateStr()), rope(getClockStr()), - content, d.meta[metaAuthor].rope, d.meta[metaVersion].rope, d.analytics.rope, d.modDeprecationMsg]) + code = getConfigVar(d.conf, "doc.file") % [ + "nimdoccss", relLink(d.conf.outDir, d.destFile.AbsoluteFile, + nimdocOutCss.RelativeFile), + "dochackjs", relLink(d.conf.outDir, d.destFile.AbsoluteFile, + docHackJsFname.RelativeFile), + "title", title, "subtitle", subtitle, "tableofcontents", toc, + "moduledesc", d.modDescFinal, "date", getDateStr(), "time", getClockStr(), + "content", content, "author", d.meta[metaAuthor], + "version", esc(d.target, d.meta[metaVersion]), "analytics", d.analytics, + "deprecationMsg", d.modDeprecationMsg, "nimVersion", $NimMajor & "." & $NimMinor & "." & $NimPatch] else: code = content result = code +proc indexFile(d: PDoc): AbsoluteFile = + let dir = d.conf.outDir + result = dir / changeFileExt(presentationPath(d.conf, + AbsoluteFile d.filename), + IndexExt) + let (finalDir, _, _) = result.string.splitFile + createDir(finalDir) + proc generateIndex*(d: PDoc) = if optGenIndex in d.conf.globalOptions: - let dir = d.conf.outDir - createDir(dir) - let dest = dir / changeFileExt(presentationPath(d.conf, AbsoluteFile d.filename), IndexExt) + let dest = indexFile(d) writeIndexFile(d[], dest.string) proc updateOutfile(d: PDoc, outfile: AbsoluteFile) = @@ -1316,22 +1773,31 @@ proc updateOutfile(d: PDoc, outfile: AbsoluteFile) = d.conf.outFile = splitPath(d.conf.outFile.string)[1].RelativeFile proc writeOutput*(d: PDoc, useWarning = false, groupedToc = false) = + if optGenIndexOnly in d.conf.globalOptions: + d.conf.outFile = indexFile(d).relativeTo(d.conf.outDir) # just for display + return runAllExamples(d) var content = genOutFile(d, groupedToc) if optStdout in d.conf.globalOptions: - writeRope(stdout, content) + write(stdout, content) else: template outfile: untyped = d.destFile.AbsoluteFile #let outfile = getOutFile2(d.conf, shortenDir(d.conf, filename), outExt) let dir = outfile.splitFile.dir createDir(dir) updateOutfile(d, outfile) - if not writeRope(content, outfile): + try: + writeFile(outfile, content) + except IOError: rawMessage(d.conf, if useWarning: warnCannotOpenFile else: errCannotOpenFile, outfile.string) - elif not d.wroteSupportFiles: # nimdoc.css + dochack.js + if not d.wroteSupportFiles: # nimdoc.css + dochack.js let nimr = $d.conf.getPrefixDir() - copyFile(docCss.interp(nimr = nimr), $d.conf.outDir / nimdocOutCss) + case d.target + of outHtml: + copyFile(docCss.interp(nimr = nimr), $d.conf.outDir / nimdocOutCss) + of outLatex: + copyFile(docCls.interp(nimr = nimr), $d.conf.outDir / nimdocOutCls) if optGenIndex in d.conf.globalOptions: let docHackJs2 = getDocHacksJs(nimr, nim = getAppFilename()) copyFile(docHackJs2, $d.conf.outDir / docHackJs2.lastPathPart) @@ -1339,17 +1805,19 @@ proc writeOutput*(d: PDoc, useWarning = false, groupedToc = false) = proc writeOutputJson*(d: PDoc, useWarning = false) = runAllExamples(d) - var modDesc: string - for desc in d.modDesc: + var modDesc: string = "" + for desc in d.modDescFinal: modDesc &= desc let content = %*{"orig": d.filename, "nimble": getPackageName(d.conf, d.filename), "moduleDescription": modDesc, - "entries": d.jArray} + "entries": d.jEntriesFinal} if optStdout in d.conf.globalOptions: - write(stdout, $content) + writeLine(stdout, $content) else: - var f: File + let dir = d.destFile.splitFile.dir + createDir(dir) + var f: File = default(File) if open(f, d.destFile, fmWrite): write(f, $content) close(f) @@ -1367,94 +1835,120 @@ proc handleDocOutputOptions*(conf: ConfigRef) = conf.outDir = AbsoluteDir(conf.outDir / conf.outFile) proc commandDoc*(cache: IdentCache, conf: ConfigRef) = + ## implementation of deprecated ``doc0`` command (without semantic checking) handleDocOutputOptions conf var ast = parseFile(conf.projectMainIdx, cache, conf) if ast == nil: return - var d = newDocumentor(conf.projectFull, cache, conf) - d.hasToc = true - generateDoc(d, ast, ast) + var d = newDocumentor(conf.projectFull, cache, conf, hasToc = true) + generateDoc(d, ast, ast, conf) + finishGenerateDoc(d) writeOutput(d) generateIndex(d) proc commandRstAux(cache: IdentCache, conf: ConfigRef; - filename: AbsoluteFile, outExt: string) = + filename: AbsoluteFile, outExt: string, + preferMarkdown: bool) = var filen = addFileExt(filename, "txt") - var d = newDocumentor(filen, cache, conf, outExt) - - d.isPureRst = true - var rst = parseRst(readFile(filen.string), filen.string, - line=LineRstInit, column=ColRstInit, - d.hasToc, {roSupportRawDirective, roSupportMarkdown}, conf) - var modDesc = newStringOfCap(30_000) - renderRstToOut(d[], rst, modDesc) - d.modDesc = rope(modDesc) - writeOutput(d) - generateIndex(d) - -proc commandRst2Html*(cache: IdentCache, conf: ConfigRef) = - commandRstAux(cache, conf, conf.projectFull, HtmlExt) - -proc commandRst2TeX*(cache: IdentCache, conf: ConfigRef) = - commandRstAux(cache, conf, conf.projectFull, TexExt) + var d = newDocumentor(filen, cache, conf, outExt, standaloneDoc = true, + preferMarkdown = preferMarkdown, hasToc = false) + try: + let rst = parseRst(readFile(filen.string), + line=LineRstInit, column=ColRstInit, + conf, d.sharedState) + d.modDescPre = @[ItemFragment(isRst: true, rst: rst)] + finishGenerateDoc(d) + writeOutput(d) + generateIndex(d) + except ERecoverableError: + discard "already reported the error" + +proc commandRst2Html*(cache: IdentCache, conf: ConfigRef, + preferMarkdown=false) = + commandRstAux(cache, conf, conf.projectFull, HtmlExt, preferMarkdown) + +proc commandRst2TeX*(cache: IdentCache, conf: ConfigRef, + preferMarkdown=false) = + commandRstAux(cache, conf, conf.projectFull, TexExt, preferMarkdown) proc commandJson*(cache: IdentCache, conf: ConfigRef) = + ## implementation of a deprecated jsondoc0 command var ast = parseFile(conf.projectMainIdx, cache, conf) if ast == nil: return - var d = newDocumentor(conf.projectFull, cache, conf) + var d = newDocumentor(conf.projectFull, cache, conf, hasToc = true) d.onTestSnippet = proc (d: var RstGenerator; filename, cmd: string; - status: int; content: string) = + status: int; content: string) {.gcsafe.} = localError(conf, newLineInfo(conf, AbsoluteFile d.filename, -1, -1), warnUser, "the ':test:' attribute is not supported by this backend") - d.hasToc = true - generateJson(d, ast) - let json = d.jArray - let content = rope(pretty(json)) + generateJson(d, ast, conf) + finishGenerateDoc(d) + let json = d.jEntriesFinal + let content = pretty(json) if optStdout in d.conf.globalOptions: - writeRope(stdout, content) + write(stdout, content) else: #echo getOutFile(gProjectFull, JsonExt) let filename = getOutFile(conf, RelativeFile conf.projectName, JsonExt) - if not writeRope(content, filename): + try: + writeFile(filename, content) + except IOError: rawMessage(conf, errCannotOpenFile, filename.string) proc commandTags*(cache: IdentCache, conf: ConfigRef) = var ast = parseFile(conf.projectMainIdx, cache, conf) if ast == nil: return - var d = newDocumentor(conf.projectFull, cache, conf) + var d = newDocumentor(conf.projectFull, cache, conf, hasToc = true) d.onTestSnippet = proc (d: var RstGenerator; filename, cmd: string; - status: int; content: string) = + status: int; content: string) {.gcsafe.} = localError(conf, newLineInfo(conf, AbsoluteFile d.filename, -1, -1), warnUser, "the ':test:' attribute is not supported by this backend") - d.hasToc = true var - content: Rope + content = "" generateTags(d, ast, content) if optStdout in d.conf.globalOptions: - writeRope(stdout, content) + write(stdout, content) else: #echo getOutFile(gProjectFull, TagsExt) let filename = getOutFile(conf, RelativeFile conf.projectName, TagsExt) - if not writeRope(content, filename): + try: + writeFile(filename, content) + except IOError: rawMessage(conf, errCannotOpenFile, filename.string) proc commandBuildIndex*(conf: ConfigRef, dir: string, outFile = RelativeFile"") = - var content = mergeIndexes(dir).rope + if optGenIndexOnly in conf.globalOptions: + return + var content = mergeIndexes(dir) var outFile = outFile if outFile.isEmpty: outFile = theindexFname.RelativeFile.changeFileExt("") let filename = getOutFile(conf, outFile, HtmlExt) - let code = ropeFormatNamedVars(conf, getConfigVar(conf, "doc.file"), [ - "nimdoccss", "dochackjs", - "title", "subtitle", "tableofcontents", "moduledesc", "date", "time", - "content", "author", "version", "analytics"], - [relLink(conf.outDir, filename, nimdocOutCss.RelativeFile), - relLink(conf.outDir, filename, docHackJsFname.RelativeFile), - rope"Index", rope"", nil, nil, rope(getDateStr()), - rope(getClockStr()), content, nil, nil, nil]) + let code = getConfigVar(conf, "doc.file") % [ + "nimdoccss", relLink(conf.outDir, filename, nimdocOutCss.RelativeFile), + "dochackjs", relLink(conf.outDir, filename, docHackJsFname.RelativeFile), + "title", "Index", + "subtitle", "", "tableofcontents", "", "moduledesc", "", + "date", getDateStr(), "time", getClockStr(), + "content", content, "author", "", "version", "", "analytics", "", "nimVersion", $NimMajor & "." & $NimMinor & "." & $NimPatch] # no analytics because context is not available - if not writeRope(code, filename): + try: + writeFile(filename, code) + except IOError: + rawMessage(conf, errCannotOpenFile, filename.string) + +proc commandBuildIndexJson*(conf: ConfigRef, dir: string, outFile = RelativeFile"") = + var (modules, symbols, docs) = readIndexDir(dir) + let documents = toSeq(keys(Table[IndexEntry, seq[IndexEntry]](docs))) + let body = %*({"documents": documents, "modules": modules, "symbols": symbols}) + + var outFile = outFile + if outFile.isEmpty: outFile = theindexFname.RelativeFile.changeFileExt("") + let filename = getOutFile(conf, outFile, JsonExt) + + try: + writeFile(filename, $body) + except IOError: rawMessage(conf, errCannotOpenFile, filename.string) diff --git a/compiler/docgen2.nim b/compiler/docgen2.nim index cfbb33156..7fb11a3bd 100644 --- a/compiler/docgen2.nim +++ b/compiler/docgen2.nim @@ -11,7 +11,7 @@ # semantic checking. import - options, ast, msgs, passes, docgen, lineinfos, pathutils + options, ast, msgs, docgen, lineinfos, pathutils, packages from modulegraphs import ModuleGraph, PPassContext @@ -23,7 +23,7 @@ type PGen = ref TGen proc shouldProcess(g: PGen): bool = - (optWholeProject in g.doc.conf.globalOptions and g.module.getnimblePkgId == g.doc.conf.mainPackageId) or + (optWholeProject in g.doc.conf.globalOptions and g.doc.conf.belongsToProjectPackage(g.module)) or sfMainModule in g.module.flags or g.config.projectMainIdx == g.module.info.fileIndex template closeImpl(body: untyped) {.dirty.} = @@ -31,31 +31,34 @@ template closeImpl(body: untyped) {.dirty.} = let useWarning = sfMainModule notin g.module.flags let groupedToc = true if shouldProcess(g): + finishGenerateDoc(g.doc) body try: generateIndex(g.doc) except IOError: discard -proc close(graph: ModuleGraph; p: PPassContext, n: PNode): PNode = +proc closeDoc*(graph: ModuleGraph; p: PPassContext, n: PNode): PNode = + result = nil closeImpl: writeOutput(g.doc, useWarning, groupedToc) -proc closeJson(graph: ModuleGraph; p: PPassContext, n: PNode): PNode = +proc closeJson*(graph: ModuleGraph; p: PPassContext, n: PNode): PNode = + result = nil closeImpl: writeOutputJson(g.doc, useWarning) -proc processNode(c: PPassContext, n: PNode): PNode = +proc processNode*(c: PPassContext, n: PNode): PNode = result = n var g = PGen(c) if shouldProcess(g): - generateDoc(g.doc, n, n) + generateDoc(g.doc, n, n, g.config) -proc processNodeJson(c: PPassContext, n: PNode): PNode = +proc processNodeJson*(c: PPassContext, n: PNode): PNode = result = n var g = PGen(c) if shouldProcess(g): - generateJson(g.doc, n, false) + generateJson(g.doc, n, g.config, false) template myOpenImpl(ext: untyped) {.dirty.} = var g: PGen @@ -63,20 +66,15 @@ template myOpenImpl(ext: untyped) {.dirty.} = g.module = module g.config = graph.config var d = newDocumentor(AbsoluteFile toFullPath(graph.config, FileIndex module.position), - graph.cache, graph.config, ext, module) - d.hasToc = true + graph.cache, graph.config, ext, module, hasToc = true) g.doc = d result = g -proc myOpen(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = +proc openHtml*(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = myOpenImpl(HtmlExt) -proc myOpenJson(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = - myOpenImpl(JsonExt) - -const docgen2Pass* = makePass(open = myOpen, process = processNode, close = close) -const docgen2JsonPass* = makePass(open = myOpenJson, process = processNodeJson, - close = closeJson) +proc openTex*(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = + myOpenImpl(TexExt) -proc finishDoc2Pass*(project: string) = - discard +proc openJson*(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = + myOpenImpl(JsonExt) diff --git a/compiler/enumtostr.nim b/compiler/enumtostr.nim index 9bfa7001a..dc516d2e5 100644 --- a/compiler/enumtostr.nim +++ b/compiler/enumtostr.nim @@ -1,16 +1,20 @@ import ast, idents, lineinfos, modulegraphs, magicsys +when defined(nimPreviewSlimSystem): + import std/assertions + + proc genEnumToStrProc*(t: PType; info: TLineInfo; g: ModuleGraph; idgen: IdGenerator): PSym = - result = newSym(skProc, getIdent(g.cache, "$"), nextSymId idgen, t.owner, info) + result = newSym(skProc, getIdent(g.cache, "$"), idgen, t.owner, info) - let dest = newSym(skParam, getIdent(g.cache, "e"), nextSymId idgen, result, info) + let dest = newSym(skParam, getIdent(g.cache, "e"), idgen, result, info) dest.typ = t - let res = newSym(skResult, getIdent(g.cache, "result"), nextSymId idgen, result, info) + let res = newSym(skResult, getIdent(g.cache, "result"), idgen, result, info) res.typ = getSysType(g, info, tyString) - result.typ = newType(tyProc, nextTypeId idgen, t.owner) + result.typ = newType(tyProc, idgen, t.owner) result.typ.n = newNodeI(nkFormalParams, info) rawAddSon(result.typ, res.typ) result.typ.n.add newNodeI(nkEffectList, info) @@ -26,7 +30,7 @@ proc genEnumToStrProc*(t: PType; info: TLineInfo; g: ModuleGraph; idgen: IdGener assert(t.n[i].kind == nkSym) var field = t.n[i].sym let val = if field.ast == nil: field.name.s else: field.ast.strVal - caseStmt.add newTree(nkOfBranch, newSymNode(field), + caseStmt.add newTree(nkOfBranch, newIntTypeNode(field.position, t), newTree(nkStmtList, newTree(nkFastAsgn, newSymNode(res), newStrNode(val, info)))) #newIntTypeNode(nkIntLit, field.position, t) @@ -52,26 +56,27 @@ proc searchObjCaseImpl(obj: PNode; field: PSym): PNode = if obj.kind == nkRecCase and obj[0].kind == nkSym and obj[0].sym == field: result = obj else: + result = nil for x in obj: result = searchObjCaseImpl(x, field) if result != nil: break proc searchObjCase(t: PType; field: PSym): PNode = result = searchObjCaseImpl(t.n, field) - if result == nil and t.len > 0: - result = searchObjCase(t[0].skipTypes({tyAlias, tyGenericInst, tyRef, tyPtr}), field) + if result == nil and t.baseClass != nil: + result = searchObjCase(t.baseClass.skipTypes({tyAlias, tyGenericInst, tyRef, tyPtr}), field) doAssert result != nil proc genCaseObjDiscMapping*(t: PType; field: PSym; info: TLineInfo; g: ModuleGraph; idgen: IdGenerator): PSym = - result = newSym(skProc, getIdent(g.cache, "objDiscMapping"), nextSymId idgen, t.owner, info) + result = newSym(skProc, getIdent(g.cache, "objDiscMapping"), idgen, t.owner, info) - let dest = newSym(skParam, getIdent(g.cache, "e"), nextSymId idgen, result, info) + let dest = newSym(skParam, getIdent(g.cache, "e"), idgen, result, info) dest.typ = field.typ - let res = newSym(skResult, getIdent(g.cache, "result"), nextSymId idgen, result, info) + let res = newSym(skResult, getIdent(g.cache, "result"), idgen, result, info) res.typ = getSysType(g, info, tyUInt8) - result.typ = newType(tyProc, nextTypeId idgen, t.owner) + result.typ = newType(tyProc, idgen, t.owner) result.typ.n = newNodeI(nkFormalParams, info) rawAddSon(result.typ, res.typ) result.typ.n.add newNodeI(nkEffectList, info) diff --git a/compiler/errorhandling.nim b/compiler/errorhandling.nim new file mode 100644 index 000000000..2cde9e3fb --- /dev/null +++ b/compiler/errorhandling.nim @@ -0,0 +1,85 @@ +# +# +# The Nim Compiler +# (c) Copyright 2021 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## This module contains support code for new-styled error +## handling via an `nkError` node kind. + +import ast, renderer, options, types +import std/strutils + +when defined(nimPreviewSlimSystem): + import std/assertions + +type + ErrorKind* = enum ## expand as you need. + RawTypeMismatchError + ExpressionCannotBeCalled + CustomError + WrongNumberOfArguments + AmbiguousCall + +proc errorSubNode*(n: PNode): PNode = + case n.kind + of nkEmpty..nkNilLit: + result = nil + of nkError: + result = n + else: + result = nil + for i in 0..<n.len: + result = errorSubNode(n[i]) + if result != nil: break + +proc newError*(wrongNode: PNode; k: ErrorKind; args: varargs[PNode]): PNode = + assert wrongNode.kind != nkError + let innerError = errorSubNode(wrongNode) + if innerError != nil: + return innerError + var idgen = idGeneratorForPackage(-1'i32) + result = newNodeIT(nkError, wrongNode.info, newType(tyError, idgen, nil)) + result.add wrongNode + result.add newIntNode(nkIntLit, ord(k)) + for a in args: result.add a + +proc newError*(wrongNode: PNode; msg: string): PNode = + assert wrongNode.kind != nkError + let innerError = errorSubNode(wrongNode) + if innerError != nil: + return innerError + var idgen = idGeneratorForPackage(-1'i32) + result = newNodeIT(nkError, wrongNode.info, newType(tyError, idgen, nil)) + result.add wrongNode + result.add newIntNode(nkIntLit, ord(CustomError)) + result.add newStrNode(msg, wrongNode.info) + +proc errorToString*(config: ConfigRef; n: PNode): string = + assert n.kind == nkError + assert n.len > 1 + let wrongNode = n[0] + case ErrorKind(n[1].intVal) + of RawTypeMismatchError: + result = "type mismatch" + of ExpressionCannotBeCalled: + result = "expression '$1' cannot be called" % wrongNode[0].renderTree + of CustomError: + result = n[2].strVal + of WrongNumberOfArguments: + result = "wrong number of arguments" + of AmbiguousCall: + let a = n[2].sym + let b = n[3].sym + var args = "(" + for i in 1..<wrongNode.len: + if i > 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] diff --git a/compiler/evalffi.nim b/compiler/evalffi.nim index 0d471cf98..9871c81af 100644 --- a/compiler/evalffi.nim +++ b/compiler/evalffi.nim @@ -9,9 +9,11 @@ ## This file implements the FFI part of the evaluator for Nim code. -import ast, types, options, tables, dynlib, msgs, lineinfos -from os import getAppFilename -import pkg/libffi +import ast, types, options, msgs, lineinfos +from std/os import getAppFilename +import libffi/libffi + +import std/[tables, dynlib] when defined(windows): const libcDll = "msvcrt.dll" @@ -37,9 +39,10 @@ else: var gExeHandle = loadLib() proc getDll(conf: ConfigRef, cache: var TDllCache; dll: string; info: TLineInfo): pointer = + result = nil if dll in cache: return cache[dll] - var libs: seq[string] + var libs: seq[string] = @[] libCandidates(dll, libs) for c in libs: result = loadLib(c) @@ -61,23 +64,23 @@ proc importcSymbol*(conf: ConfigRef, sym: PSym): PNode = let lib = sym.annex if lib != nil and lib.path.kind notin {nkStrLit..nkTripleStrLit}: globalError(conf, sym.info, "dynlib needs to be a string lit") - var theAddr: pointer + var theAddr: pointer = nil if (lib.isNil or lib.kind == libHeader) and not gExeHandle.isNil: libPathMsg = "current exe: " & getAppFilename() & " nor libc: " & libcDll # first try this exe itself: - theAddr = gExeHandle.symAddr(name) + theAddr = gExeHandle.symAddr(name.cstring) # then try libc: if theAddr.isNil: let dllhandle = getDll(conf, gDllCache, libcDll, sym.info) - theAddr = dllhandle.symAddr(name) + theAddr = dllhandle.symAddr(name.cstring) elif not lib.isNil: let dll = if lib.kind == libHeader: libcDll else: lib.path.strVal libPathMsg = dll let dllhandle = getDll(conf, gDllCache, dll, sym.info) - theAddr = dllhandle.symAddr(name) + theAddr = dllhandle.symAddr(name.cstring) if theAddr.isNil: globalError(conf, sym.info, "cannot import symbol: " & name & " from " & libPathMsg) - result.intVal = cast[ByteAddress](theAddr) + result.intVal = cast[int](theAddr) proc mapType(conf: ConfigRef, t: ast.PType): ptr libffi.Type = if t == nil: return addr libffi.type_void @@ -92,11 +95,11 @@ proc mapType(conf: ConfigRef, t: ast.PType): ptr libffi.Type = else: result = nil of tyFloat, tyFloat64: result = addr libffi.type_double of tyFloat32: result = addr libffi.type_float - of tyVar, tyLent, tyPointer, tyPtr, tyRef, tyCString, tySequence, tyString, tyUntyped, + of tyVar, tyLent, tyPointer, tyPtr, tyRef, tyCstring, tySequence, tyString, tyUntyped, tyTyped, tyTypeDesc, tyProc, tyArray, tyStatic, tyNil: result = addr libffi.type_pointer of tyDistinct, tyAlias, tySink: - result = mapType(conf, t[0]) + result = mapType(conf, t.skipModifier) else: result = nil # too risky: @@ -108,12 +111,13 @@ proc mapCallConv(conf: ConfigRef, cc: TCallingConvention, info: TLineInfo): TABI of ccStdCall: result = when defined(windows) and defined(x86): STDCALL else: DEFAULT_ABI of ccCDecl: result = DEFAULT_ABI else: + result = default(TABI) globalError(conf, info, "cannot map calling convention to FFI") -template rd(T, p: untyped): untyped = (cast[ptr T](p))[] -template wr(T, p, v: untyped): untyped = (cast[ptr T](p))[] = v +template rd(typ, p: untyped): untyped = (cast[ptr typ](p))[] +template wr(typ, p, v: untyped): untyped = (cast[ptr typ](p))[] = v template `+!`(x, y: untyped): untyped = - cast[pointer](cast[ByteAddress](x) + y) + cast[pointer](cast[int](x) + y) proc packSize(conf: ConfigRef, v: PNode, typ: PType): int = ## computes the size of the blob @@ -122,16 +126,18 @@ proc packSize(conf: ConfigRef, v: PNode, typ: PType): int = if v.kind in {nkNilLit, nkPtrLit}: result = sizeof(pointer) else: - result = sizeof(pointer) + packSize(conf, v[0], typ.lastSon) + result = sizeof(pointer) + packSize(conf, v[0], typ.elementType) of tyDistinct, tyGenericInst, tyAlias, tySink: - result = packSize(conf, v, typ[0]) + result = packSize(conf, v, typ.skipModifier) of tyArray: # consider: ptr array[0..1000_000, int] which is common for interfacing; # we use the real length here instead if v.kind in {nkNilLit, nkPtrLit}: result = sizeof(pointer) elif v.len != 0: - result = v.len * packSize(conf, v[0], typ[1]) + result = v.len * packSize(conf, v[0], typ.elementType) + else: + result = 0 else: result = getSize(conf, typ).int @@ -140,6 +146,7 @@ proc pack(conf: ConfigRef, v: PNode, typ: PType, res: pointer) proc getField(conf: ConfigRef, n: PNode; position: int): PSym = case n.kind of nkRecList: + result = nil for i in 0..<n.len: result = getField(conf, n[i], position) if result != nil: return @@ -154,7 +161,8 @@ proc getField(conf: ConfigRef, n: PNode; position: int): PSym = else: internalError(conf, n.info, "getField(record case branch)") of nkSym: if n.sym.position == position: result = n.sym - else: discard + else: result = nil + else: result = nil proc packObject(conf: ConfigRef, x: PNode, typ: PType, res: pointer) = internalAssert conf, x.kind in {nkObjConstr, nkPar, nkTupleConstr} @@ -177,8 +185,8 @@ const maxPackDepth = 20 var packRecCheck = 0 proc pack(conf: ConfigRef, v: PNode, typ: PType, res: pointer) = - template awr(T, v: untyped): untyped = - wr(T, res, v) + template awr(typ, v: untyped): untyped = + wr(typ, res, v) case typ.kind of tyBool: awr(bool, v.intVal != 0) @@ -205,7 +213,7 @@ proc pack(conf: ConfigRef, v: PNode, typ: PType, res: pointer) = of tyFloat32: awr(float32, v.floatVal) of tyFloat64: awr(float64, v.floatVal) - of tyPointer, tyProc, tyCString, tyString: + of tyPointer, tyProc, tyCstring, tyString: if v.kind == nkNilLit: # nothing to do since the memory is 0 initialized anyway discard @@ -226,19 +234,19 @@ proc pack(conf: ConfigRef, v: PNode, typ: PType, res: pointer) = packRecCheck = 0 globalError(conf, v.info, "cannot map value to FFI " & typeToString(v.typ)) inc packRecCheck - pack(conf, v[0], typ.lastSon, res +! sizeof(pointer)) + pack(conf, v[0], typ.elementType, res +! sizeof(pointer)) dec packRecCheck awr(pointer, res +! sizeof(pointer)) of tyArray: - let baseSize = getSize(conf, typ[1]) + let baseSize = getSize(conf, typ.elementType) for i in 0..<v.len: - pack(conf, v[i], typ[1], res +! i * baseSize) + pack(conf, v[i], typ.elementType, res +! i * baseSize) of tyObject, tyTuple: packObject(conf, v, typ, res) of tyNil: discard of tyDistinct, tyGenericInst, tyAlias, tySink: - pack(conf, v, typ[0], res) + pack(conf, v, typ.skipModifier, res) else: globalError(conf, v.info, "cannot map value to FFI " & typeToString(v.typ)) @@ -296,9 +304,9 @@ proc unpackArray(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = result = n if result.kind != nkBracket: globalError(conf, n.info, "cannot map value from FFI") - let baseSize = getSize(conf, typ[1]) + let baseSize = getSize(conf, typ.elementType) for i in 0..<result.len: - result[i] = unpack(conf, x +! i * baseSize, typ[1], result[i]) + result[i] = unpack(conf, x +! i * baseSize, typ.elementType, result[i]) proc canonNodeKind(k: TNodeKind): TNodeKind = case k @@ -356,6 +364,7 @@ proc unpack(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = of 4: awi(nkIntLit, rd(int32, x).BiggestInt) of 8: awi(nkIntLit, rd(int64, x).BiggestInt) else: + result = nil globalError(conf, n.info, "cannot map value from FFI (tyEnum, tySet)") of tyFloat: awf(nkFloatLit, rd(float, x)) of tyFloat32: awf(nkFloat32Lit, rd(float32, x)) @@ -369,24 +378,25 @@ proc unpack(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = # in their unboxed representation so nothing it to be unpacked: result = n else: - awi(nkPtrLit, cast[ByteAddress](p)) + awi(nkPtrLit, cast[int](p)) of tyPtr, tyRef, tyVar, tyLent: let p = rd(pointer, x) if p.isNil: setNil() elif n == nil or n.kind == nkPtrLit: - awi(nkPtrLit, cast[ByteAddress](p)) + awi(nkPtrLit, cast[int](p)) elif n != nil and n.len == 1: internalAssert(conf, n.kind == nkRefTy) - n[0] = unpack(conf, p, typ.lastSon, n[0]) + n[0] = unpack(conf, p, typ.elementType, n[0]) result = n else: + result = nil globalError(conf, n.info, "cannot map value from FFI " & typeToString(typ)) of tyObject, tyTuple: result = unpackObject(conf, x, typ, n) of tyArray: result = unpackArray(conf, x, typ, n) - of tyCString, tyString: + of tyCstring, tyString: let p = rd(cstring, x) if p.isNil: setNil() @@ -395,14 +405,15 @@ proc unpack(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = of tyNil: setNil() of tyDistinct, tyGenericInst, tyAlias, tySink: - result = unpack(conf, x, typ.lastSon, n) + result = unpack(conf, x, typ.skipModifier, n) else: # XXX what to do with 'array' here? + result = nil globalError(conf, n.info, "cannot map value from FFI " & typeToString(typ)) proc fficast*(conf: ConfigRef, x: PNode, destTyp: PType): PNode = if x.kind == nkPtrLit and x.typ.kind in {tyPtr, tyRef, tyVar, tyLent, tyPointer, - tyProc, tyCString, tyString, + tyProc, tyCstring, tyString, tySequence}: result = newNodeIT(x.kind, x.info, destTyp) result.intVal = x.intVal @@ -423,8 +434,8 @@ proc fficast*(conf: ConfigRef, x: PNode, destTyp: PType): PNode = proc callForeignFunction*(conf: ConfigRef, call: PNode): PNode = internalAssert conf, call[0].kind == nkPtrLit - var cif: TCif - var sig: ParamList + var cif: TCif = default(TCif) + var sig: ParamList = default(ParamList) # use the arguments' types for varargs support: for i in 1..<call.len: sig[i-1] = mapType(conf, call[i].typ) @@ -433,24 +444,24 @@ proc callForeignFunction*(conf: ConfigRef, call: PNode): PNode = let typ = call[0].typ if prep_cif(cif, mapCallConv(conf, typ.callConv, call.info), cuint(call.len-1), - mapType(conf, typ[0]), sig) != OK: + mapType(conf, typ.returnType), sig) != OK: globalError(conf, call.info, "error in FFI call") - var args: ArgList + var args: ArgList = default(ArgList) let fn = cast[pointer](call[0].intVal) for i in 1..<call.len: var t = call[i].typ args[i-1] = alloc0(packSize(conf, call[i], t)) pack(conf, call[i], t, args[i-1]) - let retVal = if isEmptyType(typ[0]): pointer(nil) - else: alloc(getSize(conf, typ[0]).int) + let retVal = if isEmptyType(typ.returnType): pointer(nil) + else: alloc(getSize(conf, typ.returnType).int) libffi.call(cif, fn, retVal, args) if retVal.isNil: result = newNode(nkEmpty) else: - result = unpack(conf, retVal, typ[0], nil) + result = unpack(conf, retVal, typ.returnType, nil) result.info = call.info if retVal != nil: dealloc retVal @@ -463,8 +474,8 @@ proc callForeignFunction*(conf: ConfigRef, fn: PNode, fntyp: PType, info: TLineInfo): PNode = internalAssert conf, fn.kind == nkPtrLit - var cif: TCif - var sig: ParamList + var cif: TCif = default(TCif) + var sig: ParamList = default(ParamList) for i in 0..len-1: var aTyp = args[i+start].typ if aTyp.isNil: @@ -478,7 +489,7 @@ proc callForeignFunction*(conf: ConfigRef, fn: PNode, fntyp: PType, mapType(conf, fntyp[0]), sig) != OK: globalError(conf, info, "error in FFI call") - var cargs: ArgList + var cargs: ArgList = default(ArgList) let fn = cast[pointer](fn.intVal) for i in 0..len-1: let t = args[i+start].typ diff --git a/compiler/evaltempl.nim b/compiler/evaltempl.nim index a85314ac2..77c136d63 100644 --- a/compiler/evaltempl.nim +++ b/compiler/evaltempl.nim @@ -9,16 +9,16 @@ ## Template evaluation engine. Now hygienic. -import - strutils, options, ast, astalgo, msgs, renderer, lineinfos, idents +import options, ast, astalgo, msgs, renderer, lineinfos, idents, trees +import std/strutils type TemplCtx = object owner, genSymOwner: PSym instLines: bool # use the instantiation lines numbers isDeclarative: bool - mapping: TIdTable # every gensym'ed symbol needs to be mapped to some - # new symbol + mapping: SymMapping # every gensym'ed symbol needs to be mapped to some + # new symbol config: ConfigRef ic: IdentCache instID: int @@ -26,13 +26,26 @@ type proc copyNode(ctx: TemplCtx, a, b: PNode): PNode = result = copyNode(a) - if ctx.instLines: result.info = b.info + if ctx.instLines: setInfoRecursive(result, b.info) proc evalTemplateAux(templ, actual: PNode, c: var TemplCtx, result: PNode) = template handleParam(param) = let x = param if x.kind == nkArgList: for y in items(x): result.add(y) + elif nfDefaultRefsParam in x.flags: + # value of default param needs to be evaluated like template body + # if it contains other template params + var res: PNode + if isAtom(x): + res = newNodeI(nkPar, x.info) + evalTemplateAux(x, actual, c, res) + if res.len == 1: res = res[0] + else: + res = copyNode(x) + for i in 0..<x.safeLen: + evalTemplateAux(x[i], actual, c, res) + result.add res else: result.add copyTree(x) @@ -44,18 +57,19 @@ proc evalTemplateAux(templ, actual: PNode, c: var TemplCtx, result: PNode) = handleParam actual[s.position] elif (s.owner != nil) and (s.kind == skGenericParam or s.kind == skType and s.typ != nil and s.typ.kind == tyGenericParam): - handleParam actual[s.owner.typ.len + s.position - 1] + handleParam actual[s.owner.typ.signatureLen + s.position - 1] else: internalAssert c.config, sfGenSym in s.flags or s.kind == skType - var x = PSym(idTableGet(c.mapping, s)) + var x = idTableGet(c.mapping, s) if x == nil: - x = copySym(s, nextSymId(c.idgen)) + x = copySym(s, c.idgen) # sem'check needs to set the owner properly later, see bug #9476 x.owner = nil # c.genSymOwner #if x.kind == skParam and x.owner.kind == skModule: # internalAssert c.config, false idTablePut(c.mapping, s, x) if sfGenSym in s.flags: + # TODO: getIdent(c.ic, "`" & x.name.s & "`gensym" & $c.instID) result.add newIdentNode(getIdent(c.ic, x.name.s & "`gensym" & $c.instID), if c.instLines: actual.info else: templ.info) else: @@ -83,10 +97,14 @@ proc evalTemplateAux(templ, actual: PNode, c: var TemplCtx, result: PNode) = not c.isDeclarative: c.isDeclarative = true isDeclarative = true - var res = copyNode(c, templ, actual) - for i in 0..<templ.len: - evalTemplateAux(templ[i], actual, c, res) - result.add res + if (not c.isDeclarative) and templ.kind in nkCallKinds and isRunnableExamples(templ[0]): + # fixes bug #16993, bug #18054 + discard + else: + var res = copyNode(c, templ, actual) + for i in 0..<templ.len: + evalTemplateAux(templ[i], actual, c, res) + result.add res if isDeclarative: c.isDeclarative = false const @@ -112,7 +130,7 @@ proc evalTemplateArgs(n: PNode, s: PSym; conf: ConfigRef; fromHlo: bool): PNode # now that we have working untyped parameters. genericParams = if fromHlo: 0 else: s.ast[genericParamsPos].len - expectedRegularParams = s.typ.len-1 + expectedRegularParams = s.typ.paramsLen givenRegularParams = totalParams - genericParams if givenRegularParams < 0: givenRegularParams = 0 @@ -178,14 +196,14 @@ proc evalTemplate*(n: PNode, tmpl, genSymOwner: PSym; # replace each param by the corresponding node: var args = evalTemplateArgs(n, tmpl, conf, fromHlo) - var ctx: TemplCtx - ctx.owner = tmpl - ctx.genSymOwner = genSymOwner - ctx.config = conf - ctx.ic = ic - initIdTable(ctx.mapping) - ctx.instID = instID[] - ctx.idgen = idgen + var ctx = TemplCtx(owner: tmpl, + genSymOwner: genSymOwner, + config: conf, + ic: ic, + mapping: initSymMapping(), + instID: instID[], + idgen: idgen + ) let body = tmpl.ast[bodyPos] #echo "instantion of ", renderTree(body, {renderIds}) @@ -200,7 +218,7 @@ proc evalTemplate*(n: PNode, tmpl, genSymOwner: PSym; result = copyNode(body) ctx.instLines = sfCallsite in tmpl.flags if ctx.instLines: - result.info = n.info + setInfoRecursive(result, n.info) for i in 0..<body.safeLen: evalTemplateAux(body[i], args, ctx, result) result.flags.incl nfFromTemplate diff --git a/compiler/expanddefaults.nim b/compiler/expanddefaults.nim new file mode 100644 index 000000000..c520d8849 --- /dev/null +++ b/compiler/expanddefaults.nim @@ -0,0 +1,131 @@ +# +# +# The Nim Compiler +# (c) Copyright 2023 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +import lineinfos, ast, types + +proc caseObjDefaultBranch*(obj: PNode; branch: Int128): int = + result = 0 + for i in 1 ..< obj.len: + for j in 0 .. obj[i].len - 2: + if obj[i][j].kind == nkRange: + let x = getOrdValue(obj[i][j][0]) + let y = getOrdValue(obj[i][j][1]) + if branch >= x and branch <= y: + return i + elif getOrdValue(obj[i][j]) == branch: + return i + if obj[i].len == 1: + # else branch + return i + return 1 + +template newZero(t: PType; info: TLineInfo; k = nkIntLit): PNode = newNodeIT(k, info, t) + +proc expandDefault*(t: PType; info: TLineInfo): PNode + +proc expandField(s: PSym; info: TLineInfo): PNode = + result = newNodeIT(nkExprColonExpr, info, s.typ) + result.add newSymNode(s) + result.add expandDefault(s.typ, info) + +proc expandDefaultN(n: PNode; info: TLineInfo; res: PNode) = + case n.kind + of nkRecList: + for i in 0..<n.len: + expandDefaultN(n[i], info, res) + of nkRecCase: + res.add expandField(n[0].sym, info) + var branch = Zero + let constOrNil = n[0].sym.astdef + if constOrNil != nil: + branch = getOrdValue(constOrNil) + + let selectedBranch = caseObjDefaultBranch(n, branch) + let b = lastSon(n[selectedBranch]) + expandDefaultN b, info, res + of nkSym: + res.add expandField(n.sym, info) + else: + discard + +proc expandDefaultObj(t: PType; info: TLineInfo; res: PNode) = + if t.baseClass != nil: + expandDefaultObj(t.baseClass, info, res) + expandDefaultN(t.n, info, res) + +proc expandDefault(t: PType; info: TLineInfo): PNode = + case t.kind + of tyInt: result = newZero(t, info, nkIntLit) + of tyInt8: result = newZero(t, info, nkInt8Lit) + of tyInt16: result = newZero(t, info, nkInt16Lit) + of tyInt32: result = newZero(t, info, nkInt32Lit) + of tyInt64: result = newZero(t, info, nkInt64Lit) + of tyUInt: result = newZero(t, info, nkUIntLit) + of tyUInt8: result = newZero(t, info, nkUInt8Lit) + of tyUInt16: result = newZero(t, info, nkUInt16Lit) + of tyUInt32: result = newZero(t, info, nkUInt32Lit) + of tyUInt64: result = newZero(t, info, nkUInt64Lit) + of tyFloat: result = newZero(t, info, nkFloatLit) + of tyFloat32: result = newZero(t, info, nkFloat32Lit) + of tyFloat64: result = newZero(t, info, nkFloat64Lit) + of tyFloat128: result = newZero(t, info, nkFloat64Lit) + of tyChar: result = newZero(t, info, nkCharLit) + of tyBool: result = newZero(t, info, nkIntLit) + of tyEnum: + # Could use low(T) here to finally fix old language quirks + result = newZero(t, info, nkIntLit) + of tyRange: + # Could use low(T) here to finally fix old language quirks + result = expandDefault(skipModifier t, info) + of tyVoid: result = newZero(t, info, nkEmpty) + of tySink, tyGenericInst, tyDistinct, tyAlias, tyOwned: + result = expandDefault(t.skipModifier, info) + of tyOrdinal, tyGenericBody, tyGenericParam, tyInferred, tyStatic: + if t.hasElementType: + result = expandDefault(t.skipModifier, info) + else: + result = newZero(t, info, nkEmpty) + of tyFromExpr: + if t.n != nil and t.n.typ != nil: + result = expandDefault(t.n.typ, info) + else: + result = newZero(t, info, nkEmpty) + of tyArray: + result = newZero(t, info, nkBracket) + let n = toInt64(lengthOrd(nil, t)) + for i in 0..<n: + result.add expandDefault(t.elementType, info) + of tyPtr, tyRef, tyProc, tyPointer, tyCstring: + result = newZero(t, info, nkNilLit) + of tyVar, tyLent: + let e = t.elementType + if e.skipTypes(abstractInst).kind in {tyOpenArray, tyVarargs}: + # skip the modifier, `var openArray` is a (ptr, len) pair too: + result = expandDefault(e, info) + else: + result = newZero(e, info, nkNilLit) + of tySet: + result = newZero(t, info, nkCurly) + of tyObject: + result = newNodeIT(nkObjConstr, info, t) + result.add newNodeIT(nkType, info, t) + expandDefaultObj(t, info, result) + of tyTuple: + result = newZero(t, info, nkTupleConstr) + for it in t.kids: + result.add expandDefault(it, info) + of tyVarargs, tyOpenArray, tySequence, tyUncheckedArray: + result = newZero(t, info, nkBracket) + of tyString: + result = newZero(t, info, nkStrLit) + of tyNone, tyEmpty, tyUntyped, tyTyped, tyTypeDesc, + tyNil, tyGenericInvocation, tyError, tyBuiltInTypeClass, + tyUserTypeClass, tyUserTypeClassInst, tyCompositeTypeClass, + tyAnd, tyOr, tyNot, tyAnything, tyConcept, tyIterable, tyForward: + result = newZero(t, info, nkEmpty) # bug indicator diff --git a/compiler/extccomp.nim b/compiler/extccomp.nim index e0fd5e206..ce25da773 100644 --- a/compiler/extccomp.nim +++ b/compiler/extccomp.nim @@ -12,9 +12,16 @@ # from a lineinfos file, to provide generalized procedures to compile # nim files. -import ropes, platform, condsyms, options, msgs, lineinfos, pathutils +import ropes, platform, condsyms, options, msgs, lineinfos, pathutils, modulepaths -import std/[os, strutils, osproc, sha1, streams, sequtils, times, strtabs, json] +import std/[os, osproc, streams, sequtils, times, strtabs, json, jsonutils, sugar, parseutils] + +import std / strutils except addf + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] + +import ../dist/checksums/src/checksums/sha1 type TInfoCCProp* = enum # properties of the C compiler: @@ -26,6 +33,7 @@ type hasGnuAsm, # CC's asm uses the absurd GNU assembler syntax hasDeclspec, # CC has __declspec(X) hasAttribute, # CC has __attribute__((X)) + hasBuiltinUnreachable # CC has __builtin_unreachable TInfoCCProps* = set[TInfoCCProp] TInfoCC* = tuple[ name: string, # the short name of the compiler @@ -83,12 +91,12 @@ compiler gcc: linkLibCmd: " -l$1", debug: "", pic: "-fPIC", - asmStmtFrmt: "asm($1);$n", + asmStmtFrmt: "__asm__($1);$n", structStmtFmt: "$1 $3 $2 ", # struct|union [packed] $name produceAsm: gnuAsmListing, - cppXsupport: "-std=gnu++14 -funsigned-char", + cppXsupport: "-std=gnu++17 -funsigned-char", props: {hasSwitchRange, hasComputedGoto, hasCpp, hasGcGuard, hasGnuAsm, - hasAttribute}) + hasAttribute, hasBuiltinUnreachable}) # GNU C and C++ Compiler compiler nintendoSwitchGCC: @@ -113,9 +121,9 @@ compiler nintendoSwitchGCC: asmStmtFrmt: "asm($1);$n", structStmtFmt: "$1 $3 $2 ", # struct|union [packed] $name produceAsm: gnuAsmListing, - cppXsupport: "-std=gnu++14 -funsigned-char", + cppXsupport: "-std=gnu++17 -funsigned-char", props: {hasSwitchRange, hasComputedGoto, hasCpp, hasGcGuard, hasGnuAsm, - hasAttribute}) + hasAttribute, hasBuiltinUnreachable}) # LLVM Frontend for GCC/G++ compiler llvmGcc: @@ -150,7 +158,7 @@ compiler vcc: compileTmpl: "/c$vccplatform $options $include /nologo /Fo$objfile $file", buildGui: " /SUBSYSTEM:WINDOWS user32.lib ", buildDll: " /LD", - buildLib: "lib /OUT:$libfile $objfiles", + buildLib: "vccexe --command:lib$vccplatform /nologo /OUT:$libfile $objfiles", linkerExe: "cl", linkTmpl: "$builddll$vccplatform /Fe$exefile $objfiles $buildgui /nologo $options", includeCmd: " /I", @@ -164,6 +172,22 @@ compiler vcc: cppXsupport: "", props: {hasCpp, hasAssume, hasDeclspec}) +# Nvidia CUDA NVCC Compiler +compiler nvcc: + result = gcc() + result.name = "nvcc" + result.compilerExe = "nvcc" + result.cppCompiler = "nvcc" + result.compileTmpl = "-c -x cu -Xcompiler=\"$options\" $include -o $objfile $file" + result.linkTmpl = "$buildgui $builddll -o $exefile $objfiles -Xcompiler=\"$options\"" + +# AMD HIPCC Compiler (rocm/cuda) +compiler hipcc: + result = clang() + result.name = "hipcc" + result.compilerExe = "hipcc" + result.cppCompiler = "hipcc" + compiler clangcl: result = vcc() result.name = "clang_cl" @@ -252,7 +276,7 @@ compiler envcc: buildGui: "", buildDll: " -shared ", buildLib: "", # XXX: not supported yet - linkerExe: "cc", + linkerExe: "", linkTmpl: "-o $exefile $buildgui $builddll $objfiles $options", includeCmd: " -I", linkDirCmd: "", # XXX: not supported yet @@ -277,7 +301,9 @@ const envcc(), icl(), icc(), - clangcl()] + clangcl(), + hipcc(), + nvcc()] hExt* = ".h" @@ -323,7 +349,9 @@ proc getConfigVar(conf: ConfigRef; c: TSystemCC, suffix: string): string = platform.OS[conf.target.targetOS].name & '.' & CC[c].name & fullSuffix result = getConfigVar(conf, fullCCname) - if result.len == 0: + if existsConfigVar(conf, fullCCname): + result = getConfigVar(conf, fullCCname) + else: # not overridden for this cross compilation setting? result = getConfigVar(conf, CC[c].name & fullSuffix) else: @@ -367,6 +395,7 @@ proc initVars*(conf: ConfigRef) = proc completeCfilePath*(conf: ConfigRef; cfile: AbsoluteFile, createSubDir: bool = true): AbsoluteFile = + ## Generate the absolute file path to the generated modules. result = completeGeneratedFilePath(conf, cfile, createSubDir) proc toObjFile*(conf: ConfigRef; filename: AbsoluteFile): AbsoluteFile = @@ -377,7 +406,7 @@ proc addFileToCompile*(conf: ConfigRef; cf: Cfile) = conf.toCompile.add(cf) proc addLocalCompileOption*(conf: ConfigRef; option: string; nimfile: AbsoluteFile) = - let key = completeCfilePath(conf, withPackageName(conf, nimfile)).string + let key = completeCfilePath(conf, mangleModuleName(conf, nimfile).AbsoluteFile).string var value = conf.cfileSpecificOptions.getOrDefault(key) if strutils.find(value, option, 0) < 0: addOpt(value, option) @@ -430,7 +459,13 @@ proc noAbsolutePaths(conf: ConfigRef): bool {.inline.} = # really: Cross compilation from Linux to Linux for example is entirely # reasonable. # `optGenMapping` is included here for niminst. - result = conf.globalOptions * {optGenScript, optGenMapping} != {} + # We use absolute paths for vcc / cl, see issue #19883. + let options = + if conf.cCompiler == ccVcc: + {optGenMapping} + else: + {optGenScript, optGenMapping} + result = conf.globalOptions * options != {} proc cFileSpecificOptions(conf: ConfigRef; nimname, fullNimFile: string): string = result = conf.compileOptions @@ -470,6 +505,10 @@ proc vccplatform(conf: ConfigRef): string = of cpuArm: " --platform:arm" of cpuAmd64: " --platform:amd64" else: "" + else: + result = "" + else: + result = "" proc getLinkOptions(conf: ConfigRef): string = result = conf.linkOptions & " " & conf.linkOptionsCmd & " " @@ -483,7 +522,10 @@ proc needsExeExt(conf: ConfigRef): bool {.inline.} = (conf.target.hostOS == osWindows) proc useCpp(conf: ConfigRef; cfile: AbsoluteFile): bool = - conf.backend == backendCpp and not cfile.string.endsWith(".c") + # List of possible file extensions taken from gcc + for ext in [".C", ".cc", ".cpp", ".CPP", ".c++", ".cp", ".cxx"]: + if cfile.string.endsWith(ext): return true + false proc envFlags(conf: ConfigRef): string = result = if conf.backend == backendCpp: @@ -491,14 +533,14 @@ proc envFlags(conf: ConfigRef): string = else: getEnv("CFLAGS") -proc getCompilerExe(conf: ConfigRef; compiler: TSystemCC; cfile: AbsoluteFile): string = +proc getCompilerExe(conf: ConfigRef; compiler: TSystemCC; isCpp: bool): string = if compiler == ccEnv: - result = if useCpp(conf, cfile): + result = if isCpp: getEnv("CXX") else: getEnv("CC") else: - result = if useCpp(conf, cfile): + result = if isCpp: CC[compiler].cppCompiler else: CC[compiler].compilerExe @@ -512,47 +554,36 @@ proc ccHasSaneOverflow*(conf: ConfigRef): bool = result = false # assume an old or crappy GCC var exe = getConfigVar(conf, conf.cCompiler, ".exe") if exe.len == 0: exe = CC[conf.cCompiler].compilerExe - let (s, exitCode) = try: execCmdEx(exe & " --version") except: ("", 1) + # NOTE: should we need the full version, use -dumpfullversion + let (s, exitCode) = try: execCmdEx(exe & " -dumpversion") except IOError, OSError, ValueError: ("", 1) if exitCode == 0: - var i = 0 - var j = 0 - # the version is the last part of the first line: - while i < s.len and s[i] != '\n': - if s[i] in {' ', '\t'}: j = i+1 - inc i - if j > 0: - var major = 0 - while j < s.len and s[j] in {'0'..'9'}: - major = major * 10 + (ord(s[j]) - ord('0')) - inc j - if i < s.len and s[j] == '.': inc j - while j < s.len and s[j] in {'0'..'9'}: - inc j - if j+1 < s.len and s[j] == '.' and s[j+1] in {'0'..'9'}: - # we found a third version number, chances are high - # we really parsed the version: - result = major >= 5 + var major: int = 0 + discard parseInt(s, major) + result = major >= 5 else: result = conf.cCompiler == ccCLang proc getLinkerExe(conf: ConfigRef; compiler: TSystemCC): string = result = if CC[compiler].linkerExe.len > 0: CC[compiler].linkerExe - elif optMixedMode in conf.globalOptions and conf.backend != backendCpp: CC[compiler].cppCompiler - else: getCompilerExe(conf, compiler, AbsoluteFile"") + else: getCompilerExe(conf, compiler, optMixedMode in conf.globalOptions or conf.backend == backendCpp) proc getCompileCFileCmd*(conf: ConfigRef; cfile: Cfile, isMainFile = false; produceOutput = false): string = - let c = conf.cCompiler + let + c = conf.cCompiler + isCpp = useCpp(conf, cfile.cname) # We produce files like module.nim.cpp, so the absolute Nim filename is not # cfile.name but `cfile.cname.changeFileExt("")`: var options = cFileSpecificOptions(conf, cfile.nimname, cfile.cname.changeFileExt("").string) - if useCpp(conf, cfile.cname): + if isCpp: # needs to be prepended so that --passc:-std=c++17 can override default. # we could avoid allocation by making cFileSpecificOptions inplace options = CC[c].cppXsupport & ' ' & options + # If any C++ file was compiled, we need to use C++ driver for linking as well + incl conf.globalOptions, optMixedMode var exe = getConfigVar(conf, c, ".exe") - if exe.len == 0: exe = getCompilerExe(conf, c, cfile.cname) + if exe.len == 0: exe = getCompilerExe(conf, c, isCpp) if needsExeExt(conf): exe = addFileExt(exe, "exe") if (optGenDynLib in conf.globalOptions or (conf.hcrOn and not isMainFile)) and @@ -572,7 +603,7 @@ proc getCompileCFileCmd*(conf: ConfigRef; cfile: Cfile, compilePattern = joinPath(conf.cCompilerPath, exe) else: - compilePattern = getCompilerExe(conf, c, cfile.cname) + compilePattern = exe includeCmd.add(join([CC[c].includeCmd, quoteShell(conf.projectPath.string)])) @@ -614,7 +645,7 @@ proc getCompileCFileCmd*(conf: ConfigRef; cfile: Cfile, "for the selected C compiler: " & CC[conf.cCompiler].name) result.add(' ') - result.addf(CC[c].compileTmpl, [ + strutils.addf(result, CC[c].compileTmpl, [ "dfile", dfile, "file", cfsh, "objfile", quoteShell(objfile), "options", options, "include", includeCmd, @@ -634,9 +665,9 @@ proc footprint(conf: ConfigRef; cfile: Cfile): SecureHash = proc externalFileChanged(conf: ConfigRef; cfile: Cfile): bool = if conf.backend == backendJs: return false # pre-existing behavior, but not sure it's good - let hashFile = toGeneratedFile(conf, conf.withPackageName(cfile.cname), "sha1") + let hashFile = toGeneratedFile(conf, conf.mangleModuleName(cfile.cname).AbsoluteFile, "sha1") let currentHash = footprint(conf, cfile) - var f: File + var f: File = default(File) if open(f, hashFile.string, fmRead): let oldHash = parseSecureHash(f.readLine()) close(f) @@ -649,8 +680,10 @@ proc externalFileChanged(conf: ConfigRef; cfile: Cfile): bool = close(f) proc addExternalFileToCompile*(conf: ConfigRef; c: var Cfile) = + # we want to generate the hash file unconditionally + let extFileChanged = externalFileChanged(conf, c) if optForceFullMake notin conf.globalOptions and fileExists(c.obj) and - not externalFileChanged(conf, c): + not extFileChanged: c.flags.incl CfileFlag.Cached else: # make sure Nim keeps recompiling the external file on reruns @@ -665,11 +698,13 @@ proc addExternalFileToCompile*(conf: ConfigRef; filename: AbsoluteFile) = addExternalFileToCompile(conf, c) proc getLinkCmd(conf: ConfigRef; output: AbsoluteFile, - objfiles: string, isDllBuild: bool): string = + objfiles: string, isDllBuild: bool, removeStaticFile: bool): string = if optGenStaticLib in conf.globalOptions: - removeFile output # fixes: bug #16947 + if removeStaticFile: + removeFile output # fixes: bug #16947 result = CC[conf.cCompiler].buildLib % ["libfile", quoteShell(output), - "objfiles", objfiles] + "objfiles", objfiles, + "vccplatform", vccplatform(conf)] else: var linkerExe = getConfigVar(conf, conf.cCompiler, ".linkerexe") if linkerExe.len == 0: linkerExe = getLinkerExe(conf, conf.cCompiler) @@ -702,7 +737,7 @@ proc getLinkCmd(conf: ConfigRef; output: AbsoluteFile, "buildgui", buildgui, "options", linkOptions, "objfiles", objfiles, "exefile", exefile, "nim", getPrefixDir(conf).string, "lib", conf.libpath.string]) result.add ' ' - result.addf(linkTmpl, ["builddll", builddll, + strutils.addf(result, linkTmpl, ["builddll", builddll, "mapfile", mapfile, "buildgui", buildgui, "options", linkOptions, "objfiles", objfiles, "exefile", exefile, @@ -750,8 +785,9 @@ proc getLinkCmd(conf: ConfigRef; output: AbsoluteFile, if optCDebug in conf.globalOptions and conf.cCompiler == ccVcc: result.add " /Zi /FS /Od" -template getLinkCmd(conf: ConfigRef; output: AbsoluteFile, objfiles: string): string = - getLinkCmd(conf, output, objfiles, optGenDynLib in conf.globalOptions) +template getLinkCmd(conf: ConfigRef; output: AbsoluteFile, objfiles: string, + removeStaticFile = false): string = + getLinkCmd(conf, output, objfiles, optGenDynLib in conf.globalOptions, removeStaticFile) template tryExceptOSErrorMessage(conf: ConfigRef; errorPrefix: string = "", body: untyped) = try: @@ -766,6 +802,7 @@ template tryExceptOSErrorMessage(conf: ConfigRef; errorPrefix: string = "", body raise proc getExtraCmds(conf: ConfigRef; output: AbsoluteFile): seq[string] = + result = @[] when defined(macosx): if optCDebug in conf.globalOptions and optGenStaticLib notin conf.globalOptions: # if needed, add an option to skip or override location @@ -821,10 +858,22 @@ proc linkViaResponseFile(conf: ConfigRef; cmd: string) = else: writeFile(linkerArgs, args) try: - execLinkCmd(conf, cmd.substr(0, last) & " @" & linkerArgs) + when defined(macosx): + execLinkCmd(conf, "xargs " & cmd.substr(0, last) & " < " & linkerArgs) + else: + execLinkCmd(conf, cmd.substr(0, last) & " @" & linkerArgs) finally: removeFile(linkerArgs) +proc linkViaShellScript(conf: ConfigRef; cmd: string) = + let linkerScript = conf.projectName & "_" & "linkerScript.sh" + writeFile(linkerScript, cmd) + let shell = getEnv("SHELL") + try: + execLinkCmd(conf, shell & " " & linkerScript) + finally: + removeFile(linkerScript) + proc getObjFilePath(conf: ConfigRef, f: Cfile): string = if noAbsolutePaths(conf): f.obj.extractFilename else: f.obj.string @@ -836,23 +885,38 @@ proc hcrLinkTargetName(conf: ConfigRef, objFile: string, isMain = false): Absolu result = conf.getNimcacheDir / RelativeFile(targetName) proc displayProgressCC(conf: ConfigRef, path, compileCmd: string): string = + result = "" if conf.hasHint(hintCC): if optListCmd in conf.globalOptions or conf.verbosity > 1: - result = MsgKindToStr[hintCC] % (demanglePackageName(path.splitFile.name) & ": " & compileCmd) + result = MsgKindToStr[hintCC] % (demangleModuleName(path.splitFile.name) & ": " & compileCmd) + else: + result = MsgKindToStr[hintCC] % demangleModuleName(path.splitFile.name) + +proc preventLinkCmdMaxCmdLen(conf: ConfigRef, linkCmd: string) = + # Prevent linkcmd from exceeding the maximum command line length. + # Windows's command line limit is about 8K (8191 characters) so C compilers on + # Windows support a feature where the command line can be passed via ``@linkcmd`` + # to them. + const MaxCmdLen = when defined(windows): 8_000 elif defined(macosx): 260_000 else: 32_000 + if linkCmd.len > MaxCmdLen: + when defined(macosx): + linkViaShellScript(conf, linkCmd) else: - result = MsgKindToStr[hintCC] % demanglePackageName(path.splitFile.name) + linkViaResponseFile(conf, linkCmd) + else: + execLinkCmd(conf, linkCmd) proc callCCompiler*(conf: ConfigRef) = var - linkCmd: string + linkCmd: string = "" extraCmds: seq[string] if conf.globalOptions * {optCompileOnly, optGenScript} == {optCompileOnly}: return # speed up that call if only compiling and no script shall be # generated #var c = cCompiler - var script: Rope = nil - var cmds: TStringSeq - var prettyCmds: TStringSeq + var script: Rope = "" + var cmds: TStringSeq = default(TStringSeq) + var prettyCmds: TStringSeq = default(TStringSeq) let prettyCb = proc (idx: int) = writePrettyCmdsStderr(prettyCmds[idx]) for idx, it in conf.toCompile: @@ -891,7 +955,7 @@ proc callCCompiler*(conf: ConfigRef) = let objFile = conf.getObjFilePath(x) let buildDll = idx != mainFileIdx let linkTarget = conf.hcrLinkTargetName(objFile, not buildDll) - cmds.add(getLinkCmd(conf, linkTarget, objfiles & " " & quoteShell(objFile), buildDll)) + cmds.add(getLinkCmd(conf, linkTarget, objfiles & " " & quoteShell(objFile), buildDll, removeStaticFile = true)) # try to remove all .pdb files for the current binary so they don't accumulate endlessly in the nimcache # for more info check the comment inside of getLinkCmd() where the /PDB:<filename> MSVC flag is used if isVSCompatible(conf): @@ -913,18 +977,12 @@ proc callCCompiler*(conf: ConfigRef) = objfiles.add(' ') objfiles.add(quoteShell(objFile)) let mainOutput = if optGenScript notin conf.globalOptions: conf.prepareToWriteOutput - else: AbsoluteFile(conf.projectName) - linkCmd = getLinkCmd(conf, mainOutput, objfiles) + else: AbsoluteFile(conf.outFile) + + linkCmd = getLinkCmd(conf, mainOutput, objfiles, removeStaticFile = true) extraCmds = getExtraCmds(conf, mainOutput) if optCompileOnly notin conf.globalOptions: - const MaxCmdLen = when defined(windows): 8_000 else: 32_000 - if linkCmd.len > MaxCmdLen: - # Windows's command line limit is about 8K (don't laugh...) so C compilers on - # Windows support a feature where the command line can be passed via ``@linkcmd`` - # to them. - linkViaResponseFile(conf, linkCmd) - else: - execLinkCmd(conf, linkCmd) + preventLinkCmdMaxCmdLen(conf, linkCmd) for cmd in extraCmds: execExternalProgram(conf, cmd, hintExecuting) else: @@ -934,208 +992,113 @@ proc callCCompiler*(conf: ConfigRef) = script.add("\n") generateScript(conf, script) - template hashNimExe(): string = $secureHashFile(os.getAppFilename()) -proc writeJsonBuildInstructions*(conf: ConfigRef) = - template lit(x: string) = f.write x - template str(x: string) = - buf.setLen 0 - escapeJson(x, buf) - f.write buf - - proc cfiles(conf: ConfigRef; f: File; buf: var string; clist: CfileList, isExternal: bool) = - var comma = false - for i, it in clist: - if CfileFlag.Cached in it.flags: continue - let compileCmd = getCompileCFileCmd(conf, it) - if comma: lit ",\L" else: comma = true - lit "[" - str it.cname.string - lit ", " - str compileCmd - lit "]" - - proc linkfiles(conf: ConfigRef; f: File; buf, objfiles: var string; clist: CfileList; - llist: seq[string]) = - var pastStart = false - for it in llist: - let objfile = if noAbsolutePaths(conf): it.extractFilename - else: it - let objstr = addFileExt(objfile, CC[conf.cCompiler].objExt) - objfiles.add(' ') - objfiles.add(objstr) - if pastStart: lit ",\L" - str objstr - pastStart = true - - for it in clist: - let objstr = quoteShell(it.obj) - objfiles.add(' ') - objfiles.add(objstr) - if pastStart: lit ",\L" - str objstr - pastStart = true - lit "\L" - - proc depfiles(conf: ConfigRef; f: File; buf: var string) = - var i = 0 +proc jsonBuildInstructionsFile*(conf: ConfigRef): AbsoluteFile = + # `outFile` is better than `projectName`, as it allows having different json + # files for a given source file compiled with different options; it also + # works out of the box with `hashMainCompilationParams`. + result = getNimcacheDir(conf) / conf.outFile.changeFileExt("json") + +const cacheVersion = "D20240927T193831" # update when `BuildCache` spec changes +type BuildCache = object + cacheVersion: string + outputFile: string + outputLastModificationTime: string + compile: seq[(string, string)] + link: seq[string] + linkcmd: string + extraCmds: seq[string] + configFiles: seq[string] # the hash shouldn't be needed + stdinInput: bool + projectIsCmd: bool + cmdInput: string + currentDir: string + cmdline: string + depfiles: seq[(string, string)] + nimexe: string + +proc writeJsonBuildInstructions*(conf: ConfigRef; deps: StringTableRef) = + var linkFiles = collect(for it in conf.externalToLink: + var it = it + if conf.noAbsolutePaths: it = it.extractFilename + it.addFileExt(CC[conf.cCompiler].objExt)) + for it in conf.toCompile: linkFiles.add it.obj.string + var bcache = BuildCache( + cacheVersion: cacheVersion, + outputFile: conf.absOutFile.string, + compile: collect(for i, it in conf.toCompile: + if CfileFlag.Cached notin it.flags: (it.cname.string, getCompileCFileCmd(conf, it))), + link: linkFiles, + linkcmd: getLinkCmd(conf, conf.absOutFile, linkFiles.quoteShellCommand), + extraCmds: getExtraCmds(conf, conf.absOutFile), + stdinInput: conf.projectIsStdin, + projectIsCmd: conf.projectIsCmd, + cmdInput: conf.cmdInput, + configFiles: conf.configFiles.mapIt(it.string), + currentDir: getCurrentDir()) + if optRun in conf.globalOptions or isDefined(conf, "nimBetterRun"): + bcache.cmdline = conf.commandLine for it in conf.m.fileInfos: let path = it.fullPath.string if isAbsolute(path): # TODO: else? - if i > 0: lit "],\L" - lit "[" - str path - lit ", " - str $secureHashFile(path) - inc i - lit "]\L" - - - var buf = newStringOfCap(50) - - let jsonFile = conf.getNimcacheDir / RelativeFile(conf.projectName & ".json") - conf.jsonBuildFile = jsonFile - let output = conf.absOutFile - - var f: File - if open(f, jsonFile.string, fmWrite): - lit "{\L" - lit "\"outputFile\": " - str $output - - lit ",\L\"compile\":[\L" - cfiles(conf, f, buf, conf.toCompile, false) - lit "],\L\"link\":[\L" - var objfiles = "" - # XXX add every file here that is to link - linkfiles(conf, f, buf, objfiles, conf.toCompile, conf.externalToLink) - - lit "],\L\"linkcmd\": " - str getLinkCmd(conf, output, objfiles) - - lit ",\L\"extraCmds\": " - lit $(%* getExtraCmds(conf, conf.absOutFile)) - - lit ",\L\"stdinInput\": " - lit $(%* conf.projectIsStdin) - lit ",\L\"projectIsCmd\": " - lit $(%* conf.projectIsCmd) - lit ",\L\"cmdInput\": " - lit $(%* conf.cmdInput) - lit ",\L\"currentDir\": " - lit $(%* getCurrentDir()) - - if optRun in conf.globalOptions or isDefined(conf, "nimBetterRun"): - lit ",\L\"cmdline\": " - str conf.commandLine - lit ",\L\"depfiles\":[\L" - depfiles(conf, f, buf) - lit "],\L\"nimexe\": \L" - str hashNimExe() - lit "\L" - - lit "\L}\L" - close(f) - -proc changeDetectedViaJsonBuildInstructions*(conf: ConfigRef; projectfile: AbsoluteFile): bool = - let jsonFile = toGeneratedFile(conf, projectfile, "json") - if not fileExists(jsonFile): return true - if not fileExists(conf.absOutFile): return true + if path in deps: + bcache.depfiles.add (path, deps[path]) + else: # backup for configs etc. + bcache.depfiles.add (path, $secureHashFile(path)) + + bcache.nimexe = hashNimExe() + if fileExists(bcache.outputFile): + bcache.outputLastModificationTime = $getLastModificationTime(bcache.outputFile) + conf.jsonBuildFile = conf.jsonBuildInstructionsFile + conf.jsonBuildFile.string.writeFile(bcache.toJson.pretty) + +proc changeDetectedViaJsonBuildInstructions*(conf: ConfigRef; jsonFile: AbsoluteFile): bool = result = false - try: - let data = json.parseFile(jsonFile.string) - for key in "depfiles cmdline stdinInput currentDir".split: - if not data.hasKey(key): return true - if getCurrentDir() != data["currentDir"].getStr: - # fixes bug #16271 - # Note that simply comparing `expandFilename(projectFile)` would - # not be sufficient in case other flags depend implicitly on `getCurrentDir`, - # and would require much more care. Simply re-compiling is safer for now. - # A better strategy for future work would be to cache (with an LRU cache) - # the N most recent unique build instructions, as done with `rdmd`, - # which is both robust and avoids recompilation when switching back and forth - # between projects, see https://github.com/timotheecour/Nim/issues/199 - return true - let oldCmdLine = data["cmdline"].getStr - if conf.commandLine != oldCmdLine: - return true - if hashNimExe() != data["nimexe"].getStr: - return true - let stdinInput = data["stdinInput"].getBool - let projectIsCmd = data["projectIsCmd"].getBool - if conf.projectIsStdin or stdinInput: - # could optimize by returning false if stdin input was the same, - # but I'm not sure how to get full stding input - return true - - if conf.projectIsCmd or projectIsCmd: - if not (conf.projectIsCmd and projectIsCmd): return true - if not data.hasKey("cmdInput"): return true - let cmdInput = data["cmdInput"].getStr - if cmdInput != conf.cmdInput: return true - - let depfilesPairs = data["depfiles"] - doAssert depfilesPairs.kind == JArray - for p in depfilesPairs: - doAssert p.kind == JArray - # >= 2 for forwards compatibility with potential later .json files: - doAssert p.len >= 2 - let depFilename = p[0].getStr - let oldHashValue = p[1].getStr - let newHashValue = $secureHashFile(depFilename) - if oldHashValue != newHashValue: - return true + if not fileExists(jsonFile) or not fileExists(conf.absOutFile): return true + var bcache: BuildCache = default(BuildCache) + try: bcache.fromJson(jsonFile.string.parseFile) except IOError, OSError, ValueError: - echo "Warning: JSON processing failed: ", getCurrentExceptionMsg() - result = true - -proc runJsonBuildInstructions*(conf: ConfigRef; projectfile: AbsoluteFile) = - let jsonFile = toGeneratedFile(conf, projectfile, "json") - try: - let data = json.parseFile(jsonFile.string) - - let output = data["outputFile"].getStr - createDir output.parentDir - let outputCurrent = $conf.absOutFile - if output != outputCurrent: - # previously, any specified output file would be silently ignored; - # simply copying won't work in some cases, for example with `extraCmds`, - # so we just make it an error, user should use same command for jsonscript - # as was used with --compileOnly. - globalError(conf, gCmdLineInfo, "jsonscript command outputFile '$1' must match '$2' which was specified during --compileOnly, see \"outputFile\" entry in '$3' " % [outputCurrent, output, jsonFile.string]) - - let toCompile = data["compile"] - doAssert toCompile.kind == JArray - var cmds: TStringSeq - var prettyCmds: TStringSeq - let prettyCb = proc (idx: int) = writePrettyCmdsStderr(prettyCmds[idx]) - for c in toCompile: - doAssert c.kind == JArray - doAssert c.len >= 2 - - cmds.add(c[1].getStr) - prettyCmds.add displayProgressCC(conf, c[0].getStr, c[1].getStr) - - execCmdsInParallel(conf, cmds, prettyCb) - - let linkCmd = data["linkcmd"] - doAssert linkCmd.kind == JString - execLinkCmd(conf, linkCmd.getStr) - if data.hasKey("extraCmds"): - let extraCmds = data["extraCmds"] - doAssert extraCmds.kind == JArray - for cmd in extraCmds: - doAssert cmd.kind == JString, $cmd.kind - let cmd2 = cmd.getStr - execExternalProgram(conf, cmd2, hintExecuting) - - except: + stderr.write "Warning: JSON processing failed for: $#\n" % jsonFile.string + return true + if bcache.currentDir != getCurrentDir() or # fixes bug #16271 + bcache.configFiles != conf.configFiles.mapIt(it.string) or + bcache.cacheVersion != cacheVersion or bcache.outputFile != conf.absOutFile.string or + bcache.cmdline != conf.commandLine or bcache.nimexe != hashNimExe() or + bcache.projectIsCmd != conf.projectIsCmd or conf.cmdInput != bcache.cmdInput: return true + if bcache.stdinInput or conf.projectIsStdin: return true + # xxx optimize by returning false if stdin input was the same + for (file, hash) in bcache.depfiles: + if $secureHashFile(file) != hash: return true + if bcache.outputLastModificationTime != $getLastModificationTime(bcache.outputFile): + return true + +proc runJsonBuildInstructions*(conf: ConfigRef; jsonFile: AbsoluteFile) = + var bcache: BuildCache = default(BuildCache) + try: bcache.fromJson(jsonFile.string.parseFile) + except ValueError, KeyError, JsonKindError: let e = getCurrentException() - quit "\ncaught exception:\n" & e.msg & "\nstacktrace:\n" & e.getStackTrace() & - "error evaluating JSON file: " & jsonFile.string + conf.quitOrRaise "\ncaught exception:\n$#\nstacktrace:\n$#error evaluating JSON file: $#" % + [e.msg, e.getStackTrace(), jsonFile.string] + let output = bcache.outputFile + 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]) + var cmds: TStringSeq = default(TStringSeq) + var prettyCmds: TStringSeq = default(TStringSeq) + let prettyCb = proc (idx: int) = writePrettyCmdsStderr(prettyCmds[idx]) + for (name, cmd) in bcache.compile: + cmds.add cmd + prettyCmds.add displayProgressCC(conf, name, cmd) + execCmdsInParallel(conf, cmds, prettyCb) + preventLinkCmdMaxCmdLen(conf, bcache.linkcmd) + for cmd in bcache.extraCmds: execExternalProgram(conf, cmd, hintExecuting) proc genMappingFiles(conf: ConfigRef; list: CfileList): Rope = + result = "" for it in list: result.addf("--file:r\"$1\"$N", [rope(it.cname.string)]) diff --git a/compiler/filter_tmpl.nim b/compiler/filter_tmpl.nim index 6165ff2f3..921a94b31 100644 --- a/compiler/filter_tmpl.nim +++ b/compiler/filter_tmpl.nim @@ -10,9 +10,11 @@ # This module implements Nim's standard template filter. import - llstream, strutils, ast, msgs, options, + llstream, ast, msgs, options, filters, lineinfos, pathutils +import std/strutils + type TParseState = enum psDirective, psTempl @@ -22,7 +24,7 @@ type info: TLineInfo indent, emitPar: int x: string # the current input line - outp: PLLStream # the output will be parsed by pnimsyn + outp: PLLStream # the output will be parsed by parser subsChar, nimDirective: char emit, conc, toStr: string curly, bracket, par: int @@ -201,17 +203,15 @@ proc parseLine(p: var TTmplParser) = proc filterTmpl*(conf: ConfigRef, stdin: PLLStream, filename: AbsoluteFile, call: PNode): PLLStream = - var p: TTmplParser - p.config = conf - p.info = newLineInfo(conf, filename, 0, 0) - p.outp = llStreamOpen("") - p.inp = stdin - p.subsChar = charArg(conf, call, "subschar", 1, '$') - p.nimDirective = charArg(conf, call, "metachar", 2, '#') - p.emit = strArg(conf, call, "emit", 3, "result.add") - p.conc = strArg(conf, call, "conc", 4, " & ") - p.toStr = strArg(conf, call, "tostring", 5, "$") - p.x = newStringOfCap(120) + var p = TTmplParser(config: conf, info: newLineInfo(conf, filename, 0, 0), + outp: llStreamOpen(""), inp: stdin, + subsChar: charArg(conf, call, "subschar", 1, '$'), + nimDirective: charArg(conf, call, "metachar", 2, '#'), + emit: strArg(conf, call, "emit", 3, "result.add"), + conc: strArg(conf, call, "conc", 4, " & "), + toStr: strArg(conf, call, "tostring", 5, "$"), + x: newStringOfCap(120) + ) # do not process the first line which contains the directive: if llStreamReadLine(p.inp, p.x): inc p.info.line diff --git a/compiler/filters.nim b/compiler/filters.nim index 8151c0b93..3cd56e3be 100644 --- a/compiler/filters.nim +++ b/compiler/filters.nim @@ -10,9 +10,11 @@ # This module implements Nim's simple filters and helpers for filters. import - llstream, idents, strutils, ast, msgs, options, + llstream, idents, ast, msgs, options, renderer, pathutils +import std/strutils + proc invalidPragma(conf: ConfigRef; n: PNode) = localError(conf, n.info, "'$1' not allowed here" % renderTree(n, {renderNoComments})) @@ -29,23 +31,30 @@ proc getArg(conf: ConfigRef; n: PNode, name: string, pos: int): PNode = return n[i] proc charArg*(conf: ConfigRef; n: PNode, name: string, pos: int, default: char): char = + var x = getArg(conf, n, name, pos) if x == nil: result = default elif x.kind == nkCharLit: result = chr(int(x.intVal)) - else: invalidPragma(conf, n) + else: + result = default(char) + invalidPragma(conf, n) proc strArg*(conf: ConfigRef; n: PNode, name: string, pos: int, default: string): string = var x = getArg(conf, n, name, pos) if x == nil: result = default elif x.kind in {nkStrLit..nkTripleStrLit}: result = x.strVal - else: invalidPragma(conf, n) + else: + result = "" + invalidPragma(conf, n) proc boolArg*(conf: ConfigRef; n: PNode, name: string, pos: int, default: bool): bool = var x = getArg(conf, n, name, pos) if x == nil: result = default elif x.kind == nkIdent and cmpIgnoreStyle(x.ident.s, "true") == 0: result = true elif x.kind == nkIdent and cmpIgnoreStyle(x.ident.s, "false") == 0: result = false - else: invalidPragma(conf, n) + else: + result = false + invalidPragma(conf, n) proc filterStrip*(conf: ConfigRef; stdin: PLLStream, filename: AbsoluteFile, call: PNode): PLLStream = var pattern = strArg(conf, call, "startswith", 1, "") diff --git a/compiler/gorgeimpl.nim b/compiler/gorgeimpl.nim index d4aeb6a77..da911c84c 100644 --- a/compiler/gorgeimpl.nim +++ b/compiler/gorgeimpl.nim @@ -9,8 +9,14 @@ ## Module that implements ``gorge`` for the compiler. -import msgs, std / sha1, os, osproc, streams, options, - lineinfos, pathutils +import msgs, options, lineinfos, pathutils + +import std/[os, osproc, streams] + +when defined(nimPreviewSlimSystem): + import std/syncio + +import ../dist/checksums/src/checksums/sha1 proc readOutput(p: Process): (string, int) = result[0] = "" @@ -24,10 +30,11 @@ proc readOutput(p: Process): (string, int) = proc opGorge*(cmd, input, cache: string, info: TLineInfo; conf: ConfigRef): (string, int) = let workingDir = parentDir(toFullPath(conf, info)) + result = ("", 0) if cache.len > 0: let h = secureHash(cmd & "\t" & input & "\t" & cache) let filename = toGeneratedFile(conf, AbsoluteFile("gorge_" & $h), "txt").string - var f: File + var f: File = default(File) if optForceFullMake notin conf.globalOptions and open(f, filename): result = (f.readAll, 0) f.close @@ -46,7 +53,11 @@ proc opGorge*(cmd, input, cache: string, info: TLineInfo; conf: ConfigRef): (str if result[1] == 0: writeFile(filename, result[0]) except IOError, OSError: - if not readSuccessful: result = ("", -1) + if not readSuccessful: + when defined(nimLegacyGorgeErrors): + result = ("", -1) + else: + result = ("Error running startProcess: " & getCurrentExceptionMsg(), -1) else: try: var p = startProcess(cmd, workingDir, @@ -57,4 +68,7 @@ proc opGorge*(cmd, input, cache: string, info: TLineInfo; conf: ConfigRef): (str result = p.readOutput p.close() except IOError, OSError: - result = ("", -1) + when defined(nimLegacyGorgeErrors): + result = ("", -1) + else: + result = ("Error running startProcess: " & getCurrentExceptionMsg(), -1) diff --git a/compiler/guards.nim b/compiler/guards.nim index 028142127..bbb239867 100644 --- a/compiler/guards.nim +++ b/compiler/guards.nim @@ -12,6 +12,9 @@ import ast, astalgo, msgs, magicsys, nimsets, trees, types, renderer, idents, saturate, modulegraphs, options, lineinfos, int128 +when defined(nimPreviewSlimSystem): + import std/assertions + const someEq = {mEqI, mEqF64, mEqEnum, mEqCh, mEqB, mEqRef, mEqProc, mEqStr, mEqSet, mEqCString} @@ -48,6 +51,10 @@ proc isLet(n: PNode): bool = elif n.sym.kind == skParam and skipTypes(n.sym.typ, abstractInst).kind notin {tyVar}: result = true + else: + result = false + else: + result = false proc isVar(n: PNode): bool = n.kind == nkSym and n.sym.kind in {skResult, skVar} and @@ -65,9 +72,12 @@ proc isLetLocation(m: PNode, isApprox: bool): bool = case n.kind of nkDotExpr, nkCheckedFieldExpr, nkObjUpConv, nkObjDownConv: n = n[0] - of nkDerefExpr, nkHiddenDeref: + of nkDerefExpr: n = n[0] inc derefs + of nkHiddenDeref: + n = n[0] + if not isApprox: inc derefs of nkBracketExpr: if isConstExpr(n[1]) or isLet(n[1]) or isConstExpr(n[1].skipConv): n = n[0] @@ -130,6 +140,8 @@ proc neg(n: PNode; o: Operators): PNode = result = a elif b != nil: result = b + else: + result = nil else: # leave not (a == 4) as it is result = newNodeI(nkCall, n.info, 2) @@ -197,7 +209,7 @@ proc highBound*(conf: ConfigRef; x: PNode; o: Operators): PNode = nkIntLit.newIntNode(lastOrd(conf, typ)) elif typ.kind == tySequence and x.kind == nkSym and x.sym.kind == skConst: - nkIntLit.newIntNode(x.sym.ast.len-1) + nkIntLit.newIntNode(x.sym.astdef.len-1) else: o.opAdd.buildCall(o.opLen.buildCall(x), minusOne()) result.info = x.info @@ -324,6 +336,8 @@ proc usefulFact(n: PNode; o: Operators): PNode = result = n elif n[1].getMagic in someLen or n[2].getMagic in someLen: result = n + else: + result = nil of someLe+someLt: if isLetLocation(n[1], true) or isLetLocation(n[2], true): # XXX algebraic simplifications! 'i-1 < a.len' --> 'i < a.len+1' @@ -331,12 +345,18 @@ proc usefulFact(n: PNode; o: Operators): PNode = elif n[1].getMagic in someLen or n[2].getMagic in someLen: # XXX Rethink this whole idea of 'usefulFact' for semparallel result = n + else: + result = nil of mIsNil: if isLetLocation(n[1], false) or isVar(n[1]): result = n + else: + result = nil of someIn: if isLetLocation(n[1], true): result = n + else: + result = nil of mAnd: let a = usefulFact(n[1], o) @@ -350,10 +370,14 @@ proc usefulFact(n: PNode; o: Operators): PNode = result = a elif b != nil: result = b + else: + result = nil of mNot: let a = usefulFact(n[1], o) if a != nil: result = a.neg(o) + else: + result = nil of mOr: # 'or' sucks! (p.isNil or q.isNil) --> hard to do anything # with that knowledge... @@ -370,6 +394,8 @@ proc usefulFact(n: PNode; o: Operators): PNode = result[1] = a result[2] = b result = result.neg(o) + else: + result = nil elif n.kind == nkSym and n.sym.kind == skLet: # consider: # let a = 2 < x @@ -378,8 +404,12 @@ proc usefulFact(n: PNode; o: Operators): PNode = # We make can easily replace 'a' by '2 < x' here: if n.sym.astdef != nil: result = usefulFact(n.sym.astdef, o) + else: + result = nil elif n.kind == nkStmtListExpr: result = usefulFact(n.lastSon, o) + else: + result = nil type TModel* = object @@ -441,8 +471,15 @@ proc sameTree*(a, b: PNode): bool = proc hasSubTree(n, x: PNode): bool = if n.sameTree(x): result = true else: - for i in 0..n.safeLen-1: - if hasSubTree(n[i], x): return true + case n.kind + of nkEmpty..nkNilLit: + result = n.sameTree(x) + of nkFormalParams: + result = false + else: + result = false + for i in 0..<n.len: + if hasSubTree(n[i], x): return true proc invalidateFacts*(s: var seq[PNode], n: PNode) = # We are able to guard local vars (as opposed to 'let' variables)! @@ -471,6 +508,8 @@ proc invalidateFacts*(m: var TModel, n: PNode) = proc valuesUnequal(a, b: PNode): bool = if a.isValue and b.isValue: result = not sameValue(a, b) + else: + result = false proc impliesEq(fact, eq: PNode): TImplication = let (loc, val) = if isLocation(eq[1]): (1, 2) else: (2, 1) @@ -481,16 +520,26 @@ proc impliesEq(fact, eq: PNode): TImplication = # this is not correct; consider: a == b; a == 1 --> unknown! if sameTree(fact[2], eq[val]): result = impYes elif valuesUnequal(fact[2], eq[val]): result = impNo + else: + result = impUnknown elif sameTree(fact[2], eq[loc]): if sameTree(fact[1], eq[val]): result = impYes elif valuesUnequal(fact[1], eq[val]): result = impNo + else: + result = impUnknown + else: + result = impUnknown of mInSet: # remember: mInSet is 'contains' so the set comes first! if sameTree(fact[2], eq[loc]) and isValue(eq[val]): if inSet(fact[1], eq[val]): result = impYes else: result = impNo - of mNot, mOr, mAnd: assert(false, "impliesEq") - else: discard + else: + result = impUnknown + of mNot, mOr, mAnd: + result = impUnknown + assert(false, "impliesEq") + else: result = impUnknown proc leImpliesIn(x, c, aSet: PNode): TImplication = if c.kind in {nkCharLit..nkUInt64Lit}: @@ -500,13 +549,19 @@ proc leImpliesIn(x, c, aSet: PNode): TImplication = var value = newIntNode(c.kind, firstOrd(nil, x.typ)) # don't iterate too often: if c.intVal - value.intVal < 1000: - var i, pos, neg: int + var i, pos, neg: int = 0 while value.intVal <= c.intVal: if inSet(aSet, value): inc pos else: inc neg inc i; inc value.intVal if pos == i: result = impYes elif neg == i: result = impNo + else: + result = impUnknown + else: + result = impUnknown + else: + result = impUnknown proc geImpliesIn(x, c, aSet: PNode): TImplication = if c.kind in {nkCharLit..nkUInt64Lit}: @@ -517,17 +572,23 @@ proc geImpliesIn(x, c, aSet: PNode): TImplication = let max = lastOrd(nil, x.typ) # don't iterate too often: if max - getInt(value) < toInt128(1000): - var i, pos, neg: int + var i, pos, neg: int = 0 while value.intVal <= max: if inSet(aSet, value): inc pos else: inc neg inc i; inc value.intVal if pos == i: result = impYes elif neg == i: result = impNo + else: result = impUnknown + else: + result = impUnknown + else: + result = impUnknown proc compareSets(a, b: PNode): TImplication = if equalSets(nil, a, b): result = impYes elif intersectSets(nil, a, b).len == 0: result = impNo + else: result = impUnknown proc impliesIn(fact, loc, aSet: PNode): TImplication = case fact[0].sym.magic @@ -538,22 +599,32 @@ proc impliesIn(fact, loc, aSet: PNode): TImplication = elif sameTree(fact[2], loc): if inSet(aSet, fact[1]): result = impYes else: result = impNo + else: + result = impUnknown of mInSet: if sameTree(fact[2], loc): result = compareSets(fact[1], aSet) + else: + result = impUnknown of someLe: if sameTree(fact[1], loc): result = leImpliesIn(fact[1], fact[2], aSet) elif sameTree(fact[2], loc): result = geImpliesIn(fact[2], fact[1], aSet) + else: + result = impUnknown of someLt: if sameTree(fact[1], loc): result = leImpliesIn(fact[1], fact[2].pred, aSet) elif sameTree(fact[2], loc): # 4 < x --> 3 <= x result = geImpliesIn(fact[2], fact[1].pred, aSet) - of mNot, mOr, mAnd: assert(false, "impliesIn") - else: discard + else: + result = impUnknown + of mNot, mOr, mAnd: + result = impUnknown + assert(false, "impliesIn") + else: result = impUnknown proc valueIsNil(n: PNode): TImplication = if n.kind == nkNilLit: impYes @@ -565,13 +636,19 @@ proc impliesIsNil(fact, eq: PNode): TImplication = of mIsNil: if sameTree(fact[1], eq[1]): result = impYes + else: + result = impUnknown of someEq: if sameTree(fact[1], eq[1]): result = valueIsNil(fact[2].skipConv) elif sameTree(fact[2], eq[1]): result = valueIsNil(fact[1].skipConv) - of mNot, mOr, mAnd: assert(false, "impliesIsNil") - else: discard + else: + result = impUnknown + of mNot, mOr, mAnd: + result = impUnknown + assert(false, "impliesIsNil") + else: result = impUnknown proc impliesGe(fact, x, c: PNode): TImplication = assert isLocation(x) @@ -582,32 +659,57 @@ proc impliesGe(fact, x, c: PNode): TImplication = # fact: x = 4; question x >= 56? --> true iff 4 >= 56 if leValue(c, fact[2]): result = impYes else: result = impNo + else: + result = impUnknown elif sameTree(fact[2], x): if isValue(fact[1]) and isValue(c): if leValue(c, fact[1]): result = impYes else: result = impNo + else: + result = impUnknown + else: + result = impUnknown of someLt: if sameTree(fact[1], x): if isValue(fact[2]) and isValue(c): # fact: x < 4; question N <= x? --> false iff N <= 4 if leValue(fact[2], c): result = impNo + else: result = impUnknown # fact: x < 4; question 2 <= x? --> we don't know + else: + result = impUnknown elif sameTree(fact[2], x): # fact: 3 < x; question: N-1 < x ? --> true iff N-1 <= 3 if isValue(fact[1]) and isValue(c): if leValue(c.pred, fact[1]): result = impYes + else: result = impUnknown + else: + result = impUnknown + else: + result = impUnknown of someLe: if sameTree(fact[1], x): if isValue(fact[2]) and isValue(c): # fact: x <= 4; question x >= 56? --> false iff 4 <= 56 if leValue(fact[2], c): result = impNo # fact: x <= 4; question x >= 2? --> we don't know + else: + result = impUnknown + else: + result = impUnknown elif sameTree(fact[2], x): # fact: 3 <= x; question: x >= 2 ? --> true iff 2 <= 3 if isValue(fact[1]) and isValue(c): if leValue(c, fact[1]): result = impYes - of mNot, mOr, mAnd: assert(false, "impliesGe") - else: discard + else: result = impUnknown + else: + result = impUnknown + else: + result = impUnknown + of mNot, mOr, mAnd: + result = impUnknown + assert(false, "impliesGe") + else: result = impUnknown proc impliesLe(fact, x, c: PNode): TImplication = if not isLocation(x): @@ -622,35 +724,59 @@ proc impliesLe(fact, x, c: PNode): TImplication = # fact: x = 4; question x <= 56? --> true iff 4 <= 56 if leValue(fact[2], c): result = impYes else: result = impNo + else: + result = impUnknown elif sameTree(fact[2], x): if isValue(fact[1]) and isValue(c): if leValue(fact[1], c): result = impYes else: result = impNo + else: + result = impUnknown + else: + result = impUnknown of someLt: if sameTree(fact[1], x): if isValue(fact[2]) and isValue(c): # fact: x < 4; question x <= N? --> true iff N-1 <= 4 if leValue(fact[2], c.pred): result = impYes + else: + result = impUnknown # fact: x < 4; question x <= 2? --> we don't know + else: + result = impUnknown elif sameTree(fact[2], x): # fact: 3 < x; question: x <= 1 ? --> false iff 1 <= 3 if isValue(fact[1]) and isValue(c): if leValue(c, fact[1]): result = impNo - + else: result = impUnknown + else: + result = impUnknown + else: + result = impUnknown of someLe: if sameTree(fact[1], x): if isValue(fact[2]) and isValue(c): # fact: x <= 4; question x <= 56? --> true iff 4 <= 56 if leValue(fact[2], c): result = impYes + else: result = impUnknown # fact: x <= 4; question x <= 2? --> we don't know + else: + result = impUnknown elif sameTree(fact[2], x): # fact: 3 <= x; question: x <= 2 ? --> false iff 2 < 3 if isValue(fact[1]) and isValue(c): if leValue(c, fact[1].pred): result = impNo + else:result = impUnknown + else: + result = impUnknown + else: + result = impUnknown - of mNot, mOr, mAnd: assert(false, "impliesLe") - else: discard + of mNot, mOr, mAnd: + result = impUnknown + assert(false, "impliesLe") + else: result = impUnknown proc impliesLt(fact, x, c: PNode): TImplication = # x < 3 same as x <= 2: @@ -662,6 +788,8 @@ proc impliesLt(fact, x, c: PNode): TImplication = let q = x.pred if q != x: result = impliesLe(fact, q, c) + else: + result = impUnknown proc `~`(x: TImplication): TImplication = case x @@ -713,6 +841,7 @@ proc factImplies(fact, prop: PNode): TImplication = proc doesImply*(facts: TModel, prop: PNode): TImplication = assert prop.kind in nkCallKinds + result = impUnknown for f in facts.s: # facts can be invalidated, in which case they are 'nil': if not f.isNil: @@ -741,7 +870,7 @@ template isSub(x): untyped = x.getMagic in someSub template isVal(x): untyped = x.kind in {nkCharLit..nkUInt64Lit} template isIntVal(x, y): untyped = x.intVal == y -import macros +import std/macros macro `=~`(x: PNode, pat: untyped): bool = proc m(x, pat, conds: NimNode) = @@ -888,6 +1017,7 @@ proc applyReplacements(n: PNode; rep: TReplacements): PNode = proc pleViaModelRec(m: var TModel; a, b: PNode): TImplication = # now check for inferrable facts: a <= b and b <= c implies a <= c + result = impUnknown for i in 0..m.s.high: let fact = m.s[i] if fact != nil and fact.getMagic in someLe: @@ -933,7 +1063,7 @@ proc pleViaModel(model: TModel; aa, bb: PNode): TImplication = let b = fact[2] if a.kind == nkSym: replacements.add((a,b)) else: replacements.add((b,a)) - var m: TModel + var m = TModel() var a = aa var b = bb if replacements.len > 0: @@ -968,8 +1098,8 @@ proc addFactLt*(m: var TModel; a, b: PNode) = addFactLe(m, a, bb) proc settype(n: PNode): PType = - result = newType(tySet, ItemId(module: -1, item: -1), n.typ.owner) - var idgen: IdGenerator + var idgen = idGeneratorForPackage(-1'i32) + result = newType(tySet, idgen, n.typ.owner) addSonSkipIntLit(result, n.typ, idgen) proc buildOf(it, loc: PNode; o: Operators): PNode = @@ -1045,8 +1175,12 @@ proc buildProperFieldCheck(access, check: PNode; o: Operators): PNode = assert check.getMagic == mNot result = buildProperFieldCheck(access, check[1], o).neg(o) -proc checkFieldAccess*(m: TModel, n: PNode; conf: ConfigRef) = +proc checkFieldAccess*(m: TModel, n: PNode; conf: ConfigRef; produceError: bool) = for i in 1..<n.len: let check = buildProperFieldCheck(n[0], n[i], m.g.operators) if check != nil and m.doesImply(check) != impYes: - message(conf, n.info, warnProveField, renderTree(n[0])); break + if produceError: + localError(conf, n.info, "field access outside of valid case branch: " & renderTree(n[0])) + else: + message(conf, n.info, warnProveField, renderTree(n[0])) + break diff --git a/compiler/hlo.nim b/compiler/hlo.nim index af54cabbb..9fdec38c0 100644 --- a/compiler/hlo.nim +++ b/compiler/hlo.nim @@ -8,6 +8,7 @@ # # This include implements the high level optimization pass. +# included from sem.nim proc hlo(c: PContext, n: PNode): PNode @@ -16,9 +17,11 @@ proc evalPattern(c: PContext, n, orig: PNode): PNode = # we need to ensure that the resulting AST is semchecked. However, it's # awful to semcheck before macro invocation, so we don't and treat # templates and macros as immediate in this context. - var rule: string - if c.config.hasHint(hintPattern): - rule = renderTree(n, {renderNoComments}) + var rule: string = + if c.config.hasHint(hintPattern): + renderTree(n, {renderNoComments}) + else: + "" let s = n[0].sym case s.kind of skMacro: @@ -67,9 +70,9 @@ proc hlo(c: PContext, n: PNode): PNode = # already processed (special cases in semstmts.nim) result = n else: - if n.kind in {nkFastAsgn, nkAsgn, nkIdentDefs, nkVarTuple} and + if n.kind in {nkFastAsgn, nkAsgn, nkSinkAsgn, nkIdentDefs, nkVarTuple} and n[0].kind == nkSym and - {sfGlobal, sfPure} * n[0].sym.flags == {sfGlobal, sfPure}: + {sfGlobal, sfPure} <= n[0].sym.flags: # do not optimize 'var g {.global} = re(...)' again! return n result = applyPatterns(c, n) diff --git a/compiler/ic/bitabs.nim b/compiler/ic/bitabs.nim index 1f75b7759..0c9994c83 100644 --- a/compiler/ic/bitabs.nim +++ b/compiler/ic/bitabs.nim @@ -1,7 +1,11 @@ ## A BiTable is a table that can be seen as an optimized pair -## of (Table[LitId, Val], Table[Val, LitId]). +## of `(Table[LitId, Val], Table[Val, LitId])`. -import hashes, rodfiles +import std/hashes +import rodfiles + +when defined(nimPreviewSlimSystem): + import std/assertions type LitId* = distinct uint32 @@ -10,6 +14,8 @@ type vals: seq[T] # indexed by LitId keys: seq[LitId] # indexed by hash(val) +proc initBiTable*[T](): BiTable[T] = BiTable[T](vals: @[], keys: @[]) + proc nextTry(h, maxHash: Hash): Hash {.inline.} = result = (h + 1) and maxHash @@ -30,12 +36,14 @@ proc mustRehash(length, counter: int): bool {.inline.} = result = (length * 2 < counter * 3) or (length - counter < 4) const - idStart = 256 ## - ## Ids do not start with 0 but with this value. The IR needs it. - ## TODO: explain why + idStart = 1 template idToIdx(x: LitId): int = x.int - idStart +proc hasLitId*[T](t: BiTable[T]; x: LitId): bool = + let idx = idToIdx(x) + result = idx >= 0 and idx < t.vals.len + proc enlarge[T](t: var BiTable[T]) = var n: seq[LitId] newSeq(n, len(t.keys) * 2) @@ -86,13 +94,13 @@ proc getOrIncl*[T](t: var BiTable[T]; v: T): LitId = t.vals.add v -proc `[]`*[T](t: var BiTable[T]; LitId: LitId): var T {.inline.} = - let idx = idToIdx LitId +proc `[]`*[T](t: var BiTable[T]; litId: LitId): var T {.inline.} = + let idx = idToIdx litId assert idx < t.vals.len result = t.vals[idx] -proc `[]`*[T](t: BiTable[T]; LitId: LitId): lent T {.inline.} = - let idx = idToIdx LitId +proc `[]`*[T](t: BiTable[T]; litId: LitId): lent T {.inline.} = + let idx = idToIdx litId assert idx < t.vals.len result = t.vals[idx] @@ -111,6 +119,12 @@ proc load*[T](f: var RodFile; t: var BiTable[T]) = loadSeq(f, t.vals) loadSeq(f, t.keys) +proc sizeOnDisc*(t: BiTable[string]): int = + result = 4 + for x in t.vals: + result += x.len + 4 + result += t.keys.len * sizeof(LitId) + when isMainModule: var t: BiTable[string] diff --git a/compiler/ic/cbackend.nim b/compiler/ic/cbackend.nim index 34ee59d52..83f1b4cc7 100644 --- a/compiler/ic/cbackend.nim +++ b/compiler/ic/cbackend.nim @@ -19,9 +19,12 @@ ## anymore. DCE is now done as prepass over the entire packed module graph. import std/[packedsets, algorithm, tables] - # std/intsets would give `UnusedImport`, pending https://github.com/nim-lang/Nim/issues/14246 + +when defined(nimPreviewSlimSystem): + import std/assertions + import ".."/[ast, options, lineinfos, modulegraphs, cgendata, cgen, - pathutils, extccomp, msgs] + pathutils, extccomp, msgs, modulepaths] import packed_ast, ic, dce, rodfiles @@ -30,12 +33,16 @@ proc unpackTree(g: ModuleGraph; thisModule: int; var decoder = initPackedDecoder(g.config, g.cache) result = loadNodes(decoder, g.packed, thisModule, tree, n) -proc generateCodeForModule(g: ModuleGraph; m: var LoadedModule; alive: var AliveSyms) = +proc setupBackendModule(g: ModuleGraph; m: var LoadedModule) = if g.backend == nil: g.backend = cgendata.newModuleList(g) - + assert g.backend != nil var bmod = cgen.newModule(BModuleList(g.backend), m.module, g.config) bmod.idgen = idgenFromLoadedModule(m) + +proc generateCodeForModule(g: ModuleGraph; m: var LoadedModule; alive: var AliveSyms) = + var bmod = BModuleList(g.backend).modules[m.module.position] + assert bmod != nil bmod.flags.incl useAliveDataFromDce bmod.alive = move alive[m.module.position] @@ -44,9 +51,13 @@ proc generateCodeForModule(g: ModuleGraph; m: var LoadedModule; alive: var Alive cgen.genTopLevelStmt(bmod, n) finalCodegenActions(g, bmod, newNodeI(nkStmtList, m.module.info)) + for disp in getDispatchers(g): + genProcAux(bmod, disp) + m.fromDisk.backendFlags = cgen.whichInitProcs(bmod) proc replayTypeInfo(g: ModuleGraph; m: var LoadedModule; origin: FileIndex) = for x in mitems(m.fromDisk.emittedTypeInfo): + #echo "found type ", x, " for file ", int(origin) g.emittedTypeInfo[x] = origin proc addFileToLink(config: ConfigRef; m: PSym) = @@ -55,7 +66,8 @@ proc addFileToLink(config: ConfigRef; m: PSym) = if config.backend == backendCpp: ".nim.cpp" elif config.backend == backendObjc: ".nim.m" else: ".nim.c" - let cfile = changeFileExt(completeCfilePath(config, withPackageName(config, filename)), ext) + let cfile = changeFileExt(completeCfilePath(config, + mangleModuleName(config, filename).AbsoluteFile), ext) let objFile = completeCfilePath(config, toObjFile(config, cfile)) if fileExists(objFile): var cf = Cfile(nimname: m.name.s, cname: cfile, @@ -64,7 +76,7 @@ proc addFileToLink(config: ConfigRef; m: PSym) = addFileToCompile(config, cf) when defined(debugDce): - import std / [os, packedsets] + import os, std/packedsets proc storeAliveSymsImpl(asymFile: AbsoluteFile; s: seq[int32]) = var f = rodfiles.create(asymFile.string) @@ -88,7 +100,7 @@ proc aliveSymsChanged(config: ConfigRef; position: int; alive: AliveSyms): bool var f2 = rodfiles.open(asymFile.string) f2.loadHeader() f2.loadSection aliveSymsSection - var oldData: seq[int32] + var oldData: seq[int32] = @[] f2.loadSeq(oldData) f2.close if f2.err == ok and oldData == s: @@ -98,38 +110,71 @@ proc aliveSymsChanged(config: ConfigRef; position: int; alive: AliveSyms): bool let oldAsSet = toPackedSet[int32](oldData) let newAsSet = toPackedSet[int32](s) echo "set of live symbols changed ", asymFile.changeFileExt("rod"), " ", position, " ", f2.err - echo "in old but not in new ", oldAsSet.difference(newAsSet) - echo "in new but not in old ", newAsSet.difference(oldAsSet) - - if execShellCmd(getAppFilename() & " rod " & quoteShell(asymFile.changeFileExt("rod"))) != 0: - echo "command failed" + echo "in old but not in new ", oldAsSet.difference(newAsSet), " number of entries in old ", oldAsSet.len + echo "in new but not in old ", newAsSet.difference(oldAsSet), " number of entries in new ", newAsSet.len + #if execShellCmd(getAppFilename() & " rod " & quoteShell(asymFile.changeFileExt("rod"))) != 0: + # echo "command failed" result = true storeAliveSymsImpl(asymFile, s) +proc genPackedModule(g: ModuleGraph, i: int; alive: var AliveSyms) = + # case statement here to enforce exhaustive checks. + case g.packed[i].status + of undefined: + discard "nothing to do" + of loading, stored: + assert false + of storing, outdated: + storeAliveSyms(g.config, g.packed[i].module.position, alive) + generateCodeForModule(g, g.packed[i], alive) + closeRodFile(g, g.packed[i].module) + of loaded: + if g.packed[i].loadedButAliveSetChanged: + generateCodeForModule(g, g.packed[i], alive) + else: + addFileToLink(g.config, g.packed[i].module) + replayTypeInfo(g, g.packed[i], FileIndex(i)) + + if g.backend == nil: + g.backend = cgendata.newModuleList(g) + registerInitProcs(BModuleList(g.backend), g.packed[i].module, g.packed[i].fromDisk.backendFlags) + proc generateCode*(g: ModuleGraph) = ## The single entry point, generate C(++) code for the entire ## Nim program aka `ModuleGraph`. resetForBackend(g) var alive = computeAliveSyms(g.packed, g.config) - for i in 0..high(g.packed): + when false: + for i in 0..<len(g.packed): + echo i, " is of status ", g.packed[i].status, " ", toFullPath(g.config, FileIndex(i)) + + # First pass: Setup all the backend modules for all the modules that have + # changed: + for i in 0..<len(g.packed): # case statement here to enforce exhaustive checks. case g.packed[i].status of undefined: discard "nothing to do" - of loading: + of loading, stored: assert false of storing, outdated: - generateCodeForModule(g, g.packed[i], alive) - closeRodFile(g, g.packed[i].module) - storeAliveSyms(g.config, g.packed[i].module.position, alive) + setupBackendModule(g, g.packed[i]) of loaded: # Even though this module didn't change, DCE might trigger a change. # Consider this case: Module A uses symbol S from B and B does not use # S itself. A is then edited not to use S either. Thus we have to # recompile B in order to remove S from the final result. if aliveSymsChanged(g.config, g.packed[i].module.position, alive): - generateCodeForModule(g, g.packed[i], alive) - else: - addFileToLink(g.config, g.packed[i].module) - replayTypeInfo(g, g.packed[i], FileIndex(i)) + g.packed[i].loadedButAliveSetChanged = true + setupBackendModule(g, g.packed[i]) + + # Second pass: Code generation. + let mainModuleIdx = g.config.projectMainIdx2.int + # We need to generate the main module last, because only then + # all init procs have been registered: + for i in 0..<len(g.packed): + if i != mainModuleIdx: + genPackedModule(g, i, alive) + if mainModuleIdx >= 0: + genPackedModule(g, mainModuleIdx, alive) diff --git a/compiler/ic/dce.nim b/compiler/ic/dce.nim index 0918fc379..6eb36431e 100644 --- a/compiler/ic/dce.nim +++ b/compiler/ic/dce.nim @@ -9,7 +9,11 @@ ## Dead code elimination (=DCE) for IC. -import std / [intsets, tables] +import std/[intsets, tables] + +when defined(nimPreviewSlimSystem): + import std/assertions + import ".." / [ast, options, lineinfos, types] import packed_ast, ic, bitabs @@ -27,7 +31,7 @@ type proc isExportedToC(c: var AliveContext; g: PackedModuleGraph; symId: int32): bool = ## "Exported to C" procs are special (these are marked with '.exportc') because these ## must not be optimized away! - let symPtr = addr g[c.thisModule].fromDisk.sh.syms[symId] + let symPtr = unsafeAddr g[c.thisModule].fromDisk.syms[symId] let flags = symPtr.flags # due to a bug/limitation in the lambda lifting, unused inner procs # are not transformed correctly; issue (#411). However, the whole purpose here @@ -36,10 +40,14 @@ proc isExportedToC(c: var AliveContext; g: PackedModuleGraph; symId: int32): boo if ({sfExportc, sfCompilerProc} * flags != {}) or (symPtr.kind == skMethod): result = true + else: + result = false # XXX: This used to be a condition to: # (sfExportc in prc.flags and lfExportLib in prc.loc.flags) or if sfCompilerProc in flags: - c.compilerProcs[g[c.thisModule].fromDisk.sh.strings[symPtr.name]] = (c.thisModule, symId) + c.compilerProcs[g[c.thisModule].fromDisk.strings[symPtr.name]] = (c.thisModule, symId) + else: + result = false template isNotGeneric(n: NodePos): bool = ithSon(tree, n, genericParamsPos).kind == nkEmpty @@ -47,17 +55,17 @@ proc followLater(c: var AliveContext; g: PackedModuleGraph; module: int; item: i ## Marks a symbol 'item' as used and later in 'followNow' the symbol's body will ## be analysed. if not c.alive[module].containsOrIncl(item): - var body = g[module].fromDisk.sh.syms[item].ast + var body = g[module].fromDisk.syms[item].ast if body != emptyNodeId: - let opt = g[module].fromDisk.sh.syms[item].options - if g[module].fromDisk.sh.syms[item].kind in routineKinds: + let opt = g[module].fromDisk.syms[item].options + if g[module].fromDisk.syms[item].kind in routineKinds: body = NodeId ithSon(g[module].fromDisk.bodies, NodePos body, bodyPos) c.stack.add((module, opt, NodePos(body))) when false: - let nid = g[module].fromDisk.sh.syms[item].name + let nid = g[module].fromDisk.syms[item].name if nid != LitId(0): - let name = g[module].fromDisk.sh.strings[nid] + let name = g[module].fromDisk.strings[nid] if name in ["nimFrame", "callDepthLimitReached"]: echo "I was called! ", name, " body exists: ", body != emptyNodeId, " ", module, " ", item @@ -66,12 +74,12 @@ proc requestCompilerProc(c: var AliveContext; g: PackedModuleGraph; name: string followLater(c, g, module, item) proc loadTypeKind(t: PackedItemId; c: AliveContext; g: PackedModuleGraph; toSkip: set[TTypeKind]): TTypeKind = - template kind(t: ItemId): TTypeKind = g[t.module].fromDisk.sh.types[t.item].kind + template kind(t: ItemId): TTypeKind = g[t.module].fromDisk.types[t.item].kind var t2 = translateId(t, g, c.thisModule, c.decoder.config) result = t2.kind while result in toSkip: - t2 = translateId(g[t2.module].fromDisk.sh.types[t2.item].types[^1], g, t2.module, c.decoder.config) + t2 = translateId(g[t2.module].fromDisk.types[t2.item].types[^1], g, t2.module, c.decoder.config) result = t2.kind proc rangeCheckAnalysis(c: var AliveContext; g: PackedModuleGraph; tree: PackedTree; n: NodePos) = @@ -101,13 +109,13 @@ proc aliveCode(c: var AliveContext; g: PackedModuleGraph; tree: PackedTree; n: N discard "ignore non-sym atoms" of nkSym: # This symbol is alive and everything its body references. - followLater(c, g, c.thisModule, n.operand) + followLater(c, g, c.thisModule, tree[n].soperand) of nkModuleRef: let (n1, n2) = sons2(tree, n) - assert n1.kind == nkInt32Lit - assert n2.kind == nkInt32Lit + assert n1.kind == nkNone + assert n2.kind == nkNone let m = n1.litId - let item = n2.operand + let item = tree[n2].soperand let otherModule = toFileIndexCached(c.decoder, g, c.thisModule, m).int followLater(c, g, otherModule, item) of nkMacroDef, nkTemplateDef, nkTypeSection, nkTypeOfExpr, @@ -123,7 +131,7 @@ proc aliveCode(c: var AliveContext; g: PackedModuleGraph; tree: PackedTree; n: N rangeCheckAnalysis(c, g, tree, n) of nkProcDef, nkConverterDef, nkMethodDef, nkFuncDef, nkIteratorDef: if n.firstSon.kind == nkSym and isNotGeneric(n): - let item = n.firstSon.operand + let item = tree[n.firstSon].soperand if isExportedToC(c, g, item): # This symbol is alive and everything its body references. followLater(c, g, c.thisModule, item) @@ -145,7 +153,7 @@ proc computeAliveSyms*(g: PackedModuleGraph; conf: ConfigRef): AliveSyms = var c = AliveContext(stack: @[], decoder: PackedDecoder(config: conf), thisModule: -1, alive: newSeq[IntSet](g.len), options: conf.options) - for i in countdown(high(g), 0): + for i in countdown(len(g)-1, 0): if g[i].status != undefined: c.thisModule = i for p in allNodes(g[i].fromDisk.topLevel): diff --git a/compiler/ic/design.rst b/compiler/ic/design.rst index d8e1315b1..b096e3103 100644 --- a/compiler/ic/design.rst +++ b/compiler/ic/design.rst @@ -7,12 +7,8 @@ The frontend produces a set of `.rod` files. Every `.nim` module produces its own `.rod` file. - The IR must be a faithful representation of the AST in memory. -- The backend can do its own caching but doesn't have to. -- We know by comparing 'nim check compiler/nim' against 'nim c compiler/nim' - that 2/3 of the compiler's runtime is spent in the frontend. Hence we - implement IC for the frontend first and only later for the backend. The - backend will recompile everything until we implement its own caching - mechanisms. +- The backend can do its own caching but doesn't have to. In the + current implementation the backend also caches its results. Advantage of the "set of files" vs the previous global database: - By construction, we either read from the `.rod` file or from the diff --git a/compiler/ic/ic.nim b/compiler/ic/ic.nim index 230b4d087..8e81633ef 100644 --- a/compiler/ic/ic.nim +++ b/compiler/ic/ic.nim @@ -7,12 +7,19 @@ # distribution, for details about the copyright. # -import std / [hashes, tables, intsets, sha1] +import std/[hashes, tables, intsets, monotimes] import packed_ast, bitabs, rodfiles import ".." / [ast, idents, lineinfos, msgs, ropes, options, - pathutils, condsyms] + pathutils, condsyms, packages, modulepaths] #import ".." / [renderer, astalgo] -from std / os import removeFile, isAbsolute +from std/os import removeFile, isAbsolute + +import ../../dist/checksums/src/checksums/sha1 + +import iclineinfos + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions, formatfloat] type PackedConfig* = object @@ -22,29 +29,43 @@ type options: TOptions globalOptions: TGlobalOptions + ModuleBackendFlag* = enum + HasDatInitProc + HasModuleInitProc + PackedModule* = object ## the parts of a PackedEncoder that are part of the .rod file definedSymbols: string - includes: seq[(LitId, string)] # first entry is the module filename itself + 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. + 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)] - reexports*: seq[(LitId, PackedItemId)] + hidden: seq[(LitId, int32)] + reexports: seq[(LitId, PackedItemId)] compilerProcs*: seq[(LitId, int32)] converters*, methods*, trmacros*, pureEnums*: seq[int32] - macroUsages*: seq[(PackedItemId, PackedLineInfo)] typeInstCache*: seq[(PackedItemId, PackedItemId)] procInstCache*: seq[PackedInstantiation] - attachedOps*: seq[(TTypeAttachedOp, PackedItemId, PackedItemId)] - methodsPerType*: seq[(PackedItemId, int, PackedItemId)] + attachedOps*: seq[(PackedItemId, TTypeAttachedOp, PackedItemId)] + methodsPerGenericType*: seq[(PackedItemId, int, PackedItemId)] enumToStringProcs*: seq[(PackedItemId, PackedItemId)] + methodsPerType*: seq[(PackedItemId, PackedItemId)] + dispatchers*: seq[PackedItemId] emittedTypeInfo*: seq[string] + backendFlags*: set[ModuleBackendFlag] + + syms*: OrderedTable[int32, PackedSym] + types*: OrderedTable[int32, PackedType] + strings*: BiTable[string] # we could share these between modules. + numbers*: BiTable[BiggestInt] # we also store floats in here so + # that we can assure that every bit is kept + man*: LineInfoManager - sh*: Shared cfg: PackedConfig PackedEncoder* = object @@ -59,6 +80,49 @@ type symMarker*: IntSet #Table[ItemId, SymId] # ItemId.item -> SymId config*: ConfigRef +proc toString*(tree: PackedTree; pos: NodePos; m: PackedModule; nesting: int; + result: var string) = + if result.len > 0 and result[^1] notin {' ', '\n'}: + result.add ' ' + + result.add $tree[pos].kind + case tree[pos].kind + of nkEmpty, nkNilLit, nkType: discard + of nkIdent, nkStrLit..nkTripleStrLit: + result.add " " + result.add m.strings[LitId tree[pos].uoperand] + of nkSym: + result.add " " + result.add m.strings[m.syms[tree[pos].soperand].name] + of directIntLit: + result.add " " + result.addInt tree[pos].soperand + of externSIntLit: + result.add " " + result.addInt m.numbers[LitId tree[pos].uoperand] + of externUIntLit: + result.add " " + result.addInt cast[uint64](m.numbers[LitId tree[pos].uoperand]) + of nkFloatLit..nkFloat128Lit: + result.add " " + result.addFloat cast[BiggestFloat](m.numbers[LitId tree[pos].uoperand]) + else: + result.add "(\n" + for i in 1..(nesting+1)*2: result.add ' ' + for child in sonsReadonly(tree, pos): + toString(tree, child, m, nesting + 1, result) + result.add "\n" + for i in 1..nesting*2: result.add ' ' + result.add ")" + #for i in 1..nesting*2: result.add ' ' + +proc toString*(tree: PackedTree; n: NodePos; m: PackedModule): string = + result = "" + toString(tree, n, m, 0, result) + +proc debug*(tree: PackedTree; m: PackedModule) = + stdout.write toString(tree, NodePos 0, m) + proc isActive*(e: PackedEncoder): bool = e.config != nil proc disable(e: var PackedEncoder) = e.config = nil @@ -83,14 +147,27 @@ proc rememberConfig(c: var PackedEncoder; m: var PackedModule; config: ConfigRef #primConfigFields rem m.cfg = pc +const + debugConfigDiff = defined(debugConfigDiff) + +when debugConfigDiff: + import hashes, tables, intsets, sha1, strutils, sets + proc configIdentical(m: PackedModule; config: ConfigRef): bool = result = m.definedSymbols == definedSymbolsAsString(config) - #if not result: - # echo "A ", m.definedSymbols, " ", definedSymbolsAsString(config) + when debugConfigDiff: + if not result: + var wordsA = m.definedSymbols.split(Whitespace).toHashSet() + var wordsB = definedSymbolsAsString(config).split(Whitespace).toHashSet() + for c in wordsA - wordsB: + echo "in A but not in B ", c + for c in wordsB - wordsA: + echo "in B but not in A ", c template eq(x) = result = result and m.cfg.x == config.x - #if not result: - # echo "B ", m.cfg.x, " ", config.x + when debugConfigDiff: + if m.cfg.x != config.x: + echo "B ", m.cfg.x, " ", config.x primConfigFields eq proc rememberStartupConfig*(dest: var PackedConfig, config: ConfigRef) = @@ -114,14 +191,14 @@ proc toLitId(x: FileIndex; c: var PackedEncoder; m: var PackedModule): LitId = result = c.filenames.getOrDefault(x) if result == LitId(0): let p = msgs.toFullPath(c.config, x) - result = getOrIncl(m.sh.strings, p) + result = getOrIncl(m.strings, p) c.filenames[x] = result c.lastFile = x c.lastLit = result - assert result != LitId(0) + assert result != LitId(0) proc toFileIndex*(x: LitId; m: PackedModule; config: ConfigRef): FileIndex = - result = msgs.fileInfoIdx(config, AbsoluteFile m.sh.strings[x]) + result = msgs.fileInfoIdx(config, AbsoluteFile m.strings[x]) proc includesIdentical(m: var PackedModule; config: ConfigRef): bool = for it in mitems(m.includes): @@ -131,12 +208,14 @@ proc includesIdentical(m: var PackedModule; config: ConfigRef): bool = proc initEncoder*(c: var PackedEncoder; m: var PackedModule; moduleSym: PSym; config: ConfigRef; pc: PackedConfig) = ## setup a context for serializing to packed ast - m.sh = Shared() c.thisModule = moduleSym.itemId.module c.config = config + m.moduleFlags = moduleSym.flags m.bodies = newTreeFrom(m.topLevel) m.toReplay = newTreeFrom(m.topLevel) + c.lastFile = FileIndex(-10) + let thisNimFile = FileIndex c.thisModule var h = msgs.getHash(config, thisNimFile) if h.len == 0: @@ -155,11 +234,20 @@ proc addIncludeFileDep*(c: var PackedEncoder; m: var PackedModule; f: FileIndex) proc addImportFileDep*(c: var PackedEncoder; m: var PackedModule; f: FileIndex) = m.imports.add toLitId(f, c, m) +proc addHidden*(c: var PackedEncoder; m: var PackedModule; s: PSym) = + assert s.kind != skUnknown + let nameId = getOrIncl(m.strings, s.name.s) + m.hidden.add((nameId, s.itemId.item)) + assert s.itemId.module == c.thisModule + proc addExported*(c: var PackedEncoder; m: var PackedModule; s: PSym) = - let nameId = getOrIncl(m.sh.strings, s.name.s) + assert s.kind != skUnknown + assert s.itemId.module == c.thisModule + let nameId = getOrIncl(m.strings, s.name.s) m.exports.add((nameId, s.itemId.item)) proc addConverter*(c: var PackedEncoder; m: var PackedModule; s: PSym) = + assert c.thisModule == s.itemId.module m.converters.add(s.itemId.item) proc addTrmacro*(c: var PackedEncoder; m: var PackedModule; s: PSym) = @@ -173,12 +261,14 @@ proc addMethod*(c: var PackedEncoder; m: var PackedModule; s: PSym) = m.methods.add s.itemId.item proc addReexport*(c: var PackedEncoder; m: var PackedModule; s: PSym) = - let nameId = getOrIncl(m.sh.strings, s.name.s) + assert s.kind != skUnknown + if s.kind == skModule: return + let nameId = getOrIncl(m.strings, s.name.s) m.reexports.add((nameId, PackedItemId(module: toLitId(s.itemId.module.FileIndex, c, m), item: s.itemId.item))) proc addCompilerProc*(c: var PackedEncoder; m: var PackedModule; s: PSym) = - let nameId = getOrIncl(m.sh.strings, s.name.s) + let nameId = getOrIncl(m.strings, s.name.s) m.compilerProcs.add((nameId, s.itemId.item)) proc toPackedNode*(n: PNode; ir: var PackedTree; c: var PackedEncoder; m: var PackedModule) @@ -197,14 +287,15 @@ proc flush(c: var PackedEncoder; m: var PackedModule) = proc toLitId(x: string; m: var PackedModule): LitId = ## store a string as a literal - result = getOrIncl(m.sh.strings, x) + result = getOrIncl(m.strings, x) proc toLitId(x: BiggestInt; m: var PackedModule): LitId = ## store an integer as a literal - result = getOrIncl(m.sh.integers, x) + result = getOrIncl(m.numbers, x) proc toPackedInfo(x: TLineInfo; c: var PackedEncoder; m: var PackedModule): PackedLineInfo = - PackedLineInfo(line: x.line, col: x.col, file: toLitId(x.fileIndex, c, m)) + pack(m.man, toLitId(x.fileIndex, c, m), x.line.int32, x.col.int32) + #PackedLineInfo(line: x.line, col: x.col, file: toLitId(x.fileIndex, c, m)) proc safeItemId(s: PSym; c: var PackedEncoder; m: var PackedModule): PackedItemId {.inline.} = ## given a symbol, produce an ItemId with the correct properties @@ -246,81 +337,55 @@ proc storeTypeLater(t: PType; c: var PackedEncoder; m: var PackedModule): Packed # we only write one tree into m.bodies after the other. if t.isNil: return nilItemId - if t.uniqueId.module != c.thisModule: - # XXX Assert here that it already was serialized in the foreign module! - # it is a foreign type: - assert t.uniqueId.module >= 0 - assert t.uniqueId.item > 0 - return PackedItemId(module: toLitId(t.uniqueId.module.FileIndex, c, m), item: t.uniqueId.item) - assert t.itemId.module >= 0 + assert t.uniqueId.module >= 0 assert t.uniqueId.item > 0 - result = PackedItemId(module: toLitId(t.itemId.module.FileIndex, c, m), item: t.uniqueId.item) - addMissing(c, t) + result = PackedItemId(module: toLitId(t.uniqueId.module.FileIndex, c, m), item: t.uniqueId.item) + if t.uniqueId.module == c.thisModule: + # the type belongs to this module, so serialize it here, eventually. + addMissing(c, t) proc storeSymLater(s: PSym; c: var PackedEncoder; m: var PackedModule): PackedItemId = if s.isNil: return nilItemId assert s.itemId.module >= 0 - if s.itemId.module != c.thisModule: - # XXX Assert here that it already was serialized in the foreign module! - # it is a foreign symbol: - assert s.itemId.module >= 0 - return PackedItemId(module: toLitId(s.itemId.module.FileIndex, c, m), item: s.itemId.item) - assert s.itemId.module >= 0 + assert s.itemId.item >= 0 result = PackedItemId(module: toLitId(s.itemId.module.FileIndex, c, m), item: s.itemId.item) - addMissing(c, s) + if s.itemId.module == c.thisModule: + # the sym belongs to this module, so serialize it here, eventually. + addMissing(c, s) proc storeType(t: PType; c: var PackedEncoder; m: var PackedModule): PackedItemId = ## serialize a ptype if t.isNil: return nilItemId - if t.uniqueId.module != c.thisModule: - # XXX Assert here that it already was serialized in the foreign module! - # it is a foreign type: - assert t.uniqueId.module >= 0 - assert t.uniqueId.item > 0 - return PackedItemId(module: toLitId(t.uniqueId.module.FileIndex, c, m), item: t.uniqueId.item) + assert t.uniqueId.module >= 0 + assert t.uniqueId.item > 0 + result = PackedItemId(module: toLitId(t.uniqueId.module.FileIndex, c, m), item: t.uniqueId.item) - if not c.typeMarker.containsOrIncl(t.uniqueId.item): - if t.uniqueId.item >= m.sh.types.len: - setLen m.sh.types, t.uniqueId.item+1 + if t.uniqueId.module == c.thisModule and not c.typeMarker.containsOrIncl(t.uniqueId.item): + #if t.uniqueId.item >= m.types.len: + # setLen m.types, t.uniqueId.item+1 - var p = PackedType(kind: t.kind, flags: t.flags, callConv: t.callConv, + var p = PackedType(id: t.uniqueId.item, kind: t.kind, flags: t.flags, callConv: t.callConv, size: t.size, align: t.align, nonUniqueId: t.itemId.item, - paddingAtEnd: t.paddingAtEnd, lockLevel: t.lockLevel) + paddingAtEnd: t.paddingAtEnd) storeNode(p, t, n) - - when false: - for op, s in pairs t.attachedOps: - c.addMissing s - p.attachedOps[op] = s.safeItemId(c, m) - p.typeInst = t.typeInst.storeType(c, m) - for kid in items t.sons: + for kid in kids t: p.types.add kid.storeType(c, m) - - when false: - for i, s in items t.methods: - c.addMissing s - p.methods.add (i, s.safeItemId(c, m)) c.addMissing t.sym p.sym = t.sym.safeItemId(c, m) c.addMissing t.owner p.owner = t.owner.safeItemId(c, m) # fill the reserved slot, nothing else: - m.sh.types[t.uniqueId.item] = p - - assert t.itemId.module >= 0 - assert t.uniqueId.item > 0 - result = PackedItemId(module: toLitId(t.itemId.module.FileIndex, c, m), item: t.uniqueId.item) + m.types[t.uniqueId.item] = p proc toPackedLib(l: PLib; c: var PackedEncoder; m: var PackedModule): PackedLib = ## the plib hangs off the psym via the .annex field if l.isNil: return - result.kind = l.kind - result.generated = l.generated - result.isOverriden = l.isOverriden - result.name = toLitId($l.name, m) + result = PackedLib(kind: l.kind, generated: l.generated, + isOverridden: l.isOverridden, name: toLitId($l.name, m) + ) storeNode(result, l, path) proc storeSym*(s: PSym; c: var PackedEncoder; m: var PackedModule): PackedItemId = @@ -328,21 +393,16 @@ proc storeSym*(s: PSym; c: var PackedEncoder; m: var PackedModule): PackedItemId if s.isNil: return nilItemId assert s.itemId.module >= 0 + result = PackedItemId(module: toLitId(s.itemId.module.FileIndex, c, m), item: s.itemId.item) - if s.itemId.module != c.thisModule: - # XXX Assert here that it already was serialized in the foreign module! - # it is a foreign symbol: - assert s.itemId.module >= 0 - return PackedItemId(module: toLitId(s.itemId.module.FileIndex, c, m), item: s.itemId.item) - - if not c.symMarker.containsOrIncl(s.itemId.item): - if s.itemId.item >= m.sh.syms.len: - setLen m.sh.syms, s.itemId.item+1 + if s.itemId.module == c.thisModule and not c.symMarker.containsOrIncl(s.itemId.item): + #if s.itemId.item >= m.syms.len: + # setLen m.syms, s.itemId.item+1 assert sfForward notin s.flags - var p = PackedSym(kind: s.kind, flags: s.flags, info: s.info.toPackedInfo(c, m), magic: s.magic, - position: s.position, offset: s.offset, options: s.options, + var p = PackedSym(id: s.itemId.item, kind: s.kind, flags: s.flags, info: s.info.toPackedInfo(c, m), magic: s.magic, + position: s.position, offset: s.offset, disamb: s.disamb, options: s.options, name: s.name.s.toLitId(m)) storeNode(p, s, ast) @@ -354,7 +414,7 @@ proc storeSym*(s: PSym; c: var PackedEncoder; m: var PackedModule): PackedItemId p.bitsize = s.bitsize p.alignment = s.alignment - p.externalName = toLitId(if s.loc.r.isNil: "" else: $s.loc.r, m) + p.externalName = toLitId(s.loc.snippet, m) p.locFlags = s.loc.flags c.addMissing s.typ p.typ = s.typ.storeType(c, m) @@ -363,63 +423,67 @@ proc storeSym*(s: PSym; c: var PackedEncoder; m: var PackedModule): PackedItemId p.annex = toPackedLib(s.annex, c, m) when hasFFI: p.cname = toLitId(s.cname, m) + p.instantiatedFrom = s.instantiatedFrom.safeItemId(c, m) # fill the reserved slot, nothing else: - m.sh.syms[s.itemId.item] = p - - assert s.itemId.module >= 0 - result = PackedItemId(module: toLitId(s.itemId.module.FileIndex, c, m), item: s.itemId.item) + m.syms[s.itemId.item] = p proc addModuleRef(n: PNode; ir: var PackedTree; c: var PackedEncoder; m: var PackedModule) = ## add a remote symbol reference to the tree let info = n.info.toPackedInfo(c, m) - ir.nodes.add PackedNode(kind: nkModuleRef, operand: 3.int32, # spans 3 nodes in total - typeId: storeTypeLater(n.typ, c, m), info: info) - ir.nodes.add PackedNode(kind: nkInt32Lit, info: info, - operand: toLitId(n.sym.itemId.module.FileIndex, c, m).int32) - ir.nodes.add PackedNode(kind: nkInt32Lit, info: info, - operand: n.sym.itemId.item) + if n.typ != n.sym.typ: + ir.addNode(kind = nkModuleRef, operand = 3.int32, # spans 3 nodes in total + info = info, flags = n.flags, + typeId = storeTypeLater(n.typ, c, m)) + else: + ir.addNode(kind = nkModuleRef, operand = 3.int32, # spans 3 nodes in total + info = info, flags = n.flags) + ir.addNode(kind = nkNone, info = info, + operand = toLitId(n.sym.itemId.module.FileIndex, c, m).int32) + ir.addNode(kind = nkNone, info = info, + operand = n.sym.itemId.item) proc toPackedNode*(n: PNode; ir: var PackedTree; c: var PackedEncoder; m: var PackedModule) = ## serialize a node into the tree if n == nil: - ir.nodes.add PackedNode(kind: nkNilRodNode, flags: {}, operand: 1) + ir.addNode(kind = nkNilRodNode, operand = 1, info = NoLineInfo) return let info = toPackedInfo(n.info, c, m) case n.kind of nkNone, nkEmpty, nkNilLit, nkType: - ir.nodes.add PackedNode(kind: n.kind, flags: n.flags, operand: 0, - typeId: storeTypeLater(n.typ, c, m), info: info) + ir.addNode(kind = n.kind, flags = n.flags, operand = 0, + typeId = storeTypeLater(n.typ, c, m), info = info) of nkIdent: - ir.nodes.add PackedNode(kind: n.kind, flags: n.flags, - operand: int32 getOrIncl(m.sh.strings, n.ident.s), - typeId: storeTypeLater(n.typ, c, m), info: info) + ir.addNode(kind = n.kind, flags = n.flags, + operand = int32 getOrIncl(m.strings, n.ident.s), + typeId = storeTypeLater(n.typ, c, m), info = info) of nkSym: if n.sym.itemId.module == c.thisModule: # it is a symbol that belongs to the module we're currently # packing: let id = n.sym.storeSymLater(c, m).item - ir.nodes.add PackedNode(kind: nkSym, flags: n.flags, operand: id, - typeId: storeTypeLater(n.typ, c, m), info: info) + if n.typ != n.sym.typ: + ir.addNode(kind = nkSym, flags = n.flags, operand = id, + info = info, + typeId = storeTypeLater(n.typ, c, m)) + else: + ir.addNode(kind = nkSym, flags = n.flags, operand = id, + info = info) else: # store it as an external module reference: addModuleRef(n, ir, c, m) - of directIntLit: - ir.nodes.add PackedNode(kind: n.kind, flags: n.flags, - operand: int32(n.intVal), - typeId: storeTypeLater(n.typ, c, m), info: info) of externIntLit: - ir.nodes.add PackedNode(kind: n.kind, flags: n.flags, - operand: int32 getOrIncl(m.sh.integers, n.intVal), - typeId: storeTypeLater(n.typ, c, m), info: info) + ir.addNode(kind = n.kind, flags = n.flags, + operand = int32 getOrIncl(m.numbers, n.intVal), + typeId = storeTypeLater(n.typ, c, m), info = info) of nkStrLit..nkTripleStrLit: - ir.nodes.add PackedNode(kind: n.kind, flags: n.flags, - operand: int32 getOrIncl(m.sh.strings, n.strVal), - typeId: storeTypeLater(n.typ, c, m), info: info) + ir.addNode(kind = n.kind, flags = n.flags, + operand = int32 getOrIncl(m.strings, n.strVal), + typeId = storeTypeLater(n.typ, c, m), info = info) of nkFloatLit..nkFloat128Lit: - ir.nodes.add PackedNode(kind: n.kind, flags: n.flags, - operand: int32 getOrIncl(m.sh.floats, n.floatVal), - typeId: storeTypeLater(n.typ, c, m), info: info) + ir.addNode(kind = n.kind, flags = n.flags, + operand = int32 getOrIncl(m.numbers, cast[BiggestInt](n.floatVal)), + typeId = storeTypeLater(n.typ, c, m), info = info) else: let patchPos = ir.prepare(n.kind, n.flags, storeTypeLater(n.typ, c, m), info) @@ -444,8 +508,8 @@ proc toPackedProcDef(n: PNode; ir: var PackedTree; c: var PackedEncoder; m: var # do not serialize the body of the proc, it's unnecessary since # n[0].sym.ast has the sem'checked variant of it which is what # everybody should use instead. - ir.nodes.add PackedNode(kind: nkEmpty, flags: {}, operand: 0, - typeId: nilItemId, info: info) + ir.addNode(kind = nkEmpty, flags = {}, operand = 0, + typeId = nilItemId, info = info) ir.patch patchPos proc toPackedNodeIgnoreProcDefs(n: PNode, encoder: var PackedEncoder; m: var PackedModule) = @@ -464,6 +528,9 @@ proc toPackedNodeIgnoreProcDefs(n: PNode, encoder: var PackedEncoder; m: var Pac of nkStmtList, nkStmtListExpr: for it in n: toPackedNodeIgnoreProcDefs(it, encoder, m) + of nkImportStmt, nkImportExceptStmt, nkExportStmt, nkExportExceptStmt, + nkFromStmt, nkIncludeStmt: + discard "nothing to do" else: toPackedNode(n, m.topLevel, encoder, m) @@ -480,6 +547,15 @@ proc toPackedGeneratedProcDef*(s: PSym, encoder: var PackedEncoder; m: var Packe toPackedProcDef(s.ast, m.topLevel, encoder, m) #flush encoder, m +proc storeAttachedProcDef*(t: PType; op: TTypeAttachedOp; s: PSym, + encoder: var PackedEncoder; m: var PackedModule) = + assert s.kind in routineKinds + assert isActive(encoder) + let tid = storeTypeLater(t, encoder, m) + let sid = storeSymLater(s, encoder, m) + m.attachedOps.add (tid, op, sid) + toPackedGeneratedProcDef(s, encoder, m) + proc storeInstantiation*(c: var PackedEncoder; m: var PackedModule; s: PSym; i: PInstantiation) = var t = newSeq[PackedItemId](i.concreteTypes.len) for j in 0..high(i.concreteTypes): @@ -489,6 +565,9 @@ proc storeInstantiation*(c: var PackedEncoder; m: var PackedModule; s: PSym; i: concreteTypes: t) toPackedGeneratedProcDef(i.sym, c, m) +proc storeExpansion*(c: var PackedEncoder; m: var PackedModule; info: TLineInfo; s: PSym) = + toPackedNode(newSymNode(s, info), m.bodies, c, m) + proc loadError(err: RodFileError; filename: AbsoluteFile; config: ConfigRef;) = case err of cannotOpen: @@ -496,16 +575,35 @@ proc loadError(err: RodFileError; filename: AbsoluteFile; config: ConfigRef;) = of includeFileChanged: rawMessage(config, warnFileChanged, filename.string) else: - echo "Error: ", $err, " loading file: ", filename.string + rawMessage(config, warnCannotOpenFile, filename.string & " reason: " & $err) + #echo "Error: ", $err, " loading file: ", filename.string + +proc toRodFile*(conf: ConfigRef; f: AbsoluteFile; ext = RodExt): AbsoluteFile = + result = changeFileExt(completeGeneratedFilePath(conf, + mangleModuleName(conf, f).AbsoluteFile), ext) + +const + BenchIC* = false + +when BenchIC: + var gloadBodies: MonoTime + + template bench(x, body) = + let start = getMonoTime() + body + x = x + (getMonoTime() - start) + +else: + template bench(x, body) = body proc loadRodFile*(filename: AbsoluteFile; m: var PackedModule; config: ConfigRef; ignoreConfig = false): RodFileError = - m.sh = Shared() var f = rodfiles.open(filename.string) f.loadHeader() f.loadSection configSection f.loadPrim m.definedSymbols + f.loadPrim m.moduleFlags f.loadPrim m.cfg if f.err == ok and not configIdentical(m, config) and not ignoreConfig: @@ -515,46 +613,59 @@ proc loadRodFile*(filename: AbsoluteFile; m: var PackedModule; config: ConfigRef f.loadSection section f.loadSeq data + template loadTableSection(section, data) {.dirty.} = + f.loadSection section + f.loadOrderedTable data + template loadTabSection(section, data) {.dirty.} = f.loadSection section f.load data - loadTabSection stringsSection, m.sh.strings + loadTabSection stringsSection, m.strings loadSeqSection checkSumsSection, m.includes - if not includesIdentical(m, config): + if config.cmd != cmdM and not includesIdentical(m, config): f.err = includeFileChanged loadSeqSection depsSection, m.imports - loadTabSection integersSection, m.sh.integers - loadTabSection floatsSection, m.sh.floats + bench gloadBodies: + + loadTabSection numbersSection, m.numbers - loadSeqSection exportsSection, m.exports + loadSeqSection exportsSection, m.exports + loadSeqSection hiddenSection, m.hidden + loadSeqSection reexportsSection, m.reexports - loadSeqSection reexportsSection, m.reexports + loadSeqSection compilerProcsSection, m.compilerProcs - loadSeqSection compilerProcsSection, m.compilerProcs + loadSeqSection trmacrosSection, m.trmacros - loadSeqSection trmacrosSection, m.trmacros + loadSeqSection convertersSection, m.converters + loadSeqSection methodsSection, m.methods + loadSeqSection pureEnumsSection, m.pureEnums - loadSeqSection convertersSection, m.converters - loadSeqSection methodsSection, m.methods - loadSeqSection pureEnumsSection, m.pureEnums - loadSeqSection macroUsagesSection, m.macroUsages + loadTabSection toReplaySection, m.toReplay + loadTabSection topLevelSection, m.topLevel - loadSeqSection toReplaySection, m.toReplay.nodes - loadSeqSection topLevelSection, m.topLevel.nodes - loadSeqSection bodiesSection, m.bodies.nodes - loadSeqSection symsSection, m.sh.syms - loadSeqSection typesSection, m.sh.types + loadTabSection bodiesSection, m.bodies + loadTableSection symsSection, m.syms + loadTableSection typesSection, m.types - loadSeqSection typeInstCacheSection, m.typeInstCache - loadSeqSection procInstCacheSection, m.procInstCache - loadSeqSection attachedOpsSection, m.attachedOps - loadSeqSection methodsPerTypeSection, m.methodsPerType - loadSeqSection enumToStringProcsSection, m.enumToStringProcs - loadSeqSection typeInfoSection, m.emittedTypeInfo + loadSeqSection typeInstCacheSection, m.typeInstCache + loadSeqSection procInstCacheSection, m.procInstCache + loadSeqSection attachedOpsSection, m.attachedOps + loadSeqSection methodsPerGenericTypeSection, m.methodsPerGenericType + loadSeqSection enumToStringProcsSection, m.enumToStringProcs + loadSeqSection methodsPerTypeSection, m.methodsPerType + loadSeqSection dispatchersSection, m.dispatchers + loadSeqSection typeInfoSection, m.emittedTypeInfo + + f.loadSection backendFlagsSection + f.loadPrim m.backendFlags + + f.loadSection sideChannelSection + f.load m.man close(f) result = f.err @@ -573,6 +684,7 @@ proc saveRodFile*(filename: AbsoluteFile; encoder: var PackedEncoder; m: var Pac f.storeHeader() f.storeSection configSection f.storePrim m.definedSymbols + f.storePrim m.moduleFlags f.storePrim m.cfg template storeSeqSection(section, data) {.dirty.} = @@ -583,17 +695,20 @@ proc saveRodFile*(filename: AbsoluteFile; encoder: var PackedEncoder; m: var Pac f.storeSection section f.store data - storeTabSection stringsSection, m.sh.strings + template storeTableSection(section, data) {.dirty.} = + f.storeSection section + f.storeOrderedTable data + + storeTabSection stringsSection, m.strings storeSeqSection checkSumsSection, m.includes storeSeqSection depsSection, m.imports - storeTabSection integersSection, m.sh.integers - storeTabSection floatsSection, m.sh.floats + storeTabSection numbersSection, m.numbers storeSeqSection exportsSection, m.exports - + storeSeqSection hiddenSection, m.hidden storeSeqSection reexportsSection, m.reexports storeSeqSection compilerProcsSection, m.compilerProcs @@ -602,23 +717,30 @@ proc saveRodFile*(filename: AbsoluteFile; encoder: var PackedEncoder; m: var Pac storeSeqSection convertersSection, m.converters storeSeqSection methodsSection, m.methods storeSeqSection pureEnumsSection, m.pureEnums - storeSeqSection macroUsagesSection, m.macroUsages - storeSeqSection toReplaySection, m.toReplay.nodes - storeSeqSection topLevelSection, m.topLevel.nodes + storeTabSection toReplaySection, m.toReplay + storeTabSection topLevelSection, m.topLevel - storeSeqSection bodiesSection, m.bodies.nodes - storeSeqSection symsSection, m.sh.syms + storeTabSection bodiesSection, m.bodies + storeTableSection symsSection, m.syms - storeSeqSection typesSection, m.sh.types + storeTableSection typesSection, m.types storeSeqSection typeInstCacheSection, m.typeInstCache storeSeqSection procInstCacheSection, m.procInstCache storeSeqSection attachedOpsSection, m.attachedOps - storeSeqSection methodsPerTypeSection, m.methodsPerType + storeSeqSection methodsPerGenericTypeSection, m.methodsPerGenericType storeSeqSection enumToStringProcsSection, m.enumToStringProcs + storeSeqSection methodsPerTypeSection, m.methodsPerType + storeSeqSection dispatchersSection, m.dispatchers storeSeqSection typeInfoSection, m.emittedTypeInfo + f.storeSection backendFlagsSection + f.storePrim m.backendFlags + + f.storeSection sideChannelSection + f.store m.man + close(f) encoder.disable() if f.err != ok: @@ -646,24 +768,43 @@ type storing, # state is strictly for stress-testing purposes loading, loaded, - outdated + outdated, + stored # store is complete, no further additions possible LoadedModule* = object status*: ModuleStatus - symsInit, typesInit: bool + symsInit, typesInit, loadedButAliveSetChanged*: bool fromDisk*: PackedModule - syms: seq[PSym] # indexed by itemId - types: seq[PType] + syms: OrderedTable[int32, PSym] # indexed by itemId + types: OrderedTable[int32, PType] module*: PSym # the one true module symbol. - iface: Table[PIdent, seq[PackedItemId]] # PackedItemId so that it works with reexported symbols too + iface, ifaceHidden: Table[PIdent, seq[PackedItemId]] + # PackedItemId so that it works with reexported symbols too + # ifaceHidden includes private symbols - PackedModuleGraph* = seq[LoadedModule] # indexed by FileIndex +type + PackedModuleGraph* = object + pm*: seq[LoadedModule] # indexed by FileIndex + when BenchIC: + depAnalysis: MonoTime + loadBody: MonoTime + loadSym, loadType, loadBodies: MonoTime + +when BenchIC: + proc echoTimes*(m: PackedModuleGraph) = + echo "analysis: ", m.depAnalysis, " loadBody: ", m.loadBody, " loadSym: ", + m.loadSym, " loadType: ", m.loadType, " all bodies: ", gloadBodies + +template `[]`*(m: PackedModuleGraph; i: int): LoadedModule = m.pm[i] +template len*(m: PackedModuleGraph): int = m.pm.len proc loadType(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; t: PackedItemId): PType proc loadSym(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; s: PackedItemId): PSym proc toFileIndexCached*(c: var PackedDecoder; g: PackedModuleGraph; thisModule: int; f: LitId): FileIndex = - if c.lastLit == f and c.lastModule == thisModule: + if f == LitId(0): + result = InvalidFileIdx + elif c.lastLit == f and c.lastModule == thisModule: result = c.lastFile else: result = toFileIndex(f, g[thisModule].fromDisk, c.config) @@ -673,9 +814,10 @@ proc toFileIndexCached*(c: var PackedDecoder; g: PackedModuleGraph; thisModule: proc translateLineInfo(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; x: PackedLineInfo): TLineInfo = - assert g[thisModule].status in {loaded, storing} - result = TLineInfo(line: x.line, col: x.col, - fileIndex: toFileIndexCached(c, g, thisModule, x.file)) + assert g[thisModule].status in {loaded, storing, stored} + let (fileId, line, col) = unpack(g[thisModule].fromDisk.man, x) + result = TLineInfo(line: line.uint16, col: col.int16, + fileIndex: toFileIndexCached(c, g, thisModule, fileId)) proc loadNodes*(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; tree: PackedTree; n: NodePos): PNode = @@ -689,26 +831,28 @@ proc loadNodes*(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; result.flags = n.flags case k - of nkEmpty, nkNilLit, nkType: + of nkNone, nkEmpty, nkNilLit, nkType: discard of nkIdent: - result.ident = getIdent(c.cache, g[thisModule].fromDisk.sh.strings[n.litId]) + result.ident = getIdent(c.cache, g[thisModule].fromDisk.strings[n.litId]) of nkSym: - result.sym = loadSym(c, g, thisModule, PackedItemId(module: LitId(0), item: tree.nodes[n.int].operand)) - of directIntLit: - result.intVal = tree.nodes[n.int].operand + result.sym = loadSym(c, g, thisModule, PackedItemId(module: LitId(0), item: tree[n].soperand)) + if result.typ == nil: + result.typ = result.sym.typ of externIntLit: - result.intVal = g[thisModule].fromDisk.sh.integers[n.litId] + result.intVal = g[thisModule].fromDisk.numbers[n.litId] of nkStrLit..nkTripleStrLit: - result.strVal = g[thisModule].fromDisk.sh.strings[n.litId] + result.strVal = g[thisModule].fromDisk.strings[n.litId] of nkFloatLit..nkFloat128Lit: - result.floatVal = g[thisModule].fromDisk.sh.floats[n.litId] + result.floatVal = cast[BiggestFloat](g[thisModule].fromDisk.numbers[n.litId]) of nkModuleRef: let (n1, n2) = sons2(tree, n) - assert n1.kind == nkInt32Lit - assert n2.kind == nkInt32Lit + assert n1.kind == nkNone + assert n2.kind == nkNone transitionNoneToSym(result) - result.sym = loadSym(c, g, thisModule, PackedItemId(module: n1.litId, item: tree.nodes[n2.int].operand)) + result.sym = loadSym(c, g, thisModule, PackedItemId(module: n1.litId, item: tree[n2].soperand)) + if result.typ == nil: + result.typ = result.sym.typ else: for n0 in sonsReadonly(tree, n): result.addAllowNil loadNodes(c, g, thisModule, tree, n0) @@ -740,6 +884,7 @@ proc loadProcHeader(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: proc loadProcBody(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; tree: PackedTree; n: NodePos): PNode = + result = nil var i = 0 for n0 in sonsReadonly(tree, n): if i == bodyPos: @@ -757,8 +902,10 @@ proc symHeaderFromPacked(c: var PackedDecoder; g: var PackedModuleGraph; kind: s.kind, magic: s.magic, flags: s.flags, info: translateLineInfo(c, g, si, s.info), options: s.options, - position: s.position, - name: getIdent(c.cache, g[si].fromDisk.sh.strings[s.name]) + position: if s.kind in {skForVar, skVar, skLet, skTemp}: 0 else: s.position, + offset: if s.kind in routineKinds: defaultOffset else: s.offset, + disamb: s.disamb, + name: getIdent(c.cache, g[si].fromDisk.strings[s.name]) ) template loadAstBody(p, field) = @@ -775,8 +922,8 @@ proc loadLib(c: var PackedDecoder; g: var PackedModuleGraph; if l.name.int == 0: result = nil else: - result = PLib(generated: l.generated, isOverriden: l.isOverriden, - kind: l.kind, name: rope g[si].fromDisk.sh.strings[l.name]) + result = PLib(generated: l.generated, isOverridden: l.isOverridden, + kind: l.kind, name: rope g[si].fromDisk.strings[l.name]) loadAstBody(l, path) proc symBodyFromPacked(c: var PackedDecoder; g: var PackedModuleGraph; @@ -789,37 +936,53 @@ proc symBodyFromPacked(c: var PackedDecoder; g: var PackedModuleGraph; loadAstBody(s, ast) result.annex = loadLib(c, g, si, item, s.annex) when hasFFI: - result.cname = g[si].fromDisk.sh.strings[s.cname] + result.cname = g[si].fromDisk.strings[s.cname] if s.kind in {skLet, skVar, skField, skForVar}: result.guard = loadSym(c, g, si, s.guard) result.bitsize = s.bitsize result.alignment = s.alignment result.owner = loadSym(c, g, si, s.owner) - let externalName = g[si].fromDisk.sh.strings[s.externalName] + let externalName = g[si].fromDisk.strings[s.externalName] if externalName != "": - result.loc.r = rope externalName + result.loc.snippet = externalName result.loc.flags = s.locFlags + result.instantiatedFrom = loadSym(c, g, si, s.instantiatedFrom) + +proc needsRecompile(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCache; + fileIdx: FileIndex; cachedModules: var seq[FileIndex]): bool +proc loadToReplayNodes(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCache; + fileIdx: FileIndex; m: var LoadedModule) proc loadSym(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; s: PackedItemId): PSym = if s == nilItemId: result = nil else: let si = moduleIndex(c, g, thisModule, s) - assert g[si].status in {loaded, storing} - if not g[si].symsInit: - g[si].symsInit = true - setLen g[si].syms, g[si].fromDisk.sh.syms.len - - if g[si].syms[s.item] == nil: - if g[si].fromDisk.sh.syms[s.item].kind != skModule: - result = symHeaderFromPacked(c, g, g[si].fromDisk.sh.syms[s.item], si, s.item) + if si >= g.len: + g.pm.setLen(si+1) + + if g[si].status == undefined and c.config.cmd == cmdM: + var cachedModules: seq[FileIndex] = @[] + discard needsRecompile(g, c.config, c.cache, FileIndex(si), cachedModules) + for m in cachedModules: + loadToReplayNodes(g, c.config, c.cache, m, g[int m]) + + assert g[si].status in {loaded, storing, stored} + #if not g[si].symsInit: + # g[si].symsInit = true + # setLen g[si].syms, g[si].fromDisk.syms.len + + if g[si].syms.getOrDefault(s.item) == nil: + if g[si].fromDisk.syms[s.item].kind != skModule: + result = symHeaderFromPacked(c, g, g[si].fromDisk.syms[s.item], si, s.item) # store it here early on, so that recursions work properly: g[si].syms[s.item] = result - symBodyFromPacked(c, g, g[si].fromDisk.sh.syms[s.item], si, s.item, result) + symBodyFromPacked(c, g, g[si].fromDisk.syms[s.item], si, s.item, result) else: result = g[si].module assert result != nil + g[si].syms[s.item] = result else: result = g[si].syms[s.item] @@ -828,7 +991,7 @@ proc typeHeaderFromPacked(c: var PackedDecoder; g: var PackedModuleGraph; t: PackedType; si, item: int32): PType = result = PType(itemId: ItemId(module: si, item: t.nonUniqueId), kind: t.kind, flags: t.flags, size: t.size, align: t.align, - paddingAtEnd: t.paddingAtEnd, lockLevel: t.lockLevel, + paddingAtEnd: t.paddingAtEnd, uniqueId: ItemId(module: si, item: item), callConv: t.callConv) @@ -840,8 +1003,10 @@ proc typeBodyFromPacked(c: var PackedDecoder; g: var PackedModuleGraph; for op, item in pairs t.attachedOps: result.attachedOps[op] = loadSym(c, g, si, item) result.typeInst = loadType(c, g, si, t.typeInst) + var sons = newSeq[PType]() for son in items t.types: - result.sons.add loadType(c, g, si, son) + sons.add loadType(c, g, si, son) + result.setSons(sons) loadAstBody(t, n) when false: for gen, id in items t.methods: @@ -852,42 +1017,43 @@ proc loadType(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; t result = nil else: let si = moduleIndex(c, g, thisModule, t) - assert g[si].status in {loaded, storing} + assert g[si].status in {loaded, storing, stored} assert t.item > 0 - if not g[si].typesInit: - g[si].typesInit = true - setLen g[si].types, g[si].fromDisk.sh.types.len + #if not g[si].typesInit: + # g[si].typesInit = true + # setLen g[si].types, g[si].fromDisk.types.len - if g[si].types[t.item] == nil: - result = typeHeaderFromPacked(c, g, g[si].fromDisk.sh.types[t.item], si, t.item) + if g[si].types.getOrDefault(t.item) == nil: + result = typeHeaderFromPacked(c, g, g[si].fromDisk.types[t.item], si, t.item) # store it here early on, so that recursions work properly: g[si].types[t.item] = result - typeBodyFromPacked(c, g, g[si].fromDisk.sh.types[t.item], si, t.item, result) + typeBodyFromPacked(c, g, g[si].fromDisk.types[t.item], si, t.item, result) + #assert result.itemId.item == t.item, $(result.itemId.item, t.item) + assert result.itemId.item > 0, $(result.itemId.item, t.item) else: result = g[si].types[t.item] - assert result.itemId.item > 0 - -proc newPackage(config: ConfigRef; cache: IdentCache; fileIdx: FileIndex): PSym = - let filename = AbsoluteFile toFullPath(config, fileIdx) - let name = getIdent(cache, splitFile(filename).name) - let info = newLineInfo(fileIdx, 1, 1) - let - pck = getPackageName(config, filename.string) - pck2 = if pck.len > 0: pck else: "unknown" - pack = getIdent(cache, pck2) - result = newSym(skPackage, getIdent(cache, pck2), - ItemId(module: PackageModuleId, item: int32(fileIdx)), nil, info) + assert result.itemId.item > 0, "2" proc setupLookupTables(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCache; fileIdx: FileIndex; m: var LoadedModule) = m.iface = initTable[PIdent, seq[PackedItemId]]() - for e in m.fromDisk.exports: + m.ifaceHidden = initTable[PIdent, seq[PackedItemId]]() + template impl(iface, e) = let nameLit = e[0] - m.iface.mgetOrPut(cache.getIdent(m.fromDisk.sh.strings[nameLit]), @[]).add(PackedItemId(module: LitId(0), item: e[1])) - for re in m.fromDisk.reexports: - let nameLit = re[0] - m.iface.mgetOrPut(cache.getIdent(m.fromDisk.sh.strings[nameLit]), @[]).add(re[1]) + let e2 = + when e[1] is PackedItemId: e[1] + else: PackedItemId(module: LitId(0), item: e[1]) + iface.mgetOrPut(cache.getIdent(m.fromDisk.strings[nameLit]), @[]).add(e2) + + for e in m.fromDisk.exports: + m.iface.impl(e) + m.ifaceHidden.impl(e) + for e in m.fromDisk.reexports: + m.iface.impl(e) + m.ifaceHidden.impl(e) + for e in m.fromDisk.hidden: + m.ifaceHidden.impl(e) let filename = AbsoluteFile toFullPath(conf, fileIdx) # We cannot call ``newSym`` here, because we have to circumvent the ID @@ -896,9 +1062,8 @@ proc setupLookupTables(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCa name: getIdent(cache, splitFile(filename).name), info: newLineInfo(fileIdx, 1, 1), position: int(fileIdx)) - m.module.owner = newPackage(conf, cache, fileIdx) - if fileIdx == conf.projectMainIdx2: - m.module.flags.incl sfMainModule + m.module.owner = getPackage(conf, cache, fileIdx) + m.module.flags = m.fromDisk.moduleFlags proc loadToReplayNodes(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCache; fileIdx: FileIndex; m: var LoadedModule) = @@ -918,30 +1083,37 @@ proc needsRecompile(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCache # Does the file belong to the fileIdx need to be recompiled? let m = int(fileIdx) if m >= g.len: - g.setLen(m+1) + g.pm.setLen(m+1) case g[m].status of undefined: g[m].status = loading let fullpath = msgs.toFullPath(conf, fileIdx) let rod = toRodFile(conf, AbsoluteFile fullpath) - let err = loadRodFile(rod, g[m].fromDisk, conf) + let err = loadRodFile(rod, g[m].fromDisk, conf, ignoreConfig = conf.cmd == cmdM) if err == ok: - result = optForceFullMake in conf.globalOptions - # check its dependencies: - for dep in g[m].fromDisk.imports: - let fid = toFileIndex(dep, g[m].fromDisk, conf) - # Warning: we need to traverse the full graph, so - # do **not use break here**! - if needsRecompile(g, conf, cache, fid, cachedModules): - result = true - - if not result: + if conf.cmd == cmdM: setupLookupTables(g, conf, cache, fileIdx, g[m]) cachedModules.add fileIdx g[m].status = loaded + result = false else: - g[m] = LoadedModule(status: outdated, module: g[m].module) + result = optForceFullMake in conf.globalOptions + # check its dependencies: + let imp = g[m].fromDisk.imports + for dep in imp: + let fid = toFileIndex(dep, g[m].fromDisk, conf) + # Warning: we need to traverse the full graph, so + # do **not use break here**! + if needsRecompile(g, conf, cache, fid, cachedModules): + result = true + + if not result: + setupLookupTables(g, conf, cache, fileIdx, g[m]) + cachedModules.add fileIdx + g[m].status = loaded + else: + g.pm[m] = LoadedModule(status: outdated, module: g[m].module) else: loadError(err, rod, conf) g[m].status = outdated @@ -950,18 +1122,19 @@ proc needsRecompile(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCache of loading, loaded: # For loading: Assume no recompile is required. result = false - of outdated, storing: + of outdated, storing, stored: result = true proc moduleFromRodFile*(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCache; fileIdx: FileIndex; cachedModules: var seq[FileIndex]): PSym = ## Returns 'nil' if the module needs to be recompiled. - if needsRecompile(g, conf, cache, fileIdx, cachedModules): - result = nil - else: - result = g[int fileIdx].module - assert result != nil - assert result.position == int(fileIdx) + bench g.depAnalysis: + if needsRecompile(g, conf, cache, fileIdx, cachedModules): + result = nil + else: + result = g[int fileIdx].module + assert result != nil + assert result.position == int(fileIdx) for m in cachedModules: loadToReplayNodes(g, conf, cache, m, g[int m]) @@ -975,46 +1148,43 @@ template setupDecoder() {.dirty.} = proc loadProcBody*(config: ConfigRef, cache: IdentCache; g: var PackedModuleGraph; s: PSym): PNode = - let mId = s.itemId.module - var decoder = PackedDecoder( - lastModule: int32(-1), - lastLit: LitId(0), - lastFile: FileIndex(-1), - config: config, - cache: cache) - let pos = g[mId].fromDisk.sh.syms[s.itemId.item].ast - assert pos != emptyNodeId - result = loadProcBody(decoder, g, mId, g[mId].fromDisk.bodies, NodePos pos) - -proc loadTypeFromId*(config: ConfigRef, cache: IdentCache; - g: var PackedModuleGraph; module: int; id: PackedItemId): PType = - if id.item < g[module].types.len: - result = g[module].types[id.item] - else: - result = nil - if result == nil: + bench g.loadBody: + let mId = s.itemId.module var decoder = PackedDecoder( lastModule: int32(-1), lastLit: LitId(0), lastFile: FileIndex(-1), config: config, cache: cache) - result = loadType(decoder, g, module, id) + let pos = g[mId].fromDisk.syms[s.itemId.item].ast + assert pos != emptyNodeId + result = loadProcBody(decoder, g, mId, g[mId].fromDisk.bodies, NodePos pos) + +proc loadTypeFromId*(config: ConfigRef, cache: IdentCache; + g: var PackedModuleGraph; module: int; id: PackedItemId): PType = + bench g.loadType: + result = g[module].types.getOrDefault(id.item) + if result == nil: + var decoder = PackedDecoder( + lastModule: int32(-1), + lastLit: LitId(0), + lastFile: FileIndex(-1), + config: config, + cache: cache) + result = loadType(decoder, g, module, id) proc loadSymFromId*(config: ConfigRef, cache: IdentCache; g: var PackedModuleGraph; module: int; id: PackedItemId): PSym = - if id.item < g[module].syms.len: - result = g[module].syms[id.item] - else: - result = nil - if result == nil: - var decoder = PackedDecoder( - lastModule: int32(-1), - lastLit: LitId(0), - lastFile: FileIndex(-1), - config: config, - cache: cache) - result = loadSym(decoder, g, module, id) + bench g.loadSym: + result = g[module].syms.getOrDefault(id.item) + if result == nil: + var decoder = PackedDecoder( + lastModule: int32(-1), + lastLit: LitId(0), + lastFile: FileIndex(-1), + config: config, + cache: cache) + result = loadSym(decoder, g, module, id) proc translateId*(id: PackedItemId; g: PackedModuleGraph; thisModule: int; config: ConfigRef): ItemId = if id.module == LitId(0): @@ -1022,19 +1192,6 @@ proc translateId*(id: PackedItemId; g: PackedModuleGraph; thisModule: int; confi else: ItemId(module: toFileIndex(id.module, g[thisModule].fromDisk, config).int32, item: id.item) -proc checkForHoles(m: PackedModule; config: ConfigRef; moduleId: int) = - var bugs = 0 - for i in 1 .. high(m.sh.syms): - if m.sh.syms[i].kind == skUnknown: - echo "EMPTY ID ", i, " module ", moduleId, " ", toFullPath(config, FileIndex(moduleId)) - inc bugs - assert bugs == 0 - when false: - var nones = 0 - for i in 1 .. high(m.sh.types): - inc nones, m.sh.types[i].kind == tyNone - assert nones < 1 - proc simulateLoadedModule*(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCache; moduleSym: PSym; m: PackedModule) = # For now only used for heavy debugging. In the future we could use this to reduce the @@ -1054,24 +1211,31 @@ type values: seq[PackedItemId] i, module: int +template interfSelect(a: LoadedModule, importHidden: bool): auto = + var ret = a.iface.addr + if importHidden: ret = a.ifaceHidden.addr + ret[] + proc initRodIter*(it: var RodIter; config: ConfigRef, cache: IdentCache; g: var PackedModuleGraph; module: FileIndex; - name: PIdent): PSym = + name: PIdent, importHidden: bool): PSym = it.decoder = PackedDecoder( lastModule: int32(-1), lastLit: LitId(0), lastFile: FileIndex(-1), config: config, cache: cache) - it.values = g[int module].iface.getOrDefault(name) + it.values = g[int module].interfSelect(importHidden).getOrDefault(name) it.i = 0 it.module = int(module) if it.i < it.values.len: result = loadSym(it.decoder, g, int(module), it.values[it.i]) inc it.i + else: + result = nil proc initRodIterAllSyms*(it: var RodIter; config: ConfigRef, cache: IdentCache; - g: var PackedModuleGraph; module: FileIndex): PSym = + g: var PackedModuleGraph; module: FileIndex; importHidden: bool): PSym = it.decoder = PackedDecoder( lastModule: int32(-1), lastLit: LitId(0), @@ -1080,23 +1244,27 @@ proc initRodIterAllSyms*(it: var RodIter; config: ConfigRef, cache: IdentCache; cache: cache) it.values = @[] it.module = int(module) - for v in g[int module].iface.values: + for v in g[int module].interfSelect(importHidden).values: it.values.add v it.i = 0 if it.i < it.values.len: result = loadSym(it.decoder, g, int(module), it.values[it.i]) inc it.i + else: + result = nil proc nextRodIter*(it: var RodIter; g: var PackedModuleGraph): PSym = if it.i < it.values.len: result = loadSym(it.decoder, g, it.module, it.values[it.i]) inc it.i + else: + result = nil iterator interfaceSymbols*(config: ConfigRef, cache: IdentCache; g: var PackedModuleGraph; module: FileIndex; - name: PIdent): PSym = + name: PIdent, importHidden: bool): PSym = setupDecoder() - let values = g[int module].iface.getOrDefault(name) + let values = g[int module].interfSelect(importHidden).getOrDefault(name) for pid in values: let s = loadSym(decoder, g, int(module), pid) assert s != nil @@ -1104,51 +1272,72 @@ iterator interfaceSymbols*(config: ConfigRef, cache: IdentCache; proc interfaceSymbol*(config: ConfigRef, cache: IdentCache; g: var PackedModuleGraph; module: FileIndex; - name: PIdent): PSym = + name: PIdent, importHidden: bool): PSym = setupDecoder() - let values = g[int module].iface.getOrDefault(name) + let values = g[int module].interfSelect(importHidden).getOrDefault(name) result = loadSym(decoder, g, int(module), values[0]) proc idgenFromLoadedModule*(m: LoadedModule): IdGenerator = - IdGenerator(module: m.module.itemId.module, symId: int32 m.fromDisk.sh.syms.len, - typeId: int32 m.fromDisk.sh.types.len) + IdGenerator(module: m.module.itemId.module, symId: int32 m.fromDisk.syms.len, + typeId: int32 m.fromDisk.types.len) proc searchForCompilerproc*(m: LoadedModule; name: string): int32 = # slow, linear search, but the results are cached: for it in items(m.fromDisk.compilerProcs): - if m.fromDisk.sh.strings[it[0]] == name: + if m.fromDisk.strings[it[0]] == name: return it[1] return -1 # ------------------------- .rod file viewer --------------------------------- proc rodViewer*(rodfile: AbsoluteFile; config: ConfigRef, cache: IdentCache) = - var m: PackedModule + var m: PackedModule = PackedModule() let err = loadRodFile(rodfile, m, config, ignoreConfig=true) if err != ok: - echo "Error: could not load: ", rodfile.string, " reason: ", err - quit 1 + config.quitOrRaise "Error: could not load: " & $rodfile.string & " reason: " & $err - when true: + when false: echo "exports:" for ex in m.exports: - echo " ", m.sh.strings[ex[0]], " local ID: ", ex[1] - assert ex[0] == m.sh.syms[ex[1]].name + echo " ", m.strings[ex[0]], " local ID: ", ex[1] + assert ex[0] == m.syms[ex[1]].name # ex[1] int32 echo "reexports:" for ex in m.reexports: - echo " ", m.sh.strings[ex[0]] + echo " ", m.strings[ex[0]] # reexports*: seq[(LitId, PackedItemId)] - echo "all symbols" - for i in 0..high(m.sh.syms): - if m.sh.syms[i].name != LitId(0): - echo " ", m.sh.strings[m.sh.syms[i].name], " local ID: ", i, " kind ", m.sh.syms[i].kind - else: - echo " <anon symbol?> local ID: ", i, " kind ", m.sh.syms[i].kind + echo "hidden: " & $m.hidden.len + for ex in m.hidden: + echo " ", m.strings[ex[0]], " local ID: ", ex[1] + + when false: + echo "all symbols" + for i in 0..high(m.syms): + if m.syms[i].name != LitId(0): + echo " ", m.strings[m.syms[i].name], " local ID: ", i, " kind ", m.syms[i].kind + else: + echo " <anon symbol?> local ID: ", i, " kind ", m.syms[i].kind + + echo "symbols: ", m.syms.len, " types: ", m.types.len, + " top level nodes: ", m.topLevel.len, " other nodes: ", m.bodies.len, + " strings: ", m.strings.len, " numbers: ", m.numbers.len - echo "symbols: ", m.sh.syms.len, " types: ", m.sh.types.len, - " top level nodes: ", m.topLevel.nodes.len, " other nodes: ", m.bodies.nodes.len, - " strings: ", m.sh.strings.len, " integers: ", m.sh.integers.len, - " floats: ", m.sh.floats.len + echo "SIZES:" + echo "symbols: ", m.syms.len * sizeof(PackedSym), " types: ", m.types.len * sizeof(PackedType), + " top level nodes: ", m.topLevel.len * sizeof(PackedNode), + " other nodes: ", m.bodies.len * sizeof(PackedNode), + " strings: ", sizeOnDisc(m.strings) + when false: + var tt = 0 + var fc = 0 + for x in m.topLevel: + if x.kind == nkSym or x.typeId == nilItemId: inc tt + if x.flags == {}: inc fc + for x in m.bodies: + if x.kind == nkSym or x.typeId == nilItemId: inc tt + if x.flags == {}: inc fc + let total = float(m.topLevel.len + m.bodies.len) + echo "nodes with nil type: ", tt, " in % ", tt.float / total + echo "nodes with empty flags: ", fc.float / total diff --git a/compiler/ic/iclineinfos.nim b/compiler/ic/iclineinfos.nim new file mode 100644 index 000000000..74a7d971b --- /dev/null +++ b/compiler/ic/iclineinfos.nim @@ -0,0 +1,84 @@ +# +# +# The Nim Compiler +# (c) Copyright 2024 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +# For the line information we use 32 bits. They are used as follows: +# Bit 0 (AsideBit): If we have inline line information or not. If not, the +# remaining 31 bits are used as an index into a seq[(LitId, int, int)]. +# +# We use 10 bits for the "file ID", this means a program can consist of as much +# as 1024 different files. (If it uses more files than that, the overflow bit +# would be set.) +# This means we have 21 bits left to encode the (line, col) pair. We use 7 bits for the column +# so 128 is the limit and 14 bits for the line number. +# The packed representation supports files with up to 16384 lines. +# Keep in mind that whenever any limit is reached the AsideBit is set and the real line +# information is kept in a side channel. + +import std / assertions + +const + AsideBit = 1 + FileBits = 10 + LineBits = 14 + ColBits = 7 + FileMax = (1 shl FileBits) - 1 + LineMax = (1 shl LineBits) - 1 + ColMax = (1 shl ColBits) - 1 + +static: + assert AsideBit + FileBits + LineBits + ColBits == 32 + +import .. / ic / [bitabs, rodfiles] # for LitId + +type + PackedLineInfo* = distinct uint32 + + LineInfoManager* = object + aside: seq[(LitId, int32, int32)] + +const + NoLineInfo* = PackedLineInfo(0'u32) + +proc pack*(m: var LineInfoManager; file: LitId; line, col: int32): PackedLineInfo = + if file.uint32 <= FileMax.uint32 and line <= LineMax and col <= ColMax: + let col = if col < 0'i32: 0'u32 else: col.uint32 + let line = if line < 0'i32: 0'u32 else: line.uint32 + # use inline representation: + result = PackedLineInfo((file.uint32 shl 1'u32) or (line shl uint32(AsideBit + FileBits)) or + (col shl uint32(AsideBit + FileBits + LineBits))) + else: + result = PackedLineInfo((m.aside.len shl 1) or AsideBit) + m.aside.add (file, line, col) + +proc unpack*(m: LineInfoManager; i: PackedLineInfo): (LitId, int32, int32) = + let i = i.uint32 + if (i and 1'u32) == 0'u32: + # inline representation: + result = (LitId((i shr 1'u32) and FileMax.uint32), + int32((i shr uint32(AsideBit + FileBits)) and LineMax.uint32), + int32((i shr uint32(AsideBit + FileBits + LineBits)) and ColMax.uint32)) + else: + result = m.aside[int(i shr 1'u32)] + +proc getFileId*(m: LineInfoManager; i: PackedLineInfo): LitId = + result = unpack(m, i)[0] + +proc store*(r: var RodFile; m: LineInfoManager) = storeSeq(r, m.aside) +proc load*(r: var RodFile; m: var LineInfoManager) = loadSeq(r, m.aside) + +when isMainModule: + var m = LineInfoManager(aside: @[]) + for i in 0'i32..<16388'i32: + for col in 0'i32..<100'i32: + let packed = pack(m, LitId(1023), i, col) + let u = unpack(m, packed) + assert u[0] == LitId(1023) + assert u[1] == i + assert u[2] == col + echo m.aside.len diff --git a/compiler/ic/integrity.nim b/compiler/ic/integrity.nim new file mode 100644 index 000000000..3e8ea2503 --- /dev/null +++ b/compiler/ic/integrity.nim @@ -0,0 +1,155 @@ +# +# +# The Nim Compiler +# (c) Copyright 2021 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Integrity checking for a set of .rod files. +## The set must cover a complete Nim project. + +import std/[sets, tables] + +when defined(nimPreviewSlimSystem): + import std/assertions + +import ".." / [ast, modulegraphs] +import packed_ast, bitabs, ic + +type + CheckedContext = object + g: ModuleGraph + thisModule: int32 + checkedSyms: HashSet[ItemId] + checkedTypes: HashSet[ItemId] + +proc checkType(c: var CheckedContext; typeId: PackedItemId) +proc checkForeignSym(c: var CheckedContext; symId: PackedItemId) +proc checkNode(c: var CheckedContext; tree: PackedTree; n: NodePos) + +proc checkTypeObj(c: var CheckedContext; typ: PackedType) = + for child in typ.types: + checkType(c, child) + if typ.n != emptyNodeId: + checkNode(c, c.g.packed[c.thisModule].fromDisk.bodies, NodePos typ.n) + if typ.sym != nilItemId: + checkForeignSym(c, typ.sym) + if typ.owner != nilItemId: + checkForeignSym(c, typ.owner) + checkType(c, typ.typeInst) + +proc checkType(c: var CheckedContext; typeId: PackedItemId) = + if typeId == nilItemId: return + let itemId = translateId(typeId, c.g.packed, c.thisModule, c.g.config) + if not c.checkedTypes.containsOrIncl(itemId): + let oldThisModule = c.thisModule + c.thisModule = itemId.module + checkTypeObj c, c.g.packed[itemId.module].fromDisk.types[itemId.item] + c.thisModule = oldThisModule + +proc checkSym(c: var CheckedContext; s: PackedSym) = + if s.name != LitId(0): + assert c.g.packed[c.thisModule].fromDisk.strings.hasLitId s.name + checkType c, s.typ + if s.ast != emptyNodeId: + checkNode(c, c.g.packed[c.thisModule].fromDisk.bodies, NodePos s.ast) + if s.owner != nilItemId: + checkForeignSym(c, s.owner) + +proc checkLocalSym(c: var CheckedContext; item: int32) = + let itemId = ItemId(module: c.thisModule, item: item) + if not c.checkedSyms.containsOrIncl(itemId): + checkSym c, c.g.packed[c.thisModule].fromDisk.syms[item] + +proc checkForeignSym(c: var CheckedContext; symId: PackedItemId) = + let itemId = translateId(symId, c.g.packed, c.thisModule, c.g.config) + if not c.checkedSyms.containsOrIncl(itemId): + let oldThisModule = c.thisModule + c.thisModule = itemId.module + checkSym c, c.g.packed[itemId.module].fromDisk.syms[itemId.item] + c.thisModule = oldThisModule + +proc checkNode(c: var CheckedContext; tree: PackedTree; n: NodePos) = + let t = findType(tree, n) + if t != nilItemId: + checkType(c, t) + case n.kind + of nkEmpty, nkNilLit, nkType, nkNilRodNode: + discard + of nkIdent: + assert c.g.packed[c.thisModule].fromDisk.strings.hasLitId n.litId + of nkSym: + checkLocalSym(c, tree[n].soperand) + of directIntLit: + discard + of externIntLit, nkFloatLit..nkFloat128Lit: + assert c.g.packed[c.thisModule].fromDisk.numbers.hasLitId n.litId + of nkStrLit..nkTripleStrLit: + assert c.g.packed[c.thisModule].fromDisk.strings.hasLitId n.litId + of nkModuleRef: + let (n1, n2) = sons2(tree, n) + assert n1.kind == nkNone + assert n2.kind == nkNone + checkForeignSym(c, PackedItemId(module: n1.litId, item: tree[n2].soperand)) + else: + for n0 in sonsReadonly(tree, n): + checkNode(c, tree, n0) + +proc checkTree(c: var CheckedContext; t: PackedTree) = + for p in allNodes(t): checkNode(c, t, p) + +proc checkLocalSymIds(c: var CheckedContext; m: PackedModule; symIds: seq[int32]) = + for symId in symIds: + assert symId >= 0 and symId < m.syms.len, $symId & " " & $m.syms.len + +proc checkModule(c: var CheckedContext; m: PackedModule) = + # We check that: + # - Every symbol references existing types and symbols. + # - Every tree node references existing types and symbols. + for _, v in pairs(m.syms): + checkLocalSym c, v.id + + checkTree c, m.toReplay + checkTree c, m.topLevel + + for e in m.exports: + #assert e[1] >= 0 and e[1] < m.syms.len + assert e[0] == m.syms[e[1]].name + + for e in m.compilerProcs: + #assert e[1] >= 0 and e[1] < m.syms.len + assert e[0] == m.syms[e[1]].name + + checkLocalSymIds c, m, m.converters + checkLocalSymIds c, m, m.methods + checkLocalSymIds c, m, m.trmacros + checkLocalSymIds c, m, m.pureEnums + #[ + To do: Check all these fields: + + reexports*: seq[(LitId, PackedItemId)] + macroUsages*: seq[(PackedItemId, PackedLineInfo)] + + typeInstCache*: seq[(PackedItemId, PackedItemId)] + procInstCache*: seq[PackedInstantiation] + attachedOps*: seq[(TTypeAttachedOp, PackedItemId, PackedItemId)] + methodsPerGenericType*: seq[(PackedItemId, int, PackedItemId)] + enumToStringProcs*: seq[(PackedItemId, PackedItemId)] + methodsPerType*: seq[(PackedItemId, PackedItemId)] + dispatchers*: seq[PackedItemId] + ]# + +proc checkIntegrity*(g: ModuleGraph) = + var c = CheckedContext(g: g) + for i in 0..<len(g.packed): + # case statement here to enforce exhaustive checks. + case g.packed[i].status + of undefined: + discard "nothing to do" + of loading: + assert false, "cannot check integrity: Module still loading" + of stored, storing, outdated, loaded: + c.thisModule = int32 i + checkModule(c, g.packed[i].fromDisk) diff --git a/compiler/ic/navigator.nim b/compiler/ic/navigator.nim new file mode 100644 index 000000000..39037b94f --- /dev/null +++ b/compiler/ic/navigator.nim @@ -0,0 +1,183 @@ +# +# +# The Nim Compiler +# (c) Copyright 2021 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Supports the "nim check --ic:on --defusages:FILE,LINE,COL" +## IDE-like features. It uses the set of .rod files to accomplish +## its task. The set must cover a complete Nim project. + +import std/[sets, tables] + +from std/os import nil +from std/private/miscdollars import toLocation + +when defined(nimPreviewSlimSystem): + import std/assertions + +import ".." / [ast, modulegraphs, msgs, options] +import iclineinfos +import packed_ast, bitabs, ic + +type + UnpackedLineInfo = object + file: LitId + line, col: int + NavContext = object + g: ModuleGraph + thisModule: int32 + trackPos: UnpackedLineInfo + alreadyEmitted: HashSet[string] + outputSep: char # for easier testing, use short filenames and spaces instead of tabs. + +proc isTracked(man: LineInfoManager; current: PackedLineInfo, trackPos: UnpackedLineInfo, tokenLen: int): bool = + let (currentFile, currentLine, currentCol) = man.unpack(current) + if currentFile == trackPos.file and currentLine == trackPos.line: + let col = trackPos.col + if col >= currentCol and col < currentCol+tokenLen: + result = true + else: + result = false + else: + result = false + +proc searchLocalSym(c: var NavContext; s: PackedSym; info: PackedLineInfo): bool = + result = s.name != LitId(0) and + isTracked(c.g.packed[c.thisModule].fromDisk.man, info, c.trackPos, c.g.packed[c.thisModule].fromDisk.strings[s.name].len) + +proc searchForeignSym(c: var NavContext; s: ItemId; info: PackedLineInfo): bool = + let name = c.g.packed[s.module].fromDisk.syms[s.item].name + result = name != LitId(0) and + isTracked(c.g.packed[c.thisModule].fromDisk.man, info, c.trackPos, c.g.packed[s.module].fromDisk.strings[name].len) + +const + EmptyItemId = ItemId(module: -1'i32, item: -1'i32) + +proc search(c: var NavContext; tree: PackedTree): ItemId = + # We use the linear representation here directly: + for i in 0..<len(tree): + let i = NodePos(i) + case tree[i].kind + of nkSym: + let item = tree[i].soperand + if searchLocalSym(c, c.g.packed[c.thisModule].fromDisk.syms[item], tree[i].info): + return ItemId(module: c.thisModule, item: item) + of nkModuleRef: + let (currentFile, currentLine, currentCol) = c.g.packed[c.thisModule].fromDisk.man.unpack(tree[i].info) + if currentLine == c.trackPos.line and currentFile == c.trackPos.file: + let (n1, n2) = sons2(tree, i) + assert n1.kind == nkInt32Lit + assert n2.kind == nkInt32Lit + let pId = PackedItemId(module: n1.litId, item: tree[n2].soperand) + let itemId = translateId(pId, c.g.packed, c.thisModule, c.g.config) + if searchForeignSym(c, itemId, tree[i].info): + return itemId + else: discard + return EmptyItemId + +proc isDecl(tree: PackedTree; n: NodePos): bool = + # XXX This is not correct yet. + const declarativeNodes = procDefs + {nkMacroDef, nkTemplateDef, + nkLetSection, nkVarSection, nkUsingStmt, nkConstSection, nkTypeSection, + nkIdentDefs, nkEnumTy, nkVarTuple} + result = n.int >= 0 and tree[n].kind in declarativeNodes + +proc usage(c: var NavContext; info: PackedLineInfo; isDecl: bool) = + let (fileId, line, col) = unpack(c.g.packed[c.thisModule].fromDisk.man, info) + var m = "" + var file = c.g.packed[c.thisModule].fromDisk.strings[fileId] + if c.outputSep == ' ': + file = os.extractFilename file + toLocation(m, file, line, col + ColOffset) + if not c.alreadyEmitted.containsOrIncl(m): + msgWriteln c.g.config, (if isDecl: "def" else: "usage") & c.outputSep & m + +proc list(c: var NavContext; tree: PackedTree; sym: ItemId) = + for i in 0..<len(tree): + let i = NodePos(i) + case tree[i].kind + of nkSym: + let item = tree[i].soperand + if sym.item == item and sym.module == c.thisModule: + usage(c, tree[i].info, isDecl(tree, parent(i))) + of nkModuleRef: + let (n1, n2) = sons2(tree, i) + assert n1.kind == nkNone + assert n2.kind == nkNone + let pId = PackedItemId(module: n1.litId, item: tree[n2].soperand) + let itemId = translateId(pId, c.g.packed, c.thisModule, c.g.config) + if itemId.item == sym.item and sym.module == itemId.module: + usage(c, tree[i].info, isDecl(tree, parent(i))) + else: discard + +proc searchForIncludeFile(g: ModuleGraph; fullPath: string): int = + for i in 0..<len(g.packed): + for k in 1..high(g.packed[i].fromDisk.includes): + # we start from 1 because the first "include" file is + # the module's filename. + if os.cmpPaths(g.packed[i].fromDisk.strings[g.packed[i].fromDisk.includes[k][0]], fullPath) == 0: + return i + return -1 + +proc nav(g: ModuleGraph) = + # translate the track position to a packed position: + let unpacked = g.config.m.trackPos + var mid = unpacked.fileIndex.int + + let fullPath = toFullPath(g.config, unpacked.fileIndex) + + if g.packed[mid].status == undefined: + # check if 'mid' is an include file of some other module: + mid = searchForIncludeFile(g, fullPath) + + if mid < 0: + localError(g.config, unpacked, "unknown file name: " & fullPath) + return + + let fileId = g.packed[mid].fromDisk.strings.getKeyId(fullPath) + + if fileId == LitId(0): + internalError(g.config, unpacked, "cannot find a valid file ID") + return + + var c = NavContext( + g: g, + thisModule: int32 mid, + trackPos: UnpackedLineInfo(line: unpacked.line.int, col: unpacked.col.int, file: fileId), + outputSep: if isDefined(g.config, "nimIcNavigatorTests"): ' ' else: '\t' + ) + var symId = search(c, g.packed[mid].fromDisk.topLevel) + if symId == EmptyItemId: + symId = search(c, g.packed[mid].fromDisk.bodies) + + if symId == EmptyItemId: + localError(g.config, unpacked, "no symbol at this position") + return + + for i in 0..<len(g.packed): + # case statement here to enforce exhaustive checks. + case g.packed[i].status + of undefined: + discard "nothing to do" + of loading: + assert false, "cannot check integrity: Module still loading" + of stored, storing, outdated, loaded: + c.thisModule = int32 i + list(c, g.packed[i].fromDisk.topLevel, symId) + list(c, g.packed[i].fromDisk.bodies, symId) + +proc navDefinition*(g: ModuleGraph) = nav(g) +proc navUsages*(g: ModuleGraph) = nav(g) +proc navDefusages*(g: ModuleGraph) = nav(g) + +proc writeRodFiles*(g: ModuleGraph) = + for i in 0..<len(g.packed): + case g.packed[i].status + of undefined, loading, stored, loaded: + discard "nothing to do" + of storing, outdated: + closeRodFile(g, g.packed[i].module) diff --git a/compiler/ic/packed_ast.nim b/compiler/ic/packed_ast.nim index 353cc3a42..a39bb7adf 100644 --- a/compiler/ic/packed_ast.nim +++ b/compiler/ic/packed_ast.nim @@ -12,10 +12,15 @@ ## use this representation directly in all the transformations, ## it is superior. -import std / [hashes, tables, strtabs] -import bitabs +import std/[hashes, tables, strtabs] +import bitabs, rodfiles import ".." / [ast, options] +import iclineinfos + +when defined(nimPreviewSlimSystem): + import std/assertions + type SymId* = distinct int32 ModuleId* = distinct int32 @@ -28,25 +33,21 @@ type item*: int32 # same as the in-memory representation const - nilItemId* = PackedItemId(module: LitId(0), item: -1.int32) + nilItemId* = PackedItemId(module: LitId(0), item: 0.int32) const emptyNodeId* = NodeId(-1) type - PackedLineInfo* = object - line*: uint16 - col*: int16 - file*: LitId - PackedLib* = object kind*: TLibKind generated*: bool - isOverriden*: bool + isOverridden*: bool name*: LitId path*: NodeId PackedSym* = object + id*: int32 kind*: TSymKind name*: LitId typ*: PackedItemId @@ -60,15 +61,18 @@ type alignment*: int # for alignment options*: TOptions position*: int - offset*: int + offset*: int32 + disamb*: int32 externalName*: LitId # instead of TLoc locFlags*: TLocFlags annex*: PackedLib when hasFFI: cname*: LitId constraint*: NodeId + instantiatedFrom*: PackedItemId PackedType* = object + id*: int32 kind*: TTypeKind callConv*: TCallingConvention #nodekind*: TNodeKind @@ -81,39 +85,39 @@ type size*: BiggestInt align*: int16 paddingAtEnd*: int16 - lockLevel*: TLockLevel # lock level as required for deadlock checking # not serialized: loc*: TLoc because it is backend-specific typeInst*: PackedItemId nonUniqueId*: int32 - PackedNode* = object # 20 bytes - kind*: TNodeKind - flags*: TNodeFlags - operand*: int32 # for kind in {nkSym, nkSymDef}: SymId - # for kind in {nkStrLit, nkIdent, nkNumberLit}: LitId - # for kind in nkInt32Lit: direct value - # for non-atom kinds: the number of nodes (for easy skipping) - typeId*: PackedItemId + PackedNode* = object # 8 bytes + x: uint32 info*: PackedLineInfo PackedTree* = object ## usually represents a full Nim module - nodes*: seq[PackedNode] - #sh*: Shared - - Shared* = ref object # shared between different versions of 'Module'. - # (though there is always exactly one valid - # version of a module) - syms*: seq[PackedSym] - types*: seq[PackedType] - strings*: BiTable[string] # we could share these between modules. - integers*: BiTable[BiggestInt] - floats*: BiTable[BiggestFloat] - #config*: ConfigRef + nodes: seq[PackedNode] + withFlags: seq[(int32, TNodeFlags)] + withTypes: seq[(int32, PackedItemId)] PackedInstantiation* = object key*, sym*: PackedItemId concreteTypes*: seq[PackedItemId] +const + NodeKindBits = 8'u32 + NodeKindMask = (1'u32 shl NodeKindBits) - 1'u32 + +template kind*(n: PackedNode): TNodeKind = TNodeKind(n.x and NodeKindMask) +template uoperand*(n: PackedNode): uint32 = (n.x shr NodeKindBits) +template soperand*(n: PackedNode): int32 = int32(uoperand(n)) + +template toX(k: TNodeKind; operand: uint32): uint32 = + uint32(k) or (operand shl NodeKindBits) + +template toX(k: TNodeKind; operand: LitId): uint32 = + uint32(k) or (operand.uint32 shl NodeKindBits) + +template typeId*(n: PackedNode): PackedItemId = n.typ + proc `==`*(a, b: SymId): bool {.borrow.} proc hash*(a: SymId): Hash {.borrow.} @@ -122,71 +126,35 @@ proc `==`*(a, b: NodePos): bool {.borrow.} proc `==`*(a, b: NodeId): bool {.borrow.} proc newTreeFrom*(old: PackedTree): PackedTree = - result.nodes = @[] + result = PackedTree(nodes: @[]) when false: result.sh = old.sh -when false: - proc declareSym*(tree: var PackedTree; kind: TSymKind; - name: LitId; info: PackedLineInfo): SymId = - result = SymId(tree.sh.syms.len) - tree.sh.syms.add PackedSym(kind: kind, name: name, flags: {}, magic: mNone, info: info) - - proc litIdFromName*(tree: PackedTree; name: string): LitId = - result = tree.sh.strings.getOrIncl(name) - - proc add*(tree: var PackedTree; kind: TNodeKind; token: string; info: PackedLineInfo) = - tree.nodes.add PackedNode(kind: kind, info: info, - operand: int32 getOrIncl(tree.sh.strings, token)) - - proc add*(tree: var PackedTree; kind: TNodeKind; info: PackedLineInfo) = - tree.nodes.add PackedNode(kind: kind, operand: 0, info: info) - -proc throwAwayLastNode*(tree: var PackedTree) = - tree.nodes.setLen(tree.nodes.len-1) - proc addIdent*(tree: var PackedTree; s: LitId; info: PackedLineInfo) = - tree.nodes.add PackedNode(kind: nkIdent, operand: int32(s), info: info) + tree.nodes.add PackedNode(x: toX(nkIdent, uint32(s)), info: info) proc addSym*(tree: var PackedTree; s: int32; info: PackedLineInfo) = - tree.nodes.add PackedNode(kind: nkSym, operand: s, info: info) - -proc addModuleId*(tree: var PackedTree; s: ModuleId; info: PackedLineInfo) = - tree.nodes.add PackedNode(kind: nkInt32Lit, operand: int32(s), info: info) + tree.nodes.add PackedNode(x: toX(nkSym, cast[uint32](s)), info: info) proc addSymDef*(tree: var PackedTree; s: SymId; info: PackedLineInfo) = - tree.nodes.add PackedNode(kind: nkSym, operand: int32(s), info: info) + tree.nodes.add PackedNode(x: toX(nkSym, cast[uint32](s)), info: info) proc isAtom*(tree: PackedTree; pos: int): bool {.inline.} = tree.nodes[pos].kind <= nkNilLit -proc copyTree*(dest: var PackedTree; tree: PackedTree; n: NodePos) = - # and this is why the IR is superior. We can copy subtrees - # via a linear scan. - let pos = n.int - let L = if isAtom(tree, pos): 1 else: tree.nodes[pos].operand - let d = dest.nodes.len - dest.nodes.setLen(d + L) - for i in 0..<L: - dest.nodes[d+i] = tree.nodes[pos+i] - -when false: - proc copySym*(dest: var PackedTree; tree: PackedTree; s: SymId): SymId = - result = SymId(dest.sh.syms.len) - assert int(s) < tree.sh.syms.len - let oldSym = tree.sh.syms[s.int] - dest.sh.syms.add oldSym - type PatchPos = distinct int -when false: - proc prepare*(tree: var PackedTree; kind: TNodeKind; info: PackedLineInfo): PatchPos = - result = PatchPos tree.nodes.len - tree.nodes.add PackedNode(kind: kind, operand: 0, info: info) +proc addNode*(t: var PackedTree; kind: TNodeKind; operand: int32; + typeId: PackedItemId = nilItemId; info: PackedLineInfo; + flags: TNodeFlags = {}) = + t.nodes.add PackedNode(x: toX(kind, cast[uint32](operand)), info: info) + if flags != {}: + t.withFlags.add (t.nodes.len.int32 - 1, flags) + if typeId != nilItemId: + t.withTypes.add (t.nodes.len.int32 - 1, typeId) proc prepare*(tree: var PackedTree; kind: TNodeKind; flags: TNodeFlags; typeId: PackedItemId; info: PackedLineInfo): PatchPos = result = PatchPos tree.nodes.len - tree.nodes.add PackedNode(kind: kind, flags: flags, operand: 0, info: info, - typeId: typeId) + tree.addNode(kind = kind, flags = flags, operand = 0, info = info, typeId = typeId) proc prepare*(dest: var PackedTree; source: PackedTree; sourcePos: NodePos): PatchPos = result = PatchPos dest.nodes.len @@ -194,26 +162,30 @@ proc prepare*(dest: var PackedTree; source: PackedTree; sourcePos: NodePos): Pat proc patch*(tree: var PackedTree; pos: PatchPos) = let pos = pos.int - assert tree.nodes[pos].kind > nkNilLit + let k = tree.nodes[pos].kind + assert k > nkNilLit let distance = int32(tree.nodes.len - pos) - tree.nodes[pos].operand = distance + assert distance > 0 + tree.nodes[pos].x = toX(k, cast[uint32](distance)) proc len*(tree: PackedTree): int {.inline.} = tree.nodes.len -proc `[]`*(tree: PackedTree; i: int): lent PackedNode {.inline.} = - tree.nodes[i] +proc `[]`*(tree: PackedTree; i: NodePos): lent PackedNode {.inline.} = + tree.nodes[i.int] + +template rawSpan(n: PackedNode): int = int(uoperand(n)) proc nextChild(tree: PackedTree; pos: var int) {.inline.} = if tree.nodes[pos].kind > nkNilLit: - assert tree.nodes[pos].operand > 0 - inc pos, tree.nodes[pos].operand + assert tree.nodes[pos].uoperand > 0 + inc pos, tree.nodes[pos].rawSpan else: inc pos iterator sonsReadonly*(tree: PackedTree; n: NodePos): NodePos = var pos = n.int assert tree.nodes[pos].kind > nkNilLit - let last = pos + tree.nodes[pos].operand + let last = pos + tree.nodes[pos].rawSpan inc pos while pos < last: yield NodePos pos @@ -234,7 +206,7 @@ iterator isons*(dest: var PackedTree; tree: PackedTree; iterator sonsFrom1*(tree: PackedTree; n: NodePos): NodePos = var pos = n.int assert tree.nodes[pos].kind > nkNilLit - let last = pos + tree.nodes[pos].operand + let last = pos + tree.nodes[pos].rawSpan inc pos if pos < last: nextChild tree, pos @@ -248,7 +220,7 @@ iterator sonsWithoutLast2*(tree: PackedTree; n: NodePos): NodePos = inc count var pos = n.int assert tree.nodes[pos].kind > nkNilLit - let last = pos + tree.nodes[pos].operand + let last = pos + tree.nodes[pos].rawSpan inc pos while pos < last and count > 2: yield NodePos pos @@ -258,9 +230,9 @@ iterator sonsWithoutLast2*(tree: PackedTree; n: NodePos): NodePos = proc parentImpl(tree: PackedTree; n: NodePos): NodePos = # finding the parent of a node is rather easy: var pos = n.int - 1 - while pos >= 0 and isAtom(tree, pos) or (pos + tree.nodes[pos].operand - 1 < n.int): + while pos >= 0 and (isAtom(tree, pos) or (pos + tree.nodes[pos].rawSpan - 1 < n.int)): dec pos - assert pos >= 0, "node has no parent" + #assert pos >= 0, "node has no parent" result = NodePos(pos) template parent*(n: NodePos): NodePos = parentImpl(tree, n) @@ -284,20 +256,32 @@ proc firstSon*(tree: PackedTree; n: NodePos): NodePos {.inline.} = proc kind*(tree: PackedTree; n: NodePos): TNodeKind {.inline.} = tree.nodes[n.int].kind proc litId*(tree: PackedTree; n: NodePos): LitId {.inline.} = - LitId tree.nodes[n.int].operand + LitId tree.nodes[n.int].uoperand proc info*(tree: PackedTree; n: NodePos): PackedLineInfo {.inline.} = tree.nodes[n.int].info +proc findType*(tree: PackedTree; n: NodePos): PackedItemId = + for x in tree.withTypes: + if x[0] == int32(n): return x[1] + if x[0] > int32(n): return nilItemId + return nilItemId + +proc findFlags*(tree: PackedTree; n: NodePos): TNodeFlags = + for x in tree.withFlags: + if x[0] == int32(n): return x[1] + if x[0] > int32(n): return {} + return {} + template typ*(n: NodePos): PackedItemId = - tree.nodes[n.int].typeId + tree.findType(n) template flags*(n: NodePos): TNodeFlags = - tree.nodes[n.int].flags + tree.findFlags(n) -template operand*(n: NodePos): int32 = - tree.nodes[n.int].operand +template uoperand*(n: NodePos): uint32 = + tree.nodes[n.int].uoperand proc span*(tree: PackedTree; pos: int): int {.inline.} = - if isAtom(tree, pos): 1 else: tree.nodes[pos].operand + if isAtom(tree, pos): 1 else: tree.nodes[pos].rawSpan proc sons2*(tree: PackedTree; n: NodePos): (NodePos, NodePos) = assert(not isAtom(tree, n.int)) @@ -313,6 +297,7 @@ proc sons3*(tree: PackedTree; n: NodePos): (NodePos, NodePos, NodePos) = result = (NodePos a, NodePos b, NodePos c) proc ithSon*(tree: PackedTree; n: NodePos; i: int): NodePos = + result = default(NodePos) if tree.nodes[n.int].kind > nkNilLit: var count = 0 for child in sonsReadonly(tree, n): @@ -326,105 +311,28 @@ when false: template kind*(n: NodePos): TNodeKind = tree.nodes[n.int].kind template info*(n: NodePos): PackedLineInfo = tree.nodes[n.int].info -template litId*(n: NodePos): LitId = LitId tree.nodes[n.int].operand +template litId*(n: NodePos): LitId = LitId tree.nodes[n.int].uoperand -template symId*(n: NodePos): SymId = SymId tree.nodes[n.int].operand +template symId*(n: NodePos): SymId = SymId tree.nodes[n.int].soperand proc firstSon*(n: NodePos): NodePos {.inline.} = NodePos(n.int+1) -when false: - proc strLit*(tree: PackedTree; n: NodePos): lent string = - assert n.kind == nkStrLit - result = tree.sh.strings[LitId tree.nodes[n.int].operand] - - proc strVal*(tree: PackedTree; n: NodePos): string = - assert n.kind == nkStrLit - result = tree.sh.strings[LitId tree.nodes[n.int].operand] - #result = cookedStrLit(raw) - - proc filenameVal*(tree: PackedTree; n: NodePos): string = - case n.kind - of nkStrLit: - result = strVal(tree, n) - of nkIdent: - result = tree.sh.strings[n.litId] - of nkSym: - result = tree.sh.strings[tree.sh.syms[int n.symId].name] - else: - result = "" - - proc identAsStr*(tree: PackedTree; n: NodePos): lent string = - assert n.kind == nkIdent - result = tree.sh.strings[LitId tree.nodes[n.int].operand] - const externIntLit* = {nkCharLit, nkIntLit, nkInt8Lit, nkInt16Lit, + nkInt32Lit, nkInt64Lit, nkUIntLit, nkUInt8Lit, nkUInt16Lit, nkUInt32Lit, - nkUInt64Lit} # nkInt32Lit is missing by design! + nkUInt64Lit} - externSIntLit* = {nkIntLit, nkInt8Lit, nkInt16Lit, nkInt64Lit} + externSIntLit* = {nkIntLit, nkInt8Lit, nkInt16Lit, nkInt32Lit, nkInt64Lit} externUIntLit* = {nkUIntLit, nkUInt8Lit, nkUInt16Lit, nkUInt32Lit, nkUInt64Lit} - directIntLit* = nkInt32Lit - -proc toString*(tree: PackedTree; n: NodePos; sh: Shared; nesting: int; - result: var string) = - let pos = n.int - if result.len > 0 and result[^1] notin {' ', '\n'}: - result.add ' ' - - result.add $tree[pos].kind - case tree.nodes[pos].kind - of nkNone, nkEmpty, nkNilLit, nkType: discard - of nkIdent, nkStrLit..nkTripleStrLit: - result.add " " - result.add sh.strings[LitId tree.nodes[pos].operand] - of nkSym: - result.add " " - result.add sh.strings[sh.syms[tree.nodes[pos].operand].name] - of directIntLit: - result.add " " - result.addInt tree.nodes[pos].operand - of externSIntLit: - result.add " " - result.addInt sh.integers[LitId tree.nodes[pos].operand] - of externUIntLit: - result.add " " - result.add $cast[uint64](sh.integers[LitId tree.nodes[pos].operand]) - else: - result.add "(\n" - for i in 1..(nesting+1)*2: result.add ' ' - for child in sonsReadonly(tree, n): - toString(tree, child, sh, nesting + 1, result) - result.add "\n" - for i in 1..nesting*2: result.add ' ' - result.add ")" - #for i in 1..nesting*2: result.add ' ' - - -proc toString*(tree: PackedTree; n: NodePos; sh: Shared): string = - result = "" - toString(tree, n, sh, 0, result) - -proc debug*(tree: PackedTree; sh: Shared) = - stdout.write toString(tree, NodePos 0, sh) - -when false: - proc identIdImpl(tree: PackedTree; n: NodePos): LitId = - if n.kind == nkIdent: - result = n.litId - elif n.kind == nkSym: - result = tree.sh.syms[int n.symId].name - else: - result = LitId(0) - - template identId*(n: NodePos): LitId = identIdImpl(tree, n) + directIntLit* = nkNone template copyInto*(dest, n, body) = let patchPos = prepare(dest, tree, n) @@ -436,28 +344,8 @@ template copyIntoKind*(dest, kind, info, body) = body patch dest, patchPos -when false: - proc hasPragma*(tree: PackedTree; n: NodePos; pragma: string): bool = - let litId = tree.sh.strings.getKeyId(pragma) - if litId == LitId(0): - return false - assert n.kind == nkPragma - for ch0 in sonsReadonly(tree, n): - if ch0.kind == nkExprColonExpr: - if ch0.firstSon.identId == litId: - return true - elif ch0.identId == litId: - return true - proc getNodeId*(tree: PackedTree): NodeId {.inline.} = NodeId tree.nodes.len -when false: - proc produceError*(dest: var PackedTree; tree: PackedTree; n: NodePos; msg: string) = - let patchPos = prepare(dest, nkError, n.info) - dest.add nkStrLit, msg, n.info - copyTree(dest, tree, n) - patch dest, patchPos - iterator allNodes*(tree: PackedTree): NodePos = var p = 0 while p < tree.len: @@ -467,3 +355,13 @@ iterator allNodes*(tree: PackedTree): NodePos = proc toPackedItemId*(item: int32): PackedItemId {.inline.} = PackedItemId(module: LitId(0), item: item) + +proc load*(f: var RodFile; t: var PackedTree) = + loadSeq f, t.nodes + loadSeq f, t.withFlags + loadSeq f, t.withTypes + +proc store*(f: var RodFile; t: PackedTree) = + storeSeq f, t.nodes + storeSeq f, t.withFlags + storeSeq f, t.withTypes diff --git a/compiler/ic/replayer.nim b/compiler/ic/replayer.nim index 61aa0e697..b244ec885 100644 --- a/compiler/ic/replayer.nim +++ b/compiler/ic/replayer.nim @@ -14,7 +14,10 @@ import ".." / [ast, modulegraphs, trees, extccomp, btrees, msgs, lineinfos, pathutils, options, cgmeth] -import tables +import std/tables + +when defined(nimPreviewSlimSystem): + import std/assertions import packed_ast, ic, bitabs @@ -86,6 +89,31 @@ proc replayStateChanges*(module: PSym; g: ModuleGraph) = else: internalAssert g.config, false +proc replayBackendProcs*(g: ModuleGraph; module: int) = + for it in mitems(g.packed[module].fromDisk.attachedOps): + let key = translateId(it[0], g.packed, module, g.config) + let op = it[1] + let tmp = translateId(it[2], g.packed, module, g.config) + let symId = FullId(module: tmp.module, packed: it[2]) + g.attachedOps[op][key] = LazySym(id: symId, sym: nil) + + for it in mitems(g.packed[module].fromDisk.enumToStringProcs): + let key = translateId(it[0], g.packed, module, g.config) + let tmp = translateId(it[1], g.packed, module, g.config) + let symId = FullId(module: tmp.module, packed: it[1]) + g.enumToStringProcs[key] = LazySym(id: symId, sym: nil) + + for it in mitems(g.packed[module].fromDisk.methodsPerType): + let key = translateId(it[0], g.packed, module, g.config) + let tmp = translateId(it[1], g.packed, module, g.config) + let symId = FullId(module: tmp.module, packed: it[1]) + g.methodsPerType.mgetOrPut(key, @[]).add LazySym(id: symId, sym: nil) + + for it in mitems(g.packed[module].fromDisk.dispatchers): + let tmp = translateId(it, g.packed, module, g.config) + let symId = FullId(module: tmp.module, packed: it) + g.dispatchers.add LazySym(id: symId, sym: nil) + proc replayGenericCacheInformation*(g: ModuleGraph; module: int) = ## We remember the generic instantiations a module performed ## in order to to avoid the code bloat that generic code tends @@ -110,18 +138,14 @@ proc replayGenericCacheInformation*(g: ModuleGraph; module: int) = module: module, sym: FullId(module: sym.module, packed: it.sym), concreteTypes: concreteTypes, inst: nil) - for it in mitems(g.packed[module].fromDisk.methodsPerType): + for it in mitems(g.packed[module].fromDisk.methodsPerGenericType): let key = translateId(it[0], g.packed, module, g.config) let col = it[1] let tmp = translateId(it[2], g.packed, module, g.config) let symId = FullId(module: tmp.module, packed: it[2]) - g.methodsPerType.mgetOrPut(key, @[]).add (col, LazySym(id: symId, sym: nil)) + g.methodsPerGenericType.mgetOrPut(key, @[]).add (col, LazySym(id: symId, sym: nil)) - for it in mitems(g.packed[module].fromDisk.enumToStringProcs): - let key = translateId(it[0], g.packed, module, g.config) - let tmp = translateId(it[1], g.packed, module, g.config) - let symId = FullId(module: tmp.module, packed: it[1]) - g.enumToStringProcs[key] = LazySym(id: symId, sym: nil) + replayBackendProcs(g, module) for it in mitems(g.packed[module].fromDisk.methods): let sym = loadSymFromId(g.config, g.cache, g.packed, module, diff --git a/compiler/ic/rodfiles.nim b/compiler/ic/rodfiles.nim index a518870f8..ac995dd2e 100644 --- a/compiler/ic/rodfiles.nim +++ b/compiler/ic/rodfiles.nim @@ -7,7 +7,68 @@ # distribution, for details about the copyright. # -from typetraits import supportsCopyMem +## Low level binary format used by the compiler to store and load various AST +## and related data. +## +## NB: this is incredibly low level and if you're interested in how the +## compiler works and less a storage format, you're probably looking for +## the `ic` or `packed_ast` modules to understand the logical format. + +from std/typetraits import supportsCopyMem + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] + +import std / tables + +## Overview +## ======== +## `RodFile` represents a Rod File (versioned binary format), and the +## associated data for common interactions such as IO and error tracking +## (`RodFileError`). The file format broken up into sections (`RodSection`) +## and preceded by a header (see: `cookie`). The precise layout, section +## ordering and data following the section are determined by the user. See +## `ic.loadRodFile`. +## +## A basic but "wrong" example of the lifecycle: +## --------------------------------------------- +## 1. `create` or `open` - create a new one or open an existing +## 2. `storeHeader` - header info +## 3. `storePrim` or `storeSeq` - save your stuff +## 4. `close` - and we're done +## +## Now read the bits below to understand what's missing. +## +## ### Issues with the Example +## Missing Sections: +## This is a low level API, so headers and sections need to be stored and +## loaded by the user, see `storeHeader` & `loadHeader` and `storeSection` & +## `loadSection`, respectively. +## +## No Error Handling: +## The API is centered around IO and prone to error, each operation checks or +## sets the `RodFile.err` field. A user of this API needs to handle these +## appropriately. +## +## API Notes +## ========= +## +## Valid inputs for Rod files +## -------------------------- +## ASTs, hopes, dreams, and anything as long as it and any children it may have +## support `copyMem`. This means anything that is not a pointer and that does not contain a pointer. At a glance these are: +## * string +## * objects & tuples (fields are recursed) +## * sequences AKA `seq[T]` +## +## Note on error handling style +## ---------------------------- +## A flag based approach is used where operations no-op in case of a +## preexisting error and set the flag if they encounter one. +## +## Misc +## ---- +## * 'Prim' is short for 'primitive', as in a non-sequence type type RodSection* = enum @@ -16,16 +77,15 @@ type stringsSection checkSumsSection depsSection - integersSection - floatsSection + numbersSection exportsSection + hiddenSection reexportsSection compilerProcsSection trmacrosSection convertersSection methodsSection pureEnumsSection - macroUsagesSection toReplaySection topLevelSection bodiesSection @@ -34,10 +94,16 @@ type typeInstCacheSection procInstCacheSection attachedOpsSection - methodsPerTypeSection + methodsPerGenericTypeSection enumToStringProcsSection + methodsPerTypeSection + dispatchersSection typeInfoSection # required by the backend + backendFlagsSection aliveSymsSection # beware, this is stored in a `.alivesyms` file. + sideChannelSection + namespaceSection + symnamesSection RodFileError* = enum ok, tooBig, cannotOpen, ioFailure, wrongHeader, wrongSection, configMismatch, @@ -50,8 +116,8 @@ type # better than exceptions. const - RodVersion = 1 - cookie = [byte(0), byte('R'), byte('O'), byte('D'), + RodVersion = 2 + defaultCookie = [byte(0), byte('R'), byte('O'), byte('D'), byte(sizeof(int)*8), byte(system.cpuEndian), byte(0), byte(RodVersion)] proc setError(f: var RodFile; err: RodFileError) {.inline.} = @@ -59,6 +125,8 @@ proc setError(f: var RodFile; err: RodFileError) {.inline.} = #raise newException(IOError, "IO error") proc storePrim*(f: var RodFile; s: string) = + ## Stores a string. + ## The len is prefixed to allow for later retreival. if f.err != ok: return if s.len >= high(int32): setError f, tooBig @@ -72,6 +140,9 @@ proc storePrim*(f: var RodFile; s: string) = setError f, ioFailure proc storePrim*[T](f: var RodFile; x: T) = + ## Stores a non-sequence/string `T`. + ## If `T` doesn't support `copyMem` and is an object or tuple then the fields + ## are written -- the user from context will need to know which `T` to load. if f.err != ok: return when supportsCopyMem(T): if writeBuffer(f.f, unsafeAddr(x), sizeof(x)) != sizeof(x): @@ -89,6 +160,7 @@ proc storePrim*[T](f: var RodFile; x: T) = {.error: "unsupported type for 'storePrim'".} proc storeSeq*[T](f: var RodFile; s: seq[T]) = + ## Stores a sequence of `T`s, with the len as a prefix for later retrieval. if f.err != ok: return if s.len >= high(int32): setError f, tooBig @@ -100,7 +172,20 @@ proc storeSeq*[T](f: var RodFile; s: seq[T]) = for i in 0..<s.len: storePrim(f, s[i]) +proc storeOrderedTable*[K, T](f: var RodFile; s: OrderedTable[K, T]) = + if f.err != ok: return + if s.len >= high(int32): + setError f, tooBig + return + var lenPrefix = int32(s.len) + if writeBuffer(f.f, addr lenPrefix, sizeof(lenPrefix)) != sizeof(lenPrefix): + setError f, ioFailure + else: + for _, v in s: + storePrim(f, v) + proc loadPrim*(f: var RodFile; s: var string) = + ## Read a string, the length was stored as a prefix if f.err != ok: return var lenPrefix = int32(0) if readBuffer(f.f, addr lenPrefix, sizeof(lenPrefix)) != sizeof(lenPrefix): @@ -112,6 +197,7 @@ proc loadPrim*(f: var RodFile; s: var string) = setError f, ioFailure proc loadPrim*[T](f: var RodFile; x: var T) = + ## Load a non-sequence/string `T`. if f.err != ok: return when supportsCopyMem(T): if readBuffer(f.f, unsafeAddr(x), sizeof(x)) != sizeof(x): @@ -129,6 +215,7 @@ proc loadPrim*[T](f: var RodFile; x: var T) = {.error: "unsupported type for 'loadPrim'".} proc loadSeq*[T](f: var RodFile; s: var seq[T]) = + ## `T` must be compatible with `copyMem`, see `loadPrim` if f.err != ok: return var lenPrefix = int32(0) if readBuffer(f.f, addr lenPrefix, sizeof(lenPrefix)) != sizeof(lenPrefix): @@ -138,38 +225,59 @@ proc loadSeq*[T](f: var RodFile; s: var seq[T]) = for i in 0..<lenPrefix: loadPrim(f, s[i]) -proc storeHeader*(f: var RodFile) = +proc loadOrderedTable*[K, T](f: var RodFile; s: var OrderedTable[K, T]) = + ## `T` must be compatible with `copyMem`, see `loadPrim` + if f.err != ok: return + var lenPrefix = int32(0) + if readBuffer(f.f, addr lenPrefix, sizeof(lenPrefix)) != sizeof(lenPrefix): + setError f, ioFailure + else: + s = initOrderedTable[K, T](lenPrefix) + for i in 0..<lenPrefix: + var x = default T + loadPrim(f, x) + s[x.id] = x + +proc storeHeader*(f: var RodFile; cookie = defaultCookie) = + ## stores the header which is described by `cookie`. if f.err != ok: return if f.f.writeBytes(cookie, 0, cookie.len) != cookie.len: setError f, ioFailure -proc loadHeader*(f: var RodFile) = +proc loadHeader*(f: var RodFile; cookie = defaultCookie) = + ## Loads the header which is described by `cookie`. if f.err != ok: return - var thisCookie: array[cookie.len, byte] + var thisCookie: array[cookie.len, byte] = default(array[cookie.len, byte]) if f.f.readBytes(thisCookie, 0, thisCookie.len) != thisCookie.len: setError f, ioFailure elif thisCookie != cookie: setError f, wrongHeader proc storeSection*(f: var RodFile; s: RodSection) = + ## update `currentSection` and writes the bytes value of s. if f.err != ok: return assert f.currentSection < s f.currentSection = s storePrim(f, s) proc loadSection*(f: var RodFile; expected: RodSection) = + ## read the bytes value of s, sets and error if the section is incorrect. if f.err != ok: return - var s: RodSection + var s: RodSection = default(RodSection) loadPrim(f, s) if expected != s and f.err == ok: setError f, wrongSection proc create*(filename: string): RodFile = + ## create the file and open it for writing + result = default(RodFile) if not open(result.f, filename, fmWrite): setError result, cannotOpen proc close*(f: var RodFile) = close(f.f) proc open*(filename: string): RodFile = + ## open the file for reading + result = default(RodFile) if not open(result.f, filename, fmRead): setError result, cannotOpen diff --git a/compiler/idents.nim b/compiler/idents.nim index d2a84fd36..34177e76d 100644 --- a/compiler/idents.nim +++ b/compiler/idents.nim @@ -11,8 +11,11 @@ # 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 +import wordrecg +import std/hashes + +when defined(nimPreviewSlimSystem): + import std/assertions type PIdent* = ref TIdent diff --git a/compiler/importer.nim b/compiler/importer.nim index cb529795a..ffb7e0305 100644 --- a/compiler/importer.nim +++ b/compiler/importer.nim @@ -10,9 +10,15 @@ ## This module implements the symbol importing mechanism. import - intsets, ast, astalgo, msgs, options, idents, lookups, - semdata, modulepaths, sigmatch, lineinfos, sets, - modulegraphs + ast, astalgo, msgs, options, idents, lookups, + semdata, modulepaths, sigmatch, lineinfos, + modulegraphs, wordrecg +from std/strutils import `%`, startsWith +from std/sequtils import addUnique +import std/[sets, tables, intsets] + +when defined(nimPreviewSlimSystem): + import std/assertions proc readExceptSet*(c: PContext, n: PNode): IntSet = assert n.kind in {nkImportExceptStmt, nkExportExceptStmt} @@ -107,7 +113,26 @@ proc rawImportSymbol(c: PContext, s, origin: PSym; importSet: var IntSet) = if s.owner != origin: 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") + result = (nil, @[]) + 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() + else: + result[0] = n + if result[0].safeLen > 0: + (result[0][^1], result[1]) = splitPragmas(c, result[0][^1]) + 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") + let ident = lookups.considerQuotedIdent(c, n) let s = someSym(c.graph, fromMod, ident) if s == nil: @@ -119,7 +144,7 @@ proc importSymbol(c: PContext, n: PNode, fromMod: PSym; importSet: var IntSet) = # for an enumeration we have to add all identifiers if multiImport: # for a overloadable syms add all overloaded routines - var it: ModuleIter + var it: ModuleIter = default(ModuleIter) var e = initModuleIter(it, c.graph, fromMod, s.name) while e != nil: if e.name.id != s.name.id: internalError(c.config, n.info, "importSymbol: 3") @@ -163,19 +188,24 @@ proc addImport(c: PContext; im: sink ImportedModule) = c.imports.add im template addUnnamedIt(c: PContext, fromMod: PSym; filter: untyped) {.dirty.} = - for it in c.graph.ifaces[fromMod.position].converters: + for it in mitems c.graph.ifaces[fromMod.position].converters: if filter: - addConverter(c, it) - for it in c.graph.ifaces[fromMod.position].patterns: + loadPackedSym(c.graph, it) + if sfExported in it.sym.flags: + addConverter(c, it) + for it in mitems c.graph.ifaces[fromMod.position].patterns: if filter: - addPattern(c, it) - for it in c.graph.ifaces[fromMod.position].pureEnums: + loadPackedSym(c.graph, it) + if sfExported in it.sym.flags: + addPattern(c, it) + for it in mitems c.graph.ifaces[fromMod.position].pureEnums: if filter: + loadPackedSym(c.graph, it) importPureEnumFields(c, it.sym, it.sym.typ) proc importAllSymbolsExcept(c: PContext, fromMod: PSym, exceptSet: IntSet) = c.addImport ImportedModule(m: fromMod, mode: importExcept, exceptSet: exceptSet) - addUnnamedIt(c, fromMod, it.sym.id notin exceptSet) + addUnnamedIt(c, fromMod, it.sym.name.id notin exceptSet) proc importAllSymbols*(c: PContext, fromMod: PSym) = c.addImport ImportedModule(m: fromMod, mode: importAll) @@ -201,18 +231,48 @@ proc importForwarded(c: PContext, n: PNode, exceptSet: IntSet; fromMod: PSym; im for i in 0..n.safeLen-1: importForwarded(c, n[i], exceptSet, fromMod, importSet) -proc importModuleAs(c: PContext; n: PNode, realModule: PSym): PSym = +proc importModuleAs(c: PContext; n: PNode, realModule: PSym, importHidden: bool): PSym = result = realModule - c.unusedImports.add((realModule, n.info)) + template createModuleAliasImpl(ident): untyped = + createModuleAlias(realModule, c.idgen, ident, n.info, c.config.options) 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") elif n[1].ident.id != realModule.name.id: # some misguided guy will write 'import abc.foo as foo' ... - result = createModuleAlias(realModule, nextSymId c.idgen, n[1].ident, realModule.info, - c.config.options) + result = createModuleAliasImpl(n[1].ident) + if result == realModule: + # avoids modifying `realModule`, see D20201209T194412 for `import {.all.}` + result = createModuleAliasImpl(realModule.name) + if importHidden: + result.options.incl optImportHidden + let moduleIdent = if n.kind == nkInfix: n[^1] else: n + c.unusedImports.add((result, moduleIdent.info)) + c.importModuleMap[result.id] = realModule.id + c.importModuleLookup.mgetOrPut(result.name.id, @[]).addUnique realModule.id -proc myImportModule(c: PContext, n: PNode; importStmtResult: PNode): PSym = +proc transformImportAs(c: PContext; n: PNode): tuple[node: PNode, importHidden: bool] = + result = (nil, false) + var ret = default(typeof(result)) + proc processPragma(n2: PNode): PNode = + let (result2, kws) = splitPragmas(c, n2) + result = result2 + for ai in kws: + case ai + of wImportHidden: ret.importHidden = true + else: globalError(c.config, n.info, "invalid pragma, expected: " & ${wImportHidden}) + + if n.kind == nkInfix and considerQuotedIdent(c, n[0]).s == "as": + ret.node = newNodeI(nkImportAs, n.info) + ret.node.add n[1].processPragma + ret.node.add n[2] + else: + ret.node = n.processPragma + return ret + +proc myImportModule(c: PContext, n: var PNode, importStmtResult: PNode): PSym = + let transf = transformImportAs(c, n) + n = transf.node let f = checkModuleName(c.config, n) if f != InvalidFileIdx: addImportFileDep(c, f) @@ -228,64 +288,80 @@ proc myImportModule(c: PContext, n: PNode; importStmtResult: PNode): PSym = toFullPath(c.config, c.graph.importStack[i+1]) c.recursiveDep = err + var realModule: PSym discard pushOptionEntry(c) - result = importModuleAs(c, n, c.graph.importModuleCallback(c.graph, c.module, f)) + realModule = c.graph.importModuleCallback(c.graph, c.module, f) + result = importModuleAs(c, n, realModule, transf.importHidden) popOptionEntry(c) #echo "set back to ", L c.graph.importStack.setLen(L) # we cannot perform this check reliably because of - # test: modules/import_in_config) - when true: - if result.info.fileIndex == c.module.info.fileIndex and - result.info.fileIndex == n.info.fileIndex: - localError(c.config, n.info, "A module cannot import itself") - if sfDeprecated in result.flags: - if result.constraint != nil: - message(c.config, n.info, warnDeprecated, result.constraint.strVal & "; " & result.name.s & " is deprecated") + # 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) + 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") + let moduleName = getModuleName(c.config, n) + if belongsToStdlib(c.graph, result) and not startsWith(moduleName, stdPrefix) and + not startsWith(moduleName, "system/") and not startsWith(moduleName, "packages/"): + message(c.config, n.info, warnStdPrefix, realModule.name.s) + + proc suggestMod(n: PNode; s: PSym) = + if n.kind == nkImportAs: + suggestMod(n[0], realModule) + elif n.kind == nkInfix: + suggestMod(n[2], s) else: - message(c.config, n.info, warnDeprecated, result.name.s & " is deprecated") - suggestSym(c.graph, n.info, result, c.graph.usageSym, false) + suggestSym(c.graph, n.info, s, c.graph.usageSym, false) + suggestMod(n, result) importStmtResult.add newSymNode(result, n.info) #newStrNode(toFullPath(c.config, f), n.info) - -proc transformImportAs(c: PContext; n: PNode): PNode = - if n.kind == nkInfix and considerQuotedIdent(c, n[0]).s == "as": - result = newNodeI(nkImportAs, n.info) - result.add n[1] - result.add n[2] else: - result = n + result = nil + +proc afterImport(c: PContext, m: PSym) = + if isCachedModule(c.graph, m): return + # fixes bug #17510, for re-exported symbols + let realModuleId = c.importModuleMap[m.id] + for s in allSyms(c.graph, m): + if s.owner.id != realModuleId: + c.exportIndirections.incl((m.id, s.id)) proc impMod(c: PContext; it: PNode; importStmtResult: PNode) = - let it = transformImportAs(c, it) + var it = it let m = myImportModule(c, it, importStmtResult) if m != nil: # ``addDecl`` needs to be done before ``importAllSymbols``! addDecl(c, m, it.info) # add symbol to symbol table of module importAllSymbols(c, m) #importForwarded(c, m.ast, emptySet, m) + afterImport(c, m) proc evalImport*(c: PContext, n: PNode): PNode = result = newNodeI(nkImportStmt, n.info) for i in 0..<n.len: let it = n[i] - if it.kind == nkInfix and it.len == 3 and it[2].kind == nkBracket: - let sep = it[0] - let dir = it[1] - var imp = newNodeI(nkInfix, it.info) - imp.add sep - imp.add dir - imp.add sep # dummy entry, replaced in the loop - for x in it[2]: + if it.kind in {nkInfix, nkPrefix} and it[^1].kind == nkBracket: + let lastPos = it.len - 1 + var imp = copyNode(it) + newSons(imp, it.len) + for i in 0 ..< lastPos: imp[i] = it[i] + imp[lastPos] = imp[0] # dummy entry, replaced in the loop + for x in it[lastPos]: # transform `a/b/[c as d]` to `/a/b/c as d` if x.kind == nkInfix and x[0].ident.s == "as": - let impAs = copyTree(x) - imp[2] = x[1] + var impAs = copyNode(x) + newSons(impAs, 3) + impAs[0] = x[0] + imp[lastPos] = x[1] impAs[1] = imp - impMod(c, imp, result) + impAs[2] = x[2] + impMod(c, impAs, result) else: - imp[2] = x + imp[lastPos] = x impMod(c, imp, result) else: impMod(c, it, result) @@ -293,7 +369,6 @@ proc evalImport*(c: PContext, n: PNode): PNode = proc evalFrom*(c: PContext, n: PNode): PNode = result = newNodeI(nkImportStmt, n.info) checkMinSonsLen(n, 2, c.config) - n[0] = transformImportAs(c, n[0]) var m = myImportModule(c, n[0], result) if m != nil: n[0] = newSymNode(m) @@ -304,14 +379,15 @@ proc evalFrom*(c: PContext, n: PNode): PNode = if n[i].kind != nkNilLit: importSymbol(c, n[i], m, im.imported) c.addImport im + afterImport(c, m) proc evalImportExcept*(c: PContext, n: PNode): PNode = result = newNodeI(nkImportStmt, n.info) checkMinSonsLen(n, 2, c.config) - n[0] = transformImportAs(c, n[0]) var m = myImportModule(c, n[0], result) if m != nil: n[0] = newSymNode(m) addDecl(c, m, n.info) # add symbol to symbol table of module importAllSymbolsExcept(c, m, readExceptSet(c, n)) #importForwarded(c, m.ast, exceptSet, m) + afterImport(c, m) diff --git a/compiler/injectdestructors.nim b/compiler/injectdestructors.nim index b65391252..3dcc364a3 100644 --- a/compiler/injectdestructors.nim +++ b/compiler/injectdestructors.nim @@ -14,22 +14,31 @@ ## See doc/destructors.rst for a spec of the implemented rewrite rules import - intsets, strtabs, ast, astalgo, msgs, renderer, magicsys, types, idents, - strutils, options, dfa, lowerings, tables, modulegraphs, msgs, + ast, astalgo, msgs, renderer, magicsys, types, idents, + options, lowerings, modulegraphs, lineinfos, parampatterns, sighashes, liftdestructors, optimizer, - varpartitions + varpartitions, aliasanalysis, dfa, wordrecg -from trees import exprStructuralEquivalent, getRoot +import std/[strtabs, tables, strutils, intsets] + +when defined(nimPreviewSlimSystem): + import std/assertions + +from trees import exprStructuralEquivalent, getRoot, whichPragma type Con = object owner: PSym - g: ControlFlowGraph + when true: + g: ControlFlowGraph graph: ModuleGraph inLoop, inSpawn, inLoopCond: int uninit: IntSet # set of uninit'ed vars - uninitComputed: bool idgen: IdGenerator + body: PNode + otherUsage: TLineInfo + inUncheckedAssignSection: int + inEnsureMove: int Scope = object # we do scope-based memory management. # a scope is comparable to an nkStmtListExpr like @@ -37,6 +46,8 @@ type vars: seq[PSym] wasMoved: seq[PNode] final: seq[PNode] # finally section + locals: seq[PSym] + body: PNode needsTry: bool parent: ptr Scope @@ -46,181 +57,122 @@ type sinkArg const toDebug {.strdefine.} = "" +when toDebug.len > 0: + var shouldDebug = false + +template dbg(body) = + when toDebug.len > 0: + if shouldDebug: + body proc hasDestructor(c: Con; t: PType): bool {.inline.} = result = ast.hasDestructor(t) when toDebug.len > 0: # for more effective debugging - if not result and c.graph.config.selectedGC in {gcArc, gcOrc}: + if not result and c.graph.config.selectedGC in {gcArc, gcOrc, gcAtomicArc}: assert(not containsGarbageCollectedRef(t)) -template dbg(body) = - when toDebug.len > 0: - if c.owner.name.s == toDebug or toDebug == "always": - body - proc getTemp(c: var Con; s: var Scope; typ: PType; info: TLineInfo): PNode = - let sym = newSym(skTemp, getIdent(c.graph.cache, ":tmpD"), nextSymId c.idgen, c.owner, info) + let sym = newSym(skTemp, getIdent(c.graph.cache, ":tmpD"), c.idgen, c.owner, info) sym.typ = typ s.vars.add(sym) result = newSymNode(sym) -proc nestedScope(parent: var Scope): Scope = - Scope(vars: @[], wasMoved: @[], final: @[], needsTry: false, parent: addr(parent)) - -proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode): PNode -proc moveOrCopy(dest, ri: PNode; c: var Con; s: var Scope; isDecl = false): PNode - -import sets, hashes, tables - -proc hash(n: PNode): Hash = hash(cast[pointer](n)) - -type AliasCache = Table[(PNode, PNode), AliasKind] -proc aliasesCached(cache: var AliasCache, obj, field: PNode): AliasKind = - let key = (obj, field) - if not cache.hasKey(key): - cache[key] = aliases(obj, field) - cache[key] - -proc collectLastReads(cfg: ControlFlowGraph; cache: var AliasCache, lastReads, potLastReads: var IntSet; pc: var int, until: int) = - template aliasesCached(obj, field: PNode): untyped = - aliasesCached(cache, obj, field) - while pc < until: - case cfg[pc].kind - of def: - let potLastReadsCopy = potLastReads - for r in potLastReadsCopy: - if cfg[pc].n.aliasesCached(cfg[r].n) == yes: - # the path leads to a redefinition of 's' --> sink 's'. - lastReads.incl r - potLastReads.excl r - elif cfg[r].n.aliasesCached(cfg[pc].n) != no: - # only partially writes to 's' --> can't sink 's', so this def reads 's' - # or maybe writes to 's' --> can't sink 's' - cfg[r].n.comment = '\n' & $pc - potLastReads.excl r - - inc pc - of use: - let potLastReadsCopy = potLastReads - for r in potLastReadsCopy: - if cfg[pc].n.aliasesCached(cfg[r].n) != no or cfg[r].n.aliasesCached(cfg[pc].n) != no: - cfg[r].n.comment = '\n' & $pc - potLastReads.excl r - - potLastReads.incl pc - - inc pc - of goto: - pc += cfg[pc].dest - of fork: - var variantA = pc + 1 - var variantB = pc + cfg[pc].dest - var potLastReadsA, potLastReadsB = potLastReads - var lastReadsA, lastReadsB: IntSet - while variantA != variantB and max(variantA, variantB) < cfg.len and min(variantA, variantB) < until: - if variantA < variantB: - collectLastReads(cfg, cache, lastReadsA, potLastReadsA, variantA, min(variantB, until)) - else: - collectLastReads(cfg, cache, lastReadsB, potLastReadsB, variantB, min(variantA, until)) - - # Add those last reads that were turned into last reads on both branches - lastReads.incl lastReadsA * lastReadsB - # Add those last reads that were turned into last reads on only one branch, - # but where the read operation itself also belongs to only that branch - lastReads.incl (lastReadsA + lastReadsB) - potLastReads - - let oldPotLastReads = potLastReads - potLastReads = initIntSet() - - potLastReads.incl potLastReadsA + potLastReadsB - - # Remove potential last reads that were invalidated in a branch, - # but don't remove those which were turned into last reads on that branch - potLastReads.excl ((oldPotLastReads - potLastReadsA) - lastReadsA) - potLastReads.excl ((oldPotLastReads - potLastReadsB) - lastReadsB) - - pc = min(variantA, variantB) - -proc collectFirstWrites(cfg: ControlFlowGraph; alreadySeen: var HashSet[PNode]; pc: var int, until: int) = - while pc < until: - case cfg[pc].kind - of def: - var alreadySeenThisNode = false - for s in alreadySeen: - if cfg[pc].n.aliases(s) != no or s.aliases(cfg[pc].n) != no: - alreadySeenThisNode = true; break - if alreadySeenThisNode: cfg[pc].n.flags.excl nfFirstWrite - else: cfg[pc].n.flags.incl nfFirstWrite - - alreadySeen.incl cfg[pc].n - - inc pc - of use: - alreadySeen.incl cfg[pc].n - - inc pc - of goto: - pc += cfg[pc].dest - of fork: - var variantA = pc + 1 - var variantB = pc + cfg[pc].dest - var alreadySeenA, alreadySeenB = alreadySeen - while variantA != variantB and max(variantA, variantB) < cfg.len and min(variantA, variantB) < until: - if variantA < variantB: - collectFirstWrites(cfg, alreadySeenA, variantA, min(variantB, until)) - else: - collectFirstWrites(cfg, alreadySeenB, variantB, min(variantA, until)) +proc nestedScope(parent: var Scope; body: PNode): Scope = + Scope(vars: @[], locals: @[], wasMoved: @[], final: @[], body: body, needsTry: false, parent: addr(parent)) + +proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode; tmpFlags = {sfSingleUsedTemp}; inReturn = false): PNode + +type + MoveOrCopyFlag = enum + IsDecl, IsExplicitSink, IsReturn + +proc moveOrCopy(dest, ri: PNode; c: var Con; s: var Scope; flags: set[MoveOrCopyFlag] = {}): PNode + +when false: + var + perfCounters: array[InstrKind, int] + + proc showCounters*() = + for i in low(InstrKind)..high(InstrKind): + echo "INSTR ", i, " ", perfCounters[i] - alreadySeen.incl alreadySeenA + alreadySeenB +proc isLastReadImpl(n: PNode; c: var Con; scope: var Scope): bool = + let root = parampatterns.exprRoot(n, allowCalls=false) + if root == nil: return false - pc = min(variantA, variantB) + var s = addr(scope) + while s != nil: + if s.locals.contains(root): break + s = s.parent -proc isLastRead(n: PNode; c: var Con): bool = - let m = dfa.skipConvDfa(n) - (m.kind == nkSym and sfSingleUsedTemp in m.sym.flags) or nfLastRead in m.flags + c.g = constructCfg(c.owner, if s != nil: s.body else: c.body, root) + dbg: + echo "\n### ", c.owner.name.s, ":\nCFG:" + echoCfg(c.g) + #echo c.body + + var j = 0 + while j < c.g.len: + if c.g[j].kind == use and c.g[j].n == n: break + inc j + c.otherUsage = unknownLineInfo + if j < c.g.len: + var pcs = @[j+1] + var marked = initIntSet() + result = true + while pcs.len > 0: + var pc = pcs.pop() + if not marked.contains(pc): + let oldPc = pc + while pc < c.g.len: + dbg: + echo "EXEC ", c.g[pc].kind, " ", pc, " ", n + when false: + inc perfCounters[c.g[pc].kind] + case c.g[pc].kind + of loop: + let back = pc + c.g[pc].dest + if not marked.containsOrIncl(back): + pc = back + else: + break + of goto: + pc = pc + c.g[pc].dest + of fork: + if not marked.contains(pc+1): + pcs.add pc + 1 + pc = pc + c.g[pc].dest + of use: + if c.g[pc].n.aliases(n) != no or n.aliases(c.g[pc].n) != no: + c.otherUsage = c.g[pc].n.info + return false + inc pc + of def: + if c.g[pc].n.aliases(n) == yes: + # the path leads to a redefinition of 's' --> sink 's'. + break + elif n.aliases(c.g[pc].n) != no: + # only partially writes to 's' --> can't sink 's', so this def reads 's' + # or maybe writes to 's' --> can't sink 's' + c.otherUsage = c.g[pc].n.info + return false + inc pc + marked.incl oldPc + else: + result = false + +proc isLastRead(n: PNode; c: var Con; s: var Scope): bool = + # bug #23354; an object type could have a non-trival assignements when it is passed to a sink parameter + if not hasDestructor(c, n.typ) and (n.typ.kind != tyObject or isTrival(getAttachedOp(c.graph, n.typ, attachedAsgn))): return true + + let m = skipConvDfa(n) + result = (m.kind == nkSym and sfSingleUsedTemp in m.sym.flags) or + isLastReadImpl(n, c, s) proc isFirstWrite(n: PNode; c: var Con): bool = - let m = dfa.skipConvDfa(n) - nfFirstWrite in m.flags - -proc initialized(code: ControlFlowGraph; pc: int, - init, uninit: var IntSet; until: int): int = - ## Computes the set of definitely initialized variables across all code paths - ## as an IntSet of IDs. - var pc = pc - while pc < code.len: - case code[pc].kind - of goto: - pc += code[pc].dest - of fork: - var initA = initIntSet() - var initB = initIntSet() - var variantA = pc + 1 - var variantB = pc + code[pc].dest - while variantA != variantB: - if max(variantA, variantB) > until: - break - if variantA < variantB: - variantA = initialized(code, variantA, initA, uninit, min(variantB, until)) - else: - variantB = initialized(code, variantB, initB, uninit, min(variantA, until)) - pc = min(variantA, variantB) - # we add vars if they are in both branches: - for v in initA: - if v in initB: - init.incl v - of use: - let v = code[pc].n.sym - if v.kind != skParam and v.id notin init: - # attempt to read an uninit'ed variable - uninit.incl v.id - inc pc - of def: - let v = code[pc].n.sym - init.incl v.id - inc pc - return pc + let m = skipConvDfa(n) + result = nfFirstWrite in m.flags proc isCursor(n: PNode): bool = case n.kind @@ -236,41 +188,52 @@ proc isCursor(n: PNode): bool = template isUnpackedTuple(n: PNode): bool = ## we move out all elements of unpacked tuples, ## hence unpacked tuples themselves don't need to be destroyed - (n.kind == nkSym and n.sym.kind == skTemp and n.sym.typ.kind == tyTuple) + ## except it's already a cursor + (n.kind == nkSym and n.sym.kind == skTemp and + n.sym.typ.kind == tyTuple and sfCursor notin n.sym.flags) -from strutils import parseInt - -proc checkForErrorPragma(c: Con; t: PType; ri: PNode; opname: string) = +proc checkForErrorPragma(c: Con; t: PType; ri: PNode; opname: string; inferredFromCopy = false) = var m = "'" & opname & "' is not available for type <" & typeToString(t) & ">" - if (opname == "=" or opname == "=copy") and ri != nil: + if inferredFromCopy: + m.add ", which is inferred from unavailable '=copy'" + + if (opname == "=" or opname == "=copy" or opname == "=dup") 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'): + if c.otherUsage != unknownLineInfo: + # 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 + m.add c.graph.config $ c.otherUsage + #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 + #m.add "\n\n" + #m.add renderTree(c.body, {renderIds}) localError(c.graph.config, ri.info, errGenerated, m) proc makePtrType(c: var Con, baseType: PType): PType = - result = newType(tyPtr, nextTypeId c.idgen, c.owner) + result = newType(tyPtr, c.idgen, c.owner) addSonSkipIntLit(result, baseType, c.idgen) proc genOp(c: var Con; op: PSym; dest: PNode): PNode = - let addrExp = newNodeIT(nkHiddenAddr, dest.info, makePtrType(c, dest.typ)) - addrExp.add(dest) + var addrExp: PNode + if op.typ != nil and op.typ.signatureLen > 1 and op.typ.firstParamType.kind != tyVar: + addrExp = dest + else: + addrExp = newNodeIT(nkHiddenAddr, dest.info, makePtrType(c, dest.typ)) + addrExp.add(dest) result = newTree(nkCall, newSymNode(op), addrExp) proc genOp(c: var Con; t: PType; kind: TTypeAttachedOp; dest, ri: PNode): PNode = var op = getAttachedOp(c.graph, t, kind) if op == nil or op.ast.isGenericRoutine: # give up and find the canonical type instead: - let h = sighashes.hashType(t, {CoType, CoConsiderOwned, CoDistinct}) + let h = sighashes.hashType(t, c.graph.config, {CoType, CoConsiderOwned, CoDistinct}) let canon = c.graph.canonTypes.getOrDefault(h) if canon != nil: op = getAttachedOp(c.graph, canon, kind) @@ -301,10 +264,20 @@ proc canBeMoved(c: Con; t: PType): bool {.inline.} = proc isNoInit(dest: PNode): bool {.inline.} = result = dest.kind == nkSym and sfNoInit in dest.sym.flags -proc genSink(c: var Con; dest, ri: PNode, isDecl = false): PNode = - if (c.inLoopCond == 0 and (isUnpackedTuple(dest) or isDecl or +proc deepAliases(dest, ri: PNode): bool = + case ri.kind + of nkCallKinds, nkStmtListExpr, nkBracket, nkTupleConstr, nkObjConstr, + nkCast, nkConv, nkObjUpConv, nkObjDownConv: + for r in ri: + if deepAliases(dest, r): return true + return false + else: + return aliases(dest, ri) != no + +proc genSink(c: var Con; s: var Scope; dest, ri: PNode; flags: set[MoveOrCopyFlag] = {}): PNode = + if (c.inLoopCond == 0 and (isUnpackedTuple(dest) or IsDecl in flags or (isAnalysableFieldAccess(dest, c.owner) and isFirstWrite(dest, c)))) or - isNoInit(dest): + isNoInit(dest) or IsReturn in flags: # optimize sink call into a bitwise memcopy result = newTree(nkFastAsgn, dest, ri) else: @@ -315,12 +288,19 @@ proc genSink(c: var Con; dest, ri: PNode, isDecl = false): PNode = else: # the default is to use combination of `=destroy(dest)` and # and copyMem(dest, source). This is efficient. - result = newTree(nkStmtList, c.genDestroy(dest), newTree(nkFastAsgn, dest, ri)) + if deepAliases(dest, ri): + # consider: x = x + y, it is wrong to destroy the destination first! + # tmp to support self assignments + let tmp = c.getTemp(s, dest.typ, dest.info) + result = newTree(nkStmtList, newTree(nkFastAsgn, tmp, dest), newTree(nkFastAsgn, dest, ri), + c.genDestroy(tmp)) + else: + result = newTree(nkStmtList, c.genDestroy(dest), newTree(nkFastAsgn, dest, ri)) proc isCriticalLink(dest: PNode): bool {.inline.} = #[ Lins's idea that only "critical" links can introduce a cycle. This is - critical for the performance gurantees that we strive for: If you + critical for the performance guarantees that we strive for: If you traverse a data structure, no tracing will be performed at all. ORC is about this promise: The GC only touches the memory that the mutator touches too. @@ -337,16 +317,17 @@ proc isCriticalLink(dest: PNode): bool {.inline.} = ]# result = dest.kind != nkSym -proc finishCopy(c: var Con; result, dest: PNode; isFromSink: bool) = - if c.graph.config.selectedGC == gcOrc: - let t = dest.typ.skipTypes({tyGenericInst, tyAlias, tySink, tyDistinct}) - if cyclicType(t): +proc finishCopy(c: var Con; result, dest: PNode; flags: set[MoveOrCopyFlag]; isFromSink: bool) = + if c.graph.config.selectedGC == gcOrc and IsExplicitSink notin flags: + # add cyclic flag, but not to sink calls, which IsExplicitSink generates + let t = dest.typ.skipTypes(tyUserTypeClasses + {tyGenericInst, tyAlias, tySink, tyDistinct}) + if cyclicType(c.graph, t): result.add boolLit(c.graph, result.info, isFromSink or isCriticalLink(dest)) proc genMarkCyclic(c: var Con; result, dest: PNode) = if c.graph.config.selectedGC == gcOrc: let t = dest.typ.skipTypes({tyGenericInst, tyAlias, tySink, tyDistinct}) - if cyclicType(t): + if cyclicType(c.graph, t): if t.kind == tyRef: result.add callCodegenProc(c.graph, "nimMarkCyclic", dest.info, dest) else: @@ -354,16 +335,25 @@ proc genMarkCyclic(c: var Con; result, dest: PNode) = xenv.typ = getSysType(c.graph, dest.info, tyPointer) result.add callCodegenProc(c.graph, "nimMarkCyclic", dest.info, xenv) -proc genCopyNoCheck(c: var Con; dest, ri: PNode): PNode = +proc genCopyNoCheck(c: var Con; dest, ri: PNode; a: TTypeAttachedOp): PNode = let t = dest.typ.skipTypes({tyGenericInst, tyAlias, tySink}) - result = c.genOp(t, attachedAsgn, dest, ri) + result = c.genOp(t, a, dest, ri) + assert ri.typ != nil -proc genCopy(c: var Con; dest, ri: PNode): PNode = +proc genCopy(c: var Con; dest, ri: PNode; flags: set[MoveOrCopyFlag]): PNode = + if c.inEnsureMove > 0: + localError(c.graph.config, ri.info, errFailedMove, "cannot move '" & $ri & + "', which introduces an implicit copy") let t = dest.typ if tfHasOwned in t.flags and ri.kind != nkNilLit: # try to improve the error message here: - c.checkForErrorPragma(t, ri, "=copy") - result = c.genCopyNoCheck(dest, ri) + if IsExplicitSink in flags: + c.checkForErrorPragma(t, ri, "=sink") + else: + c.checkForErrorPragma(t, ri, "=copy") + let a = if IsExplicitSink in flags: attachedSink else: attachedAsgn + result = c.genCopyNoCheck(dest, ri, a) + assert ri.typ != nil proc genDiscriminantAsgn(c: var Con; s: var Scope; n: PNode): PNode = # discriminator is ordinal value that doesn't need sink destroy @@ -382,30 +372,38 @@ 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: + sfOverridden 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""") result.add newTree(nkFastAsgn, le, tmp) return # generate: if le != tmp: `=destroy`(le) - let branchDestructor = produceDestructorForDiscriminator(c.graph, objType, leDotExpr[1].sym, n.info, c.idgen) - let cond = newNodeIT(nkInfix, n.info, getSysType(c.graph, unknownLineInfo, tyBool)) - cond.add newSymNode(getMagicEqSymForType(c.graph, le.typ, n.info)) - cond.add le - cond.add tmp - let notExpr = newNodeIT(nkPrefix, n.info, getSysType(c.graph, unknownLineInfo, tyBool)) - notExpr.add newSymNode(createMagic(c.graph, c.idgen, "not", mNot)) - notExpr.add cond - result.add newTree(nkIfStmt, newTree(nkElifBranch, notExpr, c.genOp(branchDestructor, le))) + if c.inUncheckedAssignSection != 0: + let branchDestructor = produceDestructorForDiscriminator(c.graph, objType, leDotExpr[1].sym, n.info, c.idgen) + let cond = newNodeIT(nkInfix, n.info, getSysType(c.graph, unknownLineInfo, tyBool)) + cond.add newSymNode(getMagicEqSymForType(c.graph, le.typ, n.info)) + cond.add le + cond.add tmp + let notExpr = newNodeIT(nkPrefix, n.info, getSysType(c.graph, unknownLineInfo, tyBool)) + notExpr.add newSymNode(createMagic(c.graph, c.idgen, "not", mNot)) + notExpr.add cond + result.add newTree(nkIfStmt, newTree(nkElifBranch, notExpr, c.genOp(branchDestructor, le))) result.add newTree(nkFastAsgn, le, tmp) proc genWasMoved(c: var Con, n: PNode): PNode = - result = newNodeI(nkCall, n.info) - result.add(newSymNode(createMagic(c.graph, c.idgen, "wasMoved", mWasMoved))) - result.add copyTree(n) #mWasMoved does not take the address - #if n.kind != nkSym: - # message(c.graph.config, n.info, warnUser, "wasMoved(" & $n & ")") + let typ = n.typ.skipTypes({tyGenericInst, tyAlias, tySink}) + let op = getAttachedOp(c.graph, n.typ, attachedWasMoved) + if op != nil: + if sfError in op.flags: + c.checkForErrorPragma(n.typ, n, "=wasMoved") + result = genOp(c, op, n) + else: + result = newNodeI(nkCall, n.info) + result.add(newSymNode(createMagic(c.graph, c.idgen, "`=wasMoved`", mWasMoved))) + result.add copyTree(n) #mWasMoved does not take the address + #if n.kind != nkSym: + # message(c.graph.config, n.info, warnUser, "wasMoved(" & $n & ")") proc genDefaultCall(t: PType; c: Con; info: TLineInfo): PNode = result = newNodeI(nkCall, info) @@ -414,13 +412,16 @@ proc genDefaultCall(t: PType; c: Con; info: TLineInfo): PNode = proc destructiveMoveVar(n: PNode; c: var Con; s: var Scope): PNode = # generate: (let tmp = v; reset(v); tmp) - if not hasDestructor(c, n.typ): - assert n.kind != nkSym or not hasDestructor(c, n.sym.typ) + if (not hasDestructor(c, n.typ)) and c.inEnsureMove == 0: + assert n.kind != nkSym or not hasDestructor(c, n.sym.typ) or + (n.typ.kind == tyPtr and n.sym.typ.kind == tyRef) + # bug #23505; transformed by `transf`: addr (deref ref) -> ptr + # we know it's really a pointer; so here we assign it directly result = copyTree(n) else: result = newNodeIT(nkStmtListExpr, n.info, n.typ) - var temp = newSym(skLet, getIdent(c.graph.cache, "blitTmp"), nextSymId c.idgen, c.owner, n.info) + var temp = newSym(skLet, getIdent(c.graph.cache, "blitTmp"), c.idgen, c.owner, n.info) temp.typ = n.typ var v = newNodeI(nkLetSection, n.info) let tempAsNode = newSymNode(temp) @@ -433,7 +434,8 @@ proc destructiveMoveVar(n: PNode; c: var Con; s: var Scope): PNode = result.add v let nn = skipConv(n) - c.genMarkCyclic(result, nn) + if hasDestructor(c, n.typ): + c.genMarkCyclic(result, nn) let wasMovedCall = c.genWasMoved(nn) result.add wasMovedCall result.add tempAsNode @@ -441,24 +443,50 @@ proc destructiveMoveVar(n: PNode; c: var Con; s: var Scope): PNode = proc isCapturedVar(n: PNode): bool = let root = getRoot(n) if root != nil: result = root.name.s[0] == ':' + else: result = false proc passCopyToSink(n: PNode; c: var Con; s: var Scope): PNode = result = newNodeIT(nkStmtListExpr, n.info, n.typ) - let tmp = c.getTemp(s, n.typ, n.info) - if hasDestructor(c, n.typ): - result.add c.genWasMoved(tmp) - var m = c.genCopy(tmp, n) - 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: + let nTyp = n.typ.skipTypes(tyUserTypeClasses) + let tmp = c.getTemp(s, nTyp, n.info) + if hasDestructor(c, nTyp): + let typ = nTyp.skipTypes({tyGenericInst, tyAlias, tySink}) + let op = getAttachedOp(c.graph, typ, attachedDup) + if op != nil and tfHasOwned notin typ.flags: + if sfError in op.flags: + c.checkForErrorPragma(nTyp, n, "=dup") + else: + let copyOp = getAttachedOp(c.graph, typ, attachedAsgn) + if copyOp != nil and sfError in copyOp.flags and + sfOverridden notin op.flags: + c.checkForErrorPragma(nTyp, n, "=dup", inferredFromCopy = true) + + let src = p(n, c, s, normal) + var newCall = newTreeIT(nkCall, src.info, src.typ, + newSymNode(op), + src) + c.finishCopy(newCall, n, {}, isFromSink = true) + result.add newTreeI(nkFastAsgn, + src.info, tmp, + newCall + ) + else: + result.add c.genWasMoved(tmp) + var m = c.genCopy(tmp, n, {}) + m.add p(n, c, s, normal) + c.finishCopy(m, n, {}, isFromSink = true) + result.add m + if isLValue(n) and not isCapturedVar(n) and nTyp.skipTypes(abstractInst).kind != tyRef and c.inSpawn == 0: message(c.graph.config, n.info, hintPerformance, ("passing '$1' to a sink parameter introduces an implicit copy; " & "if possible, rearrange your program's control flow to prevent it") % $n) + if c.inEnsureMove > 0: + localError(c.graph.config, n.info, errFailedMove, + ("cannot move '$1', passing '$1' to a sink parameter introduces an implicit copy") % $n) else: - if c.graph.config.selectedGC in {gcArc, gcOrc}: - assert(not containsManagedMemory(n.typ)) - if n.typ.skipTypes(abstractInst).kind in {tyOpenArray, tyVarargs}: + if c.graph.config.selectedGC in {gcArc, gcOrc, gcAtomicArc}: + assert(not containsManagedMemory(nTyp)) + if nTyp.skipTypes(abstractInst).kind in {tyOpenArray, tyVarargs}: localError(c.graph.config, n.info, "cannot create an implicit openArray copy to be passed to a sink parameter") result.add newTree(nkAsgn, tmp, p(n, c, s, normal)) # Since we know somebody will take over the produced copy, there is @@ -467,14 +495,14 @@ proc passCopyToSink(n: PNode; c: var Con; s: var Scope): PNode = proc isDangerousSeq(t: PType): bool {.inline.} = let t = t.skipTypes(abstractInst) - result = t.kind == tySequence and tfHasOwned notin t[0].flags + result = t.kind == tySequence and tfHasOwned notin t.elementType.flags proc containsConstSeq(n: PNode): bool = if n.kind == nkBracket and n.len > 0 and n.typ != nil and isDangerousSeq(n.typ): return true result = false case n.kind - of nkExprEqExpr, nkExprColonExpr, nkHiddenStdConv, nkHiddenSubConv: + of nkExprEqExpr, nkExprColonExpr, nkHiddenStdConv, nkHiddenSubConv, nkCast: result = containsConstSeq(n[1]) of nkObjConstr, nkClosure: for i in 1..<n.len: @@ -492,14 +520,14 @@ proc ensureDestruction(arg, orig: PNode; c: var Con; s: var Scope): PNode = # This was already done in the sink parameter handling logic. result = newNodeIT(nkStmtListExpr, arg.info, arg.typ) let tmp = c.getTemp(s, arg.typ, arg.info) - result.add c.genSink(tmp, arg, isDecl = true) + result.add c.genSink(s, tmp, arg, {IsDecl}) result.add tmp s.final.add c.genDestroy(tmp) else: result = arg proc cycleCheck(n: PNode; c: var Con) = - if c.graph.config.selectedGC != gcArc: return + if c.graph.config.selectedGC notin {gcArc, gcAtomicArc}: return var value = n[1] if value.kind == nkClosure: value = value[1] @@ -537,7 +565,7 @@ proc pVarTopLevel(v: PNode; c: var Con; s: var Scope; res: PNode) = res.add newTree(nkFastAsgn, v, genDefaultCall(v.typ, c, v.info)) elif sfThread notin v.sym.flags and sfCursor notin v.sym.flags: # do not destroy thread vars for now at all for consistency. - if sfGlobal in v.sym.flags and s.parent == nil: #XXX: Rethink this logic (see tarcmisc.test2) + if {sfGlobal, sfPure} <= v.sym.flags or sfGlobal in v.sym.flags and s.parent == nil: c.graph.globalDestructors.add c.genDestroy(v) else: s.final.add c.genDestroy(v) @@ -564,16 +592,19 @@ proc processScope(c: var Con; s: var Scope; ret: PNode): PNode = if s.parent != nil: s.parent[].needsTry = s.parent[].needsTry or s.needsTry -template processScopeExpr(c: var Con; s: var Scope; ret: PNode, processCall: untyped): PNode = +template processScopeExpr(c: var Con; s: var Scope; ret: PNode, processCall: untyped, tmpFlags: TSymFlags): PNode = assert not ret.typ.isEmptyType - var result = newNodeI(nkStmtListExpr, ret.info) + var result = newNodeIT(nkStmtListExpr, ret.info, ret.typ) # There is a possibility to do this check: s.wasMoved.len > 0 or s.final.len > 0 # later and use it to eliminate the temporary when theres no need for it, but its # tricky because you would have to intercept moveOrCopy at a certain point let tmp = c.getTemp(s.parent[], ret.typ, ret.info) - tmp.sym.flags.incl sfSingleUsedTemp - let cpy = if hasDestructor(c, ret.typ): - moveOrCopy(tmp, ret, c, s, isDecl = true) + tmp.sym.flags = tmpFlags + let cpy = if hasDestructor(c, ret.typ) and + ret.typ.kind notin {tyOpenArray, tyVarargs}: + # bug #23247 we don't own the data, so it's harmful to destroy it + s.parent[].final.add c.genDestroy(tmp) + moveOrCopy(tmp, ret, c, s, {IsDecl}) else: newTree(nkFastAsgn, tmp, p(ret, c, s, normal)) @@ -597,7 +628,8 @@ template processScopeExpr(c: var Con; s: var Scope; ret: PNode, processCall: unt result -template handleNestedTempl(n, processCall: untyped, willProduceStmt = false) = +template handleNestedTempl(n, processCall: untyped, willProduceStmt = false, + tmpFlags = {sfSingleUsedTemp}) = template maybeVoid(child, s): untyped = if isEmptyType(child.typ): p(child, c, s, normal) else: processCall(child, s) @@ -621,11 +653,11 @@ template handleNestedTempl(n, processCall: untyped, willProduceStmt = false) = var branch = shallowCopy(it) for j in 0 ..< it.len-1: branch[j] = copyTree(it[j]) - var ofScope = nestedScope(s) - branch[^1] = if it[^1].typ.isEmptyType or willProduceStmt: + var ofScope = nestedScope(s, it.lastSon) + branch[^1] = if n.typ.isEmptyType or it[^1].typ.isEmptyType or willProduceStmt: processScope(c, ofScope, maybeVoid(it[^1], ofScope)) else: - processScopeExpr(c, ofScope, it[^1], processCall) + processScopeExpr(c, ofScope, it[^1], processCall, tmpFlags) result.add branch of nkWhileStmt: @@ -634,7 +666,7 @@ template handleNestedTempl(n, processCall: untyped, willProduceStmt = false) = result = copyNode(n) result.add p(n[0], c, s, normal) dec c.inLoopCond - var bodyScope = nestedScope(s) + var bodyScope = nestedScope(s, n[1]) let bodyResult = p(n[1], c, bodyScope, normal) result.add processScope(c, bodyScope, bodyResult) dec c.inLoop @@ -646,7 +678,7 @@ template handleNestedTempl(n, processCall: untyped, willProduceStmt = false) = for i in 0..<last-1: result[i] = n[i] result[last-1] = p(n[last-1], c, s, normal) - var bodyScope = nestedScope(s) + var bodyScope = nestedScope(s, n[1]) let bodyResult = p(n[last], c, bodyScope, normal) result[last] = processScope(c, bodyScope, bodyResult) dec c.inLoop @@ -654,51 +686,71 @@ template handleNestedTempl(n, processCall: untyped, willProduceStmt = false) = of nkBlockStmt, nkBlockExpr: result = copyNode(n) result.add n[0] - var bodyScope = nestedScope(s) + var bodyScope = nestedScope(s, n[1]) result.add if n[1].typ.isEmptyType or willProduceStmt: processScope(c, bodyScope, processCall(n[1], bodyScope)) else: - processScopeExpr(c, bodyScope, n[1], processCall) + processScopeExpr(c, bodyScope, n[1], processCall, tmpFlags) of nkIfStmt, nkIfExpr: result = copyNode(n) for i in 0..<n.len: let it = n[i] var branch = shallowCopy(it) - var branchScope = nestedScope(s) + var branchScope = nestedScope(s, it.lastSon) if it.kind in {nkElifBranch, nkElifExpr}: #Condition needs to be destroyed outside of the condition/branch scope branch[0] = p(it[0], c, s, normal) - branch[^1] = if it[^1].typ.isEmptyType or willProduceStmt: + branch[^1] = if n.typ.isEmptyType or it[^1].typ.isEmptyType or willProduceStmt: processScope(c, branchScope, maybeVoid(it[^1], branchScope)) else: - processScopeExpr(c, branchScope, it[^1], processCall) + processScopeExpr(c, branchScope, it[^1], processCall, tmpFlags) result.add branch of nkTryStmt: result = copyNode(n) - var tryScope = nestedScope(s) + var tryScope = nestedScope(s, n[0]) result.add if n[0].typ.isEmptyType or willProduceStmt: processScope(c, tryScope, maybeVoid(n[0], tryScope)) else: - processScopeExpr(c, tryScope, n[0], maybeVoid) + processScopeExpr(c, tryScope, n[0], maybeVoid, tmpFlags) for i in 1..<n.len: let it = n[i] var branch = copyTree(it) - var branchScope = nestedScope(s) + var branchScope = nestedScope(s, it[^1]) branch[^1] = if it[^1].typ.isEmptyType or willProduceStmt or it.kind == nkFinally: processScope(c, branchScope, if it.kind == nkFinally: p(it[^1], c, branchScope, normal) else: maybeVoid(it[^1], branchScope)) else: - processScopeExpr(c, branchScope, it[^1], processCall) + processScopeExpr(c, branchScope, it[^1], processCall, tmpFlags) result.add branch of nkWhen: # This should be a "when nimvm" node. result = copyTree(n) result[1][0] = processCall(n[1][0], s) - else: assert(false) + + of nkPragmaBlock: + var inUncheckedAssignSection = 0 + let pragmaList = n[0] + for pi in pragmaList: + if whichPragma(pi) == wCast: + case whichPragma(pi[1]) + of wUncheckedAssign: + inUncheckedAssignSection = 1 + else: + discard + result = shallowCopy(n) + inc c.inUncheckedAssignSection, inUncheckedAssignSection + for i in 0 ..< n.len-1: + result[i] = p(n[i], c, s, normal) + result[^1] = maybeVoid(n[^1], s) + dec c.inUncheckedAssignSection, inUncheckedAssignSection + + else: + result = nil + assert(false) proc pRaiseStmt(n: PNode, c: var Con; s: var Scope): PNode = if optOwnedRefs in c.graph.config.globalOptions and n[0].kind != nkEmpty: @@ -708,9 +760,9 @@ proc pRaiseStmt(n: PNode, c: var Con; s: var Scope): PNode = result.add call else: let tmp = c.getTemp(s, n[0].typ, n.info) - var m = c.genCopyNoCheck(tmp, n[0]) + var m = c.genCopyNoCheck(tmp, n[0], attachedAsgn) m.add p(n[0], c, s, normal) - c.finishCopy(m, n[0], isFromSink = false) + c.finishCopy(m, n[0], {}, isFromSink = false) result = newTree(nkStmtList, c.genWasMoved(tmp), m) var toDisarm = n[0] if toDisarm.kind == nkStmtListExpr: toDisarm = toDisarm.lastSon @@ -725,11 +777,23 @@ proc pRaiseStmt(n: PNode, c: var Con; s: var Scope): PNode = result.add copyNode(n[0]) s.needsTry = true -proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode): PNode = +template isCustomDestructor(c: Con, t: PType): bool = + hasDestructor(c, t) and + getAttachedOp(c.graph, t, attachedDestructor) != nil and + sfOverridden in getAttachedOp(c.graph, t, attachedDestructor).flags + +proc hasCustomDestructor(c: Con, t: PType): bool = + result = isCustomDestructor(c, t) + var obj = t + while obj.baseClass != nil: + obj = skipTypes(obj.baseClass, abstractPtrs) + result = result or isCustomDestructor(c, obj) + +proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode; tmpFlags = {sfSingleUsedTemp}; inReturn = false): PNode = if n.kind in {nkStmtList, nkStmtListExpr, nkBlockStmt, nkBlockExpr, nkIfStmt, - nkIfExpr, nkCaseStmt, nkWhen, nkWhileStmt, nkParForStmt, nkTryStmt}: + nkIfExpr, nkCaseStmt, nkWhen, nkWhileStmt, nkParForStmt, nkTryStmt, nkPragmaBlock}: template process(child, s): untyped = p(child, c, s, mode) - handleNestedTempl(n, process) + handleNestedTempl(n, process, tmpFlags = tmpFlags) elif mode == sinkArg: if n.containsConstSeq: # const sequences are not mutable and so we need to pass a copy to the @@ -738,9 +802,17 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode): PNode = result = passCopyToSink(n, c, s) elif n.kind in {nkBracket, nkObjConstr, nkTupleConstr, nkClosure, nkNilLit} + nkCallKinds + nkLiterals: - result = p(n, c, s, consumed) + if n.kind in nkCallKinds and n[0].kind == nkSym: + if n[0].sym.magic == mEnsureMove: + inc c.inEnsureMove + result = p(n[1], c, s, sinkArg) + dec c.inEnsureMove + else: + result = p(n, c, s, consumed) + else: + result = p(n, c, s, consumed) elif ((n.kind == nkSym and isSinkParam(n.sym)) or isAnalysableFieldAccess(n, c.owner)) and - isLastRead(n, c) and not (n.kind == nkSym and isCursor(n)): + isLastRead(n, c, s) and not (n.kind == nkSym and isCursor(n)): # Sinked params can be consumed only once. We need to reset the memory # to disable the destructor which we have not elided result = destructiveMoveVar(n, c, s) @@ -758,6 +830,9 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode): PNode = elif n.kind in {nkObjDownConv, nkObjUpConv}: result = copyTree(n) result[0] = p(n[0], c, s, sinkArg) + elif n.kind == nkCast and n.typ.skipTypes(abstractInst).kind in {tyString, tySequence}: + result = copyTree(n) + result[1] = p(n[1], c, s, sinkArg) elif n.typ == nil: # 'raise X' can be part of a 'case' expression. Deal with it here: result = p(n, c, s, normal) @@ -766,7 +841,7 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode): PNode = result = passCopyToSink(n, c, s) else: case n.kind - of nkBracket, nkObjConstr, nkTupleConstr, nkClosure, nkCurly: + of nkBracket, nkTupleConstr, nkClosure, nkCurly: # Let C(x) be the construction, 'x' the vector of arguments. # C(x) either owns 'x' or it doesn't. # If C(x) owns its data, we must consume C(x). @@ -777,13 +852,11 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode): PNode = # don't destroy it" # but if C(x) is a ref it MUST own its data since we must destroy it # so then we have no choice but to use 'sinkArg'. - let isRefConstr = n.kind == nkObjConstr and n.typ.skipTypes(abstractInst).kind == tyRef - let m = if isRefConstr: sinkArg - elif mode == normal: normal + let m = if mode == normal: normal else: sinkArg result = copyTree(n) - for i in ord(n.kind in {nkObjConstr, nkClosure})..<n.len: + for i in ord(n.kind == nkClosure)..<n.len: if n[i].kind == nkExprColonExpr: result[i][1] = p(n[i][1], c, s, m) elif n[i].kind == nkRange: @@ -791,17 +864,43 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode): PNode = result[i][1] = p(n[i][1], c, s, m) else: result[i] = p(n[i], c, s, m) - if mode == normal and isRefConstr: + of nkObjConstr: + # see also the remark about `nkTupleConstr`. + let t = n.typ.skipTypes(abstractInst) + let isRefConstr = t.kind == tyRef + let m = if isRefConstr: sinkArg + elif mode == normal: normal + else: sinkArg + + result = copyTree(n) + for i in 1..<n.len: + if n[i].kind == nkExprColonExpr: + let field = lookupFieldAgain(t, n[i][0].sym) + if field != nil and (sfCursor in field.flags or field.typ.kind in {tyOpenArray, tyVarargs}): + # don't sink fields with openarray types + result[i][1] = p(n[i][1], c, s, normal) + else: + result[i][1] = p(n[i][1], c, s, m) + else: + result[i] = p(n[i], c, s, m) + if mode == normal and (isRefConstr or hasCustomDestructor(c, t)): result = ensureDestruction(result, n, c, s) of nkCallKinds: + if n[0].kind == nkSym and n[0].sym.magic == mEnsureMove: + inc c.inEnsureMove + result = p(n[1], c, s, sinkArg) + dec c.inEnsureMove + return + let inSpawn = c.inSpawn if n[0].kind == nkSym and n[0].sym.magic == mSpawn: c.inSpawn.inc elif c.inSpawn > 0: c.inSpawn.dec - let parameters = n[0].typ - let L = if parameters != nil: parameters.len else: 0 + # bug #23907; skips tyGenericInst for generic callbacks + let parameters = if n[0].typ != nil: n[0].typ.skipTypes(abstractInst) else: n[0].typ + let L = if parameters != nil: parameters.signatureLen else: 0 when false: var isDangerous = false @@ -824,14 +923,17 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode): PNode = if n[0].kind == nkSym and n[0].sym.magic in {mNew, mNewFinalize}: result[0] = copyTree(n[0]) - if c.graph.config.selectedGC in {gcHooks, gcArc, gcOrc}: + if c.graph.config.selectedGC in {gcHooks, gcArc, gcAtomicArc, gcOrc}: let destroyOld = c.genDestroy(result[1]) result = newTree(nkStmtList, destroyOld, result) else: result[0] = p(n[0], c, s, normal) if canRaise(n[0]): s.needsTry = true if mode == normal: - result = ensureDestruction(result, n, c, s) + if result.typ != nil and result.typ.kind notin {tyOpenArray, tyVarargs}: + # Returns of openarray types shouldn't be destroyed + # bug #19435; # bug #23247 + result = ensureDestruction(result, n, c, s) of nkDiscardStmt: # Small optimization result = shallowCopy(n) if n[0].kind != nkEmpty: @@ -844,32 +946,45 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode): PNode = for it in n: var ri = it[^1] if it.kind == nkVarTuple and hasDestructor(c, ri.typ): + for i in 0..<it.len-2: + if it[i].kind == nkSym: s.locals.add it[i].sym let x = lowerTupleUnpacking(c.graph, it, c.idgen, c.owner) result.add p(x, c, s, consumed) - elif it.kind == nkIdentDefs and hasDestructor(c, it[0].typ): + elif it.kind == nkIdentDefs and hasDestructor(c, skipPragmaExpr(it[0]).typ): for j in 0..<it.len-2: - let v = it[j] + let v = skipPragmaExpr(it[j]) if v.kind == nkSym: if sfCompileTime in v.sym.flags: continue + s.locals.add v.sym pVarTopLevel(v, c, s, result) if ri.kind != nkEmpty: - result.add moveOrCopy(v, ri, c, s, isDecl = v.kind == nkSym) + result.add moveOrCopy(v, ri, c, s, if v.kind == nkSym: {IsDecl} else: {}) elif ri.kind == nkEmpty and c.inLoop > 0: - result.add moveOrCopy(v, genDefaultCall(v.typ, c, v.info), c, s, isDecl = v.kind == nkSym) + let skipInit = v.kind == nkDotExpr and # Closure var + sfNoInit in v[1].sym.flags + if not skipInit: + result.add moveOrCopy(v, genDefaultCall(v.typ, c, v.info), c, s, if v.kind == nkSym: {IsDecl} else: {}) else: # keep the var but transform 'ri': var v = copyNode(n) var itCopy = copyNode(it) for j in 0..<it.len-1: itCopy.add it[j] - itCopy.add p(it[^1], c, s, normal) + var flags = {sfSingleUsedTemp} + if it.kind == nkIdentDefs and it.len == 3 and it[0].kind == nkSym and + sfGlobal in it[0].sym.flags: + flags.incl sfGlobal + itCopy.add p(it[^1], c, s, normal, tmpFlags = flags) v.add itCopy result.add v - of nkAsgn, nkFastAsgn: + of nkAsgn, nkFastAsgn, nkSinkAsgn: if hasDestructor(c, n[0].typ) and n[1].kind notin {nkProcDef, nkDo, nkLambda}: if n[0].kind in {nkDotExpr, nkCheckedFieldExpr}: cycleCheck(n, c) - assert n[1].kind notin {nkAsgn, nkFastAsgn} - result = moveOrCopy(p(n[0], c, s, mode), n[1], c, s) + assert n[1].kind notin {nkAsgn, nkFastAsgn, nkSinkAsgn} + var flags = if n.kind == nkSinkAsgn: {IsExplicitSink} else: {} + if inReturn: + flags.incl(IsReturn) + result = moveOrCopy(p(n[0], c, s, mode), n[1], c, s, flags) elif isDiscriminantField(n[0]): result = c.genDiscriminantAsgn(s, n) else: @@ -888,7 +1003,7 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode): PNode = nkTypeOfExpr, nkMixinStmt, nkBindStmt: result = n - of nkStringToCString, nkCStringToString, nkChckRangeF, nkChckRange64, nkChckRange, nkPragmaBlock: + of nkStringToCString, nkCStringToString, nkChckRangeF, nkChckRange64, nkChckRange: result = shallowCopy(n) for i in 0 ..< n.len: result[i] = p(n[i], c, s, normal) @@ -923,7 +1038,7 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode): PNode = for i in 1 ..< n.len: result[i] = n[i] if mode == sinkArg and hasDestructor(c, n.typ): - if isAnalysableFieldAccess(n, c.owner) and isLastRead(n, c): + if isAnalysableFieldAccess(n, c.owner) and isLastRead(n, c, s): s.wasMoved.add c.genWasMoved(n) else: result = passCopyToSink(result, c, s) @@ -933,7 +1048,7 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode): PNode = for i in 0 ..< n.len: result[i] = p(n[i], c, s, normal) if mode == sinkArg and hasDestructor(c, n.typ): - if isAnalysableFieldAccess(n, c.owner) and isLastRead(n, c): + if isAnalysableFieldAccess(n, c.owner) and isLastRead(n, c, s): # consider 'a[(g; destroy(g); 3)]', we want to say 'wasMoved(a[3])' # without the junk, hence 'c.genWasMoved(n)' # and not 'c.genWasMoved(result)': @@ -952,7 +1067,7 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode): PNode = of nkReturnStmt: result = shallowCopy(n) for i in 0..<n.len: - result[i] = p(n[i], c, s, mode) + result[i] = p(n[i], c, s, mode, inReturn=true) s.needsTry = true of nkCast: result = shallowCopy(n) @@ -966,11 +1081,12 @@ proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode): PNode = of nkGotoState, nkState, nkAsmStmt: result = n else: + result = nil internalError(c.graph.config, n.info, "cannot inject destructors to node kind: " & $n.kind) proc sameLocation*(a, b: PNode): bool = proc sameConstant(a, b: PNode): bool = - a.kind in nkLiterals and a.intVal == b.intVal + a.kind in nkLiterals and b.kind in nkLiterals and a.intVal == b.intVal const nkEndPoint = {nkSym, nkDotExpr, nkCheckedFieldExpr, nkBracketExpr} if a.kind in nkEndPoint and b.kind in nkEndPoint: @@ -994,140 +1110,159 @@ proc sameLocation*(a, b: PNode): bool = of nkHiddenStdConv, nkHiddenSubConv: sameLocation(a[1], b) else: false -proc moveOrCopy(dest, ri: PNode; c: var Con; s: var Scope, isDecl = false): PNode = +proc genFieldAccessSideEffects(c: var Con; s: var Scope; dest, ri: PNode; flags: set[MoveOrCopyFlag] = {}): PNode = + # with side effects + var temp = newSym(skLet, getIdent(c.graph.cache, "bracketTmp"), c.idgen, c.owner, ri[1].info) + temp.typ = ri[1].typ + var v = newNodeI(nkLetSection, ri[1].info) + let tempAsNode = newSymNode(temp) + + var vpart = newNodeI(nkIdentDefs, tempAsNode.info, 3) + vpart[0] = tempAsNode + vpart[1] = newNodeI(nkEmpty, tempAsNode.info) + vpart[2] = ri[1] + v.add(vpart) + + var newAccess = copyNode(ri) + newAccess.add ri[0] + newAccess.add tempAsNode + + var snk = c.genSink(s, dest, newAccess, flags) + result = newTree(nkStmtList, v, snk, c.genWasMoved(newAccess)) + +proc moveOrCopy(dest, ri: PNode; c: var Con; s: var Scope, flags: set[MoveOrCopyFlag] = {}): PNode = + var ri = ri + var isEnsureMove = 0 + if ri.kind in nkCallKinds and ri[0].kind == nkSym and ri[0].sym.magic == mEnsureMove: + ri = ri[1] + isEnsureMove = 1 if sameLocation(dest, ri): # rule (self-assignment-removal): result = newNodeI(nkEmpty, dest.info) - elif isCursor(dest): + elif isCursor(dest) or dest.typ.kind in {tyOpenArray, tyVarargs}: + # hoisted openArray parameters might end up here + # openArray types don't have a lifted assignment operation (it's empty) + # bug #22132 case ri.kind: of nkStmtListExpr, nkBlockExpr, nkIfExpr, nkCaseStmt, nkTryStmt: - template process(child, s): untyped = moveOrCopy(dest, child, c, s, isDecl) + template process(child, s): untyped = moveOrCopy(dest, child, c, s, flags) # We know the result will be a stmt so we use that fact to optimize handleNestedTempl(ri, process, willProduceStmt = true) else: result = newTree(nkFastAsgn, dest, p(ri, c, s, normal)) else: - case ri.kind + let ri2 = if ri.kind == nkWhen: ri[1][0] else: ri + case ri2.kind of nkCallKinds: - result = c.genSink(dest, p(ri, c, s, consumed), isDecl) + result = c.genSink(s, dest, p(ri, c, s, consumed), flags) of nkBracketExpr: if isUnpackedTuple(ri[0]): # unpacking of tuple: take over the elements - result = c.genSink(dest, p(ri, c, s, consumed), isDecl) - elif isAnalysableFieldAccess(ri, c.owner) and isLastRead(ri, c): + result = c.genSink(s, dest, p(ri, c, s, consumed), flags) + elif isAnalysableFieldAccess(ri, c.owner) and isLastRead(ri, c, s): if aliases(dest, ri) == no: # Rule 3: `=sink`(x, z); wasMoved(z) - var snk = c.genSink(dest, ri, isDecl) - result = newTree(nkStmtList, snk, c.genWasMoved(ri)) + if isAtom(ri[1]): + var snk = c.genSink(s, dest, ri, flags) + result = newTree(nkStmtList, snk, c.genWasMoved(ri)) + else: + result = genFieldAccessSideEffects(c, s, dest, ri, flags) else: - result = c.genSink(dest, destructiveMoveVar(ri, c, s), isDecl) + result = c.genSink(s, dest, destructiveMoveVar(ri, c, s), flags) else: - result = c.genCopy(dest, ri) + inc c.inEnsureMove, isEnsureMove + result = c.genCopy(dest, ri, flags) + dec c.inEnsureMove, isEnsureMove result.add p(ri, c, s, consumed) - c.finishCopy(result, dest, isFromSink = false) + c.finishCopy(result, dest, flags, isFromSink = false) of nkBracket: # array constructor if ri.len > 0 and isDangerousSeq(ri.typ): - result = c.genCopy(dest, ri) + inc c.inEnsureMove, isEnsureMove + result = c.genCopy(dest, ri, flags) + dec c.inEnsureMove, isEnsureMove result.add p(ri, c, s, consumed) - c.finishCopy(result, dest, isFromSink = false) + c.finishCopy(result, dest, flags, isFromSink = false) else: - result = c.genSink(dest, p(ri, c, s, consumed), isDecl) + result = c.genSink(s, dest, p(ri, c, s, consumed), flags) of nkObjConstr, nkTupleConstr, nkClosure, nkCharLit..nkNilLit: - result = c.genSink(dest, p(ri, c, s, consumed), isDecl) + result = c.genSink(s, dest, p(ri, c, s, consumed), flags) of nkSym: - if isSinkParam(ri.sym) and isLastRead(ri, c): + if isSinkParam(ri.sym) and isLastRead(ri, c, s): # Rule 3: `=sink`(x, z); wasMoved(z) - let snk = c.genSink(dest, ri, isDecl) + let snk = c.genSink(s, dest, ri, flags) result = newTree(nkStmtList, snk, c.genWasMoved(ri)) - elif ri.sym.kind != skParam and ri.sym.owner == c.owner and - isLastRead(ri, c) and canBeMoved(c, dest.typ) and not isCursor(ri): + elif ri.sym.kind != skParam and + isAnalysableFieldAccess(ri, c.owner) and + isLastRead(ri, c, s) and canBeMoved(c, dest.typ): # Rule 3: `=sink`(x, z); wasMoved(z) - let snk = c.genSink(dest, ri, isDecl) + let snk = c.genSink(s, dest, ri, flags) result = newTree(nkStmtList, snk, c.genWasMoved(ri)) else: - result = c.genCopy(dest, ri) + inc c.inEnsureMove, isEnsureMove + result = c.genCopy(dest, ri, flags) + dec c.inEnsureMove, isEnsureMove result.add p(ri, c, s, consumed) - c.finishCopy(result, dest, isFromSink = false) - of nkHiddenSubConv, nkHiddenStdConv, nkConv, nkObjDownConv, nkObjUpConv: - result = c.genSink(dest, p(ri, c, s, sinkArg), isDecl) + c.finishCopy(result, dest, flags, isFromSink = false) + of nkHiddenSubConv, nkHiddenStdConv, nkConv, nkObjDownConv, nkObjUpConv, nkCast: + result = c.genSink(s, dest, p(ri, c, s, sinkArg), flags) of nkStmtListExpr, nkBlockExpr, nkIfExpr, nkCaseStmt, nkTryStmt: - template process(child, s): untyped = moveOrCopy(dest, child, c, s, isDecl) + template process(child, s): untyped = moveOrCopy(dest, child, c, s, flags) # We know the result will be a stmt so we use that fact to optimize handleNestedTempl(ri, process, willProduceStmt = true) of nkRaiseStmt: result = pRaiseStmt(ri, c, s) else: - if isAnalysableFieldAccess(ri, c.owner) and isLastRead(ri, c) and + if isAnalysableFieldAccess(ri, c.owner) and isLastRead(ri, c, s) and canBeMoved(c, dest.typ): # Rule 3: `=sink`(x, z); wasMoved(z) - let snk = c.genSink(dest, ri, isDecl) + let snk = c.genSink(s, dest, ri, flags) result = newTree(nkStmtList, snk, c.genWasMoved(ri)) else: - result = c.genCopy(dest, ri) + inc c.inEnsureMove, isEnsureMove + result = c.genCopy(dest, ri, flags) + dec c.inEnsureMove, isEnsureMove result.add p(ri, c, s, consumed) - c.finishCopy(result, dest, isFromSink = false) + c.finishCopy(result, dest, flags, isFromSink = false) -proc computeUninit(c: var Con) = - if not c.uninitComputed: - c.uninitComputed = true - c.uninit = initIntSet() - var init = initIntSet() - discard initialized(c.g, pc = 0, init, c.uninit, int.high) +when false: + proc computeUninit(c: var Con) = + if not c.uninitComputed: + c.uninitComputed = true + c.uninit = initIntSet() + var init = initIntSet() + discard initialized(c.g, pc = 0, init, c.uninit, int.high) -proc injectDefaultCalls(n: PNode, c: var Con) = - case n.kind - of nkVarSection, nkLetSection: - for it in n: - if it.kind == nkIdentDefs and it[^1].kind == nkEmpty: - computeUninit(c) - for j in 0..<it.len-2: - let v = it[j] - doAssert v.kind == nkSym - if c.uninit.contains(v.sym.id): - it[^1] = genDefaultCall(v.sym.typ, c, v.info) - break - of nkNone..nkNilLit, nkTypeSection, nkProcDef, nkConverterDef, nkMethodDef, - nkIteratorDef, nkMacroDef, nkTemplateDef, nkLambda, nkDo, nkFuncDef: - discard - else: - for i in 0..<n.safeLen: - injectDefaultCalls(n[i], c) + proc injectDefaultCalls(n: PNode, c: var Con) = + case n.kind + of nkVarSection, nkLetSection: + for it in n: + if it.kind == nkIdentDefs and it[^1].kind == nkEmpty: + computeUninit(c) + for j in 0..<it.len-2: + let v = skipPragmaExpr(it[j]) + doAssert v.kind == nkSym + if c.uninit.contains(v.sym.id): + it[^1] = genDefaultCall(v.sym.typ, c, v.info) + break + of nkNone..nkNilLit, nkTypeSection, nkProcDef, nkConverterDef, nkMethodDef, + nkIteratorDef, nkMacroDef, nkTemplateDef, nkLambda, nkDo, nkFuncDef: + discard + else: + for i in 0..<n.safeLen: + injectDefaultCalls(n[i], c) proc injectDestructorCalls*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n: PNode): PNode = + when toDebug.len > 0: + shouldDebug = toDebug == owner.name.s or toDebug == "always" if sfGeneratedOp in owner.flags or (owner.kind == skIterator and isInlineIterator(owner.typ)): return n - var c = Con(owner: owner, graph: g, g: constructCfg(owner, n), idgen: idgen) - dbg: - echo "\n### ", owner.name.s, ":\nCFG:" - echoCfg(c.g) - echo n + var c = Con(owner: owner, graph: g, idgen: idgen, body: n, otherUsage: unknownLineInfo) if optCursorInference in g.config.options: computeCursors(owner, n, g) - block: - var cache = initTable[(PNode, PNode), AliasKind]() - var lastReads, potLastReads: IntSet - var pc = 0 - collectLastReads(c.g, cache, lastReads, potLastReads, pc, c.g.len) - lastReads.incl potLastReads - var lastReadTable: Table[PNode, seq[int]] - for position, node in c.g: - if node.kind == use: - lastReadTable.mgetOrPut(node.n, @[]).add position - for node, positions in lastReadTable: - var allPositionsLastRead = true - for p in positions: - if p notin lastReads: allPositionsLastRead = false; break - if allPositionsLastRead: - node.flags.incl nfLastRead - - var alreadySeen: HashSet[PNode] - pc = 0 - collectFirstWrites(c.g, alreadySeen, pc, c.g.len) - - var scope: Scope + var scope = Scope(body: n) let body = p(n, c, scope, normal) if owner.kind in {skProc, skFunc, skMethod, skIterator, skConverter}: diff --git a/compiler/installer.ini b/compiler/installer.ini index 3f1630a92..54a35dbee 100644 --- a/compiler/installer.ini +++ b/compiler/installer.ini @@ -6,13 +6,14 @@ Name: "Nim" Version: "$version" Platforms: """ windows: i386;amd64 - linux: i386;hppa;ia64;alpha;amd64;powerpc64;arm;sparc;sparc64;m68k;mips;mipsel;mips64;mips64el;powerpc;powerpc64el;arm64;riscv32;riscv64 + linux: i386;hppa;ia64;alpha;amd64;powerpc64;arm;sparc;sparc64;m68k;mips;mipsel;mips64;mips64el;powerpc;powerpc64el;arm64;riscv32;riscv64;loongarch64 macosx: i386;amd64;powerpc64;arm64 solaris: i386;amd64;sparc;sparc64 freebsd: i386;amd64;powerpc64;arm;arm64;riscv64;sparc64;mips;mipsel;mips64;mips64el;powerpc;powerpc64el - netbsd: i386;amd64 + netbsd: i386;amd64;arm64 openbsd: i386;amd64;arm;arm64 dragonfly: i386;amd64 + crossos: amd64 haiku: i386;amd64 android: i386;arm;arm64 nintendoswitch: arm64 @@ -64,11 +65,13 @@ Files: "compiler" Files: "doc" Files: "doc/html" Files: "tools" -Files: "tools/nim-gdb.py" +Files: "tools/debug/nim-gdb.py" Files: "nimpretty" Files: "testament" Files: "nimsuggest" Files: "nimsuggest/tests/*.nim" +Files: "changelogs/*.md" +Files: "ci/funs.sh" [Lib] Files: "lib" @@ -76,6 +79,7 @@ Files: "lib" [Other] Files: "examples" Files: "dist/nimble" +Files: "dist/checksums" Files: "tests" @@ -89,6 +93,7 @@ Files: "bin/nimgrab.exe" Files: "bin/nimpretty.exe" Files: "bin/testament.exe" Files: "bin/nim-gdb.bat" +Files: "bin/atlas.exe" Files: "koch.exe" Files: "finish.exe" @@ -119,7 +124,7 @@ Files: "bin/nim" InstallScript: "yes" UninstallScript: "yes" Files: "bin/nim-gdb" -Files: "bin/nim-gdb.bash" +Files: "build_all.sh" [InnoSetup] @@ -141,5 +146,5 @@ shortDesc: "The Nim Compiler" licenses: "bin/nim,MIT;lib/*,MIT;" [nimble] -pkgName: "compiler" -pkgFiles: "compiler/*;doc/basicopt.txt;doc/advopt.txt;doc/nimdoc.css" +pkgName: "nim" +pkgFiles: "compiler/*;doc/basicopt.txt;doc/advopt.txt;doc/nimdoc.css;doc/nimdoc.cls" diff --git a/compiler/int128.nim b/compiler/int128.nim index 8d3cd7113..74e581cd5 100644 --- a/compiler/int128.nim +++ b/compiler/int128.nim @@ -5,6 +5,9 @@ from std/math import trunc +when defined(nimPreviewSlimSystem): + import std/assertions + type Int128* = object udata: array[4, uint32] @@ -30,39 +33,35 @@ template high*(t: typedesc[Int128]): Int128 = Max proc `$`*(a: Int128): string proc toInt128*[T: SomeInteger | bool](arg: T): Int128 = - when T is bool: result.sdata(0) = int32(arg) - elif T is SomeUnsignedInt: - when sizeof(arg) <= 4: - result.udata[0] = uint32(arg) + {.noSideEffect.}: + result = Zero + when T is bool: result.sdata(0) = int32(arg) + elif T is SomeUnsignedInt: + when sizeof(arg) <= 4: + result.udata[0] = uint32(arg) + else: + result.udata[0] = uint32(arg and T(0xffffffff)) + result.udata[1] = uint32(arg shr 32) + elif sizeof(arg) <= 4: + result.sdata(0) = int32(arg) + if arg < 0: # sign extend + result.sdata(1) = -1 + result.sdata(2) = -1 + result.sdata(3) = -1 else: - result.udata[0] = uint32(arg and T(0xffffffff)) - result.udata[1] = uint32(arg shr 32) - elif sizeof(arg) <= 4: - result.sdata(0) = int32(arg) - if arg < 0: # sign extend - result.sdata(1) = -1 - result.sdata(2) = -1 - result.sdata(3) = -1 - else: - let tmp = int64(arg) - result.udata[0] = uint32(tmp and 0xffffffff) - result.sdata(1) = int32(tmp shr 32) - if arg < 0: # sign extend - result.sdata(2) = -1 - result.sdata(3) = -1 + let tmp = int64(arg) + result.udata[0] = uint32(tmp and 0xffffffff) + result.sdata(1) = int32(tmp shr 32) + if arg < 0: # sign extend + result.sdata(2) = -1 + result.sdata(3) = -1 template isNegative(arg: Int128): bool = arg.sdata(3) < 0 -template isNegative(arg: int32): bool = - arg < 0 - proc bitconcat(a, b: uint32): uint64 = (uint64(a) shl 32) or uint64(b) -proc bitsplit(a: uint64): (uint32, uint32) = - (cast[uint32](a shr 32), cast[uint32](a)) - proc toInt64*(arg: Int128): int64 = if isNegative(arg): assert(arg.sdata(3) == -1, "out of range") @@ -173,6 +172,7 @@ proc addToHex*(result: var string; arg: Int128) = i -= 1 proc toHex*(arg: Int128): string = + result = "" result.addToHex(arg) proc inc*(a: var Int128, y: uint32 = 1) = @@ -208,37 +208,36 @@ proc `==`*(a, b: Int128): bool = if a.udata[3] != b.udata[3]: return false return true -proc inplaceBitnot(a: var Int128) = - a.udata[0] = not a.udata[0] - a.udata[1] = not a.udata[1] - a.udata[2] = not a.udata[2] - a.udata[3] = not a.udata[3] - proc bitnot*(a: Int128): Int128 = + result = Zero result.udata[0] = not a.udata[0] result.udata[1] = not a.udata[1] result.udata[2] = not a.udata[2] result.udata[3] = not a.udata[3] proc bitand*(a, b: Int128): Int128 = + result = Zero result.udata[0] = a.udata[0] and b.udata[0] result.udata[1] = a.udata[1] and b.udata[1] result.udata[2] = a.udata[2] and b.udata[2] result.udata[3] = a.udata[3] and b.udata[3] proc bitor*(a, b: Int128): Int128 = + result = Zero result.udata[0] = a.udata[0] or b.udata[0] result.udata[1] = a.udata[1] or b.udata[1] result.udata[2] = a.udata[2] or b.udata[2] result.udata[3] = a.udata[3] or b.udata[3] proc bitxor*(a, b: Int128): Int128 = + result = Zero result.udata[0] = a.udata[0] xor b.udata[0] result.udata[1] = a.udata[1] xor b.udata[1] result.udata[2] = a.udata[2] xor b.udata[2] result.udata[3] = a.udata[3] xor b.udata[3] proc `shr`*(a: Int128, b: int): Int128 = + result = Zero let b = b and 127 if b < 32: result.sdata(3) = a.sdata(3) shr b @@ -265,6 +264,7 @@ proc `shr`*(a: Int128, b: int): Int128 = result.sdata(0) = a.sdata(3) shr (b and 31) proc `shl`*(a: Int128, b: int): Int128 = + result = Zero let b = b and 127 if b < 32: result.udata[0] = a.udata[0] shl b @@ -288,6 +288,7 @@ proc `shl`*(a: Int128, b: int): Int128 = result.udata[3] = a.udata[0] shl (b and 31) proc `+`*(a, b: Int128): Int128 = + result = Zero let tmp0 = uint64(a.udata[0]) + uint64(b.udata[0]) result.udata[0] = cast[uint32](tmp0) let tmp1 = uint64(a.udata[1]) + uint64(b.udata[1]) + (tmp0 shr 32) @@ -320,6 +321,7 @@ proc abs(a: int32): int = if a < 0: -a else: a proc `*`(a: Int128, b: uint32): Int128 = + result = Zero let tmp0 = uint64(a.udata[0]) * uint64(b) let tmp1 = uint64(a.udata[1]) * uint64(b) let tmp2 = uint64(a.udata[2]) * uint64(b) @@ -338,10 +340,11 @@ proc `*`*(a: Int128, b: int32): Int128 = if b < 0: result = -result -proc `*=`*(a: var Int128, b: int32): Int128 = - result = result * b +proc `*=`(a: var Int128, b: int32) = + a = a * b proc makeInt128(high, low: uint64): Int128 = + result = Zero result.udata[0] = cast[uint32](low) result.udata[1] = cast[uint32](low shr 32) result.udata[2] = cast[uint32](high) @@ -354,23 +357,10 @@ proc low64(a: Int128): uint64 = bitconcat(a.udata[1], a.udata[0]) proc `*`*(lhs, rhs: Int128): Int128 = - let - a = cast[uint64](lhs.udata[0]) - b = cast[uint64](lhs.udata[1]) - c = cast[uint64](lhs.udata[2]) - d = cast[uint64](lhs.udata[3]) - - e = cast[uint64](rhs.udata[0]) - f = cast[uint64](rhs.udata[1]) - g = cast[uint64](rhs.udata[2]) - h = cast[uint64](rhs.udata[3]) - - - let a32 = cast[uint64](lhs.udata[1]) - let a00 = cast[uint64](lhs.udata[0]) - let b32 = cast[uint64](rhs.udata[1]) - let b00 = cast[uint64](rhs.udata[0]) - + let a32 = uint64(lhs.udata[1]) + let a00 = uint64(lhs.udata[0]) + let b32 = uint64(rhs.udata[1]) + let b00 = uint64(rhs.udata[0]) result = makeInt128(high64(lhs) * low64(rhs) + low64(lhs) * high64(rhs) + a32 * b32, a00 * b00) result += toInt128(a32 * b00) shl 32 result += toInt128(a00 * b32) shl 32 @@ -381,6 +371,7 @@ proc `*=`*(a: var Int128, b: Int128) = import std/bitops proc fastLog2*(a: Int128): int = + result = 0 if a.udata[3] != 0: return 96 + fastLog2(a.udata[3]) if a.udata[2] != 0: @@ -392,6 +383,8 @@ proc fastLog2*(a: Int128): int = proc divMod*(dividend, divisor: Int128): tuple[quotient, remainder: Int128] = assert(divisor != Zero) + result = (Zero, Zero) + let isNegativeA = isNegative(dividend) let isNegativeB = isNegative(divisor) @@ -441,17 +434,17 @@ proc divMod*(dividend, divisor: Int128): tuple[quotient, remainder: Int128] = result.remainder = dividend proc `div`*(a, b: Int128): Int128 = - let (a, b) = divMod(a, b) + let (a, _) = divMod(a, b) return a proc `mod`*(a, b: Int128): Int128 = - let (a, b) = divMod(a, b) + let (_, b) = divMod(a, b) return b proc addInt128*(result: var string; value: Int128) = let initialSize = result.len if value == Zero: - result.add "0" + result.add '0' elif value == low(Int128): result.add "-170141183460469231731687303715884105728" else: @@ -472,6 +465,8 @@ proc addInt128*(result: var string; value: Int128) = j -= 1 proc `$`*(a: Int128): string = + # "-170141183460469231731687303715884105728".len == 41 + result = newStringOfCap(41) result.addInt128(a) proc parseDecimalInt128*(arg: string, pos: int = 0): Int128 = @@ -556,24 +551,28 @@ proc toInt128*(arg: float64): Int128 = return res proc maskUInt64*(arg: Int128): Int128 {.noinit, inline.} = + result = Zero result.udata[0] = arg.udata[0] result.udata[1] = arg.udata[1] result.udata[2] = 0 result.udata[3] = 0 proc maskUInt32*(arg: Int128): Int128 {.noinit, inline.} = + result = Zero result.udata[0] = arg.udata[0] result.udata[1] = 0 result.udata[2] = 0 result.udata[3] = 0 proc maskUInt16*(arg: Int128): Int128 {.noinit, inline.} = + result = Zero result.udata[0] = arg.udata[0] and 0xffff result.udata[1] = 0 result.udata[2] = 0 result.udata[3] = 0 proc maskUInt8*(arg: Int128): Int128 {.noinit, inline.} = + result = Zero result.udata[0] = arg.udata[0] and 0xff result.udata[1] = 0 result.udata[2] = 0 @@ -590,4 +589,4 @@ proc maskBytes*(arg: Int128, numbytes: int): Int128 {.noinit.} = of 8: return maskUInt64(arg) else: - assert(false, "masking only implemented for 1, 2, 4 and 8 bytes") + raiseAssert "masking only implemented for 1, 2, 4 and 8 bytes" diff --git a/compiler/isolation_check.nim b/compiler/isolation_check.nim index 01f0a002a..17fbde29e 100644 --- a/compiler/isolation_check.nim +++ b/compiler/isolation_check.nim @@ -11,13 +11,19 @@ ## https://github.com/nim-lang/RFCs/issues/244 for more details. import - ast, types, renderer, intsets + ast, types, renderer + +import std/intsets + +when defined(nimPreviewSlimSystem): + import std/assertions proc canAlias(arg, ret: PType; marker: var IntSet): bool proc canAliasN(arg: PType; n: PNode; marker: var IntSet): bool = case n.kind of nkRecList: + result = false for i in 0..<n.len: result = canAliasN(arg, n[i], marker) if result: return @@ -33,7 +39,7 @@ proc canAliasN(arg: PType; n: PNode; marker: var IntSet): bool = else: discard of nkSym: result = canAlias(arg, n.sym.typ, marker) - else: discard + else: result = false proc canAlias(arg, ret: PType; marker: var IntSet): bool = if containsOrIncl(marker, ret.id): @@ -48,35 +54,115 @@ proc canAlias(arg, ret: PType; marker: var IntSet): bool = of tyObject: if isFinal(ret): result = canAliasN(arg, ret.n, marker) - if not result and ret.len > 0 and ret[0] != nil: - result = canAlias(arg, ret[0], marker) + if not result and ret.baseClass != nil: + result = canAlias(arg, ret.baseClass, marker) else: result = true of tyTuple: - for i in 0..<ret.len: - result = canAlias(arg, ret[i], marker) + result = false + for r in ret.kids: + result = canAlias(arg, r, marker) if result: break of tyArray, tySequence, tyDistinct, tyGenericInst, tyAlias, tyInferred, tySink, tyLent, tyOwned, tyRef: - result = canAlias(arg, ret.lastSon, marker) + result = canAlias(arg, ret.skipModifier, marker) of tyProc: result = ret.callConv == ccClosure else: result = false -proc isValueOnlyType(t: PType): bool = +proc isValueOnlyType(t: PType): bool = # t doesn't contain pointers and references proc wrap(t: PType): bool {.nimcall.} = t.kind in {tyRef, tyPtr, tyVar, tyLent} result = not types.searchTypeFor(t, wrap) +type + SearchResult = enum + NotFound, Abort, Found + +proc containsDangerousRefAux(t: PType; marker: var IntSet): SearchResult + +proc containsDangerousRefAux(n: PNode; marker: var IntSet): SearchResult = + result = NotFound + case n.kind + of nkRecList: + for i in 0..<n.len: + result = containsDangerousRefAux(n[i], marker) + if result == Found: return result + of nkRecCase: + assert(n[0].kind == nkSym) + result = containsDangerousRefAux(n[0], marker) + if result == Found: return result + for i in 1..<n.len: + case n[i].kind + of nkOfBranch, nkElse: + result = containsDangerousRefAux(lastSon(n[i]), marker) + if result == Found: return result + else: discard + of nkSym: + result = containsDangerousRefAux(n.sym.typ, marker) + else: discard + +proc containsDangerousRefAux(t: PType; marker: var IntSet): SearchResult = + result = NotFound + if t == nil: return result + if containsOrIncl(marker, t.id): return result + + if t.kind == tyRef or (t.kind == tyProc and t.callConv == ccClosure): + result = Found + elif tfSendable in t.flags: + result = Abort + else: + # continue the type traversal: + result = NotFound + + if result != NotFound: return result + case t.kind + of tyObject: + if t.baseClass != nil: + result = containsDangerousRefAux(t.baseClass.skipTypes(skipPtrs), marker) + if result == NotFound: result = containsDangerousRefAux(t.n, marker) + of tyGenericInst, tyDistinct, tyAlias, tySink: + result = containsDangerousRefAux(skipModifier(t), marker) + of tyArray, tySet, tySequence: + result = containsDangerousRefAux(t.elementType, marker) + of tyTuple: + for a in t.kids: + result = containsDangerousRefAux(a, marker) + if result == Found: return result + else: + discard + +proc containsDangerousRef(t: PType): bool = + # a `ref` type is "dangerous" if it occurs not within a type that is like `Isolated[T]`. + # For example: + # `ref int` # dangerous + # `Isolated[ref int]` # not dangerous + var marker = initIntSet() + result = containsDangerousRefAux(t, marker) == Found + proc canAlias*(arg, ret: PType): bool = if isValueOnlyType(arg): - # can alias only with unsafeAddr(arg.x) and we don't care if it is not safe + # can alias only with addr(arg.x) and we don't care if it is not safe result = false else: var marker = initIntSet() result = canAlias(arg, ret, marker) +const + SomeVar = {skForVar, skParam, skVar, skLet, skConst, skResult, skTemp} + +proc containsVariable(n: PNode): bool = + case n.kind + of nodesToIgnoreSet: + result = false + of nkSym: + result = n.sym.kind in SomeVar + else: + for ch in n: + if containsVariable(ch): return true + result = false + proc checkIsolate*(n: PNode): bool = if types.containsTyRef(n.typ): # XXX Maybe require that 'n.typ' is acyclic. This is not much @@ -85,26 +171,41 @@ proc checkIsolate*(n: PNode): bool = of nkCharLit..nkNilLit: result = true of nkCallKinds: - if n[0].typ.flags * {tfGcSafe, tfNoSideEffect} == {}: + # XXX: as long as we don't update the analysis while examining arguments + # we can do an early check of the return type, otherwise this is a + # bug and needs to be moved below + if tfNoSideEffect notin n[0].typ.flags: return false for i in 1..<n.len: if checkIsolate(n[i]): discard "fine, it is isolated already" else: let argType = n[i].typ - if argType != nil and not isCompileTimeOnly(argType) and containsTyRef(argType): - if argType.canAlias(n.typ): + if argType != nil and not isCompileTimeOnly(argType) and containsDangerousRef(argType): + if argType.canAlias(n.typ) or containsVariable(n[i]): + # bug #19013: Alias information is not enough, we need to check for potential + # "overlaps". I claim the problem can only happen by reading again from a location + # that materialized which is only possible if a variable that contains a `ref` + # is involved. return false result = true of nkIfStmt, nkIfExpr: + result = false for it in n: result = checkIsolate(it.lastSon) if not result: break - of nkCaseStmt, nkObjConstr: + of nkCaseStmt: + result = false + for i in 1..<n.len: + result = checkIsolate(n[i].lastSon) + if not result: break + of nkObjConstr: + result = true for i in 1..<n.len: result = checkIsolate(n[i].lastSon) if not result: break of nkBracket, nkTupleConstr, nkPar: + result = false for it in n: result = checkIsolate(it) if not result: break @@ -117,10 +218,15 @@ proc checkIsolate*(n: PNode): bool = result = checkIsolate(n[^1]) else: result = false + of nkSym: + result = true + if n.sym.kind in SomeVar: + let argType = n.typ + if argType != nil and not isCompileTimeOnly(argType) and containsDangerousRef(argType): + result = false else: # unanalysable expression: result = false else: # no ref, no cry: result = true - diff --git a/compiler/jsgen.nim b/compiler/jsgen.nim index 3fc7708bf..713944def 100644 --- a/compiler/jsgen.nim +++ b/compiler/jsgen.nim @@ -31,13 +31,20 @@ implements the required case distinction. import ast, trees, magicsys, options, nversion, msgs, idents, types, - ropes, passes, ccgutils, wordrecg, renderer, - cgmeth, lowerings, sighashes, modulegraphs, lineinfos, rodutils, - transf, injectdestructors, sourcemap + ropes, wordrecg, renderer, + cgmeth, lowerings, sighashes, modulegraphs, lineinfos, + transf, injectdestructors, sourcemap, astmsgs, pushpoppragmas, + mangleutils -import std/[json, sets, math, tables, intsets, strutils] +import pipelineutils -from modulegraphs import ModuleGraph, PPassContext +import std/[json, sets, math, tables, intsets] +import std/strutils except addf + +when defined(nimPreviewSlimSystem): + import std/[assertions, syncio] + +import std/formatfloat type TJSGen = object of PPassContext @@ -45,6 +52,7 @@ type graph: ModuleGraph config: ConfigRef sigConflicts: CountTable[SigHash] + initProc: PProc BModule = ref TJSGen TJSTypeKind = enum # necessary JS "types" @@ -95,34 +103,37 @@ type prc: PSym globals, locals, body: Rope options: TOptions + optionsStack: seq[(TOptions, TNoteKinds)] module: BModule g: PGlobals - generatedParamCopies: IntSet beforeRetNeeded: bool unique: int # for temp identifier generation blocks: seq[TBlock] extraIndent: int + previousFileName: string # For frameInfo inside templates. + # legacy: generatedParamCopies and up fields are used for jsNoLambdaLifting + generatedParamCopies: IntSet up: PProc # up the call chain; required for closure support - declaredGlobals: IntSet template config*(p: PProc): ConfigRef = p.module.config proc indentLine(p: PProc, r: Rope): Rope = - result = r var p = p - while true: - for i in 0..<p.blocks.len + p.extraIndent: - prepend(result, rope" ") - if p.up == nil or p.up.prc != p.prc.owner: - break - p = p.up + if jsNoLambdaLifting in p.config.legacyFeatures: + var ind = 0 + while true: + inc ind, p.blocks.len + p.extraIndent + if p.up == nil or p.up.prc != p.prc.owner: + break + p = p.up + result = repeat(' ', ind*2) & r + else: + let ind = p.blocks.len + p.extraIndent + result = repeat(' ', ind*2) & r template line(p: PProc, added: string) = p.body.add(indentLine(p, rope(added))) -template line(p: PProc, added: Rope) = - p.body.add(indentLine(p, added)) - template lineF(p: PProc, frmt: FormatStr, args: varargs[Rope]) = p.body.add(indentLine(p, ropes.`%`(frmt, args))) @@ -132,17 +143,15 @@ template nested(p, body) = dec p.extraIndent proc newGlobals(): PGlobals = - new(result) - result.forwarded = @[] - result.generatedSyms = initIntSet() - result.typeInfoGenerated = initIntSet() - -proc initCompRes(r: var TCompRes) = - r.address = nil - r.res = nil - r.tmpLoc = nil - r.typ = etyNone - r.kind = resNone + result = PGlobals(forwarded: @[], + generatedSyms: initIntSet(), + typeInfoGenerated: initIntSet() + ) + +proc initCompRes(): TCompRes = + result = TCompRes(address: "", res: "", + tmpLoc: "", typ: etyNone, kind: resNone + ) proc rdLoc(a: TCompRes): Rope {.inline.} = if a.typ != etyBaseIndex: @@ -154,6 +163,8 @@ proc newProc(globals: PGlobals, module: BModule, procDef: PNode, options: TOptions): PProc = result = PProc( blocks: @[], + optionsStack: if module.initProc != nil: module.initProc.optionsStack + else: @[], options: options, module: module, procDef: procDef, @@ -169,10 +180,6 @@ proc initProcOptions(module: BModule): TOptions = proc newInitProc(globals: PGlobals, module: BModule): PProc = result = newProc(globals, module, nil, initProcOptions(module)) -proc declareGlobal(p: PProc; id: int; r: Rope) = - if p.prc != nil and not p.declaredGlobals.containsOrIncl(id): - p.locals.addf("global $1;$n", [r]) - const MappedToObject = {tyObject, tyArray, tyTuple, tyOpenArray, tySet, tyVarargs} @@ -180,16 +187,17 @@ const proc mapType(typ: PType): TJSTypeKind = let t = skipTypes(typ, abstractInst) case t.kind - of tyVar, tyRef, tyPtr, tyLent: - if skipTypes(t.lastSon, abstractInst).kind in MappedToObject: + of tyVar, tyRef, tyPtr: + if skipTypes(t.elementType, abstractInst).kind in MappedToObject: result = etyObject else: result = etyBaseIndex of tyPointer: # treat a tyPointer like a typed pointer to an array of bytes result = etyBaseIndex - of tyRange, tyDistinct, tyOrdinal, tyProxy: - result = mapType(t[0]) + of tyRange, tyDistinct, tyOrdinal, tyError, tyLent: + # tyLent is no-op as JS has pass-by-reference semantics + result = mapType(skipModifier t) of tyInt..tyInt64, tyUInt..tyUInt64, tyEnum, tyChar: result = etyInt of tyBool: result = etyBool of tyFloat..tyFloat128: result = etyFloat @@ -205,13 +213,14 @@ proc mapType(typ: PType): TJSTypeKind = result = etyNone of tyGenericInst, tyInferred, tyAlias, tyUserTypeClass, tyUserTypeClassInst, tySink, tyOwned: - result = mapType(typ.lastSon) + result = mapType(typ.skipModifier) of tyStatic: - if t.n != nil: result = mapType(lastSon t) + if t.n != nil: result = mapType(skipModifier t) else: result = etyNone of tyProc: result = etyProc - of tyCString: result = etyString - of tyConcept: doAssert false + of tyCstring: result = etyString + of tyConcept, tyIterable: + raiseAssert "unreachable" proc mapType(p: PProc; typ: PType): TJSTypeKind = result = mapType(typ) @@ -237,8 +246,8 @@ proc mangleName(m: BModule, s: PSym): Rope = for chr in name: if chr notin {'A'..'Z','a'..'z','_','$','0'..'9'}: return false - result = s.loc.r - if result == nil: + result = s.loc.snippet + if result == "": if s.kind == skField and s.name.s.validJsName: result = rope(s.name.s) elif s.kind == skTemp: @@ -260,11 +269,15 @@ proc mangleName(m: BModule, s: PSym): Rope = if m.config.hcrOn: # When hot reloading is enabled, we must ensure that the names # of functions and types will be preserved across rebuilds: - result.add(idOrSig(s, m.module.name.s, m.sigConflicts)) + result.add(idOrSig(s, m.module.name.s, m.sigConflicts, m.config)) + elif s.kind == skParam: + result.add mangleParamExt(s) + elif s.kind in routineKinds: + result.add mangleProcNameExt(m.graph, s) else: result.add("_") result.add(rope(s.id)) - s.loc.r = result + s.loc.snippet = result proc escapeJSString(s: string): string = result = newStringOfCap(s.len + s.len shr 2) @@ -289,6 +302,21 @@ proc makeJSString(s: string, escapeNonAscii = true): Rope = else: result = escapeJSString(s).rope +proc makeJsNimStrLit(s: string): Rope = + var x = newStringOfCap(4*s.len+1) + x.add "[" + var i = 0 + if i < s.len: + x.addInt int64(s[i]) + inc i + while i < s.len: + x.add "," + x.addInt int64(s[i]) + inc i + x.add "]" + result = rope(x) + + include jstypes proc gen(p: PProc, n: PNode, r: var TCompRes) @@ -312,23 +340,30 @@ proc useMagic(p: PProc, name: string) = proc isSimpleExpr(p: PProc; n: PNode): bool = # calls all the way down --> can stay expression based - if n.kind in nkCallKinds+{nkBracketExpr, nkDotExpr, nkPar, nkTupleConstr} or - (n.kind in {nkObjConstr, nkBracket, nkCurly}): + case n.kind + of nkCallKinds, nkBracketExpr, nkDotExpr, nkPar, nkTupleConstr, + nkObjConstr, nkBracket, nkCurly, + nkDerefExpr, nkHiddenDeref, nkAddr, nkHiddenAddr, + nkConv, nkHiddenStdConv, nkHiddenSubConv: for c in n: if not p.isSimpleExpr(c): return false result = true - elif n.isAtom: - result = true + of nkStmtListExpr: + for i in 0..<n.len-1: + if n[i].kind notin {nkCommentStmt, nkEmpty}: return false + result = isSimpleExpr(p, n.lastSon) + else: + result = n.isAtom proc getTemp(p: PProc, defineInLocals: bool = true): Rope = inc(p.unique) - result = "Tmp$1" % [rope(p.unique)] + result = "Temporary$1" % [rope(p.unique)] if defineInLocals: p.locals.add(p.indentLine("var $1;$n" % [result])) proc genAnd(p: PProc, a, b: PNode, r: var TCompRes) = assert r.kind == resNone - var x, y: TCompRes + var x, y: TCompRes = default(TCompRes) if p.isSimpleExpr(a) and p.isSimpleExpr(b): gen(p, a, x) gen(p, b, y) @@ -355,7 +390,7 @@ proc genAnd(p: PProc, a, b: PNode, r: var TCompRes) = proc genOr(p: PProc, a, b: PNode, r: var TCompRes) = assert r.kind == resNone - var x, y: TCompRes + var x, y: TCompRes = default(TCompRes) if p.isSimpleExpr(a) and p.isSimpleExpr(b): gen(p, a, x) gen(p, b, y) @@ -434,15 +469,13 @@ const # magic checked op; magic unchecked op; mUnaryMinusF64: ["", ""], mCharToStr: ["nimCharToStr", "nimCharToStr"], mBoolToStr: ["nimBoolToStr", "nimBoolToStr"], - mIntToStr: ["cstrToNimstr", "cstrToNimstr"], - mInt64ToStr: ["cstrToNimstr", "cstrToNimstr"], - mFloatToStr: ["cstrToNimstr", "cstrToNimstr"], mCStrToStr: ["cstrToNimstr", "cstrToNimstr"], mStrToStr: ["", ""]] proc needsTemp(p: PProc; n: PNode): bool = # check if n contains a call to determine # if a temp should be made to prevent multiple evals + result = false if n.kind in nkCallKinds + {nkTupleConstr, nkObjConstr, nkBracket, nkCurly}: return true for c in n: @@ -455,7 +488,7 @@ proc maybeMakeTemp(p: PProc, n: PNode; x: TCompRes): tuple[a, tmp: Rope] = b = a if needsTemp(p, n): # if we have tmp just use it - if x.tmpLoc != nil and (mapType(n.typ) == etyBaseIndex or n.kind in {nkHiddenDeref, nkDerefExpr}): + if x.tmpLoc != "" and (mapType(n.typ) == etyBaseIndex or n.kind in {nkHiddenDeref, nkDerefExpr}): b = "$1[0][$1[1]]" % [x.tmpLoc] (a: a, tmp: b) else: @@ -472,29 +505,29 @@ proc maybeMakeTempAssignable(p: PProc, n: PNode; x: TCompRes): tuple[a, tmp: Rop b = a if needsTemp(p, n): # if we have tmp just use it - if x.tmpLoc != nil and (mapType(n.typ) == etyBaseIndex or n.kind in {nkHiddenDeref, nkDerefExpr}): + if x.tmpLoc != "" and (mapType(n.typ) == etyBaseIndex or n.kind in {nkHiddenDeref, nkDerefExpr}): b = "$1[0][$1[1]]" % [x.tmpLoc] result = (a: a, tmp: b) - elif x.tmpLoc != nil and n.kind == nkBracketExpr: + elif x.tmpLoc != "" and n.kind == nkBracketExpr: # genArrayAddr var - address, index: TCompRes - first: Int128 + address, index: TCompRes = default(TCompRes) + first: Int128 = Zero gen(p, n[0], address) gen(p, n[1], index) let (m1, tmp1) = maybeMakeTemp(p, n[0], address) let typ = skipTypes(n[0].typ, abstractPtrs) if typ.kind == tyArray: - first = firstOrd(p.config, typ[0]) + first = firstOrd(p.config, typ.indexType) if optBoundsCheck in p.options: useMagic(p, "chckIndx") if first == 0: # save a couple chars - index.res = "chckIndx($1, 0, ($2).length-1)" % [index.res, tmp1] + index.res = "chckIndx($1, 0, ($2).length - 1)" % [index.res, tmp1] else: - index.res = "chckIndx($1, $2, ($3).length+($2)-1)-($2)" % [ + index.res = "chckIndx($1, $2, ($3).length + ($2) - 1) - ($2)" % [ index.res, rope(first), tmp1] elif first != 0: - index.res = "($1)-($2)" % [index.res, rope(first)] + index.res = "($1) - ($2)" % [index.res, rope(first)] else: discard # index.res = index.res let (n1, tmp2) = maybeMakeTemp(p, n[1], index) @@ -511,7 +544,7 @@ template binaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string, # $1 and $2 in the `frmt` string bind to lhs and rhs of the expr, # if $3 or $4 are present they will be substituted with temps for # lhs and rhs respectively - var x, y: TCompRes + var x, y: TCompRes = default(TCompRes) useMagic(p, magic) gen(p, n[1], x) gen(p, n[2], y) @@ -528,28 +561,36 @@ template binaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string, r.res = frmt % [a, b, tmp, tmp2] r.kind = resExpr -proc unsignedTrimmerJS(size: BiggestInt): Rope = +proc unsignedTrimmer(size: BiggestInt): string = case size - of 1: rope"& 0xff" - of 2: rope"& 0xffff" - of 4: rope">>> 0" - else: rope"" - + of 1: "& 0xff" + of 2: "& 0xffff" + of 4: ">>> 0" + else: "" -template unsignedTrimmer(size: BiggestInt): Rope = - size.unsignedTrimmerJS +proc signedTrimmer(size: BiggestInt): string = + # sign extension is done by shifting to the left and then back to the right + "<< $1 >> $1" % [$(32 - size * 8)] proc binaryUintExpr(p: PProc, n: PNode, r: var TCompRes, op: string, reassign: static[bool] = false) = - var x, y: TCompRes + var x, y: TCompRes = default(TCompRes) gen(p, n[1], x) gen(p, n[2], y) - let trimmer = unsignedTrimmer(n[1].typ.skipTypes(abstractRange).size) + let size = n[1].typ.skipTypes(abstractRange).size when reassign: let (a, tmp) = maybeMakeTempAssignable(p, n[1], x) - r.res = "$1 = (($5 $2 $3) $4)" % [a, rope op, y.rdLoc, trimmer, tmp] + if size == 8 and optJsBigInt64 in p.config.globalOptions: + r.res = "$1 = BigInt.asUintN(64, ($4 $2 $3))" % [a, rope op, y.rdLoc, tmp] + else: + let trimmer = unsignedTrimmer(size) + r.res = "$1 = (($5 $2 $3) $4)" % [a, rope op, y.rdLoc, trimmer, tmp] else: - r.res = "(($1 $2 $3) $4)" % [x.rdLoc, rope op, y.rdLoc, trimmer] + if size == 8 and optJsBigInt64 in p.config.globalOptions: + r.res = "BigInt.asUintN(64, ($1 $2 $3))" % [x.rdLoc, rope op, y.rdLoc] + else: + let trimmer = unsignedTrimmer(size) + r.res = "(($1 $2 $3) $4)" % [x.rdLoc, rope op, y.rdLoc, trimmer] r.kind = resExpr template ternaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = @@ -570,10 +611,21 @@ template unaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = r.res = frmt % [a, tmp] r.kind = resExpr +proc genBreakState(p: PProc, n: PNode, r: var TCompRes) = + var a: TCompRes = default(TCompRes) + # mangle `:state` properly somehow + if n.kind == nkClosure: + gen(p, n[1], a) + r.res = "(($1).HEX3Astate < 0)" % [rdLoc(a)] + else: + gen(p, n, a) + r.res = "((($1.ClE_0).HEX3Astate) < 0)" % [rdLoc(a)] + r.kind = resExpr + proc arithAux(p: PProc, n: PNode, r: var TCompRes, op: TMagic) = var - x, y: TCompRes - xLoc,yLoc: Rope + x, y: TCompRes = default(TCompRes) + xLoc, yLoc: Rope = "" let i = ord(optOverflowCheck notin p.options) useMagic(p, jsMagics[op][i]) if n.len > 2: @@ -590,32 +642,133 @@ proc arithAux(p: PProc, n: PNode, r: var TCompRes, op: TMagic) = template applyFormat(frmtA, frmtB) = if i == 0: applyFormat(frmtA) else: applyFormat(frmtB) - case op: - of mAddI: applyFormat("addInt($1, $2)", "($1 + $2)") - of mSubI: applyFormat("subInt($1, $2)", "($1 - $2)") - of mMulI: applyFormat("mulInt($1, $2)", "($1 * $2)") - of mDivI: applyFormat("divInt($1, $2)", "Math.trunc($1 / $2)") - of mModI: applyFormat("modInt($1, $2)", "Math.trunc($1 % $2)") - of mSucc: applyFormat("addInt($1, $2)", "($1 + $2)") - of mPred: applyFormat("subInt($1, $2)", "($1 - $2)") + template bitwiseExpr(op: string) = + let typ = n[1].typ.skipTypes(abstractVarRange) + if typ.kind in {tyUInt, tyUInt32}: + r.res = "(($1 $2 $3) >>> 0)" % [xLoc, op, yLoc] + else: + r.res = "($1 $2 $3)" % [xLoc, op, yLoc] + + case op + of mAddI: + if i == 0: + if n[1].typ.size == 8 and optJsBigInt64 in p.config.globalOptions: + useMagic(p, "addInt64") + applyFormat("addInt64($1, $2)") + else: + applyFormat("addInt($1, $2)") + else: + applyFormat("($1 + $2)") + of mSubI: + if i == 0: + if n[1].typ.size == 8 and optJsBigInt64 in p.config.globalOptions: + useMagic(p, "subInt64") + applyFormat("subInt64($1, $2)") + else: + applyFormat("subInt($1, $2)") + else: + applyFormat("($1 - $2)") + of mMulI: + if i == 0: + if n[1].typ.size == 8 and optJsBigInt64 in p.config.globalOptions: + useMagic(p, "mulInt64") + applyFormat("mulInt64($1, $2)") + else: + applyFormat("mulInt($1, $2)") + else: + applyFormat("($1 * $2)") + of mDivI: + if n[1].typ.size == 8 and optJsBigInt64 in p.config.globalOptions: + useMagic(p, "divInt64") + applyFormat("divInt64($1, $2)", "$1 / $2") + else: + applyFormat("divInt($1, $2)", "Math.trunc($1 / $2)") + of mModI: + if n[1].typ.size == 8 and optJsBigInt64 in p.config.globalOptions: + useMagic(p, "modInt64") + applyFormat("modInt64($1, $2)", "$1 % $2") + else: + applyFormat("modInt($1, $2)", "Math.trunc($1 % $2)") + of mSucc: + let typ = n[1].typ.skipTypes(abstractVarRange) + case typ.kind + of tyUInt..tyUInt32: + binaryUintExpr(p, n, r, "+") + of tyUInt64: + if optJsBigInt64 in p.config.globalOptions: + applyFormat("BigInt.asUintN(64, $1 + BigInt($2))") + else: binaryUintExpr(p, n, r, "+") + elif typ.kind == tyInt64 and optJsBigInt64 in p.config.globalOptions: + if optOverflowCheck notin p.options: + applyFormat("BigInt.asIntN(64, $1 + BigInt($2))") + else: binaryExpr(p, n, r, "addInt64", "addInt64($1, BigInt($2))") + else: + if optOverflowCheck notin p.options: applyFormat("$1 + $2") + else: binaryExpr(p, n, r, "addInt", "addInt($1, $2)") + of mPred: + let typ = n[1].typ.skipTypes(abstractVarRange) + case typ.kind + of tyUInt..tyUInt32: + binaryUintExpr(p, n, r, "-") + of tyUInt64: + if optJsBigInt64 in p.config.globalOptions: + applyFormat("BigInt.asUintN(64, $1 - BigInt($2))") + else: binaryUintExpr(p, n, r, "-") + elif typ.kind == tyInt64 and optJsBigInt64 in p.config.globalOptions: + if optOverflowCheck notin p.options: + applyFormat("BigInt.asIntN(64, $1 - BigInt($2))") + else: binaryExpr(p, n, r, "subInt64", "subInt64($1, BigInt($2))") + else: + if optOverflowCheck notin p.options: applyFormat("$1 - $2") + else: binaryExpr(p, n, r, "subInt", "subInt($1, $2)") of mAddF64: applyFormat("($1 + $2)", "($1 + $2)") of mSubF64: applyFormat("($1 - $2)", "($1 - $2)") of mMulF64: applyFormat("($1 * $2)", "($1 * $2)") of mDivF64: applyFormat("($1 / $2)", "($1 / $2)") - of mShrI: applyFormat("", "") + of mShrI: + let typ = n[1].typ.skipTypes(abstractVarRange) + if typ.kind == tyInt64 and optJsBigInt64 in p.config.globalOptions: + applyFormat("BigInt.asIntN(64, BigInt.asUintN(64, $1) >> BigInt($2))") + elif typ.kind == tyUInt64 and optJsBigInt64 in p.config.globalOptions: + applyFormat("($1 >> BigInt($2))") + else: + if typ.kind in {tyInt..tyInt32}: + let trimmerU = unsignedTrimmer(typ.size) + let trimmerS = signedTrimmer(typ.size) + r.res = "((($1 $2) >>> $3) $4)" % [xLoc, trimmerU, yLoc, trimmerS] + else: + applyFormat("($1 >>> $2)") of mShlI: - if n[1].typ.size <= 4: - applyFormat("($1 << $2)", "($1 << $2)") + let typ = n[1].typ.skipTypes(abstractVarRange) + if typ.size == 8: + if typ.kind == tyInt64 and optJsBigInt64 in p.config.globalOptions: + applyFormat("BigInt.asIntN(64, $1 << BigInt($2))") + elif typ.kind == tyUInt64 and optJsBigInt64 in p.config.globalOptions: + applyFormat("BigInt.asUintN(64, $1 << BigInt($2))") + else: + applyFormat("($1 * Math.pow(2, $2))") else: - applyFormat("($1 * Math.pow(2,$2))", "($1 * Math.pow(2,$2))") + if typ.kind in {tyUInt..tyUInt32}: + let trimmer = unsignedTrimmer(typ.size) + r.res = "(($1 << $2) $3)" % [xLoc, yLoc, trimmer] + else: + let trimmer = signedTrimmer(typ.size) + r.res = "(($1 << $2) $3)" % [xLoc, yLoc, trimmer] of mAshrI: - if n[1].typ.size <= 4: - applyFormat("($1 >> $2)", "($1 >> $2)") + let typ = n[1].typ.skipTypes(abstractVarRange) + if typ.size == 8: + if optJsBigInt64 in p.config.globalOptions: + applyFormat("($1 >> BigInt($2))") + else: + applyFormat("Math.floor($1 / Math.pow(2, $2))") else: - applyFormat("Math.floor($1 / Math.pow(2,$2))", "Math.floor($1 / Math.pow(2,$2))") - of mBitandI: applyFormat("($1 & $2)", "($1 & $2)") - of mBitorI: applyFormat("($1 | $2)", "($1 | $2)") - of mBitxorI: applyFormat("($1 ^ $2)", "($1 ^ $2)") + if typ.kind in {tyUInt..tyUInt32}: + applyFormat("($1 >>> $2)") + else: + applyFormat("($1 >> $2)") + of mBitandI: bitwiseExpr("&") + of mBitorI: bitwiseExpr("|") + of mBitxorI: bitwiseExpr("^") of mMinI: applyFormat("nimMin($1, $2)", "nimMin($1, $2)") of mMaxI: applyFormat("nimMax($1, $2)", "nimMax($1, $2)") of mAddU: applyFormat("", "") @@ -648,21 +801,31 @@ proc arithAux(p: PProc, n: PNode, r: var TCompRes, op: TMagic) = of mEqProc: applyFormat("($1 == $2)", "($1 == $2)") of mUnaryMinusI: applyFormat("negInt($1)", "-($1)") of mUnaryMinusI64: applyFormat("negInt64($1)", "-($1)") - of mAbsI: applyFormat("absInt($1)", "Math.abs($1)") + of mAbsI: + let typ = n[1].typ.skipTypes(abstractVarRange) + if typ.kind == tyInt64 and optJsBigInt64 in p.config.globalOptions: + useMagic(p, "absInt64") + applyFormat("absInt64($1)", "absInt64($1)") + else: + applyFormat("absInt($1)", "Math.abs($1)") of mNot: applyFormat("!($1)", "!($1)") of mUnaryPlusI: applyFormat("+($1)", "+($1)") - of mBitnotI: applyFormat("~($1)", "~($1)") + of mBitnotI: + let typ = n[1].typ.skipTypes(abstractVarRange) + if typ.kind in {tyUInt..tyUInt64}: + if typ.size == 8 and optJsBigInt64 in p.config.globalOptions: + applyFormat("BigInt.asUintN(64, ~($1))") + else: + let trimmer = unsignedTrimmer(typ.size) + r.res = "(~($1) $2)" % [xLoc, trimmer] + else: + applyFormat("~($1)") of mUnaryPlusF64: applyFormat("+($1)", "+($1)") of mUnaryMinusF64: applyFormat("-($1)", "-($1)") of mCharToStr: applyFormat("nimCharToStr($1)", "nimCharToStr($1)") of mBoolToStr: applyFormat("nimBoolToStr($1)", "nimBoolToStr($1)") - of mIntToStr: applyFormat("cstrToNimstr(($1)+\"\")", "cstrToNimstr(($1)+\"\")") - of mInt64ToStr: applyFormat("cstrToNimstr(($1)+\"\")", "cstrToNimstr(($1)+\"\")") - of mFloatToStr: - useMagic(p, "nimFloatToString") - applyFormat "cstrToNimstr(nimFloatToString($1))" of mCStrToStr: applyFormat("cstrToNimstr($1)", "cstrToNimstr($1)") - of mStrToStr, mUnown, mIsolate: applyFormat("$1", "$1") + of mStrToStr, mUnown, mIsolate, mFinished: applyFormat("$1", "$1") else: assert false, $op @@ -673,29 +836,29 @@ proc arith(p: PProc, n: PNode, r: var TCompRes, op: TMagic) = of mMulU: binaryUintExpr(p, n, r, "*") of mDivU: binaryUintExpr(p, n, r, "/") - if n[1].typ.skipTypes(abstractRange).size == 8: + if optJsBigInt64 notin p.config.globalOptions and + n[1].typ.skipTypes(abstractRange).size == 8: + # bigint / already truncates r.res = "Math.trunc($1)" % [r.res] of mDivI: arithAux(p, n, r, op) of mModI: arithAux(p, n, r, op) - of mShrI: - var x, y: TCompRes - gen(p, n[1], x) - gen(p, n[2], y) - let trimmer = unsignedTrimmer(n[1].typ.skipTypes(abstractRange).size) - r.res = "(($1 $2) >>> $3)" % [x.rdLoc, trimmer, y.rdLoc] - of mCharToStr, mBoolToStr, mIntToStr, mInt64ToStr, mFloatToStr, - mCStrToStr, mStrToStr, mEnumToStr: + of mCharToStr, mBoolToStr, mCStrToStr, mStrToStr, mEnumToStr: arithAux(p, n, r, op) of mEqRef: if mapType(n[1].typ) != etyBaseIndex: arithAux(p, n, r, op) else: - var x, y: TCompRes + var x, y: TCompRes = default(TCompRes) gen(p, n[1], x) gen(p, n[2], y) r.res = "($# == $# && $# == $#)" % [x.address, y.address, x.res, y.res] + of mEqProc: + if skipTypes(n[1].typ, abstractInst).callConv == ccClosure: + binaryExpr(p, n, r, "cmpClosures", "cmpClosures($1, $2)") + else: + arithAux(p, n, r, op) else: arithAux(p, n, r, op) r.kind = resExpr @@ -705,20 +868,27 @@ proc hasFrameInfo(p: PProc): bool = ((p.prc == nil) or not (sfPure in p.prc.flags)) proc lineDir(config: ConfigRef, info: TLineInfo, line: int): Rope = - ropes.`%`("// line $2 \"$1\"$n", - [rope(toFullPath(config, info)), rope(line)]) + "/* line $2:$3 \"$1\" */$n" % [ + rope(toFullPath(config, info)), rope(line), rope(info.toColumn) + ] proc genLineDir(p: PProc, n: PNode) = let line = toLinenumber(n.info) if line < 0: return + if optEmbedOrigSrc in p.config.globalOptions: + lineF(p, "//$1$n", [sourceLine(p.config, n.info)]) if optLineDir in p.options or optLineDir in p.config.options: lineF(p, "$1", [lineDir(p.config, n.info, line)]) if hasFrameInfo(p): lineF(p, "F.line = $1;$n", [rope(line)]) + let currentFileName = toFilename(p.config, n.info) + if p.previousFileName != currentFileName: + lineF(p, "F.filename = $1;$n", [makeJSString(currentFileName)]) + p.previousFileName = currentFileName proc genWhileStmt(p: PProc, n: PNode) = - var cond: TCompRes + var cond: TCompRes = default(TCompRes) internalAssert p.config, isEmptyType(n.typ) genLineDir(p, n) inc(p.unique) @@ -726,9 +896,9 @@ proc genWhileStmt(p: PProc, n: PNode) = p.blocks[^1].id = -p.unique p.blocks[^1].isLoop = true let labl = p.unique.rope - lineF(p, "L$1: while (true) {$n", [labl]) + lineF(p, "Label$1: while (true) {$n", [labl]) p.nested: gen(p, n[0], cond) - lineF(p, "if (!$1) break L$2;$n", + lineF(p, "if (!$1) break Label$2;$n", [cond.res, labl]) p.nested: genStmt(p, n[1]) lineF(p, "}$n", [labl]) @@ -741,7 +911,7 @@ proc moveInto(p: PProc, src: var TCompRes, dest: TCompRes) = else: lineF(p, "$1;$n", [src.rdLoc]) src.kind = resNone - src.res = nil + src.res = "" proc genTry(p: PProc, n: PNode, r: var TCompRes) = # code to generate: @@ -751,8 +921,8 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = # try { # stmts; # --excHandler; - # } catch (EXC) { - # var prevJSError = lastJSError; lastJSError = EXC; + # } catch (EXCEPTION) { + # var prevJSError = lastJSError; lastJSError = EXCEPTION; # framePtr = tmpFramePtr; # --excHandler; # if (e.typ && e.typ == NTI433 || e.typ == NTI2321) { @@ -777,18 +947,16 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = if catchBranchesExist: p.body.add("++excHandler;\L") var tmpFramePtr = rope"F" - if optStackTrace notin p.options: - tmpFramePtr = p.getTemp(true) - line(p, tmpFramePtr & " = framePtr;\L") lineF(p, "try {$n", []) - var a: TCompRes + var a: TCompRes = default(TCompRes) gen(p, n[0], a) moveInto(p, a, r) var generalCatchBranchExists = false if catchBranchesExist: - p.body.addf("--excHandler;$n} catch (EXC) {$n var prevJSError = lastJSError;$n" & - " lastJSError = EXC;$n --excHandler;$n", []) - line(p, "framePtr = $1;$n" % [tmpFramePtr]) + p.body.addf("--excHandler;$n} catch (EXCEPTION) {$n var prevJSError = lastJSError;$n" & + " lastJSError = EXCEPTION;$n --excHandler;$n", []) + if hasFrameInfo(p): + line(p, "framePtr = $1;$n" % [tmpFramePtr]) while i < n.len and n[i].kind == nkExceptBranch: if n[i].len == 1: # general except section: @@ -798,7 +966,7 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = moveInto(p, a, r) if i > 1: lineF(p, "}$n", []) else: - var orExpr: Rope = nil + var orExpr: Rope = "" var excAlias: PNode = nil useMagic(p, "isObj") @@ -811,19 +979,20 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = excAlias = it[2] # If this is a ``except exc as sym`` branch there must be no following # nodes - doAssert orExpr == nil + doAssert orExpr == "" elif it.kind == nkType: throwObj = it else: + throwObj = nil internalError(p.config, n.info, "genTryStmt") - if orExpr != nil: orExpr.add("||") + if orExpr != "": orExpr.add("||") # Generate the correct type checking code depending on whether this is a # NIM-native or a JS-native exception # if isJsObject(throwObj.typ): if isImportedException(throwObj.typ, p.config): orExpr.addf("lastJSError instanceof $1", - [throwObj.typ.sym.loc.r]) + [throwObj.typ.sym.loc.snippet]) else: orExpr.addf("isObj(lastJSError.m_type, $1)", [genTypeInfo(p, throwObj.typ)]) @@ -833,8 +1002,8 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = # If some branch requires a local alias introduce it here. This is needed # since JS cannot do ``catch x as y``. if excAlias != nil: - excAlias.sym.loc.r = mangleName(p.module, excAlias.sym) - lineF(p, "var $1 = lastJSError;$n", excAlias.sym.loc.r) + excAlias.sym.loc.snippet = mangleName(p.module, excAlias.sym) + lineF(p, "var $1 = lastJSError;$n", excAlias.sym.loc.snippet) gen(p, n[i][^1], a) moveInto(p, a, r) lineF(p, "}$n", []) @@ -847,14 +1016,15 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = line(p, "}\L") lineF(p, "lastJSError = prevJSError;$n") line(p, "} finally {\L") - line(p, "framePtr = $1;$n" % [tmpFramePtr]) + if hasFrameInfo(p): + line(p, "framePtr = $1;$n" % [tmpFramePtr]) if i < n.len and n[i].kind == nkFinally: genStmt(p, n[i][0]) line(p, "}\L") proc genRaiseStmt(p: PProc, n: PNode) = if n[0].kind != nkEmpty: - var a: TCompRes + var a: TCompRes = default(TCompRes) gen(p, n[0], a) let typ = skipTypes(n[0].typ, abstractPtrs) genLineDir(p, n) @@ -868,14 +1038,18 @@ proc genRaiseStmt(p: PProc, n: PNode) = proc genCaseJS(p: PProc, n: PNode, r: var TCompRes) = var - cond, stmt: TCompRes - totalRange = 0 + a, b, cond, stmt: TCompRes = default(TCompRes) genLineDir(p, n) gen(p, n[0], cond) - let stringSwitch = skipTypes(n[0].typ, abstractVar).kind == tyString - if stringSwitch: + let typeKind = skipTypes(n[0].typ, abstractVar+{tyRange}).kind + var transferRange = false + let anyString = typeKind in {tyString, tyCstring} + case typeKind + of tyString: useMagic(p, "toJSStr") lineF(p, "switch (toJSStr($1)) {$n", [cond.rdLoc]) + of tyFloat..tyFloat128, tyInt..tyInt64, tyUInt..tyUInt64: + transferRange = true else: lineF(p, "switch ($1) {$n", [cond.rdLoc]) if not isEmptyType(n.typ): @@ -883,41 +1057,76 @@ proc genCaseJS(p: PProc, n: PNode, r: var TCompRes) = r.res = getTemp(p) for i in 1..<n.len: let it = n[i] + let itLen = it.len case it.kind of nkOfBranch: - for j in 0..<it.len - 1: + if transferRange: + if i == 1: + lineF(p, "if (", []) + else: + lineF(p, "else if (", []) + for j in 0..<itLen - 1: let e = it[j] if e.kind == nkRange: - 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!") - while v.intVal <= e[1].intVal: - gen(p, v, cond) - lineF(p, "case $1:$n", [cond.rdLoc]) - inc(v.intVal) + if transferRange: + gen(p, e[0], a) + gen(p, e[1], b) + if j != itLen - 2: + lineF(p, "$1 >= $2 && $1 <= $3 || $n", [cond.rdLoc, a.rdLoc, b.rdLoc]) + else: + lineF(p, "$1 >= $2 && $1 <= $3", [cond.rdLoc, a.rdLoc, b.rdLoc]) + else: + var v = copyNode(e[0]) + while v.intVal <= e[1].intVal: + gen(p, v, cond) + lineF(p, "case $1:$n", [cond.rdLoc]) + inc(v.intVal) else: - if stringSwitch: + if anyString: case e.kind of nkStrLit..nkTripleStrLit: lineF(p, "case $1:$n", [makeJSString(e.strVal, false)]) + of nkNilLit: lineF(p, "case null:$n", []) else: internalError(p.config, e.info, "jsgen.genCaseStmt: 2") else: - gen(p, e, cond) - lineF(p, "case $1:$n", [cond.rdLoc]) + if transferRange: + gen(p, e, a) + if j != itLen - 2: + lineF(p, "$1 == $2 || $n", [cond.rdLoc, a.rdLoc]) + else: + lineF(p, "$1 == $2", [cond.rdLoc, a.rdLoc]) + else: + gen(p, e, a) + lineF(p, "case $1:$n", [a.rdLoc]) + if transferRange: + lineF(p, "){", []) p.nested: gen(p, lastSon(it), stmt) moveInto(p, stmt, r) - lineF(p, "break;$n", []) + if transferRange: + lineF(p, "}$n", []) + else: + lineF(p, "break;$n", []) of nkElse: - lineF(p, "default: $n", []) + if transferRange: + if n.len == 2: # a dangling else for a case statement + transferRange = false + lineF(p, "switch ($1) {$n", [cond.rdLoc]) + lineF(p, "default: $n", []) + else: + lineF(p, "else{$n", []) + else: + lineF(p, "default: $n", []) p.nested: gen(p, it[0], stmt) moveInto(p, stmt, r) - lineF(p, "break;$n", []) + if transferRange: + lineF(p, "}$n", []) + else: + lineF(p, "break;$n", []) else: internalError(p.config, it.info, "jsgen.genCaseStmt") - lineF(p, "}$n", []) + if not transferRange: + lineF(p, "}$n", []) proc genBlock(p: PProc, n: PNode, r: var TCompRes) = inc(p.unique) @@ -929,12 +1138,12 @@ proc genBlock(p: PProc, n: PNode, r: var TCompRes) = sym.loc.k = locOther sym.position = idx+1 let labl = p.unique - lineF(p, "L$1: do {$n", [labl.rope]) + lineF(p, "Label$1: {$n", [labl.rope]) setLen(p.blocks, idx + 1) p.blocks[idx].id = - p.unique # negative because it isn't used yet gen(p, n[1], r) setLen(p.blocks, idx) - lineF(p, "} while(false);$n", [labl.rope]) + lineF(p, "};$n", [labl.rope]) proc genBreakStmt(p: PProc, n: PNode) = var idx: int @@ -952,12 +1161,16 @@ proc genBreakStmt(p: PProc, n: PNode) = if idx < 0 or not p.blocks[idx].isLoop: internalError(p.config, n.info, "no loop to break") p.blocks[idx].id = abs(p.blocks[idx].id) # label is used - lineF(p, "break L$1;$n", [rope(p.blocks[idx].id)]) + lineF(p, "break Label$1;$n", [rope(p.blocks[idx].id)]) -proc genAsmOrEmitStmt(p: PProc, n: PNode) = +proc genAsmOrEmitStmt(p: PProc, n: PNode; isAsmStmt = false) = genLineDir(p, n) - p.body.add p.indentLine(nil) - for i in 0..<n.len: + p.body.add p.indentLine("") + let offset = + if isAsmStmt: 1 # first son is pragmas + else: 0 + + for i in offset..<n.len: let it = n[i] case it.kind of nkStrLit..nkTripleStrLit: @@ -968,29 +1181,29 @@ proc genAsmOrEmitStmt(p: PProc, n: PNode) = if false: discard else: - var r: TCompRes + var r = default(TCompRes) gen(p, it, r) if it.typ.kind == tyPointer: # A fat pointer is disguised as an array r.res = r.address - r.address = nil + r.address = "" r.typ = etyNone elif r.typ == etyBaseIndex: # Deference first r.res = "$1[$2]" % [r.address, r.res] - r.address = nil + r.address = "" r.typ = etyNone p.body.add(r.rdLoc) else: - var r: TCompRes + var r: TCompRes = default(TCompRes) gen(p, it, r) p.body.add(r.rdLoc) p.body.add "\L" proc genIf(p: PProc, n: PNode, r: var TCompRes) = - var cond, stmt: TCompRes + var cond, stmt: TCompRes = default(TCompRes) var toClose = 0 if not isEmptyType(n.typ): r.kind = resVal @@ -1012,13 +1225,22 @@ proc genIf(p: PProc, n: PNode, r: var TCompRes) = lineF(p, "}$n", []) line(p, repeat('}', toClose) & "\L") -proc generateHeader(p: PProc, typ: PType): Rope = - result = nil +proc generateHeader(p: PProc, prc: PSym): Rope = + result = "" + let typ = prc.typ + if jsNoLambdaLifting notin p.config.legacyFeatures: + if typ.callConv == ccClosure: + # we treat Env as the `this` parameter of the function + # to keep it simple + let env = prc.ast[paramsPos].lastSon + assert env.kind == nkSym, "env is missing" + env.sym.loc.snippet = "this" + for i in 1..<typ.n.len: assert(typ.n[i].kind == nkSym) var param = typ.n[i].sym if isCompileTimeOnly(param.typ): continue - if result != nil: result.add(", ") + if result != "": result.add(", ") var name = mangleName(p.module, param) result.add(name) if mapType(param.typ) == etyBaseIndex: @@ -1027,6 +1249,7 @@ proc generateHeader(p: PProc, typ: PType): Rope = result.add("_Idx") proc countJsParams(typ: PType): int = + result = 0 for i in 1..<typ.n.len: assert(typ.n[i].kind == nkSym) var param = typ.n[i].sym @@ -1045,16 +1268,17 @@ const proc needsNoCopy(p: PProc; y: PNode): bool = return y.kind in nodeKindsNeedNoCopy or - ((mapType(y.typ) != etyBaseIndex or (y.kind == nkSym and y.sym.kind == skParam)) and + ((mapType(y.typ) != etyBaseIndex or + (jsNoLambdaLifting in p.config.legacyFeatures and y.kind == nkSym and y.sym.kind == skParam)) and (skipTypes(y.typ, abstractInst).kind in - {tyRef, tyPtr, tyLent, tyVar, tyCString, tyProc, tyOwned} + IntegralTypes)) + {tyRef, tyPtr, tyLent, tyVar, tyCstring, tyProc, tyOwned, tyOpenArray} + IntegralTypes)) proc genAsgnAux(p: PProc, x, y: PNode, noCopyNeeded: bool) = - var a, b: TCompRes + var a, b: TCompRes = default(TCompRes) var xtyp = mapType(p, x.typ) # disable `[]=` for cstring - if x.kind == nkBracketExpr and x.len >= 2 and x[0].typ.skipTypes(abstractInst).kind == tyCString: + 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") gen(p, x, a) @@ -1067,14 +1291,14 @@ proc genAsgnAux(p: PProc, x, y: PNode, noCopyNeeded: bool) = xtyp = etySeq case xtyp of etySeq: - if (needsNoCopy(p, y) and needsNoCopy(p, x)) or noCopyNeeded: + if x.typ.kind in {tyVar, tyLent} or (needsNoCopy(p, y) and needsNoCopy(p, x)) or noCopyNeeded: lineF(p, "$1 = $2;$n", [a.rdLoc, b.rdLoc]) else: useMagic(p, "nimCopy") lineF(p, "$1 = nimCopy(null, $2, $3);$n", [a.rdLoc, b.res, genTypeInfo(p, y.typ)]) of etyObject: - if x.typ.kind in {tyVar} or (needsNoCopy(p, y) and needsNoCopy(p, x)) or noCopyNeeded: + if x.typ.kind in {tyVar, tyLent, tyOpenArray, tyVarargs} or (needsNoCopy(p, y) and needsNoCopy(p, x)) or noCopyNeeded: lineF(p, "$1 = $2;$n", [a.rdLoc, b.rdLoc]) else: useMagic(p, "nimCopy") @@ -1093,16 +1317,24 @@ proc genAsgnAux(p: PProc, x, y: PNode, noCopyNeeded: bool) = elif b.typ == etyBaseIndex: lineF(p, "$# = [$#, $#];$n", [a.res, b.address, b.res]) elif b.typ == etyNone: - internalAssert p.config, b.address == nil + internalAssert p.config, b.address == "" lineF(p, "$# = [$#, 0];$n", [a.address, b.res]) elif x.typ.kind == tyVar and y.typ.kind == tyPtr: lineF(p, "$# = [$#, $#];$n", [a.res, b.address, b.res]) lineF(p, "$1 = $2;$n", [a.address, b.res]) lineF(p, "$1 = $2;$n", [a.rdLoc, b.rdLoc]) + elif a.typ == etyBaseIndex: + # array indexing may not map to var type + if b.address != "": + lineF(p, "$1 = $2; $3 = $4;$n", [a.address, b.address, a.res, b.res]) + else: + lineF(p, "$1 = $2;$n", [a.address, b.res]) else: internalError(p.config, x.info, $("genAsgn", b.typ, a.typ)) - else: + elif b.address != "": lineF(p, "$1 = $2; $3 = $4;$n", [a.address, b.address, a.res, b.res]) + else: + lineF(p, "$1 = $2;$n", [a.address, b.res]) else: lineF(p, "$1 = $2;$n", [a.rdLoc, b.rdLoc]) @@ -1121,28 +1353,21 @@ proc genFastAsgn(p: PProc, n: PNode) = genAsgnAux(p, n[0], n[1], noCopyNeeded=noCopy) proc genSwap(p: PProc, n: PNode) = - var a, b: TCompRes - gen(p, n[1], a) - gen(p, n[2], b) - var tmp = p.getTemp(false) - if mapType(p, skipTypes(n[1].typ, abstractVar)) == etyBaseIndex: - let tmp2 = p.getTemp(false) - if a.typ != etyBaseIndex or b.typ != etyBaseIndex: - internalError(p.config, n.info, "genSwap") - lineF(p, "var $1 = $2; $2 = $3; $3 = $1;$n", - [tmp, a.address, b.address]) - tmp = tmp2 - lineF(p, "var $1 = $2; $2 = $3; $3 = $1;", - [tmp, a.res, b.res]) + let stmtList = lowerSwap(p.module.graph, n, p.module.idgen, if p.prc != nil: p.prc else: p.module.module) + assert stmtList.kind == nkStmtList + for i in 0..<stmtList.len: + genStmt(p, stmtList[i]) proc getFieldPosition(p: PProc; f: PNode): int = case f.kind of nkIntLit..nkUInt64Lit: result = int(f.intVal) of nkSym: result = f.sym.position - else: internalError(p.config, f.info, "genFieldPosition") + else: + result = 0 + internalError(p.config, f.info, "genFieldPosition") proc genFieldAddr(p: PProc, n: PNode, r: var TCompRes) = - var a: TCompRes + var a: TCompRes = default(TCompRes) r.typ = etyBaseIndex let b = if n.kind == nkHiddenAddr: n[0] else: n gen(p, b[0], a) @@ -1151,8 +1376,8 @@ proc genFieldAddr(p: PProc, n: PNode, r: var TCompRes) = else: if b[1].kind != nkSym: internalError(p.config, b[1].info, "genFieldAddr") var f = b[1].sym - if f.loc.r == nil: f.loc.r = mangleName(p.module, f) - r.res = makeJSString($f.loc.r) + if f.loc.snippet == "": f.loc.snippet = mangleName(p.module, f) + r.res = makeJSString($f.loc.snippet) internalAssert p.config, a.typ != etyBaseIndex r.address = a.res r.kind = resExpr @@ -1179,8 +1404,8 @@ proc genFieldAccess(p: PProc, n: PNode, r: var TCompRes) = else: if n[1].kind != nkSym: internalError(p.config, n[1].info, "genFieldAccess") var f = n[1].sym - if f.loc.r == nil: f.loc.r = mangleName(p.module, f) - r.res = "$1.$2" % [r.res, f.loc.r] + if f.loc.snippet == "": f.loc.snippet = mangleName(p.module, f) + r.res = "$1.$2" % [r.res, f.loc.snippet] mkTemp(1) r.kind = resExpr @@ -1200,42 +1425,43 @@ proc genCheckedFieldOp(p: PProc, n: PNode, addrTyp: PType, r: var TCompRes) = # Field symbol var field = accessExpr[1].sym internalAssert p.config, field.kind == skField - if field.loc.r == nil: field.loc.r = mangleName(p.module, field) + if field.loc.snippet == "": field.loc.snippet = mangleName(p.module, field) # Discriminant symbol let disc = checkExpr[2].sym internalAssert p.config, disc.kind == skField - if disc.loc.r == nil: disc.loc.r = mangleName(p.module, disc) + if disc.loc.snippet == "": disc.loc.snippet = mangleName(p.module, disc) - var setx: TCompRes + var setx: TCompRes = default(TCompRes) gen(p, checkExpr[1], setx) - var obj: TCompRes + var obj: TCompRes = default(TCompRes) gen(p, accessExpr[0], obj) # Avoid evaluating the LHS twice (one to read the discriminant and one to read # the field) let tmp = p.getTemp() lineF(p, "var $1 = $2;$n", tmp, obj.res) - useMagic(p, "raiseFieldError") + useMagic(p, "raiseFieldError2") useMagic(p, "makeNimstrLit") - let msg = genFieldDefect(field, disc) - lineF(p, "if ($1[$2.$3]$4undefined) { raiseFieldError(makeNimstrLit($5)); }$n", - setx.res, tmp, disc.loc.r, if negCheck: ~"!==" else: ~"===", - makeJSString(msg)) + useMagic(p, "reprDiscriminant") # no need to offset by firstOrd unlike for cgen + let msg = genFieldDefect(p.config, field.name.s, disc) + lineF(p, "if ($1[$2.$3]$4undefined) { raiseFieldError2(makeNimstrLit($5), reprDiscriminant($2.$3, $6)); }$n", + setx.res, tmp, disc.loc.snippet, if negCheck: "!==" else: "===", + makeJSString(msg), genTypeInfo(p, disc.typ)) if addrTyp != nil and mapType(p, addrTyp) == etyBaseIndex: r.typ = etyBaseIndex - r.res = makeJSString($field.loc.r) + r.res = makeJSString($field.loc.snippet) r.address = tmp else: r.typ = etyNone - r.res = "$1.$2" % [tmp, field.loc.r] + r.res = "$1.$2" % [tmp, field.loc.snippet] r.kind = resExpr proc genArrayAddr(p: PProc, n: PNode, r: var TCompRes) = var - a, b: TCompRes - first: Int128 + a, b: TCompRes = default(TCompRes) + first: Int128 = Zero r.typ = etyBaseIndex let m = if n.kind == nkHiddenAddr: n[0] else: n gen(p, m[0], a) @@ -1245,32 +1471,32 @@ proc genArrayAddr(p: PProc, n: PNode, r: var TCompRes) = r.address = x var typ = skipTypes(m[0].typ, abstractPtrs) if typ.kind == tyArray: - first = firstOrd(p.config, typ[0]) + first = firstOrd(p.config, typ.indexType) if optBoundsCheck in p.options: useMagic(p, "chckIndx") if first == 0: # save a couple chars - r.res = "chckIndx($1, 0, ($2).length-1)" % [b.res, tmp] + r.res = "chckIndx($1, 0, ($2).length - 1)" % [b.res, tmp] else: - r.res = "chckIndx($1, $2, ($3).length+($2)-1)-($2)" % [ + r.res = "chckIndx($1, $2, ($3).length + ($2) - 1) - ($2)" % [ b.res, rope(first), tmp] elif first != 0: - r.res = "($1)-($2)" % [b.res, rope(first)] + r.res = "($1) - ($2)" % [b.res, rope(first)] else: r.res = b.res r.kind = resExpr proc genArrayAccess(p: PProc, n: PNode, r: var TCompRes) = - var ty = skipTypes(n[0].typ, abstractVarRange) - if ty.kind in {tyRef, tyPtr, tyLent, tyOwned}: ty = skipTypes(ty.lastSon, abstractVarRange) + var ty = skipTypes(n[0].typ, abstractVarRange+tyUserTypeClasses) + if ty.kind in {tyRef, tyPtr, tyLent, tyOwned}: ty = skipTypes(ty.elementType, abstractVarRange) case ty.kind - of tyArray, tyOpenArray, tySequence, tyString, tyCString, tyVarargs: + of tyArray, tyOpenArray, tySequence, tyString, tyCstring, tyVarargs: genArrayAddr(p, n, r) of tyTuple: genFieldAddr(p, n, r) else: internalError(p.config, n.info, "expr(nkBracketExpr, " & $ty.kind & ')') r.typ = mapType(n.typ) - if r.res == nil: internalError(p.config, n.info, "genArrayAccess") - if ty.kind == tyCString: + if r.res == "": internalError(p.config, n.info, "genArrayAccess") + if ty.kind == tyCstring: r.res = "$1.charCodeAt($2)" % [r.address, r.res] elif r.typ == etyBaseIndex: if needsTemp(p, n[0]): @@ -1294,75 +1520,96 @@ template isIndirect(x: PSym): bool = v.kind notin {skProc, skFunc, skConverter, skMethod, skIterator, skConst, skTemp, skLet}) -proc genAddr(p: PProc, n: PNode, r: var TCompRes) = - case n[0].kind - of nkSym: - let s = n[0].sym - if s.loc.r == nil: internalError(p.config, n.info, "genAddr: 3") - case s.kind - of skParam: - r.res = s.loc.r - r.address = nil +proc genSymAddr(p: PProc, n: PNode, typ: PType, r: var TCompRes) = + let s = n.sym + if s.loc.snippet == "": internalError(p.config, n.info, "genAddr: 3") + case s.kind + of skParam: + r.res = s.loc.snippet + r.address = "" + r.typ = etyNone + of skVar, skLet, skResult: + r.kind = resExpr + let jsType = mapType(p): + if typ.isNil: + n.typ + else: + typ + if jsType == etyObject: + # make addr() a no-op: r.typ = etyNone - of skVar, skLet, skResult: - r.kind = resExpr - let jsType = mapType(p, n.typ) - if jsType == etyObject: - # make addr() a no-op: - r.typ = etyNone - if isIndirect(s): - r.res = s.loc.r & "[0]" - else: - r.res = s.loc.r - r.address = nil - elif {sfGlobal, sfAddrTaken} * s.flags != {} or jsType == etyBaseIndex: - # for ease of code generation, we do not distinguish between - # sfAddrTaken and sfGlobal. - r.typ = etyBaseIndex - r.address = s.loc.r - r.res = rope("0") + if isIndirect(s): + r.res = s.loc.snippet & "[0]" else: - # 'var openArray' for instance produces an 'addr' but this is harmless: - gen(p, n[0], r) - #internalError(p.config, n.info, "genAddr: 4 " & renderTree(n)) - else: internalError(p.config, n.info, $("genAddr: 2", s.kind)) - of nkCheckedFieldExpr: - genCheckedFieldOp(p, n[0], n.typ, r) - of nkDotExpr: - if mapType(p, n.typ) == etyBaseIndex: - genFieldAddr(p, n[0], r) - else: - genFieldAccess(p, n[0], r) - of nkBracketExpr: - var ty = skipTypes(n[0].typ, abstractVarRange) - if ty.kind in MappedToObject: - gen(p, n[0], r) + r.res = s.loc.snippet + r.address = "" + elif {sfGlobal, sfAddrTaken} * s.flags != {} or jsType == etyBaseIndex: + # for ease of code generation, we do not distinguish between + # sfAddrTaken and sfGlobal. + r.typ = etyBaseIndex + r.address = s.loc.snippet + r.res = rope("0") else: - let kindOfIndexedExpr = skipTypes(n[0][0].typ, abstractVarRange).kind - case kindOfIndexedExpr - of tyArray, tyOpenArray, tySequence, tyString, tyCString, tyVarargs: - genArrayAddr(p, n[0], r) - of tyTuple: - genFieldAddr(p, n[0], r) - else: internalError(p.config, n[0].info, "expr(nkBracketExpr, " & $kindOfIndexedExpr & ')') - of nkObjDownConv: - gen(p, n[0], r) - of nkHiddenDeref: - gen(p, n[0], r) - of nkHiddenAddr: - gen(p, n[0], r) - of nkStmtListExpr: - if n.len == 1: gen(p, n[0], r) - else: internalError(p.config, n[0].info, "genAddr for complex nkStmtListExpr") - of nkCallKinds: - if n[0].typ.kind == tyOpenArray: # 'var openArray' for instance produces an 'addr' but this is harmless: - # namely toOpenArray(a, 1, 3) + gen(p, n, r) + #internalError(p.config, n.info, "genAddr: 4 " & renderTree(n)) + else: internalError(p.config, n.info, $("genAddr: 2", s.kind)) + +proc genAddr(p: PProc, n: PNode, r: var TCompRes) = + if n.kind == nkSym: + genSymAddr(p, n, nil, r) + else: + case n[0].kind + of nkSym: + genSymAddr(p, n[0], n.typ, r) + of nkCheckedFieldExpr: + genCheckedFieldOp(p, n[0], n.typ, r) + of nkDotExpr: + if mapType(p, n.typ) == etyBaseIndex: + genFieldAddr(p, n[0], r) + else: + genFieldAccess(p, n[0], r) + of nkBracketExpr: + var ty = skipTypes(n[0].typ, abstractVarRange) + if ty.kind in MappedToObject: + gen(p, n[0], r) + else: + let kindOfIndexedExpr = skipTypes(n[0][0].typ, abstractVarRange+tyUserTypeClasses).kind + case kindOfIndexedExpr + of tyArray, tyOpenArray, tySequence, tyString, tyCstring, tyVarargs: + genArrayAddr(p, n[0], r) + of tyTuple: + genFieldAddr(p, n[0], r) + of tyGenericBody: + genAddr(p, n[^1], r) + else: internalError(p.config, n[0].info, "expr(nkBracketExpr, " & $kindOfIndexedExpr & ')') + of nkObjDownConv: gen(p, n[0], r) + of nkHiddenDeref: + gen(p, n[0], r) + of nkDerefExpr: + var x = n[0] + if n.kind == nkHiddenAddr: + x = n[0][0] + if n.typ.skipTypes(abstractVar).kind != tyOpenArray: + x.typ = n.typ + gen(p, x, r) + of nkHiddenAddr: + gen(p, n[0], r) + of nkConv: + genAddr(p, n[0], r) + of nkStmtListExpr: + if n.len == 1: gen(p, n[0], r) + else: internalError(p.config, n[0].info, "genAddr for complex nkStmtListExpr") + of nkCallKinds: + if n[0].typ.kind == tyOpenArray: + # 'var openArray' for instance produces an 'addr' but this is harmless: + # namely toOpenArray(a, 1, 3) + gen(p, n[0], r) + else: + internalError(p.config, n[0].info, "genAddr: " & $n[0].kind) else: internalError(p.config, n[0].info, "genAddr: " & $n[0].kind) - else: - internalError(p.config, n[0].info, "genAddr: " & $n[0].kind) proc attachProc(p: PProc; content: Rope; s: PSym) = p.g.code.add(content) @@ -1373,12 +1620,15 @@ proc attachProc(p: PProc; s: PSym) = proc genProcForSymIfNeeded(p: PProc, s: PSym) = if not p.g.generatedSyms.containsOrIncl(s.id): - let newp = genProc(p, s) - var owner = p - while owner != nil and owner.prc != s.owner: - owner = owner.up - if owner != nil: owner.locals.add(newp) - else: attachProc(p, newp, s) + if jsNoLambdaLifting in p.config.legacyFeatures: + let newp = genProc(p, s) + var owner = p + while owner != nil and owner.prc != s.owner: + owner = owner.up + if owner != nil: owner.locals.add(newp) + else: attachProc(p, newp, s) + else: + attachProc(p, s) proc genCopyForParamIfNeeded(p: PProc, n: PNode) = let s = n.sym @@ -1390,7 +1640,7 @@ proc genCopyForParamIfNeeded(p: PProc, n: PNode) = internalError(p.config, n.info, "couldn't find the owner proc of the closed over param: " & s.name.s) if owner.prc == s.owner: if not owner.generatedParamCopies.containsOrIncl(s.id): - let copy = "$1 = nimCopy(null, $1, $2);$n" % [s.loc.r, genTypeInfo(p, s.typ)] + let copy = "$1 = nimCopy(null, $1, $2);$n" % [s.loc.snippet, genTypeInfo(p, s.typ)] owner.locals.add(owner.indentLine(copy)) return owner = owner.up @@ -1401,41 +1651,41 @@ proc genSym(p: PProc, n: PNode, r: var TCompRes) = var s = n.sym case s.kind of skVar, skLet, skParam, skTemp, skResult, skForVar: - if s.loc.r == nil: + if s.loc.snippet == "": internalError(p.config, n.info, "symbol has no generated name: " & s.name.s) if sfCompileTime in s.flags: - genVarInit(p, s, if s.ast != nil: s.ast else: newNodeI(nkEmpty, s.info)) - if s.kind == skParam: + genVarInit(p, s, if s.astdef != nil: s.astdef else: newNodeI(nkEmpty, s.info)) + if jsNoLambdaLifting in p.config.legacyFeatures and s.kind == skParam: genCopyForParamIfNeeded(p, n) let k = mapType(p, s.typ) if k == etyBaseIndex: r.typ = etyBaseIndex if {sfAddrTaken, sfGlobal} * s.flags != {}: if isIndirect(s): - r.address = "$1[0][0]" % [s.loc.r] - r.res = "$1[0][1]" % [s.loc.r] + r.address = "$1[0][0]" % [s.loc.snippet] + r.res = "$1[0][1]" % [s.loc.snippet] else: - r.address = "$1[0]" % [s.loc.r] - r.res = "$1[1]" % [s.loc.r] + r.address = "$1[0]" % [s.loc.snippet] + r.res = "$1[1]" % [s.loc.snippet] else: - r.address = s.loc.r - r.res = s.loc.r & "_Idx" + r.address = s.loc.snippet + r.res = s.loc.snippet & "_Idx" elif isIndirect(s): - r.res = "$1[0]" % [s.loc.r] + r.res = "$1[0]" % [s.loc.snippet] else: - r.res = s.loc.r + r.res = s.loc.snippet of skConst: genConstant(p, s) - if s.loc.r == nil: + if s.loc.snippet == "": internalError(p.config, n.info, "symbol has no generated name: " & s.name.s) - r.res = s.loc.r - of skProc, skFunc, skConverter, skMethod: + r.res = s.loc.snippet + of skProc, skFunc, skConverter, skMethod, skIterator: if sfCompileTime in s.flags: localError(p.config, n.info, "request to generate code for .compileTime proc: " & s.name.s) discard mangleName(p.module, s) - r.res = s.loc.r - if lfNoDecl in s.loc.flags or s.magic notin {mNone, mIsolate} or + r.res = s.loc.snippet + if lfNoDecl in s.loc.flags or s.magic notin generatedMagics or {sfImportc, sfInfixCall} * s.flags != {}: discard elif s.kind == skMethod and getBody(p.module.graph, s).kind == nkEmpty: @@ -1446,18 +1696,22 @@ proc genSym(p: PProc, n: PNode, r: var TCompRes) = else: genProcForSymIfNeeded(p, s) else: - if s.loc.r == nil: + if s.loc.snippet == "": internalError(p.config, n.info, "symbol has no generated name: " & s.name.s) - r.res = s.loc.r + if mapType(p, s.typ) == etyBaseIndex: + r.address = s.loc.snippet + r.res = s.loc.snippet & "_Idx" + else: + r.res = s.loc.snippet r.kind = resVal proc genDeref(p: PProc, n: PNode, r: var TCompRes) = let it = n[0] let t = mapType(p, it.typ) - if t == etyObject: + if t == etyObject or it.typ.kind == tyLent: gen(p, it, r) else: - var a: TCompRes + var a: TCompRes = default(TCompRes) gen(p, it, a) r.kind = a.kind r.typ = mapType(p, n.typ) @@ -1467,14 +1721,14 @@ proc genDeref(p: PProc, n: PNode, r: var TCompRes) = r.res = "$1[1]" % [tmp] r.tmpLoc = tmp elif a.typ == etyBaseIndex: - if a.tmpLoc != nil: + if a.tmpLoc != "": r.tmpLoc = a.tmpLoc r.res = a.rdLoc else: internalError(p.config, n.info, "genDeref") proc genArgNoParam(p: PProc, n: PNode, r: var TCompRes) = - var a: TCompRes + var a: TCompRes = default(TCompRes) gen(p, n, a) if a.typ == etyBaseIndex: r.res.add(a.address) @@ -1484,7 +1738,7 @@ proc genArgNoParam(p: PProc, n: PNode, r: var TCompRes) = r.res.add(a.res) proc genArg(p: PProc, n: PNode, param: PSym, r: var TCompRes; emitted: ptr int = nil) = - var a: TCompRes + var a: TCompRes = default(TCompRes) gen(p, n, a) if skipTypes(param.typ, abstractVar).kind in {tyOpenArray, tyVarargs} and a.typ == etyBaseIndex: @@ -1590,9 +1844,9 @@ proc genPatternCall(p: PProc; n: PNode; pat: string; typ: PType; proc genInfixCall(p: PProc, n: PNode, r: var TCompRes) = # don't call '$' here for efficiency: let f = n[0].sym - if f.loc.r == nil: f.loc.r = mangleName(p.module, f) + if f.loc.snippet == "": f.loc.snippet = mangleName(p.module, f) if sfInfixCall in f.flags: - let pat = n[0].sym.loc.r.data + let pat = $n[0].sym.loc.snippet internalAssert p.config, pat.len > 0 if pat.contains({'#', '(', '@'}): var typ = skipTypes(n[0].typ, abstractInst) @@ -1602,13 +1856,13 @@ proc genInfixCall(p: PProc, n: PNode, r: var TCompRes) = if n.len != 1: gen(p, n[1], r) if r.typ == etyBaseIndex: - if r.address == nil: + if r.address == "": globalError(p.config, n.info, "cannot invoke with infix syntax") r.res = "$1[$2]" % [r.address, r.res] - r.address = nil + r.address = "" r.typ = etyNone r.res.add(".") - var op: TCompRes + var op: TCompRes = default(TCompRes) gen(p, n[0], op) r.res.add(op.res) genArgs(p, n, r, 2) @@ -1670,33 +1924,56 @@ proc createObjInitList(p: PProc, typ: PType, excludedFieldIDs: IntSet, output: v while t != nil: t = t.skipTypes(skipPtrs) createRecordVarAux(p, t.n, excludedFieldIDs, output) - t = t[0] + t = t.baseClass -proc arrayTypeForElemType(typ: PType): string = - # XXX This should also support tyEnum and tyBool +proc arrayTypeForElemType(conf: ConfigRef; typ: PType): string = + let typ = typ.skipTypes(abstractRange) case typ.kind of tyInt, tyInt32: "Int32Array" of tyInt16: "Int16Array" of tyInt8: "Int8Array" + of tyInt64: + if optJsBigInt64 in conf.globalOptions: + "BigInt64Array" + else: + "" of tyUInt, tyUInt32: "Uint32Array" of tyUInt16: "Uint16Array" - of tyUInt8: "Uint8Array" + of tyUInt8, tyChar, tyBool: "Uint8Array" + of tyUInt64: + if optJsBigInt64 in conf.globalOptions: + "BigUint64Array" + else: + "" of tyFloat32: "Float32Array" of tyFloat64, tyFloat: "Float64Array" + of tyEnum: + case typ.size + of 1: "Uint8Array" + of 2: "Uint16Array" + of 4: "Uint32Array" + else: "" else: "" proc createVar(p: PProc, typ: PType, indirect: bool): Rope = var t = skipTypes(typ, abstractInst) case t.kind - of tyInt..tyInt64, tyUInt..tyUInt64, tyEnum, tyChar: - if $t.sym.loc.r == "bigint": + of tyInt8..tyInt32, tyUInt8..tyUInt32, tyEnum, tyChar: + result = putToSeq("0", indirect) + of tyInt, tyUInt: + if $t.sym.loc.snippet == "bigint": + result = putToSeq("0n", indirect) + else: + result = putToSeq("0", indirect) + of tyInt64, tyUInt64: + if optJsBigInt64 in p.config.globalOptions: result = putToSeq("0n", indirect) else: result = putToSeq("0", indirect) of tyFloat..tyFloat128: result = putToSeq("0.0", indirect) - of tyRange, tyGenericInst, tyAlias, tySink, tyOwned: - result = createVar(p, lastSon(typ), indirect) + of tyRange, tyGenericInst, tyAlias, tySink, tyOwned, tyLent: + result = createVar(p, skipModifier(typ), indirect) of tySet: result = putToSeq("{}", indirect) of tyBool: @@ -1706,7 +1983,7 @@ proc createVar(p: PProc, typ: PType, indirect: bool): Rope = of tyArray: let length = toInt(lengthOrd(p.config, t)) let e = elemType(t) - let jsTyp = arrayTypeForElemType(e) + let jsTyp = arrayTypeForElemType(p.config, e) if jsTyp.len > 0: result = "new $1($2)" % [rope(jsTyp), rope(length)] elif length > 32: @@ -1733,34 +2010,34 @@ proc createVar(p: PProc, typ: PType, indirect: bool): Rope = result.add("}") if indirect: result = "[$1]" % [result] of tyObject: - var initList: Rope + var initList: Rope = "" createObjInitList(p, t, initIntSet(), initList) result = ("({$1})") % [initList] if indirect: result = "[$1]" % [result] - of tyVar, tyPtr, tyLent, tyRef, tyPointer: + of tyVar, tyPtr, tyRef, tyPointer: if mapType(p, t) == etyBaseIndex: result = putToSeq("[null, 0]", indirect) else: result = putToSeq("null", indirect) of tySequence, tyString: result = putToSeq("[]", indirect) - of tyCString, tyProc: + of tyCstring, tyProc, tyOpenArray: result = putToSeq("null", indirect) of tyStatic: if t.n != nil: - result = createVar(p, lastSon t, indirect) + result = createVar(p, skipModifier t, indirect) else: internalError(p.config, "createVar: " & $t.kind) - result = nil + result = "" else: internalError(p.config, "createVar: " & $t.kind) - result = nil + result = "" -template returnType: untyped = ~"" +template returnType: untyped = "" proc genVarInit(p: PProc, v: PSym, n: PNode) = var - a: TCompRes + a: TCompRes = default(TCompRes) s: Rope varCode: string varName = mangleName(p.module, v) @@ -1775,7 +2052,7 @@ proc genVarInit(p: PProc, v: PSym, n: PNode) = inc p.extraIndent elif useGlobalPragmas: lineF(p, "if (globalThis.$1 === undefined) {$n", varName) - varCode = $varName + varCode = "globalThis." & $varName inc p.extraIndent else: varCode = "var $2" @@ -1796,7 +2073,7 @@ proc genVarInit(p: PProc, v: PSym, n: PNode) = gen(p, n, a) case mapType(p, v.typ) of etyObject, etySeq: - if needsNoCopy(p, n): + if v.typ.kind in {tyOpenArray, tyVarargs} or needsNoCopy(p, n): s = a.res else: useMagic(p, "nimCopy") @@ -1806,33 +2083,44 @@ proc genVarInit(p: PProc, v: PSym, n: PNode) = if a.typ == etyBaseIndex: if targetBaseIndex: line(p, runtimeFormat(varCode & " = $3, $2_Idx = $4;$n", - [returnType, v.loc.r, a.address, a.res])) + [returnType, v.loc.snippet, a.address, a.res])) else: if isIndirect(v): line(p, runtimeFormat(varCode & " = [[$3, $4]];$n", - [returnType, v.loc.r, a.address, a.res])) + [returnType, v.loc.snippet, a.address, a.res])) else: line(p, runtimeFormat(varCode & " = [$3, $4];$n", - [returnType, v.loc.r, a.address, a.res])) + [returnType, v.loc.snippet, a.address, a.res])) else: if targetBaseIndex: let tmp = p.getTemp lineF(p, "var $1 = $2, $3 = $1[0], $3_Idx = $1[1];$n", - [tmp, a.res, v.loc.r]) + [tmp, a.res, v.loc.snippet]) else: - line(p, runtimeFormat(varCode & " = $3;$n", [returnType, v.loc.r, a.res])) + line(p, runtimeFormat(varCode & " = $3;$n", [returnType, v.loc.snippet, a.res])) return else: s = a.res if isIndirect(v): - line(p, runtimeFormat(varCode & " = [$3];$n", [returnType, v.loc.r, s])) + line(p, runtimeFormat(varCode & " = [$3];$n", [returnType, v.loc.snippet, s])) else: - line(p, runtimeFormat(varCode & " = $3;$n", [returnType, v.loc.r, s])) + line(p, runtimeFormat(varCode & " = $3;$n", [returnType, v.loc.snippet, s])) if useReloadingGuard or useGlobalPragmas: dec p.extraIndent lineF(p, "}$n") +proc genClosureVar(p: PProc, n: PNode) = + # assert n[2].kind != nkEmpty + # TODO: fixme transform `var env.x` into `var env.x = default()` after + # the order of transf and lambdalifting is fixed + if n[2].kind != nkEmpty: + genAsgnAux(p, n[0], n[2], false) + else: + var a: TCompRes = default(TCompRes) + gen(p, n[0], a) + line(p, runtimeFormat("$1 = $2;$n", [rdLoc(a), createVar(p, n[0].typ, false)])) + proc genVarStmt(p: PProc, n: PNode) = for i in 0..<n.len: var a = n[i] @@ -1842,27 +2130,28 @@ proc genVarStmt(p: PProc, n: PNode) = genStmt(p, unpacked) else: assert(a.kind == nkIdentDefs) - assert(a[0].kind == nkSym) - var v = a[0].sym - if lfNoDecl notin v.loc.flags and sfImportc notin v.flags: - genLineDir(p, a) - if sfCompileTime notin v.flags: - genVarInit(p, v, a[2]) - else: - # lazy emit, done when it's actually used. - if v.ast == nil: v.ast = a[2] + if a[0].kind == nkSym: + var v = a[0].sym + if lfNoDecl notin v.loc.flags and sfImportc notin v.flags: + genLineDir(p, a) + if sfCompileTime notin v.flags: + genVarInit(p, v, a[2]) + else: + # lazy emit, done when it's actually used. + if v.ast == nil: v.ast = a[2] + else: # closure + genClosureVar(p, a) proc genConstant(p: PProc, c: PSym) = if lfNoDecl notin c.loc.flags and not p.g.generatedSyms.containsOrIncl(c.id): - let oldBody = p.body - p.body = nil - #genLineDir(p, c.ast) - genVarInit(p, c, c.ast) + let oldBody = move p.body + #genLineDir(p, c.astdef) + genVarInit(p, c, c.astdef) p.g.constants.add(p.body) p.body = oldBody proc genNew(p: PProc, n: PNode) = - var a: TCompRes + var a: TCompRes = default(TCompRes) gen(p, n[1], a) var t = skipTypes(n[1].typ, abstractVar)[0] if mapType(t) == etyObject: @@ -1873,52 +2162,56 @@ proc genNew(p: PProc, n: PNode) = lineF(p, "$1 = [[$2], 0];$n", [a.rdLoc, createVar(p, t, false)]) proc genNewSeq(p: PProc, n: PNode) = - var x, y: TCompRes + var x, y: TCompRes = default(TCompRes) gen(p, n[1], x) gen(p, n[2], y) let t = skipTypes(n[1].typ, abstractVar)[0] - lineF(p, "$1 = new Array($2); for (var i=0;i<$2;++i) {$1[i]=$3;}", [ + lineF(p, "$1 = new Array($2); for (var i = 0 ; i < $2 ; ++i) { $1[i] = $3; }", [ x.rdLoc, y.rdLoc, createVar(p, t, false)]) proc genOrd(p: PProc, n: PNode, r: var TCompRes) = case skipTypes(n[1].typ, abstractVar + abstractRange).kind - of tyEnum, tyInt..tyUInt64, tyChar: gen(p, n[1], r) - of tyBool: unaryExpr(p, n, r, "", "($1 ? 1:0)") + of tyEnum, tyInt..tyInt32, tyUInt..tyUInt32, tyChar: gen(p, n[1], r) + of tyInt64, tyUInt64: + if optJsBigInt64 in p.config.globalOptions: + unaryExpr(p, n, r, "", "Number($1)") + else: gen(p, n[1], r) + of tyBool: unaryExpr(p, n, r, "", "($1 ? 1 : 0)") else: internalError(p.config, n.info, "genOrd") proc genConStrStr(p: PProc, n: PNode, r: var TCompRes) = - var a: TCompRes + var a: TCompRes = default(TCompRes) gen(p, n[1], a) r.kind = resExpr if skipTypes(n[1].typ, abstractVarRange).kind == tyChar: r.res.add("[$1].concat(" % [a.res]) else: - r.res.add("($1 || []).concat(" % [a.res]) + r.res.add("($1).concat(" % [a.res]) for i in 2..<n.len - 1: gen(p, n[i], a) if skipTypes(n[i].typ, abstractVarRange).kind == tyChar: r.res.add("[$1]," % [a.res]) else: - r.res.add("$1 || []," % [a.res]) + r.res.add("$1," % [a.res]) gen(p, n[^1], a) if skipTypes(n[^1].typ, abstractVarRange).kind == tyChar: r.res.add("[$1])" % [a.res]) else: - r.res.add("$1 || [])" % [a.res]) + r.res.add("$1)" % [a.res]) -proc genReprAux(p: PProc, n: PNode, r: var TCompRes, magic: string, typ: Rope = nil) = +proc genReprAux(p: PProc, n: PNode, r: var TCompRes, magic: string, typ: Rope = "") = useMagic(p, magic) r.res.add(magic & "(") - var a: TCompRes + var a: TCompRes = default(TCompRes) gen(p, n[1], a) if magic == "reprAny": # the pointer argument in reprAny is expandend to # (pointedto, pointer), so we need to fill it - if a.address.isNil: + if a.address.len == 0: r.res.add(a.res) r.res.add(", null") else: @@ -1926,14 +2219,14 @@ proc genReprAux(p: PProc, n: PNode, r: var TCompRes, magic: string, typ: Rope = else: r.res.add(a.res) - if not typ.isNil: + if typ != "": r.res.add(", ") r.res.add(typ) r.res.add(")") proc genRepr(p: PProc, n: PNode, r: var TCompRes) = let t = skipTypes(n[1].typ, abstractVarRange) - case t.kind: + case t.kind of tyInt..tyInt64, tyUInt..tyUInt64: genReprAux(p, n, r, "reprInt") of tyChar: @@ -1959,7 +2252,7 @@ proc genRepr(p: PProc, n: PNode, r: var TCompRes) = r.kind = resExpr proc genOf(p: PProc, n: PNode, r: var TCompRes) = - var x: TCompRes + var x: TCompRes = default(TCompRes) let t = skipTypes(n[2].typ, abstractVarRange+{tyRef, tyPtr, tyLent, tyTypeDesc, tyOwned}) gen(p, n[1], x) @@ -1974,28 +2267,36 @@ proc genDefault(p: PProc, n: PNode; r: var TCompRes) = r.res = createVar(p, n.typ, indirect = false) r.kind = resExpr -proc genReset(p: PProc, n: PNode) = - var x: TCompRes - useMagic(p, "genericReset") +proc genWasMoved(p: PProc, n: PNode) = + # TODO: it should be done by nir + var x: TCompRes = default(TCompRes) gen(p, n[1], x) if x.typ == etyBaseIndex: lineF(p, "$1 = null, $2 = 0;$n", [x.address, x.res]) else: - let (a, tmp) = maybeMakeTempAssignable(p, n[1], x) - lineF(p, "$1 = genericReset($3, $2);$n", [a, - genTypeInfo(p, n[1].typ), tmp]) + var y: TCompRes = default(TCompRes) + genDefault(p, n[1], y) + let (a, _) = maybeMakeTempAssignable(p, n[1], x) + lineF(p, "$1 = $2;$n", [a, y.rdLoc]) proc genMove(p: PProc; n: PNode; r: var TCompRes) = - var a: TCompRes + var a: TCompRes = default(TCompRes) r.kind = resVal r.res = p.getTemp() gen(p, n[1], a) lineF(p, "$1 = $2;$n", [r.rdLoc, a.rdLoc]) - genReset(p, n) + genWasMoved(p, n) #lineF(p, "$1 = $2;$n", [dest.rdLoc, src.rdLoc]) +proc genDup(p: PProc; n: PNode; r: var TCompRes) = + var a: TCompRes = default(TCompRes) + r.kind = resVal + r.res = p.getTemp() + gen(p, n[1], a) + lineF(p, "$1 = $2;$n", [r.rdLoc, a.rdLoc]) + proc genJSArrayConstr(p: PProc, n: PNode, r: var TCompRes) = - var a: TCompRes + var a: TCompRes = default(TCompRes) r.res = rope("[") r.kind = resExpr for i in 0 ..< n.len: @@ -2026,11 +2327,11 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = binaryExpr(p, n, r, "addChar", "addChar($1, $2);") of mAppendStrStr: - var lhs, rhs: TCompRes + var lhs, rhs: TCompRes = default(TCompRes) gen(p, n[1], lhs) gen(p, n[2], rhs) - if skipTypes(n[1].typ, abstractVarRange).kind == tyCString: + if skipTypes(n[1].typ, abstractVarRange).kind == tyCstring: let (b, tmp) = maybeMakeTemp(p, n[2], rhs) r.res = "if (null != $1) { if (null == $2) $2 = $3; else $2 += $3; }" % [b, lhs.rdLoc, tmp] @@ -2039,7 +2340,7 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = r.res = "$1.push.apply($3, $2);" % [a, rhs.rdLoc, tmp] r.kind = resExpr of mAppendSeqElem: - var x, y: TCompRes + var x, y: TCompRes = default(TCompRes) gen(p, n[1], x) gen(p, n[2], y) if mapType(n[2].typ) == etyBaseIndex: @@ -2067,7 +2368,7 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = if mapType(n[1].typ) != etyBaseIndex: unaryExpr(p, n, r, "", "($1 == null)") else: - var x: TCompRes + var x: TCompRes = default(TCompRes) gen(p, n[1], x) r.res = "($# == null && $# === 0)" % [x.address, x.res] of mEnumToStr: genRepr(p, n, r) @@ -2078,52 +2379,76 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = if n[1].kind == nkBracket: genJSArrayConstr(p, n[1], r) else: - var x: TCompRes + var x: TCompRes = default(TCompRes) gen(p, n[1], x) useMagic(p, "nimCopy") r.res = "nimCopy(null, $1, $2)" % [x.rdLoc, genTypeInfo(p, n.typ)] - of mDestroy: discard "ignore calls to the default destructor" + of mOpenArrayToSeq: + genCall(p, n, r) + of mDestroy, mTrace: discard "ignore calls to the default destructor" of mOrd: genOrd(p, n, r) of mLengthStr, mLengthSeq, mLengthOpenArray, mLengthArray: - var x: TCompRes + var x: TCompRes = default(TCompRes) gen(p, n[1], x) - if skipTypes(n[1].typ, abstractInst).kind == tyCString: + if skipTypes(n[1].typ, abstractInst).kind == tyCstring: let (a, tmp) = maybeMakeTemp(p, n[1], x) r.res = "(($1) == null ? 0 : ($2).length)" % [a, tmp] else: r.res = "($1).length" % [x.rdLoc] r.kind = resExpr of mHigh: - var x: TCompRes + var x: TCompRes = default(TCompRes) gen(p, n[1], x) - if skipTypes(n[1].typ, abstractInst).kind == tyCString: + if skipTypes(n[1].typ, abstractInst).kind == tyCstring: let (a, tmp) = maybeMakeTemp(p, n[1], x) r.res = "(($1) == null ? -1 : ($2).length - 1)" % [a, tmp] else: r.res = "($1).length - 1" % [x.rdLoc] r.kind = resExpr of mInc: - if n[1].typ.skipTypes(abstractRange).kind in {tyUInt..tyUInt64}: + let typ = n[1].typ.skipTypes(abstractVarRange) + case typ.kind + of tyUInt..tyUInt32: binaryUintExpr(p, n, r, "+", true) + of tyUInt64: + if optJsBigInt64 in p.config.globalOptions: + binaryExpr(p, n, r, "", "$1 = BigInt.asUintN(64, $3 + BigInt($2))", true) + else: binaryUintExpr(p, n, r, "+", true) + elif typ.kind == tyInt64 and optJsBigInt64 in p.config.globalOptions: + if optOverflowCheck notin p.options: + binaryExpr(p, n, r, "", "$1 = BigInt.asIntN(64, $3 + BigInt($2))", true) + else: binaryExpr(p, n, r, "addInt64", "$1 = addInt64($3, BigInt($2))", true) else: if optOverflowCheck notin p.options: binaryExpr(p, n, r, "", "$1 += $2") else: binaryExpr(p, n, r, "addInt", "$1 = addInt($3, $2)", true) of ast.mDec: - if n[1].typ.skipTypes(abstractRange).kind in {tyUInt..tyUInt64}: + let typ = n[1].typ.skipTypes(abstractVarRange) + case typ.kind + of tyUInt..tyUInt32: binaryUintExpr(p, n, r, "-", true) + of tyUInt64: + if optJsBigInt64 in p.config.globalOptions: + binaryExpr(p, n, r, "", "$1 = BigInt.asUintN(64, $3 - BigInt($2))", true) + else: binaryUintExpr(p, n, r, "-", true) + elif typ.kind == tyInt64 and optJsBigInt64 in p.config.globalOptions: + if optOverflowCheck notin p.options: + binaryExpr(p, n, r, "", "$1 = BigInt.asIntN(64, $3 - BigInt($2))", true) + else: binaryExpr(p, n, r, "subInt64", "$1 = subInt64($3, BigInt($2))", true) else: if optOverflowCheck notin p.options: binaryExpr(p, n, r, "", "$1 -= $2") else: binaryExpr(p, n, r, "subInt", "$1 = subInt($3, $2)", true) of mSetLengthStr: - binaryExpr(p, n, r, "mnewString", "($1.length = $2)") + binaryExpr(p, n, r, "mnewString", + """if ($1.length < $2) { for (var i = $3.length; i < $4; ++i) $3.push(0); } + else {$3.length = $4; }""") of mSetLengthSeq: - var x, y: TCompRes + var x, y: TCompRes = default(TCompRes) gen(p, n[1], x) gen(p, n[2], y) let t = skipTypes(n[1].typ, abstractVar)[0] let (a, tmp) = maybeMakeTemp(p, n[1], x) let (b, tmp2) = maybeMakeTemp(p, n[2], y) - r.res = """if ($1.length < $2) { for (var i=$4.length;i<$5;++i) $4.push($3); } + r.res = """if ($1.length < $2) { for (var i = $4.length ; i < $5 ; ++i) $4.push($3); } else { $4.length = $5; }""" % [a, b, createVar(p, t, false), tmp, tmp2] r.kind = resExpr of mCard: unaryExpr(p, n, r, "SetCard", "SetCard($1)") @@ -2140,8 +2465,8 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = of mNewSeq: genNewSeq(p, n) of mNewSeqOfCap: unaryExpr(p, n, r, "", "[]") of mOf: genOf(p, n, r) - of mDefault: genDefault(p, n, r) - of mReset, mWasMoved: genReset(p, n) + of mDefault, mZeroDefault: genDefault(p, n, r) + of mWasMoved: genWasMoved(p, n) of mEcho: genEcho(p, n, r) of mNLen..mNError, mSlurp, mStaticExec: localError(p.config, n.info, errXMustBeCompileTime % n[0].sym.name.s) @@ -2156,21 +2481,25 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = genCall(p, n, r) of mSlice: # arr.slice([begin[, end]]): 'end' is exclusive - var x, y, z: TCompRes + var x, y, z: TCompRes = default(TCompRes) gen(p, n[1], x) gen(p, n[2], y) gen(p, n[3], z) - r.res = "($1.slice($2, $3+1))" % [x.rdLoc, y.rdLoc, z.rdLoc] + r.res = "($1.slice($2, $3 + 1))" % [x.rdLoc, y.rdLoc, z.rdLoc] r.kind = resExpr of mMove: genMove(p, n, r) + of mDup: + genDup(p, n, r) + of mEnsureMove: + gen(p, n[1], r) else: genCall(p, n, r) #else internalError(p.config, e.info, 'genMagic: ' + magicToStr[op]); proc genSetConstr(p: PProc, n: PNode, r: var TCompRes) = var - a, b: TCompRes + a, b: TCompRes = default(TCompRes) useMagic(p, "setConstr") r.res = rope("setConstr(") r.kind = resExpr @@ -2202,12 +2531,12 @@ proc genArrayConstr(p: PProc, n: PNode, r: var TCompRes) = ## Nim sequence maps to JS array. var t = skipTypes(n.typ, abstractInst) let e = elemType(t) - let jsTyp = arrayTypeForElemType(e) + let jsTyp = arrayTypeForElemType(p.config, e) if skipTypes(n.typ, abstractVarRange).kind != tySequence and jsTyp.len > 0: # generate typed array # for example Nim generates `new Uint8Array([1, 2, 3])` for `[byte(1), 2, 3]` # TODO use `set` or loop to initialize typed array which improves performances in some situations - var a: TCompRes + var a: TCompRes = default(TCompRes) r.res = "new $1([" % [rope(jsTyp)] r.kind = resExpr for i in 0 ..< n.len: @@ -2219,7 +2548,7 @@ proc genArrayConstr(p: PProc, n: PNode, r: var TCompRes) = genJSArrayConstr(p, n, r) proc genTupleConstr(p: PProc, n: PNode, r: var TCompRes) = - var a: TCompRes + var a: TCompRes = default(TCompRes) r.res = rope("{") r.kind = resExpr for i in 0..<n.len: @@ -2238,10 +2567,11 @@ proc genTupleConstr(p: PProc, n: PNode, r: var TCompRes) = r.res.add("}") proc genObjConstr(p: PProc, n: PNode, r: var TCompRes) = - var a: TCompRes + var a: TCompRes = default(TCompRes) r.kind = resExpr - var initList : Rope + var initList : Rope = "" var fieldIDs = initIntSet() + let nTyp = n.typ.skipTypes(abstractInst) for i in 1..<n.len: if i > 1: initList.add(", ") var it = n[i] @@ -2249,17 +2579,17 @@ proc genObjConstr(p: PProc, n: PNode, r: var TCompRes) = let val = it[1] gen(p, val, a) var f = it[0].sym - if f.loc.r == nil: f.loc.r = mangleName(p.module, f) - fieldIDs.incl(f.id) + if f.loc.snippet == "": f.loc.snippet = mangleName(p.module, f) + fieldIDs.incl(lookupFieldAgain(n.typ.skipTypes({tyDistinct}), f).id) let typ = val.typ.skipTypes(abstractInst) if a.typ == etyBaseIndex: - initList.addf("$#: [$#, $#]", [f.loc.r, a.address, a.res]) + initList.addf("$#: [$#, $#]", [f.loc.snippet, a.address, a.res]) else: if not needsNoCopy(p, val): useMagic(p, "nimCopy") a.res = "nimCopy(null, $1, $2)" % [a.rdLoc, genTypeInfo(p, typ)] - initList.addf("$#: $#", [f.loc.r, a.res]) + initList.addf("$#: $#", [f.loc.snippet, a.res]) let t = skipTypes(n.typ, abstractInst + skipPtrs) createObjInitList(p, t, fieldIDs, initList) r.res = ("{$1}") % [initList] @@ -2282,7 +2612,29 @@ proc genConv(p: PProc, n: PNode, r: var TCompRes) = r.res = "(!!($1))" % [r.res] r.kind = resExpr elif toInt: - r.res = "(($1)|0)" % [r.res] + if src.kind in {tyInt64, tyUInt64} and optJsBigInt64 in p.config.globalOptions: + r.res = "Number($1)" % [r.res] + else: + r.res = "(($1) | 0)" % [r.res] + elif dest.kind == tyInt64 and optJsBigInt64 in p.config.globalOptions: + if fromInt or fromUint or src.kind in {tyBool, tyChar, tyEnum}: + r.res = "BigInt($1)" % [r.res] + elif src.kind in {tyFloat..tyFloat64}: + r.res = "BigInt(Math.trunc($1))" % [r.res] + elif src.kind == tyUInt64: + r.res = "BigInt.asIntN(64, $1)" % [r.res] + elif dest.kind == tyUInt64 and optJsBigInt64 in p.config.globalOptions: + if fromUint or src.kind in {tyBool, tyChar, tyEnum}: + r.res = "BigInt($1)" % [r.res] + elif fromInt: # could be negative + r.res = "BigInt.asUintN(64, BigInt($1))" % [r.res] + elif src.kind in {tyFloat..tyFloat64}: + r.res = "BigInt.asUintN(64, BigInt(Math.trunc($1)))" % [r.res] + elif src.kind == tyInt64: + r.res = "BigInt.asUintN(64, $1)" % [r.res] + elif toUint or dest.kind in tyFloat..tyFloat64: + if src.kind in {tyInt64, tyUInt64} and optJsBigInt64 in p.config.globalOptions: + r.res = "Number($1)" % [r.res] else: # TODO: What types must we handle here? discard @@ -2291,12 +2643,29 @@ proc upConv(p: PProc, n: PNode, r: var TCompRes) = gen(p, n[0], r) # XXX proc genRangeChck(p: PProc, n: PNode, r: var TCompRes, magic: string) = - var a, b: TCompRes + var a, b: TCompRes = default(TCompRes) gen(p, n[0], r) - if optRangeCheck notin p.options or (skipTypes(n.typ, abstractVar).kind in {tyUInt..tyUInt64} and - checkUnsignedConversions notin p.config.legacyFeatures): - discard "XXX maybe emit masking instructions here" + let src = skipTypes(n[0].typ, abstractVarRange) + let dest = skipTypes(n.typ, abstractVarRange) + if optRangeCheck notin p.options: + if optJsBigInt64 in p.config.globalOptions and + dest.kind in {tyUInt..tyUInt32, tyInt..tyInt32} and + src.kind in {tyInt64, tyUInt64}: + # conversions to Number are kept + r.res = "Number($1)" % [r.res] + else: + discard + elif dest.kind in {tyUInt..tyUInt64} and checkUnsignedConversions notin p.config.legacyFeatures: + if src.kind in {tyInt64, tyUInt64} and optJsBigInt64 in p.config.globalOptions: + r.res = "BigInt.asUintN($1, $2)" % [$(dest.size * 8), r.res] + else: + r.res = "BigInt.asUintN($1, BigInt($2))" % [$(dest.size * 8), r.res] + if not (dest.kind == tyUInt64 and optJsBigInt64 in p.config.globalOptions): + r.res = "Number($1)" % [r.res] else: + if src.kind in {tyInt64, tyUInt64} and dest.kind notin {tyInt64, tyUInt64} and optJsBigInt64 in p.config.globalOptions: + # we do a range check anyway, so it's ok if the number gets rounded + r.res = "Number($1)" % [r.res] gen(p, n[1], a) gen(p, n[2], b) useMagic(p, "chckRange") @@ -2310,7 +2679,7 @@ proc convStrToCStr(p: PProc, n: PNode, r: var TCompRes) = gen(p, n[0][0], r) else: gen(p, n[0], r) - if r.res == nil: internalError(p.config, n.info, "convStrToCStr") + if r.res == "": internalError(p.config, n.info, "convStrToCStr") useMagic(p, "toJSStr") r.res = "toJSStr($1)" % [r.res] r.kind = resExpr @@ -2322,7 +2691,7 @@ proc convCStrToStr(p: PProc, n: PNode, r: var TCompRes) = gen(p, n[0][0], r) else: gen(p, n[0], r) - if r.res == nil: internalError(p.config, n.info, "convCStrToStr") + if r.res == "": internalError(p.config, n.info, "convCStrToStr") useMagic(p, "cstrToNimstr") r.res = "cstrToNimstr($1)" % [r.res] r.kind = resExpr @@ -2338,7 +2707,7 @@ proc genReturnStmt(p: PProc, n: PNode) = proc frameCreate(p: PProc; procname, filename: Rope): Rope = const frameFmt = - "var F={procname:$1,prev:framePtr,filename:$2,line:0};$n" + "var F = {procname: $1, prev: framePtr, filename: $2, line: 0};$n" result = p.indentLine(frameFmt % [procname, filename]) result.add p.indentLine(ropes.`%`("framePtr = F;$n", [])) @@ -2352,11 +2721,11 @@ proc genProcBody(p: PProc, prc: PSym): Rope = makeJSString(prc.owner.name.s & '.' & prc.name.s), makeJSString(toFilenameOption(p.config, prc.info.fileIndex, foStacktrace))) else: - result = nil + result = "" if p.beforeRetNeeded: - result.add p.indentLine(~"BeforeRet: do {$n") + result.add p.indentLine("BeforeRet: {\n") result.add p.body - result.add p.indentLine(~"} while (false);$n") + result.add p.indentLine("};\n") else: result.add(p.body) if prc.typ.callConv == ccSysCall: @@ -2366,29 +2735,33 @@ proc genProcBody(p: PProc, prc: PSym): Rope = result.add(frameDestroy(p)) proc optionalLine(p: Rope): Rope = - if p == nil: - return nil + if p == "": + return "" else: return p & "\L" proc genProc(oldProc: PProc, prc: PSym): Rope = + ## Generate a JS procedure ('function'). + result = "" var resultSym: PSym - a: TCompRes + a: TCompRes = default(TCompRes) #if gVerbosity >= 3: # echo "BEGIN generating code for: " & prc.name.s var p = newProc(oldProc.g, oldProc.module, prc.ast, prc.options) p.up = oldProc - var returnStmt: Rope = nil - var resultAsgn: Rope = nil + var returnStmt: Rope = "" + var resultAsgn: Rope = "" var name = mangleName(p.module, prc) - let header = generateHeader(p, prc.typ) - if prc.typ[0] != nil and sfPure notin prc.flags: + let header = generateHeader(p, prc) + if prc.typ.returnType != nil and sfPure notin prc.flags: resultSym = prc.ast[resultPos].sym let mname = mangleName(p.module, resultSym) - if not isIndirect(resultSym) and + # otherwise uses "fat pointers" + let useRawPointer = not isIndirect(resultSym) and resultSym.typ.kind in {tyVar, tyPtr, tyLent, tyRef, tyOwned} and - mapType(p, resultSym.typ) == etyBaseIndex: + mapType(p, resultSym.typ) == etyBaseIndex + if useRawPointer: resultAsgn = p.indentLine(("var $# = null;$n") % [mname]) resultAsgn.add p.indentLine("var $#_Idx = 0;$n" % [mname]) else: @@ -2400,7 +2773,7 @@ proc genProc(oldProc: PProc, prc: PSym): Rope = else: returnStmt = "return $#;$n" % [a.res] - var transformedBody = transformBody(p.module.graph, p.module.idgen, prc, cache = false) + var transformedBody = transformBody(p.module.graph, p.module.idgen, prc, {}) if sfInjectDestructors in prc.flags: transformedBody = injectDestructorCalls(p.module.graph, p.module.idgen, prc, transformedBody) @@ -2423,7 +2796,7 @@ proc genProc(oldProc: PProc, prc: PSym): Rope = optionalLine(p.indentLine(returnStmt))]) else: # if optLineDir in p.config.options: - # result.add(~"\L") + # result.add("\L") if p.config.hcrOn: # Here, we introduce thunks that create the equivalent of a jump table @@ -2432,10 +2805,10 @@ proc genProc(oldProc: PProc, prc: PSym): Rope = # references will end up calling the reloaded code. var thunkName = name name = name & "IMLP" - result.add("function $#() { return $#.apply(this, arguments); }$n" % + result.add("\Lfunction $#() { return $#.apply(this, arguments); }$n" % [thunkName, name]) - def = "function $#($#) {$n$#$#$#$#$#" % + def = "\Lfunction $#($#) {$n$#$#$#$#$#" % [ name, header, optionalLine(p.globals), @@ -2446,20 +2819,25 @@ proc genProc(oldProc: PProc, prc: PSym): Rope = dec p.extraIndent result.add p.indentLine(def) - result.add p.indentLine(~"}$n") + result.add p.indentLine("}\n") #if gVerbosity >= 3: # echo "END generated code for: " & prc.name.s proc genStmt(p: PProc, n: PNode) = - var r: TCompRes + var r: TCompRes = default(TCompRes) gen(p, n, r) - if r.res != nil: lineF(p, "$#;$n", [r.res]) + if r.res != "": lineF(p, "$#;$n", [r.res]) proc genPragma(p: PProc, n: PNode) = - for it in n.sons: + for i in 0..<n.len: + let it = n[i] case whichPragma(it) of wEmit: genAsmOrEmitStmt(p, it[1]) + of wPush: + processPushBackendOption(p.config, p.optionsStack, p.options, n, i+1) + of wPop: + processPopBackendOption(p.config, p.optionsStack, p.options) else: discard proc genCast(p: PProc, n: PNode, r: var TCompRes) = @@ -2474,27 +2852,38 @@ proc genCast(p: PProc, n: PNode, r: var TCompRes) = let fromInt = (src.kind in tyInt..tyInt32) let fromUint = (src.kind in tyUInt..tyUInt32) - if toUint and (fromInt or fromUint): - let trimmer = unsignedTrimmer(dest.size) - r.res = "($1 $2)" % [r.res, trimmer] + if toUint: + if fromInt or fromUint: + r.res = "Number(BigInt.asUintN($1, BigInt($2)))" % [$(dest.size * 8), r.res] + elif src.kind in {tyInt64, tyUInt64} and optJsBigInt64 in p.config.globalOptions: + r.res = "Number(BigInt.asUintN($1, $2))" % [$(dest.size * 8), r.res] elif toInt: - if fromInt: - return - elif fromUint: - if src.size == 4 and dest.size == 4: - # XXX prevent multi evaluations - r.res = "($1|0)" % [r.res] - else: - let trimmer = unsignedTrimmer(dest.size) - let minuend = case dest.size - of 1: "0xfe" - of 2: "0xfffe" - of 4: "0xfffffffe" - else: "" - r.res = "($1 - ($2 $3))" % [rope minuend, r.res, trimmer] + if fromInt or fromUint: + r.res = "Number(BigInt.asIntN($1, BigInt($2)))" % [$(dest.size * 8), r.res] + elif src.kind in {tyInt64, tyUInt64} and optJsBigInt64 in p.config.globalOptions: + r.res = "Number(BigInt.asIntN($1, $2))" % [$(dest.size * 8), r.res] + elif dest.kind == tyInt64 and optJsBigInt64 in p.config.globalOptions: + if fromInt or fromUint or src.kind in {tyBool, tyChar, tyEnum}: + r.res = "BigInt($1)" % [r.res] + elif src.kind in {tyFloat..tyFloat64}: + r.res = "BigInt(Math.trunc($1))" % [r.res] + elif src.kind == tyUInt64: + r.res = "BigInt.asIntN(64, $1)" % [r.res] + elif dest.kind == tyUInt64 and optJsBigInt64 in p.config.globalOptions: + if fromUint or src.kind in {tyBool, tyChar, tyEnum}: + r.res = "BigInt($1)" % [r.res] + elif fromInt: # could be negative + r.res = "BigInt.asUintN(64, BigInt($1))" % [r.res] + elif src.kind in {tyFloat..tyFloat64}: + r.res = "BigInt.asUintN(64, BigInt(Math.trunc($1)))" % [r.res] + elif src.kind == tyInt64: + r.res = "BigInt.asUintN(64, $1)" % [r.res] + elif dest.kind in tyFloat..tyFloat64: + if src.kind in {tyInt64, tyUInt64} and optJsBigInt64 in p.config.globalOptions: + r.res = "Number($1)" % [r.res] elif (src.kind == tyPtr and mapType(p, src) == etyObject) and dest.kind == tyPointer: r.address = r.res - r.res = ~"null" + r.res = "null" r.typ = etyBaseIndex elif (dest.kind == tyPtr and mapType(p, dest) == etyObject) and src.kind == tyPointer: r.res = r.address @@ -2503,17 +2892,32 @@ proc genCast(p: PProc, n: PNode, r: var TCompRes) = proc gen(p: PProc, n: PNode, r: var TCompRes) = r.typ = etyNone if r.kind != resCallee: r.kind = resNone - #r.address = nil - r.res = nil + #r.address = "" + r.res = "" case n.kind of nkSym: genSym(p, n, r) of nkCharLit..nkUInt64Lit: - if n.typ.kind == tyBool: + case n.typ.skipTypes(abstractVarRange).kind + of tyBool: r.res = if n.intVal == 0: rope"false" else: rope"true" + of tyUInt64: + r.res = rope($cast[BiggestUInt](n.intVal)) + if optJsBigInt64 in p.config.globalOptions: + r.res.add('n') + of tyInt64: + let wrap = n.intVal < 0 # wrap negative integers with parens + if wrap: r.res.add '(' + r.res.addInt n.intVal + if optJsBigInt64 in p.config.globalOptions: + r.res.add('n') + if wrap: r.res.add ')' else: - r.res = rope(n.intVal) + let wrap = n.intVal < 0 # wrap negative integers with parens + if wrap: r.res.add '(' + r.res.addInt n.intVal + if wrap: r.res.add ')' r.kind = resExpr of nkNilLit: if isEmptyType(n.typ): @@ -2528,11 +2932,11 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = r.kind = resExpr of nkStrLit..nkTripleStrLit: if skipTypes(n.typ, abstractVarRange).kind == tyString: - if n.strVal.len != 0: + if n.strVal.len <= 64: + r.res = makeJsNimStrLit(n.strVal) + else: useMagic(p, "makeNimstrLit") r.res = "makeNimstrLit($1)" % [makeJSString(n.strVal)] - else: - r.res = rope"[]" else: r.res = makeJSString(n.strVal, false) r.kind = resExpr @@ -2552,7 +2956,11 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = r.res = rope"Infinity" of fcNegInf: r.res = rope"-Infinity" - else: r.res = rope(f.toStrMaxPrecision) + else: + if n.typ.skipTypes(abstractVarRange).kind == tyFloat32: + r.res.addFloatRoundtrip(f.float32) + else: + r.res.addFloatRoundtrip(f) r.kind = resExpr of nkCallKinds: if isEmptyType(n.typ): @@ -2564,15 +2972,33 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = genInfixCall(p, n, r) else: genCall(p, n, r) - of nkClosure: gen(p, n[0], r) + of nkClosure: + if jsNoLambdaLifting in p.config.legacyFeatures: + gen(p, n[0], r) + else: + let tmp = getTemp(p) + var a: TCompRes = default(TCompRes) + var b: TCompRes = default(TCompRes) + gen(p, n[0], a) + gen(p, n[1], b) + lineF(p, "$1 = $2.bind($3); $1.ClP_0 = $2; $1.ClE_0 = $3;$n", [tmp, a.rdLoc, b.rdLoc]) + r.res = tmp + r.kind = resVal of nkCurly: genSetConstr(p, n, r) of nkBracket: genArrayConstr(p, n, r) of nkPar, nkTupleConstr: genTupleConstr(p, n, r) of nkObjConstr: genObjConstr(p, n, r) of nkHiddenStdConv, nkHiddenSubConv, nkConv: genConv(p, n, r) of nkAddr, nkHiddenAddr: - genAddr(p, n, r) - of nkDerefExpr, nkHiddenDeref: genDeref(p, n, r) + if n.typ.kind in {tyLent}: + gen(p, n[0], r) + else: + genAddr(p, n, r) + of nkDerefExpr, nkHiddenDeref: + if n.typ.kind in {tyLent}: + gen(p, n[0], r) + else: + genDeref(p, n, r) of nkBracketExpr: genArrayAccess(p, n, r) of nkDotExpr: genFieldAccess(p, n, r) of nkCheckedFieldExpr: genCheckedFieldOp(p, n, nil, r) @@ -2588,8 +3014,8 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = of nkLambdaKinds: let s = n[namePos].sym discard mangleName(p.module, s) - r.res = s.loc.r - if lfNoDecl in s.loc.flags or s.magic notin {mNone, mIsolate}: discard + r.res = s.loc.snippet + if lfNoDecl in s.loc.flags or s.magic notin generatedMagics: discard elif not p.g.generatedSyms.containsOrIncl(s.id): p.locals.add(genProc(p, s)) of nkType: r.res = genTypeInfo(p, n.typ) @@ -2615,47 +3041,48 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = of nkReturnStmt: genReturnStmt(p, n) of nkBreakStmt: genBreakStmt(p, n) of nkAsgn: genAsgn(p, n) - of nkFastAsgn: genFastAsgn(p, n) + of nkFastAsgn, nkSinkAsgn: genFastAsgn(p, n) of nkDiscardStmt: if n[0].kind != nkEmpty: genLineDir(p, n) gen(p, n[0], r) - r.res = "var _ = " & r.res - of nkAsmStmt: genAsmOrEmitStmt(p, n) + r.res = "(" & r.res & ")" + of nkAsmStmt: + warningDeprecated(p.config, n.info, "'asm' for the JS target is deprecated, use the 'emit' pragma") + genAsmOrEmitStmt(p, n, true) of nkTryStmt, nkHiddenTryStmt: genTry(p, n, r) of nkRaiseStmt: genRaiseStmt(p, n) of nkTypeSection, nkCommentStmt, nkIncludeStmt, nkImportStmt, nkImportExceptStmt, nkExportStmt, nkExportExceptStmt, - nkFromStmt, nkTemplateDef, nkMacroDef, nkStaticStmt, + nkFromStmt, nkTemplateDef, nkMacroDef, nkIteratorDef, nkStaticStmt, nkMixinStmt, nkBindStmt: discard - of nkIteratorDef: - if n[0].sym.typ.callConv == TCallingConvention.ccClosure: - globalError(p.config, n.info, "Closure iterators are not supported by JS backend!") of nkPragma: genPragma(p, n) of nkProcDef, nkFuncDef, nkMethodDef, nkConverterDef: var s = n[namePos].sym if {sfExportc, sfCompilerProc} * s.flags == {sfExportc}: genSym(p, n[namePos], r) - r.res = nil + r.res = "" of nkGotoState, nkState: - globalError(p.config, n.info, "First class iterators not implemented") + globalError(p.config, n.info, "not implemented") + of nkBreakState: + genBreakState(p, n[0], r) of nkPragmaBlock: gen(p, n.lastSon, r) of nkComesFrom: discard "XXX to implement for better stack traces" else: internalError(p.config, n.info, "gen: unknown node type: " & $n.kind) proc newModule(g: ModuleGraph; module: PSym): BModule = - new(result) - result.module = module - result.sigConflicts = initCountTable[SigHash]() + ## Create a new JS backend module node. if g.backend == nil: g.backend = newGlobals() - result.graph = g - result.config = g.config + result = BModule(module: module, sigConflicts: initCountTable[SigHash](), + graph: g, config: g.config + ) if sfSystemModule in module.flags: PGlobals(g.backend).inSystem = true proc genHeader(): Rope = + ## Generate the JS header. result = rope("""/* Generated by the Nim Compiler v$1 */ var framePtr = null; var excHandler = 0; @@ -2686,6 +3113,8 @@ proc addHcrInitGuards(p: PProc, n: PNode, genStmt(p, n) proc genModule(p: PProc, n: PNode) = + ## Generate the JS module code. + ## Called for each top level node in a Nim module. if optStackTrace in p.options: p.body.add(frameCreate(p, makeJSString("module " & p.module.module.name.s), @@ -2696,7 +3125,7 @@ proc genModule(p: PProc, n: PNode) = if p.config.hcrOn and n.kind == nkStmtList: let moduleSym = p.module.module var moduleLoadedVar = rope(moduleSym.name.s) & "_loaded" & - idOrSig(moduleSym, moduleSym.name.s, p.module.sigConflicts) + idOrSig(moduleSym, moduleSym.name.s, p.module.sigConflicts, p.config) lineF(p, "var $1;$n", [moduleLoadedVar]) var inGuardedBlock = false @@ -2713,65 +3142,71 @@ proc genModule(p: PProc, n: PNode) = if optStackTrace in p.options: p.body.add(frameDestroy(p)) -proc myProcess(b: PPassContext, n: PNode): PNode = +proc processJSCodeGen*(b: PPassContext, n: PNode): PNode = + ## Generate JS code for a node. result = n let m = BModule(b) - if passes.skipCodegen(m.config, n): return n + if pipelineutils.skipCodegen(m.config, n): return n if m.module == nil: internalError(m.config, n.info, "myProcess") let globals = PGlobals(m.graph.backend) var p = newInitProc(globals, m) + m.initProc = p p.unique = globals.unique genModule(p, n) p.g.code.add(p.locals) p.g.code.add(p.body) proc wholeCode(graph: ModuleGraph; m: BModule): Rope = + ## Combine source code from all nodes. let globals = PGlobals(graph.backend) for prc in globals.forwarded: if not globals.generatedSyms.containsOrIncl(prc.id): var p = newInitProc(globals, m) attachProc(p, prc) - var disp = generateMethodDispatchers(graph) - for i in 0..<disp.len: - let prc = disp[i].sym + generateIfMethodDispatchers(graph, m.idgen) + for prc in getDispatchers(graph): if not globals.generatedSyms.containsOrIncl(prc.id): var p = newInitProc(globals, m) attachProc(p, prc) result = globals.typeInfo & globals.constants & globals.code -proc getClassName(t: PType): Rope = - var s = t.sym - if s.isNil or sfAnon in s.flags: - s = skipTypes(t, abstractPtrs).sym - if s.isNil or sfAnon in s.flags: - doAssert(false, "cannot retrieve class name") - if s.loc.r != nil: result = s.loc.r - else: result = rope(s.name.s) - -proc myClose(graph: ModuleGraph; b: PPassContext, n: PNode): PNode = - result = myProcess(b, n) +proc finalJSCodeGen*(graph: ModuleGraph; b: PPassContext, n: PNode): PNode = + ## Finalize JS code generation of a Nim module. + ## Param `n` may contain nodes returned from the last module close call. var m = BModule(b) if sfMainModule in m.module.flags: - for destructorCall in graph.globalDestructors: - n.add destructorCall + # Add global destructors to the module. + # This must come before the last call to `myProcess`. + for i in countdown(high(graph.globalDestructors), 0): + n.add graph.globalDestructors[i] + # Process any nodes left over from the last call to `myClose`. + result = processJSCodeGen(b, n) + # Some codegen is different (such as no stacktraces; see `initProcOptions`) + # when `std/system` is being processed. if sfSystemModule in m.module.flags: PGlobals(graph.backend).inSystem = false - if passes.skipCodegen(m.config, n): return n + # Check if codegen should continue before any files are generated. + # It may bail early is if too many errors have been raised. + if pipelineutils.skipCodegen(m.config, n): return n + # Nim modules are compiled into a single JS file. + # If this is the main module, then this is the final call to `myClose`. if sfMainModule in m.module.flags: var code = genHeader() & wholeCode(graph, m) let outFile = m.config.prepareToWriteOutput() - + # Generate an optional source map. if optSourcemap in m.config.globalOptions: var map: SourceMap - (code, map) = genSourceMap($(code), outFile.string) + map = genSourceMap($code, outFile.string) + code &= "\n//# sourceMappingURL=$#.map" % [outFile.string] writeFile(outFile.string & ".map", $(%map)) - discard writeRopeIfNotEqual(code, outFile) + # Check if the generated JS code matches the output file, or else + # write it to the file. + if not equalsFile(code, outFile): + if not writeRope(code, outFile): + rawMessage(m.config, errCannotOpenFile, outFile.string) - -proc myOpen(graph: ModuleGraph; s: PSym; idgen: IdGenerator): PPassContext = +proc setupJSgen*(graph: ModuleGraph; s: PSym; idgen: IdGenerator): PPassContext = result = newModule(graph, s) result.idgen = idgen - -const JSgenPass* = makePass(myOpen, myProcess, myClose) diff --git a/compiler/jstypes.nim b/compiler/jstypes.nim index 2073c252e..d980f9989 100644 --- a/compiler/jstypes.nim +++ b/compiler/jstypes.nim @@ -19,13 +19,13 @@ proc genObjectFields(p: PProc, typ: PType, n: PNode): Rope = s, u: Rope field: PSym b: PNode - result = nil + result = "" case n.kind of nkRecList: if n.len == 1: result = genObjectFields(p, typ, n[0]) else: - s = nil + s = "" for i in 0..<n.len: if i > 0: s.add(", \L") s.add(genObjectFields(p, typ, n[i])) @@ -44,13 +44,13 @@ proc genObjectFields(p: PProc, typ: PType, n: PNode): Rope = s = genTypeInfo(p, field.typ) for i in 1..<n.len: b = n[i] # branch - u = nil + u = "" case b.kind of nkOfBranch: if b.len < 2: internalError(p.config, b.info, "genObjectFields; nkOfBranch broken") for j in 0..<b.len - 1: - if u != nil: u.add(", ") + if u != "": u.add(", ") if b[j].kind == nkRange: u.addf("[$1, $2]", [rope(getOrdValue(b[j][0])), rope(getOrdValue(b[j][1]))]) @@ -59,7 +59,7 @@ proc genObjectFields(p: PProc, typ: PType, n: PNode): Rope = of nkElse: u = rope(lengthOrd(p.config, field.typ)) else: internalError(p.config, n.info, "genObjectFields(nkRecCase)") - if result != nil: result.add(", \L") + if result != "": result.add(", \L") result.addf("[setConstr($1), $2]", [u, genObjectFields(p, typ, lastSon(b))]) result = ("{kind: 3, offset: \"$1\", len: $3, " & @@ -69,7 +69,7 @@ proc genObjectFields(p: PProc, typ: PType, n: PNode): Rope = else: internalError(p.config, n.info, "genObjectFields") proc objHasTypeField(t: PType): bool {.inline.} = - tfInheritable in t.flags or t[0] != nil + tfInheritable in t.flags or t.baseClass != nil proc genObjectInfo(p: PProc, typ: PType, name: Rope) = let kind = if objHasTypeField(typ): tyObject else: tyTuple @@ -79,12 +79,12 @@ proc genObjectInfo(p: PProc, typ: PType, name: Rope) = p.g.typeInfo.addf("var NNI$1 = $2;$n", [rope(typ.id), genObjectFields(p, typ, typ.n)]) p.g.typeInfo.addf("$1.node = NNI$2;$n", [name, rope(typ.id)]) - if (typ.kind == tyObject) and (typ[0] != nil): + if (typ.kind == tyObject) and (typ.baseClass != nil): p.g.typeInfo.addf("$1.base = $2;$n", - [name, genTypeInfo(p, typ[0].skipTypes(skipPtrs))]) + [name, genTypeInfo(p, typ.baseClass.skipTypes(skipPtrs))]) proc genTupleFields(p: PProc, typ: PType): Rope = - var s: Rope = nil + var s: Rope = "" for i in 0..<typ.len: if i > 0: s.add(", \L") s.addf("{kind: 1, offset: \"Field$1\", len: 0, " & @@ -102,7 +102,7 @@ proc genTupleInfo(p: PProc, typ: PType, name: Rope) = p.g.typeInfo.addf("$1.node = NNI$2;$n", [name, rope(typ.id)]) proc genEnumInfo(p: PProc, typ: PType, name: Rope) = - var s: Rope = nil + var s: Rope = "" for i in 0..<typ.n.len: if (typ.n[i].kind != nkSym): internalError(p.config, typ.n.info, "genEnumInfo") let field = typ.n[i].sym @@ -117,9 +117,9 @@ proc genEnumInfo(p: PProc, typ: PType, name: Rope) = prepend(p.g.typeInfo, s) p.g.typeInfo.add(n) p.g.typeInfo.addf("$1.node = NNI$2;$n", [name, rope(typ.id)]) - if typ[0] != nil: + if typ.baseClass != nil: p.g.typeInfo.addf("$1.base = $2;$n", - [name, genTypeInfo(p, typ[0])]) + [name, genTypeInfo(p, typ.baseClass)]) proc genTypeInfo(p: PProc, typ: PType): Rope = let t = typ.skipTypes({tyGenericInst, tyDistinct, tyAlias, tySink, tyOwned}) @@ -127,30 +127,30 @@ proc genTypeInfo(p: PProc, typ: PType): Rope = if containsOrIncl(p.g.typeInfoGenerated, t.id): return case t.kind of tyDistinct: - result = genTypeInfo(p, t[0]) - of tyPointer, tyProc, tyBool, tyChar, tyCString, tyString, tyInt..tyUInt64: + result = genTypeInfo(p, t.skipModifier) + of tyPointer, tyProc, tyBool, tyChar, tyCstring, tyString, tyInt..tyUInt64: var s = "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n" % [result, rope(ord(t.kind))] prepend(p.g.typeInfo, s) - of tyVar, tyLent, tyRef, tyPtr, tySequence, tyRange, tySet: + of tyVar, tyLent, tyRef, tyPtr, tySequence, tyRange, tySet, tyOpenArray: var s = - "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n" % + "var $1 = {size: 0, kind: $2, base: null, node: null, finalizer: null};$n" % [result, rope(ord(t.kind))] prepend(p.g.typeInfo, s) p.g.typeInfo.addf("$1.base = $2;$n", - [result, genTypeInfo(p, t.lastSon)]) + [result, genTypeInfo(p, t.elementType)]) of tyArray: var s = - "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n" % + "var $1 = {size: 0, kind: $2, base: null, node: null, finalizer: null};$n" % [result, rope(ord(t.kind))] prepend(p.g.typeInfo, s) p.g.typeInfo.addf("$1.base = $2;$n", - [result, genTypeInfo(p, t[1])]) + [result, genTypeInfo(p, t.elementType)]) of tyEnum: genEnumInfo(p, t, result) of tyObject: genObjectInfo(p, t, result) of tyTuple: genTupleInfo(p, t, result) of tyStatic: - if t.n != nil: result = genTypeInfo(p, lastSon t) + if t.n != nil: result = genTypeInfo(p, skipModifier t) else: internalError(p.config, "genTypeInfo(" & $t.kind & ')') else: internalError(p.config, "genTypeInfo(" & $t.kind & ')') diff --git a/compiler/lambdalifting.nim b/compiler/lambdalifting.nim index 6f43649a1..54cdfc5bc 100644 --- a/compiler/lambdalifting.nim +++ b/compiler/lambdalifting.nim @@ -10,9 +10,14 @@ # This file implements lambda lifting for the transformator. import - intsets, strutils, options, ast, astalgo, msgs, - idents, renderer, types, magicsys, lowerings, tables, modulegraphs, lineinfos, - transf, liftdestructors + options, ast, astalgo, msgs, + idents, renderer, types, magicsys, lowerings, modulegraphs, lineinfos, + transf, liftdestructors, typeallowed + +import std/[strutils, tables, intsets] + +when defined(nimPreviewSlimSystem): + import std/assertions discard """ The basic approach is that captured vars need to be put on the heap and @@ -130,29 +135,31 @@ proc createClosureIterStateType*(g: ModuleGraph; iter: PSym; idgen: IdGenerator) var n = newNodeI(nkRange, iter.info) n.add newIntNode(nkIntLit, -1) n.add newIntNode(nkIntLit, 0) - result = newType(tyRange, nextTypeId(idgen), iter) + result = newType(tyRange, idgen, iter) result.n = n var intType = nilOrSysInt(g) - if intType.isNil: intType = newType(tyInt, nextTypeId(idgen), iter) + if intType.isNil: intType = newType(tyInt, idgen, iter) rawAddSon(result, intType) proc createStateField(g: ModuleGraph; iter: PSym; idgen: IdGenerator): PSym = - result = newSym(skField, getIdent(g.cache, ":state"), nextSymId(idgen), iter, iter.info) + result = newSym(skField, getIdent(g.cache, ":state"), idgen, iter, iter.info) result.typ = createClosureIterStateType(g, iter, idgen) +template isIterator*(owner: PSym): bool = + owner.kind == skIterator and owner.typ.callConv == ccClosure + proc createEnvObj(g: ModuleGraph; idgen: IdGenerator; owner: PSym; info: TLineInfo): PType = - # YYY meh, just add the state field for every closure for now, it's too - # hard to figure out if it comes from a closure iterator: result = createObj(g, idgen, owner, info, final=false) - rawAddField(result, createStateField(g, owner, idgen)) + if owner.isIterator or not isDefined(g.config, "nimOptIters"): + rawAddField(result, createStateField(g, owner, idgen)) proc getClosureIterResult*(g: ModuleGraph; iter: PSym; idgen: IdGenerator): PSym = if resultPos < iter.ast.len: result = iter.ast[resultPos].sym else: # XXX a bit hacky: - result = newSym(skResult, getIdent(g.cache, ":result"), nextSymId(idgen), iter, iter.info, {}) - result.typ = iter.typ[0] + result = newSym(skResult, getIdent(g.cache, ":result"), idgen, iter, iter.info, {}) + result.typ = iter.typ.returnType incl(result.flags, sfUsed) iter.ast.add newSymNode(result) @@ -167,37 +174,35 @@ proc addHiddenParam(routine: PSym, param: PSym) = assert sfFromGeneric in param.flags #echo "produced environment: ", param.id, " for ", routine.id -proc getHiddenParam(g: ModuleGraph; routine: PSym): PSym = +proc getEnvParam*(routine: PSym): PSym = let params = routine.ast[paramsPos] let hidden = lastSon(params) if hidden.kind == nkSym and hidden.sym.kind == skParam and hidden.sym.name.s == paramName: result = hidden.sym assert sfFromGeneric in result.flags else: + result = nil + +proc getHiddenParam(g: ModuleGraph; routine: PSym): PSym = + result = getEnvParam(routine) + if result.isNil: # writeStackTrace() localError(g.config, routine.info, "internal error: could not find env param for " & routine.name.s) result = routine -proc getEnvParam*(routine: PSym): PSym = - let params = routine.ast[paramsPos] - let hidden = lastSon(params) - if hidden.kind == nkSym and hidden.sym.name.s == paramName: - result = hidden.sym - assert sfFromGeneric in result.flags - proc interestingVar(s: PSym): bool {.inline.} = result = s.kind in {skVar, skLet, skTemp, skForVar, skParam, skResult} and sfGlobal notin s.flags and s.typ.kind notin {tyStatic, tyTypeDesc} proc illegalCapture(s: PSym): bool {.inline.} = - result = skipTypes(s.typ, abstractInst).kind in - {tyVar, tyOpenArray, tyVarargs, tyLent} or - s.kind == skResult + result = classifyViewType(s.typ) != noView or s.kind == skResult proc isInnerProc(s: PSym): bool = if s.kind in {skProc, skFunc, skMethod, skConverter, skIterator} and s.magic == mNone: result = s.skipGenericOwner.kind in routineKinds + else: + result = false proc newAsgnStmt(le, ri: PNode, info: TLineInfo): PNode = # Bugfix: unfortunately we cannot use 'nkFastAsgn' here as that would @@ -224,34 +229,38 @@ proc makeClosure*(g: ModuleGraph; idgen: IdGenerator; prc: PSym; env: PNode; inf prc.flags.incl sfInjectDestructors proc interestingIterVar(s: PSym): bool {.inline.} = + # unused with -d:nimOptIters # XXX optimization: Only lift the variable if it lives across # yield/return boundaries! This can potentially speed up # closure iterators quite a bit. result = s.kind in {skResult, skVar, skLet, skTemp, skForVar} and sfGlobal notin s.flags -template isIterator*(owner: PSym): bool = - owner.kind == skIterator and owner.typ.callConv == ccClosure - -proc liftingHarmful(conf: ConfigRef; owner: PSym): bool {.inline.} = +template liftingHarmful(conf: ConfigRef; owner: PSym): bool = ## lambda lifting can be harmful for JS-like code generators. let isCompileTime = sfCompileTime in owner.flags or owner.kind == skMacro - result = conf.backend == backendJs and not isCompileTime + jsNoLambdaLifting in conf.legacyFeatures and conf.backend == backendJs and not isCompileTime proc createTypeBoundOpsLL(g: ModuleGraph; refType: PType; info: TLineInfo; idgen: IdGenerator; owner: PSym) = if owner.kind != skMacro: - createTypeBoundOps(g, nil, refType.lastSon, info, idgen) + createTypeBoundOps(g, nil, refType.elementType, info, idgen) createTypeBoundOps(g, nil, refType, info, idgen) if tfHasAsgn in refType.flags or optSeqDestructors in g.config.globalOptions: owner.flags.incl sfInjectDestructors +proc genCreateEnv(env: PNode): PNode = + var c = newNodeIT(nkObjConstr, env.info, env.typ) + c.add newNodeIT(nkType, env.info, env.typ) + let e = copyTree(env) + e.flags.incl nfFirstWrite + result = newAsgnStmt(e, c) + proc liftIterSym*(g: ModuleGraph; n: PNode; idgen: IdGenerator; owner: PSym): PNode = # transforms (iter) to (let env = newClosure[iter](); (iter, env)) if liftingHarmful(g.config, owner): return n let iter = n.sym assert iter.isIterator - result = newNodeIT(nkStmtListExpr, n.info, n.typ) - + result = newNodeIT(nkStmtListExpr, n.info, iter.typ) let hp = getHiddenParam(g, iter) var env: PNode if owner.isIterator: @@ -259,7 +268,7 @@ proc liftIterSym*(g: ModuleGraph; n: PNode; idgen: IdGenerator; owner: PSym): PN addUniqueField(it.typ.skipTypes({tyOwned})[0], hp, g.cache, idgen) env = indirectAccess(newSymNode(it), hp, hp.info) else: - let e = newSym(skLet, iter.name, nextSymId(idgen), owner, n.info) + let e = newSym(skLet, iter.name, idgen, owner, n.info) e.typ = hp.typ e.flags = hp.flags env = newSymNode(e) @@ -267,54 +276,53 @@ proc liftIterSym*(g: ModuleGraph; n: PNode; idgen: IdGenerator; owner: PSym): PN addVar(v, env) result.add(v) # add 'new' statement: - result.add newCall(getSysSym(g, n.info, "internalNew"), env) + #result.add newCall(getSysSym(g, n.info, "internalNew"), env) + result.add genCreateEnv(env) createTypeBoundOpsLL(g, env.typ, n.info, idgen, owner) result.add makeClosure(g, idgen, iter, env, n.info) proc freshVarForClosureIter*(g: ModuleGraph; s: PSym; idgen: IdGenerator; owner: PSym): PNode = + # unused with -d:nimOptIters let envParam = getHiddenParam(g, owner) let obj = envParam.typ.skipTypes({tyOwned, tyRef, tyPtr}) - addField(obj, s, g.cache, idgen) + let field = addField(obj, s, g.cache, idgen) var access = newSymNode(envParam) assert obj.kind == tyObject - let field = getFieldFromObj(obj, s) - if field != nil: - result = rawIndirectAccess(access, field, s.info) - else: - localError(g.config, s.info, "internal error: cannot generate fresh variable") - result = access + result = rawIndirectAccess(access, field, s.info) # ------------------ new stuff ------------------------------------------- proc markAsClosure(g: ModuleGraph; owner: PSym; n: PNode) = let s = n.sym + let isEnv = s.name.id == getIdent(g.cache, ":env").id 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:nimWorkaround14447' 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): + " safety, declared here: $3; using '-d:nimNoLentIterators' helps in some cases." & + " Consider using a <ref T> which can be captured.") % + [s.name.s, typeToString(s.typ.skipTypes({tyVar})), g.config$s.info]) + elif not (owner.typ.isClosure or owner.isNimcall and not owner.isExplicitCallConv or isEnv): localError(g.config, n.info, "illegal capture '$1' because '$2' has the calling convention: <$3>" % [s.name.s, owner.name.s, $owner.typ.callConv]) incl(owner.typ.flags, tfCapturesEnv) - owner.typ.callConv = ccClosure + if not isEnv: + owner.typ.callConv = ccClosure type DetectionPass = object processed, capturedVars: IntSet ownerToType: Table[int, PType] somethingToDo: bool + inTypeOf: bool graph: ModuleGraph idgen: IdGenerator proc initDetectionPass(g: ModuleGraph; fn: PSym; idgen: IdGenerator): DetectionPass = - result.processed = initIntSet() - result.capturedVars = initIntSet() - result.ownerToType = initTable[int, PType]() - result.processed.incl(fn.id) - result.graph = g - result.idgen = idgen + result = DetectionPass(processed: toIntSet([fn.id]), + capturedVars: initIntSet(), ownerToType: initTable[int, PType](), + graph: g, idgen: idgen + ) discard """ proc outer = @@ -330,15 +338,19 @@ proc getEnvTypeForOwner(c: var DetectionPass; owner: PSym; info: TLineInfo): PType = result = c.ownerToType.getOrDefault(owner.id) if result.isNil: - result = newType(tyRef, nextTypeId(c.idgen), owner) - let obj = createEnvObj(c.graph, c.idgen, owner, info) - rawAddSon(result, obj) + let env = getEnvParam(owner) + if env.isNil or not owner.isIterator or not isDefined(c.graph.config, "nimOptIters"): + result = newType(tyRef, c.idgen, owner) + let obj = createEnvObj(c.graph, c.idgen, owner, info) + rawAddSon(result, obj) + else: + result = env.typ c.ownerToType[owner.id] = result proc asOwnedRef(c: var DetectionPass; t: PType): PType = if optOwnedRefs in c.graph.config.globalOptions: assert t.kind == tyRef - result = newType(tyOwned, nextTypeId(c.idgen), t.owner) + result = newType(tyOwned, c.idgen, t.owner) result.flags.incl tfHasOwned result.rawAddSon t else: @@ -347,7 +359,7 @@ proc asOwnedRef(c: var DetectionPass; t: PType): PType = proc getEnvTypeForOwnerUp(c: var DetectionPass; owner: PSym; info: TLineInfo): PType = var r = c.getEnvTypeForOwner(owner, info) - result = newType(tyPtr, nextTypeId(c.idgen), owner) + result = newType(tyPtr, c.idgen, owner) rawAddSon(result, r.skipTypes({tyOwned, tyRef, tyPtr})) proc createUpField(c: var DetectionPass; dest, dep: PSym; info: TLineInfo) = @@ -375,7 +387,7 @@ proc createUpField(c: var DetectionPass; dest, dep: PSym; info: TLineInfo) = 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") else: - let result = newSym(skField, upIdent, nextSymId(c.idgen), obj.owner, obj.owner.info) + let result = newSym(skField, upIdent, c.idgen, obj.owner, obj.owner.info) result.typ = fieldType when false: if c.graph.config.selectedGC == gcDestructors: @@ -408,12 +420,15 @@ Consider: """ +proc isTypeOf(n: PNode): bool = + n.kind == nkSym and n.sym.magic in {mTypeOf, mType} + proc addClosureParam(c: var DetectionPass; fn: PSym; info: TLineInfo) = var cp = getEnvParam(fn) let owner = if fn.kind == skIterator: fn else: fn.skipGenericOwner let t = c.getEnvTypeForOwner(owner, info) if cp == nil: - cp = newSym(skParam, getIdent(c.graph.cache, paramName), nextSymId(c.idgen), fn, fn.info) + cp = newSym(skParam, getIdent(c.graph.cache, paramName), c.idgen, fn, fn.info) incl(cp.flags, sfFromGeneric) cp.typ = t addHiddenParam(fn, cp) @@ -436,24 +451,28 @@ proc detectCapturedVars(n: PNode; owner: PSym; c: var DetectionPass) = if innerProc: if s.isIterator: c.somethingToDo = true if not c.processed.containsOrIncl(s.id): - let body = transformBody(c.graph, c.idgen, s, cache = true) + let body = transformBody(c.graph, c.idgen, s, {useCache}) detectCapturedVars(body, s, c) let ow = s.skipGenericOwner + let innerClosure = innerProc and s.typ.callConv == ccClosure and not s.isIterator + let interested = interestingVar(s) if ow == owner: if owner.isIterator: c.somethingToDo = true addClosureParam(c, owner, n.info) - if interestingIterVar(s): - if not c.capturedVars.containsOrIncl(s.id): + if not isDefined(c.graph.config, "nimOptIters") and interestingIterVar(s): + if not c.capturedVars.contains(s.id): + if not c.inTypeOf: c.capturedVars.incl(s.id) let obj = getHiddenParam(c.graph, owner).typ.skipTypes({tyOwned, tyRef, tyPtr}) #let obj = c.getEnvTypeForOwner(s.owner).skipTypes({tyOwned, tyRef, tyPtr}) if s.name.id == getIdent(c.graph.cache, ":state").id: + obj.n[0].sym.flags.incl sfNoInit obj.n[0].sym.itemId = ItemId(module: s.itemId.module, item: -s.itemId.item) else: - addField(obj, s, c.graph.cache, c.idgen) + discard addField(obj, s, c.graph.cache, c.idgen) # direct or indirect dependency: - elif (innerProc and s.typ.callConv == ccClosure) or interestingVar(s): + elif innerClosure or interested: discard """ proc outer() = var x: int @@ -470,10 +489,12 @@ proc detectCapturedVars(n: PNode; owner: PSym; c: var DetectionPass) = addClosureParam(c, owner, n.info) #echo "capturing ", n.info # variable 's' is actually captured: - if interestingVar(s) and not c.capturedVars.containsOrIncl(s.id): - let obj = c.getEnvTypeForOwner(ow, n.info).skipTypes({tyOwned, tyRef, tyPtr}) - #getHiddenParam(owner).typ.skipTypes({tyOwned, tyRef, tyPtr}) - addField(obj, s, c.graph.cache, c.idgen) + if interestingVar(s): + if not c.capturedVars.contains(s.id): + if not c.inTypeOf: c.capturedVars.incl(s.id) + let obj = c.getEnvTypeForOwner(ow, n.info).skipTypes({tyOwned, tyRef, tyPtr}) + #getHiddenParam(owner).typ.skipTypes({tyOwned, tyRef, tyPtr}) + discard addField(obj, s, c.graph.cache, c.idgen) # create required upFields: var w = owner.skipGenericOwner if isInnerProc(w) or owner.isIterator: @@ -505,9 +526,14 @@ proc detectCapturedVars(n: PNode; owner: PSym; c: var DetectionPass) = detectCapturedVars(n[namePos], owner, c) of nkReturnStmt: detectCapturedVars(n[0], owner, c) + of nkIdentDefs: + detectCapturedVars(n[^1], owner, c) else: + if n.isCallExpr and n[0].isTypeOf: + c.inTypeOf = true for i in 0..<n.len: detectCapturedVars(n[i], owner, c) + c.inTypeOf = false type LiftingPass = object @@ -517,9 +543,8 @@ type unownedEnvVars: Table[int, PNode] # only required for --newruntime proc initLiftingPass(fn: PSym): LiftingPass = - result.processed = initIntSet() - result.processed.incl(fn.id) - result.envVars = initTable[int, PNode]() + result = LiftingPass(processed: toIntSet([fn.id]), + envVars: initTable[int, PNode]()) proc accessViaEnvParam(g: ModuleGraph; n: PNode; owner: PSym): PNode = let s = n.sym @@ -527,8 +552,8 @@ proc accessViaEnvParam(g: ModuleGraph; n: PNode; owner: PSym): PNode = let envParam = getHiddenParam(g, owner) if not envParam.isNil: var access = newSymNode(envParam) + var obj = access.typ.elementType while true: - let obj = access.typ[0] assert obj.kind == tyObject let field = getFieldFromObj(obj, s) if field != nil: @@ -536,18 +561,19 @@ proc accessViaEnvParam(g: ModuleGraph; n: PNode; owner: PSym): PNode = let upField = lookupInRecord(obj.n, getIdent(g.cache, upName)) if upField == nil: break access = rawIndirectAccess(access, upField, n.info) + obj = access.typ.baseClass localError(g.config, n.info, "internal error: environment misses: " & s.name.s) result = n proc newEnvVar(cache: IdentCache; owner: PSym; typ: PType; info: TLineInfo; idgen: IdGenerator): PNode = - var v = newSym(skVar, getIdent(cache, envName), nextSymId(idgen), owner, info) + var v = newSym(skVar, getIdent(cache, envName), idgen, owner, info) v.flags = {sfShadowed, sfGeneratedOp} v.typ = typ result = newSymNode(v) when false: if owner.kind == skIterator and owner.typ.callConv == ccClosure: let it = getHiddenParam(owner) - addUniqueField(it.typ[0], v) + addUniqueField(it.typ.elementType, v) result = indirectAccess(newSymNode(it), v, v.info) else: result = newSymNode(v) @@ -564,7 +590,7 @@ proc setupEnvVar(owner: PSym; d: var DetectionPass; result = newEnvVar(d.graph.cache, owner, asOwnedRef(d, envVarType), info, d.idgen) c.envVars[owner.id] = result if optOwnedRefs in d.graph.config.globalOptions: - var v = newSym(skVar, getIdent(d.graph.cache, envName & "Alt"), nextSymId d.idgen, owner, info) + var v = newSym(skVar, getIdent(d.graph.cache, envName & "Alt"), d.idgen, owner, info) v.flags = {sfShadowed, sfGeneratedOp} v.typ = envVarType c.unownedEnvVars[owner.id] = newSymNode(v) @@ -599,7 +625,7 @@ proc rawClosureCreation(owner: PSym; addVar(v, unowned) # add 'new' statement: - result.add(newCall(getSysSym(d.graph, env.info, "internalNew"), env)) + result.add genCreateEnv(env) if optOwnedRefs in d.graph.config.globalOptions: let unowned = c.unownedEnvVars[owner.id] assert unowned != nil @@ -648,7 +674,7 @@ proc closureCreationForIter(iter: PNode; d: var DetectionPass; c: var LiftingPass): PNode = result = newNodeIT(nkStmtListExpr, iter.info, iter.sym.typ) let owner = iter.sym.skipGenericOwner - var v = newSym(skVar, getIdent(d.graph.cache, envName), nextSymId(d.idgen), owner, iter.info) + var v = newSym(skVar, getIdent(d.graph.cache, envName), d.idgen, owner, iter.info) incl(v.flags, sfShadowed) v.typ = asOwnedRef(d, getHiddenParam(d.graph, iter.sym).typ) var vnode: PNode @@ -661,7 +687,7 @@ proc closureCreationForIter(iter: PNode; var vs = newNodeI(nkVarSection, iter.info) addVar(vs, vnode) result.add(vs) - result.add(newCall(getSysSym(d.graph, iter.info, "internalNew"), vnode)) + result.add genCreateEnv(vnode) createTypeBoundOpsLL(d.graph, vnode.typ, iter.info, d.idgen, owner) let upField = lookupInRecord(v.typ.skipTypes({tyOwned, tyRef, tyPtr}).n, getIdent(d.graph.cache, upName)) @@ -706,6 +732,7 @@ proc symToClosure(n: PNode; owner: PSym; d: var DetectionPass; # direct dependency, so use the outer's env variable: result = makeClosure(d.graph, d.idgen, s, setupEnvVar(owner, d, c, n.info), n.info) else: + result = nil let available = getHiddenParam(d.graph, owner) let wanted = getHiddenParam(d.graph, s).typ # ugh: call through some other inner proc; @@ -732,7 +759,7 @@ proc liftCapturedVars(n: PNode; owner: PSym; d: var DetectionPass; # echo renderTree(s.getBody, {renderIds}) let oldInContainer = c.inContainer c.inContainer = 0 - var body = transformBody(d.graph, d.idgen, s, cache = false) + var body = transformBody(d.graph, d.idgen, s, {}) body = liftCapturedVars(body, s, d, c) if c.envVars.getOrDefault(s.id).isNil: s.transformedBody = body @@ -747,7 +774,7 @@ proc liftCapturedVars(n: PNode; owner: PSym; d: var DetectionPass; elif s.id in d.capturedVars: if s.owner != owner: result = accessViaEnvParam(d.graph, n, owner) - elif owner.isIterator and interestingIterVar(s): + elif owner.isIterator and not isDefined(d.graph.config, "nimOptIters") and interestingIterVar(s): result = accessViaEnvParam(d.graph, n, owner) else: result = accessViaEnvVar(n, owner, d, c) @@ -777,7 +804,7 @@ proc liftCapturedVars(n: PNode; owner: PSym; d: var DetectionPass; n[1] = liftCapturedVars(n[1], owner, d, c) if n[1].kind == nkClosure: result = n[1] of nkReturnStmt: - if n[0].kind in {nkAsgn, nkFastAsgn}: + if n[0].kind in {nkAsgn, nkFastAsgn, nkSinkAsgn}: # we have a `result = result` expression produced by the closure # transform, let's not touch the LHS in order to make the lifting pass # correct when `result` is lifted @@ -787,6 +814,8 @@ proc liftCapturedVars(n: PNode; owner: PSym; d: var DetectionPass; of nkTypeOfExpr: result = n else: + if n.isCallExpr and n[0].isTypeOf: + return if owner.isIterator: if nfLL in n.flags: # special case 'when nimVm' due to bug #3636: @@ -854,20 +883,19 @@ proc liftIterToProc*(g: ModuleGraph; fn: PSym; body: PNode; ptrType: PType; fn.typ.callConv = oldCC proc liftLambdas*(g: ModuleGraph; fn: PSym, body: PNode; tooEarly: var bool; - idgen: IdGenerator): PNode = - # XXX backend == backendJs does not suffice! The compiletime stuff needs - # the transformation even when compiling to JS ... - - # However we can do lifting for the stuff which is *only* compiletime. + idgen: IdGenerator; flags: TransformFlags): PNode = let isCompileTime = sfCompileTime in fn.flags or fn.kind == skMacro - if body.kind == nkEmpty or ( + if body.kind == nkEmpty or (jsNoLambdaLifting in g.config.legacyFeatures and g.config.backend == backendJs and not isCompileTime) or - fn.skipGenericOwner.kind != skModule: + (fn.skipGenericOwner.kind != skModule and force notin flags): # ignore forward declaration: result = body tooEarly = true + if fn.isIterator and isDefined(g.config, "nimOptIters"): + var d = initDetectionPass(g, fn, idgen) + addClosureParam(d, fn, body.info) else: var d = initDetectionPass(g, fn, idgen) detectCapturedVars(body, fn, d) @@ -931,14 +959,14 @@ proc liftForLoop*(g: ModuleGraph; body: PNode; idgen: IdGenerator; owner: PSym): result = newNodeI(nkStmtList, body.info) # static binding? - var env: PSym + var env: PSym = nil let op = call[0] if op.kind == nkSym and op.sym.isIterator: # createClosure() let iter = op.sym let hp = getHiddenParam(g, iter) - env = newSym(skLet, iter.name, nextSymId(idgen), owner, body.info) + env = newSym(skLet, iter.name, idgen, owner, body.info) env.typ = hp.typ env.flags = hp.flags @@ -946,7 +974,7 @@ proc liftForLoop*(g: ModuleGraph; body: PNode; idgen: IdGenerator; owner: PSym): addVar(v, newSymNode(env)) result.add(v) # add 'new' statement: - result.add(newCall(getSysSym(g, env.info, "internalNew"), env.newSymNode)) + result.add genCreateEnv(env.newSymNode) createTypeBoundOpsLL(g, env.typ, body.info, idgen, owner) elif op.kind == nkStmtListExpr: @@ -966,12 +994,15 @@ proc liftForLoop*(g: ModuleGraph; body: PNode; idgen: IdGenerator; owner: PSym): # gather vars in a tuple: var v2 = newNodeI(nkLetSection, body.info) var vpart = newNodeI(if body.len == 3: nkIdentDefs else: nkVarTuple, body.info) - for i in 0..<body.len-2: - if body[i].kind == nkSym: - body[i].sym.transitionToLet() - vpart.add body[i] + if body.len == 3 and body[0].kind == nkVarTuple: + vpart = body[0] # fixes for (i,j) in walk() # bug #15924 + else: + for i in 0..<body.len-2: + if body[i].kind == nkSym: + body[i].sym.transitionToLet() + vpart.add body[i] - vpart.add newNodeI(nkEmpty, body.info) # no explicit type + vpart.add newNodeI(nkEmpty, body.info) # no explicit type if not env.isNil: call[0] = makeClosure(g, idgen, call[0].sym, env.newSymNode, body.info) vpart.add call diff --git a/compiler/layouter.nim b/compiler/layouter.nim index ec9db6aad..0121b1185 100644 --- a/compiler/layouter.nim +++ b/compiler/layouter.nim @@ -9,7 +9,7 @@ ## Layouter for nimpretty. -import idents, lexer, lineinfos, llstream, options, msgs, strutils, pathutils +import idents, lexer, ast, lineinfos, llstream, options, msgs, strutils, pathutils const MinLineLen = 15 @@ -243,23 +243,28 @@ proc renderTokens*(em: var Emitter): string = return content -proc writeOut*(em: Emitter, content: string) = +type + FinalCheck = proc (content: string; origAst: PNode): bool {.nimcall.} + +proc writeOut*(em: Emitter; content: string; origAst: PNode; check: FinalCheck) = ## Write to disk let outFile = em.config.absOutFile if fileExists(outFile) and readFile(outFile.string) == content: discard "do nothing, see #9499" return - var f = llStreamOpen(outFile, fmWrite) - if f == nil: - rawMessage(em.config, errGenerated, "cannot open file: " & outFile.string) - return - f.llStreamWrite content - llStreamClose(f) -proc closeEmitter*(em: var Emitter) = + if check(content, origAst): + var f = llStreamOpen(outFile, fmWrite) + if f == nil: + rawMessage(em.config, errGenerated, "cannot open file: " & outFile.string) + return + f.llStreamWrite content + llStreamClose(f) + +proc closeEmitter*(em: var Emitter; origAst: PNode; check: FinalCheck) = ## Renders emitter tokens and write to a file let content = renderTokens(em) - em.writeOut(content) + em.writeOut(content, origAst, check) proc wr(em: var Emitter; x: string; lt: LayoutToken) = em.tokens.add x @@ -510,7 +515,7 @@ proc emitTok*(em: var Emitter; L: Lexer; tok: Token) = rememberSplit(splitComma) wrSpace em of openPars: - if tok.strongSpaceA > 0 and not em.endsInWhite and + if tsLeading in tok.spacing and not em.endsInWhite and (not em.wasExportMarker or tok.tokType == tkCurlyDotLe): wrSpace em wr(em, $tok.tokType, ltSomeParLe) @@ -528,7 +533,7 @@ proc emitTok*(em: var Emitter; L: Lexer; tok: Token) = wr(em, $tok.tokType, ltOther) if not em.inquote: wrSpace(em) of tkOpr, tkDotDot: - if em.inquote or ((tok.strongSpaceA == 0 and tok.strongSpaceB == 0) and + if em.inquote or (tok.spacing == {} and tok.ident.s notin ["<", ">", "<=", ">=", "==", "!="]): # bug #9504: remember to not spacify a keyword: lastTokWasTerse = true @@ -538,7 +543,7 @@ proc emitTok*(em: var Emitter; L: Lexer; tok: Token) = if not em.endsInWhite: wrSpace(em) wr(em, tok.ident.s, ltOpr) template isUnary(tok): bool = - tok.strongSpaceB == 0 and tok.strongSpaceA > 0 + tok.spacing == {tsLeading} if not isUnary(tok): rememberSplit(splitBinary) @@ -551,11 +556,15 @@ proc emitTok*(em: var Emitter; L: Lexer; tok: Token) = if not preventComment: emitComment(em, tok, dontIndent = false) of tkIntLit..tkStrLit, tkRStrLit, tkTripleStrLit, tkGStrLit, tkGTripleStrLit, tkCharLit: - let lit = fileSection(em.config, em.fid, tok.offsetA, tok.offsetB) - if endsInAlpha(em) and tok.tokType notin {tkGStrLit, tkGTripleStrLit}: wrSpace(em) - em.lineSpan = countNewlines(lit) - if em.lineSpan > 0: calcCol(em, lit) - wr em, lit, ltLit + if not em.inquote: + let lit = fileSection(em.config, em.fid, tok.offsetA, tok.offsetB) + if endsInAlpha(em) and tok.tokType notin {tkGStrLit, tkGTripleStrLit}: wrSpace(em) + em.lineSpan = countNewlines(lit) + if em.lineSpan > 0: calcCol(em, lit) + wr em, lit, ltLit + else: + if endsInAlpha(em): wrSpace(em) + wr em, tok.literal, ltLit of tkEof: discard else: let lit = if tok.ident != nil: tok.ident.s else: tok.literal diff --git a/compiler/lexer.nim b/compiler/lexer.nim index 729ba3435..ad5dd560c 100644 --- a/compiler/lexer.nim +++ b/compiler/lexer.nim @@ -7,25 +7,30 @@ # distribution, for details about the copyright. # -# This scanner is handwritten for efficiency. I used an elegant buffering +# 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 scanner to properly read Unix, +# 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 + options, msgs, platform, idents, nimlexbase, llstream, + wordrecg, lineinfos, pathutils + +import std/[hashes, parseutils, strutils] + +when defined(nimPreviewSlimSystem): + import std/[assertions, formatfloat] const - MaxLineLength* = 80 # lines longer than this lead to a warning numChars*: set[char] = {'0'..'9', 'a'..'z', 'A'..'Z'} SymChars*: set[char] = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF'} SymStartChars*: set[char] = {'a'..'z', 'A'..'Z', '\x80'..'\xFF'} OpChars*: set[char] = {'+', '-', '*', '/', '\\', '<', '>', '!', '?', '^', '.', '|', '=', '%', '&', '$', '@', '~', ':'} + UnaryMinusWhitelist = {' ', '\t', '\n', '\r', ',', ';', '(', '[', '{'} # don't forget to update the 'highlite' module if these charsets should change @@ -51,26 +56,27 @@ type tkVar = "var", tkWhen = "when", tkWhile = "while", tkXor = "xor", tkYield = "yield", # end of keywords - tkIntLit = "tkIntLit", tkInt8Lit = "tkInt8Lit", tkInt16Lit = "tkInt16Lit", + tkIntLit = "tkIntLit", tkInt8Lit = "tkInt8Lit", tkInt16Lit = "tkInt16Lit", tkInt32Lit = "tkInt32Lit", tkInt64Lit = "tkInt64Lit", - tkUIntLit = "tkUIntLit", tkUInt8Lit = "tkUInt8Lit", tkUInt16Lit = "tkUInt16Lit", + tkUIntLit = "tkUIntLit", tkUInt8Lit = "tkUInt8Lit", tkUInt16Lit = "tkUInt16Lit", tkUInt32Lit = "tkUInt32Lit", tkUInt64Lit = "tkUInt64Lit", tkFloatLit = "tkFloatLit", tkFloat32Lit = "tkFloat32Lit", tkFloat64Lit = "tkFloat64Lit", tkFloat128Lit = "tkFloat128Lit", tkStrLit = "tkStrLit", tkRStrLit = "tkRStrLit", tkTripleStrLit = "tkTripleStrLit", - tkGStrLit = "tkGStrLit", tkGTripleStrLit = "tkGTripleStrLit", tkCharLit = "tkCharLit", - + tkGStrLit = "tkGStrLit", tkGTripleStrLit = "tkGTripleStrLit", tkCharLit = "tkCharLit", + tkCustomLit = "tkCustomLit", + tkParLe = "(", tkParRi = ")", tkBracketLe = "[", tkBracketRi = "]", tkCurlyLe = "{", tkCurlyRi = "}", tkBracketDotLe = "[.", tkBracketDotRi = ".]", tkCurlyDotLe = "{.", tkCurlyDotRi = ".}", tkParDotLe = "(.", tkParDotRi = ".)", tkComma = ",", tkSemiColon = ";", - tkColon = ":", tkColonColon = "::", tkEquals = "=", + tkColon = ":", tkColonColon = "::", tkEquals = "=", tkDot = ".", tkDotDot = "..", tkBracketLeColon = "[:", tkOpr, tkComment, tkAccent = "`", # these are fake tokens used by renderer.nim - tkSpaces, tkInfixOpr, tkPrefixOpr, tkPostfixOpr + tkSpaces, tkInfixOpr, tkPrefixOpr, tkPostfixOpr, tkHideableStart, tkHideableEnd TokTypes* = set[TokType] @@ -88,19 +94,21 @@ type # 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 + TokenSpacing* = enum + tsLeading, tsTrailing, tsEof + + Token* = object # a Nim token + tokType*: TokType # the type of the token + base*: NumericalBase # the numerical base; only valid for int + # or float literals + spacing*: set[TokenSpacing] # spaces around 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 + 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 @@ -114,11 +122,12 @@ type # 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 + tokenEnd*: TLineInfo + previousTokenEnd*: TLineInfo config*: ConfigRef proc getLineInfo*(L: Lexer, tok: Token): TLineInfo {.inline.} = @@ -140,9 +149,11 @@ proc isNimIdentifier*(s: string): bool = var i = 1 while i < sLen: if s[i] == '_': inc(i) - if i < sLen and s[i] notin SymChars: return + if i < sLen and s[i] notin SymChars: return false inc(i) result = true + else: + result = false proc `$`*(tok: Token): string = case tok.tokType @@ -161,34 +172,9 @@ proc prettyTok*(tok: Token): string = else: $tok proc printTok*(conf: ConfigRef; tok: Token) = + # xxx factor with toLocation msgWriteln(conf, $tok.line & ":" & $tok.col & "\t" & $tok.tokType & " " & $tok) -proc initToken*(L: var Token) = - L.tokType = tkInvalid - L.iNumber = 0 - L.indent = 0 - L.strongSpaceA = 0 - L.literal = "" - L.fNumber = 0.0 - L.base = base10 - L.ident = nil - when defined(nimpretty): - L.commentOffsetA = 0 - L.commentOffsetB = 0 - -proc fillToken(L: var Token) = - L.tokType = tkInvalid - L.iNumber = 0 - L.indent = 0 - L.strongSpaceA = 0 - setLen(L.literal, 0) - L.fNumber = 0.0 - L.base = base10 - L.ident = nil - when defined(nimpretty): - L.commentOffsetA = 0 - L.commentOffsetB = 0 - proc openLexer*(lex: var Lexer, fileIdx: FileIndex, inputstream: PLLStream; cache: IdentCache; config: ConfigRef) = openBaseLexer(lex, inputstream) @@ -312,11 +298,9 @@ proc getNumber(L: var Lexer, result: var Token) = proc lexMessageLitNum(L: var Lexer, msg: string, startpos: int, msgKind = errGenerated) = # Used to get slightly human friendlier err messages. - const literalishChars = {'A'..'F', 'a'..'f', '0'..'9', 'X', 'x', 'o', 'O', - 'c', 'C', 'b', 'B', '_', '.', '\'', 'd', 'i', 'u'} + const literalishChars = {'A'..'Z', 'a'..'z', '0'..'9', '_', '.', '\''} var msgPos = L.bufpos - var t: Token - t.literal = "" + var t = Token(literal: "") L.bufpos = startpos # Use L.bufpos as pos because of matchChars matchChars(L, t, literalishChars) # We must verify +/- specifically so that we're not past the literal @@ -325,15 +309,14 @@ proc getNumber(L: var Lexer, result: var Token) = t.literal.add(L.buf[L.bufpos]) inc(L.bufpos) matchChars(L, t, literalishChars) - if L.buf[L.bufpos] in {'\'', 'f', 'F', 'd', 'D', 'i', 'I', 'u', 'U'}: - inc(L.bufpos) + if L.buf[L.bufpos] in literalishChars: t.literal.add(L.buf[L.bufpos]) + inc(L.bufpos) matchChars(L, t, {'0'..'9'}) L.bufpos = msgPos lexMessage(L, msgKind, msg % t.literal) var - startpos, endpos: int xi: BiggestInt isBase10 = true numDigits = 0 @@ -345,8 +328,17 @@ proc getNumber(L: var Lexer, result: var Token) = result.tokType = tkIntLit # int literal until we know better result.literal = "" result.base = base10 - startpos = L.bufpos - tokenBegin(result, startpos) + tokenBegin(result, L.bufpos) + + var isPositive = true + if L.buf[L.bufpos] == '-': + eatChar(L, result) + isPositive = false + + let startpos = L.bufpos + + template setNumber(field, value) = + field = (if isPositive: value else: -value) # First stage: find out base, make verifications, build token literal string # {'c', 'C'} is added for deprecation reasons to provide a clear error message @@ -386,200 +378,184 @@ proc getNumber(L: var Lexer, result: var Token) = discard matchUnderscoreChars(L, result, {'0'..'9'}) if L.buf[L.bufpos] in {'e', 'E'}: result.tokType = tkFloatLit - eatChar(L, result, 'e') + eatChar(L, result) if L.buf[L.bufpos] in {'+', '-'}: eatChar(L, result) discard matchUnderscoreChars(L, result, {'0'..'9'}) - endpos = L.bufpos + let endpos = L.bufpos # Second stage, find out if there's a datatype suffix and handle it var postPos = endpos + if L.buf[postPos] in {'\'', 'f', 'F', 'd', 'D', 'i', 'I', 'u', 'U'}: + let errPos = postPos + var customLitPossible = false if L.buf[postPos] == '\'': inc(postPos) + customLitPossible = true - case L.buf[postPos] - of 'f', 'F': - inc(postPos) - if (L.buf[postPos] == '3') and (L.buf[postPos + 1] == '2'): - result.tokType = tkFloat32Lit - inc(postPos, 2) - elif (L.buf[postPos] == '6') and (L.buf[postPos + 1] == '4'): - result.tokType = tkFloat64Lit - inc(postPos, 2) - elif (L.buf[postPos] == '1') and - (L.buf[postPos + 1] == '2') and - (L.buf[postPos + 2] == '8'): - result.tokType = tkFloat128Lit - inc(postPos, 3) - else: # "f" alone defaults to float32 - result.tokType = tkFloat32Lit - of 'd', 'D': # ad hoc convenience shortcut for f64 - inc(postPos) - result.tokType = tkFloat64Lit - of 'i', 'I': - inc(postPos) - if (L.buf[postPos] == '6') and (L.buf[postPos + 1] == '4'): - result.tokType = tkInt64Lit - inc(postPos, 2) - elif (L.buf[postPos] == '3') and (L.buf[postPos + 1] == '2'): - result.tokType = tkInt32Lit - inc(postPos, 2) - elif (L.buf[postPos] == '1') and (L.buf[postPos + 1] == '6'): - result.tokType = tkInt16Lit - inc(postPos, 2) - elif (L.buf[postPos] == '8'): - result.tokType = tkInt8Lit - inc(postPos) - else: - lexMessageLitNum(L, "invalid number: '$1'", startpos) - of 'u', 'U': - inc(postPos) - if (L.buf[postPos] == '6') and (L.buf[postPos + 1] == '4'): - result.tokType = tkUInt64Lit - inc(postPos, 2) - elif (L.buf[postPos] == '3') and (L.buf[postPos + 1] == '2'): - result.tokType = tkUInt32Lit - inc(postPos, 2) - elif (L.buf[postPos] == '1') and (L.buf[postPos + 1] == '6'): - result.tokType = tkUInt16Lit - inc(postPos, 2) - elif (L.buf[postPos] == '8'): - result.tokType = tkUInt8Lit - inc(postPos) + if L.buf[postPos] in SymChars: + var suffix = newStringOfCap(10) + while true: + suffix.add L.buf[postPos] + inc postPos + if L.buf[postPos] notin SymChars+{'_'}: break + let suffixAsLower = suffix.toLowerAscii + case suffixAsLower + of "f", "f32": result.tokType = tkFloat32Lit + of "d", "f64": result.tokType = tkFloat64Lit + of "f128": result.tokType = tkFloat128Lit + of "i8": result.tokType = tkInt8Lit + of "i16": result.tokType = tkInt16Lit + of "i32": result.tokType = tkInt32Lit + of "i64": result.tokType = tkInt64Lit + of "u": result.tokType = tkUIntLit + of "u8": result.tokType = tkUInt8Lit + of "u16": result.tokType = tkUInt16Lit + of "u32": result.tokType = tkUInt32Lit + of "u64": result.tokType = tkUInt64Lit + elif customLitPossible: + # remember the position of the `'` so that the parser doesn't + # have to reparse the custom literal: + result.iNumber = len(result.literal) + result.literal.add '\'' + result.literal.add suffix + result.tokType = tkCustomLit else: - result.tokType = tkUIntLit + lexMessageLitNum(L, "invalid number suffix: '$1'", errPos) else: - lexMessageLitNum(L, "invalid number: '$1'", startpos) + lexMessageLitNum(L, "invalid number suffix: '$1'", errPos) # 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) - # Third stage, extract actual number - L.bufpos = startpos # restore position - var pos: int = startpos - try: - if (L.buf[pos] == '0') and (L.buf[pos + 1] in baseCodeChars): - inc(pos, 2) - xi = 0 # it is a base prefix - - case L.buf[pos - 1] - of 'b', 'B': - result.base = base2 - while pos < endpos: - if L.buf[pos] != '_': - xi = `shl`(xi, 1) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - # 'c', 'C' is deprecated - of 'o', 'c', 'C': - result.base = base8 - while pos < endpos: - if L.buf[pos] != '_': - xi = `shl`(xi, 3) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - of 'x', 'X': - result.base = base16 - while pos < endpos: - case L.buf[pos] - of '_': - inc(pos) - of '0'..'9': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - of 'a'..'f': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('a') + 10) + if result.tokType != tkCustomLit: + # Third stage, extract actual number + L.bufpos = startpos # restore position + var pos = startpos + try: + if (L.buf[pos] == '0') and (L.buf[pos + 1] in baseCodeChars): + inc(pos, 2) + xi = 0 # it is a base prefix + + case L.buf[pos - 1] + of 'b', 'B': + result.base = base2 + while pos < endpos: + if L.buf[pos] != '_': + xi = `shl`(xi, 1) or (ord(L.buf[pos]) - ord('0')) inc(pos) - of 'A'..'F': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10) + # 'c', 'C' is deprecated (a warning is issued elsewhere) + of 'o', 'c', 'C': + result.base = base8 + while pos < endpos: + if L.buf[pos] != '_': + xi = `shl`(xi, 3) or (ord(L.buf[pos]) - ord('0')) inc(pos) - else: - break + of 'x', 'X': + result.base = base16 + while pos < endpos: + case L.buf[pos] + of '_': + inc(pos) + of '0'..'9': + xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('0')) + inc(pos) + of 'a'..'f': + xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('a') + 10) + inc(pos) + of 'A'..'F': + xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10) + inc(pos) + else: + break + else: + internalError(L.config, getLineInfo(L), "getNumber") + + case result.tokType + of tkIntLit, tkInt64Lit: setNumber result.iNumber, xi + of tkInt8Lit: setNumber result.iNumber, ashr(xi shl 56, 56) + of tkInt16Lit: setNumber result.iNumber, ashr(xi shl 48, 48) + of tkInt32Lit: setNumber result.iNumber, ashr(xi shl 32, 32) + of tkUIntLit, tkUInt64Lit: setNumber result.iNumber, xi + of tkUInt8Lit: setNumber result.iNumber, xi and 0xff + of tkUInt16Lit: setNumber result.iNumber, xi and 0xffff + of tkUInt32Lit: setNumber result.iNumber, xi and 0xffffffff + of tkFloat32Lit: + setNumber result.fNumber, (cast[ptr float32](addr(xi)))[] + # note: this code is endian neutral! + # XXX: Test this on big endian machine! + of tkFloat64Lit, tkFloatLit: + setNumber result.fNumber, (cast[ptr float64](addr(xi)))[] + else: internalError(L.config, getLineInfo(L), "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 + # below checks of signed sizes against uint*.high is deliberate: + # (0x80'u8 = 128, 0x80'i8 = -128, etc == OK) + if result.tokType notin floatTypes: + let outOfRange = + case result.tokType + of tkUInt8Lit, tkUInt16Lit, tkUInt32Lit: result.iNumber != xi + of tkInt8Lit: (xi > BiggestInt(uint8.high)) + of tkInt16Lit: (xi > BiggestInt(uint16.high)) + of tkInt32Lit: (xi > BiggestInt(uint32.high)) + else: false + + if outOfRange: + #echo "out of range num: ", result.iNumber, " vs ", xi + lexMessageLitNum(L, "number out of range: '$1'", startpos) + else: - internalError(L.config, getLineInfo(L), "getNumber") - - case result.tokType - of tkIntLit, tkInt64Lit: result.iNumber = xi - of tkInt8Lit: result.iNumber = ashr(xi shl 56, 56) - of tkInt16Lit: result.iNumber = ashr(xi shl 48, 48) - of tkInt32Lit: result.iNumber = ashr(xi shl 32, 32) - of tkUIntLit, tkUInt64Lit: result.iNumber = xi - of tkUInt8Lit: result.iNumber = xi and 0xff - of tkUInt16Lit: result.iNumber = xi and 0xffff - of tkUInt32Lit: result.iNumber = xi and 0xffffffff - of tkFloat32Lit: - result.fNumber = (cast[PFloat32](addr(xi)))[] - # note: this code is endian neutral! - # XXX: Test this on big endian machine! - of tkFloat64Lit, tkFloatLit: - result.fNumber = (cast[PFloat64](addr(xi)))[] - else: internalError(L.config, getLineInfo(L), "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 - # below checks of signed sizes against uint*.high is deliberate: - # (0x80'u8 = 128, 0x80'i8 = -128, etc == OK) - if result.tokType notin floatTypes: - let outOfRange = case result.tokType: - of tkUInt8Lit, tkUInt16Lit, tkUInt32Lit: result.iNumber != xi - of tkInt8Lit: (xi > BiggestInt(uint8.high)) - of tkInt16Lit: (xi > BiggestInt(uint16.high)) - of tkInt32Lit: (xi > BiggestInt(uint32.high)) - else: false + case result.tokType + of floatTypes: + result.fNumber = parseFloat(result.literal) + of tkUInt64Lit, tkUIntLit: + var iNumber: uint64 = uint64(0) + var len: int = 0 + try: + len = parseBiggestUInt(result.literal, iNumber) + except ValueError: + raise newException(OverflowDefect, "number out of range: " & result.literal) + if len != result.literal.len: + raise newException(ValueError, "invalid integer: " & result.literal) + result.iNumber = cast[int64](iNumber) + else: + var iNumber: int64 = int64(0) + var len: int = 0 + try: + len = parseBiggestInt(result.literal, iNumber) + except ValueError: + raise newException(OverflowDefect, "number out of range: " & result.literal) + if len != result.literal.len: + raise newException(ValueError, "invalid integer: " & result.literal) + result.iNumber = iNumber + + # Explicit bounds checks. + let outOfRange = + case result.tokType + of tkInt8Lit: result.iNumber > int8.high or result.iNumber < int8.low + of tkUInt8Lit: result.iNumber > BiggestInt(uint8.high) or result.iNumber < 0 + of tkInt16Lit: result.iNumber > int16.high or result.iNumber < int16.low + of tkUInt16Lit: result.iNumber > BiggestInt(uint16.high) or result.iNumber < 0 + of tkInt32Lit: result.iNumber > int32.high or result.iNumber < int32.low + of tkUInt32Lit: result.iNumber > BiggestInt(uint32.high) or result.iNumber < 0 + else: false if outOfRange: - #echo "out of range num: ", result.iNumber, " vs ", xi lexMessageLitNum(L, "number out of range: '$1'", startpos) - else: - case result.tokType - of floatTypes: - result.fNumber = parseFloat(result.literal) - of tkUInt64Lit, tkUIntLit: - var iNumber: uint64 - var len: int - try: - len = parseBiggestUInt(result.literal, iNumber) - except ValueError: - raise newException(OverflowDefect, "number out of range: " & $result.literal) - if len != result.literal.len: - raise newException(ValueError, "invalid integer: " & $result.literal) - result.iNumber = cast[int64](iNumber) - else: - var iNumber: int64 - var len: int - try: - len = parseBiggestInt(result.literal, iNumber) - except ValueError: - raise newException(OverflowDefect, "number out of range: " & $result.literal) - if len != result.literal.len: - raise newException(ValueError, "invalid integer: " & $result.literal) - result.iNumber = iNumber - - # Explicit bounds checks. Only T.high needs to be considered - # since result.iNumber can't be negative. - let outOfRange = - case result.tokType - of tkInt8Lit: result.iNumber > int8.high - of tkUInt8Lit: result.iNumber > BiggestInt(uint8.high) - of tkInt16Lit: result.iNumber > int16.high - of tkUInt16Lit: result.iNumber > BiggestInt(uint16.high) - of tkInt32Lit: result.iNumber > int32.high - of tkUInt32Lit: result.iNumber > BiggestInt(uint32.high) - else: false - - if outOfRange: lexMessageLitNum(L, "number out of range: '$1'", startpos) - - # Promote int literal to int64? Not always necessary, but more consistent - if result.tokType == tkIntLit: - if result.iNumber > high(int32): - result.tokType = tkInt64Lit - - except ValueError: - lexMessageLitNum(L, "invalid number: '$1'", startpos) - except OverflowDefect, RangeDefect: - lexMessageLitNum(L, "number out of range: '$1'", startpos) + # Promote int literal to int64? Not always necessary, but more consistent + if result.tokType == tkIntLit: + if result.iNumber > high(int32) or result.iNumber < low(int32): + result.tokType = tkInt64Lit + + except ValueError: + lexMessageLitNum(L, "invalid number: '$1'", startpos) + except OverflowDefect, RangeDefect: + lexMessageLitNum(L, "number out of range: '$1'", startpos) tokenEnd(result, postPos-1) L.bufpos = postPos @@ -735,10 +711,6 @@ proc handleCRLF(L: var Lexer, pos: int): int = template registerLine = let col = L.getColNumber(pos) - when not defined(nimpretty): - if col > MaxLineLength: - lexMessagePos(L, hintLineTooLong, pos) - case L.buf[pos] of CR: registerLine() @@ -798,7 +770,7 @@ proc getString(L: var Lexer, tok: var Token, mode: StringMode) = if mode != normal: tok.tokType = tkRStrLit else: tok.tokType = tkStrLit while true: - var c = L.buf[pos] + let c = L.buf[pos] if c == '\"': if mode != normal and L.buf[pos+1] == '\"': inc(pos, 2) @@ -820,10 +792,11 @@ proc getString(L: var Lexer, tok: var Token, mode: StringMode) = inc(pos) L.bufpos = pos -proc getCharacter(L: var Lexer, tok: var Token) = +proc getCharacter(L: var Lexer; tok: var Token) = tokenBegin(tok, L.bufpos) + let startPos = L.bufpos inc(L.bufpos) # skip ' - var c = L.buf[L.bufpos] + let c = L.buf[L.bufpos] case c of '\0'..pred(' '), '\'': lexMessage(L, errGenerated, "invalid character literal") @@ -832,10 +805,59 @@ proc getCharacter(L: var Lexer, tok: var Token) = else: tok.literal = $c inc(L.bufpos) - if L.buf[L.bufpos] != '\'': - lexMessage(L, errGenerated, "missing closing ' for character literal") - tokenEndIgnore(tok, L.bufpos) - inc(L.bufpos) # skip ' + if L.buf[L.bufpos] == '\'': + tokenEndIgnore(tok, L.bufpos) + inc(L.bufpos) # skip ' + else: + if startPos > 0 and L.buf[startPos-1] == '`': + tok.literal = "'" + L.bufpos = startPos+1 + else: + lexMessage(L, errGenerated, "missing closing ' for character literal") + tokenEndIgnore(tok, L.bufpos) + +const + UnicodeOperatorStartChars = {'\226', '\194', '\195'} + # the allowed unicode characters ("∙ ∘ × ★ ⊗ ⊘ ⊙ ⊛ ⊠ ⊡ ∩ ∧ ⊓ ± ⊕ ⊖ ⊞ ⊟ ∪ ∨ ⊔") + # all start with one of these. + +type + UnicodeOprPred = enum + Mul, Add + +proc unicodeOprLen(buf: cstring; pos: int): (int8, UnicodeOprPred) = + template m(len): untyped = (int8(len), Mul) + template a(len): untyped = (int8(len), Add) + result = 0.m + case buf[pos] + of '\226': + if buf[pos+1] == '\136': + if buf[pos+2] == '\152': result = 3.m # ∘ + elif buf[pos+2] == '\153': result = 3.m # ∙ + elif buf[pos+2] == '\167': result = 3.m # ∧ + elif buf[pos+2] == '\168': result = 3.a # ∨ + elif buf[pos+2] == '\169': result = 3.m # ∩ + elif buf[pos+2] == '\170': result = 3.a # ∪ + elif buf[pos+1] == '\138': + if buf[pos+2] == '\147': result = 3.m # ⊓ + elif buf[pos+2] == '\148': result = 3.a # ⊔ + elif buf[pos+2] == '\149': result = 3.a # ⊕ + elif buf[pos+2] == '\150': result = 3.a # ⊖ + elif buf[pos+2] == '\151': result = 3.m # ⊗ + elif buf[pos+2] == '\152': result = 3.m # ⊘ + elif buf[pos+2] == '\153': result = 3.m # ⊙ + elif buf[pos+2] == '\155': result = 3.m # ⊛ + elif buf[pos+2] == '\158': result = 3.a # ⊞ + elif buf[pos+2] == '\159': result = 3.a # ⊟ + elif buf[pos+2] == '\160': result = 3.m # ⊠ + elif buf[pos+2] == '\161': result = 3.m # ⊡ + elif buf[pos+1] == '\152' and buf[pos+2] == '\133': result = 3.m # ★ + of '\194': + if buf[pos+1] == '\177': result = 2.a # ± + of '\195': + if buf[pos+1] == '\151': result = 2.m # × + else: + discard proc getSymbol(L: var Lexer, tok: var Token) = var h: Hash = 0 @@ -845,7 +867,7 @@ proc getSymbol(L: var Lexer, tok: var Token) = while true: var c = L.buf[pos] case c - of 'a'..'z', '0'..'9', '\x80'..'\xFF': + of 'a'..'z', '0'..'9': h = h !& ord(c) inc(pos) of 'A'..'Z': @@ -859,10 +881,16 @@ proc getSymbol(L: var Lexer, tok: var Token) = break inc(pos) suspicious = true + of '\x80'..'\xFF': + if c in UnicodeOperatorStartChars and unicodeOprLen(L.buf, pos)[0] != 0: + break + else: + h = h !& ord(c) + inc(pos) else: break tokenEnd(tok, pos-1) h = !$h - tok.ident = L.cache.getIdent(addr(L.buf[L.bufpos]), pos - L.bufpos, h) + tok.ident = L.cache.getIdent(cast[cstring](addr(L.buf[L.bufpos])), pos - L.bufpos, h) if (tok.ident.id < ord(tokKeywordLow) - ord(tkSymbol)) or (tok.ident.id > ord(tokKeywordHigh) - ord(tkSymbol)): tok.tokType = tkSymbol @@ -876,7 +904,7 @@ proc getSymbol(L: var Lexer, tok: var Token) = proc endOperator(L: var Lexer, tok: var Token, pos: int, hash: Hash) {.inline.} = var h = !$hash - tok.ident = L.cache.getIdent(addr(L.buf[L.bufpos]), pos - L.bufpos, h) + tok.ident = L.cache.getIdent(cast[cstring](addr(L.buf[L.bufpos])), pos - L.bufpos, h) if (tok.ident.id < oprLow) or (tok.ident.id > oprHigh): tok.tokType = tkOpr else: tok.tokType = TokType(tok.ident.id - oprLow + ord(tkColon)) L.bufpos = pos @@ -886,43 +914,66 @@ proc getOperator(L: var Lexer, tok: var Token) = tokenBegin(tok, pos) var h: Hash = 0 while true: - var c = L.buf[pos] - if c notin OpChars: break - h = h !& ord(c) - inc(pos) + let c = L.buf[pos] + if c in OpChars: + h = h !& ord(c) + inc(pos) + elif c in UnicodeOperatorStartChars: + let oprLen = unicodeOprLen(L.buf, pos)[0] + if oprLen == 0: break + for i in 0..<oprLen: + h = h !& ord(L.buf[pos]) + inc pos + else: + break endOperator(L, tok, pos, h) tokenEnd(tok, pos-1) # advance pos but don't store it in L.bufpos so the next token (which might # be an operator too) gets the preceding spaces: - tok.strongSpaceB = 0 + tok.spacing = tok.spacing - {tsTrailing, tsEof} + var trailing = false while L.buf[pos] == ' ': inc pos - inc tok.strongSpaceB + trailing = true if L.buf[pos] in {CR, LF, nimlexbase.EndOfFile}: - tok.strongSpaceB = -1 + tok.spacing.incl(tsEof) + elif trailing: + tok.spacing.incl(tsTrailing) proc getPrecedence*(tok: Token): int = ## Calculates the precedence of the given token. + const + MulPred = 9 + PlusPred = 8 case tok.tokType of tkOpr: let relevantChar = tok.ident.s[0] # arrow like? if tok.ident.s.len > 1 and tok.ident.s[^1] == '>' and - tok.ident.s[^2] in {'-', '~', '='}: return 1 + tok.ident.s[^2] in {'-', '~', '='}: return 0 template considerAsgn(value: untyped) = result = if tok.ident.s[^1] == '=': 1 else: value case relevantChar of '$', '^': considerAsgn(10) - of '*', '%', '/', '\\': considerAsgn(9) + of '*', '%', '/', '\\': considerAsgn(MulPred) of '~': result = 8 - of '+', '-', '|': considerAsgn(8) + of '+', '-', '|': considerAsgn(PlusPred) of '&': considerAsgn(7) of '=', '<', '>', '!': result = 5 of '.': considerAsgn(6) of '?': result = 2 + of UnicodeOperatorStartChars: + if tok.ident.s[^1] == '=': + result = 1 + else: + let (len, pred) = unicodeOprLen(cstring(tok.ident.s), 0) + if len != 0: + result = if pred == Mul: MulPred else: PlusPred + else: + result = 2 else: considerAsgn(2) of tkDiv, tkMod, tkShl, tkShr: result = 9 of tkDotDot: result = 6 @@ -931,22 +982,6 @@ proc getPrecedence*(tok: Token): int = of tkOr, tkXor, tkPtr, tkRef: result = 3 else: return -10 -proc newlineFollows*(L: Lexer): bool = - var pos = L.bufpos - while true: - case L.buf[pos] - of ' ', '\t': - inc(pos) - of CR, LF: - result = true - break - of '#': - inc(pos) - if L.buf[pos] == '#': inc(pos) - if L.buf[pos] != '[': return true - else: - break - proc skipMultiLineComment(L: var Lexer; tok: var Token; start: int; isDoc: bool) = var pos = start @@ -998,7 +1033,6 @@ proc skipMultiLineComment(L: var Lexer; tok: var Token; start: int; when defined(nimpretty): tok.literal.add "\L" if isDoc: when not defined(nimpretty): tok.literal.add "\n" - inc tok.iNumber var c = toStrip while L.buf[pos] == ' ' and c > 0: inc pos @@ -1017,8 +1051,6 @@ proc skipMultiLineComment(L: var Lexer; tok: var Token; start: int; proc scanComment(L: var Lexer, tok: var Token) = var pos = L.bufpos tok.tokType = tkComment - # iNumber contains the number of '\n' in the token - tok.iNumber = 0 assert L.buf[pos+1] == '#' when defined(nimpretty): tok.commentOffsetA = L.offsetBase + pos @@ -1041,9 +1073,7 @@ proc scanComment(L: var Lexer, tok: var Token) = toStrip = 0 else: # found first non-whitespace character stripInit = true - var lastBackslash = -1 while L.buf[pos] notin {CR, LF, nimlexbase.EndOfFile}: - if L.buf[pos] == '\\': lastBackslash = pos+1 tok.literal.add(L.buf[pos]) inc(pos) tokenEndIgnore(tok, pos) @@ -1061,7 +1091,6 @@ proc scanComment(L: var Lexer, tok: var Token) = while L.buf[pos] == ' ' and c > 0: inc pos dec c - inc tok.iNumber else: if L.buf[pos] > ' ': L.indentAhead = indent @@ -1074,7 +1103,7 @@ proc scanComment(L: var Lexer, tok: var Token) = proc skip(L: var Lexer, tok: var Token) = var pos = L.bufpos tokenBegin(tok, pos) - tok.strongSpaceA = 0 + tok.spacing.excl(tsLeading) when defined(nimpretty): var hasComment = false var commentIndent = L.currLineIndent @@ -1085,9 +1114,9 @@ proc skip(L: var Lexer, tok: var Token) = case L.buf[pos] of ' ': inc(pos) - inc(tok.strongSpaceA) + tok.spacing.incl(tsLeading) of '\t': - if not L.allowTabs: lexMessagePos(L, errGenerated, pos, "tabs are not allowed, use spaces instead") + lexMessagePos(L, errGenerated, pos, "tabs are not allowed, use spaces instead") inc(pos) of CR, LF: tokenEndPrevious(tok, pos) @@ -1107,7 +1136,7 @@ proc skip(L: var Lexer, tok: var Token) = pos = L.bufpos else: break - tok.strongSpaceA = 0 + tok.spacing.excl(tsLeading) when defined(nimpretty): if L.buf[pos] == '#' and tok.line < 0: commentIndent = indent if L.buf[pos] > ' ' and (L.buf[pos] != '#' or L.buf[pos+1] == '#'): @@ -1146,12 +1175,16 @@ proc skip(L: var Lexer, tok: var Token) = proc rawGetTok*(L: var Lexer, tok: var Token) = template atTokenEnd() {.dirty.} = when defined(nimsuggest): + L.previousTokenEnd.line = L.tokenEnd.line + L.previousTokenEnd.col = L.tokenEnd.col + L.tokenEnd.line = tok.line.uint16 + L.tokenEnd.col = getColNumber(L, L.bufpos).int16 # we attach the cursor to the last *strong* token if tok.tokType notin weakTokens: L.previousToken.line = tok.line.uint16 L.previousToken.col = tok.col.int16 - fillToken(tok) + reset(tok) if L.indentAhead >= 0: tok.indent = L.indentAhead L.currLineIndent = L.indentAhead @@ -1163,13 +1196,18 @@ proc rawGetTok*(L: var Lexer, tok: var Token) = if tok.tokType == tkComment: L.indentAhead = L.currLineIndent return - var c = L.buf[L.bufpos] + let c = L.buf[L.bufpos] tok.line = L.lineNumber tok.col = getColNumber(L, L.bufpos) - if c in SymStartChars - {'r', 'R'}: + if c in SymStartChars - {'r', 'R'} - UnicodeOperatorStartChars: getSymbol(L, tok) else: case c + of UnicodeOperatorStartChars: + if unicodeOprLen(L.buf, L.bufpos)[0] != 0: + getOperator(L, tok) + else: + getSymbol(L, tok) of '#': scanComment(L, tok) of '*': @@ -1277,7 +1315,28 @@ proc rawGetTok*(L: var Lexer, tok: var Token) = getNumber(L, tok) let c = L.buf[L.bufpos] if c in SymChars+{'_'}: - lexMessage(L, errGenerated, "invalid token: no whitespace between number and identifier") + if c in UnicodeOperatorStartChars and + unicodeOprLen(L.buf, L.bufpos)[0] != 0: + discard + else: + lexMessage(L, errGenerated, "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): + # x)-23 # binary minus + # ,-23 # unary minus + # \n-78 # unary minus? Yes. + # =-3 # parsed as `=-` anyway + getNumber(L, tok) + let c = L.buf[L.bufpos] + if c in SymChars+{'_'}: + if c in UnicodeOperatorStartChars and + unicodeOprLen(L.buf, L.bufpos)[0] != 0: + discard + else: + lexMessage(L, errGenerated, "invalid token: no whitespace between number and identifier") + else: + getOperator(L, tok) else: if c in OpChars: getOperator(L, tok) @@ -1293,9 +1352,9 @@ proc rawGetTok*(L: var Lexer, tok: var Token) = proc getIndentWidth*(fileIdx: FileIndex, inputstream: PLLStream; cache: IdentCache; config: ConfigRef): int = - var lex: Lexer - var tok: Token - initToken(tok) + result = 0 + var lex: Lexer = default(Lexer) + var tok: Token = default(Token) openLexer(lex, fileIdx, inputstream, cache, config) var prevToken = tkEof while tok.tokType != tkEof: @@ -1308,11 +1367,11 @@ proc getIndentWidth*(fileIdx: FileIndex, inputstream: PLLStream; proc getPrecedence*(ident: PIdent): int = ## assumes ident is binary operator already - var tok: Token - initToken(tok) - tok.ident = ident - tok.tokType = - if tok.ident.id in ord(tokKeywordLow) - ord(tkSymbol)..ord(tokKeywordHigh) - ord(tkSymbol): - TokType(tok.ident.id + ord(tkSymbol)) - else: tkOpr + let + tokType = + if ident.id in ord(tokKeywordLow) - ord(tkSymbol)..ord(tokKeywordHigh) - ord(tkSymbol): + TokType(ident.id + ord(tkSymbol)) + else: tkOpr + tok = Token(ident: ident, tokType: tokType) + getPrecedence(tok) diff --git a/compiler/liftdestructors.nim b/compiler/liftdestructors.nim index 980e77e4b..9ff5c0a9d 100644 --- a/compiler/liftdestructors.nim +++ b/compiler/liftdestructors.nim @@ -8,13 +8,17 @@ # ## This module implements lifting for type-bound operations -## (``=sink``, ``=``, ``=destroy``, ``=deepCopy``). +## (`=sink`, `=copy`, `=destroy`, `=deepCopy`, `=wasMoved`, `=dup`). import modulegraphs, lineinfos, idents, ast, renderer, semdata, - sighashes, lowerings, options, types, msgs, magicsys, tables + sighashes, lowerings, options, types, msgs, magicsys, ccgutils +import std/tables from trees import isCaseObj +when defined(nimPreviewSlimSystem): + import std/assertions + type TLiftCtx = object g: ModuleGraph @@ -31,11 +35,12 @@ type template destructor*(t: PType): PSym = getAttachedOp(c.g, t, attachedDestructor) template assignment*(t: PType): PSym = getAttachedOp(c.g, t, attachedAsgn) +template dup*(t: PType): PSym = getAttachedOp(c.g, t, attachedDup) template asink*(t: PType): PSym = getAttachedOp(c.g, t, attachedSink) proc fillBody(c: var TLiftCtx; t: PType; body, x, y: PNode) proc produceSym(g: ModuleGraph; c: PContext; typ: PType; kind: TTypeAttachedOp; - info: TLineInfo; idgen: IdGenerator): PSym + info: TLineInfo; idgen: IdGenerator; isDistinct = false): PSym proc createTypeBoundOps*(g: ModuleGraph; c: PContext; orig: PType; info: TLineInfo; idgen: IdGenerator) @@ -46,15 +51,15 @@ proc at(a, i: PNode, elemType: PType): PNode = result[1] = i result.typ = elemType -proc destructorOverriden(g: ModuleGraph; t: PType): bool = +proc destructorOverridden(g: ModuleGraph; t: PType): bool = let op = getAttachedOp(g, t, attachedDestructor) - op != nil and sfOverriden in op.flags + op != nil and sfOverridden in op.flags proc fillBodyTup(c: var TLiftCtx; t: PType; body, x, y: PNode) = - for i in 0..<t.len: + for i, a in t.ikids: let lit = lowerings.newIntLit(c.g, x.info, i) - let b = if c.kind == attachedTrace: y else: y.at(lit, t[i]) - fillBody(c, t[i], body, x.at(lit, t[i]), b) + let b = if c.kind == attachedTrace: y else: y.at(lit, a) + fillBody(c, a, body, x.at(lit, a), b) proc dotField(x: PNode, f: PSym): PNode = result = newNodeI(nkDotExpr, x.info, 2) @@ -79,12 +84,14 @@ proc genBuiltin(c: var TLiftCtx; magic: TMagic; name: string; i: PNode): PNode = result = genBuiltin(c.g, c.idgen, magic, name, i) proc defaultOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = - if c.kind in {attachedAsgn, attachedDeepCopy, attachedSink}: + if c.kind in {attachedAsgn, attachedDeepCopy, attachedSink, attachedDup}: body.add newAsgnStmt(x, y) elif c.kind == attachedDestructor and c.addMemReset: let call = genBuiltin(c, mDefault, "default", x) call.typ = t body.add newAsgnStmt(x, call) + elif c.kind == attachedWasMoved: + body.add genBuiltin(c, mWasMoved, "`=wasMoved`", x) proc genAddr(c: var TLiftCtx; x: PNode): PNode = if x.kind == nkHiddenDeref: @@ -132,27 +139,36 @@ proc genContainerOf(c: var TLiftCtx; objType: PType, field, x: PSym): PNode = result.add minusExpr proc destructorCall(c: var TLiftCtx; op: PSym; x: PNode): PNode = - var destroy = newNodeIT(nkCall, x.info, op.typ[0]) + var destroy = newNodeIT(nkCall, x.info, op.typ.returnType) destroy.add(newSymNode(op)) - destroy.add genAddr(c, x) + if op.typ.firstParamType.kind != tyVar: + destroy.add x + else: + destroy.add genAddr(c, x) if sfNeverRaises notin op.flags: c.canRaise = true if c.addMemReset: - result = newTree(nkStmtList, destroy, genBuiltin(c, mWasMoved, "wasMoved", x)) + result = newTree(nkStmtList, destroy, genBuiltin(c, mWasMoved, "`=wasMoved`", x)) else: result = destroy -proc fillBodyObj(c: var TLiftCtx; n, body, x, y: PNode; enforceDefaultOp: bool) = +proc genWasMovedCall(c: var TLiftCtx; op: PSym; x: PNode): PNode = + result = newNodeIT(nkCall, x.info, op.typ.returnType) + result.add(newSymNode(op)) + result.add genAddr(c, x) + +proc fillBodyObj(c: var TLiftCtx; n, body, x, y: PNode; enforceDefaultOp: bool, enforceWasMoved = false) = case n.kind of nkSym: if c.filterDiscriminator != nil: return let f = n.sym let b = if c.kind == attachedTrace: y else: y.dotField(f) - if (sfCursor in f.flags and f.typ.skipTypes(abstractInst).kind in {tyRef, tyProc} and - c.g.config.selectedGC in {gcArc, gcOrc, gcHooks}) or + if (sfCursor in f.flags and c.g.config.selectedGC in {gcArc, gcAtomicArc, gcOrc, gcHooks}) or enforceDefaultOp: defaultOp(c, f.typ, body, x.dotField(f), b) else: + if enforceWasMoved: + body.add genBuiltin(c, mWasMoved, "`=wasMoved`", x.dotField(f)) fillBody(c, f.typ, body, x.dotField(f), b) of nkNilLit: discard of nkRecCase: @@ -162,9 +178,12 @@ proc fillBodyObj(c: var TLiftCtx; n, body, x, y: PNode; enforceDefaultOp: bool) # the value needs to be destroyed before we assign the selector # or the value is lost let prevKind = c.kind + let prevAddMemReset = c.addMemReset c.kind = attachedDestructor + c.addMemReset = true fillBodyObj(c, n, body, x, y, enforceDefaultOp = false) c.kind = prevKind + c.addMemReset = prevAddMemReset localEnforceDefaultOp = true if c.kind != attachedDestructor: @@ -188,7 +207,7 @@ proc fillBodyObj(c: var TLiftCtx; n, body, x, y: PNode; enforceDefaultOp: bool) branch[^1] = newNodeI(nkStmtList, c.info) fillBodyObj(c, n[i].lastSon, branch[^1], x, y, - enforceDefaultOp = localEnforceDefaultOp) + enforceDefaultOp = localEnforceDefaultOp, enforceWasMoved = c.kind == attachedAsgn) if branch[^1].len == 0: inc emptyBranches caseStmt.add(branch) if emptyBranches != n.len-1: @@ -199,20 +218,29 @@ proc fillBodyObj(c: var TLiftCtx; n, body, x, y: PNode; enforceDefaultOp: bool) fillBodyObj(c, n[0], body, x, y, enforceDefaultOp = false) c.filterDiscriminator = oldfilterDiscriminator of nkRecList: - for t in items(n): fillBodyObj(c, t, body, x, y, enforceDefaultOp) + for t in items(n): fillBodyObj(c, t, body, x, y, enforceDefaultOp, enforceWasMoved) else: illFormedAstLocal(n, c.g.config) proc fillBodyObjTImpl(c: var TLiftCtx; t: PType, body, x, y: PNode) = - if t.len > 0 and t[0] != nil: - fillBody(c, skipTypes(t[0], abstractPtrs), body, x, y) + if t.baseClass != nil: + let dest = newNodeIT(nkHiddenSubConv, c.info, t.baseClass) + dest.add newNodeI(nkEmpty, c.info) + dest.add x + var src = y + if c.kind in {attachedAsgn, attachedDeepCopy, attachedSink}: + src = newNodeIT(nkHiddenSubConv, c.info, t.baseClass) + src.add newNodeI(nkEmpty, c.info) + src.add y + + fillBody(c, skipTypes(t.baseClass, abstractPtrs), body, dest, src) fillBodyObj(c, t.n, body, x, y, enforceDefaultOp = false) proc fillBodyObjT(c: var TLiftCtx; t: PType, body, x, y: PNode) = var hasCase = isCaseObj(t.n) var obj = t - while obj.len > 0 and obj[0] != nil: - obj = skipTypes(obj[0], abstractPtrs) + while obj.baseClass != nil: + obj = skipTypes(obj.baseClass, abstractPtrs) hasCase = hasCase or isCaseObj(obj.n) if hasCase and c.kind in {attachedAsgn, attachedDeepCopy}: @@ -230,7 +258,16 @@ proc fillBodyObjT(c: var TLiftCtx; t: PType, body, x, y: PNode) = # for every field (dependent on dest.kind): # `=` dest.field, src.field # =destroy(blob) - var temp = newSym(skTemp, getIdent(c.g.cache, lowerings.genPrefix), nextSymId c.idgen, c.fn, c.info) + var dummy = newSym(skTemp, getIdent(c.g.cache, lowerings.genPrefix), c.idgen, c.fn, c.info) + dummy.typ = y.typ + if ccgIntroducedPtr(c.g.config, dummy, y.typ): + # Because of potential aliasing when the src param is passed by ref, we need to check for equality here, + # because the wasMoved(dest) call would zero out src, if dest aliases src. + var cond = newTree(nkCall, newSymNode(c.g.getSysMagic(c.info, "==", mEqRef)), + newTreeIT(nkAddr, c.info, makePtrType(c.fn, x.typ, c.idgen), x), newTreeIT(nkAddr, c.info, makePtrType(c.fn, y.typ, c.idgen), y)) + cond.typ = getSysType(c.g, x.info, tyBool) + body.add genIf(c, cond, newTreeI(nkReturnStmt, c.info, newNodeI(nkEmpty, c.info))) + var temp = newSym(skTemp, getIdent(c.g.cache, lowerings.genPrefix), c.idgen, c.fn, c.info) temp.typ = x.typ incl(temp.flags, sfFromGeneric) var v = newNodeI(nkVarSection, c.info) @@ -240,7 +277,7 @@ proc fillBodyObjT(c: var TLiftCtx; t: PType, body, x, y: PNode) = #body.add newAsgnStmt(blob, x) var wasMovedCall = newNodeI(nkCall, c.info) - wasMovedCall.add(newSymNode(createMagic(c.g, c.idgen, "wasMoved", mWasMoved))) + wasMovedCall.add(newSymNode(createMagic(c.g, c.idgen, "`=wasMoved`", mWasMoved))) wasMovedCall.add x # mWasMoved does not take the address body.add wasMovedCall @@ -253,6 +290,7 @@ proc fillBodyObjT(c: var TLiftCtx; t: PType, body, x, y: PNode) = c.kind = attachedDestructor fillBodyObjTImpl(c, t, body, blob, y) c.kind = prevKind + else: fillBodyObjTImpl(c, t, body, x, y) @@ -261,8 +299,8 @@ proc boolLit*(g: ModuleGraph; info: TLineInfo; value: bool): PNode = result.typ = getSysType(g, info, tyBool) proc getCycleParam(c: TLiftCtx): PNode = - assert c.kind == attachedAsgn - if c.fn.typ.len == 4: + assert c.kind in {attachedAsgn, attachedDup} + if c.fn.typ.len == 3 + ord(c.kind == attachedAsgn): result = c.fn.typ.n.lastSon assert result.kind == nkSym assert result.sym.name.s == "cyclic" @@ -276,30 +314,41 @@ proc newHookCall(c: var TLiftCtx; op: PSym; x, y: PNode): PNode = result.add newSymNode(op) if sfNeverRaises notin op.flags: c.canRaise = true - if op.typ.sons[1].kind == tyVar: + if op.typ.firstParamType.kind == tyVar: result.add genAddr(c, x) else: result.add x if y != nil: result.add y - if op.typ.len == 4: + if op.typ.signatureLen == 4: assert y != nil - if c.fn.typ.len == 4: + if c.fn.typ.signatureLen == 4: result.add getCycleParam(c) else: # assume the worst: A cycle is created: result.add boolLit(c.g, y.info, true) proc newOpCall(c: var TLiftCtx; op: PSym; x: PNode): PNode = - result = newNodeIT(nkCall, x.info, op.typ[0]) + result = newNodeIT(nkCall, x.info, op.typ.returnType) result.add(newSymNode(op)) result.add x if sfNeverRaises notin op.flags: c.canRaise = true + if c.kind == attachedDup and op.typ.len == 3: + assert x != nil + if c.fn.typ.len == 3: + result.add getCycleParam(c) + else: + # assume the worst: A cycle is created: + result.add boolLit(c.g, x.info, true) + proc newDeepCopyCall(c: var TLiftCtx; op: PSym; x, y: PNode): PNode = result = newAsgnStmt(x, newOpCall(c, op, y)) +proc newDupCall(c: var TLiftCtx; op: PSym; x, y: PNode): PNode = + result = newAsgnStmt(x, newOpCall(c, op, y)) + proc usesBuiltinArc(t: PType): bool = proc wrap(t: PType): bool {.nimcall.} = ast.isGCedMem(t) result = types.searchTypeFor(t, wrap) @@ -324,9 +373,9 @@ proc considerAsgnOrSink(c: var TLiftCtx; t: PType; body, x, y: PNode; field: var PSym): bool = if optSeqDestructors in c.g.config.globalOptions: var op = field - let destructorOverriden = destructorOverriden(c.g, t) + let destructorOverridden = destructorOverridden(c.g, t) if op != nil and op != c.fn and - (sfOverriden in op.flags or destructorOverriden): + (sfOverridden in op.flags or destructorOverridden): if sfError in op.flags: incl c.fn.flags, sfError #else: @@ -334,10 +383,12 @@ proc considerAsgnOrSink(c: var TLiftCtx; t: PType; body, x, y: PNode; onUse(c.info, op) body.add newHookCall(c, op, x, y) result = true - elif op == nil and destructorOverriden: + elif op == nil and destructorOverridden: op = produceSym(c.g, c.c, t, c.kind, c.info, c.idgen) body.add newHookCall(c, op, x, y) result = true + else: + result = false elif tfHasAsgn in t.flags: var op: PSym if sameType(t, c.asgnForType): @@ -367,12 +418,14 @@ proc considerAsgnOrSink(c: var TLiftCtx; t: PType; body, x, y: PNode; assert op.ast[genericParamsPos].kind == nkEmpty body.add newHookCall(c, op, x, y) result = true + else: + result = false proc addDestructorCall(c: var TLiftCtx; orig: PType; body, x: PNode) = let t = orig.skipTypes(abstractInst - {tyDistinct}) var op = t.destructor - if op != nil and sfOverriden in op.flags: + if op != nil and sfOverridden in op.flags: if op.ast.isGenericRoutine: # patch generic destructor: op = instantiateGeneric(c, op, t, t.typeInst) @@ -395,7 +448,7 @@ proc considerUserDefinedOp(c: var TLiftCtx; t: PType; body, x, y: PNode): bool = case c.kind of attachedDestructor: var op = t.destructor - if op != nil and sfOverriden in op.flags: + if op != nil and sfOverridden in op.flags: if op.ast.isGenericRoutine: # patch generic destructor: @@ -406,17 +459,21 @@ proc considerUserDefinedOp(c: var TLiftCtx; t: PType; body, x, y: PNode): bool = onUse(c.info, op) body.add destructorCall(c, op, x) result = true + else: + result = false #result = addDestructorCall(c, t, body, x) of attachedAsgn, attachedSink, attachedTrace: var op = getAttachedOp(c.g, t, c.kind) + if op != nil and sfOverridden in op.flags: + if op.ast.isGenericRoutine: + # patch generic =trace: + op = instantiateGeneric(c, op, t, t.typeInst) + setAttachedOp(c.g, c.idgen.module, t, c.kind, op) + result = considerAsgnOrSink(c, t, body, x, y, op) if op != nil: setAttachedOp(c.g, c.idgen.module, t, c.kind, op) - of attachedDispose: - var op = getAttachedOp(c.g, t, c.kind) - result = considerAsgnOrSink(c, t, body, x, nil, op) - if op != nil: - setAttachedOp(c.g, c.idgen.module, t, c.kind, op) + of attachedDeepCopy: let op = getAttachedOp(c.g, t, attachedDeepCopy) if op != nil: @@ -424,9 +481,43 @@ proc considerUserDefinedOp(c: var TLiftCtx; t: PType; body, x, y: PNode): bool = onUse(c.info, op) body.add newDeepCopyCall(c, op, x, y) result = true + else: + result = false + + of attachedWasMoved: + var op = getAttachedOp(c.g, t, attachedWasMoved) + if op != nil and sfOverridden in op.flags: + + if op.ast.isGenericRoutine: + # patch generic destructor: + op = instantiateGeneric(c, op, t, t.typeInst) + setAttachedOp(c.g, c.idgen.module, t, attachedWasMoved, op) + + #markUsed(c.g.config, c.info, op, c.g.usageSym) + onUse(c.info, op) + body.add genWasMovedCall(c, op, x) + result = true + else: + result = false + + of attachedDup: + var op = getAttachedOp(c.g, t, attachedDup) + if op != nil and sfOverridden in op.flags: + + if op.ast.isGenericRoutine: + # patch generic destructor: + op = instantiateGeneric(c, op, t, t.typeInst) + setAttachedOp(c.g, c.idgen.module, t, attachedDup, op) + + #markUsed(c.g.config, c.info, op, c.g.usageSym) + onUse(c.info, op) + body.add newDupCall(c, op, x, y) + result = true + else: + result = false proc declareCounter(c: var TLiftCtx; body: PNode; first: BiggestInt): PNode = - var temp = newSym(skTemp, getIdent(c.g.cache, lowerings.genPrefix), nextSymId(c.idgen), c.fn, c.info) + var temp = newSym(skTemp, getIdent(c.g.cache, lowerings.genPrefix), c.idgen, c.fn, c.info) temp.typ = getSysType(c.g, body.info, tyInt) incl(temp.flags, sfFromGeneric) @@ -436,7 +527,7 @@ proc declareCounter(c: var TLiftCtx; body: PNode; first: BiggestInt): PNode = body.add v proc declareTempOf(c: var TLiftCtx; body: PNode; value: PNode): PNode = - var temp = newSym(skTemp, getIdent(c.g.cache, lowerings.genPrefix), nextSymId(c.idgen), c.fn, c.info) + var temp = newSym(skTemp, getIdent(c.g.cache, lowerings.genPrefix), c.idgen, c.fn, c.info) temp.typ = value.typ incl(temp.flags, sfFromGeneric) @@ -471,22 +562,40 @@ proc setLenSeqCall(c: var TLiftCtx; t: PType; x, y: PNode): PNode = result = newTree(nkCall, newSymNode(op, x.info), x, lenCall) proc forallElements(c: var TLiftCtx; t: PType; body, x, y: PNode) = + let counterIdx = body.len let i = declareCounter(c, body, toInt64(firstOrd(c.g.config, t))) let whileLoop = genWhileLoop(c, i, x) - let elemType = t.lastSon + let elemType = t.elementType let b = if c.kind == attachedTrace: y else: y.at(i, elemType) fillBody(c, elemType, whileLoop[1], x.at(i, elemType), b) - addIncStmt(c, whileLoop[1], i) - body.add whileLoop + if whileLoop[1].len > 0: + addIncStmt(c, whileLoop[1], i) + body.add whileLoop + else: + body.sons.setLen counterIdx + +proc checkSelfAssignment(c: var TLiftCtx; t: PType; body, x, y: PNode) = + var cond = callCodegenProc(c.g, "sameSeqPayload", c.info, + newTreeIT(nkAddr, c.info, makePtrType(c.fn, x.typ, c.idgen), x), + newTreeIT(nkAddr, c.info, makePtrType(c.fn, y.typ, c.idgen), y) + ) + cond.typ = getSysType(c.g, c.info, tyBool) + body.add genIf(c, cond, newTreeI(nkReturnStmt, c.info, newNodeI(nkEmpty, c.info))) proc fillSeqOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = case c.kind + of attachedDup: + body.add setLenSeqCall(c, t, x, y) + forallElements(c, t, body, x, y) of attachedAsgn, attachedDeepCopy: # we generate: + # if x.p == y.p: + # return # setLen(dest, y.len) # var i = 0 # while i < y.len: dest[i] = y[i]; inc(i) # This is usually more efficient than a destroy/create pair. + checkSelfAssignment(c, t, body, x, y) body.add setLenSeqCall(c, t, x, y) forallElements(c, t, body, x, y) of attachedSink: @@ -500,19 +609,18 @@ proc fillSeqOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = forallElements(c, t, body, x, y) body.add genBuiltin(c, mDestroy, "destroy", x) of attachedTrace: - # follow all elements: - forallElements(c, t, body, x, y) - of attachedDispose: - forallElements(c, t, body, x, y) - body.add genBuiltin(c, mDestroy, "destroy", x) + if canFormAcycle(c.g, t.elemType): + # follow all elements: + forallElements(c, t, body, x, y) + of attachedWasMoved: body.add genBuiltin(c, mWasMoved, "`=wasMoved`", x) proc useSeqOrStrOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = createTypeBoundOps(c.g, c.c, t, body.info, c.idgen) # recursions are tricky, so we might need to forward the generated # operation here: var t = t - if t.assignment == nil or t.destructor == nil: - let h = sighashes.hashType(t, {CoType, CoConsiderOwned, CoDistinct}) + if t.assignment == nil or t.destructor == nil or t.dup == nil: + let h = sighashes.hashType(t,c.g.config, {CoType, CoConsiderOwned, CoDistinct}) let canon = c.g.canonTypes.getOrDefault(h) if canon != nil: t = canon @@ -537,19 +645,22 @@ proc useSeqOrStrOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = doAssert t.destructor != nil body.add destructorCall(c, t.destructor, x) of attachedTrace: + if t.kind != tyString and canFormAcycle(c.g, t.elemType): + let op = getAttachedOp(c.g, t, c.kind) + if op == nil: + return # protect from recursion + body.add newHookCall(c, op, x, y) + of attachedWasMoved: body.add genBuiltin(c, mWasMoved, "`=wasMoved`", x) + of attachedDup: + # XXX: replace these with assertions. let op = getAttachedOp(c.g, t, c.kind) if op == nil: return # protect from recursion - body.add newHookCall(c, op, x, y) - of attachedDispose: - let op = getAttachedOp(c.g, t, c.kind) - if op == nil: - return # protect from recursion - body.add newHookCall(c, op, x, nil) + body.add newDupCall(c, op, x, y) proc fillStrOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = case c.kind - of attachedAsgn, attachedDeepCopy: + of attachedAsgn, attachedDeepCopy, attachedDup: body.add callCodegenProc(c.g, "nimAsgnStrV2", c.info, genAddr(c, x), y) of attachedSink: let moveCall = genBuiltin(c, mMove, "move", x) @@ -557,14 +668,15 @@ proc fillStrOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = doAssert t.destructor != nil moveCall.add destructorCall(c, t.destructor, x) body.add moveCall - of attachedDestructor, attachedDispose: + of attachedDestructor: body.add genBuiltin(c, mDestroy, "destroy", x) of attachedTrace: discard "strings are atomic and have no inner elements that are to trace" + of attachedWasMoved: body.add genBuiltin(c, mWasMoved, "`=wasMoved`", x) -proc cyclicType*(t: PType): bool = +proc cyclicType*(g: ModuleGraph, t: PType): bool = case t.kind - of tyRef: result = types.canFormAcycle(t.lastSon) + of tyRef: result = types.canFormAcycle(g, t.elementType) of tyProc: result = t.callConv == ccClosure else: result = false @@ -589,13 +701,18 @@ proc atomicRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = ]# var actions = newNodeI(nkStmtList, c.info) - let elemType = t.lastSon + let elemType = t.elementType createTypeBoundOps(c.g, c.c, elemType, c.info, c.idgen) - let isCyclic = c.g.config.selectedGC == gcOrc and types.canFormAcycle(elemType) + let isCyclic = c.g.config.selectedGC == gcOrc and types.canFormAcycle(c.g, elemType) + + let isInheritableAcyclicRef = c.g.config.selectedGC == gcOrc and + (not isPureObject(elemType)) and + tfAcyclic in skipTypes(elemType, abstractInst+{tyOwned}-{tyTypeDesc}).flags + # dynamic Acyclic refs need to use dyn decRef let tmp = - if isCyclic and c.kind in {attachedAsgn, attachedSink}: + if isCyclic and c.kind in {attachedAsgn, attachedSink, attachedDup}: declareTempOf(c, body, x) else: x @@ -617,6 +734,8 @@ proc atomicRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = cond = callCodegenProc(c.g, "nimDecRefIsLastCyclicStatic", c.info, tmp, typInfo) else: cond = callCodegenProc(c.g, "nimDecRefIsLastCyclicDyn", c.info, tmp) + elif isInheritableAcyclicRef: + cond = callCodegenProc(c.g, "nimDecRefIsLastDyn", c.info, x) else: cond = callCodegenProc(c.g, "nimDecRefIsLast", c.info, x) cond.typ = getSysType(c.g, x.info, tyBool) @@ -643,21 +762,25 @@ proc atomicRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = body.add genIf(c, cond, actions) of attachedDeepCopy: assert(false, "cannot happen") of attachedTrace: - if isFinal(elemType): - let typInfo = genBuiltin(c, mGetTypeInfoV2, "getTypeInfoV2", newNodeIT(nkType, x.info, elemType)) - typInfo.typ = getSysType(c.g, c.info, tyPointer) - body.add callCodegenProc(c.g, "nimTraceRef", c.info, genAddrOf(x, c.idgen), typInfo, y) + if isCyclic: + if isFinal(elemType): + let typInfo = genBuiltin(c, mGetTypeInfoV2, "getTypeInfoV2", newNodeIT(nkType, x.info, elemType)) + typInfo.typ = getSysType(c.g, c.info, tyPointer) + body.add callCodegenProc(c.g, "nimTraceRef", c.info, genAddrOf(x, c.idgen), typInfo, y) + else: + # If the ref is polymorphic we have to account for this + body.add callCodegenProc(c.g, "nimTraceRefDyn", c.info, genAddrOf(x, c.idgen), y) + #echo "can follow ", elemType, " static ", isFinal(elemType) + of attachedWasMoved: body.add genBuiltin(c, mWasMoved, "`=wasMoved`", x) + of attachedDup: + if isCyclic: + body.add newAsgnStmt(x, y) + body.add genIf(c, y, callCodegenProc(c.g, + "nimIncRefCyclic", c.info, y, getCycleParam(c))) else: - # If the ref is polymorphic we have to account for this - body.add callCodegenProc(c.g, "nimTraceRefDyn", c.info, genAddrOf(x, c.idgen), y) - of attachedDispose: - # this is crucial! dispose is like =destroy but we don't follow refs - # as that is dealt within the cycle collector. - when false: - let cond = copyTree(x) - cond.typ = getSysType(c.g, x.info, tyBool) - actions.add callCodegenProc(c.g, "nimRawDispose", c.info, x) - body.add genIf(c, cond, actions) + body.add newAsgnStmt(x, y) + body.add genIf(c, y, callCodegenProc(c.g, + "nimIncRef", c.info, y)) proc atomicClosureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = ## Closures are really like refs except they always use a virtual destructor @@ -667,7 +790,7 @@ proc atomicClosureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = let isCyclic = c.g.config.selectedGC == gcOrc let tmp = - if isCyclic and c.kind in {attachedAsgn, attachedSink}: + if isCyclic and c.kind in {attachedAsgn, attachedSink, attachedDup}: declareTempOf(c, body, xenv) else: xenv @@ -701,19 +824,21 @@ proc atomicClosureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = body.add genIf(c, cond, actions) body.add newAsgnStmt(x, y) + of attachedDup: + let yenv = genBuiltin(c, mAccessEnv, "accessEnv", y) + yenv.typ = getSysType(c.g, c.info, tyPointer) + if isCyclic: + body.add newAsgnStmt(x, y) + body.add genIf(c, yenv, callCodegenProc(c.g, "nimIncRefCyclic", c.info, yenv, getCycleParam(c))) + else: + body.add newAsgnStmt(x, y) + body.add genIf(c, yenv, callCodegenProc(c.g, "nimIncRef", c.info, yenv)) of attachedDestructor: body.add genIf(c, cond, actions) of attachedDeepCopy: assert(false, "cannot happen") of attachedTrace: body.add callCodegenProc(c.g, "nimTraceRefDyn", c.info, genAddrOf(xenv, c.idgen), y) - of attachedDispose: - # this is crucial! dispose is like =destroy but we don't follow refs - # as that is dealt within the cycle collector. - when false: - let cond = copyTree(xenv) - cond.typ = getSysType(c.g, xenv.info, tyBool) - actions.add callCodegenProc(c.g, "nimRawDispose", c.info, xenv) - body.add genIf(c, cond, actions) + of attachedWasMoved: body.add genBuiltin(c, mWasMoved, "`=wasMoved`", x) proc weakrefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = case c.kind @@ -726,6 +851,9 @@ proc weakrefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = body.add genIf(c, y, callCodegenProc(c.g, "nimIncRef", c.info, y)) body.add genIf(c, x, callCodegenProc(c.g, "nimDecWeakRef", c.info, x)) body.add newAsgnStmt(x, y) + of attachedDup: + body.add newAsgnStmt(x, y) + body.add genIf(c, y, callCodegenProc(c.g, "nimIncRef", c.info, y)) of attachedDestructor: # it's better to prepend the destruction of weak refs in order to # prevent wrong "dangling refs exist" problems: @@ -737,12 +865,13 @@ proc weakrefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = else: body.sons.insert(des, 0) of attachedDeepCopy: assert(false, "cannot happen") - of attachedTrace, attachedDispose: discard + of attachedTrace: discard + of attachedWasMoved: body.add genBuiltin(c, mWasMoved, "`=wasMoved`", x) proc ownedRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = var actions = newNodeI(nkStmtList, c.info) - let elemType = t.lastSon + let elemType = t.skipModifier #fillBody(c, elemType, actions, genDeref(x), genDeref(y)) #var disposeCall = genBuiltin(c, mDispose, "dispose", x) @@ -759,10 +888,13 @@ proc ownedRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = of attachedSink, attachedAsgn: body.add genIf(c, x, actions) body.add newAsgnStmt(x, y) + of attachedDup: + body.add newAsgnStmt(x, y) of attachedDestructor: body.add genIf(c, x, actions) of attachedDeepCopy: assert(false, "cannot happen") - of attachedTrace, attachedDispose: discard + of attachedTrace: discard + of attachedWasMoved: body.add genBuiltin(c, mWasMoved, "`=wasMoved`", x) proc closureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = if c.kind == attachedDeepCopy: @@ -774,7 +906,7 @@ proc closureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = call[1] = y body.add newAsgnStmt(x, call) elif (optOwnedRefs in c.g.config.globalOptions and - optRefCheck in c.g.config.options) or c.g.config.selectedGC in {gcArc, gcOrc}: + optRefCheck in c.g.config.options) or c.g.config.selectedGC in {gcArc, gcAtomicArc, gcOrc}: let xx = genBuiltin(c, mAccessEnv, "accessEnv", x) xx.typ = getSysType(c.g, c.info, tyPointer) case c.kind @@ -789,6 +921,11 @@ proc closureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = body.add genIf(c, yy, callCodegenProc(c.g, "nimIncRef", c.info, yy)) body.add genIf(c, xx, callCodegenProc(c.g, "nimDecWeakRef", c.info, xx)) body.add newAsgnStmt(x, y) + of attachedDup: + let yy = genBuiltin(c, mAccessEnv, "accessEnv", y) + yy.typ = getSysType(c.g, c.info, tyPointer) + body.add newAsgnStmt(x, y) + body.add genIf(c, yy, callCodegenProc(c.g, "nimIncRef", c.info, yy)) of attachedDestructor: let des = genIf(c, xx, callCodegenProc(c.g, "nimDecWeakRef", c.info, xx)) if body.len == 0: @@ -796,7 +933,8 @@ proc closureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = else: body.sons.insert(des, 0) of attachedDeepCopy: assert(false, "cannot happen") - of attachedTrace, attachedDispose: discard + of attachedTrace: discard + of attachedWasMoved: body.add genBuiltin(c, mWasMoved, "`=wasMoved`", x) proc ownedClosureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = let xx = genBuiltin(c, mAccessEnv, "accessEnv", x) @@ -808,19 +946,22 @@ proc ownedClosureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = of attachedSink, attachedAsgn: body.add genIf(c, xx, actions) body.add newAsgnStmt(x, y) + of attachedDup: + body.add newAsgnStmt(x, y) of attachedDestructor: body.add genIf(c, xx, actions) of attachedDeepCopy: assert(false, "cannot happen") - of attachedTrace, attachedDispose: discard + of attachedTrace: discard + of attachedWasMoved: body.add genBuiltin(c, mWasMoved, "`=wasMoved`", x) proc fillBody(c: var TLiftCtx; t: PType; body, x, y: PNode) = case t.kind of tyNone, tyEmpty, tyVoid: discard - of tyPointer, tySet, tyBool, tyChar, tyEnum, tyInt..tyUInt64, tyCString, + of tyPointer, tySet, tyBool, tyChar, tyEnum, tyInt..tyUInt64, tyCstring, tyPtr, tyUncheckedArray, tyVar, tyLent: defaultOp(c, t, body, x, y) of tyRef: - if c.g.config.selectedGC in {gcArc, gcOrc}: + if c.g.config.selectedGC in {gcArc, gcOrc, gcAtomicArc}: atomicRefOp(c, t, body, x, y) elif (optOwnedRefs in c.g.config.globalOptions and optRefCheck in c.g.config.options): @@ -829,7 +970,7 @@ proc fillBody(c: var TLiftCtx; t: PType; body, x, y: PNode) = defaultOp(c, t, body, x, y) of tyProc: if t.callConv == ccClosure: - if c.g.config.selectedGC in {gcArc, gcOrc}: + if c.g.config.selectedGC in {gcArc, gcOrc, gcAtomicArc}: atomicClosureOp(c, t, body, x, y) else: closureOp(c, t, body, x, y) @@ -875,13 +1016,28 @@ proc fillBody(c: var TLiftCtx; t: PType; body, x, y: PNode) = defaultOp(c, t, body, x, y) of tyObject: if not considerUserDefinedOp(c, t, body, x, y): - if c.kind in {attachedAsgn, attachedSink} and t.sym != nil and sfImportc in t.sym.flags: - body.add newAsgnStmt(x, y) + if t.sym != nil and sfImportc in t.sym.flags: + case c.kind + of {attachedAsgn, attachedSink, attachedDup}: + body.add newAsgnStmt(x, y) + of attachedWasMoved: + body.add genBuiltin(c, mWasMoved, "`=wasMoved`", x) + else: + fillBodyObjT(c, t, body, x, y) else: - fillBodyObjT(c, t, body, x, y) + if c.kind == attachedDup: + var op2 = getAttachedOp(c.g, t, attachedAsgn) + if op2 != nil and sfOverridden in op2.flags: + #markUsed(c.g.config, c.info, op, c.g.usageSym) + onUse(c.info, op2) + body.add newHookCall(c, t.assignment, x, y) + else: + fillBodyObjT(c, t, body, x, y) + else: + fillBodyObjT(c, t, body, x, y) of tyDistinct: if not considerUserDefinedOp(c, t, body, x, y): - fillBody(c, t[0], body, x, y) + fillBody(c, t.elementType, body, x, y) of tyTuple: fillBodyTup(c, t, body, x, y) of tyVarargs, tyOpenArray: @@ -890,7 +1046,7 @@ proc fillBody(c: var TLiftCtx; t: PType; body, x, y: PNode) = else: discard "cannot copy openArray" - of tyFromExpr, tyProxy, tyBuiltInTypeClass, tyUserTypeClass, + of tyFromExpr, tyError, tyBuiltInTypeClass, tyUserTypeClass, tyUserTypeClassInst, tyCompositeTypeClass, tyAnd, tyOr, tyNot, tyAnything, tyGenericParam, tyGenericBody, tyNil, tyUntyped, tyTyped, tyTypeDesc, tyGenericInvocation, tyForward, tyStatic: @@ -898,42 +1054,86 @@ proc fillBody(c: var TLiftCtx; t: PType; body, x, y: PNode) = discard of tyOrdinal, tyRange, tyInferred, tyGenericInst, tyAlias, tySink: - fillBody(c, lastSon(t), body, x, y) - of tyConcept: doAssert false + fillBody(c, skipModifier(t), body, x, y) + of tyConcept, tyIterable: raiseAssert "unreachable" proc produceSymDistinctType(g: ModuleGraph; c: PContext; typ: PType; kind: TTypeAttachedOp; info: TLineInfo; idgen: IdGenerator): PSym = assert typ.kind == tyDistinct - let baseType = typ[0] + let baseType = typ.elementType if getAttachedOp(g, baseType, kind) == nil: - discard produceSym(g, c, baseType, kind, info, idgen) + # TODO: fixme `isDistinct` is a fix for #23552; remove it after + # `-d:nimPreviewNonVarDestructor` becomes the default + discard produceSym(g, c, baseType, kind, info, idgen, isDistinct = true) result = getAttachedOp(g, baseType, kind) setAttachedOp(g, idgen.module, typ, kind, result) -proc symPrototype(g: ModuleGraph; typ: PType; owner: PSym; kind: TTypeAttachedOp; +proc symDupPrototype(g: ModuleGraph; typ: PType; owner: PSym; kind: TTypeAttachedOp; info: TLineInfo; idgen: IdGenerator): PSym = + let procname = getIdent(g.cache, AttachedOpToStr[kind]) + result = newSym(skProc, procname, idgen, owner, info) + let res = newSym(skResult, getIdent(g.cache, "result"), idgen, result, info) + let src = newSym(skParam, getIdent(g.cache, "src"), + idgen, result, info) + res.typ = typ + src.typ = typ + + result.typ = newType(tyProc, idgen, owner) + result.typ.n = newNodeI(nkFormalParams, info) + rawAddSon(result.typ, res.typ) + result.typ.n.add newNodeI(nkEffectList, info) + + result.typ.addParam src + + if g.config.selectedGC == gcOrc and + cyclicType(g, typ.skipTypes(abstractInst)): + let cycleParam = newSym(skParam, getIdent(g.cache, "cyclic"), + idgen, result, info) + cycleParam.typ = getSysType(g, info, tyBool) + result.typ.addParam cycleParam + + var n = newNodeI(nkProcDef, info, bodyPos+2) + for i in 0..<n.len: n[i] = newNodeI(nkEmpty, info) + n[namePos] = newSymNode(result) + n[paramsPos] = result.typ.n + n[bodyPos] = newNodeI(nkStmtList, info) + n[resultPos] = newSymNode(res) + result.ast = n + incl result.flags, sfFromGeneric + incl result.flags, sfGeneratedOp + +proc symPrototype(g: ModuleGraph; typ: PType; owner: PSym; kind: TTypeAttachedOp; + info: TLineInfo; idgen: IdGenerator; isDiscriminant = false; isDistinct = false): PSym = + if kind == attachedDup: + return symDupPrototype(g, typ, owner, kind, info, idgen) let procname = getIdent(g.cache, AttachedOpToStr[kind]) - result = newSym(skProc, procname, nextSymId(idgen), owner, info) - let dest = newSym(skParam, getIdent(g.cache, "dest"), nextSymId(idgen), result, info) + result = newSym(skProc, procname, idgen, owner, info) + let dest = newSym(skParam, getIdent(g.cache, "dest"), idgen, result, info) let src = newSym(skParam, getIdent(g.cache, if kind == attachedTrace: "env" else: "src"), - nextSymId(idgen), result, info) - dest.typ = makeVarType(typ.owner, typ, idgen) + idgen, result, info) + + if kind == attachedDestructor and g.config.selectedGC in {gcArc, gcOrc, gcAtomicArc} and + ((g.config.isDefined("nimPreviewNonVarDestructor") and not isDiscriminant) or (typ.kind in {tyRef, tyString, tySequence} and not isDistinct)): + dest.typ = typ + else: + dest.typ = makeVarType(typ.owner, typ, idgen) + if kind == attachedTrace: src.typ = getSysType(g, info, tyPointer) else: src.typ = typ - result.typ = newProcType(info, nextTypeId(idgen), owner) + result.typ = newProcType(info, idgen, owner) result.typ.addParam dest - if kind notin {attachedDestructor, attachedDispose}: + if kind notin {attachedDestructor, attachedWasMoved}: result.typ.addParam src if kind == attachedAsgn and g.config.selectedGC == gcOrc and - cyclicType(typ.skipTypes(abstractInst)): + cyclicType(g, typ.skipTypes(abstractInst)): let cycleParam = newSym(skParam, getIdent(g.cache, "cyclic"), - nextSymId(idgen), result, info) + idgen, result, info) cycleParam.typ = getSysType(g, info, tyBool) result.typ.addParam cycleParam @@ -945,36 +1145,48 @@ proc symPrototype(g: ModuleGraph; typ: PType; owner: PSym; kind: TTypeAttachedOp result.ast = n incl result.flags, sfFromGeneric incl result.flags, sfGeneratedOp + if kind == attachedWasMoved: + incl result.flags, sfNoSideEffect + incl result.typ.flags, tfNoSideEffect +proc genTypeFieldCopy(c: var TLiftCtx; t: PType; body, x, y: PNode) = + let xx = genBuiltin(c, mAccessTypeField, "accessTypeField", x) + let yy = genBuiltin(c, mAccessTypeField, "accessTypeField", y) + xx.typ = getSysType(c.g, c.info, tyPointer) + yy.typ = xx.typ + body.add newAsgnStmt(xx, yy) proc produceSym(g: ModuleGraph; c: PContext; typ: PType; kind: TTypeAttachedOp; - info: TLineInfo; idgen: IdGenerator): PSym = + info: TLineInfo; idgen: IdGenerator; isDistinct = false): PSym = if typ.kind == tyDistinct: return produceSymDistinctType(g, c, typ, kind, info, idgen) result = getAttachedOp(g, typ, kind) if result == nil: - result = symPrototype(g, typ, typ.owner, kind, info, idgen) + result = symPrototype(g, typ, typ.owner, kind, info, idgen, isDistinct = isDistinct) var a = TLiftCtx(info: info, g: g, kind: kind, c: c, asgnForType: typ, idgen: idgen, fn: result) - let dest = result.typ.n[1].sym - let d = newDeref(newSymNode(dest)) - let src = if kind in {attachedDestructor, attachedDispose}: newNodeIT(nkSym, info, getSysType(g, info, tyPointer)) + let dest = if kind == attachedDup: result.ast[resultPos].sym else: result.typ.n[1].sym + let d = if result.typ.firstParamType.kind == tyVar: newDeref(newSymNode(dest)) else: newSymNode(dest) + let src = case kind + of {attachedDestructor, attachedWasMoved}: newNodeIT(nkSym, info, getSysType(g, info, tyPointer)) + of attachedDup: newSymNode(result.typ.n[1].sym) else: newSymNode(result.typ.n[2].sym) # register this operation already: setAttachedOpPartial(g, idgen.module, typ, kind, result) - if kind == attachedSink and destructorOverriden(g, typ): + if kind == attachedSink and destructorOverridden(g, typ): ## compiler can use a combination of `=destroy` and memCopy for sink op dest.flags.incl sfCursor - result.ast[bodyPos].add newOpCall(a, getAttachedOp(g, typ, attachedDestructor), d[0]) + let op = getAttachedOp(g, typ, attachedDestructor) + result.ast[bodyPos].add newOpCall(a, op, if op.typ.firstParamType.kind == tyVar: d[0] else: d) result.ast[bodyPos].add newAsgnStmt(d, src) else: var tk: TTypeKind - if g.config.selectedGC in {gcArc, gcOrc, gcHooks}: + if g.config.selectedGC in {gcArc, gcOrc, gcHooks, gcAtomicArc}: tk = skipTypes(typ, {tyOrdinal, tyRange, tyInferred, tyGenericInst, tyStatic, tyAlias, tySink}).kind else: tk = tyNone # no special casing for strings and seqs @@ -985,14 +1197,24 @@ proc produceSym(g: ModuleGraph; c: PContext; typ: PType; kind: TTypeAttachedOp; fillStrOp(a, typ, result.ast[bodyPos], d, src) else: fillBody(a, typ, result.ast[bodyPos], d, src) - if not a.canRaise: incl result.flags, sfNeverRaises + if tk == tyObject and a.kind in {attachedAsgn, attachedSink, attachedDeepCopy, attachedDup} and not lacksMTypeField(typ): + # bug #19205: Do not forget to also copy the hidden type field: + genTypeFieldCopy(a, typ, result.ast[bodyPos], d, src) + + if not a.canRaise: + incl result.flags, sfNeverRaises + result.ast[pragmasPos] = newNodeI(nkPragma, info) + result.ast[pragmasPos].add newTree(nkExprColonExpr, + newIdentNode(g.cache.getIdent("raises"), info), newNodeI(nkBracket, info)) + completePartialOp(g, idgen.module, typ, kind, result) proc produceDestructorForDiscriminator*(g: ModuleGraph; typ: PType; field: PSym, info: TLineInfo; idgen: IdGenerator): PSym = assert(typ.skipTypes({tyAlias, tyGenericInst}).kind == tyObject) - result = symPrototype(g, field.typ, typ.owner, attachedDestructor, info, idgen) + # discrimantor assignments needs pointers to destroy fields; alas, we cannot use non-var destructor here + result = symPrototype(g, field.typ, typ.owner, attachedDestructor, info, idgen, isDiscriminant = true) var a = TLiftCtx(info: info, g: g, kind: attachedDestructor, asgnForType: typ, idgen: idgen, fn: result) a.asgnForType = typ @@ -1000,7 +1222,7 @@ proc produceDestructorForDiscriminator*(g: ModuleGraph; typ: PType; field: PSym, a.addMemReset = true let discrimantDest = result.typ.n[1].sym - let dst = newSym(skVar, getIdent(g.cache, "dest"), nextSymId(idgen), result, info) + let dst = newSym(skVar, getIdent(g.cache, "dest"), idgen, result, info) dst.typ = makePtrType(typ.owner, typ, idgen) let dstSym = newSymNode(dst) let d = newDeref(dstSym) @@ -1026,7 +1248,7 @@ proc patchBody(g: ModuleGraph; c: PContext; n: PNode; info: TLineInfo; idgen: Id if op != nil: if op.ast.isGenericRoutine: internalError(g.config, info, "resolved destructor is generic") - if op.magic == mDestroy: + if op.magic == mDestroy and t.kind != tyString: internalError(g.config, info, "patching mDestroy with mDestroy?") n[0] = newSymNode(op) for x in n: patchBody(g, c, x, info, idgen) @@ -1036,13 +1258,7 @@ proc inst(g: ModuleGraph; c: PContext; t: PType; kind: TTypeAttachedOp; idgen: I let op = getAttachedOp(g, t, kind) if op != nil and op.ast != nil and op.ast.isGenericRoutine: if t.typeInst != nil: - var a: TLiftCtx - a.info = info - a.g = g - a.kind = kind - a.c = c - a.idgen = idgen - + var a = TLiftCtx(info: info, g: g, kind: kind, c: c, idgen: idgen) let opInst = instantiateGeneric(a, op, t, t.typeInst) if opInst.ast != nil: patchBody(g, c, opInst.ast, info, a.idgen) @@ -1050,7 +1266,7 @@ proc inst(g: ModuleGraph; c: PContext; t: PType; kind: TTypeAttachedOp; idgen: I else: localError(g.config, info, "unresolved generic parameter") -proc isTrival(s: PSym): bool {.inline.} = +proc isTrival*(s: PSym): bool {.inline.} = s == nil or (s.ast != nil and s.ast[bodyPos].len == 0) proc createTypeBoundOps(g: ModuleGraph; c: PContext; orig: PType; info: TLineInfo; @@ -1064,7 +1280,7 @@ proc createTypeBoundOps(g: ModuleGraph; c: PContext; orig: PType; info: TLineInf let skipped = orig.skipTypes({tyGenericInst, tyAlias, tySink}) if isEmptyContainer(skipped) or skipped.kind == tyStatic: return - let h = sighashes.hashType(skipped, {CoType, CoConsiderOwned, CoDistinct}) + let h = sighashes.hashType(skipped, g.config, {CoType, CoConsiderOwned, CoDistinct}) var canon = g.canonTypes.getOrDefault(h) if canon == nil: g.canonTypes[h] = skipped @@ -1077,23 +1293,23 @@ proc createTypeBoundOps(g: ModuleGraph; c: PContext; orig: PType; info: TLineInf # 4. We have a custom destructor. # 5. We have a (custom) generic destructor. - # we do not generate '=trace' nor '=dispose' procs if we + # we do not generate '=trace' procs if we # have the cycle detection disabled, saves code size. - let lastAttached = if g.config.selectedGC == gcOrc: attachedDispose + let lastAttached = if g.config.selectedGC == gcOrc: attachedTrace else: attachedSink # bug #15122: We need to produce all prototypes before entering the # mind boggling recursion. Hacks like these imply we should rewrite # this module. - var generics: array[attachedDestructor..attachedDispose, bool] - for k in attachedDestructor..lastAttached: + var generics: array[attachedWasMoved..attachedTrace, bool] = default(array[attachedWasMoved..attachedTrace, bool]) + for k in attachedWasMoved..lastAttached: generics[k] = getAttachedOp(g, canon, k) != nil if not generics[k]: setAttachedOp(g, idgen.module, canon, k, symPrototype(g, canon, canon.owner, k, info, idgen)) # we generate the destructor first so that other operators can depend on it: - for k in attachedDestructor..lastAttached: + for k in attachedWasMoved..lastAttached: if not generics[k]: discard produceSym(g, c, canon, k, info, idgen) else: diff --git a/compiler/liftlocals.nim b/compiler/liftlocals.nim index 7ca46ab1b..aaa0707e0 100644 --- a/compiler/liftlocals.nim +++ b/compiler/liftlocals.nim @@ -10,9 +10,11 @@ ## This module implements the '.liftLocals' pragma. import - strutils, options, ast, msgs, + options, ast, msgs, idents, renderer, types, lowerings, lineinfos +import std/strutils + from pragmas import getPragmaVal from wordrecg import wLiftLocals @@ -49,6 +51,7 @@ proc liftLocals(n: PNode; i: int; c: var Ctx) = liftLocals(it, i, c) proc lookupParam(params, dest: PNode): PSym = + result = nil if dest.kind != nkIdent: return nil for i in 1..<params.len: if params[i].kind == nkSym and params[i].sym.name.id == dest.ident.id: diff --git a/compiler/lineinfos.nim b/compiler/lineinfos.nim index d8f82aea0..94a483299 100644 --- a/compiler/lineinfos.nim +++ b/compiler/lineinfos.nim @@ -7,10 +7,11 @@ # distribution, for details about the copyright. # -## This module contains the ``TMsgKind`` enum as well as the -## ``TLineInfo`` object. +## This module contains the `TMsgKind` enum as well as the +## `TLineInfo` object. -import ropes, tables, pathutils, hashes +import ropes, pathutils +import std/[hashes, tables] const explanationsBaseUrl* = "https://nim-lang.github.io/Nim" @@ -27,26 +28,40 @@ proc createDocLink*(urlSuffix: string): string = type TMsgKind* = enum - errUnknown, errInternal, errIllFormedAstX, errCannotOpenFile, + # fatal errors + errUnknown, errFatal, errInternal, + # non-fatal errors + errIllFormedAstX, errCannotOpenFile, errXExpected, - errGridTableNotImplemented, - errMarkdownIllformedTable, - errGeneralParseError, - errNewSectionExpected, - errInvalidDirectiveX, - errFootnoteMismatch, + errRstMissingClosing, + errRstGridTableNotImplemented, + errRstMarkdownIllformedTable, + errRstIllformedTable, + errRstNewSectionExpected, + errRstGeneralParseError, + errRstInvalidDirectiveX, + errRstInvalidField, + errRstFootnoteMismatch, + errRstSandboxedDirective, errProveInit, # deadcode errGenerated, + errFailedMove, errUser, - + # warnings warnCannotOpenFile = "CannotOpenFile", warnOctalEscape = "OctalEscape", warnXIsNeverRead = "XIsNeverRead", warnXmightNotBeenInit = "XmightNotBeenInit", warnDeprecated = "Deprecated", warnConfigDeprecated = "ConfigDeprecated", + warnDotLikeOps = "DotLikeOps", warnSmallLshouldNotBeUsed = "SmallLshouldNotBeUsed", warnUnknownMagic = "UnknownMagic", - warnRedefinitionOfLabel = "RedefinitionOfLabel", warnUnknownSubstitutionX = "UnknownSubstitutionX", - warnLanguageXNotSupported = "LanguageXNotSupported", - warnFieldXNotSupported = "FieldXNotSupported", - warnRstStyle = "warnRstStyle", warnCommentXIgnored = "CommentXIgnored", + warnRstRedefinitionOfLabel = "RedefinitionOfLabel", + warnRstUnknownSubstitutionX = "UnknownSubstitutionX", + warnRstAmbiguousLink = "AmbiguousLink", + warnRstBrokenLink = "BrokenLink", + warnRstLanguageXNotSupported = "LanguageXNotSupported", + warnRstFieldXNotSupported = "FieldXNotSupported", + warnRstUnusedImportdoc = "UnusedImportdoc", + warnRstStyle = "warnRstStyle", + warnCommentXIgnored = "CommentXIgnored", warnTypelessParam = "TypelessParam", warnUseBase = "UseBase", warnWriteToForeignHeap = "WriteToForeignHeap", warnUnsafeCode = "UnsafeCode", warnUnusedImportX = "UnusedImport", @@ -56,19 +71,38 @@ type warnUnreachableElse = "UnreachableElse", warnUnreachableCode = "UnreachableCode", warnStaticIndexCheck = "IndexCheck", warnGcUnsafe = "GcUnsafe", warnGcUnsafe2 = "GcUnsafe2", warnUninit = "Uninit", warnGcMem = "GcMem", warnDestructor = "Destructor", - warnLockLevel = "LockLevel", warnResultShadowed = "ResultShadowed", + warnLockLevel = "LockLevel", # deadcode + 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", + warnPtrToCstringConv = "PtrToCstringConv", + warnEffect = "Effect", + warnCastSizes = "CastSizes", # deadcode + warnAboveMaxSizeSet = "AboveMaxSizeSet", + warnImplicitTemplateRedefinition = "ImplicitTemplateRedefinition", + warnUnnamedBreak = "UnnamedBreak", + warnStmtListLambda = "StmtListLambda", + warnBareExcept = "BareExcept", + warnImplicitDefaultValue = "ImplicitDefaultValue", + warnIgnoredSymbolInjection = "IgnoredSymbolInjection", + warnStdPrefix = "StdPrefix" warnUser = "User", - - hintSuccess = "Success", hintSuccessX = "SuccessX", hintCC = "CC", - hintLineTooLong = "LineTooLong", hintXDeclaredButNotUsed = "XDeclaredButNotUsed", + warnGlobalVarConstructorTemporary = "GlobalVarConstructorTemporary", + # hints + hintSuccess = "Success", hintSuccessX = "SuccessX", + hintCC = "CC", + hintXDeclaredButNotUsed = "XDeclaredButNotUsed", hintDuplicateModuleImport = "DuplicateModuleImport", hintXCannotRaiseY = "XCannotRaiseY", hintConvToBaseNotNeeded = "ConvToBaseNotNeeded", hintConvFromXtoItselfNotNeeded = "ConvFromXtoItselfNotNeeded", hintExprAlwaysX = "ExprAlwaysX", - hintQuitCalled = "QuitCalled", hintProcessing = "Processing", hintCodeBegin = "CodeBegin", + 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", @@ -77,22 +111,29 @@ type hintUser = "User", hintUserRaw = "UserRaw", hintExtendedContext = "ExtendedContext", hintMsgOrigin = "MsgOrigin", # since 1.3.5 hintDeclaredLoc = "DeclaredLoc", # since 1.5.1 + hintUnknownHint = "UnknownHint" 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", - errGridTableNotImplemented: "grid table is not implemented", - errMarkdownIllformedTable: "illformed delimiter row of a markdown table", - errGeneralParseError: "general parse error", - errNewSectionExpected: "new section expected $1", - errInvalidDirectiveX: "invalid directive: '$1'", - errFootnoteMismatch: "number of footnotes and their references don't match: $1", + errRstMissingClosing: "$1", + errRstGridTableNotImplemented: "grid table is not implemented", + errRstMarkdownIllformedTable: "illformed delimiter row of a markdown table", + errRstIllformedTable: "Illformed table: $1", + 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", + errRstSandboxedDirective: "disabled directive: '$1'", errProveInit: "Cannot prove that '$1' is initialized.", # deadcode errGenerated: "$1", + errFailedMove: "$1", errUser: "$1", warnCannotOpenFile: "cannot open '$1'", warnOctalEscape: "octal escape sequences do not exist; leading zero is ignored", @@ -100,15 +141,19 @@ const 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", - warnRedefinitionOfLabel: "redefinition of label '$1'", - warnUnknownSubstitutionX: "unknown substitution '$1'", - warnLanguageXNotSupported: "language '$1' not supported", - warnFieldXNotSupported: "field '$1' not supported", + warnRstRedefinitionOfLabel: "redefinition of label '$1'", + warnRstUnknownSubstitutionX: "unknown substitution '$1'", + warnRstAmbiguousLink: "ambiguous doc link $1", + warnRstBrokenLink: "broken link '$1'", + warnRstLanguageXNotSupported: "language '$1' not supported", + warnRstFieldXNotSupported: "field '$1' not supported", + warnRstUnusedImportdoc: "importdoc for '$1' is not used", warnRstStyle: "RST style: $1", warnCommentXIgnored: "comment '$1' ignored", - warnTypelessParam: "'$1' has no type. Typeless parameters are deprecated; only allowed for 'template'", + warnTypelessParam: "", # deadcode warnUseBase: "use {.base.} for base methods; baseless methods are deprecated", warnWriteToForeignHeap: "write to foreign heap", warnUnsafeCode: "unsafe code: '$1'", @@ -130,28 +175,46 @@ const 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", + warnLockLevel: "$1", # deadcode 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", + warnPtrToCstringConv: "unsafe conversion to 'cstring' from '$1'; Use a `cast` operation like `cast[cstring](x)`; this will become a compile time error in the future", + warnEffect: "$1", + warnCastSizes: "$1", # deadcode + warnAboveMaxSizeSet: "$1", + warnImplicitTemplateRedefinition: "template '$1' is implicitly redefined; this is deprecated, add an explicit .redefine pragma", + warnUnnamedBreak: "Using an unnamed break in a block is deprecated; Use a named block with a named break instead", + warnStmtListLambda: "statement list expression assumed to be anonymous proc; this is deprecated, use `do (): ...` or `proc () = ...` instead", + warnBareExcept: "$1", + warnImplicitDefaultValue: "$1", + warnIgnoredSymbolInjection: "$1", + warnStdPrefix: "$1 needs the 'std' prefix", warnUser: "$1", + warnGlobalVarConstructorTemporary: "global variable '$1' initialization requires a temporary variable", hintSuccess: "operation successful: $#", # keep in sync with `testament.isSuccess` - hintSuccessX: "${loc} lines; ${sec}s; $mem; $build build; proj: $project; out: $output", + 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'", @@ -174,28 +237,30 @@ const hintExtendedContext: "$1", hintMsgOrigin: "$1", hintDeclaredLoc: "$1", + hintUnknownHint: "unknown hint: $1" ] const - fatalMin* = errUnknown - fatalMax* = errInternal + 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} - result[2] = result[3] - {hintStackTrace, warnUninit, hintExtendedContext, hintDeclaredLoc} + result = default(array[0..3, TNoteKinds]) + result[3] = {low(TNoteKind)..high(TNoteKind)} - {warnObservableStores, warnResultUsed, warnAnyEnumConv, warnBareExcept, warnStdPrefix} + result[2] = result[3] - {hintStackTrace, hintExtendedContext, hintDeclaredLoc, hintProcessingStmt} result[1] = result[2] - {warnProveField, warnProveIndex, warnGcUnsafe, hintPath, hintDependency, hintCodeBegin, hintCodeEnd, - hintSource, hintGlobalVar, hintGCStats, hintMsgOrigin} + hintSource, hintGlobalVar, hintGCStats, hintMsgOrigin, hintPerformance} result[0] = result[1] - {hintSuccessX, hintSuccess, hintConf, hintProcessing, hintPattern, hintExecuting, hintLinking, hintCC} @@ -203,6 +268,7 @@ const NotesVerbosity* = computeNotesVerbosity() errXMustBeCompileTime* = "'$1' can only be used in compile-time context" errArgsNeedRunOption* = "arguments can only be given if the '--run' option is selected" + errFloatToString* = "cannot convert '$1' to '$2'" type TFileInfo* = object @@ -222,7 +288,7 @@ type # and parsed; usually "" but is used # for 'nimsuggest' hash*: string # the checksum of the file - dirty*: bool # for 'nimfix' / 'nimpretty' like tooling + dirty*: bool # for 'nimpretty' like tooling when defined(nimpretty): fullContent*: string FileIndex* = distinct int32 @@ -253,7 +319,7 @@ proc `==`*(a, b: FileIndex): bool {.borrow.} proc hash*(i: TLineInfo): Hash = hash (i.line.int, i.col.int, i.fileIndex.int) -proc raiseRecoverableError*(msg: string) {.noinline.} = +proc raiseRecoverableError*(msg: string) {.noinline, noreturn.} = raise newException(ERecoverableError, msg) const @@ -284,9 +350,8 @@ type proc initMsgConfig*(): MsgConfig = - result.msgContext = @[] - result.lastError = unknownLineInfo - result.filenameToIndexTbl = initTable[string, FileIndex]() - result.fileInfos = @[] - result.errorOutputs = {eStdOut, eStdErr} + result = MsgConfig(msgContext: @[], lastError: unknownLineInfo, + filenameToIndexTbl: initTable[string, FileIndex](), + fileInfos: @[], errorOutputs: {eStdOut, eStdErr} + ) result.filenameToIndexTbl["???"] = FileIndex(-1) diff --git a/compiler/linter.nim b/compiler/linter.nim index 1ae1fb097..a80c377e9 100644 --- a/compiler/linter.nim +++ b/compiler/linter.nim @@ -9,18 +9,22 @@ ## This module implements the style checker. -import strutils +import std/strutils +from std/sugar import dup -import options, ast, msgs, idents, lineinfos, wordrecg +import options, ast, msgs, idents, lineinfos, wordrecg, astmsgs, semdata, packages +export packages const Letters* = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF', '_'} proc identLen*(line: string, start: int): int = + result = 0 while start+result < line.len and line[start+result] in Letters: inc result proc `=~`(s: string, a: openArray[string]): bool = + result = false for x in a: if s.startsWith(x): return true @@ -40,7 +44,7 @@ proc beautifyName(s: string, k: TSymKind): string = "pointer", "float", "csize", "csize_t", "cdouble", "cchar", "cschar", "cshort", "cu", "nil", "typedesc", "auto", "any", "range", "openarray", "varargs", "set", "cfloat", "ref", "ptr", - "untyped", "typed", "static", "sink", "lent", "type", "owned"]: + "untyped", "typed", "static", "sink", "lent", "type", "owned", "iterable"]: result.add s[i] else: result.add toUpperAscii(s[i]) @@ -84,24 +88,33 @@ proc differ*(line: string, a, b: int, x: string): string = result = y proc nep1CheckDefImpl(conf: ConfigRef; info: TLineInfo; s: PSym; k: TSymKind) = - # operators stay as they are: - if k in {skResult, skTemp} or s.name.s[0] notin Letters: return - if k in {skType, skGenericParam} and sfAnon in s.flags: return - 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) -template styleCheckDef*(conf: ConfigRef; info: TLineInfo; s: PSym; k: TSymKind) = - if {optStyleHint, optStyleError} * conf.globalOptions != {}: - nep1CheckDefImpl(conf, info, s, k) - -template styleCheckDef*(conf: ConfigRef; info: TLineInfo; s: PSym) = - styleCheckDef(conf, info, s, s.kind) -template styleCheckDef*(conf: ConfigRef; s: PSym) = - styleCheckDef(conf, s.info, s, s.kind) +template styleCheckDef*(ctx: PContext; info: TLineInfo; sym: PSym; k: TSymKind) = + ## Check symbol definitions adhere to NEP1 style rules. + if optStyleCheck in ctx.config.options and # ignore if styleChecks are off + {optStyleHint, optStyleError} * ctx.config.globalOptions != {} and # check only if hint/error is enabled + hintName in ctx.config.notes and # ignore if name checks are not requested + ctx.config.belongsToProjectPackage(sym) and # ignore foreign packages + optStyleUsages notin ctx.config.globalOptions and # ignore if requested to only check name usage + sym.kind != skResult and # ignore `result` + sym.kind != skTemp and # ignore temporary variables created by the compiler + sym.name.s[0] in Letters and # ignore operators TODO: what about unicode symbols??? + k notin {skType, skGenericParam} and # ignore types and generic params + (sym.typ == nil or sym.typ.kind != tyTypeDesc) and # ignore `typedesc` + {sfImportc, sfExportc} * sym.flags == {} and # ignore FFI + sfAnon notin sym.flags: # ignore if created by compiler + nep1CheckDefImpl(ctx.config, info, sym, k) + +template styleCheckDef*(ctx: PContext; info: TLineInfo; s: PSym) = + ## Check symbol definitions adhere to NEP1 style rules. + styleCheckDef(ctx, info, s, s.kind) + +template styleCheckDef*(ctx: PContext; s: PSym) = + ## Check symbol definitions adhere to NEP1 style rules. + styleCheckDef(ctx, s.info, s, s.kind) proc differs(conf: ConfigRef; info: TLineInfo; newName: string): string = let line = sourceLine(conf, info) @@ -115,21 +128,31 @@ proc differs(conf: ConfigRef; info: TLineInfo; newName: string): string = let last = first+identLen(line, first)-1 result = differ(line, first, last, newName) -proc styleCheckUse*(conf: ConfigRef; info: TLineInfo; s: PSym) = - if info.fileIndex.int < 0: return - # we simply convert it to what it looks like in the definition - # for consistency - - # operators stay as they are: - if s.kind == skTemp or s.name.s[0] notin Letters or sfAnon in s.flags: - return - +proc styleCheckUseImpl(conf: ConfigRef; info: TLineInfo; s: PSym) = let newName = s.name.s - let oldName = differs(conf, info, newName) - if oldName.len > 0: - lintReport(conf, info, newName, oldName) - -proc checkPragmaUse*(conf: ConfigRef; info: TLineInfo; w: TSpecialWord; pragmaName: string) = + let badName = differs(conf, info, newName) + if badName.len > 0: + lintReport(conf, info, newName, badName, "".dup(addDeclaredLoc(conf, s))) + +template styleCheckUse*(ctx: PContext; info: TLineInfo; sym: PSym) = + ## Check symbol uses match their definition's style. + if {optStyleHint, optStyleError} * ctx.config.globalOptions != {} and # ignore if styleChecks are off + hintName in ctx.config.notes and # ignore if name checks are not requested + ctx.config.belongsToProjectPackage(sym) and # ignore foreign packages + sym.kind != skTemp and # ignore temporary variables created by the compiler + sym.name.s[0] in Letters and # ignore operators TODO: what about unicode symbols??? + sfAnon notin sym.flags: # ignore temporary variables created by the compiler + styleCheckUseImpl(ctx.config, info, sym) + +proc checkPragmaUseImpl(conf: ConfigRef; info: TLineInfo; w: TSpecialWord; pragmaName: string) = let wanted = $w if pragmaName != wanted: lintReport(conf, info, wanted, pragmaName) + +template checkPragmaUse*(ctx: PContext; info: TLineInfo; w: TSpecialWord; pragmaName: string, sym: PSym) = + ## Check builtin pragma uses match their definition's style. + ## Note: This only applies to builtin pragmas, not user pragmas. + if {optStyleHint, optStyleError} * ctx.config.globalOptions != {} and # ignore if styleChecks are off + hintName in ctx.config.notes and # ignore if name checks are not requested + (sym != nil and ctx.config.belongsToProjectPackage(sym)): # ignore foreign packages + checkPragmaUseImpl(ctx.config, info, w, pragmaName) diff --git a/compiler/llstream.nim b/compiler/llstream.nim index 865a98ee0..cc8148483 100644 --- a/compiler/llstream.nim +++ b/compiler/llstream.nim @@ -12,11 +12,14 @@ import pathutils +when defined(nimPreviewSlimSystem): + import std/syncio + # support `useGnuReadline`, `useLinenoise` for backwards compatibility const hasRstdin = (defined(nimUseLinenoise) or defined(useLinenoise) or defined(useGnuReadline)) and not defined(windows) -when hasRstdin: import rdstdin +when hasRstdin: import std/rdstdin type TLLRepl* = proc (s: PLLStream, buf: pointer, bufLen: int): int @@ -37,33 +40,22 @@ type PLLStream* = ref TLLStream -proc llStreamOpen*(data: string): PLLStream = - new(result) - result.s = data - result.kind = llsString +proc llStreamOpen*(data: sink string): PLLStream = + PLLStream(kind: llsString, s: data) proc llStreamOpen*(f: File): PLLStream = - new(result) - result.f = f - result.kind = llsFile + PLLStream(kind: llsFile, f: f) proc llStreamOpen*(filename: AbsoluteFile, mode: FileMode): PLLStream = - new(result) - result.kind = llsFile + result = PLLStream(kind: llsFile) if not open(result.f, filename.string, mode): result = nil proc llStreamOpen*(): PLLStream = - new(result) - result.kind = llsNone + PLLStream(kind: llsNone) proc llReadFromStdin(s: PLLStream, buf: pointer, bufLen: int): int proc llStreamOpenStdIn*(r: TLLRepl = llReadFromStdin, onPrompt: OnPrompt = nil): PLLStream = - new(result) - result.kind = llsStdIn - result.s = "" - result.lineOffset = -1 - result.repl = r - result.onPrompt = onPrompt + PLLStream(kind: llsStdIn, s: "", lineOffset: -1, repl: r, onPrompt: onPrompt) proc llStreamClose*(s: PLLStream) = case s.kind @@ -76,6 +68,7 @@ when not declared(readLineFromStdin): # fallback implementation: proc readLineFromStdin(prompt: string, line: var string): bool = stdout.write(prompt) + stdout.flushFile() result = readLine(stdin, line) if not result: stdout.write("\n") @@ -86,6 +79,8 @@ proc endsWith*(x: string, s: set[char]): bool = while i >= 0 and x[i] == ' ': dec(i) if i >= 0 and x[i] in s: result = true + else: + result = false const LineContinuationOprs = {'+', '-', '*', '/', '\\', '<', '>', '!', '?', '^', @@ -101,6 +96,7 @@ proc continueLine(line: string, inTripleString: bool): bool {.inline.} = line.endsWith(LineContinuationOprs+AdditionalLineContinuationOprs)) proc countTriples(s: string): int = + result = 0 var i = 0 while i+2 < s.len: if s[i] == '"' and s[i+1] == '"' and s[i+2] == '"': diff --git a/compiler/lookups.nim b/compiler/lookups.nim index 15a22c778..d8fcf73e0 100644 --- a/compiler/lookups.nim +++ b/compiler/lookups.nim @@ -8,11 +8,16 @@ # # This module implements lookup helpers. +import std/[algorithm, strutils, tables] + +when defined(nimPreviewSlimSystem): + import std/assertions import - intsets, ast, astalgo, idents, semdata, types, msgs, options, - renderer, nimfix/prettybase, lineinfos, strutils, - modulegraphs + ast, astalgo, idents, semdata, types, msgs, options, + renderer, lineinfos, modulegraphs, astmsgs, wordrecg + +import std/[intsets, sets] proc ensureNoMissingOrUnusedSymbols(c: PContext; scope: PScope) @@ -45,6 +50,11 @@ proc considerQuotedIdent*(c: PContext; n: PNode, origin: PNode = nil): PIdent = case x.kind of nkIdent: id.add(x.ident.s) of nkSym: id.add(x.sym.name.s) + of nkSymChoices, nkOpenSym: + if x[0].kind == nkSym: + id.add(x[0].sym.name.s) + else: + handleError(n, origin) of nkLiterals - nkFloatLiterals: id.add(x.renderTree) else: handleError(n, origin) result = getIdent(c.cache, id) @@ -53,6 +63,8 @@ proc considerQuotedIdent*(c: PContext; n: PNode, origin: PNode = nil): PIdent = result = n[0].sym.name else: handleError(n, origin) + of nkOpenSym: + result = considerQuotedIdent(c, n[0], origin) else: handleError(n, origin) @@ -64,7 +76,7 @@ proc addUniqueSym*(scope: PScope, s: PSym): PSym = proc openScope*(c: PContext): PScope {.discardable.} = result = PScope(parent: c.currentScope, - symbols: newStrTable(), + symbols: initStrTable(), depthLevel: c.scopeDepth + 1) c.currentScope = result @@ -75,7 +87,7 @@ proc closeScope*(c: PContext) = ensureNoMissingOrUnusedSymbols(c, c.currentScope) rawCloseScope(c) -iterator allScopes(scope: PScope): PScope = +iterator allScopes*(scope: PScope): PScope = var current = scope while current != nil: yield current @@ -86,17 +98,6 @@ iterator localScopesFrom*(c: PContext; scope: PScope): PScope = if s == c.topLevelScope: break yield s -proc skipAlias*(s: PSym; n: PNode; conf: ConfigRef): PSym = - if s == nil or s.kind != skAlias: - result = s - else: - result = s.owner - 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") - proc isShadowScope*(s: PScope): bool {.inline.} = s.parent != nil and s.parent.depthLevel == s.depthLevel @@ -138,7 +139,7 @@ proc nextIdentIter(ti: var ModuleIter; marked: var IntSet; im: ImportedModule; return result iterator symbols(im: ImportedModule; marked: var IntSet; name: PIdent; g: ModuleGraph): PSym = - var ti: ModuleIter + var ti: ModuleIter = default(ModuleIter) var candidate = initIdentIter(ti, marked, im, name, g) while candidate != nil: yield candidate @@ -151,7 +152,7 @@ iterator importedItems*(c: PContext; name: PIdent): PSym = yield s proc allPureEnumFields(c: PContext; name: PIdent): seq[PSym] = - var ti: TIdentIter + var ti: TIdentIter = default(TIdentIter) result = @[] var res = initIdentIter(ti, c.pureEnumFields, name) while res != nil: @@ -162,6 +163,7 @@ iterator allSyms*(c: PContext): (PSym, int, bool) = # really iterate over all symbols in all the scopes. This is expensive # and only used by suggest.nim. var isLocal = true + var scopeN = 0 for scope in allScopes(c.currentScope): if scope == c.topLevelScope: isLocal = false @@ -176,16 +178,29 @@ iterator allSyms*(c: PContext): (PSym, int, bool) = assert s != nil yield (s, scopeN, isLocal) +iterator uniqueSyms*(c: PContext): (PSym, int, bool) = + ## Like [allSyms] except only returns unique symbols (Uniqueness determined by line + name) + # Track seen symbols so we don't duplicate them. + # The int is for the symbols name, and line info is + # to be able to tell apart symbols with same name but on different lines + var seen = initHashSet[(TLineInfo, int)]() + for res in allSyms(c): + if not seen.containsOrIncl((res[0].info, res[0].name.id)): + yield res + + proc someSymFromImportTable*(c: PContext; name: PIdent; ambiguous: var bool): PSym = var marked = initIntSet() + var symSet = OverloadableSyms result = nil - for im in c.imports.mitems: - for s in symbols(im, marked, name, c.graph): - if result == nil: - result = s - else: - if s.kind notin OverloadableSyms or result.kind notin OverloadableSyms: + block outer: + for im in c.imports.mitems: + for s in symbols(im, marked, name, c.graph): + if result == nil: + result = s + elif s.kind notin symSet or result.kind notin symSet: ambiguous = true + break outer proc searchInScopes*(c: PContext, s: PIdent; ambiguous: var bool): PSym = for scope in allScopes(c.currentScope): @@ -206,15 +221,14 @@ proc debugScopes*(c: PContext; limit=0, max = int.high) {.deprecated.} = if i == limit: return inc i -proc searchInScopesFilterBy*(c: PContext, s: PIdent, filter: TSymKinds): seq[PSym] = +proc searchInScopesAllCandidatesFilterBy*(c: PContext, s: PIdent, filter: TSymKinds): seq[PSym] = result = @[] for scope in allScopes(c.currentScope): - var ti: TIdentIter + var ti: TIdentIter = default(TIdentIter) var candidate = initIdentIter(ti, scope.symbols, s) while candidate != nil: if candidate.kind in filter: - if result.len == 0: - result.add candidate + result.add candidate candidate = nextIdentIter(ti, scope.symbols) if result.len == 0: @@ -224,8 +238,83 @@ proc searchInScopesFilterBy*(c: PContext, s: PIdent, filter: TSymKinds): seq[PSy if s.kind in filter: result.add s -proc errorSym*(c: PContext, n: PNode): PSym = +proc searchInScopesFilterBy*(c: PContext, s: PIdent, filter: TSymKinds): seq[PSym] = + result = @[] + block outer: + for scope in allScopes(c.currentScope): + var ti: TIdentIter = default(TIdentIter) + var candidate = initIdentIter(ti, scope.symbols, s) + while candidate != nil: + if candidate.kind in filter: + result.add candidate + # Break here, because further symbols encountered would be shadowed + break outer + candidate = nextIdentIter(ti, scope.symbols) + + if result.len == 0: + var marked = initIntSet() + for im in c.imports.mitems: + for s in symbols(im, marked, s, c.graph): + if s.kind in filter: + result.add s + +proc cmpScopes*(ctx: PContext, s: PSym): int = + # Do not return a negative number + if s.originatingModule == ctx.module: + result = 2 + var owner = s + while true: + owner = owner.skipGenericOwner + if owner.kind == skModule: break + inc result + else: + result = 1 + +proc isAmbiguous*(c: PContext, s: PIdent, filter: TSymKinds, sym: var PSym): bool = + result = false + block outer: + for scope in allScopes(c.currentScope): + var ti: TIdentIter = default(TIdentIter) + var candidate = initIdentIter(ti, scope.symbols, s) + var scopeHasCandidate = false + while candidate != nil: + if candidate.kind in filter: + if scopeHasCandidate: + # 2 candidates in same scope, ambiguous + return true + else: + scopeHasCandidate = true + sym = candidate + candidate = nextIdentIter(ti, scope.symbols) + if scopeHasCandidate: + # scope had a candidate but wasn't ambiguous + return false + + var importsHaveCandidate = false + var marked = initIntSet() + for im in c.imports.mitems: + for s in symbols(im, marked, s, c.graph): + if s.kind in filter: + if importsHaveCandidate: + # 2 candidates among imports, ambiguous + return true + else: + importsHaveCandidate = true + sym = s + if importsHaveCandidate: + # imports had a candidate but wasn't ambiguous + return false + +proc errorSym*(c: PContext, ident: PIdent, info: TLineInfo): PSym = ## creates an error symbol to avoid cascading errors (for IDE support) + result = newSym(skError, ident, c.idgen, getCurrOwner(c), info, {}) + result.typ = errorType(c) + incl(result.flags, sfDiscardable) + # pretend it's from the top level scope to prevent cascading errors: + if c.config.cmd != cmdInteractive and c.compilesContextId == 0: + c.moduleScope.addSym(result) + +proc errorSym*(c: PContext, n: PNode): PSym = var m = n # ensure that 'considerQuotedIdent' can't fail: if m.kind == nkDotExpr: m = m[1] @@ -233,12 +322,7 @@ proc errorSym*(c: PContext, n: PNode): PSym = considerQuotedIdent(c, m) else: getIdent(c.cache, "err:" & renderTree(m)) - result = newSym(skError, ident, nextSymId(c.idgen), getCurrOwner(c), n.info, {}) - result.typ = errorType(c) - incl(result.flags, sfDiscardable) - # pretend it's from the top level scope to prevent cascading errors: - if c.config.cmd != cmdInteractive and c.compilesContextId == 0: - c.moduleScope.addSym(result) + result = errorSym(c, ident, n.info) type TOverloadIterMode* = enum @@ -265,9 +349,10 @@ proc getSymRepr*(conf: ConfigRef; s: PSym, getDeclarationPath = true): string = proc ensureNoMissingOrUnusedSymbols(c: PContext; scope: PScope) = # check if all symbols have been used and defined: - var it: TTabIter + var it: TTabIter = default(TTabIter) var s = initTabIter(it, scope.symbols) var missingImpls = 0 + var unusedSyms: seq[tuple[sym: PSym, key: string]] = @[] while s != nil: if sfForward in s.flags and s.kind notin {skType, skModule}: # too many 'implementation of X' errors are annoying @@ -282,74 +367,113 @@ proc ensureNoMissingOrUnusedSymbols(c: PContext; scope: PScope) = # maybe they can be made skGenericParam as well. if s.typ != nil and tfImplicitTypeParam notin s.typ.flags and s.typ.kind != tyGenericParam: - message(c.config, s.info, hintXDeclaredButNotUsed, s.name.s) + 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) proc wrongRedefinition*(c: PContext; info: TLineInfo, s: string; - conflictsWith: TLineInfo) = + conflictsWith: TLineInfo, note = errGenerated) = ## Emit a redefinition error if in non-interactive mode if c.config.cmd != cmdInteractive: - localError(c.config, info, + localError(c.config, info, note, "redefinition of '$1'; previous declaration here: $2" % [s, c.config $ conflictsWith]) -proc addDecl*(c: PContext, sym: PSym, info: TLineInfo) = - let conflict = c.currentScope.addUniqueSym(sym) +# 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) = + if sym.name.id == ord(wUnderscore): return + let conflict = scope.addUniqueSym(sym) if conflict != nil: - wrongRedefinition(c, info, sym.name.s, conflict.info) + if sym.kind == skModule and conflict.kind == skModule: + # 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. + if c.importModuleMap[sym.id] == c.importModuleMap[conflict.id]: + #only hints if the conflict is the actual module not just a shared name + localError(c.config, info, hintDuplicateModuleImport, + "duplicate import of '$1'; previous import here: $2" % + [sym.name.s, c.config $ conflict.info]) + else: + wrongRedefinition(c, info, sym.name.s, conflict.info, errGenerated) -proc addDecl*(c: PContext, sym: PSym) = - let conflict = strTableInclReportConflict(c.currentScope.symbols, sym, true) - if conflict != nil: - wrongRedefinition(c, sym.info, sym.name.s, conflict.info) +proc addDeclAt*(c: PContext; scope: PScope, sym: PSym) {.inline.} = + addDeclAt(c, scope, sym, sym.info) + +proc addDecl*(c: PContext, sym: PSym, info: TLineInfo) {.inline.} = + addDeclAt(c, c.currentScope, sym, info) + +proc addDecl*(c: PContext, sym: PSym) {.inline.} = + addDeclAt(c, c.currentScope, sym) proc addPrelimDecl*(c: PContext, sym: PSym) = discard c.currentScope.addUniqueSym(sym) -proc addDeclAt*(c: PContext; scope: PScope, sym: PSym) = - let conflict = scope.addUniqueSym(sym) - if conflict != nil: - wrongRedefinition(c, sym.info, sym.name.s, conflict.info) +from ic / ic import addHidden 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") + 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: + addHidden(c.encoder, c.packedRepr, sym) proc addInterfaceDeclAt*(c: PContext, scope: PScope, sym: PSym) = + ## adds a symbol on the scope and the interface if appropriate addDeclAt(c, scope, sym) - addInterfaceDeclAux(c, sym) + if not scope.isShadowScope: + # adding into a non-shadow scope, we need to handle exports, etc + addInterfaceDeclAux(c, sym) + +proc addInterfaceDecl*(c: PContext, sym: PSym) {.inline.} = + ## adds a decl and the interface if appropriate + addInterfaceDeclAt(c, c.currentScope, sym) 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") 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) - else: - scope.addSym(fn) - -proc addInterfaceDecl*(c: PContext, sym: PSym) = - # it adds the symbol to the interface if appropriate - addDecl(c, sym) - addInterfaceDeclAux(c, sym) + if fn.name.id != ord(wUnderscore): + let check = strTableGet(scope.symbols, fn.name) + if check != nil and check.kind notin OverloadableSyms: + wrongRedefinition(c, fn.info, fn.name.s, check.info) + else: + scope.addSym(fn) proc addInterfaceOverloadableSymAt*(c: PContext, scope: PScope, sym: PSym) = - # it adds the symbol to the interface if appropriate + ## adds an overloadable symbol on the scope and the interface if appropriate addOverloadableSymAt(c, scope, sym) - addInterfaceDeclAux(c, sym) + if not scope.isShadowScope: + # adding into a non-shadow scope, we need to handle exports, etc + addInterfaceDeclAux(c, sym) proc openShadowScope*(c: PContext) = + ## opens a shadow scope, just like any other scope except the depth is the + ## same as the parent -- see `isShadowScope`. c.currentScope = PScope(parent: c.currentScope, - symbols: newStrTable(), + symbols: initStrTable(), depthLevel: c.scopeDepth) proc closeShadowScope*(c: PContext) = - c.closeScope + ## closes the shadow scope, but doesn't merge any of the symbols + ## Does not check for unused symbols or missing forward decls since a macro + ## or template consumes this AST + rawCloseScope(c) proc mergeShadowScope*(c: PContext) = + ## close the existing scope and merge in all defined symbols, this will also + ## trigger any export related code if this is into a non-shadow scope. + ## + ## Merges: + ## shadow -> shadow: add symbols to the parent but check for redefinitions etc + ## shadow -> non-shadow: the above, but also handle exports and all that let shadowScope = c.currentScope c.rawCloseScope for sym in shadowScope.symbols: @@ -358,13 +482,6 @@ proc mergeShadowScope*(c: PContext) = else: c.addInterfaceDecl(sym) -when false: - # `nimfix` used to call `altSpelling` and prettybase.replaceDeprecated(n.info, ident, alt) - proc altSpelling(c: PContext, x: PIdent): PIdent = - case x.s[0] - of 'A'..'Z': result = getIdent(c.cache, toLowerAscii(x.s[0]) & x.s.substr(1)) - of 'a'..'z': result = getIdent(c.cache, toLowerAscii(x.s[0]) & x.s.substr(1)) - else: result = x import std/[editdistance, heapqueue] @@ -374,7 +491,7 @@ type SpellCandidate = object msg: string sym: PSym -template toOrderTup(a: SpellCandidate): auto = +template toOrderTup(a: SpellCandidate): (int, int, string) = # `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 @@ -387,7 +504,7 @@ proc mustFixSpelling(c: PContext): bool {.inline.} = result = c.config.spellSuggestMax != 0 and c.compilesContextId == 0 # don't slowdown inside compiles() -proc fixSpelling(c: PContext, n: PNode, ident: PIdent, result: var string) = +proc fixSpelling(c: PContext, ident: PIdent, result: var string) = ## when we cannot find the identifier, suggest nearby spellings var list = initHeapQueue[SpellCandidate]() let name0 = ident.s.nimIdentNormalize @@ -395,36 +512,37 @@ proc fixSpelling(c: PContext, n: PNode, ident: PIdent, result: var string) = for (sym, depth, isLocal) in allSyms(c): let depth = -depth - 1 let dist = editDistance(name0, sym.name.s.nimIdentNormalize) - var msg: string + 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) if list.len == 0: return let e0 = list[0] - var count = 0 + var + count = 0 + last: PIdent = nil while true: # pending https://github.com/timotheecour/Nim/issues/373 use more efficient `itemsSorted`. 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 + minLengthForSuggestion = 4 + maxCount = 3 # avoids ton of matches; three counts for equal distances + if e.dist > e0.dist or count >= maxCount or name0.len < minLengthForSuggestion: 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 + if e.sym.name != last: + result.add e.msg + count.inc + last = e.sym.name 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 + result = nil for candidate in importedItems(c, s.name): if i == 0: err.add " -- use one of the following:\n" else: err.add "\n" @@ -442,51 +560,76 @@ proc errorUseQualifier(c: PContext; info: TLineInfo; s: PSym; amb: var bool): PS amb = false proc errorUseQualifier*(c: PContext; info: TLineInfo; s: PSym) = - var amb: bool + var amb: bool = false discard errorUseQualifier(c, info, s, amb) -proc errorUseQualifier(c: PContext; info: TLineInfo; candidates: seq[PSym]) = - var err = "ambiguous identifier: '" & candidates[0].name.s & "'" +proc ambiguousIdentifierMsg*(candidates: seq[PSym], prefix = "use one of", indent = 0): string = + result = "" + for i in 0 ..< indent: + result.add(' ') + result.add "ambiguous identifier: '" & candidates[0].name.s & "'" var i = 0 for candidate in candidates: - if i == 0: err.add " -- use one of the following:\n" - else: err.add "\n" - err.add " " & candidate.owner.name.s & "." & candidate.name.s - err.add ": " & typeToString(candidate.typ) + if i == 0: result.add " -- $1 the following:\n" % prefix + else: result.add "\n" + for i in 0 ..< indent: + result.add(' ') + result.add " " & candidate.owner.name.s & "." & candidate.name.s + result.add ": " & typeToString(candidate.typ) inc i - localError(c.config, info, errGenerated, err) + +proc errorUseQualifier*(c: PContext; info: TLineInfo; candidates: seq[PSym]) = + localError(c.config, info, errGenerated, ambiguousIdentifierMsg(candidates)) + +proc ambiguousIdentifierMsg*(choices: PNode, indent = 0): string = + var candidates = newSeq[PSym](choices.len) + let prefix = if choices[0].typ.kind != tyProc: "use one of" else: "you need a helper proc to disambiguate" + for i, n in choices: + candidates[i] = n.sym + result = ambiguousIdentifierMsg(candidates, prefix, indent) + +proc errorUseQualifier*(c: PContext; info:TLineInfo; choices: PNode) = + localError(c.config, info, errGenerated, ambiguousIdentifierMsg(choices)) proc errorUndeclaredIdentifier*(c: PContext; info: TLineInfo; name: string, extra = "") = - var err = "undeclared identifier: '" & name & "'" & extra - 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 = "" + var err: string + if name == "_": + err = "the special identifier '_' is ignored in declarations and cannot be used" + else: + err = "undeclared identifier: '" & name & "'" + if "`gensym" in name: + err.add "; if declared in a template, this identifier may be inconsistently marked inject or gensym" + if extra.len != 0: + err.add extra + if c.recursiveDep.len > 0: + err.add "\nThis might be caused by a recursive module dependency:\n" + err.add c.recursiveDep + # prevent excessive errors for 'nim check' + c.recursiveDep = "" localError(c.config, info, errGenerated, err) -proc errorUndeclaredIdentifierHint*(c: PContext; n: PNode, ident: PIdent): PSym = +proc errorUndeclaredIdentifierHint*(c: PContext; ident: PIdent; info: TLineInfo): PSym = var extra = "" - if c.mustFixSpelling: fixSpelling(c, n, ident, extra) - errorUndeclaredIdentifier(c, n.info, ident.s, extra) - result = errorSym(c, n) + if c.mustFixSpelling: fixSpelling(c, ident, extra) + errorUndeclaredIdentifier(c, info, ident.s, extra) + result = errorSym(c, ident, info) proc lookUp*(c: PContext, n: PNode): PSym = # Looks up a symbol. Generates an error in case of nil. var amb = false case n.kind of nkIdent: - result = searchInScopes(c, n.ident, amb).skipAlias(n, c.config) - if result == nil: result = errorUndeclaredIdentifierHint(c, n, n.ident) + result = searchInScopes(c, n.ident, amb) + if result == nil: result = errorUndeclaredIdentifierHint(c, n.ident, n.info) of nkSym: result = n.sym of nkAccQuoted: var ident = considerQuotedIdent(c, n) - result = searchInScopes(c, ident, amb).skipAlias(n, c.config) - if result == nil: result = errorUndeclaredIdentifierHint(c, n, ident) + result = searchInScopes(c, ident, amb) + if result == nil: result = errorUndeclaredIdentifierHint(c, ident, n.info) else: internalError(c.config, n.info, "lookUp") - return + return nil if amb: #contains(c.ambiguousSymbols, result.id): result = errorUseQualifier(c, n.info, result, amb) @@ -497,54 +640,78 @@ type TLookupFlag* = enum checkAmbiguity, checkUndeclared, checkModule, checkPureEnumFields +const allExceptModule = {low(TSymKind)..high(TSymKind)} - {skModule, skPackage} + +proc lookUpCandidates*(c: PContext, ident: PIdent, filter: set[TSymKind], + includePureEnum = false): seq[PSym] = + result = searchInScopesFilterBy(c, ident, filter) + if skEnumField in filter and (result.len == 0 or includePureEnum): + result.add allPureEnumFields(c, ident) + proc qualifiedLookUp*(c: PContext, n: PNode, flags: set[TLookupFlag]): PSym = - const allExceptModule = {low(TSymKind)..high(TSymKind)} - {skModule, skPackage} case n.kind of nkIdent, nkAccQuoted: var amb = false var ident = considerQuotedIdent(c, n) if checkModule in flags: - result = searchInScopes(c, ident, amb).skipAlias(n, c.config) + result = searchInScopes(c, ident, amb) + if result == nil: + let candidates = allPureEnumFields(c, ident) + if candidates.len > 0: + result = candidates[0] + amb = candidates.len > 1 + if amb and checkAmbiguity in flags: + errorUseQualifier(c, n.info, candidates) else: - let candidates = searchInScopesFilterBy(c, ident, allExceptModule) #.skipAlias(n, c.config) - if candidates.len > 0: - result = candidates[0] - amb = candidates.len > 1 - if amb and checkAmbiguity in flags: - errorUseQualifier(c, n.info, candidates) - if result == nil: - let candidates = allPureEnumFields(c, ident) + let candidates = lookUpCandidates(c, ident, allExceptModule) if candidates.len > 0: result = candidates[0] amb = candidates.len > 1 if amb and checkAmbiguity in flags: errorUseQualifier(c, n.info, candidates) - + else: + result = nil if result == nil and checkUndeclared in flags: - result = errorUndeclaredIdentifierHint(c, n, ident) + result = errorUndeclaredIdentifierHint(c, ident, n.info) elif checkAmbiguity in flags and result != nil and amb: result = errorUseQualifier(c, n.info, result, amb) c.isAmbiguous = amb of nkSym: result = n.sym + of nkOpenSym: + result = qualifiedLookUp(c, n[0], flags) of nkDotExpr: result = nil var m = qualifiedLookUp(c, n[0], (flags * {checkUndeclared}) + {checkModule}) if m != nil and m.kind == skModule: var ident: PIdent = nil - if n[1].kind == nkIdent: - ident = n[1].ident - elif n[1].kind == nkAccQuoted: + if n[1].kind == nkAccQuoted: ident = considerQuotedIdent(c, n[1]) + else: + # this includes sym and symchoice nodes, but since we are looking in + # a module, it shouldn't matter what was captured + ident = n[1].getPIdent if ident != nil: if m == c.module: - result = strTableGet(c.topLevelScope.symbols, ident).skipAlias(n, c.config) + var ti: TIdentIter = default(TIdentIter) + result = initIdentIter(ti, c.topLevelScope.symbols, ident) + if result != nil and nextIdentIter(ti, c.topLevelScope.symbols) != nil: + # another symbol exists with same name + c.isAmbiguous = true else: - result = someSym(c.graph, m, ident).skipAlias(n, c.config) + var amb: bool = false + if c.importModuleLookup.getOrDefault(m.name.id).len > 1: + result = errorUseQualifier(c, n.info, m, amb) + else: + result = someSymAmb(c.graph, m, ident, amb) + if amb: c.isAmbiguous = true if result == nil and checkUndeclared in flags: - result = errorUndeclaredIdentifierHint(c, n[1], ident) + result = errorUndeclaredIdentifierHint(c, ident, n[1].info) elif n[1].kind == nkSym: result = n[1].sym + if result.owner != nil and result.owner != m and checkUndeclared in flags: + # dotExpr in templates can end up here + result = errorUndeclaredIdentifierHint(c, result.name, n[1].info) elif checkUndeclared in flags and n[1].kind notin {nkOpenSymChoice, nkClosedSymChoice}: localError(c.config, n[1].info, "identifier expected, but got: " & @@ -556,15 +723,20 @@ proc qualifiedLookUp*(c: PContext, n: PNode, flags: set[TLookupFlag]): PSym = if result != nil and result.kind == skStub: loadStub(result) proc initOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = + if n.kind == nkOpenSym: + # maybe the logic in semexprs should be mirrored here instead + # for now it only seems this is called for `pickSym` in `getTypeIdent` + return initOverloadIter(o, c, n[0]) o.importIdx = -1 o.marked = initIntSet() case n.kind of nkIdent, nkAccQuoted: + result = nil var ident = considerQuotedIdent(c, n) var scope = c.currentScope o.mode = oimNoQualifier while true: - result = initIdentIter(o.it, scope.symbols, ident).skipAlias(n, c.config) + result = initIdentIter(o.it, scope.symbols, ident) if result != nil: o.currentScope = scope break @@ -572,7 +744,7 @@ proc initOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = scope = scope.parent if scope == nil: for i in 0..c.imports.high: - result = initIdentIter(o.mit, o.marked, c.imports[i], ident, c.graph).skipAlias(n, c.config) + result = initIdentIter(o.mit, o.marked, c.imports[i], ident, c.graph) if result != nil: o.currentScope = nil o.importIdx = i @@ -583,6 +755,7 @@ proc initOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = result = n.sym o.mode = oimDone of nkDotExpr: + result = nil o.mode = oimOtherModule o.m = qualifiedLookUp(c, n[0], {checkUndeclared, checkModule}) if o.m != nil and o.m.kind == skModule: @@ -595,10 +768,10 @@ proc initOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = if o.m == c.module: # a module may access its private members: result = initIdentIter(o.it, c.topLevelScope.symbols, - ident).skipAlias(n, c.config) + ident) o.mode = oimSelfModule else: - result = initModuleIter(o.mit, c.graph, o.m, ident).skipAlias(n, c.config) + result = initModuleIter(o.mit, c.graph, o.m, ident) else: noidentError(c.config, n[1], n) result = errorSym(c, n[1]) @@ -612,7 +785,7 @@ proc initOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = o.symChoiceIndex = 1 o.marked = initIntSet() incl(o.marked, result.id) - else: discard + else: result = nil when false: if result != nil and result.kind == skStub: loadStub(result) @@ -627,11 +800,12 @@ proc lastOverloadScope*(o: TOverloadIter): int = else: result = -1 proc nextOverloadIterImports(o: var TOverloadIter, c: PContext, n: PNode): PSym = + result = nil assert o.currentScope == nil var idx = o.importIdx+1 o.importIdx = c.imports.len # assume the other imported modules lack this symbol too while idx < c.imports.len: - result = initIdentIter(o.mit, o.marked, c.imports[idx], o.it.name, c.graph).skipAlias(n, c.config) + result = initIdentIter(o.mit, o.marked, c.imports[idx], o.it.name, c.graph) if result != nil: # oh, we were wrong, some other module had the symbol, so remember that: o.importIdx = idx @@ -639,9 +813,10 @@ proc nextOverloadIterImports(o: var TOverloadIter, c: PContext, n: PNode): PSym inc idx proc symChoiceExtension(o: var TOverloadIter; c: PContext; n: PNode): PSym = + result = nil assert o.currentScope == nil while o.importIdx < c.imports.len: - result = initIdentIter(o.mit, o.marked, c.imports[o.importIdx], o.it.name, c.graph).skipAlias(n, c.config) + result = initIdentIter(o.mit, o.marked, c.imports[o.importIdx], o.it.name, c.graph) #while result != nil and result.id in o.marked: # result = nextIdentIter(o.it, o.marked, c.imports[o.importIdx]) if result != nil: @@ -656,29 +831,29 @@ proc nextOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = of oimNoQualifier: if o.currentScope != nil: assert o.importIdx < 0 - result = nextIdentIter(o.it, o.currentScope.symbols).skipAlias(n, c.config) + result = nextIdentIter(o.it, o.currentScope.symbols) while result == nil: o.currentScope = o.currentScope.parent if o.currentScope != nil: - result = initIdentIter(o.it, o.currentScope.symbols, o.it.name).skipAlias(n, c.config) + result = initIdentIter(o.it, o.currentScope.symbols, o.it.name) # BUGFIX: o.it.name <-> n.ident else: o.importIdx = 0 if c.imports.len > 0: - result = initIdentIter(o.mit, o.marked, c.imports[o.importIdx], o.it.name, c.graph).skipAlias(n, c.config) + result = initIdentIter(o.mit, o.marked, c.imports[o.importIdx], o.it.name, c.graph) if result == nil: result = nextOverloadIterImports(o, c, n) break elif o.importIdx < c.imports.len: - result = nextIdentIter(o.mit, o.marked, c.imports[o.importIdx], c.graph).skipAlias(n, c.config) + result = nextIdentIter(o.mit, o.marked, c.imports[o.importIdx], c.graph) if result == nil: result = nextOverloadIterImports(o, c, n) else: result = nil of oimSelfModule: - result = nextIdentIter(o.it, c.topLevelScope.symbols).skipAlias(n, c.config) + result = nextIdentIter(o.it, c.topLevelScope.symbols) of oimOtherModule: - result = nextModuleIter(o.mit, c.graph).skipAlias(n, c.config) + result = nextModuleIter(o.mit, c.graph) of oimSymChoice: if o.symChoiceIndex < n.len: result = n[o.symChoiceIndex].sym @@ -689,26 +864,28 @@ proc nextOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = o.mode = oimSymChoiceLocalLookup o.currentScope = c.currentScope result = firstIdentExcluding(o.it, o.currentScope.symbols, - n[0].sym.name, o.marked).skipAlias(n, c.config) + n[0].sym.name, o.marked) while result == nil: o.currentScope = o.currentScope.parent if o.currentScope != nil: result = firstIdentExcluding(o.it, o.currentScope.symbols, - n[0].sym.name, o.marked).skipAlias(n, c.config) + n[0].sym.name, o.marked) else: o.importIdx = 0 result = symChoiceExtension(o, c, n) break if result != nil: incl o.marked, result.id + else: + result = nil of oimSymChoiceLocalLookup: if o.currentScope != nil: - result = nextIdentExcluding(o.it, o.currentScope.symbols, o.marked).skipAlias(n, c.config) + result = nextIdentExcluding(o.it, o.currentScope.symbols, o.marked) while result == nil: o.currentScope = o.currentScope.parent if o.currentScope != nil: result = firstIdentExcluding(o.it, o.currentScope.symbols, - n[0].sym.name, o.marked).skipAlias(n, c.config) + n[0].sym.name, o.marked) else: o.importIdx = 0 result = symChoiceExtension(o, c, n) @@ -717,20 +894,23 @@ proc nextOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = incl o.marked, result.id elif o.importIdx < c.imports.len: - result = nextIdentIter(o.mit, o.marked, c.imports[o.importIdx], c.graph).skipAlias(n, c.config) + result = nextIdentIter(o.mit, o.marked, c.imports[o.importIdx], c.graph) #assert result.id notin o.marked #while result != nil and result.id in o.marked: - # result = nextIdentIter(o.it, c.imports[o.importIdx]).skipAlias(n, c.config) + # result = nextIdentIter(o.it, c.imports[o.importIdx]) if result == nil: inc o.importIdx result = symChoiceExtension(o, c, n) + else: + result = nil when false: if result != nil and result.kind == skStub: loadStub(result) proc pickSym*(c: PContext, n: PNode; kinds: set[TSymKind]; flags: TSymFlags = {}): PSym = - var o: TOverloadIter + result = nil + var o: TOverloadIter = default(TOverloadIter) var a = initOverloadIter(o, c, n) while a != nil: if a.kind in kinds and flags <= a.flags: diff --git a/compiler/lowerings.nim b/compiler/lowerings.nim index 37405d8d9..2c9c4cb32 100644 --- a/compiler/lowerings.nim +++ b/compiler/lowerings.nim @@ -15,8 +15,11 @@ const import ast, astalgo, types, idents, magicsys, msgs, options, modulegraphs, lineinfos +when defined(nimPreviewSlimSystem): + import std/assertions + proc newDeref*(n: PNode): PNode {.inline.} = - result = newNodeIT(nkHiddenDeref, n.info, n.typ[0]) + result = newNodeIT(nkHiddenDeref, n.info, n.typ.elementType) result.add n proc newTupleAccess*(g: ModuleGraph; tup: PNode, i: int): PNode = @@ -71,14 +74,20 @@ proc lowerTupleUnpacking*(g: ModuleGraph; n: PNode; idgen: IdGenerator; owner: P let value = n.lastSon result = newNodeI(nkStmtList, n.info) - var temp = newSym(skTemp, getIdent(g.cache, genPrefix), nextSymId(idgen), - owner, value.info, g.config.options) - temp.typ = skipTypes(value.typ, abstractInst) - incl(temp.flags, sfFromGeneric) + var tempAsNode: PNode + let avoidTemp = value.kind == nkSym + if avoidTemp: + tempAsNode = value + else: + var temp = newSym(skTemp, getIdent(g.cache, genPrefix), idgen, + owner, value.info, g.config.options) + temp.typ = skipTypes(value.typ, abstractInst) + incl(temp.flags, sfFromGeneric) + tempAsNode = newSymNode(temp) var v = newNodeI(nkVarSection, value.info) - let tempAsNode = newSymNode(temp) - v.addVar(tempAsNode, value) + if not avoidTemp: + v.addVar(tempAsNode, value) result.add(v) for i in 0..<n.len-2: @@ -91,7 +100,7 @@ proc evalOnce*(g: ModuleGraph; value: PNode; idgen: IdGenerator; owner: PSym): P ## freely, multiple times. This is frequently required and such a builtin would also be ## handy to have in macros.nim. The value that can be reused is 'result.lastSon'! result = newNodeIT(nkStmtListExpr, value.info, value.typ) - var temp = newSym(skTemp, getIdent(g.cache, genPrefix), nextSymId(idgen), + var temp = newSym(skTemp, getIdent(g.cache, genPrefix), idgen, owner, value.info, g.config.options) temp.typ = skipTypes(value.typ, abstractInst) incl(temp.flags, sfFromGeneric) @@ -113,29 +122,10 @@ proc newTupleAccessRaw*(tup: PNode, i: int): PNode = proc newTryFinally*(body, final: PNode): PNode = result = newTree(nkHiddenTryStmt, body, newTree(nkFinally, final)) -proc lowerTupleUnpackingForAsgn*(g: ModuleGraph; n: PNode; idgen: IdGenerator; owner: PSym): PNode = - let value = n.lastSon - result = newNodeI(nkStmtList, n.info) - - var temp = newSym(skTemp, getIdent(g.cache, "_"), nextSymId(idgen), owner, value.info, owner.options) - var v = newNodeI(nkLetSection, value.info) - let tempAsNode = newSymNode(temp) #newIdentNode(getIdent(genPrefix & $temp.id), value.info) - - var vpart = newNodeI(nkIdentDefs, tempAsNode.info, 3) - vpart[0] = tempAsNode - vpart[1] = newNodeI(nkEmpty, value.info) - vpart[2] = value - v.add vpart - result.add(v) - - let lhs = n[0] - for i in 0..<lhs.len: - result.add newAsgnStmt(lhs[i], newTupleAccessRaw(tempAsNode, i)) - proc lowerSwap*(g: ModuleGraph; n: PNode; idgen: IdGenerator; owner: PSym): PNode = result = newNodeI(nkStmtList, n.info) # note: cannot use 'skTemp' here cause we really need the copy for the VM :-( - var temp = newSym(skVar, getIdent(g.cache, genPrefix), nextSymId(idgen), owner, n.info, owner.options) + var temp = newSym(skVar, getIdent(g.cache, genPrefix), idgen, owner, n.info, owner.options) temp.typ = n[1].typ incl(temp.flags, sfFromGeneric) incl(temp.flags, sfGenSym) @@ -154,7 +144,7 @@ proc lowerSwap*(g: ModuleGraph; n: PNode; idgen: IdGenerator; owner: PSym): PNod result.add newFastAsgnStmt(n[2], tempAsNode) proc createObj*(g: ModuleGraph; idgen: IdGenerator; owner: PSym, info: TLineInfo; final=true): PType = - result = newType(tyObject, nextTypeId(idgen), owner) + result = newType(tyObject, idgen, owner) if final: rawAddSon(result, nil) incl result.flags, tfFinal @@ -162,8 +152,7 @@ proc createObj*(g: ModuleGraph; idgen: IdGenerator; owner: PSym, info: TLineInfo rawAddSon(result, getCompilerProc(g, "RootObj").typ) result.n = newNodeI(nkRecList, info) let s = newSym(skType, getIdent(g.cache, "Env_" & toFilename(g.config, info) & "_" & $owner.name.s), - nextSymId(idgen), - owner, info, owner.options) + idgen, owner, info, owner.options) incl s.flags, sfAnon s.typ = result result.sym = s @@ -221,25 +210,30 @@ proc lookupInRecord(n: PNode, id: ItemId): PSym = if n.sym.itemId.module == id.module and n.sym.itemId.item == -abs(id.item): result = n.sym else: discard -proc addField*(obj: PType; s: PSym; cache: IdentCache; idgen: IdGenerator) = +proc addField*(obj: PType; s: PSym; cache: IdentCache; idgen: IdGenerator): PSym = # because of 'gensym' support, we have to mangle the name with its ID. # This is hacky but the clean solution is much more complex than it looks. var field = newSym(skField, getIdent(cache, s.name.s & $obj.n.len), - nextSymId(idgen), s.owner, s.info, s.options) + idgen, s.owner, s.info, s.options) field.itemId = ItemId(module: s.itemId.module, item: -s.itemId.item) let t = skipIntLit(s.typ, idgen) field.typ = t + if s.kind in {skLet, skVar, skField, skForVar}: + #field.bitsize = s.bitsize + field.alignment = s.alignment assert t.kind != tyTyped propagateToOwner(obj, t) field.position = obj.n.len - field.flags = s.flags * {sfCursor} + # sfNoInit flag for skField is used in closureiterator codegen + field.flags = s.flags * {sfCursor, sfNoInit} obj.n.add newSymNode(field) fieldCheck() + result = field proc addUniqueField*(obj: PType; s: PSym; cache: IdentCache; idgen: IdGenerator): PSym {.discardable.} = result = lookupInRecord(obj.n, s.itemId) if result == nil: - var field = newSym(skField, getIdent(cache, s.name.s & $obj.n.len), nextSymId(idgen), + var field = newSym(skField, getIdent(cache, s.name.s & $obj.n.len), idgen, s.owner, s.info, s.options) field.itemId = ItemId(module: s.itemId.module, item: -s.itemId.item) let t = skipIntLit(s.typ, idgen) @@ -261,14 +255,14 @@ proc newDotExpr*(obj, b: PSym): PNode = proc indirectAccess*(a: PNode, b: ItemId, info: TLineInfo): PNode = # returns a[].b as a node var deref = newNodeI(nkHiddenDeref, info) - deref.typ = a.typ.skipTypes(abstractInst)[0] + deref.typ = a.typ.skipTypes(abstractInst).elementType var t = deref.typ.skipTypes(abstractInst) var field: PSym while true: assert t.kind == tyObject field = lookupInRecord(t.n, b) if field != nil: break - t = t[0] + t = t.baseClass if t == nil: break t = t.skipTypes(skipPtrs) #if field == nil: @@ -284,7 +278,7 @@ proc indirectAccess*(a: PNode, b: ItemId, info: TLineInfo): PNode = proc indirectAccess*(a: PNode, b: string, info: TLineInfo; cache: IdentCache): PNode = # returns a[].b as a node var deref = newNodeI(nkHiddenDeref, info) - deref.typ = a.typ.skipTypes(abstractInst)[0] + deref.typ = a.typ.skipTypes(abstractInst).elementType var t = deref.typ.skipTypes(abstractInst) var field: PSym let bb = getIdent(cache, b) @@ -292,7 +286,7 @@ proc indirectAccess*(a: PNode, b: string, info: TLineInfo; cache: IdentCache): P assert t.kind == tyObject field = getSymFromList(t.n, bb) if field != nil: break - t = t[0] + t = t.baseClass if t == nil: break t = t.skipTypes(skipPtrs) #if field == nil: @@ -312,7 +306,7 @@ proc getFieldFromObj*(t: PType; v: PSym): PSym = assert t.kind == tyObject result = lookupInRecord(t.n, v.itemId) if result != nil: break - t = t[0] + t = t.baseClass if t == nil: break t = t.skipTypes(skipPtrs) @@ -326,17 +320,18 @@ proc indirectAccess*(a, b: PSym, info: TLineInfo): PNode = proc genAddrOf*(n: PNode; idgen: IdGenerator; typeKind = tyPtr): PNode = result = newNodeI(nkAddr, n.info, 1) result[0] = n - result.typ = newType(typeKind, nextTypeId(idgen), n.typ.owner) + result.typ = newType(typeKind, idgen, n.typ.owner) result.typ.rawAddSon(n.typ) proc genDeref*(n: PNode; k = nkHiddenDeref): PNode = result = newNodeIT(k, n.info, - n.typ.skipTypes(abstractInst)[0]) + n.typ.skipTypes(abstractInst).elementType) result.add n proc callCodegenProc*(g: ModuleGraph; name: string; info: TLineInfo = unknownLineInfo; - arg1, arg2, arg3, optionalArgs: PNode = nil): PNode = + arg1: PNode = nil, arg2: PNode = nil, + arg3: PNode = nil, optionalArgs: PNode = nil): PNode = result = newNodeI(nkCall, info) let sym = magicsys.getCompilerProc(g, name) if sym == nil: @@ -349,7 +344,7 @@ proc callCodegenProc*(g: ModuleGraph; name: string; if optionalArgs != nil: for i in 1..<optionalArgs.len-2: result.add optionalArgs[i] - result.typ = sym.typ[0] + result.typ = sym.typ.returnType proc newIntLit*(g: ModuleGraph; info: TLineInfo; value: BiggestInt): PNode = result = nkIntLit.newIntNode(value) diff --git a/compiler/magicsys.nim b/compiler/magicsys.nim index e91bdf272..1ec6b9a69 100644 --- a/compiler/magicsys.nim +++ b/compiler/magicsys.nim @@ -18,7 +18,7 @@ export createMagic proc nilOrSysInt*(g: ModuleGraph): PType = g.sysTypes[tyInt] proc newSysType(g: ModuleGraph; kind: TTypeKind, size: int): PType = - result = newType(kind, nextTypeId(g.idgen), g.systemModule) + result = newType(kind, g.idgen, g.systemModule) result.size = size result.align = size.int16 @@ -26,21 +26,21 @@ 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, {}) - result.typ = newType(tyError, nextTypeId(g.idgen), g.systemModule) - if result.kind == skAlias: result = result.owner + result = newSym(skError, getIdent(g.cache, name), g.idgen, g.systemModule, g.systemModule.info, {}) + result.typ = newType(tyError, g.idgen, g.systemModule) proc getSysMagic*(g: ModuleGraph; info: TLineInfo; name: string, m: TMagic): PSym = + result = nil let id = getIdent(g.cache, name) for r in systemModuleSyms(g, id): if r.magic == m: # prefer the tyInt variant: - if r.typ[0] != nil and r.typ[0].kind == tyInt: return r + if r.typ.returnType != nil and r.typ.returnType.kind == tyInt: return r result = r if result != nil: return result localError(g.config, info, "system module needs: " & name) - result = newSym(skError, id, nextSymId(g.idgen), g.systemModule, g.systemModule.info, {}) - result.typ = newType(tyError, nextTypeId(g.idgen), g.systemModule) + result = newSym(skError, id, g.idgen, g.systemModule, g.systemModule.info, {}) + result.typ = newType(tyError, g.idgen, g.systemModule) proc sysTypeFromName*(g: ModuleGraph; info: TLineInfo; name: string): PType = result = getSysSym(g, info, name).typ @@ -50,6 +50,7 @@ proc getSysType*(g: ModuleGraph; info: TLineInfo; kind: TTypeKind): PType = result = g.sysTypes[kind] if result == nil: case kind + of tyVoid: result = sysTypeFromName("void") of tyInt: result = sysTypeFromName("int") of tyInt8: result = sysTypeFromName("int8") of tyInt16: result = sysTypeFromName("int16") @@ -67,7 +68,7 @@ proc getSysType*(g: ModuleGraph; info: TLineInfo; kind: TTypeKind): PType = of tyBool: result = sysTypeFromName("bool") of tyChar: result = sysTypeFromName("char") of tyString: result = sysTypeFromName("string") - of tyCString: result = sysTypeFromName("cstring") + 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) @@ -80,8 +81,8 @@ proc getSysType*(g: ModuleGraph; info: TLineInfo; kind: TTypeKind): PType = proc resetSysTypes*(g: ModuleGraph) = g.systemModule = nil - initStrTable(g.compilerprocs) - initStrTable(g.exposed) + g.compilerprocs = initStrTable() + g.exposed = initStrTable() for i in low(g.sysTypes)..high(g.sysTypes): g.sysTypes[i] = nil @@ -92,16 +93,23 @@ proc getFloatLitType*(g: ModuleGraph; literal: PNode): PType = proc skipIntLit*(t: PType; id: IdGenerator): PType {.inline.} = if t.n != nil and t.kind in {tyInt, tyFloat}: - result = copyType(t, nextTypeId(id), t.owner) + result = copyType(t, id, t.owner) result.n = nil else: result = t proc addSonSkipIntLit*(father, son: PType; id: IdGenerator) = let s = son.skipIntLit(id) - father.sons.add(s) + father.add(s) propagateToOwner(father, s) +proc makeVarType*(owner: PSym; baseType: PType; idgen: IdGenerator; kind = tyVar): PType = + if baseType.kind == kind: + result = baseType + else: + result = newType(kind, idgen, owner) + addSonSkipIntLit(result, baseType, idgen) + proc getCompilerProc*(g: ModuleGraph; name: string): PSym = let ident = getIdent(g.cache, name) result = strTableGet(g.compilerprocs, ident) @@ -123,7 +131,7 @@ proc registerNimScriptSymbol*(g: ModuleGraph; s: PSym) = proc getNimScriptSymbol*(g: ModuleGraph; name: string): PSym = strTableGet(g.exposed, getIdent(g.cache, name)) -proc resetNimScriptSymbols*(g: ModuleGraph) = initStrTable(g.exposed) +proc resetNimScriptSymbols*(g: ModuleGraph) = g.exposed = initStrTable() proc getMagicEqSymForType*(g: ModuleGraph; t: PType; info: TLineInfo): PSym = case t.kind @@ -145,7 +153,17 @@ proc getMagicEqSymForType*(g: ModuleGraph; t: PType; info: TLineInfo): PSym = of tyProc: result = getSysMagic(g, info, "==", mEqProc) else: + result = nil globalError(g.config, info, "can't find magic equals operator for type kind " & $t.kind) +proc makePtrType*(baseType: PType; idgen: IdGenerator): PType = + result = newType(tyPtr, idgen, baseType.owner) + addSonSkipIntLit(result, baseType, idgen) +proc makeAddr*(n: PNode; idgen: IdGenerator): PNode = + if n.kind == nkHiddenAddr: + result = n + else: + result = newTree(nkHiddenAddr, n) + result.typ = makePtrType(n.typ, idgen) diff --git a/compiler/main.nim b/compiler/main.nim index b61cdcadb..4c52317cf 100644 --- a/compiler/main.nim +++ b/compiler/main.nim @@ -13,23 +13,27 @@ when not defined(nimcore): {.error: "nimcore MUST be defined for Nim's core tooling".} import - llstream, strutils, os, ast, lexer, syntaxes, options, msgs, - condsyms, times, - sem, idents, passes, extccomp, - cgen, json, nversion, - platform, nimconf, passaux, depends, vm, + std/[strutils, os, times, tables, with, json], + llstream, ast, lexer, syntaxes, options, msgs, + condsyms, + idents, extccomp, + cgen, nversion, + platform, nimconf, depends, modules, - modulegraphs, tables, lineinfos, pathutils, vmprofiler + modulegraphs, lineinfos, pathutils, vmprofiler -import ic / cbackend -from ic / ic import rodViewer -when not defined(leanCompiler): - import jsgen, docgen, docgen2 +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] + +import ic / [cbackend, integrity, navigator, ic] -proc semanticPasses(g: ModuleGraph) = - registerPass g, verbosePass - registerPass g, semPass +import ../dist/checksums/src/checksums/sha1 + +import pipelines + +when not defined(leanCompiler): + import docgen proc writeDepsFile(g: ModuleGraph) = let fname = g.config.nimcacheDir / RelativeFile(g.config.projectName & ".deps") @@ -42,44 +46,83 @@ proc writeDepsFile(g: ModuleGraph) = f.writeLine(toFullPath(g.config, k)) f.close() +proc writeCMakeDepsFile(conf: ConfigRef) = + ## write a list of C files for build systems like CMake. + ## only updated when the C file list changes. + let fname = getNimcacheDir(conf) / conf.outFile.changeFileExt("cdeps") + # generate output files list + var cfiles: seq[string] = @[] + for it in conf.toCompile: cfiles.add(it.cname.string) + let fileset = cfiles.toCountTable() + # read old cfiles list + var fl: File = default(File) + var prevset = initCountTable[string]() + if open(fl, fname.string, fmRead): + for line in fl.lines: prevset.inc(line) + fl.close() + # write cfiles out + if fileset != prevset: + fl = open(fname.string, fmWrite) + for line in cfiles: fl.writeLine(line) + fl.close() + proc commandGenDepend(graph: ModuleGraph) = - semanticPasses(graph) - registerPass(graph, gendependPass) - compileProject(graph) + setPipeLinePass(graph, GenDependPass) + compilePipelineProject(graph) let project = graph.config.projectFull writeDepsFile(graph) generateDot(graph, project) + + # dot in graphivz tool kit is required + let graphvizDotPath = findExe("dot") + if graphvizDotPath.len == 0: + quit("gendepend: Graphviz's tool dot is required," & + "see https://graphviz.org/download for downloading") + execExternalProgram(graph.config, "dot -Tpng -o" & changeFileExt(project, "png").string & ' ' & changeFileExt(project, "dot").string) proc commandCheck(graph: ModuleGraph) = - graph.config.setErrorMaxHighMaybe - defineSymbol(graph.config.symbols, "nimcheck") - semanticPasses(graph) # use an empty backend for semantic checking only - compileProject(graph) + let conf = graph.config + conf.setErrorMaxHighMaybe + defineSymbol(conf.symbols, "nimcheck") + if optWasNimscript in conf.globalOptions: + defineSymbol(conf.symbols, "nimscript") + defineSymbol(conf.symbols, "nimconfig") + elif conf.backend == backendJs: + setTarget(conf.target, osJS, cpuJS) + setPipeLinePass(graph, SemPass) + compilePipelineProject(graph) + + if conf.symbolFiles != disabledSf: + case conf.ideCmd + of ideDef: navDefinition(graph) + of ideUse: navUsages(graph) + of ideDus: navDefusages(graph) + else: discard + writeRodFiles(graph) when not defined(leanCompiler): - proc commandDoc2(graph: ModuleGraph; json: bool) = + proc commandDoc2(graph: ModuleGraph; ext: string) = handleDocOutputOptions graph.config graph.config.setErrorMaxHighMaybe - semanticPasses(graph) - if json: registerPass(graph, docgen2JsonPass) - else: registerPass(graph, docgen2Pass) - compileProject(graph) - finishDoc2Pass(graph.config.projectName) + case ext: + of TexExt: + setPipeLinePass(graph, Docgen2TexPass) + of JsonExt: + setPipeLinePass(graph, Docgen2JsonPass) + of HtmlExt: + setPipeLinePass(graph, Docgen2Pass) + else: raiseAssert $ext + compilePipelineProject(graph) proc commandCompileToC(graph: ModuleGraph) = let conf = graph.config - setOutFile(conf) extccomp.initVars(conf) - semanticPasses(graph) if conf.symbolFiles == disabledSf: - registerPass(graph, cgenPass) - if {optRun, optForceFullMake} * conf.globalOptions == {optRun} or isDefined(conf, "nimBetterRun"): - let proj = changeFileExt(conf.projectFull, "") - if not changeDetectedViaJsonBuildInstructions(conf, proj): + if not changeDetectedViaJsonBuildInstructions(conf, conf.jsonBuildInstructionsFile): # nothing changed graph.config.notes = graph.config.mainPackageNotes return @@ -87,12 +130,18 @@ proc commandCompileToC(graph: ModuleGraph) = if not extccomp.ccHasSaneOverflow(conf): conf.symbols.defineSymbol("nimEmulateOverflowChecks") - compileProject(graph) + if conf.symbolFiles == disabledSf: + setPipeLinePass(graph, CgenPass) + else: + setPipeLinePass(graph, SemPass) + compilePipelineProject(graph) if graph.config.errorCounter > 0: return # issue #9933 if conf.symbolFiles == disabledSf: cgenWriteModules(graph.backend, conf) else: + if isDefined(conf, "nimIcIntegrityChecks"): + checkIntegrity(graph) generateCode(graph) # graph.backend can be nil under IC when nothing changed at all: if graph.backend != nil: @@ -101,64 +150,52 @@ proc commandCompileToC(graph: ModuleGraph) = extccomp.callCCompiler(conf) # for now we do not support writing out a .json file with the build instructions when HCR is on if not conf.hcrOn: - extccomp.writeJsonBuildInstructions(conf) + extccomp.writeJsonBuildInstructions(conf, graph.cachedFiles) if optGenScript in graph.config.globalOptions: writeDepsFile(graph) + if optGenCDeps in graph.config.globalOptions: + writeCMakeDepsFile(conf) proc commandJsonScript(graph: ModuleGraph) = - let proj = changeFileExt(graph.config.projectFull, "") - extccomp.runJsonBuildInstructions(graph.config, proj) + extccomp.runJsonBuildInstructions(graph.config, graph.config.jsonBuildInstructionsFile) proc commandCompileToJS(graph: ModuleGraph) = + let conf = graph.config when defined(leanCompiler): - globalError(graph.config, unknownLineInfo, "compiler wasn't built with JS code generator") + globalError(conf, unknownLineInfo, "compiler wasn't built with JS code generator") else: - let conf = graph.config conf.exc = excCpp - - if conf.outFile.isEmpty: - conf.outFile = RelativeFile(conf.projectName & ".js") - - #incl(gGlobalOptions, optSafeCode) - setTarget(graph.config.target, osJS, cpuJS) - #initDefines() - defineSymbol(graph.config.symbols, "ecmascript") # For backward compatibility - semanticPasses(graph) - registerPass(graph, JSgenPass) - compileProject(graph) - if optGenScript in graph.config.globalOptions: + setTarget(conf.target, osJS, cpuJS) + defineSymbol(conf.symbols, "ecmascript") # For backward compatibility + setPipeLinePass(graph, JSgenPass) + compilePipelineProject(graph) + if optGenScript in conf.globalOptions: writeDepsFile(graph) -proc interactivePasses(graph: ModuleGraph) = +proc commandInteractive(graph: ModuleGraph) = + graph.config.setErrorMaxHighMaybe initDefines(graph.config.symbols) defineSymbol(graph.config.symbols, "nimscript") # note: seems redundant with -d:nimHasLibFFI when hasFFI: defineSymbol(graph.config.symbols, "nimffi") - registerPass(graph, verbosePass) - registerPass(graph, semPass) - registerPass(graph, evalPass) - -proc commandInteractive(graph: ModuleGraph) = - graph.config.setErrorMaxHighMaybe - interactivePasses(graph) - compileSystemModule(graph) + setPipeLinePass(graph, InterpreterPass) + compilePipelineSystemModule(graph) if graph.config.commandArgs.len > 0: - discard graph.compileModule(fileInfoIdx(graph.config, graph.config.projectFull), {}) + discard graph.compilePipelineModule(fileInfoIdx(graph.config, graph.config.projectFull), {}) else: var m = graph.makeStdinModule() incl(m.flags, sfMainModule) var idgen = IdGenerator(module: m.itemId.module, symId: m.itemId.item, typeId: 0) let s = llStreamOpenStdIn(onPrompt = proc() = flushDot(graph.config)) - processModule(graph, m, idgen, s) + discard processPipelineModule(graph, m, idgen, s) proc commandScan(cache: IdentCache, config: ConfigRef) = var f = addFileExt(AbsoluteFile mainCommandArg(config), NimExt) var stream = llStreamOpen(f, fmRead) if stream != nil: var - L: Lexer - tok: Token - initToken(tok) + L: Lexer = default(Lexer) + tok: Token = default(Token) openLexer(L, f, stream, cache, config) while true: rawGetTok(L, tok) @@ -175,12 +212,35 @@ proc commandView(graph: ModuleGraph) = const PrintRopeCacheStats = false +proc hashMainCompilationParams*(conf: ConfigRef): string = + ## doesn't have to be complete; worst case is a cache hit and recompilation. + var state = newSha1State() + with state: + update os.getAppFilename() # nim compiler + update conf.commandLine # excludes `arguments`, as it should + update $conf.projectFull # so that running `nim r main` from 2 directories caches differently + result = $SecureHash(state.finalize()) + +proc setOutFile*(conf: ConfigRef) = + proc libNameTmpl(conf: ConfigRef): string {.inline.} = + result = if conf.target.targetOS == osWindows: "$1.lib" else: "lib$1.a" + + if conf.outFile.isEmpty: + var base = conf.projectName + if optUseNimcache in conf.globalOptions: + base.add "_" & hashMainCompilationParams(conf) + let targetName = + if conf.backend == backendJs: base & ".js" + elif optGenDynLib in conf.globalOptions: + platform.OS[conf.target.targetOS].dllFrmt % base + elif optGenStaticLib in conf.globalOptions: libNameTmpl(conf) % base + else: base & platform.OS[conf.target.targetOS].exeExt + conf.outFile = RelativeFile targetName + proc mainCommand*(graph: ModuleGraph) = let conf = graph.config let cache = graph.cache - # In "nim serve" scenario, each command must reset the registered passes - clearPasses(graph) conf.lastCmdTime = epochTime() conf.searchPaths.add(conf.libpath) @@ -205,23 +265,25 @@ proc mainCommand*(graph: ModuleGraph) = # and it has added this define implictly, so we must undo that here. # A better solution might be to fix system.nim undefSymbol(conf.symbols, "useNimRtl") - of backendInvalid: doAssert false + of backendInvalid: raiseAssert "unreachable" proc compileToBackend() = customizeForBackend(conf.backend) + setOutFile(conf) case conf.backend of backendC: commandCompileToC(graph) of backendCpp: commandCompileToC(graph) of backendObjc: commandCompileToC(graph) of backendJs: commandCompileToJS(graph) - of backendInvalid: doAssert false + of backendInvalid: raiseAssert "unreachable" template docLikeCmd(body) = when defined(leanCompiler): - quit "compiler wasn't built with documentation generator" + conf.quitOrRaise "compiler wasn't built with documentation generator" else: wantMainModule(conf) - loadConfigs(DocConfig, cache, conf, graph.idgen) + let docConf = if conf.cmd == cmdDoc2tex: DocTexConfig else: DocConfig + loadConfigs(docConf, cache, conf, graph.idgen) defineSymbol(conf.symbols, "nimdoc") body @@ -233,13 +295,18 @@ proc mainCommand*(graph: ModuleGraph) = # so by default should not end up in $PWD nor in $projectPath. var ret = if optUseNimcache in conf.globalOptions: getNimcacheDir(conf) else: conf.projectPath - doAssert ret.string.isAbsolute # `AbsoluteDir` is not a real guarantee - if conf.cmd in cmdDocLike + {cmdRst2html, cmdRst2tex}: ret = ret / htmldocsDir + if not ret.string.isAbsolute: # `AbsoluteDir` is not a real guarantee + rawMessage(conf, errCannotOpenFile, ret.string & "/") + if conf.cmd in cmdDocLike + {cmdRst2html, cmdRst2tex, cmdMd2html, cmdMd2tex}: + ret = ret / htmldocsDir conf.outDir = ret ## process all commands case conf.cmd - of cmdBackends: compileToBackend() + of cmdBackends: + compileToBackend() + when BenchIC: + echoTimes graph.packed of cmdTcc: when hasTinyCBackend: extccomp.setCC(conf, "tcc", unknownLineInfo) @@ -249,40 +316,43 @@ proc mainCommand*(graph: ModuleGraph) = else: rawMessage(conf, errGenerated, "'run' command not available; rebuild with -d:tinyc") of cmdDoc0: docLikeCmd commandDoc(cache, conf) - of cmdDoc2: + of cmdDoc: docLikeCmd(): - conf.setNoteDefaults(warnLockLevel, false) # issue #13218 - conf.setNoteDefaults(warnRedefinitionOfLabel, false) # issue #13218 + conf.setNoteDefaults(warnRstRedefinitionOfLabel, 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 # ## * `rand proc<#rand,Rand,range[]>`_ that returns a float - commandDoc2(graph, false) + commandDoc2(graph, HtmlExt) if optGenIndex in conf.globalOptions and optWholeProject in conf.globalOptions: commandBuildIndex(conf, $conf.outDir) - of cmdRst2html: + of cmdRst2html, cmdMd2html: # XXX: why are warnings disabled by default for rst2html and rst2tex? - for warn in [warnUnknownSubstitutionX, warnLanguageXNotSupported, - warnFieldXNotSupported, warnRstStyle]: + for warn in rstWarnings: conf.setNoteDefaults(warn, true) - conf.setNoteDefaults(warnRedefinitionOfLabel, false) # similar to issue #13218 + conf.setNoteDefaults(warnRstRedefinitionOfLabel, false) # similar to issue #13218 when defined(leanCompiler): - quit "compiler wasn't built with documentation generator" + conf.quitOrRaise "compiler wasn't built with documentation generator" else: loadConfigs(DocConfig, cache, conf, graph.idgen) - commandRst2Html(cache, conf) - of cmdRst2tex: - for warn in [warnRedefinitionOfLabel, warnUnknownSubstitutionX, - warnLanguageXNotSupported, - warnFieldXNotSupported, warnRstStyle]: + commandRst2Html(cache, conf, preferMarkdown = (conf.cmd == cmdMd2html)) + of cmdRst2tex, cmdMd2tex, cmdDoc2tex: + for warn in rstWarnings: conf.setNoteDefaults(warn, true) when defined(leanCompiler): - quit "compiler wasn't built with documentation generator" + conf.quitOrRaise "compiler wasn't built with documentation generator" else: - loadConfigs(DocTexConfig, cache, conf, graph.idgen) - commandRst2TeX(cache, conf) + if conf.cmd in {cmdRst2tex, cmdMd2tex}: + loadConfigs(DocTexConfig, cache, conf, graph.idgen) + commandRst2TeX(cache, conf, preferMarkdown = (conf.cmd == cmdMd2tex)) + else: + docLikeCmd commandDoc2(graph, TexExt) of cmdJsondoc0: docLikeCmd commandJson(cache, conf) - of cmdJsondoc: docLikeCmd commandDoc2(graph, true) + of cmdJsondoc: + docLikeCmd(): + commandDoc2(graph, JsonExt) + if optGenIndex in conf.globalOptions and optWholeProject in conf.globalOptions: + commandBuildIndexJson(conf, $conf.outDir) of cmdCtags: docLikeCmd commandTags(cache, conf) of cmdBuildindex: docLikeCmd commandBuildIndex(conf, $conf.projectFull, conf.outFile) of cmdGendepend: commandGenDepend(graph) @@ -321,15 +391,21 @@ proc mainCommand*(graph: ModuleGraph) = (key: "warnings", val: warnings), ] - msgWriteln(conf, $dumpdata, {msgStdout, msgSkipHook}) + 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}) - for s in definedSymbolNames(conf.symbols): msgWriteln(conf, s, {msgStdout, msgSkipHook}) + {msgStdout, msgSkipHook, msgNoUnitSep}) + for s in definedSymbolNames(conf.symbols): msgWriteln(conf, s, {msgStdout, msgSkipHook, msgNoUnitSep}) msgWriteln(conf, "-- end of list --", {msgStdout, msgSkipHook}) for it in conf.searchPaths: msgWriteln(conf, it.string) - of cmdCheck: commandCheck(graph) + of cmdCheck: + commandCheck(graph) + of cmdM: + graph.config.symbolFiles = v2Sf + setUseIc(graph.config.symbolFiles != disabledSf) + commandCheck(graph) of cmdParse: wantMainModule(conf) discard parseFile(conf.projectMainIdx, cache, conf) @@ -342,46 +418,18 @@ proc mainCommand*(graph: ModuleGraph) = if conf.projectIsCmd or conf.projectIsStdin: discard elif not fileExists(conf.projectFull): rawMessage(conf, errGenerated, "NimScript file does not exist: " & conf.projectFull.string) - elif not conf.projectFull.string.endsWith(".nims"): - rawMessage(conf, errGenerated, "not a NimScript file: " & conf.projectFull.string) # main NimScript logic handled in `loadConfigs`. of cmdNop: discard of cmdJsonscript: setOutFile(graph.config) commandJsonScript(graph) - of cmdUnknown, cmdNone, cmdIdeTools, cmdNimfix: + of cmdUnknown, cmdNone, cmdIdeTools: rawMessage(conf, errGenerated, "invalid command: " & conf.command) if conf.errorCounter == 0 and conf.cmd notin {cmdTcc, cmdDump, cmdNop}: - let mem = - when declared(system.getMaxMem): formatSize(getMaxMem()) & " peakmem" - else: formatSize(getTotalMem()) & " totmem" - let loc = $conf.linesCompiled - let build = if isDefined(conf, "danger"): "Dangerous Release" - elif isDefined(conf, "release"): "Release" - else: "Debug" - let sec = formatFloat(epochTime() - conf.lastCmdTime, ffDecimal, 3) - let project = if optListFullPaths in conf.globalOptions: $conf.projectFull else: $conf.projectName - - var output: string - if optCompileOnly in conf.globalOptions and conf.cmd != cmdJsonscript: - output = $conf.jsonBuildFile - elif conf.outFile.isEmpty and conf.cmd notin {cmdJsonscript} + cmdDocLike + cmdBackends: - # for some cmd we expect a valid absOutFile - output = "unknownOutput" - else: - output = $conf.absOutFile - if optListFullPaths notin conf.globalOptions: output = output.AbsoluteFile.extractFilename if optProfileVM in conf.globalOptions: echo conf.dump(conf.vmProfileData) - rawMessage(conf, hintSuccessX, [ - "loc", loc, - "sec", sec, - "mem", mem, - "build", build, - "project", project, - "output", output, - ]) + genSuccessX(conf) when PrintRopeCacheStats: echo "rope cache stats: " diff --git a/compiler/mangleutils.nim b/compiler/mangleutils.nim new file mode 100644 index 000000000..2ae954518 --- /dev/null +++ b/compiler/mangleutils.nim @@ -0,0 +1,59 @@ +import std/strutils +import ast, modulegraphs + +proc mangle*(name: string): string = + result = newStringOfCap(name.len) + var start = 0 + if name[0] in Digits: + result.add("X" & name[0]) + start = 1 + var requiresUnderscore = false + template special(x) = + result.add x + requiresUnderscore = true + for i in start..<name.len: + let c = name[i] + case c + of 'a'..'z', '0'..'9', 'A'..'Z': + result.add(c) + of '_': + # we generate names like 'foo_9' for scope disambiguations and so + # disallow this here: + if i > 0 and i < name.len-1 and name[i+1] in Digits: + discard + else: + result.add(c) + of '$': special "dollar" + of '%': special "percent" + of '&': special "amp" + of '^': special "roof" + of '!': special "emark" + of '?': special "qmark" + of '*': special "star" + of '+': special "plus" + of '-': special "minus" + of '/': special "slash" + of '\\': special "backslash" + of '=': special "eq" + of '<': special "lt" + of '>': special "gt" + of '~': special "tilde" + of ':': special "colon" + of '.': special "dot" + of '@': special "at" + of '|': special "bar" + else: + result.add("X" & toHex(ord(c), 2)) + requiresUnderscore = true + if requiresUnderscore: + result.add "_" + +proc mangleParamExt*(s: PSym): string = + result = "_p" + result.addInt s.position + +proc mangleProcNameExt*(graph: ModuleGraph, s: PSym): string = + result = "__" + result.add graph.ifaces[s.itemId.module].uniqueName + result.add "_u" + result.addInt s.itemId.item # s.disamb # diff --git a/compiler/modulegraphs.nim b/compiler/modulegraphs.nim index 9ac76457c..77762d23a 100644 --- a/compiler/modulegraphs.nim +++ b/compiler/modulegraphs.nim @@ -11,10 +11,15 @@ ## represents a complete Nim project. Single modules can either be kept in RAM ## or stored in a rod-file. -import std / [intsets, tables, hashes, md5] -import ast, astalgo, options, lineinfos,idents, btrees, ropes, msgs, pathutils +import std/[intsets, tables, hashes, strtabs, algorithm, os, strutils, parseutils] +import ../dist/checksums/src/checksums/md5 +import ast, astalgo, options, lineinfos,idents, btrees, ropes, msgs, pathutils, packages, suggestsymdb import ic / [packed_ast, ic] + +when defined(nimPreviewSlimSystem): + import std/assertions + type SigHash* = distinct MD5Digest @@ -29,6 +34,7 @@ type patterns*: seq[LazySym] pureEnums*: seq[LazySym] interf: TStrTable + interfHidden: TStrTable uniqueName*: Rope Operators* = object @@ -49,25 +55,39 @@ type concreteTypes*: seq[FullId] inst*: PInstantiation - ModuleGraph* = ref object + PipelinePass* = enum + NonePass + SemPass + JSgenPass + CgenPass + EvalPass + InterpreterPass + GenDependPass + Docgen2TexPass + Docgen2JsonPass + Docgen2Pass + + ModuleGraph* {.acyclic.} = ref object ifaces*: seq[Iface] ## indexed by int32 fileIdx packed*: PackedModuleGraph encoders*: seq[PackedEncoder] typeInstCache*: Table[ItemId, seq[LazyType]] # A symbol's ItemId. procInstCache*: Table[ItemId, seq[LazyInstantiation]] # A symbol's ItemId. - attachedOps*: array[TTypeAttachedOp, Table[ItemId, PSym]] # Type ID, destructors, etc. - methodsPerType*: Table[ItemId, seq[(int, LazySym)]] # Type ID, attached methods + attachedOps*: array[TTypeAttachedOp, Table[ItemId, LazySym]] # Type ID, destructors, etc. + methodsPerGenericType*: Table[ItemId, seq[(int, LazySym)]] # Type ID, attached methods + memberProcsPerType*: Table[ItemId, seq[PSym]] # Type ID, attached member procs (only c++, virtual,member and ctor so far). + initializersPerType*: Table[ItemId, PNode] # Type ID, AST call to the default ctor (c++ only) enumToStringProcs*: Table[ItemId, LazySym] emittedTypeInfo*: Table[string, FileIndex] startupPackedConfig*: PackedConfig packageSyms*: TStrTable - modulesPerPackage*: Table[ItemId, TStrTable] deps*: IntSet # the dependency graph or potentially its transitive closure. importDeps*: Table[FileIndex, seq[FileIndex]] # explicit import module dependencies suggestMode*: bool # whether we are in nimsuggest mode or not. invalidTransitiveClosure: bool + interactive*: bool inclToMod*: Table[FileIndex, FileIndex] # mapping of include file to the # first module that included it importStack*: seq[FileIndex] # The current import stack. Used for detecting recursive @@ -77,10 +97,18 @@ type cache*: IdentCache vm*: RootRef # unfortunately the 'vm' state is shared project-wise, this will # be clarified in later compiler implementations. + repl*: RootRef # REPL state is shared project-wise. doStopCompile*: proc(): bool {.closure.} usageSym*: PSym # for nimsuggest owners*: seq[PSym] + suggestSymbols*: SuggestSymbolDatabase + suggestErrors*: Table[FileIndex, seq[Suggest]] methods*: seq[tuple[methods: seq[PSym], dispatcher: PSym]] # needs serialization! + bucketTable*: CountTable[ItemId] + objectTree*: Table[ItemId, seq[tuple[depth: int, value: PType]]] + methodsPerType*: Table[ItemId, seq[LazySym]] + dispatchers*: seq[LazySym] + systemModule*: PSym sysTypes*: array[TTypeKind, PType] compilerprocs*: TStrTable @@ -95,6 +123,7 @@ type cacheCounters*: Table[string, BiggestInt] # IC: implemented cacheTables*: Table[string, BTree[string, PNode]] # IC: implemented passes*: seq[TPass] + pipelinePass*: PipelinePass onDefinition*: proc (graph: ModuleGraph; s: PSym; info: TLineInfo) {.nimcall.} onDefinitionResolveForward*: proc (graph: ModuleGraph; s: PSym; info: TLineInfo) {.nimcall.} onUsage*: proc (graph: ModuleGraph; s: PSym; info: TLineInfo) {.nimcall.} @@ -104,6 +133,8 @@ type idgen*: IdGenerator operators*: Operators + cachedFiles*: StringTableRef + TPassContext* = object of RootObj # the pass's context idgen*: IdGenerator PPassContext* = ref TPassContext @@ -118,13 +149,15 @@ type isFrontend: bool] proc resetForBackend*(g: ModuleGraph) = - initStrTable(g.compilerprocs) + g.compilerprocs = initStrTable() g.typeInstCache.clear() g.procInstCache.clear() for a in mitems(g.attachedOps): a.clear() - g.methodsPerType.clear() + g.methodsPerGenericType.clear() g.enumToStringProcs.clear() + g.dispatchers.setLen(0) + g.methodsPerType.clear() const cb64 = [ @@ -160,16 +193,32 @@ proc toBase64a(s: cstring, len: int): string = result.add cb64[a shr 2] result.add cb64[(a and 3) shl 4] -template semtab*(m: PSym; g: ModuleGraph): TStrTable = +template interfSelect(iface: Iface, importHidden: bool): TStrTable = + var ret = iface.interf.addr # without intermediate ptr, it creates a copy and compiler becomes 15x slower! + if importHidden: ret = iface.interfHidden.addr + ret[] + +template semtab(g: ModuleGraph, m: PSym): TStrTable = g.ifaces[m.position].interf +template semtabAll*(g: ModuleGraph, m: PSym): TStrTable = + g.ifaces[m.position].interfHidden + +proc initStrTables*(g: ModuleGraph, m: PSym) = + semtab(g, m) = initStrTable() + semtabAll(g, m) = initStrTable() + +proc strTableAdds*(g: ModuleGraph, m: PSym, s: PSym) = + strTableAdd(semtab(g, m), s) + strTableAdd(semtabAll(g, m), s) + proc isCachedModule(g: ModuleGraph; module: int): bool {.inline.} = result = module < g.packed.len and g.packed[module].status == loaded -proc isCachedModule(g: ModuleGraph; m: PSym): bool {.inline.} = +proc isCachedModule*(g: ModuleGraph; m: PSym): bool {.inline.} = isCachedModule(g, m.position) -proc simulateCachedModule*(g: ModuleGraph; moduleSym: PSym; m: PackedModule) = +proc simulateCachedModule(g: ModuleGraph; moduleSym: PSym; m: PackedModule) = when false: echo "simulating ", moduleSym.name.s, " ", moduleSym.position simulateLoadedModule(g.packed, g.config, g.cache, moduleSym, m) @@ -187,45 +236,68 @@ type modIndex: int ti: TIdentIter rodIt: RodIter + importHidden: bool proc initModuleIter*(mi: var ModuleIter; g: ModuleGraph; m: PSym; name: PIdent): PSym = assert m.kind == skModule mi.modIndex = m.position mi.fromRod = isCachedModule(g, mi.modIndex) + mi.importHidden = optImportHidden in m.options if mi.fromRod: - result = initRodIter(mi.rodIt, g.config, g.cache, g.packed, FileIndex mi.modIndex, name) + result = initRodIter(mi.rodIt, g.config, g.cache, g.packed, FileIndex mi.modIndex, name, mi.importHidden) else: - result = initIdentIter(mi.ti, g.ifaces[mi.modIndex].interf, name) + result = initIdentIter(mi.ti, g.ifaces[mi.modIndex].interfSelect(mi.importHidden), name) proc nextModuleIter*(mi: var ModuleIter; g: ModuleGraph): PSym = if mi.fromRod: result = nextRodIter(mi.rodIt, g.packed) else: - result = nextIdentIter(mi.ti, g.ifaces[mi.modIndex].interf) + result = nextIdentIter(mi.ti, g.ifaces[mi.modIndex].interfSelect(mi.importHidden)) iterator allSyms*(g: ModuleGraph; m: PSym): PSym = + let importHidden = optImportHidden in m.options if isCachedModule(g, m): - var rodIt: RodIter - var r = initRodIterAllSyms(rodIt, g.config, g.cache, g.packed, FileIndex m.position) + var rodIt: RodIter = default(RodIter) + var r = initRodIterAllSyms(rodIt, g.config, g.cache, g.packed, FileIndex m.position, importHidden) while r != nil: yield r r = nextRodIter(rodIt, g.packed) else: - for s in g.ifaces[m.position].interf.data: + for s in g.ifaces[m.position].interfSelect(importHidden).data: if s != nil: yield s proc someSym*(g: ModuleGraph; m: PSym; name: PIdent): PSym = + let importHidden = optImportHidden in m.options if isCachedModule(g, m): - result = interfaceSymbol(g.config, g.cache, g.packed, FileIndex(m.position), name) + result = interfaceSymbol(g.config, g.cache, g.packed, FileIndex(m.position), name, importHidden) else: - result = strTableGet(g.ifaces[m.position].interf, name) + result = strTableGet(g.ifaces[m.position].interfSelect(importHidden), name) + +proc someSymAmb*(g: ModuleGraph; m: PSym; name: PIdent; amb: var bool): PSym = + let importHidden = optImportHidden in m.options + if isCachedModule(g, m): + result = nil + for s in interfaceSymbols(g.config, g.cache, g.packed, FileIndex(m.position), name, importHidden): + if result == nil: + # set result to the first symbol + result = s + else: + # another symbol found + amb = true + break + else: + var ti: TIdentIter = default(TIdentIter) + result = initIdentIter(ti, g.ifaces[m.position].interfSelect(importHidden), name) + if result != nil and nextIdentIter(ti, g.ifaces[m.position].interfSelect(importHidden)) != nil: + # another symbol exists with same name + amb = true proc systemModuleSym*(g: ModuleGraph; name: PIdent): PSym = result = someSym(g, g.systemModule, name) iterator systemModuleSyms*(g: ModuleGraph; name: PIdent): PSym = - var mi: ModuleIter + var mi: ModuleIter = default(ModuleIter) var r = initModuleIter(mi, g, g.systemModule, name) while r != nil: yield r @@ -256,6 +328,13 @@ proc resolveInst(g: ModuleGraph; t: var LazyInstantiation): PInstantiation = t.inst = result assert result != nil +proc resolveAttachedOp*(g: ModuleGraph; t: var LazySym): PSym = + result = t.sym + if result == nil: + result = loadSymFromId(g.config, g.cache, g.packed, t.id.module, t.id.packed) + t.sym = result + assert result != nil + iterator typeInstCacheItems*(g: ModuleGraph; s: PSym): PType = if g.typeInstCache.contains(s.itemId): let x = addr(g.typeInstCache[s.itemId]) @@ -268,25 +347,50 @@ iterator procInstCacheItems*(g: ModuleGraph; s: PSym): PInstantiation = for t in mitems(x[]): yield resolveInst(g, t) + proc getAttachedOp*(g: ModuleGraph; t: PType; op: TTypeAttachedOp): PSym = ## returns the requested attached operation for type `t`. Can return nil ## if no such operation exists. - result = g.attachedOps[op].getOrDefault(t.itemId) + if g.attachedOps[op].contains(t.itemId): + result = resolveAttachedOp(g, g.attachedOps[op][t.itemId]) + else: + result = nil proc setAttachedOp*(g: ModuleGraph; module: int; t: PType; op: TTypeAttachedOp; value: PSym) = ## we also need to record this to the packed module. - g.attachedOps[op][t.itemId] = value + g.attachedOps[op][t.itemId] = LazySym(sym: value) proc setAttachedOpPartial*(g: ModuleGraph; module: int; t: PType; op: TTypeAttachedOp; value: PSym) = ## we also need to record this to the packed module. - g.attachedOps[op][t.itemId] = value - # XXX Also add to the packed module! + g.attachedOps[op][t.itemId] = LazySym(sym: value) proc completePartialOp*(g: ModuleGraph; module: int; t: PType; op: TTypeAttachedOp; value: PSym) = if g.config.symbolFiles != disabledSf: assert module < g.encoders.len assert isActive(g.encoders[module]) toPackedGeneratedProcDef(value, g.encoders[module], g.packed[module].fromDisk) + #storeAttachedProcDef(t, op, value, g.encoders[module], g.packed[module].fromDisk) + +iterator getDispatchers*(g: ModuleGraph): PSym = + for i in g.dispatchers.mitems: + yield resolveSym(g, i) + +proc addDispatchers*(g: ModuleGraph, value: PSym) = + # TODO: add it for packed modules + g.dispatchers.add LazySym(sym: value) + +iterator resolveLazySymSeq(g: ModuleGraph, list: var seq[LazySym]): PSym = + for it in list.mitems: + yield resolveSym(g, it) + +proc setMethodsPerType*(g: ModuleGraph; id: ItemId, methods: seq[LazySym]) = + # TODO: add it for packed modules + g.methodsPerType[id] = methods + +iterator getMethodsPerType*(g: ModuleGraph; t: PType): PSym = + if g.methodsPerType.contains(t.itemId): + for it in mitems g.methodsPerType[t.itemId]: + yield resolveSym(g, it) proc getToStringProc*(g: ModuleGraph; t: PType): PSym = result = resolveSym(g, g.enumToStringProcs[t.itemId]) @@ -296,12 +400,12 @@ proc setToStringProc*(g: ModuleGraph; t: PType; value: PSym) = g.enumToStringProcs[t.itemId] = LazySym(sym: value) iterator methodsForGeneric*(g: ModuleGraph; t: PType): (int, PSym) = - if g.methodsPerType.contains(t.itemId): - for it in mitems g.methodsPerType[t.itemId]: + if g.methodsPerGenericType.contains(t.itemId): + for it in mitems g.methodsPerGenericType[t.itemId]: yield (it[0], resolveSym(g, it[1])) proc addMethodToGeneric*(g: ModuleGraph; module: int; t: PType; col: int; m: PSym) = - g.methodsPerType.mgetOrPut(t.itemId, @[]).add (col, LazySym(sym: m)) + g.methodsPerGenericType.mgetOrPut(t.itemId, @[]).add (col, LazySym(sym: m)) proc hasDisabledAsgn*(g: ModuleGraph; t: PType): bool = let op = getAttachedOp(g, t, attachedAsgn) @@ -314,10 +418,11 @@ proc copyTypeProps*(g: ModuleGraph; module: int; dest, src: PType) = setAttachedOp(g, module, dest, k, op) proc loadCompilerProc*(g: ModuleGraph; name: string): PSym = + result = nil if g.config.symbolFiles == disabledSf: return nil # slow, linear search, but the results are cached: - for module in 0..high(g.packed): + for module in 0..<len(g.packed): #if isCachedModule(g, module): let x = searchForCompilerproc(g.packed[module], name) if x >= 0: @@ -326,6 +431,10 @@ proc loadCompilerProc*(g: ModuleGraph; name: string): PSym = strTableAdd(g.compilerprocs, result) return result +proc loadPackedSym*(g: ModuleGraph; s: var LazySym) = + if s.sym == nil: + s.sym = loadSymFromId(g.config, g.cache, g.packed, s.id.module, s.id.packed) + proc `$`*(u: SigHash): string = toBase64a(cast[cstring](unsafeAddr u), sizeof(u)) @@ -339,27 +448,13 @@ proc hash*(u: SigHash): Hash = proc hash*(x: FileIndex): Hash {.borrow.} -when defined(nimfind): - template onUse*(info: TLineInfo; s: PSym) = - when compiles(c.c.graph): - if c.c.graph.onUsage != nil: c.c.graph.onUsage(c.c.graph, s, info) - else: - if c.graph.onUsage != nil: c.graph.onUsage(c.graph, s, info) - - template onDef*(info: TLineInfo; s: PSym) = - when compiles(c.c.graph): - if c.c.graph.onDefinition != nil: c.c.graph.onDefinition(c.c.graph, s, info) - else: - if c.graph.onDefinition != nil: c.graph.onDefinition(c.graph, s, info) - - template onDefResolveForward*(info: TLineInfo; s: PSym) = - when compiles(c.c.graph): - if c.c.graph.onDefinitionResolveForward != nil: - c.c.graph.onDefinitionResolveForward(c.c.graph, s, info) - else: - if c.graph.onDefinitionResolveForward != nil: - c.graph.onDefinitionResolveForward(c.graph, s, info) +template getPContext(): untyped = + when c is PContext: c + else: c.c +when defined(nimsuggest): + template onUse*(info: TLineInfo; s: PSym) = discard + template onDefResolveForward*(info: TLineInfo; s: PSym) = discard else: template onUse*(info: TLineInfo; s: PSym) = discard template onDef*(info: TLineInfo; s: PSym) = discard @@ -369,13 +464,56 @@ proc stopCompile*(g: ModuleGraph): bool {.inline.} = result = g.doStopCompile != nil and g.doStopCompile() proc createMagic*(g: ModuleGraph; idgen: IdGenerator; name: string, m: TMagic): PSym = - result = newSym(skProc, getIdent(g.cache, name), nextSymId(idgen), nil, unknownLineInfo, {}) + result = newSym(skProc, getIdent(g.cache, name), idgen, nil, unknownLineInfo, {}) result.magic = m result.flags = {sfNeverRaises} proc createMagic(g: ModuleGraph; name: string, m: TMagic): PSym = result = createMagic(g, g.idgen, name, m) +proc uniqueModuleName*(conf: ConfigRef; m: PSym): string = + ## The unique module name is guaranteed to only contain {'A'..'Z', 'a'..'z', '0'..'9', '_'} + ## so that it is useful as a C identifier snippet. + let fid = FileIndex(m.position) + let path = AbsoluteFile toFullPath(conf, fid) + var isLib = false + var rel = "" + if path.string.startsWith(conf.libpath.string): + isLib = true + rel = relativeTo(path, conf.libpath).string + else: + rel = relativeTo(path, conf.projectPath).string + + if not isLib and not belongsToProjectPackage(conf, m): + # special handlings for nimble packages + when DirSep == '\\': + let rel2 = replace(rel, '\\', '/') + else: + let rel2 = rel + const pkgs2 = "pkgs2/" + var start = rel2.find(pkgs2) + if start >= 0: + start += pkgs2.len + start += skipUntil(rel2, {'/'}, start) + if start+1 < rel2.len: + rel = "pkg/" & rel2[start+1..<rel.len] # strips paths + + let trunc = if rel.endsWith(".nim"): rel.len - len(".nim") else: rel.len + result = newStringOfCap(trunc) + for i in 0..<trunc: + let c = rel[i] + case c + of 'a'..'z', '0'..'9': + result.add c + of {os.DirSep, os.AltSep}: + result.add 'Z' # because it looks a bit like '/' + of '.': + result.add 'O' # a circle + else: + # We mangle upper letters too so that there cannot + # be clashes with our special meanings of 'Z' and 'O' + result.addInt ord(c) + proc registerModule*(g: ModuleGraph; m: PSym) = assert m != nil assert m.kind == skModule @@ -384,49 +522,51 @@ proc registerModule*(g: ModuleGraph; m: PSym) = setLen(g.ifaces, m.position + 1) if m.position >= g.packed.len: - setLen(g.packed, m.position + 1) + setLen(g.packed.pm, m.position + 1) g.ifaces[m.position] = Iface(module: m, converters: @[], patterns: @[], - uniqueName: rope(uniqueModuleName(g.config, FileIndex(m.position)))) - initStrTable(g.ifaces[m.position].interf) + uniqueName: rope(uniqueModuleName(g.config, m))) + initStrTables(g, m) proc registerModuleById*(g: ModuleGraph; m: FileIndex) = registerModule(g, g.packed[int m].module) -proc initOperators(g: ModuleGraph): Operators = +proc initOperators*(g: ModuleGraph): Operators = # These are safe for IC. - result.opLe = createMagic(g, "<=", mLeI) - result.opLt = createMagic(g, "<", mLtI) - result.opAnd = createMagic(g, "and", mAnd) - result.opOr = createMagic(g, "or", mOr) - result.opIsNil = createMagic(g, "isnil", mIsNil) - result.opEq = createMagic(g, "==", mEqI) - result.opAdd = createMagic(g, "+", mAddI) - result.opSub = createMagic(g, "-", mSubI) - result.opMul = createMagic(g, "*", mMulI) - result.opDiv = createMagic(g, "div", mDivI) - result.opLen = createMagic(g, "len", mLengthSeq) - result.opNot = createMagic(g, "not", mNot) - result.opContains = createMagic(g, "contains", mInSet) - -proc newModuleGraph*(cache: IdentCache; config: ConfigRef): ModuleGraph = - result = ModuleGraph() + # Public because it's used by DrNim. + result = Operators( + opLe: createMagic(g, "<=", mLeI), + opLt: createMagic(g, "<", mLtI), + opAnd: createMagic(g, "and", mAnd), + opOr: createMagic(g, "or", mOr), + opIsNil: createMagic(g, "isnil", mIsNil), + opEq: createMagic(g, "==", mEqI), + opAdd: createMagic(g, "+", mAddI), + opSub: createMagic(g, "-", mSubI), + opMul: createMagic(g, "*", mMulI), + opDiv: createMagic(g, "div", mDivI), + opLen: createMagic(g, "len", mLengthSeq), + opNot: createMagic(g, "not", mNot), + opContains: createMagic(g, "contains", mInSet) + ) + +proc initModuleGraphFields(result: ModuleGraph) = # A module ID of -1 means that the symbol is not attached to a module at all, # but to the module graph: result.idgen = IdGenerator(module: -1'i32, symId: 0'i32, typeId: 0'i32) - initStrTable(result.packageSyms) + result.packageSyms = initStrTable() result.deps = initIntSet() result.importDeps = initTable[FileIndex, seq[FileIndex]]() result.ifaces = @[] result.importStack = @[] result.inclToMod = initTable[FileIndex, FileIndex]() - result.config = config - result.cache = cache result.owners = @[] + result.suggestSymbols = initTable[FileIndex, SuggestFileSymbolDatabase]() + result.suggestErrors = initTable[FileIndex, seq[Suggest]]() result.methods = @[] - initStrTable(result.compilerprocs) - initStrTable(result.exposed) - initStrTable(result.packageTypes) + result.compilerprocs = initStrTable() + result.exposed = initStrTable() + result.packageTypes = initStrTable() result.emptyNode = newNode(nkEmpty) result.cacheSeqs = initTable[string, PNode]() result.cacheCounters = initTable[string, BiggestInt]() @@ -435,9 +575,16 @@ proc newModuleGraph*(cache: IdentCache; config: ConfigRef): ModuleGraph = result.symBodyHashes = initTable[int, SigHash]() result.operators = initOperators(result) result.emittedTypeInfo = initTable[string, FileIndex]() + result.cachedFiles = newStringTable() + +proc newModuleGraph*(cache: IdentCache; config: ConfigRef): ModuleGraph = + result = ModuleGraph() + result.config = config + result.cache = cache + initModuleGraphFields(result) proc resetAllModules*(g: ModuleGraph) = - initStrTable(g.packageSyms) + g.packageSyms = initStrTable() g.deps = initIntSet() g.ifaces = @[] g.importStack = @[] @@ -445,21 +592,37 @@ proc resetAllModules*(g: ModuleGraph) = g.usageSym = nil g.owners = @[] g.methods = @[] - initStrTable(g.compilerprocs) - initStrTable(g.exposed) + g.compilerprocs = initStrTable() + g.exposed = initStrTable() + initModuleGraphFields(g) proc getModule*(g: ModuleGraph; fileIdx: FileIndex): PSym = + result = nil if fileIdx.int32 >= 0: if isCachedModule(g, fileIdx.int32): result = g.packed[fileIdx.int32].module elif fileIdx.int32 < g.ifaces.len: result = g.ifaces[fileIdx.int32].module +proc moduleOpenForCodegen*(g: ModuleGraph; m: FileIndex): bool {.inline.} = + if g.config.symbolFiles == disabledSf: + result = true + else: + result = g.packed[m.int32].status notin {undefined, stored, loaded} + proc rememberEmittedTypeInfo*(g: ModuleGraph; m: FileIndex; ti: string) = #assert(not isCachedModule(g, m.int32)) if g.config.symbolFiles != disabledSf: #assert g.encoders[m.int32].isActive + assert g.packed[m.int32].status != stored g.packed[m.int32].fromDisk.emittedTypeInfo.add ti + #echo "added typeinfo ", m.int32, " ", ti, " suspicious ", not g.encoders[m.int32].isActive + +proc rememberFlag*(g: ModuleGraph; m: PSym; flag: ModuleBackendFlag) = + if g.config.symbolFiles != disabledSf: + #assert g.encoders[m.int32].isActive + assert g.packed[m.position].status != stored + g.packed[m.position].fromDisk.backendFlags.incl flag proc closeRodFile*(g: ModuleGraph; m: PSym) = if g.config.symbolFiles in {readOnlySf, v2Sf}: @@ -469,6 +632,8 @@ proc closeRodFile*(g: ModuleGraph; m: PSym) = let mint = m.position saveRodFile(toRodFile(g.config, AbsoluteFile toFullPath(g.config, FileIndex(mint))), g.encoders[mint], g.packed[mint].fromDisk) + g.packed[mint].status = stored + elif g.config.symbolFiles == stressTest: # debug code, but maybe a good idea for production? Could reduce the compiler's # memory consumption considerably at the cost of more loads from disk. @@ -509,7 +674,19 @@ proc transitiveClosure(g: var IntSet; n: int) = proc markDirty*(g: ModuleGraph; fileIdx: FileIndex) = let m = g.getModule fileIdx - if m != nil: incl m.flags, sfDirty + if m != nil: + g.suggestSymbols.del(fileIdx) + g.suggestErrors.del(fileIdx) + incl m.flags, sfDirty + +proc unmarkAllDirty*(g: ModuleGraph) = + for i in 0i32..<g.ifaces.len.int32: + let m = g.ifaces[i].module + if m != nil: + m.flags.excl sfDirty + +proc isDirty*(g: ModuleGraph; m: PSym): bool = + result = g.suggestMode and sfDirty in m.flags proc markClientsDirty*(g: ModuleGraph; fileIdx: FileIndex) = # we need to mark its dependent modules D as dirty right away because after @@ -521,12 +698,28 @@ proc markClientsDirty*(g: ModuleGraph; fileIdx: FileIndex) = # every module that *depends* on this file is also dirty: for i in 0i32..<g.ifaces.len.int32: + if g.deps.contains(i.dependsOn(fileIdx.int)): + g.markDirty(FileIndex(i)) + +proc needsCompilation*(g: ModuleGraph): bool = + # every module that *depends* on this file is also dirty: + result = false + for i in 0i32..<g.ifaces.len.int32: let m = g.ifaces[i].module - if m != nil and g.deps.contains(i.dependsOn(fileIdx.int)): - incl m.flags, sfDirty + if m != nil: + if sfDirty in m.flags: + return true -proc isDirty*(g: ModuleGraph; m: PSym): bool = - result = g.suggestMode and sfDirty in m.flags +proc needsCompilation*(g: ModuleGraph, fileIdx: FileIndex): bool = + result = false + let module = g.getModule(fileIdx) + if module != nil and g.isDirty(module): + return true + + for i in 0i32..<g.ifaces.len.int32: + let m = g.ifaces[i].module + if m != nil and g.isDirty(m) and g.deps.contains(fileIdx.int32.dependsOn(i)): + return true proc getBody*(g: ModuleGraph; s: PSym): PNode {.inline.} = result = s.ast[bodyPos] @@ -540,6 +733,47 @@ proc moduleFromRodFile*(g: ModuleGraph; fileIdx: FileIndex; ## Returns 'nil' if the module needs to be recompiled. if g.config.symbolFiles in {readOnlySf, v2Sf, stressTest}: result = moduleFromRodFile(g.packed, g.config, g.cache, fileIdx, cachedModules) + else: + result = nil proc configComplete*(g: ModuleGraph) = rememberStartupConfig(g.startupPackedConfig, g.config) + +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: + 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]) + +proc getPackage*(graph: ModuleGraph; fileIdx: FileIndex): PSym = + ## Returns a package symbol for yet to be defined module for fileIdx. + ## The package symbol is added to the graph if it doesn't exist. + let pkgSym = getPackage(graph.config, graph.cache, fileIdx) + # check if the package is already in the graph + result = graph.packageSyms.strTableGet(pkgSym.name) + if result == nil: + # the package isn't in the graph, so create and add it + result = pkgSym + graph.packageSyms.strTableAdd(pkgSym) + +func belongsToStdlib*(graph: ModuleGraph, sym: PSym): bool = + ## Check if symbol belongs to the 'stdlib' package. + sym.getPackageSymbol.getPackageId == graph.systemModule.getPackageId + +proc fileSymbols*(graph: ModuleGraph, fileIdx: FileIndex): SuggestFileSymbolDatabase = + result = graph.suggestSymbols.getOrDefault(fileIdx, newSuggestFileSymbolDatabase(fileIdx, optIdeExceptionInlayHints in graph.config.globalOptions)) + doAssert(result.fileIndex == fileIdx) + +iterator suggestSymbolsIter*(g: ModuleGraph): SymInfoPair = + for xs in g.suggestSymbols.values: + for i in xs.lineInfo.low..xs.lineInfo.high: + yield xs.getSymInfoPair(i) + +iterator suggestErrorsIter*(g: ModuleGraph): Suggest = + for xs in g.suggestErrors.values: + for x in xs: + yield x diff --git a/compiler/modulepaths.nim b/compiler/modulepaths.nim index 8511b1592..c9e6060e5 100644 --- a/compiler/modulepaths.nim +++ b/compiler/modulepaths.nim @@ -7,102 +7,10 @@ # distribution, for details about the copyright. # -import ast, renderer, strutils, msgs, options, idents, os, lineinfos, +import ast, renderer, msgs, options, idents, lineinfos, pathutils -when false: - const - considerParentDirs = not defined(noParentProjects) - considerNimbleDirs = not defined(noNimbleDirs) - - proc findInNimbleDir(pkg, subdir, dir: string): string = - var best = "" - var bestv = "" - for k, p in os.walkDir(dir, relative=true): - if k == pcDir and p.len > pkg.len+1 and - p[pkg.len] == '-' and p.startsWith(pkg): - let (_, a) = getPathVersion(p) - if bestv.len == 0 or bestv < a: - bestv = a - best = dir / p - - if best.len > 0: - var f: File - if open(f, best / changeFileExt(pkg, ".nimble-link")): - # the second line contains what we're interested in, see: - # https://github.com/nim-lang/nimble#nimble-link - var override = "" - discard readLine(f, override) - discard readLine(f, override) - close(f) - if not override.isAbsolute(): - best = best / override - else: - best = override - let f = if subdir.len == 0: pkg else: subdir - let res = addFileExt(best / f, "nim") - if best.len > 0 and fileExists(res): - result = res - -when false: - proc resolveDollar(project, source, pkg, subdir: string; info: TLineInfo): string = - template attempt(a) = - let x = addFileExt(a, "nim") - if fileExists(x): return x - - case pkg - of "stdlib": - if subdir.len == 0: - return options.libpath - else: - for candidate in stdlibDirs: - attempt(options.libpath / candidate / subdir) - of "root": - let root = project.splitFile.dir - if subdir.len == 0: - return root - else: - attempt(root / subdir) - else: - when considerParentDirs: - var p = parentDir(source.splitFile.dir) - # support 'import $karax': - let f = if subdir.len == 0: pkg else: subdir - - while p.len > 0: - let dir = p / pkg - if dirExists(dir): - attempt(dir / f) - # 2nd attempt: try to use 'karax/karax' - attempt(dir / pkg / f) - # 3rd attempt: try to use 'karax/src/karax' - attempt(dir / "src" / f) - attempt(dir / "src" / pkg / f) - p = parentDir(p) - - when considerNimbleDirs: - if not options.gNoNimblePath: - var nimbleDir = getEnv("NIMBLE_DIR") - if nimbleDir.len == 0: nimbleDir = getHomeDir() / ".nimble" - result = findInNimbleDir(pkg, subdir, nimbleDir / "pkgs") - if result.len > 0: return result - when not defined(windows): - result = findInNimbleDir(pkg, subdir, "/opt/nimble/pkgs") - if result.len > 0: return result - - proc scriptableImport(pkg, sub: string; info: TLineInfo): string = - resolveDollar(gProjectFull, info.toFullPath(), pkg, sub, info) - - proc lookupPackage(pkg, subdir: PNode): string = - let sub = if subdir != nil: renderTree(subdir, {renderNoComments}).replace(" ") else: "" - case pkg.kind - of nkStrLit, nkRStrLit, nkTripleStrLit: - result = scriptableImport(pkg.strVal, sub, pkg.info) - of nkIdent: - result = scriptableImport(pkg.ident.s, sub, pkg.info) - else: - localError(pkg.info, "package name must be an identifier or string literal") - result = "" +import std/[strutils, os] proc getModuleName*(conf: ConfigRef; n: PNode): string = # This returns a short relative module name without the nim extension @@ -130,11 +38,18 @@ proc getModuleName*(conf: ConfigRef; n: PNode): string = localError(n.info, "only '/' supported with $package notation") result = "" else: - let modname = getModuleName(conf, n[2]) - # hacky way to implement 'x / y /../ z': - result = getModuleName(conf, n1) - result.add renderTree(n0, {renderNoComments}).replace(" ") - result.add modname + if n0.kind in nkIdentKinds: + let ident = n0.getPIdent + if ident != nil and ident.s[0] == '/': + let modname = getModuleName(conf, n[2]) + # hacky way to implement 'x / y /../ z': + result = getModuleName(conf, n1) + result.add renderTree(n0, {renderNoComments}).replace(" ") + result.add modname + else: + result = "" + else: + result = "" of nkPrefix: when false: if n[0].kind == nkIdent and n[0].ident.s == "$": @@ -163,3 +78,18 @@ proc checkModuleName*(conf: ConfigRef; n: PNode; doLocalError=true): FileIndex = result = InvalidFileIdx else: result = fileInfoIdx(conf, fullPath) + +proc mangleModuleName*(conf: ConfigRef; path: AbsoluteFile): string = + ## Mangle a relative module path to avoid path and symbol collisions. + ## + ## Used by backends that need to generate intermediary files from Nim modules. + ## This is needed because the compiler uses a flat cache file hierarchy. + ## + ## Example: + ## `foo-#head/../bar` becomes `@foo-@hhead@s..@sbar` + "@m" & relativeTo(path, conf.projectPath).string.multiReplace( + {$os.DirSep: "@s", $os.AltSep: "@s", "#": "@h", "@": "@@", ":": "@c"}) + +proc demangleModuleName*(path: string): string = + ## Demangle a relative module path. + result = path.multiReplace({"@@": "@", "@h": "#", "@s": "/", "@m": "", "@c": ":"}) diff --git a/compiler/modules.nim b/compiler/modules.nim index 7d7a2b6f7..6e2af8bcc 100644 --- a/compiler/modules.nim +++ b/compiler/modules.nim @@ -10,11 +10,12 @@ ## Implements the module handling, including the caching of modules. import - ast, astalgo, magicsys, msgs, options, - idents, lexer, passes, syntaxes, llstream, modulegraphs, - lineinfos, pathutils, tables + ast, magicsys, msgs, options, + idents, lexer, syntaxes, modulegraphs, + lineinfos, pathutils -import ic / replayer +import ../dist/checksums/src/checksums/sha1 +import std/strtabs proc resetSystemArtifacts*(g: ModuleGraph) = magicsys.resetSysTypes(g) @@ -22,57 +23,12 @@ proc resetSystemArtifacts*(g: ModuleGraph) = template getModuleIdent(graph: ModuleGraph, filename: AbsoluteFile): PIdent = getIdent(graph.cache, splitFile(filename).name) -template packageId(): untyped {.dirty.} = ItemId(module: PackageModuleId, item: int32(fileIdx)) - -proc getPackage(graph: ModuleGraph; fileIdx: FileIndex): PSym = - ## returns package symbol (skPackage) for yet to be defined module for fileIdx - let filename = AbsoluteFile toFullPath(graph.config, fileIdx) - let name = getModuleIdent(graph, filename) - let info = newLineInfo(fileIdx, 1, 1) - let - pck = getPackageName(graph.config, filename.string) - pck2 = if pck.len > 0: pck else: "unknown" - pack = getIdent(graph.cache, pck2) - result = graph.packageSyms.strTableGet(pack) - if result == nil: - result = newSym(skPackage, getIdent(graph.cache, pck2), packageId(), nil, info) - #initStrTable(packSym.tab) - graph.packageSyms.strTableAdd(result) - else: - let modules = graph.modulesPerPackage.getOrDefault(result.itemId) - let existing = if modules.data.len > 0: strTableGet(modules, name) else: nil - if existing != nil and existing.info.fileIndex != info.fileIndex: - when false: - # we used to produce an error: - localError(graph.config, info, - "module names need to be unique per Nimble package; module clashes with " & - toFullPath(graph.config, existing.info.fileIndex)) - else: - # but starting with version 0.20 we now produce a fake Nimble package instead - # to resolve the conflicts: - let pck3 = fakePackageName(graph.config, filename) - # this makes the new `result`'s owner be the original `result` - result = newSym(skPackage, getIdent(graph.cache, pck3), packageId(), result, info) - #initStrTable(packSym.tab) - graph.packageSyms.strTableAdd(result) - -proc partialInitModule(result: PSym; graph: ModuleGraph; fileIdx: FileIndex; filename: AbsoluteFile) = +proc partialInitModule*(result: PSym; graph: ModuleGraph; fileIdx: FileIndex; filename: AbsoluteFile) = let packSym = getPackage(graph, fileIdx) result.owner = packSym result.position = int fileIdx - #initStrTable(result.tab(graph)) - when false: - strTableAdd(result.tab, result) # a module knows itself - # This is now implemented via - # c.moduleScope.addSym(module) # a module knows itself - # in sem.nim, around line 527 - - if graph.modulesPerPackage.getOrDefault(packSym.itemId).data.len == 0: - graph.modulesPerPackage[packSym.itemId] = newStrTable() - graph.modulesPerPackage[packSym.itemId].strTableAdd(result) - -proc newModule(graph: ModuleGraph; fileIdx: FileIndex): PSym = +proc newModule*(graph: ModuleGraph; fileIdx: FileIndex): PSym = let filename = AbsoluteFile toFullPath(graph.config, fileIdx) # We cannot call ``newSym`` here, because we have to circumvent the ID # mechanism, which we do in order to assign each module a persistent ID. @@ -80,103 +36,23 @@ 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) + rawMessage(graph.config, errGenerated, "invalid module name: '" & result.name.s & + "'; a module name must be a valid Nim identifier.") partialInitModule(result, graph, fileIdx, filename) graph.registerModule(result) -proc compileModule*(graph: ModuleGraph; fileIdx: FileIndex; flags: TSymFlags): PSym = - var flags = flags - if fileIdx == graph.config.projectMainIdx2: flags.incl sfMainModule - result = graph.getModule(fileIdx) - - template processModuleAux = - var s: PLLStream - if sfMainModule in flags: - if graph.config.projectIsStdin: s = stdin.llStreamOpen - elif graph.config.projectIsCmd: s = llStreamOpen(graph.config.cmdInput) - discard processModule(graph, result, idGeneratorFromModule(result), s) - if result == nil: - var cachedModules: seq[FileIndex] - result = moduleFromRodFile(graph, fileIdx, cachedModules) - let filename = AbsoluteFile toFullPath(graph.config, fileIdx) - if result == nil: - result = newModule(graph, fileIdx) - result.flags.incl flags - registerModule(graph, result) - processModuleAux() - else: - if sfSystemModule in flags: - graph.systemModule = result - partialInitModule(result, graph, fileIdx, filename) - for m in cachedModules: - registerModuleById(graph, m) - replayStateChanges(graph.packed[m.int].module, graph) - replayGenericCacheInformation(graph, m.int) - elif graph.isDirty(result): - result.flags.excl sfDirty - # reset module fields: - initStrTable(result.semtab(graph)) - result.ast = nil - processModuleAux() - graph.markClientsDirty(fileIdx) - -proc importModule*(graph: ModuleGraph; s: PSym, fileIdx: FileIndex): PSym = - # this is called by the semantic checking phase - assert graph.config != nil - result = compileModule(graph, fileIdx, {}) - graph.addDep(s, fileIdx) - # keep track of import relationships - if graph.config.hcrOn: - graph.importDeps.mgetOrPut(FileIndex(s.position), @[]).add(fileIdx) - #if sfSystemModule in result.flags: - # localError(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 - proc includeModule*(graph: ModuleGraph; s: PSym, fileIdx: FileIndex): PNode = result = syntaxes.parseFile(fileIdx, graph.cache, graph.config) graph.addDep(s, fileIdx) graph.addIncludeDep(s.position.FileIndex, fileIdx) - -proc connectCallbacks*(graph: ModuleGraph) = - graph.includeFileCallback = includeModule - graph.importModuleCallback = importModule - -proc compileSystemModule*(graph: ModuleGraph) = - if graph.systemModule == nil: - connectCallbacks(graph) - graph.config.m.systemFileIdx = fileInfoIdx(graph.config, - graph.config.libpath / RelativeFile"system.nim") - discard graph.compileModule(graph.config.m.systemFileIdx, {sfSystemModule}) + let path = toFullPath(graph.config, fileIdx) + graph.cachedFiles[path] = $secureHashFile(path) proc wantMainModule*(conf: ConfigRef) = if conf.projectFull.isEmpty: - fatal(conf, newLineInfo(conf, AbsoluteFile(commandLineDesc), 1, 1), errGenerated, - "command expects a filename") + fatal(conf, gCmdLineInfo, "command expects a filename") conf.projectMainIdx = fileInfoIdx(conf, addFileExt(conf.projectFull, NimExt)) -proc compileProject*(graph: ModuleGraph; projectFileIdx = InvalidFileIdx) = - connectCallbacks(graph) - let conf = graph.config - wantMainModule(conf) - configComplete(graph) - - let systemFileIdx = fileInfoIdx(conf, conf.libpath / RelativeFile"system.nim") - let projectFile = if projectFileIdx == InvalidFileIdx: conf.projectMainIdx else: projectFileIdx - conf.projectMainIdx2 = projectFile - - let packSym = getPackage(graph, projectFile) - graph.config.mainPackageId = packSym.getnimblePkgId - graph.importStack.add projectFile - - if projectFile == systemFileIdx: - discard graph.compileModule(projectFile, {sfMainModule, sfSystemModule}) - else: - graph.compileSystemModule() - discard graph.compileModule(projectFile, {sfMainModule}) - proc makeModule*(graph: ModuleGraph; filename: AbsoluteFile): PSym = result = graph.newModule(fileInfoIdx(graph.config, filename)) registerModule(graph, result) diff --git a/compiler/msgs.nim b/compiler/msgs.nim index bbe40507f..c49ca8c9b 100644 --- a/compiler/msgs.nim +++ b/compiler/msgs.nim @@ -8,17 +8,26 @@ # import - options, strutils, os, tables, ropes, terminal, macros, - lineinfos, pathutils -import std/private/miscdollars -import strutils2 + std/[strutils, os, tables, terminal, macros, times], + std/private/miscdollars, + options, lineinfos, pathutils + +import ropes except `%` + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] + type InstantiationInfo* = typeof(instantiationInfo()) -template instLoc(): InstantiationInfo = instantiationInfo(-2, fullPaths = true) +template instLoc*(): InstantiationInfo = instantiationInfo(-2, fullPaths = true) template toStdOrrKind(stdOrr): untyped = if stdOrr == stdout: stdOrrStdout else: stdOrrStderr +proc toLowerAscii(a: var string) {.inline.} = + for c in mitems(a): + if isUpperAscii(c): c = char(uint8(c) xor 0b0010_0000'u8) + proc flushDot*(conf: ConfigRef) = ## safe to call multiple times # xxx one edge case not yet handled is when `printf` is called at CT with `compiletimeFFI`. @@ -28,7 +37,7 @@ proc flushDot*(conf: ConfigRef) = conf.lastMsgWasDot.excl stdOrrKind write(stdOrr, "\n") -proc toCChar*(c: char; result: var string) = +proc toCChar*(c: char; result: var string) {.inline.} = case c of '\0'..'\x1F', '\x7F'..'\xFF': result.add '\\' @@ -40,28 +49,24 @@ proc toCChar*(c: char; result: var string) = result.add c proc makeCString*(s: string): Rope = - result = nil - var res = newStringOfCap(int(s.len.toFloat * 1.1) + 1) - res.add("\"") + result = newStringOfCap(int(s.len.toFloat * 1.1) + 1) + result.add("\"") for i in 0..<s.len: # line wrapping of string litterals in cgen'd code was a bad idea, e.g. causes: bug #16265 # It also makes reading c sources or grepping harder, for zero benefit. # const MaxLineLength = 64 # if (i + 1) mod MaxLineLength == 0: # res.add("\"\L\"") - toCChar(s[i], res) - res.add('\"') - result.add(rope(res)) + toCChar(s[i], result) + result.add('\"') proc newFileInfo(fullPath: AbsoluteFile, projPath: RelativeFile): TFileInfo = - result.fullPath = fullPath - #shallow(result.fullPath) - result.projPath = projPath - #shallow(result.projPath) - result.shortName = fullPath.extractFilename + result = TFileInfo(fullPath: fullPath, projPath: projPath, + shortName: fullPath.extractFilename, + quotedFullName: fullPath.string.makeCString, + lines: @[] + ) result.quotedName = result.shortName.makeCString - result.quotedFullName = fullPath.string.makeCString - result.lines = @[] when defined(nimpretty): if not result.fullPath.isEmpty: try: @@ -75,7 +80,7 @@ when defined(nimpretty): proc fileSection*(conf: ConfigRef; fid: FileIndex; a, b: int): string = substr(conf.m.fileInfos[fid.int].fullContent, a, b) -proc canonicalCase(path: var string) = +proc canonicalCase(path: var string) {.inline.} = ## the idea is to only use this for checking whether a path is already in ## the table but otherwise keep the original case when FileSystemCaseSensitive: discard @@ -98,15 +103,13 @@ proc fileInfoIdx*(conf: ConfigRef; filename: AbsoluteFile; isKnownFile: var bool try: canon = canonicalizePath(conf, filename) - shallow(canon.string) except OSError: canon = filename # The compiler uses "filenames" such as `command line` or `stdin` # This flag indicates that we are working with such a path here pseudoPath = true - var canon2: string - forceCopy(canon2, canon.string) # because `canon` may be shallow + var canon2 = canon.string canon2.canonicalCase if conf.m.filenameToIndexTbl.hasKey(canon2): @@ -115,17 +118,23 @@ proc fileInfoIdx*(conf: ConfigRef; filename: AbsoluteFile; isKnownFile: var bool else: isKnownFile = false result = conf.m.fileInfos.len.FileIndex - #echo "ID ", result.int, " ", canon2 conf.m.fileInfos.add(newFileInfo(canon, if pseudoPath: RelativeFile filename else: relativeTo(canon, conf.projectPath))) conf.m.filenameToIndexTbl[canon2] = result proc fileInfoIdx*(conf: ConfigRef; filename: AbsoluteFile): FileIndex = - var dummy: bool + var dummy: bool = false result = fileInfoIdx(conf, filename, dummy) +proc fileInfoIdx*(conf: ConfigRef; filename: RelativeFile; isKnownFile: var bool): FileIndex = + fileInfoIdx(conf, AbsoluteFile expandFilename(filename.string), isKnownFile) + +proc fileInfoIdx*(conf: ConfigRef; filename: RelativeFile): FileIndex = + var dummy: bool = false + fileInfoIdx(conf, AbsoluteFile expandFilename(filename.string), dummy) + proc newLineInfo*(fileInfoIdx: FileIndex, line, col: int): TLineInfo = - result.fileIndex = fileInfoIdx + result = TLineInfo(fileIndex: fileInfoIdx) if line < int high(uint16): result.line = uint16(line) else: @@ -215,11 +224,18 @@ proc setDirtyFile*(conf: ConfigRef; fileIdx: FileIndex; filename: AbsoluteFile) proc setHash*(conf: ConfigRef; fileIdx: FileIndex; hash: string) = assert fileIdx.int32 >= 0 - shallowCopy(conf.m.fileInfos[fileIdx.int32].hash, hash) + when defined(gcArc) or defined(gcOrc) or defined(gcAtomicArc): + conf.m.fileInfos[fileIdx.int32].hash = hash + else: + shallowCopy(conf.m.fileInfos[fileIdx.int32].hash, hash) + proc getHash*(conf: ConfigRef; fileIdx: FileIndex): string = assert fileIdx.int32 >= 0 - shallowCopy(result, conf.m.fileInfos[fileIdx.int32].hash) + when defined(gcArc) or defined(gcOrc) or defined(gcAtomicArc): + result = conf.m.fileInfos[fileIdx.int32].hash + else: + shallowCopy(result, conf.m.fileInfos[fileIdx.int32].hash) proc toFullPathConsiderDirty*(conf: ConfigRef; fileIdx: FileIndex): AbsoluteFile = if fileIdx.int32 < 0: @@ -241,36 +257,30 @@ template toFullPath*(conf: ConfigRef; info: TLineInfo): string = template toFullPathConsiderDirty*(conf: ConfigRef; info: TLineInfo): string = string toFullPathConsiderDirty(conf, info.fileIndex) -type FilenameOption* = enum - foAbs # absolute path, e.g.: /pathto/bar/foo.nim - foRelProject # relative to project path, e.g.: ../foo.nim - foMagicSauce # magic sauce, shortest of (foAbs, foRelProject) - foName # lastPathPart, e.g.: foo.nim - foStacktrace # if optExcessiveStackTrace: foAbs else: foName - proc toFilenameOption*(conf: ConfigRef, fileIdx: FileIndex, opt: FilenameOption): string = case opt of foAbs: result = toFullPath(conf, fileIdx) of foRelProject: result = toProjPath(conf, fileIdx) - of foMagicSauce: + of foCanonical: + let absPath = toFullPath(conf, fileIdx) + result = canonicalImportAux(conf, absPath.AbsoluteFile) + of foName: result = toProjPath(conf, fileIdx).lastPathPart + of foLegacyRelProj: let absPath = toFullPath(conf, fileIdx) relPath = toProjPath(conf, fileIdx) - result = if (optListFullPaths in conf.globalOptions) or - (relPath.len > absPath.len) or - (relPath.count("..") > 2): + result = if (relPath.len > absPath.len) or (relPath.count("..") > 2): absPath else: relPath - of foName: result = toProjPath(conf, fileIdx).lastPathPart of foStacktrace: if optExcessiveStackTrace in conf.globalOptions: result = toFilenameOption(conf, fileIdx, foAbs) else: result = toFilenameOption(conf, fileIdx, foName) -proc toMsgFilename*(conf: ConfigRef; info: FileIndex): string = - toFilenameOption(conf, info, foMagicSauce) +proc toMsgFilename*(conf: ConfigRef; fileIdx: FileIndex): string = + toFilenameOption(conf, fileIdx, conf.filenameOption) template toMsgFilename*(conf: ConfigRef; info: TLineInfo): string = toMsgFilename(conf, info.fileIndex) @@ -282,9 +292,11 @@ proc toColumn*(info: TLineInfo): int {.inline.} = result = info.col proc toFileLineCol(info: InstantiationInfo): string {.inline.} = + result = "" result.toLocation(info.filename, info.line, info.column + ColOffset) proc toFileLineCol*(conf: ConfigRef; info: TLineInfo): string {.inline.} = + result = "" result.toLocation(toMsgFilename(conf, info), info.line.int, info.col.int + ColOffset) proc `$`*(conf: ConfigRef; info: TLineInfo): string = toFileLineCol(conf, info) @@ -299,6 +311,7 @@ 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 = {}) = @@ -310,17 +323,20 @@ proc msgWriteln*(conf: ConfigRef; s: string, flags: MsgFlags = {}) = ## This is used for 'nim dump' etc. where we don't have nimsuggest ## support. #if conf.cmd == cmdIdeTools and optCDebug notin gGlobalOptions: return + let sep = if msgNoUnitSep notin flags: conf.unitSep else: "" if not isNil(conf.writelnHook) and msgSkipHook notin flags: - conf.writelnHook(s) + conf.writelnHook(s & sep) elif optStdout in conf.globalOptions or msgStdout in flags: if eStdOut in conf.m.errorOutputs: flushDot(conf) - writeLine(stdout, s) + write stdout, s + writeLine(stdout, sep) flushFile(stdout) else: if eStdErr in conf.m.errorOutputs: flushDot(conf) - writeLine(stderr, s) + write stderr, s + writeLine(stderr, sep) # On Windows stderr is fully-buffered when piped, regardless of C std. when defined(windows): flushFile(stderr) @@ -366,7 +382,7 @@ proc msgWrite(conf: ConfigRef; s: string) = flushFile(stdOrr) conf.lastMsgWasDot.incl stdOrr.toStdOrrKind() # subsequent writes need `flushDot` -template styledMsgWriteln*(args: varargs[typed]) = +template styledMsgWriteln(args: varargs[typed]) = if not isNil(conf.writelnHook): callIgnoringStyle(callWritelnHook, nil, args) elif optStdout in conf.globalOptions: @@ -392,13 +408,14 @@ proc getMessageStr(msg: TMsgKind, arg: string): string = msgKindToString(msg) % type TErrorHandling* = enum doNothing, doAbort, doRaise proc log*(s: string) = - var f: File + var f: File = default(File) if open(f, getHomeDir() / "nimsuggest.log", fmAppend): f.writeLine(s) close(f) proc quit(conf: ConfigRef; msg: TMsgKind) {.gcsafe.} = - if defined(debug) or msg == errInternal or conf.hasHint(hintStackTrace): + if conf.isDefined("nimDebug"): quitOrRaise(conf, $msg) + elif defined(debug) or msg == errInternal or conf.hasHint(hintStackTrace): {.gcsafe.}: if stackTraceAvailable() and isNil(conf.writelnHook): writeStackTrace() @@ -406,19 +423,26 @@ proc quit(conf: ConfigRef; msg: TMsgKind) {.gcsafe.} = styledMsgWriteln(fgRed, """ No stack traceback available To create a stacktrace, rerun compilation with './koch temp $1 <file>', see $2 for details""" % - [conf.command, "intern.html#debugging-the-compiler".createDocLink]) + [conf.command, "intern.html#debugging-the-compiler".createDocLink], conf.unitSep) quit 1 -proc handleError(conf: ConfigRef; msg: TMsgKind, eh: TErrorHandling, s: string) = - if msg >= fatalMin and msg <= fatalMax: +proc handleError(conf: ConfigRef; msg: TMsgKind, eh: TErrorHandling, s: string, ignoreMsg: bool) = + if msg in fatalMsgs: if conf.cmd == cmdIdeTools: log(s) - quit(conf, msg) + if conf.cmd != cmdIdeTools or msg != errFatal: + quit(conf, msg) if msg >= errMin and msg <= errMax or - (msg in warnMin..hintMax and msg in conf.warningAsErrors): + (msg in warnMin..hintMax and msg in conf.warningAsErrors and not ignoreMsg): inc(conf.errorCounter) conf.exitcode = 1'i8 if conf.errorCounter >= conf.errorMax: - quit(conf, msg) + # only really quit when we're not in the new 'nim check --def' mode: + if conf.ideCmd == ideNone: + when defined(nimsuggest): + #we need to inform the user that something went wrong when initializing NimSuggest + raiseRecoverableError(s) + else: + quit(conf, msg) elif eh == doAbort and conf.cmd != cmdIdeTools: quit(conf, msg) elif eh == doRaise: @@ -441,10 +465,11 @@ proc writeContext(conf: ConfigRef; lastinfo: TLineInfo) = conf.structuredErrorHook(conf, context.info, instantiationFrom, Severity.Hint) else: - let message = if context.detail == "": - instantiationFrom - else: - instantiationOfFrom.format(context.detail) + let message = + if context.detail == "": + instantiationFrom + else: + instantiationOfFrom.format(context.detail) styledMsgWriteln(styleBright, conf.toFileLineCol(context.info), " ", resetStyle, message) info = context.info @@ -476,11 +501,14 @@ proc sourceLine*(conf: ConfigRef; i: TLineInfo): string = result = conf.m.fileInfos[i.fileIndex.int32].lines[i.line.int-1] -proc writeSurroundingSrc(conf: ConfigRef; info: TLineInfo) = - const indent = " " - msgWriteln(conf, indent & $sourceLine(conf, info)) - if info.col >= 0: - msgWriteln(conf, indent & spaces(info.col) & '^') +proc getSurroundingSrc(conf: ConfigRef; info: TLineInfo): string = + if conf.hasHint(hintSource) and info != unknownLineInfo: + const indent = " " + result = "\n" & indent & $sourceLine(conf, info) + if info.col >= 0: + result.add "\n" & indent & spaces(info.col) & '^' + else: + result = "" proc formatMsg*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg: string): string = let title = case msg @@ -490,12 +518,19 @@ proc formatMsg*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg: string): s conf.toFileLineCol(info) & " " & title & getMessageStr(msg, arg) proc liMessage*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg: string, - eh: TErrorHandling, info2: InstantiationInfo, isRaw = false) {.noinline.} = + eh: TErrorHandling, info2: InstantiationInfo, isRaw = false, + ignoreError = false) {.gcsafe, 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: @@ -512,23 +547,23 @@ proc liMessage*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg: string, of warnMin..warnMax: sev = Severity.Warning ignoreMsg = not conf.hasWarn(msg) - if msg in conf.warningAsErrors: - ignoreMsg = false + if not ignoreMsg and msg in conf.warningAsErrors: title = ErrorTitle + color = ErrorColor else: title = WarningTitle + color = WarningColor 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 + if not ignoreMsg and msg in conf.warningAsErrors: title = ErrorTitle + color = ErrorColor else: title = HintTitle - color = HintColor + color = HintColor inc(conf.hintCounter) let s = if isRaw: arg else: getMessageStr(msg, arg) @@ -539,18 +574,22 @@ proc liMessage*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg: string, if conf.structuredErrorHook != nil: conf.structuredErrorHook(conf, info, s & kindmsg, sev) if not ignoreMsgBecauseOfIdeTools(conf, msg): - if msg == hintProcessing: + if msg == hintProcessing and conf.hintProcessingDots: msgWrite(conf, ".") else: - styledMsgWriteln(styleBright, loc, resetStyle, color, title, resetStyle, s, KindColor, kindmsg) - if conf.hasHint(hintSource) and info != unknownLineInfo: - conf.writeSurroundingSrc(info) + 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) - handleError(conf, msg, eh, s) + resetStyle, conf.unitSep) + if not ignoreError: + handleError(conf, msg, eh, s, ignoreMsg) + 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 @@ -559,9 +598,7 @@ template rawMessage*(conf: ConfigRef; msg: TMsgKind, args: openArray[string]) = template rawMessage*(conf: ConfigRef; msg: TMsgKind, arg: string) = liMessage(conf, unknownLineInfo, msg, arg, eh = doAbort, instLoc()) -template fatal*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg = "") = - # this fixes bug #7080 so that it is at least obvious 'fatal' was executed. - conf.m.errorOutputs = {eStdOut, eStdErr} +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 = "") = @@ -585,9 +622,6 @@ template localError*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg = "") template localError*(conf: ConfigRef; info: TLineInfo, arg: string) = liMessage(conf, info, errGenerated, arg, doNothing, instLoc()) -template localError*(conf: ConfigRef; info: TLineInfo, format: string, params: openArray[string]) = - liMessage(conf, info, errGenerated, format % params, doNothing, instLoc()) - template message*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg = "") = liMessage(conf, info, msg, arg, doNothing, instLoc()) @@ -595,7 +629,7 @@ proc warningDeprecated*(conf: ConfigRef, info: TLineInfo = gCmdLineInfo, msg = " message(conf, info, warnDeprecated, msg) proc internalErrorImpl(conf: ConfigRef; info: TLineInfo, errMsg: string, info2: InstantiationInfo) = - if conf.cmd == cmdIdeTools and conf.structuredErrorHook.isNil: return + if conf.cmd in {cmdIdeTools, cmdCheck} and conf.structuredErrorHook.isNil: return writeContext(conf, info) liMessage(conf, info, errInternal, errMsg, doAbort, info2) @@ -612,47 +646,78 @@ template internalAssert*(conf: ConfigRef, e: bool) = let arg = info2.toFileLineCol internalErrorImpl(conf, unknownLineInfo, arg, info2) -template lintReport*(conf: ConfigRef; info: TLineInfo, beau, got: string) = - let m = "'$2' should be: '$1'" % [beau, got] +template lintReport*(conf: ConfigRef; info: TLineInfo, beau, got: string, extraMsg = "") = + let m = "'$1' should be: '$2'$3" % [got, beau, extraMsg] let msg = if optStyleError in conf.globalOptions: errGenerated else: hintName liMessage(conf, info, msg, m, doNothing, instLoc()) -proc quotedFilename*(conf: ConfigRef; i: TLineInfo): Rope = - if i.fileIndex.int32 < 0: +proc quotedFilename*(conf: ConfigRef; fi: FileIndex): Rope = + if fi.int32 < 0: result = makeCString "???" elif optExcessiveStackTrace in conf.globalOptions: - result = conf.m.fileInfos[i.fileIndex.int32].quotedFullName + result = conf.m.fileInfos[fi.int32].quotedFullName else: - result = conf.m.fileInfos[i.fileIndex.int32].quotedName + result = conf.m.fileInfos[fi.int32].quotedName + +proc quotedFilename*(conf: ConfigRef; i: TLineInfo): Rope = + quotedFilename(conf, i.fileIndex) template listMsg(title, r) = - msgWriteln(conf, title) - for a in r: msgWriteln(conf, " [$1] $2" % [if a in conf.notes: "x" else: " ", $a]) + 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) = listMsg("Warnings:", warnMin..warnMax) proc listHints*(conf: ConfigRef) = listMsg("Hints:", hintMin..hintMax) -proc uniqueModuleName*(conf: ConfigRef; fid: FileIndex): string = - ## The unique module name is guaranteed to only contain {'A'..'Z', 'a'..'z', '0'..'9', '_'} - ## so that it is useful as a C identifier snippet. - let path = AbsoluteFile toFullPath(conf, fid) - let rel = - if path.string.startsWith(conf.libpath.string): - relativeTo(path, conf.libpath).string +proc genSuccessX*(conf: ConfigRef) = + let mem = + when declared(system.getMaxMem): formatSize(getMaxMem()) & " peakmem" + else: formatSize(getTotalMem()) & " totmem" + let loc = $conf.linesCompiled + var build = "" + var flags = "" + const debugModeHints = "none (DEBUG BUILD, `-d:release` generates faster code)" + if conf.cmd in cmdBackends: + if conf.backend != backendJs: + build.add "mm: $#; " % $conf.selectedGC + if optThreads in conf.globalOptions: build.add "threads: on; " + build.add "opt: " + if optOptimizeSpeed in conf.options: build.add "speed" + elif optOptimizeSize in conf.options: build.add "size" + else: build.add debugModeHints + # pending https://github.com/timotheecour/Nim/issues/752, point to optimization.html + if isDefined(conf, "danger"): flags.add " -d:danger" + elif isDefined(conf, "release"): flags.add " -d:release" else: - relativeTo(path, conf.projectPath).string - let trunc = if rel.endsWith(".nim"): rel.len - len(".nim") else: rel.len - result = newStringOfCap(trunc) - for i in 0..<trunc: - let c = rel[i] - case c - of 'a'..'z': - result.add c - of {os.DirSep, os.AltSep}: - result.add 'Z' # because it looks a bit like '/' - of '.': - result.add 'O' # a circle - else: - # We mangle upper letters and digits too so that there cannot - # be clashes with our special meanings of 'Z' and 'O' - result.addInt ord(c) + build.add "opt: " + if isDefined(conf, "danger"): + build.add "speed" + flags.add " -d:danger" + elif isDefined(conf, "release"): + build.add "speed" + flags.add " -d:release" + else: build.add debugModeHints + if flags.len > 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 + if optCompileOnly in conf.globalOptions and conf.cmd != cmdJsonscript: + output = $conf.jsonBuildFile + elif conf.outFile.isEmpty and conf.cmd notin {cmdJsonscript} + cmdDocLike + cmdBackends: + # for some cmd we expect a valid absOutFile + output = "unknownOutput" + elif optStdout in conf.globalOptions: + output = "stdout" + 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, + ]) diff --git a/compiler/ndi.nim b/compiler/ndi.nim index 5af87237f..cc18ab39f 100644 --- a/compiler/ndi.nim +++ b/compiler/ndi.nim @@ -12,6 +12,9 @@ import ast, msgs, ropes, options, pathutils +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] + type NdiFile* = object enabled: bool @@ -26,7 +29,7 @@ proc doWrite(f: var NdiFile; s: PSym; conf: ConfigRef) = f.buf.add "\t" f.buf.addInt s.info.col.int f.f.write(s.name.s, "\t") - f.f.writeRope(s.loc.r) + f.f.writeRope(s.loc.snippet) f.f.writeLine("\t", toFullPath(conf, s.info), "\t", f.buf) template writeMangledName*(f: NdiFile; s: PSym; conf: ConfigRef) = diff --git a/compiler/nilcheck.nim b/compiler/nilcheck.nim index b779830d6..7e0efc34b 100644 --- a/compiler/nilcheck.nim +++ b/compiler/nilcheck.nim @@ -7,8 +7,11 @@ # distribution, for details about the copyright. # -import ast, renderer, intsets, tables, msgs, options, lineinfos, strformat, idents, treetab, hashes -import sequtils, strutils, std / sets +import ast, renderer, msgs, options, lineinfos, idents, treetab +import std/[intsets, tables, sequtils, strutils, sets, strformat, hashes] + +when defined(nimPreviewSlimSystem): + import std/assertions # IMPORTANT: notes not up to date, i'll update this comment again # @@ -306,6 +309,7 @@ proc symbol(n: PNode): Symbol = # echo "symbol ", n, " ", n.kind, " ", result.int func `$`(map: NilMap): string = + result = "" var now = map var stack: seq[NilMap] = @[] while not now.isNil: @@ -413,7 +417,7 @@ proc moveOut(ctx: NilCheckerContext, map: NilMap, target: PNode) = if targetSetIndex != noSetIndex: var targetSet = map.sets[targetSetIndex] if targetSet.len > 1: - var other: ExprIndex + var other: ExprIndex = default(ExprIndex) for element in targetSet: if element.ExprIndex != targetIndex: @@ -494,7 +498,7 @@ proc checkCall(n, ctx, map): Check = # check args and handle possible mutations var isNew = false - result.map = map + result = Check(map: map) for i, child in n: discard check(child, ctx, map) @@ -503,7 +507,7 @@ proc checkCall(n, ctx, map): Check = # as it might have been mutated # TODO similar for normal refs and fields: find dependent exprs: brackets - if child.kind == nkHiddenAddr and not child.typ.isNil and child.typ.kind == tyVar and child.typ[0].kind == tyRef: + if child.kind == nkHiddenAddr and not child.typ.isNil and child.typ.kind == tyVar and child.typ.elementType.kind == tyRef: if not isNew: result.map = newNilMap(map) isNew = true @@ -558,7 +562,7 @@ proc derefWarning(n, ctx, map; kind: Nilability) = if n.info in ctx.warningLocations: return ctx.warningLocations.incl(n.info) - var a: seq[History] + var a: seq[History] = @[] if n.kind == nkSym: a = history(map, ctx.index(n)) var res = "" @@ -749,6 +753,7 @@ proc checkReturn(n, ctx, map): Check = proc checkIf(n, ctx, map): Check = ## check branches based on condition + result = default(Check) var mapIf: NilMap = map # first visit the condition @@ -762,7 +767,7 @@ proc checkIf(n, ctx, map): Check = # the state of the conditions: negating conditions before the current one var layerHistory = newNilMap(mapIf) # the state after branch effects - var afterLayer: NilMap + var afterLayer: NilMap = nil # the result nilability for expressions var nilability = Safe @@ -821,7 +826,7 @@ proc checkFor(n, ctx, map): Check = var check2 = check(n.sons[2], ctx, m) var map2 = check2.map - result.map = ctx.union(map0, m) + result = Check(map: ctx.union(map0, m)) result.map = ctx.union(result.map, map2) result.nilability = Safe @@ -849,7 +854,7 @@ proc checkWhile(n, ctx, map): Check = var check2 = check(n.sons[1], ctx, m) var map2 = check2.map - result.map = ctx.union(map0, map1) + result = Check(map: ctx.union(map0, map1)) result.map = ctx.union(result.map, map2) result.nilability = Safe @@ -859,9 +864,10 @@ proc checkInfix(n, ctx, map): Check = ## a or b : map is an union of a and b's ## a == b : use checkCondition ## else: no change, just check args + result = default(Check) if n[0].kind == nkSym: - var mapL: NilMap - var mapR: NilMap + var mapL: NilMap = nil + var mapR: NilMap = nil if n[0].sym.magic notin {mAnd, mEqRef}: mapL = checkCondition(n[1], ctx, map, false, false) mapR = checkCondition(n[2], ctx, map, false, false) @@ -894,7 +900,7 @@ proc checkInfix(n, ctx, map): Check = proc checkIsNil(n, ctx, map; isElse: bool = false): Check = ## check isNil calls ## update the map depending on if it is not isNil or isNil - result.map = newNilMap(map) + result = Check(map: newNilMap(map)) let value = n[1] result.map.store(ctx, ctx.index(n[1]), if not isElse: Nil else: Safe, TArg, n.info, n) @@ -906,24 +912,24 @@ proc infix(ctx: NilCheckerContext, l: PNode, r: PNode, magic: TMagic): PNode = else: "" var cache = newIdentCache() - var op = newSym(skVar, cache.getIdent(name), nextSymId ctx.idgen, nil, r.info) + var op = newSym(skVar, cache.getIdent(name), ctx.idgen, nil, r.info) op.magic = magic result = nkInfix.newTree( newSymNode(op, r.info), l, r) - result.typ = newType(tyBool, nextTypeId ctx.idgen, nil) + result.typ = newType(tyBool, ctx.idgen, nil) proc prefixNot(ctx: NilCheckerContext, node: PNode): PNode = var cache = newIdentCache() - var op = newSym(skVar, cache.getIdent("not"), nextSymId ctx.idgen, nil, node.info) + var op = newSym(skVar, cache.getIdent("not"), ctx.idgen, nil, node.info) op.magic = mNot result = nkPrefix.newTree( newSymNode(op, node.info), node) - result.typ = newType(tyBool, nextTypeId ctx.idgen, nil) + result.typ = newType(tyBool, ctx.idgen, nil) proc infixEq(ctx: NilCheckerContext, l: PNode, r: PNode): PNode = infix(ctx, l, r, mEqRef) @@ -942,9 +948,9 @@ proc checkCase(n, ctx, map): Check = # c2 # also a == true is a , a == false is not a let base = n[0] - result.map = map.copyMap() + result = Check(map: map.copyMap()) result.nilability = Safe - var a: PNode + var a: PNode = nil for child in n: case child.kind: of nkOfBranch: @@ -1214,12 +1220,12 @@ proc check(n: PNode, ctx: NilCheckerContext, map: NilMap): Check = result = check(n.sons[1], ctx, map) of nkStmtList, nkStmtListExpr, nkChckRangeF, nkChckRange64, nkChckRange, nkBracket, nkCurly, nkPar, nkTupleConstr, nkClosure, nkObjConstr, nkElse: - result.map = map + result = Check(map: map) if n.kind in {nkObjConstr, nkTupleConstr}: # TODO deeper nested elements? # A(field: B()) # # field: Safe -> - var elements: seq[(PNode, Nilability)] + var elements: seq[(PNode, Nilability)] = @[] for i, child in n: result = check(child, ctx, result.map) if i > 0: @@ -1239,12 +1245,12 @@ proc check(n: PNode, ctx: NilCheckerContext, map: NilMap): Check = result = check(n.sons[0], ctx, map) of nkIfStmt, nkIfExpr: result = checkIf(n, ctx, map) - of nkAsgn: + of nkAsgn, nkFastAsgn, nkSinkAsgn: result = checkAsgn(n[0], n[1], ctx, map) - of nkVarSection: - result.map = map + of nkVarSection, nkLetSection: + result = Check(map: map) for child in n: - result = checkAsgn(child[0], child[2], ctx, result.map) + result = checkAsgn(child[0].skipPragmaExpr, child[2], ctx, result.map) of nkForStmt: result = checkFor(n, ctx, map) of nkCaseStmt: @@ -1268,8 +1274,7 @@ proc check(n: PNode, ctx: NilCheckerContext, map: NilMap): Check = else: var elementMap = map.copyMap() - var elementCheck: Check - elementCheck.map = elementMap + var elementCheck = Check(map: elementMap) for element in n: elementCheck = check(element, ctx, elementCheck.map) @@ -1283,7 +1288,7 @@ proc typeNilability(typ: PType): Nilability = # echo "typeNilability ", $typ.flags, " ", $typ.kind result = if tfNotNil in typ.flags: Safe - elif typ.kind in {tyRef, tyCString, tyPtr, tyPointer}: + elif typ.kind in {tyRef, tyCstring, tyPtr, tyPointer}: # # tyVar ? tyVarargs ? tySink ? tyLent ? # TODO spec? tests? @@ -1330,7 +1335,7 @@ proc preVisit(ctx: NilCheckerContext, s: PSym, body: PNode, conf: ConfigRef) = ctx.symbolIndices = {resultId: resultExprIndex}.toTable() var cache = newIdentCache() ctx.expressions = SeqOfDistinct[ExprIndex, PNode](@[newIdentNode(cache.getIdent("result"), s.ast.info)]) - var emptySet: IntSet # set[ExprIndex] + var emptySet: IntSet = initIntSet() # set[ExprIndex] ctx.dependants = SeqOfDistinct[ExprIndex, IntSet](@[emptySet]) for i, arg in s.typ.n.sons: if i > 0: @@ -1362,7 +1367,7 @@ proc checkNil*(s: PSym; body: PNode; conf: ConfigRef, idgen: IdGenerator) = continue map.store(context, context.index(child), typeNilability(child.typ), TArg, child.info, child) - map.store(context, resultExprIndex, if not s.typ[0].isNil and s.typ[0].kind == tyRef: Nil else: Safe, TResult, s.ast.info) + map.store(context, resultExprIndex, if not s.typ.returnType.isNil and s.typ.returnType.kind == tyRef: Nil else: Safe, TResult, s.ast.info) # echo "checking ", s.name.s, " ", filename @@ -1378,5 +1383,5 @@ proc checkNil*(s: PSym; body: PNode; conf: ConfigRef, idgen: IdGenerator) = # (ANotNil, BNotNil) : # do we check on asgn nilability at all? - if not s.typ[0].isNil and s.typ[0].kind == tyRef and tfNotNil in s.typ[0].flags: + if not s.typ.returnType.isNil and s.typ.returnType.kind == tyRef and tfNotNil in s.typ.returnType.flags: checkResult(s.ast, context, res.map) diff --git a/compiler/nim.cfg b/compiler/nim.cfg index 40e93d523..ce5a22ad2 100644 --- a/compiler/nim.cfg +++ b/compiler/nim.cfg @@ -4,6 +4,13 @@ hint[XDeclaredButNotUsed]:off define:booting define:nimcore +define:nimPreviewFloatRoundtrip +define:nimPreviewSlimSystem +define:nimPreviewCstringConversion +define:nimPreviewProcConversion +define:nimPreviewRangeDefault +define:nimPreviewNonVarDestructor +threads:off #import:"$projectpath/testability" @@ -22,5 +29,35 @@ define:useStdoutAsStdmsg #gc:markAndSweep @if nimHasWarningObservableStores: - warning[ObservableStores]: off + warning[ObservableStores]:off +@end + + +@if nimHasWarningAsError: + warningAsError[GcUnsafe2]:on +@end + +@if nimHasWarnUnnamedBreak: + warningAserror[UnnamedBreak]:on +@end + +@if nimHasWarnBareExcept: + warning[BareExcept]:on + warningAserror[BareExcept]:on +@end + + +@if nimUseStrictDefs: + experimental:strictDefs + warningAsError[Uninit]:on + warningAsError[ProveInit]:on +@end + +@if nimHasWarnStdPrefix: + warning[StdPrefix]:on + warningAsError[StdPrefix]:on +@end + +@if nimHasVtables: + experimental:vtables @end diff --git a/compiler/nim.nim b/compiler/nim.nim index df06a83a9..005f11a58 100644 --- a/compiler/nim.nim +++ b/compiler/nim.nim @@ -7,21 +7,25 @@ # distribution, for details about the copyright. # -when defined(gcc) and defined(windows): - when defined(x86): - {.link: "../icons/nim.res".} - else: - {.link: "../icons/nim_icon.o".} +import std/[os, strutils, parseopt] + +when defined(nimPreviewSlimSystem): + import std/assertions + +when defined(windows): + when defined(gcc): + when defined(x86): + {.link: "../icons/nim.res".} + else: + {.link: "../icons/nim_icon.o".} -when defined(amd64) and defined(windows) and defined(vcc): - {.link: "../icons/nim-amd64-windows-vcc.res".} -when defined(i386) and defined(windows) and defined(vcc): - {.link: "../icons/nim-i386-windows-vcc.res".} + when defined(amd64) and defined(vcc): + {.link: "../icons/nim-amd64-windows-vcc.res".} + when defined(i386) and defined(vcc): + {.link: "../icons/nim-i386-windows-vcc.res".} import - commands, options, msgs, - extccomp, strutils, os, main, parseopt, - idents, lineinfos, cmdlinehelper, + commands, options, msgs, extccomp, main, idents, lineinfos, cmdlinehelper, pathutils, modulegraphs from std/browsers import openDefaultBrowser @@ -34,6 +38,15 @@ when defined(profiler) or defined(memProfiler): {.hint: "Profiling support is turned on!".} import nimprof +proc nimbleLockExists(config: ConfigRef): bool = + const nimbleLock = "nimble.lock" + let pd = if not config.projectPath.isEmpty: config.projectPath else: AbsoluteDir(getCurrentDir()) + if optSkipParentConfigFiles notin config.globalOptions: + for dir in parentDirs(pd.string, fromRoot=true, inclusive=false): + if fileExists(dir / nimbleLock): + return true + return fileExists(pd.string / nimbleLock) + proc processCmdLine(pass: TCmdLinePass, cmd: string; config: ConfigRef) = var p = parseopt.initOptParser(cmd) var argsCount = 0 @@ -67,6 +80,21 @@ proc processCmdLine(pass: TCmdLinePass, cmd: string; config: ConfigRef) = config.arguments.len > 0 and config.cmd notin {cmdTcc, cmdNimscript, cmdCrun}: rawMessage(config, errGenerated, errArgsNeedRunOption) + if config.nimbleLockExists: + # disable nimble path if nimble.lock is present. + # see https://github.com/nim-lang/nimble/issues/1004 + disableNimblePath(config) + +proc getNimRunExe(conf: ConfigRef): string = + # xxx consider defining `conf.getConfigVar("nimrun.exe")` to allow users to + # customize the binary to run the command with, e.g. for custom `nodejs` or `wine`. + if conf.isDefined("mingw"): + if conf.isDefined("i386"): result = "wine" + elif conf.isDefined("amd64"): result = "wine64" + else: result = "" + else: + result = "" + proc handleCmdLine(cache: IdentCache; conf: ConfigRef) = let self = NimProg( supportsStdinFile: true, @@ -78,9 +106,21 @@ proc handleCmdLine(cache: IdentCache; conf: ConfigRef) = return self.processCmdLineAndProjectPath(conf) + var graph = newModuleGraph(cache, conf) if not self.loadConfigsAndProcessCmdLine(cache, conf, graph): return + + if conf.cmd == cmdCheck and optWasNimscript notin conf.globalOptions and + conf.backend == backendInvalid: + conf.backend = backendC + + if conf.selectedGC == gcUnselected: + if conf.backend in {backendC, backendCpp, backendObjc} or + (conf.cmd in cmdDocLike and conf.backend != backendJs) or + conf.cmd == cmdGendepend: + initOrcDefines(conf) + mainCommand(graph) if conf.hasHint(hintGCStats): echo(GC_getStatistics()) #echo(GC_getStatistics()) @@ -92,19 +132,23 @@ proc handleCmdLine(cache: IdentCache; conf: ConfigRef) = let output = conf.absOutFile case conf.cmd of cmdBackends, cmdTcc: + let nimRunExe = getNimRunExe(conf) var cmdPrefix = "" + if nimRunExe.len > 0: cmdPrefix.add nimRunExe.quoteShell case conf.backend of backendC, backendCpp, backendObjc: discard of backendJs: # D20210217T215950:here this flag is needed for node < v15.0.0, otherwise # tasyncjs_fail` would fail, refs https://nodejs.org/api/cli.html#cli_unhandled_rejections_mode - cmdPrefix = findNodeJs() & " --unhandled-rejections=strict " - else: doAssert false, $conf.backend - # No space before command otherwise 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) - of cmdDocLike, cmdRst2html, cmdRst2tex: # bugfix(cmdRst2tex was missing) + if cmdPrefix.len == 0: cmdPrefix = findNodeJs().quoteShell + cmdPrefix.add " --unhandled-rejections=strict" + else: raiseAssert $conf.backend + if cmdPrefix.len > 0: cmdPrefix.add " " + # without the `cmdPrefix.len > 0` check, on windows you'd get a cryptic: + # `The parameter is incorrect` + let cmd = cmdPrefix & output.quoteShell & ' ' & conf.arguments + execExternalProgram(conf, cmd.strip(leading=false,trailing=true)) + of cmdDocLike, cmdRst2html, cmdRst2tex, cmdMd2html, cmdMd2tex: # bugfix(cmdRst2tex was missing) if conf.arguments.len > 0: # reserved for future use rawMessage(conf, errGenerated, "'$1 cannot handle arguments" % [$conf.cmd]) diff --git a/compiler/nimblecmd.nim b/compiler/nimblecmd.nim index 28398289c..a5324ea76 100644 --- a/compiler/nimblecmd.nim +++ b/compiler/nimblecmd.nim @@ -9,8 +9,14 @@ ## Implements some helper procs for Nimble (Nim's package manager) support. -import parseutils, strutils, strtabs, os, options, msgs, sequtils, - lineinfos, pathutils +import options, msgs, lineinfos, pathutils + +import std/[parseutils, strutils, os, tables, sequtils] + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] + +import ../dist/checksums/src/checksums/sha1 proc addPath*(conf: ConfigRef; path: AbsoluteDir, info: TLineInfo) = if not conf.searchPaths.contains(path): @@ -18,6 +24,7 @@ proc addPath*(conf: ConfigRef; path: AbsoluteDir, info: TLineInfo) = type Version* = distinct string + PackageInfo = Table[string, tuple[version, checksum: string]] proc `$`*(ver: Version): string {.borrow.} @@ -31,11 +38,16 @@ proc isSpecial(ver: Version): bool = proc isValidVersion(v: string): bool = if v.len > 0: - if v[0] in {'#'} + Digits: return true + if v[0] in {'#'} + Digits: + result = true + else: + result = false + else: + result = false proc `<`*(ver: Version, ver2: Version): bool = ## This is synced from Nimble's version module. - + result = false # Handling for special versions such as "#head" or "#branch". if ver.isSpecial or ver2.isSpecial: if ver2.isSpecial and ($ver2).normalize == "#head": @@ -62,43 +74,66 @@ proc `<`*(ver: Version, ver2: Version): bool = else: return false -proc getPathVersion*(p: string): tuple[name, version: string] = - ## Splits path ``p`` in the format ``/home/user/.nimble/pkgs/package-0.1`` - ## into ``(/home/user/.nimble/pkgs/package, 0.1)`` - result.name = "" - result.version = "" +proc getPathVersionChecksum*(p: string): tuple[name, version, checksum: string] = + ## Splits path ``p`` in the format + ## ``/home/user/.nimble/pkgs/package-0.1-febadeaea2345e777f0f6f8433f7f0a52edd5d1b`` into + ## ``("/home/user/.nimble/pkgs/package", "0.1", "febadeaea2345e777f0f6f8433f7f0a52edd5d1b")`` + + result = ("", "", "") - const specialSeparator = "-#" - let last = p.rfind(p.lastPathPart) # the index where the last path part begins - var sepIdx = p.find(specialSeparator, start = last) - if sepIdx == -1: - sepIdx = p.rfind('-', start = last) + const checksumSeparator = '-' + const versionSeparator = '-' + const specialVersionSepartator = "-#" + const separatorNotFound = -1 - if sepIdx == -1: - result.name = p - return + var checksumSeparatorIndex = p.rfind(checksumSeparator) + if checksumSeparatorIndex != separatorNotFound: + result.checksum = p.substr(checksumSeparatorIndex + 1) + if not result.checksum.isValidSha1Hash(): + result.checksum = "" + checksumSeparatorIndex = p.len() + else: + checksumSeparatorIndex = p.len() - for i in sepIdx..<p.len: - if p[i] in {DirSep, AltSep}: - result.name = p - return + var versionSeparatorIndex = p.rfind( + specialVersionSepartator, 0, checksumSeparatorIndex - 1) + if versionSeparatorIndex != separatorNotFound: + result.version = p.substr( + versionSeparatorIndex + 1, checksumSeparatorIndex - 1) + else: + versionSeparatorIndex = p.rfind( + versionSeparator, 0, checksumSeparatorIndex - 1) + if versionSeparatorIndex != separatorNotFound: + result.version = p.substr( + versionSeparatorIndex + 1, checksumSeparatorIndex - 1) + else: + versionSeparatorIndex = checksumSeparatorIndex - result.name = p[0..sepIdx - 1] - result.version = p.substr(sepIdx + 1) + result.name = p[0..<versionSeparatorIndex] -proc addPackage(conf: ConfigRef; packages: StringTableRef, p: string; info: TLineInfo) = - let (name, ver) = getPathVersion(p) +proc addPackage*(conf: ConfigRef; packages: var PackageInfo, p: string; + info: TLineInfo) = + let (name, ver, checksum) = getPathVersionChecksum(p) if isValidVersion(ver): let version = newVersion(ver) - if packages.getOrDefault(name).newVersion < version or + if packages.getOrDefault(name).version.newVersion < version or (not packages.hasKey(name)): - packages[name] = $version + if checksum.isValidSha1Hash(): + packages[name] = ($version, checksum) + else: + packages[name] = ($version, "") else: localError(conf, info, "invalid package name: " & p) -iterator chosen(packages: StringTableRef): string = +iterator chosen(packages: PackageInfo): string = for key, val in pairs(packages): - let res = if val.len == 0: key else: key & '-' & val + var res = key + if val.version.len != 0: + res &= '-' + res &= val.version + if val.checksum.len != 0: + res &= '-' + res &= val.checksum yield res proc addNimblePath(conf: ConfigRef; p: string, info: TLineInfo) = @@ -118,7 +153,7 @@ proc addNimblePath(conf: ConfigRef; p: string, info: TLineInfo) = conf.lazyPaths.insert(AbsoluteDir path, 0) proc addPathRec(conf: ConfigRef; dir: string, info: TLineInfo) = - var packages = newStringTable(modeStyleInsensitive) + var packages: PackageInfo = initTable[string, tuple[version, checksum: string]]() var pos = dir.len-1 if dir[pos] in {DirSep, AltSep}: inc(pos) for k,p in os.walkDir(dir): diff --git a/compiler/nimconf.nim b/compiler/nimconf.nim index 1691e7ccf..5417cd1e9 100644 --- a/compiler/nimconf.nim +++ b/compiler/nimconf.nim @@ -10,11 +10,16 @@ # 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, msgs, lexer, ast, + options, idents, wordrecg, lineinfos, pathutils, scriptconfig + +import std/[os, strutils, strtabs] + +when defined(nimPreviewSlimSystem): + import std/syncio # ---------------- configuration file parser ----------------------------- -# we use Nim's scanner here to save space and work +# we use Nim's lexer here to save space and work proc ppGetTok(L: var Lexer, tok: var Token) = # simple filter @@ -159,7 +164,7 @@ proc checkSymbol(L: Lexer, tok: Token) = lexMessage(L, errGenerated, "expected identifier, but got: " & $tok) proc parseAssignment(L: var Lexer, tok: var Token; - config: ConfigRef; condStack: var seq[bool]) = + config: ConfigRef; filename: AbsoluteFile; condStack: var seq[bool]) = if tok.ident != nil: if tok.ident.s == "-" or tok.ident.s == "--": confTok(L, tok, config, condStack) # skip unnecessary prefix @@ -202,6 +207,7 @@ proc parseAssignment(L: var Lexer, tok: var Token; checkSymbol(L, tok) val.add($tok) confTok(L, tok, config, condStack) + config.currentConfigDir = parentDir(filename.string) if percent: processSwitch(s, strtabs.`%`(val, config.configVars, {useEnvironment, useEmpty}), passPP, info, config) @@ -211,20 +217,21 @@ proc parseAssignment(L: var Lexer, tok: var Token; proc readConfigFile*(filename: AbsoluteFile; cache: IdentCache; config: ConfigRef): bool = var - L: Lexer + L: Lexer = default(Lexer) tok: Token stream: PLLStream stream = llStreamOpen(filename, fmRead) if stream != nil: - initToken(tok) openLexer(L, filename, stream, cache, config) - tok.tokType = tkEof # to avoid a pointless warning + tok = Token(tokType: tkEof) # to avoid a pointless warning var condStack: seq[bool] = @[] confTok(L, tok, config, condStack) # read in the first token - while tok.tokType != tkEof: parseAssignment(L, tok, config, condStack) + while tok.tokType != tkEof: parseAssignment(L, tok, config, filename, condStack) if condStack.len > 0: lexMessage(L, errGenerated, "expected @end") closeLexer(L) return true + else: + result = false proc getUserConfigPath*(filename: RelativeFile): AbsoluteFile = result = getConfigDir().AbsoluteDir / RelativeDir"nim" / filename @@ -240,23 +247,20 @@ proc getSystemConfigPath*(conf: ConfigRef; filename: RelativeFile): AbsoluteFile proc loadConfigs*(cfg: RelativeFile; cache: IdentCache; conf: ConfigRef; idgen: IdGenerator) = setDefaultLibpath(conf) - - var configFiles = newSeq[AbsoluteFile]() - template readConfigFile(path) = let configPath = path if readConfigFile(configPath, cache, conf): - configFiles.add(configPath) + conf.configFiles.add(configPath) template runNimScriptIfExists(path: AbsoluteFile, isMain = false) = let p = path # eval once - var s: PLLStream + var s: PLLStream = nil 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 s != nil: - configFiles.add(p) + conf.configFiles.add(p) runNimScript(cache, p, idgen, freshDefines = false, conf, s) if optSkipSystemConfigFile notin conf.globalOptions: @@ -295,18 +299,22 @@ proc loadConfigs*(cfg: RelativeFile; cache: IdentCache; conf: ConfigRef; idgen: let scriptFile = conf.projectFull.changeFileExt("nims") let scriptIsProj = scriptFile == conf.projectFull template showHintConf = - for filename in configFiles: + for filename in conf.configFiles: # delayed to here so that `hintConf` is honored rawMessage(conf, hintConf, filename.string) - if scriptIsProj: + if conf.cmd == cmdNimscript: showHintConf() - configFiles.setLen 0 - if conf.cmd != cmdIdeTools: - runNimScriptIfExists(scriptFile, isMain = true) + conf.configFiles.setLen 0 + if conf.cmd notin {cmdIdeTools, cmdCheck, cmdDump}: + if conf.cmd == cmdNimscript: + runNimScriptIfExists(conf.projectFull, isMain = true) + else: + runNimScriptIfExists(scriptFile, isMain = true) else: if not scriptIsProj: runNimScriptIfExists(scriptFile, isMain = true) else: # 'nimsuggest foo.nims' means to just auto-complete the NimScript file + # `nim check foo.nims' means to check the syntax of the NimScript file discard showHintConf() diff --git a/compiler/nimeval.nim b/compiler/nimeval.nim index 9be595cce..0833cfeb3 100644 --- a/compiler/nimeval.nim +++ b/compiler/nimeval.nim @@ -9,10 +9,16 @@ ## exposes the Nim VM to clients. import - ast, astalgo, modules, passes, condsyms, - options, sem, llstream, lineinfos, vm, - vmdef, modulegraphs, idents, os, pathutils, - passaux, scriptconfig, std/compilesettings + ast, modules, condsyms, + options, llstream, lineinfos, vm, + vmdef, modulegraphs, idents, pathutils, + scriptconfig, std/[compilesettings, tables, os] + +import pipelines + + +when defined(nimPreviewSlimSystem): + import std/[assertions, syncio] type Interpreter* = ref object ## Use Nim as an interpreter with this object @@ -34,7 +40,7 @@ proc selectUniqueSymbol*(i: Interpreter; name: string; assert i != nil assert i.mainModule != nil, "no main module selected" let n = getIdent(i.graph.cache, name) - var it: ModuleIter + var it: ModuleIter = default(ModuleIter) var s = initModuleIter(it, i.graph, i.mainModule, n) result = nil while s != nil: @@ -57,6 +63,10 @@ proc callRoutine*(i: Interpreter; routine: PSym; args: openArray[PNode]): PNode proc getGlobalValue*(i: Interpreter; letOrVar: PSym): PNode = result = vm.getGlobalValue(PCtx i.graph.vm, letOrVar) +proc setGlobalValue*(i: Interpreter; letOrVar: PSym, val: PNode) = + ## Sets a global value to a given PNode, does not do any type checking. + vm.setGlobalValue(PCtx i.graph.vm, letOrVar, val) + proc implementRoutine*(i: Interpreter; pkg, module, name: string; impl: proc (a: VmArgs) {.closure, gcsafe.}) = assert i != nil @@ -67,12 +77,15 @@ proc evalScript*(i: Interpreter; scriptStream: PLLStream = nil) = ## This can also be used to *reload* the script. assert i != nil assert i.mainModule != nil, "no main module selected" - initStrTable(i.mainModule.semtab(i.graph)) + initStrTables(i.graph, i.mainModule) + i.graph.cacheSeqs.clear() + i.graph.cacheCounters.clear() + i.graph.cacheTables.clear() i.mainModule.ast = nil let s = if scriptStream != nil: scriptStream else: llStreamOpen(findFile(i.graph.config, i.scriptName), fmRead) - processModule(i.graph, i.mainModule, i.idgen, s) + discard processPipelineModule(i.graph, i.mainModule, i.idgen, s) proc findNimStdLib*(): string = ## Tries to find a path to a valid "system.nim" file. @@ -105,12 +118,10 @@ proc createInterpreter*(scriptName: string; var conf = newConfigRef() var cache = newIdentCache() var graph = newModuleGraph(cache, conf) - connectCallbacks(graph) + connectPipelineCallbacks(graph) initDefines(conf.symbols) for define in defines: defineSymbol(conf.symbols, define[0], define[1]) - registerPass(graph, semPass) - registerPass(graph, evalPass) for p in searchPaths: conf.searchPaths.add(AbsoluteDir p) @@ -125,7 +136,8 @@ proc createInterpreter*(scriptName: string; if registerOps: vm.registerAdditionalOps() # Required to register parts of stdlib modules graph.vm = vm - graph.compileSystemModule() + setPipeLinePass(graph, EvalPass) + graph.compilePipelineSystemModule() result = Interpreter(mainModule: m, graph: graph, scriptName: scriptName, idgen: idgen) proc destroyInterpreter*(i: Interpreter) = @@ -155,13 +167,11 @@ proc runRepl*(r: TLLRepl; defineSymbol(conf.symbols, "nimscript") if supportNimscript: defineSymbol(conf.symbols, "nimconfig") when hasFFI: defineSymbol(graph.config.symbols, "nimffi") - registerPass(graph, verbosePass) - registerPass(graph, semPass) - registerPass(graph, evalPass) var m = graph.makeStdinModule() incl(m.flags, sfMainModule) var idgen = idGeneratorFromModule(m) if supportNimscript: graph.vm = setupVM(m, cache, "stdin", graph, idgen) - graph.compileSystemModule() - processModule(graph, m, idgen, llStreamOpenStdIn(r)) + setPipeLinePass(graph, InterpreterPass) + graph.compilePipelineSystemModule() + discard processPipelineModule(graph, m, idgen, llStreamOpenStdIn(r)) diff --git a/compiler/nimfix/nimfix.nim b/compiler/nimfix/nimfix.nim deleted file mode 100644 index 30c138f79..000000000 --- a/compiler/nimfix/nimfix.nim +++ /dev/null @@ -1,111 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2015 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Nimfix is a tool that helps to convert old-style Nimrod code to Nim code. - -import strutils, os, parseopt -import compiler/[options, commands, modules, sem, - passes, passaux, linter, - msgs, nimconf, - extccomp, condsyms, - modulegraphs, idents] - -const Usage = """ -Nimfix - Tool to patch Nim code -Usage: - nimfix [options] projectfile.nim - -Options: - --overwriteFiles:on|off overwrite the original nim files. - DEFAULT is ON! - --wholeProject overwrite every processed file. - --checkExtern:on|off style check also extern names - --styleCheck:on|off|auto performs style checking for identifiers - and suggests an alternative spelling; - 'auto' corrects the spelling. - --bestEffort try to fix the code even when there - are errors. - -In addition, all command line options of Nim are supported. -""" - -proc mainCommand = - registerPass verbosePass - registerPass semPass - conf.setCmd cmdNimfix - searchPaths.add options.libpath - if gProjectFull.len != 0: - # current path is always looked first for modules - searchPaths.insert(gProjectPath, 0) - - compileProject(newModuleGraph(), newIdentCache()) - pretty.overwriteFiles() - -proc processCmdLine*(pass: TCmdLinePass, cmd: string, config: ConfigRef) = - var p = parseopt.initOptParser(cmd) - var argsCount = 0 - gOnlyMainfile = true - while true: - parseopt.next(p) - case p.kind - of cmdEnd: break - of cmdLongoption, cmdShortOption: - case p.key.normalize - of "overwritefiles": - case p.val.normalize - of "on": gOverWrite = true - of "off": gOverWrite = false - else: localError(gCmdLineInfo, errOnOrOffExpected) - of "checkextern": - case p.val.normalize - of "on": gCheckExtern = true - of "off": gCheckExtern = false - else: localError(gCmdLineInfo, errOnOrOffExpected) - of "stylecheck": - case p.val.normalize - of "off": gStyleCheck = StyleCheck.None - of "on": gStyleCheck = StyleCheck.Warn - of "auto": gStyleCheck = StyleCheck.Auto - else: localError(gCmdLineInfo, errOnOrOffExpected) - of "wholeproject": gOnlyMainfile = false - of "besteffort": msgs.gErrorMax = high(int) # don't stop after first error - else: - processSwitch(pass, p, config) - of cmdArgument: - options.gProjectName = unixToNativePath(p.key) - # if processArgument(pass, p, argsCount): break - -proc handleCmdLine(config: ConfigRef) = - if paramCount() == 0: - stdout.writeLine(Usage) - else: - processCmdLine(passCmd1, "", config) - if gProjectName != "": - try: - gProjectFull = canonicalizePath(gProjectName) - except OSError: - gProjectFull = gProjectName - var p = splitFile(gProjectFull) - gProjectPath = p.dir - gProjectName = p.name - else: - gProjectPath = getCurrentDir() - loadConfigs(DefaultConfig, config) # load all config files - # now process command line arguments again, because some options in the - # command line can overwrite the config file's settings - extccomp.initVars() - processCmdLine(passCmd2, "", config) - mainCommand() - -when compileOption("gc", "refc"): - GC_disableMarkAndSweep() - -condsyms.initDefines() -defineSymbol "nimfix" -handleCmdline newConfigRef() diff --git a/compiler/nimfix/nimfix.nim.cfg b/compiler/nimfix/nimfix.nim.cfg deleted file mode 100644 index 0d9dbfa4b..000000000 --- a/compiler/nimfix/nimfix.nim.cfg +++ /dev/null @@ -1,17 +0,0 @@ -# Special configuration file for the Nim project -# gc:markAndSweep - -hint[XDeclaredButNotUsed]:off -path:"$projectPath/.." - -path:"$lib/packages/docutils" -path:"$nim" - -define:useStdoutAsStdmsg -symbol:nimfix -define:nimfix - -cs:partial -#define:useNodeIds -define:booting -define:noDocgen diff --git a/compiler/nimfix/prettybase.nim b/compiler/nimfix/prettybase.nim deleted file mode 100644 index fbc2e3bd1..000000000 --- a/compiler/nimfix/prettybase.nim +++ /dev/null @@ -1,39 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2015 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import strutils except Letters -import ".." / [ast, msgs, lineinfos, idents, options, linter] - -proc replaceDeprecated*(conf: ConfigRef; info: TLineInfo; oldSym, newSym: PIdent) = - let line = sourceLine(conf, info) - var first = min(info.col.int, line.len) - if first < 0: return - #inc first, skipIgnoreCase(line, "proc ", first) - while first > 0 and line[first-1] in Letters: dec first - if first < 0: return - if line[first] == '`': inc first - - let last = first+identLen(line, first)-1 - if cmpIgnoreStyle(line[first..last], oldSym.s) == 0: - var x = line.substr(0, first-1) & newSym.s & line.substr(last+1) - system.shallowCopy(conf.m.fileInfos[info.fileIndex.int32].lines[info.line.int-1], x) - conf.m.fileInfos[info.fileIndex.int32].dirty = true - #if newSym.s == "File": writeStackTrace() - -proc replaceDeprecated*(conf: ConfigRef; info: TLineInfo; oldSym, newSym: PSym) = - replaceDeprecated(conf, info, oldSym.name, newSym.name) - -proc replaceComment*(conf: ConfigRef; info: TLineInfo) = - let line = sourceLine(conf, info) - var first = info.col.int - if line[first] != '#': inc first - - var x = line.substr(0, first-1) & "discard " & line.substr(first+1).escape - system.shallowCopy(conf.m.fileInfos[info.fileIndex.int32].lines[info.line.int-1], x) - conf.m.fileInfos[info.fileIndex.int32].dirty = true diff --git a/compiler/nimlexbase.nim b/compiler/nimlexbase.nim index 99d07d093..6708b57f8 100644 --- a/compiler/nimlexbase.nim +++ b/compiler/nimlexbase.nim @@ -12,8 +12,12 @@ # handling that exists! Only at line endings checks are necessary # if the buffer needs refilling. -import - llstream, strutils +import llstream + +import std/strutils + +when defined(nimPreviewSlimSystem): + import std/assertions const Lrz* = ' ' @@ -104,7 +108,7 @@ proc fillBuffer(L: var TBaseLexer) = oldBufLen = L.bufLen L.bufLen = L.bufLen * 2 L.bufStorage.setLen(L.bufLen) - L.buf = L.bufStorage + L.buf = L.bufStorage.cstring assert(L.bufLen - oldBufLen == oldBufLen) charsRead = llStreamRead(L.stream, addr(L.buf[oldBufLen]), oldBufLen) @@ -147,7 +151,7 @@ proc openBaseLexer(L: var TBaseLexer, inputstream: PLLStream, bufLen = 8192) = L.bufpos = 0 L.offsetBase = 0 L.bufStorage = newString(bufLen) - L.buf = L.bufStorage + L.buf = L.bufStorage.cstring L.bufLen = bufLen L.sentinel = bufLen - 1 L.lineStart = 0 diff --git a/compiler/nimpaths.nim b/compiler/nimpaths.nim index 71bb9a7d7..0a66c3c1f 100644 --- a/compiler/nimpaths.nim +++ b/compiler/nimpaths.nim @@ -9,7 +9,7 @@ specialpaths is simpler because it doesn't need variables to be relocatable at runtime (eg for use in testament) interpolation variables: - $nimr: such that `$nimr/lib/system.nim` exists (avoids confusion with $nim binary) +: $nimr: such that `$nimr/lib/system.nim` exists (avoids confusion with $nim binary) in compiler, it's obtainable via getPrefixDir(); for other tools (eg koch), this could be getCurrentDir() or getAppFilename().parentDir.parentDir, depending on use case @@ -17,15 +17,21 @@ interpolation variables: Unstable API ]## -import std/[os,strutils] +import std/[os, strutils] + +when defined(nimPreviewSlimSystem): + import std/assertions + const docCss* = "$nimr/doc/nimdoc.css" + docCls* = "$nimr/doc/nimdoc.cls" docHackNim* = "$nimr/tools/dochack/dochack.nim" docHackJs* = docHackNim.changeFileExt("js") docHackJsFname* = docHackJs.lastPathPart theindexFname* = "theindex.html" nimdocOutCss* = "nimdoc.out.css" + nimdocOutCls* = "nimdoc.cls" # `out` to make it easier to use with gitignore in user's repos htmldocsDirname* = "htmldocs" dotdotMangle* = "_._" ## refs #13223 diff --git a/compiler/nimsets.nim b/compiler/nimsets.nim index 8683604af..7edf55278 100644 --- a/compiler/nimsets.nim +++ b/compiler/nimsets.nim @@ -12,6 +12,9 @@ import ast, astalgo, lineinfos, bitsets, types, options +when defined(nimPreviewSlimSystem): + import std/assertions + proc inSet*(s: PNode, elem: PNode): bool = assert s.kind == nkCurly if s.kind != nkCurly: @@ -59,8 +62,10 @@ proc someInSet*(s: PNode, a, b: PNode): bool = result = false proc toBitSet*(conf: ConfigRef; s: PNode): TBitSet = - var first, j: Int128 - first = firstOrd(conf, s.typ[0]) + result = @[] + var first: Int128 = Zero + var j: Int128 = Zero + first = firstOrd(conf, s.typ.elementType) bitSetInit(result, int(getSize(conf, s.typ))) for i in 0..<s.len: if s[i].kind == nkRange: diff --git a/compiler/nodejs.nim b/compiler/nodejs.nim index 781035bb7..9753e1c99 100644 --- a/compiler/nodejs.nim +++ b/compiler/nodejs.nim @@ -1,7 +1,10 @@ -import os +import std/os proc findNodeJs*(): string {.inline.} = ## Find NodeJS executable and return it as a string. result = findExe("nodejs") - if result == "": + if result.len == 0: result = findExe("node") + if result.len == 0: + echo "Please install NodeJS first, see https://nodejs.org/en/download" + raise newException(IOError, "NodeJS not found in PATH") diff --git a/compiler/nodekinds.nim b/compiler/nodekinds.nim new file mode 100644 index 000000000..ccdbbd26d --- /dev/null +++ b/compiler/nodekinds.nim @@ -0,0 +1,211 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## NodeKind enum. + +type + TNodeKind* = enum # order is extremely important, because ranges are used + # to check whether a node belongs to a certain class + nkNone, # unknown node kind: indicates an error + # Expressions: + # Atoms: + nkEmpty, # the node is empty + nkIdent, # node is an identifier + nkSym, # node is a symbol + nkType, # node is used for its typ field + + nkCharLit, # a character literal '' + nkIntLit, # an integer literal + nkInt8Lit, + nkInt16Lit, + nkInt32Lit, + nkInt64Lit, + nkUIntLit, # an unsigned integer literal + nkUInt8Lit, + nkUInt16Lit, + nkUInt32Lit, + nkUInt64Lit, + nkFloatLit, # a floating point literal + nkFloat32Lit, + nkFloat64Lit, + nkFloat128Lit, + nkStrLit, # a string literal "" + nkRStrLit, # a raw string literal r"" + nkTripleStrLit, # a triple string literal """ + nkNilLit, # the nil literal + # end of atoms + nkComesFrom, # "comes from" template/macro information for + # better stack trace generation + nkDotCall, # used to temporarily flag a nkCall node; + # this is used + # for transforming ``s.len`` to ``len(s)`` + + nkCommand, # a call like ``p 2, 4`` without parenthesis + nkCall, # a call like p(x, y) or an operation like +(a, b) + nkCallStrLit, # a call with a string literal + # x"abc" has two sons: nkIdent, nkRStrLit + # x"""abc""" has two sons: nkIdent, nkTripleStrLit + nkInfix, # a call like (a + b) + nkPrefix, # a call like !a + nkPostfix, # something like a! (also used for visibility) + nkHiddenCallConv, # an implicit type conversion via a type converter + + nkExprEqExpr, # a named parameter with equals: ''expr = expr'' + nkExprColonExpr, # a named parameter with colon: ''expr: expr'' + nkIdentDefs, # a definition like `a, b: typeDesc = expr` + # either typeDesc or expr may be nil; used in + # formal parameters, var statements, etc. + nkVarTuple, # a ``var (a, b) = expr`` construct + nkPar, # syntactic (); may be a tuple constructor + nkObjConstr, # object constructor: T(a: 1, b: 2) + nkCurly, # syntactic {} + nkCurlyExpr, # an expression like a{i} + nkBracket, # syntactic [] + nkBracketExpr, # an expression like a[i..j, k] + nkPragmaExpr, # an expression like a{.pragmas.} + nkRange, # an expression like i..j + nkDotExpr, # a.b + nkCheckedFieldExpr, # a.b, but b is a field that needs to be checked + nkDerefExpr, # a^ + nkIfExpr, # if as an expression + nkElifExpr, + nkElseExpr, + nkLambda, # lambda expression + nkDo, # lambda block appering as trailing proc param + nkAccQuoted, # `a` as a node + + nkTableConstr, # a table constructor {expr: expr} + nkBind, # ``bind expr`` node + nkClosedSymChoice, # symbol choice node; a list of nkSyms (closed) + nkOpenSymChoice, # symbol choice node; a list of nkSyms (open) + nkHiddenStdConv, # an implicit standard type conversion + nkHiddenSubConv, # an implicit type conversion from a subtype + # to a supertype + nkConv, # a type conversion + nkCast, # a type cast + nkStaticExpr, # a static expr + nkAddr, # a addr expression + nkHiddenAddr, # implicit address operator + nkHiddenDeref, # implicit ^ operator + nkObjDownConv, # down conversion between object types + nkObjUpConv, # up conversion between object types + nkChckRangeF, # range check for floats + nkChckRange64, # range check for 64 bit ints + nkChckRange, # range check for ints + nkStringToCString, # string to cstring + nkCStringToString, # cstring to string + # end of expressions + + nkAsgn, # a = b + nkFastAsgn, # internal node for a fast ``a = b`` + # (no string copy) + nkGenericParams, # generic parameters + nkFormalParams, # formal parameters + nkOfInherit, # inherited from symbol + + nkImportAs, # a 'as' b in an import statement + nkProcDef, # a proc + nkMethodDef, # a method + nkConverterDef, # a converter + nkMacroDef, # a macro + nkTemplateDef, # a template + nkIteratorDef, # an iterator + + nkOfBranch, # used inside case statements + # for (cond, action)-pairs + nkElifBranch, # used in if statements + nkExceptBranch, # an except section + nkElse, # an else part + nkAsmStmt, # an assembler block + nkPragma, # a pragma statement + nkPragmaBlock, # a pragma with a block + nkIfStmt, # an if statement + nkWhenStmt, # a when expression or statement + nkForStmt, # a for statement + nkParForStmt, # a parallel for statement + nkWhileStmt, # a while statement + nkCaseStmt, # a case statement + nkTypeSection, # a type section (consists of type definitions) + nkVarSection, # a var section + nkLetSection, # a let section + nkConstSection, # a const section + nkConstDef, # a const definition + nkTypeDef, # a type definition + nkYieldStmt, # the yield statement as a tree + nkDefer, # the 'defer' statement + nkTryStmt, # a try statement + nkFinally, # a finally section + nkRaiseStmt, # a raise statement + nkReturnStmt, # a return statement + nkBreakStmt, # a break statement + nkContinueStmt, # a continue statement + nkBlockStmt, # a block statement + nkStaticStmt, # a static statement + nkDiscardStmt, # a discard statement + nkStmtList, # a list of statements + nkImportStmt, # an import statement + nkImportExceptStmt, # an import x except a statement + nkExportStmt, # an export statement + nkExportExceptStmt, # an 'export except' statement + nkFromStmt, # a from * import statement + nkIncludeStmt, # an include statement + nkBindStmt, # a bind statement + nkMixinStmt, # a mixin statement + nkUsingStmt, # an using statement + nkCommentStmt, # a comment statement + nkStmtListExpr, # a statement list followed by an expr; this is used + # to allow powerful multi-line templates + nkBlockExpr, # a statement block ending in an expr; this is used + # to allow powerful multi-line templates that open a + # temporary scope + nkStmtListType, # a statement list ending in a type; for macros + nkBlockType, # a statement block ending in a type; for macros + # types as syntactic trees: + + nkWith, # distinct with `foo` + nkWithout, # distinct without `foo` + + nkTypeOfExpr, # type(1+2) + nkObjectTy, # object body + nkTupleTy, # tuple body + nkTupleClassTy, # tuple type class + nkTypeClassTy, # user-defined type class + nkStaticTy, # ``static[T]`` + nkRecList, # list of object parts + nkRecCase, # case section of object + nkRecWhen, # when section of object + nkRefTy, # ``ref T`` + nkPtrTy, # ``ptr T`` + nkVarTy, # ``var T`` + nkConstTy, # ``const T`` + nkOutTy, # ``out T`` + nkDistinctTy, # distinct type + nkProcTy, # proc type + nkIteratorTy, # iterator type + nkSinkAsgn, # '=sink(x, y)' + nkEnumTy, # enum body + nkEnumFieldDef, # `ident = expr` in an enumeration + nkArgList, # argument list + nkPattern, # a special pattern; used for matching + nkHiddenTryStmt, # a hidden try statement + nkClosure, # (prc, env)-pair (internally used for code gen) + nkGotoState, # used for the state machine (for iterators) + nkState, # give a label to a code section (for iterators) + nkBreakState, # special break statement for easier code generation + nkFuncDef, # a func + nkTupleConstr # a tuple constructor + nkError # erroneous AST node + nkModuleRef # for .rod file support: A (moduleId, itemId) pair + nkReplayAction # for .rod file support: A replay action + nkNilRodNode # for .rod file support: a 'nil' PNode + nkOpenSym # container for captured sym that can be overriden by local symbols + +const + nkCallKinds* = {nkCall, nkInfix, nkPrefix, nkPostfix, + nkCommand, nkCallStrLit, nkHiddenCallConv} diff --git a/compiler/nversion.nim b/compiler/nversion.nim index 2da39b138..811008989 100644 --- a/compiler/nversion.nim +++ b/compiler/nversion.nim @@ -12,6 +12,8 @@ const MaxSetElements* = 1 shl 16 # (2^16) to support unicode character sets? + DefaultSetElements* = 1 shl 8 + ## assumed set element count when using int literals VersionAsString* = system.NimVersion RodFileVersion* = "1223" # modify this if the rod-format changes! diff --git a/compiler/optimizer.nim b/compiler/optimizer.nim index 744c82ab5..34e8ec80f 100644 --- a/compiler/optimizer.nim +++ b/compiler/optimizer.nim @@ -12,10 +12,12 @@ ## - recognize "all paths lead to 'wasMoved(x)'" import - ast, renderer, idents, intsets + ast, renderer, idents from trees import exprStructuralEquivalent +import std/[strutils, intsets] + const nfMarkForDeletion = nfNone # faster than a lookup table @@ -64,7 +66,7 @@ proc mergeBasicBlockInfo(parent: var BasicBlock; this: BasicBlock) {.inline.} = proc wasMovedTarget(matches: var IntSet; branch: seq[PNode]; moveTarget: PNode): bool = result = false for i in 0..<branch.len: - if exprStructuralEquivalent(branch[i][1].skipAddr, moveTarget, + if exprStructuralEquivalent(branch[i][1].skipHiddenAddr, moveTarget, strictSymEquality = true): result = true matches.incl i @@ -74,7 +76,7 @@ proc intersect(summary: var seq[PNode]; branch: seq[PNode]) = var i = 0 var matches = initIntSet() while i < summary.len: - if wasMovedTarget(matches, branch, summary[i][1].skipAddr): + if wasMovedTarget(matches, branch, summary[i][1].skipHiddenAddr): inc i else: summary.del i @@ -85,7 +87,7 @@ proc intersect(summary: var seq[PNode]; branch: seq[PNode]) = proc invalidateWasMoved(c: var BasicBlock; x: PNode) = var i = 0 while i < c.wasMovedLocs.len: - if exprStructuralEquivalent(c.wasMovedLocs[i][1].skipAddr, x, + if exprStructuralEquivalent(c.wasMovedLocs[i][1].skipHiddenAddr, x, strictSymEquality = true): c.wasMovedLocs.del i else: @@ -94,7 +96,7 @@ proc invalidateWasMoved(c: var BasicBlock; x: PNode) = proc wasMovedDestroyPair(c: var Con; b: var BasicBlock; d: PNode) = var i = 0 while i < b.wasMovedLocs.len: - if exprStructuralEquivalent(b.wasMovedLocs[i][1].skipAddr, d[1].skipAddr, + if exprStructuralEquivalent(b.wasMovedLocs[i][1].skipHiddenAddr, d[1].skipHiddenAddr, strictSymEquality = true): b.wasMovedLocs[i].flags.incl nfMarkForDeletion c.somethingTodo = true @@ -110,16 +112,17 @@ proc analyse(c: var Con; b: var BasicBlock; n: PNode) = var reverse = false if n[0].kind == nkSym: let s = n[0].sym - if s.magic == mWasMoved: + let name = s.name.s.normalize + if name == "=wasmoved": b.wasMovedLocs.add n special = true - elif s.name.s == "=destroy": + elif name == "=destroy": if c.inFinally > 0 and (b.hasReturn or b.hasBreak): discard "cannot optimize away the destructor" else: c.wasMovedDestroyPair b, n special = true - elif s.name.s == "=sink": + elif name == "=sink": reverse = true if not special: @@ -127,11 +130,11 @@ proc analyse(c: var Con; b: var BasicBlock; n: PNode) = for i in 0 ..< n.len: analyse(c, b, n[i]) else: - #[ Test tmatrix.test3: + #[ Test destructor/tmatrix.test3: Prevent this from being elided. We should probably find a better solution... - `=sink`(b, - ( + `=sink`(b, - let blitTmp = b; wasMoved(b); blitTmp + a) @@ -154,7 +157,7 @@ proc analyse(c: var Con; b: var BasicBlock; n: PNode) = nkTypeOfExpr, nkMixinStmt, nkBindStmt: discard "do not follow the construct" - of nkAsgn, nkFastAsgn: + of nkAsgn, nkFastAsgn, nkSinkAsgn: # reverse order, see remark for `=sink`: analyse(c, b, n[1]) analyse(c, b, n[0]) @@ -178,7 +181,7 @@ proc analyse(c: var Con; b: var BasicBlock; n: PNode) = of nkCaseStmt: let isExhaustive = skipTypes(n[0].typ, - abstractVarRange-{tyTypeDesc}).kind notin {tyFloat..tyFloat128, tyString} or + abstractVarRange-{tyTypeDesc}).kind notin {tyFloat..tyFloat128, tyString, tyCstring} or n[^1].kind == nkElse analyse(c, b, n[0]) @@ -276,8 +279,8 @@ proc optimize*(n: PNode): PNode = Now assume 'use' raises, then we shouldn't do the 'wasMoved(s)' ]# - var c: Con - var b: BasicBlock + var c: Con = Con() + var b: BasicBlock = default(BasicBlock) analyse(c, b, n) if c.somethingTodo: result = shallowCopy(n) diff --git a/compiler/options.nim b/compiler/options.nim index 2d63043df..b77bdd2a3 100644 --- a/compiler/options.nim +++ b/compiler/options.nim @@ -8,18 +8,26 @@ # import - os, strutils, strtabs, sets, lineinfos, platform, - prefixmatches, pathutils, nimpaths, tables + lineinfos, platform, + prefixmatches, pathutils, nimpaths + +import std/[tables, os, strutils, strtabs, sets] +from std/terminal import isatty +from std/times import utc, fromUnix, local, getTime, format, DateTime +from std/private/globs import nativeToUnixPath + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] -from terminal import isatty -from times import utc, fromUnix, local, getTime, format, DateTime const hasTinyCBackend* = defined(tinyc) useEffectSystem* = true useWriteTracking* = false hasFFI* = defined(nimHasLibFFI) - copyrightYear* = "2021" + copyrightYear* = "2024" + + nimEnableCovariance* = defined(nimEnableCovariance) type # please make sure we have under 32 options # (improves code efficiency a lot!) @@ -41,10 +49,11 @@ type # please make sure we have under 32 options optMemTracker, optSinkInference # 'sink T' inference optCursorInference - + optImportHidden + optQuirky TOptions* = set[TOption] - TGlobalOption* = enum # **keep binary compatible** + TGlobalOption* = enum gloptNone, optForceFullMake, optWasNimscript, # redundant with `cmdNimscript`, could be removed optListCmd, optCompileOnly, optNoLinking, @@ -53,11 +62,13 @@ type # please make sure we have under 32 options optGenStaticLib, # generate a static library optGenGuiApp, # generate a GUI application optGenScript, # generate a script file to compile the *.c files + optGenCDeps, # generate a list of *.c files to be read by CMake 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 @@ -69,16 +80,18 @@ type # please make sure we have under 32 options optThreadAnalysis, # thread analysis pass optTlsEmulation, # thread var emulation turned on optGenIndex # generate index file for documentation; + optGenIndexOnly # generate only index file for documentation + optNoImportdoc # disable loading external documentation files optEmbedOrigSrc # embed the original source in the generated code # also: generate header file optIdeDebug # idetools: debug mode optIdeTerse # idetools: use terse descriptions + optIdeExceptionInlayHints optExcessiveStackTrace # fully qualified module filenames optShowAllMismatches # show all overloading resolution candidates optWholeProject # for 'doc': output any dependency optDocInternal # generate documentation for non-exported symbols optMixedMode # true if some module triggered C++ codegen - optListFullPaths # use full paths in toMsgFilename optDeclaredLocs # show declaration locations in messages optNoNimblePath optHotCodeReloading @@ -92,11 +105,11 @@ type # please make sure we have under 32 options 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. + optShowNonExportedFields # for documentation: show fields that are not exported + optJsBigInt64 # use bigints for 64-bit integers in JS TGlobalOptions* = set[TGlobalOption] @@ -132,18 +145,22 @@ type Command* = enum ## Nim's commands cmdNone # not yet processed command cmdUnknown # command unmapped - cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, cmdCompileToJS + cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, cmdCompileToJS, cmdCrun # compile and run in nimache cmdTcc # run the project via TCC backend cmdCheck # semantic checking for whole project + cmdM # only compile a single 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 - cmdDoc2 + 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 + cmdMd2html # convert a Markdown file to HTML + cmdMd2tex # convert a Markdown file to TeX cmdJsondoc0 cmdJsondoc cmdCtags @@ -153,27 +170,37 @@ type cmdInteractive # start interactive session cmdNop cmdJsonscript # compile a .json build file - cmdNimfix # old unused: cmdInterpret, cmdDef: def feature (find definition for IDEs) const - cmdBackends* = {cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, cmdCompileToJS, cmdCrun} - cmdDocLike* = {cmdDoc0, cmdDoc2, cmdJsondoc0, cmdJsondoc, cmdCtags, cmdBuildindex} + cmdBackends* = {cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, + cmdCompileToJS, cmdCrun} + cmdDocLike* = {cmdDoc0, cmdDoc, cmdDoc2tex, cmdJsondoc0, cmdJsondoc, + cmdCtags, cmdBuildindex} type TStringSeq* = seq[string] TGCMode* = enum # the selected GC - gcUnselected, gcNone, gcBoehm, gcRegions, gcArc, gcOrc, - gcMarkAndSweep, gcHooks, gcRefc, gcV2, gcGo + gcUnselected = "unselected" + gcNone = "none" + gcBoehm = "boehm" + gcRegions = "regions" + gcArc = "arc" + gcOrc = "orc" + gcAtomicArc = "atomicArc" + gcMarkAndSweep = "markAndSweep" + gcHooks = "hooks" + gcRefc = "refc" + gcGo = "go" # gcRefc and the GCs that follow it use a write barrier, # as far as usesWriteBarrier() is concerned IdeCmd* = enum - ideNone, ideSug, ideCon, ideDef, ideUse, ideDus, ideChk, ideMod, - ideHighlight, ideOutline, ideKnown, ideMsg, ideProject + ideNone, ideSug, ideCon, ideDef, ideUse, ideDus, ideChk, ideChkFile, ideMod, + ideHighlight, ideOutline, ideKnown, ideMsg, ideProject, ideGlobalSymbols, + ideRecompile, ideChanged, ideType, ideDeclaration, ideExpand, ideInlayHints Feature* = enum ## experimental features; DO NOT RENAME THESE! - implicitDeref, dotOperators, callOperator, parallel, @@ -181,16 +208,27 @@ type notnil, dynamicBindSym, forLoopMacros, # not experimental anymore; remains here for backwards compatibility - caseStmtMacros, + caseStmtMacros, # ditto codeReordering, compiletimeFFI, ## This requires building nim with `-d:nimHasLibFFI` - ## which itself requires `nimble install libffi`, see #10150 + ## which itself requires `koch installdeps libffi`, see #10150 ## Note: this feature can't be localized with {.push.} vmopsDanger, strictFuncs, views, - strictNotNil + strictNotNil, + overloadableEnums, # deadcode + strictEffects, + unicodeOperators, # deadcode + flexibleOptionalParams, + strictDefs, + strictCaseObjects, + inferGenericTypes, + openSym, # remove nfDisabledOpenSym when this is default + # alternative to above: + genericsOpenSym + vtables LegacyFeature* = enum allowSemcheckedAstModification, @@ -201,13 +239,21 @@ type ## Historically and especially in version 1.0.0 of the language ## conversions to unsigned numbers were checked. In 1.0.4 they ## are not anymore. + laxEffects + ## Lax effects system prior to Nim 2.0. + verboseTypeMismatch + emitGenerics + ## generics are emitted in the module that contains them. + ## Useful for libraries that rely on local passC + jsNoLambdaLifting + ## Old transformation for closures in JS backend SymbolFilesOption* = enum disabledSf, writeOnlySf, readOnlySf, v2Sf, stressTest TSystemCC* = enum ccNone, ccGcc, ccNintendoSwitch, ccLLVM_Gcc, ccCLang, ccBcc, ccVcc, - ccTcc, ccEnv, ccIcl, ccIcc, ccClangCl + ccTcc, ccEnv, ccIcl, ccIcc, ccClangCl, ccHipcc, ccNvcc ExceptionSystem* = enum excNone, # no exception system selected yet @@ -245,8 +291,27 @@ type scope*, localUsages*, globalUsages*: int # more usages is better tokenLen*: int version*: int + endLine*: uint16 + endCol*: int + inlayHintInfo*: SuggestInlayHint + Suggestions* = seq[Suggest] + SuggestInlayHintKind* = enum + sihkType = "Type", + sihkParameter = "Parameter" + sihkException = "Exception" + + SuggestInlayHint* = ref object + kind*: SuggestInlayHintKind + line*: int # Starts at 1 + column*: int # Starts at 0 + label*: string + paddingLeft*: bool + paddingRight*: bool + allowInsert*: bool + tooltip*: string + ProfileInfo* = object time*: float count*: int @@ -258,7 +323,15 @@ type stdOrrStdout stdOrrStderr - ConfigRef* = ref object ## every global configuration + 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 + + ConfigRef* {.acyclic.} = ref object ## every global configuration ## fields marked with '*' are subject to ## the incremental compilation mechanisms ## (+) means "part of the dependency" @@ -270,6 +343,8 @@ type macrosToExpand*: StringTableRef arcToExpand*: StringTableRef m*: MsgConfig + filenameOption*: FilenameOption # how to render paths in compiler messages + unitSep*: string evalTemplateCounter*: int evalMacroCounter*: int exitcode*: int8 @@ -279,6 +354,7 @@ type 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 @@ -287,13 +363,13 @@ type cppDefines*: HashSet[string] # (*) headerFile*: string + nimbasePattern*: string # pattern to find nimbase.h features*: set[Feature] legacyFeatures*: set[LegacyFeature] arguments*: string ## the arguments to be passed to the program that ## should be run ideCmd*: IdeCmd - oldNewlines*: bool - cCompiler*: TSystemCC + 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 @@ -306,6 +382,7 @@ type warnCounter*: int errorMax*: int 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 @@ -318,7 +395,7 @@ type outDir*: AbsoluteDir jsonBuildFile*: AbsoluteFile prefixDir*, libpath*, nimcacheDir*: AbsoluteDir - dllOverrides, moduleOverrides*, cfileSpecificOptions*: StringTableRef + dllOverrides*, moduleOverrides*, cfileSpecificOptions*: StringTableRef projectName*: string # holds a name like 'nim' projectPath*: AbsoluteDir # holds a path like /home/alice/projects/nim/compiler/ projectFull*: AbsoluteFile # projectPath/projectName @@ -330,7 +407,6 @@ type commandArgs*: seq[string] # any arguments after the main command commandLine*: string extraCmds*: seq[string] # for writeJsonBuildInstructions - keepComments*: bool # whether the parser needs to keep comments implicitImports*: seq[string] # modules that are to be implicitly imported implicitIncludes*: seq[string] # modules that are to be implicitly included docSeeSrcUrl*: string # if empty, no seeSrc will be generated. \ @@ -338,7 +414,7 @@ type docRoot*: string ## see nim --fullhelp for --docRoot docCmd*: string ## see nim --fullhelp for --docCmd - # the used compiler + 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 @@ -355,12 +431,23 @@ type suggestVersion*: int suggestMaxResults*: int lastLineInfo*: TLineInfo - writelnHook*: proc (output: string) {.closure.} # cannot make this gcsafe yet because of Nimble + writelnHook*: proc (output: string) {.closure, gcsafe.} structuredErrorHook*: proc (config: ConfigRef; info: TLineInfo; msg: string; severity: Severity) {.closure, gcsafe.} cppCustomNamespace*: string + nimMainPrefix*: string vmProfileData*: ProfileData + expandProgress*: bool + expandLevels*: int + expandNodeResult*: string + expandPosition*: TLineInfo + + currentConfigDir*: string # used for passPP only; absolute dir + clientProcessId*: int + + + proc assignIfDefault*[T](result: var T, val: T, def = default(T)) = ## if `result` was already assigned to a value (that wasn't `def`), this is a noop. if result == def: result = val @@ -390,7 +477,7 @@ proc hasHint*(conf: ConfigRef, note: TNoteKind): bool = note in conf.mainPackageNotes else: note in conf.notes -proc hasWarn*(conf: ConfigRef, note: TNoteKind): bool = +proc hasWarn*(conf: ConfigRef, note: TNoteKind): bool {.inline.} = optWarns in conf.options and note in conf.notes proc hcrOn*(conf: ConfigRef): bool = return optHotCodeReloading in conf.globalOptions @@ -402,7 +489,7 @@ when false: fn(globalOptions) fn(selectedGC) -const oldExperimentalFeatures* = {implicitDeref, dotOperators, callOperator, parallel} +const oldExperimentalFeatures* = {dotOperators, callOperator, parallel} const ChecksOptions* = {optObjCheck, optFieldCheck, optRangeCheck, @@ -413,8 +500,8 @@ const optBoundsCheck, optOverflowCheck, optAssert, optWarns, optRefCheck, optHints, optStackTrace, optLineTrace, # consider adding `optStackTraceMsgs` optTrMacros, optStyleCheck, optCursorInference} - DefaultGlobalOptions* = {optThreadAnalysis, - optExcessiveStackTrace, optListFullPaths} + DefaultGlobalOptions* = {optThreadAnalysis, optExcessiveStackTrace, + optJsBigInt64} proc getSrcTimestamp(): DateTime = try: @@ -446,19 +533,33 @@ proc newProfileData(): ProfileData = 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.selectedGC = gcUnselected + conf.verbosity = 1 + conf.hintProcessingDots = true + conf.options = DefaultOptions + conf.globalOptions = DefaultGlobalOptions + conf.filenameOption = foAbs + conf.foreignPackageNotes = foreignPackageNotesDefault + conf.notes = NotesVerbosity[1] + conf.mainPackageNotes = NotesVerbosity[1] + proc newConfigRef*(): ConfigRef = result = ConfigRef( - selectedGC: gcRefc, cCompiler: ccGcc, - verbosity: 1, - options: DefaultOptions, - globalOptions: DefaultGlobalOptions, macrosToExpand: newStringTable(modeStyleInsensitive), arcToExpand: newStringTable(modeStyleInsensitive), m: initMsgConfig(), cppDefines: initHashSet[string](), - headerFile: "", features: {}, legacyFeatures: {}, foreignPackageNotes: foreignPackageNotesDefault, - notes: NotesVerbosity[1], mainPackageNotes: NotesVerbosity[1], + headerFile: "", features: {}, legacyFeatures: {}, configVars: newStringTable(modeStyleInsensitive), symbols: newStringTable(modeStyleInsensitive), packageCache: newPackageCache(), @@ -479,7 +580,6 @@ proc newConfigRef*(): ConfigRef = command: "", # the main command (e.g. cc, check, scan, etc) commandArgs: @[], # any arguments after the main command commandLine: "", - keepComments: true, # whether the parser needs to keep comments implicitImports: @[], # modules that are to be implicitly imported implicitIncludes: @[], # modules that are to be implicitly included docSeeSrcUrl: "", @@ -499,21 +599,23 @@ proc newConfigRef*(): ConfigRef = maxLoopIterationsVM: 10_000_000, vmProfileData: newProfileData(), spellSuggestMax: spellSuggestSecretSauce, + currentConfigDir: "" ) + initConfigRefCommon(result) setTargetFromSystem(result.target) # enable colors by default on terminals if terminal.isatty(stderr): incl(result.globalOptions, optUseColors) + when defined(nimDebugUtils): + onNewConfigRef(result) proc newPartialConfigRef*(): ConfigRef = ## create a new ConfigRef that is only good enough for error reporting. - result = ConfigRef( - selectedGC: gcRefc, - verbosity: 1, - options: DefaultOptions, - globalOptions: DefaultGlobalOptions, - foreignPackageNotes: foreignPackageNotesDefault, - notes: NotesVerbosity[1], mainPackageNotes: NotesVerbosity[1]) + when defined(nimDebugUtils): + result = getConfigRef() + else: + result = ConfigRef() + initConfigRefCommon(result) proc cppDefine*(c: ConfigRef; define: string) = c.cppDefines.incl define @@ -535,11 +637,13 @@ proc isDefined*(conf: ConfigRef; symbol: string): bool = osQnx, osAtari, osAix, osHaiku, osVxWorks, osSolaris, osNetbsd, osFreebsd, osOpenbsd, osDragonfly, osMacosx, osIos, - osAndroid, osNintendoSwitch, osFreeRTOS} + osAndroid, osNintendoSwitch, osFreeRTOS, osCrossos, osZephyr, osNuttX} of "linux": result = conf.target.targetOS in {osLinux, osAndroid} of "bsd": - result = conf.target.targetOS in {osNetbsd, osFreebsd, osOpenbsd, osDragonfly} + result = conf.target.targetOS in {osNetbsd, osFreebsd, osOpenbsd, osDragonfly, osCrossos} + of "freebsd": + result = conf.target.targetOS in {osFreebsd, osCrossos} of "emulatedthreadvars": result = platform.OS[conf.target.targetOS].props.contains(ospLacksThreadVars) of "msdos": result = conf.target.targetOS == osDos @@ -551,12 +655,14 @@ proc isDefined*(conf: ConfigRef; symbol: string): bool = of "sunos": result = conf.target.targetOS == osSolaris of "nintendoswitch": result = conf.target.targetOS == osNintendoSwitch - of "freertos": + of "freertos", "lwip": result = conf.target.targetOS == osFreeRTOS - of "lwip": - result = conf.target.targetOS in {osFreeRTOS} - of "littleendian": result = CPU[conf.target.targetCPU].endian == platform.littleEndian - of "bigendian": result = CPU[conf.target.targetCPU].endian == platform.bigEndian + of "zephyr": + result = conf.target.targetOS == osZephyr + of "nuttx": + result = conf.target.targetOS == osNuttX + of "littleendian": result = CPU[conf.target.targetCPU].endian == littleEndian + of "bigendian": result = CPU[conf.target.targetCPU].endian == bigEndian of "cpu8": result = CPU[conf.target.targetCPU].bit == 8 of "cpu16": result = CPU[conf.target.targetCPU].bit == 16 of "cpu32": result = CPU[conf.target.targetCPU].bit == 32 @@ -564,7 +670,14 @@ proc isDefined*(conf: ConfigRef; symbol: string): bool = of "nimrawsetjmp": result = conf.target.targetOS in {osSolaris, osNetbsd, osFreebsd, osOpenbsd, osDragonfly, osMacosx} - else: discard + else: result = false + +template quitOrRaise*(conf: ConfigRef, msg = "") = + # xxx in future work, consider whether to also intercept `msgQuit` calls + if conf.isDefined("nimDebug"): + raiseAssert msg + else: + quit(msg) # quits with QuitFailure proc importantComments*(conf: ConfigRef): bool {.inline.} = conf.cmd in cmdDocLike + {cmdIdeTools} proc usesWriteBarrier*(conf: ConfigRef): bool {.inline.} = conf.selectedGC >= gcRefc @@ -622,22 +735,24 @@ proc getPrefixDir*(conf: ConfigRef): AbsoluteDir = ## clone or using installed nim, so that these exist: `result/doc/advopt.txt` ## and `result/lib/system.nim` if not conf.prefixDir.isEmpty: result = conf.prefixDir - else: result = AbsoluteDir splitPath(getAppDir()).head + else: + let binParent = AbsoluteDir splitPath(getAppDir()).head + when defined(posix): + if binParent == AbsoluteDir"/usr": + result = AbsoluteDir"/usr/lib/nim" + elif binParent == AbsoluteDir"/usr/local": + result = AbsoluteDir"/usr/local/lib/nim" + else: + result = binParent + else: + result = binParent proc setDefaultLibpath*(conf: ConfigRef) = # set default value (can be overwritten): if conf.libpath.isEmpty: # choose default libpath: var prefix = getPrefixDir(conf) - when defined(posix): - if prefix == AbsoluteDir"/usr": - conf.libpath = AbsoluteDir"/usr/lib/nim" - elif prefix == AbsoluteDir"/usr/local": - conf.libpath = AbsoluteDir"/usr/local/lib/nim" - else: - conf.libpath = prefix / RelativeDir"lib" - else: - conf.libpath = prefix / RelativeDir"lib" + conf.libpath = prefix / RelativeDir"lib" # Special rule to support other tools (nimble) which import the compiler # modules and make use of them. @@ -651,6 +766,19 @@ proc setDefaultLibpath*(conf: ConfigRef) = proc canonicalizePath*(conf: ConfigRef; path: AbsoluteFile): AbsoluteFile = result = AbsoluteFile path.string.expandFilename +proc setFromProjectName*(conf: ConfigRef; projectName: string) = + try: + conf.projectFull = canonicalizePath(conf, AbsoluteFile projectName) + except OSError: + conf.projectFull = AbsoluteFile projectName + let p = splitFile(conf.projectFull) + let dir = if p.dir.isEmpty: AbsoluteDir getCurrentDir() else: p.dir + try: + conf.projectPath = AbsoluteDir canonicalizePath(conf, AbsoluteFile dir) + except OSError: + conf.projectPath = dir + conf.projectName = p.name + proc removeTrailingDirSep*(path: string): string = if (path.len > 0) and (path[^1] == DirSep): result = substr(path, 0, path.len - 2) @@ -675,14 +803,23 @@ proc getOsCacheDir(): string = result = getHomeDir() / genSubDir.string proc getNimcacheDir*(conf: ConfigRef): AbsoluteDir = + proc nimcacheSuffix(conf: ConfigRef): string = + if conf.cmd == cmdCheck: "_check" + elif isDefined(conf, "release") or isDefined(conf, "danger"): "_r" + else: "_d" + # XXX projectName should always be without a file extension! - result = if not conf.nimcacheDir.isEmpty: - conf.nimcacheDir - elif conf.backend == backendJs: - conf.projectPath / genSubDir - else: - AbsoluteDir(getOsCacheDir() / splitFile(conf.projectName).name & - (if isDefined(conf, "release") or isDefined(conf, "danger"): "_r" else: "_d")) + result = + if not conf.nimcacheDir.isEmpty: + conf.nimcacheDir + elif conf.backend == backendJs: + if conf.outDir.isEmpty: + conf.projectPath / genSubDir + else: + conf.outDir / genSubDir + else: + AbsoluteDir(getOsCacheDir() / splitFile(conf.projectName).name & + nimcacheSuffix(conf)) proc pathSubs*(conf: ConfigRef; p, config: string): string = let home = removeTrailingDirSep(os.getHomeDir()) @@ -712,19 +849,15 @@ proc toGeneratedFile*(conf: ConfigRef; path: AbsoluteFile, proc completeGeneratedFilePath*(conf: ConfigRef; f: AbsoluteFile, createSubDir: bool = true): AbsoluteFile = + ## Return an absolute path of a generated intermediary file. + ## Optionally creates the cache directory if `createSubDir` is `true`. let subdir = getNimcacheDir(conf) if createSubDir: try: createDir(subdir.string) except OSError: - writeLine(stdout, "cannot create directory: " & subdir.string) - quit(1) + conf.quitOrRaise "cannot create directory: " & subdir.string result = subdir / RelativeFile f.string.splitPath.tail - #echo "completeGeneratedFilePath(", f, ") = ", result - -proc toRodFile*(conf: ConfigRef; f: AbsoluteFile; ext = RodExt): AbsoluteFile = - result = changeFileExt(completeGeneratedFilePath(conf, - withPackageName(conf, f)), ext) proc rawFindFile(conf: ConfigRef; f: RelativeFile; suppressStdlib: bool): AbsoluteFile = for it in conf.searchPaths: @@ -753,27 +886,21 @@ template patchModule(conf: ConfigRef) {.dirty.} = let ov = conf.moduleOverrides[key] if ov.len > 0: result = AbsoluteFile(ov) -when (NimMajor, NimMinor) < (1, 1) or not declared(isRelativeTo): - proc isRelativeTo(path, base: string): bool = - # pending #13212 use os.isRelativeTo - let path = path.normalizedPath - let base = base.normalizedPath - let ret = relativePath(path, base) - result = path.len > 0 and not ret.startsWith ".." - -const stdlibDirs = [ +const stdlibDirs* = [ "pure", "core", "arch", "pure/collections", "pure/concurrency", "pure/unidecode", "impure", "wrappers", "wrappers/linenoise", - "windows", "posix", "js"] + "windows", "posix", "js", + "deprecated/pure"] const pkgPrefix = "pkg/" - stdPrefix = "std/" + stdPrefix* = "std/" proc getRelativePathFromConfigPath*(conf: ConfigRef; f: AbsoluteFile, isTitle = false): RelativeFile = + result = RelativeFile("") let f = $f if isTitle: for dir in stdlibDirs: @@ -804,19 +931,26 @@ proc findFile*(conf: ConfigRef; f: string; suppressStdlib = false): AbsoluteFile proc findModule*(conf: ConfigRef; modulename, currentModule: string): AbsoluteFile = # returns path to module var m = addFileExt(modulename, NimExt) + var hasRelativeDot = false if m.startsWith(pkgPrefix): result = findFile(conf, m.substr(pkgPrefix.len), suppressStdlib = true) else: if m.startsWith(stdPrefix): + result = AbsoluteFile("") let stripped = m.substr(stdPrefix.len) for candidate in stdlibDirs: let path = (conf.libpath.string / candidate / stripped) if fileExists(path): - m = path + result = AbsoluteFile path break - let currentPath = currentModule.splitFile.dir - result = AbsoluteFile currentPath / m - if not fileExists(result): + else: # If prefixed with std/ why would we add the current module path! + let currentPath = currentModule.splitFile.dir + result = AbsoluteFile currentPath / m + if m.startsWith('.') and not fileExists(result): + result = AbsoluteFile "" + hasRelativeDot = true + + if not fileExists(result) and not hasRelativeDot: result = findFile(conf, m) patchModule(conf) @@ -860,6 +994,25 @@ proc findProjectNimFile*(conf: ConfigRef; pkg: string): string = if dir == "": break return "" +proc canonicalImportAux*(conf: ConfigRef, file: AbsoluteFile): string = + ##[ + Shows the canonical module import, e.g.: + system, std/tables, fusion/pointers, system/assertions, std/private/asciitables + ]## + var ret = getRelativePathFromConfigPath(conf, file, isTitle = true) + let dir = getNimbleFile(conf, $file).parentDir.AbsoluteDir + if not dir.isEmpty: + let relPath = relativeTo(file, dir) + if not relPath.isEmpty and (ret.isEmpty or relPath.string.len < ret.string.len): + ret = relPath + if ret.isEmpty: + ret = relativeTo(file, conf.projectPath) + result = ret.string + +proc canonicalImport*(conf: ConfigRef, file: AbsoluteFile): string = + let ret = canonicalImportAux(conf, file) + result = ret.nativeToUnixPath.changeFileExt("") + proc canonDynlibName(s: string): string = let start = if s.startsWith("lib"): 3 else: 0 let ende = strutils.find(s, {'(', ')', '.'}) @@ -875,6 +1028,12 @@ proc isDynlibOverride*(conf: ConfigRef; lib: string): bool = result = optDynlibOverrideAll in conf.globalOptions or conf.dllOverrides.hasKey(lib.canonDynlibName) +proc showNonExportedFields*(conf: ConfigRef) = + incl(conf.globalOptions, optShowNonExportedFields) + +proc expandDone*(conf: ConfigRef): bool = + result = conf.ideCmd == ideExpand and conf.expandLevels == 0 and conf.expandProgress + proc parseIdeCmd*(s: string): IdeCmd = case s: of "sug": ideSug @@ -883,12 +1042,17 @@ proc parseIdeCmd*(s: string): IdeCmd = of "use": ideUse of "dus": ideDus of "chk": ideChk + of "chkFile": ideChkFile of "mod": ideMod of "highlight": ideHighlight of "outline": ideOutline of "known": ideKnown of "msg": ideMsg of "project": ideProject + of "globalSymbols": ideGlobalSymbols + of "recompile": ideRecompile + of "changed": ideChanged + of "type": ideType else: ideNone proc `$`*(c: IdeCmd): string = @@ -899,6 +1063,7 @@ proc `$`*(c: IdeCmd): string = of ideUse: "use" of ideDus: "dus" of ideChk: "chk" + of ideChkFile: "chkFile" of ideMod: "mod" of ideNone: "none" of ideHighlight: "highlight" @@ -906,6 +1071,13 @@ proc `$`*(c: IdeCmd): string = of ideKnown: "known" of ideMsg: "msg" of ideProject: "project" + of ideGlobalSymbols: "globalSymbols" + of ideDeclaration: "declaration" + of ideExpand: "expand" + of ideRecompile: "recompile" + of ideChanged: "changed" + of ideType: "type" + of ideInlayHints: "inlayHints" proc floatInt64Align*(conf: ConfigRef): int16 = ## Returns either 4 or 8 depending on reasons. @@ -916,18 +1088,3 @@ proc floatInt64Align*(conf: ConfigRef): int16 = # to 4bytes (except with -malign-double) return 4 return 8 - -proc setOutFile*(conf: ConfigRef) = - proc libNameTmpl(conf: ConfigRef): string {.inline.} = - result = if conf.target.targetOS == osWindows: "$1.lib" else: "lib$1.a" - - if conf.outFile.isEmpty: - let base = conf.projectName - let targetName = - if optGenDynLib in conf.globalOptions: - platform.OS[conf.target.targetOS].dllFrmt % base - elif optGenStaticLib in conf.globalOptions: - libNameTmpl(conf) % base - else: - base & platform.OS[conf.target.targetOS].exeExt - conf.outFile = RelativeFile targetName diff --git a/compiler/packagehandling.nim b/compiler/packagehandling.nim index 4af0c28fa..30f407792 100644 --- a/compiler/packagehandling.nim +++ b/compiler/packagehandling.nim @@ -17,6 +17,7 @@ iterator myParentDirs(p: string): string = proc getNimbleFile*(conf: ConfigRef; path: string): string = ## returns absolute path to nimble file, e.g.: /pathto/cligen.nimble + result = "" var parents = 0 block packageSearch: for d in myParentDirs(path): @@ -37,24 +38,7 @@ proc getNimbleFile*(conf: ConfigRef; path: string): string = proc getPackageName*(conf: ConfigRef; path: string): string = ## returns nimble package name, e.g.: `cligen` let path = getNimbleFile(conf, path) - result = path.splitFile.name - -proc fakePackageName*(conf: ConfigRef; path: AbsoluteFile): string = - # Convert `path` so that 2 modules with same name - # in different directory get different name and they can be - # placed in a directory. - # foo-#head/../bar becomes @foo-@hhead@s..@sbar - result = "@m" & relativeTo(path, conf.projectPath).string.multiReplace( - {$os.DirSep: "@s", $os.AltSep: "@s", "#": "@h", "@": "@@", ":": "@c"}) - -proc demanglePackageName*(path: string): string = - result = path.multiReplace({"@@": "@", "@h": "#", "@s": "/", "@m": "", "@c": ":"}) - -proc withPackageName*(conf: ConfigRef; path: AbsoluteFile): AbsoluteFile = - let x = getPackageName(conf, path.string) - let (p, file, ext) = path.splitFile - if x == "stdlib": - # Hot code reloading now relies on 'stdlib_system' names etc. - result = p / RelativeFile((x & '_' & file) & ext) + if path.len > 0: + return path.splitFile.name else: - result = p / RelativeFile(fakePackageName(conf, path)) + return "unknown" diff --git a/compiler/packages.nim b/compiler/packages.nim new file mode 100644 index 000000000..bb54d6154 --- /dev/null +++ b/compiler/packages.nim @@ -0,0 +1,53 @@ +# +# +# The Nim Compiler +# (c) Copyright 2022 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Package related procs. +## +## See Also: +## * `packagehandling` for package path handling +## * `modulegraphs.getPackage` +## * `modulegraphs.belongsToStdlib` + +import "." / [options, ast, lineinfos, idents, pathutils, msgs] + +when defined(nimPreviewSlimSystem): + import std/assertions + + +proc getPackage*(conf: ConfigRef; cache: IdentCache; fileIdx: FileIndex): PSym = + ## Return a new package symbol. + ## + ## See Also: + ## * `modulegraphs.getPackage` + let + filename = AbsoluteFile toFullPath(conf, fileIdx) + name = getIdent(cache, splitFile(filename).name) + info = newLineInfo(fileIdx, 1, 1) + pkgName = getPackageName(conf, filename.string) + pkgIdent = getIdent(cache, pkgName) + newSym(skPackage, pkgIdent, idGeneratorForPackage(int32(fileIdx)), nil, info) + +func getPackageSymbol*(sym: PSym): PSym = + ## Return the owning package symbol. + assert sym != nil + result = sym + while result.kind != skPackage: + result = result.owner + assert result != nil, repr(sym.info) + +func getPackageId*(sym: PSym): int = + ## Return the owning package ID. + sym.getPackageSymbol.id + +func belongsToProjectPackage*(conf: ConfigRef, sym: PSym): bool = + ## Return whether the symbol belongs to the project's package. + ## + ## See Also: + ## * `modulegraphs.belongsToStdlib` + conf.mainPackageId == sym.getPackageId diff --git a/compiler/parampatterns.nim b/compiler/parampatterns.nim index eb99004ab..e8ec22fe1 100644 --- a/compiler/parampatterns.nim +++ b/compiler/parampatterns.nim @@ -10,9 +10,11 @@ ## This module implements the pattern matching features for term rewriting ## macro support. -import strutils, ast, types, msgs, idents, renderer, wordrecg, trees, +import ast, types, msgs, idents, renderer, wordrecg, trees, options +import std/strutils + # 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 # actually improves performance. @@ -143,8 +145,11 @@ proc checkForSideEffects*(n: PNode): TSideEffectAnalysis = let s = op.sym if sfSideEffect in s.flags: return seSideEffect - # assume no side effect: - result = seNoSideEffect + elif tfNoSideEffect in op.typ.flags: + result = seNoSideEffect + else: + # assume side effect: + result = seSideEffect elif tfNoSideEffect in op.typ.flags: # indirect call without side effects: result = seNoSideEffect @@ -176,10 +181,12 @@ type arLocalLValue, # is an l-value, but local var; must not escape # its stack frame! arDiscriminant, # is a discriminant + arAddressableConst, # an addressable const arLentValue, # lent value arStrange # it is a strange beast like 'typedesc[var T]' -proc exprRoot*(n: PNode): PSym = +proc exprRoot*(n: PNode; allowCalls = true): PSym = + result = nil var it = n while true: case it.kind @@ -200,7 +207,7 @@ proc exprRoot*(n: PNode): PSym = if it.len > 0 and it.typ != nil: it = it.lastSon else: break of nkCallKinds: - if it.typ != nil and it.typ.kind in {tyVar, tyLent} and it.len > 1: + if allowCalls and it.typ != nil and it.typ.kind in {tyVar, tyLent} and it.len > 1: # See RFC #7373, calls returning 'var T' are assumed to # return a view into the first argument (if there is one): it = it[1] @@ -209,7 +216,7 @@ proc exprRoot*(n: PNode): PSym = else: break -proc isAssignable*(owner: PSym, n: PNode; isUnsafeAddr=false): TAssignableResult = +proc isAssignable*(owner: PSym, n: PNode): TAssignableResult = ## 'owner' can be nil! result = arNone case n.kind @@ -217,20 +224,20 @@ proc isAssignable*(owner: PSym, n: PNode; isUnsafeAddr=false): TAssignableResult if n.typ != nil and n.typ.kind in {tyVar}: result = arLValue of nkSym: - let kinds = if isUnsafeAddr: {skVar, skResult, skTemp, skParam, skLet, skForVar} - else: {skVar, skResult, skTemp} - if n.sym.kind == skParam and n.sym.typ.kind in {tyVar, tySink}: - result = arLValue - elif isUnsafeAddr and n.sym.kind == skParam: - result = arLValue - elif isUnsafeAddr and n.sym.kind == skConst and dontInlineConstant(n, n.sym.ast): - result = arLValue + const kinds = {skVar, skResult, skTemp, skParam, skLet, skForVar} + if n.sym.kind == skParam: + result = if n.sym.typ.kind in {tyVar, tySink}: arLValue else: arAddressableConst + elif n.sym.kind == skConst and dontInlineConstant(n, n.sym.astdef): + result = arAddressableConst elif n.sym.kind in kinds: - if owner != nil and owner == n.sym.owner and - sfGlobal notin n.sym.flags: - result = arLocalLValue + if n.sym.kind in {skParam, skLet, skForVar}: + result = arAddressableConst else: - result = arLValue + if owner != nil and owner == n.sym.owner and + sfGlobal notin n.sym.flags: + result = arLocalLValue + else: + result = arLValue elif n.sym.kind == skType: let t = n.sym.typ.skipTypes({tyTypeDesc}) if t.kind in {tyVar}: result = arStrange @@ -238,10 +245,10 @@ proc isAssignable*(owner: PSym, n: PNode; isUnsafeAddr=false): TAssignableResult let t = skipTypes(n[0].typ, abstractInst-{tyTypeDesc}) if t.kind in {tyVar, tySink, tyPtr, tyRef}: result = arLValue - elif isUnsafeAddr and t.kind == tyLent: - result = arLValue + elif t.kind == tyLent: + result = arAddressableConst else: - result = isAssignable(owner, n[0], isUnsafeAddr) + result = isAssignable(owner, n[0]) if result != arNone and n[1].kind == nkSym and sfDiscriminant in n[1].sym.flags: result = arDiscriminant @@ -249,23 +256,23 @@ proc isAssignable*(owner: PSym, n: PNode; isUnsafeAddr=false): TAssignableResult let t = skipTypes(n[0].typ, abstractInst-{tyTypeDesc}) if t.kind in {tyVar, tySink, tyPtr, tyRef}: result = arLValue - elif isUnsafeAddr and t.kind == tyLent: - result = arLValue + elif t.kind == tyLent: + result = arAddressableConst else: - result = isAssignable(owner, n[0], isUnsafeAddr) + result = isAssignable(owner, n[0]) of nkHiddenStdConv, nkHiddenSubConv, nkConv: # Object and tuple conversions are still addressable, so we skip them # XXX why is 'tyOpenArray' allowed here? if skipTypes(n.typ, abstractPtrs-{tyTypeDesc}).kind in {tyOpenArray, tyTuple, tyObject}: - result = isAssignable(owner, n[1], isUnsafeAddr) - elif compareTypes(n.typ, n[1].typ, dcEqIgnoreDistinct): + result = isAssignable(owner, n[1]) + elif compareTypes(n.typ, n[1].typ, dcEqIgnoreDistinct, {IgnoreRangeShallow}): # types that are equal modulo distinction preserve l-value: - result = isAssignable(owner, n[1], isUnsafeAddr) + result = isAssignable(owner, n[1]) of nkHiddenDeref: let n0 = n[0] if n0.typ.kind == tyLent: - if isUnsafeAddr or (n0.kind == nkSym and n0.sym.kind == skResult): + if n0.kind == nkSym and n0.sym.kind == skResult: result = arLValue else: result = arLentValue @@ -274,18 +281,26 @@ proc isAssignable*(owner: PSym, n: PNode; isUnsafeAddr=false): TAssignableResult of nkDerefExpr, nkHiddenAddr: result = arLValue of nkObjUpConv, nkObjDownConv, nkCheckedFieldExpr: - result = isAssignable(owner, n[0], isUnsafeAddr) + result = isAssignable(owner, n[0]) of nkCallKinds: - # builtin slice keeps lvalue-ness: - if getMagic(n) in {mArrGet, mSlice}: - result = isAssignable(owner, n[1], isUnsafeAddr) - elif n.typ != nil and n.typ.kind in {tyVar}: - result = arLValue - elif isUnsafeAddr and n.typ != nil and n.typ.kind == tyLent: - result = arLValue + let m = getMagic(n) + if m == mSlice: + # builtin slice keeps l-value-ness + # except for pointers because slice dereferences + if n[1].typ.kind == tyPtr: + result = arLValue + else: + result = isAssignable(owner, n[1]) + elif m == mArrGet: + result = isAssignable(owner, n[1]) + elif n.typ != nil: + case n.typ.kind + of tyVar: result = arLValue + of tyLent: result = arLentValue + else: discard of nkStmtList, nkStmtListExpr: if n.typ != nil: - result = isAssignable(owner, n.lastSon, isUnsafeAddr) + result = isAssignable(owner, n.lastSon) of nkVarTy: # XXX: The fact that this is here is a bit of a hack. # The goal is to allow the use of checks such as "foo(var T)" diff --git a/compiler/parser.nim b/compiler/parser.nim index fe857c81b..747505097 100644 --- a/compiler/parser.nim +++ b/compiler/parser.nim @@ -16,26 +16,55 @@ # In fact the grammar is generated from this file: -when isMainModule: +when isMainModule or defined(nimTestGrammar): # Leave a note in grammar.txt that it is generated: #| # This file is generated by compiler/parser.nim. - import pegs - var outp = open("doc/grammar.txt", fmWrite) - for line in lines("compiler/parser.nim"): - if line =~ peg" \s* '#| ' {.*}": - outp.write matches[0], "\L" - outp.close - - import ".." / tools / grammar_nanny - checkGrammarFile() + import std/pegs + when defined(nimPreviewSlimSystem): + import std/syncio + + proc writeGrammarFile(x: string) = + var outp = open(x, fmWrite) + for line in lines("compiler/parser.nim"): + if line =~ peg" \s* '#| ' {.*}": + outp.write matches[0], "\L" + outp.close + + when defined(nimTestGrammar): + import std/os + from ../testament/lib/stdtest/specialpaths import buildDir + const newGrammarText = buildDir / "grammar.txt" + + if not dirExists(buildDir): + createDir(buildDir) + + writeGrammarFile(newGrammarText) + + proc checkSameGrammar*() = + doAssert sameFileContent(newGrammarText, "doc/grammar.txt"), + "execute 'nim r compiler/parser.nim' to keep grammar.txt up-to-date" + else: + writeGrammarFile("doc/grammar.txt") + import ".." / tools / grammar_nanny + checkGrammarFile() import - llstream, lexer, idents, strutils, ast, msgs, options, lineinfos, + llstream, lexer, idents, msgs, options, lineinfos, pathutils +when not defined(nimCustomAst): + import ast +else: + import plugins / customast + +import std/strutils + when defined(nimpretty): import layouter +when defined(nimPreviewSlimSystem): + import std/assertions + type Parser* = object # A Parser object represents a file that # is being parsed @@ -44,9 +73,13 @@ type hasProgress: bool # some while loop requires progress ensurance lex*: Lexer # The lexer that is used for parsing tok*: Token # The current token + lineStartPrevious*: int + lineNumberPrevious*: int + bufposPrevious*: int inPragma*: int # Pragma level inSemiStmtList*: int - emptyNode: PNode + when not defined(nimCustomAst): + emptyNode: PNode when defined(nimpretty): em*: Emitter @@ -54,11 +87,11 @@ type smNormal, smAllowNil, smAfterDot PrimaryMode = enum - pmNormal, pmTypeDesc, pmTypeDef, pmSkipSuffix + pmNormal, pmTypeDesc, pmTypeDef, pmTrySimple -proc parseAll*(p: var Parser): PNode -proc closeParser*(p: var Parser) -proc parseTopLevelStmt*(p: var Parser): PNode +when defined(nimCustomAst): + # For the `customast` version we cannot share nodes, not even empty nodes: + template emptyNode(p: Parser): PNode = newNode(nkEmpty) # helpers for the other parsers proc isOperator*(tok: Token): bool @@ -68,7 +101,7 @@ proc skipComment*(p: var Parser, node: PNode) proc newNodeP*(kind: TNodeKind, p: Parser): PNode proc newIntNodeP*(kind: TNodeKind, intVal: BiggestInt, p: Parser): PNode proc newFloatNodeP*(kind: TNodeKind, floatVal: BiggestFloat, p: Parser): PNode -proc newStrNodeP*(kind: TNodeKind, strVal: string, p: Parser): PNode +proc newStrNodeP*(kind: TNodeKind, strVal: sink string, p: Parser): PNode proc newIdentNodeP*(ident: PIdent, p: Parser): PNode proc expectIdentOrKeyw*(p: Parser) proc expectIdent*(p: Parser) @@ -77,7 +110,7 @@ proc eat*(p: var Parser, tokType: TokType) proc skipInd*(p: var Parser) proc optPar*(p: var Parser) proc optInd*(p: var Parser, n: PNode) -proc indAndComment*(p: var Parser, n: PNode) +proc indAndComment*(p: var Parser, n: PNode, maybeMissEquals = false) proc setBaseFlags*(n: PNode, base: NumericalBase) proc parseSymbol*(p: var Parser, mode = smNormal): PNode proc parseTry(p: var Parser; isExpr: bool): PNode @@ -100,6 +133,9 @@ template prettySection(body) = proc getTok(p: var Parser) = ## Get the next token from the parser's lexer, and store it in the parser's ## `tok` member. + p.lineNumberPrevious = p.lex.lineNumber + p.lineStartPrevious = p.lex.lineStart + p.bufposPrevious = p.lex.bufpos rawGetTok(p.lex, p.tok) p.hasProgress = true when defined(nimpretty): @@ -114,23 +150,22 @@ proc openParser*(p: var Parser, fileIdx: FileIndex, inputStream: PLLStream, cache: IdentCache; config: ConfigRef) = ## Open a parser, using the given arguments to set up its internal state. ## - initToken(p.tok) + reset(p.tok) openLexer(p.lex, fileIdx, inputStream, cache, config) when defined(nimpretty): openEmitter(p.em, cache, config, fileIdx) getTok(p) # read the first token p.firstTok = true - p.emptyNode = newNode(nkEmpty) + when not defined(nimCustomAst): + p.emptyNode = newNode(nkEmpty) proc openParser*(p: var Parser, filename: AbsoluteFile, inputStream: PLLStream, cache: IdentCache; config: ConfigRef) = openParser(p, fileInfoIdx(config, filename), inputStream, cache, config) -proc closeParser(p: var Parser) = +proc closeParser*(p: var Parser) = ## Close a parser, freeing up its resources. closeLexer(p.lex) - when defined(nimpretty): - closeEmitter(p.em) proc parMessage(p: Parser, msg: TMsgKind, arg = "") = ## Produce and emit the parser message `arg` to output. @@ -164,13 +199,15 @@ proc validInd(p: var Parser): bool {.inline.} = proc rawSkipComment(p: var Parser, node: PNode) = if p.tok.tokType == tkComment: if node != nil: + var rhs = node.comment when defined(nimpretty): if p.tok.commentOffsetB > p.tok.commentOffsetA: - node.comment.add fileSection(p.lex.config, p.lex.fileIdx, p.tok.commentOffsetA, p.tok.commentOffsetB) + rhs.add fileSection(p.lex.config, p.lex.fileIdx, p.tok.commentOffsetA, p.tok.commentOffsetB) else: - node.comment.add p.tok.literal + rhs.add p.tok.literal else: - node.comment.add p.tok.literal + rhs.add p.tok.literal + node.comment = move rhs else: parMessage(p, errInternal, "skipComment") getTok(p) @@ -223,36 +260,37 @@ proc parLineInfo(p: Parser): TLineInfo = ## Retrieve the line information associated with the parser's current state. result = getLineInfo(p.lex, p.tok) -proc indAndComment(p: var Parser, n: PNode) = +proc indAndComment(p: var Parser, n: PNode, maybeMissEquals = false) = if p.tok.indent > p.currInd: if p.tok.tokType == tkComment: rawSkipComment(p, n) + 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) else: skipComment(p, n) proc newNodeP(kind: TNodeKind, p: Parser): PNode = - result = newNodeI(kind, parLineInfo(p)) + result = newNode(kind, parLineInfo(p)) proc newIntNodeP(kind: TNodeKind, intVal: BiggestInt, p: Parser): PNode = - result = newNodeP(kind, p) - result.intVal = intVal + result = newAtom(kind, intVal, parLineInfo(p)) proc newFloatNodeP(kind: TNodeKind, floatVal: BiggestFloat, p: Parser): PNode = - result = newNodeP(kind, p) - result.floatVal = floatVal + result = newAtom(kind, floatVal, parLineInfo(p)) -proc newStrNodeP(kind: TNodeKind, strVal: string, p: Parser): PNode = - result = newNodeP(kind, p) - result.strVal = strVal +proc newStrNodeP(kind: TNodeKind, strVal: sink string, p: Parser): PNode = + result = newAtom(kind, strVal, parLineInfo(p)) proc newIdentNodeP(ident: PIdent, p: Parser): PNode = - result = newNodeP(nkIdent, p) - result.ident = ident + result = newAtom(ident, parLineInfo(p)) proc parseExpr(p: var Parser): PNode proc parseStmt(p: var Parser): PNode -proc parseTypeDesc(p: var Parser): PNode +proc parseTypeDesc(p: var Parser, fullExpr = false): PNode +proc parseTypeDefValue(p: var Parser): PNode proc parseParamList(p: var Parser, retColon = true): PNode proc isSigilLike(tok: Token): bool {.inline.} = @@ -263,26 +301,19 @@ proc isRightAssociative(tok: Token): bool {.inline.} = result = tok.tokType == tkOpr and tok.ident.s[0] == '^' # or (tok.ident.s.len > 1 and tok.ident.s[^1] == '>') -proc isOperator(tok: Token): bool = - ## Determines if the given token is an operator type token. - tok.tokType in {tkOpr, tkDiv, tkMod, tkShl, tkShr, tkIn, tkNotin, tkIs, - tkIsnot, tkNot, tkOf, tkAs, tkFrom, tkDotDot, tkAnd, - tkOr, tkXor} - proc isUnary(tok: Token): bool = ## Check if the given token is a unary operator tok.tokType in {tkOpr, tkDotDot} and - tok.strongSpaceB == 0 and - tok.strongSpaceA > 0 + tok.spacing == {tsLeading} proc checkBinary(p: Parser) {.inline.} = ## Check if the current parser token is a binary operator. # 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: + if p.tok.spacing == {tsTrailing}: parMessage(p, warnInconsistentSpacing, prettyTok(p.tok)) -#| module = stmt ^* (';' / IND{=}) +#| module = complexOrSimpleStmt ^* (';' / IND{=}) #| #| comma = ',' COMMENT? #| semicolon = ';' COMMENT? @@ -292,7 +323,7 @@ proc checkBinary(p: Parser) {.inline.} = #| operator = OP0 | OP1 | OP2 | OP3 | OP4 | OP5 | OP6 | OP7 | OP8 | OP9 #| | 'or' | 'xor' | 'and' #| | 'is' | 'isnot' | 'in' | 'notin' | 'of' | 'as' | 'from' -#| | 'div' | 'mod' | 'shl' | 'shr' | 'not' | 'static' | '..' +#| | 'div' | 'mod' | 'shl' | 'shr' | 'not' | '..' #| #| prefixOperator = operator #| @@ -311,15 +342,30 @@ proc checkBinary(p: Parser) {.inline.} = #| mulExpr = dollarExpr (OP9 optInd dollarExpr)* #| dollarExpr = primary (OP10 optInd primary)* +proc isOperator(tok: Token): bool = + #| operatorB = OP0 | OP1 | OP2 | OP3 | OP4 | OP5 | OP6 | OP7 | OP8 | OP9 | + #| 'div' | 'mod' | 'shl' | 'shr' | 'in' | 'notin' | + #| 'is' | 'isnot' | 'not' | 'of' | 'as' | 'from' | '..' | 'and' | 'or' | 'xor' + tok.tokType in {tkOpr, tkDiv, tkMod, tkShl, tkShr, tkIn, tkNotin, tkIs, + tkIsnot, tkNot, tkOf, tkAs, tkFrom, tkDotDot, tkAnd, + tkOr, tkXor} + proc colcom(p: var Parser, n: PNode) = eat(p, tkColon) skipComment(p, n) const tkBuiltInMagics = {tkType, tkStatic, tkAddr} +template setEndInfo() = + when defined(nimsuggest): + result.endInfo = TLineInfo(fileIndex: p.lex.fileIdx, + line: p.lex.previousTokenEnd.line, + col: p.lex.previousTokenEnd.col) + proc parseSymbol(p: var Parser, mode = smNormal): PNode = #| symbol = '`' (KEYW|IDENT|literal|(operator|'('|')'|'['|']'|'{'|'}'|'=')+)+ '`' - #| | IDENT | KEYW + #| | IDENT | 'addr' | 'type' | 'static' + #| symbolOrKeyword = symbol | KEYW case p.tok.tokType of tkSymbol: result = newIdentNodeP(p.tok.ident, p) @@ -342,7 +388,7 @@ proc parseSymbol(p: var Parser, mode = smNormal): PNode = while true: case p.tok.tokType of tkAccent: - if result.len == 0: + if not result.hasSon: parMessage(p, errIdentifierExpected, p.tok) break of tkOpr, tkDot, tkDotDot, tkEquals, tkParLe..tkParDotRi: @@ -352,10 +398,9 @@ proc parseSymbol(p: var Parser, mode = smNormal): PNode = tkParLe..tkParDotRi}: accm.add($p.tok) getTok(p) - let node = newNodeI(nkIdent, lineinfo) - node.ident = p.lex.cache.getIdent(accm) + let node = newAtom(p.lex.cache.getIdent(accm), lineinfo) result.add(node) - of tokKeywordLow..tokKeywordHigh, tkSymbol, tkIntLit..tkCharLit: + of tokKeywordLow..tokKeywordHigh, tkSymbol, tkIntLit..tkCustomLit: result.add(newIdentNodeP(p.lex.cache.getIdent($p.tok), p)) getTok(p) else: @@ -369,32 +414,47 @@ proc parseSymbol(p: var Parser, mode = smNormal): PNode = # if it is a keyword: #if not isKeyword(p.tok.tokType): getTok(p) result = p.emptyNode + setEndInfo() -proc colonOrEquals(p: var Parser, a: PNode): PNode = - if p.tok.tokType == tkColon: - result = newNodeP(nkExprColonExpr, p) +proc equals(p: var Parser, a: PNode): PNode = + if p.tok.tokType == tkEquals: + result = newNodeP(nkExprEqExpr, p) getTok(p) - newlineWasSplitting(p) #optInd(p, result) result.add(a) result.add(parseExpr(p)) - elif p.tok.tokType == tkEquals: - result = newNodeP(nkExprEqExpr, p) + else: + result = a + +proc colonOrEquals(p: var Parser, a: PNode): PNode = + if p.tok.tokType == tkColon: + result = newNodeP(nkExprColonExpr, p) getTok(p) + newlineWasSplitting(p) #optInd(p, result) result.add(a) result.add(parseExpr(p)) else: - result = a + result = equals(p, a) proc exprColonEqExpr(p: var Parser): PNode = - #| exprColonEqExpr = expr (':'|'=' expr)? + #| exprColonEqExpr = expr ((':'|'=') expr + #| / doBlock extraPostExprBlock*)? var a = parseExpr(p) if p.tok.tokType == tkDo: result = postExprBlocks(p, a) else: result = colonOrEquals(p, a) +proc exprEqExpr(p: var Parser): PNode = + #| exprEqExpr = expr ('=' expr + #| / doBlock extraPostExprBlock*)? + var a = parseExpr(p) + if p.tok.tokType == tkDo: + result = postExprBlocks(p, a) + else: + result = equals(p, a) + proc exprList(p: var Parser, endTok: TokType, result: PNode) = #| exprList = expr ^+ comma when defined(nimpretty): @@ -402,6 +462,24 @@ proc exprList(p: var Parser, endTok: TokType, result: PNode) = getTok(p) optInd(p, result) # progress guaranteed + var a = parseExpr(p) + result.add(a) + while (p.tok.tokType != endTok) and (p.tok.tokType != tkEof): + if p.tok.tokType != tkComma: break + getTok(p) + optInd(p, a) + var a = parseExpr(p) + result.add(a) + when defined(nimpretty): + dec p.em.doIndentMore + +proc optionalExprList(p: var Parser, endTok: TokType, result: PNode) = + #| optionalExprList = expr ^* comma + when defined(nimpretty): + inc p.em.doIndentMore + getTok(p) + optInd(p, result) + # progress guaranteed while (p.tok.tokType != endTok) and (p.tok.tokType != tkEof): var a = parseExpr(p) result.add(a) @@ -421,10 +499,9 @@ proc exprColonEqExprListAux(p: var Parser, endTok: TokType, result: PNode) = var a = exprColonEqExpr(p) result.add(a) if p.tok.tokType != tkComma: break - getTok(p) - # (1,) produces a tuple expression - if endTok == tkParRi and p.tok.tokType == tkParRi and result.kind == nkPar: + elif result.kind == nkPar: result.transitionSonsKind(nkTupleConstr) + getTok(p) skipComment(p, a) optPar(p) eat(p, endTok) @@ -436,29 +513,37 @@ proc exprColonEqExprList(p: var Parser, kind: TNodeKind, exprColonEqExprListAux(p, endTok, result) proc dotExpr(p: var Parser, a: PNode): PNode = - #| dotExpr = expr '.' optInd (symbol | '[:' exprList ']') - #| explicitGenericInstantiation = '[:' exprList ']' ( '(' exprColonEqExpr ')' )? var info = p.parLineInfo getTok(p) - result = newNodeI(nkDotExpr, info) + result = newNode(nkDotExpr, info) optInd(p, result) result.add(a) result.add(parseSymbol(p, smAfterDot)) - if p.tok.tokType == tkBracketLeColon and p.tok.strongSpaceA <= 0: - var x = newNodeI(nkBracketExpr, p.parLineInfo) + if p.tok.tokType == tkBracketLeColon and tsLeading notin p.tok.spacing: + var x = newNode(nkBracketExpr, p.parLineInfo) # rewrite 'x.y[:z]()' to 'y[z](x)' - x.add result[1] + x.add result.secondSon exprList(p, tkBracketRi, x) eat(p, tkBracketRi) - var y = newNodeI(nkCall, p.parLineInfo) + var y = newNode(nkCall, p.parLineInfo) y.add x - y.add result[0] - if p.tok.tokType == tkParLe and p.tok.strongSpaceA <= 0: + y.add result.firstSon + if p.tok.tokType == tkParLe and tsLeading notin p.tok.spacing: exprColonEqExprListAux(p, tkParRi, y) result = y +proc dotLikeExpr(p: var Parser, a: PNode): PNode = + var info = p.parLineInfo + result = newNode(nkInfix, info) + optInd(p, result) + var opNode = newIdentNodeP(p.tok.ident, p) + getTok(p) + result.add(opNode) + result.add(a) + result.add(parseSymbol(p, smAfterDot)) + proc qualifiedIdent(p: var Parser): PNode = - #| qualifiedIdent = symbol ('.' optInd symbol)? + #| qualifiedIdent = symbol ('.' optInd symbolOrKeyword)? result = parseSymbol(p) if p.tok.tokType == tkDot: result = dotExpr(p, result) @@ -503,13 +588,20 @@ proc parseCast(p: var Parser): PNode = result.add(exprColonEqExpr(p)) optPar(p) eat(p, tkParRi) + setEndInfo() + +template setNodeFlag(n: PNode; f: untyped) = + when defined(nimCustomAst): + discard + else: + incl n.flags, f proc setBaseFlags(n: PNode, base: NumericalBase) = case base of base10: discard - of base2: incl(n.flags, nfBase2) - of base8: incl(n.flags, nfBase8) - of base16: incl(n.flags, nfBase16) + of base2: setNodeFlag(n, nfBase2) + of base8: setNodeFlag(n, nfBase8) + of base16: setNodeFlag(n, nfBase16) proc parseGStrLit(p: var Parser, a: PNode): PNode = case p.tok.tokType @@ -525,16 +617,20 @@ proc parseGStrLit(p: var Parser, a: PNode): PNode = getTok(p) else: result = a + setEndInfo() proc complexOrSimpleStmt(p: var Parser): PNode proc simpleExpr(p: var Parser, mode = pmNormal): PNode -proc parseIfExpr(p: var Parser, kind: TNodeKind): PNode +proc parseIfOrWhenExpr(p: var Parser, kind: TNodeKind): PNode proc semiStmtList(p: var Parser, result: PNode) = inc p.inSemiStmtList withInd(p): # Be lenient with the first stmt/expr - let a = if p.tok.tokType == tkIf: parseIfExpr(p, nkIfStmt) else: complexOrSimpleStmt(p) + let a = case p.tok.tokType + of tkIf: parseIfOrWhenExpr(p, nkIfStmt) + of tkWhen: parseIfOrWhenExpr(p, nkWhenStmt) + else: complexOrSimpleStmt(p) result.add a while p.tok.tokType != tkEof: @@ -547,6 +643,7 @@ proc semiStmtList(p: var Parser, result: PNode) = let a = complexOrSimpleStmt(p) if a.kind == nkEmpty: parMessage(p, errExprExpected, p.tok) + getTok(p) else: result.add a dec p.inSemiStmtList @@ -557,10 +654,11 @@ proc parsePar(p: var Parser): PNode = #| | 'finally' | 'except' | 'for' | 'block' | 'const' | 'let' #| | 'when' | 'var' | 'mixin' #| par = '(' optInd - #| ( &parKeyw (ifExpr \ complexOrSimpleStmt) ^+ ';' - #| | ';' (ifExpr \ complexOrSimpleStmt) ^+ ';' + #| ( &parKeyw (ifExpr / complexOrSimpleStmt) ^+ ';' + #| | ';' (ifExpr / complexOrSimpleStmt) ^+ ';' #| | pragmaStmt - #| | simpleExpr ( ('=' expr (';' (ifExpr \ complexOrSimpleStmt) ^+ ';' )? ) + #| | simpleExpr ( (doBlock extraPostExprBlock*) + #| | ('=' expr (';' (ifExpr / complexOrSimpleStmt) ^+ ';' )? ) #| | (':' expr (',' exprColonEqExpr ^+ ',' )? ) ) ) #| optPar ')' # @@ -584,7 +682,10 @@ proc parsePar(p: var Parser): PNode = semiStmtList(p, result) elif p.tok.tokType == tkCurlyDotLe: result.add(parseStmtPragma(p)) - elif p.tok.tokType != tkParRi: + elif p.tok.tokType == tkParRi: + # Empty tuple '()' + result.transitionSonsKind(nkTupleConstr) + else: var a = simpleExpr(p) if p.tok.tokType == tkDo: result = postExprBlocks(p, a) @@ -605,13 +706,14 @@ proc parsePar(p: var Parser): PNode = semiStmtList(p, result) else: a = colonOrEquals(p, a) + if a.kind == nkExprColonExpr: + result.transitionSonsKind(nkTupleConstr) result.add(a) if p.tok.tokType == tkComma: getTok(p) skipComment(p, a) # (1,) produces a tuple expression: - if p.tok.tokType == tkParRi: - result.transitionSonsKind(nkTupleConstr) + result.transitionSonsKind(nkTupleConstr) # progress guaranteed while p.tok.tokType != tkParRi and p.tok.tokType != tkEof: var a = exprColonEqExpr(p) @@ -621,17 +723,18 @@ proc parsePar(p: var Parser): PNode = skipComment(p, a) optPar(p) eat(p, tkParRi) + setEndInfo() proc identOrLiteral(p: var Parser, mode: PrimaryMode): PNode = #| literal = | INT_LIT | INT8_LIT | INT16_LIT | INT32_LIT | INT64_LIT #| | UINT_LIT | UINT8_LIT | UINT16_LIT | UINT32_LIT | UINT64_LIT #| | FLOAT_LIT | FLOAT32_LIT | FLOAT64_LIT #| | STR_LIT | RSTR_LIT | TRIPLESTR_LIT - #| | CHAR_LIT + #| | CHAR_LIT | CUSTOM_NUMERIC_LIT #| | NIL #| generalizedLit = GENERALIZED_STR_LIT | GENERALIZED_TRIPLESTR_LIT #| identOrLiteral = generalizedLit | symbol | literal - #| | par | arrayConstr | setOrTableConstr + #| | par | arrayConstr | setOrTableConstr | tupleConstr #| | castExpr #| tupleConstr = '(' optInd (exprColonEqExpr comma?)* optPar ')' #| arrayConstr = '[' optInd (exprColonEqExpr comma?)* optPar ']' @@ -710,6 +813,14 @@ proc identOrLiteral(p: var Parser, mode: PrimaryMode): PNode = of tkCharLit: result = newIntNodeP(nkCharLit, ord(p.tok.literal[0]), p) getTok(p) + of tkCustomLit: + let splitPos = p.tok.iNumber.int + let str = newStrNodeP(nkRStrLit, p.tok.literal.substr(0, splitPos-1), p) + let callee = newIdentNodeP(getIdent(p.lex.cache, p.tok.literal.substr(splitPos)), p) + result = newNodeP(nkDotExpr, p) + result.add str + result.add callee + getTok(p) of tkNil: result = newNodeP(nkNilLit, p) getTok(p) @@ -743,33 +854,37 @@ proc namedParams(p: var Parser, callee: PNode, proc commandParam(p: var Parser, isFirstParam: var bool; mode: PrimaryMode): PNode = if mode == pmTypeDesc: result = simpleExpr(p, mode) + elif not isFirstParam: + result = exprEqExpr(p) else: result = parseExpr(p) - if p.tok.tokType == tkDo: - result = postExprBlocks(p, result) - elif p.tok.tokType == tkEquals and not isFirstParam: - let lhs = result - result = newNodeP(nkExprEqExpr, p) - getTok(p) - result.add(lhs) - result.add(parseExpr(p)) + if p.tok.tokType == tkDo: + result = postExprBlocks(p, result) isFirstParam = false proc commandExpr(p: var Parser; r: PNode; mode: PrimaryMode): PNode = - result = newNodeP(nkCommand, p) - result.add(r) - var isFirstParam = true - # progress NOT guaranteed - p.hasProgress = false - result.add commandParam(p, isFirstParam, mode) + if mode == pmTrySimple: + result = r + else: + result = newNodeP(nkCommand, p) + result.add(r) + var isFirstParam = true + # progress NOT guaranteed + p.hasProgress = false + result.add commandParam(p, isFirstParam, mode) + +proc isDotLike(tok: Token): bool = + result = tok.tokType == tkOpr and tok.ident.s.len > 1 and + tok.ident.s[0] == '.' and tok.ident.s[1] != '.' proc primarySuffix(p: var Parser, r: PNode, baseIndent: int, mode: PrimaryMode): PNode = #| primarySuffix = '(' (exprColonEqExpr comma?)* ')' - #| | '.' optInd symbol generalizedLit? + #| | '.' optInd symbolOrKeyword ('[:' exprList ']' ( '(' exprColonEqExpr ')' )?)? generalizedLit? + #| | DOTLIKEOP optInd symbolOrKeyword generalizedLit? #| | '[' optInd exprColonEqExprList optPar ']' #| | '{' optInd exprColonEqExprList optPar '}' - #| | &( '`'|IDENT|literal|'cast'|'addr'|'type') expr # command syntax + # XXX strong spaces need to be reflected above result = r # progress guaranteed @@ -778,18 +893,11 @@ proc primarySuffix(p: var Parser, r: PNode, case p.tok.tokType of tkParLe: # progress guaranteed - if p.tok.strongSpaceA > 0: - # inside type sections, expressions such as `ref (int, bar)` - # are parsed as a nkCommand with a single tuple argument (nkPar) - if mode == pmTypeDef: - result = newNodeP(nkCommand, p) - result.add r - result.add primary(p, pmNormal) - else: - result = commandExpr(p, result, mode) + if tsLeading in p.tok.spacing: + result = commandExpr(p, result, mode) break result = namedParams(p, result, nkCall, tkParRi) - if result.len > 1 and result[1].kind == nkExprColonExpr: + if result.has2Sons and result.secondSon.kind == nkExprColonExpr: result.transitionSonsKind(nkObjConstr) of tkDot: # progress guaranteed @@ -797,17 +905,17 @@ proc primarySuffix(p: var Parser, r: PNode, result = parseGStrLit(p, result) of tkBracketLe: # progress guaranteed - if p.tok.strongSpaceA > 0: + if tsLeading in p.tok.spacing: result = commandExpr(p, result, mode) break result = namedParams(p, result, nkBracketExpr, tkBracketRi) of tkCurlyLe: # progress guaranteed - if p.tok.strongSpaceA > 0: + if tsLeading in p.tok.spacing: result = commandExpr(p, result, mode) break result = namedParams(p, result, nkCurlyExpr, tkCurlyRi) - of tkSymbol, tkAccent, tkIntLit..tkCharLit, tkNil, tkCast, + of tkSymbol, tkAccent, tkIntLit..tkCustomLit, tkNil, tkCast, tkOpr, tkDotDot, tkVar, tkOut, tkStatic, tkType, tkEnum, tkTuple, tkObject, tkProc: # XXX: In type sections we allow the free application of the @@ -815,11 +923,19 @@ proc primarySuffix(p: var Parser, r: PNode, # `foo ref` or `foo ptr`. Unfortunately, these two are also # used as infix operators for the memory regions feature and # the current parsing rules don't play well here. - 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 - result = commandExpr(p, result, mode) - break + let isDotLike2 = p.tok.isDotLike + if isDotLike2 and p.lex.config.isDefined("nimPreviewDotLikeOps"): + # synchronize with `tkDot` branch + result = dotLikeExpr(p, result) + result = parseGStrLit(p, result) + else: + if isDotLike2: + parMessage(p, warnDotLikeOps, "dot-like operators will be parsed differently with `-d:nimPreviewDotLikeOps`") + 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 + result = commandExpr(p, result, mode) + break else: break @@ -846,9 +962,13 @@ proc parseOperators(p: var Parser, headNode: PNode, a.add(b) result = a opPrec = getPrecedence(p.tok) + setEndInfo() proc simpleExprAux(p: var Parser, limit: int, mode: PrimaryMode): PNode = + var mode = mode result = primary(p, mode) + if mode == pmTrySimple: + mode = pmNormal if p.tok.tokType == tkCurlyDotLe and (p.tok.indent < 0 or realInd(p)) and mode == pmNormal: var pragmaExp = newNodeP(nkPragmaExpr, p) @@ -892,10 +1012,11 @@ proc parsePragma(p: var Parser): PNode = when defined(nimpretty): dec p.em.doIndentMore dec p.em.keepIndents + setEndInfo() proc identVis(p: var Parser; allowDot=false): PNode = #| identVis = symbol OPR? # postfix position - #| identVisDot = symbol '.' optInd symbol OPR? + #| identVisDot = symbol '.' optInd symbolOrKeyword OPR? var a = parseSymbol(p) if p.tok.tokType == tkOpr: when defined(nimpretty): @@ -929,9 +1050,9 @@ type proc parseIdentColonEquals(p: var Parser, flags: DeclaredIdentFlags): PNode = #| declColonEquals = identWithPragma (comma identWithPragma)* comma? - #| (':' optInd typeDesc)? ('=' optInd expr)? + #| (':' optInd typeDescExpr)? ('=' optInd expr)? #| identColonEquals = IDENT (comma IDENT)* comma? - #| (':' optInd typeDesc)? ('=' optInd expr)?) + #| (':' optInd typeDescExpr)? ('=' optInd expr)?) var a: PNode result = newNodeP(nkIdentDefs, p) # progress guaranteed @@ -949,7 +1070,7 @@ proc parseIdentColonEquals(p: var Parser, flags: DeclaredIdentFlags): PNode = if p.tok.tokType == tkColon: getTok(p) optInd(p, result) - result.add(parseTypeDesc(p)) + result.add(parseTypeDesc(p, fullExpr = true)) else: result.add(newNodeP(nkEmpty, p)) if p.tok.tokType != tkEquals and withBothOptional notin flags: @@ -960,13 +1081,13 @@ proc parseIdentColonEquals(p: var Parser, flags: DeclaredIdentFlags): PNode = result.add(parseExpr(p)) else: result.add(newNodeP(nkEmpty, p)) + setEndInfo() proc parseTuple(p: var Parser, indentAllowed = false): PNode = - #| inlTupleDecl = 'tuple' - #| '[' optInd (identColonEquals (comma/semicolon)?)* optPar ']' - #| extTupleDecl = 'tuple' - #| COMMENT? (IND{>} identColonEquals (IND{=} identColonEquals)*)? - #| tupleClass = 'tuple' + #| tupleTypeBracket = '[' optInd (identColonEquals (comma/semicolon)?)* optPar ']' + #| tupleType = 'tuple' tupleTypeBracket + #| tupleDecl = 'tuple' (tupleTypeBracket / + #| COMMENT? (IND{>} identColonEquals (IND{=} identColonEquals)*)?) result = newNodeP(nkTupleTy, p) getTok(p) if p.tok.tokType == tkBracketLe: @@ -1005,6 +1126,7 @@ proc parseTuple(p: var Parser, indentAllowed = false): PNode = parMessage(p, errGenerated, "the syntax for tuple types is 'tuple[...]', not 'tuple(...)'") else: result = newNodeP(nkTupleClassTy, p) + setEndInfo() proc parseParamList(p: var Parser, retColon = true): PNode = #| paramList = '(' declColonEquals ^* (comma/semicolon) ')' @@ -1046,13 +1168,14 @@ proc parseParamList(p: var Parser, retColon = true): PNode = if hasRet and p.tok.indent < 0: getTok(p) optInd(p, result) - result[0] = parseTypeDesc(p) + result.replaceFirstSon parseTypeDesc(p) elif not retColon and not hasParLe: # Mark as "not there" in order to mark for deprecation in the semantic pass: result = p.emptyNode when defined(nimpretty): dec p.em.doIndentMore dec p.em.keepIndents + setEndInfo() proc optPragmas(p: var Parser): PNode = if p.tok.tokType == tkCurlyDotLe and (p.tok.indent < 0 or realInd(p)): @@ -1062,43 +1185,53 @@ proc optPragmas(p: var Parser): PNode = proc parseDoBlock(p: var Parser; info: TLineInfo): PNode = #| doBlock = 'do' paramListArrow pragma? colcom stmt - let params = parseParamList(p, retColon=false) + result = nil + var params = parseParamList(p, retColon=false) let pragmas = optPragmas(p) colcom(p, result) result = parseStmt(p) - if params.kind != nkEmpty: + if params.kind != nkEmpty or pragmas.kind != nkEmpty: + if params.kind == nkEmpty: + params = newNodeP(nkFormalParams, p) + params.add(p.emptyNode) # return type result = newProcNode(nkDo, info, body = result, params = params, name = p.emptyNode, pattern = p.emptyNode, genericParams = p.emptyNode, pragmas = pragmas, exceptions = p.emptyNode) + setEndInfo() proc parseProcExpr(p: var Parser; isExpr: bool; kind: TNodeKind): PNode = - #| procExpr = 'proc' paramListColon pragma? ('=' COMMENT? stmt)? + #| routineExpr = ('proc' | 'func' | 'iterator') paramListColon pragma? ('=' COMMENT? stmt)? + #| routineType = ('proc' | 'iterator') paramListColon pragma? # either a proc type or a anonymous proc let info = parLineInfo(p) - getTok(p) let hasSignature = p.tok.tokType in {tkParLe, tkColon} and p.tok.indent < 0 let params = parseParamList(p) let pragmas = optPragmas(p) if p.tok.tokType == tkEquals and isExpr: getTok(p) - skipComment(p, result) - result = newProcNode(kind, info, body = parseStmt(p), + result = newProcNode(kind, info, body = p.emptyNode, params = params, name = p.emptyNode, pattern = p.emptyNode, genericParams = p.emptyNode, pragmas = pragmas, exceptions = p.emptyNode) + skipComment(p, result) + result.replaceSon bodyPos, parseStmt(p) else: - result = newNodeI(nkProcTy, info) - if hasSignature: - result.add(params) + result = newNode(if kind == nkIteratorDef: nkIteratorTy else: nkProcTy, info) + if hasSignature or pragmas.kind != nkEmpty: + if hasSignature: + result.add(params) + else: # pragmas but no param list, implies typeclass with pragmas + result.add(p.emptyNode) if kind == nkFuncDef: parMessage(p, "func keyword is not allowed in type descriptions, use proc with {.noSideEffect.} pragma instead") result.add(pragmas) + setEndInfo() proc isExprStart(p: Parser): bool = case p.tok.tokType of tkSymbol, tkAccent, tkOpr, tkNot, tkNil, tkCast, tkIf, tkFor, tkProc, tkFunc, tkIterator, tkBind, tkBuiltInMagics, - tkParLe, tkBracketLe, tkCurlyLe, tkIntLit..tkCharLit, tkVar, tkRef, tkPtr, - tkTuple, tkObject, tkWhen, tkCase, tkOut: + tkParLe, tkBracketLe, tkCurlyLe, tkIntLit..tkCustomLit, tkVar, tkRef, tkPtr, + tkEnum, tkTuple, tkObject, tkWhen, tkCase, tkOut, tkTry, tkBlock: result = true else: result = false @@ -1111,16 +1244,20 @@ proc parseSymbolList(p: var Parser, result: PNode) = if p.tok.tokType != tkComma: break getTok(p) optInd(p, s) + setEndInfo() proc parseTypeDescKAux(p: var Parser, kind: TNodeKind, mode: PrimaryMode): PNode = - #| distinct = 'distinct' optInd typeDesc result = newNodeP(kind, p) getTok(p) if p.tok.indent != -1 and p.tok.indent <= p.currInd: return optInd(p, result) + let isTypedef = mode == pmTypeDef and p.tok.tokType in {tkObject, tkTuple} if not isOperator(p.tok) and isExprStart(p): - result.add(primary(p, mode)) + if isTypedef: + result.add(parseTypeDefValue(p)) + else: + result.add(primary(p, mode)) if kind == nkDistinctTy and p.tok.tokType == tkSymbol: # XXX document this feature! var nodeKind: TNodeKind @@ -1134,11 +1271,14 @@ proc parseTypeDescKAux(p: var Parser, kind: TNodeKind, let list = newNodeP(nodeKind, p) result.add list parseSymbolList(p, list) + if mode == pmTypeDef and not isTypedef: + result = parseOperators(p, result, -1, mode) + setEndInfo() proc parseVarTuple(p: var Parser): PNode proc parseFor(p: var Parser): PNode = - #| forStmt = 'for' (identWithPragma ^+ comma) 'in' expr colcom stmt + #| forStmt = 'for' ((varTuple / identWithPragma) ^+ comma) 'in' expr colcom stmt #| forExpr = forStmt getTokNoInd(p) result = newNodeP(nkForStmt, p) @@ -1159,6 +1299,7 @@ proc parseFor(p: var Parser): PNode = result.add(parseExpr(p)) colcom(p, result) result.add(parseStmt(p)) + setEndInfo() template nimprettyDontTouch(body) = when defined(nimpretty): @@ -1181,13 +1322,13 @@ proc parseExpr(p: var Parser): PNode = result = parseBlock(p) of tkIf: nimprettyDontTouch: - result = parseIfExpr(p, nkIfExpr) + result = parseIfOrWhenExpr(p, nkIfExpr) of tkFor: nimprettyDontTouch: result = parseFor(p) of tkWhen: nimprettyDontTouch: - result = parseIfExpr(p, nkWhenExpr) + result = parseIfOrWhenExpr(p, nkWhenStmt) of tkCase: # Currently we think nimpretty is good enough with case expressions, # so it is allowed to touch them: @@ -1197,85 +1338,74 @@ proc parseExpr(p: var Parser): PNode = nimprettyDontTouch: result = parseTry(p, isExpr=true) else: result = simpleExpr(p) + setEndInfo() proc parseEnum(p: var Parser): PNode proc parseObject(p: var Parser): PNode proc parseTypeClass(p: var Parser): PNode proc primary(p: var Parser, mode: PrimaryMode): PNode = - #| typeKeyw = 'var' | 'out' | 'ref' | 'ptr' | 'shared' | 'tuple' - #| | 'proc' | 'iterator' | 'distinct' | 'object' | 'enum' - #| primary = typeKeyw optInd typeDesc - #| / prefixOperator* identOrLiteral primarySuffix* - #| / 'bind' primary + #| simplePrimary = SIGILLIKEOP? identOrLiteral primarySuffix* + #| commandStart = &('`'|IDENT|literal|'cast'|'addr'|'type'|'var'|'out'| + #| 'static'|'enum'|'tuple'|'object'|'proc') + #| primary = simplePrimary (commandStart expr (doBlock extraPostExprBlock*)?)? + #| / operatorB primary + #| / routineExpr + #| / rawTypeDesc + #| / prefixOperator primary + # XXX strong spaces need to be reflected in commandStart + # command part is handled in the primarySuffix proc + + # prefix operators: if isOperator(p.tok): + # Note 'sigil like' operators are currently not reflected in the grammar + # and should be removed for Nim 2.0, I don't think anybody uses them. let isSigil = isSigilLike(p.tok) result = newNodeP(nkPrefix, p) var a = newIdentNodeP(p.tok.ident, p) result.add(a) getTok(p) optInd(p, a) - if isSigil: - #XXX prefix operators + const identOrLiteralKinds = tkBuiltInMagics + {tkSymbol, tkAccent, tkNil, + tkIntLit..tkCustomLit, tkCast, tkOut, tkParLe, tkBracketLe, tkCurlyLe} + if isSigil and p.tok.tokType in identOrLiteralKinds: let baseInd = p.lex.currLineIndent - result.add(primary(p, pmSkipSuffix)) + result.add(identOrLiteral(p, mode)) result = primarySuffix(p, result, baseInd, mode) else: result.add(primary(p, pmNormal)) return case p.tok.tokType - of tkTuple: result = parseTuple(p, mode == pmTypeDef) - of tkProc: result = parseProcExpr(p, mode notin {pmTypeDesc, pmTypeDef}, nkLambda) - of tkFunc: result = parseProcExpr(p, mode notin {pmTypeDesc, pmTypeDef}, nkFuncDef) + of tkProc: + getTok(p) + result = parseProcExpr(p, mode != pmTypeDesc, nkLambda) + of tkFunc: + getTok(p) + result = parseProcExpr(p, mode != pmTypeDesc, nkFuncDef) of tkIterator: - result = parseProcExpr(p, mode notin {pmTypeDesc, pmTypeDef}, nkLambda) - if result.kind == nkLambda: result.transitionSonsKind(nkIteratorDef) - else: result.transitionSonsKind(nkIteratorTy) - of tkEnum: - if mode == pmTypeDef: - prettySection: - result = parseEnum(p) - else: - result = newNodeP(nkEnumTy, p) - getTok(p) - of tkObject: - if mode == pmTypeDef: - prettySection: - result = parseObject(p) - else: - result = newNodeP(nkObjectTy, p) - getTok(p) - of tkConcept: - if mode == pmTypeDef: - result = parseTypeClass(p) - else: - parMessage(p, "the 'concept' keyword is only valid in 'type' sections") + getTok(p) + result = parseProcExpr(p, mode != pmTypeDesc, nkIteratorDef) of tkBind: + # legacy syntax, no-op in current nim result = newNodeP(nkBind, p) getTok(p) optInd(p, result) result.add(primary(p, pmNormal)) - of tkVar: result = parseTypeDescKAux(p, nkVarTy, mode) - of tkOut: - # I like this parser extension to be in 1.4 as it still might turn out - # useful in the long run. - result = parseTypeDescKAux(p, nkMutableTy, mode) - of tkRef: result = parseTypeDescKAux(p, nkRefTy, mode) - of tkPtr: result = parseTypeDescKAux(p, nkPtrTy, mode) - of tkDistinct: result = parseTypeDescKAux(p, nkDistinctTy, mode) + of tkTuple, tkEnum, tkObject, tkConcept, + tkVar, tkOut, tkRef, tkPtr, tkDistinct: + result = parseTypeDesc(p) else: let baseInd = p.lex.currLineIndent result = identOrLiteral(p, mode) - if mode != pmSkipSuffix: - result = primarySuffix(p, result, baseInd, mode) + result = primarySuffix(p, result, baseInd, mode) proc binaryNot(p: var Parser; a: PNode): PNode = - if p.tok.tokType == tkNot: + if p.tok.tokType == tkNot and p.tok.indent < 0: let notOpr = newIdentNodeP(p.tok.ident, p) getTok(p) optInd(p, notOpr) - let b = parseExpr(p) + let b = primary(p, pmTypeDesc) result = newNodeP(nkInfix, p) result.add notOpr result.add a @@ -1283,33 +1413,91 @@ proc binaryNot(p: var Parser; a: PNode): PNode = else: result = a -proc parseTypeDesc(p: var Parser): PNode = - #| typeDesc = simpleExpr ('not' expr)? +proc parseTypeDesc(p: var Parser, fullExpr = false): PNode = + #| rawTypeDesc = (tupleType | routineType | 'enum' | 'object' | + #| ('var' | 'out' | 'ref' | 'ptr' | 'distinct') typeDesc?) + #| ('not' primary)? + #| typeDescExpr = (routineType / simpleExpr) ('not' primary)? + #| typeDesc = rawTypeDesc / typeDescExpr newlineWasSplitting(p) - result = simpleExpr(p, pmTypeDesc) + if fullExpr: + result = simpleExpr(p, pmTypeDesc) + else: + case p.tok.tokType + of tkTuple: + result = parseTuple(p, false) + of tkProc: + getTok(p) + result = parseProcExpr(p, false, nkLambda) + of tkIterator: + getTok(p) + result = parseProcExpr(p, false, nkIteratorDef) + of tkEnum: + result = newNodeP(nkEnumTy, p) + getTok(p) + of tkObject: + result = newNodeP(nkObjectTy, p) + getTok(p) + of tkConcept: + result = p.emptyNode + parMessage(p, "the 'concept' keyword is only valid in 'type' sections") + of tkVar: result = parseTypeDescKAux(p, nkVarTy, pmTypeDesc) + of tkOut: result = parseTypeDescKAux(p, nkOutTy, pmTypeDesc) + of tkRef: result = parseTypeDescKAux(p, nkRefTy, pmTypeDesc) + of tkPtr: result = parseTypeDescKAux(p, nkPtrTy, pmTypeDesc) + of tkDistinct: result = parseTypeDescKAux(p, nkDistinctTy, pmTypeDesc) + else: + result = simpleExpr(p, pmTypeDesc) result = binaryNot(p, result) + setEndInfo() -proc parseTypeDefAux(p: var Parser): PNode = - #| typeDefAux = simpleExpr ('not' expr)? - #| | 'concept' typeClass - result = simpleExpr(p, pmTypeDef) +proc parseTypeDefValue(p: var Parser): PNode = + #| typeDefValue = ((tupleDecl | enumDecl | objectDecl | conceptDecl | + #| ('ref' | 'ptr' | 'distinct') (tupleDecl | objectDecl)) + #| / (simpleExpr (exprEqExpr ^+ comma postExprBlocks?)?)) + #| ('not' primary)? + case p.tok.tokType + of tkTuple: result = parseTuple(p, true) + of tkRef: result = parseTypeDescKAux(p, nkRefTy, pmTypeDef) + of tkPtr: result = parseTypeDescKAux(p, nkPtrTy, pmTypeDef) + of tkDistinct: result = parseTypeDescKAux(p, nkDistinctTy, pmTypeDef) + of tkEnum: + prettySection: + result = parseEnum(p) + of tkObject: + prettySection: + result = parseObject(p) + of tkConcept: + result = parseTypeClass(p) + else: + result = simpleExpr(p, pmTypeDef) + if p.tok.tokType != tkNot: + if result.kind == nkCommand: + var isFirstParam = false + while p.tok.tokType == tkComma: + getTok(p) + optInd(p, result) + result.add(commandParam(p, isFirstParam, pmTypeDef)) + result = postExprBlocks(p, result) result = binaryNot(p, result) + setEndInfo() proc makeCall(n: PNode): PNode = ## Creates a call if the given node isn't already a call. if n.kind in nkCallKinds: result = n else: - result = newNodeI(nkCall, n.info) + result = newNode(nkCall, n.info) result.add n proc postExprBlocks(p: var Parser, x: PNode): PNode = - #| postExprBlocks = ':' stmt? ( IND{=} doBlock - #| | IND{=} 'of' exprList ':' stmt - #| | IND{=} 'elif' expr ':' stmt - #| | IND{=} 'except' exprList ':' stmt - #| | IND{=} 'finally' ':' stmt - #| | IND{=} 'else' ':' stmt )* + #| extraPostExprBlock = ( IND{=} doBlock + #| | IND{=} 'of' exprList ':' stmt + #| | IND{=} 'elif' expr ':' stmt + #| | IND{=} 'except' optionalExprList ':' stmt + #| | IND{=} 'finally' ':' stmt + #| | IND{=} 'else' ':' stmt ) + #| postExprBlocks = (doBlock / ':' (extraPostExprBlock / stmt)) extraPostExprBlock* result = x if p.tok.indent >= 0: return @@ -1326,14 +1514,17 @@ proc postExprBlocks(p: var Parser, x: PNode): PNode = result = makeCall(result) getTok(p) skipComment(p, result) - if p.tok.tokType notin {tkOf, tkElif, tkElse, tkExcept}: + if not (p.tok.tokType in {tkOf, tkElif, tkElse, tkExcept, tkFinally} and sameInd(p)): var stmtList = newNodeP(nkStmtList, p) stmtList.add parseStmt(p) # to keep backwards compatibility (see tests/vm/tstringnil) - if stmtList[0].kind == nkStmtList: stmtList = stmtList[0] + if stmtList.firstSon.kind == nkStmtList: stmtList = stmtList.firstSon - stmtList.flags.incl nfBlockArg - if openingParams.kind != nkEmpty: + setNodeFlag stmtList, nfBlockArg + if openingParams.kind != nkEmpty or openingPragmas.kind != nkEmpty: + if openingParams.kind == nkEmpty: + openingParams = newNodeP(nkFormalParams, p) + openingParams.add(p.emptyNode) # return type result.add newProcNode(nkDo, stmtList.info, body = stmtList, params = openingParams, name = p.emptyNode, pattern = p.emptyNode, @@ -1362,7 +1553,7 @@ proc postExprBlocks(p: var Parser, x: PNode): PNode = nextBlock.add parseExpr(p) of tkExcept: nextBlock = newNodeP(nkExceptBranch, p) - exprList(p, tkColon, nextBlock) + optionalExprList(p, tkColon, nextBlock) of tkFinally: nextBlock = newNodeP(nkFinally, p) getTok(p) @@ -1373,7 +1564,7 @@ proc postExprBlocks(p: var Parser, x: PNode): PNode = eat(p, tkColon) nextBlock.add parseStmt(p) - nextBlock.flags.incl nfBlockArg + setNodeFlag nextBlock, nfBlockArg result.add nextBlock if nextBlock.kind in {nkElse, nkFinally}: break @@ -1382,12 +1573,10 @@ proc postExprBlocks(p: var Parser, x: PNode): PNode = parMessage(p, "expected ':'") proc parseExprStmt(p: var Parser): PNode = - #| exprStmt = simpleExpr - #| (( '=' optInd expr colonBody? ) - #| / ( expr ^+ comma - #| postExprBlocks - #| ))? - var a = simpleExpr(p) + #| exprStmt = simpleExpr postExprBlocks? + #| / simplePrimary (exprEqExpr ^+ comma) postExprBlocks? + #| / simpleExpr '=' optInd (expr postExprBlocks?) + var a = simpleExpr(p, pmTrySimple) if p.tok.tokType == tkEquals: result = newNodeP(nkAsgn, p) getTok(p) @@ -1397,25 +1586,23 @@ proc parseExprStmt(p: var Parser): PNode = result.add(a) result.add(b) else: - # simpleExpr parsed 'p a' from 'p a, b'? var isFirstParam = false - if p.tok.indent < 0 and p.tok.tokType == tkComma and a.kind == nkCommand: - result = a - while true: - getTok(p) - optInd(p, result) - result.add(commandParam(p, isFirstParam, pmNormal)) - if p.tok.tokType != tkComma: break - elif p.tok.indent < 0 and isExprStart(p): - result = newTreeI(nkCommand, a.info, a) + # if an expression is starting here, a simplePrimary was parsed and + # this is the start of a command + if p.tok.indent < 0 and isExprStart(p): + result = newTree(nkCommand, a.info, a) + let baseIndent = p.currInd while true: result.add(commandParam(p, isFirstParam, pmNormal)) - if p.tok.tokType != tkComma: break + if p.tok.tokType != tkComma or + (p.tok.indent >= 0 and p.tok.indent < baseIndent): + break getTok(p) optInd(p, result) else: result = a result = postExprBlocks(p, result) + setEndInfo() proc parseModuleName(p: var Parser, kind: TNodeKind): PNode = result = parseExpr(p) @@ -1427,6 +1614,7 @@ proc parseModuleName(p: var Parser, kind: TNodeKind): PNode = getTok(p) result.add(a) result.add(parseExpr(p)) + setEndInfo() proc parseImport(p: var Parser, kind: TNodeKind): PNode = #| importStmt = 'import' optInd expr @@ -1455,6 +1643,7 @@ proc parseImport(p: var Parser, kind: TNodeKind): PNode = getTok(p) optInd(p, a) #expectNl(p) + setEndInfo() proc parseIncludeStmt(p: var Parser): PNode = #| includeStmt = 'include' optInd expr ^+ comma @@ -1471,6 +1660,7 @@ proc parseIncludeStmt(p: var Parser): PNode = getTok(p) optInd(p, a) #expectNl(p) + setEndInfo() proc parseFromStmt(p: var Parser): PNode = #| fromStmt = 'from' expr 'import' optInd expr (comma expr)* @@ -1491,6 +1681,7 @@ proc parseFromStmt(p: var Parser): PNode = getTok(p) optInd(p, a) #expectNl(p) + setEndInfo() proc parseReturnOrRaise(p: var Parser, kind: TNodeKind): PNode = #| returnStmt = 'return' optInd expr? @@ -1498,7 +1689,7 @@ proc parseReturnOrRaise(p: var Parser, kind: TNodeKind): PNode = #| yieldStmt = 'yield' optInd expr? #| discardStmt = 'discard' optInd expr? #| breakStmt = 'break' optInd expr? - #| continueStmt = 'break' optInd expr? + #| continueStmt = 'continue' optInd expr? result = newNodeP(kind, p) getTok(p) if p.tok.tokType == tkComment: @@ -1512,6 +1703,7 @@ proc parseReturnOrRaise(p: var Parser, kind: TNodeKind): PNode = var e = parseExpr(p) e = postExprBlocks(p, e) result.add(e) + setEndInfo() proc parseIfOrWhen(p: var Parser, kind: TNodeKind): PNode = #| condStmt = expr colcom stmt COMMENT? @@ -1536,11 +1728,12 @@ proc parseIfOrWhen(p: var Parser, kind: TNodeKind): PNode = colcom(p, branch) branch.add(parseStmt(p)) result.add(branch) + setEndInfo() -proc parseIfExpr(p: var Parser, kind: TNodeKind): PNode = - #| condExpr = expr colcom expr optInd - #| ('elif' expr colcom expr optInd)* - #| 'else' colcom expr +proc parseIfOrWhenExpr(p: var Parser, kind: TNodeKind): PNode = + #| condExpr = expr colcom stmt optInd + #| ('elif' expr colcom stmt optInd)* + #| 'else' colcom stmt #| ifExpr = 'if' condExpr #| whenExpr = 'when' condExpr result = newNodeP(kind, p) @@ -1560,6 +1753,7 @@ proc parseIfExpr(p: var Parser, kind: TNodeKind): PNode = colcom(p, branch) branch.add(parseStmt(p)) result.add(branch) + setEndInfo() proc parseWhile(p: var Parser): PNode = #| whileStmt = 'while' expr colcom stmt @@ -1569,6 +1763,7 @@ proc parseWhile(p: var Parser): PNode = result.add(parseExpr(p)) colcom(p, result) result.add(parseStmt(p)) + setEndInfo() proc parseCase(p: var Parser): PNode = #| ofBranch = 'of' exprList colcom stmt @@ -1616,24 +1811,27 @@ proc parseCase(p: var Parser): PNode = if wasIndented: p.currInd = oldInd + setEndInfo() proc parseTry(p: var Parser; isExpr: bool): PNode = #| tryStmt = 'try' colcom stmt &(IND{=}? 'except'|'finally') - #| (IND{=}? 'except' exprList colcom stmt)* + #| (IND{=}? 'except' optionalExprList colcom stmt)* #| (IND{=}? 'finally' colcom stmt)? #| tryExpr = 'try' colcom stmt &(optInd 'except'|'finally') - #| (optInd 'except' exprList colcom stmt)* + #| (optInd 'except' optionalExprList colcom stmt)* #| (optInd 'finally' colcom stmt)? result = newNodeP(nkTryStmt, p) + let parentIndent = p.currInd # isExpr getTok(p) colcom(p, result) result.add(parseStmt(p)) var b: PNode = nil - while sameOrNoInd(p) or isExpr: + + while sameOrNoInd(p) or (isExpr and parentIndent <= p.tok.indent): case p.tok.tokType of tkExcept: b = newNodeP(nkExceptBranch, p) - exprList(p, tkColon, b) + optionalExprList(p, tkColon, b) of tkFinally: b = newNodeP(nkFinally, p) getTok(p) @@ -1642,13 +1840,14 @@ proc parseTry(p: var Parser; isExpr: bool): PNode = b.add(parseStmt(p)) result.add(b) if b == nil: parMessage(p, "expected 'except'") + setEndInfo() proc parseExceptBlock(p: var Parser, kind: TNodeKind): PNode = - #| exceptBlock = 'except' colcom stmt result = newNodeP(kind, p) getTok(p) colcom(p, result) result.add(parseStmt(p)) + setEndInfo() proc parseBlock(p: var Parser): PNode = #| blockStmt = 'block' symbol? colcom stmt @@ -1659,6 +1858,7 @@ proc parseBlock(p: var Parser): PNode = else: result.add(parseSymbol(p)) colcom(p, result) result.add(parseStmt(p)) + setEndInfo() proc parseStaticOrDefer(p: var Parser; k: TNodeKind): PNode = #| staticStmt = 'static' colcom stmt @@ -1667,6 +1867,7 @@ proc parseStaticOrDefer(p: var Parser; k: TNodeKind): PNode = getTok(p) colcom(p, result) result.add(parseStmt(p)) + setEndInfo() proc parseAsm(p: var Parser): PNode = #| asmStmt = 'asm' pragma? (STR_LIT | RSTR_LIT | TRIPLESTR_LIT) @@ -1683,6 +1884,7 @@ proc parseAsm(p: var Parser): PNode = result.add(p.emptyNode) return getTok(p) + setEndInfo() proc parseGenericParam(p: var Parser): PNode = #| genericParam = symbol (comma symbol)* (colon expr)? ('=' optInd expr)? @@ -1718,6 +1920,7 @@ proc parseGenericParam(p: var Parser): PNode = result.add(parseExpr(p)) else: result.add(p.emptyNode) + setEndInfo() proc parseGenericParamList(p: var Parser): PNode = #| genericParamList = '[' optInd @@ -1736,12 +1939,14 @@ proc parseGenericParamList(p: var Parser): PNode = skipComment(p, a) optPar(p) eat(p, tkBracketRi) + setEndInfo() proc parsePattern(p: var Parser): PNode = #| pattern = '{' stmt '}' eat(p, tkCurlyLe) result = parseStmt(p) eat(p, tkCurlyRi) + setEndInfo() proc parseRoutine(p: var Parser, kind: TNodeKind): PNode = #| indAndComment = (IND{>} COMMENT)? | COMMENT? @@ -1750,6 +1955,12 @@ proc parseRoutine(p: var Parser, kind: TNodeKind): PNode = result = newNodeP(kind, p) getTok(p) optInd(p, result) + if kind in {nkProcDef, nkLambda, nkIteratorDef, nkFuncDef} and + p.tok.tokType notin {tkSymbol, tokKeywordLow..tokKeywordHigh, tkAccent}: + # no name; lambda or proc type + # in every context that we can parse a routine, we can also parse these + result = parseProcExpr(p, true, if kind == nkProcDef: nkLambda else: kind) + return result.add(identVis(p)) if p.tok.tokType == tkCurlyLe and p.validInd: result.add(p.parsePattern) else: result.add(p.emptyNode) @@ -1762,13 +1973,25 @@ proc parseRoutine(p: var Parser, kind: TNodeKind): PNode = else: result.add(p.emptyNode) # empty exception tracking: result.add(p.emptyNode) - if p.tok.tokType == tkEquals and p.validInd: + let maybeMissEquals = p.tok.tokType != tkEquals + if (not maybeMissEquals) and p.validInd: getTok(p) skipComment(p, result) result.add(parseStmt(p)) else: result.add(p.emptyNode) - indAndComment(p, result) + indAndComment(p, result, maybeMissEquals) + let body = result.lastSon + if body.kind == nkStmtList and body.hasSon and body.firstSon.comment.len > 0 and body.firstSon.kind != nkCommentStmt: + if result.comment.len == 0: + # proc fn*(a: int): int = a ## foo + # => moves comment `foo` to `fn` + result.comment = body.firstSon.comment + body.firstSon.comment = "" + #else: + # assert false, p.lex.config$body.info # avoids hard to track bugs, fail early. + # Yeah, that worked so well. There IS a bug in this logic, now what? + setEndInfo() proc newCommentStmt(p: var Parser): PNode = #| commentStmt = COMMENT @@ -1798,15 +2021,16 @@ proc parseSection(p: var Parser, kind: TNodeKind, else: parMessage(p, errIdentifierExpected, p.tok) break - if result.len == 0: parMessage(p, errIdentifierExpected, p.tok) + if not result.hasSon: parMessage(p, errIdentifierExpected, p.tok) elif p.tok.tokType in {tkSymbol, tkAccent, tkParLe} and p.tok.indent < 0: # tkParLe is allowed for ``var (x, y) = ...`` tuple parsing result.add(defparser(p)) else: parMessage(p, errIdentifierExpected, p.tok) + setEndInfo() proc parseEnum(p: var Parser): PNode = - #| enum = 'enum' optInd (symbol pragma? optInd ('=' optInd expr COMMENT?)? comma?)+ + #| enumDecl = 'enum' optInd (symbol pragma? optInd ('=' optInd expr COMMENT?)? comma?)+ result = newNodeP(nkEnumTy, p) getTok(p) result.add(p.emptyNode) @@ -1819,7 +2043,7 @@ proc parseEnum(p: var Parser): PNode = var symPragma = a var pragma: PNode - if p.tok.tokType == tkCurlyDotLe: + if (p.tok.indent < 0 or p.tok.indent >= p.currInd) and p.tok.tokType == tkCurlyDotLe: pragma = optPragmas(p) symPragma = newNodeP(nkPragmaExpr, p) symPragma.add(a) @@ -1848,8 +2072,9 @@ proc parseEnum(p: var Parser): PNode = if p.tok.indent >= 0 and p.tok.indent <= p.currInd or p.tok.tokType == tkEof: break - if result.len <= 1: + if not result.has2Sons: parMessage(p, errIdentifierExpected, p.tok) + setEndInfo() proc parseObjectPart(p: var Parser): PNode proc parseObjectWhen(p: var Parser): PNode = @@ -1875,22 +2100,19 @@ proc parseObjectWhen(p: var Parser): PNode = branch.add(parseObjectPart(p)) flexComment(p, branch) result.add(branch) + setEndInfo() proc parseObjectCase(p: var Parser): PNode = #| objectBranch = 'of' exprList colcom objectPart #| objectBranches = objectBranch (IND{=} objectBranch)* #| (IND{=} 'elif' expr colcom objectPart)* #| (IND{=} 'else' colcom objectPart)? - #| objectCase = 'case' identWithPragma ':' typeDesc ':'? COMMENT? + #| objectCase = 'case' declColonEquals ':'? COMMENT? #| (IND{>} objectBranches DED #| | IND{=} objectBranches) result = newNodeP(nkRecCase, p) getTokNoInd(p) - var a = newNodeP(nkIdentDefs, p) - a.add(identWithPragma(p)) - eat(p, tkColon) - a.add(parseTypeDesc(p)) - a.add(p.emptyNode) + var a = parseIdentColonEquals(p, {withPragma}) result.add(a) if p.tok.tokType == tkColon: getTok(p) flexComment(p, result) @@ -1920,6 +2142,7 @@ proc parseObjectCase(p: var Parser): PNode = if b.kind == nkElse: break if wasIndented: p.currInd = oldInd + setEndInfo() proc parseObjectPart(p: var Parser): PNode = #| objectPart = IND{>} objectPart^+IND{=} DED @@ -1952,17 +2175,13 @@ proc parseObjectPart(p: var Parser): PNode = result = p.emptyNode else: result = p.emptyNode + setEndInfo() proc parseObject(p: var Parser): PNode = - #| object = 'object' pragma? ('of' typeDesc)? COMMENT? objectPart + #| objectDecl = 'object' ('of' typeDesc)? COMMENT? objectPart result = newNodeP(nkObjectTy, p) 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") - result.add(parsePragma(p)) - else: - result.add(p.emptyNode) + result.add(p.emptyNode) # compatibility with old pragma node if p.tok.tokType == tkOf and p.tok.indent < 0: var a = newNodeP(nkOfInherit, p) getTok(p) @@ -1977,10 +2196,13 @@ proc parseObject(p: var Parser): PNode = result.add(p.emptyNode) else: result.add(parseObjectPart(p)) + setEndInfo() proc parseTypeClassParam(p: var Parser): PNode = - let modifier = case p.tok.tokType - of tkOut, tkVar: nkVarTy + let modifier = + case p.tok.tokType + of tkVar: nkVarTy + of tkOut: nkOutTy of tkPtr: nkPtrTy of tkRef: nkRefTy of tkStatic: nkStaticTy @@ -1993,10 +2215,11 @@ proc parseTypeClassParam(p: var Parser): PNode = result.add(p.parseSymbol) else: result = p.parseSymbol + setEndInfo() proc parseTypeClass(p: var Parser): PNode = - #| typeClassParam = ('var' | 'out')? symbol - #| typeClass = typeClassParam ^* ',' (pragma)? ('of' typeDesc ^* ',')? + #| conceptParam = ('var' | 'out' | 'ptr' | 'ref' | 'static' | 'type')? symbol + #| conceptDecl = 'concept' conceptParam ^* ',' (pragma)? ('of' typeDesc ^* ',')? #| &IND{>} stmt result = newNodeP(nkTypeClassTy, p) getTok(p) @@ -2031,45 +2254,33 @@ proc parseTypeClass(p: var Parser): PNode = skipComment(p, result) # 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) result.add(p.emptyNode) else: result.add(parseStmt(p)) + setEndInfo() proc parseTypeDef(p: var Parser): PNode = #| - #| typeDef = identWithPragmaDot genericParamList? '=' optInd typeDefAux - #| indAndComment? / identVisDot genericParamList? pragma '=' optInd typeDefAux + #| typeDef = identVisDot genericParamList? pragma '=' optInd typeDefValue #| indAndComment? result = newNodeP(nkTypeDef, p) var identifier = identVis(p, allowDot=true) var identPragma = identifier var pragma: PNode var genericParam: PNode - var noPragmaYet = true - - if p.tok.tokType == tkCurlyDotLe: - pragma = optPragmas(p) - identPragma = newNodeP(nkPragmaExpr, p) - identPragma.add(identifier) - identPragma.add(pragma) - noPragmaYet = false 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") genericParam = parseGenericParamList(p) else: genericParam = p.emptyNode - if noPragmaYet: - pragma = optPragmas(p) - if pragma.kind != nkEmpty: - identPragma = newNodeP(nkPragmaExpr, p) - identPragma.add(identifier) - identPragma.add(pragma) - elif p.tok.tokType == tkCurlyDotLe: - parMessage(p, errGenerated, "pragma already present") + pragma = optPragmas(p) + if pragma.kind != nkEmpty: + identPragma = newNodeP(nkPragmaExpr, p) + identPragma.add(identifier) + identPragma.add(pragma) result.add(identPragma) result.add(genericParam) @@ -2078,26 +2289,39 @@ proc parseTypeDef(p: var Parser): PNode = result.info = parLineInfo(p) getTok(p) optInd(p, result) - result.add(parseTypeDefAux(p)) + result.add(parseTypeDefValue(p)) else: result.add(p.emptyNode) indAndComment(p, result) # special extension! + setEndInfo() proc parseVarTuple(p: var Parser): PNode = - #| varTuple = '(' optInd identWithPragma ^+ comma optPar ')' '=' optInd expr + #| varTupleLhs = '(' optInd (identWithPragma / varTupleLhs) ^+ comma optPar ')' (':' optInd typeDescExpr)? + #| varTuple = varTupleLhs '=' optInd expr result = newNodeP(nkVarTuple, p) getTok(p) # skip '(' optInd(p, result) # progress guaranteed - while p.tok.tokType in {tkSymbol, tkAccent}: - var a = identWithPragma(p, allowDot=true) + while p.tok.tokType in {tkSymbol, tkAccent, tkParLe}: + var a: PNode + if p.tok.tokType == tkParLe: + a = parseVarTuple(p) + a.add(p.emptyNode) + else: + a = identWithPragma(p, allowDot=true) result.add(a) if p.tok.tokType != tkComma: break getTok(p) skipComment(p, a) - result.add(p.emptyNode) # no type desc optPar(p) eat(p, tkParRi) + if p.tok.tokType == tkColon: + getTok(p) + optInd(p, result) + result.add(parseTypeDesc(p, fullExpr = true)) + else: + result.add(p.emptyNode) # no type desc + setEndInfo() proc parseVariable(p: var Parser): PNode = #| colonBody = colcom stmt postExprBlocks? @@ -2108,8 +2332,9 @@ proc parseVariable(p: var Parser): PNode = optInd(p, result) result.add(parseExpr(p)) else: result = parseIdentColonEquals(p, {withPragma, withDot}) - result[^1] = postExprBlocks(p, result[^1]) + result.setLastSon postExprBlocks(p, result.lastSon) indAndComment(p, result) + setEndInfo() proc parseConstant(p: var Parser): PNode = #| constant = (varTuple / identWithPragma) (colon typeDesc)? '=' optInd expr indAndComment @@ -2126,9 +2351,10 @@ proc parseConstant(p: var Parser): PNode = eat(p, tkEquals) optInd(p, result) #add(result, parseStmtListExpr(p)) - result.add(parseExpr(p)) - result[^1] = postExprBlocks(p, result[^1]) + let a = parseExpr(p) + result.add postExprBlocks(p, a) indAndComment(p, result) + setEndInfo() proc parseBind(p: var Parser, k: TNodeKind): PNode = #| bindStmt = 'bind' optInd qualifiedIdent ^+ comma @@ -2144,17 +2370,19 @@ proc parseBind(p: var Parser, k: TNodeKind): PNode = getTok(p) optInd(p, a) #expectNl(p) + setEndInfo() proc parseStmtPragma(p: var Parser): PNode = #| pragmaStmt = pragma (':' COMMENT? stmt)? result = parsePragma(p) if p.tok.tokType == tkColon and p.tok.indent < 0: let a = result - result = newNodeI(nkPragmaBlock, a.info) + result = newNode(nkPragmaBlock, a.info) getTok(p) skipComment(p, result) result.add a result.add parseStmt(p) + setEndInfo() proc simpleStmt(p: var Parser): PNode = #| simpleStmt = ((returnStmt | raiseStmt | yieldStmt | discardStmt | breakStmt @@ -2297,23 +2525,13 @@ proc parseStmt(p: var Parser): PNode = if p.tok.tokType != tkSemiColon: break getTok(p) if err and p.tok.tokType == tkEof: break + setEndInfo() -proc parseAll(p: var Parser): PNode = - ## Parses the rest of the input stream held by the parser into a PNode. - result = newNodeP(nkStmtList, p) - while p.tok.tokType != tkEof: - p.hasProgress = false - var a = complexOrSimpleStmt(p) - if a.kind != nkEmpty and p.hasProgress: - result.add(a) - else: - parMessage(p, errExprExpected, p.tok) - # bugfix: consume a token here to prevent an endless loop: - getTok(p) - if p.tok.indent != 0: - parMessage(p, errInvalidIndentation) +proc checkFirstLineIndentation*(p: var Parser) = + if p.tok.indent != 0 and tsLeading in p.tok.spacing: + parMessage(p, errInvalidIndentation) -proc parseTopLevelStmt(p: var Parser): PNode = +proc parseTopLevelStmt*(p: var Parser): PNode = ## Implements an iterator which, when called repeatedly, returns the next ## top-level statement or emptyNode if end of stream. result = p.emptyNode @@ -2341,6 +2559,17 @@ proc parseTopLevelStmt(p: var Parser): PNode = result = complexOrSimpleStmt(p) if result.kind == nkEmpty: parMessage(p, errExprExpected, p.tok) break + setEndInfo() + +proc parseAll*(p: var Parser): PNode = + ## Parses the rest of the input stream held by the parser into a PNode. + result = newNodeP(nkStmtList, p) + while true: + let nextStmt = p.parseTopLevelStmt() + if nextStmt.kind == nkEmpty: + break + result &= nextStmt + setEndInfo() proc parseString*(s: string; cache: IdentCache; config: ConfigRef; filename: string = ""; line: int = 0; @@ -2352,9 +2581,10 @@ proc parseString*(s: string; cache: IdentCache; config: ConfigRef; var stream = llStreamOpen(s) stream.lineOffset = line - var parser: Parser - parser.lex.errorHandler = errorHandler - openParser(parser, AbsoluteFile filename, stream, cache, config) + var p = Parser() + p.lex.errorHandler = errorHandler + openParser(p, AbsoluteFile filename, stream, cache, config) - result = parser.parseAll - closeParser(parser) + result = p.parseAll + closeParser(p) + setEndInfo() diff --git a/compiler/passaux.nim b/compiler/passaux.nim index 715b7d676..af507d210 100644 --- a/compiler/passaux.nim +++ b/compiler/passaux.nim @@ -10,7 +10,7 @@ ## implements some little helper passes import - ast, passes, idents, msgs, options, lineinfos + ast, passes, msgs, options, lineinfos from modulegraphs import ModuleGraph, PPassContext @@ -19,17 +19,15 @@ type config: ConfigRef proc verboseOpen(graph: ModuleGraph; s: PSym; idgen: IdGenerator): PPassContext = - #MessageOut('compiling ' + s.name.s); + # xxx consider either removing this or keeping for documentation for how to add a pass result = VerboseRef(config: graph.config, idgen: idgen) - rawMessage(graph.config, hintProcessing, s.name.s) + +import std/objectdollar proc verboseProcess(context: PPassContext, n: PNode): PNode = + # called from `process` in `processTopLevelStmt`. result = n let v = VerboseRef(context) - if v.config.verbosity == 3: - # system.nim deactivates all hints, for verbosity:3 we want the processing - # messages nonetheless, so we activate them again (but honor cmdlineNotes) - v.config.setNote(hintProcessing) - message(v.config, n.info, hintProcessing, $v.idgen[]) + message(v.config, n.info, hintProcessingStmt, $v.idgen[]) const verbosePass* = makePass(open = verboseOpen, process = verboseProcess) diff --git a/compiler/passes.nim b/compiler/passes.nim index 3debce1f6..d6b141078 100644 --- a/compiler/passes.nim +++ b/compiler/passes.nim @@ -14,7 +14,22 @@ import options, ast, llstream, msgs, idents, syntaxes, modulegraphs, reorder, - lineinfos, pathutils + lineinfos, + pipelineutils, + modules, pathutils, packages, + sem, semdata + +import ic/replayer + +export skipCodegen, resolveMod, prepareConfigNotes + +when defined(nimsuggest): + import ../dist/checksums/src/checksums/sha1 + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] + +import std/tables type TPassData* = tuple[input: PNode, closeOutput: PNode] @@ -32,12 +47,6 @@ proc makePass*(open: TPassOpen = nil, result.process = process result.isFrontend = isFrontend -proc skipCodegen*(config: ConfigRef; n: PNode): bool {.inline.} = - # can be used by codegen passes to determine whether they should do - # something with `n`. Currently, this ignores `n` and uses the global - # error count instead. - result = config.errorCounter > 0 - const maxPasses = 10 @@ -74,13 +83,6 @@ proc processTopLevelStmt(graph: ModuleGraph, n: PNode, a: var TPassContextArray) if isNil(m): return false result = true -proc resolveMod(conf: ConfigRef; module, relativeTo: string): FileIndex = - let fullPath = findModule(conf, module, relativeTo) - if fullPath.isEmpty: - result = InvalidFileIdx - else: - result = fileInfoIdx(conf, fullPath) - proc processImplicits(graph: ModuleGraph; implicits: seq[string], nodeKind: TNodeKind, a: var TPassContextArray; m: PSym) = # XXX fixme this should actually be relative to the config file! @@ -94,29 +96,6 @@ proc processImplicits(graph: ModuleGraph; implicits: seq[string], nodeKind: TNod importStmt.add str if not processTopLevelStmt(graph, importStmt, a): break -const - imperativeCode = {low(TNodeKind)..high(TNodeKind)} - {nkTemplateDef, nkProcDef, nkMethodDef, - nkMacroDef, nkConverterDef, nkIteratorDef, nkFuncDef, nkPragma, - nkExportStmt, nkExportExceptStmt, nkFromStmt, nkImportStmt, nkImportExceptStmt} - -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 - else: - if graph.config.mainPackageNotes == {}: graph.config.mainPackageNotes = graph.config.notes - graph.config.notes = graph.config.foreignPackageNotes - -proc moduleHasChanged*(graph: ModuleGraph; module: PSym): bool {.inline.} = - result = true - #module.id >= 0 or isDefined(graph.config, "nimBackendAssumesChange") - -proc partOfStdlib(x: PSym): bool = - var it = x.owner - while it != nil and it.kind == skPackage and it.owner != nil: - it = it.owner - result = it != nil and it.name.s == "stdlib" - proc processModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator; stream: PLLStream): bool {.discardable.} = if graph.stopCompile(): return true @@ -135,10 +114,15 @@ proc processModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator; return false else: s = stream + + when defined(nimsuggest): + let filename = toFullPathConsiderDirty(graph.config, fileIdx).string + msgs.setHash(graph.config, fileIdx, $sha1.secureHashFile(filename)) + while true: openParser(p, fileIdx, s, graph.cache, graph.config) - if not partOfStdlib(module) or module.name.s == "distros": + if (not belongsToStdlib(graph, module)) or module.name.s == "distros": # XXX what about caching? no processing then? what if I change the # modules to include between compilation runs? we'd need to track that # in ROD files. I think we should enable this feature only @@ -147,43 +131,23 @@ proc processModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator; processImplicits graph, graph.config.implicitImports, nkImportStmt, a, module processImplicits graph, graph.config.implicitIncludes, nkIncludeStmt, a, module - while true: - if graph.stopCompile(): break + checkFirstLineIndentation(p) + block processCode: + if graph.stopCompile(): break processCode var n = parseTopLevelStmt(p) - if n.kind == nkEmpty: break - if (sfSystemModule notin module.flags and - ({sfNoForward, sfReorder} * module.flags != {} or - codeReordering in graph.config.features)): - # read everything, no streaming possible - var sl = newNodeI(nkStmtList, n.info) - sl.add n - while true: - var n = parseTopLevelStmt(p) - if n.kind == nkEmpty: break - sl.add n - if sfReorder in module.flags or codeReordering in graph.config.features: - sl = reorder(graph, sl, module) - discard processTopLevelStmt(graph, sl, a) - break - elif n.kind in imperativeCode: - # read everything until the next proc declaration etc. - var sl = newNodeI(nkStmtList, n.info) + if n.kind == nkEmpty: break processCode + + # read everything, no streaming possible + var sl = newNodeI(nkStmtList, n.info) + sl.add n + while true: + var n = parseTopLevelStmt(p) + if n.kind == nkEmpty: break sl.add n - var rest: PNode = nil - while true: - var n = parseTopLevelStmt(p) - if n.kind == nkEmpty or n.kind notin imperativeCode: - rest = n - break - sl.add n - #echo "-----\n", sl - if not processTopLevelStmt(graph, sl, a): break - if rest != nil: - #echo "-----\n", rest - if not processTopLevelStmt(graph, rest, a): break - else: - #echo "----- single\n", n - if not processTopLevelStmt(graph, n, a): break + if sfReorder in module.flags or codeReordering in graph.config.features: + sl = reorder(graph, sl, module) + discard processTopLevelStmt(graph, sl, a) + closeParser(p) if s.kind != llsStdIn: break closePasses(graph, a) @@ -193,3 +157,99 @@ proc processModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator; # They are responsible for closing the rod files. See `cbackend.nim`. closeRodFile(graph, module) result = true + +proc compileModule*(graph: ModuleGraph; fileIdx: FileIndex; flags: TSymFlags, fromModule: PSym = nil): PSym = + var flags = flags + if fileIdx == graph.config.projectMainIdx2: flags.incl sfMainModule + result = graph.getModule(fileIdx) + + template processModuleAux(moduleStatus) = + onProcessing(graph, fileIdx, moduleStatus, fromModule = fromModule) + var s: PLLStream = nil + if sfMainModule in flags: + if graph.config.projectIsStdin: s = stdin.llStreamOpen + elif graph.config.projectIsCmd: s = llStreamOpen(graph.config.cmdInput) + discard processModule(graph, result, idGeneratorFromModule(result), s) + if result == nil: + var cachedModules: seq[FileIndex] = @[] + result = moduleFromRodFile(graph, fileIdx, cachedModules) + let filename = AbsoluteFile toFullPath(graph.config, fileIdx) + if result == nil: + result = newModule(graph, fileIdx) + result.flags.incl flags + registerModule(graph, result) + processModuleAux("import") + else: + if sfSystemModule in flags: + graph.systemModule = result + partialInitModule(result, graph, fileIdx, filename) + for m in cachedModules: + registerModuleById(graph, m) + replayStateChanges(graph.packed.pm[m.int].module, graph) + replayGenericCacheInformation(graph, m.int) + elif graph.isDirty(result): + result.flags.excl sfDirty + # reset module fields: + initStrTables(graph, result) + result.ast = nil + processModuleAux("import(dirty)") + graph.markClientsDirty(fileIdx) + +proc importModule*(graph: ModuleGraph; s: PSym, fileIdx: FileIndex): PSym = + # this is called by the semantic checking phase + assert graph.config != nil + result = compileModule(graph, fileIdx, {}, s) + graph.addDep(s, fileIdx) + # keep track of import relationships + if graph.config.hcrOn: + graph.importDeps.mgetOrPut(FileIndex(s.position), @[]).add(fileIdx) + #if sfSystemModule in result.flags: + # localError(result.info, errAttemptToRedefine, result.name.s) + # restore the notes for outer module: + graph.config.notes = + if graph.config.belongsToProjectPackage(s) or isDefined(graph.config, "booting"): graph.config.mainPackageNotes + else: graph.config.foreignPackageNotes + +proc connectCallbacks*(graph: ModuleGraph) = + graph.includeFileCallback = modules.includeModule + graph.importModuleCallback = importModule + +proc compileSystemModule*(graph: ModuleGraph) = + if graph.systemModule == nil: + connectCallbacks(graph) + graph.config.m.systemFileIdx = fileInfoIdx(graph.config, + graph.config.libpath / RelativeFile"system.nim") + discard graph.compileModule(graph.config.m.systemFileIdx, {sfSystemModule}) + +proc compileProject*(graph: ModuleGraph; projectFileIdx = InvalidFileIdx) = + connectCallbacks(graph) + let conf = graph.config + wantMainModule(conf) + configComplete(graph) + + let systemFileIdx = fileInfoIdx(conf, conf.libpath / RelativeFile"system.nim") + let projectFile = if projectFileIdx == InvalidFileIdx: conf.projectMainIdx else: projectFileIdx + conf.projectMainIdx2 = projectFile + + let packSym = getPackage(graph, projectFile) + graph.config.mainPackageId = packSym.getPackageId + graph.importStack.add projectFile + + if projectFile == systemFileIdx: + discard graph.compileModule(projectFile, {sfMainModule, sfSystemModule}) + else: + graph.compileSystemModule() + discard graph.compileModule(projectFile, {sfMainModule}) + +proc mySemOpen(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = + result = preparePContext(graph, module, idgen) + +proc mySemClose(graph: ModuleGraph; context: PPassContext, n: PNode): PNode = + var c = PContext(context) + closePContext(graph, c, n) + +proc mySemProcess(context: PPassContext, n: PNode): PNode = + result = semWithPContext(PContext(context), n) + +const semPass* = makePass(mySemOpen, mySemProcess, mySemClose, + isFrontend = true) diff --git a/compiler/pathutils.nim b/compiler/pathutils.nim index d8f3613b0..5f6212bb2 100644 --- a/compiler/pathutils.nim +++ b/compiler/pathutils.nim @@ -10,7 +10,10 @@ ## Path handling utilities for Nim. Strictly typed code in order ## to avoid the never ending time sink in getting path handling right. -import os, pathnorm +import std/[os, pathnorm, strutils] + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] type AbsoluteFile* = distinct string @@ -99,3 +102,52 @@ when true: proc addFileExt*(x: RelativeFile; ext: string): RelativeFile {.borrow.} proc writeFile*(x: AbsoluteFile; content: string) {.borrow.} + +proc skipHomeDir(x: string): int = + when defined(windows): + if x.continuesWith("Users/", len("C:/")): + result = 3 + else: + result = 0 + else: + if x.startsWith("/home/") or x.startsWith("/Users/"): + result = 3 + elif x.startsWith("/mnt/") and x.continuesWith("/Users/", len("/mnt/c")): + result = 5 + else: + result = 0 + +proc relevantPart(s: string; afterSlashX: int): string = + result = newStringOfCap(s.len - 8) + var slashes = afterSlashX + for i in 0..<s.len: + if slashes == 0: + result.add s[i] + elif s[i] == '/': + dec slashes + +template canonSlashes(x: string): string = + when defined(windows): + x.replace('\\', '/') + else: + x + +proc customPathImpl(x: string): string = + # Idea: Encode a "protocol" via "//protocol/path" which is not ambiguous + # as path canonicalization would have removed the double slashes. + # /mnt/X/Users/Y + # X:\\Users\Y + # /home/Y + # --> + # //user/ + if not isAbsolute(x): + result = customPathImpl(canonSlashes(getCurrentDir() / x)) + else: + let slashes = skipHomeDir(x) + if slashes > 0: + result = "//user/" & relevantPart(x, slashes) + else: + result = x + +proc customPath*(x: string): string = + customPathImpl canonSlashes x diff --git a/compiler/patterns.nim b/compiler/patterns.nim index 1ef903161..32ec7fb53 100644 --- a/compiler/patterns.nim +++ b/compiler/patterns.nim @@ -13,6 +13,9 @@ import ast, types, semdata, sigmatch, idents, aliases, parampatterns, trees +when defined(nimPreviewSlimSystem): + import std/assertions + type TPatternContext = object owner: PSym @@ -26,6 +29,8 @@ type proc getLazy(c: PPatternContext, sym: PSym): PNode = if c.mappingIsFull: result = c.mapping[sym.position] + else: + result = nil proc putLazy(c: PPatternContext, sym: PSym, n: PNode) = if not c.mappingIsFull: @@ -36,12 +41,12 @@ proc putLazy(c: PPatternContext, sym: PSym, n: PNode) = proc matches(c: PPatternContext, p, n: PNode): bool proc canonKind(n: PNode): TNodeKind = - ## nodekind canonilization for pattern matching + ## nodekind canonicalization for pattern matching result = n.kind case result of nkCallKinds: result = nkCall of nkStrLit..nkTripleStrLit: result = nkStrLit - of nkFastAsgn: result = nkAsgn + of nkFastAsgn, nkSinkAsgn: result = nkAsgn else: discard proc sameKinds(a, b: PNode): bool {.inline.} = @@ -62,14 +67,21 @@ proc sameTrees*(a, b: PNode): bool = for i in 0..<a.len: if not sameTrees(a[i], b[i]): return result = true + else: + result = false + else: + result = false proc inSymChoice(sc, x: PNode): bool = if sc.kind == nkClosedSymChoice: + result = false for i in 0..<sc.len: if sc[i].sym == x.sym: return true elif sc.kind == nkOpenSymChoice: # same name suffices for open sym choices! result = sc[0].sym.name.id == x.sym.name.id + else: + result = false proc checkTypes(c: PPatternContext, p: PSym, n: PNode): bool = # check param constraints first here as this is quite optimized: @@ -85,6 +97,7 @@ proc isPatternParam(c: PPatternContext, p: PNode): bool {.inline.} = result = p.kind == nkSym and p.sym.kind == skParam and p.sym.owner == c.owner proc matchChoice(c: PPatternContext, p, n: PNode): bool = + result = false for i in 1..<p.len: if matches(c, p[i], n): return true @@ -96,6 +109,8 @@ proc bindOrCheck(c: PPatternContext, param: PSym, n: PNode): bool = elif n.kind == nkArgList or checkTypes(c, param, n): putLazy(c, param, n) result = true + else: + result = false proc gather(c: PPatternContext, param: PSym, n: PNode) = var pp = getLazy(c, param) @@ -129,6 +144,10 @@ proc matchNested(c: PPatternContext, p, n: PNode, rpn: bool): bool = var arglist = newNodeI(nkArgList, n.info) if matchStarAux(c, p, n, arglist, rpn): result = bindOrCheck(c, p[2].sym, arglist) + else: + result = false + else: + result = false proc matches(c: PPatternContext, p, n: PNode): bool = let n = skipHidden(n) @@ -143,7 +162,8 @@ proc matches(c: PPatternContext, p, n: PNode): bool = elif n.kind == nkSym and n.sym.kind == skConst: # try both: if p.kind == nkSym: result = p.sym == n.sym - elif matches(c, p, n.sym.ast): result = true + elif matches(c, p, n.sym.astdef): result = true + else: result = false elif p.kind == nkPattern: # pattern operators: | * let opr = p[0].ident.s @@ -152,7 +172,9 @@ proc matches(c: PPatternContext, p, n: PNode): bool = of "*": result = matchNested(c, p, n, rpn=false) of "**": result = matchNested(c, p, n, rpn=true) of "~": result = not matches(c, p[1], n) - else: doAssert(false, "invalid pattern") + else: + result = false + doAssert(false, "invalid pattern") # template {add(a, `&` * b)}(a: string{noalias}, b: varargs[string]) = # a.add(b) elif p.kind == nkCurlyExpr: @@ -160,10 +182,14 @@ proc matches(c: PPatternContext, p, n: PNode): bool = if matches(c, p[0], n): gather(c, p[1][1].sym, n) result = true + else: + result = false else: assert isPatternParam(c, p[1]) if matches(c, p[0], n): result = bindOrCheck(c, p[1].sym, n) + else: + result = false elif sameKinds(p, n): case p.kind of nkSym: result = p.sym == n.sym @@ -176,6 +202,7 @@ proc matches(c: PPatternContext, p, n: PNode): bool = else: # special rule for p(X) ~ f(...); this also works for stuff like # partial case statements, etc! - Not really ... :-/ + result = false let v = lastSon(p) if isPatternParam(c, v) and v.sym.typ.kind == tyVarargs: var arglist: PNode @@ -204,6 +231,8 @@ proc matches(c: PPatternContext, p, n: PNode): bool = for i in 0..<p.len: if not matches(c, p[i], n[i]): return result = true + else: + result = false proc matchStmtList(c: PPatternContext, p, n: PNode): PNode = proc matchRange(c: PPatternContext, p, n: PNode, i: int): bool = @@ -216,6 +245,7 @@ proc matchStmtList(c: PPatternContext, p, n: PNode): PNode = result = true if p.kind == nkStmtList and n.kind == p.kind and p.len < n.len: + result = nil let n = flattenStmts(n) # no need to flatten 'p' here as that has already been done for i in 0..n.len - p.len: @@ -228,8 +258,11 @@ proc matchStmtList(c: PPatternContext, p, n: PNode): PNode = break elif matches(c, p, n): result = n + else: + result = nil proc aliasAnalysisRequested(params: PNode): bool = + result = false if params.len >= 2: for i in 1..<params.len: let param = params[i].sym @@ -243,10 +276,7 @@ proc addToArgList(result, n: PNode) = proc applyRule*(c: PContext, s: PSym, n: PNode): PNode = ## returns a tree to semcheck if the rule triggered; nil otherwise - var ctx: TPatternContext - ctx.owner = s - ctx.c = c - ctx.formals = s.typ.len-1 + var ctx = TPatternContext(owner: s, c: c, formals: s.typ.paramsLen) var m = matchStmtList(ctx, s.ast[patternPos], n) if isNil(m): return nil # each parameter should have been bound; we simply setup a call and @@ -255,9 +285,11 @@ proc applyRule*(c: PContext, s: PSym, n: PNode): PNode = result.add(newSymNode(s, n.info)) let params = s.typ.n let requiresAA = aliasAnalysisRequested(params) - var args: PNode - if requiresAA: - args = newNodeI(nkArgList, n.info) + var args: PNode = + if requiresAA: + newNodeI(nkArgList, n.info) + else: + nil for i in 1..<params.len: let param = params[i].sym let x = getLazy(ctx, param) diff --git a/compiler/pipelines.nim b/compiler/pipelines.nim new file mode 100644 index 000000000..55e7fe892 --- /dev/null +++ b/compiler/pipelines.nim @@ -0,0 +1,312 @@ +import sem, cgen, modulegraphs, ast, llstream, parser, msgs, + lineinfos, reorder, options, semdata, cgendata, modules, pathutils, + packages, syntaxes, depends, vm, pragmas, idents, lookups, wordrecg, + liftdestructors + +import pipelineutils + +import ../dist/checksums/src/checksums/sha1 + +when not defined(leanCompiler): + import jsgen, docgen2 + +import std/[syncio, objectdollar, assertions, tables, strutils, strtabs] +import renderer +import ic/replayer + +proc setPipeLinePass*(graph: ModuleGraph; pass: PipelinePass) = + graph.pipelinePass = pass + +proc processPipeline(graph: ModuleGraph; semNode: PNode; bModule: PPassContext): PNode = + case graph.pipelinePass + of CgenPass: + result = semNode + if bModule != nil: + genTopLevelStmt(BModule(bModule), result) + of JSgenPass: + when not defined(leanCompiler): + result = processJSCodeGen(bModule, semNode) + else: + result = nil + of GenDependPass: + result = addDotDependency(bModule, semNode) + of SemPass: + result = graph.emptyNode + of Docgen2Pass, Docgen2TexPass: + when not defined(leanCompiler): + result = processNode(bModule, semNode) + else: + result = nil + of Docgen2JsonPass: + when not defined(leanCompiler): + result = processNodeJson(bModule, semNode) + else: + result = nil + of EvalPass, InterpreterPass: + result = interpreterCode(bModule, semNode) + of NonePass: + raiseAssert "use setPipeLinePass to set a proper PipelinePass" + +proc processImplicitImports(graph: ModuleGraph; implicits: seq[string], nodeKind: TNodeKind, + m: PSym, ctx: PContext, bModule: PPassContext, idgen: IdGenerator, + ) = + # XXX fixme this should actually be relative to the config file! + let relativeTo = toFullPath(graph.config, m.info) + for module in items(implicits): + # implicit imports should not lead to a module importing itself + if m.position != resolveMod(graph.config, module, relativeTo).int32: + var importStmt = newNodeI(nodeKind, m.info) + var str = newStrNode(nkStrLit, module) + str.info = m.info + importStmt.add str + message(graph.config, importStmt.info, hintProcessingStmt, $idgen[]) + let semNode = semWithPContext(ctx, importStmt) + if semNode == nil or processPipeline(graph, semNode, bModule) == nil: + break + +proc prePass(c: PContext; n: PNode) = + for son in n: + if son.kind == nkPragma: + for s in son: + var key = if s.kind in nkPragmaCallKinds and s.len > 1: s[0] else: s + if key.kind in {nkBracketExpr, nkCast} or key.kind notin nkIdentKinds: + continue + let ident = whichKeyword(considerQuotedIdent(c, key)) + case ident + of wReorder: + pragmaNoForward(c, s, flag = sfReorder) + of wExperimental: + if isTopLevel(c) and s.kind in nkPragmaCallKinds and s.len == 2: + let name = c.semConstExpr(c, s[1]) + case name.kind + of nkStrLit, nkRStrLit, nkTripleStrLit: + try: + let feature = parseEnum[Feature](name.strVal) + if feature == codeReordering: + c.features.incl feature + c.module.flags.incl sfReorder + except ValueError: + discard + else: + discard + else: + discard + +proc processPipelineModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator; + stream: PLLStream): bool = + if graph.stopCompile(): return true + var + p: Parser = default(Parser) + s: PLLStream + fileIdx = module.fileIdx + + prepareConfigNotes(graph, module) + let ctx = preparePContext(graph, module, idgen) + let bModule: PPassContext = + case graph.pipelinePass + of CgenPass: + setupCgen(graph, module, idgen) + of JSgenPass: + when not defined(leanCompiler): + setupJSgen(graph, module, idgen) + else: + nil + of EvalPass, InterpreterPass: + setupEvalGen(graph, module, idgen) + of GenDependPass: + setupDependPass(graph, module, idgen) + of Docgen2Pass: + when not defined(leanCompiler): + openHtml(graph, module, idgen) + else: + nil + of Docgen2TexPass: + when not defined(leanCompiler): + openTex(graph, module, idgen) + else: + nil + of Docgen2JsonPass: + when not defined(leanCompiler): + openJson(graph, module, idgen) + else: + nil + of SemPass: + nil + of NonePass: + raiseAssert "use setPipeLinePass to set a proper PipelinePass" + + if stream == nil: + let filename = toFullPathConsiderDirty(graph.config, fileIdx) + s = llStreamOpen(filename, fmRead) + if s == nil: + rawMessage(graph.config, errCannotOpenFile, filename.string) + return false + graph.interactive = false + else: + s = stream + graph.interactive = stream.kind == llsStdIn + while true: + syntaxes.openParser(p, fileIdx, s, graph.cache, graph.config) + + if not belongsToStdlib(graph, module) or (belongsToStdlib(graph, module) and module.name.s == "distros"): + # XXX what about caching? no processing then? what if I change the + # modules to include between compilation runs? we'd need to track that + # in ROD files. I think we should enable this feature only + # for the interactive mode. + if module.name.s != "nimscriptapi": + processImplicitImports graph, graph.config.implicitImports, nkImportStmt, module, ctx, bModule, idgen + processImplicitImports graph, graph.config.implicitIncludes, nkIncludeStmt, module, ctx, bModule, idgen + + checkFirstLineIndentation(p) + block processCode: + if graph.stopCompile(): break processCode + var n = parseTopLevelStmt(p) + if n.kind == nkEmpty: break processCode + # read everything, no streaming possible + var sl = newNodeI(nkStmtList, n.info) + sl.add n + while true: + var n = parseTopLevelStmt(p) + if n.kind == nkEmpty: break + sl.add n + + prePass(ctx, sl) + if sfReorder in module.flags or codeReordering in graph.config.features: + sl = reorder(graph, sl, module) + if graph.pipelinePass != EvalPass: + message(graph.config, sl.info, hintProcessingStmt, $idgen[]) + var semNode = semWithPContext(ctx, sl) + discard processPipeline(graph, semNode, bModule) + + closeParser(p) + if s.kind != llsStdIn: break + let finalNode = closePContext(graph, ctx, nil) + case graph.pipelinePass + of CgenPass: + if bModule != nil: + let m = BModule(bModule) + finalCodegenActions(graph, m, finalNode) + if graph.dispatchers.len > 0: + let ctx = preparePContext(graph, module, idgen) + for disp in getDispatchers(graph): + let retTyp = disp.typ.returnType + if retTyp != nil: + # TODO: properly semcheck the code of dispatcher? + createTypeBoundOps(graph, ctx, retTyp, disp.ast.info, idgen) + genProcAux(m, disp) + discard closePContext(graph, ctx, nil) + of JSgenPass: + when not defined(leanCompiler): + discard finalJSCodeGen(graph, bModule, finalNode) + of EvalPass, InterpreterPass: + discard interpreterCode(bModule, finalNode) + of SemPass, GenDependPass: + discard + of Docgen2Pass, Docgen2TexPass: + when not defined(leanCompiler): + discard closeDoc(graph, bModule, finalNode) + of Docgen2JsonPass: + when not defined(leanCompiler): + discard closeJson(graph, bModule, finalNode) + of NonePass: + raiseAssert "use setPipeLinePass to set a proper PipelinePass" + + if graph.config.backend notin {backendC, backendCpp, backendObjc}: + # We only write rod files here if no C-like backend is active. + # The C-like backends have been patched to support the IC mechanism. + # They are responsible for closing the rod files. See `cbackend.nim`. + closeRodFile(graph, module) + result = true + +proc compilePipelineModule*(graph: ModuleGraph; fileIdx: FileIndex; flags: TSymFlags; fromModule: PSym = nil): PSym = + var flags = flags + if fileIdx == graph.config.projectMainIdx2: flags.incl sfMainModule + result = graph.getModule(fileIdx) + + template processModuleAux(moduleStatus) = + onProcessing(graph, fileIdx, moduleStatus, fromModule = fromModule) + var s: PLLStream = nil + if sfMainModule in flags: + if graph.config.projectIsStdin: s = stdin.llStreamOpen + elif graph.config.projectIsCmd: s = llStreamOpen(graph.config.cmdInput) + discard processPipelineModule(graph, result, idGeneratorFromModule(result), s) + if result == nil: + var cachedModules: seq[FileIndex] = @[] + result = moduleFromRodFile(graph, fileIdx, cachedModules) + let path = toFullPath(graph.config, fileIdx) + let filename = AbsoluteFile path + if fileExists(filename): # it could be a stdinfile + graph.cachedFiles[path] = $secureHashFile(path) + if result == nil: + result = newModule(graph, fileIdx) + result.flags.incl flags + registerModule(graph, result) + processModuleAux("import") + else: + if sfSystemModule in flags: + graph.systemModule = result + if sfMainModule in flags and graph.config.cmd == cmdM: + result.flags.incl flags + registerModule(graph, result) + processModuleAux("import") + partialInitModule(result, graph, fileIdx, filename) + for m in cachedModules: + registerModuleById(graph, m) + if sfMainModule in flags and graph.config.cmd == cmdM: + discard + else: + replayStateChanges(graph.packed.pm[m.int].module, graph) + replayGenericCacheInformation(graph, m.int) + elif graph.isDirty(result): + result.flags.excl sfDirty + # reset module fields: + initStrTables(graph, result) + result.ast = nil + processModuleAux("import(dirty)") + graph.markClientsDirty(fileIdx) + +proc importPipelineModule(graph: ModuleGraph; s: PSym, fileIdx: FileIndex): PSym = + # this is called by the semantic checking phase + assert graph.config != nil + result = compilePipelineModule(graph, fileIdx, {}, s) + graph.addDep(s, fileIdx) + # keep track of import relationships + if graph.config.hcrOn: + graph.importDeps.mgetOrPut(FileIndex(s.position), @[]).add(fileIdx) + #if sfSystemModule in result.flags: + # localError(result.info, errAttemptToRedefine, result.name.s) + # restore the notes for outer module: + graph.config.notes = + if graph.config.belongsToProjectPackage(s) or isDefined(graph.config, "booting"): graph.config.mainPackageNotes + else: graph.config.foreignPackageNotes + +proc connectPipelineCallbacks*(graph: ModuleGraph) = + graph.includeFileCallback = modules.includeModule + graph.importModuleCallback = importPipelineModule + +proc compilePipelineSystemModule*(graph: ModuleGraph) = + if graph.systemModule == nil: + connectPipelineCallbacks(graph) + graph.config.m.systemFileIdx = fileInfoIdx(graph.config, + graph.config.libpath / RelativeFile"system.nim") + discard graph.compilePipelineModule(graph.config.m.systemFileIdx, {sfSystemModule}) + +proc compilePipelineProject*(graph: ModuleGraph; projectFileIdx = InvalidFileIdx) = + connectPipelineCallbacks(graph) + let conf = graph.config + wantMainModule(conf) + configComplete(graph) + + let systemFileIdx = fileInfoIdx(conf, conf.libpath / RelativeFile"system.nim") + let projectFile = if projectFileIdx == InvalidFileIdx: conf.projectMainIdx else: projectFileIdx + conf.projectMainIdx2 = projectFile + + let packSym = getPackage(graph, projectFile) + graph.config.mainPackageId = packSym.getPackageId + graph.importStack.add projectFile + + if projectFile == systemFileIdx: + discard graph.compilePipelineModule(projectFile, {sfMainModule, sfSystemModule}) + else: + graph.compilePipelineSystemModule() + discard graph.compilePipelineModule(projectFile, {sfMainModule}) diff --git a/compiler/pipelineutils.nim b/compiler/pipelineutils.nim new file mode 100644 index 000000000..75ba33f14 --- /dev/null +++ b/compiler/pipelineutils.nim @@ -0,0 +1,26 @@ +import ast, options, lineinfos, pathutils, msgs, modulegraphs, packages + +proc skipCodegen*(config: ConfigRef; n: PNode): bool {.inline.} = + # can be used by codegen passes to determine whether they should do + # something with `n`. Currently, this ignores `n` and uses the global + # error count instead. + result = config.errorCounter > 0 + +proc resolveMod*(conf: ConfigRef; module, relativeTo: string): FileIndex = + let fullPath = findModule(conf, module, relativeTo) + if fullPath.isEmpty: + result = InvalidFileIdx + else: + result = fileInfoIdx(conf, fullPath) + +proc prepareConfigNotes*(graph: ModuleGraph; module: PSym) = + # don't be verbose unless the module belongs to the main package: + if graph.config.belongsToProjectPackage(module): + graph.config.notes = graph.config.mainPackageNotes + else: + if graph.config.mainPackageNotes == {}: graph.config.mainPackageNotes = graph.config.notes + graph.config.notes = graph.config.foreignPackageNotes + +proc moduleHasChanged*(graph: ModuleGraph; module: PSym): bool {.inline.} = + result = true + #module.id >= 0 or isDefined(graph.config, "nimBackendAssumesChange") diff --git a/compiler/platform.nim b/compiler/platform.nim index 413a91304..03d0cc461 100644 --- a/compiler/platform.nim +++ b/compiler/platform.nim @@ -14,15 +14,20 @@ # Feel free to test for your excentric platform! import - strutils + std/strutils + +when defined(nimPreviewSlimSystem): + import std/assertions + type TSystemOS* = enum # Also add OS in initialization section and alias # conditionals to condsyms (end of module). osNone, osDos, osWindows, osOs2, osLinux, osMorphos, osSkyos, osSolaris, - osIrix, osNetbsd, osFreebsd, osOpenbsd, osDragonfly, osAix, osPalmos, osQnx, + osIrix, osNetbsd, osFreebsd, osOpenbsd, osDragonfly, osCrossos, osAix, osPalmos, osQnx, osAmiga, osAtari, osNetware, osMacos, osMacosx, osIos, osHaiku, osAndroid, osVxWorks - osGenode, osJS, osNimVM, osStandalone, osNintendoSwitch, osFreeRTOS, osAny + osGenode, osJS, osNimVM, osStandalone, osNintendoSwitch, osFreeRTOS, osZephyr, + osNuttX, osAny type TInfoOSProp* = enum @@ -105,6 +110,10 @@ const scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", props: {ospNeedsPIC, ospPosix}), + (name: "CROSSOS", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), (name: "AIX", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", @@ -181,6 +190,14 @@ const objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", props: {ospPosix}), + (name: "Zephyr", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospPosix}), + (name: "NuttX", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospPosix}), (name: "Any", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", @@ -193,16 +210,15 @@ type cpuNone, cpuI386, cpuM68k, cpuAlpha, cpuPowerpc, cpuPowerpc64, cpuPowerpc64el, cpuSparc, cpuVm, cpuHppa, cpuIa64, cpuAmd64, cpuMips, cpuMipsel, cpuArm, cpuArm64, cpuJS, cpuNimVM, cpuAVR, cpuMSP430, - cpuSparc64, cpuMips64, cpuMips64el, cpuRiscV32, cpuRiscV64, cpuEsp, cpuWasm32 + cpuSparc64, cpuMips64, cpuMips64el, cpuRiscV32, cpuRiscV64, cpuEsp, cpuWasm32, + cpuE2k, cpuLoongArch64 type - TEndian* = enum - littleEndian, bigEndian - TInfoCPU* = tuple[name: string, intSize: int, endian: TEndian, + TInfoCPU* = tuple[name: string, intSize: int, endian: Endianness, floatSize, bit: int] const - EndianToStr*: array[TEndian, string] = ["littleEndian", "bigEndian"] + EndianToStr*: array[Endianness, string] = ["littleEndian", "bigEndian"] CPU*: array[succ(low(TSystemCPU))..high(TSystemCPU), TInfoCPU] = [ (name: "i386", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), (name: "m68k", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), @@ -230,7 +246,9 @@ const (name: "riscv32", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), (name: "riscv64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), (name: "esp", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), - (name: "wasm32", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32)] + (name: "wasm32", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), + (name: "e2k", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), + (name: "loongarch64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64)] type Target* = object @@ -259,6 +277,7 @@ proc nameToOS*(name: string): TSystemOS = result = osNone proc listOSnames*(): seq[string] = + result = @[] for i in succ(osNone)..high(TSystemOS): result.add OS[i].name @@ -269,6 +288,7 @@ proc nameToCPU*(name: string): TSystemCPU = result = cpuNone proc listCPUnames*(): seq[string] = + result = @[] for i in succ(cpuNone)..high(TSystemCPU): result.add CPU[i].name diff --git a/compiler/plugins/customast.nim b/compiler/plugins/customast.nim new file mode 100644 index 000000000..87461ae39 --- /dev/null +++ b/compiler/plugins/customast.nim @@ -0,0 +1,136 @@ +# This file exists to make it overridable via +# patchFile("plugins", "customast.nim", "customast.nim") + +## This also serves as a blueprint for a possible implementation. + +import "$nim" / compiler / [lineinfos, idents] + +when defined(nimPreviewSlimSystem): + import std/assertions + +import "$nim" / compiler / nodekinds +export nodekinds + +type + PNode* = ref TNode + TNode*{.final, acyclic.} = object + case kind*: TNodeKind + of nkCharLit..nkUInt64Lit: + intVal: BiggestInt + of nkFloatLit..nkFloat128Lit: + floatVal: BiggestFloat + of nkStrLit..nkTripleStrLit: + strVal: string + of nkSym: + discard + of nkIdent: + ident: PIdent + else: + son, next, last: PNode # linked structure instead of a `seq` + info*: TLineInfo + +const + bodyPos* = 6 + paramsPos* = 3 + +proc comment*(n: PNode): string = + result = "" + +proc `comment=`*(n: PNode, a: string) = + discard "XXX implement me" + +proc add*(father, son: PNode) = + assert son != nil + if father.son == nil: + father.son = son + father.last = son + else: + father.last.next = son + father.last = son + +template firstSon*(n: PNode): PNode = n.son +template secondSon*(n: PNode): PNode = n.son.next + +proc replaceFirstSon*(n, newson: PNode) {.inline.} = + let old = n.son + n.son = newson + newson.next = old + +proc replaceSon*(n: PNode; i: int; newson: PNode) = + assert i > 0 + assert newson.next == nil + var i = i + var it = n.son + while i > 0: + it = it.next + dec i + let old = it.next + it.next = newson + newson.next = old + +template newNodeImpl(info2) = + result = PNode(kind: kind, info: info2) + +proc newNode*(kind: TNodeKind): PNode = + ## new node with unknown line info, no type, and no children + newNodeImpl(unknownLineInfo) + +proc newNode*(kind: TNodeKind, info: TLineInfo): PNode = + ## new node with line info, no type, and no children + newNodeImpl(info) + +proc newTree*(kind: TNodeKind; info: TLineInfo; child: PNode): PNode = + result = newNode(kind, info) + result.son = child + +proc newAtom*(ident: PIdent, info: TLineInfo): PNode = + result = newNode(nkIdent) + result.ident = ident + result.info = info + +proc newAtom*(kind: TNodeKind, intVal: BiggestInt, info: TLineInfo): PNode = + result = newNode(kind, info) + result.intVal = intVal + +proc newAtom*(kind: TNodeKind, floatVal: BiggestFloat, info: TLineInfo): PNode = + result = newNode(kind, info) + result.floatVal = floatVal + +proc newAtom*(kind: TNodeKind; strVal: sink string; info: TLineInfo): PNode = + result = newNode(kind, info) + result.strVal = strVal + +proc lastSon*(n: PNode): PNode {.inline.} = n.last +proc setLastSon*(n: PNode, s: PNode) = + assert s.next == nil + n.last = s + if n.son == nil: n.son = s + +proc newProcNode*(kind: TNodeKind, info: TLineInfo, body: PNode, + params, + name, pattern, genericParams, + pragmas, exceptions: PNode): PNode = + result = newNode(kind, info) + result.add name + result.add pattern + result.add genericParams + result.add params + result.add pragmas + result.add exceptions + result.add body + +template transitionNodeKindCommon(k: TNodeKind) = + let obj {.inject.} = n[] + n[] = TNode(kind: k, info: obj.info) + # n.comment = obj.comment # shouldn't be needed, the address doesnt' change + +proc transitionSonsKind*(n: PNode, kind: range[nkComesFrom..nkTupleConstr]) = + transitionNodeKindCommon(kind) + n.son = obj.son + +template hasSon*(n: PNode): bool = n.son != nil +template has2Sons*(n: PNode): bool = n.son != nil and n.son.next != nil + +proc isNewStyleConcept*(n: PNode): bool {.inline.} = + assert n.kind == nkTypeClassTy + result = n.firstSon.kind == nkEmpty diff --git a/compiler/plugins/itersgen.nim b/compiler/plugins/itersgen.nim index 24e26b2b7..e2c97bdc5 100644 --- a/compiler/plugins/itersgen.nim +++ b/compiler/plugins/itersgen.nim @@ -25,14 +25,14 @@ proc iterToProcImpl*(c: PContext, n: PNode): PNode = return let t = n[2].typ.skipTypes({tyTypeDesc, tyGenericInst}) - if t.kind notin {tyRef, tyPtr} or t.lastSon.kind != tyObject: + if t.kind notin {tyRef, tyPtr} or t.elementType.kind != tyObject: localError(c.config, n[2].info, "type must be a non-generic ref|ptr to object with state field") return let body = liftIterToProc(c.graph, iter.sym, getBody(c.graph, iter.sym), t, c.idgen) - let prc = newSym(skProc, n[3].ident, nextSymId c.idgen, iter.sym.owner, iter.sym.info) - prc.typ = copyType(iter.sym.typ, nextTypeId c.idgen, prc) + let prc = newSym(skProc, n[3].ident, c.idgen, iter.sym.owner, iter.sym.info) + prc.typ = copyType(iter.sym.typ, c.idgen, prc) excl prc.typ.flags, tfCapturesEnv prc.typ.n.add newSymNode(getEnvParam(iter.sym)) prc.typ.rawAddSon t diff --git a/compiler/plugins/locals.nim b/compiler/plugins/locals.nim index c03a6986e..d3046cd65 100644 --- a/compiler/plugins/locals.nim +++ b/compiler/plugins/locals.nim @@ -15,7 +15,7 @@ import ".." / [ast, astalgo, proc semLocals*(c: PContext, n: PNode): PNode = var counter = 0 var tupleType = newTypeS(tyTuple, c) - result = newNodeIT(nkPar, n.info, tupleType) + result = newNodeIT(nkTupleConstr, n.info, tupleType) tupleType.n = newNodeI(nkRecList, n.info) let owner = getCurrOwner(c) # for now we skip openarrays ... @@ -26,7 +26,7 @@ proc semLocals*(c: PContext, n: PNode): PNode = {tyVarargs, tyOpenArray, tyTypeDesc, tyStatic, tyUntyped, tyTyped, tyEmpty}: if it.owner == owner: - var field = newSym(skField, it.name, nextSymId c.idgen, owner, n.info) + var field = newSym(skField, it.name, c.idgen, owner, n.info) field.typ = it.typ.skipTypes({tyVar}) field.position = counter inc(counter) diff --git a/compiler/plugins/plugins.nimble b/compiler/plugins/plugins.nimble new file mode 100644 index 000000000..e69de29bb --- /dev/null +++ b/compiler/plugins/plugins.nimble diff --git a/compiler/pragmas.nim b/compiler/pragmas.nim index 35e75bc7b..9a298cd90 100644 --- a/compiler/pragmas.nim +++ b/compiler/pragmas.nim @@ -10,9 +10,16 @@ # This module implements semantic checking for pragmas import - os, condsyms, ast, astalgo, idents, semdata, msgs, renderer, - wordrecg, ropes, options, strutils, extccomp, math, magicsys, trees, - types, lookups, lineinfos, pathutils, linter + condsyms, ast, astalgo, idents, semdata, msgs, renderer, + wordrecg, ropes, options, extccomp, magicsys, trees, + types, lookups, lineinfos, pathutils, linter, modulepaths + +from sigmatch import trySuggestPragmas + +import std/[os, math, strutils] + +when defined(nimPreviewSlimSystem): + import std/assertions from ic / ic import addCompilerProc @@ -26,66 +33,72 @@ const ## common pragmas for declarations, to a good approximation procPragmas* = declPragmas + {FirstCallConv..LastCallConv, wMagic, wNoSideEffect, wSideEffect, wNoreturn, wNosinks, wDynlib, wHeader, - wCompilerProc, wNonReloadable, wCore, wProcVar, wVarargs, wCompileTime, wMerge, + wCompilerProc, wNonReloadable, wCore, wProcVar, wVarargs, wCompileTime, wBorrow, wImportCompilerProc, wThread, wAsmNoStackFrame, wDiscardable, wNoInit, wCodegenDecl, - wGensym, wInject, wRaises, wTags, wLocks, wDelegator, wGcSafe, + wGensym, wInject, wRaises, wEffectsOf, wTags, wForbids, wLocks, wDelegator, wGcSafe, wConstructor, wLiftLocals, wStackTrace, wLineTrace, wNoDestroy, - wRequires, wEnsures} + wRequires, wEnsures, wEnforceNoRaises, wSystemRaisesDefect, wVirtual, wQuirky, wMember} converterPragmas* = procPragmas methodPragmas* = procPragmas+{wBase}-{wImportCpp} templatePragmas* = {wDeprecated, wError, wGensym, wInject, wDirty, - wDelegator, wExportNims, wUsed, wPragma} + wDelegator, wExportNims, wUsed, wPragma, wRedefine, wCallsite} macroPragmas* = declPragmas + {FirstCallConv..LastCallConv, wMagic, wNoSideEffect, wCompilerProc, wNonReloadable, wCore, wDiscardable, wGensym, wInject, wDelegator} iteratorPragmas* = declPragmas + {FirstCallConv..LastCallConv, wNoSideEffect, wSideEffect, wMagic, wBorrow, - wDiscardable, wGensym, wInject, wRaises, - wTags, wLocks, wGcSafe, wRequires, wEnsures} + wDiscardable, wGensym, wInject, wRaises, wEffectsOf, + wTags, wForbids, wLocks, wGcSafe, wRequires, wEnsures} exprPragmas* = {wLine, wLocks, wNoRewrite, wGcSafe, wNoSideEffect} - stmtPragmas* = {wChecks, wObjChecks, wFieldChecks, wRangeChecks, - wBoundChecks, wOverflowChecks, wNilChecks, wStaticBoundchecks, - wStyleChecks, wAssertions, - wWarnings, wHints, - wLineDir, wStackTrace, wLineTrace, wOptimization, wHint, wWarning, wError, + stmtPragmas* = { + wHint, wWarning, wError, wFatal, wDefine, wUndef, wCompile, wLink, wLinksys, wPure, wPush, wPop, wPassl, wPassc, wLocalPassc, wDeadCodeElimUnused, # deprecated, always on wDeprecated, - wFloatChecks, wInfChecks, wNanChecks, wPragma, wEmit, wUnroll, + wPragma, wEmit, wUnroll, wLinearScanEnd, wPatterns, wTrMacros, wEffects, wNoForward, wReorder, wComputedGoto, - wInjectStmt, wExperimental, wThis, wUsed, wInvariant, wAssume, wAssert} + wExperimental, wDoctype, wThis, wUsed, wInvariant, wAssume, wAssert} + stmtPragmasTopLevel* = {wChecks, wObjChecks, wFieldChecks, wRangeChecks, + wBoundChecks, wOverflowChecks, wNilChecks, wStaticBoundchecks, + wStyleChecks, wAssertions, + wWarnings, wHints, + wLineDir, wStackTrace, wLineTrace, wOptimization, + wFloatChecks, wInfChecks, wNanChecks} lambdaPragmas* = {FirstCallConv..LastCallConv, wNoSideEffect, wSideEffect, wNoreturn, wNosinks, wDynlib, wHeader, wThread, wAsmNoStackFrame, - wRaises, wLocks, wTags, wRequires, wEnsures, + wRaises, wLocks, wTags, wForbids, wRequires, wEnsures, wEffectsOf, wGcSafe, wCodegenDecl, wNoInit, wCompileTime} typePragmas* = declPragmas + {wMagic, wAcyclic, wPure, wHeader, wCompilerProc, wCore, wFinal, wSize, wShallow, wIncompleteStruct, wCompleteStruct, wByCopy, wByRef, wInheritable, wGensym, wInject, wRequiresInit, wUnchecked, wUnion, wPacked, - wCppNonPod, wBorrow, wGcSafe, wPartial, wExplain, wPackage} + wCppNonPod, wBorrow, wGcSafe, wPartial, wExplain, wPackage, wCodegenDecl, + wSendable, wNoInit} fieldPragmas* = declPragmas + {wGuard, wBitsize, wCursor, - wRequiresInit, wNoalias, wAlign} - {wExportNims, wNodecl} # why exclude these? + wRequiresInit, wNoalias, wAlign, wNoInit} - {wExportNims, wNodecl} # why exclude these? varPragmas* = declPragmas + {wVolatile, wRegister, wThreadVar, wMagic, wHeader, wCompilerProc, wCore, wDynlib, - wNoInit, wCompileTime, wGlobal, + wNoInit, wCompileTime, wGlobal, wLiftLocals, wGensym, wInject, wCodegenDecl, wGuard, wGoto, wCursor, wNoalias, wAlign} constPragmas* = declPragmas + {wHeader, wMagic, wGensym, wInject, - wIntDefine, wStrDefine, wBoolDefine, wCompilerProc, wCore} - paramPragmas* = {wNoalias, wInject, wGensym} + wIntDefine, wStrDefine, wBoolDefine, wDefine, + wCompilerProc, wCore} + paramPragmas* = {wNoalias, wInject, wGensym, wByRef, wByCopy, wCodegenDecl, wExportc, wExportCpp} letPragmas* = varPragmas procTypePragmas* = {FirstCallConv..LastCallConv, wVarargs, wNoSideEffect, - wThread, wRaises, wLocks, wTags, wGcSafe, + wThread, wRaises, wEffectsOf, wLocks, wTags, wForbids, wGcSafe, wRequires, wEnsures} forVarPragmas* = {wInject, wGensym} allRoutinePragmas* = methodPragmas + iteratorPragmas + lambdaPragmas enumFieldPragmas* = {wDeprecated} proc getPragmaVal*(procAst: PNode; name: TSpecialWord): PNode = + result = nil let p = procAst[pragmasPos] if p.kind == nkEmpty: return nil for it in p: @@ -108,8 +121,17 @@ const proc invalidPragma*(c: PContext; n: PNode) = localError(c.config, n.info, "invalid pragma: " & renderTree(n, {renderNoComments})) + proc illegalCustomPragma*(c: PContext, n: PNode, s: PSym) = - localError(c.config, n.info, "cannot attach a custom pragma to '" & s.name.s & "'") + var msg = "cannot attach a custom pragma to '" & s.name.s & "'" + if s != nil: + msg.add("; custom pragmas are not supported for ") + case s.kind + of skForVar: msg.add("`for` loop variables") + of skEnumField: msg.add("enum fields") + of skModule: msg.add("modules") + else: msg.add("symbol kind " & $s.kind) + localError(c.config, n.info, msg) proc pragmaProposition(c: PContext, n: PNode) = if n.kind notin nkPragmaCallKinds or n.len != 2: @@ -123,44 +145,28 @@ proc pragmaEnsures(c: PContext, n: PNode) = else: openScope(c) let o = getCurrOwner(c) - if o.kind in routineKinds and o.typ != nil and o.typ.sons[0] != nil: - var s = newSym(skResult, getIdent(c.cache, "result"), nextSymId(c.idgen), o, n.info) - s.typ = o.typ.sons[0] + if o.kind in routineKinds and o.typ != nil and o.typ.returnType != nil: + var s = newSym(skResult, getIdent(c.cache, "result"), c.idgen, o, n.info) + s.typ = o.typ.returnType incl(s.flags, sfUsed) addDecl(c, s) n[1] = c.semExpr(c, n[1]) closeScope(c) -proc pragmaAsm*(c: PContext, n: PNode): char = - result = '\0' - if n != nil: - for i in 0..<n.len: - let it = n[i] - if it.kind in nkPragmaCallKinds and it.len == 2 and it[0].kind == nkIdent: - case whichKeyword(it[0].ident) - of wSubsChar: - if it[1].kind == nkCharLit: result = chr(int(it[1].intVal)) - else: invalidPragma(c, it) - else: invalidPragma(c, it) - else: - invalidPragma(c, it) - proc setExternName(c: PContext; s: PSym, extname: string, info: TLineInfo) = # special cases to improve performance: if extname == "$1": - s.loc.r = rope(s.name.s) + s.loc.snippet = rope(s.name.s) elif '$' notin extname: - s.loc.r = rope(extname) + s.loc.snippet = rope(extname) else: try: - s.loc.r = rope(extname % s.name.s) + s.loc.snippet = rope(extname % s.name.s) except ValueError: localError(c.config, info, "invalid extern name: '" & extname & "'. (Forgot to escape '$'?)") when hasFFI: - s.cname = $s.loc.r - if c.config.cmd == cmdNimfix and '$' notin extname: - # note that '{.importc.}' is transformed into '{.importc: "$1".}' - s.loc.flags.incl(lfFullExternalName) + s.cname = $s.loc.snippet + proc makeExternImport(c: PContext; s: PSym, extname: string, info: TLineInfo) = setExternName(c, s, extname, info) @@ -195,9 +201,9 @@ proc processImportObjC(c: PContext; s: PSym, extname: string, info: TLineInfo) = let m = s.getModule() incl(m.flags, sfCompileToObjc) -proc newEmptyStrNode(c: PContext; n: PNode): PNode {.noinline.} = +proc newEmptyStrNode(c: PContext; n: PNode, strVal: string = ""): PNode {.noinline.} = result = newNodeIT(nkStrLit, n.info, getSysType(c.graph, n.info, tyString)) - result.strVal = "" + result.strVal = strVal proc getStrLitNode(c: PContext, n: PNode): PNode = if n.kind notin nkPragmaCallKinds or n.len != 2: @@ -217,6 +223,7 @@ proc expectStrLit(c: PContext, n: PNode): string = result = getStrLitNode(c, n).strVal proc expectIntLit(c: PContext, n: PNode): int = + result = 0 if n.kind notin nkPragmaCallKinds or n.len != 2: localError(c.config, n.info, errIntLiteralExpected) else: @@ -229,8 +236,17 @@ proc getOptionalStr(c: PContext, n: PNode, defaultStr: string): string = if n.kind in nkPragmaCallKinds: result = expectStrLit(c, n) else: result = defaultStr +proc processVirtual(c: PContext, n: PNode, s: PSym, flag: TSymFlag) = + s.constraint = newEmptyStrNode(c, n, getOptionalStr(c, n, "$1")) + s.constraint.strVal = s.constraint.strVal % s.name.s + s.flags.incl {flag, sfInfixCall, sfExportc, sfMangleCpp} + + s.typ.callConv = ccMember + incl c.config.globalOptions, optMixedMode + proc processCodegenDecl(c: PContext, n: PNode, sym: PSym) = sym.constraint = getStrLitNode(c, n) + sym.flags.incl sfCodegenDecl proc processMagic(c: PContext, n: PNode, s: PSym) = #if sfSystemModule notin c.module.flags: @@ -253,6 +269,7 @@ proc wordToCallConv(sw: TSpecialWord): TCallingConvention = TCallingConvention(ord(ccNimCall) + ord(sw) - ord(wNimcall)) proc isTurnedOn(c: PContext, n: PNode): bool = + result = false if n.kind in nkPragmaCallKinds and n.len == 2: let x = c.semConstBoolExpr(c, n[1]) n[1] = x @@ -263,7 +280,7 @@ proc onOff(c: PContext, n: PNode, op: TOptions, resOptions: var TOptions) = if isTurnedOn(c, n): resOptions.incl op else: resOptions.excl op -proc pragmaNoForward(c: PContext, n: PNode; flag=sfNoForward) = +proc pragmaNoForward*(c: PContext, n: PNode; flag=sfNoForward) = if isTurnedOn(c, n): incl(c.module.flags, flag) c.features.incl codeReordering @@ -276,6 +293,24 @@ proc pragmaNoForward(c: PContext, n: PNode; flag=sfNoForward) = "use {.experimental: \"codeReordering\".} instead; " & (if flag == sfNoForward: "{.noForward.}" else: "{.reorder.}") & " is deprecated") +proc pragmaAsm*(c: PContext, n: PNode): char = + ## Checks asm pragmas and get's the asm subschar (default: '`'). + result = '\0' + if n != nil: + for i in 0..<n.len: + let it = n[i] + if it.kind in nkPragmaCallKinds and it.len == 2 and it[0].kind == nkIdent: + case whichKeyword(it[0].ident) + of wSubsChar: + if it[1].kind == nkCharLit: result = chr(int(it[1].intVal)) + else: invalidPragma(c, it) + of wAsmSyntax: + let s = expectStrLit(c, it) + if s notin ["gcc", "vcc"]: invalidPragma(c, it) + else: invalidPragma(c, it) + else: + invalidPragma(c, it) + proc processCallConv(c: PContext, n: PNode) = if n.kind in nkPragmaCallKinds and n.len == 2 and n[1].kind == nkIdent: let sw = whichKeyword(n[1].ident) @@ -295,7 +330,7 @@ proc getLib(c: PContext, kind: TLibKind, path: PNode): PLib = result.path = path c.libs.add result if path.kind in {nkStrLit..nkTripleStrLit}: - result.isOverriden = options.isDynlibOverride(c.config, path.strVal) + result.isOverridden = options.isDynlibOverride(c.config, path.strVal) proc expectDynlibNode(c: PContext, n: PNode): PNode = if n.kind notin nkPragmaCallKinds or n.len != 2: @@ -307,7 +342,7 @@ proc expectDynlibNode(c: PContext, n: PNode): PNode = # {.dynlib: myGetProcAddr(...).} result = c.semExpr(c, n[1]) if result.kind == nkSym and result.sym.kind == skConst: - result = result.sym.ast # look it up + result = c.semConstExpr(c, result) # fold const if result.typ == nil or result.typ.kind notin {tyPointer, tyString, tyProc}: localError(c.config, n.info, errStringLiteralExpected) result = newEmptyStrNode(c, n) @@ -315,12 +350,12 @@ proc expectDynlibNode(c: PContext, n: PNode): PNode = proc processDynLib(c: PContext, n: PNode, sym: PSym) = if (sym == nil) or (sym.kind == skModule): let lib = getLib(c, libDynamic, expectDynlibNode(c, n)) - if not lib.isOverriden: + if not lib.isOverridden: c.optionStack[^1].dynlib = lib else: if n.kind in nkPragmaCallKinds: var lib = getLib(c, libDynamic, expectDynlibNode(c, n)) - if not lib.isOverriden: + if not lib.isOverridden: addToLib(lib, sym) incl(sym.loc.flags, lfDynamicLib) else: @@ -335,7 +370,7 @@ proc processDynLib(c: PContext, n: PNode, sym: PSym) = proc processNote(c: PContext, n: PNode) = template handleNote(enumVals, notes) = let x = findStr(enumVals.a, enumVals.b, n[0][1].ident.s, errUnknown) - if x != errUnknown: + if x != errUnknown: nk = TNoteKind(x) let x = c.semConstBoolExpr(c, n[1]) n[1] = x @@ -357,7 +392,7 @@ proc processNote(c: PContext, n: PNode) = else: invalidPragma(c, n) else: invalidPragma(c, n) -proc pragmaToOptions(w: TSpecialWord): TOptions {.inline.} = +proc pragmaToOptions*(w: TSpecialWord): TOptions {.inline.} = case w of wChecks: ChecksOptions of wObjChecks: {optObjCheck} @@ -383,6 +418,7 @@ proc pragmaToOptions(w: TSpecialWord): TOptions {.inline.} = of wImplicitStatic: {optImplicitStatic} of wPatterns, wTrMacros: {optTrMacros} of wSinkInference: {optSinkInference} + of wQuirky: {optQuirky} else: {} proc processExperimental(c: PContext; n: PNode) = @@ -444,6 +480,18 @@ proc processOption(c: PContext, n: PNode, resOptions: var TOptions) = # calling conventions (boring...): localError(c.config, n.info, "option expected") +proc checkPushedPragma(c: PContext, n: PNode) = + let keyDeep = n.kind in nkPragmaCallKinds and n.len > 1 + var key = if keyDeep: n[0] else: n + if key.kind in nkIdentKinds: + let ident = considerQuotedIdent(c, key) + var userPragma = strTableGet(c.userPragmas, ident) + if userPragma == nil: + let k = whichKeyword(ident) + # TODO: might as well make a list which is not accepted by `push`: emit, cast etc. + if k == wEmit: + localError(c.config, n.info, "an 'emit' pragma cannot be pushed") + proc processPush(c: PContext, n: PNode, start: int) = if n[start-1].kind in nkPragmaCallKinds: localError(c.config, n.info, "'push' cannot have arguments") @@ -451,6 +499,7 @@ proc processPush(c: PContext, n: PNode, start: int) = for i in start..<n.len: if not tryProcessOption(c, n[i], c.config.options): # simply store it somewhere: + checkPushedPragma(c, n[i]) if x.otherPragmas.isNil: x.otherPragmas = newNodeI(nkPragma, n.info) x.otherPragmas.add n[i] @@ -470,8 +519,16 @@ proc processPop(c: PContext, n: PNode) = when defined(debugOptions): echo c.config $ n.info, " POP config is now ", c.config.options -proc processDefine(c: PContext, n: PNode) = - if (n.kind in nkPragmaCallKinds and n.len == 2) and (n[1].kind == nkIdent): +proc processDefineConst(c: PContext, n: PNode, sym: PSym, kind: TMagic) = + sym.magic = kind + if n.kind in nkPragmaCallKinds and n.len == 2: + # could also use TLib + n[1] = getStrLitNode(c, n) + +proc processDefine(c: PContext, n: PNode, sym: PSym) = + if sym != nil and sym.kind == skConst: + processDefineConst(c, n, sym, mGenericDefine) + elif (n.kind in nkPragmaCallKinds and n.len == 2) and (n[1].kind == nkIdent): defineSymbol(c.config.symbols, n[1].ident.s) else: invalidPragma(c, n) @@ -494,18 +551,28 @@ proc relativeFile(c: PContext; n: PNode; ext=""): AbsoluteFile = if result.isEmpty: result = AbsoluteFile s proc processCompile(c: PContext, n: PNode) = + ## This pragma can take two forms. The first is a simple file input: + ## {.compile: "file.c".} + ## The second is a tuple where the second arg is the output name strutils formatter: + ## {.compile: ("file.c", "$1.o").} proc docompile(c: PContext; it: PNode; src, dest: AbsoluteFile; customArgs: string) = var cf = Cfile(nimname: splitFile(src).name, cname: src, obj: dest, flags: {CfileFlag.External}, customArgs: customArgs) - extccomp.addExternalFileToCompile(c.config, cf) - recordPragma(c, it, "compile", src.string, dest.string, customArgs) + if not fileExists(src): + localError(c.config, n.info, "cannot find: " & src.string) + else: + extccomp.addExternalFileToCompile(c.config, cf) + recordPragma(c, it, "compile", src.string, dest.string, customArgs) proc getStrLit(c: PContext, n: PNode; i: int): string = n[i] = c.semConstExpr(c, n[i]) case n[i].kind of nkStrLit, nkRStrLit, nkTripleStrLit: - shallowCopy(result, n[i].strVal) + when defined(gcArc) or defined(gcOrc) or defined(gcAtomicArc): + result = n[i].strVal + else: + shallowCopy(result, n[i].strVal) else: localError(c.config, n.info, errStringLiteralExpected) result = "" @@ -536,7 +603,8 @@ proc processCompile(c: PContext, n: PNode) = else: found = findFile(c.config, s) if found.isEmpty: found = AbsoluteFile s - let obj = toObjFile(c.config, completeCfilePath(c.config, found, false)) + let mangled = completeCfilePath(c.config, mangleModuleName(c.config, found).AbsoluteFile) + let obj = toObjFile(c.config, mangled) docompile(c, it, found, obj, customArgs) proc processLink(c: PContext, n: PNode) = @@ -548,6 +616,7 @@ proc semAsmOrEmit*(con: PContext, n: PNode, marker: char): PNode = case n[1].kind of nkStrLit, nkRStrLit, nkTripleStrLit: result = newNodeI(if n.kind == nkAsmStmt: nkAsmStmt else: nkArgList, n.info) + if n.kind == nkAsmStmt: result.add n[0] # save asm pragmas for NIR var str = n[1].strVal if str == "": localError(con.config, n.info, "empty 'asm' statement") @@ -579,6 +648,7 @@ proc semAsmOrEmit*(con: PContext, n: PNode, marker: char): PNode = else: illFormedAstLocal(n, con.config) result = newNodeI(nkAsmStmt, n.info) + if n.kind == nkAsmStmt: result.add n[0] proc pragmaEmit(c: PContext, n: PNode) = if n.kind notin nkPragmaCallKinds or n.len != 2: @@ -588,7 +658,7 @@ proc pragmaEmit(c: PContext, n: PNode) = if n1.kind == nkBracket: var b = newNodeI(nkBracket, n1.info, n1.len) for i in 0..<n1.len: - b[i] = c.semExpr(c, n1[i]) + b[i] = c.semExprWithType(c, n1[i], {efTypeAllowed}) n[1] = b else: n[1] = c.semConstExpr(c, n1) @@ -635,12 +705,17 @@ proc pragmaLine(c: PContext, n: PNode) = n.info = getInfoContext(c.config, -1) proc processPragma(c: PContext, n: PNode, i: int) = + ## Create and add a new custom pragma `{.pragma: name.}` node to the module's context. let it = n[i] - if it.kind notin nkPragmaCallKinds and it.safeLen == 2: invalidPragma(c, n) + if it.kind notin nkPragmaCallKinds and it.safeLen == 2: + invalidPragma(c, n) + return elif it.safeLen != 2 or it[0].kind != nkIdent or it[1].kind != nkIdent: invalidPragma(c, n) + return - var userPragma = newSym(skTemplate, it[1].ident, nextSymId(c.idgen), nil, it.info, c.config.options) + var userPragma = newSym(skTemplate, it[1].ident, c.idgen, c.module, it.info, c.config.options) + styleCheckDef(c, userPragma) userPragma.ast = newTreeI(nkPragma, n.info, n.sons[i+1..^1]) strTableAdd(c.userPragmas, userPragma) @@ -650,7 +725,7 @@ proc pragmaRaisesOrTags(c: PContext, n: PNode) = x.typ = makeTypeFromExpr(c, x) else: var t = skipTypes(c.semTypeNode(c, x, nil), skipPtrs) - if t.kind != tyObject and not t.isMetaType: + if t.kind notin {tyObject, tyOr}: localError(c.config, x.info, errGenerated, "invalid type for raises/tags list") x.typ = t @@ -674,23 +749,6 @@ proc pragmaLockStmt(c: PContext; it: PNode) = for i in 0..<n.len: n[i] = c.semExpr(c, n[i]) -proc pragmaLocks(c: PContext, it: PNode): TLockLevel = - if it.kind notin nkPragmaCallKinds or it.len != 2: - invalidPragma(c, it) - else: - case it[1].kind - of nkStrLit, nkRStrLit, nkTripleStrLit: - if it[1].strVal == "unknown": - result = UnknownLockLevel - else: - localError(c.config, it[1].info, "invalid string literal for locks pragma (only allowed string is \"unknown\")") - else: - let x = expectIntLit(c, it) - if x < 0 or x > MaxLockLevel: - localError(c.config, it[1].info, "integer must be within 0.." & $MaxLockLevel) - else: - result = TLockLevel(x) - proc typeBorrow(c: PContext; sym: PSym, n: PNode) = if n.kind in nkPragmaCallKinds and n.len == 2: let it = n[1] @@ -699,7 +757,7 @@ proc typeBorrow(c: PContext; sym: PSym, n: PNode) = incl(sym.typ.flags, tfBorrowDot) proc markCompilerProc(c: PContext; s: PSym) = - # minor hack ahead: FlowVar is the only generic .compilerProc type which + # minor hack ahead: FlowVar is the only generic .compilerproc type which # should not have an external name set: if s.kind != skType or s.name.s != "FlowVar": makeExternExport(c, s, "$1", s.info) @@ -717,19 +775,8 @@ proc deprecatedStmt(c: PContext; outerPragma: PNode) = return if pragma.kind != nkBracket: localError(c.config, pragma.info, "list of key:value pairs expected"); return - for n in pragma: - if n.kind in nkPragmaCallKinds and n.len == 2: - let dest = qualifiedLookUp(c, n[1], {checkUndeclared}) - if dest == nil or dest.kind in routineKinds: - localError(c.config, n.info, warnUser, "the .deprecated pragma is unreliable for routines") - let src = considerQuotedIdent(c, n[0]) - let alias = newSym(skAlias, src, nextSymId(c.idgen), dest, n[0].info, c.config.options) - incl(alias.flags, sfExported) - if sfCompilerProc in dest.flags: markCompilerProc(c, alias) - addInterfaceDecl(c, alias) - n[1] = newSymNode(dest) - else: - localError(c.config, n.info, "key:value pair expected") + message(c.config, pragma.info, warnDeprecated, + "deprecated statement is now a no-op, use regular deprecated pragma") proc pragmaGuard(c: PContext; it: PNode; kind: TSymKind): PSym = if it.kind notin nkPragmaCallKinds or it.len != 2: @@ -745,31 +792,39 @@ proc pragmaGuard(c: PContext; it: PNode; kind: TSymKind): PSym = # We return a dummy symbol; later passes over the type will repair it. # Generic instantiation needs to know about this too. But we're lazy # and perform the lookup on demand instead. - result = newSym(skUnknown, considerQuotedIdent(c, n), nextSymId(c.idgen), nil, n.info, + result = newSym(skUnknown, considerQuotedIdent(c, n), c.idgen, nil, n.info, c.config.options) else: result = qualifiedLookUp(c, n, {checkUndeclared}) -proc semCustomPragma(c: PContext, n: PNode): PNode = +proc semCustomPragma(c: PContext, n: PNode, sym: PSym): PNode = var callNode: PNode - if n.kind in {nkIdent, nkSym}: + case n.kind + of nkIdentKinds: # pragma -> pragma() callNode = newTree(nkCall, n) - elif n.kind == nkExprColonExpr: + of nkExprColonExpr: # pragma: arg -> pragma(arg) callNode = newTree(nkCall, n[0], n[1]) - elif n.kind in nkPragmaCallKinds: + of nkPragmaCallKinds - {nkExprColonExpr}: callNode = n else: invalidPragma(c, n) return n + trySuggestPragmas(c, callNode[0]) + let r = c.semOverloadedCall(c, callNode, n, {skTemplate}, {efNoUndeclared}) if r.isNil or sfCustomPragma notin r[0].sym.flags: invalidPragma(c, n) return n + # we have a valid custom pragma + if sym != nil and sym.kind in {skEnumField, skForVar, skModule}: + illegalCustomPragma(c, n, sym) + return n + result = r # Transform the nkCall node back to its original form if possible if n.kind == nkIdent and r.len == 1: @@ -779,11 +834,33 @@ proc semCustomPragma(c: PContext, n: PNode): PNode = # pragma(arg) -> pragma: arg result.transitionSonsKind(n.kind) +proc processEffectsOf(c: PContext, n: PNode; owner: PSym) = + proc processParam(c: PContext; n: PNode) = + let r = c.semExpr(c, n) + if r.kind == nkSym and r.sym.kind == skParam: + if r.sym.owner == owner: + incl r.sym.flags, sfEffectsDelayed + else: + localError(c.config, n.info, errGenerated, "parameter cannot be declared as .effectsOf") + else: + localError(c.config, n.info, errGenerated, "parameter name expected") + + if n.kind notin nkPragmaCallKinds or n.len != 2: + localError(c.config, n.info, errGenerated, "parameter name expected") + else: + let it = n[1] + if it.kind in {nkCurly, nkBracket}: + for x in items(it): processParam(c, x) + else: + processParam(c, it) + proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, validPragmas: TSpecialWords, comesFromPush, isStatement: bool): bool = + result = false var it = n[i] - var key = if it.kind in nkPragmaCallKinds and it.len > 1: it[0] else: it + let keyDeep = it.kind in nkPragmaCallKinds and it.len > 1 + var key = if keyDeep: it[0] else: it if key.kind == nkBracketExpr: processNote(c, it) return @@ -793,38 +870,39 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, elif not isStatement: localError(c.config, n.info, "'cast' pragma only allowed in a statement context") case whichPragma(key[1]) - of wRaises, wTags: pragmaRaisesOrTags(c, key[1]) + of wRaises, wTags, wForbids: pragmaRaisesOrTags(c, key[1]) else: discard return elif key.kind notin nkIdentKinds: - n[i] = semCustomPragma(c, it) + n[i] = semCustomPragma(c, it, sym) return let ident = considerQuotedIdent(c, key) var userPragma = strTableGet(c.userPragmas, ident) if userPragma != nil: - if {optStyleHint, optStyleError} * c.config.globalOptions != {}: - styleCheckUse(c.config, key.info, userPragma) + styleCheckUse(c, key.info, userPragma) # number of pragmas increase/decrease with user pragma expansion inc c.instCounter + defer: dec c.instCounter if c.instCounter > 100: globalError(c.config, it.info, "recursive dependency: " & userPragma.name.s) + if keyDeep: + localError(c.config, it.info, "user pragma cannot have arguments") + pragma(c, sym, userPragma.ast, validPragmas, isStatement) n.sons[i..i] = userPragma.ast.sons # expand user pragma with its content i.inc(userPragma.ast.len - 1) # inc by -1 is ok, user pragmas was empty - dec c.instCounter else: let k = whichKeyword(ident) if k in validPragmas: - if {optStyleHint, optStyleError} * c.config.globalOptions != {}: - checkPragmaUse(c.config, key.info, k, ident.s) + checkPragmaUse(c, key.info, k, ident.s, (if sym != nil: sym else: c.module)) case k of wExportc, wExportCpp: makeExternExport(c, sym, getOptionalStr(c, it, "$1"), it.info) if k == wExportCpp: if c.config.backend != backendCpp: - localError(c.config, it.info, "exportcpp requires `cpp` backend, got " & $c.config.backend) + localError(c.config, it.info, "exportcpp requires `cpp` backend, got: " & $c.config.backend) else: incl(sym.flags, sfMangleCpp) incl(sym.flags, sfUsed) # avoid wrong hints @@ -842,6 +920,12 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, of wDirty: if sym.kind == skTemplate: incl(sym.flags, sfDirty) else: invalidPragma(c, it) + of wRedefine: + if sym.kind == skTemplate: incl(sym.flags, sfTemplateRedefinition) + else: invalidPragma(c, it) + of wCallsite: + if sym.kind == skTemplate: incl(sym.flags, sfCallsite) + else: invalidPragma(c, it) of wImportCpp: processImportCpp(c, sym, getOptionalStr(c, it, "$1"), it.info) of wCppNonPod: @@ -895,10 +979,13 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, of wNoalias: noVal(c, it) incl(sym.flags, sfNoalias) + of wEffectsOf: + processEffectsOf(c, it, sym) of wThreadVar: noVal(c, it) incl(sym.flags, {sfThread, sfGlobal}) - of wDeadCodeElimUnused: discard # deprecated, dead code elim always on + of wDeadCodeElimUnused: + warningDeprecated(c.config, n.info, "'{.deadcodeelim: on.}' is deprecated, now a noop") # deprecated, dead code elim always on of wNoForward: pragmaNoForward(c, it) of wReorder: pragmaNoForward(c, it, flag = sfReorder) of wMagic: processMagic(c, it, sym) @@ -914,12 +1001,13 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, noVal(c, it) incl(sym.flags, sfGlobal) incl(sym.flags, sfPure) - of wMerge: - # only supported for backwards compat, doesn't do anything anymore - noVal(c, it) of wConstructor: - noVal(c, it) incl(sym.flags, sfConstructor) + if sfImportc notin sym.flags: + sym.constraint = newEmptyStrNode(c, it, getOptionalStr(c, it, "")) + sym.constraint.strVal = sym.constraint.strVal + sym.flags.incl {sfExportc, sfMangleCpp} + sym.typ.callConv = ccNoConvention of wHeader: var lib = getLib(c, libHeader, getStrLitNode(c, it)) addToLib(lib, sym) @@ -927,7 +1015,7 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, incl(sym.loc.flags, lfHeader) incl(sym.loc.flags, lfNoDecl) # implies nodecl, because otherwise header would not make sense - if sym.loc.r == nil: sym.loc.r = rope(sym.name.s) + if sym.loc.snippet == "": sym.loc.snippet = rope(sym.name.s) of wNoSideEffect: noVal(c, it) if sym != nil: @@ -941,7 +1029,7 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, # Disable the 'noreturn' annotation when in the "Quirky Exceptions" mode! if c.config.exc != excQuirky: incl(sym.flags, sfNoReturn) - if sym.typ[0] != nil: + if sym.typ.returnType != nil: localError(c.config, sym.ast[paramsPos][0].info, ".noreturn with return type not allowed") of wNoDestroy: @@ -960,12 +1048,12 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, of wNonReloadable: sym.flags.incl sfNonReloadable of wProcVar: + # old procvar annotation, no longer needed noVal(c, it) - incl(sym.flags, sfProcvar) of wExplain: sym.flags.incl sfExplain of wDeprecated: - if sym != nil and sym.kind in routineKinds + {skType, skVar, skLet}: + if sym != nil and sym.kind in routineKinds + {skType, skVar, skLet, skConst}: if it.kind in nkPragmaCallKinds: discard getStrLitNode(c, it) incl(sym.flags, sfDeprecated) elif sym != nil and sym.kind != skModule: @@ -1010,10 +1098,15 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, of wThread: noVal(c, it) incl(sym.flags, sfThread) - incl(sym.flags, sfProcvar) if sym.typ != nil: incl(sym.typ.flags, tfThread) if sym.typ.callConv == ccClosure: sym.typ.callConv = ccNimCall + of wSendable: + noVal(c, it) + if sym != nil and sym.typ != nil: + incl(sym.typ.flags, tfSendable) + else: + invalidPragma(c, it) of wGcSafe: noVal(c, it) if sym != nil: @@ -1047,22 +1140,30 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, let s = expectStrLit(c, it) recordPragma(c, it, "error", s) localError(c.config, it.info, errUser, s) - of wFatal: fatal(c.config, it.info, errUser, expectStrLit(c, it)) - of wDefine: processDefine(c, it) + of wFatal: fatal(c.config, it.info, expectStrLit(c, it)) + of wDefine: processDefine(c, it, sym) of wUndef: processUndef(c, it) - of wCompile: processCompile(c, it) + of wCompile: + let m = sym.getModule() + incl(m.flags, sfUsed) + processCompile(c, it) of wLink: processLink(c, it) of wPassl: + let m = sym.getModule() + incl(m.flags, sfUsed) let s = expectStrLit(c, it) extccomp.addLinkOption(c.config, s) recordPragma(c, it, "passl", s) of wPassc: + let m = sym.getModule() + incl(m.flags, sfUsed) let s = expectStrLit(c, it) extccomp.addCompileOption(c.config, s) recordPragma(c, it, "passc", s) of wLocalPassc: assert sym != nil and sym.kind == skModule let s = expectStrLit(c, it) + appendToModule(sym, n) extccomp.addLocalCompileOption(c.config, s, toFullPathConsiderDirty(c.config, sym.info.fileIndex)) recordPragma(c, it, "localpassl", s) of wPush: @@ -1138,13 +1239,17 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, invalidPragma(c, it) of wByRef: noVal(c, it) - if sym == nil or sym.typ == nil: + if sym != nil and sym.kind == skParam: + sym.options.incl optByRef + elif sym == nil or sym.typ == nil: processOption(c, it, c.config.options) else: incl(sym.typ.flags, tfByRef) of wByCopy: noVal(c, it) - if sym.kind != skType or sym.typ == nil: invalidPragma(c, it) + if sym.kind == skParam: + incl(sym.flags, sfByCopy) + elif sym.kind != skType or sym.typ == nil: invalidPragma(c, it) else: incl(sym.typ.flags, tfByCopy) of wPartial: noVal(c, it) @@ -1157,11 +1262,11 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, noVal(c, it) if sym == nil: invalidPragma(c, it) of wLine: pragmaLine(c, it) - of wRaises, wTags: pragmaRaisesOrTags(c, it) + of wRaises, wTags, wForbids: pragmaRaisesOrTags(c, it) of wLocks: if sym == nil: pragmaLockStmt(c, it) elif sym.typ == nil: invalidPragma(c, it) - else: sym.typ.lockLevel = pragmaLocks(c, it) + else: warningDeprecated(c.config, n.info, "'Lock levels' are deprecated, now a noop") of wBitsize: if sym == nil or sym.kind != skField: invalidPragma(c, it) @@ -1182,55 +1287,49 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, of wExportNims: if sym == nil: invalidPragma(c, it) else: magicsys.registerNimScriptSymbol(c.graph, sym) - of wInjectStmt: - if it.kind notin nkPragmaCallKinds or it.len != 2: - localError(c.config, it.info, "expression expected") - else: - it[1] = c.semExpr(c, it[1]) of wExperimental: if not isTopLevel(c): localError(c.config, n.info, "'experimental' pragma only valid as toplevel statement or in a 'push' environment") processExperimental(c, it) - of wThis: - if it.kind in nkPragmaCallKinds and it.len == 2: - c.selfName = considerQuotedIdent(c, it[1]) - message(c.config, n.info, warnDeprecated, "the '.this' pragma is deprecated") - elif it.kind == nkIdent or it.len == 1: - c.selfName = getIdent(c.cache, "self") - message(c.config, n.info, warnDeprecated, "the '.this' pragma is deprecated") - else: - localError(c.config, it.info, "'this' pragma is allowed to have zero or one arguments") + of wDoctype: + if not isTopLevel(c): + localError(c.config, n.info, "\"doctype\" pragma only valid as top-level statement") of wNoRewrite: noVal(c, it) of wBase: noVal(c, it) sym.flags.incl sfBase of wIntDefine: - sym.magic = mIntDefine + processDefineConst(c, n, sym, mIntDefine) of wStrDefine: - sym.magic = mStrDefine + processDefineConst(c, n, sym, mStrDefine) of wBoolDefine: - sym.magic = mBoolDefine + processDefineConst(c, n, sym, mBoolDefine) of wUsed: noVal(c, it) if sym == nil: invalidPragma(c, it) else: sym.flags.incl sfUsed - of wLiftLocals: discard + of wLiftLocals: + sym.flags.incl(sfForceLift) of wRequires, wInvariant, wAssume, wAssert: pragmaProposition(c, it) of wEnsures: pragmaEnsures(c, it) + of wEnforceNoRaises, wQuirky: + sym.flags.incl sfNeverRaises + of wSystemRaisesDefect: + sym.flags.incl sfSystemRaisesDefect + of wVirtual: + processVirtual(c, it, sym, sfVirtual) + of wMember: + processVirtual(c, it, sym, sfMember) + else: invalidPragma(c, it) elif comesFromPush and whichKeyword(ident) != wInvalid: discard "ignore the .push pragma; it doesn't apply" else: - if sym == nil or (sym.kind in {skVar, skLet, skParam, - skField, skProc, skFunc, skConverter, skMethod, skType}): - n[i] = semCustomPragma(c, it) - elif sym != nil: - illegalCustomPragma(c, it, sym) - else: - invalidPragma(c, it) + # semCustomPragma gives appropriate error for invalid pragmas + n[i] = semCustomPragma(c, it, sym) proc overwriteLineInfo(n: PNode; info: TLineInfo) = n.info = info @@ -1245,12 +1344,22 @@ proc mergePragmas(n, pragmas: PNode) = else: for p in pragmas: n[pragmasPos].add p +proc mergeValidPragmas(n, pragmas: PNode, validPragmas: TSpecialWords) = + if n[pragmasPos].kind == nkEmpty: + n[pragmasPos] = newNodeI(nkPragma, n.info) + for p in pragmas: + let prag = whichPragma(p) + if prag in validPragmas: + let copy = copyTree(p) + overwriteLineInfo copy, n.info + n[pragmasPos].add copy + proc implicitPragmas*(c: PContext, sym: PSym, info: TLineInfo, validPragmas: TSpecialWords) = if sym != nil and sym.kind != skModule: for it in c.optionStack: let o = it.otherPragmas - if not o.isNil and sfFromGeneric notin sym.flags: # see issue #12985 + if not o.isNil and sfFromGeneric notin sym.flags: # bug #23019 pushInfoContext(c.config, info) var i = 0 while i < o.len: @@ -1258,7 +1367,8 @@ proc implicitPragmas*(c: PContext, sym: PSym, info: TLineInfo, internalError(c.config, info, "implicitPragmas") inc i popInfoContext(c.config) - if sym.kind in routineKinds and sym.ast != nil: mergePragmas(sym.ast, o) + if sym.kind in routineKinds and sym.ast != nil: + mergeValidPragmas(sym.ast, o, validPragmas) if lfExportLib in sym.loc.flags and sfExportc notin sym.flags: localError(c.config, info, ".dynlib requires .exportc") @@ -1267,7 +1377,7 @@ proc implicitPragmas*(c: PContext, sym: PSym, info: TLineInfo, sfImportc in sym.flags and lib != nil: incl(sym.loc.flags, lfDynamicLib) addToLib(lib, sym) - if sym.loc.r == nil: sym.loc.r = rope(sym.name.s) + if sym.loc.snippet == "": sym.loc.snippet = rope(sym.name.s) proc hasPragma*(n: PNode, pragma: TSpecialWord): bool = if n == nil: return false diff --git a/compiler/prefixmatches.nim b/compiler/prefixmatches.nim index 71ae9a844..bfbe3d888 100644 --- a/compiler/prefixmatches.nim +++ b/compiler/prefixmatches.nim @@ -7,7 +7,7 @@ # distribution, for details about the copyright. # -from strutils import toLowerAscii +from std/strutils import toLowerAscii type PrefixMatch* {.pure.} = enum diff --git a/compiler/procfind.nim b/compiler/procfind.nim index 0bdb3dae6..c2cc6e71f 100644 --- a/compiler/procfind.nim +++ b/compiler/procfind.nim @@ -11,7 +11,9 @@ # 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 + +import std/strutils proc equalGenericParams(procA, procB: PNode): bool = if procA.len != procB.len: return false @@ -31,7 +33,7 @@ proc equalGenericParams(procA, procB: PNode): bool = proc searchForProcAux(c: PContext, scope: PScope, fn: PSym): PSym = const flags = {ExactGenericParams, ExactTypeDescValues, ExactConstraints, IgnoreCC} - var it: TIdentIter + var it: TIdentIter = default(TIdentIter) result = initIdentIter(it, scope.symbols, fn.name) while result != nil: if result.kind == fn.kind: #and sameType(result.typ, fn.typ, flags): @@ -52,7 +54,7 @@ proc searchForProcAux(c: PContext, scope: PScope, fn: PSym): PSym = proc searchForProc*(c: PContext, scope: PScope, fn: PSym): tuple[proto: PSym, comesFromShadowScope: bool] = var scope = scope - result.proto = searchForProcAux(c, scope, fn) + result = (searchForProcAux(c, scope, fn), false) while result.proto == nil and scope.isShadowScope: scope = scope.parent result.proto = searchForProcAux(c, scope, fn) @@ -74,7 +76,7 @@ when false: proc searchForBorrowProc*(c: PContext, startScope: PScope, fn: PSym): PSym = # Searches for the fn in the symbol table. If the parameter lists are suitable # for borrowing the sym in the symbol table is returned, else nil. - var it: TIdentIter + var it: TIdentIter = default(TIdentIter) for scope in walkScopes(startScope): result = initIdentIter(it, scope.symbols, fn.Name) while result != nil: diff --git a/compiler/pushpoppragmas.nim b/compiler/pushpoppragmas.nim new file mode 100644 index 000000000..773e7013b --- /dev/null +++ b/compiler/pushpoppragmas.nim @@ -0,0 +1,54 @@ +import pragmas, options, ast, trees, lineinfos, idents, wordrecg +import std/assertions + +import renderer + + +proc processNote(config: ConfigRef, n: PNode) = + template handleNote(enumVals, notes) = + let x = findStr(enumVals.a, enumVals.b, n[0][1].ident.s, errUnknown) + assert x != errUnknown + assert n[1].kind == nkIntLit + + nk = TNoteKind(x) + if n[1].intVal != 0: incl(notes, nk) + else: excl(notes, nk) + + var nk: TNoteKind + case whichKeyword(n[0][0].ident) + of wHint: handleNote(hintMin .. hintMax, config.notes) + of wWarning: handleNote(warnMin .. warnMax, config.notes) + of wWarningAsError: handleNote(warnMin .. warnMax, config.warningAsErrors) + of wHintAsError: handleNote(hintMin .. hintMax, config.warningAsErrors) + else: discard + +proc pushBackendOption(optionsStack: var seq[(TOptions, TNoteKinds)], options: TOptions, notes: TNoteKinds) = + optionsStack.add (options, notes) + +proc popBackendOption(config: ConfigRef, optionsStack: var seq[(TOptions, TNoteKinds)], options: var TOptions) = + let entry = optionsStack[^1] + options = entry[0] + config.notes = entry[1] + optionsStack.setLen(optionsStack.len-1) + +proc processPushBackendOption*(config: ConfigRef, optionsStack: var seq[(TOptions, TNoteKinds)], options: var TOptions, + n: PNode, start: int) = + pushBackendOption(optionsStack, options, config.notes) + for i in start..<n.len: + let it = n[i] + if it.kind in nkPragmaCallKinds and it.len == 2: + if it[0].kind == nkBracketExpr and + it[0].len == 2 and + it[0][1].kind == nkIdent and it[0][0].kind == nkIdent: + processNote(config, it) + elif it[1].kind == nkIntLit: + let sw = whichPragma(it[0]) + let opts = pragmaToOptions(sw) + if opts != {}: + if it[1].intVal != 0: + options.incl opts + else: + options.excl opts + +template processPopBackendOption*(config: ConfigRef, optionsStack: var seq[(TOptions, TNoteKinds)], options: var TOptions) = + popBackendOption(config, optionsStack, options) diff --git a/compiler/readme.md b/compiler/readme.md index ac47508dc..4a197991c 100644 --- a/compiler/readme.md +++ b/compiler/readme.md @@ -4,4 +4,4 @@ - Note that this code has been translated from a bootstrapping version written in Pascal. - So the code is **not** a poster child of good Nim code. -See [Internals of the Nim Compiler](https://nim-lang.org/docs/intern.html) for more information. +See [Internals of the Nim Compiler](https://nim-lang.github.io/Nim/intern.html) for more information. diff --git a/compiler/renderer.nim b/compiler/renderer.nim index c36eaaf11..cc07c0c2d 100644 --- a/compiler/renderer.nim +++ b/compiler/renderer.nim @@ -9,25 +9,34 @@ # This module implements the renderer of the standard Nim representation. -when defined(nimHasUsed): - # 'import renderer' is so useful for debugging - # that Nim shouldn't produce a warning for that: - {.used.} +# 'import renderer' is so useful for debugging +# that Nim shouldn't produce a warning for that: +{.used.} import - lexer, options, idents, strutils, ast, msgs, lineinfos + lexer, options, idents, ast, msgs, lineinfos, wordrecg + +import std/[strutils] + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions, formatfloat] type TRenderFlag* = enum renderNone, renderNoBody, renderNoComments, renderDocComments, renderNoPragmas, renderIds, renderNoProcDefs, renderSyms, renderRunnableExamples, - renderIr + renderIr, renderNonExportedFields, renderExpandUsing, renderNoPostfix + TRenderFlags* = set[TRenderFlag] TRenderTok* = object kind*: TokType length*: int16 sym*: PSym + Section = enum + GenericParams + ObjectDef + TRenderTokSeq* = seq[TRenderTok] TSrcGen* = object indent*: int @@ -42,7 +51,7 @@ type pendingWhitespace: int comStack*: seq[PNode] # comment stack flags*: TRenderFlags - inGenericParams: bool + inside: set[Section] # Keeps track of contexts we are in checkAnon: bool # we're in a context that can contain sfAnon inPragma: int when defined(nimpretty): @@ -51,6 +60,8 @@ type config*: ConfigRef mangler: seq[PSym] +proc renderTree*(n: PNode, renderFlags: TRenderFlags = {}): string + # We render the source code in a two phases: The first # determines how long the subtree will likely be, the second # phase appends to a buffer that will be the output. @@ -67,6 +78,18 @@ proc isKeyword*(i: PIdent): bool = if (i.id >= ord(tokKeywordLow) - ord(tkSymbol)) and (i.id <= ord(tokKeywordHigh) - ord(tkSymbol)): result = true + else: + result = false + +proc isExported(n: PNode): bool = + ## Checks if an ident is exported. + ## This is meant to be used with idents in nkIdentDefs. + case n.kind + of nkPostfix: + n[0].ident.s == "*" and n[1].kind == nkIdent + of nkPragmaExpr: + n[0].isExported() + else: false proc renderDefinitionName*(s: PSym, noQuotes = false): string = ## Returns the definition name of the symbol. @@ -80,9 +103,30 @@ proc renderDefinitionName*(s: PSym, noQuotes = false): string = else: result = '`' & x & '`' +template inside(g: var TSrcGen, section: Section, body: untyped) = + ## Runs `body` with `section` included in `g.inside`. + ## Removes it at the end of the body if `g` wasn't inside it + ## before the template. + let wasntInSection = section notin g.inside + g.inside.incl section + body + if wasntInSection: + g.inside.excl section + +template outside(g: var TSrcGen, section: Section, body: untyped) = + ## Temporarily removes `section` from `g.inside`. Adds it back + ## at the end of the body if `g` was inside it before the template + let wasInSection = section in g.inside + g.inside.excl section + body + if wasInSection: + g.inside.incl section + const IndentWidth = 2 longIndentWid = IndentWidth * 2 + MaxLineLen = 80 + LineCommentColumn = 30 when defined(nimpretty): proc minmaxLine(n: PNode): (int, int) = @@ -101,23 +145,13 @@ when defined(nimpretty): proc lineDiff(a, b: PNode): int = result = minmaxLine(b)[0] - minmaxLine(a)[1] -const - MaxLineLen = 80 - LineCommentColumn = 30 - -proc initSrcGen(g: var TSrcGen, renderFlags: TRenderFlags; config: ConfigRef) = - g.comStack = @[] - g.tokens = @[] - g.indent = 0 - g.lineLen = 0 - g.pos = 0 - g.idx = 0 - g.buf = "" - g.flags = renderFlags - g.pendingNL = -1 - g.pendingWhitespace = -1 - g.inGenericParams = false - g.config = config +proc initSrcGen(renderFlags: TRenderFlags; config: ConfigRef): TSrcGen = + result = TSrcGen(comStack: @[], tokens: @[], indent: 0, + lineLen: 0, pos: 0, idx: 0, buf: "", + flags: renderFlags, pendingNL: -1, + pendingWhitespace: -1, inside: {}, + config: config + ) proc addTok(g: var TSrcGen, kind: TokType, s: string; sym: PSym = nil) = g.tokens.add TRenderTok(kind: kind, length: int16(s.len), sym: sym) @@ -160,6 +194,7 @@ proc putNL(g: var TSrcGen) = proc optNL(g: var TSrcGen, indent: int) = g.pendingNL = indent g.lineLen = indent + g.col = g.indent when defined(nimpretty): g.pendingNewlineCount = 0 proc optNL(g: var TSrcGen) = @@ -168,6 +203,7 @@ proc optNL(g: var TSrcGen) = proc optNL(g: var TSrcGen; a, b: PNode) = g.pendingNL = g.indent g.lineLen = g.indent + g.col = g.indent when defined(nimpretty): g.pendingNewlineCount = lineDiff(a, b) proc indentNL(g: var TSrcGen) = @@ -185,7 +221,7 @@ proc dedent(g: var TSrcGen) = proc put(g: var TSrcGen, kind: TokType, s: string; sym: PSym = nil) = if kind != tkSpaces: addPendingNL(g) - if s.len > 0: + if s.len > 0 or kind in {tkHideableStart, tkHideableEnd}: addTok(g, kind, s, sym) else: g.pendingWhitespace = s.len @@ -234,6 +270,7 @@ proc putComment(g: var TSrcGen, s: string) = optNL(g) proc maxLineLength(s: string): int = + result = 0 if s.len == 0: return 0 var i = 0 let hi = s.len - 1 @@ -329,8 +366,9 @@ proc litAux(g: TSrcGen; n: PNode, x: BiggestInt, size: int): string = result = t while result != nil and result.kind in {tyGenericInst, tyRange, tyVar, tyLent, tyDistinct, tyOrdinal, tyAlias, tySink}: - result = lastSon(result) + result = skipModifier(result) + result = "" let typ = n.typ.skip if typ != nil and typ.kind in {tyBool, tyEnum}: if sfPure in typ.sym.flags: @@ -372,6 +410,7 @@ proc atom(g: TSrcGen; n: PNode): string = of nkEmpty: result = "" of nkIdent: result = n.ident.s of nkSym: result = n.sym.name.s + of nkClosedSymChoice, nkOpenSymChoice: result = n[0].sym.name.s of nkStrLit: result = ""; result.addQuoted(n.strVal) of nkRStrLit: result = "r\"" & replace(n.strVal, "\"", "\"\"") & '\"' of nkTripleStrLit: result = "\"\"\"" & n.strVal & "\"\"\"" @@ -391,24 +430,29 @@ proc atom(g: TSrcGen; n: PNode): string = of nkUInt64Lit: result = ulitAux(g, n, n.intVal, 8) & "\'u64" of nkFloatLit: if n.flags * {nfBase2, nfBase8, nfBase16} == {}: result = $(n.floatVal) - else: result = litAux(g, n, (cast[PInt64](addr(n.floatVal)))[] , 8) + else: result = litAux(g, n, (cast[ptr int64](addr(n.floatVal)))[] , 8) of nkFloat32Lit: if n.flags * {nfBase2, nfBase8, nfBase16} == {}: result = $n.floatVal & "\'f32" else: f = n.floatVal.float32 - result = litAux(g, n, (cast[PInt32](addr(f)))[], 4) & "\'f32" + result = litAux(g, n, (cast[ptr int32](addr(f)))[], 4) & "\'f32" of nkFloat64Lit: if n.flags * {nfBase2, nfBase8, nfBase16} == {}: result = $n.floatVal & "\'f64" else: - result = litAux(g, n, (cast[PInt64](addr(n.floatVal)))[], 8) & "\'f64" + result = litAux(g, n, (cast[ptr int64](addr(n.floatVal)))[], 8) & "\'f64" + of nkFloat128Lit: + if n.flags * {nfBase2, nfBase8, nfBase16} == {}: + result = $n.floatVal & "\'f128" + else: + result = litAux(g, n, (cast[ptr int64](addr(n.floatVal)))[], 8) & "\'f128" of nkNilLit: result = "nil" of nkType: if (n.typ != nil) and (n.typ.sym != nil): result = n.typ.sym.name.s else: result = "[type node]" else: - internalError(g.config, "rnimsyn.atom " & $n.kind) + internalError(g.config, "renderer.atom " & $n.kind) result = "" proc lcomma(g: TSrcGen; n: PNode, start: int = 0, theEnd: int = - 1): int = @@ -427,8 +471,27 @@ proc lsons(g: TSrcGen; n: PNode, start: int = 0, theEnd: int = - 1): int = result = 0 for i in start..n.len + theEnd: inc(result, lsub(g, n[i])) +proc origUsingType(n: PNode): PSym {.inline.} = + ## Returns the type that a parameter references. Check with referencesUsing first + ## to check `n` is actually referencing a using node + # If the node is untyped the typ field will be nil + if n[0].sym.typ != nil: + n[0].sym.typ.sym + else: nil + +proc referencesUsing(n: PNode): bool = + ## Returns true if n references a using statement. + ## e.g. proc foo(x) # x doesn't have type or def value so it references a using + result = n.kind == nkIdentDefs and + # Sometimes the node might not have been semmed (e.g. doc0) and will be nkIdent instead + n[0].kind == nkSym and + # Templates/macros can have parameters with no type (But their orig type will be nil) + n.origUsingType != nil and + n[1].kind == nkEmpty and n[2].kind == nkEmpty + proc lsub(g: TSrcGen; n: PNode): int = # computes the length of a tree + result = 0 if isNil(n): return 0 if shouldRenderComment(g, n): return MaxLineLen + 1 case n.kind @@ -456,6 +519,7 @@ proc lsub(g: TSrcGen; n: PNode): int = result = if n.len > 0: lcomma(g, n) + 2 else: len("{:}") of nkClosedSymChoice, nkOpenSymChoice: if n.len > 0: result += lsub(g, n[0]) + of nkOpenSym: result = lsub(g, n[0]) of nkTupleTy: result = lcomma(g, n) + len("tuple[]") of nkTupleClassTy: result = len("tuple") of nkDotExpr: result = lsons(g, n) + 1 @@ -467,8 +531,11 @@ proc lsub(g: TSrcGen; n: PNode): int = of nkDo: result = lsons(g, n) + len("do__:_") of nkConstDef, nkIdentDefs: result = lcomma(g, n, 0, - 3) - if n[^2].kind != nkEmpty: result += lsub(g, n[^2]) + 2 - if n[^1].kind != nkEmpty: result += lsub(g, n[^1]) + 3 + if n.referencesUsing: + result += lsub(g, newSymNode(n.origUsingType)) + 2 + else: + if n[^2].kind != nkEmpty: result += lsub(g, n[^2]) + 2 + if n[^1].kind != nkEmpty: result += lsub(g, n[^1]) + 3 of nkVarTuple: if n[^1].kind == nkEmpty: result = lcomma(g, n, 0, - 2) + len("()") @@ -485,7 +552,11 @@ proc lsub(g: TSrcGen; n: PNode): int = of nkInfix: result = lsons(g, n) + 2 of nkPrefix: result = lsons(g, n)+1+(if n.len > 0 and n[1].kind == nkInfix: 2 else: 0) - of nkPostfix: result = lsons(g, n) + of nkPostfix: + if renderNoPostfix notin g.flags: + result = lsons(g, n) + else: + result = lsub(g, n[1]) of nkCallStrLit: result = lsons(g, n) of nkPragmaExpr: result = lsub(g, n[0]) + lcomma(g, n, 1) of nkRange: result = lsons(g, n) + 2 @@ -499,7 +570,7 @@ proc lsub(g: TSrcGen; n: PNode): int = of nkTypeOfExpr: result = (if n.len > 0: lsub(g, n[0]) else: 0)+len("typeof()") of nkRefTy: result = (if n.len > 0: lsub(g, n[0])+1 else: 0) + len("ref") of nkPtrTy: result = (if n.len > 0: lsub(g, n[0])+1 else: 0) + len("ptr") - of nkVarTy: result = (if n.len > 0: lsub(g, n[0])+1 else: 0) + len("var") + of nkVarTy, nkOutTy: result = (if n.len > 0: lsub(g, n[0])+1 else: 0) + len("var") of nkDistinctTy: result = len("distinct") + (if n.len > 0: lsub(g, n[0])+1 else: 0) if n.len > 1: @@ -511,7 +582,7 @@ proc lsub(g: TSrcGen; n: PNode): int = of nkOfInherit: result = lsub(g, n[0]) + len("of_") of nkProcTy: result = lsons(g, n) + len("proc_") of nkIteratorTy: result = lsons(g, n) + len("iterator_") - of nkSharedTy: result = lsons(g, n) + len("shared_") + of nkSinkAsgn: result = lsons(g, n) + len("`=sink`(, )") of nkEnumTy: if n.len > 0: result = lsub(g, n[0]) + lcomma(g, n, 1) + len("enum_") @@ -525,7 +596,7 @@ proc lsub(g: TSrcGen; n: PNode): int = if n.len > 1: result = MaxLineLen + 1 else: result = lsons(g, n) + len("using_") of nkReturnStmt: - if n.len > 0 and n[0].kind == nkAsgn: + if n.len > 0 and n[0].kind == nkAsgn and renderIr notin g.flags: result = len("return_") + lsub(g, n[0][1]) else: result = len("return_") + lsub(g, n[0]) @@ -563,15 +634,13 @@ type const emptyContext: TContext = (spacing: 0, flags: {}) -proc initContext(c: var TContext) = - c.spacing = 0 - c.flags = {} +proc initContext(): TContext = + result = (spacing: 0, flags: {}) -proc gsub(g: var TSrcGen, n: PNode, c: TContext) -proc gsub(g: var TSrcGen, n: PNode) = - var c: TContext - initContext(c) - gsub(g, n, c) +proc gsub(g: var TSrcGen, n: PNode, c: TContext, fromStmtList = false) +proc gsub(g: var TSrcGen, n: PNode, fromStmtList = false) = + var c: TContext = initContext() + gsub(g, n, c, fromStmtList = fromStmtList) proc hasCom(n: PNode): bool = result = false @@ -587,13 +656,32 @@ proc putWithSpace(g: var TSrcGen, kind: TokType, s: string) = put(g, kind, s) put(g, tkSpaces, Space) +proc isHideable(config: ConfigRef, n: PNode): bool = + # xxx compare `ident` directly with `getIdent(cache, wRaises)`, but + # this requires a `cache`. + case n.kind + of nkExprColonExpr: + result = n[0].kind == nkIdent and + n[0].ident.s.nimIdentNormalize in ["raises", "tags", "extern", "deprecated", "forbids", "stacktrace"] + of nkIdent: result = n.ident.s in ["gcsafe", "deprecated"] + else: result = false + proc gcommaAux(g: var TSrcGen, n: PNode, ind: int, start: int = 0, theEnd: int = - 1, separator = tkComma) = + let inPragma = g.inPragma == 1 # just the top-level + var inHideable = false for i in start..n.len + theEnd: - var c = i < n.len + theEnd - var sublen = lsub(g, n[i]) + ord(c) + let c = i < n.len + theEnd + let sublen = lsub(g, n[i]) + ord(c) if not fits(g, g.lineLen + sublen) and (ind + sublen < MaxLineLen): optNL(g, ind) let oldLen = g.tokens.len + if inPragma: + if not inHideable and isHideable(g.config, n[i]): + inHideable = true + put(g, tkHideableStart, "") + elif inHideable and not isHideable(g.config, n[i]): + inHideable = false + put(g, tkHideableEnd, "") gsub(g, n[i]) if c: if g.tokens.len > oldLen: @@ -601,9 +689,12 @@ proc gcommaAux(g: var TSrcGen, n: PNode, ind: int, start: int = 0, if shouldRenderComment(g) and hasCom(n[i]): gcoms(g) optNL(g, ind) + if inHideable: + put(g, tkHideableEnd, "") + inHideable = false proc gcomma(g: var TSrcGen, n: PNode, c: TContext, start: int = 0, - theEnd: int = - 1) = + theEnd: int = -1) = var ind: int if rfInConstExpr in c.flags: ind = g.indent + IndentWidth @@ -659,7 +750,7 @@ proc gstmts(g: var TSrcGen, n: PNode, c: TContext, doIndent=true) = if n[i].kind in {nkStmtList, nkStmtListExpr, nkStmtListType}: gstmts(g, n[i], c, doIndent=false) else: - gsub(g, n[i]) + gsub(g, n[i], fromStmtList = true) gcoms(g) if doIndent: dedent(g) else: @@ -678,9 +769,8 @@ proc gcond(g: var TSrcGen, n: PNode) = put(g, tkParRi, ")") proc gif(g: var TSrcGen, n: PNode) = - var c: TContext + var c: TContext = initContext() gcond(g, n[0][0]) - initContext(c) putWithSpace(g, tkColon, ":") if longMode(g, n) or (lsub(g, n[0][1]) + g.lineLen > MaxLineLen): incl(c.flags, rfLongMode) @@ -691,20 +781,18 @@ proc gif(g: var TSrcGen, n: PNode) = gsub(g, n[i], c) proc gwhile(g: var TSrcGen, n: PNode) = - var c: TContext + var c: TContext = initContext() putWithSpace(g, tkWhile, "while") gcond(g, n[0]) putWithSpace(g, tkColon, ":") - initContext(c) if longMode(g, n) or (lsub(g, n[1]) + g.lineLen > MaxLineLen): incl(c.flags, rfLongMode) gcoms(g) # a good place for comments gstmts(g, n[1], c) proc gpattern(g: var TSrcGen, n: PNode) = - var c: TContext + var c: TContext = initContext() put(g, tkCurlyLe, "{") - initContext(c) if longMode(g, n) or (lsub(g, n[0]) + g.lineLen > MaxLineLen): incl(c.flags, rfLongMode) gcoms(g) # a good place for comments @@ -712,20 +800,18 @@ proc gpattern(g: var TSrcGen, n: PNode) = put(g, tkCurlyRi, "}") proc gpragmaBlock(g: var TSrcGen, n: PNode) = - var c: TContext + var c: TContext = initContext() gsub(g, n[0]) putWithSpace(g, tkColon, ":") - initContext(c) if longMode(g, n) or (lsub(g, n[1]) + g.lineLen > MaxLineLen): incl(c.flags, rfLongMode) gcoms(g) # a good place for comments gstmts(g, n[1], c) proc gtry(g: var TSrcGen, n: PNode) = - var c: TContext + var c: TContext = initContext() put(g, tkTry, "try") putWithSpace(g, tkColon, ":") - initContext(c) if longMode(g, n) or (lsub(g, n[0]) + g.lineLen > MaxLineLen): incl(c.flags, rfLongMode) gcoms(g) # a good place for comments @@ -733,9 +819,8 @@ proc gtry(g: var TSrcGen, n: PNode) = gsons(g, n, c, 1) proc gfor(g: var TSrcGen, n: PNode) = - var c: TContext + var c: TContext = initContext() putWithSpace(g, tkFor, "for") - initContext(c) if longMode(g, n) or (lsub(g, n[^1]) + lsub(g, n[^2]) + 6 + g.lineLen > MaxLineLen): incl(c.flags, rfLongMode) @@ -748,8 +833,7 @@ proc gfor(g: var TSrcGen, n: PNode) = gstmts(g, n[^1], c) proc gcase(g: var TSrcGen, n: PNode) = - var c: TContext - initContext(c) + var c: TContext = initContext() if n.len == 0: return var last = if n[^1].kind == nkElse: -2 else: -1 if longMode(g, n, 0, last): incl(c.flags, rfLongMode) @@ -759,17 +843,17 @@ proc gcase(g: var TSrcGen, n: PNode) = optNL(g) gsons(g, n, c, 1, last) if last == - 2: - initContext(c) + c = initContext() if longMode(g, n[^1]): incl(c.flags, rfLongMode) gsub(g, n[^1], c) proc genSymSuffix(result: var string, s: PSym) {.inline.} = - if sfGenSym in s.flags: + if sfGenSym in s.flags and s.name.id != ord(wUnderscore): result.add '_' result.addInt s.id proc gproc(g: var TSrcGen, n: PNode) = - var c: TContext + var c: TContext = initContext() if n[namePos].kind == nkSym: let s = n[namePos].sym var ret = renderDefinitionName(s) @@ -780,25 +864,23 @@ proc gproc(g: var TSrcGen, n: PNode) = if n[patternPos].kind != nkEmpty: gpattern(g, n[patternPos]) - let oldInGenericParams = g.inGenericParams - g.inGenericParams = true - if renderNoBody in g.flags and n[miscPos].kind != nkEmpty and - n[miscPos][1].kind != nkEmpty: - gsub(g, n[miscPos][1]) - else: - gsub(g, n[genericParamsPos]) - g.inGenericParams = oldInGenericParams + g.inside(GenericParams): + if renderNoBody in g.flags and n[miscPos].kind != nkEmpty and + n[miscPos][1].kind != nkEmpty: + gsub(g, n[miscPos][1]) + else: + gsub(g, n[genericParamsPos]) gsub(g, n[paramsPos]) if renderNoPragmas notin g.flags: gsub(g, n[pragmasPos]) if renderNoBody notin g.flags: - if n[bodyPos].kind != nkEmpty: + if n.len > bodyPos and n[bodyPos].kind != nkEmpty: put(g, tkSpaces, Space) putWithSpace(g, tkEquals, "=") indentNL(g) gcoms(g) dedent(g) - initContext(c) + c = initContext() gstmts(g, n[bodyPos], c) putNL(g) else: @@ -807,8 +889,7 @@ proc gproc(g: var TSrcGen, n: PNode) = dedent(g) proc gTypeClassTy(g: var TSrcGen, n: PNode) = - var c: TContext - initContext(c) + var c: TContext = initContext() putWithSpace(g, tkConcept, "concept") gsons(g, n[0], c) # arglist gsub(g, n[1]) # pragmas @@ -827,8 +908,7 @@ proc gblock(g: var TSrcGen, n: PNode) = if n.len == 0: return - var c: TContext - initContext(c) + var c: TContext = initContext() if n[0].kind != nkEmpty: putWithSpace(g, tkBlock, "block") @@ -848,10 +928,9 @@ proc gblock(g: var TSrcGen, n: PNode) = gstmts(g, n[1], c) proc gstaticStmt(g: var TSrcGen, n: PNode) = - var c: TContext + var c: TContext = initContext() putWithSpace(g, tkStatic, "static") putWithSpace(g, tkColon, ":") - initContext(c) if longMode(g, n) or (lsub(g, n[0]) + g.lineLen > MaxLineLen): incl(c.flags, rfLongMode) gcoms(g) # a good place for comments @@ -865,7 +944,7 @@ proc gasm(g: var TSrcGen, n: PNode) = gsub(g, n[1]) proc gident(g: var TSrcGen, n: PNode) = - if g.inGenericParams and n.kind == nkSym: + if GenericParams in g.inside and n.kind == nkSym: if sfAnon in n.sym.flags or (n.typ != nil and tfImplicitTypeParam in n.typ.flags): return @@ -889,7 +968,9 @@ proc gident(g: var TSrcGen, n: PNode) = s.addInt localId if sfCursor in n.sym.flags: s.add "_cursor" - elif n.kind == nkSym and (renderIds in g.flags or sfGenSym in n.sym.flags or n.sym.kind == skTemp): + elif n.kind == nkSym and (renderIds in g.flags or + (sfGenSym in n.sym.flags and n.sym.name.id != ord(wUnderscore)) or + n.sym.kind == skTemp): s.add '_' s.addInt n.sym.id when defined(debugMagics): @@ -904,6 +985,7 @@ proc doParamsAux(g: var TSrcGen, params: PNode) = put(g, tkParRi, ")") if params.len > 0 and params[0].kind != nkEmpty: + put(g, tkSpaces, Space) putWithSpace(g, tkOpr, "->") gsub(g, params[0]) @@ -922,6 +1004,7 @@ proc bracketKind*(g: TSrcGen, n: PNode): BracketKind = case n.kind of nkClosedSymChoice, nkOpenSymChoice: if n.len > 0: result = bracketKind(g, n[0]) + else: result = bkNone of nkSym: result = case n.sym.name.s of "[]": bkBracket @@ -930,11 +1013,13 @@ proc bracketKind*(g: TSrcGen, n: PNode): BracketKind = of "{}=": bkCurlyAsgn else: bkNone else: result = bkNone + else: + result = bkNone proc skipHiddenNodes(n: PNode): PNode = result = n while result != nil: - if result.kind in {nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv} and result.len > 1: + if result.kind in {nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv, nkOpenSym} and result.len > 1: result = result[1] elif result.kind in {nkCheckedFieldExpr, nkHiddenAddr, nkHiddenDeref, nkStringToCString, nkCStringToString} and result.len > 0: @@ -942,14 +1027,12 @@ proc skipHiddenNodes(n: PNode): PNode = else: break proc accentedName(g: var TSrcGen, n: PNode) = - const backticksNeeded = OpChars + {'[', '{'} + # This is for cases where ident should've really been a `nkAccQuoted`, e.g. `:tmp` + # or if user writes a macro with `ident":foo"`. It's unclear whether these should be legal. + const backticksNeeded = OpChars + {'[', '{', '\''} if n == nil: return - let isOperator = - if n.kind == nkIdent and n.ident.s.len > 0 and n.ident.s[0] in backticksNeeded: true - elif n.kind == nkSym and n.sym.name.s.len > 0 and n.sym.name.s[0] in backticksNeeded: true - else: false - - if isOperator: + let ident = n.getPIdent + if ident != nil and ident.s[0] in backticksNeeded: put(g, tkAccent, "`") gident(g, n) put(g, tkAccent, "`") @@ -957,7 +1040,7 @@ proc accentedName(g: var TSrcGen, n: PNode) = gsub(g, n) proc infixArgument(g: var TSrcGen, n: PNode, i: int) = - if i < 1 and i > 2: return + if i < 1 or i > 2: return var needsParenthesis = false let nNext = n[i].skipHiddenNodes if nNext.kind == nkInfix: @@ -976,10 +1059,41 @@ proc infixArgument(g: var TSrcGen, n: PNode, i: int) = if needsParenthesis: put(g, tkParRi, ")") -proc gsub(g: var TSrcGen, n: PNode, c: TContext) = +const postExprBlocks = {nkStmtList, nkStmtListExpr, + nkOfBranch, nkElifBranch, nkElse, + nkExceptBranch, nkFinally, nkDo} + +proc postStatements(g: var TSrcGen, n: PNode, i: int, fromStmtList: bool) = + var i = i + if n[i].kind in {nkStmtList, nkStmtListExpr}: + if fromStmtList: + put(g, tkColon, ":") + else: + put(g, tkSpaces, Space) + put(g, tkDo, "do") + put(g, tkColon, ":") + gsub(g, n, i) + i.inc + for j in i ..< n.len: + if n[j].kind == nkDo: + optNL(g) + elif n[j].kind in {nkStmtList, nkStmtListExpr}: + optNL(g) + put(g, tkDo, "do") + put(g, tkColon, ":") + gsub(g, n, j) + +proc isCustomLit(n: PNode): bool = + if n.len == 2 and n[0].kind == nkRStrLit: + let ident = n[1].getPIdent + result = ident != nil and ident.s.startsWith('\'') + else: + result = false + +proc gsub(g: var TSrcGen, n: PNode, c: TContext, fromStmtList = false) = if isNil(n): return var - a: TContext + a: TContext = default(TContext) if shouldRenderComment(g, n): pushCom(g, n) case n.kind # atoms: of nkTripleStrLit: put(g, tkTripleStrLit, atom(g, n)) @@ -1005,21 +1119,15 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = of nkCharLit: put(g, tkCharLit, atom(g, n)) of nkNilLit: put(g, tkNil, atom(g, n)) # complex expressions of nkCall, nkConv, nkDotCall, nkPattern, nkObjConstr: - if n.len > 1 and n.lastSon.kind in {nkStmtList, nkStmtListExpr}: + if n.len > 1 and n.lastSon.kind in postExprBlocks: accentedName(g, n[0]) var i = 1 - while i < n.len and n[i].kind notin {nkStmtList, nkStmtListExpr}: i.inc + while i < n.len and n[i].kind notin postExprBlocks: i.inc if i > 1: put(g, tkParLe, "(") gcomma(g, n, 1, i - 1 - n.len) put(g, tkParRi, ")") - put(g, tkColon, ":") - gsub(g, n, i) - for j in i+1 ..< n.len: - optNL(g) - put(g, tkDo, "do") - put(g, tkColon, ":") - gsub(g, n, j) + postStatements(g, n, i, fromStmtList) elif n.len >= 1: case bracketKind(g, n[0]) of bkBracket: @@ -1119,14 +1227,12 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = of nkCommand: accentedName(g, n[0]) put(g, tkSpaces, Space) - if n[^1].kind == nkStmtList: - for i, child in n: - if i > 1 and i < n.len - 1: - put(g, tkComma, ",") - elif i == n.len - 1: - put(g, tkColon, ":") - if i > 0: - gsub(g, child) + if n.len > 1 and n.lastSon.kind in postExprBlocks: + var i = 1 + while i < n.len and n[i].kind notin postExprBlocks: i.inc + if i > 1: + gcomma(g, n, 1, i - 1 - n.len) + postStatements(g, n, i, fromStmtList) else: gcomma(g, n, 1) of nkExprEqExpr, nkAsgn, nkFastAsgn: @@ -1134,6 +1240,11 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkSpaces, Space) putWithSpace(g, tkEquals, "=") gsub(g, n, 1) + of nkSinkAsgn: + put(g, tkSymbol, "`=sink`") + put(g, tkParLe, "(") + gcomma(g, n) + put(g, tkParRi, ")") of nkChckRangeF: put(g, tkSymbol, "chckRangeF") put(g, tkParLe, "(") @@ -1170,6 +1281,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkParRi, if n.kind == nkOpenSymChoice: "|...)" else: ")") else: gsub(g, n, 0) + of nkOpenSym: gsub(g, n, 0) of nkPar, nkClosure: put(g, tkParLe, "(") gcomma(g, n, c) @@ -1177,7 +1289,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = of nkTupleConstr: put(g, tkParLe, "(") gcomma(g, n, c) - if n.len == 1: put(g, tkComma, ",") + if n.len == 1 and n[0].kind != nkExprColonExpr: put(g, tkComma, ",") put(g, tkParRi, ")") of nkCurly: put(g, tkCurlyLe, "{") @@ -1195,14 +1307,25 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gcomma(g, n, c) put(g, tkBracketRi, "]") of nkDotExpr: - gsub(g, n, 0) - put(g, tkDot, ".") - gsub(g, n, 1) + if isCustomLit(n): + put(g, tkCustomLit, n[0].strVal) + gsub(g, n, 1) + else: + gsub(g, n, 0) + put(g, tkDot, ".") + assert n.len == 2, $n.len + accentedName(g, n[1]) of nkBind: putWithSpace(g, tkBind, "bind") gsub(g, n, 0) of nkCheckedFieldExpr, nkHiddenAddr, nkHiddenDeref, nkStringToCString, nkCStringToString: + if renderIds in g.flags: + put(g, tkAddr, $n.kind) + put(g, tkParLe, "(") gsub(g, n, 0) + if renderIds in g.flags: + put(g, tkParRi, ")") + of nkLambda: putWithSpace(g, tkProc, "proc") gsub(g, n, paramsPos) @@ -1217,11 +1340,38 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gsub(g, n, pragmasPos) put(g, tkColon, ":") gsub(g, n, bodyPos) - of nkConstDef, nkIdentDefs: + of nkIdentDefs: + var exclFlags: TRenderFlags = {} + if ObjectDef in g.inside: + if not n[0].isExported() and renderNonExportedFields notin g.flags: + # Skip if this is a property in a type and its not exported + # (While also not allowing rendering of non exported fields) + return + # render postfix for object fields: + exclFlags = g.flags * {renderNoPostfix} + # We render the identDef without being inside the section incase we render something like + # y: proc (x: string) # (We wouldn't want to check if x is exported) + g.outside(ObjectDef): + g.flags.excl(exclFlags) + gcomma(g, n, 0, -3) + g.flags.incl(exclFlags) + if n.len >= 2 and n[^2].kind != nkEmpty: + putWithSpace(g, tkColon, ":") + gsub(g, n[^2], c) + elif n.referencesUsing and renderExpandUsing in g.flags: + putWithSpace(g, tkColon, ":") + gsub(g, newSymNode(n.origUsingType), c) + + if n.len >= 1 and n[^1].kind != nkEmpty: + put(g, tkSpaces, Space) + putWithSpace(g, tkEquals, "=") + gsub(g, n[^1], c) + of nkConstDef: gcomma(g, n, 0, -3) if n.len >= 2 and n[^2].kind != nkEmpty: putWithSpace(g, tkColon, ":") - gsub(g, n, n.len - 2) + gsub(g, n[^2], c) + if n.len >= 1 and n[^1].kind != nkEmpty: put(g, tkSpaces, Space) putWithSpace(g, tkEquals, "=") @@ -1243,6 +1393,10 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = putWithSpace(g, tkColon, ":") gsub(g, n, 1) of nkInfix: + if n.len < 3: + var i = 0 + put(g, tkOpr, "Too few children for nkInfix") + return let oldLineLen = g.lineLen # we cache this because lineLen gets updated below infixArgument(g, n, 1) put(g, tkSpaces, Space) @@ -1253,11 +1407,12 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = else: put(g, tkSpaces, Space) infixArgument(g, n, 2) + if n.len > 3 and n.lastSon.kind in postExprBlocks: + var i = 3 + while i < n.len and n[i].kind notin postExprBlocks: i.inc + postStatements(g, n, i, fromStmtList) of nkPrefix: - if n.len > 0 and n[0].kind == nkIdent and n[0].ident.s == "<//>": - discard "XXX Remove this hack after 0.20 has been released!" - else: - gsub(g, n, 0) + gsub(g, n, 0) if n.len > 1: let opr = if n[0].kind == nkIdent: n[0].ident elif n[0].kind == nkSym: n[0].sym.name @@ -1272,9 +1427,14 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkParRi, ")") else: gsub(g, n[1]) + if n.len > 2 and n.lastSon.kind in postExprBlocks: + var i = 2 + while i < n.len and n[i].kind notin postExprBlocks: i.inc + postStatements(g, n, i, fromStmtList) of nkPostfix: gsub(g, n, 1) - gsub(g, n, 0) + if renderNoPostfix notin g.flags: + gsub(g, n, 0) of nkRange: gsub(g, n, 0) put(g, tkDotDot, "..") @@ -1284,9 +1444,22 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkOpr, "[]") of nkAccQuoted: put(g, tkAccent, "`") - if n.len > 0: gsub(g, n[0]) - for i in 1..<n.len: - put(g, tkSpaces, Space) + for i in 0..<n.len: + proc isAlpha(n: PNode): bool = + if n.kind in {nkIdent, nkSym}: + let tmp = n.getPIdent.s + result = tmp.len > 0 and tmp[0] in {'a'..'z', 'A'..'Z'} + else: + result = false + var useSpace = false + if i == 1 and n[0].kind == nkIdent and n[0].ident.s in ["=", "'"]: + if not n[1].isAlpha: # handle `=destroy`, `'big' + useSpace = true + elif i == 1 and n[1].kind == nkIdent and n[1].ident.s == "=": + if not n[0].isAlpha: # handle setters, e.g. `foo=` + useSpace = true + elif i > 0: useSpace = true + if useSpace: put(g, tkSpaces, Space) gsub(g, n[i]) put(g, tkAccent, "`") of nkIfExpr: @@ -1327,6 +1500,12 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gsub(g, n[0]) else: put(g, tkVar, "var") + of nkOutTy: + if n.len > 0: + putWithSpace(g, tkOut, "out") + gsub(g, n[0]) + else: + put(g, tkOut, "out") of nkDistinctTy: if n.len > 0: putWithSpace(g, tkDistinct, "distinct") @@ -1355,20 +1534,20 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = of nkObjectTy: if n.len > 0: putWithSpace(g, tkObject, "object") - gsub(g, n[0]) - gsub(g, n[1]) - gcoms(g) - gsub(g, n[2]) + g.inside(ObjectDef): + gsub(g, n[0]) + gsub(g, n[1]) + gcoms(g) + indentNL(g) + gsub(g, n[2]) + dedent(g) else: put(g, tkObject, "object") of nkRecList: - indentNL(g) for i in 0..<n.len: optNL(g) gsub(g, n[i], c) gcoms(g) - dedent(g) - putNL(g) of nkOfInherit: putWithSpace(g, tkOf, "of") gsub(g, n, 0) @@ -1408,7 +1587,13 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkSpaces, Space) putWithSpace(g, tkEquals, "=") gsub(g, n, 1) - of nkStmtList, nkStmtListExpr, nkStmtListType: gstmts(g, n, emptyContext) + of nkStmtList, nkStmtListExpr, nkStmtListType: + if n.len == 1 and n[0].kind == nkDiscardStmt: + put(g, tkParLe, "(") + gsub(g, n[0]) + put(g, tkParRi, ")") + else: + gstmts(g, n, emptyContext) of nkIfStmt: putWithSpace(g, tkIf, "if") gif(g, n) @@ -1447,7 +1632,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = of nkTypeSection: gsection(g, n, emptyContext, tkType, "type") of nkConstSection: - initContext(a) + a = initContext() incl(a.flags, rfInConstExpr) gsection(g, n, a, tkConst, "const") of nkVarSection, nkLetSection, nkUsingStmt: @@ -1467,7 +1652,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gsub(g, n[0]) of nkReturnStmt: putWithSpace(g, tkReturn, "return") - if n.len > 0 and n[0].kind == nkAsgn: + if n.len > 0 and n[0].kind == nkAsgn and renderIr notin g.flags: gsub(g, n[0], 1) else: gsub(g, n, 0) @@ -1615,13 +1800,11 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gsub(g, n, 0) put(g, tkParRi, ")") of nkGotoState: - var c: TContext - initContext c + var c: TContext = initContext() putWithSpace g, tkSymbol, "goto" gsons(g, n, c) of nkState: - var c: TContext - initContext c + var c: TContext = initContext() putWithSpace g, tkSymbol, "state" gsub(g, n[0], c) putWithSpace(g, tkColon, ":") @@ -1635,14 +1818,17 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gsons(g, n, c, 0) of nkTypeClassTy: gTypeClassTy(g, n) + of nkError: + putWithSpace(g, tkSymbol, "error") + #gcomma(g, n, c) + gsub(g, n[0], c) else: #nkNone, nkExplicitTypeListCall: - internalError(g.config, n.info, "rnimsyn.gsub(" & $n.kind & ')') + internalError(g.config, n.info, "renderer.gsub(" & $n.kind & ')') proc renderTree*(n: PNode, renderFlags: TRenderFlags = {}): string = if n == nil: return "<nil tree>" - var g: TSrcGen - initSrcGen(g, renderFlags, newPartialConfigRef()) + var g: TSrcGen = initSrcGen(renderFlags, newPartialConfigRef()) # do not indent the initial statement list so that # writeFile("file.nim", repr n) # produces working Nim code: @@ -1659,9 +1845,8 @@ proc renderModule*(n: PNode, outfile: string, fid = FileIndex(-1); conf: ConfigRef = nil) = var - f: File - g: TSrcGen - initSrcGen(g, renderFlags, conf) + f: File = default(File) + g: TSrcGen = initSrcGen(renderFlags, conf) g.fid = fid for i in 0..<n.len: gsub(g, n[i]) @@ -1677,9 +1862,9 @@ proc renderModule*(n: PNode, outfile: string, else: rawMessage(g.config, errGenerated, "cannot open file: " & outfile) -proc initTokRender*(r: var TSrcGen, n: PNode, renderFlags: TRenderFlags = {}) = - initSrcGen(r, renderFlags, newPartialConfigRef()) - gsub(r, n) +proc initTokRender*(n: PNode, renderFlags: TRenderFlags = {}): TSrcGen = + result = initSrcGen(renderFlags, newPartialConfigRef()) + gsub(result, n) proc getNextTok*(r: var TSrcGen, kind: var TokType, literal: var string) = if r.idx < r.tokens.len: @@ -1696,15 +1881,3 @@ proc getTokSym*(r: TSrcGen): PSym = result = r.tokens[r.idx-1].sym else: result = nil - -proc quoteExpr*(a: string): string {.inline.} = - ## can be used for quoting expressions in error msgs. - "'" & a & "'" - -proc genFieldDefect*(field: PSym, disc: PSym): string = - ## this needs to be in a module accessible by jsgen, ccgexprs, and vm to - ## provide this error msg FieldDefect; msgs would be better but it does not - ## import ast - result = field.name.s.quoteExpr & " is not accessible using discriminant " & - disc.name.s.quoteExpr & " of type " & - disc.owner.name.s.quoteExpr diff --git a/compiler/renderverbatim.nim b/compiler/renderverbatim.nim index 02d405844..c12595156 100644 --- a/compiler/renderverbatim.nim +++ b/compiler/renderverbatim.nim @@ -1,8 +1,10 @@ -import strutils -from xmltree import addEscaped +import std/strutils import ast, options, msgs -import packages/docutils/highlite + +when defined(nimPreviewSlimSystem): + import std/assertions + const isDebug = false when isDebug: @@ -38,6 +40,7 @@ type LineData = object proc tripleStrLitStartsAtNextLine(conf: ConfigRef, n: PNode): bool = # enabling TLineInfo.offsetA,offsetB would probably make this easier + result = false const tripleQuote = "\"\"\"" let src = sourceLine(conf, n.info) let col = n.info.col @@ -85,7 +88,7 @@ proc startOfLineInsideTriple(ldata: LineData, line: int): bool = if index >= ldata.lines.len: false else: ldata.lines[index] -proc extractRunnableExamplesSource*(conf: ConfigRef; n: PNode): string = +proc extractRunnableExamplesSource*(conf: ConfigRef; n: PNode, indent = 0): string = ## TLineInfo.offsetA,offsetB would be cleaner but it's only enabled for nimpretty, ## we'd need to check performance impact to enable it for nimdoc. var first = n.lastSon.info @@ -104,7 +107,7 @@ proc extractRunnableExamplesSource*(conf: ConfigRef; n: PNode): string = let last = n.lastNodeRec.info var info = first - var indent = info.col + var indent2 = info.col let numLines = numLines(conf, info.fileIndex).uint16 var lastNonemptyPos = 0 @@ -120,33 +123,15 @@ proc extractRunnableExamplesSource*(conf: ConfigRef; n: PNode): string = info.line = line let src = sourceLine(conf, info) let special = startOfLineInsideTriple(ldata, line.int) - if line > last.line and not special and not isInIndentationBlock(src, indent): + if line > last.line and not special and not isInIndentationBlock(src, indent2): break if line > first.line: result.add "\n" if special: result.add src lastNonemptyPos = result.len - elif src.len > indent: - result.add src[indent..^1] + elif src.len > indent2: + for i in 0..<indent: result.add ' ' + result.add src[indent2..^1] lastNonemptyPos = result.len result.setLen lastNonemptyPos -proc renderNimCode*(result: var string, code: string, isLatex = false) = - var toknizr: GeneralTokenizer - initGeneralTokenizer(toknizr, code) - var buf = "" - template append(kind, val) = - buf.setLen 0 - buf.addEscaped(val) - let class = tokenClassToStr[kind] - if isLatex: - result.addf "\\span$1{$2}", [class, buf] - else: - result.addf "<span class=\"$1\">$2</span>", [class, buf] - while true: - getNextToken(toknizr, langNim) - case toknizr.kind - of gtEof: break # End Of File (or string) - else: - # TODO: avoid alloc; maybe toOpenArray - append(toknizr.kind, substr(code, toknizr.start, toknizr.length + toknizr.start - 1)) diff --git a/compiler/reorder.nim b/compiler/reorder.nim index d2b89f392..2f7c04af1 100644 --- a/compiler/reorder.nim +++ b/compiler/reorder.nim @@ -1,9 +1,17 @@ import - intsets, ast, idents, algorithm, renderer, strutils, + ast, idents, renderer, msgs, modulegraphs, syntaxes, options, modulepaths, lineinfos +import std/[algorithm, strutils, intsets] + +when defined(nimPreviewSlimSystem): + import std/assertions + +when defined(nimDebugReorder): + import std/tables + type DepN = ref object pnode: PNode @@ -11,36 +19,27 @@ type onStack: bool kids: seq[DepN] hAQ, hIS, hB, hCmd: int - when defined(debugReorder): + when defined(nimDebugReorder): expls: seq[string] DepG = seq[DepN] -when defined(debugReorder): +when defined(nimDebugReorder): var idNames = newTable[int, string]() proc newDepN(id: int, pnode: PNode): DepN = - new(result) - result.id = id - result.pnode = pnode - result.idx = -1 - result.lowLink = -1 - result.onStack = false - result.kids = @[] - result.hAQ = -1 - result.hIS = -1 - result.hB = -1 - result.hCmd = -1 - when defined(debugReorder): + result = DepN(id: id, pnode: pnode, idx: -1, + lowLink: -1, onStack: false, + kids: @[], hAQ: -1, hIS: -1, + hB: -1, hCmd: -1 + ) + when defined(nimDebugReorder): result.expls = @[] proc accQuoted(cache: IdentCache; n: PNode): PIdent = var id = "" for i in 0..<n.len: - let x = n[i] - case x.kind - of nkIdent: id.add(x.ident.s) - of nkSym: id.add(x.sym.name.s) - else: discard + let ident = n[i].getPIdent + if ident != nil: id.add(ident.s) result = getIdent(cache, id) proc addDecl(cache: IdentCache; n: PNode; declares: var IntSet) = @@ -49,16 +48,16 @@ proc addDecl(cache: IdentCache; n: PNode; declares: var IntSet) = of nkPragmaExpr: addDecl(cache, n[0], declares) of nkIdent: declares.incl n.ident.id - when defined(debugReorder): + when defined(nimDebugReorder): idNames[n.ident.id] = n.ident.s of nkSym: declares.incl n.sym.name.id - when defined(debugReorder): + when defined(nimDebugReorder): idNames[n.sym.name.id] = n.sym.name.s of nkAccQuoted: let a = accQuoted(cache, n) declares.incl a.id - when defined(debugReorder): + when defined(nimDebugReorder): idNames[a.id] = a.s of nkEnumFieldDef: addDecl(cache, n[0], declares) @@ -103,13 +102,16 @@ proc computeDeps(cache: IdentCache; n: PNode, declares, uses: var IntSet; topLev if a.kind == nkExprColonExpr and a[0].kind == nkIdent and a[0].ident.s == "pragma": # user defined pragma decl(a[1]) + for i in 1..<n.safeLen: deps(n[i]) else: for i in 0..<n.safeLen: deps(n[i]) of nkMixinStmt, nkBindStmt: discard else: + # XXX: for callables, this technically adds the return type dep before args for i in 0..<n.safeLen: deps(n[i]) -proc hasIncludes(n:PNode): bool = +proc hasIncludes(n: PNode): bool = + result = false for a in n: if a.kind == nkIncludeStmt: return true @@ -192,7 +194,7 @@ proc mergeSections(conf: ConfigRef; comps: seq[seq[DepN]], res: PNode) = # consecutive type and const sections var wmsg = "Circular dependency detected. `codeReordering` pragma may not be able to" & " reorder some nodes properly" - when defined(debugReorder): + when defined(nimDebugReorder): wmsg &= ":\n" for i in 0..<cs.len-1: for j in i..<cs.len: @@ -229,8 +231,9 @@ proc hasImportStmt(n: PNode): bool = # i it contains one case n.kind of nkImportStmt, nkFromStmt, nkImportExceptStmt: - return true + result = true of nkStmtList, nkStmtListExpr, nkWhenStmt, nkElifBranch, nkElse, nkStaticStmt: + result = false for a in n: if a.hasImportStmt: return true @@ -251,6 +254,7 @@ proc hasCommand(n: PNode): bool = of nkStmtList, nkStmtListExpr, nkWhenStmt, nkElifBranch, nkElse, nkStaticStmt, nkLetSection, nkConstSection, nkVarSection, nkIdentDefs: + result = false for a in n: if a.hasCommand: return true @@ -263,6 +267,7 @@ proc hasCommand(n: DepN): bool = result = bool(n.hCmd) proc hasAccQuoted(n: PNode): bool = + result = false if n.kind == nkAccQuoted: return true for a in n: @@ -278,6 +283,7 @@ proc hasAccQuotedDef(n: PNode): bool = of extendedProcDefs: result = n[0].hasAccQuoted of nkStmtList, nkStmtListExpr, nkWhenStmt, nkElifBranch, nkElse, nkStaticStmt: + result = false for a in n: if hasAccQuotedDef(a): return true @@ -298,6 +304,7 @@ proc hasBody(n: PNode): bool = of extendedProcDefs: result = n[^1].kind == nkStmtList of nkStmtList, nkStmtListExpr, nkWhenStmt, nkElifBranch, nkElse, nkStaticStmt: + result = false for a in n: if a.hasBody: return true @@ -310,10 +317,19 @@ proc hasBody(n: DepN): bool = result = bool(n.hB) proc intersects(s1, s2: IntSet): bool = + result = false for a in s1: if s2.contains(a): return true +proc hasPushOrPopPragma(n: DepN): bool = + # Checks if the tree node has some pragmas that do not + # play well with reordering, like the push/pop pragma + # no crossing for push/pop barrier + let a = n.pnode + result = a.kind == nkPragma and a[0].kind == nkIdent and + (a[0].ident.s == "push" or a[0].ident.s == "pop") + proc buildGraph(n: PNode, deps: seq[(IntSet, IntSet)]): DepG = # Build a dependency graph result = newSeqOfCap[DepN](deps.len) @@ -331,13 +347,13 @@ proc buildGraph(n: PNode, deps: seq[(IntSet, IntSet)]): DepG = if j < i and nj.hasCommand and niHasCmd: # Preserve order for commands and calls ni.kids.add nj - when defined(debugReorder): + when defined(nimDebugReorder): ni.expls.add "both have commands and one comes after the other" elif j < i and nj.hasImportStmt: # Every node that comes after an import statement must # depend on that import ni.kids.add nj - when defined(debugReorder): + when defined(nimDebugReorder): ni.expls.add "parent is, or contains, an import statement and child comes after it" elif j < i and niHasBody and nj.hasAccQuotedDef: # Every function, macro, template... with a body depends @@ -345,21 +361,28 @@ proc buildGraph(n: PNode, deps: seq[(IntSet, IntSet)]): DepG = # That's because it is hard to detect the use of functions # like "[]=", "[]", "or" ... in their bodies. ni.kids.add nj - when defined(debugReorder): + when defined(nimDebugReorder): ni.expls.add "one declares a quoted identifier and the other has a body and comes after it" elif j < i and niHasBody and not nj.hasBody and intersects(deps[i][0], declares): # Keep function declaration before function definition ni.kids.add nj - when defined(debugReorder): + when defined(nimDebugReorder): for dep in deps[i][0]: if dep in declares: ni.expls.add "one declares \"" & idNames[dep] & "\" and the other defines it" + elif hasPushOrPopPragma(nj): + # Every node that comes after a push/pop pragma must + # depend on it; vice versa + if j < i: + ni.kids.add nj + else: + nj.kids.add ni else: for d in declares: if uses.contains(d): ni.kids.add nj - when defined(debugReorder): + when defined(nimDebugReorder): ni.expls.add "one declares \"" & idNames[d] & "\" and the other uses it" proc strongConnect(v: var DepN, idx: var int, s: var seq[DepN], @@ -388,23 +411,14 @@ proc strongConnect(v: var DepN, idx: var int, s: var seq[DepN], proc getStrongComponents(g: var DepG): seq[seq[DepN]] = ## Tarjan's algorithm. Performs a topological sort ## and detects strongly connected components. - var s: seq[DepN] + result = @[] + var s: seq[DepN] = @[] var idx = 0 for v in g.mitems: if v.idx < 0: strongConnect(v, idx, s, result) -proc hasForbiddenPragma(n: PNode): bool = - # Checks if the tree node has some pragmas that do not - # play well with reordering, like the push/pop pragma - for a in n: - if a.kind == nkPragma and a[0].kind == nkIdent and - a[0].ident.s == "push": - return true - proc reorder*(graph: ModuleGraph, n: PNode, module: PSym): PNode = - if n.hasForbiddenPragma: - return n var includedFiles = initIntSet() let mpath = toFullPath(graph.config, module.fileIdx) let n = expandIncludes(graph, module, n, mpath, diff --git a/compiler/rodutils.nim b/compiler/rodutils.nim index 353992fca..5355829c1 100644 --- a/compiler/rodutils.nim +++ b/compiler/rodutils.nim @@ -10,6 +10,9 @@ ## Serialization utilities for the compiler. import std/[strutils, math] +when defined(nimPreviewSlimSystem): + import std/assertions + # bcc on windows doesn't have C99 functions when defined(windows) and defined(bcc): {.emit: """#if defined(_MSC_VER) && _MSC_VER < 1900 @@ -31,7 +34,7 @@ when defined(windows) and defined(bcc): #endif """.} -proc c_snprintf(s: cstring; n:uint; frmt: cstring): cint {.importc: "snprintf", header: "<stdio.h>", nodecl, varargs.} +proc c_snprintf(s: cstring; n: uint; frmt: cstring): cint {.importc: "snprintf", header: "<stdio.h>", nodecl, varargs.} when not declared(signbit): @@ -39,7 +42,10 @@ when not declared(signbit): proc signbit*(x: SomeFloat): bool {.inline.} = result = c_signbit(x) != 0 -proc toStrMaxPrecision*(f: BiggestFloat, literalPostfix = ""): string = +import std/formatfloat + +proc toStrMaxPrecision*(f: BiggestFloat | float32): string = + const literalPostfix = when f is float32: "f" else: "" case classify(f) of fcNan: if signbit(f): @@ -55,9 +61,9 @@ proc toStrMaxPrecision*(f: BiggestFloat, literalPostfix = ""): string = of fcNegInf: result = "-INF" else: - result = newString(81) - let n = c_snprintf(result.cstring, result.len.uint, "%#.16e%s", f, literalPostfix.cstring) - setLen(result, n) + result = "" + result.addFloatRoundtrip(f) + result.add literalPostfix proc encodeStr*(s: string, result: var string) = for i in 0..<s.len: diff --git a/compiler/ropes.nim b/compiler/ropes.nim index 1e7957337..e0d5aa0d3 100644 --- a/compiler/ropes.nim +++ b/compiler/ropes.nim @@ -7,213 +7,55 @@ # distribution, for details about the copyright. # -# Ropes for the C code generator -# -# Ropes are a data structure that represents a very long string -# efficiently; especially concatenation is done in O(1) instead of O(N). -# Ropes make use a lazy evaluation: They are essentially concatenation -# trees that are only flattened when converting to a native Nim -# string or when written to disk. The empty string is represented by a -# nil pointer. -# A little picture makes everything clear: -# -# "this string" & " is internally " & "represented as" -# -# con -- inner nodes do not contain raw data -# / \ -# / \ -# / \ -# con "represented as" -# / \ -# / \ -# / \ -# / \ -# / \ -#"this string" " is internally " -# -# Note that this is the same as: -# "this string" & (" is internally " & "represented as") -# -# con -# / \ -# / \ -# / \ -# "this string" con -# / \ -# / \ -# / \ -# / \ -# / \ -#" is internally " "represented as" -# -# The 'con' operator is associative! This does not matter however for -# the algorithms we use for ropes. -# -# Note that the left and right pointers are not needed for leaves. -# Leaves have relatively high memory overhead (~30 bytes on a 32 -# bit machines) and we produce many of them. This is why we cache and -# share leaves across different rope trees. -# To cache them they are inserted in a `cache` array. - -import - hashes +# Ropes for the C code generator. Ropes are mapped to `string` directly nowadays. from pathutils import AbsoluteFile +when defined(nimPreviewSlimSystem): + import std/[assertions, syncio, formatfloat] + type FormatStr* = string # later we may change it to CString for better # performance of the code generator (assignments # copy the format strings # though it is not necessary) - Rope* = ref RopeObj - RopeObj*{.acyclic.} = object of RootObj # the empty rope is represented - # by nil to safe space - left, right: Rope - L: int # <= 0 if a leaf - data*: string + Rope* = string -proc len*(a: Rope): int = - ## the rope's length - if a == nil: result = 0 - else: result = abs a.L +proc newRopeAppender*(cap = 80): string {.inline.} = + result = newStringOfCap(cap) -proc newRope(data: string = ""): Rope = - new(result) - result.L = -data.len - result.data = data +proc freeze*(r: Rope) {.inline.} = discard -when not compileOption("threads"): - var - cache: array[0..2048*2 - 1, Rope] - - proc resetRopeCache* = - for i in low(cache)..high(cache): - cache[i] = nil - -proc ropeInvariant(r: Rope): bool = - if r == nil: - result = true - else: - result = true # - # if r.data <> snil then - # result := true - # else begin - # result := (r.left <> nil) and (r.right <> nil); - # if result then result := ropeInvariant(r.left); - # if result then result := ropeInvariant(r.right); - # end - -var gCacheTries* = 0 -var gCacheMisses* = 0 -var gCacheIntTries* = 0 +proc resetRopeCache* = discard -proc insertInCache(s: string): Rope = - when declared(cache): - inc gCacheTries - var h = hash(s) and high(cache) - result = cache[h] - if isNil(result) or result.data != s: - inc gCacheMisses - result = newRope(s) - cache[h] = result - else: - result = newRope(s) - -proc rope*(s: string): Rope = - ## Converts a string to a rope. - if s.len == 0: - result = nil - else: - result = insertInCache(s) - assert(ropeInvariant(result)) +template rope*(s: string): string = s proc rope*(i: BiggestInt): Rope = ## Converts an int to a rope. - inc gCacheIntTries result = rope($i) proc rope*(f: BiggestFloat): Rope = ## Converts a float to a rope. result = rope($f) -proc `&`*(a, b: Rope): Rope = - if a == nil: - result = b - elif b == nil: - result = a - else: - result = newRope() - result.L = abs(a.L) + abs(b.L) - result.left = a - result.right = b - -proc `&`*(a: Rope, b: string): Rope = - ## the concatenation operator for ropes. - result = a & rope(b) - -proc `&`*(a: string, b: Rope): Rope = - ## the concatenation operator for ropes. - result = rope(a) & b - -proc `&`*(a: openArray[Rope]): Rope = - ## the concatenation operator for an openarray of ropes. - for i in 0..high(a): result = result & a[i] - -proc add*(a: var Rope, b: Rope) = - ## adds `b` to the rope `a`. - a = a & b - -proc add*(a: var Rope, b: string) = - ## adds `b` to the rope `a`. - a = a & b - -iterator leaves*(r: Rope): string = - ## iterates over any leaf string in the rope `r`. - if r != nil: - var stack = @[r] - while stack.len > 0: - var it = stack.pop - while it.left != nil: - assert it.right != nil - stack.add(it.right) - it = it.left - assert(it != nil) - yield it.data - -iterator items*(r: Rope): char = - ## iterates over any character in the rope `r`. - for s in leaves(r): - for c in items(s): yield c - proc writeRope*(f: File, r: Rope) = ## writes a rope to a file. - for s in leaves(r): write(f, s) + write(f, r) proc writeRope*(head: Rope, filename: AbsoluteFile): bool = - var f: File + var f: File = default(File) if open(f, filename.string, fmWrite): - if head != nil: writeRope(f, head) + writeRope(f, head) close(f) result = true else: result = false -proc `$`*(r: Rope): string = - ## converts a rope back to a string. - result = newString(r.len) - setLen(result, 0) - for s in leaves(r): result.add(s) - -proc ropeConcat*(a: varargs[Rope]): Rope = - # not overloaded version of concat to speed-up `rfmt` a little bit - for i in 0..high(a): result = result & a[i] - -proc prepend*(a: var Rope, b: Rope) = a = b & a proc prepend*(a: var Rope, b: string) = a = b & a proc runtimeFormat*(frmt: FormatStr, args: openArray[Rope]): Rope = var i = 0 - result = nil + result = newRopeAppender() var num = 0 while i < frmt.len: if frmt[i] == '$': @@ -234,7 +76,7 @@ proc runtimeFormat*(frmt: FormatStr, args: openArray[Rope]): Rope = if i >= frmt.len or frmt[i] notin {'0'..'9'}: break num = j if j > high(args) + 1: - doAssert false, "invalid format string: " & frmt + raiseAssert "invalid format string: " & frmt else: result.add(args[j-1]) of '{': @@ -246,10 +88,10 @@ proc runtimeFormat*(frmt: FormatStr, args: openArray[Rope]): Rope = num = j if frmt[i] == '}': inc(i) else: - doAssert false, "invalid format string: " & frmt + raiseAssert "invalid format string: " & frmt if j > high(args) + 1: - doAssert false, "invalid format string: " & frmt + raiseAssert "invalid format string: " & frmt else: result.add(args[j-1]) of 'n': @@ -259,14 +101,10 @@ proc runtimeFormat*(frmt: FormatStr, args: openArray[Rope]): Rope = result.add("\n") inc(i) else: - doAssert false, "invalid format string: " & frmt - var start = i - while i < frmt.len: - if frmt[i] != '$': inc(i) - else: break - if i - 1 >= start: - result.add(substr(frmt, start, i - 1)) - assert(ropeInvariant(result)) + raiseAssert "invalid format string: " & frmt + else: + result.add(frmt[i]) + inc(i) proc `%`*(frmt: static[FormatStr], args: openArray[Rope]): Rope = runtimeFormat(frmt, args) @@ -275,30 +113,19 @@ template addf*(c: var Rope, frmt: FormatStr, args: openArray[Rope]) = ## shortcut for ``add(c, frmt % args)``. c.add(frmt % args) -when true: - template `~`*(r: string): Rope = r % [] -else: - {.push stack_trace: off, line_trace: off.} - proc `~`*(r: static[string]): Rope = - # this is the new optimized "to rope" operator - # the mnemonic is that `~` looks a bit like a rope :) - var r {.global.} = r % [] - return r - {.pop.} - const bufSize = 1024 # 1 KB is reasonable -proc equalsFile*(r: Rope, f: File): bool = +proc equalsFile*(s: Rope, f: File): bool = ## returns true if the contents of the file `f` equal `r`. var - buf: array[bufSize, char] + buf: array[bufSize, char] = default(array[bufSize, char]) bpos = buf.len blen = buf.len btotal = 0 rtotal = 0 - for s in leaves(r): + when true: var spos = 0 rtotal += s.len while spos < s.len: @@ -324,15 +151,8 @@ proc equalsFile*(r: Rope, f: File): bool = proc equalsFile*(r: Rope, filename: AbsoluteFile): bool = ## returns true if the contents of the file `f` equal `r`. If `f` does not ## exist, false is returned. - var f: File + var f: File = default(File) result = open(f, filename.string) if result: result = equalsFile(r, f) close(f) - -proc writeRopeIfNotEqual*(r: Rope, filename: AbsoluteFile): bool = - # returns true if overwritten - if not equalsFile(r, filename): - result = writeRope(r, filename) - else: - result = false diff --git a/compiler/scriptconfig.nim b/compiler/scriptconfig.nim index ef1ceb12b..e3d2bcd45 100644 --- a/compiler/scriptconfig.nim +++ b/compiler/scriptconfig.nim @@ -11,13 +11,18 @@ ## language. import - ast, modules, idents, passes, condsyms, - options, sem, llstream, vm, vmdef, commands, - os, times, osproc, wordrecg, strtabs, modulegraphs, - pathutils + ast, modules, idents, condsyms, + options, llstream, vm, vmdef, commands, + wordrecg, modulegraphs, + pathutils, pipelines + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] + +import std/[strtabs, os, times, osproc] # we support 'cmpIgnoreStyle' natively for efficiency: -from strutils import cmpIgnoreStyle, contains +from std/strutils import cmpIgnoreStyle, contains proc listDirs(a: VmArgs, filter: set[PathComponent]) = let dir = getString(a, 0) @@ -151,21 +156,13 @@ proc setupVM*(module: PSym; cache: IdentCache; scriptName: string; setResult(a, strutils.cmpIgnoreCase(a.getString 0, a.getString 1)) cbconf setCommand: conf.setCommandEarly(a.getString 0) - # xxx move remaining logic to commands.nim or other let arg = a.getString 1 incl(conf.globalOptions, optWasNimscript) - if arg.len > 0: - conf.projectName = arg - let path = - if conf.projectName.isAbsolute: AbsoluteFile(conf.projectName) - else: conf.projectPath / RelativeFile(conf.projectName) - try: - conf.projectFull = canonicalizePath(conf, path) - except OSError: - conf.projectFull = path + if arg.len > 0: setFromProjectName(conf, arg) cbconf getCommand: setResult(a, conf.command) cbconf switch: + conf.currentConfigDir = vthisDir processSwitch(a.getString 0, a.getString 1, passPP, module.info, conf) cbconf hintImpl: processSpecificNote(a.getString 0, wHint, passPP, module.info, @@ -187,15 +184,13 @@ proc setupVM*(module: PSym; cache: IdentCache; scriptName: string; options.cppDefine(conf, a.getString(0)) cbexc stdinReadLine, EOFError: if defined(nimsuggest) or graph.config.cmd == cmdCheck: - discard - else: setResult(a, "") + else: setResult(a, stdin.readLine()) cbexc stdinReadAll, EOFError: if defined(nimsuggest) or graph.config.cmd == cmdCheck: - discard - else: setResult(a, "") + else: setResult(a, stdin.readAll()) proc runNimScript*(cache: IdentCache; scriptName: AbsoluteFile; @@ -205,20 +200,18 @@ proc runNimScript*(cache: IdentCache; scriptName: AbsoluteFile; conf.symbolFiles = disabledSf let graph = newModuleGraph(cache, conf) - connectCallbacks(graph) + connectPipelineCallbacks(graph) if freshDefines: initDefines(conf.symbols) defineSymbol(conf.symbols, "nimscript") defineSymbol(conf.symbols, "nimconfig") - registerPass(graph, semPass) - registerPass(graph, evalPass) conf.searchPaths.add(conf.libpath) let oldGlobalOptions = conf.globalOptions let oldSelectedGC = conf.selectedGC - undefSymbol(conf.symbols, "nimv2") - conf.globalOptions.excl {optTinyRtti, optOwnedRefs, optSeqDestructors} + unregisterArcOrc(conf) + conf.globalOptions.excl optOwnedRefs conf.selectedGC = gcUnselected var m = graph.makeModule(scriptName) @@ -226,8 +219,9 @@ proc runNimScript*(cache: IdentCache; scriptName: AbsoluteFile; var vm = setupVM(m, cache, scriptName.string, graph, idgen) graph.vm = vm - graph.compileSystemModule() - discard graph.processModule(m, vm.idgen, stream) + graph.setPipeLinePass(EvalPass) + graph.compilePipelineSystemModule() + discard graph.processPipelineModule(m, vm.idgen, stream) # watch out, "newruntime" can be set within NimScript itself and then we need # to remember this: @@ -236,9 +230,20 @@ proc runNimScript*(cache: IdentCache; scriptName: AbsoluteFile; if optOwnedRefs in oldGlobalOptions: conf.globalOptions.incl {optTinyRtti, optOwnedRefs, optSeqDestructors} defineSymbol(conf.symbols, "nimv2") - if conf.selectedGC in {gcArc, gcOrc}: + if conf.selectedGC in {gcArc, gcOrc, gcAtomicArc}: conf.globalOptions.incl {optTinyRtti, optSeqDestructors} defineSymbol(conf.symbols, "nimv2") + defineSymbol(conf.symbols, "gcdestructors") + defineSymbol(conf.symbols, "nimSeqsV2") + case conf.selectedGC + of gcArc: + defineSymbol(conf.symbols, "gcarc") + of gcOrc: + defineSymbol(conf.symbols, "gcorc") + of gcAtomicArc: + defineSymbol(conf.symbols, "gcatomicarc") + else: + raiseAssert "unreachable" # ensure we load 'system.nim' again for the real non-config stuff! resetSystemArtifacts(graph) diff --git a/compiler/sem.nim b/compiler/sem.nim index 6b3f0c80d..2cf93d365 100644 --- a/compiler/sem.nim +++ b/compiler/sem.nim @@ -10,28 +10,35 @@ # This module implements the semantic checking pass. import - ast, strutils, options, astalgo, trees, - wordrecg, ropes, msgs, idents, renderer, types, platform, math, + ast, options, astalgo, trees, + wordrecg, ropes, msgs, idents, renderer, types, platform, magicsys, nversion, nimsets, semfold, modulepaths, importer, - procfind, lookups, pragmas, passes, semdata, semtypinst, sigmatch, - intsets, transf, vmdef, vm, aliases, cgmeth, lambdalifting, + procfind, lookups, pragmas, semdata, semtypinst, sigmatch, + transf, vmdef, vm, aliases, cgmeth, lambdalifting, evaltempl, patterns, parampatterns, sempass2, linter, semmacrosanity, - lowerings, plugins/active, lineinfos, strtabs, int128, - isolation_check, typeallowed, modulegraphs, enumtostr, concepts + lowerings, plugins/active, lineinfos, int128, + isolation_check, typeallowed, modulegraphs, enumtostr, concepts, astmsgs, + extccomp -when defined(nimfix): - import nimfix/prettybase +import vtables +import std/[strtabs, math, tables, intsets, strutils, packedsets] when not defined(leanCompiler): import spawn +when defined(nimPreviewSlimSystem): + import std/[ + formatfloat, + assertions, + ] + # implementation -proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode -proc semExprWithType(c: PContext, n: PNode, flags: TExprFlags = {}): PNode +proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType = nil): PNode +proc semExprWithType(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType = nil): PNode proc semExprNoType(c: PContext, n: PNode): PNode proc semExprNoDeref(c: PContext, n: PNode, flags: TExprFlags = {}): PNode -proc semProcBody(c: PContext, n: PNode): PNode +proc semProcBody(c: PContext, n: PNode; expectedType: PType = nil): PNode proc fitNode(c: PContext, formal: PType, arg: PNode; info: TLineInfo): PNode proc changeType(c: PContext; n: PNode, newType: PType, check: bool) @@ -48,7 +55,7 @@ proc semQuoteAst(c: PContext, n: PNode): PNode proc finishMethod(c: PContext, s: PSym) proc evalAtCompileTime(c: PContext, n: PNode): PNode proc indexTypesMatch(c: PContext, f, a: PType, arg: PNode): PNode -proc semStaticExpr(c: PContext, n: PNode): PNode +proc semStaticExpr(c: PContext, n: PNode; expectedType: PType = nil): PNode proc semStaticType(c: PContext, childNode: PNode, prev: PType): PType proc semTypeOf(c: PContext; n: PNode): PNode proc computeRequiresInit(c: PContext, t: PType): bool @@ -77,7 +84,8 @@ template semIdeForTemplateOrGeneric(c: PContext; n: PNode; proc fitNodePostMatch(c: PContext, formal: PType, arg: PNode): PNode = let x = arg.skipConv - if x.kind in {nkPar, nkTupleConstr, nkCurly} and formal.kind != tyUntyped: + if (x.kind == nkCurly and formal.kind == tySet and formal.base.kind != tyGenericParam) or + (x.kind in {nkPar, nkTupleConstr}) and formal.kind notin {tyUntyped, tyBuiltInTypeClass, tyAnything}: changeType(c, x, formal, check=true) result = arg result = skipHiddenSubConv(result, c.graph, c.idgen) @@ -90,6 +98,13 @@ proc fitNode(c: PContext, formal: PType, arg: PNode; info: TLineInfo): PNode = # error correction: result = copyTree(arg) result.typ = formal + elif arg.kind in nkSymChoices and formal.skipTypes(abstractInst).kind == tyEnum: + # Pick the right 'sym' from the sym choice by looking at 'formal' type: + result = nil + for ch in arg: + if sameType(ch.typ, formal): + return ch + typeMismatch(c.config, info, formal, arg.typ, arg) else: result = indexTypesMatch(c, formal, arg.typ, arg) if result == nil: @@ -100,6 +115,16 @@ proc fitNode(c: PContext, formal: PType, arg: PNode; info: TLineInfo): PNode = else: result = fitNodePostMatch(c, formal, result) +proc fitNodeConsiderViewType(c: PContext, formal: PType, arg: PNode; info: TLineInfo): PNode = + let a = fitNode(c, formal, arg, info) + if formal.kind in {tyVar, tyLent}: + #classifyViewType(formal) != noView: + result = newNodeIT(nkHiddenAddr, a.info, formal) + result.add a + formal.flags.incl tfVarIsPtr + else: + result = a + proc inferWithMetatype(c: PContext, formal: PType, arg: PNode, coerceDistincts = false): PNode @@ -119,26 +144,26 @@ proc commonType*(c: PContext; x, y: PType): PType = elif b.kind == tyTyped: result = b elif a.kind == tyTypeDesc: # turn any concrete typedesc into the abstract typedesc type - if a.len == 0: result = a + if not a.hasElementType: result = a else: - result = newType(tyTypeDesc, nextTypeId(c.idgen), a.owner) - rawAddSon(result, newType(tyNone, nextTypeId(c.idgen), a.owner)) + result = newType(tyTypeDesc, c.idgen, a.owner) + rawAddSon(result, newType(tyNone, c.idgen, a.owner)) elif b.kind in {tyArray, tySet, tySequence} and a.kind == b.kind: # check for seq[empty] vs. seq[int] let idx = ord(b.kind == tyArray) if a[idx].kind == tyEmpty: return y - elif a.kind == tyTuple and b.kind == tyTuple and a.len == b.len: - var nt: PType - for i in 0..<a.len: - let aEmpty = isEmptyContainer(a[i]) - let bEmpty = isEmptyContainer(b[i]) + elif a.kind == tyTuple and b.kind == tyTuple and sameTupleLengths(a, b): + var nt: PType = nil + for i, aa, bb in tupleTypePairs(a, b): + let aEmpty = isEmptyContainer(aa) + let bEmpty = isEmptyContainer(bb) if aEmpty != bEmpty: if nt.isNil: - nt = copyType(a, nextTypeId(c.idgen), a.owner) + nt = copyType(a, c.idgen, a.owner) copyTypeProps(c.graph, c.idgen.module, nt, a) - nt[i] = if aEmpty: b[i] else: a[i] + nt[i] = if aEmpty: bb else: aa if not nt.isNil: result = nt #elif b[idx].kind == tyEmpty: return x elif a.kind == tyRange and b.kind == tyRange: @@ -159,14 +184,20 @@ proc commonType*(c: PContext; x, y: PType): PType = result = b #.skipIntLit elif a.kind in IntegralTypes and a.n != nil: result = a #.skipIntLit + elif a.kind == tyProc and b.kind == tyProc: + if a.callConv == ccClosure and b.callConv != ccClosure: + result = x + elif compatibleEffects(a, b) != efCompat or + (b.flags * {tfNoSideEffect, tfGcSafe}) < (a.flags * {tfNoSideEffect, tfGcSafe}): + result = y else: var k = tyNone if a.kind in {tyRef, tyPtr}: k = a.kind if b.kind != a.kind: return x # bug #7601, array construction of ptr generic - a = a.lastSon.skipTypes({tyGenericInst}) - b = b.lastSon.skipTypes({tyGenericInst}) + a = a.elementType.skipTypes({tyGenericInst}) + b = b.elementType.skipTypes({tyGenericInst}) if a.kind == tyObject and b.kind == tyObject: result = commonSuperclass(a, b) # this will trigger an error later: @@ -176,16 +207,22 @@ proc commonType*(c: PContext; x, y: PType): PType = # ill-formed AST, no need for additional tyRef/tyPtr if k != tyNone and x.kind != tyGenericInst: let r = result - result = newType(k, nextTypeId(c.idgen), r.owner) + result = newType(k, c.idgen, r.owner) result.addSonSkipIntLit(r, c.idgen) -proc endsInNoReturn(n: PNode): bool = - # check if expr ends in raise exception or call of noreturn proc - var it = n - while it.kind in {nkStmtList, nkStmtListExpr} and it.len > 0: - it = it.lastSon - result = it.kind in nkLastBlockStmts or - it.kind in nkCallKinds and it[0].kind == nkSym and sfNoReturn in it[0].sym.flags +const shouldChckCovered = {tyInt..tyInt64, tyChar, tyEnum, tyUInt..tyUInt64, tyBool} +proc shouldCheckCaseCovered(caseTyp: PType): bool = + result = false + case caseTyp.kind + of shouldChckCovered: + result = true + of tyRange: + if skipTypes(caseTyp[0], abstractInst).kind in shouldChckCovered: + result = true + else: + discard + +proc endsInNoReturn(n: PNode): bool proc commonType*(c: PContext; x: PType, y: PNode): PType = # ignore exception raising branches in case/if expressions @@ -193,7 +230,7 @@ proc commonType*(c: PContext; x: PType, y: PNode): PType = commonType(c, x, y.typ) proc newSymS(kind: TSymKind, n: PNode, c: PContext): PSym = - result = newSym(kind, considerQuotedIdent(c, n), nextSymId c.idgen, getCurrOwner(c), n.info) + result = newSym(kind, considerQuotedIdent(c, n), c.idgen, getCurrOwner(c), n.info) when defined(nimsuggest): suggestDecl(c, n, result) @@ -216,7 +253,9 @@ proc newSymG*(kind: TSymKind, n: PNode, c: PContext): PSym = # template; we must fix it here: see #909 result.owner = getCurrOwner(c) else: - result = newSym(kind, considerQuotedIdent(c, n), nextSymId c.idgen, getCurrOwner(c), n.info) + result = newSym(kind, considerQuotedIdent(c, n), c.idgen, getCurrOwner(c), n.info) + if find(result.name.s, '`') >= 0: + result.flags.incl sfWasGenSym #if kind in {skForVar, skLet, skVar} and result.owner.kind == skModule: # incl(result.flags, sfGlobal) when defined(nimsuggest): @@ -226,7 +265,7 @@ proc semIdentVis(c: PContext, kind: TSymKind, n: PNode, allowed: TSymFlags): PSym # identifier with visibility proc semIdentWithPragma(c: PContext, kind: TSymKind, n: PNode, - allowed: TSymFlags): PSym + allowed: TSymFlags, fromTopLevel = false): PSym proc typeAllowedCheck(c: PContext; info: TLineInfo; typ: PType; kind: TSymKind; flags: TTypeAllowedFlags = {}) = @@ -246,22 +285,12 @@ proc paramsTypeCheck(c: PContext, typ: PType) {.inline.} = typeAllowedCheck(c, typ.n.info, typ, skProc) proc expectMacroOrTemplateCall(c: PContext, n: PNode): PSym -proc semDirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode +proc semDirectOp(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode proc semWhen(c: PContext, n: PNode, semCheck: bool = true): PNode proc semTemplateExpr(c: PContext, n: PNode, s: PSym, - flags: TExprFlags = {}): PNode + flags: TExprFlags = {}; expectedType: PType = nil): PNode proc semMacroExpr(c: PContext, n, nOrig: PNode, sym: PSym, - flags: TExprFlags = {}): PNode - -proc symFromType(c: PContext; t: PType, info: TLineInfo): PSym = - if t.sym != nil: return t.sym - result = newSym(skType, getIdent(c.cache, "AnonType"), nextSymId c.idgen, t.owner, info) - result.flags.incl sfAnon - result.typ = t - -proc symNodeFromType(c: PContext, t: PType, info: TLineInfo): PNode = - result = newSymNode(symFromType(c, t, info), info) - result.typ = makeTypeDesc(c, t) + flags: TExprFlags = {}; expectedType: PType = nil): PNode when false: proc createEvalContext(c: PContext, mode: TEvalMode): PEvalContext = @@ -279,6 +308,7 @@ when false: result = isOpImpl(c, n) proc hasCycle(n: PNode): bool = + result = false incl n.flags, nfNone for i in 0..<n.safeLen: if nfNone in n[i].flags or hasCycle(n[i]): @@ -296,8 +326,7 @@ proc fixupTypeAfterEval(c: PContext, evaluated, eOrig: PNode): PNode = result = evaluated let expectedType = eOrig.typ.skipTypes({tyStatic}) if hasCycle(result): - globalError(c.config, eOrig.info, "the resulting AST is cyclic and cannot be processed further") - result = errorNode(c, eOrig) + result = localErrorNode(c, eOrig, "the resulting AST is cyclic and cannot be processed further") else: semmacrosanity.annotateType(result, expectedType, c.config) else: @@ -312,8 +341,8 @@ proc fixupTypeAfterEval(c: PContext, evaluated, eOrig: PNode): PNode = isArrayConstr(arg): arg.typ = eOrig.typ -proc tryConstExpr(c: PContext, n: PNode): PNode = - var e = semExprWithType(c, n) +proc tryConstExpr(c: PContext, n: PNode; expectedType: PType = nil): PNode = + var e = semExprWithType(c, n, expectedType = expectedType) if e == nil: return result = getConstExpr(c.module, e, c.idgen, c.graph) @@ -326,6 +355,11 @@ proc tryConstExpr(c: PContext, n: PNode): PNode = c.config.m.errorOutputs = {} c.config.errorMax = high(int) # `setErrorMaxHighMaybe` not appropriate here + 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 + try: result = evalConstExpr(c.module, c.idgen, c.graph, e) if result == nil or result.kind == nkEmpty: @@ -336,6 +370,10 @@ proc tryConstExpr(c: PContext, n: PNode): PNode = except ERecoverableError: result = nil + when defined(nimsuggest): + # Restore the error hook + c.graph.config.structuredErrorHook = tempHook + c.config.errorCounter = oldErrorCount c.config.errorMax = oldErrorMax c.config.m.errorOutputs = oldErrorOutputs @@ -343,11 +381,13 @@ proc tryConstExpr(c: PContext, n: PNode): PNode = const errConstExprExpected = "constant expression expected" -proc semConstExpr(c: PContext, n: PNode): PNode = - var e = semExprWithType(c, n) +proc semConstExpr(c: PContext, n: PNode; expectedType: PType = nil): PNode = + var e = semExprWithType(c, n, expectedType = expectedType) if e == nil: localError(c.config, n.info, errConstExprExpected) 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) @@ -364,32 +404,32 @@ proc semConstExpr(c: PContext, n: PNode): PNode = else: result = fixupTypeAfterEval(c, result, e) -proc semExprFlagDispatched(c: PContext, n: PNode, flags: TExprFlags): PNode = +proc semExprFlagDispatched(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode = if efNeedStatic in flags: if efPreferNilResult in flags: - return tryConstExpr(c, n) + return tryConstExpr(c, n, expectedType) else: - return semConstExpr(c, n) + return semConstExpr(c, n, expectedType) else: - result = semExprWithType(c, n, flags) + result = semExprWithType(c, n, flags, expectedType) if efPreferStatic in flags: var evaluated = getConstExpr(c.module, result, c.idgen, c.graph) if evaluated != nil: return evaluated evaluated = evalAtCompileTime(c, result) if evaluated != nil: return evaluated -when not defined(nimHasSinkInference): - {.pragma: nosinks.} +proc semGenericStmt(c: PContext, n: PNode): PNode include hlo, seminst, semcall proc resetSemFlag(n: PNode) = - excl n.flags, nfSem - for i in 0..<n.safeLen: - resetSemFlag(n[i]) + if n != nil: + excl n.flags, nfSem + for i in 0..<n.safeLen: + resetSemFlag(n[i]) proc semAfterMacroCall(c: PContext, call, macroResult: PNode, - s: PSym, flags: TExprFlags): PNode = + s: PSym, flags: TExprFlags; expectedType: PType = nil): PNode = ## Semantically check the output of a macro. ## This involves processes such as re-checking the macro output for type ## coherence, making sure that variables declared with 'let' aren't @@ -401,22 +441,22 @@ proc semAfterMacroCall(c: PContext, call, macroResult: PNode, c.friendModules.add(s.owner.getModule) result = macroResult resetSemFlag result - if s.typ[0] == nil: + if s.typ.returnType == nil: result = semStmt(c, result, flags) else: - var retType = s.typ[0] + var retType = s.typ.returnType if retType.kind == tyTypeDesc and tfUnresolved in retType.flags and - retType.len == 1: + retType.hasElementType: # bug #11941: template fails(T: type X, v: auto): T # does not mean we expect a tyTypeDesc. - retType = retType[0] + retType = retType.skipModifier case retType.kind - of tyUntyped: + of tyUntyped, tyAnything: # Not expecting a type here allows templates like in ``tmodulealias.in``. - result = semExpr(c, result, flags) + result = semExpr(c, result, flags, expectedType) of tyTyped: # More restrictive version. - result = semExprWithType(c, result, flags) + result = semExprWithType(c, result, flags, expectedType) of tyTypeDesc: if result.kind == nkStmtList: result.transitionSonsKind(nkStmtListType) var typ = semTypeNode(c, result, nil) @@ -433,25 +473,34 @@ proc semAfterMacroCall(c: PContext, call, macroResult: PNode, # e.g. template foo(T: typedesc): seq[T] # We will instantiate the return type here, because # we now know the supplied arguments - var paramTypes = newIdTable() + var paramTypes = initTypeMapping() for param, value in genericParamsInMacroCall(s, call): - idTablePut(paramTypes, param.typ, value.typ) + var givenType = value.typ + # the sym nodes used for the supplied generic arguments for + # templates and macros leave type nil so regular sem can handle it + # in this case, get the type directly from the sym + if givenType == nil and value.kind == nkSym and value.sym.typ != nil: + givenType = value.sym.typ + idTablePut(paramTypes, param.typ, givenType) retType = generateTypeInstance(c, paramTypes, macroResult.info, retType) - result = semExpr(c, result, flags) - result = fitNode(c, retType, result, result.info) - #globalError(s.info, errInvalidParamKindX, typeToString(s.typ[0])) + if retType.kind == tyVoid: + result = semStmt(c, result, flags) + else: + result = semExpr(c, result, flags, expectedType) + result = fitNode(c, retType, result, result.info) + #globalError(s.info, errInvalidParamKindX, typeToString(s.typ.returnType)) dec(c.config.evalTemplateCounter) discard c.friendModules.pop() const errMissingGenericParamsForTemplate = "'$1' has unspecified generic parameters" - errFloatToString = "cannot convert '$1' to '$2'" proc semMacroExpr(c: PContext, n, nOrig: PNode, sym: PSym, - flags: TExprFlags = {}): PNode = + flags: TExprFlags = {}; expectedType: PType = nil): PNode = + rememberExpansion(c, nOrig.info, sym) pushInfoContext(c.config, nOrig.info, sym.detailedInfo) let info = getCallLineInfo(n) @@ -470,7 +519,7 @@ proc semMacroExpr(c: PContext, n, nOrig: PNode, sym: PSym, # 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) + result = semAfterMacroCall(c, n, result, sym, flags, expectedType) if c.config.macrosToExpand.hasKey(sym.name.s): message(c.config, nOrig.info, hintExpandMacro, renderTree(result)) result = wrapInComesFrom(nOrig.info, sym, result) @@ -481,11 +530,9 @@ proc forceBool(c: PContext, n: PNode): PNode = if result == nil: result = n proc semConstBoolExpr(c: PContext, n: PNode): PNode = - result = forceBool(c, semConstExpr(c, n)) + result = forceBool(c, semConstExpr(c, n, getSysType(c.graph, n.info, tyBool))) if result.kind != nkIntLit: localError(c.config, n.info, errConstExprExpected) - -proc semGenericStmt(c: PContext, n: PNode): PNode proc semConceptBody(c: PContext, n: PNode): PNode include semtypes @@ -509,6 +556,147 @@ proc setGenericParamsMisc(c: PContext; n: PNode) = else: n[miscPos][1] = orig +proc caseBranchMatchesExpr(branch, matched: PNode): bool = + result = false + for i in 0 ..< branch.len-1: + if branch[i].kind == nkRange: + if overlap(branch[i], matched): return true + elif exprStructuralEquivalent(branch[i], matched): + return true + +proc pickCaseBranchIndex(caseExpr, matched: PNode): int = + result = 0 + let endsWithElse = caseExpr[^1].kind == nkElse + for i in 1..<caseExpr.len - endsWithElse.int: + if caseExpr[i].caseBranchMatchesExpr(matched): + return i + if endsWithElse: + return caseExpr.len - 1 + +proc defaultFieldsForTheUninitialized(c: PContext, recNode: PNode, checkDefault: bool): seq[PNode] +proc defaultNodeField(c: PContext, a: PNode, aTyp: PType, checkDefault: bool): PNode +proc defaultNodeField(c: PContext, a: PNode, checkDefault: bool): PNode + +const defaultFieldsSkipTypes = {tyGenericInst, tyAlias, tySink} + +proc defaultFieldsForTuple(c: PContext, recNode: PNode, hasDefault: var bool, checkDefault: bool): seq[PNode] = + result = @[] + case recNode.kind + of nkRecList: + for field in recNode: + result.add defaultFieldsForTuple(c, field, hasDefault, checkDefault) + of nkSym: + let field = recNode.sym + let recType = recNode.typ.skipTypes(defaultFieldsSkipTypes) + if field.ast != nil: #Try to use default value + hasDefault = true + result.add newTree(nkExprColonExpr, recNode, field.ast) + else: + if recType.kind in {tyObject, tyArray, tyTuple}: + let asgnExpr = defaultNodeField(c, recNode, recNode.typ, checkDefault) + if asgnExpr != nil: + hasDefault = true + asgnExpr.flags.incl nfSkipFieldChecking + result.add newTree(nkExprColonExpr, recNode, asgnExpr) + return + + let asgnType = newType(tyTypeDesc, c.idgen, recNode.typ.owner) + rawAddSon(asgnType, recNode.typ) + let asgnExpr = newTree(nkCall, + newSymNode(getSysMagic(c.graph, recNode.info, "zeroDefault", mZeroDefault)), + newNodeIT(nkType, recNode.info, asgnType) + ) + asgnExpr.flags.incl nfSkipFieldChecking + asgnExpr.typ = recNode.typ + result.add newTree(nkExprColonExpr, recNode, asgnExpr) + else: + raiseAssert "unreachable" + +proc defaultFieldsForTheUninitialized(c: PContext, recNode: PNode, checkDefault: bool): seq[PNode] = + result = @[] + case recNode.kind + of nkRecList: + for field in recNode: + result.add defaultFieldsForTheUninitialized(c, field, checkDefault) + of nkRecCase: + let discriminator = recNode[0] + var selectedBranch: int + var defaultValue = discriminator.sym.ast + if defaultValue == nil: + # None of the branches were explicitly selected by the user and no value + # was given to the discrimator. We can assume that it will be initialized + # to zero and this will select a particular branch as a result: + if checkDefault: # don't add defaults when checking whether a case branch has default fields + return + defaultValue = newIntNode(nkIntLit#[c.graph]#, 0) + defaultValue.typ = discriminator.typ + selectedBranch = recNode.pickCaseBranchIndex defaultValue + defaultValue.flags.incl nfSkipFieldChecking + result.add newTree(nkExprColonExpr, discriminator, defaultValue) + result.add defaultFieldsForTheUninitialized(c, recNode[selectedBranch][^1], checkDefault) + of nkSym: + let field = recNode.sym + let recType = recNode.typ.skipTypes(defaultFieldsSkipTypes) + if field.ast != nil: #Try to use default value + result.add newTree(nkExprColonExpr, recNode, field.ast) + elif recType.kind in {tyObject, tyArray, tyTuple}: + let asgnExpr = defaultNodeField(c, recNode, recNode.typ, checkDefault) + if asgnExpr != nil: + asgnExpr.typ = recNode.typ + asgnExpr.flags.incl nfSkipFieldChecking + result.add newTree(nkExprColonExpr, recNode, asgnExpr) + else: + raiseAssert "unreachable" + +proc defaultNodeField(c: PContext, a: PNode, aTyp: PType, checkDefault: bool): PNode = + let aTypSkip = aTyp.skipTypes(defaultFieldsSkipTypes) + case aTypSkip.kind + of tyObject: + let child = defaultFieldsForTheUninitialized(c, aTypSkip.n, checkDefault) + if child.len > 0: + var asgnExpr = newTree(nkObjConstr, newNodeIT(nkType, a.info, aTyp)) + asgnExpr.typ = aTyp + asgnExpr.sons.add child + result = semExpr(c, asgnExpr) + else: + result = nil + of tyArray: + let child = defaultNodeField(c, a, aTypSkip[1], checkDefault) + + if child != nil: + let node = newNode(nkIntLit) + node.intVal = toInt64(lengthOrd(c.graph.config, aTypSkip)) + result = semExpr(c, newTree(nkCall, newSymNode(getSysSym(c.graph, a.info, "arrayWith"), a.info), + semExprWithType(c, child), + node + )) + result.typ = aTyp + else: + result = nil + of tyTuple: + var hasDefault = false + if aTypSkip.n != nil: + let children = defaultFieldsForTuple(c, aTypSkip.n, hasDefault, checkDefault) + if hasDefault and children.len > 0: + result = newNodeI(nkTupleConstr, a.info) + result.typ = aTyp + result.sons.add children + result = semExpr(c, result) + else: + result = nil + else: + result = nil + of tyRange: + if c.graph.config.isDefined("nimPreviewRangeDefault"): + result = firstRange(c.config, aTypSkip) + else: + result = nil + else: + result = nil + +proc defaultNodeField(c: PContext, a: PNode, checkDefault: bool): PNode = + result = defaultNodeField(c, a, a.typ, checkDefault) + include semtempl, semgnrc, semstmts, semexprs proc addCodeForGenerics(c: PContext, n: PNode) = @@ -521,53 +709,63 @@ proc addCodeForGenerics(c: PContext, n: PNode) = n.add prc.ast c.lastGenericIdx = c.generics.len -proc myOpen(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext {.nosinks.} = - var c = newContext(graph, module) - c.idgen = idgen - c.enforceVoidContext = newType(tyTyped, nextTypeId(idgen), nil) - - if c.p != nil: internalError(graph.config, module.info, "sem.myOpen") - c.semConstExpr = semConstExpr - c.semExpr = semExpr - c.semTryExpr = tryExpr - c.semTryConstExpr = tryConstExpr - c.computeRequiresInit = computeRequiresInit - c.semOperand = semOperand - c.semConstBoolExpr = semConstBoolExpr - c.semOverloadedCall = semOverloadedCall - c.semInferredLambda = semInferredLambda - c.semGenerateInstance = generateInstance - c.semTypeNode = semTypeNode - c.instTypeBoundOp = sigmatch.instTypeBoundOp - c.hasUnresolvedArgs = hasUnresolvedArgs - c.templInstCounter = new int - - pushProcCon(c, module) - pushOwner(c, c.module) - - c.moduleScope = openScope(c) - c.moduleScope.addSym(module) # a module knows itself +proc preparePContext*(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PContext = + result = newContext(graph, module) + result.idgen = idgen + result.enforceVoidContext = newType(tyTyped, idgen, nil) + result.voidType = newType(tyVoid, idgen, nil) + + if result.p != nil: internalError(graph.config, module.info, "sem.preparePContext") + result.semConstExpr = semConstExpr + result.semExpr = semExpr + result.semExprWithType = semExprWithType + result.semTryExpr = tryExpr + result.semTryConstExpr = tryConstExpr + result.computeRequiresInit = computeRequiresInit + result.semOperand = semOperand + result.semConstBoolExpr = semConstBoolExpr + result.semOverloadedCall = semOverloadedCall + result.semInferredLambda = semInferredLambda + result.semGenerateInstance = generateInstance + result.instantiateOnlyProcType = instantiateOnlyProcType + result.semTypeNode = semTypeNode + result.instTypeBoundOp = sigmatch.instTypeBoundOp + result.hasUnresolvedArgs = hasUnresolvedArgs + result.templInstCounter = new int + + pushProcCon(result, module) + pushOwner(result, result.module) + + result.moduleScope = openScope(result) + result.moduleScope.addSym(module) # a module knows itself if sfSystemModule in module.flags: graph.systemModule = module - c.topLevelScope = openScope(c) - result = c + result.topLevelScope = openScope(result) proc isImportSystemStmt(g: ModuleGraph; n: PNode): bool = if g.systemModule == nil: return false + var n = n + if n.kind == nkStmtList: + for i in 0..<n.len-1: + if n[i].kind notin {nkCommentStmt, nkEmpty}: + n = n[i] + break case n.kind of nkImportStmt: + result = false for x in n: if x.kind == nkIdent: let f = checkModuleName(g.config, x, false) if f == g.systemModule.info.fileIndex: return true of nkImportExceptStmt, nkFromStmt: + result = false if n[0].kind == nkIdent: let f = checkModuleName(g.config, n[0], false) if f == g.systemModule.info.fileIndex: return true - else: discard + else: result = false proc isEmptyTree(n: PNode): bool = case n.kind @@ -610,6 +808,13 @@ proc semStmtAndGenerateGenerics(c: PContext, n: PNode): PNode = if c.config.cmd == cmdIdeTools: appendToModule(c.module, result) trackStmt(c, c.module, result, isTopLevel = true) + if optMultiMethods notin c.config.globalOptions and + c.config.selectedGC in {gcArc, gcOrc, gcAtomicArc} and + Feature.vtables in c.config.features: + sortVTableDispatchers(c.graph) + + if sfMainModule in c.module.flags: + collectVTableDispatchers(c.graph) proc recoverContext(c: PContext) = # clean up in case of a semantic error: We clean up the stacks, etc. This is @@ -619,8 +824,7 @@ proc recoverContext(c: PContext) = while getCurrOwner(c).kind != skModule: popOwner(c) while c.p != nil and c.p.owner.kind != skModule: c.p = c.p.next -proc myProcess(context: PPassContext, n: PNode): PNode {.nosinks.} = - var c = PContext(context) +proc semWithPContext*(c: PContext, n: PNode): PNode = # no need for an expensive 'try' if we stop after the first error anyway: if c.config.errorMax <= 1: result = semStmtAndGenerateGenerics(c, n) @@ -641,13 +845,14 @@ proc myProcess(context: PPassContext, n: PNode): PNode {.nosinks.} = #if c.config.cmd == cmdIdeTools: findSuggest(c, n) storeRodNode(c, result) + proc reportUnusedModules(c: PContext) = + if c.config.cmd == cmdM: return 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) -proc myClose(graph: ModuleGraph; context: PPassContext, n: PNode): PNode = - var c = PContext(context) +proc closePContext*(graph: ModuleGraph; c: PContext, n: PNode): PNode = if c.config.cmd == cmdIdeTools and not c.suggestionsMade: suggestSentinel(c) closeScope(c) # close module's scope @@ -662,6 +867,3 @@ proc myClose(graph: ModuleGraph; context: PPassContext, n: PNode): PNode = popOwner(c) popProcCon(c) sealRodFile(c) - -const semPass* = makePass(myOpen, myProcess, myClose, - isFrontend = true) diff --git a/compiler/semcall.nim b/compiler/semcall.nim index 99979c382..13f2273a9 100644 --- a/compiler/semcall.nim +++ b/compiler/semcall.nim @@ -10,7 +10,8 @@ ## This module implements semantic checking for calls. # included from sem.nim -from algorithm import sort +from std/algorithm import sort + proc sameMethodDispatcher(a, b: PSym): bool = result = false @@ -42,16 +43,29 @@ proc initCandidateSymbols(c: PContext, headSymbol: PNode, best, alt: var TCandidate, o: var TOverloadIter, diagnostics: bool): seq[tuple[s: PSym, scope: int]] = + ## puts all overloads into a seq and prepares best+alt result = @[] var symx = initOverloadIter(o, c, headSymbol) while symx != nil: if symx.kind in filter: result.add((symx, o.lastOverloadScope)) + elif symx.kind == skGenericParam: + #[ + This code handles looking up a generic parameter when it's a static callable. + For instance: + proc name[T: static proc()]() = T() + name[proc() = echo"hello"]() + ]# + for paramSym in searchInScopesAllCandidatesFilterBy(c, symx.name, {skConst}): + let paramTyp = paramSym.typ + if paramTyp.n.kind == nkSym and paramTyp.n.sym.kind in filter: + result.add((paramTyp.n.sym, o.lastOverloadScope)) + symx = nextOverloadIter(o, c, headSymbol) if result.len > 0: - initCandidate(c, best, result[0].s, initialBinding, + best = initCandidate(c, result[0].s, initialBinding, result[0].scope, diagnostics) - initCandidate(c, alt, result[0].s, initialBinding, + alt = initCandidate(c, result[0].s, initialBinding, result[0].scope, diagnostics) best.state = csNoMatch @@ -62,40 +76,43 @@ proc pickBestCandidate(c: PContext, headSymbol: PNode, best, alt: var TCandidate, errors: var CandidateErrors, diagnosticsFlag: bool, - errorsEnabled: bool) = - var o: TOverloadIter - var sym = initOverloadIter(o, c, headSymbol) - var scope = o.lastOverloadScope - # Thanks to the lazy semchecking for operands, we need to check whether - # 'initCandidate' modifies the symbol table (via semExpr). - # This can occur in cases like 'init(a, 1, (var b = new(Type2); b))' - let counterInitial = c.currentScope.symbols.counter - var syms: seq[tuple[s: PSym, scope: int]] - var noSyms = true - var nextSymIndex = 0 - while sym != nil: - if sym.kind in filter: - # Initialise 'best' and 'alt' with the first available symbol - initCandidate(c, best, sym, initialBinding, scope, diagnosticsFlag) - initCandidate(c, alt, sym, initialBinding, scope, diagnosticsFlag) - best.state = csNoMatch - break - else: - sym = nextOverloadIter(o, c, headSymbol) - scope = o.lastOverloadScope - var z: TCandidate - while sym != nil: - if sym.kind notin filter: - sym = nextOverloadIter(o, c, headSymbol) - scope = o.lastOverloadScope - continue + errorsEnabled: bool, flags: TExprFlags) = + # `matches` may find new symbols, so keep track of count + var symCount = c.currentScope.symbols.counter + + var o: TOverloadIter = default(TOverloadIter) + # https://github.com/nim-lang/Nim/issues/21272 + # prevent mutation during iteration by storing them in a seq + # luckily `initCandidateSymbols` does just that + var syms = initCandidateSymbols(c, headSymbol, initialBinding, filter, + best, alt, o, diagnosticsFlag) + if len(syms) == 0: + return + # current overload being considered + var sym = syms[0].s + var scope = syms[0].scope + + # starts at 1 because 0 is already done with setup, only needs checking + var nextSymIndex = 1 + var z: TCandidate # current candidate + while true: determineType(c, sym) - initCandidate(c, z, sym, initialBinding, scope, diagnosticsFlag) - if c.currentScope.symbols.counter == counterInitial or syms.len != 0: + z = initCandidate(c, sym, initialBinding, scope, diagnosticsFlag) + + # this is kinda backwards as without a check here the described + # problems in recalc would not happen, but instead it 100% + # does check forever in some cases + if c.currentScope.symbols.counter == symCount: + # may introduce new symbols with caveats described in recalc branch matches(c, n, orig, z) + if z.state == csMatch: # little hack so that iterators are preferred over everything else: - if sym.kind == skIterator: inc(z.exactMatches, 200) + if sym.kind == skIterator: + if not (efWantIterator notin flags and efWantIterable in flags): + inc(z.exactMatches, 200) + else: + dec(z.exactMatches, 200) case best.state of csEmpty, csNoMatch: best = z of csMatch: @@ -108,22 +125,36 @@ proc pickBestCandidate(c: PContext, headSymbol: PNode, firstMismatch: z.firstMismatch, diagnostics: z.diagnostics)) else: + # this branch feels like a ticking timebomb + # one of two bad things could happen + # 1) new symbols are discovered but the loop ends before we recalc + # 2) new symbols are discovered and resemmed forever + # not 100% sure if these are possible though as they would rely + # on somehow introducing a new overload during overload resolution + # Symbol table has been modified. Restart and pre-calculate all syms # before any further candidate init and compare. SLOW, but rare case. syms = initCandidateSymbols(c, headSymbol, initialBinding, filter, best, alt, o, diagnosticsFlag) - noSyms = false - if noSyms: - sym = nextOverloadIter(o, c, headSymbol) - scope = o.lastOverloadScope - elif nextSymIndex < syms.len: - # rare case: retrieve the next pre-calculated symbol - sym = syms[nextSymIndex].s - scope = syms[nextSymIndex].scope - nextSymIndex += 1 - else: + + # reset counter because syms may be in a new order + symCount = c.currentScope.symbols.counter + nextSymIndex = 0 + + # just in case, should be impossible though + if syms.len == 0: + break + + if nextSymIndex > high(syms): + # we have reached the end break + # advance to next sym + sym = syms[nextSymIndex].s + scope = syms[nextSymIndex].scope + inc(nextSymIndex) + + proc effectProblem(f, a: PType; result: var string; c: PContext) = if f.kind == tyProc and a.kind == tyProc: if tfThread in f.flags and tfThread notin a.flags: @@ -145,9 +176,10 @@ proc effectProblem(f, a: PType; result: var string; c: PContext) = 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." + of efTagsIllegal: + result.add "\n The `.forbids` requirements caught an illegal tag." when defined(drnim): if not c.graph.compatibleProps(c.graph, f, a): result.add "\n The `.requires` or `.ensures` properties are incompatible." @@ -187,7 +219,7 @@ proc presentFailedCandidates(c: PContext, n: PNode, errors: CandidateErrors): # argument in order to remove plenty of candidates. This is # comparable to what C# does and C# is doing fine. var filterOnlyFirst = false - if optShowAllMismatches notin c.config.globalOptions: + if optShowAllMismatches notin c.config.globalOptions and verboseTypeMismatch in c.config.legacyFeatures: for err in errors: if err.firstMismatch.arg > 1: filterOnlyFirst = true @@ -195,7 +227,7 @@ proc presentFailedCandidates(c: PContext, n: PNode, errors: CandidateErrors): var maybeWrongSpace = false - var candidatesAll: seq[string] + var candidatesAll: seq[string] = @[] var candidates = "" var skipped = 0 for err in errors: @@ -203,6 +235,10 @@ proc presentFailedCandidates(c: PContext, n: PNode, errors: CandidateErrors): if filterOnlyFirst and err.firstMismatch.arg == 1: inc skipped continue + + if verboseTypeMismatch notin c.config.legacyFeatures: + candidates.add "[" & $err.firstMismatch.arg & "] " + if err.sym.kind in routineKinds and err.sym.ast != nil: candidates.add(renderTree(err.sym.ast, {renderNoBody, renderNoComments, renderNoPragmas})) @@ -210,44 +246,151 @@ proc presentFailedCandidates(c: PContext, n: PNode, errors: CandidateErrors): candidates.add(getProcHeader(c.config, err.sym, prefer)) candidates.addDeclaredLocMaybe(c.config, err.sym) candidates.add("\n") - let nArg = if err.firstMismatch.arg < n.len: n[err.firstMismatch.arg] else: nil + const genericParamMismatches = {kGenericParamTypeMismatch, kExtraGenericParam, kMissingGenericParam} + let isGenericMismatch = err.firstMismatch.kind in genericParamMismatches + var argList = n + if isGenericMismatch and n[0].kind == nkBracketExpr: + argList = n[0] + let nArg = + if err.firstMismatch.arg < argList.len: + argList[err.firstMismatch.arg] + else: + nil let nameParam = if err.firstMismatch.formal != nil: err.firstMismatch.formal.name.s else: "" if n.len > 1: - 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 - var wanted = err.firstMismatch.formal.typ - doAssert err.firstMismatch.formal != nil - candidates.add("\n required type for " & nameParam & ": ") - candidates.add typeToString(wanted) - candidates.addDeclaredLocMaybe(c.config, wanted) - candidates.add "\n but expression '" - if err.firstMismatch.kind == kVarNeeded: + if verboseTypeMismatch notin c.config.legacyFeatures: + case err.firstMismatch.kind + of kUnknownNamedParam: + if nArg == nil: + candidates.add(" unknown named parameter") + else: + candidates.add(" unknown named parameter: " & $nArg[0]) + candidates.add "\n" + of kAlreadyGiven: + candidates.add(" named param already provided: " & $nArg[0]) + candidates.add "\n" + of kPositionalAlreadyGiven: + candidates.add(" positional param was already given as named param") + candidates.add "\n" + of kExtraArg: + candidates.add(" extra argument given") + candidates.add "\n" + of kMissingParam: + candidates.add(" missing parameter: " & nameParam) + candidates.add "\n" + of kExtraGenericParam: + candidates.add(" extra generic param given") + candidates.add "\n" + of kMissingGenericParam: + candidates.add(" missing generic parameter: " & nameParam) + candidates.add "\n" + of kVarNeeded: + doAssert nArg != nil + doAssert err.firstMismatch.formal != nil + candidates.add " expression '" candidates.add renderNotLValue(nArg) candidates.add "' is immutable, not 'var'" - else: - candidates.add renderTree(nArg) - candidates.add "' is of type: " - var got = nArg.typ - candidates.add typeToString(got) - candidates.addDeclaredLocMaybe(c.config, got) + candidates.add "\n" + of kTypeMismatch: + doAssert nArg != nil + if nArg.kind in nkSymChoices: + candidates.add ambiguousIdentifierMsg(nArg, indent = 2) + let wanted = err.firstMismatch.formal.typ + doAssert err.firstMismatch.formal != nil + doAssert wanted != nil + let got = nArg.typ + if got != nil and got.kind == tyProc and wanted.kind == tyProc: + # These are proc mismatches so, + # add the extra explict detail of the mismatch + candidates.add " expression '" + candidates.add renderTree(nArg) + candidates.add "' is of type: " + candidates.addTypeDeclVerboseMaybe(c.config, got) + candidates.addPragmaAndCallConvMismatch(wanted, got, c.config) + effectProblem(wanted, got, candidates, c) + candidates.add "\n" + of kGenericParamTypeMismatch: + let pos = err.firstMismatch.arg + doAssert n[0].kind == nkBracketExpr and pos < n[0].len + let arg = n[0][pos] + doAssert arg != nil + var wanted = err.firstMismatch.formal.typ + if wanted.kind == tyGenericParam and wanted.genericParamHasConstraints: + wanted = wanted.genericConstraint + let got = arg.typ.skipTypes({tyTypeDesc}) + doAssert err.firstMismatch.formal != nil doAssert wanted != nil - if got != nil: 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: + doAssert got != nil + candidates.add " generic parameter mismatch, expected " + candidates.addTypeDeclVerboseMaybe(c.config, wanted) + candidates.add " but got '" + candidates.add renderTree(arg) + candidates.add "' of type: " + candidates.addTypeDeclVerboseMaybe(c.config, got) + if nArg.kind in nkSymChoices: + candidates.add "\n" + candidates.add ambiguousIdentifierMsg(nArg, indent = 2) + if got != nil and got.kind == tyProc and wanted.kind == tyProc: + # These are proc mismatches so, + # add the extra explict detail of the mismatch + candidates.addPragmaAndCallConvMismatch(wanted, got, c.config) + if got != nil: + effectProblem(wanted, got, candidates, c) + candidates.add "\n" + of kUnknown: discard "do not break 'nim check'" + else: + candidates.add(" first type mismatch at position: " & $err.firstMismatch.arg) + if err.firstMismatch.kind in genericParamMismatches: + candidates.add(" in generic parameters") + # candidates.add "\n reason: " & $err.firstMismatch.kind # for debugging + case err.firstMismatch.kind + of kUnknownNamedParam: + if nArg == nil: + candidates.add("\n unknown named parameter") + else: + candidates.add("\n unknown named parameter: " & $nArg[0]) + of kAlreadyGiven: candidates.add("\n named param already provided: " & $nArg[0]) + of kPositionalAlreadyGiven: candidates.add("\n positional param was already given as named param") + of kExtraArg: candidates.add("\n extra argument given") + of kMissingParam: candidates.add("\n missing parameter: " & nameParam) + of kExtraGenericParam: + candidates.add("\n extra generic param given") + of kMissingGenericParam: + candidates.add("\n missing generic parameter: " & nameParam) + of kTypeMismatch, kGenericParamTypeMismatch, kVarNeeded: + doAssert nArg != nil + var wanted = err.firstMismatch.formal.typ + if isGenericMismatch and wanted.kind == tyGenericParam and + wanted.genericParamHasConstraints: + wanted = wanted.genericConstraint + doAssert err.firstMismatch.formal != nil + candidates.add("\n required type for " & nameParam & ": ") + candidates.addTypeDeclVerboseMaybe(c.config, wanted) + candidates.add "\n but expression '" + if err.firstMismatch.kind == kVarNeeded: + candidates.add renderNotLValue(nArg) + candidates.add "' is immutable, not 'var'" + else: + candidates.add renderTree(nArg) + candidates.add "' is of type: " + var got = nArg.typ + if isGenericMismatch: got = got.skipTypes({tyTypeDesc}) + candidates.addTypeDeclVerboseMaybe(c.config, got) + if nArg.kind in nkSymChoices: + candidates.add "\n" + candidates.add ambiguousIdentifierMsg(nArg, indent = 2) + doAssert wanted != nil + if got != nil: + if got.kind == tyProc and wanted.kind == tyProc: + # These are proc mismatches so, + # add the extra explict detail of the mismatch + candidates.addPragmaAndCallConvMismatch(wanted, got, c.config) + effectProblem(wanted, got, candidates, c) + + of kUnknown: discard "do not break 'nim check'" + candidates.add "\n" + if err.firstMismatch.arg == 1 and nArg != nil and + nArg.kind == nkTupleConstr and n.kind == nkCommand: maybeWrongSpace = true for diag in err.diagnostics: candidates.add(diag & "\n") @@ -264,24 +407,21 @@ proc presentFailedCandidates(c: PContext, n: PNode, errors: CandidateErrors): const errTypeMismatch = "type mismatch: got <" - errButExpected = "but expected one of: " + errButExpected = "but expected one of:" + errExpectedPosition = "Expected one of (first mismatch at [position]):" 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" -proc notFoundError*(c: PContext, n: PNode, errors: CandidateErrors) = - # Gives a detailed error message; this is separated from semOverloadedCall, - # as semOverlodedCall is already pretty slow (and we need this information - # only in case of an error). - if c.config.m.errorOutputs == {}: - # fail fast: - globalError(c.config, n.info, "type mismatch") - return - if errors.len == 0: - localError(c.config, n.info, "expression '$1' cannot be called" % n[0].renderTree) - return +proc describeParamList(c: PContext, n: PNode, startIdx = 1; prefer = preferName): string = + result = "Expression: " & $n + for i in startIdx..<n.len: + result.add "\n [" & $i & "] " & renderTree(n[i]) & ": " + result.add describeArg(c, n, i, startIdx, prefer) + result.add "\n" +template legacynotFoundError(c: PContext, n: PNode, errors: CandidateErrors) = let (prefer, candidates) = presentFailedCandidates(c, n, errors) var result = errTypeMismatch result.add(describeArgs(c, n, 1, prefer)) @@ -290,39 +430,60 @@ proc notFoundError*(c: PContext, n: PNode, errors: CandidateErrors) = result.add("\n" & errButExpected & "\n" & candidates) localError(c.config, n.info, result & "\nexpression: " & $n) -proc bracketNotFoundError(c: PContext; n: PNode) = - var errors: CandidateErrors = @[] - var o: TOverloadIter - let headSymbol = n[0] - var symx = initOverloadIter(o, c, headSymbol) - while symx != nil: - if symx.kind in routineKinds: - errors.add(CandidateError(sym: symx, - firstMismatch: MismatchInfo(), - diagnostics: @[], - enabled: false)) - symx = nextOverloadIter(o, c, headSymbol) +proc notFoundError*(c: PContext, n: PNode, errors: CandidateErrors) = + # 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). + if c.config.m.errorOutputs == {}: + # fail fast: + globalError(c.config, n.info, "type mismatch") + return + # see getMsgDiagnostic: + if nfExplicitCall notin n.flags and {nfDotField, nfDotSetter} * n.flags != {}: + let ident = considerQuotedIdent(c, n[0], n).s + let sym = n[1].typ.typSym + var typeHint = "" + if sym == nil: + discard + else: + typeHint = " for type " & getProcHeader(c.config, sym) + localError(c.config, n.info, errUndeclaredField % ident & typeHint) + return if errors.len == 0: - localError(c.config, n.info, "could not resolve: " & $n) + if n[0].kind in nkIdentKinds: + let ident = considerQuotedIdent(c, n[0], n).s + localError(c.config, n.info, errUndeclaredRoutine % ident) + else: + localError(c.config, n.info, "expression '$1' cannot be called" % n[0].renderTree) + return + + if verboseTypeMismatch in c.config.legacyFeatures: + legacynotFoundError(c, n, errors) else: - notFoundError(c, n, errors) + let (prefer, candidates) = presentFailedCandidates(c, n, errors) + var result = "type mismatch\n" + result.add describeParamList(c, n, 1, prefer) + if candidates != "": + result.add("\n" & errExpectedPosition & "\n" & candidates) + localError(c.config, n.info, result) proc getMsgDiagnostic(c: PContext, flags: TExprFlags, n, f: PNode): string = + result = "" 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 else: - var o: TOverloadIter + var o: TOverloadIter = default(TOverloadIter) var sym = initOverloadIter(o, c, f) while sym != nil: result &= "\n found $1" % [getSymRepr(c.config, sym)] sym = nextOverloadIter(o, c, f) let ident = considerQuotedIdent(c, f, n).s - if {nfDotField, nfExplicitCall} * n.flags == {nfDotField}: - let sym = n[1].typ.sym + if nfExplicitCall notin n.flags and {nfDotField, nfDotSetter} * n.flags != {}: + let sym = n[1].typ.typSym var typeHint = "" if sym == nil: # Perhaps we're in a `compiles(foo.bar)` expression, or @@ -333,7 +494,8 @@ proc getMsgDiagnostic(c: PContext, flags: TExprFlags, n, f: PNode): string = discard else: typeHint = " for type " & getProcHeader(c.config, sym) - result = errUndeclaredField % ident & typeHint & " " & result + 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] @@ -342,8 +504,9 @@ proc resolveOverloads(c: PContext, n, orig: PNode, filter: TSymKinds, flags: TExprFlags, errors: var CandidateErrors, errorsEnabled: bool): TCandidate = + result = default(TCandidate) var initialBinding: PNode - var alt: TCandidate + var alt: TCandidate = default(TCandidate) var f = n[0] if f.kind == nkBracketExpr: # fill in the bindings: @@ -353,30 +516,18 @@ proc resolveOverloads(c: PContext, n, orig: PNode, else: initialBinding = nil - template pickBest(headSymbol) = + pickBestCandidate(c, f, n, orig, initialBinding, + filter, result, alt, errors, efExplain in flags, + errorsEnabled, flags) + + var dummyErrors: CandidateErrors = @[] + template pickSpecialOp(headSymbol) = pickBestCandidate(c, headSymbol, n, orig, initialBinding, - filter, result, alt, errors, efExplain in flags, - errorsEnabled) - pickBest(f) + filter, result, alt, dummyErrors, efExplain in flags, + false, flags) let overloadsState = result.state if overloadsState != csMatch: - if c.p != nil and c.p.selfSym != nil: - # we need to enforce semchecking of selfSym again because it - # might need auto-deref: - var hiddenArg = newSymNode(c.p.selfSym) - hiddenArg.typ = nil - n.sons.insert(hiddenArg, 1) - orig.sons.insert(hiddenArg, 1) - - pickBest(f) - - if result.state != csMatch: - n.sons.delete(1) - orig.sons.delete(1) - excl n.flags, nfExprCall - else: return - if nfDotField in n.flags: internalAssert c.config, f.kind == nkIdent and n.len >= 2 @@ -389,7 +540,7 @@ proc resolveOverloads(c: PContext, n, orig: PNode, let op = newIdentNode(getIdent(c.cache, x), n.info) n[0] = op orig[0] = op - pickBest(op) + pickSpecialOp(op) if nfExplicitCall in n.flags: tryOp ".()" @@ -403,10 +554,14 @@ proc resolveOverloads(c: PContext, n, orig: PNode, let callOp = newIdentNode(getIdent(c.cache, ".="), n.info) n.sons[0..1] = [callOp, n[1], calleeName] orig.sons[0..1] = [callOp, orig[1], calleeName] - pickBest(callOp) + pickSpecialOp(callOp) if overloadsState == csEmpty and result.state == csEmpty: if efNoUndeclared notin flags: # for tests/pragmas/tcustom_pragma.nim + result.state = csNoMatch + if c.inGenericContext > 0 and nfExprCall in n.flags: + # untyped expression calls end up here, see #24099 + return # xxx adapt/use errorUndeclaredIdentifierHint(c, n, f.ident) localError(c.config, n.info, getMsgDiagnostic(c, flags, n, f)) return @@ -441,6 +596,39 @@ proc resolveOverloads(c: PContext, n, orig: PNode, getProcHeader(c.config, alt.calleeSym), args]) +proc bracketNotFoundError(c: PContext; n: PNode; flags: TExprFlags) = + var errors: CandidateErrors = @[] + let headSymbol = n[0] + block: + # we build a closed symchoice of all `[]` overloads for their errors, + # except add a custom error for the magics which always match + var choice = newNodeIT(nkClosedSymChoice, headSymbol.info, newTypeS(tyNone, c)) + var o: TOverloadIter = default(TOverloadIter) + var symx = initOverloadIter(o, c, headSymbol) + while symx != nil: + if symx.kind in routineKinds: + if symx.magic in {mArrGet, mArrPut}: + errors.add(CandidateError(sym: symx, + firstMismatch: MismatchInfo(), + diagnostics: @[], + enabled: false)) + else: + choice.add newSymNode(symx, headSymbol.info) + symx = nextOverloadIter(o, c, headSymbol) + n[0] = choice + # copied from semOverloadedCallAnalyzeEffects, might be overkill: + const baseFilter = {skProc, skFunc, skMethod, skConverter, skMacro, skTemplate} + let filter = + if flags*{efInTypeof, efWantIterator, efWantIterable} != {}: + baseFilter + {skIterator} + else: baseFilter + # this will add the errors: + var r = resolveOverloads(c, n, n, filter, flags, errors, true) + if errors.len == 0: + localError(c.config, n.info, "could not resolve: " & $n) + else: + notFoundError(c, n, errors) + proc instGenericConvertersArg*(c: PContext, a: PNode, x: TCandidate) = let a = if a.kind == nkHiddenDeref: a[0] else: a if a.kind == nkHiddenCallConv and a[0].kind == nkSym: @@ -449,7 +637,7 @@ proc instGenericConvertersArg*(c: PContext, a: PNode, x: TCandidate) = let finalCallee = generateInstance(c, s, x.bindings, a.info) a[0].sym = finalCallee a[0].typ = finalCallee.typ - #a.typ = finalCallee.typ[0] + #a.typ = finalCallee.typ.returnType proc instGenericConvertersSons*(c: PContext, n: PNode, x: TCandidate) = assert n.kind in nkCallKinds @@ -482,7 +670,7 @@ proc inferWithMetatype(c: PContext, formal: PType, result = copyTree(arg) result.typ = formal -proc updateDefaultParams(call: PNode) = +proc updateDefaultParams(c: PContext, call: PNode) = # In generic procs, the default parameter may be unique for each # instantiation (see tlateboundgenericparams). # After a call is resolved, we need to re-assign any default value @@ -492,8 +680,18 @@ proc updateDefaultParams(call: PNode) = let calleeParams = call[0].sym.typ.n for i in 1..<call.len: if nfDefaultParam in call[i].flags: - let def = calleeParams[i].sym.ast + let formal = calleeParams[i].sym + let def = formal.ast if nfDefaultRefsParam in def.flags: call.flags.incl nfDefaultRefsParam + # mirrored with sigmatch: + if def.kind == nkEmpty: + # The default param value is set to empty in `instantiateProcType` + # when the type of the default expression doesn't match the type + # of the instantiated proc param: + pushInfoContext(c.config, call.info, call[0].sym.detailedInfo) + typeMismatch(c.config, def.info, formal.typ, def.typ, formal.ast) + popInfoContext(c.config) + def.typ = errorType(c) call[i] = def proc getCallLineInfo(n: PNode): TLineInfo = @@ -508,20 +706,77 @@ proc getCallLineInfo(n: PNode): TLineInfo = discard result = n.info -proc semResolvedCall(c: PContext, x: TCandidate, - n: PNode, flags: TExprFlags): PNode = +proc inheritBindings(c: PContext, x: var TCandidate, expectedType: PType) = + ## Helper proc to inherit bound generic parameters from expectedType into x. + ## Does nothing if 'inferGenericTypes' isn't in c.features. + if inferGenericTypes notin c.features: return + if expectedType == nil or x.callee.returnType == nil: return # required for inference + + var + flatUnbound: seq[PType] = @[] + flatBound: seq[PType] = @[] + # seq[(result type, expected type)] + var typeStack = newSeq[(PType, PType)]() + + template stackPut(a, b) = + ## skips types and puts the skipped version on stack + # It might make sense to skip here one by one. It's not part of the main + # type reduction because the right side normally won't be skipped + const toSkip = {tyVar, tyLent, tyStatic, tyCompositeTypeClass, tySink} + let + x = a.skipTypes(toSkip) + y = if a.kind notin toSkip: b + else: b.skipTypes(toSkip) + typeStack.add((x, y)) + + stackPut(x.callee.returnType, expectedType) + + while typeStack.len() > 0: + let (t, u) = typeStack.pop() + if t == u or t == nil or u == nil or t.kind == tyAnything or u.kind == tyAnything: + continue + case t.kind + of ConcreteTypes, tyGenericInvocation, tyUncheckedArray: + # XXX This logic makes no sense for `tyUncheckedArray` + # nested, add all the types to stack + let + startIdx = if u.kind in ConcreteTypes: 0 else: 1 + endIdx = min(u.kidsLen() - startIdx, t.kidsLen()) + + for i in startIdx ..< endIdx: + # early exit with current impl + if t[i] == nil or u[i] == nil: return + stackPut(t[i], u[i]) + of tyGenericParam: + let prebound = x.bindings.idTableGet(t) + if prebound != nil: + continue # Skip param, already bound + + # fully reduced generic param, bind it + if t notin flatUnbound: + flatUnbound.add(t) + flatBound.add(u) + else: + discard + # update bindings + for i in 0 ..< flatUnbound.len(): + x.bindings.idTablePut(flatUnbound[i], flatBound[i]) + +proc semResolvedCall(c: PContext, x: var TCandidate, + n: PNode, flags: TExprFlags; + expectedType: PType = nil): PNode = assert x.state == csMatch var finalCallee = x.calleeSym let info = getCallLineInfo(n) markUsed(c, info, finalCallee) onUse(info, finalCallee) assert finalCallee.ast != nil - if x.hasFauxMatch: + if x.matchedErrorType: result = x.call result[0] = newSymNode(finalCallee, getCallLineInfo(result[0])) - if containsGenericType(result.typ) or x.fauxMatch == tyUnknown: - result.typ = newTypeS(x.fauxMatch, c) - if result.typ.kind == tyError: incl result.typ.flags, tfCheckedForDestructor + if containsGenericType(result.typ): + result.typ = newTypeS(tyError, c) + incl result.typ.flags, tfCheckedForDestructor return let gp = finalCallee.ast[genericParamsPos] if gp.isGenericParams: @@ -529,27 +784,35 @@ proc semResolvedCall(c: PContext, x: TCandidate, if x.calleeSym.magic in {mArrGet, mArrPut}: finalCallee = x.calleeSym else: + c.inheritBindings(x, expectedType) finalCallee = generateInstance(c, x.calleeSym, x.bindings, n.info) else: # For macros and templates, the resolved generic params # are added as normal params. + c.inheritBindings(x, expectedType) for s in instantiateGenericParamList(c, gp, x.bindings): case s.kind of skConst: - if not s.ast.isNil: - x.call.add s.ast + if not s.astdef.isNil: + x.call.add s.astdef else: x.call.add c.graph.emptyNode of skType: - x.call.add newSymNode(s, n.info) + var tn = newSymNode(s, n.info) + # this node will be used in template substitution, + # pretend this is an untyped node and let regular sem handle the type + # to prevent problems where a generic parameter is treated as a value + tn.typ = nil + x.call.add tn else: internalAssert c.config, false result = x.call instGenericConvertersSons(c, result, x) result[0] = newSymNode(finalCallee, getCallLineInfo(result[0])) - result.typ = finalCallee.typ[0] - updateDefaultParams(result) + if finalCallee.magic notin {mArrGet, mArrPut}: + result.typ = finalCallee.typ.returnType + updateDefaultParams(c, result) proc canDeref(n: PNode): bool {.inline.} = result = n.len >= 2 and (let t = n[1].typ; @@ -561,7 +824,8 @@ proc tryDeref(n: PNode): PNode = result.add n proc semOverloadedCall(c: PContext, n, nOrig: PNode, - filter: TSymKinds, flags: TExprFlags): PNode {.nosinks.} = + filter: TSymKinds, flags: TExprFlags; + expectedType: PType = nil): PNode = var errors: CandidateErrors = @[] # if efExplain in flags: @[] else: nil var r = resolveOverloads(c, n, nOrig, filter, flags, errors, efExplain in flags) if r.state == csMatch: @@ -571,57 +835,36 @@ proc semOverloadedCall(c: PContext, n, nOrig: PNode, message(c.config, n.info, hintUserRaw, "Non-matching candidates for " & renderTree(n) & "\n" & candidates) - result = semResolvedCall(c, r, n, flags) - elif implicitDeref in c.features and canDeref(n): - # try to deref the first argument and then try overloading resolution again: - # - # XXX: why is this here? - # it could be added to the long list of alternatives tried - # inside `resolveOverloads` or it could be moved all the way - # into sigmatch with hidden conversion produced there - # - n[1] = n[1].tryDeref - var r = resolveOverloads(c, n, nOrig, filter, flags, errors, efExplain in flags) - if r.state == csMatch: result = semResolvedCall(c, r, n, flags) - else: - # get rid of the deref again for a better error message: - n[1] = n[1][0] - #notFoundError(c, n, errors) - if efExplain notin flags: - # repeat the overload resolution, - # this time enabling all the diagnostic output (this should fail again) - discard semOverloadedCall(c, n, nOrig, filter, flags + {efExplain}) - elif efNoUndeclared notin flags: - notFoundError(c, n, errors) + result = semResolvedCall(c, r, n, flags, expectedType) else: - if efExplain notin flags: + if c.inGenericContext > 0 and c.matchedConcept == nil: + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, result.copyTree) + elif efExplain notin flags: # repeat the overload resolution, # this time enabling all the diagnostic output (this should fail again) - discard semOverloadedCall(c, n, nOrig, filter, flags + {efExplain}) + result = semOverloadedCall(c, n, nOrig, filter, flags + {efExplain}) elif efNoUndeclared notin flags: + result = nil notFoundError(c, n, errors) + else: + result = nil proc explicitGenericInstError(c: PContext; n: PNode): PNode = localError(c.config, getCallLineInfo(n), errCannotInstantiateX % renderTree(n)) result = n proc explicitGenericSym(c: PContext, n: PNode, s: PSym): PNode = + if s.kind in {skTemplate, skMacro}: + internalError c.config, n.info, "cannot get explicitly instantiated symbol of " & + (if s.kind == skTemplate: "template" else: "macro") # binding has to stay 'nil' for this to work! var m = newCandidate(c, s, nil) - - for i in 1..<n.len: - let formal = s.ast[genericParamsPos][i-1].typ - var arg = n[i].typ - # try transforming the argument into a static one before feeding it into - # typeRel - if formal.kind == tyStatic and arg.kind != tyStatic: - let evaluated = c.semTryConstExpr(c, n[i]) - if evaluated != nil: - arg = newTypeS(tyStatic, c) - arg.sons = @[evaluated.typ] - arg.n = evaluated - let tm = typeRel(m, formal, arg) - if tm in {isNone, isConvertible}: return nil + matchGenericParams(m, n, s) + if m.state != csMatch: + # state is csMatch only if *all* generic params were matched, + # including implicit parameters + return nil var newInst = generateInstance(c, s, m.bindings, n.info) newInst.typ.flags.excl tfUnresolved let info = getCallLineInfo(n) @@ -629,14 +872,24 @@ proc explicitGenericSym(c: PContext, n: PNode, s: PSym): PNode = onUse(info, s) result = newSymNode(newInst, info) -proc explicitGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = - assert n.kind == nkBracketExpr +proc setGenericParams(c: PContext, n, expectedParams: PNode) = + ## sems generic params in subscript expression for i in 1..<n.len: - let e = semExpr(c, n[i]) + let + constraint = + if expectedParams != nil and i <= expectedParams.len: + expectedParams[i - 1].typ + else: + nil + e = semExprWithType(c, n[i], expectedType = constraint) if e.typ == nil: n[i].typ = errorType(c) else: n[i].typ = e.typ.skipTypes({tyTypeDesc}) + +proc explicitGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = + assert n.kind == nkBracketExpr + setGenericParams(c, n, s.ast[genericParamsPos]) var s = s var a = n[0] if a.kind == nkSym: @@ -671,32 +924,58 @@ proc explicitGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = else: result = explicitGenericInstError(c, n) -proc searchForBorrowProc(c: PContext, startScope: PScope, fn: PSym): PSym = +proc searchForBorrowProc(c: PContext, startScope: PScope, fn: PSym): tuple[s: PSym, state: TBorrowState] = # Searches for the fn in the symbol table. If the parameter lists are suitable # for borrowing the sym in the symbol table is returned, else nil. # New approach: generate fn(x, y, z) where x, y, z have the proper types # and use the overloading resolution mechanism: + const desiredTypes = abstractVar + {tyCompositeTypeClass} - {tyTypeDesc, tyDistinct} + + template getType(isDistinct: bool; t: PType):untyped = + if isDistinct: t.baseOfDistinct(c.graph, c.idgen) else: t + + result = default(tuple[s: PSym, state: TBorrowState]) var call = newNodeI(nkCall, fn.info) var hasDistinct = false + var isDistinct: bool + var x: PType + var t: PType call.add(newIdentNode(fn.name, fn.info)) for i in 1..<fn.typ.n.len: let param = fn.typ.n[i] - let t = skipTypes(param.typ, abstractVar-{tyTypeDesc, tyDistinct}) - if t.kind == tyDistinct or param.typ.kind == tyDistinct: hasDistinct = true - var x: PType + #[. + # We only want the type not any modifiers such as `ptr`, `var`, `ref` ... + # tyCompositeTypeClass is here for + # when using something like: + type Foo[T] = distinct int + proc `$`(f: Foo): string {.borrow.} + # We want to skip the `Foo` to get `int` + ]# + t = skipTypes(param.typ, desiredTypes) + isDistinct = t.kind == tyDistinct or param.typ.kind == tyDistinct + if t.kind == tyGenericInvocation and t.genericHead.last.kind == tyDistinct: + result.state = bsGeneric + return + if isDistinct: hasDistinct = true if param.typ.kind == tyVar: x = newTypeS(param.typ.kind, c) - x.addSonSkipIntLit(t.baseOfDistinct(c.graph, c.idgen), c.idgen) + x.addSonSkipIntLit(getType(isDistinct, t), c.idgen) else: - x = t.baseOfDistinct(c.graph, c.idgen) - call.add(newNodeIT(nkEmpty, fn.info, x)) + x = getType(isDistinct, t) + var s = copySym(param.sym, c.idgen) + s.typ = x + s.info = param.info + call.add(newSymNode(s)) if hasDistinct: let filter = if fn.kind in {skProc, skFunc}: {skProc, skFunc} else: {fn.kind} var resolved = semOverloadedCall(c, call, call, filter, {}) if resolved != nil: - result = resolved[0].sym - if not compareTypes(result.typ[0], fn.typ[0], dcEqIgnoreDistinct): - result = nil - elif result.magic in {mArrPut, mArrGet}: + result.s = resolved[0].sym + result.state = bsMatch + if not compareTypes(result.s.typ.returnType, fn.typ.returnType, dcEqIgnoreDistinct, {IgnoreFlags}): + result.state = bsReturnNotMatch + elif result.s.magic in {mArrPut, mArrGet}: # cannot borrow these magics for now - result = nil + result.state = bsNotSupported + else: + result.state = bsNoDistinct diff --git a/compiler/semdata.nim b/compiler/semdata.nim index c655047e2..ca35ddc53 100644 --- a/compiler/semdata.nim +++ b/compiler/semdata.nim @@ -9,11 +9,14 @@ ## This module contains the data structures for the semantic checking phase. -import std / tables +import std/[tables, intsets, sets] + +when defined(nimPreviewSlimSystem): + import std/assertions import - intsets, options, ast, astalgo, msgs, idents, renderer, - magicsys, vmdef, modulegraphs, lineinfos, sets, pathutils + options, ast, astalgo, msgs, idents, renderer, + magicsys, vmdef, modulegraphs, lineinfos, pathutils import ic / ic @@ -29,18 +32,16 @@ type POptionEntry* = ref TOptionEntry PProcCon* = ref TProcCon - TProcCon* = object # procedure context; also used for top-level - # statements + TProcCon* {.acyclic.} = object # procedure context; also used for top-level + # statements owner*: PSym # the symbol this context belongs to resultSym*: PSym # the result symbol (if we are in a proc) - selfSym*: PSym # the 'self' symbol (if available) nestedLoopCounter*: int # whether we are in a loop or not nestedBlockCounter*: int # whether we are in a block or not - inTryStmt*: int # whether we are in a try statement; works also - # in standalone ``except`` and ``finally`` + breakInLoop*: bool # whether we are in a loop without block next*: PProcCon # used for stacking procedure contexts mappingExists*: bool - mapping*: TIdTable + mapping*: Table[ItemId, PSym] caseContext*: seq[tuple[n: PNode, idx: int]] localBindStmts*: seq[PNode] @@ -54,7 +55,7 @@ type inst*: PInstantiation TExprFlag* = enum - efLValue, efWantIterator, efInTypeof, + efLValue, efWantIterator, efWantIterable, efInTypeof, efNeedStatic, # Use this in contexts where a static value is mandatory efPreferStatic, @@ -67,11 +68,15 @@ type # you may be in position to supply a better error message # to the user. efWantStmt, efAllowStmt, efDetermineType, efExplain, - efAllowDestructor, efWantValue, efOperand, efNoSemCheck, + efWantValue, efOperand, efNoSemCheck, efNoEvaluateGeneric, efInCall, efFromHlo, efNoSem2Check, - efNoUndeclared + efNoUndeclared, efIsDotCall, efCannotBeDotCall, # Use this if undeclared identifiers should not raise an error during # overload resolution. + efTypeAllowed # typeAllowed will be called after + efWantNoDefaults + efIgnoreDefaults # var statements without initialization + efAllowSymChoice # symchoice node should not be resolved TExprFlags* = set[TExprFlag] @@ -90,6 +95,9 @@ type TContext* = object of TPassContext # a context represents the module # that is currently being compiled enforceVoidContext*: PType + # for `if cond: stmt else: foo`, `foo` will be evaluated under + # enforceVoidContext != nil + voidType*: PType # for typeof(stmt) module*: PSym # the module sym belonging to the context currentScope*: PScope # current scope moduleScope*: PScope # scope for modules @@ -114,24 +122,26 @@ type converters*: seq[PSym] patterns*: seq[PSym] # sequence of pattern matchers optionStack*: seq[POptionEntry] - symMapping*: TIdTable # every gensym'ed symbol needs to be mapped - # to some new symbol in a generic instantiation libs*: seq[PLib] # all libs used by this module - semConstExpr*: proc (c: PContext, n: PNode): PNode {.nimcall.} # for the pragmas - semExpr*: proc (c: PContext, n: PNode, flags: TExprFlags = {}): PNode {.nimcall.} + semConstExpr*: proc (c: PContext, n: PNode; expectedType: PType = nil): PNode {.nimcall.} # for the pragmas + semExpr*: proc (c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType = nil): PNode {.nimcall.} + semExprWithType*: proc (c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType = nil): PNode {.nimcall.} semTryExpr*: proc (c: PContext, n: PNode, flags: TExprFlags = {}): PNode {.nimcall.} - semTryConstExpr*: proc (c: PContext, n: PNode): PNode {.nimcall.} + semTryConstExpr*: proc (c: PContext, n: PNode; expectedType: PType = nil): PNode {.nimcall.} computeRequiresInit*: proc (c: PContext, t: PType): bool {.nimcall.} hasUnresolvedArgs*: proc (c: PContext, n: PNode): bool semOperand*: proc (c: PContext, n: PNode, flags: TExprFlags = {}): PNode {.nimcall.} semConstBoolExpr*: proc (c: PContext, n: PNode): PNode {.nimcall.} # XXX bite the bullet semOverloadedCall*: proc (c: PContext, n, nOrig: PNode, - filter: TSymKinds, flags: TExprFlags): PNode {.nimcall.} + filter: TSymKinds, flags: TExprFlags, expectedType: PType = nil): PNode {.nimcall.} semTypeNode*: proc(c: PContext, n: PNode, prev: PType): PType {.nimcall.} - semInferredLambda*: proc(c: PContext, pt: TIdTable, n: PNode): PNode - semGenerateInstance*: proc (c: PContext, fn: PSym, pt: TIdTable, + semInferredLambda*: proc(c: PContext, pt: Table[ItemId, PType], n: PNode): PNode + semGenerateInstance*: proc (c: PContext, fn: PSym, pt: Table[ItemId, PType], info: TLineInfo): PSym + instantiateOnlyProcType*: proc (c: PContext, pt: TypeMapping, + prc: PSym, info: TLineInfo): PType + # used by sigmatch for explicit generic instantiations includedFiles*: IntSet # used to detect recursive include files pureEnumFields*: TStrTable # pure enum fields that can be used unambiguously userPragmas*: TStrTable @@ -145,7 +155,6 @@ type inParallelStmt*: int instTypeBoundOp*: proc (c: PContext; dc: PSym; t: PType; info: TLineInfo; op: TTypeAttachedOp; col: int): PSym {.nimcall.} - selfName*: PIdent cache*: IdentCache graph*: ModuleGraph signatures*: TStrTable @@ -155,8 +164,16 @@ type features*: set[Feature] inTypeContext*, inConceptDecl*: int unusedImports*: seq[(PSym, TLineInfo)] - exportIndirections*: HashSet[(int, int)] + exportIndirections*: HashSet[(int, int)] # (module.id, symbol.id) + importModuleMap*: Table[int, int] # (module.id, module.id) lastTLineInfo*: TLineInfo + sideEffects*: Table[int, seq[(TLineInfo, PSym)]] # symbol.id index + inUncheckedAssignSection*: int + importModuleLookup*: Table[int, seq[int]] # (module.ident.id, [module.id]) + skipTypes*: seq[PNode] # used to skip types between passes in type section. So far only used for inheritance, sets and generic bodies. + inTypeofContext*: int + TBorrowState* = enum + bsNone, bsReturnNotMatch, bsNoDistinct, bsGeneric, bsNotSupported, bsMatch template config*(c: PContext): ConfigRef = c.graph.config @@ -167,12 +184,12 @@ proc getIntLitType*(c: PContext; literal: PNode): PType = result = c.intTypeCache[value.int] if result == nil: let ti = getSysType(c.graph, literal.info, tyInt) - result = copyType(ti, nextTypeId(c.idgen), ti.owner) + result = copyType(ti, c.idgen, ti.owner) result.n = literal c.intTypeCache[value.int] = result else: let ti = getSysType(c.graph, literal.info, tyInt) - result = copyType(ti, nextTypeId(c.idgen), ti.owner) + result = copyType(ti, c.idgen, ti.owner) result.n = literal proc setIntLitType*(c: PContext; result: PNode) = @@ -205,12 +222,11 @@ proc setIntLitType*(c: PContext; result: PNode) = internalError(c.config, result.info, "invalid int size") proc makeInstPair*(s: PSym, inst: PInstantiation): TInstantiationPair = - result.genericSym = s - result.inst = inst + result = TInstantiationPair(genericSym: s, inst: inst) proc filename*(c: PContext): string = # the module's filename - return toFilename(c.config, FileIndex c.module.position) + result = toFilename(c.config, FileIndex c.module.position) proc scopeDepth*(c: PContext): int {.inline.} = result = if c.currentScope != nil: c.currentScope.depthLevel @@ -237,14 +253,14 @@ proc popProcCon*(c: PContext) {.inline.} = c.p = c.p.next proc put*(p: PProcCon; key, val: PSym) = if not p.mappingExists: - initIdTable(p.mapping) + p.mapping = initTable[ItemId, PSym]() p.mappingExists = true #echo "put into table ", key.info - p.mapping.idTablePut(key, val) + p.mapping[key.itemId] = val proc get*(p: PProcCon; key: PSym): PSym = if not p.mappingExists: return nil - result = PSym(p.mapping.idTableGet(key)) + result = p.mapping.getOrDefault(key.itemId) proc getGenSym*(c: PContext; s: PSym): PSym = if sfGenSym notin s.flags: return s @@ -258,7 +274,9 @@ proc getGenSym*(c: PContext; s: PSym): PSym = result = s proc considerGenSyms*(c: PContext; n: PNode) = - if n.kind == nkSym: + if n == nil: + discard "can happen for nkFormalParams/nkArgList" + elif n.kind == nkSym: let s = getGenSym(c, n.sym) if n.sym != s: n.sym = s @@ -301,17 +319,18 @@ proc newContext*(graph: ModuleGraph; module: PSym): PContext = result.converters = @[] result.patterns = @[] result.includedFiles = initIntSet() - initStrTable(result.pureEnumFields) - initStrTable(result.userPragmas) + result.pureEnumFields = initStrTable() + result.userPragmas = initStrTable() result.generics = @[] result.unknownIdents = initIntSet() result.cache = graph.cache result.graph = graph - initStrTable(result.signatures) + result.signatures = initStrTable() result.features = graph.config.features if graph.config.symbolFiles != disabledSf: let id = module.position - assert graph.packed[id].status in {undefined, outdated} + if graph.config.cmd != cmdM: + assert graph.packed[id].status in {undefined, outdated} graph.packed[id].status = storing graph.packed[id].module = module initEncoder graph, module @@ -341,6 +360,9 @@ proc addConverter*(c: PContext, conv: LazySym) = assert conv.sym != nil if inclSym(c.converters, conv.sym): add(c.graph.ifaces[c.module.position].converters, conv) + +proc addConverterDef*(c: PContext, conv: LazySym) = + addConverter(c, conv) if c.config.symbolFiles != disabledSf: addConverter(c.encoder, c.packedRepr, conv.sym) @@ -358,30 +380,29 @@ proc addPattern*(c: PContext, p: LazySym) = addTrmacro(c.encoder, c.packedRepr, p.sym) proc exportSym*(c: PContext; s: PSym) = - strTableAdd(c.module.semtab(c.graph), s) + strTableAdds(c.graph, c.module, s) if c.config.symbolFiles != disabledSf: addExported(c.encoder, c.packedRepr, s) proc reexportSym*(c: PContext; s: PSym) = - strTableAdd(c.module.semtab(c.graph), s) + strTableAdds(c.graph, c.module, s) if c.config.symbolFiles != disabledSf: addReexport(c.encoder, c.packedRepr, s) proc newLib*(kind: TLibKind): PLib = new(result) - result.kind = kind #initObjectSet(result.syms) + result.kind = kind #result.syms = initObjectSet() proc addToLib*(lib: PLib, sym: PSym) = #if sym.annex != nil and not isGenericRoutine(sym): # LocalError(sym.info, errInvalidPragma) sym.annex = lib -proc newTypeS*(kind: TTypeKind, c: PContext): PType = - result = newType(kind, nextTypeId(c.idgen), getCurrOwner(c)) +proc newTypeS*(kind: TTypeKind; c: PContext; son: sink PType = nil): PType = + result = newType(kind, c.idgen, getCurrOwner(c), son = son) proc makePtrType*(owner: PSym, baseType: PType; idgen: IdGenerator): PType = - result = newType(tyPtr, nextTypeId(idgen), owner) - addSonSkipIntLit(result, baseType, idgen) + result = newType(tyPtr, idgen, owner, skipIntLit(baseType, idgen)) proc makePtrType*(c: PContext, baseType: PType): PType = makePtrType(getCurrOwner(c), baseType, c.idgen) @@ -394,29 +415,20 @@ proc makeTypeWithModifier*(c: PContext, if modifier in {tyVar, tyLent, tyTypeDesc} and baseType.kind == modifier: result = baseType else: - result = newTypeS(modifier, c) - addSonSkipIntLit(result, baseType, c.idgen) + result = newTypeS(modifier, c, skipIntLit(baseType, c.idgen)) proc makeVarType*(c: PContext, baseType: PType; kind = tyVar): PType = if baseType.kind == kind: result = baseType else: - result = newTypeS(kind, c) - addSonSkipIntLit(result, baseType, c.idgen) - -proc makeVarType*(owner: PSym, baseType: PType; idgen: IdGenerator; kind = tyVar): PType = - if baseType.kind == kind: - result = baseType - else: - result = newType(kind, nextTypeId(idgen), owner) - addSonSkipIntLit(result, baseType, idgen) + result = newTypeS(kind, c, skipIntLit(baseType, c.idgen)) proc makeTypeSymNode*(c: PContext, typ: PType, info: TLineInfo): PNode = let typedesc = newTypeS(tyTypeDesc, c) incl typedesc.flags, tfCheckedForDestructor internalAssert(c.config, typ != nil) typedesc.addSonSkipIntLit(typ, c.idgen) - let sym = newSym(skType, c.cache.idAnon, nextSymId(c.idgen), getCurrOwner(c), info, + let sym = newSym(skType, c.cache.idAnon, c.idgen, getCurrOwner(c), info, c.config.options).linkTo(typedesc) result = newSymNode(sym, info) @@ -425,38 +437,40 @@ proc makeTypeFromExpr*(c: PContext, n: PNode): PType = assert n != nil result.n = n -proc newTypeWithSons*(owner: PSym, kind: TTypeKind, sons: seq[PType]; - idgen: IdGenerator): PType = - result = newType(kind, nextTypeId(idgen), owner) - result.sons = sons +when false: + proc newTypeWithSons*(owner: PSym, kind: TTypeKind, sons: seq[PType]; + idgen: IdGenerator): PType = + result = newType(kind, idgen, owner, sons = sons) -proc newTypeWithSons*(c: PContext, kind: TTypeKind, - sons: seq[PType]): PType = - result = newType(kind, nextTypeId(c.idgen), getCurrOwner(c)) - result.sons = sons + proc newTypeWithSons*(c: PContext, kind: TTypeKind, + sons: seq[PType]): PType = + result = newType(kind, c.idgen, getCurrOwner(c), sons = sons) proc makeStaticExpr*(c: PContext, n: PNode): PNode = result = newNodeI(nkStaticExpr, n.info) result.sons = @[n] result.typ = if n.typ != nil and n.typ.kind == tyStatic: n.typ - else: newTypeWithSons(c, tyStatic, @[n.typ]) + else: newTypeS(tyStatic, c, n.typ) proc makeAndType*(c: PContext, t1, t2: PType): PType = result = newTypeS(tyAnd, c) - result.sons = @[t1, t2] + result.rawAddSon t1 + result.rawAddSon t2 propagateToOwner(result, t1) propagateToOwner(result, t2) result.flags.incl((t1.flags + t2.flags) * {tfHasStatic}) result.flags.incl tfHasMeta proc makeOrType*(c: PContext, t1, t2: PType): PType = - result = newTypeS(tyOr, c) if t1.kind != tyOr and t2.kind != tyOr: - result.sons = @[t1, t2] + result = newTypeS(tyOr, c) + result.rawAddSon t1 + result.rawAddSon t2 else: + result = newTypeS(tyOr, c) template addOr(t1) = if t1.kind == tyOr: - for x in t1.sons: result.rawAddSon x + for x in t1.kids: result.rawAddSon x else: result.rawAddSon t1 addOr(t1) @@ -467,8 +481,7 @@ proc makeOrType*(c: PContext, t1, t2: PType): PType = result.flags.incl tfHasMeta proc makeNotType*(c: PContext, t1: PType): PType = - result = newTypeS(tyNot, c) - result.sons = @[t1] + result = newTypeS(tyNot, c, son = t1) propagateToOwner(result, t1) result.flags.incl(t1.flags * {tfHasStatic}) result.flags.incl tfHasMeta @@ -479,8 +492,7 @@ proc nMinusOne(c: PContext; n: PNode): PNode = # Remember to fix the procs below this one when you make changes! proc makeRangeWithStaticExpr*(c: PContext, n: PNode): PType = let intType = getSysType(c.graph, n.info, tyInt) - result = newTypeS(tyRange, c) - result.sons = @[intType] + result = newTypeS(tyRange, c, son = intType) if n.typ != nil and n.typ.n == nil: result.flags.incl tfUnresolved result.n = newTreeI(nkRange, n.info, newIntTypeNode(0, intType), @@ -498,6 +510,25 @@ proc errorNode*(c: PContext, n: PNode): PNode = result = newNodeI(nkEmpty, n.info) 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 = + let n2 = n + liMessage(c.config, n2.info, errGenerated, arg, doNothing, instLoc()) + errorNode(c, n2) + proc fillTypeS*(dest: PType, kind: TTypeKind, c: PContext) = dest.kind = kind dest.owner = getCurrOwner(c) @@ -513,6 +544,27 @@ proc makeRangeType*(c: PContext; first, last: BiggestInt; result.n = n addSonSkipIntLit(result, intType, c.idgen) # basetype of range +proc isSelf*(t: PType): bool {.inline.} = + ## Is this the magical 'Self' type from concepts? + t.kind == tyTypeDesc and tfPacked in t.flags + +proc makeTypeDesc*(c: PContext, typ: PType): PType = + if typ.kind == tyTypeDesc and not isSelf(typ): + result = typ + else: + result = newTypeS(tyTypeDesc, c, skipIntLit(typ, c.idgen)) + incl result.flags, tfCheckedForDestructor + +proc symFromType*(c: PContext; t: PType, info: TLineInfo): PSym = + if t.sym != nil: return t.sym + result = newSym(skType, getIdent(c.cache, "AnonType"), c.idgen, t.owner, info) + result.flags.incl sfAnon + result.typ = t + +proc symNodeFromType*(c: PContext, t: PType, info: TLineInfo): PNode = + result = newSymNode(symFromType(c, t, info), info) + result.typ = makeTypeDesc(c, t) + proc markIndirect*(c: PContext, s: PSym) {.inline.} = if s.kind in {skProc, skFunc, skConverter, skMethod, skIterator}: incl(s.flags, sfAddrTaken) @@ -533,6 +585,10 @@ proc checkMinSonsLen*(n: PNode, length: int; conf: ConfigRef) = proc isTopLevel*(c: PContext): bool {.inline.} = result = c.currentScope.depthLevel <= 2 +proc isTopLevelInsideDeclaration*(c: PContext, sym: PSym): bool {.inline.} = + # for routeKinds the scope isn't closed yet: + c.currentScope.depthLevel <= 2 + ord(sym.kind in routineKinds) + proc pushCaseContext*(c: PContext, caseNode: PNode) = c.p.caseContext.add((caseNode, 0)) @@ -567,3 +623,13 @@ proc sealRodFile*(c: PContext) = if m == c.module: addPragmaComputation(c, n) c.idgen.sealed = true # no further additions are allowed + +proc rememberExpansion*(c: PContext; info: TLineInfo; expandedSym: PSym) = + ## Templates and macros are very special in Nim; these have + ## inlining semantics so after semantic checking they leave no trace + ## in the sem'checked AST. This is very bad for IDE-like tooling + ## ("find all usages of this template" would not work). We need special + ## logic to remember macro/template expansions. This is done here and + ## delegated to the "rod" file mechanism. + if c.config.symbolFiles != disabledSf: + storeExpansion(c.encoder, c.packedRepr, info, expandedSym) diff --git a/compiler/semexprs.nim b/compiler/semexprs.nim index 27b78aa6f..2885142a7 100644 --- a/compiler/semexprs.nim +++ b/compiler/semexprs.nim @@ -10,7 +10,7 @@ # this module does the semantic checking for expressions # included from sem.nim -when defined(nimCompilerStackraceHints): +when defined(nimCompilerStacktraceHints): import std/stackframes const @@ -26,7 +26,8 @@ const errUndeclaredFieldX = "undeclared field: '$1'" proc semTemplateExpr(c: PContext, n: PNode, s: PSym, - flags: TExprFlags = {}): PNode = + flags: TExprFlags = {}; expectedType: PType = nil): PNode = + rememberExpansion(c, n.info, s) let info = getCallLineInfo(n) markUsed(c, info, s) onUse(info, s) @@ -35,7 +36,8 @@ proc semTemplateExpr(c: PContext, n: PNode, s: PSym, pushInfoContext(c.config, n.info, s.detailedInfo) 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) + if efNoSemCheck notin flags: + result = semAfterMacroCall(c, n, result, s, flags, expectedType) popInfoContext(c.config) # XXX: A more elaborate line info rewrite might be needed @@ -50,11 +52,8 @@ template rejectEmptyNode(n: PNode) = proc semOperand(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = rejectEmptyNode(n) # same as 'semExprWithType' but doesn't check for proc vars - result = semExpr(c, n, flags + {efOperand}) + result = semExpr(c, n, flags + {efOperand, efAllowSymChoice}) if result.typ != nil: - # XXX tyGenericInst here? - if result.typ.kind == tyProc and tfUnresolved in result.typ.flags: - localError(c.config, n.info, errProcHasNoConcreteType % n.renderTree) if result.typ.kind in {tyVar, tyLent}: result = newDeref(result) elif {efWantStmt, efAllowStmt} * flags != {}: result.typ = newTypeS(tyVoid, c) @@ -63,9 +62,9 @@ proc semOperand(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = renderTree(result, {renderNoComments})) result.typ = errorType(c) -proc semExprCheck(c: PContext, n: PNode, flags: TExprFlags): PNode = +proc semExprCheck(c: PContext, n: PNode, flags: TExprFlags, expectedType: PType = nil): PNode = rejectEmptyNode(n) - result = semExpr(c, n, flags+{efWantValue}) + result = semExpr(c, n, flags+{efWantValue}, expectedType) let isEmpty = result.kind == nkEmpty @@ -80,15 +79,29 @@ proc semExprCheck(c: PContext, n: PNode, flags: TExprFlags): PNode = # do not produce another redundant error message: result = errorNode(c, n) -proc semExprWithType(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = - result = semExprCheck(c, n, flags) - if result.typ == nil or result.typ == c.enforceVoidContext: +proc semExprWithType(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType = nil): PNode = + result = semExprCheck(c, n, flags-{efTypeAllowed}, expectedType) + 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})) result.typ = errorType(c) elif result.typ.kind == tyError: # associates the type error to the current owner result.typ = errorType(c) + elif efTypeAllowed in flags and result.typ.kind == tyProc and + hasUnresolvedParams(result, {}): + # mirrored with semOperand but only on efTypeAllowed + let owner = result.typ.owner + let err = + # consistent error message with evaltempl/semMacroExpr + if owner != nil and owner.kind in {skTemplate, skMacro}: + errMissingGenericParamsForTemplate % n.renderTree + else: + errProcHasNoConcreteType % n.renderTree + localError(c.config, n.info, err) + result.typ = errorType(c) else: if result.typ.kind in {tyVar, tyLent}: result = newDeref(result) @@ -102,8 +115,114 @@ proc semExprNoDeref(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = proc semSymGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = result = symChoice(c, n, s, scClosed) +proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode + +proc isSymChoice(n: PNode): bool {.inline.} = + result = n.kind in nkSymChoices + +proc resolveSymChoice(c: PContext, n: var PNode, flags: TExprFlags = {}, expectedType: PType = nil) = + ## Attempts to resolve a symchoice `n`, `n` remains a symchoice if + ## it cannot be resolved (this is the case even when `n.len == 1`). + if expectedType != nil: + # resolve from type inference, see paramTypesMatch + n = fitNode(c, expectedType, n, n.info) + if isSymChoice(n) and efAllowSymChoice notin flags: + # some contexts might want sym choices preserved for later disambiguation + # in general though they are ambiguous + let first = n[0].sym + var foundSym: PSym = nil + if first.kind == skEnumField and + not isAmbiguous(c, first.name, {skEnumField}, foundSym) and + foundSym == first: + # choose the first resolved enum field, i.e. the latest in scope + # to mirror behavior before overloadable enums + n = n[0] + +proc semOpenSym(c: PContext, n: PNode, flags: TExprFlags, expectedType: PType, + warnDisabled = false): PNode = + ## sem the child of an `nkOpenSym` node, that is, captured symbols that can be + ## replaced by newly injected symbols in generics. `s` must be the captured + ## symbol if the original node is an `nkSym` node; and `nil` if it is an + ## `nkOpenSymChoice`, in which case only non-overloadable injected symbols + ## will be considered. + let isSym = n.kind == nkSym + let ident = n.getPIdent + assert ident != nil + let id = newIdentNode(ident, n.info) + c.isAmbiguous = false + let s2 = qualifiedLookUp(c, id, {}) + # for `nkSym`, the first found symbol being different and unambiguous is + # enough to replace the original + # for `nkOpenSymChoice`, the first found symbol must be non-overloadable, + # since otherwise we have to use regular `nkOpenSymChoice` functionality + # but of the overloadable sym kinds, semExpr does not handle skModule, skMacro, skTemplate + # as overloaded in the case where `nkIdent` finds them first + if s2 != nil and not c.isAmbiguous and + ((isSym and s2 != n.sym) or + (not isSym and s2.kind notin OverloadableSyms-{skModule, skMacro, skTemplate})): + # only consider symbols defined under current proc: + var o = s2.owner + while o != nil: + if o == c.p.owner: + if not warnDisabled: + result = semExpr(c, id, flags, expectedType) + return + else: + var msg = + "a new symbol '" & ident.s & "' has been injected during " & + # msgContext should show what is being instantiated: + "template or generic instantiation, however " + if isSym: + msg.add( + getSymRepr(c.config, n.sym) & " captured at " & + "the proc declaration will be used instead; " & + "either enable --experimental:openSym to use the injected symbol, " & + "or `bind` this captured symbol explicitly") + else: + msg.add( + "overloads of " & ident.s & " will be used instead; " & + "either enable --experimental:openSym to use the injected symbol, " & + "or `bind` this symbol explicitly") + message(c.config, n.info, warnIgnoredSymbolInjection, msg) + break + o = o.owner + # nothing found + n.flags.excl nfDisabledOpenSym + if not warnDisabled and isSym: + result = semExpr(c, n, flags, expectedType) + else: + result = nil + if not isSym: + # set symchoice node type back to None + n.typ = newTypeS(tyNone, c) + +proc semSymChoice(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType = nil): PNode = + if n.kind == nkOpenSymChoice: + result = semOpenSym(c, n, flags, expectedType, + warnDisabled = nfDisabledOpenSym in n.flags and + genericsOpenSym notin c.features) + if result != nil: + return + result = n + resolveSymChoice(c, result, flags, expectedType) + if isSymChoice(result) and result.len == 1: + # resolveSymChoice can leave 1 sym + result = result[0] + if isSymChoice(result) and efAllowSymChoice notin flags: + var err = "ambiguous identifier: '" & result[0].sym.name.s & + "' -- use one of the following:\n" + for child in n: + let candidate = child.sym + err.add " " & candidate.owner.name.s & "." & candidate.name.s + err.add ": " & typeToString(candidate.typ) & "\n" + localError(c.config, n.info, err) + n.typ = errorType(c) + result = n + if result.kind == nkSym: + result = semSym(c, result, result.sym, flags) + proc inlineConst(c: PContext, n: PNode, s: PSym): PNode {.inline.} = - result = copyTree(s.ast) + result = copyTree(s.astdef) if result.isNil: localError(c.config, n.info, "constant of type '" & typeToString(s.typ) & "' has no value") result = newSymNode(s) @@ -139,19 +258,19 @@ proc checkConvertible(c: PContext, targetTyp: PType, src: PNode): TConvStatus = var d = skipTypes(targetTyp, abstractVar) var s = srcTyp if s.kind in tyUserTypeClasses and s.isResolvedUserTypeClass: - s = s.lastSon + s = s.last s = skipTypes(s, abstractVar-{tyTypeDesc, tyOwned}) if s.kind == tyOwned and d.kind != tyOwned: - s = s.lastSon + s = s.skipModifier var pointers = 0 while (d != nil) and (d.kind in {tyPtr, tyRef, tyOwned}): if s.kind == tyOwned and d.kind != tyOwned: - s = s.lastSon + s = s.skipModifier elif d.kind != s.kind: break else: - d = d.lastSon - s = s.lastSon + d = d.elementType + s = s.elementType inc pointers let targetBaseTyp = skipTypes(targetTyp, abstractVarRange) @@ -163,11 +282,16 @@ proc checkConvertible(c: PContext, targetTyp: PType, src: PNode): TConvStatus = result = checkConversionBetweenObjects(d.skipTypes(abstractInst), s.skipTypes(abstractInst), pointers) elif (targetBaseTyp.kind in IntegralTypes) and (srcBaseTyp.kind in IntegralTypes): + if targetTyp.kind == tyEnum and srcBaseTyp.kind == tyEnum and + not sameType(targetTyp, srcBaseTyp): + message(c.config, src.info, warnSuspiciousEnumConv, "suspicious code: enum to enum conversion") + # `elif` would be incorrect here if targetTyp.kind == tyBool: discard "convOk" elif targetTyp.isOrdinalType: if src.kind in nkCharLit..nkUInt64Lit and - src.getInt notin firstOrd(c.config, targetTyp)..lastOrd(c.config, targetTyp): + src.getInt notin firstOrd(c.config, targetTyp)..lastOrd(c.config, targetTyp) and + targetTyp.kind notin {tyUInt..tyUInt64}: result = convNotInRange elif src.kind in nkFloatLit..nkFloat64Lit and (classify(src.floatVal) in {fcNan, fcNegInf, fcInf} or @@ -182,6 +306,9 @@ proc checkConvertible(c: PContext, targetTyp: PType, src: PNode): TConvStatus = result = convNotInRange else: # we use d, s here to speed up that operation a bit: + if d.kind == tyFromExpr: + result = convNotLegal + return case cmpTypes(c, d, s) of isNone, isGeneric: if not compareTypes(targetTyp.skipTypes(abstractVar), srcTyp.skipTypes({tyOwned}), dcEqIgnoreDistinct): @@ -189,10 +316,10 @@ proc checkConvertible(c: PContext, targetTyp: PType, src: PNode): TConvStatus = else: discard -proc isCastable(c: PContext; dst, src: PType): bool = +proc isCastable(c: PContext; dst, src: PType, info: TLineInfo): bool = ## Checks whether the source type can be cast to the destination type. ## Casting is very unrestrictive; casts are allowed as long as - ## castDest.size >= src.size, and typeAllowed(dst, skParam) + ## dst.size >= src.size, and typeAllowed(dst, skParam) #const # castableTypeKinds = {tyInt, tyPtr, tyRef, tyCstring, tyString, # tySequence, tyPointer, tyNil, tyOpenArray, @@ -205,11 +332,13 @@ proc isCastable(c: PContext; dst, src: PType): bool = if skipTypes(dst, abstractInst).kind == tyBuiltInTypeClass: return false let conf = c.config - if conf.selectedGC in {gcArc, gcOrc}: + if conf.selectedGC in {gcArc, gcOrc, gcAtomicArc}: let d = skipTypes(dst, abstractInst) let s = skipTypes(src, abstractInst) if d.kind == tyRef and s.kind == tyRef and s[0].isFinal != d[0].isFinal: return false + elif d.kind in IntegralTypes and s.kind in {tyString, tySequence}: + return false var dstSize, srcSize: BiggestInt dstSize = computeSize(conf, dst) @@ -219,22 +348,19 @@ proc isCastable(c: PContext; dst, src: PType): bool = # Just assume the programmer knows what he is doing. return true if dstSize < 0: - result = false + return false elif srcSize < 0: - result = false - elif typeAllowed(dst, skParam, c) != nil: - result = false + return false + elif typeAllowed(dst, skParam, c, {taIsCastable}) != nil: + return false elif dst.kind == tyProc and dst.callConv == ccClosure: - result = src.kind == tyProc and src.callConv == ccClosure + return src.kind == tyProc and src.callConv == ccClosure else: result = (dstSize >= srcSize) or (skipTypes(dst, abstractInst).kind in IntegralTypes) or (skipTypes(src, abstractInst-{tyTypeDesc}).kind in IntegralTypes) if result and src.kind == tyNil: - result = dst.size <= conf.target.ptrSize - -proc isSymChoice(n: PNode): bool {.inline.} = - result = n.kind in nkSymChoices + return dst.size <= conf.target.ptrSize proc maybeLiftType(t: var PType, c: PContext, info: TLineInfo) = # XXX: liftParamType started to perform addDecl @@ -250,7 +376,7 @@ proc isOwnedSym(c: PContext; n: PNode): bool = let s = qualifiedLookUp(c, n, {}) result = s != nil and sfSystemModule in s.owner.flags and s.name.s == "owned" -proc semConv(c: PContext, n: PNode): PNode = +proc semConv(c: PContext, n: PNode; flags: TExprFlags = {}, expectedType: PType = nil): PNode = if n.len != 2: localError(c.config, n.info, "a type conversion takes exactly one argument") return n @@ -258,7 +384,7 @@ proc semConv(c: PContext, n: PNode): PNode = result = newNodeI(nkConv, n.info) var targetType = semTypeNode(c, n[0], nil) - case targetType.kind + case targetType.skipTypes({tyDistinct}).kind of tyTypeDesc: internalAssert c.config, targetType.len > 0 if targetType.base.kind == tyNone: @@ -266,7 +392,7 @@ proc semConv(c: PContext, n: PNode): PNode = else: targetType = targetType.base of tyStatic: - var evaluated = semStaticExpr(c, n[1]) + var evaluated = semStaticExpr(c, n[1], expectedType) if evaluated.kind == nkType or evaluated.typ.kind == tyTypeDesc: result = n result.typ = c.makeTypeDesc semStaticType(c, evaluated, nil) @@ -275,16 +401,17 @@ proc semConv(c: PContext, n: PNode): PNode = return evaluated else: targetType = targetType.base + of tyAnything, tyUntyped, tyTyped: + localError(c.config, n.info, "illegal type conversion to '$1'" % typeToString(targetType)) else: discard maybeLiftType(targetType, c, n[0].info) if targetType.kind in {tySink, tyLent} or isOwnedSym(c, n[0]): let baseType = semTypeNode(c, n[1], nil).skipTypes({tyTypeDesc}) - let t = newTypeS(targetType.kind, c) + let t = newTypeS(targetType.kind, c, baseType) if targetType.kind == tyOwned: t.flags.incl tfHasOwned - t.rawAddSonNoPropagationOfTypeFlags baseType result = newNodeI(nkType, n.info) result.typ = makeTypeDesc(c, t) return @@ -295,7 +422,10 @@ proc semConv(c: PContext, n: PNode): PNode = if n[1].kind == nkExprEqExpr and targetType.skipTypes(abstractPtrs).kind == tyObject: localError(c.config, n.info, "object construction uses ':', not '='") - var op = semExprWithType(c, n[1]) + var op = semExprWithType(c, n[1], flags * {efDetermineType} + {efAllowSymChoice}) + if isSymChoice(op) and op[0].sym.kind notin routineKinds: + # T(foo) disambiguation syntax only allowed for routines + op = semSymChoice(c, op) if targetType.kind != tyGenericParam and targetType.isMetaType: let final = inferWithMetatype(c, targetType, op, true) result.add final @@ -307,7 +437,9 @@ proc semConv(c: PContext, n: PNode): PNode = # here or needs to be overwritten too then. result.add op - if targetType.kind == tyGenericParam: + if targetType.kind == tyGenericParam or + (op.typ != nil and op.typ.kind == tyFromExpr and c.inGenericContext > 0): + # expression is compiled early in a generic body result.typ = makeTypeFromExpr(c, copyTree(result)) return result @@ -321,7 +453,8 @@ 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) + if efNoSem2Check notin flags: + message(c.config, n.info, hintConvFromXtoItselfNotNeeded, result.typ.typeToString) of convNotLegal: result = fitNode(c, result.typ, result[1], result.info) if result == nil: @@ -348,13 +481,14 @@ proc semCast(c: PContext, n: PNode): PNode = checkSonsLen(n, 2, c.config) let targetType = semTypeNode(c, n[0], nil) let castedExpr = semExprWithType(c, n[1]) + if castedExpr.kind == nkClosedSymChoice: + errorUseQualifier(c, n[1].info, castedExpr) + if targetType == nil: + localError(c.config, n.info, "Invalid usage of cast, cast requires a type to convert to, e.g., cast[int](0d).") if tfHasMeta in targetType.flags: localError(c.config, n[0].info, "cannot cast to a non concrete type: '$1'" % $targetType) - if not isCastable(c, targetType, castedExpr.typ): - let tar = $targetType - let alt = typeToString(targetType, preferDesc) - let msg = if tar != alt: tar & "=" & alt else: tar - localError(c.config, n.info, "expression cannot be cast to " & msg) + if not isCastable(c, targetType, castedExpr.typ, n.info): + localError(c.config, n.info, "expression cannot be cast to '$1'" % $targetType) result = newNodeI(nkCast, n.info) result.typ = targetType result.add copyTree(n[0]) @@ -369,10 +503,12 @@ proc semLowHigh(c: PContext, n: PNode, m: TMagic): PNode = n[1] = semExprWithType(c, n[1], {efDetermineType}) var typ = skipTypes(n[1].typ, abstractVarRange + {tyTypeDesc, tyUserTypeClassInst}) case typ.kind - of tySequence, tyString, tyCString, tyOpenArray, tyVarargs: + of tySequence, tyString, tyCstring, tyOpenArray, tyVarargs: n.typ = getSysType(c.graph, n.info, tyInt) of tyArray: - n.typ = typ[0] # indextype + n.typ = typ.indexType + if n.typ.kind == tyRange and emptyRange(n.typ.n[0], n.typ.n[1]): #Invalid range + n.typ = getSysType(c.graph, n.info, tyInt) of tyInt..tyInt64, tyChar, tyBool, tyEnum, tyUInt..tyUInt64, tyFloat..tyFloat64: n.typ = n[1].typ.skipTypes({tyTypeDesc}) of tyGenericParam: @@ -395,7 +531,7 @@ proc fixupStaticType(c: PContext, n: PNode) = # apply this measure only in code that is enlightened to work # with static types. if n.typ.kind != tyStatic: - n.typ = newTypeWithSons(getCurrOwner(c), tyStatic, @[n.typ], c.idgen) + n.typ = newTypeS(tyStatic, c, n.typ) n.typ.n = n # XXX: cycles like the one here look dangerous. # Consider using `n.copyTree` @@ -420,6 +556,7 @@ proc isOpImpl(c: PContext, n: PNode, flags: TExprFlags): PNode = res = t.kind == tyProc and t.callConv == ccClosure of "iterator": + # holdover from when `is iterator` didn't work let t = skipTypes(t1, abstractRange) res = t.kind == tyProc and t.callConv == ccClosure and @@ -447,8 +584,9 @@ proc isOpImpl(c: PContext, n: PNode, flags: TExprFlags): PNode = result.typ = n.typ proc semIs(c: PContext, n: PNode, flags: TExprFlags): PNode = - if n.len != 3: + if n.len != 3 or n[2].kind == nkEmpty: localError(c.config, n.info, "'is' operator takes 2 arguments") + return errorNode(c, n) let boolType = getSysType(c.graph, n.info, tyBool) result = n @@ -482,15 +620,14 @@ proc semIs(c: PContext, n: PNode, flags: TExprFlags): PNode = n[1] = makeTypeSymNode(c, lhsType, n[1].info) lhsType = n[1].typ else: - if lhsType.base.kind == tyNone or - (c.inGenericContext > 0 and lhsType.base.containsGenericType): + if c.inGenericContext > 0 and lhsType.base.containsUnresolvedType: # BUGFIX: don't evaluate this too early: ``T is void`` return result = isOpImpl(c, n, flags) proc semOpAux(c: PContext, n: PNode) = - const flags = {efDetermineType} + const flags = {efDetermineType, efAllowSymChoice} for i in 1..<n.len: var a = n[i] if a.kind == nkExprEqExpr and a.len == 2: @@ -511,11 +648,18 @@ proc overloadedCallOpr(c: PContext, n: PNode): PNode = result = newNodeI(nkCall, n.info) result.add newIdentNode(par, n.info) for i in 0..<n.len: result.add n[i] - result = semExpr(c, result) + result = semExpr(c, result, flags = {efNoUndeclared}) proc changeType(c: PContext; n: PNode, newType: PType, check: bool) = case n.kind - of nkCurly, nkBracket: + of nkCurly: + for i in 0..<n.len: + if n[i].kind == nkRange: + changeType(c, n[i][0], elemType(newType), check) + changeType(c, n[i][1], elemType(newType), check) + else: + changeType(c, n[i], elemType(newType), check) + of nkBracket: for i in 0..<n.len: changeType(c, n[i], elemType(newType), check) of nkPar, nkTupleConstr: @@ -548,14 +692,20 @@ proc changeType(c: PContext; n: PNode, newType: PType, check: bool) = a.add m changeType(m, tup[i], check) of nkCharLit..nkUInt64Lit: - if check and n.kind != nkUInt64Lit and not sameType(n.typ, newType): + if check and n.kind != nkUInt64Lit and not sameTypeOrNil(n.typ, newType): let value = n.intVal if value < firstOrd(c.config, newType) or value > lastOrd(c.config, newType): localError(c.config, n.info, "cannot convert " & $value & - " to " & typeToString(newType)) + " to " & typeNameAndDesc(newType)) of nkFloatLit..nkFloat64Lit: if check and not floatRangeCheck(n.floatVal, newType): - localError(c.config, n.info, errFloatToString % [$n.floatVal, typeToString(newType)]) + localError(c.config, n.info, errFloatToString % [$n.floatVal, typeNameAndDesc(newType)]) + of nkSym: + if check and n.sym.kind == skEnumField and not sameTypeOrNil(n.sym.typ, newType): + let value = n.sym.position + if value < firstOrd(c.config, newType) or value > lastOrd(c.config, newType): + localError(c.config, n.info, "cannot convert '" & n.sym.name.s & + "' to '" & typeNameAndDesc(newType) & "'") else: discard n.typ = newType @@ -567,24 +717,51 @@ proc arrayConstrType(c: PContext, n: PNode): PType = else: var t = skipTypes(n[0].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal, tyAlias, tySink}) addSonSkipIntLit(typ, t, c.idgen) - typ[0] = makeRangeType(c, 0, n.len - 1, n.info) + typ.setIndexType makeRangeType(c, 0, n.len - 1, n.info) result = typ -proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = +proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode = result = newNodeI(nkBracket, n.info) - result.typ = newTypeS(tyArray, c) - rawAddSon(result.typ, nil) # index type + # nkBracket nodes can also be produced by the VM as seq constant nodes + # in which case, we cannot produce a new array type for the node, + # as this might lose type info even when the node has array type + let constructType = n.typ.isNil + var expectedElementType, expectedIndexType: PType = nil + var expectedBase: PType = nil + if constructType: + result.typ = newTypeS(tyArray, c) + rawAddSon(result.typ, nil) # index type + if expectedType != nil: + expectedBase = expectedType.skipTypes(abstractRange-{tyDistinct}) + else: + result.typ = n.typ + expectedBase = n.typ.skipTypes(abstractRange) # include tyDistinct this time + if expectedBase != nil: + case expectedBase.kind + of tyArray: + expectedIndexType = expectedBase[0] + expectedElementType = expectedBase[1] + of tyOpenArray, tySequence: + # typed bracket expressions can also have seq type + expectedElementType = expectedBase[0] + else: discard var - firstIndex, lastIndex: Int128 + firstIndex, lastIndex: Int128 = Zero indexType = getSysType(c.graph, n.info, tyInt) lastValidIndex = lastOrd(c.config, indexType) if n.len == 0: - rawAddSon(result.typ, newTypeS(tyEmpty, c)) # needs an empty basetype! + if constructType: + rawAddSon(result.typ, + if expectedElementType != nil and + typeAllowed(expectedElementType, skLet, c) == nil: + expectedElementType + else: + newTypeS(tyEmpty, c)) # needs an empty basetype! lastIndex = toInt128(-1) else: var x = n[0] if x.kind == nkExprColonExpr and x.len == 2: - var idx = semConstExpr(c, x[0]) + var idx = semConstExpr(c, x[0], expectedIndexType) if not isOrdinalType(idx.typ): localError(c.config, idx.info, "expected ordinal value for array " & "index, got '$1'" % renderTree(idx)) @@ -595,8 +772,14 @@ proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = lastValidIndex = lastOrd(c.config, indexType) x = x[1] - let yy = semExprWithType(c, x) - var typ = yy.typ + let yy = semExprWithType(c, x, {efTypeAllowed}, expectedElementType) + var typ: PType + if constructType: + typ = yy.typ + if expectedElementType == nil: + expectedElementType = typ + else: + typ = expectedElementType result.add yy #var typ = skipTypes(result[0].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal}) for i in 1..<n.len: @@ -608,45 +791,53 @@ proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = x = n[i] if x.kind == nkExprColonExpr and x.len == 2: - var idx = semConstExpr(c, x[0]) + var idx = semConstExpr(c, x[0], indexType) idx = fitNode(c, indexType, idx, x.info) if lastIndex+1 != getOrdValue(idx): localError(c.config, x.info, "invalid order in array constructor") x = x[1] - let xx = semExprWithType(c, x, flags*{efAllowDestructor}) + let xx = semExprWithType(c, x, {efTypeAllowed}, expectedElementType) result.add xx - typ = commonType(c, typ, xx.typ) - #n[i] = semExprWithType(c, x, flags*{efAllowDestructor}) + if constructType: + typ = commonType(c, typ, xx.typ) + #n[i] = semExprWithType(c, x, {}) #result.add fitNode(c, typ, n[i]) inc(lastIndex) - addSonSkipIntLit(result.typ, typ, c.idgen) + if constructType: + addSonSkipIntLit(result.typ, typ, c.idgen) for i in 0..<result.len: result[i] = fitNode(c, typ, result[i], result[i].info) - result.typ[0] = makeRangeType(c, toInt64(firstIndex), toInt64(lastIndex), n.info, - indexType) + if constructType: + result.typ.setIndexType( + makeRangeType(c, + toInt64(firstIndex), toInt64(lastIndex), + n.info, indexType)) proc fixAbstractType(c: PContext, n: PNode) = for i in 1..<n.len: let it = n[i] + if it == nil: + localError(c.config, n.info, "'$1' has nil child at index $2" % [renderTree(n, {renderNoComments}), $i]) + return # do not get rid of nkHiddenSubConv for OpenArrays, the codegen needs it: if it.kind == nkHiddenSubConv and skipTypes(it.typ, abstractVar).kind notin {tyOpenArray, tyVarargs}: if skipTypes(it[1].typ, abstractVar).kind in {tyNil, tyTuple, tySet} or it[1].isArrayConstr: - var s = skipTypes(it.typ, abstractVar) + var s = skipTypes(it.typ, abstractVar + tyUserTypeClasses) if s.kind != tyUntyped: changeType(c, it[1], s, check=true) n[i] = it[1] -proc isAssignable(c: PContext, n: PNode; isUnsafeAddr=false): TAssignableResult = - result = parampatterns.isAssignable(c.p.owner, n, isUnsafeAddr) +proc isAssignable(c: PContext, n: PNode): TAssignableResult = + result = parampatterns.isAssignable(c.p.owner, n) proc isUnresolvedSym(s: PSym): bool = result = s.kind == skGenericParam if not result and s.typ != nil: result = tfInferrableStatic in s.typ.flags or - (s.kind == skParam and s.typ.isMetaType) or + (s.kind == skParam and (s.typ.isMetaType or sfTemplateParam in s.flags)) or (s.kind == skType and s.typ.flags * {tfGenericTypeParam, tfImplicitTypeParam} != {}) @@ -674,7 +865,7 @@ proc hasUnresolvedArgs(c: PContext, n: PNode): bool = if hasUnresolvedArgs(c, n[i]): return true return false -proc newHiddenAddrTaken(c: PContext, n: PNode): PNode = +proc newHiddenAddrTaken(c: PContext, n: PNode, isOutParam: bool): PNode = if n.kind == nkHiddenDeref and not (c.config.backend == backendCpp or sfCompileToCpp in c.module.flags): checkSonsLen(n, 1, c.config) @@ -682,10 +873,18 @@ proc newHiddenAddrTaken(c: PContext, n: PNode): PNode = else: result = newNodeIT(nkHiddenAddr, n.info, makeVarType(c, n.typ)) result.add n - if isAssignable(c, n) notin {arLValue, arLocalLValue}: - localError(c.config, n.info, errVarForOutParamNeededX % renderNotLValue(n)) + let aa = isAssignable(c, n) + let sym = getRoot(n) + if aa notin {arLValue, arLocalLValue}: + if aa == arDiscriminant and c.inUncheckedAssignSection > 0: + discard "allow access within a cast(unsafeAssign) section" + elif strictDefs in c.features and aa == arAddressableConst and + sym != nil and sym.kind == skLet and isOutParam: + discard "allow let varaibles to be passed to out parameters" + else: + localError(c.config, n.info, errVarForOutParamNeededX % renderNotLValue(n)) -proc analyseIfAddressTaken(c: PContext, n: PNode): PNode = +proc analyseIfAddressTaken(c: PContext, n: PNode, isOutParam: bool): PNode = result = n case n.kind of nkSym: @@ -693,7 +892,7 @@ proc analyseIfAddressTaken(c: PContext, n: PNode): PNode = if n.sym.typ != nil and skipTypes(n.sym.typ, abstractInst-{tyTypeDesc}).kind notin {tyVar, tyLent}: incl(n.sym.flags, sfAddrTaken) - result = newHiddenAddrTaken(c, n) + result = newHiddenAddrTaken(c, n, isOutParam) of nkDotExpr: checkSonsLen(n, 2, c.config) if n[1].kind != nkSym: @@ -701,27 +900,35 @@ proc analyseIfAddressTaken(c: PContext, n: PNode): PNode = return if skipTypes(n[1].sym.typ, abstractInst-{tyTypeDesc}).kind notin {tyVar, tyLent}: incl(n[1].sym.flags, sfAddrTaken) - result = newHiddenAddrTaken(c, n) + result = newHiddenAddrTaken(c, n, isOutParam) of nkBracketExpr: checkMinSonsLen(n, 1, c.config) if skipTypes(n[0].typ, abstractInst-{tyTypeDesc}).kind notin {tyVar, tyLent}: if n[0].kind == nkSym: incl(n[0].sym.flags, sfAddrTaken) - result = newHiddenAddrTaken(c, n) + result = newHiddenAddrTaken(c, n, isOutParam) else: - result = newHiddenAddrTaken(c, n) + result = newHiddenAddrTaken(c, n, isOutParam) -proc analyseIfAddressTakenInCall(c: PContext, n: PNode) = +proc analyseIfAddressTakenInCall(c: PContext, n: PNode, isConverter = false) = checkMinSonsLen(n, 1, c.config) + if n[0].typ == nil: + # n[0] might be erroring node in nimsuggest + return const FakeVarParams = {mNew, mNewFinalize, mInc, ast.mDec, mIncl, mExcl, mSetLengthStr, mSetLengthSeq, mAppendStrCh, mAppendStrStr, mSwap, - mAppendSeqElem, mNewSeq, mReset, mShallowCopy, mDeepCopy, mMove, + mAppendSeqElem, mNewSeq, mShallowCopy, mDeepCopy, mMove, mWasMoved} + template checkIfConverterCalled(c: PContext, n: PNode) = + ## Checks if there is a converter call which wouldn't be checked otherwise + # Call can sometimes be wrapped in a deref + let node = if n.kind == nkHiddenDeref: n[0] else: n + if node.kind == nkHiddenCallConv: + analyseIfAddressTakenInCall(c, node, true) # get the real type of the callee # it may be a proc var with a generic alias type, so we skip over them var t = n[0].typ.skipTypes({tyGenericInst, tyAlias, tySink}) - if n[0].kind == nkSym and n[0].sym.magic in FakeVarParams: # BUGFIX: check for L-Value still needs to be done for the arguments! # note sometimes this is eval'ed twice so we check for nkHiddenAddr here: @@ -729,9 +936,15 @@ proc analyseIfAddressTakenInCall(c: PContext, n: PNode) = if i < t.len and t[i] != nil and skipTypes(t[i], abstractInst-{tyTypeDesc}).kind in {tyVar}: let it = n[i] - if isAssignable(c, it) notin {arLValue, arLocalLValue}: + let aa = isAssignable(c, it) + if aa notin {arLValue, arLocalLValue}: if it.kind != nkHiddenAddr: - localError(c.config, it.info, errVarForOutParamNeededX % $it) + if aa == arDiscriminant and c.inUncheckedAssignSection > 0: + discard "allow access within a cast(unsafeAssign) section" + else: + localError(c.config, it.info, errVarForOutParamNeededX % $it) + # Make sure to still check arguments for converters + c.checkIfConverterCalled(n[i]) # 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 @@ -743,14 +956,13 @@ proc analyseIfAddressTakenInCall(c: PContext, n: PNode) = return for i in 1..<n.len: let n = if n.kind == nkHiddenDeref: n[0] else: n - if n[i].kind == nkHiddenCallConv: - # we need to recurse explicitly here as converters can create nested - # calls and then they wouldn't be analysed otherwise - analyseIfAddressTakenInCall(c, n[i]) + c.checkIfConverterCalled(n[i]) if i < t.len and skipTypes(t[i], abstractInst-{tyTypeDesc}).kind in {tyVar}: - if n[i].kind != nkHiddenAddr: - n[i] = analyseIfAddressTaken(c, n[i]) + # Converters wrap var parameters in nkHiddenAddr but they haven't been analysed yet. + # So we need to make sure we are checking them still when in a converter call + if n[i].kind != nkHiddenAddr or isConverter: + n[i] = analyseIfAddressTaken(c, n[i].skipAddr(), isOutParam(skipTypes(t[i], abstractInst-{tyTypeDesc}))) include semmagic @@ -790,7 +1002,7 @@ proc evalAtCompileTime(c: PContext, n: PNode): PNode = if n[i].typ.isNil or n[i].typ.kind != tyStatic or tfUnresolved notin n[i].typ.flags: break maybeLabelAsStatic - n.typ = newTypeWithSons(c, tyStatic, @[n.typ]) + n.typ = newTypeS(tyStatic, c, n.typ) n.typ.flags.incl tfUnresolved # optimization pass: not necessary for correctness of the semantic pass @@ -804,7 +1016,8 @@ proc evalAtCompileTime(c: PContext, n: PNode): PNode = if callee.magic notin ctfeWhitelist: return - if callee.kind notin {skProc, skFunc, skConverter, skConst} or callee.isGenericRoutine: + if callee.kind notin {skProc, skFunc, skConverter, skConst} or + callee.isGenericRoutineStrict: return if n.typ != nil and typeAllowed(n.typ, skConst, c) != nil: return @@ -832,10 +1045,10 @@ proc evalAtCompileTime(c: PContext, n: PNode): PNode = #if result != n: # echo "SUCCESS evaluated at compile time: ", call.renderTree -proc semStaticExpr(c: PContext, n: PNode): PNode = +proc semStaticExpr(c: PContext, n: PNode; expectedType: PType = nil): PNode = inc c.inStaticContext openScope(c) - let a = semExprWithType(c, n) + let a = semExprWithType(c, n, expectedType = expectedType) closeScope(c) dec c.inStaticContext if a.findUnresolvedStatic != nil: return a @@ -847,111 +1060,146 @@ proc semStaticExpr(c: PContext, n: PNode): PNode = result = fixupTypeAfterEval(c, result, a) proc semOverloadedCallAnalyseEffects(c: PContext, n: PNode, nOrig: PNode, - flags: TExprFlags): PNode = - if flags*{efInTypeof, efWantIterator} != {}: + flags: TExprFlags; expectedType: PType = nil): PNode = + if flags*{efInTypeof, efWantIterator, efWantIterable} != {}: # consider: 'for x in pReturningArray()' --> we don't want the restriction # to 'skIterator' anymore; skIterator is preferred in sigmatch already # for typeof support. # for ``typeof(countup(1,3))``, see ``tests/ttoseq``. result = semOverloadedCall(c, n, nOrig, - {skProc, skFunc, skMethod, skConverter, skMacro, skTemplate, skIterator}, flags) + {skProc, skFunc, skMethod, skConverter, skMacro, skTemplate, skIterator}, flags, expectedType) else: result = semOverloadedCall(c, n, nOrig, - {skProc, skFunc, skMethod, skConverter, skMacro, skTemplate}, flags) + {skProc, skFunc, skMethod, skConverter, skMacro, skTemplate}, flags, expectedType) if result != nil: if result[0].kind != nkSym: - internalError(c.config, "semOverloadedCallAnalyseEffects") + if not (c.inGenericContext > 0): # see generic context check in semOverloadedCall + internalError(c.config, "semOverloadedCallAnalyseEffects") return let callee = result[0].sym case callee.kind of skMacro, skTemplate: discard else: - if callee.kind == skIterator and callee.id == c.p.owner.id: + if callee.kind == skIterator and callee.id == c.p.owner.id and + not isClosureIterator(c.p.owner.typ): localError(c.config, n.info, errRecursiveDependencyIteratorX % callee.name.s) # error correction, prevents endless for loop elimination in transf. # See bug #2051: result[0] = newSymNode(errorSym(c, n)) - -proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags): PNode + elif callee.kind == skIterator: + if efWantIterable in flags: + let typ = newTypeS(tyIterable, c) + rawAddSon(typ, result.typ) + result.typ = typ proc resolveIndirectCall(c: PContext; n, nOrig: PNode; t: PType): TCandidate = - initCandidate(c, result, t) + result = initCandidate(c, t) matches(c, n, nOrig, result) - if result.state != csMatch: - # try to deref the first argument: - if implicitDeref in c.features and canDeref(n): - n[1] = n[1].tryDeref - initCandidate(c, result, t) - matches(c, n, nOrig, result) - -proc bracketedMacro(n: PNode): PSym = - if n.len >= 1 and n[0].kind == nkSym: - result = n[0].sym - if result.kind notin {skMacro, skTemplate}: - result = nil -proc setGenericParams(c: PContext, n: PNode) = - for i in 1..<n.len: - n[i].typ = semTypeNode(c, n[i], nil) +proc finishOperand(c: PContext, a: PNode): PNode = + if a.typ.isNil: + result = c.semOperand(c, a, {efDetermineType}) + else: + result = a + # XXX tyGenericInst here? + if result.typ.kind == tyProc and hasUnresolvedParams(result, {efOperand}): + #and tfUnresolved in result.typ.flags: + let owner = result.typ.owner + let err = + # consistent error message with evaltempl/semMacroExpr + if owner != nil and owner.kind in {skTemplate, skMacro}: + errMissingGenericParamsForTemplate % a.renderTree + else: + errProcHasNoConcreteType % a.renderTree + localError(c.config, a.info, err) + considerGenSyms(c, result) -proc afterCallActions(c: PContext; n, orig: PNode, flags: TExprFlags): PNode = +proc semFinishOperands(c: PContext; n: PNode; isBracketExpr = false) = + # this needs to be called to ensure that after overloading resolution every + # argument has been sem'checked + + # skip the first argument for operands of `[]` since it may be an unresolved + # generic proc, which is handled in semMagic + let start = 1 + ord(isBracketExpr) + for i in start..<n.len: + n[i] = finishOperand(c, n[i]) + +proc afterCallActions(c: PContext; n, orig: PNode, flags: TExprFlags; expectedType: PType = nil): PNode = if efNoSemCheck notin flags and n.typ != nil and n.typ.kind == tyError: return errorNode(c, n) + if n.typ != nil and n.typ.kind == tyFromExpr and c.inGenericContext > 0: + return n result = n + + when defined(nimsuggest): + if c.config.expandProgress: + if c.config.expandLevels == 0: + return n + else: + c.config.expandLevels -= 1 + let callee = result[0].sym case callee.kind - of skMacro: result = semMacroExpr(c, result, orig, callee, flags) - of skTemplate: result = semTemplateExpr(c, result, callee, flags) + of skMacro: result = semMacroExpr(c, result, orig, callee, flags, expectedType) + of skTemplate: result = semTemplateExpr(c, result, callee, flags, expectedType) else: - semFinishOperands(c, result) + semFinishOperands(c, result, isBracketExpr = callee.magic in {mArrGet, mArrPut}) activate(c, result) fixAbstractType(c, result) analyseIfAddressTakenInCall(c, result) if callee.magic != mNone: - result = magicsAfterOverloadResolution(c, result, flags) + result = magicsAfterOverloadResolution(c, result, flags, expectedType) when false: if result.typ != nil and - not (result.typ.kind == tySequence and result.typ[0].kind == tyEmpty): + not (result.typ.kind == tySequence and result.elementType.kind == tyEmpty): liftTypeBoundOps(c, result.typ, n.info) #result = patchResolvedTypeBoundOp(c, result) - if c.matchedConcept == nil: + if c.matchedConcept == nil and (c.inTypeofContext == 0 or callee.magic != mNone): + # don't fold calls in concepts and typeof result = evalAtCompileTime(c, result) -proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = +proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode = result = nil checkMinSonsLen(n, 1, c.config) var prc = n[0] if n[0].kind == nkDotExpr: checkSonsLen(n[0], 2, c.config) - let n0 = semFieldAccess(c, n[0]) + let n0 = semFieldAccess(c, n[0], {efIsDotCall}) if n0.kind == nkDotCall: # it is a static call! result = n0 result.transitionSonsKind(nkCall) result.flags.incl nfExplicitCall for i in 1..<n.len: result.add n[i] - return semExpr(c, result, flags) + return semExpr(c, result, flags, expectedType) + elif n0.typ.kind == tyFromExpr and c.inGenericContext > 0: + # don't make assumptions, entire expression needs to be tyFromExpr + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, result.copyTree) + return else: n[0] = n0 else: - n[0] = semExpr(c, n[0], {efInCall}) + n[0] = semExpr(c, n[0], {efInCall, efAllowSymChoice}) let t = n[0].typ if t != nil and t.kind in {tyVar, tyLent}: n[0] = newDeref(n[0]) - elif n[0].kind == nkBracketExpr: - let s = bracketedMacro(n[0]) - if s != nil: - setGenericParams(c, n[0]) - return semDirectOp(c, n, flags) + elif isSymChoice(n[0]) and nfDotField notin n.flags: + # overloaded generic procs e.g. newSeq[int] can end up here + return semDirectOp(c, n, flags, expectedType) - let nOrig = n.copyTree - semOpAux(c, n) var t: PType = nil if n[0].typ != nil: t = skipTypes(n[0].typ, abstractInst+{tyOwned}-{tyTypeDesc, tyDistinct}) + if t != nil and t.kind == tyTypeDesc: + if n.len == 1: return semObjConstr(c, n, flags, expectedType) + return semConv(c, n, flags) + + let nOrig = n.copyTree + semOpAux(c, n) if t != nil and t.kind == tyProc: # This is a proc variable, apply normal overload resolution let m = resolveIndirectCall(c, n, nOrig, t) @@ -972,7 +1220,7 @@ proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = break if not hasErrorType: let typ = n[0].typ - msg.add(">\nbut expected one of: \n" & + msg.add(">\nbut expected one of:\n" & typeToString(typ)) # prefer notin preferToResolveSymbols # t.sym != nil @@ -985,19 +1233,15 @@ proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = msg.addDeclaredLocMaybe(c.config, typ) localError(c.config, n.info, msg) return errorNode(c, n) - result = nil else: result = m.call instGenericConvertersSons(c, result, m) - elif t != nil and t.kind == tyTypeDesc: - if n.len == 1: return semObjConstr(c, n, flags) - return semConv(c, n) else: - result = overloadedCallOpr(c, n) + result = overloadedCallOpr(c, n) # this uses efNoUndeclared # Now that nkSym does not imply an iteration over the proc/iterator space, # the old ``prc`` (which is likely an nkIdent) has to be restored: - if result == nil: + if result == nil or result.kind == nkEmpty: # XXX: hmm, what kind of symbols will end up here? # do we really need to try the overload resolution? n[0] = prc @@ -1011,17 +1255,17 @@ proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = return result #result = afterCallActions(c, result, nOrig, flags) if result[0].kind == nkSym: - result = afterCallActions(c, result, nOrig, flags) + result = afterCallActions(c, result, nOrig, flags, expectedType) else: fixAbstractType(c, result) analyseIfAddressTakenInCall(c, result) -proc semDirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = +proc semDirectOp(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode = # this seems to be a hotspot in the compiler! let nOrig = n.copyTree #semLazyOpAux(c, n) - result = semOverloadedCallAnalyseEffects(c, n, nOrig, flags) - if result != nil: result = afterCallActions(c, result, nOrig, flags) + result = semOverloadedCallAnalyseEffects(c, n, nOrig, flags, expectedType) + if result != nil: result = afterCallActions(c, result, nOrig, flags, expectedType) else: result = errorNode(c, n) proc buildEchoStmt(c: PContext, n: PNode): PNode = @@ -1031,9 +1275,9 @@ proc buildEchoStmt(c: PContext, n: PNode): PNode = if e != nil: result.add(newSymNode(e)) else: - localError(c.config, n.info, "system needs: echo") - result.add(errorNode(c, n)) + result.add localErrorNode(c, n, "system needs: echo") result.add(n) + result.add(newStrNode(nkStrLit, ": " & n.typ.typeToString)) result = semExpr(c, result) proc semExprNoType(c: PContext, n: PNode): PNode = @@ -1131,7 +1375,7 @@ proc readTypeParameter(c: PContext, typ: PType, # This seems semantically correct and then we'll be able # to return the section symbol directly here let foundType = makeTypeDesc(c, def[2].typ) - return newSymNode(copySym(def[0].sym, nextSymId c.idgen).linkTo(foundType), info) + return newSymNode(copySym(def[0].sym, c.idgen).linkTo(foundType), info) of nkConstSection: for def in statement: @@ -1142,7 +1386,7 @@ proc readTypeParameter(c: PContext, typ: PType, discard if typ.kind != tyUserTypeClass: - let ty = if typ.kind == tyCompositeTypeClass: typ[1].skipGenericAlias + let ty = if typ.kind == tyCompositeTypeClass: typ.firstGenericParam.skipGenericAlias else: typ.skipGenericAlias let tbody = ty[0] for s in 0..<tbody.len-1: @@ -1156,19 +1400,22 @@ proc readTypeParameter(c: PContext, typ: PType, return c.graph.emptyNode else: let foundTyp = makeTypeDesc(c, rawTyp) - return newSymNode(copySym(tParam.sym, nextSymId c.idgen).linkTo(foundTyp), info) + return newSymNode(copySym(tParam.sym, c.idgen).linkTo(foundTyp), info) return nil proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode = + result = nil + assert n.kind in nkIdentKinds + {nkDotExpr} let s = getGenSym(c, sym) case s.kind of skConst: - markUsed(c, n.info, s) + if n.kind != nkDotExpr: # dotExpr is already checked by builtinFieldAccess + markUsed(c, n.info, s) onUse(n.info, s) let typ = skipTypes(s.typ, abstractInst-{tyTypeDesc}) case typ.kind - of tyNil, tyChar, tyInt..tyInt64, tyFloat..tyFloat128, + of tyNil, tyChar, tyInt..tyInt64, tyFloat..tyFloat128, tyTuple, tySet, tyUInt..tyUInt64: if s.magic == mNone: result = inlineConst(c, n, s) else: result = newSymNode(s, n.info) @@ -1183,7 +1430,7 @@ proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode = # It is clear that ``[]`` means two totally different things. Thus, we # copy `x`'s AST into each context, so that the type fixup phase can # deal with two different ``[]``. - if s.ast.safeLen == 0: result = inlineConst(c, n, s) + if s.astdef.safeLen == 0: result = inlineConst(c, n, s) else: result = newSymNode(s, n.info) of tyStatic: if typ.n != nil: @@ -1193,24 +1440,18 @@ proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode = result = newSymNode(s, n.info) else: result = newSymNode(s, n.info) - of skMacro: - if efNoEvaluateGeneric in flags and s.ast[genericParamsPos].len > 0 or - (n.kind notin nkCallKinds and s.requiredParams > 0): - markUsed(c, n.info, s) - onUse(n.info, s) - result = symChoice(c, n, s, scClosed) - else: - result = semMacroExpr(c, n, n, s, flags) - of skTemplate: - if efNoEvaluateGeneric in flags and s.ast[genericParamsPos].len > 0 or - (n.kind notin nkCallKinds and s.requiredParams > 0) or - sfCustomPragma in sym.flags: + of skMacro, skTemplate: + # check if we cannot use alias syntax (no required args or generic params) + if sfNoalias in s.flags: let info = getCallLineInfo(n) markUsed(c, info, s) onUse(info, s) result = symChoice(c, n, s, scClosed) else: - result = semTemplateExpr(c, n, s, flags) + case s.kind + of skMacro: result = semMacroExpr(c, n, n, s, flags) + of skTemplate: result = semTemplateExpr(c, n, s, flags) + else: discard # unreachable of skParam: markUsed(c, n.info, s) onUse(n.info, s) @@ -1225,13 +1466,17 @@ proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode = if s.magic == mNimvm: localError(c.config, n.info, "illegal context for 'nimvm' magic") - markUsed(c, n.info, s) + if n.kind != nkDotExpr: # dotExpr is already checked by builtinFieldAccess + markUsed(c, n.info, s) onUse(n.info, s) result = newSymNode(s, n.info) # We cannot check for access to outer vars for example because it's still # 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) + of skGenericParam: onUse(n.info, s) if s.typ.kind == tyStatic: @@ -1243,44 +1488,24 @@ proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode = n.typ = s.typ return n of skType: - markUsed(c, n.info, s) + if n.kind != nkDotExpr: # dotExpr is already checked by builtinFieldAccess + markUsed(c, n.info, s) onUse(n.info, s) if s.typ.kind == tyStatic and s.typ.base.kind != tyNone and s.typ.n != nil: return s.typ.n result = newSymNode(s, n.info) result.typ = makeTypeDesc(c, s.typ) of skField: - var p = c.p - while p != nil and p.selfSym == nil: - p = p.next - if p != nil and p.selfSym != nil: - var ty = skipTypes(p.selfSym.typ, {tyGenericInst, tyVar, tyLent, tyPtr, tyRef, - tyAlias, tySink, tyOwned}) - while tfBorrowDot in ty.flags: ty = ty.skipTypes({tyDistinct}) - var check: PNode = nil - if ty.kind == tyObject: - while true: - check = nil - let f = lookupInRecordAndBuildCheck(c, n, ty.n, s.name, check) - if f != nil and fieldVisible(c, f): - # is the access to a public field or in the same module or in a friend? - doAssert f == s - markUsed(c, n.info, f) - onUse(n.info, f) - result = newNodeIT(nkDotExpr, n.info, f.typ) - result.add makeDeref(newSymNode(p.selfSym)) - result.add newSymNode(f) # we now have the correct field - if check != nil: - check[0] = result - check.typ = result.typ - result = check - return result - if ty[0] == nil: break - ty = skipTypes(ty[0], skipPtrs) # old code, not sure if it's live code: markUsed(c, n.info, s) onUse(n.info, s) result = newSymNode(s, n.info) + of skModule: + # make sure type is None and not nil for discard checking + if efWantStmt in flags: s.typ = newTypeS(tyNone, c) + markUsed(c, n.info, s) + onUse(n.info, s) + result = newSymNode(s, n.info) else: let info = getCallLineInfo(n) #if efInCall notin flags: @@ -1290,24 +1515,39 @@ proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode = proc tryReadingGenericParam(c: PContext, n: PNode, i: PIdent, t: PType): PNode = case t.kind - of tyTypeParamsHolders: + of tyGenericInst: result = readTypeParameter(c, t, i, n.info) if result == c.graph.emptyNode: - result = n - n.typ = makeTypeFromExpr(c, n.copyTree) + if c.inGenericContext > 0: + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, result.copyTree) + else: + result = nil of tyUserTypeClasses: if t.isResolvedUserTypeClass: result = readTypeParameter(c, t, i, n.info) + elif c.inGenericContext > 0: + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, copyTree(result)) else: - n.typ = makeTypeFromExpr(c, copyTree(n)) - result = n - of tyGenericParam, tyAnything: - n.typ = makeTypeFromExpr(c, copyTree(n)) - result = n + result = nil + of tyGenericBody, tyCompositeTypeClass: + if c.inGenericContext > 0: + result = readTypeParameter(c, t, i, n.info) + if result != nil: + # generic parameter exists, stop here but delay until instantiation + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, copyTree(result)) + else: + result = nil + elif c.inGenericContext > 0 and t.containsUnresolvedType: + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, copyTree(result)) else: - discard + result = nil proc tryReadingTypeField(c: PContext, n: PNode, i: PIdent, ty: PType): PNode = + result = nil var ty = ty.skipTypes(tyDotOpTransparent) case ty.kind of tyEnum: @@ -1316,7 +1556,7 @@ proc tryReadingTypeField(c: PContext, n: PNode, i: PIdent, ty: PType): PNode = while ty != nil: f = getSymFromList(ty.n, i) if f != nil: break - ty = ty.sons[0] # enum inheritance + ty = ty[0] # enum inheritance if f != nil: result = newSymNode(f) result.info = n.info @@ -1330,13 +1570,13 @@ proc tryReadingTypeField(c: PContext, n: PNode, i: PIdent, ty: PType): PNode = n.typ = makeTypeDesc(c, field.typ) result = n of tyGenericInst: - result = tryReadingTypeField(c, n, i, ty.lastSon) + result = tryReadingTypeField(c, n, i, ty.skipModifier) if result == nil: result = tryReadingGenericParam(c, n, i, ty) else: result = tryReadingGenericParam(c, n, i, ty) -proc builtinFieldAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = +proc builtinFieldAccess(c: PContext; n: PNode; flags: var TExprFlags): PNode = ## returns nil if it's not a built-in field access checkSonsLen(n, 2, c.config) # tests/bind/tbindoverload.nim wants an early exit here, but seems to @@ -1359,7 +1599,8 @@ proc builtinFieldAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = onUse(n[1].info, s) return - n[0] = semExprWithType(c, n[0], flags+{efDetermineType}) + # extra flags since LHS may become a call operand: + n[0] = semExprWithType(c, n[0], flags+{efDetermineType, efWantIterable, efAllowSymChoice}) #restoreOldStyleType(n[0]) var i = considerQuotedIdent(c, n[1], n) var ty = n[0].typ @@ -1374,21 +1615,24 @@ proc builtinFieldAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = # field access and we leave the compiler to compile a normal call: if getCurrOwner(c).kind != skMacro: n.typ = makeTypeFromExpr(c, n.copyTree) + flags.incl efCannotBeDotCall return n else: return nil else: + flags.incl efCannotBeDotCall return tryReadingTypeField(c, n, i, ty.base) elif isTypeExpr(n.sons[0]): + flags.incl efCannotBeDotCall return tryReadingTypeField(c, n, i, ty) elif ty.kind == tyError: # a type error doesn't have any builtin fields return nil if ty.kind in tyUserTypeClasses and ty.isResolvedUserTypeClass: - ty = ty.lastSon - ty = skipTypes(ty, {tyGenericInst, tyVar, tyLent, tyPtr, tyRef, tyOwned, tyAlias, tySink}) - while tfBorrowDot in ty.flags: ty = ty.skipTypes({tyDistinct}) + ty = ty.last + ty = skipTypes(ty, {tyGenericInst, tyVar, tyLent, tyPtr, tyRef, tyOwned, tyAlias, tySink, tyStatic}) + while tfBorrowDot in ty.flags: ty = ty.skipTypes({tyDistinct, tyGenericInst, tyAlias}) var check: PNode = nil if ty.kind == tyObject: while true: @@ -1406,8 +1650,10 @@ proc builtinFieldAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = # is the access to a public field or in the same module or in a friend? markUsed(c, n[1].info, f) onUse(n[1].info, f) + let info = n[1].info n[0] = makeDeref(n[0]) n[1] = newSymNode(f) # we now have the correct field + n[1].info = info # preserve the original info n.typ = f.typ if check == nil: result = n @@ -1429,9 +1675,12 @@ proc builtinFieldAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = if result == nil: let t = n[0].typ.skipTypes(tyDotOpTransparent) result = tryReadingGenericParam(c, n, i, t) + flags.incl efCannotBeDotCall proc dotTransformation(c: PContext, n: PNode): PNode = - if isSymChoice(n[1]): + if isSymChoice(n[1]) or + # generics usually leave field names as symchoices, but not types + (n[1].kind == nkSym and n[1].sym.kind == skType): result = newNodeI(nkDotCall, n.info) result.add n[1] result.add copyTree(n[0]) @@ -1445,8 +1694,11 @@ proc dotTransformation(c: PContext, n: PNode): PNode = proc semFieldAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = # this is difficult, because the '.' is used in many different contexts # in Nim. We first allow types in the semantic checking. - result = builtinFieldAccess(c, n, flags) - if result == nil: + var f = flags - {efIsDotCall} + result = builtinFieldAccess(c, n, f) + if result == nil or ((result.typ == nil or result.typ.skipTypes(abstractInst).kind != tyProc) and + efIsDotCall in flags and callOperator notin c.features and + efCannotBeDotCall notin f): result = dotTransformation(c, n) proc buildOverloadedSubscripts(n: PNode, ident: PIdent): PNode = @@ -1454,34 +1706,59 @@ proc buildOverloadedSubscripts(n: PNode, ident: PIdent): PNode = result.add(newIdentNode(ident, n.info)) for s in n: result.add s -proc semDeref(c: PContext, n: PNode): PNode = +proc semDeref(c: PContext, n: PNode, flags: TExprFlags): PNode = checkSonsLen(n, 1, c.config) n[0] = semExprWithType(c, n[0]) let a = getConstExpr(c.module, n[0], c.idgen, c.graph) if a != nil: - if a.kind == nkNilLit: + if a.kind == nkNilLit and efInTypeof notin flags: localError(c.config, n.info, "nil dereference is not allowed") n[0] = a result = n var t = skipTypes(n[0].typ, {tyGenericInst, tyVar, tyLent, tyAlias, tySink, tyOwned}) case t.kind - of tyRef, tyPtr: n.typ = t.lastSon + of tyRef, tyPtr: n.typ = t.elementType + of tyMetaTypes, tyFromExpr: + n.typ = makeTypeFromExpr(c, n.copyTree) else: result = nil #GlobalError(n[0].info, errCircumNeedsPointer) +proc maybeInstantiateGeneric(c: PContext, n: PNode, s: PSym): PNode = + ## Instantiates generic if not lacking implicit generics, + ## otherwise returns n. + let + neededGenParams = s.ast[genericParamsPos].len + heldGenParams = n.len - 1 + var implicitParams = 0 + for x in s.ast[genericParamsPos]: + if tfImplicitTypeParam in x.typ.flags: + inc implicitParams + if heldGenParams != neededGenParams and implicitParams + heldGenParams == neededGenParams: + # This is an implicit + explicit generic procedure without all args passed, + # kicking back the sem'd symbol fixes #17212 + # Uncertain the hackiness of this solution. + result = n + else: + result = explicitGenericInstantiation(c, n, s) + if result == n: + n[0] = copyTree(result[0]) + proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = ## returns nil if not a built-in subscript operator; also called for the ## checking of assignments + result = nil if n.len == 1: - let x = semDeref(c, n) + let x = semDeref(c, n, flags) if x == nil: return nil + if x.typ.kind == tyFromExpr: + # depends on generic type + return x result = newNodeIT(nkDerefExpr, x.info, x.typ) result.add(x[0]) return checkMinSonsLen(n, 2, c.config) - # make sure we don't evaluate generic macros/templates - n[0] = semExprWithType(c, n[0], - {efNoEvaluateGeneric}) + # signal that generic parameters may be applied after + n[0] = semExprWithType(c, n[0], {efNoEvaluateGeneric, efAllowSymChoice}) var arr = skipTypes(n[0].typ, {tyGenericInst, tyUserTypeClassInst, tyOwned, tyVar, tyLent, tyPtr, tyRef, tyAlias, tySink}) if arr.kind == tyStatic: @@ -1495,7 +1772,7 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = arr = arr.base case arr.kind - of tyArray, tyOpenArray, tyVarargs, tySequence, tyString, tyCString, + of tyArray, tyOpenArray, tyVarargs, tySequence, tyString, tyCstring, tyUncheckedArray: if n.len != 2: return nil n[0] = makeDeref(n[0]) @@ -1531,24 +1808,23 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = {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") + else: + localError(c.config, n.info, + "invalid index $1 in subscript for tuple of length $2" % + [$idx, $arr.len]) result = n else: result = nil else: let s = if n[0].kind == nkSym: n[0].sym - elif n[0].kind in nkSymChoices: n[0][0].sym + elif n[0].kind in nkSymChoices + {nkOpenSym}: n[0][0].sym else: nil if s != nil: case s.kind of skProc, skFunc, skMethod, skConverter, skIterator: # type parameters: partial generic specialization n[0] = semSymGenericInstantiation(c, n[0], s) - result = explicitGenericInstantiation(c, n, s) - if result == n: - n[0] = copyTree(result) - else: - n[0] = result + result = maybeInstantiateGeneric(c, n, s) of skMacro, skTemplate: if efInCall in flags: # We are processing macroOrTmpl[] in macroOrTmpl[](...) call. @@ -1568,11 +1844,11 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = else: discard -proc semArrayAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = +proc semArrayAccess(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode = result = semSubscript(c, n, flags) if result == nil: # overloaded [] operator: - result = semExpr(c, buildOverloadedSubscripts(n, getIdent(c.cache, "[]"))) + result = semExpr(c, buildOverloadedSubscripts(n, getIdent(c.cache, "[]")), flags, expectedType) proc propertyWriteAccess(c: PContext, n, nOrig, a: PNode): PNode = var id = considerQuotedIdent(c, a[1], a) @@ -1581,7 +1857,7 @@ proc propertyWriteAccess(c: PContext, n, nOrig, a: PNode): PNode = # this is ugly. XXX Semantic checking should use the ``nfSem`` flag for # nodes? let aOrig = nOrig[0] - result = newTreeI(nkCall, n.info, setterId, a[0], semExprWithType(c, n[1])) + result = newTreeI(nkCall, n.info, setterId, a[0], n[1]) result.flags.incl nfDotSetter let orig = newTreeI(nkCall, n.info, setterId, aOrig[0], nOrig[1]) result = semOverloadedCallAnalyseEffects(c, result, orig, {}) @@ -1613,23 +1889,30 @@ proc takeImplicitAddr(c: PContext, n: PNode; isLent: bool): PNode = # `proc fun(a: var int): var int = a` discard else: discard - let valid = isAssignable(c, n, isLent) + let valid = isAssignable(c, n) if valid != arLValue: - if valid == arLocalLValue: + if valid in {arAddressableConst, arLentValue} and isLent: + discard "ok" + elif valid == arLocalLValue: localError(c.config, n.info, errXStackEscape % renderTree(n, {renderNoComments})) else: localError(c.config, n.info, errExprHasNoAddress) - result = newNodeIT(nkHiddenAddr, n.info, makePtrType(c, n.typ)) + result = newNodeIT(nkHiddenAddr, n.info, if n.typ.kind in {tyVar, tyLent}: n.typ else: makePtrType(c, n.typ)) + if n.typ.kind in {tyVar, tyLent}: + n.typ = n.typ.elementType result.add(n) proc asgnToResultVar(c: PContext, n, le, ri: PNode) {.inline.} = if le.kind == nkHiddenDeref: var x = le[0] - if (x.typ.kind in {tyVar, tyLent} or classifyViewType(x.typ) != noView) and x.kind == nkSym and x.sym.kind == skResult: - n[0] = x # 'result[]' --> 'result' - n[1] = takeImplicitAddr(c, ri, x.typ.kind == tyLent) - x.typ.flags.incl tfVarIsPtr - #echo x.info, " setting it for this type ", typeToString(x.typ), " ", n.info + if x.kind == nkSym: + if x.sym.kind == skResult and (x.typ.kind in {tyVar, tyLent} or classifyViewType(x.typ) != noView): + n[0] = x # 'result[]' --> 'result' + n[1] = takeImplicitAddr(c, ri, x.typ.kind == tyLent) + x.typ.flags.incl tfVarIsPtr + #echo x.info, " setting it for this type ", typeToString(x.typ), " ", n.info + elif sfGlobal in x.sym.flags: + x.typ.flags.incl tfVarIsPtr proc borrowCheck(c: PContext, n, le, ri: PNode) = const @@ -1683,6 +1966,39 @@ proc goodLineInfo(arg: PNode): TLineInfo = else: arg.info +proc makeTupleAssignments(c: PContext; n: PNode): PNode = + ## expand tuple unpacking assignment into series of assignments + ## + ## mirrored with semstmts.makeVarTupleSection + let lhs = n[0] + let value = semExprWithType(c, n[1], {efTypeAllowed}) + if value.typ.kind != tyTuple: + localError(c.config, n[1].info, errTupleUnpackingTupleExpected % + [typeToString(value.typ, preferDesc)]) + elif lhs.len != value.typ.len: + localError(c.config, n.info, errTupleUnpackingDifferentLengths % + [$lhs.len, typeToString(value.typ, preferDesc), $value.typ.len]) + result = newNodeI(nkStmtList, n.info) + + let temp = newSym(skTemp, getIdent(c.cache, "tmpTupleAsgn"), c.idgen, getCurrOwner(c), n.info) + temp.typ = value.typ + temp.flags.incl(sfGenSym) + var v = newNodeI(nkLetSection, value.info) + let tempNode = newSymNode(temp) #newIdentNode(getIdent(genPrefix & $temp.id), value.info) + var vpart = newNodeI(nkIdentDefs, v.info, 3) + vpart[0] = tempNode + vpart[1] = c.graph.emptyNode + vpart[2] = value + v.add vpart + result.add(v) + + for i in 0..<lhs.len: + if lhs[i].kind == nkIdent and lhs[i].ident.id == ord(wUnderscore): + # skip _ assignments if we are using a temp as they are already evaluated + discard + else: + result.add newAsgnStmt(lhs[i], newTupleAccessRaw(tempNode, i)) + proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode = checkSonsLen(n, 2, c.config) var a = n[0] @@ -1691,7 +2007,8 @@ proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode = # r.f = x # --> `f=` (r, x) let nOrig = n.copyTree - a = builtinFieldAccess(c, a, {efLValue}) + var flags = {efLValue} + a = builtinFieldAccess(c, a, flags) if a == nil: a = propertyWriteAccess(c, n, nOrig, n[0]) if a != nil: return a @@ -1709,8 +2026,8 @@ proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode = result = buildOverloadedSubscripts(n[0], getIdent(c.cache, "[]=")) result.add(n[1]) if mode == noOverloadedSubscript: - bracketNotFoundError(c, result) - return n + bracketNotFoundError(c, result, {}) + return errorNode(c, n) else: result = semExprNoType(c, result) return result @@ -1720,11 +2037,11 @@ proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode = result.add(n[1]) return semExprNoType(c, result) of nkPar, nkTupleConstr: - if a.len >= 2: + if a.len >= 2 or a.kind == nkTupleConstr: # unfortunately we need to rewrite ``(x, y) = foo()`` already here so # that overloading of the assignment operator still works. Usually we # prefer to do these rewritings in transf.nim: - return semStmt(c, lowerTupleUnpackingForAsgn(c.graph, n, c.idgen, c.p.owner), {}) + return semStmt(c, makeTupleAssignments(c, n), {}) else: a = semExprWithType(c, a, {efLValue}) else: @@ -1733,34 +2050,37 @@ proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode = # a = b # both are vars, means: a[] = b[] # a = b # b no 'var T' means: a = addr(b) var le = a.typ + let assignable = isAssignable(c, a) + let root = getRoot(a) + let useStrictDefLet = root != nil and root.kind == skLet and + assignable == arAddressableConst and + strictDefs in c.features and isLocalSym(root) if le == nil: localError(c.config, a.info, "expression has no type") 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): + assignable in {arNone, arLentValue, arAddressableConst} and not useStrictDefLet + ) 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})) else: - let - lhs = n[0] - lhsIsResult = lhs.kind == nkSym and lhs.sym.kind == skResult - var - rhs = semExprWithType(c, n[1], - if lhsIsResult: {efAllowDestructor} else: {}) - if lhsIsResult: + let lhs = n[0] + let rhs = semExprWithType(c, n[1], {efTypeAllowed}, le) + if lhs.kind == nkSym and lhs.sym.kind == skResult: n.typ = c.enforceVoidContext if c.p.owner.kind != skMacro and resultTypeIsInferrable(lhs.sym.typ): var rhsTyp = rhs.typ if rhsTyp.kind in tyUserTypeClasses and rhsTyp.isResolvedUserTypeClass: - rhsTyp = rhsTyp.lastSon + rhsTyp = rhsTyp.last + if lhs.sym.typ.kind == tyAnything: + rhsTyp = rhsTyp.skipTypes({tySink}).skipIntLit(c.idgen) if cmpTypes(c, lhs.typ, rhsTyp) in {isGeneric, isEqual}: internalAssert c.config, c.p.resultSym != nil # Make sure the type is valid for the result variable typeAllowedCheck(c, n.info, rhsTyp, skResult) lhs.typ = rhsTyp c.p.resultSym.typ = rhsTyp - c.p.owner.typ[0] = rhsTyp + c.p.owner.typ.setReturnType rhsTyp else: typeMismatch(c.config, n.info, lhs.typ, rhsTyp, rhs) borrowCheck(c, n, lhs, rhs) @@ -1796,9 +2116,12 @@ proc semReturn(c: PContext, n: PNode): PNode = else: localError(c.config, n.info, "'return' not allowed here") -proc semProcBody(c: PContext, n: PNode): PNode = +proc semProcBody(c: PContext, n: PNode; expectedType: PType = nil): PNode = + when defined(nimsuggest): + if c.graph.config.expandDone(): + return n openScope(c) - result = semExpr(c, n) + result = semExpr(c, n, expectedType = expectedType) if c.p.resultSym != nil and not isEmptyType(result.typ): if result.kind == nkNilLit: # or ImplicitlyDiscardable(result): @@ -1823,12 +2146,12 @@ proc semProcBody(c: PContext, n: PNode): PNode = if isEmptyType(result.typ): # we inferred a 'void' return type: c.p.resultSym.typ = errorType(c) - c.p.owner.typ[0] = nil + c.p.owner.typ.setReturnType nil else: localError(c.config, c.p.resultSym.info, errCannotInferReturnType % c.p.owner.name.s) - if isInlineIterator(c.p.owner.typ) and c.p.owner.typ[0] != nil and - c.p.owner.typ[0].kind == tyUntyped: + if isIterator(c.p.owner.typ) and c.p.owner.typ.returnType != nil and + c.p.owner.typ.returnType.kind == tyAnything: localError(c.config, c.p.owner.info, errCannotInferReturnType % c.p.owner.name.s) closeScope(c) @@ -1854,6 +2177,8 @@ proc semYieldVarResult(c: PContext, n: PNode, restype: PType) = tupleConstr[i] = takeImplicitAddr(c, tupleConstr[i], e.kind == tyLent) else: localError(c.config, n[0].info, errXExpected, "tuple constructor") + elif e.kind == tyEmpty: + localError(c.config, n[0].info, errTypeExpected) else: when false: # XXX investigate what we really need here. @@ -1866,12 +2191,10 @@ proc semYield(c: PContext, n: PNode): PNode = if c.p.owner == nil or c.p.owner.kind != skIterator: localError(c.config, n.info, errYieldNotAllowedHere) elif n[0].kind != nkEmpty: - n[0] = semExprWithType(c, n[0]) # check for type compatibility: var iterType = c.p.owner.typ let restype = iterType[0] + n[0] = semExprWithType(c, n[0], {}, restype) # check for type compatibility: if restype != nil: - if restype.kind != tyUntyped: - n[0] = fitNode(c, restype, n[0], n.info) if n[0].typ == nil: internalError(c.config, n.info, "semYield") if resultTypeIsInferrable(restype): @@ -1879,18 +2202,32 @@ proc semYield(c: PContext, n: PNode): PNode = iterType[0] = inferred if c.p.resultSym != nil: c.p.resultSym.typ = inferred + else: + n[0] = fitNode(c, restype, n[0], n.info) semYieldVarResult(c, n, restype) else: localError(c.config, n.info, errCannotReturnExpr) - elif c.p.owner.typ[0] != nil: + elif c.p.owner.typ.returnType != nil: localError(c.config, n.info, errGenerated, "yield statement must yield a value") +proc considerQuotedIdentOrDot(c: PContext, n: PNode, origin: PNode = nil): PIdent = + if n.kind == nkDotExpr: + let a = considerQuotedIdentOrDot(c, n[0], origin).s + let b = considerQuotedIdentOrDot(c, n[1], origin).s + var s = newStringOfCap(a.len + b.len + 1) + s.add(a) + s.add('.') + s.add(b) + result = getIdent(c.cache, s) + else: + result = considerQuotedIdent(c, n, origin) + proc semDefined(c: PContext, n: PNode): PNode = checkSonsLen(n, 2, c.config) # we replace this node by a 'true' or 'false' node: result = newIntNode(nkIntLit, 0) - result.intVal = ord isDefined(c.config, considerQuotedIdent(c, n[1], n).s) + result.intVal = ord isDefined(c.config, considerQuotedIdentOrDot(c, n[1], n).s) result.info = n.info result.typ = getSysType(c.graph, n.info, tyBool) @@ -1918,6 +2255,8 @@ proc lookUpForDeclared(c: PContext, n: PNode, onlyCurrentScope: bool): PSym = result = n.sym of nkOpenSymChoice, nkClosedSymChoice: result = n[0].sym + of nkOpenSym: + result = lookUpForDeclared(c, n[0], onlyCurrentScope) else: localError(c.config, n.info, "identifier expected, but got: " & renderTree(n)) result = nil @@ -1953,10 +2292,11 @@ proc expectString(c: PContext, n: PNode): string = if n.kind in nkStrKinds: return n.strVal else: + result = "" localError(c.config, n.info, errStringLiteralExpected) proc newAnonSym(c: PContext; kind: TSymKind, info: TLineInfo): PSym = - result = newSym(kind, c.cache.idAnon, nextSymId c.idgen, getCurrOwner(c), info) + result = newSym(kind, c.cache.idAnon, c.idgen, getCurrOwner(c), info) proc semExpandToAst(c: PContext, n: PNode): PNode = let macroCall = n[1] @@ -1977,7 +2317,7 @@ proc semExpandToAst(c: PContext, n: PNode): PNode = let headSymbol = macroCall[0] var cands = 0 var cand: PSym = nil - var o: TOverloadIter + var o: TOverloadIter = default(TOverloadIter) var symx = initOverloadIter(o, c, headSymbol) while symx != nil: if symx.kind in {skTemplate, skMacro} and symx.typ.len == macroCall.len: @@ -2073,20 +2413,26 @@ proc semQuoteAst(c: PContext, n: PNode): PNode = ids[0] = newAnonSym(c, skParam, n.info).newSymNode processQuotations(c, quotedBlock, op, quotes, ids) + let dummyTemplateSym = newAnonSym(c, skTemplate, n.info) + incl(dummyTemplateSym.flags, sfTemplateRedefinition) var dummyTemplate = newProcNode( nkTemplateDef, quotedBlock.info, body = quotedBlock, params = c.graph.emptyNode, - name = newAnonSym(c, skTemplate, n.info).newSymNode, + name = dummyTemplateSym.newSymNode, pattern = c.graph.emptyNode, genericParams = c.graph.emptyNode, pragmas = c.graph.emptyNode, exceptions = c.graph.emptyNode) if ids.len > 0: dummyTemplate[paramsPos] = newNodeI(nkFormalParams, n.info) dummyTemplate[paramsPos].add getSysSym(c.graph, n.info, "untyped").newSymNode # return type - ids.add getSysSym(c.graph, n.info, "untyped").newSymNode # params type - ids.add c.graph.emptyNode # no default value - dummyTemplate[paramsPos].add newTreeI(nkIdentDefs, n.info, ids) - + dummyTemplate[paramsPos].add newTreeI(nkIdentDefs, n.info, ids[0], getSysSym(c.graph, n.info, "typed").newSymNode, c.graph.emptyNode) + for i in 1..<ids.len: + let exp = semExprWithType(c, quotes[i+1], {}) + let typ = exp.typ + if tfTriggersCompileTime notin typ.flags and typ.kind != tyStatic and exp.kind == nkSym and exp.sym.kind notin routineKinds + {skType}: + dummyTemplate[paramsPos].add newTreeI(nkIdentDefs, n.info, ids[i], newNodeIT(nkType, n.info, typ), c.graph.emptyNode) + else: + dummyTemplate[paramsPos].add newTreeI(nkIdentDefs, n.info, ids[i], getSysSym(c.graph, n.info, "typed").newSymNode, c.graph.emptyNode) var tmpl = semTemplateDef(c, dummyTemplate) quotes[0] = tmpl[namePos] # This adds a call to newIdentNode("result") as the first argument to the template call @@ -2142,7 +2488,7 @@ proc tryExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = if c.config.errorCounter != oldErrorCount: result = nil except ERecoverableError: - discard + result = nil # undo symbol table changes (as far as it's possible): c.compilesContextId = oldCompilesId c.generics = oldGenerics @@ -2181,7 +2527,7 @@ proc semShallowCopy(c: PContext, n: PNode, flags: TExprFlags): PNode = result = semDirectOp(c, n, flags) proc createFlowVar(c: PContext; t: PType; info: TLineInfo): PType = - result = newType(tyGenericInvocation, nextTypeId c.idgen, c.module) + result = newType(tyGenericInvocation, c.idgen, c.module) addSonSkipIntLit(result, magicsys.getCompilerProc(c.graph, "FlowVar").typ, c.idgen) addSonSkipIntLit(result, t, c.idgen) result = instGenericContainer(c, info, result, allowMetaTypes = false) @@ -2191,15 +2537,14 @@ proc instantiateCreateFlowVarCall(c: PContext; t: PType; let sym = magicsys.getCompilerProc(c.graph, "nimCreateFlowVar") if sym == nil: localError(c.config, info, "system needs: nimCreateFlowVar") - var bindings: TIdTable - initIdTable(bindings) + var bindings = initTypeMapping() bindings.idTablePut(sym.ast[genericParamsPos][0].typ, t) result = c.semGenerateInstance(c, sym, bindings, info) # since it's an instantiation, we unmark it as a compilerproc. Otherwise # codegen would fail: if sfCompilerProc in result.flags: result.flags.excl {sfCompilerProc, sfExportc, sfImportc} - result.loc.r = nil + result.loc.snippet = "" proc setMs(n: PNode, s: PSym): PNode = result = n @@ -2215,16 +2560,14 @@ proc semSizeof(c: PContext, n: PNode): PNode = n.typ = getSysType(c.graph, n.info, tyInt) result = foldSizeOf(c.config, n, n) -proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = +proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags; expectedType: PType = nil): PNode = # this is a hotspot in the compiler! result = n case s.magic # magics that need special treatment of mAddr: markUsed(c, n.info, s) checkSonsLen(n, 2, c.config) - result[0] = newSymNode(s, n[0].info) - result[1] = semAddrArg(c, n[1], s.name.s == "unsafeAddr") - result.typ = makePtrType(c, result[1].typ) + result = semAddr(c, n[1]) of mTypeOf: markUsed(c, n.info, s) result = semTypeOf(c, n) @@ -2270,12 +2613,15 @@ proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = of mSpawn: markUsed(c, n.info, s) when defined(leanCompiler): - localError(c.config, n.info, "compiler was built without 'spawn' support") - result = n + result = localErrorNode(c, n, "compiler was built without 'spawn' support") else: result = setMs(n, s) for i in 1..<n.len: result[i] = semExpr(c, n[i]) + + if n.len > 1 and n[1].kind notin nkCallKinds: + return localErrorNode(c, n, n[1].info, "'spawn' takes a call expression; got: " & $n[1]) + let typ = result[^1].typ if not typ.isEmptyType: if spawnResult(typ, c.inParallelStmt > 0) == srFlowVar: @@ -2328,16 +2674,30 @@ proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = of mSizeOf: markUsed(c, n.info, s) result = semSizeof(c, setMs(n, s)) + of mArrToSeq, mOpenArrayToSeq: + if expectedType != nil and ( + let expected = expectedType.skipTypes(abstractRange-{tyDistinct}); + expected.kind in {tySequence, tyOpenArray}): + # seq type inference + var arrayType = newType(tyOpenArray, c.idgen, expected.owner) + arrayType.rawAddSon(expected[0]) + if n[0].kind == nkSym and sfFromGeneric in n[0].sym.flags: + # may have been resolved to `@`[empty] at some point, + # reset to `@` to deal with this + n[0] = newSymNode(n[0].sym.instantiatedFrom, n[0].info) + n[1] = semExpr(c, n[1], flags, arrayType) + result = semDirectOp(c, n, flags, expectedType) else: - result = semDirectOp(c, n, flags) + result = semDirectOp(c, n, flags, expectedType) proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = # If semCheck is set to false, ``when`` will return the verbatim AST of # the correct branch. Otherwise the AST will be passed through semStmt. result = nil + let flags = if semCheck: {efWantStmt} else: {} template setResult(e: untyped) = - if semCheck: result = semExpr(c, e) # do not open a new scope! + if semCheck: result = semExpr(c, e, flags) # do not open a new scope! else: result = e # Check if the node is "when nimvm" @@ -2347,15 +2707,18 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = # ... var whenNimvm = false var typ = commonTypeBegin - if n.len == 2 and n[0].kind == nkElifBranch and - n[1].kind == nkElse: - let exprNode = n[0][0] + if n.len in 1..2 and n[0].kind == nkElifBranch and ( + n.len == 1 or n[1].kind == nkElse): + var exprNode = n[0][0] + if exprNode.kind == nkOpenSym: + exprNode = exprNode[0] if exprNode.kind == nkIdent: whenNimvm = lookUp(c, exprNode).magic == mNimvm elif exprNode.kind == nkSym: whenNimvm = exprNode.sym.magic == mNimvm if whenNimvm: n.flags.incl nfLL + var cannotResolve = false for i in 0..<n.len: var it = n[i] case it.kind @@ -2363,9 +2726,22 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = checkSonsLen(it, 2, c.config) if whenNimvm: if semCheck: - it[1] = semExpr(c, it[1]) + it[1] = semExpr(c, it[1], flags) typ = commonType(c, typ, it[1].typ) result = n # when nimvm is not elimited until codegen + elif c.inGenericContext > 0: + let e = semExprWithType(c, it[0]) + if e.typ.kind == tyFromExpr: + it[0] = makeStaticExpr(c, e) + cannotResolve = true + else: + it[0] = forceBool(c, e) + let val = getConstExpr(c.module, it[0], c.idgen, c.graph) + if val == nil or val.kind != nkIntLit: + cannotResolve = true + elif not cannotResolve and val.intVal != 0 and result == nil: + setResult(it[1]) + return # we're not in nimvm and we already have a result else: let e = forceBool(c, semConstExpr(c, it[0])) if e.kind != nkIntLit: @@ -2377,48 +2753,81 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = return # we're not in nimvm and we already have a result of nkElse, nkElseExpr: checkSonsLen(it, 1, c.config) - if result == nil or whenNimvm: + if cannotResolve: + discard + elif result == nil or whenNimvm: if semCheck: - it[0] = semExpr(c, it[0]) + it[0] = semExpr(c, it[0], flags) typ = commonType(c, typ, it[0].typ) + if typ != nil and typ.kind != tyUntyped: + it[0] = fitNode(c, typ, it[0], it[0].info) if result == nil: result = it[0] else: illFormedAst(n, c.config) + if cannotResolve: + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, result.copyTree) + return if result == nil: result = newNodeI(nkEmpty, n.info) - if whenNimvm: result.typ = typ + if whenNimvm: + result.typ = typ + if n.len == 1: + result.add(newTree(nkElse, newNode(nkStmtList))) -proc semSetConstr(c: PContext, n: PNode): PNode = +proc semSetConstr(c: PContext, n: PNode, expectedType: PType = nil): PNode = result = newNodeI(nkCurly, n.info) result.typ = newTypeS(tySet, c) + result.typ.flags.incl tfIsConstructor + var expectedElementType: PType = nil + if expectedType != nil and ( + let expected = expectedType.skipTypes(abstractRange-{tyDistinct}); + expected.kind == tySet): + expectedElementType = expected[0] if n.len == 0: - rawAddSon(result.typ, newTypeS(tyEmpty, c)) + rawAddSon(result.typ, + if expectedElementType != nil and + typeAllowed(expectedElementType, skLet, c) == nil: + expectedElementType + else: + newTypeS(tyEmpty, c)) else: # only semantic checking for all elements, later type checking: var typ: PType = nil for i in 0..<n.len: + let doSetType = typ == nil if isRange(n[i]): checkSonsLen(n[i], 3, c.config) - n[i][1] = semExprWithType(c, n[i][1]) - n[i][2] = semExprWithType(c, n[i][2]) - if typ == nil: + n[i][1] = semExprWithType(c, n[i][1], {efTypeAllowed}, expectedElementType) + n[i][2] = semExprWithType(c, n[i][2], {efTypeAllowed}, expectedElementType) + if doSetType: typ = skipTypes(n[i][1].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal, tyAlias, tySink}) n[i].typ = n[i][2].typ # range node needs type too elif n[i].kind == nkRange: # already semchecked - if typ == nil: + if doSetType: typ = skipTypes(n[i][0].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal, tyAlias, tySink}) else: - n[i] = semExprWithType(c, n[i]) - if typ == nil: + n[i] = semExprWithType(c, n[i], {efTypeAllowed}, expectedElementType) + if doSetType: 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) - elif lengthOrd(c.config, typ) > MaxSetElements: - typ = makeRangeType(c, 0, MaxSetElements-1, n.info) + if doSetType: + if not isOrdinalType(typ, allowEnumWithHoles=true): + localError(c.config, n.info, errOrdinalTypeExpected % typeToString(typ, preferDesc)) + typ = makeRangeType(c, 0, MaxSetElements-1, n.info) + elif isIntLit(typ): + # set of int literal, use a default range smaller than the max range + typ = makeRangeType(c, 0, DefaultSetElements-1, n.info) + elif lengthOrd(c.config, typ) > MaxSetElements: + message(c.config, n.info, warnAboveMaxSizeSet, "type '" & + typeToString(typ, preferDesc) & "' is too big to be a `set` element, " & + "assuming a range of 0.." & $(MaxSetElements - 1) & + ", explicitly write this range to get rid of warning") + typ = makeRangeType(c, 0, MaxSetElements-1, n.info) + if expectedElementType == nil: + expectedElementType = typ addSonSkipIntLit(result.typ, typ, c.idgen) for i in 0..<n.len: var m: PNode @@ -2432,7 +2841,7 @@ proc semSetConstr(c: PContext, n: PNode): PNode = m = fitNode(c, typ, n[i], info) result.add m -proc semTableConstr(c: PContext, n: PNode): PNode = +proc semTableConstr(c: PContext, n: PNode; expectedType: PType = nil): PNode = # we simply transform ``{key: value, key2, key3: value}`` to # ``[(key, value), (key2, value2), (key3, value2)]`` result = newNodeI(nkBracket, n.info) @@ -2454,7 +2863,7 @@ proc semTableConstr(c: PContext, n: PNode): PNode = lastKey = i+1 if lastKey != n.len: illFormedAst(n, c.config) - result = semExpr(c, result) + result = semExpr(c, result, expectedType = expectedType) type TParKind = enum @@ -2481,8 +2890,13 @@ proc checkPar(c: PContext; n: PNode): TParKind = localError(c.config, n[i].info, errNamedExprNotAllowed) return paNone -proc semTupleFieldsConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = +proc semTupleFieldsConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode = result = newNodeI(nkTupleConstr, n.info) + var expected: PType = nil + if expectedType != nil: + expected = expectedType.skipTypes(abstractRange-{tyDistinct}) + if not (expected.kind == tyTuple and expected.len == n.len): + expected = nil var typ = newTypeS(tyTuple, c) typ.n = newNodeI(nkRecList, n.info) # nkIdentDefs var ids = initIntSet() @@ -2492,15 +2906,22 @@ proc semTupleFieldsConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = let id = considerQuotedIdent(c, n[i][0]) if containsOrIncl(ids, id.id): localError(c.config, n[i].info, errFieldInitTwice % id.s) - n[i][1] = semExprWithType(c, n[i][1], - flags*{efAllowDestructor}) + # can check if field name matches expected type here + let expectedElemType = if expected != nil: expected[i] else: nil + n[i][1] = semExprWithType(c, n[i][1], {}, expectedElemType) + if expectedElemType != nil and + (expectedElemType.kind != tyNil and not hasEmpty(expectedElemType)): + # hasEmpty/nil check is to not break existing code like + # `const foo = [(1, {}), (2, {false})]`, + # `const foo = if true: (0, nil) else: (1, new(int))` + n[i][1] = fitNode(c, expectedElemType, n[i][1], n[i][1].info) if n[i][1].typ.kind == tyTypeDesc: localError(c.config, n[i][1].info, "typedesc not allowed as tuple field.") n[i][1].typ = errorType(c) var f = newSymS(skField, n[i][0], c) - f.typ = skipIntLit(n[i][1].typ, c.idgen) + f.typ = skipIntLit(n[i][1].typ.skipTypes({tySink}), c.idgen) f.position = i rawAddSon(typ, f.typ) typ.n.add newSymNode(f) @@ -2508,20 +2929,34 @@ proc semTupleFieldsConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = result.add n[i] result.typ = typ -proc semTuplePositionsConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = +proc semTuplePositionsConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode = result = n # we don't modify n, but compute the type: result.transitionSonsKind(nkTupleConstr) + var expected: PType = nil + if expectedType != nil: + expected = expectedType.skipTypes(abstractRange-{tyDistinct}) + if not (expected.kind == tyTuple and expected.len == n.len): + expected = nil var typ = newTypeS(tyTuple, c) # leave typ.n nil! for i in 0..<n.len: - n[i] = semExprWithType(c, n[i], flags*{efAllowDestructor}) - addSonSkipIntLit(typ, n[i].typ, c.idgen) + let expectedElemType = if expected != nil: expected[i] else: nil + n[i] = semExprWithType(c, n[i], {}, expectedElemType) + if expectedElemType != nil and + (expectedElemType.kind != tyNil and not hasEmpty(expectedElemType)): + # hasEmpty/nil check is to not break existing code like + # `const foo = [(1, {}), (2, {false})]`, + # `const foo = if true: (0, nil) else: (1, new(int))` + n[i] = fitNode(c, expectedElemType, n[i], n[i].info) + addSonSkipIntLit(typ, n[i].typ.skipTypes({tySink}), c.idgen) result.typ = typ include semobjconstr -proc semBlock(c: PContext, n: PNode; flags: TExprFlags): PNode = +proc semBlock(c: PContext, n: PNode; flags: TExprFlags; expectedType: PType = nil): PNode = result = n inc(c.p.nestedBlockCounter) + let oldBreakInLoop = c.p.breakInLoop + c.p.breakInLoop = false checkSonsLen(n, 2, c.config) openScope(c) # BUGFIX: label is in the scope of block! if n[0].kind != nkEmpty: @@ -2532,13 +2967,14 @@ proc semBlock(c: PContext, n: PNode; flags: TExprFlags): PNode = labl.owner = c.p.owner n[0] = newSymNode(labl, n[0].info) suggestSym(c.graph, n[0].info, labl, c.graph.usageSym) - styleCheckDef(c.config, labl) + styleCheckDef(c, labl) onDef(n[0].info, labl) - n[1] = semExpr(c, n[1], flags) + n[1] = semExpr(c, n[1], flags, expectedType) n.typ = n[1].typ if isEmptyType(n.typ): n.transitionSonsKind(nkBlockStmt) else: n.transitionSonsKind(nkBlockExpr) closeScope(c) + c.p.breakInLoop = oldBreakInLoop dec(c.p.nestedBlockCounter) proc semExportExcept(c: PContext, n: PNode): PNode = @@ -2566,7 +3002,7 @@ proc semExport(c: PContext, n: PNode): PNode = result = newNodeI(nkExportStmt, n.info) for i in 0..<n.len: let a = n[i] - var o: TOverloadIter + var o: TOverloadIter = default(TOverloadIter) var s = initOverloadIter(o, c, a) if s == nil: localError(c.config, a.info, errGenerated, "cannot export: " & renderTree(a)) @@ -2600,16 +3036,15 @@ proc semExport(c: PContext, n: PNode): PNode = s = nextOverloadIter(o, c, a) -proc semTupleConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = - var tupexp = semTuplePositionsConstr(c, n, flags) - var isTupleType: bool +proc semTupleConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode = + var tupexp = semTuplePositionsConstr(c, n, flags, expectedType) + var isTupleType: bool = false if tupexp.len > 0: # don't interpret () as type isTupleType = tupexp[0].typ.kind == tyTypeDesc # check if either everything or nothing is tyTypeDesc for i in 1..<tupexp.len: if isTupleType != (tupexp[i].typ.kind == tyTypeDesc): - localError(c.config, tupexp[i].info, "Mixing types and values in tuples is not allowed.") - return(errorNode(c,n)) + return localErrorNode(c, n, tupexp[i].info, "Mixing types and values in tuples is not allowed.") if isTupleType: # expressions as ``(int, string)`` are reinterpret as type expressions result = n var typ = semTypeNode(c, n, nil).skipTypes({tyTypeDesc}) @@ -2617,18 +3052,73 @@ proc semTupleConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = else: result = tupexp -proc shouldBeBracketExpr(n: PNode): bool = +proc isExplicitGenericCall(c: PContext, n: PNode): bool = + ## checks if a call node `n` is a routine call with explicit generic params + ## + ## the callee node needs to be either an nkBracketExpr or a call to a + ## symchoice of `[]` in which case it will be transformed into nkBracketExpr + ## + ## the LHS of the bracket expr has to either be a symchoice or resolve to + ## a routine symbol + template checkCallee(n: PNode) = + # check subscript LHS, `n` must be mutable + if isSymChoice(n): + result = true + else: + let s = qualifiedLookUp(c, n, {}) + if s != nil and s.kind in routineKinds: + result = true + n = semSymGenericInstantiation(c, n, s) assert n.kind in nkCallKinds + result = false let a = n[0] - if a.kind in nkCallKinds: + case a.kind + of nkBracketExpr: + checkCallee(a[0]) + of nkCallKinds: let b = a[0] if b.kind in nkSymChoices: - for i in 0..<b.len: - if b[i].kind == nkSym and b[i].sym.magic == mArrGet: - let be = newNodeI(nkBracketExpr, n.info) + let name = b.getPIdent + if name != nil and name.s == "[]": + checkCallee(a[1]) + if result: + # transform callee into normal bracket expr, only on success + let be = newNodeI(nkBracketExpr, a.info) for i in 1..<a.len: be.add(a[i]) n[0] = be - return true + else: + result = false + +proc asBracketExpr(c: PContext; n: PNode): PNode = + proc isGeneric(c: PContext; n: PNode): bool = + if n.kind in {nkIdent, nkAccQuoted}: + let s = qualifiedLookUp(c, n, {}) + result = s != nil and isGenericRoutineStrict(s) + else: + result = false + + assert n.kind in nkCallKinds + if n.len > 1 and isGeneric(c, n[1]): + let b = n[0] + if b.kind in nkSymChoices: + for i in 0..<b.len: + if b[i].kind == nkSym and b[i].sym.magic == mArrGet: + result = newNodeI(nkBracketExpr, n.info) + for i in 1..<n.len: result.add(n[i]) + return result + return nil + +proc isOpenArraySym(x: PNode): bool = + var x = x + while true: + case x.kind + of {nkAddr, nkHiddenAddr}: + x = x[0] + of {nkHiddenStdConv, nkHiddenDeref}: + x = x[1] + else: + break + result = x.kind == nkSym proc hoistParamsUsedInDefault(c: PContext, call, letSection, defExpr: var PNode) = # This takes care of complicated signatures such as: @@ -2647,11 +3137,18 @@ proc hoistParamsUsedInDefault(c: PContext, call, letSection, defExpr: var PNode) # duty is activated by returning a non-nil value. The caller is responsible # for replacing the input to the function with the returned non-nil value. # (which is the hoisted symbol) - if defExpr.kind == nkSym and defExpr.sym.kind == skParam and defExpr.sym.owner == call[0].sym: + if defExpr.kind == nkSym and defExpr.sym.kind == skParam and + (defExpr.sym.owner == call[0].sym or + # symbol was resolved before proc was instantiated: + (sfFromGeneric in call[0].sym.flags and + defExpr.sym.owner == call[0].sym.instantiatedFrom)): let paramPos = defExpr.sym.position + 1 - if call[paramPos].kind != nkSym: - let hoistedVarSym = newSym(skLet, getIdent(c.graph.cache, genPrefix), nextSymId c.idgen, + if call[paramPos].skipAddr.kind != nkSym and not ( + skipTypes(call[paramPos].typ, abstractVar).kind in {tyOpenArray, tyVarargs} and + isOpenArraySym(call[paramPos]) + ): + let hoistedVarSym = newSym(skLet, getIdent(c.graph.cache, genPrefix), c.idgen, c.p.owner, letSection.info, c.p.owner.options) hoistedVarSym.typ = call[paramPos].typ @@ -2662,7 +3159,7 @@ proc hoistParamsUsedInDefault(c: PContext, call, letSection, defExpr: var PNode) call[paramPos] = newSymNode(hoistedVarSym) # Refer the original arg to its hoisted sym - # arg we refer to is a sym, wether introduced by hoisting or not doesn't matter, we simply reuse it + # arg we refer to is a sym, whether introduced by hoisting or not doesn't matter, we simply reuse it defExpr = call[paramPos] else: for i in 0..<defExpr.safeLen: @@ -2676,23 +3173,133 @@ proc getNilType(c: PContext): PType = result.align = c.config.target.ptrSize.int16 c.nilTypeCache = result -proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = - when defined(nimCompilerStackraceHints): +proc enumFieldSymChoice(c: PContext, n: PNode, s: PSym; flags: TExprFlags): PNode = + var o: TOverloadIter = default(TOverloadIter) + var i = 0 + var a = initOverloadIter(o, c, n) + while a != nil: + if a.kind == skEnumField: + inc(i) + if i > 1: break + a = nextOverloadIter(o, c, n) + let info = getCallLineInfo(n) + if i <= 1: + if sfGenSym notin s.flags: + result = newSymNode(s, info) + markUsed(c, info, s, efInCall notin flags) + onUse(info, s) + else: + result = n + else: + result = newNodeIT(nkClosedSymChoice, info, newTypeS(tyNone, c)) + a = initOverloadIter(o, c, n) + while a != nil: + if a.kind == skEnumField: + incl(a.flags, sfUsed) + markOwnerModuleAsUsed(c, a) + result.add newSymNode(a, info) + onUse(info, a) + a = nextOverloadIter(o, c, n) + +proc semPragmaStmt(c: PContext; n: PNode) = + if c.p.owner.kind == skModule: + pragma(c, c.p.owner, n, stmtPragmas+stmtPragmasTopLevel, true) + else: + pragma(c, c.p.owner, n, stmtPragmas, true) + +proc resolveIdentToSym(c: PContext, n: PNode, resultNode: var PNode, + flags: TExprFlags, expectedType: PType): PSym = + # result is nil on error or if a node that can't produce a sym is resolved + let ident = considerQuotedIdent(c, n) + var filter = {low(TSymKind)..high(TSymKind)} + if efNoEvaluateGeneric in flags or expectedType != nil: + # `a[...]` where `a` is a module or package is not possible + filter.excl {skModule, skPackage} + let includePureEnum = expectedType != nil and + expectedType.skipTypes(abstractRange-{tyDistinct}).kind == tyEnum + let candidates = lookUpCandidates(c, ident, filter, + includePureEnum = includePureEnum) + if candidates.len == 0: + result = errorUndeclaredIdentifierHint(c, ident, n.info) + elif candidates.len == 1 or {efNoEvaluateGeneric, efInCall} * flags != {}: + # unambiguous, or we don't care about ambiguity + result = candidates[0] + else: + # ambiguous symbols have 1 last chance as a symchoice + var choice = newNodeIT(nkClosedSymChoice, n.info, newTypeS(tyNone, c)) + for cand in candidates: + case cand.kind + of skModule, skPackage: + discard + of skType: + choice.add newSymNodeTypeDesc(cand, c.idgen, n.info) + else: + choice.add newSymNode(cand, n.info) + if choice.len == 0: + # we know candidates.len > 1, we just couldn't put any in a symchoice + errorUseQualifier(c, n.info, candidates) + return nil + resolveSymChoice(c, choice, flags, expectedType) + # choice.len == 1 can be true here but as long as it's a symchoice + # it's still not resolved + if isSymChoice(choice): + result = nil + if efAllowSymChoice in flags: + resultNode = choice + else: + errorUseQualifier(c, n.info, candidates) + else: + if choice.kind == nkSym: + result = choice.sym + else: + # resolution could have generated nkHiddenStdConv etc + resultNode = semExpr(c, choice, flags, expectedType) + result = nil + +proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}, expectedType: PType = nil): PNode = + when defined(nimCompilerStacktraceHints): setFrameMsg c.config$n.info & " " & $n.kind + when false: # see `tdebugutils` + if isCompilerDebug(): + echo (">", c.config$n.info, n, flags, n.kind) + defer: + if isCompilerDebug(): + echo ("<", c.config$n.info, n, ?.result.typ) + template directLiteral(typeKind: TTypeKind) = + if result.typ == nil: + if expectedType != nil and ( + let expected = expectedType.skipTypes(abstractRange-{tyDistinct}); + expected.kind == typeKind): + result.typ = expected + changeType(c, result, expectedType, check=true) + else: + result.typ = getSysType(c.graph, n.info, typeKind) + result = n + when defined(nimsuggest): + var expandStarted = false + if c.config.ideCmd == ideExpand and not c.config.expandProgress and + ((n.kind in {nkFuncDef, nkProcDef, nkIteratorDef, nkTemplateDef, nkMethodDef, nkConverterDef} and + n.info.exactEquals(c.config.expandPosition)) or + (n.kind in {nkCall, nkCommand} and + n[0].info.exactEquals(c.config.expandPosition))): + expandStarted = true + c.config.expandProgress = true + if c.config.expandLevels == 0: + c.config.expandNodeResult = $n + suggestQuit() + if c.config.cmd == cmdIdeTools: suggestExpr(c, n) if nfSem in n.flags: return case n.kind of nkIdent, nkAccQuoted: - let checks = if efNoEvaluateGeneric in flags: - {checkUndeclared, checkPureEnumFields} - elif efInCall in flags: - {checkUndeclared, checkModule, checkPureEnumFields} - else: - {checkUndeclared, checkModule, checkAmbiguity, checkPureEnumFields} - var s = qualifiedLookUp(c, n, checks) + let s = resolveIdentToSym(c, n, result, flags, expectedType) + if s == nil: + # resolveIdentToSym either errored or gave a result node + return if c.matchedConcept == nil: semCaptureSym(s, c.p.owner) - if s.kind in {skProc, skFunc, skMethod, skConverter, skIterator}: + case s.kind + of skProc, skFunc, skMethod, skConverter, skIterator: #performProcvarCheck(c, n, s) result = symChoice(c, n, s, scClosed) if result.kind == nkSym: @@ -2702,62 +3309,96 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = # "procs literals" are 'owned' if optOwnedRefs in c.config.globalOptions: result.typ = makeVarType(c, result.typ, tyOwned) + of skEnumField: + result = enumFieldSymChoice(c, n, s, flags) else: result = semSym(c, n, s, flags) + if isSymChoice(result): + result = semSymChoice(c, result, flags, expectedType) + of nkClosedSymChoice, nkOpenSymChoice: + result = semSymChoice(c, n, flags, expectedType) of nkSym: + let s = n.sym + if nfDisabledOpenSym in n.flags: + let override = genericsOpenSym in c.features + let res = semOpenSym(c, n, flags, expectedType, + warnDisabled = not override) + if res != nil: + assert override + return res # because of the changed symbol binding, this does not mean that we # don't have to check the symbol for semantics here again! - result = semSym(c, n, n.sym, flags) + result = semSym(c, n, s, flags) + of nkOpenSym: + assert n.len == 1 + let inner = n[0] + result = semOpenSym(c, inner, flags, expectedType) of nkEmpty, nkNone, nkCommentStmt, nkType: discard of nkNilLit: - if result.typ == nil: result.typ = getNilType(c) + if result.typ == nil: + result.typ = getNilType(c) + if expectedType != nil and expectedType.kind notin {tyUntyped, tyTyped}: + var m = newCandidate(c, result.typ) + if typeRel(m, expectedType, result.typ) >= isSubtype: + result.typ = expectedType + # or: result = fitNode(c, expectedType, result, n.info) of nkIntLit: - if result.typ == nil: setIntLitType(c, result) - of nkInt8Lit: - if result.typ == nil: result.typ = getSysType(c.graph, n.info, tyInt8) - of nkInt16Lit: - if result.typ == nil: result.typ = getSysType(c.graph, n.info, tyInt16) - of nkInt32Lit: - if result.typ == nil: result.typ = getSysType(c.graph, n.info, tyInt32) - of nkInt64Lit: - if result.typ == nil: result.typ = getSysType(c.graph, n.info, tyInt64) - of nkUIntLit: - if result.typ == nil: result.typ = getSysType(c.graph, n.info, tyUInt) - of nkUInt8Lit: - if result.typ == nil: result.typ = getSysType(c.graph, n.info, tyUInt8) - of nkUInt16Lit: - if result.typ == nil: result.typ = getSysType(c.graph, n.info, tyUInt16) - of nkUInt32Lit: - if result.typ == nil: result.typ = getSysType(c.graph, n.info, tyUInt32) - of nkUInt64Lit: - if result.typ == nil: result.typ = getSysType(c.graph, n.info, tyUInt64) - #of nkFloatLit: - # if result.typ == nil: result.typ = getFloatLitType(result) - of nkFloat32Lit: - if result.typ == nil: result.typ = getSysType(c.graph, n.info, tyFloat32) - of nkFloat64Lit, nkFloatLit: - if result.typ == nil: result.typ = getSysType(c.graph, n.info, tyFloat64) - of nkFloat128Lit: - if result.typ == nil: result.typ = getSysType(c.graph, n.info, tyFloat128) + if result.typ == nil: + if expectedType != nil and ( + let expected = expectedType.skipTypes(abstractRange-{tyDistinct}); + expected.kind in {tyInt..tyInt64, + tyUInt..tyUInt64, + tyFloat..tyFloat128}): + if expected.kind in {tyFloat..tyFloat128}: + n.transitionIntToFloatKind(nkFloatLit) + changeType(c, result, expectedType, check=true) + else: + setIntLitType(c, result) + of nkInt8Lit: directLiteral(tyInt8) + of nkInt16Lit: directLiteral(tyInt16) + of nkInt32Lit: directLiteral(tyInt32) + of nkInt64Lit: directLiteral(tyInt64) + of nkUIntLit: directLiteral(tyUInt) + of nkUInt8Lit: directLiteral(tyUInt8) + of nkUInt16Lit: directLiteral(tyUInt16) + of nkUInt32Lit: directLiteral(tyUInt32) + of nkUInt64Lit: directLiteral(tyUInt64) + of nkFloatLit: + if result.typ == nil: + if expectedType != nil and ( + let expected = expectedType.skipTypes(abstractRange-{tyDistinct}); + expected.kind in {tyFloat..tyFloat128}): + result.typ = expected + changeType(c, result, expectedType, check=true) + else: + result.typ = getSysType(c.graph, n.info, tyFloat64) + of nkFloat32Lit: directLiteral(tyFloat32) + of nkFloat64Lit: directLiteral(tyFloat64) + of nkFloat128Lit: directLiteral(tyFloat128) of nkStrLit..nkTripleStrLit: - if result.typ == nil: result.typ = getSysType(c.graph, n.info, tyString) - of nkCharLit: - if result.typ == nil: result.typ = getSysType(c.graph, n.info, tyChar) + if result.typ == nil: + if expectedType != nil and ( + let expected = expectedType.skipTypes(abstractRange-{tyDistinct}); + expected.kind in {tyString, tyCstring}): + result.typ = expectedType + else: + result.typ = getSysType(c.graph, n.info, tyString) + of nkCharLit: directLiteral(tyChar) of nkDotExpr: result = semFieldAccess(c, n, flags) if result.kind == nkDotCall: result.transitionSonsKind(nkCall) - result = semExpr(c, result, flags) + result = semExpr(c, result, flags, expectedType) of nkBind: message(c.config, n.info, warnDeprecated, "bind is deprecated") - result = semExpr(c, n[0], flags) - of nkTypeOfExpr, nkTupleTy, nkTupleClassTy, nkRefTy..nkEnumTy, nkStaticTy: + result = semExpr(c, n[0], flags, expectedType) + of nkTypeOfExpr..nkTupleClassTy, nkStaticTy, nkRefTy..nkEnumTy: if c.matchedConcept != nil and n.len == 1: let modifier = n.modifierTypeKindOfNode if modifier != tyNone: var baseType = semExpr(c, n[0]).typ.skipTypes({tyTypeDesc}) - result.typ = c.makeTypeDesc(c.newTypeWithSons(modifier, @[baseType])) + result.typ = c.makeTypeDesc(newTypeS(modifier, c, baseType)) return var typ = semTypeNode(c, n, nil).skipTypes({tyTypeDesc}) result.typ = makeTypeDesc(c, typ) @@ -2773,38 +3414,39 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = c.isAmbiguous = false var s = qualifiedLookUp(c, n[0], mode) if s != nil: - #if c.config.cmd == cmdNimfix and n[0].kind == nkDotExpr: - # pretty.checkUse(n[0][1].info, s) case s.kind of skMacro, skTemplate: - result = semDirectOp(c, n, flags) + result = semDirectOp(c, n, flags, expectedType) of skType: # XXX think about this more (``set`` procs) let ambig = c.isAmbiguous - if not (n[0].kind in {nkClosedSymChoice, nkOpenSymChoice, nkIdent} and ambig) and n.len == 2: - result = semConv(c, n) - elif ambig and n.len == 1: - errorUseQualifier(c, n.info, s) + if not (n[0].kind in nkSymChoices + {nkIdent, nkDotExpr} and ambig) and n.len == 2: + result = semConv(c, n, flags, expectedType) elif n.len == 1: - result = semObjConstr(c, n, flags) - elif s.magic == mNone: result = semDirectOp(c, n, flags) - else: result = semMagic(c, n, s, flags) + if ambig: + errorUseQualifier(c, n.info, s) + else: + result = semObjConstr(c, n, flags, expectedType) + elif s.magic == mNone: result = semDirectOp(c, n, flags, expectedType) + else: result = semMagic(c, n, s, flags, expectedType) of skProc, skFunc, skMethod, skConverter, skIterator: - if s.magic == mNone: result = semDirectOp(c, n, flags) - else: result = semMagic(c, n, s, flags) + if s.magic == mNone: result = semDirectOp(c, n, flags, expectedType) + else: result = semMagic(c, n, s, flags, expectedType) else: #liMessage(n.info, warnUser, renderTree(n)); - result = semIndirectOp(c, n, flags) - elif (n[0].kind == nkBracketExpr or shouldBeBracketExpr(n)) and - isSymChoice(n[0][0]): - # indirectOp can deal with explicit instantiations; the fixes - # the 'newSeq[T](x)' bug - setGenericParams(c, n[0]) - result = semDirectOp(c, n, flags) - elif isSymChoice(n[0]) or nfDotField in n.flags: - result = semDirectOp(c, n, flags) + result = semIndirectOp(c, n, flags, expectedType) + elif isExplicitGenericCall(c, n): # this modifies `n` if true + result = semDirectOp(c, n, flags, expectedType) + elif nfDotField in n.flags: + result = semDirectOp(c, n, flags, expectedType) + elif isSymChoice(n[0]): + let b = asBracketExpr(c, n) + if b != nil: + result = semExpr(c, b, flags, expectedType) + else: + result = semDirectOp(c, n, flags, expectedType) else: - result = semIndirectOp(c, n, flags) + result = semIndirectOp(c, n, flags, expectedType) if nfDefaultRefsParam in result.flags: result = result.copyTree #XXX: Figure out what causes default param nodes to be shared.. (sigmatch bug?) @@ -2823,12 +3465,12 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = # This is a "when nimvm" stmt. result = semWhen(c, n, true) else: - result = semExpr(c, result, flags) + result = semExpr(c, result, flags, expectedType) of nkBracketExpr: checkMinSonsLen(n, 1, c.config) - result = semArrayAccess(c, n, flags) + result = semArrayAccess(c, n, flags, expectedType) of nkCurlyExpr: - result = semExpr(c, buildOverloadedSubscripts(n, getIdent(c.cache, "{}")), flags) + result = semExpr(c, buildOverloadedSubscripts(n, getIdent(c.cache, "{}")), flags, expectedType) of nkPragmaExpr: var pragma = n[1] @@ -2850,24 +3492,24 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = of nkPar, nkTupleConstr: case checkPar(c, n) of paNone: result = errorNode(c, n) - of paTuplePositions: result = semTupleConstr(c, n, flags) - of paTupleFields: result = semTupleFieldsConstr(c, n, flags) - of paSingle: result = semExpr(c, n[0], flags) - of nkCurly: result = semSetConstr(c, n) - of nkBracket: result = semArrayConstr(c, n, flags) - of nkObjConstr: result = semObjConstr(c, n, flags) + of paTuplePositions: result = semTupleConstr(c, n, flags, expectedType) + of paTupleFields: result = semTupleFieldsConstr(c, n, flags, expectedType) + of paSingle: result = semExpr(c, n[0], flags, expectedType) + of nkCurly: result = semSetConstr(c, n, expectedType) + of nkBracket: + result = semArrayConstr(c, n, flags, expectedType) + of nkObjConstr: result = semObjConstr(c, n, flags, expectedType) of nkLambdaKinds: result = semProcAux(c, n, skProc, lambdaPragmas, flags) - of nkDerefExpr: result = semDeref(c, n) + of nkDerefExpr: result = semDeref(c, n, flags) of nkAddr: result = n checkSonsLen(n, 1, c.config) - result[0] = semAddrArg(c, n[0]) - result.typ = makePtrType(c, result[0].typ) + result = semAddr(c, n[0]) of nkHiddenAddr, nkHiddenDeref: checkSonsLen(n, 1, c.config) - n[0] = semExpr(c, n[0], flags) + n[0] = semExpr(c, n[0], flags, expectedType) of nkCast: result = semCast(c, n) - of nkIfExpr, nkIfStmt: result = semIf(c, n, flags) + of nkIfExpr, nkIfStmt: result = semIf(c, n, flags, expectedType) of nkHiddenStdConv, nkHiddenSubConv, nkConv, nkHiddenCallConv: checkSonsLen(n, 2, c.config) considerGenSyms(c, n) @@ -2881,15 +3523,11 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = checkMinSonsLen(n, 2, c.config) considerGenSyms(c, n) of nkTableConstr: - result = semTableConstr(c, n) - of nkClosedSymChoice, nkOpenSymChoice: - # handling of sym choices is context dependent - # the node is left intact for now - discard - of nkStaticExpr: result = semStaticExpr(c, n[0]) - of nkAsgn: result = semAsgn(c, n) - of nkBlockStmt, nkBlockExpr: result = semBlock(c, n, flags) - of nkStmtList, nkStmtListExpr: result = semStmtList(c, n, flags) + result = semTableConstr(c, n, expectedType) + of nkStaticExpr: result = semStaticExpr(c, n[0], expectedType) + of nkAsgn, nkFastAsgn: result = semAsgn(c, n) + of nkBlockStmt, nkBlockExpr: result = semBlock(c, n, flags, expectedType) + of nkStmtList, nkStmtListExpr: result = semStmtList(c, n, flags, expectedType) of nkRaiseStmt: result = semRaise(c, n) of nkVarSection: result = semVarOrLet(c, n, skVar) of nkLetSection: result = semVarOrLet(c, n, skLet) @@ -2897,15 +3535,15 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = of nkTypeSection: result = semTypeSection(c, n) of nkDiscardStmt: result = semDiscard(c, n) of nkWhileStmt: result = semWhile(c, n, flags) - of nkTryStmt, nkHiddenTryStmt: result = semTry(c, n, flags) + of nkTryStmt, nkHiddenTryStmt: result = semTry(c, n, flags, expectedType) of nkBreakStmt, nkContinueStmt: result = semBreakOrContinue(c, n) of nkForStmt, nkParForStmt: result = semFor(c, n, flags) - of nkCaseStmt: result = semCase(c, n, flags) + of nkCaseStmt: result = semCase(c, n, flags, expectedType) of nkReturnStmt: result = semReturn(c, n) of nkUsingStmt: result = semUsing(c, n) of nkAsmStmt: result = semAsm(c, n) of nkYieldStmt: result = semYield(c, n) - of nkPragma: pragma(c, c.p.owner, n, stmtPragmas, true) + of nkPragma: semPragmaStmt(c, n) of nkIteratorDef: result = semIterator(c, n) of nkProcDef: result = semProc(c, n) of nkFuncDef: result = semFunc(c, n) @@ -2939,13 +3577,15 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "export") result = semExportExcept(c, n) of nkPragmaBlock: - result = semPragmaBlock(c, n) + result = semPragmaBlock(c, n, expectedType) of nkStaticStmt: result = semStaticStmt(c, n) of nkDefer: if c.currentScope == c.topLevelScope: localError(c.config, n.info, "defer statement not supported at top level") + openScope(c) n[0] = semExpr(c, n[0]) + closeScope(c) 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") @@ -2957,7 +3597,8 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = of nkMixinStmt: discard of nkBindStmt: if c.p != nil: - c.p.localBindStmts.add n + if n.len > 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})) @@ -2965,3 +3606,8 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = localError(c.config, n.info, "invalid expression: " & renderTree(n, {renderNoComments})) if result != nil: incl(result.flags, nfSem) + + when defined(nimsuggest): + if expandStarted: + c.config.expandNodeResult = $result + suggestQuit() diff --git a/compiler/semfields.nim b/compiler/semfields.nim index 93184c568..874055cdc 100644 --- a/compiler/semfields.nim +++ b/compiler/semfields.nim @@ -64,10 +64,12 @@ type proc semForObjectFields(c: TFieldsCtx, typ, forLoop, father: PNode) = case typ.kind of nkSym: - var fc: TFieldInstCtx # either 'tup[i]' or 'field' is valid - fc.c = c.c - fc.field = typ.sym - fc.replaceByFieldName = c.m == mFieldPairs + # either 'tup[i]' or 'field' is valid + var fc = TFieldInstCtx( + c: c.c, + field: typ.sym, + replaceByFieldName: c.m == mFieldPairs + ) openScope(c.c) inc c.c.inUnrolledContext let body = instFieldLoopBody(fc, lastSon(forLoop), forLoop) @@ -109,7 +111,7 @@ proc semForFields(c: PContext, n: PNode, m: TMagic): PNode = 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) + trueSymbol = newSym(skUnknown, getIdent(c.cache, "true"), c.idgen, getCurrOwner(c), n.info) trueSymbol.typ = getSysType(c.graph, n.info, tyBool) result[0] = newSymNode(trueSymbol, n.info) @@ -133,29 +135,31 @@ proc semForFields(c: PContext, n: PNode, m: TMagic): PNode = typeMismatch(c.config, calli.info, tupleTypeA, tupleTypeB, calli) inc(c.p.nestedLoopCounter) + let oldBreakInLoop = c.p.breakInLoop + c.p.breakInLoop = true if tupleTypeA.kind == tyTuple: var loopBody = n[^1] for i in 0..<tupleTypeA.len: openScope(c) - var fc: TFieldInstCtx - fc.tupleType = tupleTypeA - fc.tupleIndex = i - fc.c = c - fc.replaceByFieldName = m == mFieldPairs + var fc = TFieldInstCtx( + tupleType: tupleTypeA, + tupleIndex: i, + c: c, + replaceByFieldName: m == mFieldPairs + ) var body = instFieldLoopBody(fc, loopBody, n) inc c.inUnrolledContext stmts.add(semStmt(c, body, {})) dec c.inUnrolledContext closeScope(c) else: - var fc: TFieldsCtx - fc.m = m - fc.c = c + var fc = TFieldsCtx(m: m, c: c) var t = tupleTypeA while t.kind == tyObject: semForObjectFields(fc, t.n, n, stmts) - if t[0] == nil: break - t = skipTypes(t[0], skipPtrs) + if t.baseClass == nil: break + t = skipTypes(t.baseClass, skipPtrs) + c.p.breakInLoop = oldBreakInLoop dec(c.p.nestedLoopCounter) # for TR macros this 'while true: ...; break' loop is pretty bad, so # we avoid it now if we can: diff --git a/compiler/semfold.nim b/compiler/semfold.nim index a3b9a8dde..80144ccc0 100644 --- a/compiler/semfold.nim +++ b/compiler/semfold.nim @@ -11,21 +11,25 @@ # and evaluation phase import - strutils, options, ast, trees, nimsets, - platform, math, msgs, idents, renderer, types, - commands, magicsys, modulegraphs, strtabs, lineinfos + options, ast, trees, nimsets, + platform, msgs, idents, renderer, types, + commands, magicsys, modulegraphs, lineinfos, wordrecg +import std/[strutils, math, strtabs] from system/memory import nimCStrLen +when defined(nimPreviewSlimSystem): + import std/[assertions, formatfloat] + proc errorType*(g: ModuleGraph): PType = ## creates a type representing an error state - result = newType(tyError, nextTypeId(g.idgen), g.owners[^1]) + result = newType(tyError, g.idgen, g.owners[^1]) result.flags.incl tfCheckedForDestructor proc getIntLitTypeG(g: ModuleGraph; literal: PNode; idgen: IdGenerator): PType = # we cache some common integer literal types for performance: let ti = getSysType(g, literal.info, tyInt) - result = copyType(ti, nextTypeId(idgen), ti.owner) + result = copyType(ti, idgen, ti.owner) result.n = literal proc newIntNodeT*(intVal: Int128, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = @@ -62,24 +66,34 @@ proc foldAdd(a, b: Int128, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode let res = a + b if checkInRange(g.config, n, res): result = newIntNodeT(res, n, idgen, g) + else: + result = nil proc foldSub(a, b: Int128, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = let res = a - b if checkInRange(g.config, n, res): result = newIntNodeT(res, n, idgen, g) + else: + result = nil proc foldUnarySub(a: Int128, n: PNode; idgen: IdGenerator, g: ModuleGraph): PNode = if a != firstOrd(g.config, n.typ): result = newIntNodeT(-a, n, idgen, g) + else: + result = nil proc foldAbs(a: Int128, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = if a != firstOrd(g.config, n.typ): result = newIntNodeT(abs(a), n, idgen, g) + else: + result = nil proc foldMul(a, b: Int128, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = let res = a * b if checkInRange(g.config, n, res): return newIntNodeT(res, n, idgen, g) + else: + result = nil proc ordinalValToString*(a: PNode; g: ModuleGraph): string = # because $ has the param ordinal[T], `a` is not necessarily an enum, but an @@ -91,6 +105,7 @@ proc ordinalValToString*(a: PNode; g: ModuleGraph): string = of tyChar: result = $chr(toInt64(x) and 0xff) of tyEnum: + result = "" var n = t.n for i in 0..<n.len: if n[i].kind != nkSym: internalError(g.config, a.info, "ordinalValToString") @@ -107,10 +122,10 @@ proc ordinalValToString*(a: PNode; g: ModuleGraph): string = result = $x proc isFloatRange(t: PType): bool {.inline.} = - result = t.kind == tyRange and t[0].kind in {tyFloat..tyFloat128} + result = t.kind == tyRange and t.elementType.kind in {tyFloat..tyFloat128} proc isIntRange(t: PType): bool {.inline.} = - result = t.kind == tyRange and t[0].kind in { + result = t.kind == tyRange and t.elementType.kind in { tyInt..tyInt64, tyUInt8..tyUInt32} proc pickIntRange(a, b: PType): PType = @@ -133,7 +148,7 @@ proc evalOp(m: TMagic, n, a, b, c: PNode; idgen: IdGenerator; g: ModuleGraph): P of mCard: result = newIntNodeT(toInt128(nimsets.cardSet(g.config, a)), n, idgen, g) of mBitnotI: if n.typ.isUnsigned: - result = newIntNodeT(bitnot(getInt(a)).maskBytes(int(n.typ.size)), n, idgen, g) + result = newIntNodeT(bitnot(getInt(a)).maskBytes(int(getSize(g.config, n.typ))), n, idgen, g) else: result = newIntNodeT(bitnot(getInt(a)), n, idgen, g) of mLengthArray: result = newIntNodeT(lengthOrd(g.config, a.typ), n, idgen, g) @@ -143,8 +158,8 @@ proc evalOp(m: TMagic, n, a, b, c: PNode; idgen: IdGenerator; g: ModuleGraph): P elif a.kind in {nkStrLit..nkTripleStrLit}: if a.typ.kind == tyString: result = newIntNodeT(toInt128(a.strVal.len), n, idgen, g) - elif a.typ.kind == tyCString: - result = newIntNodeT(toInt128(nimCStrLen(a.strVal)), n, idgen, g) + elif a.typ.kind == tyCstring: + result = newIntNodeT(toInt128(nimCStrLen(a.strVal.cstring)), n, idgen, g) else: result = newIntNodeT(toInt128(a.len), n, idgen, g) of mUnaryPlusI, mUnaryPlusF64: result = a # throw `+` away @@ -227,7 +242,13 @@ proc evalOp(m: TMagic, n, a, b, c: PNode; idgen: IdGenerator; g: ModuleGraph): P of mMulF64: result = newFloatNodeT(getFloat(a) * getFloat(b), n, g) of mDivF64: result = newFloatNodeT(getFloat(a) / getFloat(b), n, g) - of mIsNil: result = newIntNodeT(toInt128(ord(a.kind == nkNilLit)), n, idgen, g) + of mIsNil: + let val = a.kind == nkNilLit or + # nil closures have the value (nil, nil) + (a.typ != nil and skipTypes(a.typ, abstractRange).kind == tyProc and + a.kind == nkTupleConstr and a.len == 2 and + a[0].kind == nkNilLit and a[1].kind == nkNilLit) + result = newIntNodeT(toInt128(ord(val)), n, idgen, g) of mLtI, mLtB, mLtEnum, mLtCh: result = newIntNodeT(toInt128(ord(getOrdValue(a) < getOrdValue(b))), n, idgen, g) of mLeI, mLeB, mLeEnum, mLeCh: @@ -248,23 +269,23 @@ proc evalOp(m: TMagic, n, a, b, c: PNode; idgen: IdGenerator; g: ModuleGraph): P of mBitorI, mOr: result = newIntNodeT(bitor(getInt(a), getInt(b)), n, idgen, g) of mBitxorI, mXor: result = newIntNodeT(bitxor(getInt(a), getInt(b)), n, idgen, g) of mAddU: - let val = maskBytes(getInt(a) + getInt(b), int(n.typ.size)) + let val = maskBytes(getInt(a) + getInt(b), int(getSize(g.config, n.typ))) result = newIntNodeT(val, n, idgen, g) of mSubU: - let val = maskBytes(getInt(a) - getInt(b), int(n.typ.size)) + let val = maskBytes(getInt(a) - getInt(b), int(getSize(g.config, n.typ))) result = newIntNodeT(val, n, idgen, g) # echo "subU: ", val, " n: ", n, " result: ", val of mMulU: - let val = maskBytes(getInt(a) * getInt(b), int(n.typ.size)) + let val = maskBytes(getInt(a) * getInt(b), int(getSize(g.config, n.typ))) result = newIntNodeT(val, n, idgen, g) of mModU: - let argA = maskBytes(getInt(a), int(a.typ.size)) - let argB = maskBytes(getInt(b), int(a.typ.size)) + let argA = maskBytes(getInt(a), int(getSize(g.config, a.typ))) + let argB = maskBytes(getInt(b), int(getSize(g.config, a.typ))) if argB != Zero: result = newIntNodeT(argA mod argB, n, idgen, g) of mDivU: - let argA = maskBytes(getInt(a), int(a.typ.size)) - let argB = maskBytes(getInt(b), int(a.typ.size)) + let argA = maskBytes(getInt(a), int(getSize(g.config, a.typ))) + let argB = maskBytes(getInt(b), int(getSize(g.config, a.typ))) if argB != Zero: result = newIntNodeT(argA div argB, n, idgen, g) of mLeSet: result = newIntNodeT(toInt128(ord(containsSets(g.config, a, b))), n, idgen, g) @@ -286,19 +307,11 @@ proc evalOp(m: TMagic, n, a, b, c: PNode; idgen: IdGenerator; g: ModuleGraph): P of mRepr: # BUGFIX: we cannot eval mRepr here for reasons that I forgot. discard - of mIntToStr, mInt64ToStr: result = newStrNodeT($(getOrdValue(a)), n, g) of mBoolToStr: if getOrdValue(a) == 0: result = newStrNodeT("false", n, g) else: result = newStrNodeT("true", n, g) - of mFloatToStr: result = newStrNodeT($getFloat(a), n, g) of mCStrToStr, mCharToStr: - if a.kind == nkBracket: - var s = "" - for b in a.sons: - s.add b.getStrOrChar - result = newStrNodeT(s, n, g) - else: - result = newStrNodeT(getStrOrChar(a), n, g) + result = newStrNodeT(getStrOrChar(a), n, g) of mStrToStr: result = newStrNodeT(getStrOrChar(a), n, g) of mEnumToStr: result = newStrNodeT(ordinalValToString(a, g), n, g) of mArrToSeq: @@ -349,7 +362,7 @@ proc magicCall(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = var s = n[0].sym var a = getConstExpr(m, n[1], idgen, g) - var b, c: PNode + var b, c: PNode = nil if a == nil: return if n.len > 2: b = getConstExpr(m, n[2], idgen, g) @@ -374,6 +387,11 @@ proc rangeCheck(n: PNode, value: Int128; g: ModuleGraph) = localError(g.config, n.info, "cannot convert " & $value & " to " & typeToString(n.typ)) +proc floatRangeCheck(n: PNode, value: BiggestFloat; g: ModuleGraph) = + if value < firstFloat(n.typ) or value > lastFloat(n.typ): + localError(g.config, n.info, "cannot convert " & $value & + " to " & typeToString(n.typ)) + proc foldConv(n, a: PNode; idgen: IdGenerator; g: ModuleGraph; check = false): PNode = let dstTyp = skipTypes(n.typ, abstractRange - {tyTypeDesc}) let srcTyp = skipTypes(a.typ, abstractRange - {tyTypeDesc}) @@ -394,31 +412,35 @@ proc foldConv(n, a: PNode; idgen: IdGenerator; g: ModuleGraph; check = false): P of tyBool, tyEnum: # xxx shouldn't we disallow `tyEnum`? result = a result.typ = n.typ - else: doAssert false, $srcTyp.kind + else: + raiseAssert $srcTyp.kind of tyInt..tyInt64, tyUInt..tyUInt64: case srcTyp.kind of tyFloat..tyFloat64: result = newIntNodeT(toInt128(getFloat(a)), n, idgen, g) of tyChar, tyUInt..tyUInt64, tyInt..tyInt64: var val = a.getOrdValue - if check: rangeCheck(n, val, g) - result = newIntNodeT(val, n, idgen, g) if dstTyp.kind in {tyUInt..tyUInt64}: + result = newIntNodeT(maskBytes(val, int getSize(g.config, dstTyp)), n, idgen, g) result.transitionIntKind(nkUIntLit) + else: + if check: rangeCheck(n, val, g) + result = newIntNodeT(val, n, idgen, g) else: result = a result.typ = n.typ - if check and result.kind in {nkCharLit..nkUInt64Lit}: + if check and result.kind in {nkCharLit..nkUInt64Lit} and + dstTyp.kind notin {tyUInt..tyUInt64}: rangeCheck(n, getInt(result), g) of tyFloat..tyFloat64: case srcTyp.kind - of tyInt..tyInt64, tyEnum, tyBool, tyChar: + of tyInt..tyInt64, tyUInt..tyUInt64, tyEnum, tyBool, tyChar: result = newFloatNodeT(toFloat64(getOrdValue(a)), n, g) else: result = a result.typ = n.typ of tyOpenArray, tyVarargs, tyProc, tyPointer: - discard + result = nil else: result = a result.typ = n.typ @@ -445,21 +467,26 @@ proc foldArrayAccess(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNo result = x.sons[idx] if result.kind == nkExprColonExpr: result = result[1] else: + result = nil localError(g.config, n.info, formatErrorIndexBound(idx, x.len-1) & $n) 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) + else: + result = nil + localError(g.config, n.info, formatErrorIndexBound(idx, x.len-1) & $n) of nkStrLit..nkTripleStrLit: result = newNodeIT(nkCharLit, x.info, n.typ) if idx >= 0 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 + else: result = nil proc foldFieldAccess(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = # a real field access; proc calls have already been transformed + result = nil + if n[1].kind != nkSym: return nil var x = getConstExpr(m, n[0], idgen, g) if x == nil or x.kind notin {nkObjConstr, nkPar, nkTupleConstr}: return @@ -487,11 +514,89 @@ proc foldConStrStr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode proc newSymNodeTypeDesc*(s: PSym; idgen: IdGenerator; info: TLineInfo): PNode = result = newSymNode(s, info) if s.typ.kind != tyTypeDesc: - result.typ = newType(tyTypeDesc, idgen.nextTypeId, s.owner) + result.typ = newType(tyTypeDesc, idgen, s.owner) result.typ.addSonSkipIntLit(s.typ, idgen) else: result.typ = s.typ +proc foldDefine(m, s: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = + result = nil + var name = s.name.s + let prag = extractPragma(s) + if prag != nil: + for it in prag: + if it.kind in nkPragmaCallKinds and it.len == 2 and it[0].kind == nkIdent: + let word = whichKeyword(it[0].ident) + if word in {wStrDefine, wIntDefine, wBoolDefine, wDefine}: + # should be processed in pragmas.nim already + if it[1].kind in {nkStrLit, nkRStrLit, nkTripleStrLit}: + name = it[1].strVal + if isDefined(g.config, name): + let str = g.config.symbols[name] + case s.magic + of mIntDefine: + try: + result = newIntNodeT(toInt128(str.parseInt), n, idgen, g) + except ValueError: + localError(g.config, s.info, + "{.intdefine.} const was set to an invalid integer: '" & + str & "'") + of mStrDefine: + result = newStrNodeT(str, n, g) + of mBoolDefine: + try: + result = newIntNodeT(toInt128(str.parseBool.int), n, idgen, g) + except ValueError: + localError(g.config, s.info, + "{.booldefine.} const was set to an invalid bool: '" & + str & "'") + of mGenericDefine: + let rawTyp = s.typ + # pretend we don't support distinct types + let typ = rawTyp.skipTypes(abstractVarRange-{tyDistinct}) + try: + template intNode(value): PNode = + let val = toInt128(value) + rangeCheck(n, val, g) + newIntNodeT(val, n, idgen, g) + case typ.kind + of tyString, tyCstring: + result = newStrNodeT(str, n, g) + of tyInt..tyInt64: + result = intNode(str.parseBiggestInt) + of tyUInt..tyUInt64: + result = intNode(str.parseBiggestUInt) + of tyBool: + result = intNode(str.parseBool.int) + of tyEnum: + # compile time parseEnum + let ident = getIdent(g.cache, str) + for e in typ.n: + if e.kind != nkSym: internalError(g.config, "foldDefine for enum") + let es = e.sym + let match = + if es.ast.isNil: + es.name.id == ident.id + else: + es.ast.strVal == str + if match: + result = intNode(es.position) + break + if result.isNil: + raise newException(ValueError, "invalid enum value: " & str) + else: + localError(g.config, s.info, "unsupported type $1 for define '$2'" % + [name, typeToString(rawTyp)]) + except ValueError as e: + localError(g.config, s.info, + "could not process define '$1' of type $2; $3" % + [name, typeToString(rawTyp), e.msg]) + else: result = copyTree(s.astdef) # unreachable + else: + result = copyTree(s.astdef) + if result != nil: + result.info = n.info + proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = result = nil case n.kind @@ -511,33 +616,12 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode of mBuildOS: result = newStrNodeT(toLowerAscii(platform.OS[g.config.target.hostOS].name), n, g) of mBuildCPU: result = newStrNodeT(platform.CPU[g.config.target.hostCPU].name.toLowerAscii, n, g) of mAppType: result = getAppType(n, g) - of mIntDefine: - if isDefined(g.config, s.name.s): - 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] & "'") - else: - result = copyTree(s.ast) - of mStrDefine: - if isDefined(g.config, s.name.s): - result = newStrNodeT(g.config.symbols[s.name.s], n, g) - else: - result = copyTree(s.ast) - of mBoolDefine: - if isDefined(g.config, s.name.s): - 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] & "'") - else: - result = copyTree(s.ast) + of mIntDefine, mStrDefine, mBoolDefine, mGenericDefine: + result = foldDefine(m, s, n, idgen, g) else: - result = copyTree(s.ast) + result = copyTree(s.astdef) + if result != nil: + result.info = n.info of skProc, skFunc, skMethod: result = n of skParam: @@ -578,7 +662,7 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode result = newIntNodeT(firstOrd(g.config, n[1].typ), n, idgen, g) of mHigh: if skipTypes(n[1].typ, abstractVar+{tyUserTypeClassInst}).kind notin - {tySequence, tyString, tyCString, tyOpenArray, tyVarargs}: + {tySequence, tyString, tyCstring, tyOpenArray, tyVarargs}: if skipTypes(n[1].typ, abstractVarRange).kind in tyFloat..tyFloat64: result = newFloatNodeT(lastFloat(n[1].typ), n, g) else: @@ -620,13 +704,10 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode except DivByZeroDefect: localError(g.config, n.info, "division by zero") of nkAddr: - var a = getConstExpr(m, n[0], idgen, g) - if a != nil: - result = n - n[0] = a + result = nil # don't fold paths containing nkAddr of nkBracket, nkCurly: result = copyNode(n) - for i, son in n.pairs: + for son in n.items: var a = getConstExpr(m, son, idgen, g) if a == nil: return nil result.add a @@ -650,7 +731,7 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode # tuple constructor result = copyNode(n) if (n.len > 0) and (n[0].kind == nkExprColonExpr): - for i, expr in n.pairs: + for expr in n.items: let exprNew = copyNode(expr) # nkExprColonExpr exprNew.add expr[0] let a = getConstExpr(m, expr[1], idgen, g) @@ -658,7 +739,7 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode exprNew.add a result.add exprNew else: - for i, expr in n.pairs: + for expr in n.items: let a = getConstExpr(m, expr, idgen, g) if a == nil: return nil result.add a @@ -669,6 +750,8 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode if leValueConv(n[1], a) and leValueConv(a, n[2]): result = a # a <= x and x <= b result.typ = n.typ + elif n.typ.kind in {tyUInt..tyUInt64}: + discard "don't check uints" else: localError(g.config, n.info, "conversion from $1 to $2 is invalid" % @@ -685,11 +768,13 @@ proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode of nkDerefExpr, nkHiddenDeref: let a = getConstExpr(m, n[0], idgen, g) if a != nil and a.kind == nkNilLit: - localError(g.config, n.info, "nil dereference is not allowed") + result = nil + #localError(g.config, n.info, "nil dereference is not allowed") of nkCast: var a = getConstExpr(m, n[1], idgen, g) if a == nil: return - if n.typ != nil and n.typ.kind in NilableTypes: + if n.typ != nil and n.typ.kind in NilableTypes and + not (n.typ.kind == tyProc and a.typ.kind == tyProc): # we allow compile-time 'cast' for pointer types: result = a result.typ = n.typ diff --git a/compiler/semgnrc.nim b/compiler/semgnrc.nim index dfbb022c8..2639aba6c 100644 --- a/compiler/semgnrc.nim +++ b/compiler/semgnrc.nim @@ -50,52 +50,83 @@ proc semGenericStmtScope(c: PContext, n: PNode, result = semGenericStmt(c, n, flags, ctx) closeScope(c) -template macroToExpand(s): untyped = - s.kind in {skMacro, skTemplate} and (s.typ.len == 1 or sfAllUntyped in s.flags) - -template macroToExpandSym(s): untyped = - sfCustomPragma notin s.flags and s.kind in {skMacro, skTemplate} and - (s.typ.len == 1) and not fromDotExpr - template isMixedIn(sym): bool = let s = sym s.name.id in ctx.toMixin or (withinConcept in flags and s.magic == mNone and s.kind in OverloadableSyms) +template canOpenSym(s): bool = + {withinMixin, withinConcept} * flags == {withinMixin} and s.id notin ctx.toBind + proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, ctx: var GenericCtx; flags: TSemGenericFlags, + isAmbiguous: bool, fromDotExpr=false): PNode = + result = nil semIdeForTemplateOrGenericCheck(c.config, n, ctx.cursorInBody) incl(s.flags, sfUsed) + template maybeDotChoice(c: PContext, n: PNode, s: PSym, fromDotExpr: bool) = + if fromDotExpr: + result = symChoice(c, n, s, scForceOpen) + if result.kind == nkOpenSymChoice and result.len == 1: + result.transitionSonsKind(nkClosedSymChoice) + else: + result = symChoice(c, n, s, scOpen) + if canOpenSym(s): + if openSym in c.features: + if result.kind == nkSym: + result = newOpenSym(result) + else: + result.typ = nil + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil case s.kind of skUnknown: # Introduced in this pass! Leave it as an identifier. result = n - of skProc, skFunc, skMethod, skIterator, skConverter, skModule: - result = symChoice(c, n, s, scOpen) - of skTemplate: - if macroToExpandSym(s): - onUse(n.info, s) - result = semTemplateExpr(c, n, s, {efNoSemCheck}) - result = semGenericStmt(c, result, {}, ctx) - else: - result = symChoice(c, n, s, scOpen) - of skMacro: - if macroToExpandSym(s): + of skProc, skFunc, skMethod, skIterator, skConverter, skModule, skEnumField: + maybeDotChoice(c, n, s, fromDotExpr) + of skTemplate, skMacro: + # alias syntax, see semSym for skTemplate, skMacro + if sfNoalias notin s.flags and not fromDotExpr: onUse(n.info, s) - result = semMacroExpr(c, n, n, s, {efNoSemCheck}) + case s.kind + of skTemplate: result = semTemplateExpr(c, n, s, {efNoSemCheck}) + of skMacro: result = semMacroExpr(c, n, n, s, {efNoSemCheck}) + else: discard # unreachable + c.friendModules.add(s.owner.getModule) result = semGenericStmt(c, result, {}, ctx) + discard c.friendModules.pop() else: - result = symChoice(c, n, s, scOpen) + maybeDotChoice(c, n, s, fromDotExpr) of skGenericParam: if s.typ != nil and s.typ.kind == tyStatic: if s.typ.n != nil: result = s.typ.n + elif c.inGenericContext > 0 and withinConcept notin flags: + # don't leave generic param as identifier node in generic type, + # sigmatch will try to instantiate generic type AST without all params + # fine to give a symbol node a generic type here since + # we are in a generic context and `prepareNode` will be called + result = newSymNodeTypeDesc(s, c.idgen, n.info) + if canOpenSym(result.sym): + if openSym in c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil else: result = n else: result = newSymNodeTypeDesc(s, c.idgen, n.info) + if canOpenSym(result.sym): + if openSym in c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil onUse(n.info, s) of skParam: result = n @@ -103,12 +134,41 @@ proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, of skType: if (s.typ != nil) and (s.typ.flags * {tfGenericTypeParam, tfImplicitTypeParam} == {}): + if isAmbiguous: + # ambiguous types should be symchoices since lookup behaves + # differently for them in regular expressions + maybeDotChoice(c, n, s, fromDotExpr) + return + result = newSymNodeTypeDesc(s, c.idgen, n.info) + if canOpenSym(result.sym): + if openSym in c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil + elif c.inGenericContext > 0 and withinConcept notin flags: + # don't leave generic param as identifier node in generic type, + # sigmatch will try to instantiate generic type AST without all params + # fine to give a symbol node a generic type here since + # we are in a generic context and `prepareNode` will be called result = newSymNodeTypeDesc(s, c.idgen, n.info) + if canOpenSym(result.sym): + if openSym in c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil else: result = n onUse(n.info, s) else: result = newSymNode(s, n.info) + if canOpenSym(result.sym): + if openSym in c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil onUse(n.info, s) proc lookup(c: PContext, n: PNode, flags: TSemGenericFlags, @@ -116,7 +176,7 @@ proc lookup(c: PContext, n: PNode, flags: TSemGenericFlags, result = n let ident = considerQuotedIdent(c, n) var amb = false - var s = searchInScopes(c, ident, amb).skipAlias(n, c.config) + var s = searchInScopes(c, ident, amb) if s == nil: s = strTableGet(c.pureEnumFields, ident) #if s != nil and contains(c.ambiguousSymbols, s.id): @@ -130,7 +190,7 @@ proc lookup(c: PContext, n: PNode, flags: TSemGenericFlags, elif s.isMixedIn: result = symChoice(c, n, s, scForceOpen) else: - result = semGenericStmtSymbol(c, n, s, ctx, flags) + result = semGenericStmtSymbol(c, n, s, ctx, flags, amb) # else: leave as nkIdent proc newDot(n, b: PNode): PNode = @@ -139,43 +199,66 @@ proc newDot(n, b: PNode): PNode = result.add(b) proc fuzzyLookup(c: PContext, n: PNode, flags: TSemGenericFlags, - ctx: var GenericCtx; isMacro: var bool): PNode = + ctx: var GenericCtx; isMacro: var bool; + inCall = false): PNode = assert n.kind == nkDotExpr semIdeForTemplateOrGenericCheck(c.config, n, ctx.cursorInBody) let luf = if withinMixin notin flags: {checkUndeclared, checkModule} else: {checkModule} + c.isAmbiguous = false var s = qualifiedLookUp(c, n, luf) if s != nil: - result = semGenericStmtSymbol(c, n, s, ctx, flags) + isMacro = s.kind in {skTemplate, skMacro} + result = semGenericStmtSymbol(c, n, s, ctx, flags, c.isAmbiguous) else: n[0] = semGenericStmt(c, n[0], flags, ctx) result = n let n = n[1] let ident = considerQuotedIdent(c, n) - var candidates = searchInScopesFilterBy(c, ident, routineKinds) # .skipAlias(n, c.config) + # could be type conversion if like a.T and not a.T() + let symKinds = if inCall: routineKinds else: routineKinds+{skType} + var candidates = searchInScopesFilterBy(c, ident, symKinds) if candidates.len > 0: let s = candidates[0] # XXX take into account the other candidates! isMacro = s.kind in {skTemplate, skMacro} if withinBind in flags or s.id in ctx.toBind: - result = newDot(result, symChoice(c, n, s, scClosed)) + if s.kind == skType: # don't put types in sym choice + var ambig = false + if candidates.len > 1: + let s2 = searchInScopes(c, ident, ambig) + result = newDot(result, semGenericStmtSymbol(c, n, s, ctx, flags, + isAmbiguous = ambig, fromDotExpr = true)) + else: + result = newDot(result, symChoice(c, n, s, scClosed)) elif s.isMixedIn: result = newDot(result, symChoice(c, n, s, scForceOpen)) else: - let syms = semGenericStmtSymbol(c, n, s, ctx, flags, fromDotExpr=true) - if syms.kind == nkSym: - let choice = symChoice(c, n, s, scForceOpen) - choice.transitionSonsKind(nkClosedSymChoice) - result = newDot(result, choice) - else: - result = newDot(result, syms) + var ambig = false + if s.kind == skType and candidates.len > 1: + discard searchInScopes(c, ident, ambig) + let syms = semGenericStmtSymbol(c, n, s, ctx, flags, + isAmbiguous = ambig, fromDotExpr = true) + result = newDot(result, syms) proc addTempDecl(c: PContext; n: PNode; kind: TSymKind) = let s = newSymS(skUnknown, getIdentNode(c, n), c) addPrelimDecl(c, s) - styleCheckDef(c.config, n.info, s, kind) + styleCheckDef(c, n.info, s, kind) onDef(n.info, s) +proc addTempDeclToIdents(c: PContext; n: PNode; kind: TSymKind; inCall: bool) = + case n.kind + of nkIdent: + if inCall: + addTempDecl(c, n, kind) + of nkCallKinds: + for s in n: + addTempDeclToIdents(c, s, kind, true) + else: + for s in n: + addTempDeclToIdents(c, s, kind, inCall) + proc semGenericStmt(c: PContext, n: PNode, flags: TSemGenericFlags, ctx: var GenericCtx): PNode = result = n @@ -189,12 +272,15 @@ proc semGenericStmt(c: PContext, n: PNode, case n.kind of nkIdent, nkAccQuoted: result = lookup(c, n, flags, ctx) + if result != nil and result.kind == nkSym: + assert result.sym != nil + markUsed(c, n.info, result.sym) of nkDotExpr: #let luf = if withinMixin notin flags: {checkUndeclared} else: {} #var s = qualifiedLookUp(c, n, luf) #if s != nil: result = semGenericStmtSymbol(c, n, s) # XXX for example: ``result.add`` -- ``add`` needs to be looked up here... - var dummy: bool + var dummy: bool = false result = fuzzyLookup(c, n, flags, ctx, dummy) of nkSym: let a = n.sym @@ -219,7 +305,9 @@ proc semGenericStmt(c: PContext, n: PNode, # check if it is an expression macro: checkMinSonsLen(n, 1, c.config) let fn = n[0] + c.isAmbiguous = false var s = qualifiedLookUp(c, fn, {}) + let ambig = c.isAmbiguous if s == nil and {withinMixin, withinConcept}*flags == {} and fn.kind in {nkIdent, nkAccQuoted} and @@ -236,20 +324,17 @@ proc semGenericStmt(c: PContext, n: PNode, else: scOpen let sc = symChoice(c, fn, s, whichChoice) case s.kind - of skMacro: - if macroToExpand(s) and sc.safeLen <= 1: + of skMacro, skTemplate: + # unambiguous macros/templates are expanded if all params are untyped + if sfAllUntyped in s.flags and sc.safeLen <= 1: onUse(fn.info, s) - result = semMacroExpr(c, n, n, s, {efNoSemCheck}) - result = semGenericStmt(c, result, flags, ctx) - else: - n[0] = sc - result = n - mixinContext = true - of skTemplate: - if macroToExpand(s) and sc.safeLen <= 1: - onUse(fn.info, s) - result = semTemplateExpr(c, n, s, {efNoSemCheck}) + case s.kind + of skMacro: result = semMacroExpr(c, n, n, s, {efNoSemCheck}) + of skTemplate: result = semTemplateExpr(c, n, s, {efNoSemCheck}) + else: discard # unreachable + c.friendModules.add(s.owner.getModule) result = semGenericStmt(c, result, flags, ctx) + discard c.friendModules.pop() else: n[0] = sc result = n @@ -275,7 +360,12 @@ proc semGenericStmt(c: PContext, n: PNode, of skType: # bad hack for generics: if (s.typ != nil) and (s.typ.kind != tyGenericParam): - result[0] = newSymNodeTypeDesc(s, c.idgen, fn.info) + if ambig: + # ambiguous types should be symchoices since lookup behaves + # differently for them in regular expressions + result[0] = sc + else: + result[0] = newSymNodeTypeDesc(s, c.idgen, fn.info) onUse(fn.info, s) first = 1 else: @@ -283,7 +373,7 @@ proc semGenericStmt(c: PContext, n: PNode, onUse(fn.info, s) first = 1 elif fn.kind == nkDotExpr: - result[0] = fuzzyLookup(c, fn, flags, ctx, mixinContext) + result[0] = fuzzyLookup(c, fn, flags, ctx, mixinContext, inCall = true) first = 1 # Consider 'when declared(globalsSlot): ThreadVarSetValue(globalsSlot, ...)' # in threads.nim: the subtle preprocessing here binds 'globalsSlot' which @@ -300,9 +390,8 @@ proc semGenericStmt(c: PContext, n: PNode, result = newNodeI(nkCall, n.info) result.add newIdentNode(getIdent(c.cache, "[]"), n.info) for i in 0..<n.len: result.add(n[i]) - withBracketExpr ctx, n[0]: - result = semGenericStmt(c, result, flags, ctx) - of nkAsgn, nkFastAsgn: + result = semGenericStmt(c, result, flags, ctx) + of nkAsgn, nkFastAsgn, nkSinkAsgn: checkSonsLen(n, 2, c.config) let a = n[0] let b = n[1] @@ -320,8 +409,7 @@ proc semGenericStmt(c: PContext, n: PNode, result.add newIdentNode(getIdent(c.cache, "[]="), n.info) for i in 0..<a.len: result.add(a[i]) result.add(b) - withBracketExpr ctx, a[0]: - result = semGenericStmt(c, result, flags, ctx) + result = semGenericStmt(c, result, flags, ctx) else: for i in 0..<n.len: result[i] = semGenericStmt(c, n[i], flags, ctx) @@ -350,7 +438,9 @@ proc semGenericStmt(c: PContext, n: PNode, var a = n[i] checkMinSonsLen(a, 1, c.config) for j in 0..<a.len-1: - a[j] = semGenericStmt(c, a[j], flags, ctx) + a[j] = semGenericStmt(c, a[j], flags+{withinMixin}, ctx) + addTempDeclToIdents(c, a[j], skVar, false) + a[^1] = semGenericStmtScope(c, a[^1], flags, ctx) closeScope(c) of nkForStmt, nkParForStmt: @@ -390,16 +480,24 @@ proc semGenericStmt(c: PContext, n: PNode, a[^1] = semGenericStmtScope(c, a[^1], flags, ctx) closeScope(c) - of nkVarSection, nkLetSection: + of nkVarSection, nkLetSection, nkConstSection: + let varKind = + case n.kind + of nkVarSection: skVar + of nkLetSection: skLet + else: skConst for i in 0..<n.len: var a = n[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkIdentDefs) and (a.kind != nkVarTuple): illFormedAst(a, c.config) - checkMinSonsLen(a, 3, c.config) - a[^2] = semGenericStmt(c, a[^2], flags+{withinTypeDesc}, ctx) - a[^1] = semGenericStmt(c, a[^1], flags, ctx) - for j in 0..<a.len-2: - addTempDecl(c, getIdentNode(c, a[j]), skVar) + case a.kind: + of nkCommentStmt: continue + of nkIdentDefs, nkVarTuple, nkConstDef: + checkMinSonsLen(a, 3, c.config) + a[^2] = semGenericStmt(c, a[^2], flags+{withinTypeDesc}, ctx) + a[^1] = semGenericStmt(c, a[^1], flags, ctx) + for j in 0..<a.len-2: + addTempDecl(c, getIdentNode(c, a[j]), varKind) + else: + illFormedAst(a, c.config) of nkGenericParams: for i in 0..<n.len: var a = n[i] @@ -409,15 +507,6 @@ proc semGenericStmt(c: PContext, n: PNode, # do not perform symbol lookup for default expressions for j in 0..<a.len-2: addTempDecl(c, getIdentNode(c, a[j]), skType) - of nkConstSection: - for i in 0..<n.len: - var a = n[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkConstDef): illFormedAst(a, c.config) - checkSonsLen(a, 3, c.config) - addTempDecl(c, getIdentNode(c, a[0]), skConst) - a[1] = semGenericStmt(c, a[1], flags+{withinTypeDesc}, ctx) - a[2] = semGenericStmt(c, a[2], flags, ctx) of nkTypeSection: for i in 0..<n.len: var a = n[i] @@ -442,18 +531,55 @@ proc semGenericStmt(c: PContext, n: PNode, if n[0].kind != nkEmpty: n[0] = semGenericStmt(c, n[0], flags+{withinTypeDesc}, ctx) for i in 1..<n.len: - var a: PNode + var a: PNode = nil case n[i].kind of nkEnumFieldDef: a = n[i][0] of nkIdent: a = n[i] else: illFormedAst(n, c.config) addDecl(c, newSymS(skUnknown, getIdentNode(c, a), c)) - of nkObjectTy, nkTupleTy, nkTupleClassTy: - discard + of nkTupleTy: + for i in 0..<n.len: + var a = n[i] + case a.kind: + of nkCommentStmt, nkNilLit, nkSym, nkEmpty: continue + of nkIdentDefs: + checkMinSonsLen(a, 3, c.config) + a[^2] = semGenericStmt(c, a[^2], flags+{withinTypeDesc}, ctx) + a[^1] = semGenericStmt(c, a[^1], flags, ctx) + for j in 0..<a.len-2: + addTempDecl(c, getIdentNode(c, a[j]), skField) + else: + illFormedAst(a, c.config) + of nkObjectTy: + if n.len > 0: + openScope(c) + for i in 0..<n.len: + result[i] = semGenericStmt(c, n[i], flags, ctx) + closeScope(c) + of nkRecList: + for i in 0..<n.len: + var a = n[i] + case a.kind: + of nkCommentStmt, nkNilLit, nkSym, nkEmpty: continue + of nkIdentDefs: + checkMinSonsLen(a, 3, c.config) + a[^2] = semGenericStmt(c, a[^2], flags+{withinTypeDesc}, ctx) + a[^1] = semGenericStmt(c, a[^1], flags, ctx) + for j in 0..<a.len-2: + addTempDecl(c, getIdentNode(c, a[j]), skField) + of nkRecCase, nkRecWhen: + n[i] = semGenericStmt(c, a, flags, ctx) + else: + illFormedAst(a, c.config) + of nkRecCase: + checkSonsLen(n[0], 3, c.config) + n[0][^2] = semGenericStmt(c, n[0][^2], flags+{withinTypeDesc}, ctx) + n[0][^1] = semGenericStmt(c, n[0][^1], flags, ctx) + addTempDecl(c, getIdentNode(c, n[0][0]), skField) + for i in 1..<n.len: + n[i] = semGenericStmt(c, n[i], flags, ctx) of nkFormalParams: checkMinSonsLen(n, 1, c.config) - if n[0].kind != nkEmpty: - n[0] = semGenericStmt(c, n[0], flags+{withinTypeDesc}, ctx) for i in 1..<n.len: var a = n[i] if (a.kind != nkIdentDefs): illFormedAst(a, c.config) @@ -462,6 +588,10 @@ proc semGenericStmt(c: PContext, n: PNode, a[^1] = semGenericStmt(c, a[^1], flags, ctx) for j in 0..<a.len-2: addTempDecl(c, getIdentNode(c, a[j]), skParam) + # XXX: last change was moving this down here, search for "1.." to keep + # going from this file onward + if n[0].kind != nkEmpty: + n[0] = semGenericStmt(c, n[0], flags+{withinTypeDesc}, ctx) of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, nkTemplateDef, nkFuncDef, nkIteratorDef, nkLambdaKinds: checkSonsLen(n, bodyPos + 1, c.config) @@ -472,7 +602,7 @@ proc semGenericStmt(c: PContext, n: PNode, flags, ctx) if n[paramsPos].kind != nkEmpty: if n[paramsPos][0].kind != nkEmpty: - addPrelimDecl(c, newSym(skUnknown, getIdent(c.cache, "result"), nextSymId c.idgen, nil, n.info)) + addPrelimDecl(c, newSym(skUnknown, getIdent(c.cache, "result"), c.idgen, nil, n.info)) n[paramsPos] = semGenericStmt(c, n[paramsPos], flags, ctx) n[pragmasPos] = semGenericStmt(c, n[pragmasPos], flags, ctx) var body: PNode @@ -483,12 +613,27 @@ proc semGenericStmt(c: PContext, n: PNode, else: body = getBody(c.graph, s) else: body = n[bodyPos] - n[bodyPos] = semGenericStmtScope(c, body, flags, ctx) + let bodyFlags = if n.kind == nkTemplateDef: flags + {withinMixin} else: flags + n[bodyPos] = semGenericStmtScope(c, body, bodyFlags, ctx) closeScope(c) of nkPragma, nkPragmaExpr: discard of nkExprColonExpr, nkExprEqExpr: checkMinSonsLen(n, 2, c.config) result[1] = semGenericStmt(c, n[1], flags, ctx) + of nkObjConstr: + for i in 0..<n.len: + result[i] = semGenericStmt(c, n[i], flags, ctx) + if result[0].kind == nkSym: + let fmoduleId = getModule(result[0].sym).id + var isVisable = false + for module in c.friendModules: + if module.id == fmoduleId: + isVisable = true + break + if isVisable: + for i in 1..<result.len: + if result[i].kind == nkExprColonExpr: + result[i][1].flags.incl nfSkipFieldChecking else: for i in 0..<n.len: result[i] = semGenericStmt(c, n[i], flags, ctx) @@ -497,16 +642,18 @@ proc semGenericStmt(c: PContext, n: PNode, if withinTypeDesc in flags: dec c.inTypeContext proc semGenericStmt(c: PContext, n: PNode): PNode = - var ctx: GenericCtx - ctx.toMixin = initIntSet() - ctx.toBind = initIntSet() + var ctx = GenericCtx( + toMixin: initIntSet(), + toBind: initIntSet() + ) result = semGenericStmt(c, n, {}, ctx) semIdeForTemplateOrGeneric(c, result, ctx.cursorInBody) proc semConceptBody(c: PContext, n: PNode): PNode = - var ctx: GenericCtx - ctx.toMixin = initIntSet() - ctx.toBind = initIntSet() + var ctx = GenericCtx( + toMixin: initIntSet(), + toBind: initIntSet() + ) result = semGenericStmt(c, n, {withinConcept}, ctx) semIdeForTemplateOrGeneric(c, result, ctx.cursorInBody) diff --git a/compiler/seminst.nim b/compiler/seminst.nim index 68ab2a310..1bc6d31a2 100644 --- a/compiler/seminst.nim +++ b/compiler/seminst.nim @@ -28,54 +28,41 @@ proc addObjFieldsToLocalScope(c: PContext; n: PNode) = # it is not an error to shadow fields via parameters else: discard -proc rawPushProcCon(c: PContext, owner: PSym) = - var x: PProcCon - new(x) - x.owner = owner - x.next = c.p - c.p = x - -proc rawHandleSelf(c: PContext; owner: PSym) = - const callableSymbols = {skProc, skFunc, skMethod, skConverter, skIterator, skMacro} - if c.selfName != nil and owner.kind in callableSymbols and owner.typ != nil: - let params = owner.typ.n - if params.len > 1: - let arg = params[1].sym - if arg.name.id == c.selfName.id: - c.p.selfSym = arg - arg.flags.incl sfIsSelf - var t = c.p.selfSym.typ.skipTypes(abstractPtrs) - while t.kind == tyObject: - addObjFieldsToLocalScope(c, t.n) - if t[0] == nil: break - t = t[0].skipTypes(skipPtrs) - proc pushProcCon*(c: PContext; owner: PSym) = - rawPushProcCon(c, owner) - rawHandleSelf(c, owner) + c.p = PProcCon(owner: owner, next: c.p) const errCannotInstantiateX = "cannot instantiate: '$1'" -iterator instantiateGenericParamList(c: PContext, n: PNode, pt: TIdTable): PSym = +iterator instantiateGenericParamList(c: PContext, n: PNode, pt: TypeMapping): PSym = internalAssert c.config, n.kind == nkGenericParams - for i, a in n.pairs: + for a in n.items: internalAssert c.config, a.kind == nkSym var q = a.sym if q.typ.kind in {tyTypeDesc, tyGenericParam, tyStatic, tyConcept}+tyTypeClasses: let symKind = if q.typ.kind == tyStatic: skConst else: skType - var s = newSym(symKind, q.name, nextSymId(c.idgen), getCurrOwner(c), q.info) + var s = newSym(symKind, q.name, c.idgen, getCurrOwner(c), q.info) s.flags.incl {sfUsed, sfFromGeneric} - var t = PType(idTableGet(pt, q.typ)) + var t = idTableGet(pt, q.typ) if t == nil: if tfRetType in q.typ.flags: # keep the generic type and allow the return type to be bound # later by semAsgn in return type inference scenario t = q.typ else: - localError(c.config, a.info, errCannotInstantiateX % s.name.s) + if q.typ.kind != tyCompositeTypeClass: + localError(c.config, a.info, errCannotInstantiateX % s.name.s) t = errorType(c) - elif t.kind in {tyGenericParam, tyConcept}: + elif t.kind in {tyGenericParam, tyConcept, tyFromExpr}: + localError(c.config, a.info, errCannotInstantiateX % q.name.s) + t = errorType(c) + elif isUnresolvedStatic(t) and (q.typ.kind == tyStatic or + (q.typ.kind == tyGenericParam and + q.typ.genericParamHasConstraints and + q.typ.genericConstraint.kind == tyStatic)) and + c.inGenericContext == 0 and c.matchedConcept == nil: + # generic/concept type bodies will try to instantiate static values but + # won't actually use them localError(c.config, a.info, errCannotInstantiateX % q.name.s) t = errorType(c) elif t.kind == tyGenericInvocation: @@ -91,11 +78,15 @@ proc sameInstantiation(a, b: TInstantiation): bool = for i in 0..a.concreteTypes.high: if not compareTypes(a.concreteTypes[i], b.concreteTypes[i], flags = {ExactTypeDescValues, - ExactGcSafety}): return + ExactGcSafety, + PickyCAliases}): return result = true + else: + result = false proc genericCacheGet(g: ModuleGraph; genericSym: PSym, entry: TInstantiation; id: CompilesId): PSym = + result = nil for inst in procInstCacheItems(g, genericSym): if (inst.compilesId == 0 or inst.compilesId == id) and sameInstantiation(entry, inst[]): return inst.sym @@ -104,7 +95,7 @@ when false: proc `$`(x: PSym): string = result = x.name.s & " " & " id " & $x.id -proc freshGenSyms(c: PContext; n: PNode, owner, orig: PSym, symMap: var TIdTable) = +proc freshGenSyms(c: PContext; n: PNode, owner, orig: PSym, symMap: var SymMapping) = # we need to create a fresh set of gensym'ed symbols: #if n.kind == nkSym and sfGenSym in n.sym.flags: # if n.sym.owner != orig: @@ -112,12 +103,12 @@ proc freshGenSyms(c: PContext; n: PNode, owner, orig: PSym, symMap: var TIdTable if n.kind == nkSym and sfGenSym in n.sym.flags: # and # (n.sym.owner == orig or n.sym.owner.kind in {skPackage}): let s = n.sym - var x = PSym(idTableGet(symMap, s)) + var x = idTableGet(symMap, s) if x != nil: n.sym = x elif s.owner == nil or s.owner.kind == skPackage: #echo "copied this ", s.name.s - x = copySym(s, nextSymId c.idgen) + x = copySym(s, c.idgen) x.owner = owner idTablePut(symMap, s, x) n.sym = x @@ -136,18 +127,28 @@ proc instantiateBody(c: PContext, n, params: PNode, result, orig: PSym) = inc c.inGenericInst # add it here, so that recursive generic procs are possible: var b = n[bodyPos] - var symMap: TIdTable - initIdTable symMap + var symMap = initSymMapping() if params != nil: for i in 1..<params.len: let param = params[i].sym if sfGenSym in param.flags: idTablePut(symMap, params[i].sym, result.typ.n[param.position+1].sym) freshGenSyms(c, b, result, orig, symMap) - b = semProcBody(c, b) + + if sfBorrow notin orig.flags: + # We do not want to generate a body for generic borrowed procs. + # As body is a sym to the borrowed proc. + let resultType = # todo probably refactor it into a function + if result.kind == skMacro: + sysTypeFromName(c.graph, n.info, "NimNode") + elif not isInlineIterator(result.typ): + result.typ.returnType + else: + nil + b = semProcBody(c, b, resultType) result.ast[bodyPos] = hloBody(c, b) - trackProc(c, result, result.ast[bodyPos]) excl(result.flags, sfForward) + trackProc(c, result, result.ast[bodyPos]) dec c.inGenericInst proc fixupInstantiatedSymbols(c: PContext, s: PSym) = @@ -176,17 +177,12 @@ proc instGenericContainer(c: PContext, info: TLineInfo, header: PType, allowMetaTypes = false): PType = internalAssert c.config, header.kind == tyGenericInvocation - var - cl: TReplTypeVars + var cl: TReplTypeVars = TReplTypeVars(symMap: initSymMapping(), + localCache: initTypeMapping(), typeMap: LayeredIdTable(), + info: info, c: c, allowMetaTypes: allowMetaTypes + ) - initIdTable(cl.symMap) - initIdTable(cl.localCache) - cl.typeMap = LayeredIdTable() - initIdTable(cl.typeMap.topLayer) - - cl.info = info - cl.c = c - cl.allowMetaTypes = allowMetaTypes + cl.typeMap.topLayer = initTypeMapping() # We must add all generic params in scope, because the generic body # may include tyFromExpr nodes depending on these generic params. @@ -194,12 +190,11 @@ proc instGenericContainer(c: PContext, info: TLineInfo, header: PType, # perhaps the code can be extracted in a shared function. openScope(c) let genericTyp = header.base - for i in 0..<genericTyp.len - 1: - let genParam = genericTyp[i] + for i, genParam in genericBodyParams(genericTyp): var param: PSym template paramSym(kind): untyped = - newSym(kind, genParam.sym.name, nextSymId c.idgen, genericTyp.sym, genParam.sym.info) + newSym(kind, genParam.sym.name, c.idgen, genericTyp.sym, genParam.sym.info) if genParam.kind == tyStatic: param = paramSym skConst @@ -225,7 +220,7 @@ proc referencesAnotherParam(n: PNode, p: PSym): bool = if referencesAnotherParam(n[i], p): return true return false -proc instantiateProcType(c: PContext, pt: TIdTable, +proc instantiateProcType(c: PContext, pt: TypeMapping, prc: PSym, info: TLineInfo) = # XXX: Instantiates a generic proc signature, while at the same # time adding the instantiated proc params into the current scope. @@ -247,20 +242,26 @@ proc instantiateProcType(c: PContext, pt: TIdTable, var result = instCopyType(cl, prc.typ) let originalParams = result.n result.n = originalParams.shallowCopy - for i in 1..<result.len: + for i, resulti in paramTypes(result): # twrong_field_caching requires these 'resetIdTable' calls: - if i > 1: + if i > FirstParamAt: resetIdTable(cl.symMap) resetIdTable(cl.localCache) # take a note of the original type. If't a free type or static parameter # we'll need to keep it unbound for the `fitNode` operation below... - var typeToFit = result[i] + var typeToFit = resulti - let needsStaticSkipping = result[i].kind == tyFromExpr - result[i] = replaceTypeVarsT(cl, result[i]) + let needsStaticSkipping = resulti.kind == tyFromExpr + let needsTypeDescSkipping = resulti.kind == tyTypeDesc and tfUnresolved in resulti.flags + if resulti.kind == tyFromExpr: + resulti.flags.incl tfNonConstExpr + result[i] = replaceTypeVarsT(cl, resulti) if needsStaticSkipping: result[i] = result[i].skipTypes({tyStatic}) + if needsTypeDescSkipping: + result[i] = result[i].skipTypes({tyTypeDesc}) + typeToFit = result[i] # ...otherwise, we use the instantiated type in `fitNode` if (typeToFit.kind != tyTypeDesc or typeToFit.base.kind != tyNone) and @@ -269,7 +270,7 @@ proc instantiateProcType(c: PContext, pt: TIdTable, internalAssert c.config, originalParams[i].kind == nkSym let oldParam = originalParams[i].sym - let param = copySym(oldParam, nextSymId c.idgen) + let param = copySym(oldParam, c.idgen) param.owner = prc param.typ = result[i] @@ -278,11 +279,14 @@ proc instantiateProcType(c: PContext, pt: TIdTable, # call head symbol, because this leads to infinite recursion. if oldParam.ast != nil: var def = oldParam.ast.copyTree - if def.kind == nkCall: - for i in 1..<def.len: - def[i] = replaceTypeVarsN(cl, def[i]) - - def = semExprWithType(c, def) + if def.typ.kind == tyFromExpr: + def.typ.flags.incl tfNonConstExpr + if not isIntLit(def.typ): + def = prepareNode(cl, def) + + # allow symchoice since node will be fit later + # although expectedType should cover it + def = semExprWithType(c, def, {efAllowSymChoice}, typeToFit) if def.referencesAnotherParam(getCurrOwner(c)): def.flags.incl nfDefaultRefsParam @@ -295,6 +299,8 @@ proc instantiateProcType(c: PContext, pt: TIdTable, # the user calls an explicit instantiation of the proc (this is # the only way the default value might be inserted). param.ast = errorNode(c, def) + # we know the node is empty, we need the actual type for error message + param.ast.typ = def.typ else: param.ast = fitNodePostMatch(c, typeToFit, converted) param.typ = result[i] @@ -306,7 +312,7 @@ proc instantiateProcType(c: PContext, pt: TIdTable, resetIdTable(cl.symMap) resetIdTable(cl.localCache) cl.isReturnType = true - result[0] = replaceTypeVarsT(cl, result[0]) + result.setReturnType replaceTypeVarsT(cl, result.returnType) cl.isReturnType = false result.n[0] = originalParams[0].copyTree if result[0] != nil: @@ -318,6 +324,22 @@ proc instantiateProcType(c: PContext, pt: TIdTable, prc.typ = result popInfoContext(c.config) +proc instantiateOnlyProcType(c: PContext, pt: TypeMapping, prc: PSym, info: TLineInfo): PType = + # instantiates only the type of a given proc symbol + # used by sigmatch for explicit generics + # wouldn't be needed if sigmatch could handle complex cases, + # examples are in texplicitgenerics + # might be buggy, see rest of generateInstance if problems occur + let fakeSym = copySym(prc, c.idgen) + incl(fakeSym.flags, sfFromGeneric) + fakeSym.instantiatedFrom = prc + openScope(c) + for s in instantiateGenericParamList(c, prc.ast[genericParamsPos], pt): + addDecl(c, s) + instantiateProcType(c, pt, fakeSym, info) + closeScope(c) + result = fakeSym.typ + proc fillMixinScope(c: PContext) = var p = c.p while p != nil: @@ -326,8 +348,20 @@ proc fillMixinScope(c: PContext) = addSym(c.currentScope, n.sym) p = p.next -proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, - info: TLineInfo): PSym {.nosinks.} = +proc getLocalPassC(c: PContext, s: PSym): string = + when defined(nimsuggest): return "" + if s.ast == nil or s.ast.len == 0: return "" + result = "" + template extractPassc(p: PNode) = + if p.kind == nkPragma and p[0][0].ident == c.cache.getIdent"localpassc": + return p[0][1].strVal + extractPassc(s.ast[0]) #it is set via appendToModule in pragmas (fast access) + for n in s.ast: + for p in n: + extractPassc(p) + +proc generateInstance(c: PContext, fn: PSym, pt: TypeMapping, + info: TLineInfo): PSym = ## Generates a new instance of a generic procedure. ## The `pt` parameter is a type-unsafe mapping table used to link generic ## parameters to their concrete types within the generic instance. @@ -336,19 +370,28 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, # generates an instantiated proc if c.instCounter > 50: globalError(c.config, info, "generic instantiation too nested") - inc(c.instCounter) + inc c.instCounter + defer: dec c.instCounter # careful! we copy the whole AST including the possibly nil body! var n = copyTree(fn.ast) # NOTE: for access of private fields within generics from a different module # we set the friend module: - c.friendModules.add(getModule(fn)) + let producer = getModule(fn) + c.friendModules.add(producer) let oldMatchedConcept = c.matchedConcept c.matchedConcept = nil let oldScope = c.currentScope while not isTopLevel(c): c.currentScope = c.currentScope.parent - result = copySym(fn, nextSymId c.idgen) + result = copySym(fn, c.idgen) incl(result.flags, sfFromGeneric) - result.owner = fn + result.instantiatedFrom = fn + if sfGlobal in result.flags and c.config.symbolFiles != disabledSf: + let passc = getLocalPassC(c, producer) + if passc != "": #pass the local compiler options to the consumer module too + extccomp.addLocalCompileOption(c.config, passc, toFullPathConsiderDirty(c.config, c.module.info.fileIndex)) + result.owner = c.module + else: + result.owner = fn result.ast = n pushOwner(c, result) @@ -358,7 +401,9 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, openScope(c) let gp = n[genericParamsPos] - internalAssert c.config, gp.kind == nkGenericParams + if gp.kind != nkGenericParams: + # bug #22137 + globalError(c.config, info, "generic instantiation too nested") n[namePos] = newSymNode(result) pushInfoContext(c.config, info, fn.detailedInfo) var entry = TInstantiation.new @@ -367,16 +412,20 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, # generic[void](), generic[int]() # see ttypeor.nim test. var i = 0 - newSeq(entry.concreteTypes, fn.typ.len+gp.len-1) + newSeq(entry.concreteTypes, fn.typ.paramsLen+gp.len) + # let param instantiation know we are in a concept for unresolved statics: + c.matchedConcept = oldMatchedConcept for s in instantiateGenericParamList(c, gp, pt): addDecl(c, s) entry.concreteTypes[i] = s.typ inc i - rawPushProcCon(c, result) + c.matchedConcept = nil + pushProcCon(c, result) instantiateProcType(c, pt, result, info) - for j in 1..<result.typ.len: - entry.concreteTypes[i] = result.typ[j] + for _, param in paramTypes(result.typ): + entry.concreteTypes[i] = param inc i + #echo "INSTAN ", fn.name.s, " ", typeToString(result.typ), " ", entry.concreteTypes.len if tfTriggersCompileTime in result.typ.flags: incl(result.flags, sfCompileTime) n[genericParamsPos] = c.graph.emptyNode @@ -387,21 +436,27 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, # a ``compiles`` context but this is the lesser evil. See # bug #1055 (tevilcompiles). #if c.compilesContextId == 0: - rawHandleSelf(c, result) entry.compilesId = c.compilesContextId addToGenericProcCache(c, fn, entry) c.generics.add(makeInstPair(fn, entry)) + # bug #12985 bug #22913 + # TODO: use the context of the declaration of generic functions instead + # TODO: consider fixing options as well + let otherPragmas = c.optionStack[^1].otherPragmas + c.optionStack[^1].otherPragmas = nil if n[pragmasPos].kind != nkEmpty: pragma(c, result, n[pragmasPos], allRoutinePragmas) if isNil(n[bodyPos]): n[bodyPos] = copyTree(getBody(c.graph, fn)) - if c.inGenericContext == 0: - instantiateBody(c, n, fn.typ.n, result, fn) + instantiateBody(c, n, fn.typ.n, result, fn) + c.optionStack[^1].otherPragmas = otherPragmas sideEffectsCheck(c, result) if result.magic notin {mSlice, mTypeOf}: # 'toOpenArray' is special and it is allowed to return 'openArray': paramsTypeCheck(c, result.typ) + #echo "INSTAN ", fn.name.s, " ", typeToString(result.typ), " <-- NEW PROC!", " ", entry.concreteTypes.len else: + #echo "INSTAN ", fn.name.s, " ", typeToString(result.typ), " <-- CACHED! ", typeToString(oldPrc.typ), " ", entry.concreteTypes.len result = oldPrc popProcCon(c) popInfoContext(c.config) @@ -410,7 +465,6 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, popOwner(c) c.currentScope = oldScope discard c.friendModules.pop() - dec(c.instCounter) c.matchedConcept = oldMatchedConcept if result.kind == skMethod: finishMethod(c, result) diff --git a/compiler/semmacrosanity.nim b/compiler/semmacrosanity.nim index a8eb62067..727f36470 100644 --- a/compiler/semmacrosanity.nim +++ b/compiler/semmacrosanity.nim @@ -35,12 +35,12 @@ proc ithField(n: PNode, field: var int): PSym = else: discard proc ithField(t: PType, field: var int): PSym = - var base = t[0] + var base = t.baseClass while base != nil: let b = skipTypes(base, skipPtrs) result = ithField(b.n, field) if result != nil: return result - base = b[0] + base = b.baseClass result = ithField(t.n, field) proc annotateType*(n: PNode, t: PType; conf: ConfigRef) = @@ -51,6 +51,7 @@ proc annotateType*(n: PNode, t: PType; conf: ConfigRef) = of nkObjConstr: let x = t.skipTypes(abstractPtrs) n.typ = t + n[0].typ = t for i in 1..<n.len: var j = i-1 let field = x.ithField(j) @@ -63,10 +64,31 @@ proc annotateType*(n: PNode, t: PType; conf: ConfigRef) = if x.kind == tyTuple: n.typ = t for i in 0..<n.len: - if i >= x.len: globalError conf, n.info, "invalid field at index " & $i + if i >= x.kidsLen: globalError conf, n.info, "invalid field at index " & $i else: annotateType(n[i], x[i], conf) elif x.kind == tyProc and x.callConv == ccClosure: n.typ = t + elif x.kind == tyOpenArray: # `opcSlice` transforms slices into tuples + if n.kind == nkTupleConstr: + let + bracketExpr = newNodeI(nkBracket, n.info) + left = int n[1].intVal + right = int n[2].intVal + bracketExpr.flags = n.flags + case n[0].kind # is this a string slice or a array slice + of nkStrKinds: + for i in left..right: + bracketExpr.add newIntNode(nkCharLit, BiggestInt n[0].strVal[i]) + annotateType(bracketExpr[^1], x.elementType, conf) + of nkBracket: + for i in left..right: + bracketExpr.add n[0][i] + annotateType(bracketExpr[^1], x.elementType, conf) + else: + globalError(conf, n.info, "Incorrectly generated tuple constr") + n[] = bracketExpr[] + + n.typ = t else: globalError(conf, n.info, "() must have a tuple type") of nkBracket: @@ -92,7 +114,7 @@ proc annotateType*(n: PNode, t: PType; conf: ConfigRef) = else: globalError(conf, n.info, "integer literal must have some int type") of nkStrLit..nkTripleStrLit: - if x.kind in {tyString, tyCString}: + if x.kind in {tyString, tyCstring}: n.typ = t else: globalError(conf, n.info, "string literal must be of some string type") diff --git a/compiler/semmagic.nim b/compiler/semmagic.nim index c80e689a5..a12e933e7 100644 --- a/compiler/semmagic.nim +++ b/compiler/semmagic.nim @@ -10,18 +10,35 @@ # This include file implements the semantic checking for magics. # included from sem.nim -proc semAddrArg(c: PContext; n: PNode; isUnsafeAddr = false): PNode = +proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode + + +proc addDefaultFieldForNew(c: PContext, n: PNode): PNode = + result = n + let typ = result[1].typ # new(x) + if typ.skipTypes({tyGenericInst, tyAlias, tySink}).kind == tyRef and typ.skipTypes({tyGenericInst, tyAlias, tySink})[0].kind == tyObject: + var asgnExpr = newTree(nkObjConstr, newNodeIT(nkType, result[1].info, typ)) + asgnExpr.typ = typ + var t = typ.skipTypes({tyGenericInst, tyAlias, tySink})[0] + while true: + asgnExpr.sons.add defaultFieldsForTheUninitialized(c, t.n, false) + let base = t.baseClass + if base == nil: + break + t = skipTypes(base, skipPtrs) + + if asgnExpr.sons.len > 1: + result = newTree(nkAsgn, result[1], asgnExpr) + +proc semAddr(c: PContext; n: PNode): PNode = + result = newNodeI(nkAddr, n.info) let x = semExprWithType(c, n) if x.kind == nkSym: x.sym.flags.incl(sfAddrTaken) - if isAssignable(c, x, 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'") - result = x + if isAssignable(c, x) notin {arLValue, arLocalLValue, arAddressableConst, arLentValue}: + localError(c.config, n.info, errExprHasNoAddress) + result.add x + result.typ = makePtrType(c, x.typ) proc semTypeOf(c: PContext; n: PNode): PNode = var m = BiggestInt 1 # typeOfIter @@ -32,8 +49,12 @@ proc semTypeOf(c: PContext; n: PNode): PNode = else: m = mode.intVal result = newNodeI(nkTypeOfExpr, n.info) + inc c.inTypeofContext + defer: dec c.inTypeofContext # compiles can raise an exception let typExpr = semExprWithType(c, n[1], if m == 1: {efInTypeof} else: {}) result.add typExpr + if typExpr.typ.kind == tyFromExpr: + typExpr.typ.flags.incl tfNonConstExpr result.typ = makeTypeDesc(c, typExpr.typ) type @@ -49,22 +70,31 @@ proc semArrGet(c: PContext; n: PNode; flags: TExprFlags): PNode = if result.isNil: let x = copyTree(n) x[0] = newIdentNode(getIdent(c.cache, "[]"), n.info) - bracketNotFoundError(c, x) + if c.inGenericContext > 0: + for i in 0..<n.len: + let a = n[i] + if a.typ != nil and a.typ.kind in {tyGenericParam, tyFromExpr}: + # expression is compiled early in a generic body + result = semGenericStmt(c, x) + result.typ = makeTypeFromExpr(c, copyTree(result)) + result.typ.flags.incl tfNonConstExpr + return + bracketNotFoundError(c, x, flags) #localError(c.config, n.info, "could not resolve: " & $n) - result = n + result = errorNode(c, n) proc semArrPut(c: PContext; n: PNode; flags: TExprFlags): PNode = # rewrite `[]=`(a, i, x) back to ``a[i] = x``. let b = newNodeI(nkBracketExpr, n.info) - b.add(n[1].skipAddr) + b.add(n[1].skipHiddenAddr) for i in 2..<n.len-1: b.add(n[i]) result = newNodeI(nkAsgn, n.info, 2) result[0] = b result[1] = n.lastSon result = semAsgn(c, result, noOverloadedSubscript) -proc semAsgnOpr(c: PContext; n: PNode): PNode = - result = newNodeI(nkAsgn, n.info, 2) +proc semAsgnOpr(c: PContext; n: PNode; k: TNodeKind): PNode = + result = newNodeI(k, n.info, 2) result[0] = n[1] result[1] = n[2] result = semAsgn(c, result, noOverloadedAsgn) @@ -77,7 +107,9 @@ 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: + result = 0 + localError(c.config, n.info, errIntLiteralExpected) proc semInstantiationInfo(c: PContext, n: PNode): PNode = result = newNodeIT(nkTupleConstr, n.info, n.typ) @@ -115,14 +147,22 @@ proc uninstantiate(t: PType): PType = result = case t.kind of tyMagicGenerics: t of tyUserDefinedGenerics: t.base - of tyCompositeTypeClass: uninstantiate t[1] + of tyCompositeTypeClass: uninstantiate t.firstGenericParam else: t proc getTypeDescNode(c: PContext; typ: PType, sym: PSym, info: TLineInfo): PNode = - var resType = newType(tyTypeDesc, nextTypeId c.idgen, sym) + var resType = newType(tyTypeDesc, c.idgen, sym) rawAddSon(resType, typ) result = toNode(resType, info) +proc buildBinaryPredicate(kind: TTypeKind; c: PContext; context: PSym; a, b: sink PType): PType = + result = newType(kind, c.idgen, context) + result.rawAddSon a + result.rawAddSon b + +proc buildNotPredicate(c: PContext; context: PSym; a: sink PType): PType = + result = newType(tyNot, c.idgen, context, a) + proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym): PNode = const skippedTypes = {tyTypeDesc, tyAlias, tySink} let trait = traitCall[0] @@ -132,20 +172,17 @@ proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym) template operand2: PType = traitCall[2].typ.skipTypes({tyTypeDesc}) - template typeWithSonsResult(kind, sons): PNode = - newTypeWithSons(context, kind, sons, c.idgen).toNode(traitCall.info) - if operand.kind == tyGenericParam or (traitCall.len > 2 and operand2.kind == tyGenericParam): return traitCall ## too early to evaluate let s = trait.sym.name.s case s of "or", "|": - return typeWithSonsResult(tyOr, @[operand, operand2]) + return buildBinaryPredicate(tyOr, c, context, operand, operand2).toNode(traitCall.info) of "and": - return typeWithSonsResult(tyAnd, @[operand, operand2]) + return buildBinaryPredicate(tyAnd, c, context, operand, operand2).toNode(traitCall.info) of "not": - return typeWithSonsResult(tyNot, @[operand]) + return buildNotPredicate(c, context, operand).toNode(traitCall.info) of "typeToString": var prefer = preferTypeName if traitCall.len >= 2: @@ -160,7 +197,7 @@ proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym) result.info = traitCall.info of "arity": result = newIntNode(nkIntLit, operand.len - ord(operand.kind==tyProc)) - result.typ = newType(tyInt, nextTypeId c.idgen, context) + result.typ = newType(tyInt, c.idgen, context) result.info = traitCall.info of "genericHead": var arg = operand @@ -172,7 +209,7 @@ proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym) # 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)]) - result = newType(tyError, nextTypeId c.idgen, context).toNode(traitCall.info) + result = newType(tyError, c.idgen, context).toNode(traitCall.info) of "stripGenericParams": result = uninstantiate(operand).toNode(traitCall.info) of "supportsCopyMem": @@ -180,6 +217,8 @@ proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym) let complexObj = containsGarbageCollectedRef(t) or hasDestructor(t) result = newIntNodeT(toInt128(ord(not complexObj)), traitCall, c.idgen, c.graph) + of "hasDefaultValue": + result = newIntNodeT(toInt128(ord(not operand.requiresInit)), traitCall, c.idgen, c.graph) of "isNamedTuple": var operand = operand.skipTypes({tyGenericInst}) let cond = operand.kind == tyTuple and operand.n != nil @@ -190,10 +229,21 @@ proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym) result = newIntNodeT(toInt128(operand.len), traitCall, c.idgen, c.graph) of "distinctBase": var arg = operand.skipTypes({tyGenericInst}) + let rec = semConstExpr(c, traitCall[2]).intVal != 0 while arg.kind == tyDistinct: + arg = arg.base.skipTypes(skippedTypes + {tyGenericInst}) + if not rec: break + result = getTypeDescNode(c, arg, operand.owner, traitCall.info) + of "rangeBase": + # return the base type of a range type + var arg = operand.skipTypes({tyGenericInst}) + if arg.kind == tyRange: arg = arg.base - arg = arg.skipTypes(skippedTypes + {tyGenericInst}) result = getTypeDescNode(c, arg, operand.owner, traitCall.info) + of "isCyclic": + var operand = operand.skipTypes({tyGenericInst}) + let isCyclic = canFormAcycle(c.graph, operand) + result = newIntNodeT(toInt128(ord(isCyclic)), traitCall, c.idgen, c.graph) else: localError(c.config, traitCall.info, "unknown trait: " & s) result = newNodeI(nkEmpty, traitCall.info) @@ -201,7 +251,7 @@ proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym) proc semTypeTraits(c: PContext, n: PNode): PNode = checkMinSonsLen(n, 2, c.config) let t = n[1].typ - internalAssert c.config, t != nil and t.kind == tyTypeDesc + internalAssert c.config, t != nil and t.skipTypes({tyAlias}).kind == tyTypeDesc if t.len > 0: # This is either a type known to sem or a typedesc # param to a regular proc (again, known at instantiation) @@ -215,12 +265,8 @@ proc semOrd(c: PContext, n: PNode): PNode = let parType = n[1].typ if isOrdinalType(parType, allowEnumWithHoles=true): discard - elif parType.kind == tySet: - let a = toInt64(firstOrd(c.config, parType)) - let b = toInt64(lastOrd(c.config, parType)) - result.typ = makeRangeType(c, a, b, n.info) else: - localError(c.config, n.info, errOrdinalTypeExpected) + localError(c.config, n.info, errOrdinalTypeExpected % typeToString(parType, preferDesc)) result.typ = errorType(c) proc semBindSym(c: PContext, n: PNode): PNode = @@ -229,14 +275,12 @@ proc semBindSym(c: PContext, n: PNode): PNode = let sl = semConstExpr(c, n[1]) if sl.kind notin {nkStrLit, nkRStrLit, nkTripleStrLit}: - localError(c.config, n[1].info, errStringLiteralExpected) - return errorNode(c, n) + return localErrorNode(c, n, n[1].info, errStringLiteralExpected) let isMixin = semConstExpr(c, n[2]) if isMixin.kind != nkIntLit or isMixin.intVal < 0 or isMixin.intVal > high(TSymChoiceRule).int: - localError(c.config, n[2].info, errConstExprExpected) - return errorNode(c, n) + return localErrorNode(c, n, n[2].info, errConstExprExpected) let id = newIdentNode(getIdent(c.cache, sl.strVal), n.info) let s = qualifiedLookUp(c, id, {checkUndeclared}) @@ -253,12 +297,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}: - localError(c.config, info.info, errStringOrIdentNodeExpected) - return errorNode(c, n) + return localErrorNode(c, n, info.info, errStringOrIdentNodeExpected) if isMixin < 0 or isMixin > high(TSymChoiceRule).int: - localError(c.config, info.info, errConstExprExpected) - return errorNode(c, n) + return localErrorNode(c, n, info.info, errConstExprExpected) let id = if n.kind == nkIdent: n else: newIdentNode(getIdent(c.cache, n.strVal), info.info) @@ -270,6 +312,7 @@ proc opBindSym(c: PContext, scope: PScope, n: PNode, isMixin: int, info: PNode): # we need to mark all symbols: result = symChoice(c, id, s, TSymChoiceRule(isMixin)) else: + result = nil errorUndeclaredIdentifier(c, info.info, if n.kind == nkIdent: n.ident.s else: n.strVal) c.currentScope = tmpScope @@ -365,18 +408,18 @@ proc semUnown(c: PContext; n: PNode): PNode = elems[i] = unownedType(c, t[i]) if elems[i] != t[i]: someChange = true if someChange: - result = newType(tyTuple, nextTypeId c.idgen, t.owner) + result = newType(tyTuple, c.idgen, t.owner) # we have to use 'rawAddSon' here so that type flags are # properly computed: for e in elems: result.rawAddSon(e) else: result = t - of tyOwned: result = t[0] + of tyOwned: result = t.elementType of tySequence, tyOpenArray, tyArray, tyVarargs, tyVar, tyLent, tyGenericInst, tyAlias: let b = unownedType(c, t[^1]) if b != t[^1]: - result = copyType(t, nextTypeId c.idgen, t.owner) + result = copyType(t, c.idgen, t.owner) copyTypeProps(c.graph, c.idgen.module, result, t) result[^1] = b @@ -396,34 +439,30 @@ proc turnFinalizerIntoDestructor(c: PContext; orig: PSym; info: TLineInfo): PSym # Replace nkDerefExpr by nkHiddenDeref # nkDeref is for 'ref T': x[].field # nkHiddenDeref is for 'var T': x<hidden deref [] here>.field - proc transform(c: PContext; procSym: PSym; n: PNode; old, fresh: PType; oldParam, newParam: PSym): PNode = + proc transform(c: PContext; n: PNode; old, fresh: PType; oldParam, newParam: PSym): PNode = result = shallowCopy(n) if sameTypeOrNil(n.typ, old): result.typ = fresh - if n.kind == nkSym: - if n.sym == oldParam: - result.sym = newParam - elif n.sym.owner == orig: - result.sym = copySym(n.sym, nextSymId c.idgen) - result.sym.owner = procSym + if n.kind == nkSym and n.sym == oldParam: + result.sym = newParam for i in 0 ..< safeLen(n): - result[i] = transform(c, procSym, n[i], old, fresh, oldParam, newParam) + result[i] = transform(c, n[i], old, fresh, oldParam, newParam) #if n.kind == nkDerefExpr and sameType(n[0].typ, old): # result = - result = copySym(orig, nextSymId c.idgen) + result = copySym(orig, c.idgen) result.info = info result.flags.incl sfFromGeneric result.owner = orig - let origParamType = orig.typ[1] + let origParamType = orig.typ.firstParamType let newParamType = makeVarType(result, origParamType.skipTypes(abstractPtrs), c.idgen) let oldParam = orig.typ.n[1].sym - let newParam = newSym(skParam, oldParam.name, nextSymId c.idgen, result, result.info) + let newParam = newSym(skParam, oldParam.name, c.idgen, result, result.info) newParam.typ = newParamType # proc body: - result.ast = transform(c, result, orig.ast, origParamType, newParamType, oldParam, newParam) + result.ast = transform(c, orig.ast, origParamType, newParamType, oldParam, newParam) # proc signature: - result.typ = newProcType(result.info, nextTypeId c.idgen, result) + result.typ = newProcType(result.info, c.idgen, result) result.typ.addParam newParam proc semQuantifier(c: PContext; n: PNode): PNode = @@ -440,7 +479,7 @@ proc semQuantifier(c: PContext; n: PNode): PNode = let op = considerQuotedIdent(c, it[0]) if op.id == ord(wIn): let v = newSymS(skForVar, it[1], c) - styleCheckDef(c.config, v) + styleCheckDef(c, v) onDef(it[1].info, v) let domain = semExprWithType(c, it[2], {efWantIterator}) v.typ = domain.typ @@ -461,8 +500,74 @@ proc semOld(c: PContext; n: PNode): PNode = localError(c.config, n[1].info, n[1].sym.name.s & " does not belong to " & getCurrOwner(c).name.s) result = n +proc semNewFinalize(c: PContext; n: PNode): PNode = + # 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") + 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") + 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") + + # check if we converted this finalizer into a destructor already: + let t = whereToBindTypeHook(c, fin.typ.firstParamType.skipTypes(abstractInst+{tyRef})) + if t != nil and getAttachedOp(c.graph, t, attachedDestructor) != nil and + getAttachedOp(c.graph, t, attachedDestructor).owner == fin: + discard "already turned this one into a finalizer" + else: + if fin.instantiatedFrom != nil and fin.instantiatedFrom != fin.owner: #undo move + fin.owner = fin.instantiatedFrom + let wrapperSym = newSym(skProc, getIdent(c.graph.cache, fin.name.s & "FinalizerWrapper"), c.idgen, fin.owner, fin.info) + let selfSymNode = newSymNode(copySym(fin.ast[paramsPos][1][0].sym, c.idgen)) + selfSymNode.typ = fin.typ.firstParamType + wrapperSym.flags.incl sfUsed + + let wrapper = c.semExpr(c, newProcNode(nkProcDef, fin.info, body = newTree(nkCall, newSymNode(fin), selfSymNode), + params = nkFormalParams.newTree(c.graph.emptyNode, + newTree(nkIdentDefs, selfSymNode, newNodeIT(nkType, + fin.ast[paramsPos][1][1].info, fin.typ.firstParamType), c.graph.emptyNode) + ), + name = newSymNode(wrapperSym), pattern = fin.ast[patternPos], + genericParams = fin.ast[genericParamsPos], pragmas = fin.ast[pragmasPos], exceptions = fin.ast[miscPos]), {}) + + var transFormedSym = turnFinalizerIntoDestructor(c, wrapperSym, wrapper.info) + transFormedSym.owner = fin + if c.config.backend == backendCpp or sfCompileToCpp in c.module.flags: + let origParamType = transFormedSym.ast[bodyPos][1].typ + let selfSymbolType = makePtrType(c, origParamType.skipTypes(abstractPtrs)) + let selfPtr = newNodeI(nkHiddenAddr, transFormedSym.ast[bodyPos][1].info) + selfPtr.add transFormedSym.ast[bodyPos][1] + selfPtr.typ = selfSymbolType + transFormedSym.ast[bodyPos][1] = c.semExpr(c, selfPtr) + # TODO: suppress var destructor warnings; if newFinalizer is not + # TODO: deprecated, try to implement plain T destructor + bindTypeHook(c, transFormedSym, n, attachedDestructor, suppressVarDestructorWarning = true) + result = addDefaultFieldForNew(c, n) + +proc semPrivateAccess(c: PContext, n: PNode): PNode = + let t = n[1].typ.elementType.toObjectFromRefPtrGeneric + if t.kind == tyObject: + assert t.sym != nil + c.currentScope.allowPrivateAccess.add t.sym + result = newNodeIT(nkEmpty, n.info, getSysType(c.graph, n.info, tyVoid)) + +proc checkDefault(c: PContext, n: PNode): PNode = + result = n + 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)) + proc magicsAfterOverloadResolution(c: PContext, n: PNode, - flags: TExprFlags): PNode = + flags: TExprFlags; expectedType: PType = nil): PNode = ## This is the preferred code point to implement magics. ## ``c`` the current module, a symbol table to a very good approximation ## ``n`` the ast like it would be passed to a real macro @@ -472,9 +577,7 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, case n[0].sym.magic of mAddr: checkSonsLen(n, 2, c.config) - result = n - result[1] = semAddrArg(c, n[1], n[0].sym.name.s == "unsafeAddr") - result.typ = makePtrType(c, result[1].typ) + result = semAddr(c, n[1]) of mTypeOf: result = semTypeOf(c, n) of mSizeOf: @@ -489,7 +592,9 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, result = semArrPut(c, n, flags) of mAsgn: if n[0].sym.name.s == "=": - result = semAsgnOpr(c, n) + result = semAsgnOpr(c, n, nkAsgn) + elif n[0].sym.name.s == "=sink": + result = semAsgnOpr(c, n, nkSinkAsgn) else: result = semShallowCopy(c, n, flags) of mIsPartOf: result = semIsPartOf(c, n, flags) @@ -519,37 +624,50 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, result = n else: result = plugin(c, n) + of mNew: + if n[0].sym.name.s == "unsafeNew": # special case for unsafeNew + result = n + else: + result = addDefaultFieldForNew(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") - 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") - 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") - - # check if we converted this finalizer into a destructor already: - let t = whereToBindTypeHook(c, fin.typ[1].skipTypes(abstractInst+{tyRef})) - if t != nil and getAttachedOp(c.graph, t, attachedDestructor) != nil and - getAttachedOp(c.graph, t, attachedDestructor).owner == fin: - discard "already turned this one into a finalizer" - else: - bindTypeHook(c, turnFinalizerIntoDestructor(c, fin, n.info), n, attachedDestructor) - result = n + result = semNewFinalize(c, n) of mDestroy: result = n let t = n[1].typ.skipTypes(abstractVar) let op = getAttachedOp(c.graph, t, attachedDestructor) if op != nil: result[0] = newSymNode(op) + if op.typ != nil and op.typ.len == 2 and op.typ.firstParamType.kind != tyVar: + if n[1].kind == nkSym and n[1].sym.kind == skParam and + n[1].typ.kind == tyVar: + result[1] = genDeref(n[1]) + else: + result[1] = skipAddr(n[1]) + of mTrace: + result = n + let t = n[1].typ.skipTypes(abstractVar) + let op = getAttachedOp(c.graph, t, attachedTrace) + if op != nil: + result[0] = newSymNode(op) + of mDup: + result = n + let t = n[1].typ.skipTypes(abstractVar) + let op = getAttachedOp(c.graph, t, attachedDup) + if op != nil: + result[0] = newSymNode(op) + if op.typ.len == 3: + let boolLit = newIntLit(c.graph, n.info, 1) + boolLit.typ = getSysType(c.graph, n.info, tyBool) + result.add boolLit + of mWasMoved: + result = n + let t = n[1].typ.skipTypes(abstractVar) + let op = getAttachedOp(c.graph, t, attachedWasMoved) + if op != nil: + result[0] = newSymNode(op) + let addrExp = newNodeIT(nkHiddenAddr, result[1].info, makePtrType(c, t)) + addrExp.add result[1] + result[1] = addrExp of mUnown: result = semUnown(c, n) of mExists, mForall: @@ -564,18 +682,28 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, if seqType.kind == tySequence and seqType.base.requiresInit: message(c.config, n.info, warnUnsafeSetLen, typeToString(seqType.base)) of mDefault: - result = n - 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)) + result = checkDefault(c, n) + let typ = result[^1].typ.skipTypes({tyTypeDesc}) + let defaultExpr = defaultNodeField(c, result[^1], typ, false) + if defaultExpr != nil: + result = defaultExpr + of mZeroDefault: + result = checkDefault(c, n) of mIsolate: if not checkIsolate(n[1]): localError(c.config, n.info, "expression cannot be isolated: " & $n[1]) result = n - of mPred: - if n[1].typ.skipTypes(abstractInst).kind in {tyUInt..tyUInt64}: - n[0].sym.magic = mSubU + of mPrivateAccess: + result = semPrivateAccess(c, n) + of mArrToSeq: + result = n + if result.typ != nil and expectedType != nil and result.typ.kind == tySequence and + expectedType.kind == tySequence and result.typ.elementType.kind == tyEmpty: + result.typ = expectedType # type inference for empty sequence # bug #21377 + of mEnsureMove: result = n + if n[1].kind in {nkStmtListExpr, nkBlockExpr, + nkIfExpr, nkCaseStmt, nkTryStmt}: + localError(c.config, n.info, "Nested expressions cannot be moved: '" & $n[1] & "'") else: result = n diff --git a/compiler/semobjconstr.nim b/compiler/semobjconstr.nim index 792488c9f..048053115 100644 --- a/compiler/semobjconstr.nim +++ b/compiler/semobjconstr.nim @@ -11,6 +11,8 @@ # included from sem.nim +from std/sugar import dup + type ObjConstrContext = object typ: PType # The constructed type @@ -19,6 +21,7 @@ type # set this to true while visiting # parent types. missingFields: seq[PSym] # Fields that the user failed to specify + checkDefault: bool # Checking defaults InitStatus = enum # This indicates the result of object construction initUnknown @@ -27,6 +30,10 @@ type initNone # None of the fields have been initialized initConflict # Fields from different branches have been initialized + +proc semConstructFields(c: PContext, n: PNode, constrCtx: var ObjConstrContext, + flags: TExprFlags): tuple[status: InitStatus, defaults: seq[PNode]] + proc mergeInitStatus(existing: var InitStatus, newStatus: InitStatus) = case newStatus of initConflict: @@ -55,14 +62,13 @@ proc invalidObjConstr(c: PContext, n: PNode) = proc locateFieldInInitExpr(c: PContext, field: PSym, initExpr: PNode): PNode = # Returns the assignment nkExprColonExpr node or nil + result = nil let fieldId = field.name.id for i in 1..<initExpr.len: let assignment = initExpr[i] if assignment.kind != nkExprColonExpr: invalidObjConstr(c, assignment) - continue - - if fieldId == considerQuotedIdent(c, assignment[0]).id: + elif fieldId == considerQuotedIdent(c, assignment[0]).id: return assignment proc semConstrField(c: PContext, flags: TExprFlags, @@ -70,27 +76,23 @@ proc semConstrField(c: PContext, flags: TExprFlags, let assignment = locateFieldInInitExpr(c, field, initExpr) if assignment != nil: if nfSem in assignment.flags: return assignment[1] - if not fieldVisible(c, field): + if nfSkipFieldChecking in assignment[1].flags: + discard + elif not fieldVisible(c, field): localError(c.config, initExpr.info, "the field '$1' is not accessible." % [field.name.s]) return - var initValue = semExprFlagDispatched(c, assignment[1], flags) + var initValue = semExprFlagDispatched(c, assignment[1], flags, field.typ) if initValue != nil: - initValue = fitNode(c, field.typ, initValue, assignment.info) + initValue = fitNodeConsiderViewType(c, field.typ, initValue, assignment.info) + initValue.flags.incl nfSkipFieldChecking assignment[0] = newSymNode(field) assignment[1] = initValue assignment.flags.incl nfSem - return initValue - -proc caseBranchMatchesExpr(branch, matched: PNode): bool = - for i in 0..<branch.len-1: - if branch[i].kind == nkRange: - if overlap(branch[i], matched): return true - elif exprStructuralEquivalent(branch[i], matched): - return true - - return false + result = initValue + else: + result = nil proc branchVals(c: PContext, caseNode: PNode, caseIdx: int, isStmtBranch: bool): IntSet = @@ -105,6 +107,7 @@ proc branchVals(c: PContext, caseNode: PNode, caseIdx: int, result.excl(val) proc findUsefulCaseContext(c: PContext, discrimator: PNode): (PNode, int) = + result = (nil, 0) for i in countdown(c.p.caseContext.high, 0): let (caseNode, index) = c.p.caseContext[i] @@ -120,7 +123,9 @@ proc pickCaseBranch(caseExpr, matched: PNode): PNode = return caseExpr[i] if endsWithElse: - return caseExpr[^1] + result = caseExpr[^1] + else: + result = nil iterator directFieldsInRecList(recList: PNode): PNode = # XXX: We can remove this case by making all nkOfBranch nodes @@ -131,8 +136,8 @@ iterator directFieldsInRecList(recList: PNode): PNode = else: doAssert recList.kind == nkRecList for field in recList: - if field.kind != nkSym: continue - yield field + if field.kind == nkSym: + yield field template quoteStr(s: string): string = "'" & s & "'" @@ -143,48 +148,90 @@ proc fieldsPresentInInitExpr(c: PContext, fieldsRecList, initExpr: PNode): strin if result.len != 0: result.add ", " result.add field.sym.name.s.quoteStr +proc locateFieldInDefaults(sym: PSym, defaults: seq[PNode]): bool = + result = false + for d in defaults: + if sym.id == d[0].sym.id: + return true + proc collectMissingFields(c: PContext, fieldsRecList: PNode, - constrCtx: var ObjConstrContext) = + constrCtx: var ObjConstrContext, defaults: seq[PNode] + ): seq[PSym] = + result = @[] for r in directFieldsInRecList(fieldsRecList): - if constrCtx.needsFullInit or - sfRequiresInit in r.sym.flags or - r.sym.typ.requiresInit: - let assignment = locateFieldInInitExpr(c, r.sym, constrCtx.initExpr) - if assignment == nil: + let assignment = locateFieldInInitExpr(c, r.sym, constrCtx.initExpr) + if assignment == nil and not locateFieldInDefaults(r.sym, defaults): + if constrCtx.needsFullInit or + sfRequiresInit in r.sym.flags or + r.sym.typ.requiresInit: constrCtx.missingFields.add r.sym + else: + result.add r.sym - -proc semConstructFields(c: PContext, n: PNode, - constrCtx: var ObjConstrContext, - flags: TExprFlags): InitStatus = - result = initUnknown - +proc collectMissingCaseFields(c: PContext, branchNode: PNode, + constrCtx: var ObjConstrContext, defaults: seq[PNode]): seq[PSym] = + if branchNode != nil: + let fieldsRecList = branchNode[^1] + result = collectMissingFields(c, fieldsRecList, constrCtx, defaults) + else: + result = @[] + +proc collectOrAddMissingCaseFields(c: PContext, branchNode: PNode, + constrCtx: var ObjConstrContext, defaults: var seq[PNode]) = + let res = collectMissingCaseFields(c, branchNode, constrCtx, defaults) + for sym in res: + let asgnType = newType(tyTypeDesc, c.idgen, sym.typ.owner) + let recTyp = sym.typ.skipTypes(defaultFieldsSkipTypes) + rawAddSon(asgnType, recTyp) + let asgnExpr = newTree(nkCall, + newSymNode(getSysMagic(c.graph, constrCtx.initExpr.info, "zeroDefault", mZeroDefault)), + newNodeIT(nkType, constrCtx.initExpr.info, asgnType) + ) + asgnExpr.flags.incl nfSkipFieldChecking + asgnExpr.typ = recTyp + defaults.add newTree(nkExprColonExpr, newSymNode(sym), asgnExpr) + +proc collectBranchFields(c: PContext, n: PNode, discriminatorVal: PNode, + constrCtx: var ObjConstrContext, flags: TExprFlags) = + # All bets are off. If any of the branches has a mandatory + # fields we must produce an error: + for i in 1..<n.len: + let branchNode = n[i] + if branchNode != nil: + let oldCheckDefault = constrCtx.checkDefault + constrCtx.checkDefault = true + let (_, defaults) = semConstructFields(c, branchNode[^1], constrCtx, flags) + constrCtx.checkDefault = oldCheckDefault + if len(defaults) > 0: + localError(c.config, discriminatorVal.info, "branch initialization " & + "with a runtime discriminator is not supported " & + "for a branch whose fields have default values.") + discard collectMissingCaseFields(c, n[i], constrCtx, @[]) + +proc semConstructFields(c: PContext, n: PNode, constrCtx: var ObjConstrContext, + flags: TExprFlags): tuple[status: InitStatus, defaults: seq[PNode]] = + result = (initUnknown, @[]) case n.kind of nkRecList: for field in n: - let status = semConstructFields(c, field, constrCtx, flags) - mergeInitStatus(result, status) - + let (subSt, subDf) = semConstructFields(c, field, constrCtx, flags) + result.status.mergeInitStatus subSt + result.defaults.add subDf of nkRecCase: template fieldsPresentInBranch(branchIdx: int): string = let branch = n[branchIdx] let fields = branch[^1] fieldsPresentInInitExpr(c, fields, constrCtx.initExpr) - template collectMissingFields(branchNode: PNode) = - if branchNode != nil: - let fields = branchNode[^1] - collectMissingFields(c, fields, constrCtx) - let discriminator = n[0] internalAssert c.config, discriminator.kind == nkSym var selectedBranch = -1 for i in 1..<n.len: let innerRecords = n[i][^1] - let status = semConstructFields(c, innerRecords, constrCtx, flags) + let (status, _) = semConstructFields(c, innerRecords, constrCtx, flags) # todo if status notin {initNone, initUnknown}: - mergeInitStatus(result, status) + result.status.mergeInitStatus status if selectedBranch != -1: let prevFields = fieldsPresentInBranch(selectedBranch) let currentFields = fieldsPresentInBranch(i) @@ -192,26 +239,28 @@ proc semConstructFields(c: PContext, n: PNode, ("The fields '$1' and '$2' cannot be initialized together, " & "because they are from conflicting branches in the case object.") % [prevFields, currentFields]) - result = initConflict + result.status = initConflict else: selectedBranch = i if selectedBranch != -1: template badDiscriminatorError = - let fields = fieldsPresentInBranch(selectedBranch) - localError(c.config, constrCtx.initExpr.info, - ("cannot prove that it's safe to initialize $1 with " & - "the runtime value for the discriminator '$2' ") % - [fields, discriminator.sym.name.s]) - mergeInitStatus(result, initNone) + if c.inUncheckedAssignSection == 0: + let fields = fieldsPresentInBranch(selectedBranch) + localError(c.config, constrCtx.initExpr.info, + ("cannot prove that it's safe to initialize $1 with " & + "the runtime value for the discriminator '$2' ") % + [fields, discriminator.sym.name.s]) + mergeInitStatus(result.status, initNone) template wrongBranchError(i) = - let fields = fieldsPresentInBranch(i) - localError(c.config, constrCtx.initExpr.info, - "a case selecting discriminator '$1' with value '$2' " & - "appears in the object construction, but the field(s) $3 " & - "are in conflict with this value.", - [discriminator.sym.name.s, discriminatorVal.renderTree, fields]) + if c.inUncheckedAssignSection == 0: + let fields = fieldsPresentInBranch(i) + localError(c.config, constrCtx.initExpr.info, + ("a case selecting discriminator '$1' with value '$2' " & + "appears in the object construction, but the field(s) $3 " & + "are in conflict with this value.") % + [discriminator.sym.name.s, discriminatorVal.renderTree, fields]) template valuesInConflictError(valsDiff) = localError(c.config, discriminatorVal.info, ("possible values " & @@ -220,8 +269,7 @@ proc semConstructFields(c: PContext, n: PNode, valsDiff.renderAsType(n[0].typ)]) let branchNode = n[selectedBranch] - let flags = flags*{efAllowDestructor} + {efPreferStatic, - efPreferNilResult} + let flags = {efPreferStatic, efPreferNilResult} var discriminatorVal = semConstrField(c, flags, discriminator.sym, constrCtx.initExpr) @@ -250,9 +298,10 @@ proc semConstructFields(c: PContext, n: PNode, badDiscriminatorError() elif discriminatorVal.sym.kind notin {skLet, skParam} or discriminatorVal.sym.typ.kind in {tyVar}: - localError(c.config, discriminatorVal.info, - "runtime discriminator must be immutable if branch fields are " & - "initialized, a 'let' binding is required.") + if c.inUncheckedAssignSection == 0: + localError(c.config, discriminatorVal.info, + "runtime discriminator must be immutable if branch fields are " & + "initialized, a 'let' binding is required.") elif ctorCase[ctorIdx].kind == nkElifBranch: localError(c.config, discriminatorVal.info, "branch initialization " & "with a runtime discriminator is not supported inside of an " & @@ -285,56 +334,92 @@ proc semConstructFields(c: PContext, n: PNode, else: wrongBranchError(failedBranch) + let (_, defaults) = semConstructFields(c, branchNode[^1], constrCtx, flags) + result.defaults.add defaults + # When a branch is selected with a partial match, some of the fields # that were not initialized may be mandatory. We must check for this: - if result == initPartial: - collectMissingFields branchNode - + if result.status == initPartial: + collectOrAddMissingCaseFields(c, branchNode, constrCtx, result.defaults) else: - result = initNone + result.status = initNone let discriminatorVal = semConstrField(c, flags + {efPreferStatic}, discriminator.sym, constrCtx.initExpr) if discriminatorVal == nil: - # None of the branches were explicitly selected by the user and no - # value was given to the discrimator. We can assume that it will be - # initialized to zero and this will select a particular branch as - # a result: - let defaultValue = newIntLit(c.graph, constrCtx.initExpr.info, 0) - let matchedBranch = n.pickCaseBranch defaultValue - collectMissingFields matchedBranch + if discriminator.sym.ast != nil: + # branch is selected by the default field value of discriminator + let discriminatorDefaultVal = discriminator.sym.ast + result.status = initUnknown + result.defaults.add newTree(nkExprColonExpr, n[0], discriminatorDefaultVal) + if discriminatorDefaultVal.kind == nkIntLit: + let matchedBranch = n.pickCaseBranch discriminatorDefaultVal + if matchedBranch != nil: + let (_, defaults) = semConstructFields(c, matchedBranch[^1], constrCtx, flags) + result.defaults.add defaults + collectOrAddMissingCaseFields(c, matchedBranch, constrCtx, result.defaults) + else: + collectBranchFields(c, n, discriminatorDefaultVal, constrCtx, flags) + else: + # None of the branches were explicitly selected by the user and no + # value was given to the discrimator. We can assume that it will be + # initialized to zero and this will select a particular branch as + # a result: + let defaultValue = newIntLit(c.graph, constrCtx.initExpr.info, 0) + let matchedBranch = n.pickCaseBranch defaultValue + discard collectMissingCaseFields(c, matchedBranch, constrCtx, @[]) else: - result = initPartial + result.status = initPartial if discriminatorVal.kind == nkIntLit: # When the discriminator is a compile-time value, we also know # which branch will be selected: let matchedBranch = n.pickCaseBranch discriminatorVal - if matchedBranch != nil: collectMissingFields matchedBranch + if matchedBranch != nil: + let (_, defaults) = semConstructFields(c, matchedBranch[^1], constrCtx, flags) + result.defaults.add defaults + collectOrAddMissingCaseFields(c, matchedBranch, constrCtx, result.defaults) else: - # All bets are off. If any of the branches has a mandatory - # fields we must produce an error: - for i in 1..<n.len: collectMissingFields n[i] + collectBranchFields(c, n, discriminatorVal, constrCtx, flags) of nkSym: let field = n.sym let e = semConstrField(c, flags, field, constrCtx.initExpr) - result = if e != nil: initFull else: initNone - + if e != nil: + result.status = initFull + elif field.ast != nil: + if efIgnoreDefaults notin flags: + result.status = initUnknown + result.defaults.add newTree(nkExprColonExpr, n, field.ast) + else: + result.status = initNone + else: + if {efWantNoDefaults, efIgnoreDefaults} * flags == {}: # cannot compute defaults at the typeRightPass + let defaultExpr = defaultNodeField(c, n, constrCtx.checkDefault) + if defaultExpr != nil: + result.status = initUnknown + result.defaults.add newTree(nkExprColonExpr, n, defaultExpr) + else: + result.status = initNone + else: + result.status = initNone else: internalAssert c.config, false proc semConstructTypeAux(c: PContext, constrCtx: var ObjConstrContext, - flags: TExprFlags): InitStatus = - result = initUnknown + flags: TExprFlags): tuple[status: InitStatus, defaults: seq[PNode]] = + result = (initUnknown, @[]) var t = constrCtx.typ while true: - let status = semConstructFields(c, t.n, constrCtx, flags) - mergeInitStatus(result, status) + let (status, defaults) = semConstructFields(c, t.n, constrCtx, flags) + result.status.mergeInitStatus status + result.defaults.add defaults if status in {initPartial, initNone, initUnknown}: - collectMissingFields c, t.n, constrCtx - let base = t[0] - if base == nil: break + discard collectMissingFields(c, t.n, constrCtx, result.defaults) + let base = t.baseClass + if base == nil or base.id == t.id or + base.kind in {tyRef, tyPtr} and base.elementType.id == t.id: + break t = skipTypes(base, skipPtrs) if t.kind != tyObject: # XXX: This is not supposed to happen, but apparently @@ -351,60 +436,70 @@ proc initConstrContext(t: PType, initExpr: PNode): ObjConstrContext = proc computeRequiresInit(c: PContext, t: PType): bool = assert t.kind == tyObject var constrCtx = initConstrContext(t, newNode(nkObjConstr)) - let initResult = semConstructTypeAux(c, constrCtx, {}) + let initResult = semConstructTypeAux(c, constrCtx, {efWantNoDefaults}) constrCtx.missingFields.len > 0 proc defaultConstructionError(c: PContext, t: PType, info: TLineInfo) = var objType = t while objType.kind notin {tyObject, tyDistinct}: - objType = objType.lastSon + objType = objType.last assert objType != nil if objType.kind == tyObject: var constrCtx = initConstrContext(objType, newNodeI(nkObjConstr, info)) - let initResult = semConstructTypeAux(c, constrCtx, {}) - 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)]) + let initResult = semConstructTypeAux(c, constrCtx, {efIgnoreDefaults}) + if constrCtx.missingFields.len > 0: + localError(c.config, info, + "The $1 type doesn't have a default value. The following fields must be initialized: $2." % [typeToString(t), listSymbolNames(constrCtx.missingFields)]) elif objType.kind == tyDistinct: localError(c.config, info, - "The $1 distinct type doesn't have a default value.", [typeToString(t)]) + "The $1 distinct type doesn't have a default value." % typeToString(t)) else: assert false, "Must not enter here." -proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = +proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode = var t = semTypeNode(c, n[0], nil) result = newNodeIT(nkObjConstr, n.info, t) - for child in n: result.add child + for i in 0..<n.len: + result.add n[i] if t == nil: - localError(c.config, n.info, errGenerated, "object constructor needs an object type") - return + return localErrorNode(c, result, "object constructor needs an object type") + + if t.skipTypes({tyGenericInst, + tyAlias, tySink, tyOwned, tyRef}).kind != tyObject and + expectedType != nil and expectedType.skipTypes({tyGenericInst, + tyAlias, tySink, tyOwned, tyRef}).kind == tyObject: + t = expectedType t = skipTypes(t, {tyGenericInst, tyAlias, tySink, tyOwned}) if t.kind == tyRef: - t = skipTypes(t[0], {tyGenericInst, tyAlias, tySink, tyOwned}) + t = skipTypes(t.elementType, {tyGenericInst, tyAlias, tySink, tyOwned}) if optOwnedRefs in c.config.globalOptions: result.typ = makeVarType(c, result.typ, tyOwned) # we have to watch out, there are also 'owned proc' types that can be used # multiple times as long as they don't have closures. result.typ.flags.incl tfHasOwned if t.kind != tyObject: - localError(c.config, n.info, errGenerated, "object constructor needs an object type") - return + return localErrorNode(c, result, if t.kind != tyGenericBody: + "object constructor needs an object type".dup(addTypeNodeDeclaredLoc(c.config, t)) + else: "cannot instantiate: '" & + typeToString(t, preferDesc) & + "'; the object's generic parameters cannot be inferred and must be explicitly given" + ) # Check if the object is fully initialized by recursively testing each # field (if this is a case object, initialized fields in two different # branches will be reported as an error): var constrCtx = initConstrContext(t, result) - let initResult = semConstructTypeAux(c, constrCtx, flags) + let (initResult, defaults) = semConstructTypeAux(c, constrCtx, flags) + var hasError = false # needed to split error detect/report for better msgs # It's possible that the object was not fully initialized while # specifying a .requiresInit. pragma: if constrCtx.missingFields.len > 0: + hasError = true localError(c.config, result.info, - "The $1 type requires the following fields to be initialized: $2.", + "The $1 type requires the following fields to be initialized: $2." % [t.sym.name.s, listSymbolNames(constrCtx.missingFields)]) # Since we were traversing the object fields, it's possible that @@ -415,6 +510,7 @@ proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = if nfSem notin field.flags: if field.kind != nkExprColonExpr: invalidObjConstr(c, field) + hasError = true continue let id = considerQuotedIdent(c, field[0]) # This node was not processed. There are two possible reasons: @@ -423,10 +519,18 @@ proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = let prevId = considerQuotedIdent(c, result[j][0]) if prevId.id == id.id: localError(c.config, field.info, errFieldInitTwice % id.s) - return + hasError = true + break # 2) No such field exists in the constructed type - localError(c.config, field.info, errUndeclaredFieldX % id.s) - return + let msg = errUndeclaredField % id.s & " for type " & getProcHeader(c.config, t.sym) + localError(c.config, field.info, msg) + hasError = true + break + + result.sons.add defaults if initResult == initFull: incl result.flags, nfAllFieldsSet + + # wrap in an error see #17437 + if hasError: result = errorNode(c, result) diff --git a/compiler/semparallel.nim b/compiler/semparallel.nim index b5b0be91b..23a8e6362 100644 --- a/compiler/semparallel.nim +++ b/compiler/semparallel.nim @@ -25,8 +25,8 @@ import ast, astalgo, idents, lowerings, magicsys, guards, msgs, renderer, types, modulegraphs, options, spawn, lineinfos -from trees import getMagic, isTrue, getRoot -from strutils import `%` +from trees import getMagic, getRoot +from std/strutils import `%` discard """ @@ -77,12 +77,12 @@ type graph: ModuleGraph proc initAnalysisCtx(g: ModuleGraph): AnalysisCtx = - result.locals = @[] - result.slices = @[] - result.args = @[] + result = AnalysisCtx(locals: @[], + slices: @[], + args: @[], + graph: g) result.guards.s = @[] result.guards.g = g - result.graph = g proc lookupSlot(c: AnalysisCtx; s: PSym): int = for i in 0..<c.locals.len: @@ -184,7 +184,10 @@ proc stride(c: AnalysisCtx; n: PNode): BiggestInt = let s = c.lookupSlot(n.sym) if s >= 0 and c.locals[s].stride != nil: result = c.locals[s].stride.intVal + else: + result = 0 else: + result = 0 for i in 0..<n.safeLen: result += stride(c, n[i]) proc subStride(c: AnalysisCtx; n: PNode): PNode = @@ -323,7 +326,7 @@ proc analyseIf(c: var AnalysisCtx; n: PNode) = proc analyse(c: var AnalysisCtx; n: PNode) = case n.kind - of nkAsgn, nkFastAsgn: + of nkAsgn, nkFastAsgn, nkSinkAsgn: let y = n[1].skipConv if n[0].isSingleAssignable and y.isLocal: let slot = c.getSlot(y.sym) @@ -402,6 +405,9 @@ proc transformSlices(g: ModuleGraph; idgen: IdGenerator; n: PNode): PNode = let op = n[0].sym if op.name.s == "[]" and op.fromSystem: result = copyNode(n) + var typ = newType(tyOpenArray, idgen, result.typ.owner) + typ.add result.typ.elementType + result.typ = typ let opSlice = newSymNode(createMagic(g, idgen, "slice", mSlice)) opSlice.typ = getSysType(g, n.info, tyInt) result.add opSlice @@ -435,16 +441,16 @@ proc transformSpawn(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n, barrier: if result.isNil: result = newNodeI(nkStmtList, n.info) result.add n - let t = b[1][0].typ[0] + let t = b[1][0].typ.returnType if spawnResult(t, true) == srByVar: result.add wrapProcForSpawn(g, idgen, owner, m, b.typ, barrier, it[0]) it[^1] = newNodeI(nkEmpty, it.info) else: it[^1] = wrapProcForSpawn(g, idgen, owner, m, b.typ, barrier, nil) if result.isNil: result = n - of nkAsgn, nkFastAsgn: + of nkAsgn, nkFastAsgn, nkSinkAsgn: let b = n[1] - if getMagic(b) == mSpawn and (let t = b[1][0].typ[0]; + if getMagic(b) == mSpawn and (let t = b[1][0].typ.returnType; spawnResult(t, true) == srByVar): let m = transformSlices(g, idgen, b) return wrapProcForSpawn(g, idgen, owner, m, b.typ, barrier, n[0]) @@ -460,10 +466,10 @@ proc transformSpawn(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n, barrier: result = n proc checkArgs(a: var AnalysisCtx; n: PNode) = - discard "too implement" + discard "to implement" proc generateAliasChecks(a: AnalysisCtx; result: PNode) = - discard "too implement" + discard "to implement" proc liftParallel*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n: PNode): PNode = # this needs to be called after the 'for' loop elimination @@ -483,7 +489,7 @@ proc liftParallel*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n: PNode): P checkArgs(a, body) var varSection = newNodeI(nkVarSection, n.info) - var temp = newSym(skTemp, getIdent(g.cache, "barrier"), nextSymId idgen, owner, n.info) + var temp = newSym(skTemp, getIdent(g.cache, "barrier"), idgen, owner, n.info) temp.typ = magicsys.getCompilerProc(g, "Barrier").typ incl(temp.flags, sfFromGeneric) let tempNode = newSymNode(temp) diff --git a/compiler/sempass2.nim b/compiler/sempass2.nim index f269afe4c..0a160897f 100644 --- a/compiler/sempass2.nim +++ b/compiler/sempass2.nim @@ -8,9 +8,15 @@ # import - intsets, ast, astalgo, msgs, renderer, magicsys, types, idents, trees, - wordrecg, strutils, options, guards, lineinfos, semfold, semdata, - modulegraphs, varpartitions, typeallowed, nilcheck + ast, astalgo, msgs, renderer, magicsys, types, idents, trees, + wordrecg, options, guards, lineinfos, semfold, semdata, + modulegraphs, varpartitions, typeallowed, nilcheck, errorhandling, + semstrictfuncs, suggestsymdb, pushpoppragmas + +import std/[tables, intsets, strutils, sequtils] + +when defined(nimPreviewSlimSystem): + import std/assertions when defined(useDfa): import dfa @@ -60,32 +66,69 @@ discard """ """ type + CaughtExceptionsStack = object + nodes: seq[seq[PType]] TEffects = object exc: PNode # stack of exceptions + when defined(nimsuggest): + caughtExceptions: CaughtExceptionsStack tags: PNode # list of tags - bottom, inTryStmt, inExceptOrFinallyStmt, leftPartOfAsgn: int + forbids: PNode # list of tags + bottom, inTryStmt, inExceptOrFinallyStmt, leftPartOfAsgn, inIfStmt, currentBlock: int owner: PSym ownerModule: PSym init: seq[int] # list of initialized variables + scopes: Table[int, int] # maps var-id to its scope (see also `currentBlock`). guards: TModel # nested guards locked: seq[PNode] # locked locations gcUnsafe, isRecursive, isTopLevel, hasSideEffect, inEnforcedGcSafe: bool - hasDangerousAssign, isInnerProc: bool + isInnerProc: bool inEnforcedNoSideEffects: bool - maxLockLevel, currLockLevel: TLockLevel currOptions: TOptions + optionsStack: seq[(TOptions, TNoteKinds)] config: ConfigRef graph: ModuleGraph c: PContext + escapingParams: IntSet PEffects = var TEffects -proc `<`(a, b: TLockLevel): bool {.borrow.} -proc `<=`(a, b: TLockLevel): bool {.borrow.} -proc `==`(a, b: TLockLevel): bool {.borrow.} -proc max(a, b: TLockLevel): TLockLevel {.borrow.} +const + errXCannotBeAssignedTo = "'$1' cannot be assigned to" + errLetNeedsInit = "'let' symbol requires an initialization" + +proc getObjDepth(t: PType): (int, ItemId) = + var x = t + result = (-1, default(ItemId)) + var stack = newSeq[ItemId]() + while x != nil: + x = skipTypes(x, skipPtrs) + if x.kind != tyObject: + return (-3, default(ItemId)) + stack.add x.itemId + x = x.baseClass + inc(result[0]) + result[1] = stack[^2] + +proc collectObjectTree(graph: ModuleGraph, n: PNode) = + for section in n: + if section.kind == nkTypeDef and section[^1].kind in {nkObjectTy, nkRefTy, nkPtrTy} and section[^1].typ != nil: + let typ = section[^1].typ.skipTypes(skipPtrs) + if typ.kind == tyObject and typ.baseClass != nil: + let (depthLevel, root) = getObjDepth(typ) + if depthLevel != -3: + if depthLevel == 1: + graph.objectTree[root] = @[] + else: + if root notin graph.objectTree: + graph.objectTree[root] = @[(depthLevel, typ)] + else: + graph.objectTree[root].add (depthLevel, typ) proc createTypeBoundOps(tracked: PEffects, typ: PType; info: TLineInfo) = - if typ == nil: return + if typ == nil or sfGeneratedOp in tracked.owner.flags: + # don't create type bound ops for anything in a function with a `nodestroy` pragma + # bug #21987 + return when false: let realType = typ.skipTypes(abstractInst) if realType.kind == tyRef and @@ -97,38 +140,16 @@ proc createTypeBoundOps(tracked: PEffects, typ: PType; info: TLineInfo) = optSeqDestructors in tracked.config.globalOptions: tracked.owner.flags.incl sfInjectDestructors -proc isLocalVar(a: PEffects, s: PSym): bool = - # and (s.kind != skParam or s.typ.kind == tyOut) - s.kind in {skVar, skResult} and sfGlobal notin s.flags and - s.owner == a.owner and s.typ != nil - -proc getLockLevel(t: PType): TLockLevel = - var t = t - # tyGenericInst(TLock {tyGenericBody}, tyStatic, tyObject): - if t.kind == tyGenericInst and t.len == 3: t = t[1] - if t.kind == tyStatic and t.n != nil and t.n.kind in {nkCharLit..nkInt64Lit}: - result = t.n.intVal.TLockLevel +proc isLocalSym(a: PEffects, s: PSym): bool = + s.typ != nil and (s.kind in {skLet, skVar, skResult} or (s.kind == skParam and isOutParam(s.typ))) and + sfGlobal notin s.flags and s.owner == a.owner proc lockLocations(a: PEffects; pragma: PNode) = if pragma.kind != nkExprColonExpr: localError(a.config, pragma.info, "locks pragma without argument") return - var firstLL = TLockLevel(-1'i16) for x in pragma[1]: - let thisLL = getLockLevel(x.typ) - if thisLL != 0.TLockLevel: - if thisLL < 0.TLockLevel or thisLL > MaxLockLevel.TLockLevel: - localError(a.config, x.info, "invalid lock level: " & $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") - 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") - a.currLockLevel = firstLL proc guardGlobal(a: PEffects; n: PNode; guard: PSym) = # check whether the corresponding lock is held: @@ -137,7 +158,7 @@ proc guardGlobal(a: PEffects; n: PNode; guard: PSym) = # we allow accesses nevertheless in top level statements for # easier initialization: #if a.isTopLevel: - # message(n.info, warnUnguardedAccess, renderTree(n)) + # message(a.config, n.info, warnUnguardedAccess, renderTree(n)) #else: if not a.isTopLevel: localError(a.config, n.info, "unguarded access: " & renderTree(n)) @@ -184,23 +205,54 @@ proc makeVolatile(a: PEffects; s: PSym) {.inline.} = if a.inTryStmt > 0 and a.config.exc == excSetjmp: incl(s.flags, sfVolatile) +proc varDecl(a: PEffects; n: PNode) {.inline.} = + if n.kind == nkSym: + a.scopes[n.sym.id] = a.currentBlock + +proc skipHiddenDeref(n: PNode): PNode {.inline.} = + result = if n.kind == nkHiddenDeref: n[0] else: n + proc initVar(a: PEffects, n: PNode; volatileCheck: bool) = + let n = skipHiddenDeref(n) if n.kind != nkSym: return let s = n.sym - if isLocalVar(a, s): + if isLocalSym(a, s): if volatileCheck: makeVolatile(a, s) for x in a.init: - if x == s.id: return + if x == s.id: + if strictDefs in a.c.features and s.kind == skLet: + localError(a.config, n.info, errXCannotBeAssignedTo % + renderTree(n, {renderNoComments} + )) + return a.init.add s.id + if a.scopes.getOrDefault(s.id) == a.currentBlock: + #[ Consider this case: + + var x: T + while true: + if cond: + x = T() #1 + else: + x = T() #2 + use x + + Even though both #1 and #2 are first writes we must use the `=copy` + here so that the old value is destroyed because `x`'s destructor is + run outside of the while loop. This is why we need the check here that + the assignment is done in the same logical block as `x` was declared in. + ]# + n.flags.incl nfFirstWrite proc initVarViaNew(a: PEffects, n: PNode) = + let n = skipHiddenDeref(n) if n.kind != nkSym: return let s = n.sym if {tfRequiresInit, tfNotNil} * s.typ.flags <= {tfNotNil}: # 'x' is not nil, but that doesn't mean its "not nil" children # are initialized: initVar(a, n, volatileCheck=true) - elif isLocalVar(a, s): + elif isLocalSym(a, s): makeVolatile(a, s) proc warnAboutGcUnsafe(n: PNode; conf: ConfigRef) = @@ -219,16 +271,24 @@ proc markGcUnsafe(a: PEffects; reason: PNode) = if reason.kind == nkSym: a.owner.gcUnsafetyReason = reason.sym else: - a.owner.gcUnsafetyReason = newSym(skUnknown, a.owner.name, nextSymId a.c.idgen, + a.owner.gcUnsafetyReason = newSym(skUnknown, a.owner.name, a.c.idgen, a.owner, reason.info, {}) -when true: - template markSideEffect(a: PEffects; reason: typed) = - if not a.inEnforcedNoSideEffects: a.hasSideEffect = true -else: - template markSideEffect(a: PEffects; reason: typed) = - if not a.inEnforcedNoSideEffects: a.hasSideEffect = true - markGcUnsafe(a, reason) +proc markSideEffect(a: PEffects; reason: PNode | PSym; useLoc: TLineInfo) = + if not a.inEnforcedNoSideEffects: + a.hasSideEffect = true + if a.owner.kind in routineKinds: + var sym: PSym + when reason is PNode: + if reason.kind == nkSym: + sym = reason.sym + else: + let kind = if reason.kind == nkHiddenDeref: skParam else: skUnknown + sym = newSym(kind, a.owner.name, a.c.idgen, a.owner, reason.info, {}) + else: + sym = reason + 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 @@ -236,16 +296,26 @@ proc listGcUnsafety(s: PSym; onlyWarning: bool; cycleCheck: var IntSet; conf: Co let msgKind = if onlyWarning: warnGcUnsafe2 else: errGenerated case u.kind of skLet, skVar: - 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]) + 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]) + 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]) + if u.kind == skMethod and {sfBase, sfThread} * u.flags == {sfBase}: + message(conf, u.info, msgKind, + "Base method '$#' requires explicit '{.gcsafe.}' to be GC-safe" % + [u.name.s]) + else: + 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 '$#'" % @@ -258,6 +328,31 @@ 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) + if context.sideEffects.hasKey(s.id): + for (useLineInfo, u) in context.sideEffects[s.id]: + if u != nil and not cycleCheck.containsOrIncl(u.id): + 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) + 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) + of skParam, skForVar: + addHint("calls routine via hidden pointer indirection", useLineInfo, s.name.s) + else: + addHint("calls routine via pointer indirection", useLineInfo, s.name.s) + +proc listSideEffects(result: var string; s: PSym; conf: ConfigRef; context: PContext) = + var cycleCheck = initIntSet() + result.addf("'$#' can have side effects\n", s.name.s) + listSideEffects(result, s, cycleCheck, conf, context, 1) + proc useVarNoInitCheck(a: PEffects; n: PNode; s: PSym) = if {sfGlobal, sfThread} * s.flags != {} and s.kind in {skVar, skLet} and s.magic != mNimvm: @@ -266,9 +361,7 @@ proc useVarNoInitCheck(a: PEffects; n: PNode; s: PSym) = (tfHasGCedMem in s.typ.flags or s.typ.isGCedMem): #if a.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n) markGcUnsafe(a, s) - markSideEffect(a, s) - else: - markSideEffect(a, s) + markSideEffect(a, s, n.info) if s.owner != a.owner and s.kind in {skVar, skLet, skForVar, skResult, skParam} and {sfGlobal, sfThread} * s.flags == {}: a.isInnerProc = true @@ -277,7 +370,7 @@ proc useVar(a: PEffects, n: PNode) = let s = n.sym if a.inExceptOrFinallyStmt > 0: incl s.flags, sfUsedInFinallyOrExcept - if isLocalVar(a, s): + if isLocalSym(a, s): if sfNoInit in s.flags: # If the variable is explicitly marked as .noinit. do not emit any error a.init.add s.id @@ -285,32 +378,45 @@ proc useVar(a: PEffects, n: PNode) = if s.typ.requiresInit: message(a.config, n.info, warnProveInit, s.name.s) elif a.leftPartOfAsgn <= 0: - message(a.config, n.info, warnUninit, s.name.s) + if strictDefs in a.c.features: + if s.kind == skLet: + localError(a.config, n.info, errLetNeedsInit) + else: + message(a.config, n.info, warnUninit, s.name.s) # prevent superfluous warnings about the same variable: a.init.add s.id useVarNoInitCheck(a, n, s) +type + BreakState = enum + bsNone + bsBreakOrReturn + bsNoReturn type TIntersection = seq[tuple[id, count: int]] # a simple count table -proc addToIntersection(inter: var TIntersection, s: int) = +proc addToIntersection(inter: var TIntersection, s: int, state: BreakState) = for j in 0..<inter.len: if s == inter[j].id: - inc inter[j].count + if state == bsNone: + inc inter[j].count return - inter.add((id: s, count: 1)) + if state == bsNone: + inter.add((id: s, count: 1)) + else: + inter.add((id: s, count: 0)) proc throws(tracked, n, orig: PNode) = if n.typ == nil or n.typ.kind != tyError: if orig != nil: - let x = copyNode(n) - x.info = orig.info + let x = copyTree(orig) + x.typ = n.typ tracked.add x else: tracked.add n -proc getEbase(g: ModuleGraph; info: TLineInfo): PType = +proc getEbase*(g: ModuleGraph; info: TLineInfo): PType = result = g.sysTypeFromName(info, "Exception") proc excType(g: ModuleGraph; n: PNode): PType = @@ -329,7 +435,7 @@ proc createTag(g: ModuleGraph; n: PNode): PNode = if not n.isNil: result.info = n.info proc addRaiseEffect(a: PEffects, e, comesFrom: PNode) = - assert e.kind != nkRaiseStmt + #assert e.kind != nkRaiseStmt var aa = a.exc for i in a.bottom..<aa.len: # we only track the first node that can have the effect E in order @@ -337,7 +443,7 @@ proc addRaiseEffect(a: PEffects, e, comesFrom: PNode) = if sameType(a.graph.excType(aa[i]), a.graph.excType(e)): return if e.typ != nil: - if optNimV1Emulation in a.config.globalOptions or not isDefectException(e.typ): + if not isDefectException(e.typ): throws(a.exc, e, comesFrom) proc addTag(a: PEffects, e, comesFrom: PNode) = @@ -348,6 +454,12 @@ proc addTag(a: PEffects, e, comesFrom: PNode) = if sameType(aa[i].typ.skipTypes(skipPtrs), e.typ.skipTypes(skipPtrs)): return throws(a.tags, e, comesFrom) +proc addNotTag(a: PEffects, e, comesFrom: PNode) = + var aa = a.forbids + for i in 0..<aa.len: + if sameType(aa[i].typ.skipTypes(skipPtrs), e.typ.skipTypes(skipPtrs)): return + throws(a.forbids, e, comesFrom) + proc mergeRaises(a: PEffects, b, comesFrom: PNode) = if b.isNil: addRaiseEffect(a, createRaise(a.graph, comesFrom), comesFrom) @@ -363,8 +475,7 @@ proc mergeTags(a: PEffects, b, comesFrom: PNode) = 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)) - #if a.maxLockLevel != 0: - # message(e.info, hintUser, "lockLevel: " & a.maxLockLevel) + for e in items(a.forbids): message(a.config, e.info, hintUser, typeToString(e.typ)) proc catches(tracked: PEffects, e: PType) = let e = skipTypes(e, skipPtrs) @@ -386,6 +497,18 @@ proc catchesAll(tracked: PEffects) = if tracked.exc.len > 0: setLen(tracked.exc.sons, tracked.bottom) +proc push(s: var CaughtExceptionsStack) = + s.nodes.add(@[]) + +proc pop(s: var CaughtExceptionsStack) = + s.nodes.del(high(s.nodes)) + +proc addCatch(s: var CaughtExceptionsStack, e: PType) = + s.nodes[high(s.nodes)].add(e) + +proc addCatchAll(s: var CaughtExceptionsStack) = + s.nodes[high(s.nodes)].add(nil) + proc track(tracked: PEffects, n: PNode) proc trackTryStmt(tracked: PEffects, n: PNode) = let oldBottom = tracked.bottom @@ -394,11 +517,32 @@ proc trackTryStmt(tracked: PEffects, n: PNode) = let oldState = tracked.init.len var inter: TIntersection = @[] + when defined(nimsuggest): + tracked.caughtExceptions.push + for i in 1..<n.len: + let b = n[i] + if b.kind == nkExceptBranch: + if b.len == 1: + tracked.caughtExceptions.addCatchAll + else: + for j in 0..<b.len - 1: + if b[j].isInfixAs(): + assert(b[j][1].kind == nkType) + tracked.caughtExceptions.addCatch(b[j][1].typ) + else: + assert(b[j].kind == nkType) + tracked.caughtExceptions.addCatch(b[j].typ) + else: + assert b.kind == nkFinally + inc tracked.inTryStmt track(tracked, n[0]) dec tracked.inTryStmt for i in oldState..<tracked.init.len: - addToIntersection(inter, tracked.init[i]) + addToIntersection(inter, tracked.init[i], bsNone) + + when defined(nimsuggest): + tracked.caughtExceptions.pop var branches = 1 var hasFinally = false @@ -427,9 +571,13 @@ proc trackTryStmt(tracked: PEffects, n: PNode) = let b = n[i] if b.kind == nkExceptBranch: setLen(tracked.init, oldState) + for j in 0..<b.len - 1: + if b[j].isInfixAs(): # skips initialization checks + assert(b[j][2].kind == nkSym) + tracked.init.add b[j][2].sym.id track(tracked, b[^1]) for i in oldState..<tracked.init.len: - addToIntersection(inter, tracked.init[i]) + addToIntersection(inter, tracked.init[i], bsNone) else: setLen(tracked.init, oldState) track(tracked, b[^1]) @@ -442,16 +590,24 @@ proc trackTryStmt(tracked: PEffects, n: PNode) = for id, count in items(inter): if count == branches: tracked.init.add id -proc isIndirectCall(n: PNode, owner: PSym): bool = +proc isIndirectCall(tracked: PEffects; n: PNode): bool = # we don't count f(...) as an indirect call if 'f' is an parameter. # Instead we track expressions of type tyProc too. See the manual for # details: if n.kind != nkSym: result = true elif n.sym.kind == skParam: - result = owner != n.sym.owner or owner == nil + if laxEffects notin tracked.c.config.legacyFeatures: + if tracked.owner == n.sym.owner and sfEffectsDelayed in n.sym.flags: + result = false # it is not a harmful call + else: + result = true + else: + result = tracked.owner != n.sym.owner or tracked.owner == nil elif n.sym.kind notin routineKinds: result = true + else: + result = false proc isForwardedProc(n: PNode): bool = result = n.kind == nkSym and sfForward in n.sym.flags @@ -460,9 +616,16 @@ proc trackPragmaStmt(tracked: PEffects, n: PNode) = for i in 0..<n.len: var it = n[i] let pragma = whichPragma(it) - if pragma == wEffects: + case pragma + of wEffects: # list the computed effects up to here: listEffects(tracked) + of wPush: + processPushBackendOption(tracked.c.config, tracked.optionsStack, tracked.currOptions, n, i+1) + of wPop: + processPopBackendOption(tracked.c.config, tracked.optionsStack, tracked.currOptions) + else: + discard template notGcSafe(t): untyped = {tfGcSafe, tfNoSideEffect} * t.flags == {} @@ -470,25 +633,6 @@ proc importedFromC(n: PNode): bool = # when imported from C, we assume GC-safety. result = n.kind == nkSym and sfImportc in n.sym.flags -proc getLockLevel(s: PSym): TLockLevel = - result = s.typ.lockLevel - if result == UnspecifiedLockLevel: - if {sfImportc, sfNoSideEffect} * s.flags != {} or - tfNoSideEffect in s.typ.flags: - result = 0.TLockLevel - else: - result = UnknownLockLevel - #message(s.info, warnUser, "FOR THIS " & s.name.s) - -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 - tracked.maxLockLevel = max(tracked.maxLockLevel, lockLevel) - proc propagateEffects(tracked: PEffects, n: PNode, s: PSym) = let pragma = s.ast[pragmasPos] let spec = effectSpec(pragma, wRaises) @@ -501,14 +645,14 @@ proc propagateEffects(tracked: PEffects, n: PNode, s: PSym) = if tracked.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n, tracked.config) markGcUnsafe(tracked, s) if tfNoSideEffect notin s.typ.flags: - markSideEffect(tracked, s) - mergeLockLevels(tracked, n, s.getLockLevel) + markSideEffect(tracked, s, n.info) proc procVarCheck(n: PNode; conf: ConfigRef) = if n.kind in nkSymChoices: 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) + localError(conf, n.info, ("'$1' is a built-in and cannot be used as " & + "a first-class procedure") % n.sym.name.s) proc notNilCheck(tracked: PEffects, n: PNode, paramType: PType) = let n = n.skipConv @@ -520,7 +664,7 @@ proc notNilCheck(tracked: PEffects, n: PNode, paramType: PType) = if paramType != nil and tfNotNil in paramType.flags and n.typ != nil: let ntyp = n.typ.skipTypesOrNil({tyVar, tyLent, tySink}) if ntyp != nil and tfNotNil notin ntyp.flags: - if isAddrNode(n): + if n.kind in {nkAddr, nkHiddenAddr}: # addr(x[]) can't be proven, but addr(x) can: if not containsNode(n, {nkDerefExpr, nkHiddenDeref}): return elif (n.kind == nkSym and n.sym.kind in routineKinds) or @@ -541,28 +685,32 @@ proc notNilCheck(tracked: PEffects, n: PNode, paramType: PType) = proc assumeTheWorst(tracked: PEffects; n: PNode; op: PType) = addRaiseEffect(tracked, createRaise(tracked.graph, n), nil) addTag(tracked, createTag(tracked.graph, n), nil) - let lockLevel = if op.lockLevel == UnspecifiedLockLevel: UnknownLockLevel - else: op.lockLevel - #if lockLevel == UnknownLockLevel: - # message(n.info, warnUser, "had to assume the worst here") - mergeLockLevels(tracked, n, lockLevel) -proc isOwnedProcVar(n: PNode; owner: PSym): bool = +proc isOwnedProcVar(tracked: PEffects; n: PNode): bool = # XXX prove the soundness of this effect system rule - result = n.kind == nkSym and n.sym.kind == skParam and owner == n.sym.owner + result = n.kind == nkSym and n.sym.kind == skParam and + tracked.owner == n.sym.owner + #if result and sfPolymorphic notin n.sym.flags: + # echo tracked.config $ n.info, " different here!" + if laxEffects notin tracked.c.config.legacyFeatures: + result = result and sfEffectsDelayed in n.sym.flags proc isNoEffectList(n: PNode): bool {.inline.} = assert n.kind == nkEffectList - n.len == 0 or (n[tagEffects] == nil and n[exceptionEffects] == nil) + n.len == 0 or (n[tagEffects] == nil and n[exceptionEffects] == nil and n[forbiddenEffects] == nil) proc isTrival(caller: PNode): bool {.inline.} = result = caller.kind == nkSym and caller.sym.magic in {mEqProc, mIsNil, mMove, mWasMoved, mSwap} -proc trackOperandForIndirectCall(tracked: PEffects, n: PNode, paramType: PType; caller: PNode) = +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 formals.n != nil and argIndex < formals.n.len: formals.n[argIndex].sym else: nil # assume indirect calls are taken here: - if op != nil and op.kind == tyProc and n.skipConv.kind != nkNilLit and not isTrival(caller): + 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 laxEffects in tracked.c.config.legacyFeatures): + internalAssert tracked.config, op.n[0].kind == nkEffectList var effectList = op.n[0] var s = n.skipConv @@ -575,15 +723,15 @@ proc trackOperandForIndirectCall(tracked: PEffects, n: PNode, paramType: PType; # we have no explicit effects but it's a forward declaration and so it's # stated there are no additional effects, so simply propagate them: propagateEffects(tracked, n, n.sym) - elif not isOwnedProcVar(a, tracked.owner): + elif not isOwnedProcVar(tracked, a): # we have no explicit effects so assume the worst: assumeTheWorst(tracked, n, op) # assume GcUnsafe unless in its type; 'forward' does not matter: - if notGcSafe(op) and not isOwnedProcVar(a, tracked.owner): + if notGcSafe(op) and not isOwnedProcVar(tracked, a): if tracked.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n, tracked.config) markGcUnsafe(tracked, a) - elif tfNoSideEffect notin op.flags and not isOwnedProcVar(a, tracked.owner): - markSideEffect(tracked, a) + elif tfNoSideEffect notin op.flags and not isOwnedProcVar(tracked, a): + markSideEffect(tracked, a, n.info) else: mergeRaises(tracked, effectList[exceptionEffects], n) mergeTags(tracked, effectList[tagEffects], n) @@ -591,10 +739,11 @@ proc trackOperandForIndirectCall(tracked: PEffects, n: PNode, paramType: PType; if tracked.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n, tracked.config) markGcUnsafe(tracked, a) elif tfNoSideEffect notin op.flags: - markSideEffect(tracked, a) + markSideEffect(tracked, a, n.info) + let paramType = if formals != nil and argIndex < formals.signatureLen: formals[argIndex] else: nil if paramType != nil and paramType.kind in {tyVar}: invalidateFacts(tracked.guards, n) - if n.kind == nkSym and isLocalVar(tracked, n.sym): + if n.kind == nkSym and isLocalSym(tracked, n.sym): makeVolatile(tracked, n.sym) if paramType != nil and paramType.kind == tyProc and tfGcSafe in paramType.flags: let argtype = skipTypes(a.typ, abstractInst) @@ -604,26 +753,66 @@ proc trackOperandForIndirectCall(tracked: PEffects, n: PNode, paramType: PType; localError(tracked.config, n.info, $n & " is not GC safe") notNilCheck(tracked, n, paramType) -proc breaksBlock(n: PNode): bool = + +proc breaksBlock(n: PNode): BreakState = # semantic check doesn't allow statements after raise, break, return or # call to noreturn proc, so it is safe to check just the last statements var it = n while it.kind in {nkStmtList, nkStmtListExpr} and it.len > 0: it = it.lastSon - result = it.kind in {nkBreakStmt, nkReturnStmt, nkRaiseStmt} or - it.kind in nkCallKinds and it[0].kind == nkSym and sfNoReturn in it[0].sym.flags + case it.kind + of nkBreakStmt, nkReturnStmt: + result = bsBreakOrReturn + of nkRaiseStmt: + result = bsNoReturn + of nkCallKinds: + if it[0].kind == nkSym and sfNoReturn in it[0].sym.flags: + result = bsNoReturn + else: + result = bsNone + else: + result = bsNone + +proc addIdToIntersection(tracked: PEffects, inter: var TIntersection, resCounter: var int, + hasBreaksBlock: BreakState, oldState: int, resSym: PSym, hasResult: bool) = + if hasResult: + var alreadySatisfy = false + + if hasBreaksBlock == bsNoReturn: + alreadySatisfy = true + inc resCounter + + for i in oldState..<tracked.init.len: + if tracked.init[i] == resSym.id: + if not alreadySatisfy: + inc resCounter + alreadySatisfy = true + else: + addToIntersection(inter, tracked.init[i], hasBreaksBlock) + else: + for i in oldState..<tracked.init.len: + addToIntersection(inter, tracked.init[i], hasBreaksBlock) + +template hasResultSym(s: PSym): bool = + s != nil and s.kind in {skProc, skFunc, skConverter, skMethod} and + not isEmptyType(s.typ.returnType) proc trackCase(tracked: PEffects, n: PNode) = track(tracked, n[0]) + inc tracked.inIfStmt let oldState = tracked.init.len let oldFacts = tracked.guards.s.len let stringCase = n[0].typ != nil and skipTypes(n[0].typ, - abstractVarRange-{tyTypeDesc}).kind in {tyFloat..tyFloat128, tyString} + abstractVarRange-{tyTypeDesc}).kind in {tyFloat..tyFloat128, tyString, tyCstring} let interesting = not stringCase and interestingCaseExpr(n[0]) and - tracked.config.hasWarn(warnProveField) + (tracked.config.hasWarn(warnProveField) or strictCaseObjects in tracked.c.features) var inter: TIntersection = @[] var toCover = 0 + let hasResult = hasResultSym(tracked.owner) + let resSym = if hasResult: tracked.owner.ast[resultPos].sym else: nil + var resCounter = 0 + for i in 1..<n.len: let branch = n[i] setLen(tracked.init, oldState) @@ -632,29 +821,39 @@ proc trackCase(tracked: PEffects, n: PNode) = addCaseBranchFacts(tracked.guards, n, i) for i in 0..<branch.len: track(tracked, branch[i]) - if not breaksBlock(branch.lastSon): inc toCover - for i in oldState..<tracked.init.len: - addToIntersection(inter, tracked.init[i]) + let hasBreaksBlock = breaksBlock(branch.lastSon) + if hasBreaksBlock == bsNone: + inc toCover + addIdToIntersection(tracked, inter, resCounter, hasBreaksBlock, oldState, resSym, hasResult) setLen(tracked.init, oldState) if not stringCase or lastSon(n).kind == nkElse: + if hasResult and resCounter == n.len-1: + tracked.init.add resSym.id for id, count in items(inter): if count >= toCover: tracked.init.add id # else we can't merge setLen(tracked.guards.s, oldFacts) + dec tracked.inIfStmt proc trackIf(tracked: PEffects, n: PNode) = track(tracked, n[0][0]) + inc tracked.inIfStmt let oldFacts = tracked.guards.s.len addFact(tracked.guards, n[0][0]) let oldState = tracked.init.len + let hasResult = hasResultSym(tracked.owner) + let resSym = if hasResult: tracked.owner.ast[resultPos].sym else: nil + var resCounter = 0 + var inter: TIntersection = @[] var toCover = 0 track(tracked, n[0][1]) - if not breaksBlock(n[0][1]): inc toCover - for i in oldState..<tracked.init.len: - addToIntersection(inter, tracked.init[i]) + let hasBreaksBlock = breaksBlock(n[0][1]) + if hasBreaksBlock == bsNone: + inc toCover + addIdToIntersection(tracked, inter, resCounter, hasBreaksBlock, oldState, resSym, hasResult) for i in 1..<n.len: let branch = n[i] @@ -666,15 +865,20 @@ proc trackIf(tracked: PEffects, n: PNode) = setLen(tracked.init, oldState) for i in 0..<branch.len: track(tracked, branch[i]) - if not breaksBlock(branch.lastSon): inc toCover - for i in oldState..<tracked.init.len: - addToIntersection(inter, tracked.init[i]) + let hasBreaksBlock = breaksBlock(branch.lastSon) + if hasBreaksBlock == bsNone: + inc toCover + addIdToIntersection(tracked, inter, resCounter, hasBreaksBlock, oldState, resSym, hasResult) + setLen(tracked.init, oldState) if lastSon(n).len == 1: + if hasResult and resCounter == n.len: + tracked.init.add resSym.id for id, count in items(inter): if count >= toCover: tracked.init.add id # else we can't merge as it is not exhaustive setLen(tracked.guards.s, oldFacts) + dec tracked.inIfStmt proc trackBlock(tracked: PEffects, n: PNode) = if n.kind in {nkStmtList, nkStmtListExpr}: @@ -692,11 +896,8 @@ proc trackBlock(tracked: PEffects, n: PNode) = else: track(tracked, n) -proc paramType(op: PType, i: int): PType = - if op != nil and i < op.len: result = op[i] - proc cstringCheck(tracked: PEffects; n: PNode) = - if n[0].typ.kind == tyCString and (let a = skipConv(n[1]); + if n[0].typ.kind == tyCstring and (let a = skipConv(n[1]); a.typ.kind == tyString and a.kind notin {nkStrLit..nkTripleStrLit}): message(tracked.config, n.info, warnUnsafeCode, renderTree(n)) @@ -738,6 +939,42 @@ 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 checkForSink(tracked: PEffects; n: PNode) = + if tracked.inIfStmt == 0 and optSinkInference in tracked.config.options: + checkForSink(tracked.config, tracked.c.idgen, tracked.owner, n) + +proc markCaughtExceptions(tracked: PEffects; g: ModuleGraph; info: TLineInfo; s: PSym; usageSym: var PSym) = + when defined(nimsuggest): + proc internalMarkCaughtExceptions(tracked: PEffects; q: var SuggestFileSymbolDatabase; info: TLineInfo) = + var si = q.findSymInfoIndex(info) + if si != -1: + q.caughtExceptionsSet[si] = true + for w1 in tracked.caughtExceptions.nodes: + for w2 in w1: + q.caughtExceptions[si].add(w2) + + if optIdeExceptionInlayHints in tracked.config.globalOptions: + internalMarkCaughtExceptions(tracked, g.suggestSymbols.mgetOrPut(info.fileIndex, newSuggestFileSymbolDatabase(info.fileIndex, true)), info) + proc trackCall(tracked: PEffects; n: PNode) = template gcsafeAndSideeffectCheck() = if notGcSafe(op) and not importedFromC(a): @@ -748,8 +985,7 @@ proc trackCall(tracked: PEffects; n: PNode) = 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): - markSideEffect(tracked, a) - + markSideEffect(tracked, a, n.info) # p's effects are ours too: var a = n[0] #if canRaise(a): @@ -758,7 +994,16 @@ proc trackCall(tracked: PEffects; n: PNode) = if n.typ != nil: if tracked.owner.kind != skMacro and n.typ.skipTypes(abstractVar).kind != tyOpenArray: createTypeBoundOps(tracked, n.typ, n.info) - if getConstExpr(tracked.ownerModule, n, tracked.c.idgen, tracked.graph) == nil: + + when defined(nimsuggest): + var actualLoc = a.info + if n.kind == nkHiddenCallConv: + actualLoc = n.info + if a.kind == nkSym: + markCaughtExceptions(tracked, tracked.graph, actualLoc, a.sym, tracked.graph.usageSym) + + let notConstExpr = getConstExpr(tracked.ownerModule, n, tracked.c.idgen, tracked.graph) == nil + if notConstExpr: if a.kind == nkCast and a[1].typ.kind == tyProc: a = a[1] # XXX: in rare situations, templates and macros will reach here after @@ -769,30 +1014,37 @@ proc trackCall(tracked: PEffects; n: PNode) = if a.kind == nkSym: if a.sym == tracked.owner: tracked.isRecursive = true # even for recursive calls we need to check the lock levels (!): - mergeLockLevels(tracked, n, a.sym.getLockLevel) - if sfSideEffect in a.sym.flags: markSideEffect(tracked, a) + if sfSideEffect in a.sym.flags: markSideEffect(tracked, a, n.info) else: - mergeLockLevels(tracked, n, op.lockLevel) + discard var effectList = op.n[0] if a.kind == nkSym and a.sym.kind == skMethod: + if {sfBase, sfThread} * a.sym.flags == {sfBase}: + if tracked.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n, tracked.config) + markGcUnsafe(tracked, a) propagateEffects(tracked, n, a.sym) elif isNoEffectList(effectList): if isForwardedProc(a): propagateEffects(tracked, n, a.sym) - elif isIndirectCall(a, tracked.owner): + elif isIndirectCall(tracked, a): assumeTheWorst(tracked, n, op) gcsafeAndSideeffectCheck() + else: + if laxEffects notin tracked.c.config.legacyFeatures and a.kind == nkSym and + a.sym.kind in routineKinds: + propagateEffects(tracked, n, a.sym) else: mergeRaises(tracked, effectList[exceptionEffects], n) mergeTags(tracked, effectList[tagEffects], n) gcsafeAndSideeffectCheck() - if a.kind != nkSym or a.sym.magic != mNBindSym: - for i in 1..<n.len: trackOperandForIndirectCall(tracked, n[i], paramType(op, i), a) + if a.kind != nkSym or a.sym.magic notin {mNBindSym, mFinished, mExpandToAst, mQuoteAst}: + for i in 1..<n.len: + trackOperandForIndirectCall(tracked, n[i], op, i, a) if a.kind == nkSym and a.sym.magic in {mNew, mNewFinalize, mNewSeq}: # may not look like an assignment, but it is: let arg = n[1] initVarViaNew(tracked, arg) - if arg.typ.len != 0 and {tfRequiresInit} * arg.typ.lastSon.flags != {}: + if arg.typ.hasElementType and {tfRequiresInit} * arg.typ.elementType.flags != {}: if a.sym.magic == mNewSeq and n[2].kind in {nkCharLit..nkUInt64Lit} and n[2].intVal == 0: # var s: seq[notnil]; newSeq(s, 0) is a special case! @@ -801,8 +1053,8 @@ proc trackCall(tracked: PEffects; n: PNode) = message(tracked.config, arg.info, warnProveInit, $arg) # check required for 'nim check': - if n[1].typ.len > 0: - createTypeBoundOps(tracked, n[1].typ.lastSon, n.info) + if n[1].typ.hasElementType: + createTypeBoundOps(tracked, n[1].typ.elementType, n.info) createTypeBoundOps(tracked, n[1].typ, n.info) # new(x, finalizer): Problem: how to move finalizer into 'createTypeBoundOps'? @@ -810,9 +1062,6 @@ proc trackCall(tracked: PEffects; n: PNode) = optStaticBoundsCheck in tracked.currOptions: checkBounds(tracked, n[1], n[2]) - if a.kind != nkSym or a.sym.magic != mRunnableExamples: - for i in 0..<n.safeLen: - track(tracked, n[i]) if a.kind == nkSym and a.sym.name.s.len > 0 and a.sym.name.s[0] == '=' and tracked.owner.kind != skMacro: @@ -828,33 +1077,47 @@ proc trackCall(tracked: PEffects; n: PNode) = n[0].sym = op if op != nil and op.kind == tyProc: - for i in 1..<min(n.safeLen, op.len): - case op[i].kind + for i in 1..<min(n.safeLen, op.signatureLen): + let paramType = op[i] + case paramType.kind of tySink: - createTypeBoundOps(tracked, op[i][0], n.info) - checkForSink(tracked.config, tracked.c.idgen, tracked.owner, n[i]) + createTypeBoundOps(tracked, paramType.elementType, n.info) + checkForSink(tracked, n[i]) of tyVar: - tracked.hasDangerousAssign = true - #of tyOut: - # consider this case: p(out x, x); we want to remark that 'x' is not - # initialized until after the call. Since we do this after we analysed the - # call, this is fine. - # initVar(tracked, n[i].skipAddr, false) + if isOutParam(paramType): + # consider this case: p(out x, x); we want to remark that 'x' is not + # initialized until after the call. Since we do this after we analysed the + # call, this is fine. + initVar(tracked, n[i].skipHiddenAddr, false) + if strictFuncs in tracked.c.features and not tracked.inEnforcedNoSideEffects and + isDangerousLocation(n[i].skipHiddenAddr, tracked.owner): + if sfNoSideEffect in tracked.owner.flags: + localError(tracked.config, n[i].info, + "cannot pass $1 to `var T` parameter within a strict func" % renderTree(n[i])) + tracked.hasSideEffect = true else: discard + if notConstExpr and (a.kind != nkSym or + a.sym.magic notin {mRunnableExamples, mNBindSym, mExpandToAst, mQuoteAst} + ): + # tracked after out analysis + for i in 0..<n.safeLen: + track(tracked, n[i]) + type PragmaBlockContext = object oldLocked: int - oldLockLevel: TLockLevel enforcedGcSafety, enforceNoSideEffects: bool - oldExc, oldTags: int - exc, tags: PNode + oldExc, oldTags, oldForbids: int + exc, tags, forbids: PNode proc createBlockContext(tracked: PEffects): PragmaBlockContext = + var oldForbidsLen = 0 + if tracked.forbids != nil: oldForbidsLen = tracked.forbids.len result = PragmaBlockContext(oldLocked: tracked.locked.len, - oldLockLevel: tracked.currLockLevel, enforcedGcSafety: false, enforceNoSideEffects: false, - oldExc: tracked.exc.len, oldTags: tracked.tags.len) + oldExc: tracked.exc.len, oldTags: tracked.tags.len, + oldForbids: oldForbidsLen) proc applyBlockContext(tracked: PEffects, bc: PragmaBlockContext) = if bc.enforcedGcSafety: tracked.inEnforcedGcSafe = true @@ -864,7 +1127,6 @@ proc unapplyBlockContext(tracked: PEffects; bc: PragmaBlockContext) = if bc.enforcedGcSafety: tracked.inEnforcedGcSafe = false if bc.enforceNoSideEffects: tracked.inEnforcedNoSideEffects = false setLen(tracked.locked, bc.oldLocked) - tracked.currLockLevel = bc.oldLockLevel if bc.exc != nil: # beware that 'raises: []' is very different from not saying # anything about 'raises' in the 'cast' at all. Same applies for 'tags'. @@ -875,6 +1137,10 @@ proc unapplyBlockContext(tracked: PEffects; bc: PragmaBlockContext) = setLen(tracked.tags.sons, bc.oldTags) for t in bc.tags: addTag(tracked, t, t) + if bc.forbids != nil: + setLen(tracked.forbids.sons, bc.oldForbids) + for t in bc.forbids: + addNotTag(tracked, t, t) proc castBlock(tracked: PEffects, pragma: PNode, bc: var PragmaBlockContext) = case whichPragma(pragma) @@ -889,6 +1155,13 @@ proc castBlock(tracked: PEffects, pragma: PNode, bc: var PragmaBlockContext) = else: bc.tags = newNodeI(nkArgList, pragma.info) bc.tags.add n + of wForbids: + let n = pragma[1] + if n.kind in {nkCurly, nkBracket}: + bc.forbids = n + else: + bc.forbids = newNodeI(nkArgList, pragma.info) + bc.forbids.add n of wRaises: let n = pragma[1] if n.kind in {nkCurly, nkBracket}: @@ -896,10 +1169,40 @@ proc castBlock(tracked: PEffects, pragma: PNode, bc: var PragmaBlockContext) = else: bc.exc = newNodeI(nkArgList, pragma.info) bc.exc.add n + of wUncheckedAssign: + discard "handled in sempass1" else: localError(tracked.config, pragma.info, "invalid pragma block: " & $pragma) +proc trackInnerProc(tracked: PEffects, n: PNode) = + case n.kind + of nkSym: + let s = n.sym + if s.kind == skParam and s.owner == tracked.owner: + tracked.escapingParams.incl s.id + of nkNone..pred(nkSym), succ(nkSym)..nkNilLit: + discard + of nkProcDef, nkConverterDef, nkMethodDef, nkIteratorDef, nkLambda, nkFuncDef, nkDo: + if n[0].kind == nkSym and n[0].sym.ast != nil: + trackInnerProc(tracked, getBody(tracked.graph, n[0].sym)) + of nkTypeSection, nkMacroDef, nkTemplateDef, nkError, + nkConstSection, nkConstDef, nkIncludeStmt, nkImportStmt, + nkExportStmt, nkPragma, nkCommentStmt, nkBreakState, + nkTypeOfExpr, nkMixinStmt, nkBindStmt: + discard + else: + for ch in n: trackInnerProc(tracked, ch) + +proc allowCStringConv(n: PNode): bool = + case n.kind + of nkStrLit..nkTripleStrLit: result = true + of nkSym: result = n.sym.kind in {skConst, skParam} + of nkAddr: result = isCharArrayPtr(n.typ, true) + of nkCallKinds: + result = isCharArrayPtr(n.typ, n[0].kind == nkSym and n[0].sym.magic == mAddr) + else: result = isCharArrayPtr(n.typ, false) + proc track(tracked: PEffects, n: PNode) = case n.kind of nkSym: @@ -907,9 +1210,10 @@ proc track(tracked: PEffects, n: PNode) = if n.sym.typ != nil and tfHasAsgn in n.sym.typ.flags: tracked.owner.flags.incl sfInjectDestructors # bug #15038: ensure consistency - if not hasDestructor(n.typ) and sameType(n.typ, n.sym.typ): n.typ = n.sym.typ + if n.typ == nil or (not hasDestructor(n.typ) and sameType(n.typ, n.sym.typ)): n.typ = n.sym.typ of nkHiddenAddr, nkAddr: - if n[0].kind == nkSym and isLocalVar(tracked, n[0].sym): + if n[0].kind == nkSym and isLocalSym(tracked, n[0].sym) and + n.typ.kind notin {tyVar, tyLent}: useVarNoInitCheck(tracked, n[0], n[0].sym) else: track(tracked, n[0]) @@ -917,7 +1221,7 @@ proc track(tracked: PEffects, n: PNode) = if n[0].kind != nkEmpty: n[0].info = n.info #throws(tracked.exc, n[0]) - addRaiseEffect(tracked, n[0], nil) + addRaiseEffect(tracked, n[0], n) for i in 0..<n.safeLen: track(tracked, n[i]) createTypeBoundOps(tracked, n[0].typ, n.info) @@ -930,14 +1234,17 @@ proc track(tracked: PEffects, n: PNode) = trackCall(tracked, n) of nkDotExpr: guardDotAccess(tracked, n) + let oldLeftPartOfAsgn = tracked.leftPartOfAsgn + tracked.leftPartOfAsgn = 0 for i in 0..<n.len: track(tracked, n[i]) + tracked.leftPartOfAsgn = oldLeftPartOfAsgn of nkCheckedFieldExpr: track(tracked, n[0]) - if tracked.config.hasWarn(warnProveField): - checkFieldAccess(tracked.guards, n, tracked.config) + if tracked.config.hasWarn(warnProveField) or strictCaseObjects in tracked.c.features: + checkFieldAccess(tracked.guards, n, tracked.config, strictCaseObjects in tracked.c.features) of nkTryStmt: trackTryStmt(tracked, n) of nkPragma: trackPragmaStmt(tracked, n) - of nkAsgn, nkFastAsgn: + of nkAsgn, nkFastAsgn, nkSinkAsgn: track(tracked, n[1]) initVar(tracked, n[0], volatileCheck=true) invalidateFacts(tracked.guards, n[0]) @@ -947,12 +1254,16 @@ proc track(tracked: PEffects, n: PNode) = addAsgnFact(tracked.guards, n[0], n[1]) notNilCheck(tracked, n[1], n[0].typ) when false: cstringCheck(tracked, n) - if tracked.owner.kind != skMacro: + if tracked.owner.kind != skMacro and n[0].typ.kind notin {tyOpenArray, tyVarargs}: createTypeBoundOps(tracked, n[0].typ, n.info) - if n[0].kind != nkSym or not isLocalVar(tracked, n[0].sym): - checkForSink(tracked.config, tracked.c.idgen, tracked.owner, n[1]) - if not tracked.hasDangerousAssign and n[0].kind != nkSym: - tracked.hasDangerousAssign = true + if n[0].kind != nkSym or not isLocalSym(tracked, n[0].sym): + checkForSink(tracked, n[1]) + if strictFuncs in tracked.c.features and not tracked.inEnforcedNoSideEffects and + isDangerousLocation(n[0], tracked.owner): + tracked.hasSideEffect = true + if sfNoSideEffect in tracked.owner.flags: + localError(tracked.config, n[0].info, + "cannot mutate location $1 within a strict func" % renderTree(n[0])) of nkVarSection, nkLetSection: for child in n: let last = lastSon(child) @@ -963,18 +1274,23 @@ proc track(tracked: PEffects, n: PNode) = for i in 0..<child.len-2: createTypeBoundOps(tracked, child[i].typ, child.info) else: - createTypeBoundOps(tracked, child[0].typ, child.info) - if child.kind == nkIdentDefs and last.kind != nkEmpty: + createTypeBoundOps(tracked, skipPragmaExpr(child[0]).typ, child.info) + if child.kind == nkIdentDefs: for i in 0..<child.len-2: - initVar(tracked, child[i], volatileCheck=false) - addAsgnFact(tracked.guards, child[i], last) - notNilCheck(tracked, last, child[i].typ) - elif child.kind == nkVarTuple and last.kind != nkEmpty: + let a = skipPragmaExpr(child[i]) + varDecl(tracked, a) + if last.kind != nkEmpty: + initVar(tracked, a, volatileCheck=false) + addAsgnFact(tracked.guards, a, last) + notNilCheck(tracked, last, a.typ) + elif child.kind == nkVarTuple: for i in 0..<child.len-1: if child[i].kind == nkEmpty or - child[i].kind == nkSym and child[i].sym.name.s == "_": + child[i].kind == nkSym and child[i].sym.name.id == ord(wUnderscore): continue - initVar(tracked, child[i], volatileCheck=false) + varDecl(tracked, child[i]) + if last.kind != nkEmpty: + initVar(tracked, child[i], volatileCheck=false) if last.kind in {nkPar, nkTupleConstr}: addAsgnFact(tracked.guards, child[i], last[i]) notNilCheck(tracked, last[i], child[i].typ) @@ -989,6 +1305,7 @@ proc track(tracked: PEffects, n: PNode) = of nkBlockStmt, nkBlockExpr: trackBlock(tracked, n[1]) of nkWhileStmt: # 'while true' loop? + inc tracked.currentBlock if isTrue(n[0]): trackBlock(tracked, n[1]) else: @@ -1000,8 +1317,10 @@ proc track(tracked: PEffects, n: PNode) = track(tracked, n[1]) setLen(tracked.init, oldState) setLen(tracked.guards.s, oldFacts) + dec tracked.currentBlock of nkForStmt, nkParForStmt: # we are very conservative here and assume the loop is never executed: + inc tracked.currentBlock let oldState = tracked.init.len let oldFacts = tracked.guards.s.len @@ -1043,6 +1362,8 @@ proc track(tracked: PEffects, n: PNode) = track(tracked, loopBody) setLen(tracked.init, oldState) setLen(tracked.guards.s, oldFacts) + dec tracked.currentBlock + of nkObjConstr: when false: track(tracked, n[0]) let oldFacts = tracked.guards.s.len @@ -1057,24 +1378,25 @@ proc track(tracked: PEffects, n: PNode) = if x.kind == nkExprColonExpr: if x[0].kind == nkSym: notNilCheck(tracked, x[1], x[0].sym.typ) - checkForSink(tracked.config, tracked.c.idgen, tracked.owner, x[1]) + checkForSink(tracked, x[1]) else: - checkForSink(tracked.config, tracked.c.idgen, tracked.owner, x) + checkForSink(tracked, x) setLen(tracked.guards.s, oldFacts) if tracked.owner.kind != skMacro: # XXX n.typ can be nil in runnableExamples, we need to do something about it. if n.typ != nil and n.typ.skipTypes(abstractInst).kind == tyRef: - createTypeBoundOps(tracked, n.typ.lastSon, n.info) + createTypeBoundOps(tracked, n.typ.elementType, n.info) createTypeBoundOps(tracked, n.typ, n.info) of nkTupleConstr: for i in 0..<n.len: track(tracked, n[i]) + notNilCheck(tracked, n[i].skipColon, n[i].typ) if tracked.owner.kind != skMacro: if n[i].kind == nkExprColonExpr: createTypeBoundOps(tracked, n[i][0].typ, n.info) else: createTypeBoundOps(tracked, n[i].typ, n.info) - checkForSink(tracked.config, tracked.c.idgen, tracked.owner, n[i]) + checkForSink(tracked, n[i]) of nkPragmaBlock: let pragmaList = n[0] var bc = createBlockContext(tracked) @@ -1095,15 +1417,39 @@ proc track(tracked: PEffects, n: PNode) = track(tracked, n.lastSon) unapplyBlockContext(tracked, bc) - of nkTypeSection, nkProcDef, nkConverterDef, nkMethodDef, nkIteratorDef, - nkMacroDef, nkTemplateDef, nkLambda, nkDo, nkFuncDef: + of nkProcDef, nkConverterDef, nkMethodDef, nkIteratorDef, nkLambda, nkFuncDef, nkDo: + if n[0].kind == nkSym and n[0].sym.ast != nil: + trackInnerProc(tracked, getBody(tracked.graph, n[0].sym)) + of nkMacroDef, nkTemplateDef: discard + of nkTypeSection: + if tracked.isTopLevel: + collectObjectTree(tracked.graph, n) of nkCast: if n.len == 2: track(tracked, n[1]) if tracked.owner.kind != skMacro: createTypeBoundOps(tracked, n.typ, n.info) of nkHiddenStdConv, nkHiddenSubConv, nkConv: + if n.kind in {nkHiddenStdConv, nkHiddenSubConv} and + n.typ.skipTypes(abstractInst).kind == tyCstring and + not allowCStringConv(n[1]): + message(tracked.config, n.info, warnCstringConv, + "implicit conversion to 'cstring' from a non-const location: $1; this will become a compile time error in the future" % + $n[1]) + if n.typ.skipTypes(abstractInst).kind == tyCstring and + isCharArrayPtr(n[1].typ, true): + message(tracked.config, n.info, warnPtrToCstringConv, + $n[1].typ) + + + let t = n.typ.skipTypes(abstractInst) + if t.kind == tyEnum: + if tfEnumHasHoles in t.flags: + message(tracked.config, n.info, warnHoleEnumConv, "conversion to enum with holes is unsafe: $1" % $n) + else: + message(tracked.config, n.info, warnAnyEnumConv, "enum conversion: $1" % $n) + if n.len == 2: track(tracked, n[1]) if tracked.owner.kind != skMacro: @@ -1125,7 +1471,7 @@ proc track(tracked: PEffects, n: PNode) = of nkBracket: for i in 0..<n.safeLen: track(tracked, n[i]) - checkForSink(tracked.config, tracked.c.idgen, tracked.owner, n[i]) + checkForSink(tracked, n[i]) if tracked.owner.kind != skMacro: createTypeBoundOps(tracked, n.typ, n.info) of nkBracketExpr: @@ -1136,20 +1482,23 @@ proc track(tracked: PEffects, n: PNode) = dec tracked.leftPartOfAsgn for i in 1 ..< n.len: track(tracked, n[i]) inc tracked.leftPartOfAsgn + of nkError: + localError(tracked.config, n.info, errorToString(tracked.config, n)) else: for i in 0..<n.safeLen: track(tracked, n[i]) proc subtypeRelation(g: ModuleGraph; spec, real: PNode): bool = if spec.typ.kind == tyOr: - for t in spec.typ.sons: + result = false + for t in spec.typ.kids: if safeInheritanceDiff(g.excType(real), t) <= 0: return true else: return safeInheritanceDiff(g.excType(real), spec.typ) <= 0 -proc checkRaisesSpec(g: ModuleGraph; spec, real: PNode, msg: string, hints: bool; +proc checkRaisesSpec(g: ModuleGraph; emitWarnings: bool; spec, real: PNode, msg: string, hints: bool; effectPredicate: proc (g: ModuleGraph; a, b: PNode): bool {.nimcall.}; - hintsArg: PNode = nil) = + hintsArg: PNode = nil; isForbids: bool = false) = # check that any real exception is listed in 'spec'; mark those as used; # report any unused exception var used = initIntSet() @@ -1157,11 +1506,17 @@ proc checkRaisesSpec(g: ModuleGraph; spec, real: PNode, msg: string, hints: bool block search: for s in 0..<spec.len: if effectPredicate(g, spec[s], r): + if isForbids: break used.incl(s) break search + if isForbids: + break search # XXX call graph analysis would be nice here! pushInfoContext(g.config, spec.info) - localError(g.config, r.info, errGenerated, msg & typeToString(r.typ)) + var rr = if r.kind == nkRaiseStmt: r[0] else: r + while rr.kind in {nkStmtList, nkStmtListExpr} and rr.len > 0: rr = rr.lastSon + message(g.config, r.info, if emitWarnings: warnEffect else: errGenerated, + renderTree(rr) & " " & msg & typeToString(r.typ)) popInfoContext(g.config) # hint about unnecessarily listed exception types: if hints: @@ -1178,12 +1533,16 @@ proc checkMethodEffects*(g: ModuleGraph; disp, branch: PSym) = let p = disp.ast[pragmasPos] let raisesSpec = effectSpec(p, wRaises) if not isNil(raisesSpec): - checkRaisesSpec(g, raisesSpec, actual[exceptionEffects], + checkRaisesSpec(g, false, raisesSpec, actual[exceptionEffects], "can raise an unlisted exception: ", hints=off, subtypeRelation) let tagsSpec = effectSpec(p, wTags) if not isNil(tagsSpec): - checkRaisesSpec(g, tagsSpec, actual[tagEffects], + checkRaisesSpec(g, false, tagsSpec, actual[tagEffects], "can have an unlisted effect: ", hints=off, subtypeRelation) + let forbidsSpec = effectSpec(p, wForbids) + if not isNil(forbidsSpec): + checkRaisesSpec(g, false, forbidsSpec, actual[tagEffects], + "has an illegal effect: ", hints=off, subtypeRelation, isForbids=true) if sfThread in disp.flags and notGcSafe(branch.typ): localError(g.config, branch.info, "base method is GC-safe, but '$1' is not" % branch.name.s) @@ -1192,18 +1551,7 @@ proc checkMethodEffects*(g: ModuleGraph; disp, branch: PSym) = localError(g.config, branch.info, "for method '" & branch.name.s & "' the `.requires` or `.ensures` properties are incompatible.") - if branch.typ.lockLevel > 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]) - else: - # XXX make this an error after bigbreak has been released: - localError(g.config, branch.info, - "base method has lock level $1, but dispatcher has $2" % - [$branch.typ.lockLevel, $disp.typ.lockLevel]) - -proc setEffectsForProcType*(g: ModuleGraph; t: PType, n: PNode) = +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: @@ -1212,9 +1560,20 @@ proc setEffectsForProcType*(g: ModuleGraph; t: PType, n: PNode) = let raisesSpec = effectSpec(n, wRaises) if not isNil(raisesSpec): effects[exceptionEffects] = raisesSpec + elif s != nil and (s.magic != mNone or {sfImportc, sfExportc} * s.flags == {sfImportc}): + effects[exceptionEffects] = newNodeI(nkArgList, effects.info) + let tagsSpec = effectSpec(n, wTags) if not isNil(tagsSpec): effects[tagEffects] = tagsSpec + elif s != nil and (s.magic != mNone or {sfImportc, sfExportc} * s.flags == {sfImportc}): + effects[tagEffects] = newNodeI(nkArgList, effects.info) + + let forbidsSpec = effectSpec(n, wForbids) + if not isNil(forbidsSpec): + effects[forbiddenEffects] = forbidsSpec + elif s != nil and (s.magic != mNone or {sfImportc, sfExportc} * s.flags == {sfImportc}): + effects[forbiddenEffects] = newNodeI(nkArgList, effects.info) let requiresSpec = propSpec(n, wRequires) if not isNil(requiresSpec): @@ -1224,56 +1583,62 @@ proc setEffectsForProcType*(g: ModuleGraph; t: PType, n: PNode) = effects[ensuresEffects] = ensuresSpec effects[pragmasEffects] = n + if s != nil and s.magic != mNone: + if s.magic != mEcho: + t.flags.incl tfNoSideEffect -proc initEffects(g: ModuleGraph; effects: PNode; s: PSym; t: var TEffects; c: PContext) = +proc rawInitEffects(g: ModuleGraph; effects: PNode) = newSeq(effects.sons, effectListLen) - effects[exceptionEffects] = newNodeI(nkArgList, s.info) - effects[tagEffects] = newNodeI(nkArgList, s.info) + effects[exceptionEffects] = newNodeI(nkArgList, effects.info) + effects[tagEffects] = newNodeI(nkArgList, effects.info) + effects[forbiddenEffects] = newNodeI(nkArgList, effects.info) effects[requiresEffects] = g.emptyNode effects[ensuresEffects] = g.emptyNode effects[pragmasEffects] = g.emptyNode - t.exc = effects[exceptionEffects] - t.tags = effects[tagEffects] - t.owner = s - t.ownerModule = s.getModule - t.init = @[] - t.guards.s = @[] - t.guards.g = g +proc initEffects(g: ModuleGraph; effects: PNode; s: PSym; c: PContext): TEffects = + rawInitEffects(g, effects) + + result = TEffects(exc: effects[exceptionEffects], tags: effects[tagEffects], + forbids: effects[forbiddenEffects], owner: s, ownerModule: s.getModule, + init: @[], locked: @[], graph: g, config: g.config, c: c, + currentBlock: 1, optionsStack: @[(g.config.options, g.config.notes)] + ) + result.guards.s = @[] + result.guards.g = g when defined(drnim): - t.currOptions = g.config.options + s.options - {optStaticBoundsCheck} + result.currOptions = g.config.options + s.options - {optStaticBoundsCheck} else: - t.currOptions = g.config.options + s.options - t.guards.beSmart = optStaticBoundsCheck in t.currOptions - t.locked = @[] - t.graph = g - t.config = g.config - t.c = c + result.currOptions = g.config.options + s.options + result.guards.beSmart = optStaticBoundsCheck in result.currOptions proc hasRealBody(s: PSym): bool = ## also handles importc procs with runnableExamples, which requires `=`, ## which is not a real implementation, refs #14314 result = {sfForward, sfImportc} * s.flags == {} -proc maybeWrappedInClosure(tracked: PEffects; t: PType): bool {.inline.} = - ## The spec does say when to produce destructors. However, the spec - ## was written in mind with the idea that "lambda lifting" already - ## happened. Not true in our implementation, so we need to workaround - ## here: - result = tracked.isInnerProc and - sfSystemModule notin tracked.c.module.flags and - tfCheckedForDestructor notin t.flags and containsGarbageCollectedRef(t) - proc trackProc*(c: PContext; s: PSym, body: PNode) = let g = c.graph + when defined(nimsuggest): + if g.config.expandDone(): + return var effects = s.typ.n[0] if effects.kind != nkEffectList: return # effects already computed? if not s.hasRealBody: return - if effects.len == effectListLen: return + let emitWarnings = tfEffectSystemWorkaround in s.typ.flags + if effects.len == effectListLen and not emitWarnings: return + + var inferredEffects = newNodeI(nkEffectList, s.info) + + var t: TEffects = initEffects(g, inferredEffects, s, c) + rawInitEffects g, effects + + if not isEmptyType(s.typ.returnType) and + s.kind in {skProc, skFunc, skConverter, skMethod}: + var res = s.ast[resultPos].sym # get result symbol + t.scopes[res.id] = t.currentBlock - var t: TEffects - initEffects(g, effects, s, t, c) track(t, body) if s.kind != skMacro: @@ -1282,33 +1647,50 @@ proc trackProc*(c: PContext; s: PSym, body: PNode) = let param = params[i].sym let typ = param.typ if isSinkTypeForParam(typ) or - (t.config.selectedGC in {gcArc, gcOrc} and - (isClosure(typ.skipTypes(abstractInst)) or maybeWrappedInClosure(t, typ))): + (t.config.selectedGC in {gcArc, gcOrc, gcAtomicArc} and + (isClosure(typ.skipTypes(abstractInst)) or param.id in t.escapingParams)): createTypeBoundOps(t, typ, param.info) - when false: - if typ.kind == tyOut and param.id notin t.init: - message(g.config, param.info, warnProveInit, param.name.s) + if isOutParam(typ) and param.id notin t.init: + message(g.config, param.info, warnProveInit, param.name.s) - if not isEmptyType(s.typ[0]) and - (s.typ[0].requiresInit or s.typ[0].skipTypes(abstractInst).kind == tyVar) and - s.kind in {skProc, skFunc, skConverter, skMethod}: + if not isEmptyType(s.typ.returnType) and + (s.typ.returnType.requiresInit or s.typ.returnType.skipTypes(abstractInst).kind == tyVar or + strictDefs in c.features) and + s.kind in {skProc, skFunc, skConverter, skMethod} and s.magic == mNone: var res = s.ast[resultPos].sym # get result symbol - if res.id notin t.init: - message(g.config, body.info, warnProveInit, "result") + if res.id notin t.init and breaksBlock(body) != bsNoReturn: + if tfRequiresInit in s.typ.returnType.flags: + localError(g.config, body.info, "'$1' requires explicit initialization" % "result") + else: + message(g.config, body.info, warnProveInit, "result") let p = s.ast[pragmasPos] let raisesSpec = effectSpec(p, wRaises) if not isNil(raisesSpec): - checkRaisesSpec(g, raisesSpec, t.exc, "can raise an unlisted exception: ", + let useWarning = s.name.s == "=destroy" + checkRaisesSpec(g, useWarning, raisesSpec, t.exc, "can raise an unlisted exception: ", hints=on, subtypeRelation, hintsArg=s.ast[0]) # after the check, use the formal spec: effects[exceptionEffects] = raisesSpec + else: + effects[exceptionEffects] = t.exc let tagsSpec = effectSpec(p, wTags) if not isNil(tagsSpec): - checkRaisesSpec(g, tagsSpec, t.tags, "can have an unlisted effect: ", + checkRaisesSpec(g, false, tagsSpec, t.tags, "can have an unlisted effect: ", hints=off, subtypeRelation) # after the check, use the formal spec: effects[tagEffects] = tagsSpec + else: + effects[tagEffects] = t.tags + + let forbidsSpec = effectSpec(p, wForbids) + if not isNil(forbidsSpec): + checkRaisesSpec(g, false, forbidsSpec, t.tags, "has an illegal effect: ", + hints=off, subtypeRelation, isForbids=true) + # after the check, use the formal spec: + effects[forbiddenEffects] = forbidsSpec + else: + effects[forbiddenEffects] = t.forbids let requiresSpec = propSpec(p, wRequires) if not isNil(requiresSpec): @@ -1319,15 +1701,9 @@ proc trackProc*(c: PContext; s: PSym, body: PNode) = effects[ensuresEffects] = ensuresSpec var mutationInfo = MutationInfo() - if {strictFuncs, views} * c.features != {}: - var goals: set[Goal] = {} - if strictFuncs in c.features: goals.incl constParameters - if views in c.features: goals.incl borrowChecking - var partitions = computeGraphPartitions(s, body, g, goals) - if not t.hasSideEffect and t.hasDangerousAssign: - t.hasSideEffect = varpartitions.hasSideEffect(partitions, mutationInfo) - if views in c.features: - checkBorrowedLocations(partitions, body, g.config) + if views in c.features: + var partitions = computeGraphPartitions(s, body, g, {borrowChecking}) + checkBorrowedLocations(partitions, body, g.config) if sfThread in s.flags and t.gcUnsafe: if optThreads in g.config.globalOptions and optThreadAnalysis in g.config.globalOptions: @@ -1340,18 +1716,16 @@ proc trackProc*(c: PContext; s: PSym, body: PNode) = when false: listGcUnsafety(s, onlyWarning=false, g.config) else: - localError(g.config, s.info, ("'$1' can have side effects" % s.name.s) & (g.config $ mutationInfo)) + if 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) + else: + localError(g.config, s.info, "") # simple error for `system.compiles` context if not t.gcUnsafe: s.typ.flags.incl tfGcSafe if not t.hasSideEffect and sfSideEffect notin s.flags: s.typ.flags.incl tfNoSideEffect - 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]) when defined(drnim): if c.graph.strongSemCheck != nil: c.graph.strongSemCheck(c.graph, s, body) when defined(useDfa): @@ -1359,18 +1733,22 @@ proc trackProc*(c: PContext; s: PSym, body: PNode) = dataflowAnalysis(s, body) when false: trackWrites(s, body) - if strictNotNil in c.features and s.kind == skProc: + if strictNotNil in c.features and s.kind in {skProc, skFunc, skMethod, skConverter}: checkNil(s, body, g.config, c.idgen) proc trackStmt*(c: PContext; module: PSym; n: PNode, isTopLevel: bool) = - if n.kind in {nkPragma, nkMacroDef, nkTemplateDef, nkProcDef, nkFuncDef, - nkTypeSection, nkConverterDef, nkMethodDef, nkIteratorDef}: - return - let g = c.graph - var effects = newNodeI(nkEffectList, n.info) - var t: TEffects - initEffects(g, effects, module, t, c) - t.isTopLevel = isTopLevel - track(t, n) - when defined(drnim): - if c.graph.strongSemCheck != nil: c.graph.strongSemCheck(c.graph, module, n) + case n.kind + of {nkPragma, nkMacroDef, nkTemplateDef, nkProcDef, nkFuncDef, + nkConverterDef, nkMethodDef, nkIteratorDef}: + discard + of nkTypeSection: + if isTopLevel: + collectObjectTree(c.graph, n) + else: + let g = c.graph + var effects = newNodeI(nkEffectList, n.info) + var t: TEffects = initEffects(g, effects, module, c) + t.isTopLevel = isTopLevel + track(t, n) + when defined(drnim): + if c.graph.strongSemCheck != nil: c.graph.strongSemCheck(c.graph, module, n) diff --git a/compiler/semstmts.nim b/compiler/semstmts.nim index ff8f68ed0..f5f8fea0c 100644 --- a/compiler/semstmts.nim +++ b/compiler/semstmts.nim @@ -36,6 +36,19 @@ const 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" + errCannotAssignToGlobal = "cannot assign local to global variable" + +proc implicitlyDiscardable(n: PNode): bool + +proc hasEmpty(typ: PType): bool = + if typ.kind in {tySequence, tyArray, tySet}: + result = typ.elementType.kind == tyEmpty + elif typ.kind == tyTuple: + result = false + for s in typ.kids: + result = result or hasEmpty(s) + else: + result = false proc semDiscard(c: PContext, n: PNode): PNode = result = n @@ -44,7 +57,9 @@ proc semDiscard(c: PContext, n: PNode): PNode = n[0] = semExprWithType(c, n[0]) let sonType = n[0].typ let sonKind = n[0].kind - if isEmptyType(sonType) or sonType.kind in {tyNone, tyTypeDesc} or sonKind == nkTypeOfExpr: + if isEmptyType(sonType) or hasEmpty(sonType) or + sonType.kind in {tyNone, tyTypeDesc} or + sonKind == nkTypeOfExpr: localError(c.config, n.info, errInvalidDiscard) if sonType.kind == tyProc and sonKind notin nkCallKinds: # tyProc is disallowed to prevent ``discard foo`` to be valid, when ``discard foo()`` is meant. @@ -55,7 +70,7 @@ proc semBreakOrContinue(c: PContext, n: PNode): PNode = checkSonsLen(n, 1, c.config) if n[0].kind != nkEmpty: if n.kind != nkContinueStmt: - var s: PSym + var s: PSym = nil case n[0].kind of nkIdent: s = lookUp(c, n[0]) of nkSym: s = n[0].sym @@ -72,6 +87,8 @@ proc semBreakOrContinue(c: PContext, n: PNode): PNode = localError(c.config, n.info, errInvalidControlFlowX % s.name.s) else: localError(c.config, n.info, errGenerated, "'continue' cannot have a label") + elif c.p.nestedBlockCounter > 0 and n.kind == nkBreakStmt and not c.p.breakInLoop: + localError(c.config, n.info, warnUnnamedBreak) elif (c.p.nestedLoopCounter <= 0) and ((c.p.nestedBlockCounter <= 0) or n.kind == nkContinueStmt): localError(c.config, n.info, errInvalidControlFlowX % renderTree(n, {renderNoComments})) @@ -86,41 +103,170 @@ proc semWhile(c: PContext, n: PNode; flags: TExprFlags): PNode = result = n checkSonsLen(n, 2, c.config) openScope(c) - n[0] = forceBool(c, semExprWithType(c, n[0])) + n[0] = forceBool(c, semExprWithType(c, n[0], expectedType = getSysType(c.graph, n.info, tyBool))) inc(c.p.nestedLoopCounter) + let oldBreakInLoop = c.p.breakInLoop + c.p.breakInLoop = true n[1] = semStmt(c, n[1], flags) + c.p.breakInLoop = oldBreakInLoop dec(c.p.nestedLoopCounter) closeScope(c) if n[1].typ == c.enforceVoidContext: result.typ = c.enforceVoidContext elif efInTypeof in flags: result.typ = n[1].typ + elif implicitlyDiscardable(n[1]): + result[1].typ = c.enforceVoidContext proc semProc(c: PContext, n: PNode): PNode -proc semExprBranch(c: PContext, n: PNode; flags: TExprFlags = {}): PNode = - result = semExpr(c, n, flags) +proc semExprBranch(c: PContext, n: PNode; flags: TExprFlags = {}; expectedType: PType = nil): PNode = + result = semExpr(c, n, flags, expectedType) if result.typ != nil: # XXX tyGenericInst here? if result.typ.kind in {tyVar, tyLent}: result = newDeref(result) -proc semExprBranchScope(c: PContext, n: PNode): PNode = +proc semExprBranchScope(c: PContext, n: PNode; expectedType: PType = nil): PNode = openScope(c) - result = semExprBranch(c, n) + result = semExprBranch(c, n, expectedType = expectedType) closeScope(c) const - skipForDiscardable = {nkIfStmt, nkIfExpr, nkCaseStmt, nkOfBranch, - nkElse, nkStmtListExpr, nkTryStmt, nkFinally, nkExceptBranch, + skipForDiscardable = {nkStmtList, nkStmtListExpr, + nkOfBranch, nkElse, nkFinally, nkExceptBranch, nkElifBranch, nkElifExpr, nkElseExpr, nkBlockStmt, nkBlockExpr, - nkHiddenStdConv, nkHiddenDeref} + nkHiddenStdConv, nkHiddenSubConv, nkHiddenDeref} proc implicitlyDiscardable(n: PNode): bool = - var n = n - while n.kind in skipForDiscardable: n = n.lastSon - result = n.kind in nkLastBlockStmts or - (isCallExpr(n) and n[0].kind == nkSym and - sfDiscardable in n[0].sym.flags) + # same traversal as endsInNoReturn + template checkBranch(branch) = + if not implicitlyDiscardable(branch): + return false + + var it = n + # skip these beforehand, no special handling needed + while it.kind in skipForDiscardable and it.len > 0: + it = it.lastSon + + case it.kind + of nkIfExpr, nkIfStmt: + for branch in it: + checkBranch: + if branch.len == 2: + branch[1] + elif branch.len == 1: + branch[0] + else: + raiseAssert "Malformed `if` statement during implicitlyDiscardable" + # all branches are discardable + result = true + of nkCaseStmt: + for i in 1 ..< it.len: + let branch = it[i] + checkBranch: + case branch.kind + of nkOfBranch: + branch[^1] + of nkElifBranch: + branch[1] + of nkElse: + branch[0] + else: + raiseAssert "Malformed `case` statement in implicitlyDiscardable" + # all branches are discardable + result = true + of nkTryStmt: + checkBranch(it[0]) + for i in 1 ..< it.len: + let branch = it[i] + if branch.kind != nkFinally: + checkBranch(branch[^1]) + # all branches are discardable + result = true + of nkCallKinds: + result = it[0].kind == nkSym and {sfDiscardable, sfNoReturn} * it[0].sym.flags != {} + of nkLastBlockStmts: + result = true + else: + result = false + +proc endsInNoReturn(n: PNode, returningNode: var PNode; discardableCheck = false): bool = + ## check if expr ends the block like raising or call of noreturn procs do + result = false # assume it does return + + template checkBranch(branch) = + if not endsInNoReturn(branch, returningNode, discardableCheck): + # proved a branch returns + return false + + var it = n + # skip these beforehand, no special handling needed + let skips = if discardableCheck: skipForDiscardable else: skipForDiscardable-{nkBlockExpr, nkBlockStmt} + while it.kind in skips and it.len > 0: + it = it.lastSon + + case it.kind + of nkIfExpr, nkIfStmt: + var hasElse = false + for branch in it: + checkBranch: + if branch.len == 2: + branch[1] + elif branch.len == 1: + hasElse = true + branch[0] + else: + raiseAssert "Malformed `if` statement during endsInNoReturn" + # none of the branches returned + result = hasElse # Only truly a no-return when it's exhaustive + of nkCaseStmt: + let caseTyp = skipTypes(it[0].typ, abstractVar-{tyTypeDesc}) + # semCase should already have checked for exhaustiveness in this case + # effectively the same as having an else + var hasElse = caseTyp.shouldCheckCaseCovered() + + # actual noreturn checks + for i in 1 ..< it.len: + let branch = it[i] + checkBranch: + case branch.kind + of nkOfBranch: + branch[^1] + of nkElifBranch: + branch[1] + of nkElse: + hasElse = true + branch[0] + else: + raiseAssert "Malformed `case` statement in endsInNoReturn" + # Can only guarantee a noreturn if there is an else or it's exhaustive + result = hasElse + of nkTryStmt: + checkBranch(it[0]) + var lastIndex = it.len - 1 + if it[lastIndex].kind == nkFinally: + # if finally is noreturn, then the entire statement is noreturn + if endsInNoReturn(it[lastIndex][^1], returningNode, discardableCheck): + return true + dec lastIndex + for i in 1 .. lastIndex: + let branch = it[i] + checkBranch(branch[^1]) + # none of the branches returned + result = true + of nkLastBlockStmts: + result = true + of nkCallKinds: + result = it[0].kind == nkSym and sfNoReturn in it[0].sym.flags + if not result: + returningNode = it + else: + result = false + returningNode = it + +proc endsInNoReturn(n: PNode): bool = + var dummy: PNode = nil + result = endsInNoReturn(n, dummy) proc fixNilType(c: PContext; n: PNode) = if isAtom(n): @@ -138,34 +284,47 @@ proc discardCheck(c: PContext, result: PNode, flags: TExprFlags) = if implicitlyDiscardable(result): var n = newNodeI(nkDiscardStmt, result.info, 1) n[0] = result + # notes that it doesn't transform nodes into discard statements elif result.typ.kind != tyError and c.config.cmd != cmdInteractive: - 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) - -proc semIf(c: PContext, n: PNode; flags: TExprFlags): PNode = + if result.typ.kind == tyNone: + localError(c.config, result.info, "expression has no type: " & + renderTree(result, {renderNoComments})) + else: + # Ignore noreturn procs since they don't have a type + var n = result + if result.endsInNoReturn(n, discardableCheck = true): + return + + var s = "expression '" & $n & "' is of type '" & + result.typ.typeToString & "' and has to be used (or discarded)" + if result.info.line != n.info.line or + 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) + +proc semIf(c: PContext, n: PNode; flags: TExprFlags; expectedType: PType = nil): PNode = result = n var typ = commonTypeBegin + var expectedType = expectedType var hasElse = false for i in 0..<n.len: var it = n[i] if it.len == 2: openScope(c) - it[0] = forceBool(c, semExprWithType(c, it[0])) - it[1] = semExprBranch(c, it[1], flags) + it[0] = forceBool(c, semExprWithType(c, it[0], expectedType = getSysType(c.graph, n.info, tyBool))) + it[1] = semExprBranch(c, it[1], flags, expectedType) typ = commonType(c, typ, it[1]) + if not endsInNoReturn(it[1]): + expectedType = typ closeScope(c) elif it.len == 1: hasElse = true - it[0] = semExprBranchScope(c, it[0]) + it[0] = semExprBranchScope(c, it[0], expectedType) typ = commonType(c, typ, it[0]) + if not endsInNoReturn(it[0]): + expectedType = typ else: illFormedAst(it, c.config) if isEmptyType(typ) or typ.kind in {tyNil, tyUntyped} or (not hasElse and efInTypeof notin flags): @@ -181,7 +340,7 @@ proc semIf(c: PContext, n: PNode; flags: TExprFlags): PNode = result.transitionSonsKind(nkIfExpr) result.typ = typ -proc semTry(c: PContext, n: PNode; flags: TExprFlags): PNode = +proc semTry(c: PContext, n: PNode; flags: TExprFlags; expectedType: PType = nil): PNode = var check = initIntSet() template semExceptBranchType(typeNode: PNode): bool = # returns true if exception type is imported type @@ -191,6 +350,8 @@ proc semTry(c: PContext, n: PNode; flags: TExprFlags): PNode = isImported = true elif not isException(typ): localError(c.config, typeNode.info, errExprCannotBeRaised) + elif not isDefectOrCatchableError(typ): + message(c.config, a.info, warnBareExcept, "catch a more precise Exception deriving from CatchableError or Defect.") if containsOrIncl(check, typ.id): localError(c.config, typeNode.info, errExceptionAlreadyHandled) @@ -198,12 +359,14 @@ proc semTry(c: PContext, n: PNode; flags: TExprFlags): PNode = isImported result = n - inc c.p.inTryStmt checkMinSonsLen(n, 2, c.config) var typ = commonTypeBegin - n[0] = semExprBranchScope(c, n[0]) - typ = commonType(c, typ, n[0].typ) + var expectedType = expectedType + n[0] = semExprBranchScope(c, n[0], expectedType) + if not endsInNoReturn(n[0]): + typ = commonType(c, typ, n[0].typ) + expectedType = typ var last = n.len - 1 var catchAllExcepts = 0 @@ -216,7 +379,7 @@ proc semTry(c: PContext, n: PNode; flags: TExprFlags): PNode = if a.len == 2 and a[0].kind == nkBracket: # rewrite ``except [a, b, c]: body`` -> ```except a, b, c: body``` - a.sons[0..0] = a[0].sons + a.sons[0..0] = move a[0].sons if a.len == 2 and a[0].isInfixAs(): # support ``except Exception as ex: body`` @@ -231,14 +394,15 @@ proc semTry(c: PContext, n: PNode; flags: TExprFlags): PNode = elif a.len == 1: # count number of ``except: body`` blocks inc catchAllExcepts - + message(c.config, a.info, warnBareExcept, + "The bare except clause is deprecated; use `except CatchableError:` instead") else: # support ``except KeyError, ValueError, ... : body`` if catchAllExcepts > 0: # if ``except: body`` already encountered, # cannot be followed by a ``except KeyError, ... : body`` block inc catchAllExcepts - var isNative, isImported: bool + var isNative, isImported: bool = false for j in 0..<a.len-1: let tmp = semExceptBranchType(a[j]) if tmp: isImported = true @@ -260,12 +424,16 @@ proc semTry(c: PContext, n: PNode; flags: TExprFlags): PNode = localError(c.config, a.info, "Only one general except clause is allowed after more specific exceptions") # 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: + a[^1] = semExprBranchScope(c, a[^1], expectedType) + typ = commonType(c, typ, a[^1]) + if not endsInNoReturn(a[^1]): + expectedType = typ + else: + a[^1] = semExprBranchScope(c, a[^1]) + dec last closeScope(c) - dec c.p.inTryStmt if isEmptyType(typ) or typ.kind in {tyNil, tyUntyped}: discardCheck(c, n[0], flags) for i in 1..<n.len: discardCheck(c, n[i].lastSon, flags) @@ -273,7 +441,8 @@ proc semTry(c: PContext, n: PNode; flags: TExprFlags): PNode = result.typ = c.enforceVoidContext else: if n.lastSon.kind == nkFinally: discardCheck(c, n.lastSon.lastSon, flags) - n[0] = fitNode(c, typ, n[0], n[0].info) + if not endsInNoReturn(n[0]): + n[0] = fitNode(c, typ, n[0], n[0].info) for i in 1..last: var it = n[i] let j = it.len-1 @@ -291,6 +460,8 @@ proc fitRemoveHiddenConv(c: PContext, typ: PType, n: PNode): PNode = result.typ = typ if not floatRangeCheck(result.floatVal, typ): localError(c.config, n.info, errFloatToString % [$result.floatVal, typeToString(typ)]) + elif r1.kind == nkSym and typ.skipTypes(abstractRange).kind == tyCstring: + discard "keep nkHiddenStdConv for cstring conversions" else: changeType(c, r1, typ, check=true) result = r1 @@ -298,6 +469,7 @@ proc fitRemoveHiddenConv(c: PContext, typ: PType, n: PNode): PNode = changeType(c, result, typ, check=false) proc findShadowedVar(c: PContext, v: PSym): PSym = + result = nil for scope in localScopesFrom(c, c.currentScope.parent): let shadowed = strTableGet(scope.symbols, v.name) if shadowed != nil and shadowed.kind in skLocalVars: @@ -308,9 +480,9 @@ proc identWithin(n: PNode, s: PIdent): bool = if identWithin(n[i], s): return true result = n.kind == nkSym and n.sym.name.id == s.id -proc semIdentDef(c: PContext, n: PNode, kind: TSymKind): PSym = +proc semIdentDef(c: PContext, n: PNode, kind: TSymKind, reportToNimsuggest = true): PSym = if isTopLevel(c): - result = semIdentWithPragma(c, kind, n, {sfExported}) + result = semIdentWithPragma(c, kind, n, {sfExported}, fromTopLevel = true) incl(result.flags, sfGlobal) #if kind in {skVar, skLet}: # echo "global variable here ", n.info, " ", result.name.s @@ -332,7 +504,8 @@ proc semIdentDef(c: PContext, n: PNode, kind: TSymKind): PSym = discard result = n.info let info = getLineInfo(n) - suggestSym(c.graph, info, result, c.graph.usageSym) + if reportToNimsuggest: + suggestSym(c.graph, info, result, c.graph.usageSym) proc checkNilable(c: PContext; v: PSym) = if {sfGlobal, sfImportc} * v.flags == {sfGlobal} and v.typ.requiresInit: @@ -343,8 +516,12 @@ proc checkNilable(c: PContext; v: PSym) = #include liftdestructors -proc addToVarSection(c: PContext; result: PNode; orig, identDefs: PNode) = - let value = identDefs[^1] +proc addToVarSection(c: PContext; result: var PNode; n: PNode) = + if result.kind != nkStmtList: + result = makeStmtList(result) + result.add n + +proc addToVarSection(c: PContext; result: var PNode; orig, identDefs: PNode) = if result.kind == nkStmtList: let o = copyNode(orig) o.add identDefs @@ -353,9 +530,11 @@ proc addToVarSection(c: PContext; result: PNode; orig, identDefs: PNode) = result.add identDefs proc isDiscardUnderscore(v: PSym): bool = - if v.name.s == "_": + if v.name.id == ord(wUnderscore): v.flags.incl(sfGenSym) result = true + else: + result = false proc semUsing(c: PContext; n: PNode): PNode = result = c.graph.emptyNode @@ -370,7 +549,7 @@ proc semUsing(c: PContext; n: PNode): PNode = let typ = semTypeNode(c, a[^2], nil) for j in 0..<a.len-2: let v = semIdentDef(c, a[j], skParam) - styleCheckDef(c.config, v) + styleCheckDef(c, v) onDef(a[j].info, v) v.typ = typ strTableIncl(c.signatures, v) @@ -380,26 +559,36 @@ proc semUsing(c: PContext; n: PNode): PNode = if a[^1].kind != nkEmpty: localError(c.config, a.info, "'using' sections cannot contain assignments") -proc hasEmpty(typ: PType): bool = - if typ.kind in {tySequence, tyArray, tySet}: - result = typ.lastSon.kind == tyEmpty - elif typ.kind == tyTuple: - for s in typ.sons: - result = result or hasEmpty(s) +proc hasUnresolvedParams(n: PNode; flags: TExprFlags): bool = + result = tfUnresolved in n.typ.flags + when false: + case n.kind + of nkSym: + result = isGenericRoutineStrict(n.sym) + of nkSymChoices: + for ch in n: + if hasUnresolvedParams(ch, flags): + return true + result = false + else: + result = false + if efOperand in flags: + if tfUnresolved notin n.typ.flags: + result = false proc makeDeref(n: PNode): PNode = var t = n.typ if t.kind in tyUserTypeClasses and t.isResolvedUserTypeClass: - t = t.lastSon + t = t.last t = skipTypes(t, {tyGenericInst, tyAlias, tySink, tyOwned}) result = n if t.kind in {tyVar, tyLent}: - result = newNodeIT(nkHiddenDeref, n.info, t[0]) + result = newNodeIT(nkHiddenDeref, n.info, t.elementType) result.add n - t = skipTypes(t[0], {tyGenericInst, tyAlias, tySink, tyOwned}) + t = skipTypes(t.elementType, {tyGenericInst, tyAlias, tySink, tyOwned}) while t.kind in {tyPtr, tyRef}: var a = result - let baseTyp = t.lastSon + let baseTyp = t.elementType result = newNodeIT(nkHiddenDeref, n.info, baseTyp) result.add a t = skipTypes(baseTyp, {tyGenericInst, tyAlias, tySink, tyOwned}) @@ -410,7 +599,7 @@ proc fillPartialObject(c: PContext; n: PNode; typ: PType) = let y = considerQuotedIdent(c, n[1]) let obj = x.typ.skipTypes(abstractPtrs) if obj.kind == tyObject and tfPartial in obj.flags: - let field = newSym(skField, getIdent(c.cache, y.s), nextSymId c.idgen, obj.sym, n[1].info) + let field = newSym(skField, getIdent(c.cache, y.s), c.idgen, obj.sym, n[1].info) field.typ = skipIntLit(typ, c.idgen) field.position = obj.n.len obj.n.add newSymNode(field) @@ -430,58 +619,195 @@ proc setVarType(c: PContext; v: PSym, typ: PType) = "; new type is: " & typeToString(typ, preferDesc)) v.typ = typ -proc semLowerLetVarCustomPragma(c: PContext, a: PNode, n: PNode): PNode = - var b = a[0] - if b.kind == nkPragmaExpr: - if b[1].len != 1: - # we could in future support pragmas w args e.g.: `var foo {.bar:"goo".} = expr` - return nil - let nodePragma = b[1][0] - # see: `singlePragma` - if nodePragma.kind notin {nkIdent, nkAccQuoted}: - return nil - let ident = considerQuotedIdent(c, nodePragma) - var userPragma = strTableGet(c.userPragmas, ident) - if userPragma != nil: return nil - - let w = nodePragma.whichPragma - if n.kind == nkVarSection and w in varPragmas or - n.kind == nkLetSection and w in letPragmas or - n.kind == nkConstSection and w in constPragmas: - return nil - - var amb = false - let sym = searchInScopes(c, ident, amb) - # XXX what if amb is true? - if sym == nil or sfCustomPragma in sym.flags: return nil - # skip if not in scope; skip `template myAttr() {.pragma.}` - let lhs = b[0] - let clash = strTableGet(c.currentScope.symbols, lhs.ident) - if clash != nil: - # refs https://github.com/nim-lang/Nim/issues/8275 - wrongRedefinition(c, lhs.info, lhs.ident.s, clash.info) - - result = newTree(nkCall) - doAssert nodePragma.kind in {nkIdent, nkAccQuoted}, $nodePragma.kind - result.add nodePragma - result.add lhs - if a[1].kind != nkEmpty: - result.add a[1] +proc isPossibleMacroPragma(c: PContext, it: PNode, key: PNode): bool = + # make sure it's not a normal pragma, and calls an identifier + # considerQuotedIdent below will fail on non-identifiers + result = whichPragma(it) == wInvalid and key.kind in nkIdentKinds+{nkDotExpr} + if result: + # make sure it's not a user pragma + if key.kind != nkDotExpr: + let ident = considerQuotedIdent(c, key) + result = strTableGet(c.userPragmas, ident) == nil + if result: + # make sure it's not a custom pragma + let sym = qualifiedLookUp(c, key, {}) + result = sym == nil or sfCustomPragma notin sym.flags + +proc copyExcept(n: PNode, i: int): PNode = + result = copyNode(n) + for j in 0..<n.len: + if j != i: result.add(n[j]) + +proc semVarMacroPragma(c: PContext, a: PNode, n: PNode): PNode = + # Mirrored with semProcAnnotation + result = nil + # a, b {.prag.}: int = 3 not allowed + const lhsPos = 0 + if a.len == 3 and a[lhsPos].kind == nkPragmaExpr: + var b = a[lhsPos] + const + namePos = 0 + pragmaPos = 1 + let pragmas = b[pragmaPos] + for i in 0 ..< pragmas.len: + let it = pragmas[i] + let key = if it.kind in nkPragmaCallKinds and it.len >= 1: it[0] else: it + + trySuggestPragmas(c, key) + + if isPossibleMacroPragma(c, it, key): + # we transform ``var p {.m, rest.}`` into ``m(do: var p {.rest.})`` and + # let the semantic checker deal with it: + var x = newNodeI(nkCall, key.info) + x.add(key) + + if it.kind in nkPragmaCallKinds and it.len > 1: + # pass pragma arguments to the macro too: + for i in 1..<it.len: + x.add(it[i]) + + # Drop the pragma from the list, this prevents getting caught in endless + # recursion when the nkCall is semanticized + let oldExpr = a[lhsPos] + let newPragmas = copyExcept(pragmas, i) + if newPragmas.kind != nkEmpty and newPragmas.len == 0: + a[lhsPos] = oldExpr[namePos] + else: + a[lhsPos] = copyNode(oldExpr) + a[lhsPos].add(oldExpr[namePos]) + a[lhsPos].add(newPragmas) + + var unarySection = newNodeI(n.kind, a.info) + unarySection.add(a) + x.add(unarySection) + + # recursion assures that this works for multiple macro annotations too: + var r = semOverloadedCall(c, x, x, {skMacro, skTemplate}, {efNoUndeclared}) + if r == nil: + # Restore the old list of pragmas since we couldn't process this + a[lhsPos] = oldExpr + # No matching macro was found but there's always the possibility this may + # be a .pragma. template instead + continue + + doAssert r[0].kind == nkSym + let m = r[0].sym + case m.kind + of skMacro: result = semMacroExpr(c, r, r, m, {}) + of skTemplate: result = semTemplateExpr(c, r, m, {}) + else: + a[lhsPos] = oldExpr + continue + + doAssert result != nil + + return result + +template isLocalSym(sym: PSym): bool = + sym.kind in {skVar, skLet, skParam} and not + ({sfGlobal, sfPure} * sym.flags != {} or + sym.typ.kind == tyTypeDesc or + sfCompileTime in sym.flags) or + sym.kind in {skProc, skFunc, skIterator} and + sfGlobal notin sym.flags + +template isLocalVarSym(n: PNode): bool = + n.kind == nkSym and isLocalSym(n.sym) + +proc usesLocalVar(n: PNode): bool = + result = false + for z in 1 ..< n.len: + if n[z].isLocalVarSym: + return true + elif n[z].kind in nkCallKinds: + if usesLocalVar(n[z]): + return true + +proc globalVarInitCheck(c: PContext, n: PNode) = + if n.isLocalVarSym or n.kind in nkCallKinds and usesLocalVar(n): + localError(c.config, n.info, errCannotAssignToGlobal) + +const + errTupleUnpackingTupleExpected = "tuple expected for tuple unpacking, but got '$1'" + errTupleUnpackingDifferentLengths = "tuple with $1 elements expected, but got '$2' with $3 elements" + +proc makeVarTupleSection(c: PContext, n, a, def: PNode, typ: PType, symkind: TSymKind, origResult: var PNode): PNode = + ## expand tuple unpacking assignments into new var/let/const section + ## + ## mirrored with semexprs.makeTupleAssignments + if typ.kind != tyTuple: + localError(c.config, a.info, errTupleUnpackingTupleExpected % + [typeToString(typ, preferDesc)]) + elif a.len-2 != typ.len: + localError(c.config, a.info, errTupleUnpackingDifferentLengths % + [$(a.len-2), typeToString(typ, preferDesc), $typ.len]) + var + tempNode: PNode = nil + lastDef: PNode + let defkind = if symkind == skConst: nkConstDef else: nkIdentDefs + # temporary not needed if not const and RHS is tuple literal + # const breaks with seqs without temporary + let useTemp = def.kind notin {nkPar, nkTupleConstr} or symkind == skConst + if useTemp: + # use same symkind for compatibility with original section + let temp = newSym(symkind, getIdent(c.cache, "tmpTuple"), c.idgen, getCurrOwner(c), n.info) + temp.typ = typ + temp.flags.incl(sfGenSym) + lastDef = newNodeI(defkind, a.info) + newSons(lastDef, 3) + lastDef[0] = newSymNode(temp) + # NOTE: at the moment this is always ast.emptyNode, see parser.nim + lastDef[1] = a[^2] + lastDef[2] = def + temp.ast = lastDef + addToVarSection(c, origResult, n, lastDef) + tempNode = newSymNode(temp) + result = newNodeI(n.kind, a.info) + for j in 0..<a.len-2: + let name = a[j] + if useTemp and name.kind == nkIdent and name.ident.id == ord(wUnderscore): + # skip _ assignments if we are using a temp as they are already evaluated + continue + if name.kind == nkVarTuple: + # nested tuple + lastDef = newNodeI(nkVarTuple, name.info) + newSons(lastDef, name.len) + for k in 0..<name.len-2: + lastDef[k] = name[k] + else: + lastDef = newNodeI(defkind, name.info) + newSons(lastDef, 3) + lastDef[0] = name + lastDef[^2] = c.graph.emptyNode + if useTemp: + lastDef[^1] = newTupleAccessRaw(tempNode, j) else: - result.add newNodeIT(nkNilLit, a.info, c.graph.sysTypes[tyNil]) - result.add a[2] - result.info = a.info - let ret = newNodeI(nkStmtList, a.info) - ret.add result - result = semExprNoType(c, ret) + var val = def[j] + if val.kind == nkExprColonExpr: val = val[1] + lastDef[^1] = val + result.add(lastDef) proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = - if n.len == 1: - result = semLowerLetVarCustomPragma(c, n[0], n) - if result != nil: return result - var b: PNode result = copyNode(n) + + # transform var x, y = 12 into var x = 12; var y = 12 + # bug #18104; transformation should be finished before templates expansion + # TODO: move warnings for tuple here + var transformed = copyNode(n) + for i in 0..<n.len: + var a = n[i] + if a.kind == nkIdentDefs and a.len > 3 and a[^1].kind != nkEmpty: + for j in 0..<a.len-2: + var b = newNodeI(nkIdentDefs, a.info) + b.add a[j] + b.add a[^2] + b.add copyTree(a[^1]) + transformed.add b + else: + transformed.add a + let n = transformed + for i in 0..<n.len: var a = n[i] if c.config.cmd == cmdIdeTools: suggestStmt(c, a) @@ -489,15 +815,27 @@ proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = if a.kind notin {nkIdentDefs, nkVarTuple}: illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) + b = semVarMacroPragma(c, a, n) + if b != nil: + addToVarSection(c, result, b) + continue + + var hasUserSpecifiedType = false var typ: PType = nil if a[^2].kind != nkEmpty: typ = semTypeNode(c, a[^2], nil) + hasUserSpecifiedType = true - var typFlags: TTypeAllowedFlags + var typFlags: TTypeAllowedFlags = {} var def: PNode = c.graph.emptyNode + if typ != nil and typ.kind == tyRange and + c.graph.config.isDefined("nimPreviewRangeDefault") and + a[^1].kind == nkEmpty: + a[^1] = firstRange(c.config, typ) + if a[^1].kind != nkEmpty: - def = semExprWithType(c, a[^1], {efAllowDestructor}) + def = semExprWithType(c, a[^1], {efTypeAllowed}, typ) if def.kind == nkSym and def.sym.kind in {skTemplate, skMacro}: typFlags.incl taIsTemplateOrMacro @@ -511,16 +849,23 @@ proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = else: # BUGFIX: ``fitNode`` is needed here! # check type compatibility between def.typ and typ - def = fitNode(c, typ, def, def.info) + def = fitNodeConsiderViewType(c, typ, def, def.info) #changeType(def.skipConv, typ, check=true) else: typ = def.typ.skipTypes({tyStatic, tySink}).skipIntLit(c.idgen) if typ.kind in tyUserTypeClasses and typ.isResolvedUserTypeClass: - typ = typ.lastSon + typ = typ.last if hasEmpty(typ): localError(c.config, def.info, errCannotInferTypeOfTheLiteral % typ.kind.toHumanStr) - elif typ.kind == tyProc and tfUnresolved in typ.flags: - localError(c.config, def.info, errProcHasNoConcreteType % def.renderTree) + elif typ.kind == tyProc and def.kind == nkSym and isGenericRoutine(def.sym.ast): + let owner = typ.owner + let err = + # consistent error message with evaltempl/semMacroExpr + if owner != nil and owner.kind in {skTemplate, skMacro}: + errMissingGenericParamsForTemplate % def.renderTree + else: + errProcHasNoConcreteType % def.renderTree + localError(c.config, def.info, err) when false: # XXX This typing rule is neither documented nor complete enough to # justify it. Instead use the newer 'unowned x' until we figured out @@ -539,95 +884,86 @@ proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = var tup = skipTypes(typ, {tyGenericInst, tyAlias, tySink}) if a.kind == nkVarTuple: - if tup.kind != tyTuple: - localError(c.config, a.info, errXExpected, "tuple") - elif a.len-2 != tup.len: - localError(c.config, a.info, errWrongNumberOfVariables) - b = newNodeI(nkVarTuple, a.info) - newSons(b, a.len) - # keep type desc for doc generator - # NOTE: at the moment this is always ast.emptyNode, see parser.nim - b[^2] = a[^2] - b[^1] = def - addToVarSection(c, result, n, b) - elif tup.kind == tyTuple and def.kind in {nkPar, nkTupleConstr} and - a.kind == nkIdentDefs and a.len > 3: - message(c.config, a.info, warnEachIdentIsTuple) - - for j in 0..<a.len-2: - if a[j].kind == nkDotExpr: - fillPartialObject(c, a[j], - if a.kind != nkVarTuple: typ else: tup[j]) - addToVarSection(c, result, n, a) - continue - var v = semIdentDef(c, a[j], symkind) - styleCheckDef(c.config, v) - onDef(a[j].info, v) - if sfGenSym notin v.flags: - if not isDiscardUnderscore(v): addInterfaceDecl(c, v) - else: - if v.owner == nil: v.owner = c.p.owner - when oKeepVariableNames: - if c.inUnrolledContext > 0: v.flags.incl(sfShadowed) + # generate new section from tuple unpacking and embed it into this one + let assignments = makeVarTupleSection(c, n, a, def, tup, symkind, result) + let resSection = semVarOrLet(c, assignments, symkind) + for resDef in resSection: + addToVarSection(c, result, n, resDef) + else: + if tup.kind == tyTuple and def.kind in {nkPar, nkTupleConstr} and + a.len > 3: + # var a, b = (1, 2) + message(c.config, a.info, warnEachIdentIsTuple) + + for j in 0..<a.len-2: + if a[j].kind == nkDotExpr: + fillPartialObject(c, a[j], typ) + addToVarSection(c, result, n, a) + continue + var v = semIdentDef(c, a[j], symkind, false) + when defined(nimsuggest): + v.hasUserSpecifiedType = hasUserSpecifiedType + styleCheckDef(c, v) + onDef(a[j].info, v) + if sfGenSym notin v.flags: + if not isDiscardUnderscore(v): addInterfaceDecl(c, v) else: - let shadowed = findShadowedVar(c, v) - if shadowed != nil: - shadowed.flags.incl(sfShadowed) - if shadowed.kind == skResult and sfGenSym notin v.flags: - message(c.config, a.info, warnResultShadowed) - if a.kind != nkVarTuple: + if v.owner == nil: v.owner = c.p.owner + when oKeepVariableNames: + if c.inUnrolledContext > 0: v.flags.incl(sfShadowed) + else: + let shadowed = findShadowedVar(c, v) + if shadowed != nil: + shadowed.flags.incl(sfShadowed) + if shadowed.kind == skResult and sfGenSym notin v.flags: + message(c.config, a.info, warnResultShadowed) if def.kind != nkEmpty: if sfThread in v.flags: localError(c.config, def.info, errThreadvarCannotInit) setVarType(c, v, typ) + # this is needed for the evaluation pass, guard checking + # and custom pragmas: b = newNodeI(nkIdentDefs, a.info) if importantComments(c.config): # keep documentation information: b.comment = a.comment - b.add newSymNode(v) - # keep type desc for doc generator - b.add a[^2] - b.add copyTree(def) - addToVarSection(c, result, n, b) - # this is needed for the evaluation pass, guard checking - # and custom pragmas: - var ast = newNodeI(nkIdentDefs, a.info) + # postfix not generated here (to generate, get rid of it in transf) if a[j].kind == nkPragmaExpr: var p = newNodeI(nkPragmaExpr, a.info) p.add newSymNode(v) - p.add a[j][1].copyTree - ast.add p - else: - ast.add newSymNode(v) - ast.add a[^2].copyTree - ast.add def - v.ast = ast - else: - if def.kind in {nkPar, nkTupleConstr}: v.ast = def[j] - # bug #7663, for 'nim check' this can be a non-tuple: - if tup.kind == tyTuple: setVarType(c, v, tup[j]) - else: v.typ = tup - b[j] = newSymNode(v) - if def.kind == nkEmpty: - let actualType = v.typ.skipTypes({tyGenericInst, tyAlias, - tyUserTypeClassInst}) - if actualType.kind in {tyObject, tyDistinct} and - actualType.requiresInit: - defaultConstructionError(c, v.typ, v.info) + p.add a[j][1] + b.add p else: - checkNilable(c, v) - # allow let to not be initialised if imported from C: - if v.kind == skLet and sfImportc notin v.flags: - localError(c.config, a.info, errLetNeedsInit) - if sfCompileTime in v.flags: - var x = newNodeI(result.kind, v.info) - x.add result[i] - vm.setupCompileTimeVar(c.module, c.idgen, c.graph, x) - if v.flags * {sfGlobal, sfThread} == {sfGlobal}: - message(c.config, v.info, hintGlobalVar) + b.add newSymNode(v) + # keep type desc for doc generator + b.add a[^2] + b.add copyTree(def) + addToVarSection(c, result, n, b) + v.ast = b + if def.kind == nkEmpty: + let actualType = v.typ.skipTypes({tyGenericInst, tyAlias, + tyUserTypeClassInst}) + if actualType.kind in {tyObject, tyDistinct} and + actualType.requiresInit: + defaultConstructionError(c, v.typ, v.info) + else: + checkNilable(c, v) + # allow let to not be initialised if imported from C: + if v.kind == skLet and sfImportc notin v.flags and (strictDefs notin c.features or not isLocalSym(v)): + localError(c.config, a.info, errLetNeedsInit) + if sfCompileTime in v.flags: + var x = newNodeI(result.kind, v.info) + x.add result[i] + vm.setupCompileTimeVar(c.module, c.idgen, c.graph, x) + if v.flags * {sfGlobal, sfThread} == {sfGlobal}: + message(c.config, v.info, hintGlobalVar) + if {sfGlobal, sfPure} <= v.flags: + globalVarInitCheck(c, def) + suggestSym(c.graph, v.info, v, c.graph.usageSym) proc semConst(c: PContext, n: PNode): PNode = result = copyNode(n) inc c.inStaticContext + var b: PNode for i in 0..<n.len: var a = n[i] if c.config.cmd == cmdIdeTools: suggestStmt(c, a) @@ -635,14 +971,22 @@ proc semConst(c: PContext, n: PNode): PNode = if a.kind notin {nkConstDef, nkVarTuple}: illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) + b = semVarMacroPragma(c, a, n) + if b != nil: + addToVarSection(c, result, b) + continue + + var hasUserSpecifiedType = false var typ: PType = nil if a[^2].kind != nkEmpty: typ = semTypeNode(c, a[^2], nil) + hasUserSpecifiedType = true - var typFlags: TTypeAllowedFlags + var typFlags: TTypeAllowedFlags = {} # don't evaluate here since the type compatibility check below may add a converter - var def = semExprWithType(c, a[^1]) + openScope(c) + var def = semExprWithType(c, a[^1], {efTypeAllowed}, typ) if def.kind == nkSym and def.sym.kind in {skTemplate, skMacro}: typFlags.incl taIsTemplateOrMacro @@ -668,39 +1012,46 @@ proc semConst(c: PContext, n: PNode): PNode = if c.matchedConcept != nil: typFlags.incl taConcept typeAllowedCheck(c, a.info, typ, skConst, typFlags) + closeScope(c) - var b: PNode if a.kind == nkVarTuple: - if typ.kind != tyTuple: - localError(c.config, a.info, errXExpected, "tuple") - elif a.len-2 != typ.len: - localError(c.config, a.info, errWrongNumberOfVariables) - b = newNodeI(nkVarTuple, a.info) - newSons(b, a.len) - b[^2] = a[^2] - b[^1] = def - - for j in 0..<a.len-2: - var v = semIdentDef(c, a[j], skConst) - if sfGenSym notin v.flags: addInterfaceDecl(c, v) - elif v.owner == nil: v.owner = getCurrOwner(c) - styleCheckDef(c.config, v) - onDef(a[j].info, v) - - if a.kind != nkVarTuple: - setVarType(c, v, typ) - v.ast = def # no need to copy + # generate new section from tuple unpacking and embed it into this one + let assignments = makeVarTupleSection(c, n, a, def, typ, skConst, result) + let resSection = semConst(c, assignments) + for resDef in resSection: + addToVarSection(c, result, n, resDef) + else: + for j in 0..<a.len-2: + var v = semIdentDef(c, a[j], skConst) + when defined(nimsuggest): + v.hasUserSpecifiedType = hasUserSpecifiedType + if sfGenSym notin v.flags: addInterfaceDecl(c, v) + elif v.owner == nil: v.owner = getCurrOwner(c) + styleCheckDef(c, v) + onDef(a[j].info, v) + + var fillSymbol = true + if v.typ != nil: + # symbol already has type and probably value + # don't mutate + fillSymbol = false + else: + setVarType(c, v, typ) b = newNodeI(nkConstDef, a.info) if importantComments(c.config): b.comment = a.comment - b.add newSymNode(v) + # postfix not generated here (to generate, get rid of it in transf) + if a[j].kind == nkPragmaExpr: + var p = newNodeI(nkPragmaExpr, a.info) + p.add newSymNode(v) + p.add a[j][1].copyTree + b.add p + else: + b.add newSymNode(v) b.add a[1] b.add copyTree(def) - else: - setVarType(c, v, typ[j]) - v.ast = if def[j].kind != nkExprColonExpr: def[j] - else: def[j][1] - b[j] = newSymNode(v) - result.add b + if fillSymbol: + v.ast = b + addToVarSection(c, result, n, b) dec c.inStaticContext include semfields @@ -709,7 +1060,7 @@ include semfields proc symForVar(c: PContext, n: PNode): PSym = let m = if n.kind == nkPragmaExpr: n[0] else: n result = newSymG(skForVar, m, c) - styleCheckDef(c.config, result) + styleCheckDef(c, result) onDef(n.info, result) if n.kind == nkPragmaExpr: pragma(c, result, n[1], forVarPragmas) @@ -721,11 +1072,18 @@ proc semForVars(c: PContext, n: PNode; flags: TExprFlags): PNode = var iterAfterVarLent = iter.skipTypes({tyGenericInst, tyAlias, tyLent, tyVar}) # n.len == 3 means that there is one for loop variable # and thus no tuple unpacking: + if iterAfterVarLent.kind == tyEmpty: + localError(c.config, n[^2].info, "cannot infer element type of $1" % + renderTree(n[^2], {renderNoComments})) if iterAfterVarLent.kind != tyTuple or n.len == 3: if n.len == 3: if n[0].kind == nkVarTuple: - if n[0].len-1 != iterAfterVarLent.len: - localError(c.config, n[0].info, errWrongNumberOfVariables) + if iterAfterVarLent.kind != tyTuple: + return localErrorNode(c, n, n[0].info, errTupleUnpackingTupleExpected % + [typeToString(n[1].typ, preferDesc)]) + elif n[0].len-1 != iterAfterVarLent.len: + return localErrorNode(c, n, n[0].info, errWrongNumberOfVariables) + for i in 0..<n[0].len-1: var v = symForVar(c, n[0][i]) if getCurrOwner(c).kind == skModule: incl(v.flags, sfGlobal) @@ -800,11 +1158,14 @@ proc semForVars(c: PContext, n: PNode; flags: TExprFlags): PNode = if not isDiscardUnderscore(v): addDecl(c, v) elif v.owner == nil: v.owner = getCurrOwner(c) inc(c.p.nestedLoopCounter) + let oldBreakInLoop = c.p.breakInLoop + c.p.breakInLoop = true openScope(c) n[^1] = semExprBranch(c, n[^1], flags) if efInTypeof notin flags: discardCheck(c, n[^1], flags) closeScope(c) + c.p.breakInLoop = oldBreakInLoop dec(c.p.nestedLoopCounter) proc implicitIterator(c: PContext, it: string, arg: PNode): PNode = @@ -833,12 +1194,12 @@ proc handleStmtMacro(c: PContext; n, selector: PNode; magicType: string; if maType == nil: return let headSymbol = selector[0] - var o: TOverloadIter + var o: TOverloadIter = default(TOverloadIter) var match: PSym = nil var symx = initOverloadIter(o, c, headSymbol) while symx != nil: if symx.kind in {skTemplate, skMacro}: - if symx.typ.len == 2 and symx.typ[1] == maType.typ: + if symx.typ.len == 2 and symx.typ.firstParamType == maType.typ: if match == nil: match = symx else: @@ -855,6 +1216,8 @@ proc handleStmtMacro(c: PContext; n, selector: PNode; magicType: string; of skMacro: result = semMacroExpr(c, callExpr, callExpr, match, flags) of skTemplate: result = semTemplateExpr(c, callExpr, match, flags) else: result = nil + else: + result = nil proc handleForLoopMacro(c: PContext; n: PNode; flags: TExprFlags): PNode = result = handleStmtMacro(c, n, n[^2], "ForLoopStmt", flags) @@ -867,8 +1230,8 @@ proc handleCaseStmtMacro(c: PContext; n: PNode; flags: TExprFlags): PNode = toResolve.add newIdentNode(getIdent(c.cache, "case"), n.info) toResolve.add n[0] - var errors: CandidateErrors - var r = resolveOverloads(c, toResolve, toResolve, {skTemplate, skMacro}, {}, + var errors: CandidateErrors = @[] + var r = resolveOverloads(c, toResolve, toResolve, {skTemplate, skMacro}, {efNoUndeclared}, errors, false) if r.state == csMatch: var match = r.calleeSym @@ -881,7 +1244,11 @@ proc handleCaseStmtMacro(c: PContext; n: PNode; flags: TExprFlags): PNode = case match.kind of skMacro: result = semMacroExpr(c, toExpand, toExpand, match, flags) of skTemplate: result = semTemplateExpr(c, toExpand, match, flags) - else: result = nil + else: result = errorNode(c, n[0]) + else: + result = errorNode(c, n[0]) + if result.kind == nkEmpty: + localError(c.config, n[0].info, errSelectorMustBeOfCertainTypes) # this would be the perfectly consistent solution with 'for loop macros', # but it kinda sucks for pattern matching as the matcher is not attached to # a type then: @@ -896,7 +1263,8 @@ proc semFor(c: PContext, n: PNode; flags: TExprFlags): PNode = result = n n[^2] = semExprNoDeref(c, n[^2], {efWantIterator}) var call = n[^2] - if call.kind == nkStmtListExpr and isTrivalStmtExpr(call): + + if call.kind == nkStmtListExpr and (isTrivalStmtExpr(call) or (call.lastSon.kind in nkCallKinds and call.lastSon[0].sym.kind == skIterator)): call = call.lastSon n[^2] = call let isCallExpr = call.kind in nkCallKinds @@ -928,35 +1296,29 @@ proc semFor(c: PContext, n: PNode; flags: TExprFlags): PNode = result.typ = result.lastSon.typ closeScope(c) -proc semCase(c: PContext, n: PNode; flags: TExprFlags): PNode = +proc semCase(c: PContext, n: PNode; flags: TExprFlags; expectedType: PType = nil): PNode = result = n checkMinSonsLen(n, 2, c.config) openScope(c) pushCaseContext(c, n) n[0] = semExprWithType(c, n[0]) - var chckCovered = false var covered: Int128 = toInt128(0) var typ = commonTypeBegin + var expectedType = expectedType var hasElse = false let caseTyp = skipTypes(n[0].typ, abstractVar-{tyTypeDesc}) - const shouldChckCovered = {tyInt..tyInt64, tyChar, tyEnum, tyUInt..tyUInt32, tyBool} + var chckCovered = caseTyp.shouldCheckCaseCovered() case caseTyp.kind - of shouldChckCovered: - chckCovered = true - of tyRange: - if skipTypes(caseTyp[0], abstractInst).kind in shouldChckCovered: - chckCovered = true - of tyFloat..tyFloat128, tyString, tyError: + of tyFloat..tyFloat128, tyString, tyCstring, tyError, shouldChckCovered, tyRange: discard else: popCaseContext(c) closeScope(c) - if caseStmtMacros in c.features: - result = handleCaseStmtMacro(c, n, flags) - if result != nil: - return result - localError(c.config, n[0].info, errSelectorMustBeOfCertainTypes) - return + return handleCaseStmtMacro(c, n, flags) + template invalidOrderOfBranches(n: PNode) = + localError(c.config, n.info, "invalid order of case branches") + break + for i in 1..<n.len: setCaseContextIdx(c, i) var x = n[i] @@ -965,23 +1327,31 @@ proc semCase(c: PContext, n: PNode; flags: TExprFlags): PNode = suggestEnum(c, x, caseTyp) case x.kind of nkOfBranch: + if hasElse: invalidOrderOfBranches(x) checkMinSonsLen(x, 2, c.config) semCaseBranch(c, n, x, i, covered) var last = x.len-1 - x[last] = semExprBranchScope(c, x[last]) + x[last] = semExprBranchScope(c, x[last], expectedType) typ = commonType(c, typ, x[last]) + if not endsInNoReturn(x[last]): + expectedType = typ of nkElifBranch: + if hasElse: invalidOrderOfBranches(x) chckCovered = false checkSonsLen(x, 2, c.config) openScope(c) - x[0] = forceBool(c, semExprWithType(c, x[0])) - x[1] = semExprBranch(c, x[1]) + x[0] = forceBool(c, semExprWithType(c, x[0], expectedType = getSysType(c.graph, n.info, tyBool))) + x[1] = semExprBranch(c, x[1], expectedType = expectedType) typ = commonType(c, typ, x[1]) + if not endsInNoReturn(x[1]): + expectedType = typ closeScope(c) of nkElse: checkSonsLen(x, 1, c.config) - x[0] = semExprBranchScope(c, x[0]) + x[0] = semExprBranchScope(c, x[0], expectedType) typ = commonType(c, typ, x[0]) + if not endsInNoReturn(x[0]): + expectedType = typ if (chckCovered and covered == toCover(c, n[0].typ)) or hasElse: message(c.config, x.info, warnUnreachableElse) hasElse = true @@ -1022,9 +1392,8 @@ proc semRaise(c: PContext, n: PNode): PNode = typ = typ.skipTypes({tyAlias, tyGenericInst, tyOwned}) if typ.kind != tyRef: localError(c.config, n.info, errExprCannotBeRaised) - if typ.len > 0 and not isException(typ.lastSon): - localError(c.config, n.info, "raised object of type $1 does not inherit from Exception", - [typeToString(typ)]) + if typ.len > 0 and not isException(typ.elementType): + localError(c.config, n.info, "raised object of type $1 does not inherit from Exception" % typeToString(typ)) proc addGenericParamListToScope(c: PContext, n: PNode) = if n.kind != nkGenericParams: illFormedAst(n, c.config) @@ -1039,13 +1408,16 @@ proc typeSectionTypeName(c: PContext; n: PNode): PNode = result = n[0] else: result = n + if result.kind == nkPostfix: + if result.len != 2: illFormedAst(n, c.config) + result = result[1] if result.kind != nkSym: illFormedAst(n, c.config) proc typeDefLeftSidePass(c: PContext, typeSection: PNode, i: int) = let typeDef = typeSection[i] checkSonsLen(typeDef, 3, c.config) var name = typeDef[0] - var s: PSym + var s: PSym = nil if name.kind == nkDotExpr and typeDef[2].kind == nkObjectTy: let pkgName = considerQuotedIdent(c, name[0]) let typName = considerQuotedIdent(c, name[1]) @@ -1065,6 +1437,7 @@ proc typeDefLeftSidePass(c: PContext, typeSection: PNode, i: int) = elif typsym.kind == skType and sfForward in typsym.flags: s = typsym addInterfaceDecl(c, s) + # PRTEMP no onDef here? else: localError(c.config, name.info, typsym.name.s & " is not a type that can be forwarded") s = typsym @@ -1076,7 +1449,12 @@ proc typeDefLeftSidePass(c: PContext, typeSection: PNode, i: int) = if name.kind == nkPragmaExpr: let rewritten = applyTypeSectionPragmas(c, name[1], typeDef) if rewritten != nil: - typeSection[i] = rewritten + case rewritten.kind + of nkTypeDef: + typeSection[i] = rewritten + of nkTypeSection: + typeSection.sons[i .. i] = rewritten.sons + else: illFormedAst(rewritten, c.config) typeDefLeftSidePass(c, typeSection, i) return pragma(c, s, name[1], typePragmas) @@ -1100,26 +1478,35 @@ proc typeDefLeftSidePass(c: PContext, typeSection: PNode, i: int) = elif s.owner == nil: s.owner = getCurrOwner(c) if name.kind == nkPragmaExpr: - typeDef[0][0] = newSymNode(s) + if name[0].kind == nkPostfix: + typeDef[0][0][1] = newSymNode(s) + else: + typeDef[0][0] = newSymNode(s) else: - typeDef[0] = newSymNode(s) + if name.kind == nkPostfix: + typeDef[0][1] = newSymNode(s) + else: + typeDef[0] = newSymNode(s) proc typeSectionLeftSidePass(c: PContext, n: PNode) = # process the symbols on the left side for the whole type section, before # we even look at the type definitions on the right - for i in 0..<n.len: + var i = 0 + while i < n.len: # n may grow due to type pragma macros var a = n[i] when defined(nimsuggest): if c.config.cmd == cmdIdeTools: inc c.inTypeContext suggestStmt(c, a) dec c.inTypeContext - if a.kind == nkCommentStmt: continue - if a.kind != nkTypeDef: illFormedAst(a, c.config) - typeDefLeftSidePass(c, n, i) + case a.kind + of nkCommentStmt: discard + of nkTypeDef: typeDefLeftSidePass(c, n, i) + else: illFormedAst(a, c.config) + inc i proc checkCovariantParamsUsages(c: PContext; genericType: PType) = - var body = genericType[^1] + var body = genericType.typeBodyImpl proc traverseSubTypes(c: PContext; t: PType): bool = template error(msg) = localError(c.config, genericType.sym.info, msg) @@ -1136,17 +1523,17 @@ proc checkCovariantParamsUsages(c: PContext; genericType: PType) = for field in t.n: subresult traverseSubTypes(c, field.typ) of tyArray: - return traverseSubTypes(c, t[1]) + return traverseSubTypes(c, t.elementType) of tyProc: - for subType in t.sons: + for subType in t.signature: if subType != nil: subresult traverseSubTypes(c, subType) if result: error("non-invariant type param used in a proc type: " & $t) of tySequence: - return traverseSubTypes(c, t[0]) + return traverseSubTypes(c, t.elementType) of tyGenericInvocation: - let targetBody = t[0] + let targetBody = t.genericHead for i in 1..<t.len: let param = t[i] if param.kind == tyGenericParam: @@ -1171,13 +1558,13 @@ proc checkCovariantParamsUsages(c: PContext; genericType: PType) = of tyUserTypeClass, tyUserTypeClassInst: error("non-invariant type parameters are not supported in concepts") of tyTuple: - for fieldType in t.sons: + for fieldType in t.kids: subresult traverseSubTypes(c, fieldType) of tyPtr, tyRef, tyVar, tyLent: - if t.base.kind == tyGenericParam: return true - return traverseSubTypes(c, t.base) + if t.elementType.kind == tyGenericParam: return true + return traverseSubTypes(c, t.elementType) of tyDistinct, tyAlias, tySink, tyOwned: - return traverseSubTypes(c, t.lastSon) + return traverseSubTypes(c, t.skipModifier) of tyGenericInst: internalAssert c.config, false else: @@ -1195,6 +1582,7 @@ proc typeSectionRightSidePass(c: PContext, n: PNode) = if s.magic == mNone and a[2].kind == nkEmpty: localError(c.config, a.info, errImplOfXexpected % s.name.s) if s.magic != mNone: processMagicType(c, s) + let oldFlags = s.typ.flags if a[1].kind != nkEmpty: # We have a generic type declaration here. In generic types, # symbol lookup needs to be done here. @@ -1214,14 +1602,25 @@ proc typeSectionRightSidePass(c: PContext, n: PNode) = # we fill it out later. For magic generics like 'seq', it won't be filled # so we use tyNone instead of nil to not crash for strange conversions # like: mydata.seq - rawAddSon(s.typ, newTypeS(tyNone, c)) + if s.typ.kind in {tyOpenArray, tyVarargs} and s.typ.len == 1: + # XXX investigate why `tySequence` cannot be added here for now. + discard + else: + rawAddSon(s.typ, newTypeS(tyNone, c)) s.ast = a inc c.inGenericContext - var body = semTypeNode(c, a[2], nil) + var body = semTypeNode(c, a[2], s.typ) dec c.inGenericContext if body != nil: body.sym = s body.size = -1 # could not be computed properly + if body.kind == tyObject: + # add flags applied to generic type to object (nominal) type + incl(body.flags, oldFlags) + # {.inheritable, final.} is already disallowed, but + # object might have been assumed to be final + if tfInheritable in oldFlags and tfFinal in body.flags: + excl(body.flags, tfFinal) s.typ[^1] = body if tfCovariant in s.typ.flags: checkCovariantParamsUsages(c, s.typ) @@ -1234,7 +1633,7 @@ proc typeSectionRightSidePass(c: PContext, n: PNode) = # possibilities such as instantiating C++ generic types with # garbage collected Nim types. if sfImportc in s.flags: - var body = s.typ.lastSon + var body = s.typ.last if body.kind == tyObject: # erases all declared fields body.n.sons = @[] @@ -1258,53 +1657,85 @@ proc typeSectionRightSidePass(c: PContext, n: PNode) = # final pass if a[2].kind in nkCallKinds: incl a[2].flags, nfSem # bug #10548 - if sfExportc in s.flags and s.typ.kind == tyAlias: - localError(c.config, name.info, "{.exportc.} not allowed for type aliases") - if tfBorrowDot in s.typ.flags and s.typ.kind != tyDistinct: - excl s.typ.flags, tfBorrowDot - localError(c.config, name.info, "only a 'distinct' type can borrow `.`") + if sfExportc in s.flags: + if s.typ.kind == tyAlias: + localError(c.config, name.info, "{.exportc.} not allowed for type aliases") + elif s.typ.kind == tyGenericBody: + localError(c.config, name.info, "{.exportc.} not allowed for generic types") + + if tfBorrowDot in s.typ.flags: + let body = s.typ.skipTypes({tyGenericBody}) + if body.kind != tyDistinct: + # flag might be copied from alias/instantiation: + let t = body.skipTypes({tyAlias, tyGenericInst}) + if not (t.kind == tyDistinct and tfBorrowDot in t.flags): + excl s.typ.flags, tfBorrowDot + localError(c.config, name.info, "only a 'distinct' type can borrow `.`") let aa = a[2] if aa.kind in {nkRefTy, nkPtrTy} and aa.len == 1 and aa[0].kind == nkObjectTy: # give anonymous object a dummy symbol: var st = s.typ - if st.kind == tyGenericBody: st = st.lastSon + if st.kind == tyGenericBody: st = st.typeBodyImpl internalAssert c.config, st.kind in {tyPtr, tyRef} - internalAssert c.config, st.lastSon.sym == nil + internalAssert c.config, st.last.sym == nil incl st.flags, tfRefsAnonObj + let objTy = st.last + # add flags for `ref object` etc to underlying `object` + incl(objTy.flags, oldFlags) + # {.inheritable, final.} is already disallowed, but + # object might have been assumed to be final + if tfInheritable in oldFlags and tfFinal in objTy.flags: + excl(objTy.flags, tfFinal) let obj = newSym(skType, getIdent(c.cache, s.name.s & ":ObjectType"), - nextSymId c.idgen, getCurrOwner(c), s.info) + c.idgen, getCurrOwner(c), s.info) + obj.flags.incl sfGeneratedType let symNode = newSymNode(obj) obj.ast = a.shallowCopy case a[0].kind - of nkSym: obj.ast[0] = symNode - of nkPragmaExpr: - obj.ast[0] = a[0].shallowCopy + of nkSym: obj.ast[0] = symNode + of nkPragmaExpr: + obj.ast[0] = a[0].shallowCopy + if a[0][0].kind == nkPostfix: + obj.ast[0][0] = a[0][0].shallowCopy + obj.ast[0][0][1] = symNode + else: obj.ast[0][0] = symNode - obj.ast[0][1] = a[0][1] - else: assert(false) + obj.ast[0][1] = a[0][1] + of nkPostfix: + obj.ast[0] = a[0].shallowCopy + obj.ast[0][1] = symNode + else: assert(false) obj.ast[1] = a[1] obj.ast[2] = a[2][0] if sfPure in s.flags: obj.flags.incl sfPure - obj.typ = st.lastSon - st.lastSon.sym = obj - -proc checkForMetaFields(c: PContext; n: PNode) = - proc checkMeta(c: PContext; n: PNode; t: PType) = - if t != nil and t.isMetaType and tfGenericTypeParam notin t.flags: - if t.kind == tyBuiltInTypeClass and t.len == 1 and t[0].kind == tyProc: + obj.typ = objTy + objTy.sym = obj + for sk in c.skipTypes: + discard semTypeNode(c, sk, nil) + c.skipTypes = @[] + +proc checkForMetaFields(c: PContext; n: PNode; hasError: var bool) = + proc checkMeta(c: PContext; n: PNode; t: PType; hasError: var bool; parent: PType) = + if t != nil and (t.isMetaType or t.kind == tyNone) and tfGenericTypeParam notin t.flags: + if t.kind == tyBuiltInTypeClass and t.len == 1 and t.elementType.kind == tyProc: localError(c.config, n.info, ("'$1' is not a concrete type; " & "for a callback without parameters use 'proc()'") % t.typeToString) + elif t.kind == tyNone and parent != nil: + # TODO: openarray has the `tfGenericTypeParam` flag & generics + # TODO: handle special cases (sink etc.) and views + localError(c.config, n.info, errTIsNotAConcreteType % parent.typeToString) else: localError(c.config, n.info, errTIsNotAConcreteType % t.typeToString) + hasError = true if n.isNil: return case n.kind of nkRecList, nkRecCase: - for s in n: checkForMetaFields(c, s) + for s in n: checkForMetaFields(c, s, hasError) of nkOfBranch, nkElse: - checkForMetaFields(c, n.lastSon) + checkForMetaFields(c, n.lastSon, hasError) of nkSym: let t = n.sym.typ case t.kind @@ -1312,9 +1743,9 @@ proc checkForMetaFields(c: PContext; n: PNode) = tyProc, tyGenericInvocation, tyGenericInst, tyAlias, tySink, tyOwned: let start = ord(t.kind in {tyGenericInvocation, tyGenericInst}) for i in start..<t.len: - checkMeta(c, n, t[i]) + checkMeta(c, n, t[i], hasError, t) else: - checkMeta(c, n, t) + checkMeta(c, n, t, hasError, nil) else: internalAssert c.config, false @@ -1325,7 +1756,7 @@ proc typeSectionFinalPass(c: PContext, n: PNode) = let name = typeSectionTypeName(c, a[0]) var s = name.sym # check the style here after the pragmas have been processed: - styleCheckDef(c.config, s) + styleCheckDef(c, s) # compute the type's size and check for illegal recursions: if a[1].kind == nkEmpty: var x = a[2] @@ -1349,11 +1780,16 @@ proc typeSectionFinalPass(c: PContext, n: PNode) = assert s.typ != nil assignType(s.typ, t) s.typ.itemId = t.itemId # same id - checkConstructedType(c.config, s.info, s.typ) - if s.typ.kind in {tyObject, tyTuple} and not s.typ.n.isNil: - checkForMetaFields(c, s.typ.n) - # fix bug #5170: ensure locally scoped object types get a unique name: - if s.typ.kind == tyObject and not isTopLevel(c): incl(s.flags, sfGenSym) + var hasError = false + let baseType = s.typ.safeSkipTypes(abstractPtrs) + if baseType.kind in {tyObject, tyTuple} and not baseType.n.isNil and + (x.kind in {nkObjectTy, nkTupleTy} or + (x.kind in {nkRefTy, nkPtrTy} and x.len == 1 and + x[0].kind in {nkObjectTy, nkTupleTy}) + ): + checkForMetaFields(c, baseType.n, hasError) + if not hasError: + checkConstructedType(c.config, s.info, s.typ) #instAllTypeBoundOp(c, n.info) @@ -1427,104 +1863,114 @@ proc addParams(c: PContext, n: PNode, kind: TSymKind) = proc semBorrow(c: PContext, n: PNode, s: PSym) = # search for the correct alias: - var b = searchForBorrowProc(c, c.currentScope.parent, s) - if b != nil: + var (b, state) = searchForBorrowProc(c, c.currentScope.parent, s) + case state + of bsMatch: # store the alias: n[bodyPos] = newSymNode(b) # Carry over the original symbol magic, this is necessary in order to ensure # the semantic pass is correct s.magic = b.magic + if b.typ != nil and b.typ.len > 0: + s.typ.n[0] = b.typ.n[0] + s.typ.flags = b.typ.flags + of bsNoDistinct: + localError(c.config, n.info, "borrow proc without distinct type parameter is meaningless") + of bsReturnNotMatch: + localError(c.config, n.info, "borrow from proc return type mismatch: '$1'" % typeToString(b.typ.returnType)) + of bsGeneric: + localError(c.config, n.info, "borrow with generic parameter is not supported") + of bsNotSupported: + localError(c.config, n.info, "borrow from '$1' is not supported" % $b.name.s) else: localError(c.config, n.info, errNoSymbolToBorrowFromFound) +proc swapResult(n: PNode, sRes: PSym, dNode: PNode) = + ## Swap nodes that are (skResult) symbols to d(estination)Node. + for i in 0..<n.safeLen: + if n[i].kind == nkSym and n[i].sym == sRes: + n[i] = dNode + swapResult(n[i], sRes, dNode) + proc addResult(c: PContext, n: PNode, t: PType, owner: TSymKind) = + template genResSym(s) = + var s = newSym(skResult, getIdent(c.cache, "result"), c.idgen, + getCurrOwner(c), n.info) + s.typ = t + incl(s.flags, sfUsed) + if owner == skMacro or t != nil: if n.len > resultPos and n[resultPos] != nil: - if n[resultPos].sym.kind != skResult or n[resultPos].sym.owner != getCurrOwner(c): + if n[resultPos].sym.kind != skResult: localError(c.config, n.info, "incorrect result proc symbol") + if n[resultPos].sym.owner != getCurrOwner(c): + # re-write result with new ownership, and re-write the proc accordingly + let sResSym = n[resultPos].sym + genResSym(s) + n[resultPos] = newSymNode(s) + swapResult(n, sResSym, n[resultPos]) c.p.resultSym = n[resultPos].sym else: - var s = newSym(skResult, getIdent(c.cache, "result"), nextSymId c.idgen, getCurrOwner(c), n.info) - s.typ = t - incl(s.flags, sfUsed) + genResSym(s) c.p.resultSym = s n.add newSymNode(c.p.resultSym) addParamOrResult(c, c.p.resultSym, owner) -proc copyExcept(n: PNode, i: int): PNode = - result = copyNode(n) - for j in 0..<n.len: - if j != i: result.add(n[j]) - proc semProcAnnotation(c: PContext, prc: PNode; validPragmas: TSpecialWords): PNode = + # Mirrored with semVarMacroPragma + result = nil var n = prc[pragmasPos] if n == nil or n.kind == nkEmpty: return for i in 0..<n.len: let it = n[i] let key = if it.kind in nkPragmaCallKinds and it.len >= 1: it[0] else: it - if whichPragma(it) != wInvalid: - # Not a custom pragma - continue - else: - let ident = considerQuotedIdent(c, key) - if strTableGet(c.userPragmas, ident) != nil: - continue # User defined pragma - else: - var amb = false - let sym = searchInScopes(c, ident, amb) - if sym != nil and sfCustomPragma in sym.flags: - continue # User custom pragma - - # we transform ``proc p {.m, rest.}`` into ``m(do: proc p {.rest.})`` and - # let the semantic checker deal with it: - var x = newNodeI(nkCall, key.info) - x.add(key) - - if it.kind in nkPragmaCallKinds and it.len > 1: - # pass pragma arguments to the macro too: - for i in 1..<it.len: - x.add(it[i]) - - # Drop the pragma from the list, this prevents getting caught in endless - # recursion when the nkCall is semanticized - prc[pragmasPos] = copyExcept(n, i) - if prc[pragmasPos].kind != nkEmpty and prc[pragmasPos].len == 0: - prc[pragmasPos] = c.graph.emptyNode - - x.add(prc) - - # recursion assures that this works for multiple macro annotations too: - var r = semOverloadedCall(c, x, x, {skMacro, skTemplate}, {efNoUndeclared}) - if r == nil: - # Restore the old list of pragmas since we couldn't process this - prc[pragmasPos] = n - # No matching macro was found but there's always the possibility this may - # be a .pragma. template instead - continue - - doAssert r[0].kind == nkSym - let m = r[0].sym - case m.kind - of skMacro: result = semMacroExpr(c, r, r, m, {}) - of skTemplate: result = semTemplateExpr(c, r, m, {}) - else: - prc[pragmasPos] = n - continue + trySuggestPragmas(c, key) + + if isPossibleMacroPragma(c, it, key): + # we transform ``proc p {.m, rest.}`` into ``m(do: proc p {.rest.})`` and + # let the semantic checker deal with it: + var x = newNodeI(nkCall, key.info) + x.add(key) + + if it.kind in nkPragmaCallKinds and it.len > 1: + # pass pragma arguments to the macro too: + for i in 1..<it.len: + x.add(it[i]) + + # Drop the pragma from the list, this prevents getting caught in endless + # recursion when the nkCall is semanticized + prc[pragmasPos] = copyExcept(n, i) + if prc[pragmasPos].kind != nkEmpty and prc[pragmasPos].len == 0: + prc[pragmasPos] = c.graph.emptyNode + + x.add(prc) + + # recursion assures that this works for multiple macro annotations too: + var r = semOverloadedCall(c, x, x, {skMacro, skTemplate}, {efNoUndeclared}) + if r == nil: + # Restore the old list of pragmas since we couldn't process this + prc[pragmasPos] = n + # No matching macro was found but there's always the possibility this may + # be a .pragma. template instead + continue - doAssert result != nil + doAssert r[0].kind == nkSym + let m = r[0].sym + case m.kind + of skMacro: result = semMacroExpr(c, r, r, m, {}) + of skTemplate: result = semTemplateExpr(c, r, m, {}) + else: + prc[pragmasPos] = n + continue - # since a proc annotation can set pragmas, we process these here again. - # This is required for SqueakNim-like export pragmas. - if result.kind in procDefs and result[namePos].kind == nkSym and - result[pragmasPos].kind != nkEmpty: - pragma(c, result[namePos].sym, result[pragmasPos], validPragmas) + doAssert result != nil - return + return result -proc semInferredLambda(c: PContext, pt: TIdTable, n: PNode): PNode {.nosinks.} = - ## used for resolving 'auto' in lambdas based on their callsite +proc semInferredLambda(c: PContext, pt: TypeMapping, n: PNode): PNode = + ## used for resolving 'auto' in lambdas based on their callsite var n = n let original = n[namePos].sym let s = original #copySym(original, false) @@ -1538,7 +1984,6 @@ proc semInferredLambda(c: PContext, pt: TIdTable, n: PNode): PNode {.nosinks.} = n[genericParamsPos] = c.graph.emptyNode # for LL we need to avoid wrong aliasing let params = copyTree n.typ.n - n[paramsPos] = params s.typ = n.typ for i in 1..<params.len: if params[i].typ.kind in {tyTypeDesc, tyGenericParam, @@ -1550,8 +1995,8 @@ proc semInferredLambda(c: PContext, pt: TIdTable, n: PNode): PNode {.nosinks.} = pushOwner(c, s) addParams(c, params, skProc) pushProcCon(c, s) - addResult(c, n, n.typ[0], skProc) - s.ast[bodyPos] = hloBody(c, semProcBody(c, n[bodyPos])) + addResult(c, n, n.typ.returnType, skProc) + s.ast[bodyPos] = hloBody(c, semProcBody(c, n[bodyPos], n.typ.returnType)) trackProc(c, s, s.ast[bodyPos]) popProcCon(c) popOwner(c) @@ -1581,8 +2026,8 @@ proc maybeAddResult(c: PContext, s: PSym, n: PNode) = if s.kind == skMacro: let resultType = sysTypeFromName(c.graph, n.info, "NimNode") addResult(c, n, resultType, s.kind) - elif s.typ[0] != nil and not isInlineIterator(s.typ): - addResult(c, n, s.typ[0], s.kind) + elif s.typ.returnType != nil and not isInlineIterator(s.typ): + addResult(c, n, s.typ.returnType, s.kind) proc canonType(c: PContext, t: PType): PType = if t.kind == tySequence: @@ -1592,7 +2037,7 @@ proc canonType(c: PContext, t: PType): PType = proc prevDestructor(c: PContext; prevOp: PSym; obj: PType; info: TLineInfo) = var msg = "cannot bind another '" & prevOp.name.s & "' to: " & typeToString(obj) - if sfOverriden notin prevOp.flags: + if sfOverridden notin prevOp.flags: msg.add "; previous declaration was constructed here implicitly: " & (c.config $ prevOp.info) else: msg.add "; previous declaration was here: " & (c.config $ prevOp.info) @@ -1601,28 +2046,79 @@ proc prevDestructor(c: PContext; prevOp: PSym; obj: PType; info: TLineInfo) = proc whereToBindTypeHook(c: PContext; t: PType): PType = result = t while true: - if result.kind in {tyGenericBody, tyGenericInst}: result = result.lastSon + if result.kind in {tyGenericBody, tyGenericInst}: result = result.skipModifier elif result.kind == tyGenericInvocation: result = result[0] else: break if result.kind in {tyObject, tyDistinct, tySequence, tyString}: result = canonType(c, result) -proc bindTypeHook(c: PContext; s: PSym; n: PNode; op: TTypeAttachedOp) = +proc bindDupHook(c: PContext; s: PSym; n: PNode; op: TTypeAttachedOp) = let t = s.typ var noError = false - let cond = if op == attachedDestructor: - t.len == 2 and t[0] == nil and t[1].kind == tyVar + let cond = t.len == 2 and t.returnType != nil + + if cond: + var obj = t.firstParamType + while true: + incl(obj.flags, tfHasAsgn) + if obj.kind in {tyGenericBody, tyGenericInst}: obj = obj.skipModifier + elif obj.kind == tyGenericInvocation: obj = obj.genericHead + else: break + + var res = t.returnType + while true: + if res.kind in {tyGenericBody, tyGenericInst}: res = res.skipModifier + elif res.kind == tyGenericInvocation: res = res.genericHead + else: break + + if obj.kind in {tyObject, tyDistinct, tySequence, tyString} and sameType(obj, res): + obj = canonType(c, obj) + let ao = getAttachedOp(c.graph, obj, op) + if ao == s: + discard "forward declared destructor" + elif ao.isNil and tfCheckedForDestructor notin obj.flags: + setAttachedOp(c.graph, c.module.position, obj, op, s) + else: + prevDestructor(c, ao, obj, n.info) + noError = true + if obj.owner.getModule != s.getModule: + localError(c.config, n.info, errGenerated, + "type bound operation `" & s.name.s & "` can be defined only in the same module with its type (" & obj.typeToString() & ")") + + if not noError and sfSystemModule notin s.owner.flags: + localError(c.config, n.info, errGenerated, + "signature for '=dup' must be proc[T: object](x: T): T") + + incl(s.flags, sfUsed) + incl(s.flags, sfOverridden) + +proc bindTypeHook(c: PContext; s: PSym; n: PNode; op: TTypeAttachedOp; suppressVarDestructorWarning = false) = + let t = s.typ + var noError = false + let cond = case op + of attachedWasMoved: + t.len == 2 and t.returnType == nil and t.firstParamType.kind == tyVar + of attachedTrace: + t.len == 3 and t.returnType == nil and t.firstParamType.kind == tyVar and t[2].kind == tyPointer + of attachedDestructor: + if c.config.selectedGC in {gcArc, gcAtomicArc, gcOrc}: + t.len == 2 and t.returnType == nil + else: + t.len == 2 and t.returnType == nil and t.firstParamType.kind == tyVar else: - t.len >= 2 and t[0] == nil + t.len >= 2 and t.returnType == nil if cond: - var obj = t[1].skipTypes({tyVar}) + var obj = t.firstParamType.skipTypes({tyVar}) while true: incl(obj.flags, tfHasAsgn) - if obj.kind in {tyGenericBody, tyGenericInst}: obj = obj.lastSon - elif obj.kind == tyGenericInvocation: obj = obj[0] + if obj.kind in {tyGenericBody, tyGenericInst}: obj = obj.skipModifier + elif obj.kind == tyGenericInvocation: obj = obj.genericHead else: break if obj.kind in {tyObject, tyDistinct, tySequence, tyString}: + if (not suppressVarDestructorWarning) and op == attachedDestructor and t.firstParamType.kind == tyVar and + c.config.selectedGC in {gcArc, gcAtomicArc, gcOrc}: + message(c.config, n.info, warnDeprecated, "A custom '=destroy' hook which takes a 'var T' parameter is deprecated; it should take a 'T' parameter") obj = canonType(c, obj) let ao = getAttachedOp(c.graph, obj, op) if ao == s: @@ -1636,26 +2132,43 @@ proc bindTypeHook(c: PContext; s: PSym; n: PNode; op: TTypeAttachedOp) = localError(c.config, n.info, errGenerated, "type bound operation `" & s.name.s & "` can be defined only in the same module with its type (" & obj.typeToString() & ")") if not noError and sfSystemModule notin s.owner.flags: - localError(c.config, n.info, errGenerated, - "signature for '" & s.name.s & "' must be proc[T: object](x: var T)") + case op + of attachedTrace: + localError(c.config, n.info, errGenerated, + "signature for '=trace' must be proc[T: object](x: var T; env: pointer)") + of attachedDestructor: + if c.config.selectedGC in {gcArc, gcAtomicArc, gcOrc}: + localError(c.config, n.info, errGenerated, + "signature for '=destroy' must be proc[T: object](x: var T) or proc[T: object](x: T)") + else: + localError(c.config, n.info, errGenerated, + "signature for '=destroy' must be proc[T: object](x: var T)") + else: + localError(c.config, n.info, errGenerated, + "signature for '" & s.name.s & "' must be proc[T: object](x: var T)") incl(s.flags, sfUsed) - incl(s.flags, sfOverriden) + incl(s.flags, sfOverridden) proc semOverride(c: PContext, s: PSym, n: PNode) = let name = s.name.s.normalize case name of "=destroy": bindTypeHook(c, s, n, attachedDestructor) + if s.ast != nil: + if s.ast[pragmasPos].kind == nkEmpty: + s.ast[pragmasPos] = newNodeI(nkPragma, s.info) + s.ast[pragmasPos].add newTree(nkExprColonExpr, + newIdentNode(c.cache.getIdent("raises"), s.info), newNodeI(nkBracket, s.info)) of "deepcopy", "=deepcopy": if s.typ.len == 2 and - s.typ[1].skipTypes(abstractInst).kind in {tyRef, tyPtr} and - sameType(s.typ[1], s.typ[0]): + s.typ.firstParamType.skipTypes(abstractInst).kind in {tyRef, tyPtr} and + sameType(s.typ.firstParamType, s.typ.returnType): # Note: we store the deepCopy in the base of the pointer to mitigate # the problem that pointers are structural types: - var t = s.typ[1].skipTypes(abstractInst).lastSon.skipTypes(abstractInst) + var t = s.typ.firstParamType.skipTypes(abstractInst).elementType.skipTypes(abstractInst) while true: - if t.kind == tyGenericBody: t = t.lastSon - elif t.kind == tyGenericInvocation: t = t[0] + if t.kind == tyGenericBody: t = t.typeBodyImpl + elif t.kind == tyGenericInvocation: t = t.genericHead else: break if t.kind in {tyObject, tyDistinct, tyEnum, tySequence, tyString}: if getAttachedOp(c.graph, t, attachedDeepCopy).isNil: @@ -1675,24 +2188,26 @@ proc semOverride(c: PContext, s: PSym, n: PNode) = localError(c.config, n.info, errGenerated, "signature for 'deepCopy' must be proc[T: ptr|ref](x: T): T") incl(s.flags, sfUsed) - incl(s.flags, sfOverriden) + incl(s.flags, sfOverridden) of "=", "=copy", "=sink": if s.magic == mAsgn: return incl(s.flags, sfUsed) - incl(s.flags, sfOverriden) + incl(s.flags, sfOverridden) + if name == "=": + message(c.config, n.info, warnDeprecated, "Overriding `=` hook is deprecated; Override `=copy` hook instead") let t = s.typ - if t.len == 3 and t[0] == nil and t[1].kind == tyVar: - var obj = t[1][0] + if t.len == 3 and t.returnType == nil and t.firstParamType.kind == tyVar: + var obj = t.firstParamType.elementType while true: incl(obj.flags, tfHasAsgn) - if obj.kind == tyGenericBody: obj = obj.lastSon - elif obj.kind == tyGenericInvocation: obj = obj[0] + if obj.kind == tyGenericBody: obj = obj.skipModifier + elif obj.kind == tyGenericInvocation: obj = obj.genericHead else: break var objB = t[2] while true: - if objB.kind == tyGenericBody: objB = objB.lastSon + if objB.kind == tyGenericBody: objB = objB.skipModifier elif objB.kind in {tyGenericInvocation, tyGenericInst}: - objB = objB[0] + objB = objB.genericHead else: break if obj.kind in {tyObject, tyDistinct, tySequence, tyString} and sameType(obj, objB): # attach these ops to the canonical tySequence @@ -1715,15 +2230,21 @@ proc semOverride(c: PContext, s: PSym, n: PNode) = localError(c.config, n.info, errGenerated, "signature for '" & s.name.s & "' must be proc[T: object](x: var T; y: T)") of "=trace": - bindTypeHook(c, s, n, attachedTrace) - of "=dispose": - bindTypeHook(c, s, n, attachedDispose) + if s.magic != mTrace: + bindTypeHook(c, s, n, attachedTrace) + of "=wasmoved": + if s.magic != mWasMoved: + bindTypeHook(c, s, n, attachedWasMoved) + of "=dup": + if s.magic != mDup: + bindDupHook(c, s, n, attachedDup) else: - if sfOverriden in s.flags: + if sfOverridden in s.flags: localError(c.config, n.info, errGenerated, "'destroy' or 'deepCopy' expected for 'override'") proc cursorInProcAux(conf: ConfigRef; n: PNode): bool = + result = false if inCheckpoint(n.info, conf.m.trackPos) != cpNone: return true for i in 0..<n.safeLen: if cursorInProcAux(conf, n[i]): return true @@ -1731,8 +2252,11 @@ proc cursorInProcAux(conf: ConfigRef; n: PNode): bool = proc cursorInProc(conf: ConfigRef; n: PNode): bool = if n.info.fileIndex == conf.m.trackPos.fileIndex: result = cursorInProcAux(conf, n) + else: + result = false proc hasObjParam(s: PSym): bool = + result = false var t = s.typ for col in 1..<t.len: if skipTypes(t[col], skipPtrs).kind == tyObject: @@ -1742,6 +2266,55 @@ proc finishMethod(c: PContext, s: PSym) = if hasObjParam(s): methodDef(c.graph, c.idgen, s) +proc semCppMember(c: PContext; s: PSym; n: PNode) = + if sfImportc notin s.flags: + let isVirtual = sfVirtual in s.flags + let isCtor = sfConstructor in s.flags + let pragmaName = if isVirtual: "virtual" elif isCtor: "constructor" else: "member" + if c.config.backend == backendCpp: + if s.typ.len < 2 and not isCtor: + localError(c.config, n.info, pragmaName & " must have at least one parameter") + for son in s.typ.signature: + if son!=nil and son.isMetaType: + localError(c.config, n.info, pragmaName & " unsupported for generic routine") + var typ: PType + if isCtor: + typ = s.typ.returnType + if typ == nil or typ.kind != tyObject: + localError(c.config, n.info, "constructor must return an object") + if sfImportc in typ.sym.flags: + localError(c.config, n.info, "constructor in an imported type needs importcpp pragma") + else: + typ = s.typ.firstParamType + if typ.kind == tyPtr and not isCtor: + typ = typ.elementType + if typ.kind != tyObject: + localError(c.config, n.info, pragmaName & " must be either ptr to object or object type.") + if typ.owner.id == s.owner.id and c.module.id == s.owner.id: + c.graph.memberProcsPerType.mgetOrPut(typ.itemId, @[]).add s + else: + localError(c.config, n.info, + pragmaName & " procs must be defined in the same scope as the type they are virtual for and it must be a top level scope") + else: + localError(c.config, n.info, pragmaName & " procs are only supported in C++") + else: + var typ = s.typ.returnType + if typ != nil and typ.kind == tyObject and typ.itemId notin c.graph.initializersPerType: + var initializerCall = newTree(nkCall, newSymNode(s)) + var isInitializer = n[paramsPos].len > 1 + for i in 1..<n[paramsPos].len: + let p = n[paramsPos][i] + let val = p[^1] + if val.kind == nkEmpty: + isInitializer = false + break + var j = 0 + while p[j].sym.kind == skParam: + initializerCall.add val + inc j + if isInitializer: + c.graph.initializersPerType[typ.itemId] = initializerCall + proc semMethodPrototype(c: PContext; s: PSym; n: PNode) = if s.isGenericRoutine: let tt = s.typ @@ -1751,7 +2324,7 @@ proc semMethodPrototype(c: PContext; s: PSym; n: PNode) = for col in 1..<tt.len: let t = tt[col] if t != nil and t.kind == tyGenericInvocation: - var x = skipTypes(t[0], {tyVar, tyLent, tyPtr, tyRef, tyGenericInst, + var x = skipTypes(t.genericHead, {tyVar, tyLent, tyPtr, tyRef, tyGenericInst, tyGenericInvocation, tyGenericBody, tyAlias, tySink, tyOwned}) if x.kind == tyObject and t.len-1 == n[genericParamsPos].len: @@ -1776,20 +2349,25 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, result = n checkMinSonsLen(n, bodyPos + 1, c.config) - let isAnon = n[namePos].kind == nkEmpty + let + isAnon = n[namePos].kind == nkEmpty + isHighlight = c.config.ideCmd == ideHighlight var s: PSym case n[namePos].kind of nkEmpty: - s = newSym(kind, c.cache.idAnon, nextSymId c.idgen, c.getCurrOwner, n.info) + s = newSym(kind, c.cache.idAnon, c.idgen, c.getCurrOwner, n.info) s.flags.incl sfUsed n[namePos] = newSymNode(s) of nkSym: s = n[namePos].sym s.owner = c.getCurrOwner else: - s = semIdentDef(c, n[namePos], kind) + # Highlighting needs to be done early so the position for + # name isn't changed (see taccent_highlight). We don't want to check if this is the + # defintion yet since we are missing some info (comments, side effects) + s = semIdentDef(c, n[namePos], kind, reportToNimsuggest=isHighlight) n[namePos] = newSymNode(s) when false: # disable for now @@ -1804,10 +2382,13 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, s.ast = n s.options = c.config.options #s.scope = c.currentScope + if s.kind in {skMacro, skTemplate}: + # push noalias flag at first to prevent unwanted recursive calls: + incl(s.flags, sfNoalias) # before compiling the proc params & body, set as current the scope # where the proc was declared - let delcarationScope = c.currentScope + let declarationScope = c.currentScope pushOwner(c, s) openScope(c) @@ -1843,7 +2424,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if tfTriggersCompileTime in s.typ.flags: incl(s.flags, sfCompileTime) if n[patternPos].kind != nkEmpty: - n[patternPos] = semPattern(c, n[patternPos]) + n[patternPos] = semPattern(c, n[patternPos], s) if s.kind == skIterator: s.typ.flags.incl(tfIterator) elif s.kind == skFunc: @@ -1852,12 +2433,17 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, var (proto, comesFromShadowScope) = if isAnon: (nil, false) - else: searchForProc(c, delcarationScope, s) - if proto == nil and sfForward in s.flags: + else: searchForProc(c, declarationScope, s) + if proto == nil and sfForward in s.flags and n[bodyPos].kind != nkEmpty: ## In cases such as a macro generating a proc with a gensymmed name we ## know `searchForProc` will not find it and sfForward will be set. In ## such scenarios the sym is shared between forward declaration and we ## can treat the `s` as the proto. + ## To differentiate between that happening and a macro just returning a + ## forward declaration that has been typed before we check if the body + ## is not empty. This has the sideeffect of allowing multiple forward + ## declarations if they share the same sym. + ## See the "doubly-typed forward decls" case in tmacros_issues.nim proto = s let hasProto = proto != nil @@ -1879,14 +2465,18 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if not hasProto and sfGenSym notin s.flags: #and not isAnon: if s.kind in OverloadableSyms: - addInterfaceOverloadableSymAt(c, delcarationScope, s) + addInterfaceOverloadableSymAt(c, declarationScope, s) else: - addInterfaceDeclAt(c, delcarationScope, s) + addInterfaceDeclAt(c, declarationScope, s) pragmaCallable(c, s, n, validPragmas) if not hasProto: implicitPragmas(c, s, n.info, validPragmas) + if n[pragmasPos].kind != nkEmpty and sfBorrow notin s.flags: + setEffectsForProcType(c.graph, s.typ, n[pragmasPos], s) + s.typ.flags.incl tfEffectSystemWorkaround + # To ease macro generation that produce forwarded .async procs we now # allow a bit redundancy in the pragma declarations. The rule is # a prototype's pragma list must be a superset of the current pragma @@ -1902,7 +2492,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, ("'" & proto.name.s & "' from " & c.config$proto.info & " '" & s.name.s & "' from " & c.config$s.info)) - styleCheckDef(c.config, s) + styleCheckDef(c, s) if hasProto: onDefResolveForward(n[namePos].info, proto) else: @@ -1935,7 +2525,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, pushOwner(c, s) if not isAnon: - if sfOverriden in s.flags or s.name.s[0] == '=': semOverride(c, s, n) + if sfOverridden 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 & @@ -1944,10 +2534,14 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, localError(c.config, n.info, "the overloaded " & s.name.s & " operator has to be enabled with {.experimental: \"callOperator\".}") + if sfBorrow in s.flags and c.config.cmd notin cmdDocLike: + result[bodyPos] = c.graph.emptyNode + + if sfCppMember * s.flags != {} and sfWasForwarded notin s.flags: + semCppMember(c, s, n) + 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) if c.config.ideCmd in {ideSug, ideCon} and s.kind notin {skMacro, skTemplate} and not cursorInProc(c.config, n[bodyPos]): # speed up nimsuggest @@ -1958,8 +2552,8 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, # absolutely no generics (empty) or a single generic return type are # allowed, everything else, including a nullary generic is an error. pushProcCon(c, s) - addResult(c, n, s.typ[0], skProc) - s.ast[bodyPos] = hloBody(c, semProcBody(c, n[bodyPos])) + addResult(c, n, s.typ.returnType, skProc) + s.ast[bodyPos] = hloBody(c, semProcBody(c, n[bodyPos], s.typ.returnType)) trackProc(c, s, s.ast[bodyPos]) popProcCon(c) elif efOperand notin flags: @@ -1970,16 +2564,22 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, # Macros and Templates can have generic parameters, but they are only # used for overload resolution (there is no instantiation of the symbol) if s.kind notin {skMacro, skTemplate} and s.magic == mNone: paramsTypeCheck(c, s.typ) - maybeAddResult(c, s, n) + let resultType = + if s.kind == skMacro: + sysTypeFromName(c.graph, n.info, "NimNode") + elif not isInlineIterator(s.typ): + s.typ.returnType + else: + nil # semantic checking also needed with importc in case used in VM - s.ast[bodyPos] = hloBody(c, semProcBody(c, n[bodyPos])) + s.ast[bodyPos] = hloBody(c, semProcBody(c, n[bodyPos], resultType)) # unfortunately we cannot skip this step when in 'system.compiles' # context as it may even be evaluated in 'system.compiles': trackProc(c, s, s.ast[bodyPos]) else: - if (s.typ[0] != nil and s.kind != skIterator): - addDecl(c, newSym(skUnknown, getIdent(c.cache, "result"), nextSymId c.idgen, nil, n.info)) + if (s.typ.returnType != nil and s.kind != skIterator): + addDecl(c, newSym(skUnknown, getIdent(c.cache, "result"), c.idgen, s, n.info)) openScope(c) n[bodyPos] = semGenericStmt(c, n[bodyPos]) @@ -1993,14 +2593,14 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if hasProto: localError(c.config, n.info, errImplOfXexpected % proto.name.s) if {sfImportc, sfBorrow, sfError} * s.flags == {} and s.magic == mNone: # this is a forward declaration and we're building the prototype - if s.kind in {skProc, skFunc} and s.typ[0] != nil and s.typ[0].kind == tyUntyped: - # `auto` is represented as `tyUntyped` at this point in compilation. + if s.kind in {skProc, skFunc} and s.typ.returnType != nil and s.typ.returnType.kind == tyAnything: localError(c.config, n[paramsPos][0].info, "return type 'auto' cannot be used in forward declarations") incl(s.flags, sfForward) incl(s.flags, sfWasForwarded) elif sfBorrow in s.flags: semBorrow(c, n, s) sideEffectsCheck(c, s) + closeScope(c) # close scope for parameters # c.currentScope = oldScope popOwner(c) @@ -2014,6 +2614,11 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, 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") + # Prevent double highlights. We already highlighted before. + # When not highlighting we still need to allow for suggestions though + if not isHighlight: + suggestSym(c.graph, s.info, s, c.graph.usageSym) + proc determineType(c: PContext, s: PSym) = if s.typ != nil: return #if s.magic != mNone: return @@ -2033,7 +2638,7 @@ proc semIterator(c: PContext, n: PNode): PNode = if result.kind != n.kind: return var s = result[namePos].sym var t = s.typ - if t[0] == nil and s.typ.callConv != ccClosure: + if t.returnType == nil and s.typ.callConv != ccClosure: localError(c.config, n.info, "iterator needs a return type") # iterators are either 'inline' or 'closure'; for backwards compatibility, # we require first class iterators to be marked with 'closure' explicitly @@ -2070,16 +2675,15 @@ proc semMethod(c: PContext, n: PNode): PNode = # test case): let disp = getDispatcher(s) # auto return type? - if disp != nil and disp.typ[0] != nil and disp.typ[0].kind == tyUntyped: - let ret = s.typ[0] - disp.typ[0] = ret + if disp != nil and disp.typ.returnType != nil and disp.typ.returnType.kind == tyUntyped: + let ret = s.typ.returnType + disp.typ.setReturnType ret if disp.ast[resultPos].kind == nkSym: if isEmptyType(ret): disp.ast[resultPos] = c.graph.emptyNode else: disp.ast[resultPos].sym.typ = ret proc semConverterDef(c: PContext, n: PNode): PNode = if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "converter") - checkSonsLen(n, bodyPos + 1, c.config) result = semProcAux(c, n, skConverter, converterPragmas) # macros can transform converters to nothing: if namePos >= result.safeLen: return result @@ -2089,12 +2693,11 @@ proc semConverterDef(c: PContext, n: PNode): PNode = if result.kind != nkConverterDef: return var s = result[namePos].sym var t = s.typ - if t[0] == nil: localError(c.config, n.info, errXNeedsReturnType % "converter") + if t.returnType == nil: localError(c.config, n.info, errXNeedsReturnType % "converter") if t.len != 2: localError(c.config, n.info, "a converter takes exactly one argument") - addConverter(c, LazySym(sym: s)) + addConverterDef(c, LazySym(sym: s)) proc semMacroDef(c: PContext, n: PNode): PNode = - checkSonsLen(n, bodyPos + 1, c.config) result = semProcAux(c, n, skMacro, macroPragmas) # macros can transform macros to nothing: if namePos >= result.safeLen: return result @@ -2105,10 +2708,16 @@ proc semMacroDef(c: PContext, n: PNode): PNode = var s = result[namePos].sym var t = s.typ var allUntyped = true + var nullary = true for i in 1..<t.n.len: let param = t.n[i].sym if param.typ.kind != tyUntyped: allUntyped = false + # no default value, parameters required in call + if param.ast == nil: nullary = false if allUntyped: incl(s.flags, sfAllUntyped) + if nullary and n[genericParamsPos].kind == nkEmpty: + # macro can be called with alias syntax, remove pushed noalias flag + excl(s.flags, sfNoalias) if n[bodyPos].kind == nkEmpty: localError(c.config, n.info, errImplOfXexpected % s.name.s) @@ -2116,6 +2725,7 @@ proc incMod(c: PContext, n: PNode, it: PNode, includeStmtResult: PNode) = var f = checkModuleName(c.config, it) if f != InvalidFileIdx: 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)) else: @@ -2125,39 +2735,57 @@ proc incMod(c: PContext, n: PNode, it: PNode, includeStmtResult: PNode) = proc evalInclude(c: PContext, n: PNode): PNode = result = newNodeI(nkStmtList, n.info) result.add n + template checkAs(it: PNode) = + if it.kind == nkInfix and it.len == 3: + let op = it[0].getPIdent + if op != nil and op.id == ord(wAs): + localError(c.config, it.info, "Cannot use '" & it[0].renderTree & "' in 'include'.") for i in 0..<n.len: - var imp: PNode let it = n[i] - if it.kind == nkInfix and it.len == 3 and it[0].ident.s != "/": - localError(c.config, it.info, "Cannot use '" & it[0].ident.s & "' in 'include'.") - if it.kind == nkInfix and it.len == 3 and it[2].kind == nkBracket: - let sep = it[0] - let dir = it[1] - imp = newNodeI(nkInfix, it.info) - imp.add sep - imp.add dir - imp.add sep # dummy entry, replaced in the loop - for x in it[2]: - imp[2] = x + checkAs(it) + if it.kind in {nkInfix, nkPrefix} and it[^1].kind == nkBracket: + let lastPos = it.len - 1 + var imp = copyNode(it) + newSons(imp, it.len) + for i in 0 ..< lastPos: imp[i] = it[i] + imp[lastPos] = imp[0] # dummy entry, replaced in the loop + for x in it[lastPos]: + checkAs(x) + imp[lastPos] = x incMod(c, n, imp, result) else: incMod(c, n, it, result) -proc setLine(n: PNode, info: TLineInfo) = - for i in 0..<n.safeLen: setLine(n[i], info) - n.info = info +proc recursiveSetFlag(n: PNode, flag: TNodeFlag) = + if n != nil: + for i in 0..<n.safeLen: recursiveSetFlag(n[i], flag) + incl(n.flags, flag) -proc semPragmaBlock(c: PContext, n: PNode): PNode = +proc semPragmaBlock(c: PContext, n: PNode; expectedType: PType = nil): PNode = checkSonsLen(n, 2, c.config) let pragmaList = n[0] pragma(c, nil, pragmaList, exprPragmas, isStatement = true) - n[1] = semExpr(c, n[1]) + + var inUncheckedAssignSection = 0 + for p in pragmaList: + if whichPragma(p) == wCast: + case whichPragma(p[1]) + of wGcSafe, wNoSideEffect, wTags, wForbids, wRaises: + discard "handled in sempass2" + of wUncheckedAssign: + inUncheckedAssignSection = 1 + else: + localError(c.config, p.info, "invalid pragma block: " & $p) + + inc c.inUncheckedAssignSection, inUncheckedAssignSection + n[1] = semExpr(c, n[1], expectedType = expectedType) + dec c.inUncheckedAssignSection, inUncheckedAssignSection result = n result.typ = n[1].typ for i in 0..<pragmaList.len: case whichPragma(pragmaList[i]) - of wLine: setLine(result, pragmaList[i].info) - of wNoRewrite: incl(result.flags, nfNoRewrite) + of wLine: setInfoRecursive(result, pragmaList[i].info) + of wNoRewrite: recursiveSetFlag(result, nfNoRewrite) else: discard proc semStaticStmt(c: PContext, n: PNode): PNode = @@ -2187,8 +2815,11 @@ proc usesResult(n: PNode): bool = elif n.kind == nkReturnStmt: result = true else: + result = false for c in n: if usesResult(c): return true + else: + result = false proc inferConceptStaticParam(c: PContext, inferred, n: PNode) = var typ = inferred.typ @@ -2196,11 +2827,10 @@ proc inferConceptStaticParam(c: PContext, inferred, n: PNode) = 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]) + "attempt to equate '%s' and '%s'." % [inferred.renderTree, $res.typ, $typ.base]) typ.n = res -proc semStmtList(c: PContext, n: PNode, flags: TExprFlags): PNode = +proc semStmtList(c: PContext, n: PNode, flags: TExprFlags, expectedType: PType = nil): PNode = result = n result.transitionSonsKind(nkStmtList) var voidContext = false @@ -2213,26 +2843,26 @@ proc semStmtList(c: PContext, n: PNode, flags: TExprFlags): PNode = # nkNilLit, nkEmpty}: # dec last for i in 0..<n.len: - var expr = semExpr(c, n[i], flags) - n[i] = expr - if c.matchedConcept != nil and expr.typ != nil and + var x = semExpr(c, n[i], flags, if i == n.len - 1: expectedType else: nil) + n[i] = x + if c.matchedConcept != nil and x.typ != nil and (nfFromTemplate notin n.flags or i != last): - case expr.typ.kind + case x.typ.kind of tyBool: - if expr.kind == nkInfix and - expr[0].kind == nkSym and - expr[0].sym.name.s == "==": - if expr[1].typ.isUnresolvedStatic: - inferConceptStaticParam(c, expr[1], expr[2]) + if x.kind == nkInfix and + x[0].kind == nkSym and + x[0].sym.name.s == "==": + if x[1].typ.isUnresolvedStatic: + inferConceptStaticParam(c, x[1], x[2]) continue - elif expr[2].typ.isUnresolvedStatic: - inferConceptStaticParam(c, expr[2], expr[1]) + elif x[2].typ.isUnresolvedStatic: + inferConceptStaticParam(c, x[2], x[1]) continue let verdict = semConstExpr(c, n[i]) if verdict == nil or verdict.kind != nkIntLit or verdict.intVal == 0: localError(c.config, result.info, "concept predicate failed") - of tyUnknown: continue + of tyFromExpr: continue else: discard if n[i].typ == c.enforceVoidContext: #or usesResult(n[i]): voidContext = true @@ -2245,9 +2875,10 @@ proc semStmtList(c: PContext, n: PNode, flags: TExprFlags): PNode = else: n.typ = n[i].typ if not isEmptyType(n.typ): n.transitionSonsKind(nkStmtListExpr) - if n[i].kind in nkLastBlockStmts or - n[i].kind in nkCallKinds and n[i][0].kind == nkSym and - sfNoReturn in n[i][0].sym.flags: + var m = n[i] + while m.kind in {nkStmtListExpr, nkStmtList} and m.len > 0: # from templates + m = m.lastSon + if endsInNoReturn(m): for j in i + 1..<n.len: case n[j].kind of nkPragma, nkCommentStmt, nkNilLit, nkEmpty, nkState: discard @@ -2263,12 +2894,6 @@ proc semStmtList(c: PContext, n: PNode, flags: TExprFlags): PNode = result[0].kind != nkDefer: result = result[0] - when defined(nimfix): - if result.kind == nkCommentStmt and not result.comment.isNil and - not (result.comment[0] == '#' and result.comment[1] == '#'): - # it is an old-style comment statement: we replace it with 'discard ""': - prettybase.replaceComment(result.info) - proc semStmt(c: PContext, n: PNode; flags: TExprFlags): PNode = if efInTypeof notin flags: result = semExprNoType(c, n) diff --git a/compiler/semstrictfuncs.nim b/compiler/semstrictfuncs.nim new file mode 100644 index 000000000..c54196283 --- /dev/null +++ b/compiler/semstrictfuncs.nim @@ -0,0 +1,55 @@ +# +# +# The Nim Compiler +# (c) Copyright 2022 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## New "strict funcs" checking. Much simpler and hopefully easier to teach than +## the old but more advanced algorithm that can/could be found in `varpartitions.nim`. + +import ast, typeallowed, renderer +from aliasanalysis import PathKinds0, PathKinds1 +from trees import getMagic + +proc isDangerousLocation*(n: PNode; owner: PSym): bool = + var n = n + var hasDeref = false + while true: + case n.kind + of nkDerefExpr, nkHiddenDeref: + if n[0].typ.kind != tyVar: + hasDeref = true + n = n[0] + of PathKinds0 - {nkDerefExpr, nkHiddenDeref}: + n = n[0] + of PathKinds1: + n = n[1] + of nkCallKinds: + if n.len > 1: + if (n.typ != nil and classifyViewType(n.typ) != noView) or getMagic(n) == mSlice: + # borrow from first parameter: + n = n[1] + else: + break + else: + break + else: + break + if n.kind == nkSym: + # dangerous if contains a pointer deref or if it doesn't belong to us: + result = hasDeref or n.sym.owner != owner + when false: + # store to something that belongs to a `var` parameter is fine: + let s = n.sym + if s.kind == skParam: + # dangerous unless a `var T` parameter: + result = s.typ.kind != tyVar + else: + # dangerous if contains a pointer deref or if it doesn't belong to us: + result = hasDeref or s.owner != owner + else: + # dangerous if it contains a pointer deref + result = hasDeref diff --git a/compiler/semtempl.nim b/compiler/semtempl.nim index 40502daf4..817cb6249 100644 --- a/compiler/semtempl.nim +++ b/compiler/semtempl.nim @@ -34,6 +34,7 @@ type spNone, spGenSym, spInject proc symBinding(n: PNode): TSymBinding = + result = spNone for i in 0..<n.len: var it = n[i] var key = if it.kind == nkExprColonExpr: it[0] else: it @@ -51,7 +52,7 @@ proc symChoice(c: PContext, n: PNode, s: PSym, r: TSymChoiceRule; isField = false): PNode = var a: PSym - o: TOverloadIter + o: TOverloadIter = default(TOverloadIter) var i = 0 a = initOverloadIter(o, c, n) while a != nil: @@ -70,6 +71,9 @@ proc symChoice(c: PContext, n: PNode, s: PSym, r: TSymChoiceRule; onUse(info, s) else: result = n + elif i == 0: + # forced open but symbol not in scope, retain information + result = n else: # semantic checking requires a type; ``fitNode`` deals with it # appropriately @@ -78,7 +82,7 @@ proc symChoice(c: PContext, n: PNode, s: PSym, r: TSymChoiceRule; result = newNodeIT(kind, info, newTypeS(tyNone, c)) a = initOverloadIter(o, c, n) while a != nil: - if a.kind != skModule and (not isField or sfGenSym notin s.flags): + if a.kind != skModule and (not isField or sfGenSym notin a.flags): incl(a.flags, sfUsed) markOwnerModuleAsUsed(c, a) result.add newSymNode(a, info) @@ -112,7 +116,8 @@ proc semMixinStmt(c: PContext, n: PNode, toMixin: var IntSet): PNode = result = copyNode(n) for i in 0..<n.len: toMixin.incl(considerQuotedIdent(c, n[i]).id) - result.add symChoice(c, n[i], nil, scForceOpen) + let x = symChoice(c, n[i], nil, scForceOpen) + result.add x proc replaceIdentBySym(c: PContext; n: var PNode, s: PNode) = case n.kind @@ -131,27 +136,32 @@ type noGenSym: int inTemplateHeader: int -template withBracketExpr(ctx, x, body: untyped) = - body +proc isTemplParam(c: TemplCtx, s: PSym): bool {.inline.} = + result = s.kind == skParam and + s.owner == c.owner and sfTemplateParam in s.flags -proc getIdentNode(c: var TemplCtx, n: PNode): PNode = +proc getIdentReplaceParams(c: var TemplCtx, n: var PNode): tuple[node: PNode, hasParam: bool] = case n.kind - of nkPostfix: result = getIdentNode(c, n[1]) - of nkPragmaExpr: result = getIdentNode(c, n[0]) + of nkPostfix: result = getIdentReplaceParams(c, n[1]) + of nkPragmaExpr: result = getIdentReplaceParams(c, n[0]) of nkIdent: - result = n + result = (n, false) let s = qualifiedLookUp(c.c, n, {}) - if s != nil: - if s.owner == c.owner and s.kind == skParam: - result = newSymNode(s, n.info) - of nkAccQuoted, nkSym: result = n + if s != nil and isTemplParam(c, s): + n = newSymNode(s, n.info) + result = (n, true) + of nkSym: + result = (n, isTemplParam(c, n.sym)) + of nkAccQuoted: + result = (n, false) + for i in 0..<n.safeLen: + let (ident, hasParam) = getIdentReplaceParams(c, n[i]) + if hasParam: + result.node[i] = ident + result.hasParam = true else: illFormedAst(n, c.c.config) - result = n - -proc isTemplParam(c: TemplCtx, n: PNode): bool {.inline.} = - result = n.kind == nkSym and n.sym.kind == skParam and - n.sym.owner == c.owner and sfTemplateParam in n.sym.flags + result = (n, false) proc semTemplBody(c: var TemplCtx, n: PNode): PNode @@ -166,73 +176,54 @@ proc semTemplBodyScope(c: var TemplCtx, n: PNode): PNode = result = semTemplBody(c, n) closeScope(c) -proc onlyReplaceParams(c: var TemplCtx, n: PNode): PNode = - result = n - if n.kind == nkIdent: - let s = qualifiedLookUp(c.c, n, {}) - if s != nil: - if s.owner == c.owner and s.kind == skParam: - incl(s.flags, sfUsed) - result = newSymNode(s, n.info) - onUse(n.info, s) - else: - for i in 0..<n.safeLen: - result[i] = onlyReplaceParams(c, n[i]) - proc newGenSym(kind: TSymKind, n: PNode, c: var TemplCtx): PSym = - result = newSym(kind, considerQuotedIdent(c.c, n), nextSymId c.c.idgen, c.owner, n.info) + result = newSym(kind, considerQuotedIdent(c.c, n), c.c.idgen, c.owner, n.info) incl(result.flags, sfGenSym) incl(result.flags, sfShadowed) proc addLocalDecl(c: var TemplCtx, n: var PNode, k: TSymKind) = - # locals default to 'gensym': - if n.kind == nkPragmaExpr and symBinding(n[1]) == spInject: + # locals default to 'gensym', fields default to 'inject': + if (n.kind == nkPragmaExpr and symBinding(n[1]) == spInject) or + k == skField: # even if injected, don't produce a sym choice here: #n = semTemplBody(c, n) - var x = n[0] - while true: - case x.kind - of nkPostfix: x = x[1] - of nkPragmaExpr: x = x[0] - of nkIdent: break - of nkAccQuoted: - # consider: type `T TemplParam` {.inject.} - # it suffices to return to treat it like 'inject': - n = onlyReplaceParams(c, n) - return - else: - illFormedAst(x, c.c.config) - let ident = getIdentNode(c, x) - if not isTemplParam(c, ident): - c.toInject.incl(x.ident.id) - else: - replaceIdentBySym(c.c, n, ident) + let (ident, hasParam) = getIdentReplaceParams(c, n) + if not hasParam: + if k != skField: + c.toInject.incl(considerQuotedIdent(c.c, ident).id) else: if (n.kind == nkPragmaExpr and n.len >= 2 and n[1].kind == nkPragma): let pragmaNode = n[1] for i in 0..<pragmaNode.len: - openScope(c) - pragmaNode[i] = semTemplBody(c,pragmaNode[i]) - closeScope(c) - let ident = getIdentNode(c, n) - if not isTemplParam(c, ident): - if n.kind != nkSym: + let ni = pragmaNode[i] + # see D20210801T100514 + var found = false + if ni.kind == nkIdent: + for a in templatePragmas: + if ni.ident.id == ord(a): + found = true + break + if not found: + openScope(c) + pragmaNode[i] = semTemplBody(c, pragmaNode[i]) + closeScope(c) + let (ident, hasParam) = getIdentReplaceParams(c, n) + if not hasParam: + if n.kind != nkSym and not (n.kind == nkIdent and n.ident.id == ord(wUnderscore)): let local = newGenSym(k, ident, c) addPrelimDecl(c.c, local) - styleCheckDef(c.c.config, n.info, local) + styleCheckDef(c.c, n.info, local) onDef(n.info, local) replaceIdentBySym(c.c, n, newSymNode(local, n.info)) if k == skParam and c.inTemplateHeader > 0: local.flags.incl sfTemplateParam - else: - replaceIdentBySym(c.c, n, ident) -proc semTemplSymbol(c: PContext, n: PNode, s: PSym; isField: bool): PNode = +proc semTemplSymbol(c: var TemplCtx, n: PNode, s: PSym; isField, isAmbiguous: bool): PNode = incl(s.flags, sfUsed) # bug #12885; ideally sem'checking is performed again afterwards marking # the symbol as used properly, but the nfSem mechanism currently prevents # that from happening, so we mark the module as used here already: - markOwnerModuleAsUsed(c, s) + markOwnerModuleAsUsed(c.c, s) # we do not call onUse here, as the identifier is not really # resolved here. We will fixup the used identifiers later. case s.kind @@ -240,54 +231,97 @@ proc semTemplSymbol(c: PContext, n: PNode, s: PSym; isField: bool): PNode = # Introduced in this pass! Leave it as an identifier. result = n of OverloadableSyms: - result = symChoice(c, n, s, scOpen, isField) + result = symChoice(c.c, n, s, scOpen, isField) + if not isField and result.kind in {nkSym, nkOpenSymChoice}: + if openSym in c.c.features: + if result.kind == nkSym: + result = newOpenSym(result) + else: + result.typ = nil + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil of skGenericParam: if isField and sfGenSym in s.flags: result = n - else: result = newSymNodeTypeDesc(s, c.idgen, n.info) + else: + result = newSymNodeTypeDesc(s, c.c.idgen, n.info) + if not isField and s.owner != c.owner: + if openSym in c.c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil of skParam: result = n of skType: if isField and sfGenSym in s.flags: result = n - else: result = newSymNodeTypeDesc(s, c.idgen, n.info) + else: + if isAmbiguous: + # ambiguous types should be symchoices since lookup behaves + # differently for them in regular expressions + result = symChoice(c.c, n, s, scOpen, isField) + else: result = newSymNodeTypeDesc(s, c.c.idgen, n.info) + if not isField and not (s.owner == c.owner and + s.typ != nil and s.typ.kind == tyGenericParam) and + result.kind in {nkSym, nkOpenSymChoice}: + if openSym in c.c.features: + if result.kind == nkSym: + result = newOpenSym(result) + else: + result.typ = nil + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil else: if isField and sfGenSym in s.flags: result = n - else: result = newSymNode(s, n.info) + else: + result = newSymNode(s, n.info) + if not isField: + if openSym in c.c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil # Issue #12832 when defined(nimsuggest): - suggestSym(c.graph, n.info, s, c.graph.usageSym, false) - if {optStyleHint, optStyleError} * c.config.globalOptions != {}: - styleCheckUse(c.config, n.info, s) + suggestSym(c.c.graph, n.info, s, c.c.graph.usageSym, false) + # field access (dot expr) will be handled by builtinFieldAccess + if not isField: + styleCheckUse(c.c, n.info, s) -proc semRoutineInTemplName(c: var TemplCtx, n: PNode): PNode = +proc semRoutineInTemplName(c: var TemplCtx, n: PNode, explicitInject: bool): PNode = result = n if n.kind == nkIdent: let s = qualifiedLookUp(c.c, n, {}) if s != nil: - if s.owner == c.owner and (s.kind == skParam or sfGenSym in s.flags): + if s.owner == c.owner and (s.kind == skParam or + (sfGenSym in s.flags and not explicitInject)): incl(s.flags, sfUsed) result = newSymNode(s, n.info) onUse(n.info, s) else: for i in 0..<n.safeLen: - result[i] = semRoutineInTemplName(c, n[i]) + result[i] = semRoutineInTemplName(c, n[i], explicitInject) proc semRoutineInTemplBody(c: var TemplCtx, n: PNode, k: TSymKind): PNode = result = n checkSonsLen(n, bodyPos + 1, c.c.config) - # routines default to 'inject': - if n.kind notin nkLambdaKinds and symBinding(n[pragmasPos]) == spGenSym: - let ident = getIdentNode(c, n[namePos]) - if not isTemplParam(c, ident): - var s = newGenSym(k, ident, c) - s.ast = n - addPrelimDecl(c.c, s) - styleCheckDef(c.c.config, n.info, s) - onDef(n.info, s) - n[namePos] = newSymNode(s, n[namePos].info) + if n.kind notin nkLambdaKinds: + # routines default to 'inject': + let binding = symBinding(n[pragmasPos]) + if binding == spGenSym: + let (ident, hasParam) = getIdentReplaceParams(c, n[namePos]) + if not hasParam: + var s = newGenSym(k, ident, c) + s.ast = n + addPrelimDecl(c.c, s) + styleCheckDef(c.c, n.info, s) + onDef(n.info, s) + n[namePos] = newSymNode(s, n[namePos].info) + else: + n[namePos] = ident else: - n[namePos] = ident - else: - n[namePos] = semRoutineInTemplName(c, n[namePos]) + n[namePos] = semRoutineInTemplName(c, n[namePos], binding == spInject) # open scope for parameters openScope(c) for i in patternPos..paramsPos-1: @@ -309,22 +343,29 @@ proc semRoutineInTemplBody(c: var TemplCtx, n: PNode, k: TSymKind): PNode = # close scope for parameters closeScope(c) -proc semTemplSomeDecl(c: var TemplCtx, n: PNode, symKind: TSymKind; start=0) = +proc semTemplIdentDef(c: var TemplCtx, a: PNode, symKind: TSymKind) = + checkMinSonsLen(a, 3, c.c.config) + when defined(nimsuggest): + inc c.c.inTypeContext + a[^2] = semTemplBody(c, a[^2]) + when defined(nimsuggest): + dec c.c.inTypeContext + a[^1] = semTemplBody(c, a[^1]) + for j in 0..<a.len-2: + addLocalDecl(c, a[j], symKind) + +proc semTemplSomeDecl(c: var TemplCtx, n: PNode, symKind: TSymKind; start = 0) = for i in start..<n.len: var a = n[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkIdentDefs) and (a.kind != nkVarTuple): illFormedAst(a, c.c.config) - checkMinSonsLen(a, 3, c.c.config) - when defined(nimsuggest): - inc c.c.inTypeContext - a[^2] = semTemplBody(c, a[^2]) - when defined(nimsuggest): - dec c.c.inTypeContext - a[^1] = semTemplBody(c, a[^1]) - for j in 0..<a.len-2: - addLocalDecl(c, a[j], symKind) + case a.kind: + of nkCommentStmt: continue + of nkIdentDefs, nkVarTuple, nkConstDef: + semTemplIdentDef(c, a, symKind) + else: + illFormedAst(a, c.c.config) -proc semPattern(c: PContext, n: PNode): PNode + +proc semPattern(c: PContext, n: PNode; s: PSym): PNode proc semTemplBodySons(c: var TemplCtx, n: PNode): PNode = result = n @@ -337,6 +378,7 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = case n.kind of nkIdent: if n.ident.id in c.toInject: return n + c.c.isAmbiguous = false let s = qualifiedLookUp(c.c, n, {}) if s != nil: if s.owner == c.owner and s.kind == skParam and sfTemplateParam in s.flags: @@ -354,7 +396,9 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = result = newSymNode(s, n.info) onUse(n.info, s) else: - result = semTemplSymbol(c.c, n, s, c.noGenSym > 0) + if s.kind in {skVar, skLet, skConst}: + discard qualifiedLookUp(c.c, n, {checkAmbiguity, checkModule}) + result = semTemplSymbol(c, n, s, c.noGenSym > 0, c.c.isAmbiguous) of nkBind: result = semTemplBody(c, n[0]) of nkBindStmt: @@ -411,7 +455,7 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = # labels are always 'gensym'ed: let s = newGenSym(skLabel, n[0], c) addPrelimDecl(c.c, s) - styleCheckDef(c.c.config, s) + styleCheckDef(c.c, s) onDef(n[0].info, s) n[0] = newSymNode(s, n[0].info) n[1] = semTemplBody(c, n[1]) @@ -437,15 +481,7 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = checkMinSonsLen(n, 1, c.c.config) semTemplSomeDecl(c, n, skParam, 1) n[0] = semTemplBody(c, n[0]) - of nkConstSection: - for i in 0..<n.len: - var a = n[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkConstDef): illFormedAst(a, c.c.config) - checkSonsLen(a, 3, c.c.config) - addLocalDecl(c, a[0], skConst) - a[1] = semTemplBody(c, a[1]) - a[2] = semTemplBody(c, a[2]) + of nkConstSection: semTemplSomeDecl(c, n, skConst) of nkTypeSection: for i in 0..<n.len: var a = n[i] @@ -465,6 +501,25 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = closeScope(c) else: a[2] = semTemplBody(c, a[2]) + of nkObjectTy: + openScope(c) + result = semTemplBodySons(c, n) + closeScope(c) + of nkRecList: + for i in 0..<n.len: + var a = n[i] + case a.kind: + of nkCommentStmt, nkNilLit, nkSym, nkEmpty: continue + of nkIdentDefs: + semTemplIdentDef(c, a, skField) + of nkRecCase, nkRecWhen: + n[i] = semTemplBody(c, a) + else: + illFormedAst(a, c.c.config) + of nkRecCase: + semTemplIdentDef(c, n[0], skField) + for i in 1..<n.len: + n[i] = semTemplBody(c, n[i]) of nkProcDef, nkLambdaKinds: result = semRoutineInTemplBody(c, n, skProc) of nkFuncDef: @@ -488,18 +543,23 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = if x.kind == nkExprColonExpr: x[1] = semTemplBody(c, x[1]) of nkBracketExpr: - result = newNodeI(nkCall, n.info) - result.add newIdentNode(getIdent(c.c.cache, "[]"), n.info) - for i in 0..<n.len: result.add(n[i]) - let n0 = semTemplBody(c, n[0]) - withBracketExpr c, n0: - result = semTemplBodySons(c, result) + if n.typ == nil: + # if a[b] is nested inside a typed expression, don't convert it + # back to `[]`(a, b), prepareOperand will not typecheck it again + # and so `[]` will not be resolved + # checking if a[b] is typed should be enough to cover this case + result = newNodeI(nkCall, n.info) + result.add newIdentNode(getIdent(c.c.cache, "[]"), n.info) + for i in 0..<n.len: result.add(n[i]) + result = semTemplBodySons(c, result) of nkCurlyExpr: - result = newNodeI(nkCall, n.info) - result.add newIdentNode(getIdent(c.c.cache, "{}"), n.info) - for i in 0..<n.len: result.add(n[i]) + if n.typ == nil: + # see nkBracketExpr case for explanation + result = newNodeI(nkCall, n.info) + result.add newIdentNode(getIdent(c.c.cache, "{}"), n.info) + for i in 0..<n.len: result.add(n[i]) result = semTemplBodySons(c, result) - of nkAsgn, nkFastAsgn: + of nkAsgn, nkFastAsgn, nkSinkAsgn: checkSonsLen(n, 2, c.c.config) let a = n[0] let b = n[1] @@ -507,18 +567,21 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = let k = a.kind case k of nkBracketExpr: - result = newNodeI(nkCall, n.info) - result.add newIdentNode(getIdent(c.c.cache, "[]="), n.info) - for i in 0..<a.len: result.add(a[i]) - result.add(b) + if a.typ == nil: + # see nkBracketExpr case above for explanation + result = newNodeI(nkCall, n.info) + result.add newIdentNode(getIdent(c.c.cache, "[]="), n.info) + for i in 0..<a.len: result.add(a[i]) + result.add(b) let a0 = semTemplBody(c, a[0]) - withBracketExpr c, a0: - result = semTemplBodySons(c, result) + result = semTemplBodySons(c, result) of nkCurlyExpr: - result = newNodeI(nkCall, n.info) - result.add newIdentNode(getIdent(c.c.cache, "{}="), n.info) - for i in 0..<a.len: result.add(a[i]) - result.add(b) + if a.typ == nil: + # see nkBracketExpr case above for explanation + result = newNodeI(nkCall, n.info) + result.add newIdentNode(getIdent(c.c.cache, "{}="), n.info) + for i in 0..<a.len: result.add(a[i]) + result.add(b) result = semTemplBodySons(c, result) else: result = semTemplBodySons(c, n) @@ -529,8 +592,10 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = of nkDotExpr, nkAccQuoted: # dotExpr is ambiguous: note that we explicitly allow 'x.TemplateParam', # so we use the generic code for nkDotExpr too + c.c.isAmbiguous = false let s = qualifiedLookUp(c.c, n, {}) if s != nil: + # mirror the nkIdent case # do not symchoice a quoted template parameter (bug #2390): if s.owner == c.owner and s.kind == skParam and n.kind == nkAccQuoted and n.len == 1: @@ -542,13 +607,23 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = elif contains(c.toMixin, s.name.id): return symChoice(c.c, n, s, scForceOpen, c.noGenSym > 0) else: - return symChoice(c.c, n, s, scOpen, c.noGenSym > 0) + if s.kind in {skVar, skLet, skConst}: + discard qualifiedLookUp(c.c, n, {checkAmbiguity, checkModule}) + return semTemplSymbol(c, n, s, c.noGenSym > 0, c.c.isAmbiguous) if n.kind == nkDotExpr: result = n result[0] = semTemplBody(c, n[0]) inc c.noGenSym result[1] = semTemplBody(c, n[1]) dec c.noGenSym + if result[1].kind == nkSym and result[1].sym.kind in routineKinds: + # prevent `dotTransformation` from rewriting this node to `nkIdent` + # by making it a symchoice + # in generics this becomes `nkClosedSymChoice` but this breaks code + # as the old behavior here was that this became `nkIdent` + var choice = newNodeIT(nkOpenSymChoice, n[1].info, newTypeS(tyNone, c.c)) + choice.add result[1] + result[1] = choice else: result = semTemplBodySons(c, n) of nkExprColonExpr, nkExprEqExpr: @@ -594,7 +669,12 @@ proc semTemplBodyDirty(c: var TemplCtx, n: PNode): PNode = for i in 0..<n.len: result[i] = semTemplBodyDirty(c, n[i]) +# in semstmts.nim: +proc semProcAnnotation(c: PContext, prc: PNode; validPragmas: TSpecialWords): PNode + proc semTemplateDef(c: PContext, n: PNode): PNode = + result = semProcAnnotation(c, n, templatePragmas) + if result != nil: return result result = n var s: PSym if isTopLevel(c): @@ -604,58 +684,77 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = s = semIdentVis(c, skTemplate, n[namePos], {}) assert s.kind == skTemplate - if s.owner != nil: - const names = ["!=", ">=", ">", "incl", "excl", "in", "notin", "isnot"] - if sfSystemModule in s.owner.flags and s.name.s in names or - s.owner.name.s == "vm" and s.name.s == "stackTrace": - incl(s.flags, sfCallsite) - - s.ast = n - - styleCheckDef(c.config, s) + styleCheckDef(c, s) onDef(n[namePos].info, s) # check parameter list: #s.scope = c.currentScope + # push noalias flag at first to prevent unwanted recursive calls: + incl(s.flags, sfNoalias) pushOwner(c, s) openScope(c) n[namePos] = newSymNode(s) + s.ast = n # for implicitPragmas to use pragmaCallable(c, s, n, templatePragmas) implicitPragmas(c, s, n.info, templatePragmas) setGenericParamsMisc(c, n) # process parameters: var allUntyped = true + var nullary = true if n[paramsPos].kind != nkEmpty: semParamList(c, n[paramsPos], n[genericParamsPos], s) # a template's parameters are not gensym'ed even if that was originally the # case as we determine whether it's a template parameter in the template # body by the absence of the sfGenSym flag: + let retType = s.typ.returnType + if retType != nil and retType.kind != tyUntyped: + allUntyped = false for i in 1..<s.typ.n.len: let param = s.typ.n[i].sym - param.flags.incl sfTemplateParam - param.flags.excl sfGenSym + if param.name.id != ord(wUnderscore): + param.flags.incl sfTemplateParam + param.flags.excl sfGenSym if param.typ.kind != tyUntyped: allUntyped = false + # no default value, parameters required in call + if param.ast == nil: nullary = false else: s.typ = newTypeS(tyProc, c) # XXX why do we need tyTyped as a return type again? s.typ.n = newNodeI(nkFormalParams, n.info) rawAddSon(s.typ, newTypeS(tyTyped, c)) - s.typ.n.add newNodeIT(nkType, n.info, s.typ[0]) + s.typ.n.add newNodeIT(nkType, n.info, s.typ.returnType) if n[genericParamsPos].safeLen == 0: # restore original generic type params as no explicit or implicit were found n[genericParamsPos] = n[miscPos][1] n[miscPos] = c.graph.emptyNode if allUntyped: incl(s.flags, sfAllUntyped) - + if nullary and + n[genericParamsPos].kind == nkEmpty and + n[bodyPos].kind != nkEmpty: + # template can be called with alias syntax, remove pushed noalias flag + excl(s.flags, sfNoalias) + if n[patternPos].kind != nkEmpty: - n[patternPos] = semPattern(c, n[patternPos]) - - var ctx: TemplCtx - ctx.toBind = initIntSet() - ctx.toMixin = initIntSet() - ctx.toInject = initIntSet() - ctx.c = c - ctx.owner = s + n[patternPos] = semPattern(c, n[patternPos], s) + + var ctx = TemplCtx( + toBind: initIntSet(), + toMixin: initIntSet(), + toInject: initIntSet(), + c: c, + owner: s + ) + # handle default params: + for i in 1..<s.typ.n.len: + let param = s.typ.n[i].sym + if param.ast != nil: + # param default values need to be treated like template body: + if sfDirty in s.flags: + param.ast = semTemplBodyDirty(ctx, param.ast) + else: + param.ast = semTemplBody(ctx, param.ast) + if param.ast.referencesAnotherParam(s): + param.ast.flags.incl nfDefaultRefsParam if sfDirty in s.flags: n[bodyPos] = semTemplBodyDirty(ctx, n[bodyPos]) else: @@ -664,6 +763,7 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = semIdeForTemplateOrGeneric(c, n[bodyPos], ctx.cursorInBody) closeScope(c) popOwner(c) + if sfCustomPragma in s.flags: if n[bodyPos].kind != nkEmpty: localError(c.config, n[bodyPos].info, errImplOfXNotAllowed % s.name.s) @@ -673,6 +773,9 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = if proto == nil: addInterfaceOverloadableSymAt(c, c.currentScope, s) elif not comesFromShadowscope: + if {sfTemplateRedefinition, sfGenSym} * s.flags == {}: + #wrongRedefinition(c, n.info, proto.name.s, proto.info) + message(c.config, n.info, warnImplicitTemplateRedefinition, s.name.s) symTabReplace(c.currentScope.symbols, proto, s) if n[patternPos].kind != nkEmpty: c.patterns.add(s) @@ -795,14 +898,15 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = for i in 0..<n.len: result[i] = semPatternBody(c, n[i]) -proc semPattern(c: PContext, n: PNode): PNode = +proc semPattern(c: PContext, n: PNode; s: PSym): PNode = openScope(c) - var ctx: TemplCtx - ctx.toBind = initIntSet() - ctx.toMixin = initIntSet() - ctx.toInject = initIntSet() - ctx.c = c - ctx.owner = getCurrOwner(c) + var ctx = TemplCtx( + toBind: initIntSet(), + toMixin: initIntSet(), + toInject: initIntSet(), + c: c, + owner: getCurrOwner(c) + ) result = flattenStmts(semPatternBody(ctx, n)) if result.kind in {nkStmtList, nkStmtListExpr}: if result.len == 1: @@ -810,3 +914,4 @@ proc semPattern(c: PContext, n: PNode): PNode = elif result.len == 0: localError(c.config, n.info, "a pattern cannot be empty") closeScope(c) + addPattern(c, LazySym(sym: s)) diff --git a/compiler/semtypes.nim b/compiler/semtypes.nim index dcab9a884..113946fef 100644 --- a/compiler/semtypes.nim +++ b/compiler/semtypes.nim @@ -10,22 +10,20 @@ # this module does the semantic checking of type declarations # included from sem.nim -import math - const errStringOrIdentNodeExpected = "string or ident node expected" errStringLiteralExpected = "string literal expected" errIntLiteralExpected = "integer literal expected" errWrongNumberOfVariables = "wrong number of variables" - errInvalidOrderInEnumX = "invalid order in enum '$1'" - errOrdinalTypeExpected = "ordinal type expected" - errSetTooBig = "set is too large" + errDuplicateAliasInEnumX = "duplicate value in enum '$1'" + errOverflowInEnumX = "The enum '$1' exceeds its maximum value ($2)" + errOrdinalTypeExpected = "ordinal type expected; given: $1" + errSetTooBig = "set is too large; use `std/sets` for ordinal types with more than 2^16 elements" errBaseTypeMustBeOrdinal = "base type of a set must be an ordinal" errInheritanceOnlyWithNonFinalObjects = "inheritance only works with non-final objects" errXExpectsOneTypeParam = "'$1' expects one type parameter" errArrayExpectsTwoTypeParams = "array expects two type parameters" errInvalidVisibilityX = "invalid visibility: '$1'" - errInitHereNotAllowed = "initialization not allowed here" errXCannotBeAssignedTo = "'$1' cannot be assigned to" errIteratorNotAllowed = "iterators can only be defined at the module's top level" errXNeedsReturnType = "$1 needs a return type" @@ -40,13 +38,21 @@ const errNoGenericParamsAllowedForX = "no generic parameters allowed for $1" errInOutFlagNotExtern = "the '$1' modifier can be used only with imported types" +proc newOrPrevType(kind: TTypeKind, prev: PType, c: PContext, son: sink PType): PType = + if prev == nil or prev.kind == tyGenericBody: + result = newTypeS(kind, c, son) + else: + result = prev + result.setSon(son) + if result.kind == tyForward: result.kind = kind + #if kind == tyError: result.flags.incl tfCheckedForDestructor + proc newOrPrevType(kind: TTypeKind, prev: PType, c: PContext): PType = - if prev == nil: + if prev == nil or prev.kind == tyGenericBody: result = newTypeS(kind, c) else: result = prev if result.kind == tyForward: result.kind = kind - #if kind == tyError: result.flags.incl tfCheckedForDestructor proc newConstraint(c: PContext, k: TTypeKind): PType = result = newTypeS(tyBuiltInTypeClass, c) @@ -59,10 +65,11 @@ proc semEnum(c: PContext, n: PNode, prev: PType): PType = # don't create an empty tyEnum; fixes #3052 return errorType(c) var - counter, x: BiggestInt - e: PSym - base: PType - identToReplace: ptr PNode + counter, x: BiggestInt = 0 + e: PSym = nil + base: PType = nil + identToReplace: ptr PNode = nil + counterSet = initPackedSet[BiggestInt]() counter = 0 base = nil result = newOrPrevType(tyEnum, prev, c) @@ -75,11 +82,11 @@ proc semEnum(c: PContext, n: PNode, prev: PType): PType = counter = toInt64(lastOrd(c.config, base)) + 1 rawAddSon(result, base) let isPure = result.sym != nil and sfPure in result.sym.flags - var symbols: TStrTable - if isPure: initStrTable(symbols) + var symbols: TStrTable = initStrTable() var hasNull = false for i in 1..<n.len: if n[i].kind == nkEmpty: continue + var useAutoCounter = false case n[i].kind of nkEnumFieldDef: if n[i][0].kind == nkPragmaExpr: @@ -95,61 +102,77 @@ proc semEnum(c: PContext, n: PNode, prev: PType): PType = of tyTuple: if v.len == 2: strVal = v[1] # second tuple part is the string value - if skipTypes(strVal.typ, abstractInst).kind in {tyString, tyCString}: + if skipTypes(strVal.typ, abstractInst).kind in {tyString, tyCstring}: if not isOrdinalType(v[0].typ, allowEnumWithHoles=true): - localError(c.config, v[0].info, errOrdinalTypeExpected & "; given: " & typeToString(v[0].typ, preferDesc)) + localError(c.config, v[0].info, errOrdinalTypeExpected % typeToString(v[0].typ, preferDesc)) x = toInt64(getOrdValue(v[0])) # first tuple part is the ordinal n[i][1][0] = newIntTypeNode(x, getSysType(c.graph, unknownLineInfo, tyInt)) else: localError(c.config, strVal.info, errStringLiteralExpected) else: localError(c.config, v.info, errWrongNumberOfVariables) - of tyString, tyCString: + of tyString, tyCstring: strVal = v x = counter + useAutoCounter = true else: - if not isOrdinalType(v.typ, allowEnumWithHoles=true): - localError(c.config, v.info, errOrdinalTypeExpected & "; given: " & typeToString(v.typ, preferDesc)) - x = toInt64(getOrdValue(v)) - n[i][1] = newIntTypeNode(x, getSysType(c.graph, unknownLineInfo, tyInt)) + if isOrdinalType(v.typ, allowEnumWithHoles=true): + x = toInt64(getOrdValue(v)) + n[i][1] = newIntTypeNode(x, getSysType(c.graph, unknownLineInfo, tyInt)) + else: + localError(c.config, v.info, errOrdinalTypeExpected % typeToString(v.typ, preferDesc)) if i != 1: if x != counter: incl(result.flags, tfEnumHasHoles) - if x < counter: - localError(c.config, n[i].info, errInvalidOrderInEnumX % e.name.s) - x = counter e.ast = strVal # might be nil counter = x of nkSym: e = n[i].sym + useAutoCounter = true of nkIdent, nkAccQuoted: e = newSymS(skEnumField, n[i], c) identToReplace = addr n[i] + useAutoCounter = true of nkPragmaExpr: e = newSymS(skEnumField, n[i][0], c) pragma(c, e, n[i][1], enumFieldPragmas) identToReplace = addr n[i][0] + useAutoCounter = true else: illFormedAst(n[i], c.config) + + if useAutoCounter: + while counter in counterSet and counter != high(typeof(counter)): + inc counter + counterSet.incl counter + elif counterSet.containsOrIncl(counter): + localError(c.config, n[i].info, errDuplicateAliasInEnumX % e.name.s) + e.typ = result e.position = int(counter) let symNode = newSymNode(e) - if optNimV1Emulation notin c.config.globalOptions and identToReplace != nil and - c.config.cmd notin cmdDocLike: # A hack to produce documentation for enum fields. + if identToReplace != nil and c.config.cmd notin cmdDocLike: + # A hack to produce documentation for enum fields. identToReplace[] = symNode if e.position == 0: hasNull = true if result.sym != nil and sfExported in result.sym.flags: - incl(e.flags, sfUsed) - incl(e.flags, sfExported) - if not isPure: exportSym(c, e) + e.flags.incl {sfUsed, sfExported} + result.n.add symNode - styleCheckDef(c.config, e) + styleCheckDef(c, e) onDef(e.info, e) + suggestSym(c.graph, e.info, e, c.graph.usageSym) if sfGenSym notin e.flags: - if not isPure: addDecl(c, e) - else: declarePureEnumField(c, e) - if isPure and (let conflict = strTableInclReportConflict(symbols, e); conflict != nil): + if not isPure: + addInterfaceOverloadableSymAt(c, c.currentScope, e) + else: + declarePureEnumField(c, e) + if (let conflict = strTableInclReportConflict(symbols, e); conflict != nil): wrongRedefinition(c, e.info, e.name.s, conflict.info) - inc(counter) + if counter == high(typeof(counter)): + if i > 1 and result.n[i-2].sym.position == high(int): + localError(c.config, n[i].info, errOverflowInEnumX % [e.name.s, $high(typeof(counter))]) + else: + inc(counter) if isPure and sfExported in result.sym.flags: addPureEnum(c, LazySym(sym: result.sym)) if tfNotNil in e.typ.flags and not hasNull: @@ -161,10 +184,12 @@ proc semSet(c: PContext, n: PNode, prev: PType): PType = if n.len == 2 and n[1].kind != nkEmpty: var base = semTypeNode(c, n[1], nil) addSonSkipIntLit(result, base, c.idgen) - if base.kind in {tyGenericInst, tyAlias, tySink}: base = lastSon(base) + if base.kind in {tyGenericInst, tyAlias, tySink}: base = skipModifier(base) if base.kind notin {tyGenericParam, tyGenericInvocation}: - if not isOrdinalType(base, allowEnumWithHoles = true): - localError(c.config, n.info, errOrdinalTypeExpected) + if base.kind == tyForward: + c.skipTypes.add n + elif not isOrdinalType(base, allowEnumWithHoles = true): + localError(c.config, n.info, errOrdinalTypeExpected % typeToString(base, preferDesc)) elif lengthOrd(c.config, base) > MaxSetElements: localError(c.config, n.info, errSetTooBig) else: @@ -197,9 +222,10 @@ proc semVarargs(c: PContext, n: PNode, prev: PType): PType = localError(c.config, n.info, errXExpectsOneTypeParam % "varargs") addSonSkipIntLit(result, errorType(c), c.idgen) -proc semVarOutType(c: PContext, n: PNode, prev: PType; kind: TTypeKind): PType = +proc semVarOutType(c: PContext, n: PNode, prev: PType; flags: TTypeFlags): PType = if n.len == 1: - result = newOrPrevType(kind, prev, c) + result = newOrPrevType(tyVar, prev, c) + result.flags = flags var base = semTypeNode(c, n[0], nil) if base.kind == tyTypeDesc and not isSelf(base): base = base[0] @@ -208,12 +234,59 @@ proc semVarOutType(c: PContext, n: PNode, prev: PType; kind: TTypeKind): PType = base = base[0] addSonSkipIntLit(result, base, c.idgen) else: - result = newConstraint(c, kind) + result = newConstraint(c, tyVar) + +proc isRecursiveType(t: PType, cycleDetector: var IntSet): bool = + if t == nil: + return false + if cycleDetector.containsOrIncl(t.id): + return true + case t.kind + of tyAlias, tyGenericInst, tyDistinct: + return isRecursiveType(t.skipModifier, cycleDetector) + else: + return false + +proc fitDefaultNode(c: PContext, n: PNode): PType = + inc c.inStaticContext + let expectedType = if n[^2].kind != nkEmpty: semTypeNode(c, n[^2], nil) else: nil + n[^1] = semConstExpr(c, n[^1], expectedType = expectedType) + let oldType = n[^1].typ + n[^1].flags.incl nfSem + if n[^2].kind != nkEmpty: + if expectedType != nil and oldType != expectedType: + n[^1] = fitNodeConsiderViewType(c, expectedType, n[^1], n[^1].info) + changeType(c, n[^1], expectedType, true) # infer types for default fields value + # bug #22926; be cautious that it uses `semConstExpr` to + # evaulate the default fields; it's only natural to use + # `changeType` to infer types for constant values + # that's also the reason why we don't use `semExpr` to check + # the type since two overlapping error messages might be produced + result = n[^1].typ + else: + result = n[^1].typ + # xxx any troubles related to defaults fields, consult `semConst` for a potential answer + if n[^1].kind != nkNilLit: + typeAllowedCheck(c, n.info, result, skConst, {taProcContextIsNotMacro, taIsDefaultField}) + dec c.inStaticContext + +proc isRecursiveType*(t: PType): bool = + # handle simple recusive types before typeFinalPass + var cycleDetector = initIntSet() + isRecursiveType(t, cycleDetector) + +proc addSonSkipIntLitChecked(c: PContext; father, son: PType; it: PNode, id: IdGenerator) = + let s = son.skipIntLit(id) + father.add(s) + if isRecursiveType(s): + localError(c.config, it.info, "illegal recursion in type '" & typeToString(s) & "'") + else: + propagateToOwner(father, s) proc semDistinct(c: PContext, n: PNode, prev: PType): PType = if n.len == 0: return newConstraint(c, tyDistinct) result = newOrPrevType(tyDistinct, prev, c) - addSonSkipIntLit(result, semTypeNode(c, n[0], nil), c.idgen) + addSonSkipIntLitChecked(c, result, semTypeNode(c, n[0], nil), n[0], c.idgen) if n.len > 1: result.n = n[1] proc semRangeAux(c: PContext, n: PNode, prev: PType): PType = @@ -229,22 +302,25 @@ proc semRangeAux(c: PContext, n: PNode, prev: PType): PType = localError(c.config, n.info, "range is empty") var range: array[2, PNode] + # XXX this is still a hard compilation in a generic context, this can + # result in unresolved generic parameters being treated like real types range[0] = semExprWithType(c, n[1], {efDetermineType}) range[1] = semExprWithType(c, n[2], {efDetermineType}) - var rangeT: array[2, PType] + var rangeT: array[2, PType] = default(array[2, PType]) for i in 0..1: rangeT[i] = range[i].typ.skipTypes({tyStatic}).skipIntLit(c.idgen) let hasUnknownTypes = c.inGenericContext > 0 and - rangeT[0].kind == tyFromExpr or rangeT[1].kind == tyFromExpr + (rangeT[0].kind == tyFromExpr or rangeT[1].kind == tyFromExpr) if not hasUnknownTypes: if not sameType(rangeT[0].skipTypes({tyRange}), rangeT[1].skipTypes({tyRange})): - localError(c.config, n.info, "type mismatch") + typeMismatch(c.config, n.info, rangeT[0], rangeT[1], n) + 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") + localError(c.config, n.info, "ordinal or float type expected, but got " & typeToString(rangeT[0])) elif enumHasHoles(rangeT[0]): localError(c.config, n.info, "enum '$1' has holes" % typeToString(rangeT[0])) @@ -255,9 +331,8 @@ proc semRangeAux(c: PContext, n: PNode, prev: PType): PType = else: result.n.add semConstExpr(c, range[i]) - if (result.n[0].kind in {nkFloatLit..nkFloat64Lit} and classify(result.n[0].floatVal) == fcNan) or - (result.n[1].kind in {nkFloatLit..nkFloat64Lit} and classify(result.n[1].floatVal) == fcNan): - localError(c.config, n.info, "NaN is not a valid start or end for a range") + if result.n[i].kind in {nkFloatLit..nkFloat64Lit} and result.n[i].floatVal.isNaN: + localError(c.config, n.info, "NaN is not a valid range " & (if i == 0: "start" else: "end")) if weakLeValue(result.n[0], result.n[1]) == impNo: localError(c.config, n.info, "range is empty") @@ -269,17 +344,18 @@ proc semRange(c: PContext, n: PNode, prev: PType): PType = if n.len == 2: if isRange(n[1]): result = semRangeAux(c, n[1], prev) - let n = result.n - if n[0].kind in {nkCharLit..nkUInt64Lit} and n[0].intVal > 0: - incl(result.flags, tfRequiresInit) - elif n[1].kind in {nkCharLit..nkUInt64Lit} and n[1].intVal < 0: - incl(result.flags, tfRequiresInit) - elif n[0].kind in {nkFloatLit..nkFloat64Lit} and - n[0].floatVal > 0.0: - incl(result.flags, tfRequiresInit) - elif n[1].kind in {nkFloatLit..nkFloat64Lit} and - n[1].floatVal < 0.0: - incl(result.flags, tfRequiresInit) + if not isDefined(c.config, "nimPreviewRangeDefault"): + let n = result.n + if n[0].kind in {nkCharLit..nkUInt64Lit} and n[0].intVal > 0: + incl(result.flags, tfRequiresInit) + elif n[1].kind in {nkCharLit..nkUInt64Lit} and n[1].intVal < 0: + incl(result.flags, tfRequiresInit) + elif n[0].kind in {nkFloatLit..nkFloat64Lit} and + n[0].floatVal > 0.0: + incl(result.flags, tfRequiresInit) + elif n[1].kind in {nkFloatLit..nkFloat64Lit} and + n[1].floatVal < 0.0: + 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") @@ -290,31 +366,47 @@ proc semRange(c: PContext, n: PNode, prev: PType): PType = localError(c.config, n.info, errXExpectsOneTypeParam % "range") result = newOrPrevType(tyError, prev, c) +proc semArrayIndexConst(c: PContext, e: PNode, info: TLineInfo): PType = + let x = semConstExpr(c, e) + if x.kind in {nkIntLit..nkUInt64Lit}: + result = makeRangeType(c, 0, x.intVal-1, info, + x.typ.skipTypes({tyTypeDesc})) + else: + result = x.typ.skipTypes({tyTypeDesc}) + proc semArrayIndex(c: PContext, n: PNode): PType = if isRange(n): result = semRangeAux(c, n, nil) + elif n.kind == nkInfix and n[0].kind == nkIdent and n[0].ident.s == "..<": + result = errorType(c) else: + # XXX this is still a hard compilation in a generic context, this can + # result in unresolved generic parameters being treated like real types let e = semExprWithType(c, n, {efDetermineType}) if e.typ.kind == tyFromExpr: result = makeRangeWithStaticExpr(c, e.typ.n) elif e.kind in {nkIntLit..nkUInt64Lit}: if e.intVal < 0: - localError(c.config, n[1].info, + localError(c.config, n.info, "Array length can't be negative, but was " & $e.intVal) result = makeRangeType(c, 0, e.intVal-1, n.info, e.typ) - elif e.kind == nkSym and e.typ.kind == tyStatic: - 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) - result = makeRangeWithStaticExpr(c, e) - if c.inGenericContext > 0: result.flags.incl tfUnresolved + elif e.kind == nkSym and (e.typ.kind == tyStatic or e.typ.kind == tyTypeDesc): + if e.typ.kind == tyStatic: + if e.sym.ast != nil: + return semArrayIndex(c, e.sym.ast) + if e.typ.skipModifier.kind != tyGenericParam and not isOrdinalType(e.typ.skipModifier): + let info = if n.safeLen > 1: n[1].info else: n.info + localError(c.config, info, errOrdinalTypeExpected % typeToString(e.typ, preferDesc)) + result = makeRangeWithStaticExpr(c, e) + if c.inGenericContext > 0: result.flags.incl tfUnresolved + else: + result = e.typ.skipTypes({tyTypeDesc}) + result.flags.incl tfImplicitStatic elif e.kind in (nkCallKinds + {nkBracketExpr}) and hasUnresolvedArgs(c, e): if not isOrdinalType(e.typ.skipTypes({tyStatic, tyAlias, tyGenericInst, tySink})): - localError(c.config, n[1].info, errOrdinalTypeExpected) + localError(c.config, n[1].info, errOrdinalTypeExpected % typeToString(e.typ, preferDesc)) # This is an int returning call, depending on an - # yet unknown generic param (see tgenericshardcases). + # yet unknown generic param (see tuninstantiatedgenericcalls). # We are going to construct a range type that will be # properly filled-out in semtypinst (see how tyStaticExpr # is handled there). @@ -322,12 +414,7 @@ proc semArrayIndex(c: PContext, n: PNode): PType = elif e.kind == nkIdent: result = e.typ.skipTypes({tyTypeDesc}) else: - let x = semConstExpr(c, e) - if x.kind in {nkIntLit..nkUInt64Lit}: - result = makeRangeType(c, 0, x.intVal-1, n.info, - x.typ.skipTypes({tyTypeDesc})) - else: - result = x.typ.skipTypes({tyTypeDesc}) + result = semArrayIndexConst(c, e, n.info) #localError(c.config, n[1].info, errConstExprExpected) proc semArray(c: PContext, n: PNode, prev: PType): PType = @@ -336,106 +423,64 @@ proc semArray(c: PContext, n: PNode, prev: PType): PType = # 3 = length(array indx base) let indx = semArrayIndex(c, n[1]) var indxB = indx - if indxB.kind in {tyGenericInst, tyAlias, tySink}: indxB = lastSon(indxB) - if indxB.kind notin {tyGenericParam, tyStatic, tyFromExpr}: - if indxB.skipTypes({tyRange}).kind in {tyUInt, tyUInt64}: - discard - elif not isOrdinalType(indxB): - localError(c.config, n[1].info, errOrdinalTypeExpected) + if indxB.kind in {tyGenericInst, tyAlias, tySink}: indxB = skipModifier(indxB) + if indxB.kind notin {tyGenericParam, tyStatic, tyFromExpr} and + tfUnresolved notin indxB.flags: + if not isOrdinalType(indxB): + localError(c.config, n[1].info, errOrdinalTypeExpected % typeToString(indxB, preferDesc)) elif enumHasHoles(indxB): localError(c.config, n[1].info, "enum '$1' has holes" % typeToString(indxB.skipTypes({tyRange}))) + elif indxB.kind != tyRange and + lengthOrd(c.config, indxB) > high(uint16).int: + # assume range type is intentional + localError(c.config, n[1].info, + "index type '$1' for array is too large" % typeToString(indxB)) base = semTypeNode(c, n[2], nil) # ensure we only construct a tyArray when there was no error (bug #3048): - result = newOrPrevType(tyArray, prev, c) # bug #6682: Do not propagate initialization requirements etc for the # index type: - rawAddSonNoPropagationOfTypeFlags(result, indx) + result = newOrPrevType(tyArray, prev, c, indx) addSonSkipIntLit(result, base, c.idgen) else: localError(c.config, n.info, errArrayExpectsTwoTypeParams) result = newOrPrevType(tyError, prev, c) +proc semIterableType(c: PContext, n: PNode, prev: PType): PType = + result = newOrPrevType(tyIterable, prev, c) + if n.len == 2: + let base = semTypeNode(c, n[1], nil) + addSonSkipIntLit(result, base, c.idgen) + else: + localError(c.config, n.info, errXExpectsOneTypeParam % "iterable") + result = newOrPrevType(tyError, prev, c) + proc semOrdinal(c: PContext, n: PNode, prev: PType): PType = result = newOrPrevType(tyOrdinal, prev, c) if n.len == 2: var base = semTypeNode(c, n[1], nil) if base.kind != tyGenericParam: if not isOrdinalType(base): - localError(c.config, n[1].info, errOrdinalTypeExpected) + localError(c.config, n[1].info, errOrdinalTypeExpected % typeToString(base, preferDesc)) addSonSkipIntLit(result, base, c.idgen) else: localError(c.config, n.info, errXExpectsOneTypeParam % "ordinal") result = newOrPrevType(tyError, prev, c) -proc semTypeIdent(c: PContext, n: PNode): PSym = - if n.kind == nkSym: - result = getGenSym(c, n.sym) - else: - result = pickSym(c, n, {skType, skGenericParam, skParam}) - if result.isNil: - result = qualifiedLookUp(c, n, {checkAmbiguity, checkUndeclared}) - if result != nil: - markUsed(c, n.info, result) - onUse(n.info, result) - - if result.kind == skParam and result.typ.kind == tyTypeDesc: - # This is a typedesc param. is it already bound? - # it's not bound when it's used multiple times in the - # proc signature for example - if c.inGenericInst > 0: - let bound = result.typ[0].sym - if bound != nil: return bound - return result - if result.typ.sym == nil: - localError(c.config, n.info, errTypeExpected) - return errorSym(c, n) - result = result.typ.sym.copySym(nextSymId c.idgen) - result.typ = exactReplica(result.typ) - result.typ.flags.incl tfUnresolved - - if result.kind == skGenericParam: - if result.typ.kind == tyGenericParam and result.typ.len == 0 and - tfWildcard in result.typ.flags: - # collapse the wild-card param to a type - result.transitionGenericParamToType() - result.typ.flags.excl tfWildcard - return - else: - localError(c.config, n.info, errTypeExpected) - return errorSym(c, n) - if result.kind != skType and result.magic notin {mStatic, mType, mTypeOf}: - # this implements the wanted ``var v: V, x: V`` feature ... - var ov: TOverloadIter - var amb = initOverloadIter(ov, c, n) - while amb != nil and amb.kind != skType: - amb = nextOverloadIter(ov, c, n) - if amb != nil: result = amb - else: - if result.kind != skError: localError(c.config, n.info, errTypeExpected) - return errorSym(c, n) - if result.typ.kind != tyGenericParam: - # XXX get rid of this hack! - var oldInfo = n.info - when defined(useNodeIds): - let oldId = n.id - reset(n[]) - when defined(useNodeIds): - n.id = oldId - n.transitionNoneToSym() - n.sym = result - n.info = oldInfo - n.typ = result.typ - else: - localError(c.config, n.info, "identifier expected") - result = errorSym(c, n) - proc semAnonTuple(c: PContext, n: PNode, prev: PType): PType = if n.len == 0: localError(c.config, n.info, errTypeExpected) result = newOrPrevType(tyTuple, prev, c) for it in n: - addSonSkipIntLit(result, semTypeNode(c, it, nil), c.idgen) + let t = semTypeNode(c, it, nil) + addSonSkipIntLitChecked(c, result, t, it, c.idgen) + +proc firstRange(config: ConfigRef, t: PType): PNode = + if t.skipModifier().kind in tyFloat..tyFloat64: + result = newFloatNode(nkFloatLit, firstFloat(t)) + else: + result = newIntNode(nkIntLit, firstOrd(config, t)) + result.typ = t proc semTuple(c: PContext, n: PNode, prev: PType): PType = var typ: PType @@ -447,13 +492,17 @@ proc semTuple(c: PContext, n: PNode, prev: PType): PType = var a = n[i] if (a.kind != nkIdentDefs): illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) - if a[^2].kind != nkEmpty: + var hasDefaultField = a[^1].kind != nkEmpty + if hasDefaultField: + typ = fitDefaultNode(c, a) + elif a[^2].kind != nkEmpty: typ = semTypeNode(c, a[^2], nil) + if c.graph.config.isDefined("nimPreviewRangeDefault") and typ.skipTypes(abstractInst).kind == tyRange: + a[^1] = firstRange(c.config, typ) + hasDefaultField = true else: localError(c.config, a.info, errTypeExpected) typ = errorType(c) - if a[^1].kind != nkEmpty: - localError(c.config, a[^1].info, errInitHereNotAllowed) for j in 0..<a.len - 2: var field = newSymG(skField, a[j], c) field.typ = typ @@ -462,9 +511,13 @@ proc semTuple(c: PContext, n: PNode, prev: PType): PType = if containsOrIncl(check, field.name.id): localError(c.config, a[j].info, "attempt to redefine: '" & field.name.s & "'") else: - result.n.add newSymNode(field) + let fSym = newSymNode(field) + if hasDefaultField: + fSym.sym.ast = a[^1] + fSym.sym.ast.flags.incl nfSkipFieldChecking + result.n.add fSym addSonSkipIntLit(result, typ, c.idgen) - styleCheckDef(c.config, a[j].info, field) + styleCheckDef(c, a[j].info, field) onDef(field.info, field) if result.n.len == 0: result.n = nil if isTupleRecursive(result): @@ -487,12 +540,13 @@ proc semIdentVis(c: PContext, kind: TSymKind, n: PNode, else: localError(c.config, n[0].info, errInvalidVisibilityX % renderTree(n[0])) else: + result = nil illFormedAst(n, c.config) else: result = newSymG(kind, n, c) proc semIdentWithPragma(c: PContext, kind: TSymKind, n: PNode, - allowed: TSymFlags): PSym = + allowed: TSymFlags, fromTopLevel = false): PSym = if n.kind == nkPragmaExpr: checkSonsLen(n, 2, c.config) result = semIdentVis(c, kind, n[0], allowed) @@ -507,6 +561,16 @@ proc semIdentWithPragma(c: PContext, kind: TSymKind, n: PNode, else: discard else: result = semIdentVis(c, kind, n, allowed) + let invalidPragmasForPush = if fromTopLevel and sfWasGenSym notin result.flags: + {} + else: + {wExportc, wExportCpp, wDynlib} + case kind + of skField: implicitPragmas(c, result, n.info, fieldPragmas) + of skVar: implicitPragmas(c, result, n.info, varPragmas-invalidPragmasForPush) + of skLet: implicitPragmas(c, result, n.info, letPragmas-invalidPragmasForPush) + of skConst: implicitPragmas(c, result, n.info, constPragmas-invalidPragmasForPush) + else: discard proc checkForOverlap(c: PContext, t: PNode, currentEx, branchIndex: int) = let ex = t[branchIndex][currentEx].skipConv @@ -516,13 +580,20 @@ proc checkForOverlap(c: PContext, t: PNode, currentEx, branchIndex: int) = if overlap(t[i][j].skipConv, ex): localError(c.config, ex.info, errDuplicateCaseLabel) -proc semBranchRange(c: PContext, t, a, b: PNode, covered: var Int128): PNode = - checkMinSonsLen(t, 1, c.config) +proc semBranchRange(c: PContext, n, a, b: PNode, covered: var Int128): PNode = + checkMinSonsLen(n, 1, c.config) let ac = semConstExpr(c, a) let bc = semConstExpr(c, b) - let at = fitNode(c, t[0].typ, ac, ac.info).skipConvTakeType - let bt = fitNode(c, t[0].typ, bc, bc.info).skipConvTakeType - + if ac.kind in {nkStrLit..nkTripleStrLit} or bc.kind in {nkStrLit..nkTripleStrLit}: + localError(c.config, b.info, "range of string is invalid") + var at = fitNode(c, n[0].typ, ac, ac.info).skipConvTakeType + var bt = fitNode(c, n[0].typ, bc, bc.info).skipConvTakeType + # the calls to fitNode may introduce calls to converters + # mirrored with semCaseBranch for single elements + if at.kind in {nkHiddenCallConv, nkHiddenStdConv, nkHiddenSubConv}: + at = semConstExpr(c, at) + if bt.kind in {nkHiddenCallConv, nkHiddenStdConv, nkHiddenSubConv}: + bt = semConstExpr(c, bt) result = newNodeI(nkRange, a.info) result.add(at) result.add(bt) @@ -534,39 +605,45 @@ proc semCaseBranchRange(c: PContext, t, b: PNode, checkSonsLen(b, 3, c.config) result = semBranchRange(c, t, b[1], b[2], covered) -proc semCaseBranchSetElem(c: PContext, t, b: PNode, +proc semCaseBranchSetElem(c: PContext, n, b: PNode, covered: var Int128): PNode = if isRange(b): checkSonsLen(b, 3, c.config) - result = semBranchRange(c, t, b[1], b[2], covered) + result = semBranchRange(c, n, b[1], b[2], covered) elif b.kind == nkRange: checkSonsLen(b, 2, c.config) - result = semBranchRange(c, t, b[0], b[1], covered) + result = semBranchRange(c, n, b[0], b[1], covered) else: - result = fitNode(c, t[0].typ, b, b.info) + result = fitNode(c, n[0].typ, b, b.info) inc(covered) -proc semCaseBranch(c: PContext, t, branch: PNode, branchIndex: int, +proc semCaseBranch(c: PContext, n, branch: PNode, branchIndex: int, covered: var Int128) = let lastIndex = branch.len - 2 for i in 0..lastIndex: var b = branch[i] if b.kind == nkRange: branch[i] = b + # same check as in semBranchRange for exhaustiveness + covered = covered + getOrdValue(b[1]) + 1 - getOrdValue(b[0]) elif isRange(b): - branch[i] = semCaseBranchRange(c, t, b, covered) + branch[i] = semCaseBranchRange(c, n, b, covered) else: # constant sets and arrays are allowed: - var r = semConstExpr(c, b) + # set expected type to selector type for type inference + # even if it can be a different type like a set or array + var r = semConstExpr(c, b, expectedType = n[0].typ) if r.kind in {nkCurly, nkBracket} and r.len == 0 and branch.len == 2: # discarding ``{}`` and ``[]`` branches silently delSon(branch, 0) return elif r.kind notin {nkCurly, nkBracket} or r.len == 0: - checkMinSonsLen(t, 1, c.config) - var tmp = fitNode(c, t[0].typ, r, r.info) + checkMinSonsLen(n, 1, c.config) + var tmp = fitNode(c, n[0].typ, r, r.info) # the call to fitNode may introduce a call to a converter - if tmp.kind in {nkHiddenCallConv}: tmp = semConstExpr(c, tmp) + # mirrored with semBranchRange + if tmp.kind in {nkHiddenCallConv, nkHiddenStdConv, nkHiddenSubConv}: + tmp = semConstExpr(c, tmp) branch[i] = skipConv(tmp) inc(covered) else: @@ -574,18 +651,18 @@ proc semCaseBranch(c: PContext, t, branch: PNode, branchIndex: int, r = deduplicate(c.config, r) # first element is special and will overwrite: branch[i]: - branch[i] = semCaseBranchSetElem(c, t, r[0], covered) + branch[i] = semCaseBranchSetElem(c, n, r[0], covered) # other elements have to be added to ``branch`` for j in 1..<r.len: - branch.add(semCaseBranchSetElem(c, t, r[j], covered)) + branch.add(semCaseBranchSetElem(c, n, r[j], covered)) # caution! last son of branch must be the actions to execute: swap(branch[^2], branch[^1]) - checkForOverlap(c, t, i, branchIndex) + checkForOverlap(c, n, i, branchIndex) # Elements added above needs to be checked for overlaps. for i in lastIndex.succ..<branch.len - 1: - checkForOverlap(c, t, i, branchIndex) + checkForOverlap(c, n, i, branchIndex) proc toCover(c: PContext, t: PType): Int128 = let t2 = skipTypes(t, abstractVarRange-{tyTypeDesc}) @@ -677,7 +754,7 @@ proc semRecordCase(c: PContext, n: PNode, check: var IntSet, pos: var int, of tyFloat..tyFloat128, tyError: discard of tyRange: - if skipTypes(typ[0], abstractInst).kind in shouldChckCovered: + if skipTypes(typ.elementType, abstractInst).kind in shouldChckCovered: chckCovered = true of tyForward: errorUndeclaredIdentifier(c, n[0].info, typ.sym.name.s) @@ -717,9 +794,11 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, if n == nil: return case n.kind of nkRecWhen: + var a = copyTree(n) var branch: PNode = nil # the branch to take - for i in 0..<n.len: - var it = n[i] + var cannotResolve = false # no branch should be taken + for i in 0..<a.len: + var it = a[i] if it == nil: illFormedAst(n, c.config) var idx = 1 case it.kind @@ -730,24 +809,35 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, if e.kind != nkIntLit: discard "don't report followup error" elif e.intVal != 0 and branch == nil: branch = it[1] else: - it[0] = forceBool(c, semExprWithType(c, it[0])) + # XXX this is still a hard compilation in a generic context, this can + # result in unresolved generic parameters being treated like real types + let e = semExprWithType(c, it[0], {efDetermineType}) + if e.typ.kind == tyFromExpr: + it[0] = makeStaticExpr(c, e) + cannotResolve = true + else: + it[0] = forceBool(c, e) + let val = getConstExpr(c.module, it[0], c.idgen, c.graph) + if val == nil or val.kind != nkIntLit: + cannotResolve = true + elif not cannotResolve and val.intVal != 0 and branch == nil: + branch = it[1] of nkElse: checkSonsLen(it, 1, c.config) - if branch == nil: branch = it[0] + if branch == nil and not cannotResolve: branch = it[0] idx = 0 else: illFormedAst(n, c.config) - if c.inGenericContext > 0: + if c.inGenericContext > 0 and cannotResolve: # use a new check intset here for each branch: - var newCheck: IntSet - assign(newCheck, check) + var newCheck: IntSet = check var newPos = pos var newf = newNodeI(nkRecList, n.info) semRecordNodeAux(c, it[idx], newCheck, newPos, newf, rectype, hasCaseFields) it[idx] = if newf.len == 1: newf[0] else: newf - if c.inGenericContext > 0: - father.add n - elif branch != nil: + if branch != nil: semRecordNodeAux(c, branch, check, pos, father, rectype, hasCaseFields) + elif cannotResolve: + father.add a elif father.kind in {nkElse, nkOfBranch}: father.add newNodeI(nkRecList, n.info) of nkRecCase: @@ -765,14 +855,19 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, var a: PNode 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) var typ: PType - if n[^2].kind == nkEmpty: + var hasDefaultField = n[^1].kind != nkEmpty + if hasDefaultField: + typ = fitDefaultNode(c, n) + propagateToOwner(rectype, typ) + elif n[^2].kind == nkEmpty: localError(c.config, n.info, errTypeExpected) typ = errorType(c) else: typ = semTypeNode(c, n[^2], nil) + if c.graph.config.isDefined("nimPreviewRangeDefault") and typ.skipTypes(abstractInst).kind == tyRange: + n[^1] = firstRange(c.config, typ) + hasDefaultField = true propagateToOwner(rectype, typ) var fieldOwner = if c.inGenericContext > 0: c.getCurrOwner else: rectype.sym @@ -788,15 +883,19 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, f.options = c.config.options if fieldOwner != nil and {sfImportc, sfExportc} * fieldOwner.flags != {} and - not hasCaseFields and f.loc.r == nil: - f.loc.r = rope(f.name.s) + not hasCaseFields and f.loc.snippet == "": + f.loc.snippet = rope(f.name.s) f.flags.incl {sfImportc, sfExportc} * fieldOwner.flags inc(pos) if containsOrIncl(check, f.name.id): localError(c.config, info, "attempt to redefine: '" & f.name.s & "'") - if a.kind == nkEmpty: father.add newSymNode(f) - else: a.add newSymNode(f) - styleCheckDef(c.config, f) + let fSym = newSymNode(f) + if hasDefaultField: + fSym.sym.ast = n[^1] + fSym.sym.ast.flags.incl nfSkipFieldChecking + if a.kind == nkEmpty: father.add fSym + else: a.add fSym + styleCheckDef(c, f) onDef(f.info, f) if a.kind != nkEmpty: father.add a of nkSym: @@ -835,16 +934,24 @@ proc skipGenericInvocation(t: PType): PType {.inline.} = if result.kind == tyGenericInvocation: result = result[0] while result.kind in {tyGenericInst, tyGenericBody, tyRef, tyPtr, tyAlias, tySink, tyOwned}: - result = lastSon(result) - -proc addInheritedFields(c: PContext, check: var IntSet, pos: var int, - obj: PType) = - assert obj.kind == tyObject - if (obj.len > 0) and (obj[0] != nil): - addInheritedFields(c, check, pos, obj[0].skipGenericInvocation) - addInheritedFieldsAux(c, check, pos, obj.n) + result = skipModifier(result) + +proc tryAddInheritedFields(c: PContext, check: var IntSet, pos: var int, + obj: PType, n: PNode, isPartial = false, innerObj: PType = nil): bool = + if ((not isPartial) and (obj.kind notin {tyObject, tyGenericParam} or tfFinal in obj.flags)) or + (innerObj != nil and obj.sym.id == innerObj.sym.id): + localError(c.config, n.info, "Cannot inherit from: '" & $obj & "'") + result = false + elif obj.kind == tyObject: + result = true + if (obj.len > 0) and (obj[0] != nil): + result = result and tryAddInheritedFields(c, check, pos, obj[0].skipGenericInvocation, n, false, obj) + addInheritedFieldsAux(c, check, pos, obj.n) + else: + result = true -proc semObjectNode(c: PContext, n: PNode, prev: PType; isInheritable: bool): PType = +proc semObjectNode(c: PContext, n: PNode, prev: PType; flags: TTypeFlags): PType = + result = nil if n.len == 0: return newConstraint(c, tyObject) var check = initIntSet() @@ -869,7 +976,11 @@ proc semObjectNode(c: PContext, n: PNode, prev: PType; isInheritable: bool): PTy if concreteBase.sym != nil and concreteBase.sym.magic == mException and sfSystemModule notin c.module.flags: message(c.config, n.info, warnInheritFromException, "") - addInheritedFields(c, check, pos, concreteBase) + if not tryAddInheritedFields(c, check, pos, concreteBase, n): + return newType(tyError, c.idgen, result.owner) + + elif concreteBase.kind == tyForward: + c.skipTypes.add n #we retry in the final pass else: if concreteBase.kind != tyError: localError(c.config, n[1].info, "inheritance only works with non-final objects; " & @@ -880,13 +991,16 @@ proc semObjectNode(c: PContext, n: PNode, prev: PType; isInheritable: bool): PTy if n.kind != nkObjectTy: internalError(c.config, n.info, "semObjectNode") result = newOrPrevType(tyObject, prev, c) rawAddSon(result, realBase) - if realBase == nil and isInheritable: + if realBase == nil and tfInheritable in flags: result.flags.incl tfInheritable + if tfAcyclic in flags: result.flags.incl tfAcyclic if result.n.isNil: result.n = newNodeI(nkRecList, n.info) else: # partial object so add things to the check - addInheritedFields(c, check, pos, result) + if not tryAddInheritedFields(c, check, pos, result, n, isPartial = true): + return newType(tyError, c.idgen, result.owner) + semRecordNodeAux(c, n[2], check, pos, result.n, result) if n[0].kind != nkEmpty: # dummy symbol for `pragma`: @@ -906,8 +1020,8 @@ proc semAnyRef(c: PContext; n: PNode; kind: TTypeKind; prev: PType): PType = let n = if n[0].kind == nkBracket: n[0] else: n checkMinSonsLen(n, 1, c.config) let body = n.lastSon - var t = if prev != nil and body.kind == nkObjectTy and tfInheritable in prev.flags: - semObjectNode(c, body, nil, isInheritable=true) + var t = if prev != nil and prev.kind != tyGenericBody and body.kind == nkObjectTy: + semObjectNode(c, body, nil, prev.flags) else: semTypeNode(c, body, nil) if t.kind == tyTypeDesc and tfUnresolved notin t.flags: @@ -936,31 +1050,30 @@ proc semAnyRef(c: PContext; n: PNode; kind: TTypeKind; prev: PType): PType = addSonSkipIntLit(result, region, c.idgen) addSonSkipIntLit(result, t, c.idgen) if tfPartial in result.flags: - if result.lastSon.kind == tyObject: incl(result.lastSon.flags, tfPartial) + if result.elementType.kind == tyObject: incl(result.elementType.flags, tfPartial) # if not isNilable: result.flags.incl tfNotNil case wrapperKind of tyOwned: if optOwnedRefs in c.config.globalOptions: - let t = newTypeS(tyOwned, c) + let t = newTypeS(tyOwned, c, result) t.flags.incl tfHasOwned - t.rawAddSonNoPropagationOfTypeFlags result result = t of tySink: - let t = newTypeS(tySink, c) - t.rawAddSonNoPropagationOfTypeFlags result + let t = newTypeS(tySink, c, result) result = t else: discard - if result.kind == tyRef and c.config.selectedGC in {gcArc, gcOrc}: + if result.kind == tyRef and c.config.selectedGC in {gcArc, gcOrc, gcAtomicArc}: result.flags.incl tfHasAsgn proc findEnforcedStaticType(t: PType): PType = # This handles types such as `static[T] and Foo`, # which are subset of `static[T]`, hence they could # be treated in the same way + result = nil if t == nil: return nil if t.kind == tyStatic: return t if t.kind == tyAnd: - for s in t.sons: + for s in t.kids: let t = findEnforcedStaticType(s) if t != nil: return t @@ -968,7 +1081,7 @@ proc addParamOrResult(c: PContext, param: PSym, kind: TSymKind) = if kind == skMacro: let staticType = findEnforcedStaticType(param.typ) if staticType != nil: - var a = copySym(param, nextSymId c.idgen) + var a = copySym(param, c.idgen) a.typ = staticType.base addDecl(c, a) #elif param.typ != nil and param.typ.kind == tyTypeDesc: @@ -976,7 +1089,7 @@ proc addParamOrResult(c: PContext, param: PSym, kind: TSymKind) = else: # within a macro, every param has the type NimNode! let nn = getSysSym(c.graph, param.info, "NimNode") - var a = copySym(param, nextSymId c.idgen) + var a = copySym(param, c.idgen) a.typ = nn.typ addDecl(c, a) else: @@ -1006,7 +1119,7 @@ proc addImplicitGeneric(c: PContext; typeClass: PType, typId: PIdent; let owner = if typeClass.sym != nil: typeClass.sym else: getCurrOwner(c) - var s = newSym(skType, finalTypId, nextSymId c.idgen, owner, info) + var s = newSym(skType, finalTypId, c.idgen, owner, info) if sfExplain in owner.flags: s.flags.incl sfExplain if typId == nil: s.flags.incl(sfAnon) s.linkTo(typeClass) @@ -1041,7 +1154,7 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, let base = (if lifted != nil: lifted else: paramType.base) if base.isMetaType and procKind == skMacro: localError(c.config, info, errMacroBodyDependsOnGenericTypes % paramName) - result = addImplicitGeneric(c, c.newTypeWithSons(tyStatic, @[base]), + result = addImplicitGeneric(c, newTypeS(tyStatic, c, base), paramTypId, info, genericParams, paramName) if result != nil: result.flags.incl({tfHasStatic, tfUnresolved}) @@ -1053,38 +1166,42 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, paramTypId.id == getIdent(c.cache, "type").id): # XXX Why doesn't this check for tyTypeDesc instead? paramTypId = nil - let t = c.newTypeWithSons(tyTypeDesc, @[paramType.base]) + let t = newTypeS(tyTypeDesc, c, paramType.base) incl t.flags, tfCheckedForDestructor result = addImplicitGeneric(c, t, paramTypId, info, genericParams, paramName) - + else: + result = nil of tyDistinct: if paramType.len == 1: # disable the bindOnce behavior for the type class result = recurse(paramType.base, true) - + else: + result = nil of tyTuple: + result = nil for i in 0..<paramType.len: let t = recurse(paramType[i]) if t != nil: paramType[i] = t result = paramType - of tyAlias, tyOwned, tySink: + of tyAlias, tyOwned: result = recurse(paramType.base) of tySequence, tySet, tyArray, tyOpenArray, - tyVar, tyLent, tyPtr, tyRef, tyProc: + tyVar, tyLent, tyPtr, tyRef, tyProc, tySink: # XXX: this is a bit strange, but proc(s: seq) # produces tySequence(tyGenericParam, tyNone). # This also seems to be true when creating aliases # like: type myseq = distinct seq. # Maybe there is another better place to associate # the seq type class with the seq identifier. - if paramType.kind == tySequence and paramType.lastSon.kind == tyNone: - let typ = c.newTypeWithSons(tyBuiltInTypeClass, - @[newTypeS(paramType.kind, c)]) + if paramType.kind == tySequence and paramType.elementType.kind == tyNone: + let typ = newTypeS(tyBuiltInTypeClass, c, + newTypeS(paramType.kind, c)) result = addImplicitGeneric(c, typ, paramTypId, info, genericParams, paramName) else: + result = nil for i in 0..<paramType.len: if paramType[i] == paramType: globalError(c.config, info, errIllegalRecursionInTypeX % typeToString(paramType)) @@ -1105,21 +1222,22 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, else: result.rawAddSon newTypeS(tyAnything, c) - if paramType.lastSon.kind == tyUserTypeClass: + if paramType.typeBodyImpl.kind == tyUserTypeClass: result.kind = tyUserTypeClassInst - result.rawAddSon paramType.lastSon + result.rawAddSon paramType.typeBodyImpl return addImplicitGeneric(c, result, paramTypId, info, genericParams, paramName) let x = instGenericContainer(c, paramType.sym.info, result, allowMetaTypes = true) - result = newTypeWithSons(c, tyCompositeTypeClass, @[paramType, x]) - #result = newTypeS(tyCompositeTypeClass, c) - #for i in 0..<x.len: result.rawAddSon(x[i]) + result = newTypeS(tyCompositeTypeClass, c) + result.rawAddSon paramType + result.rawAddSon x result = addImplicitGeneric(c, result, paramTypId, info, genericParams, paramName) of tyGenericInst: - if paramType.lastSon.kind == tyUserTypeClass: - var cp = copyType(paramType, nextTypeId c.idgen, getCurrOwner(c)) + result = nil + if paramType.skipModifier.kind == tyUserTypeClass: + var cp = copyType(paramType, c.idgen, getCurrOwner(c)) copyTypeProps(c.graph, c.idgen.module, cp, paramType) cp.kind = tyUserTypeClassInst @@ -1130,15 +1248,16 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, if lifted != nil: paramType[i] = lifted result = paramType - result.lastSon.shouldHaveMeta + result.last.shouldHaveMeta - let liftBody = recurse(paramType.lastSon, true) + let liftBody = recurse(paramType.skipModifier, true) if liftBody != nil: result = liftBody result.flags.incl tfHasMeta #result.shouldHaveMeta of tyGenericInvocation: + result = nil for i in 1..<paramType.len: #if paramType[i].kind != tyTypeDesc: let lifted = recurse(paramType[i]) @@ -1150,7 +1269,7 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, # before one of its param types return - if body.lastSon.kind == tyUserTypeClass: + if body.last.kind == tyUserTypeClass: let expanded = instGenericContainer(c, info, paramType, allowMetaTypes = true) result = recurse(expanded, true) @@ -1158,24 +1277,26 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, of tyUserTypeClasses, tyBuiltInTypeClass, tyCompositeTypeClass, tyAnd, tyOr, tyNot, tyConcept: result = addImplicitGeneric(c, - copyType(paramType, nextTypeId c.idgen, getCurrOwner(c)), paramTypId, + copyType(paramType, c.idgen, getCurrOwner(c)), paramTypId, info, genericParams, paramName) of tyGenericParam: + result = nil markUsed(c, paramType.sym.info, paramType.sym) onUse(paramType.sym.info, paramType.sym) if tfWildcard in paramType.flags: paramType.flags.excl tfWildcard paramType.sym.transitionGenericParamToType() - else: discard + else: result = nil proc semParamType(c: PContext, n: PNode, constraint: var PNode): PType = + ## Semchecks the type of parameters. if n.kind == nkCurlyExpr: result = semTypeNode(c, n[0], nil) constraint = semNodeKindConstraints(n, c.config, 1) elif n.kind == nkCall and - n[0].kind in {nkIdent, nkSym, nkOpenSymChoice, nkClosedSymChoice} and + n[0].kind in {nkIdent, nkSym, nkOpenSymChoice, nkClosedSymChoice, nkOpenSym} and considerQuotedIdent(c, n[0]).s == "{}": result = semTypeNode(c, n[1], nil) constraint = semNodeKindConstraints(n, c.config, 2) @@ -1193,6 +1314,7 @@ proc newProcType(c: PContext; info: TLineInfo; prev: PType = nil): PType = result.n.add newNodeI(nkEffectList, info) proc isMagic(sym: PSym): bool = + if sym.ast == nil: return false let nPragmas = sym.ast[pragmasPos] return hasPragma(nPragmas, wMagic) @@ -1204,6 +1326,9 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, result = newProcType(c, n.info, prev) var check = initIntSet() var counter = 0 + template isCurrentlyGeneric: bool = + # genericParams might update as implicit generic params are added + genericParams != nil and genericParams.len > 0 for i in 1..<n.len: var a = n[i] @@ -1224,22 +1349,49 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, hasDefault = a[^1].kind != nkEmpty if hasType: + let isGeneric = isCurrentlyGeneric() + inc c.inGenericContext, ord(isGeneric) typ = semParamType(c, a[^2], constraint) + dec c.inGenericContext, ord(isGeneric) # TODO: Disallow typed/untyped in procs in the compiler/stdlib - if kind == skProc and (typ.kind == tyTyped or typ.kind == tyUntyped): + if kind in {skProc, skFunc} and (typ.kind == tyTyped or typ.kind == tyUntyped): if not isMagic(getCurrOwner(c)): localError(c.config, a[^2].info, "'" & typ.sym.name.s & "' is only allowed in templates and macros or magic procs") + if hasDefault: def = a[^1] + if a.len > 3: + var msg = "" + for j in 0 ..< a.len - 2: + if msg.len != 0: msg.add(", ") + msg.add($a[j]) + msg.add(" all have default value '") + msg.add(def.renderTree) + msg.add("', this may be unintentional, " & + "either use ';' (semicolon) or explicitly write each default value") + message(c.config, a.info, warnImplicitDefaultValue, msg) block determineType: - if genericParams.isGenericParams: - def = semGenericStmt(c, def) - if hasUnresolvedArgs(c, def): + var canBeVoid = false + if kind == skTemplate: + if typ != nil and typ.kind == tyUntyped: + # don't do any typechecking or assign a type for + # `untyped` parameter default value + break determineType + elif hasUnresolvedArgs(c, def): + # template default value depends on other parameter + # don't do any typechecking def.typ = makeTypeFromExpr(c, def.copyTree) break determineType - - def = semExprWithType(c, def, {efDetermineType}) + elif typ != nil and typ.kind == tyTyped: + canBeVoid = true + let isGeneric = isCurrentlyGeneric() + inc c.inGenericContext, ord(isGeneric) + if canBeVoid: + def = semExpr(c, def, {efDetermineType, efAllowSymChoice}, typ) + else: + def = semExprWithType(c, def, {efDetermineType, efAllowSymChoice}, typ) + dec c.inGenericContext, ord(isGeneric) if def.referencesAnotherParam(getCurrOwner(c)): def.flags.incl nfDefaultRefsParam @@ -1255,10 +1407,10 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, # which will prevent other types from matching - clearly a very # surprising behavior. We must instead fix the expected type of # the proc to be the unbound typedesc type: - typ = newTypeWithSons(c, tyTypeDesc, @[newTypeS(tyNone, c)]) + typ = newTypeS(tyTypeDesc, c, newTypeS(tyNone, c)) typ.flags.incl tfCheckedForDestructor - else: + elif def.typ != nil and def.typ.kind != tyFromExpr: # def.typ can be void # if def.typ != nil and def.typ.kind != tyNone: # example code that triggers it: # proc sort[T](cmp: proc(a, b: T): int = cmp) @@ -1278,36 +1430,45 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, for j in 0..<a.len-2: var arg = newSymG(skParam, if a[j].kind == nkPragmaExpr: a[j][0] else: a[j], c) + if arg.name.id == ord(wUnderscore): + arg.flags.incl(sfGenSym) + elif containsOrIncl(check, arg.name.id): + localError(c.config, a[j].info, "attempt to redefine: '" & arg.name.s & "'") if a[j].kind == nkPragmaExpr: pragma(c, arg, a[j][1], paramPragmas) if not hasType and not hasDefault and kind notin {skTemplate, skMacro}: let param = strTableGet(c.signatures, arg.name) if param != nil: typ = param.typ else: - localError(c.config, a.info, "typeless parameters are obsolete") + localError(c.config, a.info, "parameter '$1' requires a type" % arg.name.s) typ = errorType(c) + var nameForLift = arg.name.s + if sfGenSym in arg.flags: + nameForLift.add("`gensym" & $arg.id) let lifted = liftParamType(c, kind, genericParams, typ, - arg.name.s, arg.info) + nameForLift, arg.info) let finalType = if lifted != nil: lifted else: typ.skipIntLit(c.idgen) arg.typ = finalType arg.position = counter - arg.constraint = constraint + if constraint != nil: + #only replace the constraint when it has been set as arg could contain codegenDecl + arg.constraint = constraint inc(counter) if def != nil and def.kind != nkEmpty: arg.ast = copyTree(def) - if containsOrIncl(check, arg.name.id): - localError(c.config, a[j].info, "attempt to redefine: '" & arg.name.s & "'") result.n.add newSymNode(arg) rawAddSon(result, finalType) addParamOrResult(c, arg, kind) - styleCheckDef(c.config, a[j].info, arg) + styleCheckDef(c, a[j].info, arg) onDef(a[j].info, arg) - if {optNimV1Emulation, optNimV12Emulation} * c.config.globalOptions == {}: - a[j] = newSymNode(arg) + a[j] = newSymNode(arg) - var r: PType + var r: PType = nil if n[0].kind != nkEmpty: + let isGeneric = isCurrentlyGeneric() + inc c.inGenericContext, ord(isGeneric) r = semTypeNode(c, n[0], nil) + dec c.inGenericContext, ord(isGeneric) if r != nil and kind in {skMacro, skTemplate} and r.kind == tyTyped: # XXX: To implement the proposed change in the warning, just @@ -1330,9 +1491,8 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, "' is only valid for macros and templates") # 'auto' as a return type does not imply a generic: elif r.kind == tyAnything: - # 'p(): auto' and 'p(): untyped' are equivalent, but the rest of the - # compiler is hardly aware of 'auto': - r = newTypeS(tyUntyped, c) + r = copyType(r, c.idgen, r.owner) + r.flags.incl tfRetType elif r.kind == tyStatic: # type allowed should forbid this type discard @@ -1361,7 +1521,7 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, result.flags.excl tfHasMeta result.n.typ = r - if genericParams.isGenericParams: + if isCurrentlyGeneric(): for n in genericParams: if {sfUsed, sfAnon} * n.sym.flags == {}: result.flags.incl tfUnresolved @@ -1383,6 +1543,8 @@ proc semStmtListType(c: PContext, n: PNode, prev: PType): PType = proc semBlockType(c: PContext, n: PNode, prev: PType): PType = inc(c.p.nestedBlockCounter) + let oldBreakInLoop = c.p.breakInLoop + c.p.breakInLoop = false checkSonsLen(n, 2, c.config) openScope(c) if n[0].kind notin {nkEmpty, nkSym}: @@ -1391,31 +1553,42 @@ proc semBlockType(c: PContext, n: PNode, prev: PType): PType = n[1].typ = result n.typ = result closeScope(c) + c.p.breakInLoop = oldBreakInLoop dec(c.p.nestedBlockCounter) proc semGenericParamInInvocation(c: PContext, n: PNode): PType = result = semTypeNode(c, n, nil) n.typ = makeTypeDesc(c, result) -proc semObjectTypeForInheritedGenericInst(c: PContext, n: PNode, t: PType) = +proc trySemObjectTypeForInheritedGenericInst(c: PContext, n: PNode, t: PType): bool = var check = initIntSet() pos = 0 let - realBase = t[0] + realBase = t.baseClass base = skipTypesOrNil(realBase, skipPtrs) + result = true if base.isNil: localError(c.config, n.info, errIllegalRecursionInTypeX % "object") else: let concreteBase = skipGenericInvocation(base) if concreteBase.kind == tyObject and tfFinal notin concreteBase.flags: - addInheritedFields(c, check, pos, concreteBase) + if not tryAddInheritedFields(c, check, pos, concreteBase, n): + return false else: if concreteBase.kind != tyError: localError(c.config, n.info, errInheritanceOnlyWithNonFinalObjects) var newf = newNodeI(nkRecList, n.info) semRecordNodeAux(c, t.n, check, pos, newf, t) +proc containsGenericInvocationWithForward(n: PNode): bool = + if n.kind == nkSym and n.sym.ast != nil and n.sym.ast.len > 1 and n.sym.ast[2].kind == nkObjectTy: + for p in n.sym.ast[2][^1]: + if p.kind == nkIdentDefs and p[1].typ != nil and p[1].typ.kind == tyGenericInvocation and + p[1][0].kind == nkSym and p[1][0].typ.kind == tyForward: + return true + return false + proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = if s.typ == nil: localError(c.config, n.info, "cannot instantiate the '$1' $2" % @@ -1425,20 +1598,24 @@ proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = var t = s.typ.skipTypes({tyAlias}) if t.kind == tyCompositeTypeClass and t.base.kind == tyGenericBody: t = t.base - result = newOrPrevType(tyGenericInvocation, prev, c) addSonSkipIntLit(result, t, c.idgen) - template addToResult(typ) = + template addToResult(typ, skip) = + if typ.isNil: internalAssert c.config, false rawAddSon(result, typ) - else: addSonSkipIntLit(result, typ, c.idgen) + else: + if skip: + addSonSkipIntLit(result, typ, c.idgen) + else: + rawAddSon(result, makeRangeWithStaticExpr(c, typ.n)) if t.kind == tyForward: for i in 1..<n.len: var elem = semGenericParamInInvocation(c, n[i]) - addToResult(elem) + addToResult(elem, true) return elif t.kind != tyGenericBody: # we likely got code of the form TypeA[TypeB] where TypeA is @@ -1451,14 +1628,15 @@ proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = matches(c, n, copyTree(n), m) if m.state != csMatch: - let err = "cannot instantiate " & typeToString(t) & "\n" & - "got: <" & describeArgs(c, n) & ">\n" & - "but expected: <" & describeArgs(c, t.n, 0) & ">" + var err = "cannot instantiate " + err.addTypeHeader(c.config, t) + err.add "\ngot: <$1>\nbut expected: <$2>" % [describeArgs(c, n), describeArgs(c, t.n, 0)] localError(c.config, n.info, errGenerated, err) return newOrPrevType(tyError, prev, c) var isConcrete = true - + let rType = m.call[0].typ + let mIndex = if rType != nil: rType.len - 1 else: -1 for i in 1..<m.call.len: var typ = m.call[i].typ # is this a 'typedesc' *parameter*? If so, use the typedesc type, @@ -1466,17 +1644,22 @@ proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = if m.call[i].kind == nkSym and m.call[i].sym.kind == skParam and typ.kind == tyTypeDesc and containsGenericType(typ): isConcrete = false - addToResult(typ) + addToResult(typ, true) else: typ = typ.skipTypes({tyTypeDesc}) if containsGenericType(typ): isConcrete = false - addToResult(typ) + var skip = true + if mIndex >= i - 1 and tfImplicitStatic in rType[i - 1].flags and isIntLit(typ): + skip = false + addToResult(typ, skip) 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) result = newOrPrevType(tyError, prev, c) + elif containsGenericInvocationWithForward(n[0]): + c.skipTypes.add n #fixes 1500 else: result = instGenericContainer(c, n.info, result, allowMetaTypes = false) @@ -1489,30 +1672,36 @@ proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = return errorType(c) if tx != result and tx.kind == tyObject: if tx[0] != nil: - semObjectTypeForInheritedGenericInst(c, n, tx) + if not trySemObjectTypeForInheritedGenericInst(c, n, tx): + return newOrPrevType(tyError, prev, c) var position = 0 recomputeFieldPositions(tx, tx.n, position) proc maybeAliasType(c: PContext; typeExpr, prev: PType): PType = - if typeExpr.kind in {tyObject, tyEnum, tyDistinct, tyForward, tyGenericBody} and prev != nil: + if prev != nil and (prev.kind == tyGenericBody or + typeExpr.kind in {tyObject, tyEnum, tyDistinct, tyForward, tyGenericBody}): result = newTypeS(tyAlias, c) result.rawAddSon typeExpr result.sym = prev.sym - assignType(prev, result) + if prev.kind != tyGenericBody: + assignType(prev, result) + else: + result = nil proc fixupTypeOf(c: PContext, prev: PType, typExpr: PNode) = if prev != nil: let result = newTypeS(tyAlias, c) result.rawAddSon typExpr.typ result.sym = prev.sym - assignType(prev, result) + if prev.kind != tyGenericBody: + assignType(prev, result) proc semTypeExpr(c: PContext, n: PNode; prev: PType): PType = var n = semExprWithType(c, n, {efDetermineType}) if n.typ.kind == tyTypeDesc: result = n.typ.base # fix types constructed by macros/template: - if prev != nil and prev.sym != nil: + if prev != nil and prev.kind != tyGenericBody and prev.sym != nil: if result.sym.isNil: # Behold! you're witnessing enormous power yielded # by macros. Only macros can summon unnamed types @@ -1528,13 +1717,17 @@ proc semTypeExpr(c: PContext, n: PNode; prev: PType): PType = # unnecessary new type creation let alias = maybeAliasType(c, result, prev) if alias != nil: result = alias + elif n.typ.kind == tyFromExpr and c.inGenericContext > 0: + # sometimes not possible to distinguish type from value in generic body, + # for example `T.Foo`, so both are handled under `tyFromExpr` + result = n.typ else: localError(c.config, n.info, "expected type, but got: " & n.renderTree) result = errorType(c) proc freshType(c: PContext; res, prev: PType): PType {.inline.} = - if prev.isNil: - result = copyType(res, nextTypeId c.idgen, res.owner) + if prev.isNil or prev.kind == tyGenericBody: + result = copyType(res, c.idgen, res.owner) copyTypeProps(c.graph, c.idgen.module, result, res) else: result = res @@ -1560,11 +1753,10 @@ proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = pragmas = n[1] inherited = n[2] - result = newOrPrevType(tyUserTypeClass, prev, c) - result.flags.incl tfCheckedForDestructor var owner = getCurrOwner(c) - var candidateTypeSlot = newTypeWithSons(owner, tyAlias, @[c.errorType], c.idgen) - result.sons = @[candidateTypeSlot] + var candidateTypeSlot = newTypeS(tyAlias, c, c.errorType) + result = newOrPrevType(tyUserTypeClass, prev, c, son = candidateTypeSlot) + result.flags.incl tfCheckedForDestructor result.n = n if inherited.kind != nkEmpty: @@ -1598,7 +1790,7 @@ proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = internalAssert c.config, dummyName.kind == nkIdent var dummyParam = newSym(if modifier == tyTypeDesc: skType else: skVar, - dummyName.ident, nextSymId c.idgen, owner, param.info) + dummyName.ident, c.idgen, owner, param.info) dummyParam.typ = dummyType incl dummyParam.flags, sfUsed addDecl(c, dummyParam) @@ -1607,18 +1799,22 @@ proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = closeScope(c) proc applyTypeSectionPragmas(c: PContext; pragmas, operand: PNode): PNode = + result = nil for p in pragmas: let key = if p.kind in nkPragmaCallKinds and p.len >= 1: p[0] else: p - if p.kind == nkEmpty or whichPragma(p) != wInvalid: discard "builtin pragma" else: - let ident = considerQuotedIdent(c, key) - if strTableGet(c.userPragmas, ident) != nil: + trySuggestPragmas(c, key) + let ident = + if key.kind in nkIdentKinds: + considerQuotedIdent(c, key) + else: + nil + if ident != nil and strTableGet(c.userPragmas, ident) != nil: discard "User-defined pragma" else: - var amb = false - let sym = searchInScopes(c, ident, amb) + let sym = qualifiedLookUp(c, key, {}) # XXX: What to do here if amb is true? if sym != nil and sfCustomPragma in sym.flags: discard "Custom user pragma" @@ -1662,7 +1858,7 @@ proc semProcTypeWithScope(c: PContext, n: PNode, if n[1].kind != nkEmpty and n[1].len > 0: pragma(c, s, n[1], procTypePragmas) when useEffectSystem: setEffectsForProcType(c.graph, result, n[1]) - elif c.optionStack.len > 0 and optNimV1Emulation notin c.config.globalOptions: + elif c.optionStack.len > 0: # we construct a fake 'nkProcDef' for the 'mergePragmas' inside 'implicitPragmas'... s.ast = newTree(nkProcDef, newNodeI(nkEmpty, n.info), newNodeI(nkEmpty, n.info), newNodeI(nkEmpty, n.info), newNodeI(nkEmpty, n.info), newNodeI(nkEmpty, n.info)) @@ -1683,14 +1879,18 @@ proc semStaticType(c: PContext, childNode: PNode, prev: PType): PType = result.rawAddSon(base) result.flags.incl tfHasStatic -proc semTypeof(c: PContext; n: PNode; prev: PType): PType = +proc semTypeOf(c: PContext; n: PNode; prev: PType): PType = openScope(c) + inc c.inTypeofContext + defer: dec c.inTypeofContext # compiles can raise an exception let t = semExprWithType(c, n, {efInTypeof}) closeScope(c) fixupTypeOf(c, prev, t) result = t.typ + if result.kind == tyFromExpr: + result.flags.incl tfNonConstExpr -proc semTypeof2(c: PContext; n: PNode; prev: PType): PType = +proc semTypeOf2(c: PContext; n: PNode; prev: PType): PType = openScope(c) var m = BiggestInt 1 # typeOfIter if n.len == 3: @@ -1699,10 +1899,81 @@ proc semTypeof2(c: PContext; n: PNode; prev: PType): PType = localError(c.config, n.info, "typeof: cannot evaluate 'mode' parameter at compile-time") else: m = mode.intVal + inc c.inTypeofContext + defer: dec c.inTypeofContext # compiles can raise an exception let t = semExprWithType(c, n[1], if m == 1: {efInTypeof} else: {}) closeScope(c) fixupTypeOf(c, prev, t) result = t.typ + if result.kind == tyFromExpr: + result.flags.incl tfNonConstExpr + +proc semTypeIdent(c: PContext, n: PNode): PSym = + if n.kind == nkSym: + result = getGenSym(c, n.sym) + else: + result = pickSym(c, n, {skType, skGenericParam, skParam}) + if result.isNil: + result = qualifiedLookUp(c, n, {checkAmbiguity, checkUndeclared}) + if result != nil: + markUsed(c, n.info, result) + onUse(n.info, result) + + # alias syntax, see semSym for skTemplate, skMacro + if result.kind in {skTemplate, skMacro} and sfNoalias notin result.flags: + let t = semTypeExpr(c, n, nil) + result = symFromType(c, t, n.info) + + if result.kind == skParam and result.typ.kind == tyTypeDesc: + # This is a typedesc param. is it already bound? + # it's not bound when it's used multiple times in the + # proc signature for example + if c.inGenericInst > 0: + let bound = result.typ.elementType.sym + if bound != nil: return bound + return result + if result.typ.sym == nil: + localError(c.config, n.info, errTypeExpected) + return errorSym(c, n) + result = result.typ.sym.copySym(c.idgen) + result.typ = exactReplica(result.typ) + result.typ.flags.incl tfUnresolved + + if result.kind == skGenericParam: + if result.typ.kind == tyGenericParam and result.typ.len == 0 and + tfWildcard in result.typ.flags: + # collapse the wild-card param to a type + result.transitionGenericParamToType() + result.typ.flags.excl tfWildcard + return + else: + localError(c.config, n.info, errTypeExpected) + return errorSym(c, n) + if result.kind != skType and result.magic notin {mStatic, mType, mTypeOf}: + # this implements the wanted ``var v: V, x: V`` feature ... + var ov: TOverloadIter = default(TOverloadIter) + var amb = initOverloadIter(ov, c, n) + while amb != nil and amb.kind != skType: + amb = nextOverloadIter(ov, c, n) + if amb != nil: result = amb + else: + if result.kind != skError: localError(c.config, n.info, errTypeExpected) + return errorSym(c, n) + if result.typ.kind != tyGenericParam: + # XXX get rid of this hack! + var oldInfo = n.info + when defined(useNodeIds): + let oldId = n.id + reset(n[]) + when defined(useNodeIds): + n.id = oldId + n.transitionNoneToSym() + n.sym = result + n.info = oldInfo + n.typ = result.typ + else: + localError(c.config, n.info, "identifier expected") + result = errorSym(c, n) proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = nil @@ -1714,7 +1985,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = of nkTypeOfExpr: # for ``typeof(countup(1,3))``, see ``tests/ttoseq``. checkSonsLen(n, 1, c.config) - result = semTypeof(c, n[0], prev) + result = semTypeOf(c, n[0], prev) if result.kind == tyTypeDesc: result.flags.incl tfExplicit of nkPar: if n.len == 1: result = semTypeNode(c, n[0], prev) @@ -1723,11 +1994,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = of nkTupleConstr: result = semAnonTuple(c, n, prev) of nkCallKinds: let x = n[0] - let ident = case x.kind - of nkIdent: x.ident - of nkSym: x.sym.name - of nkClosedSymChoice, nkOpenSymChoice: x[0].sym.name - else: nil + let ident = x.getPIdent if ident != nil and ident.s == "[]": let b = newNodeI(nkBracketExpr, n.info) for i in 1..<n.len: b.add(n[i]) @@ -1746,7 +2013,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = semTypeExpr(c, n, prev) else: let op = considerQuotedIdent(c, n[0]) - if op.id in {ord(wAnd), ord(wOr)} or op.s == "|": + if op.id == ord(wAnd) or op.id == ord(wOr) or op.s == "|": checkSonsLen(n, 3, c.config) var t1 = semTypeNode(c, n[1], nil) @@ -1816,20 +2083,22 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = semAnyRef(c, n, tyRef, prev) elif op.id == ord(wType): checkSonsLen(n, 2, c.config) - result = semTypeof(c, n[1], prev) - elif op.s == "typeof" and n[0].kind == nkSym and n[0].sym.magic == mTypeOf: - result = semTypeof2(c, n, prev) + result = semTypeOf(c, n[1], prev) + elif op.s == "typeof" and ( + (n[0].kind == nkSym and n[0].sym.magic == mTypeOf) or + (n[0].kind == nkOpenSym and n[0][0].sym.magic == mTypeOf)): + result = semTypeOf2(c, n, prev) elif op.s == "owned" and optOwnedRefs notin c.config.globalOptions and n.len == 2: result = semTypeExpr(c, n[1], prev) else: - if c.inGenericContext > 0 and n.kind == nkCall: - result = makeTypeFromExpr(c, n.copyTree) - else: - result = semTypeExpr(c, n, prev) + result = semTypeExpr(c, n, prev) of nkWhenStmt: var whenResult = semWhen(c, n, false) if whenResult.kind == nkStmtList: whenResult.transitionSonsKind(nkStmtListType) - result = semTypeNode(c, whenResult, prev) + if whenResult.kind == nkWhenStmt: + result = whenResult.typ + else: + result = semTypeNode(c, whenResult, prev) of nkBracketExpr: checkMinSonsLen(n, 2, c.config) var head = n[0] @@ -1842,6 +2111,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = of mRange: result = semRange(c, n, prev) of mSet: result = semSet(c, n, prev) of mOrdinal: result = semOrdinal(c, n, prev) + of mIterableType: result = semIterableType(c, n, prev) of mSeq: result = semContainer(c, n, tySequence, "seq", prev) if optSeqDestructors in c.config.globalOptions: @@ -1856,7 +2126,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = semTypeNode(c, n[0], nil) if result != nil: let old = result - result = copyType(result, nextTypeId c.idgen, getCurrOwner(c)) + result = copyType(result, c.idgen, getCurrOwner(c)) copyTypeProps(c.graph, c.idgen.module, result, old) for i in 1..<n.len: result.rawAddSon(semTypeNode(c, n[i], nil)) @@ -1873,6 +2143,12 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = of mRef: result = semAnyRef(c, n, tyRef, prev) of mPtr: result = semAnyRef(c, n, tyPtr, prev) of mTuple: result = semTuple(c, n, prev) + of mBuiltinType: + case s.name.s + of "lent": result = semAnyRef(c, n, tyLent, prev) + of "sink": result = semAnyRef(c, n, tySink, prev) + of "owned": result = semAnyRef(c, n, tyOwned, prev) + else: result = semGeneric(c, n, s, prev) else: result = semGeneric(c, n, s, prev) of nkDotExpr: let typeExpr = semExpr(c, n) @@ -1902,7 +2178,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = if s.kind != skError: localError(c.config, n.info, errTypeExpected) result = newOrPrevType(tyError, prev, c) elif s.kind == skParam and s.typ.kind == tyTypeDesc: - internalAssert c.config, s.typ.base.kind != tyNone and prev == nil + internalAssert c.config, s.typ.base.kind != tyNone result = s.typ.base elif prev == nil: result = s.typ @@ -1910,6 +2186,8 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = let alias = maybeAliasType(c, s.typ, prev) if alias != nil: result = alias + elif prev.kind == tyGenericBody: + result = s.typ else: assignType(prev, s.typ) # bugfix: keep the fresh id for aliases to integral types: @@ -1924,12 +2202,12 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = if s.kind == skType: s.typ else: - internalAssert c.config, s.typ.base.kind != tyNone and prev == nil + internalAssert c.config, s.typ.base.kind != tyNone s.typ.base let alias = maybeAliasType(c, t, prev) if alias != nil: result = alias - elif prev == nil: + elif prev == nil or prev.kind == tyGenericBody: result = t else: assignType(prev, t) @@ -1944,41 +2222,53 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = localError(c.config, n.info, "type expected, but got symbol '$1' of kind '$2'" % [s.name.s, s.kind.toHumanStr]) result = newOrPrevType(tyError, prev, c) - of nkObjectTy: result = semObjectNode(c, n, prev, isInheritable=false) + of nkObjectTy: result = semObjectNode(c, n, prev, {}) of nkTupleTy: result = semTuple(c, n, prev) of nkTupleClassTy: result = newConstraint(c, tyTuple) of nkTypeClassTy: result = semTypeClass(c, n, prev) of nkRefTy: result = semAnyRef(c, n, tyRef, prev) of nkPtrTy: result = semAnyRef(c, n, tyPtr, prev) - of nkVarTy: result = semVarOutType(c, n, prev, tyVar) + of nkVarTy: result = semVarOutType(c, n, prev, {}) + of nkOutTy: result = semVarOutType(c, n, prev, {tfIsOutParam}) of nkDistinctTy: result = semDistinct(c, n, prev) of nkStaticTy: result = semStaticType(c, n[0], prev) - of nkIteratorTy: - if n.len == 0: + of nkProcTy, nkIteratorTy: + if n.len == 0 or n[0].kind == nkEmpty: + # 0 length or empty param list with possible pragmas imply typeclass result = newTypeS(tyBuiltInTypeClass, c) let child = newTypeS(tyProc, c) - child.flags.incl tfIterator + if n.kind == nkIteratorTy: + child.flags.incl tfIterator + if n.len > 0 and n[1].kind != nkEmpty and n[1].len > 0: + # typeclass with pragma + let symKind = if n.kind == nkIteratorTy: skIterator else: skProc + # dummy symbol for `pragma`: + var s = newSymS(symKind, newIdentNode(getIdent(c.cache, "dummy"), n.info), c) + s.typ = child + # for now only call convention pragmas supported in proc typeclass + pragma(c, s, n[1], {FirstCallConv..LastCallConv}) result.addSonSkipIntLit(child, c.idgen) else: - result = semProcTypeWithScope(c, n, prev, skIterator) - if result.kind == tyProc: + let symKind = if n.kind == nkIteratorTy: skIterator else: skProc + result = semProcTypeWithScope(c, n, prev, symKind) + if result == nil: + localError(c.config, n.info, "type expected, but got: " & renderTree(n)) + result = newOrPrevType(tyError, prev, c) + + if n.kind == nkIteratorTy and result.kind == tyProc: result.flags.incl(tfIterator) - if n.lastSon.kind == nkPragma and hasPragma(n.lastSon, wInline): - result.callConv = ccInline - else: - result.callConv = ccClosure - of nkProcTy: - if n.len == 0: - result = newConstraint(c, tyProc) - else: - result = semProcTypeWithScope(c, n, prev, skProc) + if result.callConv == ccClosure and c.config.selectedGC in {gcArc, gcOrc, gcAtomicArc}: + result.flags.incl tfHasAsgn of nkEnumTy: result = semEnum(c, n, prev) of nkType: result = n.typ of nkStmtListType: result = semStmtListType(c, n, prev) of nkBlockType: result = semBlockType(c, n, prev) + of nkOpenSym: result = semTypeNode(c, n[0], prev) else: - localError(c.config, n.info, "type expected, but got: " & renderTree(n)) - result = newOrPrevType(tyError, prev, c) + result = semTypeExpr(c, n, prev) + when false: + localError(c.config, n.info, "type expected, but got: " & renderTree(n)) + result = newOrPrevType(tyError, prev, c) n.typ = result dec c.inTypeContext @@ -2024,7 +2314,7 @@ proc processMagicType(c: PContext, m: PSym) = if optSeqDestructors in c.config.globalOptions: incl m.typ.flags, tfHasAsgn of mCstring: - setMagicIntegral(c.config, m, tyCString, c.config.target.ptrSize) + setMagicIntegral(c.config, m, tyCstring, c.config.target.ptrSize) rawAddSon(m.typ, getSysType(c.graph, m.info, tyChar)) of mPointer: setMagicIntegral(c.config, m, tyPointer, c.config.target.ptrSize) of mNil: setMagicType(c.config, m, tyNil, c.config.target.ptrSize) @@ -2060,11 +2350,17 @@ proc processMagicType(c: PContext, m: PSym) = setMagicType(c.config, m, tySequence, szUncomputedSize) if optSeqDestructors in c.config.globalOptions: incl m.typ.flags, tfHasAsgn - assert c.graph.sysTypes[tySequence] == nil + if defined(nimsuggest) or c.config.cmd == cmdCheck: # bug #18985 + discard + else: + assert c.graph.sysTypes[tySequence] == nil c.graph.sysTypes[tySequence] = m.typ of mOrdinal: setMagicIntegral(c.config, m, tyOrdinal, szUncomputedSize) rawAddSon(m.typ, newTypeS(tyNone, c)) + of mIterableType: + setMagicIntegral(c.config, m, tyIterable, 0) + rawAddSon(m.typ, newTypeS(tyNone, c)) of mPNimrodNode: incl m.typ.flags, tfTriggersCompileTime incl m.typ.flags, tfCheckedForDestructor @@ -2080,7 +2376,7 @@ proc processMagicType(c: PContext, m: PSym) = else: localError(c.config, m.info, errTypeExpected) proc semGenericConstraints(c: PContext, x: PType): PType = - result = newTypeWithSons(c, tyGenericParam, @[x]) + result = newTypeS(tyGenericParam, c, x) proc semGenericParamList(c: PContext, n: PNode, father: PType = nil): PNode = @@ -2100,14 +2396,14 @@ proc semGenericParamList(c: PContext, n: PNode, father: PType = nil): PNode = of nkIdentDefs: var def = a[^1] let constraint = a[^2] - var typ: PType + var typ: PType = nil if constraint.kind != nkEmpty: typ = semTypeNode(c, constraint, nil) if typ.kind != tyStatic or typ.len == 0: if typ.kind == tyTypeDesc: - if typ[0].kind == tyNone: - typ = newTypeWithSons(c, tyTypeDesc, @[newTypeS(tyNone, c)]) + if typ.elementType.kind == tyNone: + typ = newTypeS(tyTypeDesc, c, newTypeS(tyNone, c)) incl typ.flags, tfCheckedForDestructor else: typ = semGenericConstraints(c, typ) @@ -2116,7 +2412,7 @@ proc semGenericParamList(c: PContext, n: PNode, father: PType = nil): PNode = def = semConstExpr(c, def) if typ == nil: if def.typ.kind != tyTypeDesc: - typ = newTypeWithSons(c, tyStatic, @[def.typ]) + typ = newTypeS(tyStatic, c, def.typ) else: # the following line fixes ``TV2*[T:SomeNumber=TR] = array[0..1, T]`` # from manyloc/named_argument_bug/triengine: @@ -2135,7 +2431,7 @@ proc semGenericParamList(c: PContext, n: PNode, father: PType = nil): PNode = if j == 0: finalType = typ else: - finalType = copyType(typ, nextTypeId c.idgen, typ.owner) + finalType = copyType(typ, c.idgen, typ.owner) copyTypeProps(c.graph, c.idgen.module, finalType, typ) # it's important the we create an unique # type for each generic param. the index diff --git a/compiler/semtypinst.nim b/compiler/semtypinst.nim index c9b9e39ea..759e8e6ab 100644 --- a/compiler/semtypinst.nim +++ b/compiler/semtypinst.nim @@ -9,70 +9,71 @@ # This module does the instantiation of generic types. +import std / tables + import ast, astalgo, msgs, types, magicsys, semdata, renderer, options, lineinfos, modulegraphs -from concepts import makeTypeDesc +when defined(nimPreviewSlimSystem): + import std/assertions const tfInstClearedFlags = {tfHasMeta, tfUnresolved} proc checkPartialConstructedType(conf: ConfigRef; info: TLineInfo, t: PType) = - if t.kind in {tyVar, tyLent} and t[0].kind in {tyVar, tyLent}: + if t.kind in {tyVar, tyLent} and t.elementType.kind in {tyVar, tyLent}: localError(conf, info, "type 'var var' is not allowed") proc checkConstructedType*(conf: ConfigRef; info: TLineInfo, typ: PType) = var t = typ.skipTypes({tyDistinct}) if t.kind in tyTypeClasses: discard - elif t.kind in {tyVar, tyLent} and t[0].kind in {tyVar, tyLent}: + elif t.kind in {tyVar, tyLent} and t.elementType.kind in {tyVar, tyLent}: localError(conf, info, "type 'var var' is not allowed") elif computeSize(conf, t) == szIllegalRecursion or isTupleRecursive(t): localError(conf, info, "illegal recursion in type '" & typeToString(t) & "'") - when false: - if t.kind == tyObject and t[0] != nil: - if t[0].kind != tyObject or tfFinal in t[0].flags: - localError(info, errInheritanceOnlyWithNonFinalObjects) proc searchInstTypes*(g: ModuleGraph; key: PType): PType = + result = nil let genericTyp = key[0] if not (genericTyp.kind == tyGenericBody and - key[0] == genericTyp and genericTyp.sym != nil): return + genericTyp.sym != nil): return for inst in typeInstCacheItems(g, genericTyp.sym): if inst.id == key.id: return inst - if inst.len < key.len: + if inst.kidsLen < key.kidsLen: # XXX: This happens for prematurely cached # types such as Channel[empty]. Why? # See the notes for PActor in handleGenericInvocation - return + # if this is return the same type gets cached more than it needs to + continue if not sameFlags(inst, key): continue block matchType: - for j in 1..high(key.sons): + for j in FirstGenericParamAt..<key.kidsLen: # XXX sameType is not really correct for nested generics? if not compareTypes(inst[j], key[j], - flags = {ExactGenericParams}): + flags = {ExactGenericParams, PickyCAliases}): break matchType return inst proc cacheTypeInst(c: PContext; inst: PType) = let gt = inst[0] - let t = if gt.kind == tyGenericBody: gt.lastSon else: gt + let t = if gt.kind == tyGenericBody: gt.typeBodyImpl else: gt if t.kind in {tyStatic, tyError, tyGenericParam} + tyTypeClasses: return addToGenericCache(c, gt.sym, inst) type - LayeredIdTable* = ref object - topLayer*: TIdTable + LayeredIdTable* {.acyclic.} = ref object + topLayer*: TypeMapping nextLayer*: LayeredIdTable TReplTypeVars* = object c*: PContext typeMap*: LayeredIdTable # map PType to PType - symMap*: TIdTable # map PSym to PSym - localCache*: TIdTable # local cache for remembering already replaced + symMap*: SymMapping # map PSym to PSym + localCache*: TypeMapping # local cache for remembering already replaced # types during instantiation of meta types # (they are not stored in the global cache) info*: TLineInfo @@ -84,27 +85,26 @@ type recursionLimit: int proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType -proc replaceTypeVarsS(cl: var TReplTypeVars, s: PSym): PSym -proc replaceTypeVarsN*(cl: var TReplTypeVars, n: PNode; start=0): PNode +proc replaceTypeVarsS(cl: var TReplTypeVars, s: PSym, t: PType): PSym +proc replaceTypeVarsN*(cl: var TReplTypeVars, n: PNode; start=0; expectedType: PType = nil): PNode -proc initLayeredTypeMap*(pt: TIdTable): LayeredIdTable = +proc initLayeredTypeMap*(pt: sink TypeMapping): LayeredIdTable = result = LayeredIdTable() - copyIdTable(result.topLayer, pt) + result.topLayer = pt proc newTypeMapLayer*(cl: var TReplTypeVars): LayeredIdTable = - result = LayeredIdTable() - result.nextLayer = cl.typeMap - initIdTable(result.topLayer) + result = LayeredIdTable(nextLayer: cl.typeMap, topLayer: initTable[ItemId, PType]()) proc lookup(typeMap: LayeredIdTable, key: PType): PType = + result = nil var tm = typeMap while tm != nil: - result = PType(idTableGet(tm.topLayer, key)) + result = getOrDefault(tm.topLayer, key.itemId) if result != nil: return tm = tm.nextLayer template put(typeMap: LayeredIdTable, key, value: PType) = - idTablePut(typeMap.topLayer, key, value) + typeMap.topLayer[key.itemId] = value template checkMetaInvariants(cl: TReplTypeVars, t: PType) = # noop code when false: @@ -118,19 +118,86 @@ proc replaceTypeVarsT*(cl: var TReplTypeVars, t: PType): PType = result = replaceTypeVarsTAux(cl, t) checkMetaInvariants(cl, result) -proc prepareNode(cl: var TReplTypeVars, n: PNode): PNode = +proc prepareNode*(cl: var TReplTypeVars, n: PNode): PNode = + ## instantiates a given generic expression, not a type node + if n.kind == nkSym and n.sym.kind == skType and + n.sym.typ != nil and n.sym.typ.kind == tyGenericBody: + # generic body types are allowed as user expressions, see #24090 + return n let t = replaceTypeVarsT(cl, n.typ) if t != nil and t.kind == tyStatic and t.n != nil: return if tfUnresolved in t.flags: prepareNode(cl, t.n) else: t.n result = copyNode(n) result.typ = t - if result.kind == nkSym: result.sym = replaceTypeVarsS(cl, n.sym) - let isCall = result.kind in nkCallKinds - for i in 0..<n.safeLen: - # XXX HACK: ``f(a, b)``, avoid to instantiate `f` - if isCall and i == 0: result.add(n[i]) - else: result.add(prepareNode(cl, n[i])) + if result.kind == nkSym: + result.sym = + if n.typ != nil and n.typ == n.sym.typ: + replaceTypeVarsS(cl, n.sym, result.typ) + else: + replaceTypeVarsS(cl, n.sym, replaceTypeVarsT(cl, n.sym.typ)) + # we need to avoid trying to instantiate nodes that can have uninstantiated + # types, like generic proc symbols or raw generic type symbols + case n.kind + of nkSymChoices: + # don't try to instantiate symchoice symbols, they can be + # generic procs which the compiler will think are uninstantiated + # because their type will contain uninstantiated params + for i in 0..<n.len: + result.add(n[i]) + of nkCallKinds: + # don't try to instantiate call names since they may be generic proc syms + # also bracket expressions can turn into calls with symchoice [] and + # we need to not instantiate the Generic in Generic[int] + # exception exists for the call name being a dot expression since + # dot expressions need their LHS instantiated + assert n.len != 0 + # avoid instantiating generic proc symbols, refine condition if needed: + let ignoreFirst = n[0].kind notin {nkDotExpr, nkBracketExpr} + nkCallKinds + let name = n[0].getPIdent + let ignoreSecond = name != nil and name.s == "[]" and n.len > 1 and + # generic type instantiation: + ((n[1].typ != nil and n[1].typ.kind == tyTypeDesc) or + # generic proc instantiation: + (n[1].kind == nkSym and n[1].sym.isGenericRoutineStrict)) + if ignoreFirst: + result.add(n[0]) + else: + result.add(prepareNode(cl, n[0])) + if n.len > 1: + if ignoreSecond: + result.add(n[1]) + else: + result.add(prepareNode(cl, n[1])) + for i in 2..<n.len: + result.add(prepareNode(cl, n[i])) + of nkBracketExpr: + # don't instantiate Generic body type in expression like Generic[T] + # exception exists for the call name being a dot expression since + # dot expressions need their LHS instantiated + assert n.len != 0 + let ignoreFirst = n[0].kind != nkDotExpr and + # generic type instantiation: + ((n[0].typ != nil and n[0].typ.kind == tyTypeDesc) or + # generic proc instantiation: + (n[0].kind == nkSym and n[0].sym.isGenericRoutineStrict)) + if ignoreFirst: + result.add(n[0]) + else: + result.add(prepareNode(cl, n[0])) + for i in 1..<n.len: + result.add(prepareNode(cl, n[i])) + of nkDotExpr: + # don't try to instantiate RHS of dot expression, it can outright be + # undeclared, but definitely instantiate LHS + assert n.len >= 2 + result.add(prepareNode(cl, n[0])) + result.add(n[1]) + for i in 2..<n.len: + result.add(prepareNode(cl, n[i])) + else: + for i in 0..<n.safeLen: + result.add(prepareNode(cl, n[i])) proc isTypeParam(n: PNode): bool = # XXX: generic params should use skGenericParam instead of skType @@ -138,27 +205,28 @@ proc isTypeParam(n: PNode): bool = (n.sym.kind == skGenericParam or (n.sym.kind == skType and sfFromGeneric in n.sym.flags)) -proc reResolveCallsWithTypedescParams(cl: var TReplTypeVars, n: PNode): PNode = - # This is needed for tgenericshardcases - # It's possible that a generic param will be used in a proc call to a - # typedesc accepting proc. After generic param substitution, such procs - # should be optionally instantiated with the correct type. In order to - # perform this instantiation, we need to re-run the generateInstance path - # in the compiler, but it's quite complicated to do so at the moment so we - # resort to a mild hack; the head symbol of the call is temporary reset and - # overload resolution is executed again (which may trigger generateInstance). - if n.kind in nkCallKinds and sfFromGeneric in n[0].sym.flags: - var needsFixing = false - for i in 1..<n.safeLen: - if isTypeParam(n[i]): needsFixing = true - if needsFixing: - n[0] = newSymNode(n[0].sym.owner) - return cl.c.semOverloadedCall(cl.c, n, n, {skProc, skFunc}, {}) - - for i in 0..<n.safeLen: - n[i] = reResolveCallsWithTypedescParams(cl, n[i]) - - return n +when false: # old workaround + proc reResolveCallsWithTypedescParams(cl: var TReplTypeVars, n: PNode): PNode = + # This is needed for tuninstantiatedgenericcalls + # It's possible that a generic param will be used in a proc call to a + # typedesc accepting proc. After generic param substitution, such procs + # should be optionally instantiated with the correct type. In order to + # perform this instantiation, we need to re-run the generateInstance path + # in the compiler, but it's quite complicated to do so at the moment so we + # resort to a mild hack; the head symbol of the call is temporary reset and + # overload resolution is executed again (which may trigger generateInstance). + if n.kind in nkCallKinds and sfFromGeneric in n[0].sym.flags: + var needsFixing = false + for i in 1..<n.safeLen: + if isTypeParam(n[i]): needsFixing = true + if needsFixing: + n[0] = newSymNode(n[0].sym.owner) + return cl.c.semOverloadedCall(cl.c, n, n, {skProc, skFunc}, {}) + + for i in 0..<n.safeLen: + n[i] = reResolveCallsWithTypedescParams(cl, n[i]) + + return n proc replaceObjBranches(cl: TReplTypeVars, n: PNode): PNode = result = n @@ -190,10 +258,31 @@ proc replaceObjBranches(cl: TReplTypeVars, n: PNode): PNode = for i in 0..<n.len: n[i] = replaceObjBranches(cl, n[i]) -proc replaceTypeVarsN(cl: var TReplTypeVars, n: PNode; start=0): PNode = +proc hasValuelessStatics(n: PNode): bool = + # We should only attempt to call an expression that has no tyStatics + # As those are unresolved generic parameters, which means in the following + # The compiler attempts to do `T == 300` which errors since the typeclass `MyThing` lacks a parameter + #[ + type MyThing[T: static int] = object + when T == 300: + a + proc doThing(_: MyThing) + ]# + if n.safeLen == 0 and n.kind != nkEmpty: # Some empty nodes can get in here + n.typ == nil or n.typ.kind == tyStatic + else: + for x in n: + if hasValuelessStatics(x): + return true + false + +proc replaceTypeVarsN(cl: var TReplTypeVars, n: PNode; start=0; expectedType: PType = nil): PNode = if n == nil: return result = copyNode(n) if n.typ != nil: + if n.typ.kind == tyFromExpr: + # type of node should not be evaluated as a static value + n.typ.flags.incl tfNonConstExpr result.typ = replaceTypeVarsT(cl, n.typ) checkMetaInvariants(cl, result.typ) case n.kind @@ -201,8 +290,13 @@ proc replaceTypeVarsN(cl: var TReplTypeVars, n: PNode; start=0): PNode = discard of nkOpenSymChoice, nkClosedSymChoice: result = n of nkSym: - result.sym = replaceTypeVarsS(cl, n.sym) - if result.sym.typ.kind == tyVoid: + result.sym = + if n.typ != nil and n.typ == n.sym.typ: + replaceTypeVarsS(cl, n.sym, result.typ) + else: + replaceTypeVarsS(cl, n.sym, replaceTypeVarsT(cl, n.sym.typ)) + # sym type can be nil if was gensym created by macro, see #24048 + if result.sym.typ != nil and result.sym.typ.kind == tyVoid: # don't add the 'void' field result = newNodeI(nkRecList, n.info) of nkRecWhen: @@ -214,10 +308,11 @@ proc replaceTypeVarsN(cl: var TReplTypeVars, n: PNode; start=0): PNode = of nkElifBranch: checkSonsLen(it, 2, cl.c.config) var cond = prepareNode(cl, it[0]) - var e = cl.c.semConstExpr(cl.c, cond) - if e.kind != nkIntLit: - internalError(cl.c.config, e.info, "ReplaceTypeVarsN: when condition not a bool") - if e.intVal != 0 and branch == nil: branch = it[1] + if not cond.hasValuelessStatics: + var e = cl.c.semConstExpr(cl.c, cond) + if e.kind != nkIntLit: + internalError(cl.c.config, e.info, "ReplaceTypeVarsN: when condition not a bool") + if e.intVal != 0 and branch == nil: branch = it[1] of nkElse: checkSonsLen(it, 1, cl.c.config) if branch == nil: branch = it[0] @@ -228,10 +323,11 @@ proc replaceTypeVarsN(cl: var TReplTypeVars, n: PNode; start=0): PNode = result = newNodeI(nkRecList, n.info) of nkStaticExpr: var n = prepareNode(cl, n) - n = reResolveCallsWithTypedescParams(cl, n) + when false: + n = reResolveCallsWithTypedescParams(cl, n) result = if cl.allowMetaTypes: n - else: cl.c.semExpr(cl.c, n) - if not cl.allowMetaTypes: + else: cl.c.semExpr(cl.c, n, {}, expectedType) + if not cl.allowMetaTypes and expectedType != nil: assert result.kind notin nkCallKinds else: if n.len > 0: @@ -241,7 +337,7 @@ proc replaceTypeVarsN(cl: var TReplTypeVars, n: PNode; start=0): PNode = for i in start..<n.len: result[i] = replaceTypeVarsN(cl, n[i]) -proc replaceTypeVarsS(cl: var TReplTypeVars, s: PSym): PSym = +proc replaceTypeVarsS(cl: var TReplTypeVars, s: PSym, t: PType): PSym = if s == nil: return nil # symbol is not our business: if cl.owner != nil and s.owner != cl.owner: @@ -278,15 +374,18 @@ proc replaceTypeVarsS(cl: var TReplTypeVars, s: PSym): PSym = var g: G[string] ]# - result = copySym(s, nextSymId cl.c.idgen) + result = copySym(s, cl.c.idgen) incl(result.flags, sfFromGeneric) #idTablePut(cl.symMap, s, result) result.owner = s.owner - result.typ = replaceTypeVarsT(cl, s.typ) + result.typ = t if result.kind != skType: result.ast = replaceTypeVarsN(cl, s.ast) proc lookupTypeVar(cl: var TReplTypeVars, t: PType): PType = + if tfRetType in t.flags and t.kind == tyAnything: + # don't bind `auto` return type to a previous binding of `auto` + return nil result = cl.typeMap.lookup(t) if result == nil: if cl.allowMetaTypes or tfRetType in t.flags: return @@ -304,7 +403,7 @@ proc instCopyType*(cl: var TReplTypeVars, t: PType): PType = if cl.allowMetaTypes: result = t.exactReplica else: - result = copyType(t, nextTypeId(cl.c.idgen), t.owner) + result = copyType(t, cl.c.idgen, t.owner) copyTypeProps(cl.c.graph, cl.c.idgen.module, result, t) #cl.typeMap.topLayer.idTablePut(result, t) @@ -324,13 +423,13 @@ proc instCopyType*(cl: var TReplTypeVars, t: PType): PType = proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = # tyGenericInvocation[A, tyGenericInvocation[A, B]] # is difficult to handle: - var body = t[0] + var body = t.genericHead if body.kind != tyGenericBody: internalError(cl.c.config, cl.info, "no generic body") var header = t # search for some instantiation here: if cl.allowMetaTypes: - result = PType(idTableGet(cl.localCache, t)) + result = getOrDefault(cl.localCache, t.itemId) else: result = searchInstTypes(cl.c.graph, t) @@ -338,7 +437,7 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = when defined(reportCacheHits): echo "Generic instantiation cached ", typeToString(result), " for ", typeToString(t) return - for i in 1..<t.len: + for i in FirstGenericParamAt..<t.kidsLen: var x = t[i] if x.kind in {tyGenericParam}: x = lookupTypeVar(cl, x) @@ -360,31 +459,34 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = else: header = instCopyType(cl, t) - result = newType(tyGenericInst, nextTypeId(cl.c.idgen), t[0].owner) + result = newType(tyGenericInst, cl.c.idgen, t.genericHead.owner, son = header.genericHead) result.flags = header.flags # be careful not to propagate unnecessary flags here (don't use rawAddSon) - result.sons = @[header[0]] # ugh need another pass for deeply recursive generic types (e.g. PActor) # we need to add the candidate here, before it's fully instantiated for # recursive instantions: if not cl.allowMetaTypes: cacheTypeInst(cl.c, result) else: - idTablePut(cl.localCache, t, result) + cl.localCache[t.itemId] = result let oldSkipTypedesc = cl.skipTypedesc cl.skipTypedesc = true cl.typeMap = newTypeMapLayer(cl) - for i in 1..<t.len: - var x = replaceTypeVarsT(cl, t[i]) + for i in FirstGenericParamAt..<t.kidsLen: + var x = replaceTypeVarsT(cl): + if header[i].kind == tyGenericInst: + t[i] + else: + header[i] assert x.kind != tyGenericInvocation header[i] = x propagateToOwner(header, x) cl.typeMap.put(body[i-1], x) - for i in 1..<t.len: + for i in FirstGenericParamAt..<t.kidsLen: # if one of the params is not concrete, we cannot do anything # but we already raised an error! rawAddSon(result, header[i], propagateHasAsgn = false) @@ -392,7 +494,7 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = if body.kind == tyError: return - let bbody = lastSon body + let bbody = last body var newbody = replaceTypeVarsT(cl, bbody) cl.skipTypedesc = oldSkipTypedesc newbody.flags = newbody.flags + (t.flags + body.flags - tfInstClearedFlags) @@ -406,6 +508,7 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = # One step is enough, because the recursive nature of # handleGenericInvocation will handle the alias-to-alias-to-alias case if newbody.isGenericAlias: newbody = newbody.skipGenericAlias + rawAddSon(result, newbody) checkPartialConstructedType(cl.c.config, cl.info, newbody) if not cl.allowMetaTypes: @@ -422,11 +525,11 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = # can come here for tyGenericInst too, see tests/metatype/ttypeor.nim # need to look into this issue later assert newbody.kind in {tyRef, tyPtr} - if newbody.lastSon.typeInst != nil: + if newbody.last.typeInst != nil: #internalError(cl.c.config, cl.info, "ref already has a 'typeInst' field") discard else: - newbody.lastSon.typeInst = result + newbody.last.typeInst = result # DESTROY: adding object|opt for opt[topttree.Tree] # sigmatch: Formal opt[=destroy.T] real opt[topttree.Tree] # adding myseq for myseq[system.int] @@ -446,25 +549,24 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = proc eraseVoidParams*(t: PType) = # transform '(): void' into '()' because old parts of the compiler really # don't deal with '(): void': - if t[0] != nil and t[0].kind == tyVoid: - t[0] = nil + if t.returnType != nil and t.returnType.kind == tyVoid: + t.setReturnType nil - for i in 1..<t.len: + for i in FirstParamAt..<t.signatureLen: # don't touch any memory unless necessary if t[i].kind == tyVoid: var pos = i - for j in i+1..<t.len: + for j in i+1..<t.signatureLen: if t[j].kind != tyVoid: t[pos] = t[j] t.n[pos] = t.n[j] inc pos - setLen t.sons, pos + newSons t, pos setLen t.n.sons, pos break proc skipIntLiteralParams*(t: PType; idgen: IdGenerator) = - for i in 0..<t.len: - let p = t[i] + for i, p in t.ikids: if p == nil: continue let skipped = p.skipIntLit(idgen) if skipped != p: @@ -473,8 +575,8 @@ proc skipIntLiteralParams*(t: PType; idgen: IdGenerator) = # when the typeof operator is used on a static input # param, the results gets infected with static as well: - if t[0] != nil and t[0].kind == tyStatic: - t[0] = t[0].base + if t.returnType != nil and t.returnType.kind == tyStatic: + t.setReturnType t.returnType.skipModifier proc propagateFieldFlags(t: PType, n: PNode) = # This is meant for objects and tuples @@ -492,32 +594,48 @@ proc propagateFieldFlags(t: PType, n: PNode) = proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = template bailout = - if cl.recursionLimit > 100: - # bail out, see bug #2509. But note this caching is in general wrong, - # look at this example where TwoVectors should not share the generic - # instantiations (bug #3112): - - # type - # Vector[N: static[int]] = array[N, float64] - # TwoVectors[Na, Nb: static[int]] = (Vector[Na], Vector[Nb]) - result = PType(idTableGet(cl.localCache, t)) - if result != nil: return result - inc cl.recursionLimit + if (t.sym == nil) or (t.sym != nil and sfGeneratedType in t.sym.flags): + # In the first case 't.sym' can be 'nil' if the type is a ref/ptr, see + # issue https://github.com/nim-lang/Nim/issues/20416 for more details. + # Fortunately for us this works for now because partial ref/ptr types are + # not allowed in object construction, eg. + # type + # Container[T] = ... + # O = object + # val: ref Container + # + # In the second case only consider the recursion limit if the symbol is a + # type with generic parameters that have not been explicitly supplied, + # typechecking should terminate when generic parameters are explicitly + # supplied. + if cl.recursionLimit > 100: + # bail out, see bug #2509. But note this caching is in general wrong, + # look at this example where TwoVectors should not share the generic + # instantiations (bug #3112): + # type + # Vector[N: static[int]] = array[N, float64] + # TwoVectors[Na, Nb: static[int]] = (Vector[Na], Vector[Nb]) + result = getOrDefault(cl.localCache, t.itemId) + if result != nil: return result + inc cl.recursionLimit result = t if t == nil: return - if t.kind in {tyStatic, tyGenericParam, tyConcept} + tyTypeClasses: + const lookupMetas = {tyStatic, tyGenericParam, tyConcept} + tyTypeClasses - {tyAnything} + if t.kind in lookupMetas or + (t.kind == tyAnything and tfRetType notin t.flags): let lookup = cl.typeMap.lookup(t) if lookup != nil: return lookup case t.kind of tyGenericInvocation: result = handleGenericInvocation(cl, t) - if result.lastSon.kind == tyUserTypeClass: + if result.last.kind == tyUserTypeClass: result.kind = tyUserTypeClassInst of tyGenericBody: + if cl.allowMetaTypes: return localError( cl.c.config, cl.info, @@ -536,21 +654,25 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = assert t.n.typ != t var n = prepareNode(cl, t.n) if n.kind != nkEmpty: - n = cl.c.semConstExpr(cl.c, n) + if tfNonConstExpr in t.flags: + n = cl.c.semExprWithType(cl.c, n, flags = {efInTypeof}) + else: + n = cl.c.semConstExpr(cl.c, n) if n.typ.kind == tyTypeDesc: # XXX: sometimes, chained typedescs enter here. # It may be worth investigating why this is happening, # because it may cause other bugs elsewhere. result = n.typ.skipTypes({tyTypeDesc}) # result = n.typ.base + elif tfNonConstExpr in t.flags: + result = n.typ else: - if n.typ.kind != tyStatic: + if n.typ.kind != tyStatic and n.kind != nkType: # XXX: In the future, semConstExpr should # return tyStatic values to let anyone make # use of this knowledge. The patching here # won't be necessary then. - result = newTypeS(tyStatic, cl.c) - result.sons = @[n.typ] + result = newTypeS(tyStatic, cl.c, son = n.typ) result.n = n else: result = n.typ @@ -566,19 +688,42 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = result = makeTypeDesc(cl.c, result) elif tfUnresolved in t.flags or cl.skipTypedesc: result = result.base - elif t[0].kind != tyNone: - result = makeTypeDesc(cl.c, replaceTypeVarsT(cl, t[0])) + elif t.elementType.kind != tyNone: + result = makeTypeDesc(cl.c, replaceTypeVarsT(cl, t.elementType)) - of tyUserTypeClass, tyStatic: + of tyUserTypeClass: result = t + + of tyStatic: + if cl.c.matchedConcept != nil: + # allow concepts to not instantiate statics for now + # they can't always infer them + return + if not containsGenericType(t) and (t.n == nil or t.n.kind in nkLiterals): + # no need to instantiate + return + bailout() + result = instCopyType(cl, t) + cl.localCache[t.itemId] = result + for i in FirstGenericParamAt..<result.kidsLen: + var r = result[i] + if r != nil: + r = replaceTypeVarsT(cl, r) + result[i] = r + propagateToOwner(result, r) + result.n = replaceTypeVarsN(cl, result.n) + if not cl.allowMetaTypes and result.n != nil and + result.base.kind != tyNone: + result.n = cl.c.semConstExpr(cl.c, result.n) + result.n.typ = result.base of tyGenericInst, tyUserTypeClassInst: bailout() result = instCopyType(cl, t) - idTablePut(cl.localCache, t, result) - for i in 1..<result.len: + cl.localCache[t.itemId] = result + for i in FirstGenericParamAt..<result.kidsLen: result[i] = replaceTypeVarsT(cl, result[i]) - propagateToOwner(result, result.lastSon) + propagateToOwner(result, result.last) else: if containsGenericType(t): @@ -587,17 +732,17 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = result = instCopyType(cl, t) result.size = -1 # needs to be recomputed #if not cl.allowMetaTypes: - idTablePut(cl.localCache, t, result) + cl.localCache[t.itemId] = result - for i in 0..<result.len: - if result[i] != nil: - if result[i].kind == tyGenericBody: + for i, resulti in result.ikids: + if resulti != nil: + if resulti.kind == tyGenericBody and not cl.allowMetaTypes: localError(cl.c.config, if t.sym != nil: t.sym.info else: cl.info, "cannot instantiate '" & typeToString(result[i], preferDesc) & "' inside of type definition: '" & t.owner.name.s & "'; Maybe generic arguments are missing?") - var r = replaceTypeVarsT(cl, result[i]) + var r = replaceTypeVarsT(cl, resulti) if result.kind == tyObject: # carefully coded to not skip the precious tyGenericInst: let r2 = r.skipTypes({tyAlias, tySink, tyOwned}) @@ -610,7 +755,7 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = result.n = replaceTypeVarsN(cl, result.n, ord(result.kind==tyProc)) case result.kind of tyArray: - let idx = result[0] + let idx = result.indexType internalAssert cl.c.config, idx.kind != tyStatic of tyObject, tyTuple: @@ -623,7 +768,7 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = skipIntLiteralParams(result, cl.c.idgen) of tyRange: - result[0] = result[0].skipTypes({tyStatic, tyDistinct}) + result.setIndexType result.indexType.skipTypes({tyStatic, tyDistinct}) else: discard else: @@ -632,8 +777,8 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = result = t # Slow path, we have some work to do - if t.kind == tyRef and t.len > 0 and t[0].kind == tyObject and t[0].n != nil: - discard replaceObjBranches(cl, t[0].n) + if t.kind == tyRef and t.hasElementType and t.elementType.kind == tyObject and t.elementType.n != nil: + discard replaceObjBranches(cl, t.elementType.n) elif result.n != nil and t.kind == tyObject: # Invalidate the type size as we may alter its structure @@ -642,20 +787,26 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = proc initTypeVars*(p: PContext, typeMap: LayeredIdTable, info: TLineInfo; owner: PSym): TReplTypeVars = - initIdTable(result.symMap) - initIdTable(result.localCache) - result.typeMap = typeMap - result.info = info - result.c = p - result.owner = owner - -proc replaceTypesInBody*(p: PContext, pt: TIdTable, n: PNode; - owner: PSym, allowMetaTypes = false): PNode = + result = TReplTypeVars(symMap: initSymMapping(), + localCache: initTypeMapping(), typeMap: typeMap, + info: info, c: p, owner: owner) + +proc replaceTypesInBody*(p: PContext, pt: TypeMapping, n: PNode; + owner: PSym, allowMetaTypes = false, + fromStaticExpr = false, expectedType: PType = nil): PNode = var typeMap = initLayeredTypeMap(pt) var cl = initTypeVars(p, typeMap, n.info, owner) cl.allowMetaTypes = allowMetaTypes pushInfoContext(p.config, n.info) - result = replaceTypeVarsN(cl, n) + result = replaceTypeVarsN(cl, n, expectedType = expectedType) + popInfoContext(p.config) + +proc prepareTypesInBody*(p: PContext, pt: TypeMapping, n: PNode; + owner: PSym = nil): PNode = + var typeMap = initLayeredTypeMap(pt) + var cl = initTypeVars(p, typeMap, n.info, owner) + pushInfoContext(p.config, n.info) + result = prepareNode(cl, n) popInfoContext(p.config) when false: @@ -670,8 +821,8 @@ when false: popInfoContext(p.config) proc recomputeFieldPositions*(t: PType; obj: PNode; currPosition: var int) = - if t != nil and t.len > 0 and t[0] != nil: - let b = skipTypes(t[0], skipPtrs) + if t != nil and t.baseClass != nil: + let b = skipTypes(t.baseClass, skipPtrs) recomputeFieldPositions(b, b.n, currPosition) case obj.kind of nkRecList: @@ -685,7 +836,7 @@ proc recomputeFieldPositions*(t: PType; obj: PNode; currPosition: var int) = inc currPosition else: discard "cannot happen" -proc generateTypeInstance*(p: PContext, pt: TIdTable, info: TLineInfo, +proc generateTypeInstance*(p: PContext, pt: TypeMapping, info: TLineInfo, t: PType): PType = # Given `t` like Foo[T] # pt: Table with type mappings: T -> int @@ -701,7 +852,7 @@ proc generateTypeInstance*(p: PContext, pt: TIdTable, info: TLineInfo, var position = 0 recomputeFieldPositions(objType, objType.n, position) -proc prepareMetatypeForSigmatch*(p: PContext, pt: TIdTable, info: TLineInfo, +proc prepareMetatypeForSigmatch*(p: PContext, pt: TypeMapping, info: TLineInfo, t: PType): PType = var typeMap = initLayeredTypeMap(pt) var cl = initTypeVars(p, typeMap, info, nil) @@ -710,6 +861,6 @@ proc prepareMetatypeForSigmatch*(p: PContext, pt: TIdTable, info: TLineInfo, result = replaceTypeVarsT(cl, t) popInfoContext(p.config) -template generateTypeInstance*(p: PContext, pt: TIdTable, arg: PNode, +template generateTypeInstance*(p: PContext, pt: TypeMapping, arg: PNode, t: PType): untyped = generateTypeInstance(p, pt, arg.info, t) diff --git a/compiler/sighashes.nim b/compiler/sighashes.nim index 156bc66d7..d8dfe1828 100644 --- a/compiler/sighashes.nim +++ b/compiler/sighashes.nim @@ -9,14 +9,22 @@ ## Computes hash values for routine (proc, method etc) signatures. -import ast, tables, ropes, md5, modulegraphs -from hashes import Hash +import ast, ropes, modulegraphs, options, msgs, pathutils +from std/hashes import Hash +import std/tables import types +import ../dist/checksums/src/checksums/md5 + + +when defined(nimPreviewSlimSystem): + import std/assertions + proc `&=`(c: var MD5Context, s: string) = md5Update(c, s, s.len) -proc `&=`(c: var MD5Context, ch: char) = md5Update(c, unsafeAddr ch, 1) -proc `&=`(c: var MD5Context, r: Rope) = - for l in leaves(r): md5Update(c, l, l.len) +proc `&=`(c: var MD5Context, ch: char) = + # XXX suspicious code here; relies on ch being zero terminated? + md5Update(c, cast[cstring](unsafeAddr ch), 1) + proc `&=`(c: var MD5Context, i: BiggestInt) = md5Update(c, cast[cstring](unsafeAddr i), sizeof(i)) proc `&=`(c: var MD5Context, f: BiggestFloat) = @@ -37,8 +45,7 @@ type CoDistinct CoHashTypeInsideNode -proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]) - +proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]; conf: ConfigRef) proc hashSym(c: var MD5Context, s: PSym) = if sfAnon in s.flags or s.kind == skGenericParam: c &= ":anon" @@ -48,21 +55,26 @@ proc hashSym(c: var MD5Context, s: PSym) = c &= it.name.s c &= "." it = it.owner + c &= "#" + c &= s.disamb -proc hashTypeSym(c: var MD5Context, s: PSym) = +proc hashTypeSym(c: var MD5Context, s: PSym; conf: ConfigRef) = if sfAnon in s.flags or s.kind == skGenericParam: c &= ":anon" else: var it = s + c &= customPath(conf.toFullPath(s.info)) while it != nil: if sfFromGeneric in it.flags and it.kind in routineKinds and it.typ != nil: - hashType c, it.typ, {CoProc} + hashType c, it.typ, {CoProc}, conf c &= it.name.s c &= "." it = it.owner + c &= "#" + c &= s.disamb -proc hashTree(c: var MD5Context, n: PNode; flags: set[ConsiderFlag]) = +proc hashTree(c: var MD5Context, n: PNode; flags: set[ConsiderFlag]; conf: ConfigRef) = if n == nil: c &= "\255" return @@ -77,7 +89,7 @@ proc hashTree(c: var MD5Context, n: PNode; flags: set[ConsiderFlag]) = of nkSym: hashSym(c, n.sym) if CoHashTypeInsideNode in flags and n.sym.typ != nil: - hashType(c, n.sym.typ, flags) + hashType(c, n.sym.typ, flags, conf) of nkCharLit..nkUInt64Lit: let v = n.intVal lowlevel v @@ -87,24 +99,24 @@ proc hashTree(c: var MD5Context, n: PNode; flags: set[ConsiderFlag]) = of nkStrLit..nkTripleStrLit: c &= n.strVal else: - for i in 0..<n.len: hashTree(c, n[i], flags) + for i in 0..<n.len: hashTree(c, n[i], flags, conf) -proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]) = +proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]; conf: ConfigRef) = if t == nil: c &= "\254" return case t.kind of tyGenericInvocation: - for i in 0..<t.len: - c.hashType t[i], flags + for a in t.kids: + c.hashType a, flags, conf of tyDistinct: if CoDistinct in flags: if t.sym != nil: c.hashSym(t.sym) if t.sym == nil or tfFromGeneric in t.flags: - c.hashType t.lastSon, flags + c.hashType t.elementType, flags, conf elif CoType in flags or t.sym == nil: - c.hashType t.lastSon, flags + c.hashType t.elementType, flags, conf else: c.hashSym(t.sym) of tyGenericInst: @@ -113,16 +125,17 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]) = # We cannot trust the `lastSon` to hold a properly populated and unique # value for each instantiation, so we hash the generic parameters here: let normalizedType = t.skipGenericAlias - for i in 0..<normalizedType.len - 1: - c.hashType t[i], flags + c.hashType normalizedType.genericHead, flags, conf + for _, a in normalizedType.genericInstParams: + c.hashType a, flags, conf else: - c.hashType t.lastSon, flags + c.hashType t.skipModifier, flags, conf of tyAlias, tySink, tyUserTypeClasses, tyInferred: - c.hashType t.lastSon, flags + c.hashType t.skipModifier, flags, conf of tyOwned: if CoConsiderOwned in flags: c &= char(t.kind) - c.hashType t.lastSon, flags + c.hashType t.skipModifier, flags, conf of tyBool, tyChar, tyInt..tyUInt64: # no canonicalization for integral types, so that e.g. ``pid_t`` is # produced instead of ``NI``: @@ -135,8 +148,9 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]) = let inst = t.typeInst t.typeInst = nil assert inst.kind == tyGenericInst - for i in 0..<inst.len - 1: - c.hashType inst[i], flags + c.hashType inst.genericHead, flags, conf + for _, a in inst.genericInstParams: + c.hashType a, flags, conf t.typeInst = inst return c &= char(t.kind) @@ -144,22 +158,31 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]) = # is actually safe without an infinite recursion check: if t.sym != nil: if {sfCompilerProc} * t.sym.flags != {}: - doAssert t.sym.loc.r != nil + doAssert t.sym.loc.snippet != "" # The user has set a specific name for this type - c &= t.sym.loc.r + c &= t.sym.loc.snippet elif CoOwnerSig in flags: - c.hashTypeSym(t.sym) + c.hashTypeSym(t.sym, conf) else: c.hashSym(t.sym) - if {sfAnon, sfGenSym} * t.sym.flags != {}: + + var symWithFlags: PSym = nil + template hasFlag(sym): bool = + let ret = {sfAnon, sfGenSym} * sym.flags != {} + if ret: symWithFlags = sym + ret + if hasFlag(t.sym) or (t.kind == tyObject and t.owner.kind == skType and t.owner.typ.kind == tyRef and hasFlag(t.owner)): + # for `PFoo:ObjectType`, arising from `type PFoo = ref object` # Generated object names can be identical, so we need to # disambiguate furthermore by hashing the field types and names. if t.n.len > 0: - let oldFlags = t.sym.flags - # Mild hack to prevent endless recursion. - t.sym.flags.excl {sfAnon, sfGenSym} - hashTree(c, t.n, flags + {CoHashTypeInsideNode}) - t.sym.flags = oldFlags + let oldFlags = symWithFlags.flags + # Hack to prevent endless recursion + # xxx instead, use a hash table to indicate we've already visited a type, which + # would also be more efficient. + symWithFlags.flags.excl {sfAnon, sfGenSym} + hashTree(c, t.n, flags + {CoHashTypeInsideNode}, conf) + symWithFlags.flags = oldFlags else: # The object has no fields: we _must_ add something here in order to # make the hash different from the one we produce by hashing only the @@ -167,36 +190,40 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]) = c &= ".empty" else: c &= t.id - if t.len > 0 and t[0] != nil: - hashType c, t[0], flags - of tyRef, tyPtr, tyGenericBody, tyVar: + if t.hasElementType and t.baseClass != nil: + hashType c, t.baseClass, flags, conf + of tyRef, tyPtr, tyVar: c &= char(t.kind) - c.hashType t.lastSon, flags + if t.hasElementType: + c.hashType t.elementType, flags, conf if tfVarIsPtr in t.flags: c &= ".varisptr" + of tyGenericBody: + c &= char(t.kind) + if t.hasElementType: + c.hashType t.typeBodyImpl, flags, conf of tyFromExpr: c &= char(t.kind) - c.hashTree(t.n, {}) + c.hashTree(t.n, {}, conf) of tyTuple: c &= char(t.kind) if t.n != nil and CoType notin flags: - assert(t.n.len == t.len) for i in 0..<t.n.len: assert(t.n[i].kind == nkSym) c &= t.n[i].sym.name.s c &= ':' - c.hashType(t[i], flags+{CoIgnoreRange}) + c.hashType(t.n[i].sym.typ, flags+{CoIgnoreRange}, conf) c &= ',' else: - for i in 0..<t.len: c.hashType t[i], flags+{CoIgnoreRange} + for a in t.kids: c.hashType a, flags+{CoIgnoreRange}, conf of tyRange: if CoIgnoreRange notin flags: c &= char(t.kind) - c.hashTree(t.n, {}) - c.hashType(t[0], flags) + c.hashTree(t.n, {}, conf) + c.hashType(t.elementType, flags, conf) of tyStatic: c &= char(t.kind) - c.hashTree(t.n, {}) - c.hashType(t[0], flags) + c.hashTree(t.n, {}, conf) + c.hashType(t.skipModifier, flags, conf) of tyProc: c &= char(t.kind) c &= (if tfIterator in t.flags: "iterator " else: "proc ") @@ -206,11 +233,11 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]) = let param = params[i].sym c &= param.name.s c &= ':' - c.hashType(param.typ, flags) + c.hashType(param.typ, flags, conf) c &= ',' - c.hashType(t[0], flags) + c.hashType(t.returnType, flags, conf) else: - for i in 0..<t.len: c.hashType(t[i], flags) + for a in t.signature: c.hashType(a, flags, conf) c &= char(t.callConv) # purity of functions doesn't have to affect the mangling (which is in fact # problematic for HCR - someone could have cached a pointer to another @@ -222,10 +249,11 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]) = if tfVarargs in t.flags: c &= ".varargs" of tyArray: c &= char(t.kind) - for i in 0..<t.len: c.hashType(t[i], flags-{CoIgnoreRange}) + c.hashType(t.indexType, flags-{CoIgnoreRange}, conf) + c.hashType(t.elementType, flags-{CoIgnoreRange}, conf) else: c &= char(t.kind) - for i in 0..<t.len: c.hashType(t[i], flags) + for a in t.kids: c.hashType(a, flags, conf) if tfNotNil in t.flags and CoType notin flags: c &= "not nil" when defined(debugSigHashes): @@ -242,19 +270,21 @@ when defined(debugSigHashes): # select hash, type from sighashes where hash in # (select hash from sighashes group by hash having count(*) > 1) order by hash; -proc hashType*(t: PType; flags: set[ConsiderFlag] = {CoType}): SigHash = - var c: MD5Context +proc hashType*(t: PType; conf: ConfigRef; flags: set[ConsiderFlag] = {CoType}): SigHash = + result = default(SigHash) + var c: MD5Context = default(MD5Context) md5Init c - hashType c, t, flags+{CoOwnerSig} + hashType c, t, flags+{CoOwnerSig}, conf md5Final c, result.MD5Digest when defined(debugSigHashes): db.exec(sql"INSERT OR IGNORE INTO sighashes(type, hash) VALUES (?, ?)", typeToString(t), $result) -proc hashProc*(s: PSym): SigHash = - var c: MD5Context +proc hashProc(s: PSym; conf: ConfigRef): SigHash = + result = default(SigHash) + var c: MD5Context = default(MD5Context) md5Init c - hashType c, s.typ, {CoProc} + hashType c, s.typ, {CoProc}, conf var m = s while m.kind != skModule: m = m.owner @@ -272,7 +302,8 @@ proc hashProc*(s: PSym): SigHash = md5Final c, result.MD5Digest proc hashNonProc*(s: PSym): SigHash = - var c: MD5Context + result = default(SigHash) + var c: MD5Context = default(MD5Context) md5Init c hashSym(c, s) var it = s @@ -288,7 +319,8 @@ proc hashNonProc*(s: PSym): SigHash = md5Final c, result.MD5Digest proc hashOwner*(s: PSym): SigHash = - var c: MD5Context + result = default(SigHash) + var c: MD5Context = default(MD5Context) md5Init c var m = s while m.kind != skModule: m = m.owner @@ -300,9 +332,9 @@ proc hashOwner*(s: PSym): SigHash = md5Final c, result.MD5Digest -proc sigHash*(s: PSym): SigHash = +proc sigHash*(s: PSym; conf: ConfigRef): SigHash = if s.kind in routineKinds and s.typ != nil: - result = hashProc(s) + result = hashProc(s, conf) else: result = hashNonProc(s) @@ -319,7 +351,7 @@ proc hashVarSymBody(graph: ModuleGraph, c: var MD5Context, s: PSym) = c &= hashNonProc(s) # this one works for let and const but not for var. True variables can change value # later on. it is user resposibility to hash his global state if required - if s.ast != nil and s.ast.kind == nkIdentDefs: + if s.ast != nil and s.ast.kind in {nkIdentDefs, nkConstDef}: hashBodyTree(graph, c, s.ast[^1]) else: hashBodyTree(graph, c, s.ast) @@ -357,13 +389,13 @@ proc symBodyDigest*(graph: ModuleGraph, sym: PSym): SigHash = ## compute unique digest of the proc/func/method symbols ## recursing into invoked symbols as well assert(sym.kind in skProcKinds, $sym.kind) - + result = default(SigHash) graph.symBodyHashes.withValue(sym.id, value): return value[] - var c: MD5Context + var c: MD5Context = default(MD5Context) md5Init(c) - c.hashType(sym.typ, {CoProc}) + c.hashType(sym.typ, {CoProc}, graph.config) c &= char(sym.kind) c.md5Final(result.MD5Digest) graph.symBodyHashes[sym.id] = result # protect from recursion in the body @@ -376,12 +408,12 @@ proc symBodyDigest*(graph: ModuleGraph, sym: PSym): SigHash = graph.symBodyHashes[sym.id] = result proc idOrSig*(s: PSym, currentModule: string, - sigCollisions: var CountTable[SigHash]): Rope = + sigCollisions: var CountTable[SigHash]; conf: ConfigRef): Rope = if s.kind in routineKinds and s.typ != nil: # signatures for exported routines are reliable enough to - # produce a unique name and this means produced C++ is more stable wrt + # produce a unique name and this means produced C++ is more stable regarding # Nim changes: - let sig = hashProc(s) + let sig = hashProc(s, conf) result = rope($sig) #let m = if s.typ.callConv != ccInline: findPendingModule(m, s) else: m let counter = sigCollisions.getOrDefault(sig) diff --git a/compiler/sigmatch.nim b/compiler/sigmatch.nim index 87f7c273b..6ea2c7bb5 100644 --- a/compiler/sigmatch.nim +++ b/compiler/sigmatch.nim @@ -11,14 +11,20 @@ ## the call to overloaded procs, generic procs and operators. import - intsets, ast, astalgo, semdata, types, msgs, renderer, lookups, semtypinst, - magicsys, idents, lexer, options, parampatterns, strutils, trees, + ast, astalgo, semdata, types, msgs, renderer, lookups, semtypinst, + magicsys, idents, lexer, options, parampatterns, trees, linter, lineinfos, lowerings, modulegraphs, concepts +import std/[intsets, strutils, tables] + +when defined(nimPreviewSlimSystem): + import std/assertions + type MismatchKind* = enum kUnknown, kAlreadyGiven, kUnknownNamedParam, kTypeMismatch, kVarNeeded, - kMissingParam, kExtraArg, kPositionalAlreadyGiven + kMissingParam, kExtraArg, kPositionalAlreadyGiven, + kGenericParamTypeMismatch, kMissingGenericParam, kExtraGenericParam MismatchInfo* = object kind*: MismatchKind # reason for mismatch @@ -50,12 +56,12 @@ type calleeScope*: int # scope depth: # is this a top-level symbol or a nested proc? call*: PNode # modified call - bindings*: TIdTable # maps types to types + bindings*: TypeMapping # maps types to types magic*: TMagic # magic of operation baseTypeMatch: bool # needed for conversions from T to openarray[T] # for example - fauxMatch*: TTypeKind # the match was successful only due to the use - # of error or wildcard (unknown) types. + matchedErrorType*: bool # match is considered successful after matching + # error type to avoid cascading errors # this is used to prevent instantiations. genericConverter*: bool # true if a generic converter needs to # be instantiated @@ -75,7 +81,8 @@ type # or when the explain pragma is used. may be # triggered with an idetools command in the # future. - inheritancePenalty: int # to prefer closest father object type + # to prefer closest father object type + inheritancePenalty: int firstMismatch*: MismatchInfo # mismatch info for better error messages diagnosticsEnabled*: bool @@ -83,60 +90,38 @@ type trDontBind trNoCovariance trBindGenericParam # bind tyGenericParam even with trDontBind + trIsOutParam TTypeRelFlags* = set[TTypeRelFlag] - 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 const isNilConversion = isConvertible # maybe 'isIntConv' fits better? + maxInheritancePenalty = high(int) div 2 -proc markUsed*(c: PContext; info: TLineInfo, s: PSym) +proc markUsed*(c: PContext; info: TLineInfo, s: PSym; checkStyle = true) proc markOwnerModuleAsUsed*(c: PContext; s: PSym) -template hasFauxMatch*(c: TCandidate): bool = c.fauxMatch != tyNone - proc initCandidateAux(ctx: PContext, - c: var TCandidate, callee: PType) {.inline.} = - c.c = ctx - c.exactMatches = 0 - c.subtypeMatches = 0 - c.convMatches = 0 - c.intConvMatches = 0 - c.genericMatches = 0 - c.state = csEmpty - c.firstMismatch = MismatchInfo() - c.callee = callee - c.call = nil - c.baseTypeMatch = false - c.genericConverter = false - c.inheritancePenalty = 0 - -proc initCandidate*(ctx: PContext, c: var TCandidate, callee: PType) = - initCandidateAux(ctx, c, callee) - c.calleeSym = nil - initIdTable(c.bindings) + callee: PType): TCandidate {.inline.} = + result = TCandidate(c: ctx, exactMatches: 0, subtypeMatches: 0, + convMatches: 0, intConvMatches: 0, genericMatches: 0, + state: csEmpty, firstMismatch: MismatchInfo(), + callee: callee, call: nil, baseTypeMatch: false, + genericConverter: false, inheritancePenalty: -1 + ) + +proc initCandidate*(ctx: PContext, callee: PType): TCandidate = + result = initCandidateAux(ctx, callee) + result.calleeSym = nil + result.bindings = initTypeMapping() proc put(c: var TCandidate, key, val: PType) {.inline.} = ## Given: proc foo[T](x: T); foo(4) ## key: 'T' ## val: 'int' (typeof(4)) when false: - let old = PType(idTableGet(c.bindings, key)) + let old = idTableGet(c.bindings, key) if old != nil: echo "Putting ", typeToString(key), " ", typeToString(val), " and old is ", typeToString(old) if typeToString(old) == "float32": @@ -145,78 +130,174 @@ proc put(c: var TCandidate, key, val: PType) {.inline.} = echo "binding ", key, " -> ", val idTablePut(c.bindings, key, val.skipIntLit(c.c.idgen)) -proc initCandidate*(ctx: PContext, c: var TCandidate, callee: PSym, +proc typeRel*(c: var TCandidate, f, aOrig: PType, + flags: TTypeRelFlags = {}): TTypeRelation + +proc matchGenericParam(m: var TCandidate, formal: PType, n: PNode) = + var arg = n.typ + if m.c.inGenericContext > 0: + # don't match yet-unresolved generic instantiations + while arg != nil and arg.kind == tyGenericParam: + arg = idTableGet(m.bindings, arg) + if arg == nil or arg.containsUnresolvedType: + m.state = csNoMatch + return + # fix up the type to get ready to match formal: + var formalBase = formal + while formalBase.kind == tyGenericParam and + formalBase.genericParamHasConstraints: + formalBase = formalBase.genericConstraint + if formalBase.kind == tyStatic and arg.kind != tyStatic: + # maybe call `paramTypesMatch` here, for now be conservative + if n.kind in nkSymChoices: n.flags.excl nfSem + let evaluated = m.c.semTryConstExpr(m.c, n, formalBase.skipTypes({tyStatic})) + if evaluated != nil: + arg = newTypeS(tyStatic, m.c, son = evaluated.typ) + arg.n = evaluated + elif formalBase.kind == tyTypeDesc: + if arg.kind != tyTypeDesc: + arg = makeTypeDesc(m.c, arg) + else: + arg = arg.skipTypes({tyTypeDesc}) + let tm = typeRel(m, formal, arg) + if tm in {isNone, isConvertible}: + m.state = csNoMatch + m.firstMismatch.kind = kGenericParamTypeMismatch + return + +proc matchGenericParams*(m: var TCandidate, binding: PNode, callee: PSym) = + ## matches explicit generic instantiation `binding` against generic params of + ## proc symbol `callee` + ## state is set to `csMatch` if all generic params match, `csEmpty` if + ## implicit generic parameters are missing (matches but cannot instantiate), + ## `csNoMatch` if a constraint fails or param count doesn't match + let c = m.c + let typeParams = callee.ast[genericParamsPos] + let paramCount = typeParams.len + let bindingCount = binding.len-1 + if bindingCount > paramCount: + m.state = csNoMatch + m.firstMismatch.kind = kExtraGenericParam + m.firstMismatch.arg = paramCount + 1 + return + for i in 1..bindingCount: + matchGenericParam(m, typeParams[i-1].typ, binding[i]) + if m.state == csNoMatch: + m.firstMismatch.arg = i + m.firstMismatch.formal = typeParams[i-1].sym + return + # not enough generic params given, check if remaining have defaults: + for i in bindingCount ..< paramCount: + let param = typeParams[i] + assert param.kind == nkSym + let paramSym = param.sym + if paramSym.ast != nil: + matchGenericParam(m, param.typ, paramSym.ast) + if m.state == csNoMatch: + m.firstMismatch.arg = i + 1 + m.firstMismatch.formal = paramSym + return + elif tfImplicitTypeParam in paramSym.typ.flags: + # not a mismatch, but can't create sym + m.state = csEmpty + return + else: + m.state = csNoMatch + m.firstMismatch.kind = kMissingGenericParam + m.firstMismatch.arg = i + 1 + m.firstMismatch.formal = paramSym + return + m.state = csMatch + +proc copyingEraseVoidParams(m: TCandidate, t: var PType) = + ## if `t` is a proc type with void parameters, copies it and erases them + assert t.kind == tyProc + let original = t + var copied = false + for i in 1 ..< original.len: + var f = original[i] + var isVoidParam = f.kind == tyVoid + if not isVoidParam: + let prev = idTableGet(m.bindings, f) + if prev != nil: f = prev + isVoidParam = f.kind == tyVoid + if isVoidParam: + if not copied: + # keep first i children + t = copyType(original, m.c.idgen, t.owner) + t.setSonsLen(i) + t.n = copyNode(original.n) + t.n.sons = original.n.sons + t.n.sons.setLen(i) + copied = true + elif copied: + t.add(f) + t.n.add(original.n[i]) + +proc initCandidate*(ctx: PContext, callee: PSym, binding: PNode, calleeScope = -1, - diagnosticsEnabled = false) = - initCandidateAux(ctx, c, callee.typ) - c.calleeSym = callee + diagnosticsEnabled = false): TCandidate = + result = initCandidateAux(ctx, callee.typ) + result.calleeSym = callee if callee.kind in skProcKinds and calleeScope == -1: - if callee.originatingModule == ctx.module: - c.calleeScope = 2 - var owner = callee - while true: - owner = owner.skipGenericOwner - if owner.kind == skModule: break - inc c.calleeScope - else: - c.calleeScope = 1 + result.calleeScope = cmpScopes(ctx, callee) else: - c.calleeScope = calleeScope - c.diagnostics = @[] # if diagnosticsEnabled: @[] else: nil - c.diagnosticsEnabled = diagnosticsEnabled - c.magic = c.calleeSym.magic - initIdTable(c.bindings) + result.calleeScope = calleeScope + result.diagnostics = @[] # if diagnosticsEnabled: @[] else: nil + result.diagnosticsEnabled = diagnosticsEnabled + result.magic = result.calleeSym.magic + result.bindings = initTypeMapping() if binding != nil and callee.kind in routineKinds: - var typeParams = callee.ast[genericParamsPos] - for i in 1..min(typeParams.len, binding.len-1): - var formalTypeParam = typeParams[i-1].typ - var bound = binding[i].typ - if bound != nil: - if formalTypeParam.kind == tyTypeDesc: - if bound.kind != tyTypeDesc: - bound = makeTypeDesc(ctx, bound) - else: - bound = bound.skipTypes({tyTypeDesc}) - put(c, formalTypeParam, bound) + matchGenericParams(result, binding, callee) + let genericMatch = result.state + if genericMatch != csNoMatch: + result.state = csEmpty + if genericMatch == csMatch: # csEmpty if not fully instantiated + # instantiate the type, emulates old compiler behavior + # wouldn't be needed if sigmatch could handle complex cases, + # examples are in texplicitgenerics + # might be buggy, see rest of generateInstance if problems occur + let typ = ctx.instantiateOnlyProcType(ctx, result.bindings, callee, binding.info) + result.callee = typ + else: + # createThread[void] requires this if the above branch is removed: + copyingEraseVoidParams(result, result.callee) proc newCandidate*(ctx: PContext, callee: PSym, binding: PNode, calleeScope = -1): TCandidate = - initCandidate(ctx, result, callee, binding, calleeScope) + result = initCandidate(ctx, callee, binding, calleeScope) proc newCandidate*(ctx: PContext, callee: PType): TCandidate = - initCandidate(ctx, result, callee) - -proc copyCandidate(a: var TCandidate, b: TCandidate) = - a.c = b.c - a.exactMatches = b.exactMatches - a.subtypeMatches = b.subtypeMatches - a.convMatches = b.convMatches - a.intConvMatches = b.intConvMatches - a.genericMatches = b.genericMatches - a.state = b.state - a.callee = b.callee - a.calleeSym = b.calleeSym - a.call = copyTree(b.call) - a.baseTypeMatch = b.baseTypeMatch - copyIdTable(a.bindings, b.bindings) - -proc typeRel*(c: var TCandidate, f, aOrig: PType, - flags: TTypeRelFlags = {}): TTypeRelation + result = initCandidate(ctx, callee) + +proc copyCandidate(dest: var TCandidate, src: TCandidate) = + dest.c = src.c + dest.exactMatches = src.exactMatches + dest.subtypeMatches = src.subtypeMatches + dest.convMatches = src.convMatches + dest.intConvMatches = src.intConvMatches + dest.genericMatches = src.genericMatches + dest.state = src.state + dest.callee = src.callee + dest.calleeSym = src.calleeSym + dest.call = copyTree(src.call) + dest.baseTypeMatch = src.baseTypeMatch + dest.bindings = src.bindings proc checkGeneric(a, b: TCandidate): int = let c = a.c let aa = a.callee let bb = b.callee var winner = 0 - for i in 1..<min(aa.len, bb.len): - var ma = newCandidate(c, bb[i]) - let tra = typeRel(ma, bb[i], aa[i], {trDontBind}) - var mb = newCandidate(c, aa[i]) - let trb = typeRel(mb, aa[i], bb[i], {trDontBind}) - if tra == isGeneric and trb == isNone: + for aai, bbi in underspecifiedPairs(aa, bb, 1): + var ma = newCandidate(c, bbi) + let tra = typeRel(ma, bbi, aai, {trDontBind}) + var mb = newCandidate(c, aai) + let trb = typeRel(mb, aai, bbi, {trDontBind}) + if tra == isGeneric and trb in {isNone, isInferred, isInferredConvertible}: if winner == -1: return 0 winner = 1 - if trb == isGeneric and tra == isNone: + if trb == isGeneric and tra in {isNone, isInferred, isInferredConvertible}: if winner == 1: return 0 winner = -1 result = winner @@ -225,53 +306,65 @@ proc sumGeneric(t: PType): int = # count the "genericness" so that Foo[Foo[T]] has the value 3 # and Foo[T] has the value 2 so that we know Foo[Foo[T]] is more # specific than Foo[T]. + result = 0 var t = t - var isvar = 1 while true: case t.kind - of tyGenericInst, tyArray, tyRef, tyPtr, tyDistinct, tyUncheckedArray, - tyOpenArray, tyVarargs, tySet, tyRange, tySequence, tyGenericBody, - tyLent, tyOwned: - t = t.lastSon + of tyAlias, tySink, tyNot: t = t.skipModifier + of tyArray, tyRef, tyPtr, tyDistinct, tyUncheckedArray, + tyOpenArray, tyVarargs, tySet, tyRange, tySequence, + tyLent, tyOwned, tyVar: + t = t.elementType + inc result + of tyBool, tyChar, tyEnum, tyObject, tyPointer, tyVoid, + tyString, tyCstring, tyInt..tyInt64, tyFloat..tyFloat128, + tyUInt..tyUInt64, tyCompositeTypeClass, tyBuiltInTypeClass: + inc result + break + of tyGenericBody: + t = t.typeBodyImpl + of tyGenericInst, tyStatic: + t = t.skipModifier inc result of tyOr: var maxBranch = 0 - for branch in t.sons: + for branch in t.kids: let branchSum = sumGeneric(branch) if branchSum > maxBranch: maxBranch = branchSum inc result, maxBranch break - of tyVar: - t = t[0] - inc result - inc isvar of tyTypeDesc: - t = t.lastSon + t = t.elementType if t.kind == tyEmpty: break inc result - of tyGenericInvocation, tyTuple, tyProc, tyAnd: - result += ord(t.kind in {tyGenericInvocation, tyAnd}) - for i in 0..<t.len: - if t[i] != nil: - result += sumGeneric(t[i]) + of tyGenericParam: + if t.len > 0: + t = t.skipModifier + else: + inc result + break + of tyUntyped, tyTyped: break + of tyGenericInvocation, tyTuple, tyAnd: + result += ord(t.kind == tyAnd) + for a in t.kids: + if a != nil: + result += sumGeneric(a) + break + of tyProc: + if t.returnType != nil: + result += sumGeneric(t.returnType) + for _, a in t.paramTypes: + result += sumGeneric(a) break - of tyStatic: - return sumGeneric(t[0]) + 1 - of tyGenericParam, tyUntyped, tyTyped: break - of tyAlias, tySink: t = t.lastSon - of tyBool, tyChar, tyEnum, tyObject, tyPointer, - tyString, tyCString, tyInt..tyInt64, tyFloat..tyFloat128, - tyUInt..tyUInt64, tyCompositeTypeClass: - return isvar else: - return 0 + break proc complexDisambiguation(a, b: PType): int = # 'a' matches better if *every* argument matches better or equal than 'b'. var winner = 0 - for i in 1..<min(a.len, b.len): - let x = a[i].sumGeneric - let y = b[i].sumGeneric + for ai, bi in underspecifiedPairs(a, b, 1): + let x = ai.sumGeneric + let y = bi.sumGeneric if x != y: if winner == 0: if x > y: winner = 1 @@ -286,8 +379,8 @@ proc complexDisambiguation(a, b: PType): int = result = winner when false: var x, y: int - for i in 1..<a.len: x += a[i].sumGeneric - for i in 1..<b.len: y += b[i].sumGeneric + for i in 1..<a.len: x += ai.sumGeneric + for i in 1..<b.len: y += bi.sumGeneric result = x - y proc writeMatches*(c: TCandidate) = @@ -299,7 +392,16 @@ proc writeMatches*(c: TCandidate) = echo " conv matches: ", c.convMatches echo " inheritance: ", c.inheritancePenalty -proc cmpCandidates*(a, b: TCandidate): int = +proc cmpInheritancePenalty(a, b: int): int = + var eb = b + var ea = a + if b < 0: + eb = maxInheritancePenalty # defacto max penalty + if a < 0: + ea = maxInheritancePenalty + eb - ea + +proc cmpCandidates*(a, b: TCandidate, isFormal=true): int = result = a.exactMatches - b.exactMatches if result != 0: return result = a.genericMatches - b.genericMatches @@ -310,16 +412,16 @@ proc cmpCandidates*(a, b: TCandidate): int = if result != 0: return result = a.convMatches - b.convMatches if result != 0: return - # the other way round because of other semantics: - result = b.inheritancePenalty - a.inheritancePenalty + result = cmpInheritancePenalty(a.inheritancePenalty, b.inheritancePenalty) if result != 0: return - # check for generic subclass relation - result = checkGeneric(a, b) + if isFormal: + # check for generic subclass relation + result = checkGeneric(a, b) + if result != 0: return + # prefer more specialized generic over more general generic: + result = complexDisambiguation(a.callee, b.callee) if result != 0: return - # prefer more specialized generic over more general generic: - result = complexDisambiguation(a.callee, b.callee) # only as a last resort, consider scoping: - if result != 0: return result = a.calleeScope - b.calleeScope proc argTypeToString(arg: PNode; prefer: TPreferedDesc): string = @@ -333,26 +435,44 @@ proc argTypeToString(arg: PNode; prefer: TPreferedDesc): string = else: result = arg.typ.typeToString(prefer) -proc describeArgs*(c: PContext, n: PNode, startIdx = 1; prefer = preferName): string = - result = "" - for i in startIdx..<n.len: - var arg = n[i] - if n[i].kind == nkExprEqExpr: - result.add renderTree(n[i][0]) - result.add ": " - if arg.typ.isNil and arg.kind notin {nkStmtList, nkDo}: - # XXX we really need to 'tryExpr' here! - arg = c.semOperand(c, n[i][1]) +template describeArgImpl(c: PContext, n: PNode, i: int, startIdx = 1; prefer = preferName) = + var arg = n[i] + if n[i].kind == nkExprEqExpr: + result.add renderTree(n[i][0]) + result.add ": " + if arg.typ.isNil and arg.kind notin {nkStmtList, nkDo}: + arg = c.semTryExpr(c, n[i][1]) + if arg == nil: + arg = n[i][1] + arg.typ = newTypeS(tyUntyped, c) + else: + if arg.typ == nil: + arg.typ = newTypeS(tyVoid, c) n[i].typ = arg.typ n[i][1] = arg - else: - if arg.typ.isNil and arg.kind notin {nkStmtList, nkDo, nkElse, - nkOfBranch, nkElifBranch, - nkExceptBranch}: - arg = c.semOperand(c, n[i]) + else: + if arg.typ.isNil and arg.kind notin {nkStmtList, nkDo, nkElse, + nkOfBranch, nkElifBranch, + nkExceptBranch}: + arg = c.semTryExpr(c, n[i]) + if arg == nil: + arg = n[i] + arg.typ = newTypeS(tyUntyped, c) + else: + if arg.typ == nil: + arg.typ = newTypeS(tyVoid, c) n[i] = arg - if arg.typ != nil and arg.typ.kind == tyError: return - result.add argTypeToString(arg, prefer) + if arg.typ != nil and arg.typ.kind == tyError: return + result.add argTypeToString(arg, prefer) + +proc describeArg*(c: PContext, n: PNode, i: int, startIdx = 1; prefer = preferName): string = + result = "" + describeArgImpl(c, n, i, startIdx, prefer) + +proc describeArgs*(c: PContext, n: PNode, startIdx = 1; prefer = preferName): string = + result = "" + for i in startIdx..<n.len: + describeArgImpl(c, n, i, startIdx, prefer) if i != n.len - 1: result.add ", " proc concreteType(c: TCandidate, t: PType; f: PType = nil): PType = @@ -361,12 +481,13 @@ proc concreteType(c: TCandidate, t: PType; f: PType = nil): PType = if c.isNoCall: result = t else: result = nil of tySequence, tySet: - if t[0].kind == tyEmpty: result = nil + if t.elementType.kind == tyEmpty: result = nil else: result = t of tyGenericParam, tyAnything, tyConcept: result = t + if c.isNoCall: return while true: - result = PType(idTableGet(c.bindings, t)) + result = idTableGet(c.bindings, t) if result == nil: break # it's ok, no match # example code that triggers it: @@ -377,22 +498,31 @@ proc concreteType(c: TCandidate, t: PType; f: PType = nil): PType = of tyOwned: # bug #11257: the comparison system.`==`[T: proc](x, y: T) works # better without the 'owned' type: - if f != nil and f.len > 0 and f[0].skipTypes({tyBuiltInTypeClass}).kind == tyProc: - result = t.lastSon + if f != nil and f.hasElementType and f.elementType.skipTypes({tyBuiltInTypeClass, tyOr}).kind == tyProc: + result = t.skipModifier else: result = t else: result = t # Note: empty is valid here -proc handleRange(f, a: PType, min, max: TTypeKind): TTypeRelation = +proc handleRange(c: PContext, f, a: PType, min, max: TTypeKind): TTypeRelation = if a.kind == f.kind: result = isEqual else: let ab = skipTypes(a, {tyRange}) let k = ab.kind - if k == f.kind: result = isSubrange - elif k == tyInt and f.kind in {tyRange, tyInt8..tyInt64, - tyUInt..tyUInt64} and + let nf = c.config.normalizeKind(f.kind) + let na = c.config.normalizeKind(k) + if k == f.kind: + # `a` is a range type matching its base type + # see very bottom for range types matching different types + if isIntLit(ab): + # range type can only give isFromIntLit for base type + result = isFromIntLit + else: + result = isSubrange + elif a.kind == tyInt and f.kind in {tyRange, tyInt..tyInt64, + tyUInt..tyUInt64} and isIntLit(ab) and getInt(ab.n) >= firstOrd(nil, f) and getInt(ab.n) <= lastOrd(nil, f): # passing 'nil' to firstOrd/lastOrd here as type checking rules should @@ -400,23 +530,27 @@ proc handleRange(f, a: PType, min, max: TTypeKind): TTypeRelation = # integer literal in the proper range; we want ``i16 + 4`` to stay an # ``int16`` operation so we declare the ``4`` pseudo-equal to int16 result = isFromIntLit - elif f.kind == tyInt and k in {tyInt8..tyInt32}: + elif a.kind == tyInt and nf == c.config.targetSizeSignedToKind: + result = isIntConv + elif a.kind == tyUInt and nf == c.config.targetSizeUnsignedToKind: result = isIntConv - elif f.kind == tyUInt and k in {tyUInt8..tyUInt32}: + elif f.kind == tyInt and na in {tyInt8 .. pred(c.config.targetSizeSignedToKind)}: + result = isIntConv + elif f.kind == tyUInt and na in {tyUInt8 .. pred(c.config.targetSizeUnsignedToKind)}: result = isIntConv elif k >= min and k <= max: result = isConvertible elif a.kind == tyRange and # Make sure the conversion happens between types w/ same signedness (f.kind in {tyInt..tyInt64} and a[0].kind in {tyInt..tyInt64} or - f.kind in {tyUInt8..tyUInt32} and a[0].kind in {tyUInt8..tyInt32}) and + f.kind in {tyUInt8..tyUInt32} and a[0].kind in {tyUInt8..tyUInt32}) and a.n[0].intVal >= firstOrd(nil, f) and a.n[1].intVal <= lastOrd(nil, f): # passing 'nil' to firstOrd/lastOrd here as type checking rules should # not depend on the target integer size configurations! result = isConvertible else: result = isNone -proc isConvertibleToRange(f, a: PType): bool = +proc isConvertibleToRange(c: PContext, f, a: PType): bool = if f.kind in {tyInt..tyInt64, tyUInt..tyUInt64} and a.kind in {tyInt..tyInt64, tyUInt..tyUInt64}: case f.kind @@ -424,18 +558,21 @@ proc isConvertibleToRange(f, a: PType): bool = of tyInt16: result = isIntLit(a) or a.kind in {tyInt8, tyInt16} of tyInt32: result = isIntLit(a) or a.kind in {tyInt8, tyInt16, tyInt32} # This is wrong, but seems like there's a lot of code that relies on it :( - of tyInt, tyUInt, tyUInt64: result = true + of tyInt, tyUInt: result = true + # of tyInt: result = isIntLit(a) or a.kind in {tyInt8 .. c.config.targetSizeSignedToKind} of tyInt64: result = isIntLit(a) or a.kind in {tyInt8, tyInt16, tyInt32, tyInt, tyInt64} of tyUInt8: result = isIntLit(a) or a.kind in {tyUInt8} of tyUInt16: result = isIntLit(a) or a.kind in {tyUInt8, tyUInt16} of tyUInt32: result = isIntLit(a) or a.kind in {tyUInt8, tyUInt16, tyUInt32} - #of tyUInt: result = isIntLit(a) or a.kind in {tyUInt8, tyUInt16, tyUInt32, tyUInt} - #of tyUInt64: result = isIntLit(a) or a.kind in {tyUInt8, tyUInt16, tyUInt32, tyUInt, tyUInt64} + # of tyUInt: result = isIntLit(a) or a.kind in {tyUInt8 .. c.config.targetSizeUnsignedToKind} + of tyUInt64: result = isIntLit(a) or a.kind in {tyUInt8, tyUInt16, tyUInt32, tyUInt64} else: result = false elif f.kind in {tyFloat..tyFloat128}: # `isIntLit` is correct and should be used above as well, see PR: # https://github.com/nim-lang/Nim/pull/11197 result = isIntLit(a) or a.kind in {tyFloat..tyFloat128} + else: + result = false proc handleFloatRange(f, a: PType): TTypeRelation = if a.kind == f.kind: @@ -452,11 +589,50 @@ proc handleFloatRange(f, a: PType): TTypeRelation = else: result = isIntConv else: result = isNone +proc reduceToBase(f: PType): PType = + #[ + Returns the lowest order (most general) type that that is compatible with the input. + E.g. + A[T] = ptr object ... A -> ptr object + A[N: static[int]] = array[N, int] ... A -> array + ]# + case f.kind: + of tyGenericParam: + if f.len <= 0 or f.skipModifier == nil: + result = f + else: + result = reduceToBase(f.skipModifier) + of tyGenericInvocation: + result = reduceToBase(f.baseClass) + of tyCompositeTypeClass, tyAlias: + if not f.hasElementType or f.elementType == nil: + result = f + else: + result = reduceToBase(f.elementType) + of tyGenericInst: + result = reduceToBase(f.skipModifier) + of tyGenericBody: + result = reduceToBase(f.typeBodyImpl) + of tyUserTypeClass: + if f.isResolvedUserTypeClass: + result = f.base # ?? idk if this is right + else: + result = f.skipModifier + of tyStatic, tyOwned, tyVar, tyLent, tySink: + result = reduceToBase(f.base) + of tyInferred: + # This is not true "After a candidate type is selected" + result = reduceToBase(f.base) + of tyRange: + result = f.elementType + else: + result = f + proc genericParamPut(c: var TCandidate; last, fGenericOrigin: PType) = if fGenericOrigin != nil and last.kind == tyGenericInst and - last.len-1 == fGenericOrigin.len: - for i in 1..<fGenericOrigin.len: - let x = PType(idTableGet(c.bindings, fGenericOrigin[i])) + last.kidsLen-1 == fGenericOrigin.kidsLen: + for i in FirstGenericParamAt..<fGenericOrigin.kidsLen: + let x = idTableGet(c.bindings, fGenericOrigin[i]) if x == nil: put(c, fGenericOrigin[i], last[i]) @@ -466,8 +642,9 @@ proc isObjectSubtype(c: var TCandidate; a, f, fGenericOrigin: PType): int = var depth = 0 var last = a while t != nil and not sameObjectTypes(f, t): - assert t.kind == tyObject - t = t[0] + if t.kind != tyObject: # avoid entering generic params etc + return -1 + t = t.baseClass if t == nil: break last = t t = skipTypes(t, skipPtrs) @@ -488,20 +665,23 @@ proc skipToObject(t: PType; skipped: var SkippedPtr): PType = while r != nil: case r.kind of tyGenericInvocation: - r = r[0] + r = r.genericHead of tyRef: inc ptrs skipped = skippedRef - r = r.lastSon + r = r.elementType of tyPtr: inc ptrs skipped = skippedPtr - r = r.lastSon - of tyGenericBody, tyGenericInst, tyAlias, tySink, tyOwned: - r = r.lastSon + r = r.elementType + of tyGenericInst, tyAlias, tySink, tyOwned: + r = r.elementType + of tyGenericBody: + r = r.typeBodyImpl else: break if r.kind == tyObject and ptrs <= 1: result = r + else: result = nil proc isGenericSubtype(c: var TCandidate; a, f: PType, d: var int, fGenericOrigin: PType): bool = assert f.kind in {tyGenericInst, tyGenericInvocation, tyGenericBody} @@ -515,7 +695,7 @@ proc isGenericSubtype(c: var TCandidate; a, f: PType, d: var int, fGenericOrigin # XXX sameObjectType can return false here. Need to investigate # why that is but sameObjectType does way too much work here anyway. while t != nil and r.sym != t.sym and askip == fskip: - t = t[0] + t = t.baseClass if t == nil: break last = t t = t.skipToObject(askip) @@ -524,22 +704,29 @@ proc isGenericSubtype(c: var TCandidate; a, f: PType, d: var int, fGenericOrigin genericParamPut(c, last, fGenericOrigin) d = depth result = true + else: + result = false proc minRel(a, b: TTypeRelation): TTypeRelation = if a <= b: result = a else: result = b -proc recordRel(c: var TCandidate, f, a: PType): TTypeRelation = +proc recordRel(c: var TCandidate, f, a: PType, flags: TTypeRelFlags): TTypeRelation = result = isNone if sameType(f, a): result = isEqual - elif a.len == f.len: + elif sameTupleLengths(a, f): result = isEqual let firstField = if f.kind == tyTuple: 0 else: 1 - for i in firstField..<f.len: - var m = typeRel(c, f[i], a[i]) + for _, ff, aa in tupleTypePairs(f, a): + var m = typeRel(c, ff, aa, flags) if m < isSubtype: return isNone + if m == isSubtype and aa.kind != tyNil and c.inheritancePenalty > -1: + # we can't process individual element type conversions from a + # type conversion for the whole tuple + # subtype relations need type conversions when inheritance is used + return isNone result = minRel(result, m) if f.n != nil and a.n != nil: for i in 0..<f.n.len: @@ -549,7 +736,7 @@ proc recordRel(c: var TCandidate, f, a: PType): TTypeRelation = else: var x = f.n[i].sym var y = a.n[i].sym - if f.kind == tyObject and typeRel(c, x.typ, y.typ) < isSubtype: + if f.kind == tyObject and typeRel(c, x.typ, y.typ, flags) < isSubtype: return isNone if x.name.id != y.name.id: return isNone @@ -557,16 +744,16 @@ proc allowsNil(f: PType): TTypeRelation {.inline.} = result = if tfNotNil notin f.flags: isSubtype else: isNone proc inconsistentVarTypes(f, a: PType): bool {.inline.} = - result = f.kind != a.kind and - (f.kind in {tyVar, tyLent, tySink} or a.kind in {tyVar, tyLent, tySink}) + result = (f.kind != a.kind and + (f.kind in {tyVar, tyLent, tySink} or a.kind in {tyVar, tyLent, tySink})) or + isOutParam(f) != isOutParam(a) -proc procParamTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = +proc procParamTypeRel(c: var TCandidate; f, a: PType): TTypeRelation = ## For example we have: - ## - ## .. code-block:: nim + ## ```nim ## proc myMap[T,S](sIn: seq[T], f: proc(x: T): S): seq[S] = ... ## proc innerProc[Q,W](q: Q): W = ... - ## + ## ``` ## And we want to match: myMap(@[1,2,3], innerProc) ## This proc (procParamTypeRel) will do the following steps in ## three different calls: @@ -583,7 +770,7 @@ proc procParamTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = a = a if a.isMetaType: - let aResolved = PType(idTableGet(c.bindings, a)) + let aResolved = idTableGet(c.bindings, a) if aResolved != nil: a = aResolved if a.isMetaType: @@ -605,13 +792,14 @@ proc procParamTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = if reverseRel >= isGeneric: result = isInferred #inc c.genericMatches + else: + result = isNone else: # Note that this typeRel call will save f's resolved type into c.bindings # if f is metatype. result = typeRel(c, f, a) - # v--- is this correct? - if result <= isIntConv or inconsistentVarTypes(f, a): + if result <= isSubrange or inconsistentVarTypes(f, a): result = isNone #if result == isEqual: @@ -620,10 +808,15 @@ proc procParamTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = proc procTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = case a.kind of tyProc: - if f.len != a.len: return + var f = f + copyingEraseVoidParams(c, f) + if f.signatureLen != a.signatureLen: return result = isEqual # start with maximum; also correct for no # params at all + if f.flags * {tfIterator} != a.flags * {tfIterator}: + return isNone + template checkParam(f, a) = result = minRel(result, procParamTypeRel(c, f, a)) if result == isNone: return @@ -641,22 +834,8 @@ proc procTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = elif a[0] != nil: return isNone - if tfNoSideEffect in f.flags and tfNoSideEffect notin a.flags: - return isNone - elif tfThread in f.flags and a.flags * {tfThread, tfNoSideEffect} == {} and - optThreadAnalysis in c.c.config.globalOptions: - # noSideEffect implies ``tfThread``! - return isNone - elif f.flags * {tfIterator} != a.flags * {tfIterator}: - return isNone - elif f.callConv != a.callConv: - # valid to pass a 'nimcall' thingie to 'closure': - if f.callConv == ccClosure and a.callConv == ccNimCall: - result = if result == isInferred: isInferredConvertible - elif result == isBothMetaConvertible: isBothMetaConvertible - else: isConvertible - else: - return isNone + result = getProcConvMismatch(c.c.config, f, a, result)[1] + when useEffectSystem: if compatibleEffects(f, a) != efCompat: return isNone when defined(drnim): @@ -664,7 +843,7 @@ proc procTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = of tyNil: result = f.allowsNil - else: discard + else: result = isNone proc typeRangeRel(f, a: PType): TTypeRelation {.noinline.} = template checkRange[T](a0, a1, f0, f1: T): TTypeRelation = @@ -689,7 +868,7 @@ proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = c = m.c typeClass = ff.skipTypes({tyUserTypeClassInst}) body = typeClass.n[3] - matchedConceptContext: TMatchedConcept + matchedConceptContext = TMatchedConcept() prevMatchedConcept = c.matchedConcept prevCandidateType = typeClass[0][0] @@ -709,20 +888,20 @@ proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = typeClass[0][0] = prevCandidateType closeScope(c) - var typeParams: seq[(PSym, PType)] + var typeParams: seq[(PSym, PType)] = @[] if ff.kind == tyUserTypeClassInst: for i in 1..<(ff.len - 1): var typeParamName = ff.base[i-1].sym.name typ = ff[i] - param: PSym - alreadyBound = PType(idTableGet(m.bindings, typ)) + param: PSym = nil + alreadyBound = idTableGet(m.bindings, typ) if alreadyBound != nil: typ = alreadyBound template paramSym(kind): untyped = - newSym(kind, typeParamName, nextSymId(c.idgen), typeClass.sym, typeClass.sym.info, {}) + newSym(kind, typeParamName, c.idgen, typeClass.sym, typeClass.sym.info, {}) block addTypeParam: for prev in typeParams: @@ -735,19 +914,19 @@ proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = of tyStatic: param = paramSym skConst param.typ = typ.exactReplica - #copyType(typ, nextTypeId(c.idgen), typ.owner) + #copyType(typ, c.idgen, typ.owner) if typ.n == nil: param.typ.flags.incl tfInferrableStatic else: param.ast = typ.n - of tyUnknown: + of tyFromExpr: param = paramSym skVar param.typ = typ.exactReplica - #copyType(typ, nextTypeId(c.idgen), typ.owner) + #copyType(typ, c.idgen, typ.owner) else: param = paramSym skType param.typ = if typ.isMetaType: - c.newTypeWithSons(tyInferred, @[typ]) + newTypeS(tyInferred, c, typ) else: makeTypeDesc(c, typ) @@ -756,8 +935,8 @@ proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = addDecl(c, param) var - oldWriteHook: typeof(m.c.config.writelnHook) - diagnostics: seq[string] + oldWriteHook = default typeof(m.c.config.writelnHook) + diagnostics: seq[string] = @[] errorPrefix: string flags: TExprFlags = {} collectDiagnostics = m.diagnosticsEnabled or @@ -795,7 +974,7 @@ proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = result = generateTypeInstance(c, m.bindings, typeClass.sym.info, ff) else: result = ff.exactReplica - #copyType(ff, nextTypeId(c.idgen), ff.owner) + #copyType(ff, c.idgen, ff.owner) result.n = checkedBody @@ -818,7 +997,9 @@ proc maybeSkipDistinct(m: TCandidate; t: PType, callee: PSym): PType = result = t proc tryResolvingStaticExpr(c: var TCandidate, n: PNode, - allowUnresolved = false): PNode = + allowUnresolved = false, + allowCalls = false, + expectedType: PType = nil): PNode = # Consider this example: # type Value[N: static[int]] = object # proc foo[N](a: Value[N], r: range[0..(N-1)]) @@ -827,6 +1008,8 @@ proc tryResolvingStaticExpr(c: var TCandidate, n: PNode, # This proc is used to evaluate such static expressions. let instantiated = replaceTypesInBody(c.c, c.bindings, n, nil, allowMetaTypes = allowUnresolved) + if not allowCalls and instantiated.kind in nkCallKinds: + return nil result = c.c.semExpr(c.c, instantiated) proc inferStaticParam*(c: var TCandidate, lhs: PNode, rhs: BiggestInt): bool = @@ -897,8 +1080,9 @@ proc inferStaticParam*(c: var TCandidate, lhs: PNode, rhs: BiggestInt): bool = else: discard - elif lhs.kind == nkSym and lhs.typ.kind == tyStatic and lhs.typ.n == nil: - var inferred = newTypeWithSons(c.c, tyStatic, lhs.typ.sons) + elif lhs.kind == nkSym and lhs.typ.kind == tyStatic and + (lhs.typ.n == nil or idTableGet(c.bindings, lhs.typ) == nil): + var inferred = newTypeS(tyStatic, c.c, lhs.typ.elementType) inferred.n = newIntNode(nkIntLit, rhs) put(c, lhs.typ, inferred) if c.c.matchedConcept != nil: @@ -929,6 +1113,7 @@ proc inferStaticsInRange(c: var TCandidate, else: failureToInferStaticParam(c.c.config, exp) + result = isNone if lowerBound.kind == nkIntLit: if upperBound.kind == nkIntLit: if lengthOrd(c.c.config, concrete) == upperBound.intVal - lowerBound.intVal + 1: @@ -940,9 +1125,21 @@ proc inferStaticsInRange(c: var TCandidate, doInferStatic(lowerBound, getInt(upperBound) + 1 - lengthOrd(c.c.config, concrete)) template subtypeCheck() = - if result <= isSubrange and f.lastSon.skipTypes(abstractInst).kind in { - tyRef, tyPtr, tyVar, tyLent, tyOwned}: + case result + of isIntConv: result = isNone + of isSubrange: + discard # XXX should be isNone with preview define, warnings + of isConvertible: + if f.last.skipTypes(abstractInst).kind != tyOpenArray: + # exclude var openarray which compiler supports + result = isNone + of isSubtype: + if f.last.skipTypes(abstractInst).kind in { + tyRef, tyPtr, tyVar, tyLent, tyOwned}: + # compiler can't handle subtype conversions with pointer indirection + result = isNone + else: discard proc isCovariantPtr(c: var TCandidate, f, a: PType): bool = # this proc is always called for a pair of matching types @@ -999,8 +1196,8 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # of the designated type class. # # 3) When used with two type classes, it will check whether the types - # matching the first type class are a strict subset of the types matching - # the other. This allows us to compare the signatures of generic procs in + # matching the first type class (aOrig) are a strict subset of the types matching + # the other (f). This allows us to compare the signatures of generic procs in # order to give preferrence to the most specific one: # # seq[seq[any]] is a strict subset of seq[any] and hence more specific. @@ -1011,7 +1208,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, when declared(deallocatedRefId): let corrupt = deallocatedRefId(cast[pointer](f)) if corrupt != 0: - quit "it's corrupt " & $corrupt + c.c.config.quitOrRaise "it's corrupt " & $corrupt if f.kind == tyUntyped: if aOrig != nil: put(c, f, aOrig) @@ -1040,7 +1237,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, case f.kind of tyGenericParam: - var prev = PType(idTableGet(c.bindings, f)) + var prev = idTableGet(c.bindings, f) if prev != nil: candidate = prev of tyFromExpr: let computedType = tryResolvingStaticExpr(c, f.n).typ @@ -1072,16 +1269,16 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # situation when nkDotExpr are rotated to nkDotCalls if aOrig.kind in {tyAlias, tySink}: - return typeRel(c, f, lastSon(aOrig), flags) + return typeRel(c, f, skipModifier(aOrig), flags) if a.kind == tyGenericInst and skipTypes(f, {tyStatic, tyVar, tyLent, tySink}).kind notin { tyGenericBody, tyGenericInvocation, tyGenericInst, tyGenericParam} + tyTypeClasses: - return typeRel(c, f, lastSon(a), flags) + return typeRel(c, f, skipModifier(a), flags) if a.isResolvedUserTypeClass: - return typeRel(c, f, a.lastSon, flags) + return typeRel(c, f, a.skipModifier, flags) template bindingRet(res) = if doBind: @@ -1090,10 +1287,15 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, return res template considerPreviousT(body: untyped) = - var prev = PType(idTableGet(c.bindings, f)) + var prev = idTableGet(c.bindings, f) if prev == nil: body else: return typeRel(c, prev, a, flags) + if c.c.inGenericContext > 0 and not c.isNoCall and + (tfUnresolved in a.flags or a.kind in tyTypeClasses): + # cheap check for unresolved arg, not nested + return isNone + case a.kind of tyOr: # XXX: deal with the current dual meaning of tyGenericParam @@ -1102,23 +1304,23 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # both int and string must match against number # but ensure that '[T: A|A]' matches as good as '[T: A]' (bug #2219): result = isGeneric - for branch in a.sons: + for branch in a.kids: let x = typeRel(c, f, branch, flags + {trDontBind}) if x == isNone: return isNone if x < result: result = x return result - of tyAnd: # XXX: deal with the current dual meaning of tyGenericParam c.typedescMatched = true # seq[Sortable and Iterable] vs seq[Sortable] # only one match is enough - for branch in a.sons: + for branch in a.kids: let x = typeRel(c, f, branch, flags + {trDontBind}) if x != isNone: return if x >= isGeneric: isGeneric else: x return isNone - + of tyIterable: + if f.kind != tyIterable: return isNone of tyNot: case f.kind of tyNot: @@ -1126,18 +1328,16 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # seq[float] matches the first, but not the second # we must turn the problem around: # is number a subset of int? - return typeRel(c, a.lastSon, f.lastSon, flags) + return typeRel(c, a.elementType, f.elementType, flags) else: # negative type classes are essentially infinite, # so only the `any` type class is their superset return if f.kind == tyAnything: isGeneric else: isNone - of tyAnything: if f.kind == tyAnything: return isGeneric else: return isNone - of tyUserTypeClass, tyUserTypeClassInst: if c.c.matchedConcept != nil and c.c.matchedConcept.depth <= 4: # consider this: 'var g: Node' *within* a concept where 'Node' @@ -1146,6 +1346,17 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, let x = typeRel(c, a, f, flags + {trDontBind}) if x >= isGeneric: return isGeneric + of tyFromExpr: + if c.c.inGenericContext > 0: + if not c.isNoCall: + # generic type bodies can sometimes compile call expressions + # prevent expressions with unresolved types from + # being passed as parameters + return isNone + else: + # Foo[templateCall(T)] shouldn't fail early if Foo has a constraint + # and we can't evaluate `templateCall(T)` yet + return isGeneric else: discard case f.kind @@ -1164,43 +1375,57 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, if result notin {isNone, isGeneric}: # resolve any late-bound static expressions # that may appear in the range: + let expectedType = base(f) for i in 0..1: if f.n[i].kind == nkStaticExpr: - f.n[i] = tryResolvingStaticExpr(c, f.n[i]) + let r = tryResolvingStaticExpr(c, f.n[i], expectedType = expectedType) + if r != nil: + f.n[i] = r result = typeRangeRel(f, a) else: let f = skipTypes(f, {tyRange}) if f.kind == a.kind and (f.kind != tyEnum or sameEnumTypes(f, a)): result = isIntConv - elif isConvertibleToRange(f, a): + elif isConvertibleToRange(c.c, f, a): result = isConvertible # a convertible to f - of tyInt: result = handleRange(f, a, tyInt8, tyInt32) - of tyInt8: result = handleRange(f, a, tyInt8, tyInt8) - of tyInt16: result = handleRange(f, a, tyInt8, tyInt16) - of tyInt32: result = handleRange(f, a, tyInt8, tyInt32) - of tyInt64: result = handleRange(f, a, tyInt, tyInt64) - of tyUInt: result = handleRange(f, a, tyUInt8, tyUInt32) - of tyUInt8: result = handleRange(f, a, tyUInt8, tyUInt8) - of tyUInt16: result = handleRange(f, a, tyUInt8, tyUInt16) - of tyUInt32: result = handleRange(f, a, tyUInt8, tyUInt32) - of tyUInt64: result = handleRange(f, a, tyUInt, tyUInt64) + of tyInt: result = handleRange(c.c, f, a, tyInt8, c.c.config.targetSizeSignedToKind) + of tyInt8: result = handleRange(c.c, f, a, tyInt8, tyInt8) + of tyInt16: result = handleRange(c.c, f, a, tyInt8, tyInt16) + of tyInt32: result = handleRange(c.c, f, a, tyInt8, tyInt32) + of tyInt64: result = handleRange(c.c, f, a, tyInt, tyInt64) + of tyUInt: result = handleRange(c.c, f, a, tyUInt8, c.c.config.targetSizeUnsignedToKind) + of tyUInt8: result = handleRange(c.c, f, a, tyUInt8, tyUInt8) + of tyUInt16: result = handleRange(c.c, f, a, tyUInt8, tyUInt16) + of tyUInt32: result = handleRange(c.c, f, a, tyUInt8, tyUInt32) + of tyUInt64: result = handleRange(c.c, f, a, tyUInt, tyUInt64) of tyFloat: result = handleFloatRange(f, a) of tyFloat32: result = handleFloatRange(f, a) of tyFloat64: result = handleFloatRange(f, a) of tyFloat128: result = handleFloatRange(f, a) - of tyVar, tyLent: - if aOrig.kind == f.kind: result = typeRel(c, f.base, aOrig.base, flags) - else: result = typeRel(c, f.base, aOrig, flags + {trNoCovariance}) + of tyVar: + let flags = if isOutParam(f): flags + {trIsOutParam} else: flags + if aOrig.kind == f.kind and (isOutParam(aOrig) == isOutParam(f)): + result = typeRel(c, f.base, aOrig.base, flags) + else: + result = typeRel(c, f.base, aOrig, flags + {trNoCovariance}) + subtypeCheck() + of tyLent: + if aOrig.kind == f.kind: + result = typeRel(c, f.base, aOrig.base, flags) + else: + result = typeRel(c, f.base, aOrig, flags + {trNoCovariance}) subtypeCheck() of tyArray: - case a.kind - of tyArray: - var fRange = f[0] - var aRange = a[0] - if fRange.kind == tyGenericParam: - var prev = PType(idTableGet(c.bindings, fRange)) + a = reduceToBase(a) + if a.kind == tyArray: + var fRange = f.indexType + var aRange = a.indexType + if fRange.kind in {tyGenericParam, tyAnything}: + var prev = idTableGet(c.bindings, fRange) if prev == nil: - put(c, fRange, a[0]) + if typeRel(c, fRange, aRange) == isNone: + return isNone + put(c, fRange, a.indexType) fRange = a else: fRange = prev @@ -1208,11 +1433,10 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # This typeDesc rule is wrong, see bug #7331 let aa = a[1] #.skipTypes({tyTypeDesc}) - if f[0].kind != tyGenericParam and aa.kind == tyEmpty: + if f.indexType.kind != tyGenericParam and aa.kind == tyEmpty: result = isGeneric else: result = typeRel(c, ff, aa, flags) - if result < isGeneric: if nimEnableCovariance and trNoCovariance notin flags and @@ -1223,24 +1447,22 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, return isNone if fRange.rangeHasUnresolvedStatic: + if aRange.kind in {tyGenericParam} and aRange.reduceToBase() == aRange: + return return inferStaticsInRange(c, fRange, a) elif c.c.matchedConcept != nil and aRange.rangeHasUnresolvedStatic: return inferStaticsInRange(c, aRange, f) + elif result == isGeneric and concreteType(c, aa, ff) == nil: + return isNone else: if lengthOrd(c.c.config, fRange) != lengthOrd(c.c.config, aRange): result = isNone - else: discard - of tyUncheckedArray: - if a.kind == tyUncheckedArray: - result = typeRel(c, base(f), base(a), flags) - if result < isGeneric: result = isNone - else: discard of tyOpenArray, tyVarargs: # varargs[untyped] is special too but handled earlier. So we only need to # handle varargs[typed]: if f.kind == tyVarargs: if tfVarargs in a.flags: - return typeRel(c, f.base, a.lastSon, flags) + return typeRel(c, f.base, a.elementType, flags) if f[0].kind == tyTyped: return template matchArrayOrSeq(aBase: PType) = @@ -1260,13 +1482,13 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, result = typeRel(c, base(f), base(a), flags) if result < isGeneric: result = isNone of tyArray: - if (f[0].kind != tyGenericParam) and (a[1].kind == tyEmpty): + if (f[0].kind != tyGenericParam) and (a.elementType.kind == tyEmpty): return isSubtype - matchArrayOrSeq(a[1]) + matchArrayOrSeq(a.elementType) of tySequence: - if (f[0].kind != tyGenericParam) and (a[0].kind == tyEmpty): + if (f[0].kind != tyGenericParam) and (a.elementType.kind == tyEmpty): return isConvertible - matchArrayOrSeq(a[0]) + matchArrayOrSeq(a.elementType) of tyString: if f.kind == tyOpenArray: if f[0].kind == tyChar: @@ -1275,14 +1497,13 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, typeRel(c, base(f), base(a), flags) >= isGeneric: result = isConvertible else: discard - of tySequence: - case a.kind - of tySequence: - if (f[0].kind != tyGenericParam) and (a[0].kind == tyEmpty): + of tySequence, tyUncheckedArray: + if a.kind == f.kind: + if (f[0].kind != tyGenericParam) and (a.elementType.kind == tyEmpty): result = isSubtype else: let ff = f[0] - let aa = a[0] + let aa = a.elementType result = typeRel(c, ff, aa, flags) if result < isGeneric: if nimEnableCovariance and @@ -1292,13 +1513,11 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, result = isSubtype else: result = isNone - elif tfNotNil in f.flags and tfNotNil notin a.flags: - result = isNilConversion - of tyNil: result = isNone - else: discard + elif a.kind == tyNil: + result = isNone of tyOrdinal: - if isOrdinalType(a, allowEnumWithHoles = optNimV1Emulation in c.c.config.globalOptions): - var x = if a.kind == tyOrdinal: a[0] else: a + if isOrdinalType(a): + var x = if a.kind == tyOrdinal: a.elementType else: a if f[0].kind == tyNone: result = isGeneric else: @@ -1313,16 +1532,20 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, skipOwned(a) if a.kind == f.kind: result = isEqual of tyTuple: - if a.kind == tyTuple: result = recordRel(c, f, a) + if a.kind == tyTuple: result = recordRel(c, f, a, flags) of tyObject: - if a.kind == tyObject: - if sameObjectTypes(f, a): + let effectiveArgType = if useTypeLoweringRuleInTypeClass: + a + else: + reduceToBase(a) + if effectiveArgType.kind == tyObject: + if sameObjectTypes(f, effectiveArgType): + c.inheritancePenalty = if tfFinal in f.flags: -1 else: 0 result = isEqual # elif tfHasMeta in f.flags: result = recordRel(c, f, a) - else: - var depth = isObjectSubtype(c, a, f, nil) - if depth > 0: - inc(c.inheritancePenalty, depth) + elif trIsOutParam notin flags: + c.inheritancePenalty = isObjectSubtype(c, effectiveArgType, f, nil) + if c.inheritancePenalty > 0: result = isSubtype of tyDistinct: a = a.skipTypes({tyOwned, tyGenericInst, tyRange}) @@ -1330,8 +1553,6 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, if sameDistinctTypes(f, a): result = isEqual #elif f.base.kind == tyAnything: result = isGeneric # issue 4435 elif c.coerceDistincts: result = typeRel(c, f.base, a, flags) - elif a.kind == tyNil and f.base.kind in NilableTypes: - result = f.allowsNil # XXX remove this typing rule, it is not in the spec elif c.coerceDistincts: result = typeRel(c, f.base, a, flags) of tySet: if a.kind == tySet: @@ -1339,16 +1560,21 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, result = isSubtype else: result = typeRel(c, f[0], a[0], flags) - if result <= isConvertible: - result = isNone # BUGFIX! + if result < isGeneric: + if tfIsConstructor notin a.flags: + # set['a'..'z'] and set[char] have different representations + result = isNone + else: + # but we can convert individual elements of the constructor + result = isConvertible of tyPtr, tyRef: - skipOwned(a) + a = reduceToBase(a) if a.kind == f.kind: # ptr[R, T] can be passed to ptr[T], but not the other way round: if a.len < f.len: return isNone for i in 0..<f.len-1: if typeRel(c, f[i], a[i], flags) == isNone: return isNone - result = typeRel(c, f.lastSon, a.lastSon, flags + {trNoCovariance}) + result = typeRel(c, f.elementType, a.elementType, flags + {trNoCovariance}) subtypeCheck() if result <= isIntConv: result = isNone elif tfNotNil in f.flags and tfNotNil notin a.flags: @@ -1363,7 +1589,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, of tyOwned: case a.kind of tyOwned: - result = typeRel(c, lastSon(f), lastSon(a), flags) + result = typeRel(c, skipModifier(f), skipModifier(a), flags) of tyNil: result = f.allowsNil else: discard of tyPointer: @@ -1376,26 +1602,25 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, result = isEqual of tyNil: result = f.allowsNil of tyProc: - if a.callConv != ccClosure: result = isConvertible + if isDefined(c.c.config, "nimPreviewProcConversion"): + result = isNone + else: + if a.callConv != ccClosure: result = isConvertible of tyPtr: # 'pointer' is NOT compatible to regionized pointers # so 'dealloc(regionPtr)' fails: if a.len == 1: result = isConvertible - of tyCString: result = isConvertible + of tyCstring: result = isConvertible else: discard of tyString: case a.kind - of tyString: - if tfNotNil in f.flags and tfNotNil notin a.flags: - result = isNilConversion - else: - result = isEqual + of tyString: result = isEqual of tyNil: result = isNone else: discard - of tyCString: + of tyCstring: # conversion from string to cstring is automatic: case a.kind - of tyCString: + of tyCstring: if tfNotNil in f.flags and tfNotNil notin a.flags: result = isNilConversion else: @@ -1403,31 +1628,43 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, of tyNil: result = f.allowsNil of tyString: result = isConvertible of tyPtr: - # ptr[Tag, char] is not convertible to 'cstring' for now: - if a.len == 1: - let pointsTo = a[0].skipTypes(abstractInst) - if pointsTo.kind == tyChar: result = isConvertible - elif pointsTo.kind == tyUncheckedArray and pointsTo[0].kind == tyChar: - result = isConvertible - elif pointsTo.kind == tyArray and firstOrd(nil, pointsTo[0]) == 0 and - skipTypes(pointsTo[0], {tyRange}).kind in {tyInt..tyInt64} and - pointsTo[1].kind == tyChar: - result = isConvertible + if isDefined(c.c.config, "nimPreviewCstringConversion"): + result = isNone + else: + if a.len == 1: + let pointsTo = a[0].skipTypes(abstractInst) + if pointsTo.kind == tyChar: result = isConvertible + elif pointsTo.kind == tyUncheckedArray and pointsTo[0].kind == tyChar: + result = isConvertible + elif pointsTo.kind == tyArray and firstOrd(nil, pointsTo[0]) == 0 and + skipTypes(pointsTo[0], {tyRange}).kind in {tyInt..tyInt64} and + pointsTo[1].kind == tyChar: + result = isConvertible else: discard - of tyEmpty, tyVoid: if a.kind == f.kind: result = isEqual - of tyAlias, tySink: - result = typeRel(c, lastSon(f), a, flags) - + result = typeRel(c, skipModifier(f), a, flags) + of tyIterable: + if a.kind == tyIterable: + if f.len == 1: + result = typeRel(c, skipModifier(f), skipModifier(a), flags) + else: + # f.len = 3, for some reason + result = isGeneric + else: + result = isNone of tyGenericInst: - var prev = PType(idTableGet(c.bindings, f)) + var prev = idTableGet(c.bindings, f) let origF = f var f = if prev == nil: f else: prev - let roota = a.skipGenericAlias - let rootf = f.skipGenericAlias + let deptha = a.genericAliasDepth() + let depthf = f.genericAliasDepth() + let skipBoth = deptha == depthf and (a.len > 0 and f.len > 0 and a.base != f.base) + + let roota = if skipBoth or deptha > depthf: a.skipGenericAlias else: a + let rootf = if skipBoth or depthf > deptha: f.skipGenericAlias else: f if a.kind == tyGenericInst: if roota.base == rootf.base: @@ -1459,13 +1696,13 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, return isNone if prev == nil: put(c, f, a) else: - let fKind = rootf.lastSon.kind + let fKind = rootf.last.kind if fKind in {tyAnd, tyOr}: - result = typeRel(c, lastSon(f), a, flags) + result = typeRel(c, last(f), a, flags) if result != isNone: put(c, f, a) return - var aAsObject = roota.lastSon + var aAsObject = roota.last if fKind in {tyRef, tyPtr}: if aAsObject.kind == tyObject: @@ -1475,46 +1712,47 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, elif aAsObject.kind == fKind: aAsObject = aAsObject.base - if aAsObject.kind == tyObject: + if aAsObject.kind == tyObject and trIsOutParam notin flags: let baseType = aAsObject.base if baseType != nil: - c.inheritancePenalty += 1 + inc c.inheritancePenalty, 1 + int(c.inheritancePenalty < 0) let ret = typeRel(c, f, baseType, flags) return if ret in {isEqual,isGeneric}: isSubtype else: ret result = isNone else: - assert lastSon(origF) != nil - result = typeRel(c, lastSon(origF), a, flags) + assert last(origF) != nil + result = typeRel(c, last(origF), a, flags) if result != isNone and a.kind != tyNil: put(c, f, a) - of tyGenericBody: considerPreviousT: if a == f or a.kind == tyGenericInst and a.skipGenericAlias[0] == f: bindingRet isGeneric - let ff = lastSon(f) + let ff = last(f) if ff != nil: result = typeRel(c, ff, a, flags) - of tyGenericInvocation: var x = a.skipGenericAlias + if x.kind == tyGenericParam and x.len > 0: + x = x.last let concpt = f[0].skipTypes({tyGenericBody}) var preventHack = concpt.kind == tyConcept if x.kind == tyOwned and f[0].kind != tyOwned: preventHack = true - x = x.lastSon + x = x.last # XXX: This is very hacky. It should be moved back into liftTypeParam if x.kind in {tyGenericInst, tyArray} and c.calleeSym != nil and c.calleeSym.kind in {skProc, skFunc} and c.call != nil and not preventHack: let inst = prepareMetatypeForSigmatch(c.c, c.bindings, c.call.info, f) - #echo "inferred ", typeToString(inst), " for ", f return typeRel(c, inst, a, flags) if x.kind == tyGenericInvocation: if f[0] == x[0]: for i in 1..<f.len: + # Handle when checking against a generic that isn't fully instantiated + if i >= x.len: return let tr = typeRel(c, f[i], x[i], flags) if tr <= isSubtype: return result = isGeneric @@ -1535,10 +1773,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, var askip = skippedNone var fskip = skippedNone let aobj = x.skipToObject(askip) - let fobj = genericBody.lastSon.skipToObject(fskip) - var depth = -1 - if fobj != nil and aobj != nil and askip == fskip: - depth = isObjectSubtype(c, aobj, fobj, f) + let fobj = genericBody.last.skipToObject(fskip) result = typeRel(c, genericBody, x, flags) if result != isNone: # see tests/generics/tgeneric3.nim for an example that triggers this @@ -1552,18 +1787,21 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # # we steal the generic parameters from the tyGenericBody: for i in 1..<f.len: - let x = PType(idTableGet(c.bindings, genericBody[i-1])) + let x = idTableGet(c.bindings, genericBody[i-1]) if x == nil: discard "maybe fine (for e.g. a==tyNil)" elif x.kind in {tyGenericInvocation, tyGenericParam}: internalError(c.c.graph.config, "wrong instantiated type!") else: let key = f[i] - let old = PType(idTableGet(c.bindings, key)) + let old = idTableGet(c.bindings, key) if old == nil: put(c, key, x) elif typeRel(c, old, x, flags + {trDontBind}) == isNone: return isNone + var depth = -1 + if fobj != nil and aobj != nil and askip == fskip: + depth = isObjectSubtype(c, aobj, fobj, f) if result == isNone: # Here object inheriting from generic/specialized generic object @@ -1574,72 +1812,73 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, depth = -1 if depth >= 0: - c.inheritancePenalty += depth + inc c.inheritancePenalty, depth + int(c.inheritancePenalty < 0) # bug #4863: We still need to bind generic alias crap, so # we cannot return immediately: result = if depth == 0: isGeneric else: isSubtype of tyAnd: considerPreviousT: result = isEqual - for branch in f.sons: + for branch in f.kids: let x = typeRel(c, branch, aOrig, flags) if x < isSubtype: return isNone # 'and' implies minimum matching result: if x < result: result = x if result > isGeneric: result = isGeneric bindingRet result - of tyOr: considerPreviousT: result = isNone let oldInheritancePenalty = c.inheritancePenalty - var maxInheritance = 0 - for branch in f.sons: - c.inheritancePenalty = 0 + var minInheritance = maxInheritancePenalty + for branch in f.kids: + c.inheritancePenalty = -1 let x = typeRel(c, branch, aOrig, flags) - maxInheritance = max(maxInheritance, c.inheritancePenalty) - - # 'or' implies maximum matching result: - if x > result: result = x - if result >= isSubtype: + if x >= result: + if c.inheritancePenalty > -1: + minInheritance = min(minInheritance, c.inheritancePenalty) + result = x + if result >= isIntConv: + if minInheritance < maxInheritancePenalty: + c.inheritancePenalty = oldInheritancePenalty + minInheritance if result > isGeneric: result = isGeneric bindingRet result else: result = isNone - c.inheritancePenalty = oldInheritancePenalty + maxInheritance - of tyNot: considerPreviousT: - for branch in f.sons: - if typeRel(c, branch, aOrig, flags) != isNone: - return isNone + if typeRel(c, f.elementType, aOrig, flags) != isNone: + return isNone bindingRet isGeneric - of tyAnything: considerPreviousT: var concrete = concreteType(c, a) if concrete != nil and doBind: put(c, f, concrete) return isGeneric - of tyBuiltInTypeClass: considerPreviousT: - let targetKind = f[0].kind - let effectiveArgType = a.skipTypes({tyRange, tyGenericInst, - tyBuiltInTypeClass, tyAlias, tySink, tyOwned}) - let typeClassMatches = targetKind == effectiveArgType.kind and - not effectiveArgType.isEmptyContainer - if typeClassMatches or - (targetKind in {tyProc, tyPointer} and effectiveArgType.kind == tyNil): - put(c, f, a) + let target = f.genericHead + let targetKind = target.kind + var effectiveArgType = reduceToBase(a) + effectiveArgType = effectiveArgType.skipTypes({tyBuiltInTypeClass}) + if targetKind == effectiveArgType.kind: + if effectiveArgType.isEmptyContainer: + return isNone + if targetKind == tyProc: + if target.flags * {tfIterator} != effectiveArgType.flags * {tfIterator}: + return isNone + if tfExplicitCallConv in target.flags and + target.callConv != effectiveArgType.callConv: + return isNone + if doBind: put(c, f, a) return isGeneric else: return isNone - of tyUserTypeClassInst, tyUserTypeClass: if f.isResolvedUserTypeClass: - result = typeRel(c, f.lastSon, a, flags) + result = typeRel(c, f.last, a, flags) else: considerPreviousT: if aOrig == f: return isEqual @@ -1648,17 +1887,24 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, bindConcreteTypeToUserTypeClass(matched, a) if doBind: put(c, f, matched) result = isGeneric + elif a.len > 0 and a.last == f: + # Needed for checking `Y` == `Addable` in the following + #[ + type + Addable = concept a, type A + a + a is A + MyType[T: Addable; Y: static T] = object + ]# + result = isGeneric else: result = isNone - of tyConcept: result = if concepts.conceptMatch(c.c, f, a, c.bindings, nil): isGeneric else: isNone - of tyCompositeTypeClass: considerPreviousT: let roota = a.skipGenericAlias - let rootf = f.lastSon.skipGenericAlias + let rootf = f.last.skipGenericAlias if a.kind == tyGenericInst and roota.base == rootf.base: for i in 1..<rootf.len-1: let ff = rootf[i] @@ -1667,14 +1913,13 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, if result == isNone: return if ff.kind == tyRange and result != isEqual: return isNone else: - result = typeRel(c, rootf.lastSon, a, flags) + result = typeRel(c, rootf.last, a, flags) if result != isNone: put(c, f, a) result = isGeneric - of tyGenericParam: let doBindGP = doBind or trBindGenericParam in flags - var x = PType(idTableGet(c.bindings, f)) + var x = idTableGet(c.bindings, f) if x == nil: if c.callee.kind == tyGenericBody and not c.typedescMatched: # XXX: The fact that generic types currently use tyGenericParam for @@ -1692,8 +1937,9 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, c.typedescMatched = true var aa = a while aa.kind in {tyTypeDesc, tyGenericParam} and aa.len > 0: - aa = lastSon(aa) - if aa.kind == tyGenericParam: + aa = last(aa) + if aa.kind in {tyGenericParam} + tyTypeClasses: + # If the constraint is a genericParam or typeClass this isGeneric return isGeneric result = typeRel(c, f.base, aa, flags) if result > isGeneric: result = isGeneric @@ -1708,18 +1954,12 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, else: # check if 'T' has a constraint as in 'proc p[T: Constraint](x: T)' if f.len > 0 and f[0].kind != tyNone: - let oldInheritancePenalty = c.inheritancePenalty - result = typeRel(c, f[0], a, flags + {trDontBind,trBindGenericParam}) + result = typeRel(c, f[0], a, flags + {trDontBind, trBindGenericParam}) if doBindGP and result notin {isNone, isGeneric}: let concrete = concreteType(c, a, f) if concrete == nil: return isNone put(c, f, concrete) - # bug #6526 if result in {isEqual, isSubtype}: - # 'T: Class' is a *better* match than just 'T' - # but 'T: Subclass' is even better: - c.inheritancePenalty = oldInheritancePenalty - c.inheritancePenalty - - 100 * ord(result == isEqual) result = isGeneric elif a.kind == tyTypeDesc: # somewhat special typing rule, the following is illegal: @@ -1734,7 +1974,12 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, if tfWildcard in a.flags: a.sym.transitionGenericParamToType() a.flags.excl tfWildcard - else: + elif doBind: + # careful: `trDontDont` (set by `checkGeneric`) is not always respected in this call graph. + # typRel having two different modes (binding and non-binding) can make things harder to + # reason about and maintain. Refactoring typeRel to not be responsible for setting, or + # at least validating, bindings can have multiple benefits. This is debatable. I'm not 100% sure. + # A design that allows a proper complexity analysis of types like `tyOr` would be ideal. concrete = concreteType(c, a, f) if concrete == nil: return isNone @@ -1747,33 +1992,57 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, elif x.kind == tyGenericParam: result = isGeneric else: + # This is the bound type - can't benifit from these tallies + let + inheritancePenaltyOld = c.inheritancePenalty result = typeRel(c, x, a, flags) # check if it fits + c.inheritancePenalty = inheritancePenaltyOld if result > isGeneric: result = isGeneric of tyStatic: - let prev = PType(idTableGet(c.bindings, f)) + let prev = idTableGet(c.bindings, f) if prev == nil: if aOrig.kind == tyStatic: - if f.base.kind != tyNone: + if c.c.inGenericContext > 0 and aOrig.n == nil and not c.isNoCall: + # don't match unresolved static value to static param to avoid + # faulty instantiations in calls in generic bodies + # but not for generic invocations as they only check constraints + result = isNone + elif f.base.kind notin {tyNone, tyGenericParam}: result = typeRel(c, f.base, a, flags) if result != isNone and f.n != nil: - if not exprStructuralEquivalent(f.n, aOrig.n): + var r = tryResolvingStaticExpr(c, f.n) + if r == nil: r = f.n + if not exprStructuralEquivalent(r, aOrig.n) and + not (aOrig.n != nil and aOrig.n.kind == nkIntLit and + inferStaticParam(c, r, aOrig.n.intVal)): result = isNone + elif f.base.kind == tyGenericParam: + # Handling things like `type A[T; Y: static T] = object` + if f.base.len > 0: # There is a constraint, handle it + result = typeRel(c, f.base.last, a, flags) + else: + # No constraint + if tfGenericTypeParam in f.flags: + result = isGeneric + else: + # for things like `proc fun[T](a: static[T])` + result = typeRel(c, f.base, a, flags) else: result = isGeneric if result != isNone: put(c, f, aOrig) elif aOrig.n != nil and aOrig.n.typ != nil: result = if f.base.kind != tyNone: - typeRel(c, f.lastSon, aOrig.n.typ, flags) + typeRel(c, f.last, aOrig.n.typ, flags) else: isGeneric if result != isNone: - var boundType = newTypeWithSons(c.c, tyStatic, @[aOrig.n.typ]) + var boundType = newTypeS(tyStatic, c.c, aOrig.n.typ) boundType.n = aOrig.n put(c, f, boundType) else: result = isNone elif prev.kind == tyStatic: if aOrig.kind == tyStatic: - result = typeRel(c, prev.lastSon, a, flags) + result = typeRel(c, prev.last, a, flags) if result != isNone and prev.n != nil: if not exprStructuralEquivalent(prev.n, aOrig.n): result = isNone @@ -1782,7 +2051,6 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # XXX endless recursion? #result = typeRel(c, prev, aOrig, flags) result = isNone - of tyInferred: let prev = f.previouslyInferred if prev != nil: @@ -1792,14 +2060,18 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, if result != isNone: c.inferredTypes.add f f.add a - of tyTypeDesc: - var prev = PType(idTableGet(c.bindings, f)) + var prev = idTableGet(c.bindings, f) if prev == nil: # proc foo(T: typedesc, x: T) # when `f` is an unresolved typedesc, `a` could be any # type, so we should not perform this check earlier - if a.kind != tyTypeDesc: + if c.c.inGenericContext > 0 and a.containsUnresolvedType: + # generic type bodies can sometimes compile call expressions + # prevent unresolved generic parameters from being passed to procs as + # typedesc parameters + result = isNone + elif a.kind != tyTypeDesc: if a.kind == tyGenericParam and tfWildcard in a.flags: # TODO: prevent `a` from matching as a wildcard again result = isGeneric @@ -1819,32 +2091,40 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, result = typeRel(c, prev.base, a.base, flags) else: result = isNone - of tyTyped: if aOrig != nil: put(c, f, aOrig) result = isGeneric - - of tyProxy: + of tyError: result = isEqual - of tyFromExpr: # fix the expression, so it contains the already instantiated types if f.n == nil or f.n.kind == nkEmpty: return isGeneric - let reevaluated = tryResolvingStaticExpr(c, f.n) - case reevaluated.typ.kind + if c.c.inGenericContext > 0: + # need to delay until instantiation + # also prevent infinite recursion below + return isNone + inc c.c.inGenericContext # to generate tyFromExpr again if unresolved + # use prepareNode for consistency with other tyFromExpr in semtypinst: + let instantiated = prepareTypesInBody(c.c, c.bindings, f.n) + let reevaluated = c.c.semExpr(c.c, instantiated).typ + dec c.c.inGenericContext + case reevaluated.kind + of tyFromExpr: + # not resolved + result = isNone of tyTypeDesc: - result = typeRel(c, a, reevaluated.typ.base, flags) + result = typeRel(c, reevaluated.base, a, flags) of tyStatic: - result = typeRel(c, a, reevaluated.typ.base, flags) - if result != isNone and reevaluated.typ.n != nil: - if not exprStructuralEquivalent(aOrig.n, reevaluated.typ.n): + result = typeRel(c, reevaluated.base, a, flags) + if result != isNone and reevaluated.n != nil: + if not exprStructuralEquivalent(aOrig.n, reevaluated.n): result = isNone else: # bug #14136: other types are just like 'tyStatic' here: - result = typeRel(c, a, reevaluated.typ, flags) - if result != isNone and reevaluated.typ.n != nil: - if not exprStructuralEquivalent(aOrig.n, reevaluated.typ.n): + result = typeRel(c, reevaluated, a, flags) + if result != isNone and reevaluated.n != nil: + if not exprStructuralEquivalent(aOrig.n, reevaluated.n): result = isNone of tyNone: if a.kind == tyNone: result = isEqual @@ -1872,7 +2152,7 @@ proc cmpTypes*(c: PContext, f, a: PType): TTypeRelation = proc getInstantiatedType(c: PContext, arg: PNode, m: TCandidate, f: PType): PType = - result = PType(idTableGet(m.bindings, f)) + result = idTableGet(m.bindings, f) if result == nil: result = generateTypeInstance(c, m.bindings, arg, f) if result == nil: @@ -1883,22 +2163,121 @@ proc implicitConv(kind: TNodeKind, f: PType, arg: PNode, m: TCandidate, c: PContext): PNode = result = newNodeI(kind, arg.info) if containsGenericType(f): - if not m.hasFauxMatch: + if not m.matchedErrorType: result.typ = getInstantiatedType(c, arg, m, f).skipTypes({tySink}) else: result.typ = errorType(c) else: result.typ = f.skipTypes({tySink}) + # keep varness + if arg.typ != nil and arg.typ.kind == tyVar: + result.typ = toVar(result.typ, tyVar, c.idgen) + else: + result.typ = result.typ.skipTypes({tyVar}) + if result.typ == nil: internalError(c.graph.config, arg.info, "implicitConv") result.add c.graph.emptyNode - result.add arg + if arg.typ != nil and arg.typ.kind == tyLent: + let a = newNodeIT(nkHiddenDeref, arg.info, arg.typ.elementType) + a.add arg + result.add a + else: + result.add arg + +proc convertLiteral(kind: TNodeKind, c: PContext, m: TCandidate; n: PNode, newType: PType): PNode = + # based off changeType but generates implicit conversions instead + template addConsiderNil(s, node) = + let val = node + if val.isNil: return nil + s.add(val) + case n.kind + of nkCurly: + result = copyNode(n) + for i in 0..<n.len: + if n[i].kind == nkRange: + var x = copyNode(n[i]) + x.addConsiderNil convertLiteral(kind, c, m, n[i][0], elemType(newType)) + x.addConsiderNil convertLiteral(kind, c, m, n[i][1], elemType(newType)) + result.add x + else: + result.addConsiderNil convertLiteral(kind, c, m, n[i], elemType(newType)) + result.typ = newType + return + of nkBracket: + result = copyNode(n) + for i in 0..<n.len: + result.addConsiderNil convertLiteral(kind, c, m, n[i], elemType(newType)) + result.typ = newType + return + of nkPar, nkTupleConstr: + let tup = newType.skipTypes({tyGenericInst, tyAlias, tySink, tyDistinct}) + if tup.kind == tyTuple: + result = copyNode(n) + if n.len > 0 and n[0].kind == nkExprColonExpr: + # named tuple? + for i in 0..<n.len: + var name = n[i][0] + if name.kind != nkSym: + #globalError(c.config, name.info, "invalid tuple constructor") + return nil + if tup.n != nil: + var f = getSymFromList(tup.n, name.sym.name) + if f == nil: + #globalError(c.config, name.info, "unknown identifier: " & name.sym.name.s) + return nil + result.addConsiderNil convertLiteral(kind, c, m, n[i][1], f.typ) + else: + result.addConsiderNil convertLiteral(kind, c, m, n[i][1], tup[i]) + else: + for i in 0..<n.len: + result.addConsiderNil convertLiteral(kind, c, m, n[i], tup[i]) + result.typ = newType + return + of nkCharLit..nkUInt64Lit: + if n.kind != nkUInt64Lit and not sameTypeOrNil(n.typ, newType) and isOrdinalType(newType): + let value = n.intVal + if value < firstOrd(c.config, newType) or value > lastOrd(c.config, newType): + return nil + result = copyNode(n) + result.typ = newType + return + of nkFloatLit..nkFloat64Lit: + if newType.skipTypes(abstractVarRange-{tyTypeDesc}).kind == tyFloat: + if not floatRangeCheck(n.floatVal, newType): + return nil + result = copyNode(n) + result.typ = newType + return + of nkSym: + if n.sym.kind == skEnumField and not sameTypeOrNil(n.sym.typ, newType) and isOrdinalType(newType): + let value = n.sym.position + if value < firstOrd(c.config, newType) or value > lastOrd(c.config, newType): + return nil + result = copyNode(n) + result.typ = newType + return + else: discard + return implicitConv(kind, newType, n, m, c) + +proc isLValue(c: PContext; n: PNode, isOutParam = false): bool {.inline.} = + let aa = isAssignable(nil, n) + case aa + of arLValue, arLocalLValue, arStrange: + result = true + of arDiscriminant: + result = c.inUncheckedAssignSection > 0 + of arAddressableConst: + let sym = getRoot(n) + result = strictDefs in c.features and sym != nil and sym.kind == skLet and isOutParam + else: + result = false proc userConvMatch(c: PContext, m: var TCandidate, f, a: PType, arg: PNode): PNode = result = nil for i in 0..<c.converters.len: - var src = c.converters[i].typ[1] - var dest = c.converters[i].typ[0] + var src = c.converters[i].typ.firstParamType + var dest = c.converters[i].typ.returnType # for generic type converters we need to check 'src <- a' before # 'f <- dest' in order to not break the unification: # see tests/tgenericconverter: @@ -1909,7 +2288,7 @@ proc userConvMatch(c: PContext, m: var TCandidate, f, a: PType, let constraint = c.converters[i].typ.n[1].sym.constraint if not constraint.isNil and not matchNodeKinds(constraint, arg): continue - if src.kind in {tyVar, tyLent} and not arg.isLValue: + if src.kind in {tyVar, tyLent} and not isLValue(c, arg): continue let destIsGeneric = containsGenericType(dest) @@ -1930,8 +2309,8 @@ proc userConvMatch(c: PContext, m: var TCandidate, f, a: PType, if srca == isSubtype: param = implicitConv(nkHiddenSubConv, src, copyTree(arg), m, c) elif src.kind in {tyVar}: - # Analyse the converter return type - param = newNodeIT(nkHiddenAddr, arg.info, s.typ[1]) + # Analyse the converter return type. + param = newNodeIT(nkHiddenAddr, arg.info, s.typ.firstParamType) param.add copyTree(arg) else: param = copyTree(arg) @@ -1965,7 +2344,7 @@ proc localConvMatch(c: PContext, m: var TCandidate, f, a: PType, if result != nil: if result.typ == nil: return nil # bug #13378, ensure we produce a real generic instantiation: - result = c.semExpr(c, call) + result = c.semExpr(c, call, {efNoSem2Check}) # resulting type must be consistent with the other arguments: var r = typeRel(m, f[0], result.typ) if r < isGeneric: return nil @@ -1987,17 +2366,17 @@ proc incMatches(m: var TCandidate; r: TTypeRelation; convMatch = 1) = of isNone: discard template matchesVoidProc(t: PType): bool = - (t.kind == tyProc and t.len == 1 and t[0] == nil) or - (t.kind == tyBuiltInTypeClass and t[0].kind == tyProc) + (t.kind == tyProc and t.len == 1 and t.returnType == nil) or + (t.kind == tyBuiltInTypeClass and t.elementType.kind == tyProc) proc paramTypesMatchAux(m: var TCandidate, f, a: PType, argSemantized, argOrig: PNode): PNode = + result = nil var fMaybeStatic = f.skipTypes({tyDistinct}) arg = argSemantized a = a c = m.c - if tfHasStatic in fMaybeStatic.flags: # XXX: When implicit statics are the default # this will be done earlier - we just have to @@ -2017,13 +2396,15 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, a.n == nil and tfGenericTypeParam notin a.flags: return newNodeIT(nkType, argOrig.info, makeTypeFromExpr(c, arg)) - else: + elif a.kind == tyFromExpr and c.inGenericContext > 0: + # don't try to evaluate + discard + elif arg.kind != nkEmpty: var evaluated = c.semTryConstExpr(c, arg) if evaluated != nil: # Don't build the type in-place because `evaluated` and `arg` may point # to the same object and we'd end up creating recursive types (#9255) - let typ = newTypeS(tyStatic, c) - typ.sons = @[evaluated.typ] + let typ = newTypeS(tyStatic, c, son = evaluated.typ) typ.n = evaluated arg = copyTree(arg) # fix #12864 arg.typ = typ @@ -2056,36 +2437,58 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, else: return argSemantized # argOrig - # If r == isBothMetaConvertible then we rerun typeRel. - # bothMetaCounter is for safety to avoid any infinite loop, - # I don't have any example when it is needed. - # lastBindingsLenth is used to check whether m.bindings remains the same, - # because in that case there is no point in continuing. - var bothMetaCounter = 0 - var lastBindingsLength = -1 - while r == isBothMetaConvertible and - lastBindingsLength != m.bindings.counter and - bothMetaCounter < 100: - lastBindingsLength = m.bindings.counter - inc(bothMetaCounter) - if arg.kind in {nkProcDef, nkFuncDef, nkIteratorDef} + nkLambdaKinds: - result = c.semInferredLambda(c, m.bindings, arg) - elif arg.kind != nkSym: - return nil - else: - let inferred = c.semGenerateInstance(c, arg.sym, m.bindings, arg.info) - result = newSymNode(inferred, arg.info) - inc(m.convMatches) - arg = result - r = typeRel(m, f, arg.typ) + block instantiateGenericRoutine: + # In the case where the matched value is a generic proc, we need to + # fully instantiate it and then rerun typeRel to make sure it matches. + # instantiationCounter is for safety to avoid any infinite loop, + # I don't have any example when it is needed. + # lastBindingCount is used to check whether m.bindings remains the same, + # because in that case there is no point in continuing. + var instantiationCounter = 0 + var lastBindingCount = -1 + while r in {isBothMetaConvertible, isInferred, isInferredConvertible} and + lastBindingCount != m.bindings.len and + instantiationCounter < 100: + lastBindingCount = m.bindings.len + inc(instantiationCounter) + if arg.kind in {nkProcDef, nkFuncDef, nkIteratorDef} + nkLambdaKinds: + result = c.semInferredLambda(c, m.bindings, arg) + elif arg.kind != nkSym: + return nil + elif arg.sym.kind in {skMacro, skTemplate}: + return nil + else: + if arg.sym.ast == nil: + return nil + let inferred = c.semGenerateInstance(c, arg.sym, m.bindings, arg.info) + result = newSymNode(inferred, arg.info) + arg = result + r = typeRel(m, f, arg.typ) case r of isConvertible: + if f.skipTypes({tyRange}).kind in {tyInt, tyUInt}: + inc(m.convMatches) inc(m.convMatches) - result = implicitConv(nkHiddenStdConv, f, arg, m, c) + if skipTypes(f, abstractVar-{tyTypeDesc}).kind == tySet: + if tfIsConstructor in a.flags and arg.kind == nkCurly: + # we marked the set as convertible only because the arg is a literal + # in which case we individually convert each element + let t = + if containsGenericType(f): + getInstantiatedType(c, arg, m, f).skipTypes({tySink}) + else: + f.skipTypes({tySink}) + result = convertLiteral(nkHiddenStdConv, c, m, arg, t) + else: + result = nil + else: + result = implicitConv(nkHiddenStdConv, f, arg, m, c) of isIntConv: # I'm too lazy to introduce another ``*matches`` field, so we conflate # ``isIntConv`` and ``isIntLit`` here: + if f.skipTypes({tyRange}).kind notin {tyInt, tyUInt}: + inc(m.intConvMatches) inc(m.intConvMatches) result = implicitConv(nkHiddenStdConv, f, arg, m, c) of isSubtype: @@ -2100,25 +2503,20 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, result = arg else: result = implicitConv(nkHiddenStdConv, f, arg, m, c) - of isInferred, isInferredConvertible: - if arg.kind in {nkProcDef, nkFuncDef, nkIteratorDef} + nkLambdaKinds: - result = c.semInferredLambda(c, m.bindings, arg) - elif arg.kind != nkSym: - return nil - else: - let inferred = c.semGenerateInstance(c, arg.sym, m.bindings, arg.info) - result = newSymNode(inferred, arg.info) - if r == isInferredConvertible: - inc(m.convMatches) - result = implicitConv(nkHiddenStdConv, f, result, m, c) - else: - inc(m.genericMatches) + of isInferred: + # result should be set in above while loop: + assert result != nil + inc(m.genericMatches) + of isInferredConvertible: + # result should be set in above while loop: + assert result != nil + inc(m.convMatches) + result = implicitConv(nkHiddenStdConv, f, result, m, c) of isGeneric: inc(m.genericMatches) if arg.typ == nil: result = arg - elif skipTypes(arg.typ, abstractVar-{tyTypeDesc}).kind == tyTuple or - m.inheritancePenalty > oldInheritancePenalty: + elif skipTypes(arg.typ, abstractVar-{tyTypeDesc}).kind == tyTuple or cmpInheritancePenalty(oldInheritancePenalty, m.inheritancePenalty) > 0: result = implicitConv(nkHiddenSubConv, f, arg, m, c) elif arg.typ.isEmptyContainer: result = arg.copyTree @@ -2126,8 +2524,10 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, else: result = arg of isBothMetaConvertible: - # This is the result for the 101th time. - result = nil + # result should be set in above while loop: + assert result != nil + inc(m.convMatches) + result = arg of isFromIntLit: # too lazy to introduce another ``*matches`` field, so we conflate # ``isIntConv`` and ``isIntLit`` here: @@ -2136,17 +2536,21 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, of isEqual: inc(m.exactMatches) result = arg - if skipTypes(f, abstractVar-{tyTypeDesc}).kind == tyTuple or + let ff = skipTypes(f, abstractVar-{tyTypeDesc}) + if ff.kind == tyTuple or (arg.typ != nil and skipTypes(arg.typ, abstractVar-{tyTypeDesc}).kind == tyTuple): result = implicitConv(nkHiddenSubConv, f, arg, m, c) of isNone: # do not do this in ``typeRel`` as it then can't infer T in ``ref T``: - if a.kind in {tyProxy, tyUnknown}: + if a.kind == tyFromExpr: return nil + elif a.kind == tyError: inc(m.genericMatches) - m.fauxMatch = a.kind + m.matchedErrorType = true return arg elif a.kind == tyVoid and f.matchesVoidProc and argOrig.kind == nkStmtList: # lift do blocks without params to lambdas + # now deprecated + message(c.config, argOrig.info, warnStmtListLambda) let p = c.graph let lifted = c.semExpr(c, newProcNode(nkDo, argOrig.info, body = argOrig, params = nkFormalParams.newTree(p.emptyNode), name = p.emptyNode, pattern = p.emptyNode, @@ -2163,6 +2567,9 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, if f.n != nil: # Forward to the varargs converter result = localConvMatch(c, m, f, a, arg) + elif f[0].kind == tyTyped: + inc m.genericMatches + result = arg else: r = typeRel(m, base(f), a) case r @@ -2190,61 +2597,103 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, result = userConvMatch(c, m, base(f), a, arg) if result != nil: m.baseTypeMatch = true +proc staticAwareTypeRel(m: var TCandidate, f: PType, arg: var PNode): TTypeRelation = + if f.kind == tyStatic and f.base.kind == tyProc: + # The ast of the type does not point to the symbol. + # Without this we will never resolve a `static proc` with overloads + let copiedNode = copyNode(arg) + copiedNode.typ = exactReplica(copiedNode.typ) + copiedNode.typ.n = arg + arg = copiedNode + typeRel(m, f, arg.typ) + + proc paramTypesMatch*(m: var TCandidate, f, a: PType, arg, argOrig: PNode): PNode = if arg == nil or arg.kind notin nkSymChoices: result = paramTypesMatchAux(m, f, a, arg, argOrig) else: - # CAUTION: The order depends on the used hashing scheme. Thus it is - # incorrect to simply use the first fitting match. However, to implement - # this correctly is inefficient. We have to copy `m` here to be able to - # roll back the side effects of the unification algorithm. - let c = m.c - var - x = newCandidate(c, m.callee) - y = newCandidate(c, m.callee) - z = newCandidate(c, m.callee) - x.calleeSym = m.calleeSym - y.calleeSym = m.calleeSym - z.calleeSym = m.calleeSym + # symbol kinds that don't participate in symchoice type disambiguation: + let matchSet = {low(TSymKind)..high(TSymKind)} - {skModule, skPackage} + var best = -1 - for i in 0..<arg.len: - if arg[i].sym.kind in {skProc, skFunc, skMethod, skConverter, - skIterator, skMacro, skTemplate}: - copyCandidate(z, m) - z.callee = arg[i].typ - if tfUnresolved in z.callee.flags: continue - z.calleeSym = arg[i].sym - # XXX this is still all wrong: (T, T) should be 2 generic matches - # and (int, int) 2 exact matches, etc. Essentially you cannot call - # typeRel here and expect things to work! - let r = typeRel(z, f, arg[i].typ) - incMatches(z, r, 2) - if r != isNone: - z.state = csMatch - case x.state - of csEmpty, csNoMatch: - x = z + result = arg + + var actingF = f + if f.kind == tyVarargs: + if m.calleeSym.kind in {skTemplate, skMacro}: + actingF = f[0] + if actingF.kind in {tyTyped, tyUntyped}: + var + bestScope = -1 + counts = 0 + for i in 0..<arg.len: + if arg[i].sym.kind in matchSet: + let thisScope = cmpScopes(m.c, arg[i].sym) + if thisScope > bestScope: best = i - of csMatch: - let cmp = cmpCandidates(x, z) - if cmp < 0: - best = i - x = z - elif cmp == 0: - y = z # z is as good as x - - if x.state == csEmpty: - result = nil - elif y.state == csMatch and cmpCandidates(x, y) == 0: - if x.state != csMatch: - internalError(m.c.graph.config, arg.info, "x.state is not csMatch") - # ambiguous: more than one symbol fits! - # See tsymchoice_for_expr as an example. 'f.kind == tyUntyped' should match - # anyway: - if f.kind in {tyUntyped, tyTyped}: result = arg - else: result = nil + bestScope = thisScope + counts = 0 + elif thisScope == bestScope: + inc counts + if best == -1: + result = nil + elif counts > 0: + m.genericMatches = 1 + best = -1 else: + # CAUTION: The order depends on the used hashing scheme. Thus it is + # incorrect to simply use the first fitting match. However, to implement + # this correctly is inefficient. We have to copy `m` here to be able to + # roll back the side effects of the unification algorithm. + let c = m.c + var + x = newCandidate(c, m.callee) # potential "best" + y = newCandidate(c, m.callee) # potential competitor with x + z = newCandidate(c, m.callee) # buffer for copies of m + x.calleeSym = m.calleeSym + y.calleeSym = m.calleeSym + z.calleeSym = m.calleeSym + + for i in 0..<arg.len: + if arg[i].sym.kind in matchSet: + copyCandidate(z, m) + z.callee = arg[i].typ + if arg[i].sym.kind == skType and z.callee.kind != tyTypeDesc: + # creating the symchoice with the type sym having typedesc type + # breaks a lot of stuff, so we make the typedesc type here + # mirrored from `newSymNodeTypeDesc` + z.callee = newType(tyTypeDesc, c.idgen, arg[i].sym.owner) + z.callee.addSonSkipIntLit(arg[i].sym.typ, c.idgen) + if tfUnresolved in z.callee.flags: continue + z.calleeSym = arg[i].sym + z.calleeScope = cmpScopes(m.c, arg[i].sym) + # XXX this is still all wrong: (T, T) should be 2 generic matches + # and (int, int) 2 exact matches, etc. Essentially you cannot call + # typeRel here and expect things to work! + let r = staticAwareTypeRel(z, f, arg[i]) + incMatches(z, r, 2) + if r != isNone: + z.state = csMatch + case x.state + of csEmpty, csNoMatch: + x = z + best = i + of csMatch: + let cmp = cmpCandidates(x, z, isFormal=false) + if cmp < 0: + best = i + x = z + elif cmp == 0: + y = z # z is as good as x + + if x.state == csEmpty: + result = nil + elif y.state == csMatch and cmpCandidates(x, y, isFormal=false) == 0: + if x.state != csMatch: + internalError(m.c.graph.config, arg.info, "x.state is not csMatch") + result = nil + if best > -1 and result != nil: # only one valid interpretation found: markUsed(m.c, arg.info, arg[best].sym) onUse(arg.info, arg[best].sym) @@ -2266,21 +2715,27 @@ proc setSon(father: PNode, at: int, son: PNode) = # we are allowed to modify the calling node in the 'prepare*' procs: proc prepareOperand(c: PContext; formal: PType; a: PNode): PNode = if formal.kind == tyUntyped and formal.len != 1: - # {tyTypeDesc, tyUntyped, tyTyped, tyProxy}: + # {tyTypeDesc, tyUntyped, tyTyped, tyError}: # a.typ == nil is valid result = a elif a.typ.isNil: - # XXX This is unsound! 'formal' can differ from overloaded routine to - # overloaded routine! - let flags = {efDetermineType, efAllowStmt} - #if formal.kind == tyIter: {efDetermineType, efWantIterator} - #else: {efDetermineType, efAllowStmt} - #elif formal.kind == tyTyped: {efDetermineType, efWantStmt} - #else: {efDetermineType} - result = c.semOperand(c, a, flags) + if formal.kind == tyIterable: + let flags = {efDetermineType, efAllowStmt, efWantIterator, efWantIterable} + result = c.semOperand(c, a, flags) + else: + # XXX This is unsound! 'formal' can differ from overloaded routine to + # overloaded routine! + let flags = {efDetermineType, efAllowStmt} + #if formal.kind == tyIterable: {efDetermineType, efWantIterator} + #else: {efDetermineType, efAllowStmt} + #elif formal.kind == tyTyped: {efDetermineType, efWantStmt} + #else: {efDetermineType} + result = c.semOperand(c, a, flags) else: result = a considerGenSyms(c, result) + if result.kind != nkHiddenDeref and result.typ.kind in {tyVar, tyLent} and c.matchedConcept == nil: + result = newDeref(result) proc prepareOperand(c: PContext; a: PNode): PNode = if a.typ.isNil: @@ -2298,7 +2753,7 @@ proc arrayConstr(c: PContext, n: PNode): PType = result = newTypeS(tyArray, c) rawAddSon(result, makeRangeType(c, 0, 0, n.info)) addSonSkipIntLit(result, skipTypes(n.typ, - {tyGenericInst, tyVar, tyLent, tyOrdinal}), c.idgen) + {tyVar, tyLent, tyOrdinal}), c.idgen) proc arrayConstr(c: PContext, info: TLineInfo): PType = result = newTypeS(tyArray, c) @@ -2307,11 +2762,27 @@ proc arrayConstr(c: PContext, info: TLineInfo): PType = proc incrIndexType(t: PType) = assert t.kind == tyArray - inc t[0].n[1].intVal + inc t.indexType.n[1].intVal template isVarargsUntyped(x): untyped = x.kind == tyVarargs and x[0].kind == tyUntyped +template isVarargsTyped(x): untyped = + x.kind == tyVarargs and x[0].kind == tyTyped + +proc findFirstArgBlock(m: var TCandidate, n: PNode): int = + # see https://github.com/nim-lang/RFCs/issues/405 + result = int.high + for a2 in countdown(n.len-1, 0): + # checking `nfBlockArg in n[a2].flags` wouldn't work inside templates + if n[a2].kind != nkStmtList: break + let formalLast = m.callee.n[m.callee.n.len - (n.len - a2)] + # parameter has to occupy space (no default value, not void or varargs) + if formalLast.kind == nkSym and formalLast.sym.ast == nil and + formalLast.sym.typ.kind notin {tyVoid, tyVarargs}: + result = a2 + else: break + proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var IntSet) = template noMatch() = @@ -2322,7 +2793,7 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int return template checkConstraint(n: untyped) {.dirty.} = - if not formal.constraint.isNil: + if not formal.constraint.isNil and sfCodegenDecl notin formal.flags: if matchNodeKinds(formal.constraint, n): # better match over other routines with no such restriction: inc(m.genericMatches, 100) @@ -2335,7 +2806,7 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int if argConverter.typ.kind notin {tyVar}: m.firstMismatch.kind = kVarNeeded noMatch() - elif not n.isLValue: + elif not (isLValue(c, n, isOutParam(formal.typ))): m.firstMismatch.kind = kVarNeeded noMatch() @@ -2348,11 +2819,11 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int a = 1 # iterates over the actual given arguments f = if m.callee.kind != tyGenericBody: 1 else: 0 # iterates over formal parameters - arg: PNode # current prepared argument + arg: PNode = nil # current prepared argument formalLen = m.callee.n.len formal = if formalLen > 1: m.callee.n[1].sym else: nil # current routine parameter container: PNode = nil # constructed container - + let firstArgBlock = findFirstArgBlock(m, n) while a < n.len: c.openShadowScope @@ -2421,7 +2892,7 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int n[a] = prepareOperand(c, n[a]) if skipTypes(n[a].typ, abstractVar-{tyTypeDesc}).kind==tyString: m.call.add implicitConv(nkHiddenStdConv, - getSysType(c.graph, n[a].info, tyCString), + getSysType(c.graph, n[a].info, tyCstring), copyTree(n[a]), m, c) else: m.call.add copyTree(n[a]) @@ -2448,6 +2919,8 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int if m.callee.n[f].kind != nkSym: internalError(c.config, n[a].info, "matches") noMatch() + if flexibleOptionalParams in c.features and a >= firstArgBlock: + f = max(f, m.callee.n.len - (n.len - a)) formal = m.callee.n[f].sym m.firstMismatch.kind = kTypeMismatch if containsOrIncl(marker, formal.position) and container.isNil: @@ -2471,7 +2944,15 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int n[a], nOrig[a]) if arg == nil: noMatch() - if m.baseTypeMatch: + if formal.typ.isVarargsTyped and m.calleeSym.kind in {skTemplate, skMacro}: + if container.isNil: + container = newNodeIT(nkBracket, n[a].info, arrayConstr(c, n.info)) + setSon(m.call, formal.position + 1, implicitConv(nkHiddenStdConv, formal.typ, container, m, c)) + else: + incrIndexType(container.typ) + container.add n[a] + f = max(f, formalLen - n.len + a + 1) + elif m.baseTypeMatch: assert formal.typ.kind == tyVarargs #assert(container == nil) if container.isNil: @@ -2511,12 +2992,6 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m: var TCandidate, marker: var Int m.firstMismatch.arg = a m.firstMismatch.formal = formal -proc semFinishOperands*(c: PContext, n: PNode) = - # this needs to be called to ensure that after overloading resolution every - # argument has been sem'checked: - for i in 1..<n.len: - n[i] = prepareOperand(c, n[i]) - proc partialMatch*(c: PContext, n, nOrig: PNode, m: var TCandidate) = # for 'suggest' support: var marker = initIntSet() @@ -2532,6 +3007,8 @@ proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = inc m.genericMatches inc m.exactMatches return + # initCandidate may have given csNoMatch if generic params didn't match: + if m.state == csNoMatch: return var marker = initIntSet() matchesAux(c, n, nOrig, m, marker) if m.state == csNoMatch: return @@ -2554,14 +3031,16 @@ proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = m.firstMismatch.formal = formal break else: + # mirrored with updateDefaultParams: if formal.ast.kind == nkEmpty: # The default param value is set to empty in `instantiateProcType` # when the type of the default expression doesn't match the type # of the instantiated proc param: - localError(c.config, m.call.info, - ("The default parameter '$1' has incompatible type " & - "with the explicitly requested proc instantiation") % - formal.name.s) + pushInfoContext(c.config, m.call.info, + if m.calleeSym != nil: m.calleeSym.detailedInfo else: "") + typeMismatch(c.config, formal.ast.info, formal.typ, formal.ast.typ, formal.ast) + popInfoContext(c.config) + formal.ast.typ = errorType(c) if nfDefaultRefsParam in formal.ast.flags: m.call.flags.incl nfDefaultRefsParam var defaultValue = copyTree(formal.ast) @@ -2570,7 +3049,7 @@ proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = # proc foo(x: T = 0.0) # foo() if {tfImplicitTypeParam, tfGenericTypeParam} * formal.typ.flags != {}: - let existing = PType(idTableGet(m.bindings, formal.typ)) + let existing = idTableGet(m.bindings, formal.typ) if existing == nil or existing.kind == tyTypeDesc: # see bug #11600: put(m, formal.typ, defaultValue.typ) @@ -2579,7 +3058,7 @@ proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = # forget all inferred types if the overload matching failed if m.state == csNoMatch: for t in m.inferredTypes: - if t.len > 1: t.sons.setLen 1 + if t.len > 1: t.newSons 1 proc argtypeMatches*(c: PContext, f, a: PType, fromHlo = false): bool = var m = newCandidate(c, f) @@ -2593,11 +3072,9 @@ proc argtypeMatches*(c: PContext, f, a: PType, fromHlo = false): bool = # pattern templates do not allow for conversions except from int literal res != nil and m.convMatches == 0 and m.intConvMatches in [0, 256] -when not defined(nimHasSinkInference): - {.pragma: nosinks.} proc instTypeBoundOp*(c: PContext; dc: PSym; t: PType; info: TLineInfo; - op: TTypeAttachedOp; col: int): PSym {.nosinks.} = + op: TTypeAttachedOp; col: int): PSym = var m = newCandidate(c, dc.typ) if col >= dc.typ.len: localError(c.config, info, "cannot instantiate: '" & dc.name.s & "'") @@ -2605,10 +3082,11 @@ proc instTypeBoundOp*(c: PContext; dc: PSym; t: PType; info: TLineInfo; var f = dc.typ[col] if op == attachedDeepCopy: - if f.kind in {tyRef, tyPtr}: f = f.lastSon + if f.kind in {tyRef, tyPtr}: f = f.elementType else: - if f.kind in {tyVar}: f = f.lastSon + if f.kind in {tyVar}: f = f.elementType if typeRel(m, f, t) == isNone: + result = nil localError(c.config, info, "cannot instantiate: '" & dc.name.s & "'") else: result = c.semGenerateInstance(c, dc, m.bindings, info) diff --git a/compiler/sinkparameter_inference.nim b/compiler/sinkparameter_inference.nim index fa9f2b445..09d54ec79 100644 --- a/compiler/sinkparameter_inference.nim +++ b/compiler/sinkparameter_inference.nim @@ -19,7 +19,6 @@ proc checkForSink*(config: ConfigRef; idgen: IdGenerator; owner: PSym; arg: PNod var local = p # sink parameter? passToSink(local) ]# - if optSinkInference notin config.options: return case arg.kind of nkSym: if arg.sym.kind == skParam and @@ -32,7 +31,7 @@ proc checkForSink*(config: ConfigRef; idgen: IdGenerator; owner: PSym; arg: PNod if sfWasForwarded notin owner.flags: let argType = arg.sym.typ - let sinkType = newType(tySink, nextTypeId(idgen), owner) + let sinkType = newType(tySink, idgen, owner) sinkType.size = argType.size sinkType.align = argType.align sinkType.paddingAtEnd = argType.paddingAtEnd diff --git a/compiler/sizealignoffsetimpl.nim b/compiler/sizealignoffsetimpl.nim index b50777c9e..1dd481ec0 100644 --- a/compiler/sizealignoffsetimpl.nim +++ b/compiler/sizealignoffsetimpl.nim @@ -12,7 +12,7 @@ proc align(address, alignment: BiggestInt): BiggestInt = result = (address + (alignment - 1)) and not (alignment - 1) -proc align(address, alignment: int): int = +proc align(address, alignment: int32): int32 = result = (address + (alignment - 1)) and not (alignment - 1) const @@ -29,26 +29,26 @@ proc raiseIllegalTypeRecursion() = raise newException(IllegalTypeRecursionError, "illegal type recursion") type - OffsetAccum = object - maxAlign: int - offset: int + OffsetAccum* = object + maxAlign*: int32 + offset*: int32 -proc inc(arg: var OffsetAccum; value: int) = +proc inc*(arg: var OffsetAccum; value: int32) = if unlikely(value == szIllegalRecursion): raiseIllegalTypeRecursion() if value == szUnknownSize or arg.offset == szUnknownSize: arg.offset = szUnknownSize else: arg.offset += value -proc alignmentMax(a,b: int): int = +proc alignmentMax(a, b: int32): int32 = if unlikely(a == szIllegalRecursion or b == szIllegalRecursion): raiseIllegalTypeRecursion() if a == szUnknownSize or b == szUnknownSize: szUnknownSize else: - max(a,b) + max(a, b) -proc align(arg: var OffsetAccum; value: int) = - if unlikely(value == szIllegalRecursion): raiseIllegalTypeRecursion() +proc align*(arg: var OffsetAccum; value: int32) = + if unlikely(value == szIllegalRecursion): raiseIllegalTypeRecursion() if value == szUnknownSize or arg.maxAlign == szUnknownSize or arg.offset == szUnknownSize: arg.maxAlign = szUnknownSize arg.offset = szUnknownSize @@ -65,7 +65,7 @@ proc mergeBranch(arg: var OffsetAccum; value: OffsetAccum) = arg.offset = max(arg.offset, value.offset) arg.maxAlign = max(arg.maxAlign, value.maxAlign) -proc finish(arg: var OffsetAccum): int = +proc finish(arg: var OffsetAccum): int32 = if arg.maxAlign == szUnknownSize or arg.offset == szUnknownSize: result = szUnknownSize arg.offset = szUnknownSize @@ -73,7 +73,7 @@ proc finish(arg: var OffsetAccum): int = result = align(arg.offset, arg.maxAlign) - arg.offset arg.offset += result -proc computeSizeAlign(conf: ConfigRef; typ: PType) +proc computeSizeAlign*(conf: ConfigRef; typ: PType) proc computeSubObjectAlign(conf: ConfigRef; n: PNode): BiggestInt = ## returns object alignment @@ -112,7 +112,7 @@ proc setOffsetsToUnknown(n: PNode) = for i in 0..<n.safeLen: setOffsetsToUnknown(n[i]) -proc computeObjectOffsetsFoldFunction(conf: ConfigRef; n: PNode, packed: bool, accum: var OffsetAccum) = +proc computeObjectOffsetsFoldFunction(conf: ConfigRef; n: PNode; packed: bool; accum: var OffsetAccum) = ## ``offset`` is the offset within the object, after the node has been written, no padding bytes added ## ``align`` maximum alignment from all sub nodes assert n != nil @@ -122,20 +122,20 @@ proc computeObjectOffsetsFoldFunction(conf: ConfigRef; n: PNode, packed: bool, a of nkRecCase: assert(n[0].kind == nkSym) computeObjectOffsetsFoldFunction(conf, n[0], packed, accum) - var maxChildAlign: int = if accum.offset == szUnknownSize: szUnknownSize else: 1 + var maxChildAlign = if accum.offset == szUnknownSize: szUnknownSize.int32 else: 1'i32 if not packed: for i in 1..<n.len: let child = n[i] case child.kind of nkOfBranch, nkElse: # offset parameter cannot be known yet, it needs to know the alignment first - let align = int(computeSubObjectAlign(conf, n[i].lastSon)) + let align = int32(computeSubObjectAlign(conf, n[i].lastSon)) maxChildAlign = alignmentMax(maxChildAlign, align) else: internalError(conf, "computeObjectOffsetsFoldFunction(record case branch)") if maxChildAlign == szUnknownSize: setOffsetsToUnknown(n) - accum.offset = szUnknownSize + accum.offset = szUnknownSize accum.maxAlign = szUnknownSize else: # the union needs to be aligned first, before the offsets can be assigned @@ -150,15 +150,15 @@ proc computeObjectOffsetsFoldFunction(conf: ConfigRef; n: PNode, packed: bool, a for i, child in n.sons: computeObjectOffsetsFoldFunction(conf, child, packed, accum) of nkSym: - var size = szUnknownSize - var align = szUnknownSize + var size = szUnknownSize.int32 + var align = szUnknownSize.int32 if n.sym.bitsize == 0: # 0 represents bitsize not set computeSizeAlign(conf, n.sym.typ) - size = n.sym.typ.size.int - align = if packed: 1 else: n.sym.typ.align.int + size = n.sym.typ.size.int32 + align = if packed: 1 else: n.sym.typ.align.int32 accum.align(align) if n.sym.alignment > 0: - accum.align(n.sym.alignment) + accum.align(n.sym.alignment.int32) n.sym.offset = accum.offset accum.inc(size) else: @@ -180,15 +180,15 @@ proc computeUnionObjectOffsetsFoldFunction(conf: ConfigRef; n: PNode; packed: bo discard finish(branchAccum) accum.mergeBranch(branchAccum) of nkSym: - var size = szUnknownSize - var align = szUnknownSize + var size = szUnknownSize.int32 + var align = szUnknownSize.int32 if n.sym.bitsize == 0: # 0 represents bitsize not set computeSizeAlign(conf, n.sym.typ) - size = n.sym.typ.size.int - align = if packed: 1 else: n.sym.typ.align.int + size = n.sym.typ.size.int32 + align = if packed: 1 else: n.sym.typ.align.int32 accum.align(align) if n.sym.alignment > 0: - accum.align(n.sym.alignment) + accum.align(n.sym.alignment.int32) n.sym.offset = accum.offset accum.inc(size) else: @@ -196,6 +196,11 @@ proc computeUnionObjectOffsetsFoldFunction(conf: ConfigRef; n: PNode; packed: bo accum.offset = szUnknownSize proc computeSizeAlign(conf: ConfigRef; typ: PType) = + template setSize(typ, s) = + typ.size = s + typ.align = s + typ.paddingAtEnd = 0 + ## computes and sets ``size`` and ``align`` members of ``typ`` assert typ != nil let hasSize = typ.size != szUncomputedSize @@ -242,8 +247,8 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = else: typ.size = conf.target.ptrSize typ.align = int16(conf.target.ptrSize) - of tyCString, tySequence, tyPtr, tyRef, tyVar, tyLent: - let base = typ.lastSon + of tyCstring, tySequence, tyPtr, tyRef, tyVar, tyLent: + let base = typ.last if base == typ: # this is not the correct location to detect ``type A = ptr A`` typ.size = szIllegalRecursion @@ -257,21 +262,21 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = typ.size = conf.target.ptrSize of tyArray: - computeSizeAlign(conf, typ[1]) - let elemSize = typ[1].size - let len = lengthOrd(conf, typ[0]) + computeSizeAlign(conf, typ.elementType) + let elemSize = typ.elementType.size + let len = lengthOrd(conf, typ.indexType) if elemSize < 0: typ.size = elemSize typ.align = int16(elemSize) 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 + typ.align = typ.elementType.align of tyUncheckedArray: - let base = typ.lastSon + let base = typ.last computeSizeAlign(conf, base) typ.size = 0 typ.align = base.align @@ -295,11 +300,11 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = typ.size = 8 typ.align = int16(conf.floatInt64Align) of tySet: - if typ[0].kind == tyGenericParam: + if typ.elementType.kind == tyGenericParam: typ.size = szUncomputedSize typ.align = szUncomputedSize else: - let length = toInt64(lengthOrd(conf, typ[0])) + let length = toInt64(lengthOrd(conf, typ.elementType)) if length <= 8: typ.size = 1 typ.align = 1 @@ -314,27 +319,26 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = typ.align = int16(conf.floatInt64Align) elif align(length, 8) mod 8 == 0: typ.size = align(length, 8) div 8 - typ.align = int16(conf.floatInt64Align) + typ.align = 1 else: typ.size = align(length, 8) div 8 + 1 - typ.align = int16(conf.floatInt64Align) + typ.align = 1 of tyRange: - computeSizeAlign(conf, typ[0]) - typ.size = typ[0].size - typ.align = typ[0].align - typ.paddingAtEnd = typ[0].paddingAtEnd + computeSizeAlign(conf, typ.elementType) + typ.size = typ.elementType.size + typ.align = typ.elementType.align + typ.paddingAtEnd = typ.elementType.paddingAtEnd of tyTuple: try: var accum = OffsetAccum(maxAlign: 1) - for i in 0..<typ.len: - let child = typ[i] + for i, child in typ.ikids: computeSizeAlign(conf, child) accum.align(child.align) if typ.n != nil: # is named tuple (has field symbols)? let sym = typ.n[i].sym sym.offset = accum.offset - accum.inc(int(child.size)) + accum.inc(int32(child.size)) typ.paddingAtEnd = int16(accum.finish()) typ.size = if accum.offset == 0: 1 else: accum.offset typ.align = int16(accum.maxAlign) @@ -346,27 +350,27 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = of tyObject: try: var accum = - if typ[0] != nil: + if typ.baseClass != nil: # compute header size - var st = typ[0] + var st = typ.baseClass while st.kind in skipPtrs: - st = st[^1] + st = st.skipModifier computeSizeAlign(conf, st) if conf.backend == backendCpp: OffsetAccum( - offset: int(st.size) - int(st.paddingAtEnd), + offset: int32(st.size) - int32(st.paddingAtEnd), maxAlign: st.align ) else: OffsetAccum( - offset: int(st.size), + offset: int32(st.size), maxAlign: st.align ) elif isObjectWithTypeFieldPredicate(typ): # this branch is taken for RootObj OffsetAccum( - offset: conf.target.intSize, - maxAlign: conf.target.intSize + offset: conf.target.intSize.int32, + maxAlign: conf.target.intSize.int32 ) else: OffsetAccum(maxAlign: 1) @@ -375,14 +379,19 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = let info = if typ.sym != nil: typ.sym.info else: unknownLineInfo localError(conf, info, "union type may not have an object header") accum = OffsetAccum(offset: szUnknownSize, maxAlign: szUnknownSize) - elif tfPacked in typ.flags: - computeUnionObjectOffsetsFoldFunction(conf, typ.n, true, accum) else: - computeUnionObjectOffsetsFoldFunction(conf, typ.n, false, accum) + computeUnionObjectOffsetsFoldFunction(conf, typ.n, tfPacked in typ.flags, accum) elif tfPacked in typ.flags: accum.maxAlign = 1 computeObjectOffsetsFoldFunction(conf, typ.n, true, accum) else: + if typ.baseClass == nil and lacksMTypeField(typ) and typ.n.len == 1 and + typ.n[0].kind == nkSym and + typ.n[0].sym.typ.skipTypes(abstractInst).kind == tyUncheckedArray: + # a dummy field is generated for an object with a single field + # with an UncheckedArray type + assert accum.offset == 0 + accum.offset = 1 computeObjectOffsetsFoldFunction(conf, typ.n, false, accum) let paddingAtEnd = int16(accum.finish()) if typ.sym != nil and @@ -400,24 +409,24 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = typ.align = szIllegalRecursion typ.paddingAtEnd = szIllegalRecursion of tyInferred: - if typ.len > 1: - computeSizeAlign(conf, typ.lastSon) - typ.size = typ.lastSon.size - typ.align = typ.lastSon.align - typ.paddingAtEnd = typ.lastSon.paddingAtEnd + if typ.hasElementType: + computeSizeAlign(conf, typ.last) + typ.size = typ.last.size + typ.align = typ.last.align + typ.paddingAtEnd = typ.last.paddingAtEnd of tyGenericInst, tyDistinct, tyGenericBody, tyAlias, tySink, tyOwned: - computeSizeAlign(conf, typ.lastSon) - typ.size = typ.lastSon.size - typ.align = typ.lastSon.align - typ.paddingAtEnd = typ.lastSon.paddingAtEnd + computeSizeAlign(conf, typ.skipModifier) + typ.size = typ.skipModifier.size + typ.align = typ.skipModifier.align + typ.paddingAtEnd = typ.last.paddingAtEnd of tyTypeClasses: if typ.isResolvedUserTypeClass: - computeSizeAlign(conf, typ.lastSon) - typ.size = typ.lastSon.size - typ.align = typ.lastSon.align - typ.paddingAtEnd = typ.lastSon.paddingAtEnd + computeSizeAlign(conf, typ.last) + typ.size = typ.last.size + typ.align = typ.last.align + typ.paddingAtEnd = typ.last.paddingAtEnd else: typ.size = szUnknownSize typ.align = szUnknownSize @@ -430,21 +439,30 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = typ.paddingAtEnd = typ.base.paddingAtEnd of tyForward: - # is this really illegal recursion, or maybe just unknown? - typ.size = szIllegalRecursion - typ.align = szIllegalRecursion - typ.paddingAtEnd = szIllegalRecursion + typ.size = szUnknownSize + typ.align = szUnknownSize + typ.paddingAtEnd = szUnknownSize of tyStatic: if typ.n != nil: - computeSizeAlign(conf, typ.lastSon) - typ.size = typ.lastSon.size - typ.align = typ.lastSon.align - typ.paddingAtEnd = typ.lastSon.paddingAtEnd + computeSizeAlign(conf, typ.last) + typ.size = typ.last.size + typ.align = typ.last.align + typ.paddingAtEnd = typ.last.paddingAtEnd else: typ.size = szUnknownSize typ.align = szUnknownSize typ.paddingAtEnd = szUnknownSize + of tyInt, tyUInt: + setSize typ, conf.target.intSize.int16 + of tyBool, tyChar, tyUInt8, tyInt8: + setSize typ, 1 + of tyInt16, tyUInt16: + setSize typ, 2 + of tyInt32, tyUInt32, tyFloat32: + setSize typ, 4 + of tyInt64, tyUInt64, tyFloat64, tyFloat: + setSize typ, 8 else: typ.size = szUnknownSize typ.align = szUnknownSize @@ -482,7 +500,7 @@ template foldOffsetOf*(conf: ConfigRef; n: PNode; fallback: PNode): PNode = ## Returns an int literal node of the given offsetof expression in `n`. ## Falls back to `fallback`, if the `offsetof` expression can't be processed. let config = conf - let node : PNode = n + let node = n var dotExpr: PNode block findDotExpr: if node[1].kind == nkDotExpr: @@ -490,6 +508,7 @@ template foldOffsetOf*(conf: ConfigRef; n: PNode; fallback: PNode): PNode = elif node[1].kind == nkCheckedFieldExpr: dotExpr = node[1][0] else: + dotExpr = nil localError(config, node.info, "can't compute offsetof on this ast") assert dotExpr != nil diff --git a/compiler/sourcemap.nim b/compiler/sourcemap.nim index 2ec40227b..1395168cd 100644 --- a/compiler/sourcemap.nim +++ b/compiler/sourcemap.nim @@ -1,383 +1,206 @@ -import os, strformat, strutils, tables, sets, ropes, json, algorithm +import std/[strutils, strscans, parseutils, assertions] type - SourceNode* = ref object - line*: int - column*: int - source*: string - name*: string - children*: seq[Child] - - C = enum cSourceNode, cString - - Child* = ref object - case kind*: C: - of cSourceNode: - node*: SourceNode - of cString: - s*: string - - SourceMap* = ref object + Segment = object + ## Segment refers to a block of something in the JS output. + ## This could be a token or an entire line + original: int # Column in the Nim source + generated: int # Column in the generated JS + name: int # Index into names list (-1 for no name) + + Mapping = object + ## Mapping refers to a line in the JS output. + ## It is made up of segments which refer to the tokens in the line + case inSource: bool # Whether the line in JS has Nim equivalent + of true: + file: int # Index into files list + line: int # 0 indexed line of code in the Nim source + segments: seq[Segment] + else: discard + + SourceInfo = object + mappings: seq[Mapping] + names, files: seq[string] + + SourceMap* = object version*: int sources*: seq[string] names*: seq[string] mappings*: string file*: string - # sourceRoot*: string - # sourcesContent*: string - - SourceMapGenerator = ref object - file: string - sourceRoot: string - skipValidation: bool - sources: seq[string] - names: seq[string] - mappings: seq[Mapping] - - Mapping* = ref object - source*: string - original*: tuple[line: int, column: int] - generated*: tuple[line: int, column: int] - name*: string - noSource*: bool - noName*: bool - - -proc child*(s: string): Child = - Child(kind: cString, s: s) - - -proc child*(node: SourceNode): Child = - Child(kind: cSourceNode, node: node) - -proc newSourceNode(line: int, column: int, path: string, node: SourceNode, name: string = ""): SourceNode = - SourceNode(line: line, column: column, source: path, name: name, children: @[child(node)]) - - -proc newSourceNode(line: int, column: int, path: string, s: string, name: string = ""): SourceNode = - SourceNode(line: line, column: column, source: path, name: name, children: @[child(s)]) - - -proc newSourceNode(line: int, column: int, path: string, children: seq[Child], name: string = ""): SourceNode = - SourceNode(line: line, column: column, source: path, name: name, children: children) - - - - -# debugging - - -proc text*(sourceNode: SourceNode, depth: int): string = - let empty = " " - result = &"{repeat(empty, depth)}SourceNode({sourceNode.source}:{sourceNode.line}:{sourceNode.column}):\n" - for child in sourceNode.children: - if child.kind == cString: - result.add(&"{repeat(empty, depth + 1)}{child.s}\n") - else: - result.add(child.node.text(depth + 1)) - - -proc `$`*(sourceNode: SourceNode): string = text(sourceNode, 0) +func addSegment(info: var SourceInfo, original, generated: int, name: string = "") {.raises: [].} = + ## Adds a new segment into the current line + assert info.mappings.len > 0, "No lines have been added yet" + var segment = Segment(original: original, generated: generated, name: -1) + if name != "": + # Make name be index into names list + segment.name = info.names.find(name) + if segment.name == -1: + segment.name = info.names.len + info.names &= name + + assert info.mappings[^1].inSource, "Current line isn't in Nim source" + info.mappings[^1].segments &= segment + +func newLine(info: var SourceInfo) {.raises: [].} = + ## Add new mapping which doesn't appear in the Nim source + info.mappings &= Mapping(inSource: false) + +func newLine(info: var SourceInfo, file: string, line: int) {.raises: [].} = + ## Starts a new line in the mappings. Call addSegment after this to add + ## segments into the line + var mapping = Mapping(inSource: true, line: line) + # Set file to file position. Add in if needed + mapping.file = info.files.find(file) + if mapping.file == -1: + mapping.file = info.files.len + info.files &= file + info.mappings &= mapping # base64_VLQ - - -let integers = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=" - - -proc encode*(i: int): string = +func encode*(values: seq[int]): string {.raises: [].} = + ## Encodes a series of integers into a VLQ base64 encoded string + # References: + # - https://www.lucidchart.com/techblog/2019/08/22/decode-encoding-base64-vlqs-source-maps/ + # - https://github.com/rails/sprockets/blob/main/guides/source_maps.md#source-map-file + const + alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" + shift = 5 + continueBit = 1 shl 5 + mask = continueBit - 1 result = "" - var n = i - if n < 0: - n = (-n shl 1) or 1 - else: - n = n shl 1 - - var z = 0 - while z == 0 or n > 0: - var e = n and 31 - n = n shr 5 - if n > 0: - e = e or 32 - - result.add(integers[e]) - z += 1 - - -type TokenState = enum Normal, String, Ident, Mangled - -iterator tokenize*(line: string): (bool, string) = - # result = @[] - var state = Normal - var token = "" - var isMangled = false - for z, ch in line: - if ch.isAlphaAscii: - if state == Normal: - state = Ident - if token.len > 0: - yield (isMangled, token) - token = $ch - isMangled = false - else: - token.add(ch) - elif ch == '_': - if state == Ident: - state = Mangled - isMangled = true - token.add($ch) - elif ch != '"' and not ch.isAlphaNumeric: - if state in {Ident, Mangled}: - state = Normal - if token.len > 0: - yield (isMangled, token) - token = $ch - isMangled = false - else: - token.add($ch) - elif ch == '"': - if state != String: - state = String - if token.len > 0: - yield (isMangled, token) - token = $ch - isMangled = false - else: - state = Normal - token.add($ch) - if token.len > 0: - yield (isMangled, token) - isMangled = false - token = "" + for val in values: + # Sign is stored in first bit + var newVal = abs(val) shl 1 + if val < 0: + newVal = newVal or 1 + # Now comes the variable length part + # This is how we are able to store large numbers + while true: + # We only encode 5 bits. + var masked = newVal and mask + newVal = newVal shr shift + # If there is still something left + # then signify with the continue bit that the + # decoder should keep decoding + if newVal > 0: + masked = masked or continueBit + result &= alphabet[masked] + # If the value is zero then we have nothing left to encode + if newVal == 0: + break + +iterator tokenize*(line: string): (int, string) = + ## Goes through a line and splits it into Nim identifiers and + ## normal JS code. This allows us to map mangled names back to Nim names. + ## Yields (column, name). Doesn't yield anything but identifiers. + ## See mangleName in compiler/jsgen.nim for how name mangling is done + var + col = 0 + token = "" + while col < line.len: + var + token: string = "" + name: string = "" + # First we find the next identifier + col += line.skipWhitespace(col) + col += line.skipUntil(IdentStartChars, col) + let identStart = col + col += line.parseIdent(token, col) + # Idents will either be originalName_randomInt or HEXhexCode_randomInt + if token.startsWith("HEX"): + var hex: int = 0 + # 3 = "HEX".len and we only want to parse the two integers after it + discard token[3 ..< 5].parseHex(hex) + name = $chr(hex) + elif not token.endsWith("_Idx"): # Ignore address indexes + # It might be in the form originalName_randomInt + let lastUnderscore = token.rfind('_') + if lastUnderscore != -1: + name = token[0..<lastUnderscore] + if name != "": + yield (identStart, name) + +func parse*(source: string): SourceInfo = + ## Parses the JS output for embedded line info + ## So it can convert those into a series of mappings + result = default(SourceInfo) + var + skipFirstLine = true + currColumn = 0 + currLine = 0 + currFile = "" + # Add each line as a node into the output + for line in source.splitLines(): + var + lineNumber: int = 0 + linePath: string = "" + column: int = 0 + if line.strip().scanf("/* line $i:$i \"$+\" */", lineNumber, column, linePath): + # When we reach the first line mappinsegmentg then we can assume + # we can map the rest of the JS lines to Nim lines + currColumn = column # Column is already zero indexed + currLine = lineNumber - 1 + currFile = linePath + # Lines are zero indexed + result.newLine(currFile, currLine) + # Skip whitespace to find the starting column + result.addSegment(currColumn, line.skipWhitespace()) + elif currFile != "": + result.newLine(currFile, currLine) + # There mightn't be any tokens so add a starting segment + result.addSegment(currColumn, line.skipWhitespace()) + for jsColumn, token in line.tokenize: + result.addSegment(currColumn, jsColumn, token) else: - token.add($ch) - if token.len > 0: - yield (isMangled, token) - -proc parse*(source: string, path: string): SourceNode = - let lines = source.splitLines() - var lastLocation: SourceNode = nil - result = newSourceNode(0, 0, path, @[]) - - # we just use one single parent and add all nim lines - # as its children, I guess in typical codegen - # that happens recursively on ast level - # we also don't have column info, but I doubt more one nim lines can compile to one js - # maybe in macros? - - for i, originalLine in lines: - let line = originalLine.strip - if line.len == 0: - continue - - # this shouldn't be a problem: - # jsgen doesn't generate comments - # and if you emit // line you probably know what you're doing - if line.startsWith("// line"): - if result.children.len > 0: - result.children[^1].node.children.add(child(line & "\n")) - let pos = line.find(" ", 8) - let lineNumber = line[8 .. pos - 1].parseInt - let linePath = line[pos + 2 .. ^2] # quotes - - lastLocation = newSourceNode( - lineNumber, - 0, - linePath, - @[]) - result.children.add(child(lastLocation)) - else: - var last: SourceNode - for token in line.tokenize(): - var name = "" - if token[0]: - name = token[1].split('_', 1)[0] - - - if result.children.len > 0: - result.children[^1].node.children.add( - child( - newSourceNode( - result.children[^1].node.line, - 0, - result.children[^1].node.source, - token[1], - name))) - last = result.children[^1].node.children[^1].node - else: - result.children.add( - child( - newSourceNode(i + 1, 0, path, token[1], name))) - last = result.children[^1].node - let nl = "\n" - if not last.isNil: - last.source.add(nl) - -proc cmp(a: Mapping, b: Mapping): int = - var c = cmp(a.generated, b.generated) - if c != 0: - return c - - c = cmp(a.source, b.source) - if c != 0: - return c - - c = cmp(a.original, b.original) - if c != 0: - return c - - return cmp(a.name, b.name) - - -proc index*[T](elements: seq[T], element: T): int = - for z in 0 ..< elements.len: - if elements[z] == element: - return z - return -1 - - -proc serializeMappings(map: SourceMapGenerator, mappings: seq[Mapping]): string = - var previous = Mapping(generated: (line: 1, column: 0), original: (line: 0, column: 0), name: "", source: "") - var previousSourceId = 0 - var previousNameId = 0 - var next = "" - var nameId = 0 - var sourceId = 0 - result = "" - - for z, mapping in mappings: - next = "" - - if mapping.generated.line != previous.generated.line: - previous.generated.column = 0 - - while mapping.generated.line != previous.generated.line: - next.add(";") - previous.generated.line += 1 - - else: - if z > 0: - if cmp(mapping, mappings[z - 1]) == 0: - continue - next.add(",") - - next.add(encode(mapping.generated.column - previous.generated.column)) - previous.generated.column = mapping.generated.column - - if not mapping.noSource and mapping.source.len > 0: - sourceId = map.sources.index(mapping.source) - next.add(encode(sourceId - previousSourceId)) - previousSourceId = sourceId - next.add(encode(mapping.original.line - 1 - previous.original.line)) - previous.original.line = mapping.original.line - 1 - next.add(encode(mapping.original.column - previous.original.column)) - previous.original.column = mapping.original.column - - if not mapping.noName and mapping.name.len > 0: - nameId = map.names.index(mapping.name) - next.add(encode(nameId - previousNameId)) - previousNameId = nameId - - result.add(next) - - -proc gen*(map: SourceMapGenerator): SourceMap = - var mappings = map.mappings.sorted do (a: Mapping, b: Mapping) -> int: - cmp(a, b) - result = SourceMap( - file: map.file, - version: 3, - sources: map.sources[0..^1], - names: map.names[0..^1], - mappings: map.serializeMappings(mappings)) - - - -proc addMapping*(map: SourceMapGenerator, mapping: Mapping) = - if not mapping.noSource and mapping.source notin map.sources: - map.sources.add(mapping.source) - - if not mapping.noName and mapping.name.len > 0 and mapping.name notin map.names: - map.names.add(mapping.name) - - # echo "map ", mapping.source, " ", mapping.original, " ", mapping.generated, " ", mapping.name - map.mappings.add(mapping) - - -proc walk*(node: SourceNode, fn: proc(line: string, original: SourceNode)) = - for child in node.children: - if child.kind == cString and child.s.len > 0: - fn(child.s, node) - else: - child.node.walk(fn) - - -proc toSourceMap*(node: SourceNode, file: string): SourceMapGenerator = - var map = SourceMapGenerator(file: file, sources: @[], names: @[], mappings: @[]) - - var generated = (line: 1, column: 0) - var sourceMappingActive = false - var lastOriginal = SourceNode(source: "", line: -1, column: 0, name: "", children: @[]) - - node.walk do (line: string, original: SourceNode): - if original.source.endsWith(".js"): - # ignore it - discard - else: - if original.line != -1: - if lastOriginal.source != original.source or - lastOriginal.line != original.line or - lastOriginal.column != original.column or - lastOriginal.name != original.name: - map.addMapping( - Mapping( - source: original.source, - original: (line: original.line, column: original.column), - generated: (line: generated.line, column: generated.column), - name: original.name)) - - lastOriginal = SourceNode( - source: original.source, - line: original.line, - column: original.column, - name: original.name, - children: lastOriginal.children) - sourceMappingActive = true - elif sourceMappingActive: - map.addMapping( - Mapping( - noSource: true, - noName: true, - generated: (line: generated.line, column: generated.column), - original: (line: -1, column: -1))) - lastOriginal.line = -1 - sourceMappingActive = false - - for z in 0 ..< line.len: - if line[z] in Newlines: - generated.line += 1 - generated.column = 0 - - if z == line.len - 1: - lastOriginal.line = -1 - sourceMappingActive = false - elif sourceMappingActive: - map.addMapping( - Mapping( - source: original.source, - original: (line: original.line, column: original.column), - generated: (line: generated.line, column: generated.column), - name: original.name)) - else: - generated.column += 1 - - map - - -proc genSourceMap*(source: string, outFile: string): (Rope, SourceMap) = - let node = parse(source, outFile) - let map = node.toSourceMap(file = outFile) - ((&"{source}\n//# sourceMappingURL={outFile}.map").rope, map.gen) + result.newLine() + +func toSourceMap*(info: SourceInfo, file: string): SourceMap {.raises: [].} = + ## Convert from high level SourceInfo into the required SourceMap object + # Add basic info + result = SourceMap(version: 3, file: file, sources: info.files, names: info.names) + # Convert nodes into mappings. + # Mappings are split into blocks where each block referes to a line in the outputted JS. + # Blocks can be separated into statements which refere to tokens on the line. + # Since the mappings depend on previous values we need to + # keep track of previous file, name, etc + var + prevFile = 0 + prevLine = 0 + prevName = 0 + prevNimCol = 0 + + for mapping in info.mappings: + # We know need to encode segments with the following fields + # All these fields are relative to their previous values + # - 0: Column in generated code + # - 1: Index of Nim file in source list + # - 2: Line in Nim source + # - 3: Column in Nim source + # - 4: Index in names list + if mapping.inSource: + # JS Column is special in that it is reset after every line + var prevJSCol = 0 + for segment in mapping.segments: + var values = @[segment.generated - prevJSCol, mapping.file - prevFile, mapping.line - prevLine, segment.original - prevNimCol] + # Add name field if needed + if segment.name != -1: + values &= segment.name - prevName + prevName = segment.name + prevJSCol = segment.generated + prevNimCol = segment.original + prevFile = mapping.file + prevLine = mapping.line + result.mappings &= encode(values) & "," + # Remove trailing , + if mapping.segments.len > 0: + result.mappings.setLen(result.mappings.len - 1) + + result.mappings &= ";" + +proc genSourceMap*(source: string, outFile: string): SourceMap = + let node = parse(source) + result = node.toSourceMap(outFile) diff --git a/compiler/spawn.nim b/compiler/spawn.nim index 54ed51dbc..58d5a4928 100644 --- a/compiler/spawn.nim +++ b/compiler/spawn.nim @@ -16,7 +16,7 @@ from trees import getMagic, getRoot proc callProc(a: PNode): PNode = result = newNodeI(nkCall, a.info) result.add a - result.typ = a.typ[0] + result.typ = a.typ.returnType # we have 4 cases to consider: # - a void proc --> nothing to do @@ -37,7 +37,7 @@ proc spawnResult*(t: PType; inParallel: bool): TSpawnResult = else: srFlowVar proc flowVarKind(c: ConfigRef, t: PType): TFlowVarKind = - if c.selectedGC in {gcArc, gcOrc}: fvBlob + if c.selectedGC in {gcArc, gcOrc, gcAtomicArc}: fvBlob elif t.skipTypes(abstractInst).kind in {tyRef, tyString, tySequence}: fvGC elif containsGarbageCollectedRef(t): fvInvalid else: fvBlob @@ -50,12 +50,12 @@ proc typeNeedsNoDeepCopy(t: PType): bool = # note that seq[T] is fine, but 'var seq[T]' is not, so we need to skip 'var' # for the stricter check and likewise we can skip 'seq' for a less # strict check: - if t.kind in {tyVar, tyLent, tySequence}: t = t.lastSon + if t.kind in {tyVar, tyLent, tySequence}: t = t.elementType result = not containsGarbageCollectedRef(t) proc addLocalVar(g: ModuleGraph; varSection, varInit: PNode; idgen: IdGenerator; owner: PSym; typ: PType; v: PNode; useShallowCopy=false): PSym = - result = newSym(skTemp, getIdent(g.cache, genPrefix), nextSymId idgen, owner, varSection.info, + result = newSym(skTemp, getIdent(g.cache, genPrefix), idgen, owner, varSection.info, owner.options) result.typ = typ incl(result.flags, sfFromGeneric) @@ -66,7 +66,7 @@ proc addLocalVar(g: ModuleGraph; varSection, varInit: PNode; idgen: IdGenerator; vpart[2] = if varInit.isNil: v else: vpart[1] varSection.add vpart if varInit != nil: - if g.config.selectedGC in {gcArc, gcOrc}: + if g.config.selectedGC in {gcArc, gcOrc, gcAtomicArc}: # inject destructors pass will do its own analysis varInit.add newFastMoveStmt(g, newSymNode(result), v) else: @@ -109,12 +109,22 @@ stmtList: """ +proc castToVoidPointer(g: ModuleGraph, n: PNode, fvField: PNode): PNode = + if g.config.backend == backendCpp: + result = fvField + else: + let ptrType = getSysType(g, n.info, tyPointer) + result = newNodeI(nkCast, fvField.info) + result.add newNodeI(nkEmpty, fvField.info) + result.add fvField + result.typ = ptrType + proc createWrapperProc(g: ModuleGraph; f: PNode; threadParam, argsParam: PSym; varSection, varInit, call, barrier, fv: PNode; idgen: IdGenerator; spawnKind: TSpawnResult, result: PSym) = var body = newNodeI(nkStmtList, f.info) - var threadLocalBarrier: PSym + var threadLocalBarrier: PSym = nil if barrier != nil: var varSection2 = newNodeI(nkVarSection, barrier.info) threadLocalBarrier = addLocalVar(g, varSection2, nil, idgen, result, @@ -122,7 +132,7 @@ proc createWrapperProc(g: ModuleGraph; f: PNode; threadParam, argsParam: PSym; body.add varSection2 body.add callCodegenProc(g, "barrierEnter", threadLocalBarrier.info, threadLocalBarrier.newSymNode) - var threadLocalProm: PSym + var threadLocalProm: PSym = nil if spawnKind == srByVar: threadLocalProm = addLocalVar(g, varSection, nil, idgen, result, fv.typ, fv) elif fv != nil: @@ -141,10 +151,10 @@ proc createWrapperProc(g: ModuleGraph; f: PNode; threadParam, argsParam: PSym; if spawnKind == srByVar: body.add newAsgnStmt(genDeref(threadLocalProm.newSymNode), call) elif fv != nil: - let fk = flowVarKind(g.config, fv.typ[1]) + let fk = flowVarKind(g.config, fv.typ.firstGenericParam) if fk == fvInvalid: localError(g.config, f.info, "cannot create a flowVar of type: " & - typeToString(fv.typ[1])) + typeToString(fv.typ.firstGenericParam)) body.add newAsgnStmt(indirectAccess(threadLocalProm.newSymNode, if fk == fvGC: "data" else: "blob", fv.info, g.cache), call) if fk == fvGC: @@ -156,8 +166,9 @@ proc createWrapperProc(g: ModuleGraph; f: PNode; threadParam, argsParam: PSym; if barrier == nil: # by now 'fv' is shared and thus might have beeen overwritten! we need # to use the thread-local view instead: + let castExpr = castToVoidPointer(g, f, threadLocalProm.newSymNode) body.add callCodegenProc(g, "nimFlowVarSignal", threadLocalProm.info, - threadLocalProm.newSymNode) + castExpr) else: body.add call if barrier != nil: @@ -169,7 +180,7 @@ proc createWrapperProc(g: ModuleGraph; f: PNode; threadParam, argsParam: PSym; params.add threadParam.newSymNode params.add argsParam.newSymNode - var t = newType(tyProc, nextTypeId idgen, threadParam.owner) + var t = newType(tyProc, idgen, threadParam.owner) t.rawAddSon nil t.rawAddSon threadParam.typ t.rawAddSon argsParam.typ @@ -189,9 +200,14 @@ proc createCastExpr(argsParam: PSym; objType: PType; idgen: IdGenerator): PNode result = newNodeI(nkCast, argsParam.info) result.add newNodeI(nkEmpty, argsParam.info) result.add newSymNode(argsParam) - result.typ = newType(tyPtr, nextTypeId idgen, objType.owner) + result.typ = newType(tyPtr, idgen, objType.owner) result.typ.rawAddSon(objType) +template checkMagicProcs(g: ModuleGraph, n: PNode, formal: PNode) = + if (formal.typ.kind == tyVarargs and formal.typ.elementType.kind in {tyTyped, tyUntyped}) or + formal.typ.kind in {tyTyped, tyUntyped}: + localError(g.config, n.info, "'spawn'ed function cannot have a 'typed' or 'untyped' parameter") + proc setupArgsForConcurrency(g: ModuleGraph; n: PNode; objType: PType; idgen: IdGenerator; owner: PSym; scratchObj: PSym, castExpr, call, @@ -205,15 +221,18 @@ proc setupArgsForConcurrency(g: ModuleGraph; n: PNode; objType: PType; 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") + + 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") 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) + var field = newSym(skField, fieldname, idgen, objType.owner, n.info, g.config.options) field.typ = argType - objType.addField(field, g.cache, idgen) + discard objType.addField(field, g.cache, idgen) result.add newFastAsgnStmt(newDotExpr(scratchObj, field), n[i]) let temp = addLocalVar(g, varSection, varInit, idgen, owner, argType, @@ -233,13 +252,16 @@ proc setupArgsForParallelism(g: ModuleGraph; n: PNode; objType: PType; let n = n[i] if i < formals.len and formals[i].typ.kind in {tyStatic, tyTypeDesc}: continue + + checkMagicProcs(g, n, formals[i]) + 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") 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) + var field = newSym(skField, fieldname, idgen, objType.owner, n.info, g.config.options) if argType.kind in {tyVarargs, tyOpenArray}: # important special case: we always create a zero-copy slice: @@ -247,19 +269,19 @@ proc setupArgsForParallelism(g: ModuleGraph; n: PNode; objType: PType; slice.typ = n.typ slice[0] = newSymNode(createMagic(g, idgen, "slice", mSlice)) slice[0].typ = getSysType(g, n.info, tyInt) # fake type - var fieldB = newSym(skField, tmpName, nextSymId idgen, objType.owner, n.info, g.config.options) + var fieldB = newSym(skField, tmpName, idgen, objType.owner, n.info, g.config.options) fieldB.typ = getSysType(g, n.info, tyInt) - objType.addField(fieldB, g.cache, idgen) + discard objType.addField(fieldB, g.cache, idgen) if getMagic(n) == mSlice: let a = genAddrOf(n[1], idgen) field.typ = a.typ - objType.addField(field, g.cache, idgen) + discard objType.addField(field, g.cache, idgen) result.add newFastAsgnStmt(newDotExpr(scratchObj, field), a) - var fieldA = newSym(skField, tmpName, nextSymId idgen, objType.owner, n.info, g.config.options) + var fieldA = newSym(skField, tmpName, idgen, objType.owner, n.info, g.config.options) fieldA.typ = getSysType(g, n.info, tyInt) - objType.addField(fieldA, g.cache, idgen) + discard objType.addField(fieldA, g.cache, idgen) result.add newFastAsgnStmt(newDotExpr(scratchObj, fieldA), n[2]) result.add newFastAsgnStmt(newDotExpr(scratchObj, fieldB), n[3]) @@ -270,7 +292,7 @@ proc setupArgsForParallelism(g: ModuleGraph; n: PNode; objType: PType; else: let a = genAddrOf(n, idgen) field.typ = a.typ - objType.addField(field, g.cache, idgen) + discard objType.addField(field, g.cache, idgen) result.add newFastAsgnStmt(newDotExpr(scratchObj, field), a) result.add newFastAsgnStmt(newDotExpr(scratchObj, fieldB), genHigh(g, n)) @@ -288,7 +310,7 @@ proc setupArgsForParallelism(g: ModuleGraph; n: PNode; objType: PType; # it is more efficient to pass a pointer instead: let a = genAddrOf(n, idgen) field.typ = a.typ - objType.addField(field, g.cache, idgen) + discard objType.addField(field, g.cache, idgen) result.add newFastAsgnStmt(newDotExpr(scratchObj, field), a) let threadLocal = addLocalVar(g, varSection, nil, idgen, owner, field.typ, indirectAccess(castExpr, field, n.info), @@ -297,7 +319,7 @@ proc setupArgsForParallelism(g: ModuleGraph; n: PNode; objType: PType; else: # boring case field.typ = argType - objType.addField(field, g.cache, idgen) + discard objType.addField(field, g.cache, idgen) result.add newFastAsgnStmt(newDotExpr(scratchObj, field), n) let threadLocal = addLocalVar(g, varSection, varInit, idgen, owner, field.typ, @@ -306,7 +328,7 @@ proc setupArgsForParallelism(g: ModuleGraph; n: PNode; objType: PType; call.add(threadLocal.newSymNode) proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExpr: PNode; retType: PType; - barrier, dest: PNode = nil): PNode = + barrier: PNode = nil, dest: PNode = nil): PNode = # if 'barrier' != nil, then it is in a 'parallel' section and we # generate quite different code let n = spawnExpr[^2] @@ -323,7 +345,7 @@ proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExp result = newNodeI(nkStmtList, n.info) if n.kind notin nkCallKinds: - localError(g.config, n.info, "'spawn' takes a call expression; got " & $n) + localError(g.config, n.info, "'spawn' takes a call expression; got: " & $n) return if optThreadAnalysis in g.config.globalOptions: if {tfThread, tfNoSideEffect} * n[0].typ.flags == {}: @@ -332,9 +354,9 @@ proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExp 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), idgen, owner, fn.info, g.config.options) + threadParam = newSym(skParam, getIdent(g.cache, "thread"), idgen, wrapperProc, n.info, g.config.options) + argsParam = newSym(skParam, getIdent(g.cache, "args"), idgen, wrapperProc, n.info, g.config.options) wrapperProc.flags.incl sfInjectDestructors block: @@ -347,7 +369,7 @@ proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExp incl(objType.flags, tfFinal) let castExpr = createCastExpr(argsParam, objType, idgen) - var scratchObj = newSym(skVar, getIdent(g.cache, "scratch"), nextSymId idgen, owner, n.info, g.config.options) + var scratchObj = newSym(skVar, getIdent(g.cache, "scratch"), idgen, owner, n.info, g.config.options) block: scratchObj.typ = objType incl(scratchObj.flags, sfFromGeneric) @@ -364,15 +386,13 @@ proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExp skFunc, skMethod, skConverter}): # for indirect calls we pass the function pointer in the scratchObj var argType = n[0].typ.skipTypes(abstractInst) - var field = newSym(skField, getIdent(g.cache, "fn"), nextSymId idgen, owner, n.info, g.config.options) + var field = newSym(skField, getIdent(g.cache, "fn"), idgen, owner, n.info, g.config.options) field.typ = argType - objType.addField(field, g.cache, idgen) + discard objType.addField(field, g.cache, idgen) 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") - elif fn.typ.callConv == ccClosure: - localError(g.config, n.info, "closure in spawn environment is not allowed") call.add(fn) var varSection = newNodeI(nkVarSection, n.info) @@ -386,31 +406,32 @@ proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExp var barrierAsExpr: PNode = nil if barrier != nil: - let typ = newType(tyPtr, nextTypeId idgen, owner) + let typ = newType(tyPtr, 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"), idgen, owner, n.info, g.config.options) field.typ = typ - objType.addField(field, g.cache, idgen) + discard objType.addField(field, g.cache, idgen) result.add newFastAsgnStmt(newDotExpr(scratchObj, field), barrier) barrierAsExpr = indirectAccess(castExpr, field, n.info) var fvField, fvAsExpr: PNode = nil if spawnKind == srFlowVar: - var field = newSym(skField, getIdent(g.cache, "fv"), nextSymId idgen, owner, n.info, g.config.options) + var field = newSym(skField, getIdent(g.cache, "fv"), idgen, owner, n.info, g.config.options) field.typ = retType - objType.addField(field, g.cache, idgen) + discard objType.addField(field, g.cache, idgen) fvField = newDotExpr(scratchObj, field) fvAsExpr = indirectAccess(castExpr, field, n.info) # create flowVar: result.add newFastAsgnStmt(fvField, callProc(spawnExpr[^1])) if barrier == nil: - result.add callCodegenProc(g, "nimFlowVarCreateSemaphore", fvField.info, fvField) + let castExpr = castToVoidPointer(g, n, fvField) + result.add callCodegenProc(g, "nimFlowVarCreateSemaphore", fvField.info, castExpr) elif spawnKind == srByVar: - var field = newSym(skField, getIdent(g.cache, "fv"), nextSymId idgen, owner, n.info, g.config.options) - field.typ = newType(tyPtr, nextTypeId idgen, objType.owner) + var field = newSym(skField, getIdent(g.cache, "fv"), idgen, owner, n.info, g.config.options) + field.typ = newType(tyPtr, idgen, objType.owner) field.typ.rawAddSon(retType) - objType.addField(field, g.cache, idgen) + discard objType.addField(field, g.cache, idgen) fvAsExpr = indirectAccess(castExpr, field, n.info) result.add newFastAsgnStmt(newDotExpr(scratchObj, field), genAddrOf(dest, idgen)) @@ -422,4 +443,3 @@ proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExp wrapperProc.newSymNode, genAddrOf(scratchObj.newSymNode, idgen), nil, spawnExpr) if spawnKind == srFlowVar: result.add fvField - diff --git a/compiler/strutils2.nim b/compiler/strutils2.nim deleted file mode 100644 index f44b811c7..000000000 --- a/compiler/strutils2.nim +++ /dev/null @@ -1,57 +0,0 @@ -##[ -internal API for now, subject to modifications and moving around - -string API's focusing on performance, that can be used as building blocks -for other routines. - -Un-necessary allocations are avoided and appropriate algorithms are used at the -expense of code clarity when justified. -]## - -proc dataPointer*[T](a: T): pointer = - ## same as C++ `data` that works with std::string, std::vector etc. - ## Note: safe to use when a.len == 0 but whether the result is nil or not - ## is implementation defined for performance reasons. - # this could be improved with ocmpiler support to avoid the `if`, e.g. in C++ - # `&a[0]` is well defined even if a.size() == 0 - when T is string | seq: - if a.len == 0: nil else: cast[pointer](a[0].unsafeAddr) - elif T is array: - when a.len > 0: a.unsafeAddr - else: nil - elif T is cstring: - cast[pointer](a) - else: static: doAssert false, $T - -proc setLen*(result: var string, n: int, isInit: bool) = - ## when isInit = false, elements are left uninitialized, analog to `{.noinit.}` - ## else, there are 0-initialized. - # xxx placeholder until system.setLen supports this - # to distinguish between algorithms that need 0-initialization vs not; note - # that `setLen` for string is inconsistent with `setLen` for seq. - # likwise with `newString` vs `newSeq`. This should be fixed in `system`. - let n0 = result.len - result.setLen(n) - if isInit and n > n0: - zeroMem(result[n0].addr, n - n0) - -proc forceCopy*(result: var string, a: string) = - ## also forces a copy if `a` is shallow - # the naitve `result = a` would not work if `a` is shallow - let n = a.len - result.setLen n, isInit = false - copyMem(result.dataPointer, a.dataPointer, n) - -proc isUpperAscii(c: char): bool {.inline.} = - # avoids import strutils.isUpperAscii - c in {'A'..'Z'} - -proc toLowerAscii*(a: var string) = - ## optimized and inplace overload of strutils.toLowerAscii - # refs https://github.com/timotheecour/Nim/pull/54 - # this is 10X faster than a naive implementation using a an optimization trick - # that can be adapted in similar contexts. Predictable writes avoid write - # hazards and lead to better machine code, compared to random writes arising - # from: `if c.isUpperAscii: c = ...` - for c in mitems(a): - c = chr(c.ord + (if c.isUpperAscii: (ord('a') - ord('A')) else: 0)) diff --git a/compiler/suggest.nim b/compiler/suggest.nim index cad776015..a5213086b 100644 --- a/compiler/suggest.nim +++ b/compiler/suggest.nim @@ -32,11 +32,13 @@ # included from sigmatch.nim -import algorithm, sets, prefixmatches, lineinfos, parseutils, linter +import prefixmatches, suggestsymdb from wordrecg import wDeprecated, wError, wAddr, wYield +import std/[algorithm, sets, parseutils, tables] + when defined(nimsuggest): - import passes, tables, pathutils # importer + import pathutils # importer const sep = '\t' @@ -53,8 +55,10 @@ proc findDocComment(n: PNode): PNode = if result != nil: return if n.len > 1: result = findDocComment(n[1]) - elif n.kind in {nkAsgn, nkFastAsgn} and n.len == 2: + elif n.kind in {nkAsgn, nkFastAsgn, nkSinkAsgn} and n.len == 2: result = findDocComment(n[1]) + else: + result = nil proc extractDocComment(g: ModuleGraph; s: PSym): string = var n = findDocComment(s.ast) @@ -81,7 +85,16 @@ proc cmpSuggestions(a, b: Suggest): int = # independent of hashing order: result = cmp(a.name[], b.name[]) -proc getTokenLenFromSource(conf: ConfigRef; ident: string; info: TLineInfo): int = +proc scanForTrailingAsterisk(line: string, start: int): int = + result = 0 + while start+result < line.len and line[start+result] in {' ', '\t'}: + inc result + if start+result < line.len and line[start+result] == '*': + inc result + else: + result = 0 + +proc getTokenLenFromSource(conf: ConfigRef; ident: string; info: TLineInfo; skipTrailingAsterisk: bool = false): int = let line = sourceLine(conf, info) column = toColumn(info) @@ -101,26 +114,34 @@ proc getTokenLenFromSource(conf: ConfigRef; ident: string; info: TLineInfo): int result = skipUntil(line, '`', column) if cmpIgnoreStyle(line[column..column + result - 1], ident) != 0: result = 0 + elif column >= 0 and line[column] == '`' and isOpeningBacktick(column): + result = skipUntil(line, '`', column + 1) + 2 + if cmpIgnoreStyle(line[column + 1..column + result - 2], ident) != 0: + result = 0 elif ident[0] in linter.Letters and ident[^1] != '=': result = identLen(line, column) - if cmpIgnoreStyle(line[column..column + result - 1], ident) != 0: + if cmpIgnoreStyle(line[column..column + result - 1], ident[0..min(result-1,len(ident)-1)]) != 0: result = 0 + if skipTrailingAsterisk and result > 0: + result += scanForTrailingAsterisk(line, column + result) else: - var sourceIdent: string + var sourceIdent: string = "" result = parseWhile(line, sourceIdent, OpChars + {'[', '(', '{', ']', ')', '}'}, column) if ident[^1] == '=' and ident[0] in linter.Letters: if sourceIdent != "=": result = 0 - elif sourceIdent.len > ident.len and sourceIdent[..ident.high] == ident: + elif sourceIdent.len > ident.len and sourceIdent[0..ident.high] == ident: result = ident.len elif sourceIdent != ident: result = 0 -proc symToSuggest(g: ModuleGraph; s: PSym, isLocal: bool, section: IdeCmd, info: TLineInfo; +proc symToSuggest*(g: ModuleGraph; s: PSym, isLocal: bool, section: IdeCmd, info: TLineInfo; quality: range[0..100]; prefix: PrefixMatch; inTypeContext: bool; scope: int; - useSuppliedInfo = false): Suggest = + useSuppliedInfo = false, + endLine: uint16 = 0, + endCol = 0, extractDocs = true): Suggest = new(result) result.section = section result.quality = quality @@ -152,65 +173,139 @@ proc symToSuggest(g: ModuleGraph; s: PSym, isLocal: bool, section: IdeCmd, info: result.qualifiedPath.add(s.name.s) if s.typ != nil: - result.forth = typeToString(s.typ) + if section == ideInlayHints: + result.forth = typeToString(s.typ, preferInlayHint) + else: + result.forth = typeToString(s.typ, preferInferredEffects) else: result.forth = "" when defined(nimsuggest) and not defined(noDocgen) and not defined(leanCompiler): - result.doc = extractDocComment(g, s) - let infox = - if useSuppliedInfo or section in {ideUse, ideHighlight, ideOutline}: - info - else: - s.info - result.filePath = toFullPath(g.config, infox) - result.line = toLinenumber(infox) - result.column = toColumn(infox) + if extractDocs: + result.doc = extractDocComment(g, s) + if s.kind == skModule and s.ast.len != 0 and section != ideHighlight: + result.filePath = toFullPath(g.config, s.ast[0].info) + result.line = 1 + result.column = 0 + result.tokenLen = 0 + else: + let infox = + if useSuppliedInfo or section in {ideUse, ideHighlight, ideOutline, ideDeclaration}: + info + else: + s.info + result.filePath = toFullPath(g.config, infox) + result.line = toLinenumber(infox) + result.column = toColumn(infox) + result.tokenLen = if section notin {ideHighlight, ideInlayHints}: + s.name.s.len + else: + getTokenLenFromSource(g.config, s.name.s, infox, section == ideInlayHints) result.version = g.config.suggestVersion - result.tokenLen = if section != ideHighlight: - s.name.s.len - else: - getTokenLenFromSource(g.config, s.name.s, infox) + result.endLine = endLine + result.endCol = endCol -proc `$`*(suggest: Suggest): string = - result = $suggest.section +proc `$`*(suggest: SuggestInlayHint): string = + result = $suggest.kind result.add(sep) - if suggest.section == ideHighlight: - if suggest.symkind.TSymKind == skVar and suggest.isGlobal: - result.add("skGlobalVar") - elif suggest.symkind.TSymKind == skLet and suggest.isGlobal: - result.add("skGlobalLet") - else: - result.add($suggest.symkind.TSymKind) - result.add(sep) - result.add($suggest.line) - result.add(sep) - result.add($suggest.column) - result.add(sep) - result.add($suggest.tokenLen) + result.add($suggest.line) + result.add(sep) + result.add($suggest.column) + result.add(sep) + result.add(suggest.label) + result.add(sep) + result.add($suggest.paddingLeft) + result.add(sep) + result.add($suggest.paddingRight) + result.add(sep) + result.add($suggest.allowInsert) + result.add(sep) + result.add(suggest.tooltip) + +proc `$`*(suggest: Suggest): string = + if suggest.section == ideInlayHints: + result = $suggest.inlayHintInfo else: - result.add($suggest.symkind.TSymKind) - result.add(sep) - if suggest.qualifiedPath.len != 0: - result.add(suggest.qualifiedPath.join(".")) - result.add(sep) - result.add(suggest.forth) - result.add(sep) - result.add(suggest.filePath) - result.add(sep) - result.add($suggest.line) - result.add(sep) - result.add($suggest.column) + result = $suggest.section result.add(sep) - when defined(nimsuggest) and not defined(noDocgen) and not defined(leanCompiler): - result.add(suggest.doc.escape) - if suggest.version == 0: + if suggest.section == ideHighlight: + if suggest.symkind.TSymKind == skVar and suggest.isGlobal: + result.add("skGlobalVar") + elif suggest.symkind.TSymKind == skLet and suggest.isGlobal: + result.add("skGlobalLet") + else: + result.add($suggest.symkind.TSymKind) + result.add(sep) + result.add($suggest.line) + result.add(sep) + result.add($suggest.column) + result.add(sep) + result.add($suggest.tokenLen) + else: + result.add($suggest.symkind.TSymKind) + result.add(sep) + if suggest.qualifiedPath.len != 0: + result.add(suggest.qualifiedPath.join(".")) + result.add(sep) + result.add(suggest.forth) + result.add(sep) + result.add(suggest.filePath) result.add(sep) - result.add($suggest.quality) - if suggest.section == ideSug: + result.add($suggest.line) + result.add(sep) + result.add($suggest.column) + result.add(sep) + when defined(nimsuggest) and not defined(noDocgen) and not defined(leanCompiler): + result.add(suggest.doc.escape) + if suggest.version == 0 or suggest.version == 3: result.add(sep) - result.add($suggest.prefix) + result.add($suggest.quality) + if suggest.section == ideSug: + result.add(sep) + result.add($suggest.prefix) -proc suggestResult(conf: ConfigRef; s: Suggest) = + if (suggest.version == 3 and suggest.section in {ideOutline, ideExpand}): + result.add(sep) + result.add($suggest.endLine) + result.add(sep) + result.add($suggest.endCol) + +proc suggestToSuggestInlayTypeHint*(sug: Suggest): SuggestInlayHint = + SuggestInlayHint( + kind: sihkType, + line: sug.line, + column: sug.column + sug.tokenLen, + label: ": " & sug.forth, + paddingLeft: false, + paddingRight: false, + allowInsert: true, + tooltip: "" + ) + +proc suggestToSuggestInlayExceptionHintLeft*(sug: Suggest, propagatedExceptions: seq[PType]): SuggestInlayHint = + SuggestInlayHint( + kind: sihkException, + line: sug.line, + column: sug.column, + label: "try ", + paddingLeft: false, + paddingRight: false, + allowInsert: false, + tooltip: "propagated exceptions: " & $propagatedExceptions + ) + +proc suggestToSuggestInlayExceptionHintRight*(sug: Suggest, propagatedExceptions: seq[PType]): SuggestInlayHint = + SuggestInlayHint( + kind: sihkException, + line: sug.line, + column: sug.column + sug.tokenLen, + label: "!", + paddingLeft: false, + paddingRight: false, + allowInsert: false, + tooltip: "propagated exceptions: " & $propagatedExceptions + ) + +proc suggestResult*(conf: ConfigRef; s: Suggest) = if not isNil(conf.suggestionResultHook): conf.suggestionResultHook(s) else: @@ -238,13 +333,17 @@ proc filterSym(s: PSym; prefix: PNode; res: var PrefixMatch): bool {.inline.} = of nkOpenSymChoice, nkClosedSymChoice, nkAccQuoted: if n.len > 0: result = prefixMatch(s, n[0]) - else: discard + else: + result = default(PrefixMatch) + else: result = default(PrefixMatch) if s.kind != skModule: if prefix != nil: res = prefixMatch(s, prefix) result = res != PrefixMatch.None else: result = true + else: + result = false proc filterSymNoOpr(s: PSym; prefix: PNode; res: var PrefixMatch): bool {.inline.} = result = filterSym(s, prefix, res) and s.name.s[0] in lexer.SymChars and @@ -253,15 +352,21 @@ proc filterSymNoOpr(s: PSym; prefix: PNode; res: var PrefixMatch): bool {.inline proc fieldVisible*(c: PContext, f: PSym): bool {.inline.} = let fmoduleId = getModule(f).id result = sfExported in f.flags or fmoduleId == c.module.id - for module in c.friendModules: - if fmoduleId == module.id: - result = true - break + + if not result: + for module in c.friendModules: + if fmoduleId == module.id: return true + if f.kind == skField: + var symObj = f.owner.typ.toObjectFromRefPtrGeneric.sym + assert symObj != nil + for scope in allScopes(c.currentScope): + for sym in scope.allowPrivateAccess: + if symObj.id == sym.id: return true proc getQuality(s: PSym): range[0..100] = result = 100 - if s.typ != nil and s.typ.len > 1: - var exp = s.typ[1].skipTypes({tyGenericInst, tyVar, tyLent, tyAlias, tySink}) + if s.typ != nil and s.typ.paramsLen > 0: + var exp = s.typ.firstParamType.skipTypes({tyGenericInst, tyVar, tyLent, tyAlias, tySink}) if exp.kind == tyVarargs: exp = elemType(exp) if exp.kind in {tyUntyped, tyTyped, tyGenericParam, tyAnything}: result = 50 @@ -270,15 +375,15 @@ proc getQuality(s: PSym): range[0..100] = result = result - 5 proc suggestField(c: PContext, s: PSym; f: PNode; info: TLineInfo; outputs: var Suggestions) = - var pm: PrefixMatch + var pm: PrefixMatch = default(PrefixMatch) if filterSym(s, f, pm) and fieldVisible(c, s): outputs.add(symToSuggest(c.graph, s, isLocal=true, ideSug, info, s.getQuality, pm, c.inTypeContext > 0, 0)) template wholeSymTab(cond, section: untyped) {.dirty.} = - for (item, scopeN, isLocal) in allSyms(c): + for (item, scopeN, isLocal) in uniqueSyms(c): let it = item - var pm: PrefixMatch + var pm: PrefixMatch = default(PrefixMatch) if cond: outputs.add(symToSuggest(c.graph, it, isLocal = isLocal, section, info, getQuality(it), pm, c.inTypeContext > 0, scopeN)) @@ -330,17 +435,19 @@ proc suggestVar(c: PContext, n: PNode, outputs: var Suggestions) = wholeSymTab(nameFits(c, it, n), ideCon) proc typeFits(c: PContext, s: PSym, firstArg: PType): bool {.inline.} = - if s.typ != nil and s.typ.len > 1 and s.typ[1] != nil: + if s.typ != nil and s.typ.paramsLen > 0 and s.typ.firstParamType != nil: # special rule: if system and some weird generic match via 'tyUntyped' # or 'tyGenericParam' we won't list it either to reduce the noise (nobody # wants 'system.`-|` as suggestion let m = s.getModule() if m != nil and sfSystemModule in m.flags: if s.kind == skType: return - var exp = s.typ[1].skipTypes({tyGenericInst, tyVar, tyLent, tyAlias, tySink}) + var exp = s.typ.firstParamType.skipTypes({tyGenericInst, tyVar, tyLent, tyAlias, tySink}) if exp.kind == tyVarargs: exp = elemType(exp) if exp.kind in {tyUntyped, tyTyped, tyGenericParam, tyAnything}: return - result = sigmatch.argtypeMatches(c, s.typ[1], firstArg) + result = sigmatch.argtypeMatches(c, s.typ.firstParamType, firstArg) + else: + result = false proc suggestOperations(c: PContext, n, f: PNode, typ: PType, outputs: var Suggestions) = assert typ != nil @@ -349,8 +456,8 @@ proc suggestOperations(c: PContext, n, f: PNode, typ: PType, outputs: var Sugges proc suggestEverything(c: PContext, n, f: PNode, outputs: var Suggestions) = # do not produce too many symbols: - for (it, scopeN, isLocal) in allSyms(c): - var pm: PrefixMatch + for (it, scopeN, isLocal) in uniqueSyms(c): + var pm: PrefixMatch = default(PrefixMatch) if filterSym(it, f, pm): outputs.add(symToSuggest(c.graph, it, isLocal = isLocal, ideSug, n.info, it.getQuality, pm, c.inTypeContext > 0, scopeN)) @@ -359,7 +466,7 @@ proc suggestFieldAccess(c: PContext, n, field: PNode, outputs: var Suggestions) # special code that deals with ``myObj.``. `n` is NOT the nkDotExpr-node, but # ``myObj``. var typ = n.typ - var pm: PrefixMatch + var pm: PrefixMatch = default(PrefixMatch) when defined(nimsuggest): if n.kind == nkSym and n.sym.kind == skError and c.config.suggestVersion == 0: # consider 'foo.|' where 'foo' is some not imported module. @@ -408,16 +515,24 @@ proc suggestFieldAccess(c: PContext, n, field: PNode, outputs: var Suggestions) var t = typ while t != nil: suggestSymList(c, t.n, field, n.info, outputs) - t = t[0] + t = t.baseClass elif typ.kind == tyObject: var t = typ while true: suggestObject(c, t.n, field, n.info, outputs) - if t[0] == nil: break - t = skipTypes(t[0], skipPtrs) + if t.baseClass == nil: break + t = skipTypes(t.baseClass, skipPtrs) elif typ.kind == tyTuple and typ.n != nil: - suggestSymList(c, typ.n, field, n.info, outputs) - + # All tuple fields are in scope + # So go through each field and add it to the suggestions (If it passes the filter) + for node in typ.n: + if node.kind == nkSym: + let s = node.sym + var pm: PrefixMatch = default(PrefixMatch) + if filterSym(s, field, pm): + outputs.add(symToSuggest(c.graph, s, isLocal=true, ideSug, n.info, + s.getQuality, pm, c.inTypeContext > 0, 0)) + suggestOperations(c, n, field, orig, outputs) if typ != orig: suggestOperations(c, n, field, typ, outputs) @@ -428,17 +543,34 @@ type proc inCheckpoint*(current, trackPos: TLineInfo): TCheckPointResult = if current.fileIndex == trackPos.fileIndex: + result = cpNone if current.line == trackPos.line and abs(current.col-trackPos.col) < 4: return cpExact if current.line >= trackPos.line: return cpFuzzy + else: + result = cpNone proc isTracked*(current, trackPos: TLineInfo, tokenLen: int): bool = if current.fileIndex==trackPos.fileIndex and current.line==trackPos.line: let col = trackPos.col if col >= current.col and col <= current.col+tokenLen-1: - return true + result = true + else: + result = false + else: + result = false + +proc isTracked*(current, trackPos: TinyLineInfo, tokenLen: int): bool = + if current.line==trackPos.line: + let col = trackPos.col + if col >= current.col and col <= current.col+tokenLen-1: + result = true + else: + result = false + else: + result = false when defined(nimsuggest): # Since TLineInfo defined a == operator that doesn't include the column, @@ -475,7 +607,7 @@ proc findDefinition(g: ModuleGraph; info: TLineInfo; s: PSym; usageSym: var PSym if s.isNil: return if isTracked(info, g.config.m.trackPos, s.name.s.len) or (s == usageSym and sfForward notin s.flags): suggestResult(g.config, symToSuggest(g, s, isLocal=false, ideDef, info, 100, PrefixMatch.None, false, 0, useSuppliedInfo = s == usageSym)) - if sfForward notin s.flags: + if sfForward notin s.flags and g.config.suggestVersion < 3: suggestQuit() else: usageSym = s @@ -490,6 +622,8 @@ proc suggestSym*(g: ModuleGraph; info: TLineInfo; s: PSym; usageSym: var PSym; i ## misnamed: should be 'symDeclared' let conf = g.config when defined(nimsuggest): + g.suggestSymbols.add SymInfoPair(sym: s, info: info, isDecl: isDecl), optIdeExceptionInlayHints in g.config.globalOptions + if conf.suggestVersion == 0: if s.allUsages.len == 0: s.allUsages = @[info] @@ -520,16 +654,6 @@ proc suggestSym*(g: ModuleGraph; info: TLineInfo; s: PSym; usageSym: var PSym; i if parentFileIndex == conf.m.trackPos.fileIndex: suggestResult(conf, symToSuggest(g, s, isLocal=false, ideOutline, info, 100, PrefixMatch.None, false, 0)) -proc extractPragma(s: PSym): PNode = - if s.kind in routineKinds: - result = s.ast[pragmasPos] - elif s.kind in {skType, skVar, skLet}: - if s.ast != nil and s.ast.len > 0: - if s.ast[0].kind == nkPragmaExpr and s.ast[0].len > 1: - # s.ast = nkTypedef / nkPragmaExpr / [nkSym, nkPragma] - result = s.ast[0][1] - doAssert result == nil or result.kind == nkPragma - proc warnAboutDeprecated(conf: ConfigRef; info: TLineInfo; s: PSym) = var pragmaNode: PNode pragmaNode = if s.kind == skEnumField: extractPragma(s.owner) else: extractPragma(s) @@ -565,13 +689,14 @@ 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.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: inc i -proc markUsed(c: PContext; info: TLineInfo; s: PSym) = +proc markUsed(c: PContext; info: TLineInfo; s: PSym; checkStyle = true) = let conf = c.config incl(s.flags, sfUsed) if s.kind == skEnumField and s.owner != nil: @@ -588,8 +713,8 @@ proc markUsed(c: PContext; info: TLineInfo; s: PSym) = if sfError in s.flags: userError(conf, info, s) when defined(nimsuggest): suggestSym(c.graph, info, s, c.graph.usageSym, false) - if {optStyleHint, optStyleError} * conf.globalOptions != {}: - styleCheckUse(conf, info, s) + if checkStyle: + styleCheckUse(c, info, s) markOwnerModuleAsUsed(c, s) proc safeSemExpr*(c: PContext, n: PNode): PNode = @@ -658,6 +783,9 @@ proc suggestDecl*(c: PContext, n: PNode; s: PSym) = if attached: inc(c.inTypeContext) defer: if attached: dec(c.inTypeContext) + # If user is typing out an enum field, then don't provide suggestions + if s.kind == skEnumField and c.config.cmd == cmdIdeTools and exactEquals(c.config.m.trackPos, n.info): + suggestQuit() suggestExpr(c, n) proc suggestStmt*(c: PContext, n: PNode) = @@ -669,14 +797,46 @@ proc suggestEnum*(c: PContext; n: PNode; t: PType) = produceOutput(outputs, c.config) if outputs.len > 0: suggestQuit() +proc suggestPragmas*(c: PContext, n: PNode) = + ## Suggests anything that might be a pragma + ## - template that has {.pragma.} + ## - macros + ## - user pragmas + let info = n.info + var outputs: Suggestions = @[] + # First filter for template/macros + wholeSymTab(filterSym(it, n, pm) and + (sfCustomPragma in it.flags or it.kind == skMacro), + ideSug) + + # Now show suggestions for user pragmas + for pragma in c.userPragmas: + var pm = default(PrefixMatch) + if filterSym(pragma, n, pm): + outputs &= symToSuggest(c.graph, pragma, isLocal=true, ideSug, info, + pragma.getQuality, pm, c.inTypeContext > 0, 0, + extractDocs=false) + + produceOutput(outputs, c.config) + if outputs.len > 0: + suggestQuit() + +template trySuggestPragmas*(c: PContext, n: PNode) = + ## Runs [suggestPragmas] when compiling nimsuggest and + ## we are querying the node + when defined(nimsuggest): + let tmp = n + if c.config.ideCmd == ideSug and exactEquals(c.config.m.trackPos, tmp.info): + suggestPragmas(c, tmp) + proc suggestSentinel*(c: PContext) = if c.config.ideCmd != ideSug or c.module.position != c.config.m.trackPos.fileIndex.int32: return if c.compilesContextId > 0: return inc(c.compilesContextId) var outputs: Suggestions = @[] # suggest everything: - for (it, scopeN, isLocal) in allSyms(c): - var pm: PrefixMatch + for (it, scopeN, isLocal) in uniqueSyms(c): + var pm: PrefixMatch = default(PrefixMatch) if filterSymNoOpr(it, nil, pm): outputs.add(symToSuggest(c.graph, it, isLocal = isLocal, ideSug, newLineInfo(c.config.m.trackPos.fileIndex, 0, -1), it.getQuality, @@ -684,3 +844,16 @@ proc suggestSentinel*(c: PContext) = dec(c.compilesContextId) produceOutput(outputs, c.config) + +when defined(nimsuggest): + proc onDef(graph: ModuleGraph, s: PSym, info: TLineInfo) = + if graph.config.suggestVersion >= 3 and info.exactEquals(s.info): + suggestSym(graph, info, s, graph.usageSym) + + template getPContext(): untyped = + when c is PContext: c + else: c.c + + template onDef*(info: TLineInfo; s: PSym) = + let c = getPContext() + onDef(c.graph, s, info) diff --git a/compiler/suggestsymdb.nim b/compiler/suggestsymdb.nim new file mode 100644 index 000000000..e1e67afbe --- /dev/null +++ b/compiler/suggestsymdb.nim @@ -0,0 +1,212 @@ +import std/[intsets, tables, algorithm, assertions] +import ast, lineinfos, msgs + +type + PackedBoolArray* = object + s: IntSet + len: int + + TinyLineInfo* = object + line*: uint16 + col*: int16 + + SymInfoPair* = object + sym*: PSym + info*: TLineInfo + caughtExceptions*: seq[PType] + caughtExceptionsSet*: bool + isDecl*: bool + + SuggestFileSymbolDatabase* = object + lineInfo*: seq[TinyLineInfo] + sym*: seq[PSym] + caughtExceptions*: seq[seq[PType]] + caughtExceptionsSet*: PackedBoolArray + isDecl*: PackedBoolArray + fileIndex*: FileIndex + trackCaughtExceptions*: bool + isSorted*: bool + + SuggestSymbolDatabase* = Table[FileIndex, SuggestFileSymbolDatabase] + + +func newPackedBoolArray*(): PackedBoolArray = + PackedBoolArray( + s: initIntSet(), + len: 0 + ) + +func low*(s: PackedBoolArray): int = + 0 + +func high*(s: PackedBoolArray): int = + s.len - 1 + +func `[]`*(s: PackedBoolArray; idx: int): bool = + s.s.contains(idx) + +proc `[]=`*(s: var PackedBoolArray; idx: int; v: bool) = + if v: + s.s.incl(idx) + else: + s.s.excl(idx) + +proc add*(s: var PackedBoolArray; v: bool) = + inc(s.len) + if v: + s.s.incl(s.len - 1) + +proc reverse*(s: var PackedBoolArray) = + var + reversedSet = initIntSet() + for i in 0..s.high: + if s.s.contains(i): + reversedSet.incl(s.high - i) + s.s = reversedSet + +proc getSymInfoPair*(s: SuggestFileSymbolDatabase; idx: int): SymInfoPair = + SymInfoPair( + sym: s.sym[idx], + info: TLineInfo( + line: s.lineInfo[idx].line, + col: s.lineInfo[idx].col, + fileIndex: s.fileIndex + ), + caughtExceptions: + if s.trackCaughtExceptions: + s.caughtExceptions[idx] + else: + @[], + caughtExceptionsSet: + if s.trackCaughtExceptions: + s.caughtExceptionsSet[idx] + else: + false, + isDecl: s.isDecl[idx] + ) + +proc reverse*(s: var SuggestFileSymbolDatabase) = + s.lineInfo.reverse() + s.sym.reverse() + s.caughtExceptions.reverse() + s.caughtExceptionsSet.reverse() + s.isDecl.reverse() + +proc newSuggestFileSymbolDatabase*(aFileIndex: FileIndex; aTrackCaughtExceptions: bool): SuggestFileSymbolDatabase = + SuggestFileSymbolDatabase( + lineInfo: @[], + sym: @[], + caughtExceptions: @[], + caughtExceptionsSet: newPackedBoolArray(), + isDecl: newPackedBoolArray(), + fileIndex: aFileIndex, + trackCaughtExceptions: aTrackCaughtExceptions, + isSorted: true + ) + +proc exactEquals*(a, b: TinyLineInfo): bool = + result = a.line == b.line and a.col == b.col + +proc `==`*(a, b: SymInfoPair): bool = + result = a.sym == b.sym and a.info.exactEquals(b.info) + +func cmp*(a: TinyLineInfo; b: TinyLineInfo): int = + result = cmp(a.line, b.line) + if result == 0: + result = cmp(a.col, b.col) + +func compare*(s: var SuggestFileSymbolDatabase; i, j: int): int = + result = cmp(s.lineInfo[i], s.lineInfo[j]) + if result == 0: + result = cmp(s.isDecl[i], s.isDecl[j]) + +proc exchange(s: var SuggestFileSymbolDatabase; i, j: int) = + if i == j: + return + var tmp1 = s.lineInfo[i] + s.lineInfo[i] = s.lineInfo[j] + s.lineInfo[j] = tmp1 + if s.trackCaughtExceptions: + var tmp2 = s.caughtExceptions[i] + s.caughtExceptions[i] = s.caughtExceptions[j] + s.caughtExceptions[j] = tmp2 + var tmp3 = s.caughtExceptionsSet[i] + s.caughtExceptionsSet[i] = s.caughtExceptionsSet[j] + s.caughtExceptionsSet[j] = tmp3 + var tmp4 = s.isDecl[i] + s.isDecl[i] = s.isDecl[j] + s.isDecl[j] = tmp4 + var tmp5 = s.sym[i] + s.sym[i] = s.sym[j] + s.sym[j] = tmp5 + +proc quickSort(s: var SuggestFileSymbolDatabase; ll, rr: int) = + var + i, j, pivotIdx: int + l = ll + r = rr + while true: + i = l + j = r + pivotIdx = l + ((r - l) shr 1) + while true: + while (i < pivotIdx) and (s.compare(pivotIdx, i) > 0): + inc i + while (j > pivotIdx) and (s.compare(pivotIdx, j) < 0): + dec j + if i < j: + s.exchange(i, j) + if pivotIdx == i: + pivotIdx = j + inc i + elif pivotIdx == j: + pivotIdx = i + dec j + else: + inc i + dec j + else: + break + if (pivotIdx - l) < (r - pivotIdx): + if (l + 1) < pivotIdx: + s.quickSort(l, pivotIdx - 1) + l = pivotIdx + 1 + else: + if (pivotIdx + 1) < r: + s.quickSort(pivotIdx + 1, r) + if (l + 1) < pivotIdx: + r = pivotIdx - 1 + else: + break + if l >= r: + break + +proc sort*(s: var SuggestFileSymbolDatabase) = + s.quickSort(s.lineInfo.low, s.lineInfo.high) + s.isSorted = true + +proc add*(s: var SuggestFileSymbolDatabase; v: SymInfoPair) = + doAssert(v.info.fileIndex == s.fileIndex) + s.lineInfo.add(TinyLineInfo( + line: v.info.line, + col: v.info.col + )) + s.sym.add(v.sym) + s.isDecl.add(v.isDecl) + if s.trackCaughtExceptions: + s.caughtExceptions.add(v.caughtExceptions) + s.caughtExceptionsSet.add(v.caughtExceptionsSet) + s.isSorted = false + +proc add*(s: var SuggestSymbolDatabase; v: SymInfoPair; trackCaughtExceptions: bool) = + s.mgetOrPut(v.info.fileIndex, newSuggestFileSymbolDatabase(v.info.fileIndex, trackCaughtExceptions)).add(v) + +proc findSymInfoIndex*(s: var SuggestFileSymbolDatabase; li: TLineInfo): int = + doAssert(li.fileIndex == s.fileIndex) + if not s.isSorted: + s.sort() + var q = TinyLineInfo( + line: li.line, + col: li.col + ) + result = binarySearch(s.lineInfo, q, cmp) diff --git a/compiler/syntaxes.nim b/compiler/syntaxes.nim index e745e28ba..6b325c77f 100644 --- a/compiler/syntaxes.nim +++ b/compiler/syntaxes.nim @@ -10,10 +10,14 @@ ## Implements the dispatcher for the different parsers. import - strutils, llstream, ast, idents, lexer, options, msgs, parser, + llstream, ast, idents, lexer, options, msgs, parser, filters, filter_tmpl, renderer, lineinfos, pathutils -export Parser, parseAll, parseTopLevelStmt, closeParser +import std/strutils +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] + +export Parser, parseAll, parseTopLevelStmt, checkFirstLineIndentation, closeParser type FilterKind = enum @@ -33,6 +37,8 @@ proc containsShebang(s: string, i: int): bool = var j = i + 2 while j < s.len and s[j] in Whitespace: inc(j) result = s[j] == '/' + else: + result = false proc parsePipe(filename: AbsoluteFile, inputStream: PLLStream; cache: IdentCache; config: ConfigRef): PNode = @@ -50,17 +56,18 @@ proc parsePipe(filename: AbsoluteFile, inputStream: PLLStream; cache: IdentCache if i+1 < line.len and line[i] == '#' and line[i+1] == '?': when defined(nimpretty): # XXX this is a bit hacky, but oh well... - quit "can't nimpretty a source code filter" + config.quitOrRaise "can't nimpretty a source code filter: " & $filename else: inc(i, 2) while i < line.len and line[i] in Whitespace: inc(i) - var p: Parser + var p: Parser = default(Parser) openParser(p, filename, llStreamOpen(substr(line, i)), cache, config) result = parseAll(p) closeParser(p) llStreamClose(s) proc getFilter(ident: PIdent): FilterKind = + result = filtNone for i in FilterKind: if cmpIgnoreStyle(ident.s, $i) == 0: return i @@ -71,6 +78,7 @@ proc getCallee(conf: ConfigRef; n: PNode): PIdent = elif n.kind == nkIdent: result = n.ident else: + result = nil localError(conf, n.info, "invalid filter: " & renderTree(n)) proc applyFilter(p: var Parser, n: PNode, filename: AbsoluteFile, @@ -121,7 +129,7 @@ proc openParser*(p: var Parser, fileIdx: FileIndex, inputstream: PLLStream; proc setupParser*(p: var Parser; fileIdx: FileIndex; cache: IdentCache; config: ConfigRef): bool = let filename = toFullPathConsiderDirty(config, fileIdx) - var f: File + var f: File = default(File) if not open(f, filename.string): rawMessage(config, errGenerated, "cannot open file: " & filename.string) return false @@ -129,7 +137,9 @@ proc setupParser*(p: var Parser; fileIdx: FileIndex; cache: IdentCache; result = true proc parseFile*(fileIdx: FileIndex; cache: IdentCache; config: ConfigRef): PNode = - var p: Parser + var p: Parser = default(Parser) if setupParser(p, fileIdx, cache, config): result = parseAll(p) closeParser(p) + else: + result = nil diff --git a/compiler/tccgen.nim b/compiler/tccgen.nim index ba553906a..9ee8516c4 100644 --- a/compiler/tccgen.nim +++ b/compiler/tccgen.nim @@ -14,7 +14,7 @@ const tinyPrefix = "dist/nim-tinyc-archive".unixToNativePath const nimRoot = currentSourcePath.parentDir.parentDir const tinycRoot = nimRoot / tinyPrefix when not dirExists(tinycRoot): - static: doAssert false, $(tinycRoot, "requires: ./koch installdeps tinyc") + static: raiseAssert $(tinycRoot, "requires: ./koch installdeps tinyc") {.compile: tinycRoot / "tinyc/libtcc.c".} var @@ -48,15 +48,15 @@ proc setupEnvironment = var tinycRoot = nimDir / tinyPrefix let libpath = nimDir / "lib" - addIncludePath(gTinyC, libpath) + addIncludePath(gTinyC, cstring(libpath)) when defined(windows): - addSysincludePath(gTinyC, tinycRoot / "tinyc/win32/include") - addSysincludePath(gTinyC, tinycRoot / "tinyc/include") + addSysincludePath(gTinyC, cstring(tinycRoot / "tinyc/win32/include")) + addSysincludePath(gTinyC, cstring(tinycRoot / "tinyc/include")) when defined(windows): defineSymbol(gTinyC, "_WIN32", nil) # we need Mingw's headers too: var gccbin = getConfigVar("gcc.path") % ["nim", tinycRoot] - addSysincludePath(gTinyC, gccbin /../ "include") + addSysincludePath(gTinyC, cstring(gccbin /../ "include")) #addFile(tinycRoot / r"tinyc\win32\wincrt1.o") addFile(tinycRoot / r"tinyc\win32\alloca86.o") addFile(tinycRoot / r"tinyc\win32\chkstk.o") diff --git a/compiler/transf.nim b/compiler/transf.nim index d2d9156aa..8dd24e090 100644 --- a/compiler/transf.nim +++ b/compiler/transf.nim @@ -18,20 +18,29 @@ # * performs lambda lifting for closure support # * transforms 'defer' into a 'try finally' statement +import std / tables + import options, ast, astalgo, trees, msgs, idents, renderer, types, semfold, magicsys, cgmeth, lowerings, liftlocals, modulegraphs, lineinfos -proc transformBody*(g: ModuleGraph; idgen: IdGenerator, prc: PSym, cache: bool): PNode +when defined(nimPreviewSlimSystem): + import std/assertions + +type + TransformFlag* = enum + useCache, keepOpenArrayConversions, force + TransformFlags* = set[TransformFlag] + +proc transformBody*(g: ModuleGraph; idgen: IdGenerator; prc: PSym; flags: TransformFlags): PNode import closureiters, lambdalifting type - PTransCon = ref TTransCon - TTransCon{.final.} = object # part of TContext; stackable - mapping: TIdNodeTable # mapping from symbols to nodes + PTransCon = ref object # part of TContext; stackable + mapping: Table[ItemId, PNode] # mapping from symbols to nodes owner: PSym # current owner forStmt: PNode # current for stmt forLoopBody: PNode # transformed for loop body @@ -40,16 +49,17 @@ type # if we encounter the 2nd yield statement next: PTransCon # for stacking - TTransfContext = object + PTransf = ref object module: PSym transCon: PTransCon # top of a TransCon stack inlining: int # > 0 if we are in inlining context (copy vars) - nestedProcs: int # > 0 if we are in a nested proc contSyms, breakSyms: seq[PSym] # to transform 'continue' and 'break' deferDetected, tooEarly: bool + isIntroducingNewLocalVars: bool # true if we are in `introducingNewLocalVars` (don't transform yields) + inAddr: bool + flags: TransformFlags graph: ModuleGraph idgen: IdGenerator - PTransf = ref TTransfContext proc newTransNode(a: PNode): PNode {.inline.} = result = shallowCopy(a) @@ -64,15 +74,12 @@ proc newTransNode(kind: TNodeKind, n: PNode, sons: int): PNode {.inline.} = var x = newNodeIT(kind, n.info, n.typ) newSeq(x.sons, sons) - x.typ = n.typ # x.flags = n.flags result = x proc newTransCon(owner: PSym): PTransCon = assert owner != nil - new(result) - initIdNodeTable(result.mapping) - result.owner = owner + result = PTransCon(mapping: initTable[ItemId, PNode](), owner: owner) proc pushTransCon(c: PTransf, t: PTransCon) = t.next = c.transCon @@ -87,11 +94,11 @@ proc getCurrOwner(c: PTransf): PSym = else: result = c.module proc newTemp(c: PTransf, typ: PType, info: TLineInfo): PNode = - let r = newSym(skTemp, getIdent(c.graph.cache, genPrefix), nextSymId(c.idgen), getCurrOwner(c), info) + let r = newSym(skTemp, getIdent(c.graph.cache, genPrefix), c.idgen, getCurrOwner(c), info) r.typ = typ #skipTypes(typ, {tyGenericInst, tyAlias, tySink}) incl(r.flags, sfFromGeneric) let owner = getCurrOwner(c) - if owner.isIterator and not c.tooEarly: + if owner.isIterator and not c.tooEarly and not isDefined(c.graph.config, "nimOptIters"): result = freshVarForClosureIter(c.graph, r, c.idgen, owner) else: result = newSymNode(r) @@ -103,16 +110,18 @@ proc transformSons(c: PTransf, n: PNode): PNode = for i in 0..<n.len: result[i] = transform(c, n[i]) -proc newAsgnStmt(c: PTransf, kind: TNodeKind, le: PNode, ri: PNode): PNode = +proc newAsgnStmt(c: PTransf, kind: TNodeKind, le: PNode, ri: PNode; isFirstWrite: bool): PNode = result = newTransNode(kind, ri.info, 2) result[0] = le + if isFirstWrite: + le.flags.incl nfFirstWrite result[1] = ri proc transformSymAux(c: PTransf, n: PNode): PNode = let s = n.sym if s.typ != nil and s.typ.callConv == ccClosure: if s.kind in routineKinds: - discard transformBody(c.graph, c.idgen, s, true) + discard transformBody(c.graph, c.idgen, s, {useCache}+c.flags) if s.kind == skIterator: if c.tooEarly: return n else: return liftIterSym(c.graph, n, c.idgen, getCurrOwner(c)) @@ -126,6 +135,14 @@ proc transformSymAux(c: PTransf, n: PNode): PNode = var tc = c.transCon if sfBorrow in s.flags and s.kind in routineKinds: # simply exchange the symbol: + var s = s + while true: + # Skips over all borrowed procs getting the last proc symbol without an implementation + let body = getBody(c.graph, s) + if body.kind == nkSym and sfBorrow in body.sym.flags and getBody(c.graph, body.sym).kind == nkSym: + s = body.sym + else: + break b = getBody(c.graph, s) if b.kind != nkSym: internalError(c.graph.config, n.info, "wrong AST for borrowed symbol") b = newSymNode(b.sym, n.info) @@ -145,7 +162,7 @@ proc transformSymAux(c: PTransf, n: PNode): PNode = else: b = n while tc != nil: - result = idNodeTableGet(tc.mapping, b.sym) + result = getOrDefault(tc.mapping, b.sym.itemId) if result != nil: # this slightly convoluted way ensures the line info stays correct: if result.kind == nkSym: @@ -160,10 +177,10 @@ proc transformSym(c: PTransf, n: PNode): PNode = proc freshVar(c: PTransf; v: PSym): PNode = let owner = getCurrOwner(c) - if owner.isIterator and not c.tooEarly: + if owner.isIterator and not c.tooEarly and not isDefined(c.graph.config, "nimOptIters"): result = freshVarForClosureIter(c.graph, v, c.idgen, owner) else: - var newVar = copySym(v, nextSymId(c.idgen)) + var newVar = copySym(v, c.idgen) incl(newVar.flags, sfFromGeneric) newVar.owner = owner result = newSymNode(newVar) @@ -175,10 +192,12 @@ proc transformVarSection(c: PTransf, v: PNode): PNode = if it.kind == nkCommentStmt: result[i] = it elif it.kind == nkIdentDefs: - if it[0].kind == nkSym: + var vn = it[0] + if vn.kind == nkPragmaExpr: vn = vn[0] + if vn.kind == nkSym: internalAssert(c.graph.config, it.len == 3) - let x = freshVar(c, it[0].sym) - idNodeTablePut(c.transCon.mapping, it[0].sym, x) + let x = freshVar(c, vn.sym) + c.transCon.mapping[vn.sym.itemId] = x var defs = newTransNode(nkIdentDefs, it.info, 3) if importantComments(c.graph.config): # keep documentation information: @@ -199,7 +218,7 @@ proc transformVarSection(c: PTransf, v: PNode): PNode = for j in 0..<it.len-2: if it[j].kind == nkSym: let x = freshVar(c, it[j].sym) - idNodeTablePut(c.transCon.mapping, it[j].sym, x) + c.transCon.mapping[it[j].sym.itemId] = x defs[j] = x else: defs[j] = transform(c, it[j]) @@ -226,21 +245,21 @@ proc transformConstSection(c: PTransf, v: PNode): PNode = proc hasContinue(n: PNode): bool = case n.kind - of nkEmpty..nkNilLit, nkForStmt, nkParForStmt, nkWhileStmt: discard + of nkEmpty..nkNilLit, nkForStmt, nkParForStmt, nkWhileStmt: result = false of nkContinueStmt: result = true else: + result = false for i in 0..<n.len: if hasContinue(n[i]): return true proc newLabel(c: PTransf, n: PNode): PSym = - result = newSym(skLabel, nil, nextSymId(c.idgen), getCurrOwner(c), n.info) - result.name = getIdent(c.graph.cache, genPrefix) + result = newSym(skLabel, getIdent(c.graph.cache, genPrefix), c.idgen, getCurrOwner(c), n.info) proc transformBlock(c: PTransf, n: PNode): PNode = var labl: PSym if c.inlining > 0: labl = newLabel(c, n[0]) - idNodeTablePut(c.transCon.mapping, n[0].sym, newSymNode(labl)) + c.transCon.mapping[n[0].sym.itemId] = newSymNode(labl) else: labl = if n[0].kind != nkEmpty: @@ -309,6 +328,14 @@ proc introduceNewLocalVars(c: PTransf, n: PNode): PNode = if a.kind == nkSym: n[1] = transformSymAux(c, a) return n + of nkProcDef: # todo optimize nosideeffects? + result = newTransNode(n) + let x = newSymNode(copySym(n[namePos].sym, c.idgen)) + c.transCon.mapping[n[namePos].sym.itemId] = x + result[namePos] = x # we have to copy proc definitions for iters + for i in 1..<n.len: + result[i] = introduceNewLocalVars(c, n[i]) + result[namePos].sym.ast = result else: result = newTransNode(n) for i in 0..<n.len: @@ -354,10 +381,11 @@ proc transformYield(c: PTransf, n: PNode): PNode = case lhs.kind of nkSym: internalAssert c.graph.config, lhs.sym.kind == skForVar - result = newAsgnStmt(c, nkFastAsgn, lhs, rhs) + result = newAsgnStmt(c, nkFastAsgn, lhs, rhs, false) of nkDotExpr: - result = newAsgnStmt(c, nkAsgn, lhs, rhs) + result = newAsgnStmt(c, nkAsgn, lhs, rhs, false) else: + result = nil internalAssert c.graph.config, false result = newTransNode(nkStmtList, n.info, 0) var e = n[0] @@ -366,7 +394,7 @@ proc transformYield(c: PTransf, n: PNode): PNode = if e.typ.isNil: return result # can happen in nimsuggest for unknown reasons if c.transCon.forStmt.len != 3: e = skipConv(e) - if e.kind in {nkPar, nkTupleConstr}: + if e.kind == nkTupleConstr: for i in 0..<e.len: var v = e[i] if v.kind == nkExprColonExpr: v = v[1] @@ -379,45 +407,89 @@ proc transformYield(c: PTransf, n: PNode): PNode = let lhs = c.transCon.forStmt[i] let rhs = transform(c, v) result.add(asgnTo(lhs, rhs)) + elif e.kind notin {nkAddr, nkHiddenAddr}: # no need to generate temp for address operation + # TODO do not use temp for nodes which cannot have side-effects + var tmp = newTemp(c, e.typ, e.info) + let v = newNodeI(nkVarSection, e.info) + v.addVar(tmp, e) + + result.add transform(c, v) + + for i in 0..<c.transCon.forStmt.len - 2: + if c.transCon.forStmt[i].kind == nkVarTuple: + for j in 0..<c.transCon.forStmt[i].len-1: + let lhs = c.transCon.forStmt[i][j] + let rhs = transform(c, newTupleAccess(c.graph, newTupleAccess(c.graph, tmp, i), j)) + result.add(asgnTo(lhs, rhs)) + else: + let lhs = c.transCon.forStmt[i] + let rhs = transform(c, newTupleAccess(c.graph, tmp, i)) + result.add(asgnTo(lhs, rhs)) else: - # Unpack the tuple into the loop variables - # XXX: BUG: what if `n` is an expression with side-effects? for i in 0..<c.transCon.forStmt.len - 2: let lhs = c.transCon.forStmt[i] let rhs = transform(c, newTupleAccess(c.graph, e, i)) result.add(asgnTo(lhs, rhs)) else: if c.transCon.forStmt[0].kind == nkVarTuple: - for i in 0..<c.transCon.forStmt[0].len-1: - let lhs = c.transCon.forStmt[0][i] - let rhs = transform(c, newTupleAccess(c.graph, e, i)) - result.add(asgnTo(lhs, rhs)) + var notLiteralTuple = false # we don't generate temp for tuples with const value: (1, 2, 3) + let ev = e.skipConv + if ev.kind == nkTupleConstr: + for i in ev: + if not isConstExpr(i): + notLiteralTuple = true + break + else: + notLiteralTuple = true + + if e.kind notin {nkAddr, nkHiddenAddr} and notLiteralTuple: + # TODO do not use temp for nodes which cannot have side-effects + var tmp = newTemp(c, e.typ, e.info) + let v = newNodeI(nkVarSection, e.info) + v.addVar(tmp, e) + + result.add transform(c, v) + for i in 0..<c.transCon.forStmt[0].len-1: + let lhs = c.transCon.forStmt[0][i] + let rhs = transform(c, newTupleAccess(c.graph, tmp, i)) + result.add(asgnTo(lhs, rhs)) + else: + for i in 0..<c.transCon.forStmt[0].len-1: + let lhs = c.transCon.forStmt[0][i] + let rhs = transform(c, newTupleAccess(c.graph, e, i)) + result.add(asgnTo(lhs, rhs)) else: let lhs = c.transCon.forStmt[0] let rhs = transform(c, e) result.add(asgnTo(lhs, rhs)) + + # bug #23536; note that the info of forLoopBody should't change + for idx in 0 ..< result.len: + var changeNode = result[idx] + changeNode.info = c.transCon.forStmt.info + for i, child in changeNode: + child.info = changeNode.info + inc(c.transCon.yieldStmts) if c.transCon.yieldStmts <= 1: # common case result.add(c.transCon.forLoopBody) else: # we need to introduce new local variables: + c.isIntroducingNewLocalVars = true # don't transform yields when introducing new local vars result.add(introduceNewLocalVars(c, c.transCon.forLoopBody)) - if result.len > 0: - var changeNode = result[0] - changeNode.info = c.transCon.forStmt.info - for i, child in changeNode: - child.info = changeNode.info + c.isIntroducingNewLocalVars = false -proc transformAddrDeref(c: PTransf, n: PNode, a, b: TNodeKind): PNode = +proc transformAddrDeref(c: PTransf, n: PNode, kinds: TNodeKinds): PNode = result = transformSons(c, n) - if c.graph.config.backend == backendCpp or sfCompileToCpp in c.module.flags: return + # inlining of 'var openarray' iterators; bug #19977 + if n.typ.kind != tyOpenArray and (c.graph.config.backend == backendCpp or sfCompileToCpp in c.module.flags): return var n = result case n[0].kind of nkObjUpConv, nkObjDownConv, nkChckRange, nkChckRangeF, nkChckRange64: var m = n[0][0] - if m.kind == a or m.kind == b: + if m.kind in kinds: # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) n[0][0] = m[0] result = n[0] @@ -427,7 +499,7 @@ proc transformAddrDeref(c: PTransf, n: PNode, a, b: TNodeKind): PNode = result.typ = toVar(result.typ, n.typ.skipTypes(abstractInst).kind, c.idgen) of nkHiddenStdConv, nkHiddenSubConv, nkConv: var m = n[0][1] - if m.kind == a or m.kind == b: + if m.kind in kinds: # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) n[0][1] = m[0] result = n[0] @@ -436,7 +508,15 @@ proc transformAddrDeref(c: PTransf, n: PNode, a, b: TNodeKind): PNode = elif n.typ.skipTypes(abstractInst).kind in {tyVar}: result.typ = toVar(result.typ, n.typ.skipTypes(abstractInst).kind, c.idgen) else: - if n[0].kind == a or n[0].kind == b: + if n[0].kind in kinds and + not (n[0][0].kind == nkSym and n[0][0].sym.kind == skForVar and + n[0][0].typ.skipTypes(abstractVar).kind == tyTuple + ) and not (n[0][0].kind == nkSym and n[0][0].sym.kind == skParam and + n.typ.kind == tyVar and + n.typ.skipTypes(abstractVar).kind == tyOpenArray and + n[0][0].typ.skipTypes(abstractVar).kind == tyString) + : # elimination is harmful to `for tuple unpack` because of newTupleAccess + # it is also harmful to openArrayLoc (var openArray) for strings # addr ( deref ( x )) --> x result = n[0][0] if n.typ.skipTypes(abstractVar).kind != tyOpenArray: @@ -448,7 +528,7 @@ proc generateThunk(c: PTransf; prc: PNode, dest: PType): PNode = # we cannot generate a proper thunk here for GC-safety reasons # (see internal documentation): - if c.graph.config.backend == backendJs: return prc + if jsNoLambdaLifting in c.graph.config.legacyFeatures and c.graph.config.backend == backendJs: return prc result = newNodeIT(nkClosure, prc.info, dest) var conv = newNodeIT(nkHiddenSubConv, prc.info, dest) conv.add(newNodeI(nkEmpty, prc.info)) @@ -494,19 +574,22 @@ proc transformConv(c: PTransf, n: PNode): PNode = else: result = transformSons(c, n) of tyOpenArray, tyVarargs: - result = transform(c, n[1]) - #result = transformSons(c, n) - result.typ = takeType(n.typ, n[1].typ, c.graph, c.idgen) - #echo n.info, " came here and produced ", typeToString(result.typ), - # " from ", typeToString(n.typ), " and ", typeToString(n[1].typ) - of tyCString: + if keepOpenArrayConversions in c.flags: + result = transformSons(c, n) + else: + result = transform(c, n[1]) + #result = transformSons(c, n) + result.typ = takeType(n.typ, n[1].typ, c.graph, c.idgen) + #echo n.info, " came here and produced ", typeToString(result.typ), + # " from ", typeToString(n.typ), " and ", typeToString(n[1].typ) + of tyCstring: if source.kind == tyString: result = newTransNode(nkStringToCString, n, 1) result[0] = transform(c, n[1]) else: result = transformSons(c, n) of tyString: - if source.kind == tyCString: + if source.kind == tyCstring: result = newTransNode(nkCStringToString, n, 1) result[0] = transform(c, n[1]) else: @@ -551,7 +634,7 @@ proc transformConv(c: PTransf, n: PNode): PNode = type TPutArgInto = enum paDirectMapping, paFastAsgn, paFastAsgnTakeTypeFromArg - paVarAsgn, paComplexOpenarray + paVarAsgn, paComplexOpenarray, paViaIndirection proc putArgInto(arg: PNode, formal: PType): TPutArgInto = # This analyses how to treat the mapping "formal <-> arg" in an @@ -569,8 +652,11 @@ proc putArgInto(arg: PNode, formal: PType): TPutArgInto = case arg.kind of nkEmpty..nkNilLit: result = paDirectMapping - of nkDotExpr, nkDerefExpr, nkHiddenDeref, nkAddr, nkHiddenAddr: + of nkDotExpr, nkDerefExpr, nkHiddenDeref: result = putArgInto(arg[0], formal) + of nkAddr, nkHiddenAddr: + result = putArgInto(arg[0], formal) + if result == paViaIndirection: result = paFastAsgn of nkCurly, nkBracket: for i in 0..<arg.len: if putArgInto(arg[i], formal) != paDirectMapping: @@ -583,6 +669,9 @@ proc putArgInto(arg: PNode, formal: PType): TPutArgInto = if putArgInto(a, formal) != paDirectMapping: return paFastAsgn result = paDirectMapping + of nkBracketExpr: + if skipTypes(formal, abstractInst).kind in {tyVar, tyLent}: result = paVarAsgn + else: result = paViaIndirection else: if skipTypes(formal, abstractInst).kind in {tyVar, tyLent}: result = paVarAsgn else: result = paFastAsgn @@ -596,7 +685,7 @@ proc findWrongOwners(c: PTransf, n: PNode) = else: for i in 0..<n.safeLen: findWrongOwners(c, n[i]) -proc isSimpleIteratorVar(c: PTransf; iter: PSym): bool = +proc isSimpleIteratorVar(c: PTransf; iter: PSym; call: PNode; owner: PSym): bool = proc rec(n: PNode; owner: PSym; dangerousYields: var int) = case n.kind of nkEmpty..nkNilLit: discard @@ -608,9 +697,22 @@ proc isSimpleIteratorVar(c: PTransf; iter: PSym): bool = else: for c in n: rec(c, owner, dangerousYields) + proc recSym(n: PNode; owner: PSym; sameOwner: var bool) = + case n.kind + of {nkEmpty..nkNilLit} - {nkSym}: discard + of nkSym: + if n.sym.owner != owner: + sameOwner = false + else: + for c in n: recSym(c, owner, sameOwner) + var dangerousYields = 0 rec(getBody(c.graph, iter), iter, dangerousYields) result = dangerousYields == 0 + # the parameters should be owned by the owner + # bug #22237 + for i in 1..<call.len: + recSym(call[i], owner, result) template destructor(t: PType): PSym = getAttachedOp(c.graph, t, attachedDestructor) @@ -654,7 +756,7 @@ proc transformFor(c: PTransf, n: PNode): PNode = for j in 0..<n[i].len-1: addVar(v, copyTree(n[i][j])) # declare new vars else: - if n[i].kind == nkSym and isSimpleIteratorVar(c, iter): + if n[i].kind == nkSym and isSimpleIteratorVar(c, iter, call, n[i].sym.owner): incl n[i].sym.flags, sfCursor addVar(v, copyTree(n[i])) # declare new vars stmtList.add(v) @@ -678,7 +780,7 @@ proc transformFor(c: PTransf, n: PNode): PNode = let pa = putArgInto(arg, formal.typ) case pa of paDirectMapping: - idNodeTablePut(newC.mapping, formal, arg) + newC.mapping[formal.itemId] = arg of paFastAsgn, paFastAsgnTakeTypeFromArg: var t = formal.typ if pa == paFastAsgnTakeTypeFromArg: @@ -689,25 +791,36 @@ proc transformFor(c: PTransf, n: PNode): PNode = t = arg.typ # generate a temporary and produce an assignment statement: var temp = newTemp(c, t, formal.info) + #incl(temp.sym.flags, sfCursor) addVar(v, temp) - stmtList.add(newAsgnStmt(c, nkFastAsgn, temp, arg)) - idNodeTablePut(newC.mapping, formal, temp) + stmtList.add(newAsgnStmt(c, nkFastAsgn, temp, arg, true)) + newC.mapping[formal.itemId] = temp of paVarAsgn: - assert(skipTypes(formal.typ, abstractInst).kind in {tyVar}) - idNodeTablePut(newC.mapping, formal, arg) + assert(skipTypes(formal.typ, abstractInst).kind in {tyVar, tyLent}) + newC.mapping[formal.itemId] = arg # XXX BUG still not correct if the arg has a side effect! + of paViaIndirection: + let t = formal.typ + let vt = makeVarType(t.owner, t, c.idgen) + vt.flags.incl tfVarIsPtr + var temp = newTemp(c, vt, formal.info) + addVar(v, temp) + var addrExp = newNodeIT(nkHiddenAddr, formal.info, makeVarType(t.owner, t, c.idgen, tyPtr)) + addrExp.add(arg) + stmtList.add(newAsgnStmt(c, nkFastAsgn, temp, addrExp, true)) + newC.mapping[formal.itemId] = newDeref(temp) of paComplexOpenarray: # arrays will deep copy here (pretty bad). var temp = newTemp(c, arg.typ, formal.info) addVar(v, temp) - stmtList.add(newAsgnStmt(c, nkFastAsgn, temp, arg)) - idNodeTablePut(newC.mapping, formal, temp) + stmtList.add(newAsgnStmt(c, nkFastAsgn, temp, arg, true)) + newC.mapping[formal.itemId] = temp - let body = transformBody(c.graph, c.idgen, iter, true) + let body = transformBody(c.graph, c.idgen, iter, {useCache}+c.flags) pushInfoContext(c.graph.config, n.info) inc(c.inlining) stmtList.add(transform(c, body)) - #findWrongOwners(c, stmtList.pnode) + #findWrongOwners(c, stmtList.PNode) dec(c.inlining) popInfoContext(c.graph.config) popTransCon(c) @@ -761,9 +874,13 @@ proc getMergeOp(n: PNode): PSym = nkCallStrLit: if n[0].kind == nkSym and n[0].sym.magic == mConStrStr: result = n[0].sym - else: discard + else: + result = nil + else: result = nil proc flattenTreeAux(d, a: PNode, op: PSym) = + ## Optimizes away the `&` calls in the children nodes and + ## lifts the leaf nodes to the same level as `op2`. let op2 = getMergeOp(a) if op2 != nil and (op2.id == op.id or op.magic != mNone and op2.magic == op.magic): @@ -799,10 +916,6 @@ proc transformCall(c: PTransf, n: PNode): PNode = inc(j) result.add(a) if result.len == 2: result = result[1] - elif magic == mAddr: - result = newTransNode(nkAddr, n, 1) - result[0] = n[1] - result = transformAddrDeref(c, result, nkDerefExpr, nkHiddenDeref) elif magic in {mNBindSym, mTypeOf, mRunnableExamples}: # for bindSym(myconst) we MUST NOT perform constant folding: result = n @@ -856,6 +969,9 @@ proc transformExceptBranch(c: PTransf, n: PNode): PNode = result = transformSons(c, n) proc commonOptimizations*(g: ModuleGraph; idgen: IdGenerator; c: PSym, n: PNode): PNode = + ## Merges adjacent constant expressions of the children of the `&` call into + ## a single constant expression. It also inlines constant expressions which are not + ## complex. result = n for i in 0..<n.safeLen: result[i] = commonOptimizations(g, idgen, c, n[i]) @@ -885,6 +1001,15 @@ proc commonOptimizations*(g: ModuleGraph; idgen: IdGenerator; c: PSym, n: PNode) else: result = n +proc transformDerefBlock(c: PTransf, n: PNode): PNode = + # We transform (block: x)[] to (block: x[]) + let e0 = n[0] + result = shallowCopy(e0) + result.typ = n.typ + for i in 0 ..< e0.len - 1: + result[i] = e0[i] + result[e0.len-1] = newTreeIT(nkHiddenDeref, n.info, n.typ, e0[e0.len-1]) + proc transform(c: PTransf, n: PNode): PNode = when false: var oldDeferAnchor: PNode @@ -951,10 +1076,22 @@ proc transform(c: PTransf, n: PNode): PNode = of nkBreakStmt: result = transformBreak(c, n) of nkCallKinds: result = transformCall(c, n) - of nkAddr, nkHiddenAddr: - result = transformAddrDeref(c, n, nkDerefExpr, nkHiddenDeref) - of nkDerefExpr, nkHiddenDeref: - result = transformAddrDeref(c, n, nkAddr, nkHiddenAddr) + of nkHiddenAddr: + result = transformAddrDeref(c, n, {nkHiddenDeref}) + of nkAddr: + let oldInAddr = c.inAddr + c.inAddr = true + result = transformAddrDeref(c, n, {nkDerefExpr, nkHiddenDeref}) + c.inAddr = oldInAddr + of nkDerefExpr: + result = transformAddrDeref(c, n, {nkAddr, nkHiddenAddr}) + of nkHiddenDeref: + if n[0].kind in {nkBlockExpr, nkBlockStmt}: + # bug #20107 bug #21540. Watch out to not deref the pointer too late. + let e = transformDerefBlock(c, n) + result = transformBlock(c, e) + else: + result = transformAddrDeref(c, n, {nkAddr, nkHiddenAddr}) of nkHiddenStdConv, nkHiddenSubConv, nkConv: result = transformConv(c, n) of nkDiscardStmt: @@ -981,18 +1118,20 @@ proc transform(c: PTransf, n: PNode): PNode = else: result = transformSons(c, n) of nkYieldStmt: - if c.inlining > 0: + if c.inlining > 0 and not c.isIntroducingNewLocalVars: result = transformYield(c, n) else: result = transformSons(c, n) of nkAsgn: result = transformAsgn(c, n) of nkIdentDefs, nkConstDef: - result = n - result[0] = transform(c, n[0]) + result = newTransNode(n) + result[0] = transform(c, skipPragmaExpr(n[0])) # Skip the second son since it only contains an unsemanticized copy of the # variable type used by docgen - result[2] = transform(c, n[2]) + let last = n.len-1 + for i in 1..<last: result[i] = n[i] + result[last] = transform(c, n[last]) # XXX comment handling really sucks: if importantComments(c.graph.config): result.comment = n.comment @@ -1002,8 +1141,10 @@ proc transform(c: PTransf, n: PNode): PNode = # (bug #2604). We need to patch this environment here too: let a = n[1] if a.kind == nkSym: - n[1] = transformSymAux(c, a) - return n + result = copyTree(n) + result[1] = transformSymAux(c, a) + else: + result = n of nkExceptBranch: result = transformExceptBranch(c, n) of nkCheckedFieldExpr: @@ -1021,7 +1162,7 @@ proc transform(c: PTransf, n: PNode): PNode = let exprIsPointerCast = n.kind in {nkCast, nkConv, nkHiddenStdConv} and n.typ != nil and n.typ.kind == tyPointer - if not exprIsPointerCast: + if not exprIsPointerCast and not c.inAddr: var cnst = getConstExpr(c.module, result, c.idgen, c.graph) # we inline constants if they are not complex constants: if cnst != nil and not dontInlineConstant(n, cnst): @@ -1037,13 +1178,8 @@ proc processTransf(c: PTransf, n: PNode, owner: PSym): PNode = popTransCon(c) incl(result.flags, nfTransf) -proc openTransf(g: ModuleGraph; module: PSym, filename: string; idgen: IdGenerator): PTransf = - new(result) - result.contSyms = @[] - result.breakSyms = @[] - result.module = module - result.graph = g - result.idgen = idgen +proc openTransf(g: ModuleGraph; module: PSym, filename: string; idgen: IdGenerator; flags: TransformFlags): PTransf = + result = PTransf(module: module, graph: g, idgen: idgen, flags: flags) proc flattenStmts(n: PNode) = var goOn = true @@ -1086,7 +1222,7 @@ template liftDefer(c, root) = if c.deferDetected: liftDeferAux(root) -proc transformBody*(g: ModuleGraph; idgen: IdGenerator; prc: PSym; cache: bool): PNode = +proc transformBody*(g: ModuleGraph; idgen: IdGenerator; prc: PSym; flags: TransformFlags): PNode = assert prc.kind in routineKinds if prc.transformedBody != nil: @@ -1095,8 +1231,8 @@ proc transformBody*(g: ModuleGraph; idgen: IdGenerator; prc: PSym; cache: bool): result = getBody(g, prc) else: prc.transformedBody = newNode(nkEmpty) # protects from recursion - var c = openTransf(g, prc.getModule, "", idgen) - result = liftLambdas(g, prc, getBody(g, prc), c.tooEarly, c.idgen) + var c = openTransf(g, prc.getModule, "", idgen, flags) + result = liftLambdas(g, prc, getBody(g, prc), c.tooEarly, c.idgen, flags) result = processTransf(c, result, prc) liftDefer(c, result) result = liftLocalsIfRequested(prc, result, g.cache, g.config, c.idgen) @@ -1106,7 +1242,7 @@ proc transformBody*(g: ModuleGraph; idgen: IdGenerator; prc: PSym; cache: bool): incl(result.flags, nfTransf) - if cache or prc.typ.callConv == ccInline: + if useCache in flags or prc.typ.callConv == ccInline: # genProc for inline procs will be called multiple times from different modules, # it is important to transform exactly once to get sym ids and locations right prc.transformedBody = result @@ -1117,21 +1253,21 @@ proc transformBody*(g: ModuleGraph; idgen: IdGenerator; prc: PSym; cache: bool): #if prc.name.s == "main": # echo "transformed into ", renderTree(result, {renderIds}) -proc transformStmt*(g: ModuleGraph; idgen: IdGenerator; module: PSym, n: PNode): PNode = +proc transformStmt*(g: ModuleGraph; idgen: IdGenerator; module: PSym, n: PNode; flags: TransformFlags = {}): PNode = if nfTransf in n.flags: result = n else: - var c = openTransf(g, module, "", idgen) + var c = openTransf(g, module, "", idgen, flags) result = processTransf(c, n, module) liftDefer(c, result) #result = liftLambdasForTopLevel(module, result) incl(result.flags, nfTransf) -proc transformExpr*(g: ModuleGraph; idgen: IdGenerator; module: PSym, n: PNode): PNode = +proc transformExpr*(g: ModuleGraph; idgen: IdGenerator; module: PSym, n: PNode; flags: TransformFlags = {}): PNode = if nfTransf in n.flags: result = n else: - var c = openTransf(g, module, "", idgen) + var c = openTransf(g, module, "", idgen, flags) result = processTransf(c, n, module) liftDefer(c, result) # expressions are not to be injected with destructor calls as that diff --git a/compiler/trees.nim b/compiler/trees.nim index 05c060595..41b54eb09 100644 --- a/compiler/trees.nim +++ b/compiler/trees.nim @@ -13,6 +13,7 @@ import ast, wordrecg, idents proc cyclicTreeAux(n: PNode, visited: var seq[PNode]): bool = + result = false if n == nil: return for v in visited: if v == n: return true @@ -53,8 +54,13 @@ proc exprStructuralEquivalent*(a, b: PNode; strictSymEquality=false): bool = if not exprStructuralEquivalent(a[i], b[i], strictSymEquality): return result = true + else: + result = false + else: + result = false proc sameTree*(a, b: PNode): bool = + result = false if a == b: result = true elif a != nil and b != nil and a.kind == b.kind: @@ -91,6 +97,7 @@ proc isConstExpr*(n: PNode): bool = n.kind in atomKinds or nfAllConst in n.flags proc isCaseObj*(n: PNode): bool = + result = false if n.kind == nkRecCase: return true for i in 0..<n.safeLen: if n[i].isCaseObj: return true @@ -109,7 +116,7 @@ proc isDeepConstExpr*(n: PNode; preventInheritance = false): bool = let t = n.typ.skipTypes({tyGenericInst, tyDistinct, tyAlias, tySink, tyOwned}) if t.kind in {tyRef, tyPtr} or tfUnion in t.flags: return false if t.kind == tyObject: - if preventInheritance and t[0] != nil: + if preventInheritance and t.baseClass != nil: result = false elif isCaseObj(t.n): result = false @@ -117,7 +124,7 @@ proc isDeepConstExpr*(n: PNode; preventInheritance = false): bool = result = true else: result = true - else: discard + else: result = false proc isRange*(n: PNode): bool {.inline.} = if n.kind in nkCallKinds: @@ -127,16 +134,22 @@ proc isRange*(n: PNode): bool {.inline.} = (callee.kind in {nkClosedSymChoice, nkOpenSymChoice} and callee[1].sym.name.id == ord(wDotDot)): result = true + else: + result = false + else: + result = false proc whichPragma*(n: PNode): TSpecialWord = let key = if n.kind in nkPragmaCallKinds and n.len > 0: n[0] else: n case key.kind of nkIdent: result = whichKeyword(key.ident) of nkSym: result = whichKeyword(key.sym.name) - of nkCast: result = wCast + of nkCast: return wCast of nkClosedSymChoice, nkOpenSymChoice: - result = whichPragma(key[0]) - else: result = wInvalid + return whichPragma(key[0]) + else: return wInvalid + if result in nonPragmaWordsLow..nonPragmaWordsHigh: + result = wInvalid proc isNoSideEffectPragma*(n: PNode): bool = var k = whichPragma(n) @@ -145,12 +158,14 @@ proc isNoSideEffectPragma*(n: PNode): bool = result = k == wNoSideEffect proc findPragma*(n: PNode, which: TSpecialWord): PNode = + result = nil if n.kind == nkPragma: for son in n: if whichPragma(son) == which: return son proc effectSpec*(n: PNode, effectType: TSpecialWord): PNode = + result = nil for i in 0..<n.len: var it = n[i] if it.kind == nkExprColonExpr and whichPragma(it) == effectType: @@ -161,6 +176,7 @@ proc effectSpec*(n: PNode, effectType: TSpecialWord): PNode = return proc propSpec*(n: PNode, effectType: TSpecialWord): PNode = + result = nil for i in 0..<n.len: var it = n[i] if it.kind == nkExprColonExpr and whichPragma(it) == effectType: @@ -182,10 +198,6 @@ proc extractRange*(k: TNodeKind, n: PNode, a, b: int): PNode = result = newNodeI(k, n.info, b-a+1) for i in 0..b-a: result[i] = n[i+a] -proc isTrue*(n: PNode): bool = - n.kind == nkSym and n.sym.kind == skEnumField and n.sym.position != 0 or - n.kind == nkIntLit and n.intVal != 0 - proc getRoot*(n: PNode): PSym = ## ``getRoot`` takes a *path* ``n``. A path is an lvalue expression ## like ``obj.x[i].y``. The *root* of a path is the symbol that can be @@ -194,6 +206,8 @@ proc getRoot*(n: PNode): PSym = of nkSym: if n.sym.kind in {skVar, skResult, skTemp, skLet, skForVar, skParam}: result = n.sym + else: + result = nil of nkDotExpr, nkBracketExpr, nkHiddenDeref, nkDerefExpr, nkObjUpConv, nkObjDownConv, nkCheckedFieldExpr, nkHiddenAddr, nkAddr: result = getRoot(n[0]) @@ -201,7 +215,8 @@ proc getRoot*(n: PNode): PSym = result = getRoot(n[1]) of nkCallKinds: if getMagic(n) == mSlice: result = getRoot(n[1]) - else: discard + else: result = nil + else: result = nil proc stupidStmtListExpr*(n: PNode): bool = for i in 0..<n.len-1: @@ -211,6 +226,13 @@ proc stupidStmtListExpr*(n: PNode): bool = proc dontInlineConstant*(orig, cnst: PNode): bool {.inline.} = # symbols that expand to a complex constant (array, etc.) should not be # inlined, unless it's the empty array: - result = orig.kind != cnst.kind and - cnst.kind in {nkCurly, nkPar, nkTupleConstr, nkBracket, nkObjConstr} and + result = cnst.kind in {nkCurly, nkPar, nkTupleConstr, nkBracket, nkObjConstr} and cnst.len > ord(cnst.kind == nkObjConstr) + +proc isRunnableExamples*(n: PNode): bool = + # Templates and generics don't perform symbol lookups. + result = n.kind == nkSym and n.sym.magic == mRunnableExamples or + n.kind == nkIdent and n.ident.id == ord(wRunnableExamples) + +proc skipAddr*(n: PNode): PNode {.inline.} = + result = if n.kind in {nkAddr, nkHiddenAddr}: n[0] else: n diff --git a/compiler/treetab.nim b/compiler/treetab.nim index 31cc76366..6685c4a89 100644 --- a/compiler/treetab.nim +++ b/compiler/treetab.nim @@ -9,8 +9,12 @@ # Implements a table from trees to trees. Does structural equivalence checking. -import - hashes, ast, astalgo, types +import ast, astalgo, types + +import std/hashes + +when defined(nimPreviewSlimSystem): + import std/assertions proc hashTree*(n: PNode): Hash = if n.isNil: @@ -54,7 +58,11 @@ proc treesEquivalent(a, b: PNode): bool = for i in 0..<a.len: if not treesEquivalent(a[i], b[i]): return result = true + else: + result = false if result: result = sameTypeOrNil(a.typ, b.typ) + else: + result = false proc nodeTableRawGet(t: TNodeTable, k: Hash, key: PNode): int = var h: Hash = k and high(t.data) @@ -79,36 +87,34 @@ proc nodeTableRawInsert(data: var TNodePairSeq, k: Hash, key: PNode, data[h].val = val proc nodeTablePut*(t: var TNodeTable, key: PNode, val: int) = - var n: TNodePairSeq - var k: Hash = hashTree(key) - var index = nodeTableRawGet(t, k, key) + let k = hashTree(key) + let index = nodeTableRawGet(t, k, key) if index >= 0: assert(t.data[index].key != nil) t.data[index].val = val else: if mustRehash(t.data.len, t.counter): - newSeq(n, t.data.len * GrowthFactor) + var n = newSeq[TNodePair](t.data.len * GrowthFactor) for i in 0..high(t.data): if t.data[i].key != nil: nodeTableRawInsert(n, t.data[i].h, t.data[i].key, t.data[i].val) - swap(t.data, n) + t.data = move n nodeTableRawInsert(t.data, k, key, val) inc(t.counter) proc nodeTableTestOrSet*(t: var TNodeTable, key: PNode, val: int): int = - var n: TNodePairSeq - var k: Hash = hashTree(key) - var index = nodeTableRawGet(t, k, key) + let k = hashTree(key) + let index = nodeTableRawGet(t, k, key) if index >= 0: assert(t.data[index].key != nil) result = t.data[index].val else: if mustRehash(t.data.len, t.counter): - newSeq(n, t.data.len * GrowthFactor) + var n = newSeq[TNodePair](t.data.len * GrowthFactor) for i in 0..high(t.data): if t.data[i].key != nil: nodeTableRawInsert(n, t.data[i].h, t.data[i].key, t.data[i].val) - swap(t.data, n) + t.data = move n nodeTableRawInsert(t.data, k, key, val) result = val inc(t.counter) diff --git a/compiler/typeallowed.nim b/compiler/typeallowed.nim index db3735359..39193a42d 100644 --- a/compiler/typeallowed.nim +++ b/compiler/typeallowed.nim @@ -8,10 +8,13 @@ # ## This module contains 'typeAllowed' and friends which check -## for invalid types like 'openArray[var int]'. +## for invalid types like `openArray[var int]`. -import - intsets, ast, renderer, options, semdata, types +import ast, renderer, options, semdata, types +import std/intsets + +when defined(nimPreviewSlimSystem): + import std/assertions type TTypeAllowedFlag* = enum @@ -22,6 +25,9 @@ type taNoUntyped taIsTemplateOrMacro taProcContextIsNotMacro + taIsCastable + taIsDefaultField + taVoid # only allow direct void fields of objects/tuples TTypeAllowedFlags* = set[TTypeAllowedFlag] @@ -43,6 +49,8 @@ proc typeAllowedNode(marker: var IntSet, n: PNode, kind: TSymKind, let it = n[i] result = typeAllowedNode(marker, it, kind, c, flags) if result != nil: break + else: + result = nil proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, c: PContext; flags: TTypeAllowedFlags = {}): PType = @@ -53,14 +61,22 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, if typ == nil: return nil if containsOrIncl(marker, typ.id): return nil var t = skipTypes(typ, abstractInst-{tyTypeDesc, tySink}) + + let flags = if t.kind == tyVoid: flags else: flags-{taVoid} case t.kind of tyVar, tyLent: if kind in {skProc, skFunc, skConst} and (views notin c.features): result = t - elif t.kind == tyLent and kind != skResult and (views notin c.features): + elif taIsOpenArray in flags: + result = t + elif t.kind == tyLent and ((kind != skResult and views notin c.features) or + (kind == skParam and {taIsCastable, taField} * flags == {})): # lent cannot be used as parameters. + # except in the cast environment and as the field of an object + result = t + elif isOutParam(t) and kind != skParam: result = t else: - var t2 = skipTypes(t[0], abstractInst-{tyTypeDesc, tySink}) + var t2 = skipTypes(t.elementType, abstractInst-{tyTypeDesc, tySink}) case t2.kind of tyVar, tyLent: if taHeap notin flags: result = t2 # ``var var`` is illegal on the heap @@ -83,11 +99,11 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, # only closure iterators may be assigned to anything. result = t let f = if kind in {skProc, skFunc}: flags+{taNoUntyped} else: flags - for i in 1..<t.len: + for _, a in t.paramTypes: if result != nil: break - result = typeAllowedAux(marker, t[i], skParam, c, f-{taIsOpenArray}) - if result.isNil and t[0] != nil: - result = typeAllowedAux(marker, t[0], skResult, c, flags) + result = typeAllowedAux(marker, a, skParam, c, f-{taIsOpenArray}) + if result.isNil and t.returnType != nil: + result = typeAllowedAux(marker, t.returnType, skResult, c, flags) of tyTypeDesc: if kind in {skVar, skLet, skConst} and taProcContextIsNotMacro in flags: result = t @@ -96,15 +112,18 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, result = nil of tyUntyped, tyTyped: if kind notin {skParam, skResult} or taNoUntyped in flags: result = t + of tyIterable: + if kind notin {skParam} or taNoUntyped in flags: result = t + # tyIterable is only for templates and macros. of tyStatic: if kind notin {skParam}: result = t of tyVoid: - if taField notin flags: result = t + if taVoid notin flags: result = t of tyTypeClasses: if tfGenericTypeParam in t.flags or taConcept in flags: #or taField notin flags: discard elif t.isResolvedUserTypeClass: - result = typeAllowedAux(marker, t.lastSon, kind, c, flags) + result = typeAllowedAux(marker, t.last, kind, c, flags) elif kind notin {skParam, skResult}: result = t of tyGenericBody, tyGenericParam, tyGenericInvocation, @@ -112,79 +131,82 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, result = t of tyNil: if kind != skConst and kind != skParam: result = t - of tyString, tyBool, tyChar, tyEnum, tyInt..tyUInt64, tyCString, tyPointer: + of tyString, tyBool, tyChar, tyEnum, tyInt..tyUInt64, tyCstring, tyPointer: result = nil of tyOrdinal: if kind != skParam: result = t of tyGenericInst, tyDistinct, tyAlias, tyInferred: - result = typeAllowedAux(marker, lastSon(t), kind, c, flags) + result = typeAllowedAux(marker, skipModifier(t), kind, c, flags) of tyRange: - if skipTypes(t[0], abstractInst-{tyTypeDesc}).kind notin - {tyChar, tyEnum, tyInt..tyFloat128, tyInt..tyUInt64}: result = t + if skipTypes(t.elementType, abstractInst-{tyTypeDesc}).kind notin + {tyChar, tyEnum, tyInt..tyFloat128, tyInt..tyUInt64, tyRange}: result = t of tyOpenArray: # you cannot nest openArrays/sinks/etc. if (kind != skParam or taIsOpenArray in flags) and views notin c.features: result = t else: - result = typeAllowedAux(marker, t[0], kind, c, flags+{taIsOpenArray}) + result = typeAllowedAux(marker, t.elementType, kind, c, flags+{taIsOpenArray}) of tyVarargs: # you cannot nest openArrays/sinks/etc. if kind != skParam or taIsOpenArray in flags: result = t else: - result = typeAllowedAux(marker, t[0], kind, c, flags+{taIsOpenArray}) + result = typeAllowedAux(marker, t.elementType, kind, c, flags+{taIsOpenArray}) of tySink: # you cannot nest openArrays/sinks/etc. - if kind != skParam or taIsOpenArray in flags or t[0].kind in {tySink, tyLent, tyVar}: + if kind != skParam or taIsOpenArray in flags or t.elementType.kind in {tySink, tyLent, tyVar}: result = t else: - result = typeAllowedAux(marker, t[0], kind, c, flags) + result = typeAllowedAux(marker, t.elementType, kind, c, flags) of tyUncheckedArray: if kind != skParam and taHeap notin flags: result = t else: - result = typeAllowedAux(marker, lastSon(t), kind, c, flags-{taHeap}) + result = typeAllowedAux(marker, elementType(t), kind, c, flags-{taHeap}) of tySequence: - if t[0].kind != tyEmpty: - result = typeAllowedAux(marker, t[0], kind, c, flags+{taHeap}) + if t.elementType.kind != tyEmpty: + result = typeAllowedAux(marker, t.elementType, kind, c, flags+{taHeap}) elif kind in {skVar, skLet}: - result = t[0] + result = t.elementType of tyArray: - if t[1].kind == tyTypeDesc: - result = t[1] - elif t[1].kind != tyEmpty: - result = typeAllowedAux(marker, t[1], kind, c, flags) + if t.elementType.kind == tyTypeDesc: + result = t.elementType + elif t.elementType.kind != tyEmpty: + result = typeAllowedAux(marker, t.elementType, kind, c, flags) elif kind in {skVar, skLet}: - result = t[1] + result = t.elementType of tyRef: - if kind == skConst: result = t - else: result = typeAllowedAux(marker, t.lastSon, kind, c, flags+{taHeap}) + if kind == skConst and taIsDefaultField notin flags: result = t + else: result = typeAllowedAux(marker, t.elementType, kind, c, flags+{taHeap}) of tyPtr: - result = typeAllowedAux(marker, t.lastSon, kind, c, flags+{taHeap}) + result = typeAllowedAux(marker, t.elementType, kind, c, flags+{taHeap}) of tySet: - for i in 0..<t.len: - result = typeAllowedAux(marker, t[i], kind, c, flags) - if result != nil: break - of tyObject, tyTuple: + result = typeAllowedAux(marker, t.elementType, kind, c, flags) + of tyObject: if kind in {skProc, skFunc, skConst} and - t.kind == tyObject and t[0] != nil: + t.baseClass != nil and taIsDefaultField notin flags: result = t else: - let flags = flags+{taField} - for i in 0..<t.len: - result = typeAllowedAux(marker, t[i], kind, c, flags) - if result != nil: break + let flags = flags+{taField, taVoid} + result = typeAllowedAux(marker, t.baseClass, kind, c, flags) if result.isNil and t.n != nil: result = typeAllowedNode(marker, t.n, kind, c, flags) + of tyTuple: + let flags = flags+{taField, taVoid} + for a in t.kids: + result = typeAllowedAux(marker, a, kind, c, flags) + if result != nil: break + if result.isNil and t.n != nil: + result = typeAllowedNode(marker, t.n, kind, c, flags) of tyEmpty: if kind in {skVar, skLet}: result = t - of tyProxy: + of tyError: # for now same as error node; we say it's a valid type as it should # prevent cascading errors: result = nil of tyOwned: - if t.len == 1 and t[0].skipTypes(abstractInst).kind in {tyRef, tyPtr, tyProc}: - result = typeAllowedAux(marker, t.lastSon, kind, c, flags+{taHeap}) + if t.hasElementType and t.skipModifier.skipTypes(abstractInst).kind in {tyRef, tyPtr, tyProc}: + result = typeAllowedAux(marker, t.skipModifier, kind, c, flags+{taHeap}) else: result = t of tyConcept: @@ -227,27 +249,27 @@ proc classifyViewTypeAux(marker: var IntSet, t: PType): ViewTypeKind = case t.kind of tyVar: result = mutableView - of tyLent, tyOpenArray: + of tyLent, tyOpenArray, tyVarargs: result = immutableView of tyGenericInst, tyDistinct, tyAlias, tyInferred, tySink, tyOwned, tyUncheckedArray, tySequence, tyArray, tyRef, tyStatic: - result = classifyViewTypeAux(marker, lastSon(t)) + result = classifyViewTypeAux(marker, skipModifier(t)) of tyFromExpr: - if t.len > 0: - result = classifyViewTypeAux(marker, lastSon(t)) + if t.hasElementType: + result = classifyViewTypeAux(marker, skipModifier(t)) else: result = noView of tyTuple: result = noView - for i in 0..<t.len: - result.combine classifyViewTypeAux(marker, t[i]) + for a in t.kids: + result.combine classifyViewTypeAux(marker, a) if result == mutableView: break of tyObject: result = noView if t.n != nil: result = classifyViewTypeNode(marker, t.n) - if t[0] != nil: - result.combine classifyViewTypeAux(marker, t[0]) + if t.baseClass != nil: + result.combine classifyViewTypeAux(marker, t.baseClass) else: # it doesn't matter what these types contain, 'ptr openArray' is not a # view type! @@ -265,7 +287,7 @@ proc directViewType*(t: PType): ViewTypeKind = of tyLent, tyOpenArray: result = immutableView of abstractInst-{tyTypeDesc}: - result = directViewType(t.lastSon) + result = directViewType(t.skipModifier) else: result = noView diff --git a/compiler/types.nim b/compiler/types.nim index a0d43ec09..a441b0ea2 100644 --- a/compiler/types.nim +++ b/compiler/types.nim @@ -10,8 +10,13 @@ # this module contains routines for accessing and iterating over types import - intsets, ast, astalgo, trees, msgs, strutils, platform, renderer, options, - lineinfos, int128, modulegraphs + ast, astalgo, trees, msgs, platform, renderer, options, + lineinfos, int128, modulegraphs, astmsgs, wordrecg + +import std/[intsets, strutils] + +when defined(nimPreviewSlimSystem): + import std/[assertions, formatfloat] type TPreferedDesc* = enum @@ -25,23 +30,49 @@ type preferMixed, # most useful, shows: symbol + resolved symbols if it differs, e.g.: # tuple[a: MyInt{int}, b: float] + preferInlayHint, + preferInferredEffects, + + TTypeRelation* = enum # order is important! + isNone, isConvertible, + 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 + pcmNotIterator + pcmDifferentCallConv proc typeToString*(typ: PType; prefer: TPreferedDesc = preferName): string -template `$`*(typ: PType): string = typeToString(typ) -proc base*(t: PType): PType = - result = t[0] +proc addTypeDeclVerboseMaybe*(result: var string, conf: ConfigRef; typ: PType) = + if optDeclaredLocs in conf.globalOptions: + result.add typeToString(typ, preferMixed) + result.addDeclaredLoc(conf, typ) + else: + result.add typeToString(typ) + +template `$`*(typ: PType): string = typeToString(typ) # ------------------- type iterator: ---------------------------------------- type TTypeIter* = proc (t: PType, closure: RootRef): bool {.nimcall.} # true if iteration should stop - TTypeMutator* = proc (t: PType, closure: RootRef): PType {.nimcall.} # copy t and mutate it TTypePredicate* = proc (t: PType): bool {.nimcall.} proc iterOverType*(t: PType, iter: TTypeIter, closure: RootRef): bool # Returns result of `iter`. -proc mutateType*(t: PType, iter: TTypeMutator, closure: RootRef): PType - # Returns result of `iter`. type TParamsEquality* = enum # they are equal, but their @@ -65,9 +96,6 @@ const tyAlias, tyInferred, tySink, tyLent, tyOwned} abstractRange* = {tyGenericInst, tyRange, tyDistinct, tyOrdinal, tyTypeDesc, tyAlias, tyInferred, tySink, tyOwned} - # see also ast.abstractVarRange - abstractInst* = {tyGenericInst, tyDistinct, tyOrdinal, tyTypeDesc, tyAlias, - tyInferred, tySink, tyOwned} abstractInstOwned* = abstractInst + {tyOwned} skipPtrs* = {tyVar, tyPtr, tyRef, tyGenericInst, tyTypeDesc, tyAlias, tyInferred, tySink, tyLent, tyOwned} @@ -76,18 +104,18 @@ const typedescInst* = abstractInst + {tyTypeDesc, tyOwned, tyUserTypeClass} proc invalidGenericInst*(f: PType): bool = - result = f.kind == tyGenericInst and lastSon(f) == nil + result = f.kind == tyGenericInst and skipModifier(f) == nil proc isPureObject*(typ: PType): bool = var t = typ - while t.kind == tyObject and t[0] != nil: - t = t[0].skipTypes(skipPtrs) + while t.kind == tyObject and t.baseClass != nil: + t = t.baseClass.skipTypes(skipPtrs) result = t.sym != nil and sfPure in t.sym.flags proc isUnsigned*(t: PType): bool = t.skipTypes(abstractInst).kind in {tyChar, tyUInt..tyUInt64} -proc getOrdValue*(n: PNode; onError = high(Int128)): Int128 = +proc getOrdValueAux*(n: PNode, err: var bool): Int128 = var k = n.kind if n.typ != nil and n.typ.skipTypes(abstractInst).kind in {tyChar, tyUInt..tyUInt64}: k = nkUIntLit @@ -103,13 +131,22 @@ proc getOrdValue*(n: PNode; onError = high(Int128)): Int128 = toInt128(n.intVal) of nkNilLit: int128.Zero - of nkHiddenStdConv: getOrdValue(n[1], onError) + of nkHiddenStdConv: + getOrdValueAux(n[1], err) else: - # XXX: The idea behind the introduction of int128 was to finally - # have all calculations numerically far away from any - # overflows. This command just introduces such overflows and - # should therefore really be revisited. - onError + err = true + int128.Zero + +proc getOrdValue*(n: PNode): Int128 = + var err: bool = false + result = getOrdValueAux(n, err) + #assert err == false + +proc getOrdValue*(n: PNode, onError: Int128): Int128 = + var err = false + result = getOrdValueAux(n, err) + if err: + result = onError proc getFloatValue*(n: PNode): BiggestFloat = case n.kind @@ -123,23 +160,6 @@ proc isIntLit*(t: PType): bool {.inline.} = proc isFloatLit*(t: PType): bool {.inline.} = result = t.kind == tyFloat and t.n != nil and t.n.kind == nkFloatLit -proc addDeclaredLoc*(result: var string, conf: ConfigRef; sym: PSym) = - result.add " [$1 declared in $2]" % [sym.kind.toHumanStr, toFileLineCol(conf, sym.info)] - -proc addDeclaredLocMaybe*(result: var string, conf: ConfigRef; sym: PSym) = - if optDeclaredLocs in conf.globalOptions and sym != nil: - addDeclaredLoc(result, conf, sym) - -proc addDeclaredLoc(result: var string, conf: ConfigRef; typ: PType) = - let typ = typ.skipTypes(abstractInst - {tyRange}) - result.add " [$1" % typ.kind.toHumanStr - if typ.sym != nil: - result.add " declared in " & toFileLineCol(conf, typ.sym.info) - result.add "]" - -proc addDeclaredLocMaybe*(result: var string, conf: ConfigRef; typ: PType) = - if optDeclaredLocs in conf.globalOptions: addDeclaredLoc(result, conf, typ) - proc addTypeHeader*(result: var string, conf: ConfigRef; typ: PType; prefer: TPreferedDesc = preferMixed; getDeclarationPath = true) = result.add typeToString(typ, prefer) if getDeclarationPath: result.addDeclaredLoc(conf, typ.sym) @@ -168,10 +188,10 @@ proc getProcHeader*(conf: ConfigRef; sym: PSym; prefer: TPreferedDesc = preferNa proc elemType*(t: PType): PType = assert(t != nil) case t.kind - of tyGenericInst, tyDistinct, tyAlias, tySink: result = elemType(lastSon(t)) - of tyArray: result = t[1] + of tyGenericInst, tyDistinct, tyAlias, tySink: result = elemType(skipModifier(t)) + of tyArray: result = t.elementType of tyError: result = t - else: result = t.lastSon + else: result = t.elementType assert(result != nil) proc enumHasHoles*(t: PType): bool = @@ -184,7 +204,7 @@ proc isOrdinalType*(t: PType, allowEnumWithHoles: bool = false): bool = baseKinds = {tyChar, tyInt..tyInt64, tyUInt..tyUInt64, tyBool, tyEnum} parentKinds = {tyRange, tyOrdinal, tyGenericInst, tyAlias, tySink, tyDistinct} result = (t.kind in baseKinds and (not t.enumHasHoles or allowEnumWithHoles)) or - (t.kind in parentKinds and isOrdinalType(t.lastSon, allowEnumWithHoles)) + (t.kind in parentKinds and isOrdinalType(t.skipModifier, allowEnumWithHoles)) proc iterOverTypeAux(marker: var IntSet, t: PType, iter: TTypeIter, closure: RootRef): bool @@ -196,9 +216,13 @@ proc iterOverNode(marker: var IntSet, n: PNode, iter: TTypeIter, # a leaf result = iterOverTypeAux(marker, n.typ, iter, closure) else: + result = iterOverTypeAux(marker, n.typ, iter, closure) + if result: return for i in 0..<n.len: result = iterOverNode(marker, n[i], iter, closure) if result: return + else: + result = false proc iterOverTypeAux(marker: var IntSet, t: PType, iter: TTypeIter, closure: RootRef): bool = @@ -208,11 +232,15 @@ proc iterOverTypeAux(marker: var IntSet, t: PType, iter: TTypeIter, if result: return if not containsOrIncl(marker, t.id): case t.kind - of tyGenericInst, tyGenericBody, tyAlias, tySink, tyInferred: - result = iterOverTypeAux(marker, lastSon(t), iter, closure) + of tyGenericBody: + # treat as atomic, containsUnresolvedType wants always false, + # containsGenericType always gives true + discard + of tyGenericInst, tyAlias, tySink, tyInferred: + result = iterOverTypeAux(marker, skipModifier(t), iter, closure) else: - for i in 0..<t.len: - result = iterOverTypeAux(marker, t[i], iter, closure) + for a in t.kids: + result = iterOverTypeAux(marker, a, iter, closure) if result: return if t.n != nil and t.kind != tyProc: result = iterOverNode(marker, t.n, iter, closure) @@ -255,14 +283,14 @@ proc searchTypeForAux(t: PType, predicate: TTypePredicate, if result: return case t.kind of tyObject: - if t[0] != nil: - result = searchTypeForAux(t[0].skipTypes(skipPtrs), predicate, marker) + if t.baseClass != nil: + result = searchTypeForAux(t.baseClass.skipTypes(skipPtrs), predicate, marker) if not result: result = searchTypeNodeForAux(t.n, predicate, marker) of tyGenericInst, tyDistinct, tyAlias, tySink: - result = searchTypeForAux(lastSon(t), predicate, marker) + result = searchTypeForAux(skipModifier(t), predicate, marker) of tyArray, tySet, tyTuple: - for i in 0..<t.len: - result = searchTypeForAux(t[i], predicate, marker) + for a in t.kids: + result = searchTypeForAux(a, predicate, marker) if result: return else: discard @@ -278,7 +306,7 @@ proc containsObject*(t: PType): bool = result = searchTypeFor(t, isObjectPredicate) proc isObjectWithTypeFieldPredicate(t: PType): bool = - result = t.kind == tyObject and t[0] == nil and + result = t.kind == tyObject and t.baseClass == nil and not (t.sym != nil and {sfPure, sfInfixCall} * t.sym.flags != {}) and tfFinal notin t.flags @@ -290,7 +318,6 @@ type proc analyseObjectWithTypeFieldAux(t: PType, marker: var IntSet): TTypeFieldResult = - var res: TTypeFieldResult result = frNone if t == nil: return case t.kind @@ -298,20 +325,19 @@ proc analyseObjectWithTypeFieldAux(t: PType, if t.n != nil: if searchTypeNodeForAux(t.n, isObjectWithTypeFieldPredicate, marker): return frEmbedded - for i in 0..<t.len: - var x = t[i] - if x != nil: x = x.skipTypes(skipPtrs) - res = analyseObjectWithTypeFieldAux(x, marker) - if res == frEmbedded: - return frEmbedded - if res == frHeader: result = frHeader + var x = t.baseClass + if x != nil: x = x.skipTypes(skipPtrs) + let res = analyseObjectWithTypeFieldAux(x, marker) + if res == frEmbedded: + return frEmbedded + if res == frHeader: result = frHeader if result == frNone: if isObjectWithTypeFieldPredicate(t): result = frHeader of tyGenericInst, tyDistinct, tyAlias, tySink: - result = analyseObjectWithTypeFieldAux(lastSon(t), marker) + result = analyseObjectWithTypeFieldAux(skipModifier(t), marker) of tyArray, tyTuple: - for i in 0..<t.len: - res = analyseObjectWithTypeFieldAux(t[i], marker) + for a in t.kids: + let res = analyseObjectWithTypeFieldAux(a, marker) if res != frNone: return frEmbedded else: @@ -357,41 +383,68 @@ proc containsHiddenPointer*(typ: PType): bool = # that need to be copied deeply) result = searchTypeFor(typ, isHiddenPointer) -proc canFormAcycleAux(marker: var IntSet, typ: PType, startId: int): bool -proc canFormAcycleNode(marker: var IntSet, n: PNode, startId: int): bool = +proc canFormAcycleAux(g: ModuleGraph; marker: var IntSet, typ: PType, orig: PType, withRef: bool, hasTrace: bool): bool +proc canFormAcycleNode(g: ModuleGraph; marker: var IntSet, n: PNode, orig: PType, withRef: bool, hasTrace: bool): bool = result = false if n != nil: - result = canFormAcycleAux(marker, n.typ, startId) - if not result: - case n.kind - of nkNone..nkNilLit: - discard - else: - for i in 0..<n.len: - result = canFormAcycleNode(marker, n[i], startId) - if result: return + var hasCursor = n.kind == nkSym and sfCursor in n.sym.flags + # cursor fields don't own the refs, which cannot form reference cycles + if hasTrace or not hasCursor: + result = canFormAcycleAux(g, marker, n.typ, orig, withRef, hasTrace) + if not result: + case n.kind + of nkNone..nkNilLit: + discard + else: + for i in 0..<n.len: + result = canFormAcycleNode(g, marker, n[i], orig, withRef, hasTrace) + if result: return + -proc canFormAcycleAux(marker: var IntSet, typ: PType, startId: int): bool = +proc sameBackendType*(x, y: PType): bool +proc canFormAcycleAux(g: ModuleGraph, marker: var IntSet, typ: PType, orig: PType, withRef: bool, hasTrace: bool): bool = result = false if typ == nil: return if tfAcyclic in typ.flags: return var t = skipTypes(typ, abstractInst+{tyOwned}-{tyTypeDesc}) if tfAcyclic in t.flags: return case t.kind - of tyTuple, tyObject, tyRef, tySequence, tyArray, tyOpenArray, tyVarargs: - if not containsOrIncl(marker, t.id): - for i in 0..<t.len: - result = canFormAcycleAux(marker, t[i], startId) + of tyRef, tyPtr, tyUncheckedArray: + if t.kind == tyRef or hasTrace: + if withRef and sameBackendType(t, orig): + result = true + elif not containsOrIncl(marker, t.id): + result = canFormAcycleAux(g, marker, t.elementType, orig, withRef or t.kind != tyUncheckedArray, hasTrace) + of tyObject: + if withRef and sameBackendType(t, orig): + result = true + elif not containsOrIncl(marker, t.id): + var hasTrace = hasTrace + let op = getAttachedOp(g, t.skipTypes({tyRef}), attachedTrace) + if op != nil and sfOverridden in op.flags: + hasTrace = true + if t.baseClass != nil: + result = canFormAcycleAux(g, marker, t.baseClass, orig, withRef, hasTrace) if result: return - if t.n != nil: result = canFormAcycleNode(marker, t.n, startId) - else: - result = t.id == startId + if t.n != nil: result = canFormAcycleNode(g, marker, t.n, orig, withRef, hasTrace) # Inheritance can introduce cyclic types, however this is not relevant # as the type that is passed to 'new' is statically known! # er but we use it also for the write barrier ... - if t.kind == tyObject and tfFinal notin t.flags: + if tfFinal notin t.flags: # damn inheritance may introduce cycles: result = true + of tyTuple: + if withRef and sameBackendType(t, orig): + result = true + elif not containsOrIncl(marker, t.id): + for a in t.kids: + result = canFormAcycleAux(g, marker, a, orig, withRef, hasTrace) + if result: return + of tySequence, tyArray, tyOpenArray, tyVarargs: + if withRef and sameBackendType(t, orig): + result = true + elif not containsOrIncl(marker, t.id): + result = canFormAcycleAux(g, marker, t.elementType, orig, withRef, hasTrace) of tyProc: result = typ.callConv == ccClosure else: discard @@ -399,46 +452,20 @@ proc isFinal*(t: PType): bool = let t = t.skipTypes(abstractInst) result = t.kind != tyObject or tfFinal in t.flags or isPureObject(t) -proc canFormAcycle*(typ: PType): bool = +proc canFormAcycle*(g: ModuleGraph, typ: PType): bool = var marker = initIntSet() - result = canFormAcycleAux(marker, typ, typ.id) - -proc mutateTypeAux(marker: var IntSet, t: PType, iter: TTypeMutator, - closure: RootRef): PType -proc mutateNode(marker: var IntSet, n: PNode, iter: TTypeMutator, - closure: RootRef): PNode = - result = nil - if n != nil: - result = copyNode(n) - result.typ = mutateTypeAux(marker, n.typ, iter, closure) - case n.kind - of nkNone..nkNilLit: - # a leaf - discard - else: - for i in 0..<n.len: - result.add mutateNode(marker, n[i], iter, closure) - -proc mutateTypeAux(marker: var IntSet, t: PType, iter: TTypeMutator, - closure: RootRef): PType = - result = nil - if t == nil: return - result = iter(t, closure) - if not containsOrIncl(marker, t.id): - for i in 0..<t.len: - result[i] = mutateTypeAux(marker, result[i], iter, closure) - if t.n != nil: result.n = mutateNode(marker, t.n, iter, closure) - assert(result != nil) - -proc mutateType(t: PType, iter: TTypeMutator, closure: RootRef): PType = - var marker = initIntSet() - result = mutateTypeAux(marker, t, iter, closure) + let t = skipTypes(typ, abstractInst+{tyOwned}-{tyTypeDesc}) + result = canFormAcycleAux(g, marker, t, t, false, false) proc valueToString(a: PNode): string = case a.kind - of nkCharLit..nkUInt64Lit: result = $a.intVal + of nkCharLit, nkUIntLit..nkUInt64Lit: + result = $cast[uint64](a.intVal) + of nkIntLit..nkInt64Lit: + result = $a.intVal of nkFloatLit..nkFloat128Lit: result = $a.floatVal of nkStrLit..nkTripleStrLit: result = a.strVal + of nkStaticExpr: result = "static(" & a[0].renderTree & ")" else: result = "<invalid value>" proc rangeToStr(n: PNode): string = @@ -460,11 +487,11 @@ const "lent ", "varargs[$1]", "UncheckedArray[$1]", "Error Type", "BuiltInTypeClass", "UserTypeClass", "UserTypeClassInst", "CompositeTypeClass", "inferred", - "and", "or", "not", "any", "static", "TypeFromExpr", "out ", - "void"] + "and", "or", "not", "any", "static", "TypeFromExpr", "concept", # xxx bugfix + "void", "iterable"] const preferToResolveSymbols = {preferName, preferTypeName, preferModuleInfo, - preferGenericArg, preferResolved, preferMixed} + preferGenericArg, preferResolved, preferMixed, preferInlayHint, preferInferredEffects} template bindConcreteTypeToUserTypeClass*(tc, concrete: PType) = tc.add concrete @@ -472,7 +499,7 @@ template bindConcreteTypeToUserTypeClass*(tc, concrete: PType) = # TODO: It would be a good idea to kill the special state of a resolved # concept by switching to tyAlias within the instantiated procs. -# Currently, tyAlias is always skipped with lastSon, which means that +# Currently, tyAlias is always skipped with skipModifier, which means that # we can store information about the matched concept in another position. # Then builtInFieldAccess can be modified to properly read the derived # consts and types stored within the concept. @@ -498,32 +525,31 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = if prefer in preferToResolveSymbols and t.sym != nil and sfAnon notin t.sym.flags and t.kind != tySequence: if t.kind == tyInt and isIntLit(t): - result = t.sym.name.s & " literal(" & $t.n.intVal & ")" - elif t.kind == tyAlias and t[0].kind != tyAlias: - result = typeToString(t[0]) + if prefer == preferInlayHint: + result = t.sym.name.s + else: + result = t.sym.name.s & " literal(" & $t.n.intVal & ")" + elif t.kind == tyAlias and t.elementType.kind != tyAlias: + result = typeToString(t.elementType) elif prefer in {preferResolved, preferMixed}: case t.kind - of IntegralTypes + {tyFloat..tyFloat128} + {tyString, tyCString}: + of IntegralTypes + {tyFloat..tyFloat128} + {tyString, tyCstring}: result = typeToStr[t.kind] of tyGenericBody: - result = typeToString(t.lastSon) + result = typeToString(t.last) of tyCompositeTypeClass: # avoids showing `A[any]` in `proc fun(a: A)` with `A = object[T]` - result = typeToString(t.lastSon.lastSon) + result = typeToString(t.last.last) else: result = t.sym.name.s if prefer == preferMixed and result != t.sym.name.s: result = t.sym.name.s & "{" & result & "}" - elif prefer in {preferName, preferTypeName} or t.sym.owner.isNil: + elif prefer in {preferName, preferTypeName, preferInlayHint, preferInferredEffects} or t.sym.owner.isNil: # note: should probably be: {preferName, preferTypeName, preferGenericArg} result = t.sym.name.s - if t.kind == tyGenericParam and t.len > 0: + if t.kind == tyGenericParam and t.genericParamHasConstraints: result.add ": " - var first = true - for son in t.sons: - if not first: result.add " or " - result.add son.typeToString - first = false + result.add t.elementType.typeToString else: result = t.sym.owner.name.s & '.' & t.sym.name.s result.addTypeFlags(t) @@ -533,39 +559,49 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = if not isIntLit(t) or prefer == preferExported: result = typeToStr[t.kind] else: - if prefer == preferGenericArg: + case prefer: + of preferGenericArg: result = $t.n.intVal + of preferInlayHint: + result = "int" else: result = "int literal(" & $t.n.intVal & ")" - of tyGenericInst, tyGenericInvocation: - result = typeToString(t[0]) & '[' - for i in 1..<t.len-ord(t.kind != tyGenericInvocation): - if i > 1: result.add(", ") - result.add(typeToString(t[i], preferGenericArg)) + of tyGenericInst: + result = typeToString(t.genericHead) & '[' + for needsComma, a in t.genericInstParams: + if needsComma: result.add(", ") + result.add(typeToString(a, preferGenericArg)) + result.add(']') + of tyGenericInvocation: + result = typeToString(t.genericHead) & '[' + for needsComma, a in t.genericInvocationParams: + if needsComma: result.add(", ") + result.add(typeToString(a, preferGenericArg)) result.add(']') of tyGenericBody: - result = typeToString(t.lastSon) & '[' - for i in 0..<t.len-1: + result = typeToString(t.typeBodyImpl) & '[' + for i, a in t.genericBodyParams: if i > 0: result.add(", ") - result.add(typeToString(t[i], preferTypeName)) + result.add(typeToString(a, preferTypeName)) result.add(']') of tyTypeDesc: - if t[0].kind == tyNone: result = "typedesc" - else: result = "typedesc[" & typeToString(t[0]) & "]" + if t.elementType.kind == tyNone: result = "typedesc" + else: result = "typedesc[" & typeToString(t.elementType) & "]" of tyStatic: if prefer == preferGenericArg and t.n != nil: result = t.n.renderTree else: - result = "static[" & (if t.len > 0: typeToString(t[0]) else: "") & "]" + result = "static[" & (if t.hasElementType: typeToString(t.skipModifier) else: "") & "]" if t.n != nil: result.add "(" & renderTree(t.n) & ")" of tyUserTypeClass: if t.sym != nil and t.sym.owner != nil: - if t.isResolvedUserTypeClass: return typeToString(t.lastSon) + if t.isResolvedUserTypeClass: return typeToString(t.last) return t.sym.owner.name.s else: result = "<invalid tyUserTypeClass>" of tyBuiltInTypeClass: - result = case t.base.kind + result = + case t.base.kind of tyVar: "var" of tyRef: "ref" of tyPtr: "ptr" @@ -586,22 +622,20 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = of tyUserTypeClassInst: let body = t.base result = body.sym.name.s & "[" - for i in 1..<t.len - 1: - if i > 1: result.add(", ") - result.add(typeToString(t[i])) + for needsComma, a in t.userTypeClassInstParams: + if needsComma: result.add(", ") + result.add(typeToString(a)) result.add "]" of tyAnd: - for i, son in t.sons: + for i, son in t.ikids: + if i > 0: result.add(" and ") result.add(typeToString(son)) - if i < t.sons.high: - result.add(" and ") of tyOr: - for i, son in t.sons: + for i, son in t.ikids: + if i > 0: result.add(" or ") result.add(typeToString(son)) - if i < t.sons.high: - result.add(" or ") of tyNot: - result = "not " & typeToString(t[0]) + result = "not " & typeToString(t.elementType) of tyUntyped: #internalAssert t.len == 0 result = "untyped" @@ -612,75 +646,75 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = result = "typeof(" & renderTree(t.n) & ")" of tyArray: result = "array" - if t.len > 0: - if t[0].kind == tyRange: - result &= "[" & rangeToStr(t[0].n) & ", " & - typeToString(t[1]) & ']' + if t.hasElementType: + if t.indexType.kind == tyRange: + result &= "[" & rangeToStr(t.indexType.n) & ", " & + typeToString(t.elementType) & ']' else: - result &= "[" & typeToString(t[0]) & ", " & - typeToString(t[1]) & ']' + result &= "[" & typeToString(t.indexType) & ", " & + typeToString(t.elementType) & ']' of tyUncheckedArray: result = "UncheckedArray" - if t.len > 0: - result &= "[" & typeToString(t[0]) & ']' + if t.hasElementType: + result &= "[" & typeToString(t.elementType) & ']' of tySequence: if t.sym != nil and prefer != preferResolved: result = t.sym.name.s else: result = "seq" - if t.len > 0: - result &= "[" & typeToString(t[0]) & ']' + if t.hasElementType: + result &= "[" & typeToString(t.elementType) & ']' of tyOrdinal: result = "ordinal" - if t.len > 0: - result &= "[" & typeToString(t[0]) & ']' + if t.hasElementType: + result &= "[" & typeToString(t.skipModifier) & ']' of tySet: result = "set" - if t.len > 0: - result &= "[" & typeToString(t[0]) & ']' + if t.hasElementType: + result &= "[" & typeToString(t.elementType) & ']' of tyOpenArray: result = "openArray" - if t.len > 0: - result &= "[" & typeToString(t[0]) & ']' + if t.hasElementType: + result &= "[" & typeToString(t.elementType) & ']' of tyDistinct: - result = "distinct " & typeToString(t[0], + result = "distinct " & typeToString(t.elementType, if prefer == preferModuleInfo: preferModuleInfo else: preferTypeName) + of tyIterable: + # xxx factor this pattern + result = "iterable" + if t.hasElementType: + result &= "[" & typeToString(t.skipModifier) & ']' of tyTuple: # we iterate over t.sons here, because t.n may be nil if t.n != nil: result = "tuple[" - assert(t.n.len == t.len) for i in 0..<t.n.len: assert(t.n[i].kind == nkSym) - result.add(t.n[i].sym.name.s & ": " & typeToString(t[i])) + result.add(t.n[i].sym.name.s & ": " & typeToString(t.n[i].sym.typ)) if i < t.n.len - 1: result.add(", ") result.add(']') - elif t.len == 0: + elif t.isEmptyTupleType: result = "tuple[]" + elif t.isSingletonTupleType: + result = "(" + for son in t.kids: + result.add(typeToString(son)) + result.add(",)") else: result = "(" - for i in 0..<t.len: - result.add(typeToString(t[i])) - if i < t.len - 1: result.add(", ") - elif t.len == 1: result.add(",") + for i, son in t.ikids: + if i > 0: result.add ", " + result.add(typeToString(son)) result.add(')') of tyPtr, tyRef, tyVar, tyLent: - result = typeToStr[t.kind] - if t.len >= 2: - setLen(result, result.len-1) - result.add '[' - for i in 0..<t.len: - result.add(typeToString(t[i])) - if i < t.len - 1: result.add(", ") - result.add ']' - else: - result.add typeToString(t[0]) + result = if isOutParam(t): "out " else: typeToStr[t.kind] + result.add typeToString(t.elementType) of tyRange: result = "range " if t.n != nil and t.n.kind == nkRange: result.add rangeToStr(t.n) if prefer != preferExported: - result.add("(" & typeToString(t[0]) & ")") + result.add("(" & typeToString(t.elementType) & ")") of tyProc: result = if tfIterator in t.flags: "iterator " elif t.owner != nil: @@ -693,31 +727,62 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = "proc " if tfUnresolved in t.flags: result.add "[*missing parameters*]" result.add "(" - for i in 1..<t.len: - if t.n != nil and i < t.n.len and t.n[i].kind == nkSym: - result.add(t.n[i].sym.name.s) + for i, a in t.paramTypes: + if i > FirstParamAt: result.add(", ") + let j = paramTypeToNodeIndex(i) + if t.n != nil and j < t.n.len and t.n[j].kind == nkSym: + result.add(t.n[j].sym.name.s) result.add(": ") - result.add(typeToString(t[i])) - if i < t.len - 1: result.add(", ") + result.add(typeToString(a)) result.add(')') - if t.len > 0 and t[0] != nil: result.add(": " & typeToString(t[0])) + if t.returnType != nil: result.add(": " & typeToString(t.returnType)) var prag = if t.callConv == ccNimCall and tfExplicitCallConv notin t.flags: "" else: $t.callConv + var hasImplicitRaises = false + if not isNil(t.owner) and not isNil(t.owner.ast) and (t.owner.ast.len - 1) >= pragmasPos: + let pragmasNode = t.owner.ast[pragmasPos] + let raisesSpec = effectSpec(pragmasNode, wRaises) + if not isNil(raisesSpec): + addSep(prag) + prag.add("raises: ") + prag.add($raisesSpec) + hasImplicitRaises = true if tfNoSideEffect in t.flags: addSep(prag) prag.add("noSideEffect") if tfThread in t.flags: addSep(prag) prag.add("gcsafe") - if t.lockLevel.ord != UnspecifiedLockLevel.ord: + var effectsOfStr = "" + for i, a in t.paramTypes: + let j = paramTypeToNodeIndex(i) + if t.n != nil and j < t.n.len and t.n[j].kind == nkSym and t.n[j].sym.kind == skParam and sfEffectsDelayed in t.n[j].sym.flags: + addSep(effectsOfStr) + effectsOfStr.add(t.n[j].sym.name.s) + if effectsOfStr != "": addSep(prag) - prag.add("locks: " & $t.lockLevel) + prag.add("effectsOf: ") + prag.add(effectsOfStr) + if not hasImplicitRaises and prefer == preferInferredEffects and not isNil(t.owner) and not isNil(t.owner.typ) and not isNil(t.owner.typ.n) and (t.owner.typ.n.len > 0): + let effects = t.owner.typ.n[0] + if effects.kind == nkEffectList and effects.len == effectListLen: + var inferredRaisesStr = "" + let effs = effects[exceptionEffects] + if not isNil(effs): + for eff in items(effs): + if not isNil(eff): + addSep(inferredRaisesStr) + inferredRaisesStr.add($eff.typ) + addSep(prag) + prag.add("raises: <inferred> [") + prag.add(inferredRaisesStr) + prag.add("]") if prag.len != 0: result.add("{." & prag & ".}") of tyVarargs: - result = typeToStr[t.kind] % typeToString(t[0]) + result = typeToStr[t.kind] % typeToString(t.elementType) of tySink: - result = "sink " & typeToString(t[0]) + result = "sink " & typeToString(t.skipModifier) of tyOwned: - result = "owned " & typeToString(t[0]) + result = "owned " & typeToString(t.elementType) else: result = typeToStr[t.kind] result.addTypeFlags(t) @@ -725,17 +790,22 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = proc firstOrd*(conf: ConfigRef; t: PType): Int128 = case t.kind - of tyBool, tyChar, tySequence, tyOpenArray, tyString, tyVarargs, tyProxy: + of tyBool, tyChar, tySequence, tyOpenArray, tyString, tyVarargs, tyError: result = Zero - of tySet, tyVar: result = firstOrd(conf, t[0]) - of tyArray: result = firstOrd(conf, t[0]) + of tySet, tyVar: result = firstOrd(conf, t.elementType) + of tyArray: result = firstOrd(conf, t.indexType) of tyRange: assert(t.n != nil) # range directly given: assert(t.n.kind == nkRange) result = getOrdValue(t.n[0]) of tyInt: - if conf != nil and conf.target.intSize == 4: - result = toInt128(-2147483648) + if conf != nil: + case conf.target.intSize + of 8: result = toInt128(0x8000000000000000'i64) + of 4: result = toInt128(-2147483648) + of 2: result = toInt128(-32768) + of 1: result = toInt128(-128) + else: result = Zero else: result = toInt128(0x8000000000000000'i64) of tyInt8: result = toInt128(-128) @@ -745,23 +815,29 @@ proc firstOrd*(conf: ConfigRef; t: PType): Int128 = of tyUInt..tyUInt64: result = Zero of tyEnum: # if basetype <> nil then return firstOrd of basetype - if t.len > 0 and t[0] != nil: - result = firstOrd(conf, t[0]) + if t.baseClass != nil: + result = firstOrd(conf, t.baseClass) else: if t.n.len > 0: assert(t.n[0].kind == nkSym) result = toInt128(t.n[0].sym.position) + else: + result = Zero of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tySink, - tyStatic, tyInferred, tyUserTypeClasses, tyLent: - result = firstOrd(conf, lastSon(t)) + tyStatic, tyInferred, tyLent: + result = firstOrd(conf, skipModifier(t)) + of tyUserTypeClasses: + result = firstOrd(conf, last(t)) of tyOrdinal: - if t.len > 0: result = firstOrd(conf, lastSon(t)) - else: internalError(conf, "invalid kind for firstOrd(" & $t.kind & ')') - of tyUncheckedArray, tyCString: + if t.hasElementType: result = firstOrd(conf, skipModifier(t)) + else: + result = Zero + fatal(conf, unknownLineInfo, "invalid kind for firstOrd(" & $t.kind & ')') + of tyUncheckedArray, tyCstring: result = Zero else: - internalError(conf, "invalid kind for firstOrd(" & $t.kind & ')') result = Zero + fatal(conf, unknownLineInfo, "invalid kind for firstOrd(" & $t.kind & ')') proc firstFloat*(t: PType): BiggestFloat = case t.kind @@ -770,26 +846,57 @@ proc firstFloat*(t: PType): BiggestFloat = assert(t.n != nil) # range directly given: assert(t.n.kind == nkRange) getFloatValue(t.n[0]) - of tyVar: firstFloat(t[0]) + of tyVar: firstFloat(t.elementType) of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tySink, - tyStatic, tyInferred, tyUserTypeClasses: - firstFloat(lastSon(t)) + tyStatic, tyInferred: + firstFloat(skipModifier(t)) + of tyUserTypeClasses: + firstFloat(last(t)) else: internalError(newPartialConfigRef(), "invalid kind for firstFloat(" & $t.kind & ')') NaN +proc targetSizeSignedToKind*(conf: ConfigRef): TTypeKind = + case conf.target.intSize + of 8: result = tyInt64 + of 4: result = tyInt32 + of 2: result = tyInt16 + else: result = tyNone + +proc targetSizeUnsignedToKind*(conf: ConfigRef): TTypeKind = + case conf.target.intSize + of 8: result = tyUInt64 + of 4: result = tyUInt32 + of 2: result = tyUInt16 + else: result = tyNone + +proc normalizeKind*(conf: ConfigRef, k: TTypeKind): TTypeKind = + case k + of tyInt: + result = conf.targetSizeSignedToKind() + of tyUInt: + result = conf.targetSizeUnsignedToKind() + else: + result = k + proc lastOrd*(conf: ConfigRef; t: PType): Int128 = case t.kind of tyBool: result = toInt128(1'u) of tyChar: result = toInt128(255'u) - of tySet, tyVar: result = lastOrd(conf, t[0]) - of tyArray: result = lastOrd(conf, t[0]) + of tySet, tyVar: result = lastOrd(conf, t.elementType) + of tyArray: result = lastOrd(conf, t.indexType) of tyRange: assert(t.n != nil) # range directly given: assert(t.n.kind == nkRange) result = getOrdValue(t.n[1]) of tyInt: - if conf != nil and conf.target.intSize == 4: result = toInt128(0x7FFFFFFF) + if conf != nil: + case conf.target.intSize + of 8: result = toInt128(0x7FFFFFFFFFFFFFFF'u64) + of 4: result = toInt128(0x7FFFFFFF) + of 2: result = toInt128(0x00007FFF) + of 1: result = toInt128(0x0000007F) + else: result = Zero else: result = toInt128(0x7FFFFFFFFFFFFFFF'u64) of tyInt8: result = toInt128(0x0000007F) of tyInt16: result = toInt128(0x00007FFF) @@ -809,30 +916,38 @@ proc lastOrd*(conf: ConfigRef; t: PType): Int128 = if t.n.len > 0: assert(t.n[^1].kind == nkSym) result = toInt128(t.n[^1].sym.position) + else: + result = Zero of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tySink, - tyStatic, tyInferred, tyUserTypeClasses, tyLent: - result = lastOrd(conf, lastSon(t)) - of tyProxy: result = Zero + tyStatic, tyInferred, tyLent: + result = lastOrd(conf, skipModifier(t)) + of tyUserTypeClasses: + result = lastOrd(conf, last(t)) + of tyError: result = Zero of tyOrdinal: - if t.len > 0: result = lastOrd(conf, lastSon(t)) - else: internalError(conf, "invalid kind for lastOrd(" & $t.kind & ')') + if t.hasElementType: result = lastOrd(conf, skipModifier(t)) + else: + result = Zero + fatal(conf, unknownLineInfo, "invalid kind for lastOrd(" & $t.kind & ')') of tyUncheckedArray: result = Zero else: - internalError(conf, "invalid kind for lastOrd(" & $t.kind & ')') result = Zero + fatal(conf, unknownLineInfo, "invalid kind for lastOrd(" & $t.kind & ')') proc lastFloat*(t: PType): BiggestFloat = case t.kind of tyFloat..tyFloat128: Inf - of tyVar: lastFloat(t[0]) + of tyVar: lastFloat(t.elementType) of tyRange: assert(t.n != nil) # range directly given: assert(t.n.kind == nkRange) getFloatValue(t.n[1]) of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tySink, - tyStatic, tyInferred, tyUserTypeClasses: - lastFloat(lastSon(t)) + tyStatic, tyInferred: + lastFloat(skipModifier(t)) + of tyUserTypeClasses: + lastFloat(last(t)) else: internalError(newPartialConfigRef(), "invalid kind for lastFloat(" & $t.kind & ')') NaN @@ -846,17 +961,19 @@ proc floatRangeCheck*(x: BiggestFloat, t: PType): bool = of tyRange: x in firstFloat(t)..lastFloat(t) of tyVar: - floatRangeCheck(x, t[0]) + floatRangeCheck(x, t.elementType) of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tySink, - tyStatic, tyInferred, tyUserTypeClasses: - floatRangeCheck(x, lastSon(t)) + tyStatic, tyInferred: + floatRangeCheck(x, skipModifier(t)) + of tyUserTypeClasses: + floatRangeCheck(x, last(t)) else: internalError(newPartialConfigRef(), "invalid kind for floatRangeCheck:" & $t.kind) false proc lengthOrd*(conf: ConfigRef; t: PType): Int128 = if t.skipTypes(tyUserTypeClasses).kind == tyDistinct: - result = lengthOrd(conf, t[0]) + result = lengthOrd(conf, t.skipModifier) else: let last = lastOrd(conf, t) let first = firstOrd(conf, t) @@ -879,6 +996,10 @@ type ExactConstraints ExactGcSafety AllowCommonBase + PickyCAliases # be picky about the distinction between 'cint' and 'int32' + IgnoreFlags # used for borrowed functions and methods; ignores the tfVarIsPtr flag + PickyBackendAliases # be picky about different aliases + IgnoreRangeShallow TTypeCmpFlags* = set[TTypeCmpFlag] @@ -891,7 +1012,7 @@ type proc initSameTypeClosure: TSameTypeClosure = # we do the initialization lazily for performance (avoids memory allocations) - discard + result = TSameTypeClosure() proc containsOrIncl(c: var TSameTypeClosure, a, b: PType): bool = result = c.s.len > 0 and c.s.contains((a.id, b.id)) @@ -930,6 +1051,8 @@ proc equalParam(a, b: PSym): TParamsEquality = result = paramsEqual elif b.ast != nil: result = paramsIncompatible + else: + result = paramsNotEqual else: result = paramsNotEqual @@ -974,11 +1097,11 @@ proc sameTuple(a, b: PType, c: var TSameTypeClosure): bool = # two tuples are equivalent iff the names, types and positions are the same; # however, both types may not have any field names (t.n may be nil) which # complicates the matter a bit. - if a.len == b.len: + if sameTupleLengths(a, b): result = true - for i in 0..<a.len: - var x = a[i] - var y = b[i] + for i, aa, bb in tupleTypePairs(a, b): + var x = aa + var y = bb if IgnoreTupleFields in c.flags: x = skipTypes(x, {tyRange, tyGenericInst, tyAlias}) y = skipTypes(y, {tyRange, tyGenericInst, tyAlias}) @@ -997,6 +1120,8 @@ proc sameTuple(a, b: PType, c: var TSameTypeClosure): bool = return false elif a.n != b.n and (a.n == nil or b.n == nil) and IgnoreTupleFields notin c.flags: result = false + else: + result = false template ifFastObjectTypeCheckFailed(a, b: PType, body: untyped) = if tfFromGeneric notin a.flags + b.flags: @@ -1016,6 +1141,8 @@ template ifFastObjectTypeCheckFailed(a, b: PType, body: untyped) = if tfFromGeneric in a.flags * b.flags and a.sym.id == b.sym.id: # ok, we need the expensive structural check body + else: + result = false proc sameObjectTypes*(a, b: PType): bool = # specialized for efficiency (sigmatch uses it) @@ -1053,32 +1180,44 @@ proc sameObjectTree(a, b: PNode, c: var TSameTypeClosure): bool = for i in 0..<a.len: if not sameObjectTree(a[i], b[i], c): return result = true + else: + result = false + else: + result = false + else: + result = false proc sameObjectStructures(a, b: PType, c: var TSameTypeClosure): bool = - # check base types: - if a.len != b.len: return - for i in 0..<a.len: - if not sameTypeOrNilAux(a[i], b[i], c): return - if not sameObjectTree(a.n, b.n, c): return + if not sameTypeOrNilAux(a.baseClass, b.baseClass, c): return false + if not sameObjectTree(a.n, b.n, c): return false result = true proc sameChildrenAux(a, b: PType, c: var TSameTypeClosure): bool = - if a.len != b.len: return false + if not sameTupleLengths(a, b): return false + # XXX This is not tuple specific. result = true - for i in 0..<a.len: - result = sameTypeOrNilAux(a[i], b[i], c) + for _, x, y in tupleTypePairs(a, b): + result = sameTypeOrNilAux(x, y, c) if not result: return proc isGenericAlias*(t: PType): bool = - return t.kind == tyGenericInst and t.lastSon.kind == tyGenericInst + return t.kind == tyGenericInst and t.skipModifier.kind == tyGenericInst + +proc genericAliasDepth*(t: PType): int = + result = 0 + var it = t + while it.isGenericAlias: + it = it.skipModifier + inc result proc skipGenericAlias*(t: PType): PType = - return if t.isGenericAlias: t.lastSon else: t + return if t.isGenericAlias: t.skipModifier else: t proc sameFlags*(a, b: PType): bool {.inline.} = result = eqTypeFlags*a.flags == eqTypeFlags*b.flags proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool = + result = false template cycleCheck() = # believe it or not, the direct check for ``containsOrIncl(c, a, b)`` # increases bootstrapping time from 2.4s to 3.3s on my laptop! So we cheat @@ -1089,69 +1228,103 @@ proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool = inc c.recCheck else: if containsOrIncl(c, a, b): return true + template maybeSkipRange(x: set[TTypeKind]): set[TTypeKind] = + if IgnoreRangeShallow in c.flags: + x + {tyRange} + else: + x + + template withoutShallowFlags(body) = + let oldFlags = c.flags + c.flags.excl IgnoreRangeShallow + body + c.flags = oldFlags if x == y: return true - var a = skipTypes(x, {tyGenericInst, tyAlias}) + let aliasSkipSet = maybeSkipRange({tyAlias}) + var a = skipTypes(x, aliasSkipSet) while a.kind == tyUserTypeClass and tfResolved in a.flags: - a = skipTypes(a[^1], {tyGenericInst, tyAlias}) - var b = skipTypes(y, {tyGenericInst, tyAlias}) + a = skipTypes(a.last, aliasSkipSet) + var b = skipTypes(y, aliasSkipSet) while b.kind == tyUserTypeClass and tfResolved in b.flags: - b = skipTypes(b[^1], {tyGenericInst, tyAlias}) + b = skipTypes(b.last, aliasSkipSet) assert(a != nil) assert(b != nil) - if a.kind != b.kind: - case c.cmp - of dcEq: return false - of dcEqIgnoreDistinct: - while a.kind == tyDistinct: a = a[0] - while b.kind == tyDistinct: b = b[0] - if a.kind != b.kind: return false - of dcEqOrDistinctOf: - while a.kind == tyDistinct: a = a[0] - if a.kind != b.kind: return false - + case c.cmp + of dcEq: + if a.kind != b.kind: return false + of dcEqIgnoreDistinct: + let distinctSkipSet = maybeSkipRange({tyDistinct, tyGenericInst}) + a = a.skipTypes(distinctSkipSet) + b = b.skipTypes(distinctSkipSet) + if a.kind != b.kind: return false + of dcEqOrDistinctOf: + let distinctSkipSet = maybeSkipRange({tyDistinct, tyGenericInst}) + a = a.skipTypes(distinctSkipSet) + if a.kind != b.kind: return false + + #[ + The following code should not run in the case either side is an generic alias, + but it's not presently possible to distinguish the genericinsts from aliases of + objects ie `type A[T] = SomeObject` + ]# # this is required by tunique_type but makes no sense really: - if x.kind == tyGenericInst and IgnoreTupleFields notin c.flags: + if c.cmp == dcEq and x.kind == tyGenericInst and + IgnoreTupleFields notin c.flags and tyDistinct != y.kind: let lhs = x.skipGenericAlias rhs = y.skipGenericAlias - if rhs.kind != tyGenericInst or lhs.base != rhs.base: + if rhs.kind != tyGenericInst or lhs.base != rhs.base or rhs.kidsLen != lhs.kidsLen: return false - for i in 1..<lhs.len - 1: - let ff = rhs[i] - let aa = lhs[i] - if not sameTypeAux(ff, aa, c): return false + withoutShallowFlags: + for ff, aa in underspecifiedPairs(rhs, lhs, 1, -1): + if not sameTypeAux(ff, aa, c): return false return true case a.kind - of tyEmpty, tyChar, tyBool, tyNil, tyPointer, tyString, tyCString, + of tyEmpty, tyChar, tyBool, tyNil, tyPointer, tyString, tyCstring, tyInt..tyUInt64, tyTyped, tyUntyped, tyVoid: result = sameFlags(a, b) + if result and {PickyCAliases, ExactTypeDescValues} <= c.flags: + # additional requirement for the caching of generics for importc'ed types: + # the symbols must be identical too: + let symFlagsA = if a.sym != nil: a.sym.flags else: {} + let symFlagsB = if b.sym != nil: b.sym.flags else: {} + if (symFlagsA+symFlagsB) * {sfImportc, sfExportc} != {}: + result = symFlagsA == symFlagsB + elif result and PickyBackendAliases in c.flags: + let symFlagsA = if a.sym != nil: a.sym.flags else: {} + let symFlagsB = if b.sym != nil: b.sym.flags else: {} + if (symFlagsA+symFlagsB) * {sfImportc, sfExportc} != {}: + result = a.id == b.id + of tyStatic, tyFromExpr: result = exprStructuralEquivalent(a.n, b.n) and sameFlags(a, b) - if result and a.len == b.len and a.len == 1: + if result and sameTupleLengths(a, b) and a.hasElementType: cycleCheck() - result = sameTypeAux(a[0], b[0], c) + result = sameTypeAux(a.skipModifier, b.skipModifier, c) of tyObject: - ifFastObjectTypeCheckFailed(a, b): - cycleCheck() - result = sameObjectStructures(a, b, c) and sameFlags(a, b) + withoutShallowFlags: + ifFastObjectTypeCheckFailed(a, b): + cycleCheck() + result = sameObjectStructures(a, b, c) and sameFlags(a, b) of tyDistinct: cycleCheck() if c.cmp == dcEq: if sameFlags(a, b): ifFastObjectTypeCheckFailed(a, b): - result = sameTypeAux(a[0], b[0], c) + result = sameTypeAux(a.elementType, b.elementType, c) else: - result = sameTypeAux(a[0], b[0], c) and sameFlags(a, b) + result = sameTypeAux(a.elementType, b.elementType, c) and sameFlags(a, b) of tyEnum, tyForward: # XXX generic enums do not make much sense, but require structural checking result = a.id == b.id and sameFlags(a, b) of tyError: result = b.kind == tyError of tyTuple: - cycleCheck() - result = sameTuple(a, b, c) and sameFlags(a, b) + withoutShallowFlags: + cycleCheck() + result = sameTuple(a, b, c) and sameFlags(a, b) of tyTypeDesc: if c.cmp == dcEqIgnoreDistinct: result = false elif ExactTypeDescValues in c.flags: @@ -1164,21 +1337,22 @@ proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool = if result and {ExactGenericParams, ExactTypeDescValues} * c.flags != {}: result = a.sym.position == b.sym.position of tyBuiltInTypeClass: - assert a.len == 1 - assert a[0].len == 0 - assert b.len == 1 - assert b[0].len == 0 - result = a[0].kind == b[0].kind + result = a.elementType.kind == b.elementType.kind and sameFlags(a.elementType, b.elementType) + if result and a.elementType.kind == tyProc and IgnoreCC notin c.flags: + let ecc = a.elementType.flags * {tfExplicitCallConv} + result = ecc == b.elementType.flags * {tfExplicitCallConv} and + (ecc == {} or a.elementType.callConv == b.elementType.callConv) of tyGenericInvocation, tyGenericBody, tySequence, tyOpenArray, tySet, tyRef, tyPtr, tyVar, tyLent, tySink, tyUncheckedArray, tyArray, tyProc, tyVarargs, tyOrdinal, tyCompositeTypeClass, tyUserTypeClass, tyUserTypeClassInst, tyAnd, tyOr, tyNot, tyAnything, tyOwned: cycleCheck() if a.kind == tyUserTypeClass and a.n != nil: return a.n == b.n - result = sameChildrenAux(a, b, c) - if result: + withoutShallowFlags: + result = sameChildrenAux(a, b, c) + if result and IgnoreFlags notin c.flags: if IgnoreTupleFields in c.flags: - result = a.flags * {tfVarIsPtr} == b.flags * {tfVarIsPtr} + result = a.flags * {tfVarIsPtr, tfIsOutParam} == b.flags * {tfVarIsPtr, tfIsOutParam} else: result = sameFlags(a, b) if result and ExactGcSafety in c.flags: @@ -1188,12 +1362,22 @@ proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool = ((ExactConstraints notin c.flags) or sameConstraints(a.n, b.n)) of tyRange: cycleCheck() - result = sameTypeOrNilAux(a[0], b[0], c) and - sameValue(a.n[0], b.n[0]) and + result = sameTypeOrNilAux(a.elementType, b.elementType, c) + if result and IgnoreRangeShallow notin c.flags: + result = sameValue(a.n[0], b.n[0]) and sameValue(a.n[1], b.n[1]) - of tyGenericInst, tyAlias, tyInferred: + of tyAlias, tyInferred, tyIterable: + cycleCheck() + result = sameTypeAux(a.skipModifier, b.skipModifier, c) + of tyGenericInst: + # BUG #23445 + # The type system must distinguish between `T[int] = object #[empty]#` + # and `T[float] = object #[empty]#`! cycleCheck() - result = sameTypeAux(a.lastSon, b.lastSon, c) + withoutShallowFlags: + for ff, aa in underspecifiedPairs(a, b, 1, -1): + if not sameTypeAux(ff, aa, c): return false + result = sameTypeAux(a.skipModifier, b.skipModifier, c) of tyNone: result = false of tyConcept: result = exprStructuralEquivalent(a.n, b.n) @@ -1204,6 +1388,19 @@ proc sameBackendType*(x, y: PType): bool = c.cmp = dcEqIgnoreDistinct result = sameTypeAux(x, y, c) +proc sameBackendTypeIgnoreRange*(x, y: PType): bool = + var c = initSameTypeClosure() + c.flags.incl IgnoreTupleFields + c.flags.incl IgnoreRangeShallow + c.cmp = dcEqIgnoreDistinct + result = sameTypeAux(x, y, c) + +proc sameBackendTypePickyAliases*(x, y: PType): bool = + var c = initSameTypeClosure() + c.flags.incl {IgnoreTupleFields, PickyCAliases, PickyBackendAliases} + c.cmp = dcEqIgnoreDistinct + result = sameTypeAux(x, y, c) + proc compareTypes*(x, y: PType, cmp: TDistinctCompare = dcEq, flags: TTypeCmpFlags = {}): bool = @@ -1228,18 +1425,19 @@ proc inheritanceDiff*(a, b: PType): int = while x != nil: x = skipTypes(x, skipPtrs) if sameObjectTypes(x, b): return - x = x[0] + x = x.baseClass dec(result) var y = b result = 0 while y != nil: y = skipTypes(y, skipPtrs) if sameObjectTypes(y, a): return - y = y[0] + y = y.baseClass inc(result) result = high(int) proc commonSuperclass*(a, b: PType): PType = + result = nil # quick check: are they the same? if sameObjectTypes(a, b): return a @@ -1252,7 +1450,7 @@ proc commonSuperclass*(a, b: PType): PType = while x != nil: x = skipTypes(x, skipPtrs) ancestors.incl(x.id) - x = x[0] + x = x.baseClass var y = b while y != nil: var t = y # bug #7818, save type before skip @@ -1261,17 +1459,10 @@ proc commonSuperclass*(a, b: PType): PType = # bug #7818, defer the previous skipTypes if t.kind != tyGenericInst: t = y return t - y = y[0] - -proc matchType*(a: PType, pattern: openArray[tuple[k:TTypeKind, i:int]], - last: TTypeKind): bool = - var a = a - for k, i in pattern.items: - if a.kind != k: return false - if i >= a.len or a[i] == nil: return false - a = a[i] - result = a.kind == last + y = y.baseClass +proc lacksMTypeField*(typ: PType): bool {.inline.} = + (typ.sym != nil and sfPure in typ.sym.flags) or tfFinal in typ.flags include sizealignoffsetimpl @@ -1282,7 +1473,7 @@ proc computeSize*(conf: ConfigRef; typ: PType): BiggestInt = proc getReturnType*(s: PSym): PType = # Obtains the return type of a iterator/proc/macro/template assert s.kind in skProcKinds - result = s.typ[0] + result = s.typ.returnType proc getAlign*(conf: ConfigRef; typ: PType): BiggestInt = computeSizeAlign(conf, typ) @@ -1308,17 +1499,34 @@ proc containsGenericTypeIter(t: PType, closure: RootRef): bool = proc containsGenericType*(t: PType): bool = result = iterOverType(t, containsGenericTypeIter, nil) +proc containsUnresolvedTypeIter(t: PType, closure: RootRef): bool = + if tfUnresolved in t.flags: return true + case t.kind + of tyStatic: + return t.n == nil + of tyTypeDesc: + if t.base.kind == tyNone: return true + if containsUnresolvedTypeIter(t.base, closure): return true + return false + of tyGenericInvocation, tyGenericParam, tyFromExpr, tyAnything: + return true + else: + return false + +proc containsUnresolvedType*(t: PType): bool = + result = iterOverType(t, containsUnresolvedTypeIter, nil) + proc baseOfDistinct*(t: PType; g: ModuleGraph; idgen: IdGenerator): PType = if t.kind == tyDistinct: - result = t[0] + result = t.elementType else: - result = copyType(t, nextTypeId idgen, t.owner) + result = copyType(t, idgen, t.owner) copyTypeProps(g, idgen.module, result, t) var parent: PType = nil var it = result while it.kind in {tyPtr, tyRef, tyOwned}: parent = it - it = it.lastSon + it = it.elementType if it.kind == tyDistinct and parent != nil: parent[0] = it[0] @@ -1339,6 +1547,27 @@ proc compatibleEffectsAux(se, re: PNode): bool = return false result = true +proc isDefectException*(t: PType): bool +proc compatibleExceptions(se, re: PNode): bool = + if re.isNil: return false + for r in items(re): + block search: + if isDefectException(r.typ): + break search + for s in items(se): + if safeInheritanceDiff(r.typ, s.typ) <= 0: + break search + return false + result = true + +proc hasIncompatibleEffect(se, re: PNode): bool = + result = false + if re.isNil: return false + for r in items(re): + for s in items(se): + if safeInheritanceDiff(r.typ, s.typ) != high(int): + return true + type EffectsCompat* = enum efCompat @@ -1346,11 +1575,15 @@ type efRaisesUnknown efTagsDiffer efTagsUnknown - efLockLevelsDiffer + efEffectsDelayed + efTagsIllegal proc compatibleEffects*(formal, actual: PType): EffectsCompat = # for proc type compatibility checking: assert formal.kind == tyProc and actual.kind == tyProc + #if tfEffectSystemWorkaround in actual.flags: + # return efCompat + if formal.n[0].kind != nkEffectList or actual.n[0].kind != nkEffectList: return efTagsUnknown @@ -1366,7 +1599,7 @@ proc compatibleEffects*(formal, actual: PType): EffectsCompat = if not isNil(se) and se.kind != nkArgList: # spec requires some exception or tag, but we don't know anything: if real.len == 0: return efRaisesUnknown - let res = compatibleEffectsAux(se, real[exceptionEffects]) + let res = compatibleExceptions(se, real[exceptionEffects]) if not res: return efRaisesDiffer let st = spec[tagEffects] @@ -1374,20 +1607,32 @@ proc compatibleEffects*(formal, actual: PType): EffectsCompat = # spec requires some exception or tag, but we don't know anything: if real.len == 0: return efTagsUnknown let res = compatibleEffectsAux(st, real[tagEffects]) - if not res: return efTagsDiffer - if formal.lockLevel.ord < 0 or - actual.lockLevel.ord <= formal.lockLevel.ord: - result = efCompat - else: - result = efLockLevelsDiffer + if not res: + #if tfEffectSystemWorkaround notin actual.flags: + return efTagsDiffer + + let sn = spec[forbiddenEffects] + if not isNil(sn) and sn.kind != nkArgList: + if 0 == real.len: + return efTagsUnknown + elif hasIncompatibleEffect(sn, real[tagEffects]): + return efTagsIllegal + + for i in 1 ..< min(formal.n.len, actual.n.len): + if formal.n[i].sym.flags * {sfEffectsDelayed} != actual.n[i].sym.flags * {sfEffectsDelayed}: + result = efEffectsDelayed + break + + result = efCompat + proc isCompileTimeOnly*(t: PType): bool {.inline.} = - result = t.kind in {tyTypeDesc, tyStatic} + result = t.kind in {tyTypeDesc, tyStatic, tyGenericParam} proc containsCompileTimeOnly*(t: PType): bool = if isCompileTimeOnly(t): return true - for i in 0..<t.len: - if t[i] != nil and isCompileTimeOnly(t[i]): + for a in t.kids: + if a != nil and isCompileTimeOnly(a): return true return false @@ -1396,7 +1641,7 @@ proc safeSkipTypes*(t: PType, kinds: TTypeKinds): PType = result = t var seen = initIntSet() while result.kind in kinds and not containsOrIncl(seen, result.id): - result = lastSon(result) + result = skipModifier(result) type OrdinalType* = enum @@ -1445,10 +1690,9 @@ proc skipConvTakeType*(n: PNode): PNode = proc isEmptyContainer*(t: PType): bool = case t.kind of tyUntyped, tyNil: result = true - of tyArray: result = t[1].kind == tyEmpty - of tySet, tySequence, tyOpenArray, tyVarargs: - result = t[0].kind == tyEmpty - of tyGenericInst, tyAlias, tySink: result = isEmptyContainer(t.lastSon) + of tyArray, tySet, tySequence, tyOpenArray, tyVarargs: + result = t.elementType.kind == tyEmpty + of tyGenericInst, tyAlias, tySink: result = isEmptyContainer(t.skipModifier) else: result = false proc takeType*(formal, arg: PType; g: ModuleGraph; idgen: IdGenerator): PType = @@ -1459,7 +1703,7 @@ proc takeType*(formal, arg: PType; g: ModuleGraph; idgen: IdGenerator): PType = result = formal elif formal.kind in {tyOpenArray, tyVarargs, tySequence} and arg.isEmptyContainer: - let a = copyType(arg.skipTypes({tyGenericInst, tyAlias}), nextTypeId(idgen), arg.owner) + let a = copyType(arg.skipTypes({tyGenericInst, tyAlias}), idgen, arg.owner) copyTypeProps(g, idgen.module, a, arg) a[ord(arg.kind == tyArray)] = formal[0] result = a @@ -1485,6 +1729,83 @@ proc skipHiddenSubConv*(n: PNode; g: ModuleGraph; idgen: IdGenerator): PNode = else: result = n +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: + # Formal is pure, but actual is not + result[0].incl pcmNoSideEffect + result[1] = isNone + + if tfThread in f.flags and a.flags * {tfThread, tfNoSideEffect} == {} and + optThreadAnalysis in c.globalOptions: + # noSideEffect implies ``tfThread``! + result[0].incl pcmNotGcSafe + result[1] = isNone + + if f.flags * {tfIterator} != a.flags * {tfIterator}: + # One of them is an iterator so not convertible + result[0].incl pcmNotIterator + result[1] = isNone + + if f.callConv != a.callConv: + # valid to pass a 'nimcall' thingie to 'closure': + if f.callConv == ccClosure and a.callConv == ccNimCall: + case result[1] + of isInferred: result[1] = isInferredConvertible + of isBothMetaConvertible: result[1] = isBothMetaConvertible + elif result[1] != isNone: result[1] = isConvertible + else: result[0].incl pcmDifferentCallConv + else: + result[1] = isNone + result[0].incl pcmDifferentCallConv + +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 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 processPragmaAndCallConvMismatch(msg: var string, formal, actual: PType, conf: ConfigRef) = + 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 efEffectsDelayed: + msg.add "\n.effectsOf annotations differ" + of efTagsIllegal: + msg.add "\n.notTag catched an illegal effect" + +proc typeNameAndDesc*(t: PType): string = + result = typeToString(t) + let desc = typeToString(t, preferDesc) + if result != desc: + result.add(" = ") + result.add(desc) + proc typeMismatch*(conf: ConfigRef; info: TLineInfo, formal, actual: PType, n: PNode) = if formal.kind != tyError and actual.kind != tyError: let actualStr = typeToString(actual) @@ -1503,20 +1824,18 @@ proc typeMismatch*(conf: ConfigRef; info: TLineInfo, formal, actual: PType, n: P msg.add "\n" msg.add " but expected '$1'" % x if verbose: msg.addDeclaredLoc(conf, formal) - - if formal.kind == tyProc and actual.kind == tyProc: - 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" + var a = formal + var b = actual + if formal.kind == tyArray and actual.kind == tyArray: + a = formal[1] + b = actual[1] + processPragmaAndCallConvMismatch(msg, a, b, conf) + elif formal.kind == tySequence and actual.kind == tySequence: + a = formal[0] + b = actual[0] + processPragmaAndCallConvMismatch(msg, a, b, conf) + else: + processPragmaAndCallConvMismatch(msg, a, b, conf) localError(conf, info, msg) proc isTupleRecursive(t: PType, cycleDetector: var IntSet): bool = @@ -1526,14 +1845,17 @@ proc isTupleRecursive(t: PType, cycleDetector: var IntSet): bool = return true case t.kind of tyTuple: + result = false var cycleDetectorCopy: IntSet - for i in 0..<t.len: - assign(cycleDetectorCopy, cycleDetector) - if isTupleRecursive(t[i], cycleDetectorCopy): + for a in t.kids: + cycleDetectorCopy = cycleDetector + if isTupleRecursive(a, cycleDetectorCopy): return true - of tyAlias, tyRef, tyPtr, tyGenericInst, tyVar, tyLent, tySink, + of tyRef, tyPtr, tyVar, tyLent, tySink, tyArray, tyUncheckedArray, tySequence, tyDistinct: - return isTupleRecursive(t.lastSon, cycleDetector) + return isTupleRecursive(t.elementType, cycleDetector) + of tyAlias, tyGenericInst: + return isTupleRecursive(t.skipModifier, cycleDetector) else: return false @@ -1548,8 +1870,8 @@ proc isException*(t: PType): bool = var t = t.skipTypes(abstractInst) while t.kind == tyObject: if t.sym != nil and t.sym.magic == mException: return true - if t[0] == nil: break - t = skipTypes(t[0], abstractPtrs) + if t.baseClass == nil: break + t = skipTypes(t.baseClass, abstractPtrs) return false proc isDefectException*(t: PType): bool = @@ -1559,8 +1881,20 @@ proc isDefectException*(t: PType): bool = sfSystemModule in t.sym.owner.flags and t.sym.name.s == "Defect": return true - if t[0] == nil: break - t = skipTypes(t[0], abstractPtrs) + if t.baseClass == nil: break + t = skipTypes(t.baseClass, abstractPtrs) + return false + +proc isDefectOrCatchableError*(t: PType): bool = + var t = t.skipTypes(abstractPtrs) + while t.kind == tyObject: + if t.sym != nil and t.sym.owner != nil and + sfSystemModule in t.sym.owner.flags and + (t.sym.name.s == "Defect" or + t.sym.name.s == "CatchableError"): + return true + if t.baseClass == nil: break + t = skipTypes(t.baseClass, abstractPtrs) return false proc isSinkTypeForParam*(t: PType): bool = @@ -1573,3 +1907,31 @@ proc isSinkTypeForParam*(t: PType): bool = result = false else: result = true + +proc lookupFieldAgain*(ty: PType; field: PSym): PSym = + result = nil + var ty = ty + while ty != nil: + ty = ty.skipTypes(skipPtrs) + assert(ty.kind in {tyTuple, tyObject}) + result = lookupInRecord(ty.n, field.name) + if result != nil: break + ty = ty.baseClass + if result == nil: result = field + +proc isCharArrayPtr*(t: PType; allowPointerToChar: bool): bool = + let t = t.skipTypes(abstractInst) + if t.kind == tyPtr: + let pointsTo = t.elementType.skipTypes(abstractInst) + case pointsTo.kind + of tyUncheckedArray: + result = pointsTo.elementType.kind == tyChar + of tyArray: + result = pointsTo.elementType.kind == tyChar and firstOrd(nil, pointsTo.indexType) == 0 and + skipTypes(pointsTo.indexType, {tyRange}).kind in {tyInt..tyInt64} + of tyChar: + result = allowPointerToChar + else: + result = false + else: + result = false diff --git a/compiler/typesrenderer.nim b/compiler/typesrenderer.nim index 0da05d70d..72bcddb05 100644 --- a/compiler/typesrenderer.nim +++ b/compiler/typesrenderer.nim @@ -7,10 +7,21 @@ # distribution, for details about the copyright. # -import renderer, strutils, ast, types +import renderer, ast, types +import std/strutils + +when defined(nimPreviewSlimSystem): + import std/assertions + const defaultParamSeparator* = "," +template mayNormalize(s: string): string = + if toNormalize: + s.nimIdentNormalize + else: + s + proc renderPlainSymbolName*(n: PNode): string = ## Returns the first non '*' nkIdent node from the tree. ## @@ -30,63 +41,82 @@ proc renderPlainSymbolName*(n: PNode): string = result = "" #internalError(n.info, "renderPlainSymbolName() with " & $n.kind) -proc renderType(n: PNode): string = +proc renderType(n: PNode, toNormalize: bool): string = ## Returns a string with the node type or the empty string. + ## This proc should be kept in sync with `toLangSymbols` from + ## ``lib/packages/docutils/dochelpers.nim``. case n.kind: - of nkIdent: result = n.ident.s - of nkSym: result = typeToString(n.sym.typ) + of nkIdent: result = mayNormalize(n.ident.s) + of nkSym: result = mayNormalize(typeToString(n.sym.typ)) of nkVarTy: if n.len == 1: - result = renderType(n[0]) + result = renderType(n[0], toNormalize) else: result = "var" of nkRefTy: if n.len == 1: - result = "ref." & renderType(n[0]) + result = "ref." & renderType(n[0], toNormalize) else: result = "ref" of nkPtrTy: if n.len == 1: - result = "ptr." & renderType(n[0]) + result = "ptr." & renderType(n[0], toNormalize) else: result = "ptr" of nkProcTy: assert n.len != 1 - if n.len > 1: + if n.len > 1 and n[0].kind == nkFormalParams: let params = n[0] - assert params.kind == nkFormalParams assert params.len > 0 result = "proc(" - for i in 1..<params.len: result.add(renderType(params[i]) & ',') + for i in 1..<params.len: result.add(renderType(params[i], toNormalize) & ',') result[^1] = ')' else: result = "proc" of nkIdentDefs: assert n.len >= 3 let typePos = n.len - 2 - let typeStr = renderType(n[typePos]) + let typeStr = renderType(n[typePos], toNormalize) result = typeStr for i in 1..<typePos: assert n[i].kind in {nkSym, nkIdent} result.add(',' & typeStr) of nkTupleTy: result = "tuple[" - for i in 0..<n.len: result.add(renderType(n[i]) & ',') + for i in 0..<n.len: result.add(renderType(n[i], toNormalize) & ',') result[^1] = ']' of nkBracketExpr: assert n.len >= 2 - result = renderType(n[0]) & '[' - for i in 1..<n.len: result.add(renderType(n[i]) & ',') + result = renderType(n[0], toNormalize) & '[' + for i in 1..<n.len: result.add(renderType(n[i], toNormalize) & ',') result[^1] = ']' of nkCommand: - result = renderType(n[0]) + result = renderType(n[0], toNormalize) for i in 1..<n.len: if i > 1: result.add ", " - result.add(renderType(n[i])) + result.add(renderType(n[i], toNormalize)) else: result = "" -proc renderParamTypes(found: var seq[string], n: PNode) = +proc renderParamNames*(n: PNode, toNormalize=false): seq[string] = + ## Returns parameter names of routine `n`. + result = @[] + doAssert n.kind == nkFormalParams + case n.kind + of nkFormalParams: + for i in 1..<n.len: + if n[i].kind == nkIdentDefs: + # These are parameter names + type + default value node. + let typePos = n[i].len - 2 + for j in 0..<typePos: + result.add mayNormalize($n[i][j]) + else: # error + result.add($n[i]) + else: #error + result.add $n + + +proc renderParamTypes*(found: var seq[string], n: PNode, toNormalize=false) = ## Recursive helper, adds to `found` any types, or keeps diving the AST. ## ## The normal `doc` generator doesn't include .typ information, so the @@ -94,12 +124,12 @@ proc renderParamTypes(found: var seq[string], n: PNode) = ## generator does include the information. case n.kind of nkFormalParams: - for i in 1..<n.len: renderParamTypes(found, n[i]) + for i in 1..<n.len: renderParamTypes(found, n[i], toNormalize) of nkIdentDefs: # These are parameter names + type + default value node. let typePos = n.len - 2 assert typePos > 0 - var typeStr = renderType(n[typePos]) + var typeStr = renderType(n[typePos], toNormalize) if typeStr.len < 1 and n[typePos+1].kind != nkEmpty: # Try with the last node, maybe its a default value. let typ = n[typePos+1].typ @@ -111,7 +141,8 @@ proc renderParamTypes(found: var seq[string], n: PNode) = found.add($n) #internalError(n.info, "renderParamTypes(found,n) with " & $n.kind) -proc renderParamTypes*(n: PNode, sep = defaultParamSeparator): string = +proc renderParamTypes*(n: PNode, sep = defaultParamSeparator, + toNormalize=false): string = ## Returns the types contained in `n` joined by `sep`. ## ## This proc expects to be passed as `n` the parameters of any callable. The @@ -120,6 +151,10 @@ proc renderParamTypes*(n: PNode, sep = defaultParamSeparator): string = ## other characters may appear too, like ``[]`` or ``|``. result = "" var found: seq[string] = @[] - renderParamTypes(found, n) + renderParamTypes(found, n, toNormalize) if found.len > 0: result = found.join(sep) + +proc renderOutType*(n: PNode, toNormalize=false): string = + assert n.kind == nkFormalParams + result = renderType(n[0], toNormalize) diff --git a/compiler/varpartitions.nim b/compiler/varpartitions.nim index 7bb626c0a..1711fea46 100644 --- a/compiler/varpartitions.nim +++ b/compiler/varpartitions.nim @@ -32,6 +32,9 @@ import ast, types, lineinfos, options, msgs, renderer, typeallowed, modulegraphs from trees import getMagic, isNoSideEffectPragma, stupidStmtListExpr from isolation_check import canAlias +when defined(nimPreviewSlimSystem): + import std/assertions + type AbstractTime = distinct int @@ -51,6 +54,7 @@ type SubgraphFlag = enum isMutated, # graph might be mutated isMutatedDirectly, # graph is mutated directly by a non-var parameter. + isMutatedByVarParam, # graph is mutated by a var parameter. connectsConstParam # graph is connected to a non-var parameter. VarFlag = enum @@ -94,12 +98,15 @@ type Partitions* = object abstractTime: AbstractTime + defers: seq[PNode] + processDefer: bool s: seq[VarIndex] graphs: seq[MutationInfo] goals: set[Goal] unanalysableMutation: bool inAsgnSource, inConstructor, inNoSideEffectSection: int inConditional, inLoop: int + inConvHasDestructor: int owner: PSym g: ModuleGraph @@ -175,12 +182,18 @@ proc root(v: var Partitions; start: int): int = v.s[it].con = Connection(kind: dependsOn, parent: result) it = next -proc potentialMutation(v: var Partitions; s: PSym; info: TLineInfo) = +proc potentialMutation(v: var Partitions; s: PSym; level: int; info: TLineInfo) = let id = variableId(v, s) if id >= 0: let r = root(v, id) - let flags = if s.kind == skParam and isConstParam(s): - {isMutated, isMutatedDirectly} + let flags = if s.kind == skParam: + if isConstParam(s): + {isMutated, isMutatedDirectly} + elif s.typ.kind == tyVar and level <= 1: + # varParam[i] = v is different from varParam[i][] = v + {isMutatedByVarParam} + else: + {isMutated} else: {isMutated} @@ -276,7 +289,9 @@ proc borrowFromConstExpr(n: PNode): bool = result = true for i in 1..<n.len: if not borrowFromConstExpr(n[i]): return false - else: discard + else: + result = false + else: result = false proc pathExpr(node: PNode; owner: PSym): PNode = #[ From the spec: @@ -339,36 +354,44 @@ proc pathExpr(node: PNode; owner: PSym): PNode = if result == nil and borrowFromConstExpr(n): result = n -proc allRoots(n: PNode; result: var seq[PSym]; followDotExpr = true) = +const + RootEscapes = 1000 # in 'p(r)' we don't know what p does to our poor root. + # so we assume a high level of indirections + +proc allRoots(n: PNode; result: var seq[(PSym, int)]; level: int) = case n.kind of nkSym: if n.sym.kind in {skParam, skVar, skTemp, skLet, skResult, skForVar}: - result.add(n.sym) + result.add((n.sym, level)) - of nkDotExpr, nkDerefExpr, nkBracketExpr, nkHiddenDeref, - nkCheckedFieldExpr, nkAddr, nkHiddenAddr: - if followDotExpr: - allRoots(n[0], result, followDotExpr) + of nkDerefExpr, nkHiddenDeref: + allRoots(n[0], result, level+1) + of nkBracketExpr, nkDotExpr, nkCheckedFieldExpr, nkAddr, nkHiddenAddr: + allRoots(n[0], result, level) of nkExprEqExpr, nkExprColonExpr, nkHiddenStdConv, nkHiddenSubConv, nkConv, nkStmtList, nkStmtListExpr, nkBlockStmt, nkBlockExpr, nkCast, nkObjUpConv, nkObjDownConv: if n.len > 0: - allRoots(n.lastSon, result, followDotExpr) + allRoots(n.lastSon, result, level) of nkCaseStmt, nkObjConstr: for i in 1..<n.len: - allRoots(n[i].lastSon, result, followDotExpr) + allRoots(n[i].lastSon, result, level) of nkIfStmt, nkIfExpr: for i in 0..<n.len: - allRoots(n[i].lastSon, result, followDotExpr) + allRoots(n[i].lastSon, result, level) of nkBracket, nkTupleConstr, nkPar: for i in 0..<n.len: - allRoots(n[i], result, followDotExpr) + allRoots(n[i], result, level-1) of nkCallKinds: if n.typ != nil and n.typ.kind in {tyVar, tyLent}: if n.len > 1: - allRoots(n[1], result, followDotExpr) + # XXX We really need the unwritten RFC here and distinguish between + # proc `[]`(x: var Container): var T # resizes the container + # and + # proc `[]`(x: Container): var T # only allows for slot mutation + allRoots(n[1], result, RootEscapes) else: let m = getMagic(n) case m @@ -378,21 +401,20 @@ proc allRoots(n: PNode; result: var seq[PSym]; followDotExpr = true) = if typ != nil: typ = skipTypes(typ, abstractInst) if typ.kind != tyProc: typ = nil - else: assert(typ.len == typ.n.len) for i in 1 ..< n.len: let it = n[i] - if typ != nil and i < typ.len: + if typ != nil and i < typ.n.len: assert(typ.n[i].kind == nkSym) let paramType = typ.n[i].typ - if not paramType.isCompileTimeOnly and not typ.sons[0].isEmptyType and - canAlias(paramType, typ.sons[0]): - allRoots(it, result, followDotExpr) + if not paramType.isCompileTimeOnly and not typ.returnType.isEmptyType and + canAlias(paramType, typ.returnType): + allRoots(it, result, RootEscapes) else: - allRoots(it, result, followDotExpr) + allRoots(it, result, RootEscapes) of mSlice: - allRoots(n[1], result, followDotExpr) + allRoots(n[1], result, level+1) else: discard "harmless operation" else: @@ -401,22 +423,33 @@ proc allRoots(n: PNode; result: var seq[PSym]; followDotExpr = true) = proc destMightOwn(c: var Partitions; dest: var VarIndex; n: PNode) = ## Analyse if 'n' is an expression that owns the data, if so mark 'dest' ## with 'ownsData'. - if n.typ == nil: return case n.kind of nkEmpty, nkCharLit..nkNilLit: # primitive literals including the empty are harmless: discard - of nkExprEqExpr, nkExprColonExpr, nkHiddenStdConv, nkHiddenSubConv, nkCast, nkConv: + of nkExprEqExpr, nkExprColonExpr, nkHiddenStdConv, nkHiddenSubConv, nkCast: destMightOwn(c, dest, n[1]) + of nkConv: + if hasDestructor(n.typ): + inc c.inConvHasDestructor + destMightOwn(c, dest, n[1]) + dec c.inConvHasDestructor + else: + destMightOwn(c, dest, n[1]) + of nkIfStmt, nkIfExpr: for i in 0..<n.len: + inc c.inConditional destMightOwn(c, dest, n[i].lastSon) + dec c.inConditional of nkCaseStmt: for i in 1..<n.len: + inc c.inConditional destMightOwn(c, dest, n[i].lastSon) + dec c.inConditional of nkStmtList, nkStmtListExpr: if n.len > 0: @@ -460,30 +493,42 @@ proc destMightOwn(c: var Partitions; dest: var VarIndex; n: PNode) = destMightOwn(c, dest, n[0]) of nkCallKinds: - if hasDestructor(n.typ): - # calls do construct, what we construct must be destroyed, - # so dest cannot be a cursor: - dest.flags.incl ownsData - elif n.typ.kind in {tyLent, tyVar}: - # we know the result is derived from the first argument: - var roots: seq[PSym] - allRoots(n[1], roots) - for r in roots: - connect(c, dest.sym, r, n[1].info) + if n.typ != nil: + if hasDestructor(n.typ) or c.inConvHasDestructor > 0: + # calls do construct, what we construct must be destroyed, + # so dest cannot be a cursor: + dest.flags.incl ownsData + elif n.typ.kind in {tyLent, tyVar} and n.len > 1: + # we know the result is derived from the first argument: + var roots: seq[(PSym, int)] = @[] + allRoots(n[1], roots, RootEscapes) + if roots.len == 0 and c.inConditional > 0: + # when in a conditional expression, + # to ensure that the first argument isn't outlived + # by the lvalue, we need find the root, otherwise + # it is probably a local temporary + # (e.g. a return value from a call), + # we should prevent cursorfication + dest.flags.incl preventCursor + else: + for r in roots: + connect(c, dest.sym, r[0], n[1].info) - else: - let magic = if n[0].kind == nkSym: n[0].sym.magic else: mNone - # this list is subtle, we try to answer the question if after 'dest = f(src)' - # there is a connection betwen 'src' and 'dest' so that mutations to 'src' - # also reflect 'dest': - if magic in {mNone, mMove, mSlice, mAppendStrCh, mAppendStrStr, mAppendSeqElem, mArrToSeq}: - for i in 1..<n.len: - # we always have to assume a 'select(...)' like mechanism. - # But at least we do filter out simple POD types from the - # list of dependencies via the 'hasDestructor' check for - # the root's symbol. - if hasDestructor(n[i].typ.skipTypes({tyVar, tySink, tyLent, tyGenericInst, tyAlias})): - destMightOwn(c, dest, n[i]) + else: + let magic = if n[0].kind == nkSym: n[0].sym.magic else: mNone + # this list is subtle, we try to answer the question if after 'dest = f(src)' + # there is a connection betwen 'src' and 'dest' so that mutations to 'src' + # also reflect 'dest': + if magic in {mNone, mMove, mSlice, + mAppendStrCh, mAppendStrStr, mAppendSeqElem, + mArrToSeq, mOpenArrayToSeq}: + for i in 1..<n.len: + # we always have to assume a 'select(...)' like mechanism. + # But at least we do filter out simple POD types from the + # list of dependencies via the 'hasDestructor' check for + # the root's symbol. + if hasDestructor(n[i].typ.skipTypes({tyVar, tySink, tyLent, tyGenericInst, tyAlias})): + destMightOwn(c, dest, n[i]) else: # something we cannot handle: @@ -505,13 +550,17 @@ const proc isConstSym(s: PSym): bool = result = s.kind in {skConst, skLet} or isConstParam(s) +proc toString(n: PNode): string = + if n.kind == nkEmpty: result = "<empty>" + 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 & ", it is not a path expression; " & url) + localError(c.g.config, src.info, "cannot borrow from " & src.toString & ", it is not a path expression; " & url) elif s.kind == nkSym: if dest.kind == skResult: if s.sym.kind != skParam or s.sym.position != 0: @@ -556,23 +605,33 @@ proc borrowingAsgn(c: var Partitions; dest, src: PNode) = if dest.kind == nkSym: if directViewType(dest.typ) != noView: borrowFrom(c, dest.sym, src) - elif dest.kind in {nkHiddenDeref, nkDerefExpr, nkBracketExpr}: - case directViewType(dest[0].typ) - of mutableView: - # we do not borrow, but we use the view to mutate the borrowed - # location: - let viewOrigin = pathExpr(dest, c.owner) - if viewOrigin.kind == nkSym: - let vid = variableId(c, viewOrigin.sym) + else: + let viewOrigin = pathExpr(dest, c.owner) + if viewOrigin != nil and viewOrigin.kind == nkSym: + let viewSym = viewOrigin.sym + let directView = directViewType(dest[0].typ) # check something like result[first] = toOpenArray(s, first, last-1) + # so we don't need to iterate the original type + let originSymbolView = directViewType(viewSym.typ) # find the original symbol which preserves the view type + # var foo: var Object = a + # foo.id = 777 # the type of foo is no view, so we need + # to check the original symbol + let viewSets = {directView, originSymbolView} + + if viewSets * {mutableView, immutableView} != {}: + # we do not borrow, but we use the view to mutate the borrowed + # location: + let vid = variableId(c, viewSym) if vid >= 0: c.s[vid].flags.incl viewDoesMutate - of immutableView: - if dest.kind == nkBracketExpr and dest[0].kind == nkHiddenDeref and - mutableParameter(dest[0][0]): - discard "remains a mutable location anyhow" + #[of immutableView: + if dest.kind == nkBracketExpr and dest[0].kind == nkHiddenDeref and + mutableParameter(dest[0][0]): + discard "remains a mutable location anyhow" + else: + localError(c.g.config, dest.info, "attempt to mutate a borrowed location from an immutable view") + ]# else: - localError(c.g.config, dest.info, "attempt to mutate a borrowed location from an immutable view") - of noView: discard "nothing to do" + discard "nothing to do" proc containsPointer(t: PType): bool = proc wrap(t: PType): bool {.nimcall.} = t.kind in {tyRef, tyPtr} @@ -582,19 +641,20 @@ proc deps(c: var Partitions; dest, src: PNode) = if borrowChecking in c.goals: borrowingAsgn(c, dest, src) - var targets, sources: seq[PSym] - allRoots(dest, targets) - allRoots(src, sources) + var targets: seq[(PSym, int)] = @[] + var sources: seq[(PSym, int)] = @[] + allRoots(dest, targets, 0) + allRoots(src, sources, 0) let destIsComplex = containsPointer(dest.typ) for t in targets: if dest.kind != nkSym and c.inNoSideEffectSection == 0: - potentialMutation(c, t, dest.info) + potentialMutation(c, t[0], t[1], dest.info) if destIsComplex: for s in sources: - connect(c, t, s, dest.info) + connect(c, t[0], s[0], dest.info) if cursorInference in c.goals and src.kind != nkEmpty: let d = pathExpr(dest, c.owner) @@ -602,7 +662,8 @@ proc deps(c: var Partitions; dest, src: PNode) = let vid = variableId(c, d.sym) if vid >= 0: destMightOwn(c, c.s[vid], src) - for s in sources: + for source in sources: + let s = source[0] if s == d.sym: discard "assignments like: it = it.next are fine" elif {sfGlobal, sfThread} * s.flags != {} or hasDisabledAsgn(c.g, s.typ): @@ -626,21 +687,14 @@ proc deps(c: var Partitions; dest, src: PNode) = when explainCursors: echo "D not a cursor ", d.sym, " reassignedTo ", c.s[srcid].reassignedTo c.s[vid].flags.incl preventCursor -const - nodesToIgnoreSet = {nkNone..pred(nkSym), succ(nkSym)..nkNilLit, - nkTypeSection, nkProcDef, nkConverterDef, - nkMethodDef, nkIteratorDef, nkMacroDef, nkTemplateDef, nkLambda, nkDo, - nkFuncDef, nkConstSection, nkConstDef, nkIncludeStmt, nkImportStmt, - nkExportStmt, nkPragma, nkCommentStmt, nkBreakState, - nkTypeOfExpr, nkMixinStmt, nkBindStmt} proc potentialMutationViaArg(c: var Partitions; n: PNode; callee: PType) = if constParameters in c.goals and tfNoSideEffect in callee.flags: discard "we know there are no hidden mutations through an immutable parameter" elif c.inNoSideEffectSection == 0 and containsPointer(n.typ): - var roots: seq[PSym] - allRoots(n, roots) - for r in roots: potentialMutation(c, r, n.info) + var roots: seq[(PSym, int)] = @[] + allRoots(n, roots, RootEscapes) + for r in roots: potentialMutation(c, r[0], r[1], n.info) proc traverse(c: var Partitions; n: PNode) = inc c.abstractTime @@ -658,7 +712,7 @@ proc traverse(c: var Partitions; n: PNode) = for i in 0..<child.len-2: #registerVariable(c, child[i]) deps(c, child[i], last) - of nkAsgn, nkFastAsgn: + of nkAsgn, nkFastAsgn, nkSinkAsgn: traverse(c, n[0]) inc c.inAsgnSource traverse(c, n[1]) @@ -674,20 +728,24 @@ proc traverse(c: var Partitions; n: PNode) = for child in n: traverse(c, child) let parameters = n[0].typ - let L = if parameters != nil: parameters.len else: 0 + let L = if parameters != nil: parameters.signatureLen else: 0 let m = getMagic(n) + if m == mEnsureMove and n[1].kind == nkSym: + # we know that it must be moved so it cannot be a cursor + noCursor(c, n[1].sym) + for i in 1..<n.len: let it = n[i] if i < L: let paramType = parameters[i].skipTypes({tyGenericInst, tyAlias}) if not paramType.isCompileTimeOnly and paramType.kind in {tyVar, tySink, tyOwned}: - var roots: seq[PSym] - allRoots(it, roots) + var roots: seq[(PSym, int)] = @[] + allRoots(it, roots, RootEscapes) if paramType.kind == tyVar: if c.inNoSideEffectSection == 0: - for r in roots: potentialMutation(c, r, it.info) - for r in roots: noCursor(c, r) + for r in roots: potentialMutation(c, r[0], r[1], it.info) + for r in roots: noCursor(c, r[0]) if borrowChecking in c.goals: # a call like 'result.add toOpenArray()' can also be a borrow @@ -695,7 +753,7 @@ proc traverse(c: var Partitions; n: PNode) = # 'paramType[0]' is still a view type, this is not a typo! if directViewType(paramType[0]) == noView and classifyViewType(paramType[0]) != noView: borrowingCall(c, paramType[0], n, i) - elif borrowChecking in c.goals and m == mNone: + elif m == mNone: potentialMutationViaArg(c, n[i], parameters) of nkAddr, nkHiddenAddr: @@ -703,10 +761,10 @@ proc traverse(c: var Partitions; n: PNode) = when false: # XXX investigate if this is required, it doesn't look # like it is! - var roots: seq[PSym] - allRoots(n[0], roots) + var roots: seq[(PSym, int)] + allRoots(n[0], roots, RootEscapes) for r in roots: - potentialMutation(c, r, it.info) + potentialMutation(c, r[0], r[1], it.info) of nkTupleConstr, nkBracket: for child in n: traverse(c, child) @@ -748,6 +806,14 @@ proc traverse(c: var Partitions; n: PNode) = # mutate(graph) # connect(graph, cursorVar) for child in n: traverse(c, child) + + if n.kind == nkWhileStmt: + traverse(c, n[0]) + # variables in while condition has longer alive time than local variables + # in the while loop body + of nkDefer: + if c.processDefer: + for child in n: traverse(c, child) else: for child in n: traverse(c, child) @@ -778,7 +844,11 @@ proc computeLiveRanges(c: var Partitions; n: PNode) = registerVariable(c, child[i]) #deps(c, child[i], last) - of nkAsgn, nkFastAsgn: + if c.inLoop > 0 and child[0].kind == nkSym: # bug #22787 + let vid = variableId(c, child[0].sym) + if child[^1].kind != nkEmpty: + markAsReassigned(c, vid) + of nkAsgn, nkFastAsgn, nkSinkAsgn: computeLiveRanges(c, n[0]) computeLiveRanges(c, n[1]) if n[0].kind == nkSym: @@ -786,6 +856,10 @@ proc computeLiveRanges(c: var Partitions; n: PNode) = if vid >= 0: if n[1].kind == nkSym and (c.s[vid].reassignedTo == 0 or c.s[vid].reassignedTo == n[1].sym.id): c.s[vid].reassignedTo = n[1].sym.id + if c.inConditional > 0 and c.inLoop > 0: + # bug #22200: live ranges with loops and conditionals are too + # complex for our current analysis, so we prevent the cursorfication. + c.s[vid].flags.incl isConditionallyReassigned else: markAsReassigned(c, vid) @@ -805,7 +879,7 @@ proc computeLiveRanges(c: var Partitions; n: PNode) = for child in n: computeLiveRanges(c, child) let parameters = n[0].typ - let L = if parameters != nil: parameters.len else: 0 + let L = if parameters != nil: parameters.signatureLen else: 0 for i in 1..<n.len: let it = n[i] @@ -834,11 +908,21 @@ proc computeLiveRanges(c: var Partitions; n: PNode) = # connect(graph, cursorVar) inc c.inLoop for child in n: computeLiveRanges(c, child) - inc c.inLoop + dec c.inLoop + + if n.kind == nkWhileStmt: + computeLiveRanges(c, n[0]) + # variables in while condition has longer alive time than local variables + # in the while loop body of nkElifBranch, nkElifExpr, nkElse, nkOfBranch: inc c.inConditional for child in n: computeLiveRanges(c, child) dec c.inConditional + of nkDefer: + if c.processDefer: + for child in n: computeLiveRanges(c, child) + else: + c.defers.add n else: for child in n: computeLiveRanges(c, child) @@ -852,13 +936,21 @@ proc computeGraphPartitions*(s: PSym; n: PNode; g: ModuleGraph; goals: set[Goal] registerResult(result, s.ast[resultPos]) computeLiveRanges(result, n) + result.processDefer = true + for i in countdown(len(result.defers)-1, 0): + computeLiveRanges(result, result.defers[i]) + result.processDefer = false # restart the timer for the second pass: result.abstractTime = AbstractTime 0 traverse(result, n) + result.processDefer = true + for i in countdown(len(result.defers)-1, 0): + traverse(result, result.defers[i]) + result.processDefer = false proc dangerousMutation(g: MutationInfo; v: VarIndex): bool = #echo "range ", v.aliveStart, " .. ", v.aliveEnd, " ", v.sym - if isMutated in g.flags: + if {isMutated, isMutatedByVarParam} * g.flags != {}: for m in g.mutations: #echo "mutation ", m if m in v.aliveStart..v.aliveEnd: @@ -915,10 +1007,13 @@ proc computeCursors*(s: PSym; n: PNode; g: ModuleGraph) = if v.flags * {ownsData, preventCursor, isConditionallyReassigned} == {} and v.sym.kind notin {skParam, skResult} and v.sym.flags * {sfThread, sfGlobal} == {} and hasDestructor(v.sym.typ) and - v.sym.typ.skipTypes({tyGenericInst, tyAlias}).kind != tyOwned: + v.sym.typ.skipTypes({tyGenericInst, tyAlias}).kind != tyOwned and + (getAttachedOp(g, v.sym.typ, attachedAsgn) == nil or + sfError notin getAttachedOp(g, v.sym.typ, attachedAsgn).flags): let rid = root(par, i) if par.s[rid].con.kind == isRootOf and dangerousMutation(par.graphs[par.s[rid].con.graphIndex], par.s[i]): discard "cannot cursor into a graph that is mutated" else: v.sym.flags.incl sfCursor - #echo "this is now a cursor ", v.sym, " ", par.s[rid].flags, " ", config $ v.sym.info + when false: + echo "this is now a cursor ", v.sym, " ", par.s[rid].flags, " ", g.config $ v.sym.info diff --git a/compiler/vm.nim b/compiler/vm.nim index c2ff798a7..161b025a6 100644 --- a/compiler/vm.nim +++ b/compiler/vm.nim @@ -10,14 +10,17 @@ ## This file implements the new evaluation engine for Nim code. ## An instruction is 1-3 int32s in memory, it is a register based VM. -import ast except getstr - +import semmacrosanity import - strutils, msgs, vmdef, vmgen, nimsets, types, passes, - parser, vmdeps, idents, trees, renderer, options, transf, parseutils, - vmmarshal, gorgeimpl, lineinfos, tables, btrees, macrocacheimpl, + std/[strutils, tables, parseutils], + msgs, vmdef, vmgen, nimsets, types, + parser, vmdeps, idents, trees, renderer, options, transf, + gorgeimpl, lineinfos, btrees, macrocacheimpl, modulegraphs, sighashes, int128, vmprofiler +when defined(nimPreviewSlimSystem): + import std/formatfloat +import ast except getstr from semfold import leValueConv, ordinalValToString from evaltempl import evalTemplate from magicsys import getSysType @@ -37,7 +40,7 @@ proc stackTraceAux(c: PCtx; x: PStackFrame; pc: int; recursionLimit=100) = while x != nil: inc calls x = x.next - msgWriteln(c.config, $calls & " calls omitted\n") + msgWriteln(c.config, $calls & " calls omitted\n", {msgNoUnitSep}) return stackTraceAux(c, x.next, x.comesFrom, recursionLimit-1) var info = c.debug[pc] @@ -59,20 +62,23 @@ proc stackTraceAux(c: PCtx; x: PStackFrame; pc: int; recursionLimit=100) = 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) + 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)") + 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) +when not defined(nimHasCallsitePragma): + {.pragma: callsite.} + template stackTrace(c: PCtx, tos: PStackFrame, pc: int, - msg: string, lineInfo: TLineInfo = TLineInfo.default) = + msg: string, lineInfo: TLineInfo = TLineInfo.default) {.callsite.} = stackTraceImpl(c, tos, pc, msg, lineInfo, instantiationInfo(-2, fullPaths = true)) return @@ -84,9 +90,9 @@ proc bailOut(c: PCtx; tos: PStackFrame) = when not defined(nimComputedGoto): {.pragma: computedGoto.} -proc ensureKind(n: var TFullReg, kind: TRegisterKind) = - if n.kind != kind: - n = TFullReg(kind: kind) +proc ensureKind(n: var TFullReg, k: TRegisterKind) {.inline.} = + if n.kind != k: + n = TFullReg(kind: k) template ensureKind(k: untyped) {.dirty.} = ensureKind(regs[ra], k) @@ -113,18 +119,22 @@ template decodeBx(k: untyped) {.dirty.} = let rbx = instr.regBx - wordExcess ensureKind(k) -template move(a, b: untyped) {.dirty.} = system.shallowCopy(a, b) -# XXX fix minor 'shallowCopy' overloading bug in compiler +template move(a, b: untyped) {.dirty.} = + when defined(gcArc) or defined(gcOrc) or defined(gcAtomicArc): + a = move b + else: + system.shallowCopy(a, b) + # XXX fix minor 'shallowCopy' overloading bug in compiler proc derefPtrToReg(address: BiggestInt, typ: PType, r: var TFullReg, isAssign: bool): bool = # nim bug: `isAssign: static bool` doesn't work, giving odd compiler error - template fun(field, T, rkind) = + template fun(field, typ, rkind) = if isAssign: - cast[ptr T](address)[] = T(r.field) + cast[ptr typ](address)[] = typ(r.field) else: r.ensureKind(rkind) - let val = cast[ptr T](address)[] - when T is SomeInteger | char: + let val = cast[ptr typ](address)[] + when typ is SomeInteger | char: r.field = BiggestInt(val) else: r.field = val @@ -371,6 +381,7 @@ proc cleanUpOnReturn(c: PCtx; f: PStackFrame): int = return pc + 1 proc opConv(c: PCtx; dest: var TFullReg, src: TFullReg, desttyp, srctyp: PType): bool = + result = false if desttyp.kind == tyString: dest.ensureKind(rkNode) dest.node = newNode(nkStrLit) @@ -399,7 +410,7 @@ proc opConv(c: PCtx; dest: var TFullReg, src: TFullReg, desttyp, srctyp: PType): dest.node.strVal = $src.floatVal of tyString: dest.node.strVal = src.node.strVal - of tyCString: + of tyCstring: if src.node.kind == nkBracket: # Array of chars var strVal = "" @@ -415,7 +426,8 @@ proc opConv(c: PCtx; dest: var TFullReg, src: TFullReg, desttyp, srctyp: PType): else: internalError(c.config, "cannot convert to string " & desttyp.typeToString) else: - case skipTypes(desttyp, abstractVarRange).kind + let desttyp = skipTypes(desttyp, abstractVarRange) + case desttyp.kind of tyInt..tyInt64: dest.ensureKind(rkInt) case skipTypes(srctyp, abstractRange).kind @@ -432,10 +444,16 @@ proc opConv(c: PCtx; dest: var TFullReg, src: TFullReg, desttyp, srctyp: PType): of tyFloat..tyFloat64: dest.intVal = int(src.floatVal) else: - let srcDist = (sizeof(src.intVal) - styp.size) * 8 - let destDist = (sizeof(dest.intVal) - desttyp.size) * 8 + let destSize = getSize(c.config, desttyp) + let destDist = (sizeof(dest.intVal) - destSize) * 8 var value = cast[BiggestUInt](src.intVal) - value = (value shl srcDist) shr srcDist + when false: + # this would make uint64(-5'i8) evaluate to 251 + # but at runtime, uint64(-5'i8) is 18446744073709551611 + # so don't do it + let srcSize = getSize(c.config, styp) + let srcDist = (sizeof(src.intVal) - srcSize) * 8 + value = (value shl srcDist) shr srcDist value = (value shl destDist) shr destDist dest.intVal = cast[BiggestInt](value) of tyBool: @@ -446,9 +464,12 @@ proc opConv(c: PCtx; dest: var TFullReg, src: TFullReg, desttyp, srctyp: PType): else: int(src.intVal != 0) of tyFloat..tyFloat64: dest.ensureKind(rkFloat) - case skipTypes(srctyp, abstractRange).kind + let srcKind = skipTypes(srctyp, abstractRange).kind + case srcKind of tyInt..tyInt64, tyUInt..tyUInt64, tyEnum, tyBool, tyChar: dest.floatVal = toBiggestFloat(src.intVal) + elif src.kind == rkInt: + dest.floatVal = toBiggestFloat(src.intVal) else: dest.floatVal = src.floatVal of tyObject: @@ -469,7 +490,7 @@ template handleJmpBack() {.dirty.} = if allowInfiniteLoops in c.features: c.loopIterations = c.config.maxLoopIterationsVM else: - msgWriteln(c.config, "stack trace: (most recent call last)") + msgWriteln(c.config, "stack trace: (most recent call last)", {msgNoUnitSep}) stackTraceAux(c, tos, pc) globalError(c.config, c.debug[pc], errTooManyIterations % $c.config.maxLoopIterationsVM) dec(c.loopIterations) @@ -486,7 +507,7 @@ proc setLenSeq(c: PCtx; node: PNode; newLen: int; info: TLineInfo) = setLen(node.sons, newLen) if oldLen < newLen: for i in oldLen..<newLen: - node[i] = getNullValue(typ[0], info, c.config) + node[i] = getNullValue(c, typ.elementType, info, c.config) const errNilAccess = "attempt to access a nil address" @@ -506,7 +527,7 @@ template maybeHandlePtr(node2: PNode, reg: TFullReg, isAssign2: bool): bool = if nfIsPtr in node.flags or (typ != nil and typ.kind == tyPtr): assert node.kind == nkIntLit, $(node.kind) assert typ != nil - let typ2 = if typ.kind == tyPtr: typ[0] else: typ + let typ2 = if typ.kind == tyPtr: typ.elementType else: typ if not derefPtrToReg(node.intVal, typ2, reg, isAssign = isAssign2): # tyObject not supported in this context stackTrace(c, tos, pc, "deref unsupported ptr type: " & $(typeToString(typ), typ.kind)) @@ -514,16 +535,27 @@ template maybeHandlePtr(node2: PNode, reg: TFullReg, isAssign2: bool): bool = else: false -when not defined(nimHasSinkInference): - {.pragma: nosinks.} +template takeAddress(reg, source) = + reg.nodeAddr = addr source + GC_ref source + +proc takeCharAddress(c: PCtx, src: PNode, index: BiggestInt, pc: int): TFullReg = + let typ = newType(tyPtr, c.idgen, c.module.owner) + typ.add getSysType(c.graph, c.debug[pc], tyChar) + var node = newNodeIT(nkIntLit, c.debug[pc], typ) # xxx nkPtrLit + node.intVal = cast[int](src.strVal[index].addr) + node.flags.incl nfIsPtr + TFullReg(kind: rkNode, node: node) + proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = + result = TFullReg(kind: rkNone) var pc = start var tos = tos # Used to keep track of where the execution is resumed. var savedPC = -1 - var savedFrame: PStackFrame - when defined(gcArc): + var savedFrame: PStackFrame = nil + when defined(gcArc) or defined(gcOrc) or defined(gcAtomicArc): template updateRegsAlias = discard template regs: untyped = tos.slots else: @@ -546,9 +578,12 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = "pc", $pc, "opcode", alignLeft($c.code[pc].opcode, 15), "ra", regDescr("ra", ra), "rb", regDescr("rb", instr.regB), "rc", regDescr("rc", instr.regC)] - + if c.config.isVmTrace: + # unlike nimVMDebug, this doesn't require re-compiling nim and is controlled by user code + let info = c.debug[pc] + # other useful variables: c.loopIterations + echo "$# [$#] $#" % [c.config$info, $instr.opcode, c.config.sourceLine(info)] c.profiler.enter(c, tos) - case instr.opcode of opcEof: return regs[ra] of opcRet: @@ -574,7 +609,10 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcYldVal: assert false of opcAsgnInt: decodeB(rkInt) - regs[ra].intVal = regs[rb].intVal + if regs[rb].kind == rkInt: + regs[ra].intVal = regs[rb].intVal + else: + stackTrace(c, tos, pc, "opcAsgnInt: got " & $regs[rb].kind) of opcAsgnFloat: decodeB(rkFloat) regs[ra].floatVal = regs[rb].floatVal @@ -604,6 +642,10 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[ra].intVal = cast[int](regs[rb].node.intVal) of rkNodeAddr: regs[ra].intVal = cast[int](regs[rb].nodeAddr) + of rkRegisterAddr: + regs[ra].intVal = cast[int](regs[rb].regAddr) + of rkInt: + regs[ra].intVal = regs[rb].intVal else: stackTrace(c, tos, pc, "opcCastPtrToInt: got " & $regs[rb].kind) of 2: # tyRef @@ -630,23 +672,68 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcNodeToReg: let ra = instr.regA let rb = instr.regB - # opcDeref might already have loaded it into a register. XXX Let's hope + # opcLdDeref might already have loaded it into a register. XXX Let's hope # this is still correct this way: if regs[rb].kind != rkNode: regs[ra] = regs[rb] else: assert regs[rb].kind == rkNode let nb = regs[rb].node - case nb.kind - of nkCharLit..nkUInt64Lit: - ensureKind(rkInt) - regs[ra].intVal = nb.intVal - of nkFloatLit..nkFloat64Lit: - ensureKind(rkFloat) - regs[ra].floatVal = nb.floatVal + if nb == nil: + stackTrace(c, tos, pc, errNilAccess) else: - ensureKind(rkNode) - regs[ra].node = nb + case nb.kind + of nkCharLit..nkUInt64Lit: + ensureKind(rkInt) + regs[ra].intVal = nb.intVal + of nkFloatLit..nkFloat64Lit: + ensureKind(rkFloat) + regs[ra].floatVal = nb.floatVal + else: + ensureKind(rkNode) + regs[ra].node = nb + of opcSlice: + # A bodge, but this takes in `toOpenArray(rb, rc, rc)` and emits + # nkTupleConstr(x, y, z) into the `regs[ra]`. These can later be used for calculating the slice we have taken. + decodeBC(rkNode) + let + collection = regs[ra].node + leftInd = regs[rb].intVal + rightInd = regs[rc].intVal + + proc rangeCheck(left, right: BiggestInt, safeLen: BiggestInt) = + if left < 0: + stackTrace(c, tos, pc, formatErrorIndexBound(left, safeLen)) + + if right > safeLen: + stackTrace(c, tos, pc, formatErrorIndexBound(right, safeLen)) + + case collection.kind + of nkTupleConstr: # slice of a slice + let safeLen = collection[2].intVal - collection[1].intVal + rangeCheck(leftInd, rightInd, safeLen) + let + leftInd = leftInd + collection[1].intVal # Slice is from the start of the old + rightInd = rightInd + collection[1].intVal + + regs[ra].node = newTree( + nkTupleConstr, + collection[0], + newIntNode(nkIntLit, BiggestInt leftInd), + newIntNode(nkIntLit, BiggestInt rightInd) + ) + + else: + let safeLen = safeArrLen(collection) - 1 + rangeCheck(leftInd, rightInd, safeLen) + regs[ra].node = newTree( + nkTupleConstr, + collection, + newIntNode(nkIntLit, BiggestInt leftInd), + newIntNode(nkIntLit, BiggestInt rightInd) + ) + + of opcLdArr: # a = b[c] decodeBC(rkNode) @@ -654,7 +741,24 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = stackTrace(c, tos, pc, formatErrorIndexBound(regs[rc].intVal, high(int))) let idx = regs[rc].intVal.int let src = regs[rb].node - if src.kind in {nkStrLit..nkTripleStrLit}: + case src.kind + of nkTupleConstr: # refer to `of opcSlice` + let + left = src[1].intVal + right = src[2].intVal + realIndex = left + idx + if idx in 0..(right - left): + case src[0].kind + of nkStrKinds: + regs[ra].node = newIntNode(nkCharLit, ord src[0].strVal[int realIndex]) + of nkBracket: + regs[ra].node = src[0][int realIndex] + else: + stackTrace(c, tos, pc, "opcLdArr internal error") + else: + stackTrace(c, tos, pc, formatErrorIndexBound(idx, int right)) + + of nkStrLit..nkTripleStrLit: if idx <% src.strVal.len: regs[ra].node = newNodeI(nkCharLit, c.debug[pc]) regs[ra].node.intVal = src.strVal[idx].ord @@ -671,14 +775,33 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = stackTrace(c, tos, pc, formatErrorIndexBound(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] + case src.kind + of nkTupleConstr: + let + left = src[1].intVal + right = src[2].intVal + realIndex = left + idx + if idx in 0..(right - left): # Refer to `opcSlice` + case src[0].kind + of nkStrKinds: + regs[ra] = takeCharAddress(c, src[0], realIndex, pc) + of nkBracket: + takeAddress regs[ra], src.sons[0].sons[realIndex] + else: + stackTrace(c, tos, pc, "opcLdArrAddr internal error") + else: + stackTrace(c, tos, pc, formatErrorIndexBound(idx, int right)) else: - stackTrace(c, tos, pc, formatErrorIndexBound(idx, src.safeLen-1)) + if src.kind notin {nkEmpty..nkTripleStrLit} and idx <% src.len: + takeAddress regs[ra], src.sons[idx] + elif src.kind in nkStrKinds and idx <% src.strVal.len: + regs[ra] = takeCharAddress(c, src, idx, pc) + else: + stackTrace(c, tos, pc, formatErrorIndexBound(idx, src.safeLen-1)) of opcLdStrIdx: decodeBC(rkInt) let idx = regs[rc].intVal.int - let s = regs[rb].node.strVal + let s {.cursor.} = regs[rb].node.strVal if idx <% s.len: regs[ra].intVal = s[idx].ord else: @@ -691,21 +814,37 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let idx = regs[rc].intVal.int let s = regs[rb].node.strVal.addr # or `byaddr` if idx <% s[].len: - # `makePtrType` not accessible from vm.nim - let typ = newType(tyPtr, nextTypeId c.idgen, c.module.owner) - typ.add getSysType(c.graph, c.debug[pc], tyChar) - let node = newNodeIT(nkIntLit, c.debug[pc], typ) # xxx nkPtrLit - node.intVal = cast[int](s[][idx].addr) - node.flags.incl nfIsPtr - regs[ra].node = node + regs[ra] = takeCharAddress(c, regs[rb].node, idx, pc) else: stackTrace(c, tos, pc, formatErrorIndexBound(idx, s[].len-1)) of opcWrArr: # a[b] = c decodeBC(rkNode) let idx = regs[rb].intVal.int + assert regs[ra].kind == rkNode let arr = regs[ra].node - if arr.kind in {nkStrLit..nkTripleStrLit}: + case arr.kind + of nkTupleConstr: # refer to `opcSlice` + let + src = arr[0] + left = arr[1].intVal + right = arr[2].intVal + realIndex = left + idx + if idx in 0..(right - left): + case src.kind + of nkStrKinds: + src.strVal[int(realIndex)] = char(regs[rc].intVal) + of nkBracket: + if regs[rc].kind == rkInt: + src[int(realIndex)] = newIntNode(nkIntLit, regs[rc].intVal) + else: + assert regs[rc].kind == rkNode + src[int(realIndex)] = regs[rc].node + else: + stackTrace(c, tos, pc, "opcWrArr internal error") + else: + stackTrace(c, tos, pc, formatErrorIndexBound(idx, int right)) + of {nkStrLit..nkTripleStrLit}: if idx <% arr.strVal.len: arr.strVal[idx] = chr(regs[rc].intVal) else: @@ -717,19 +856,30 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcLdObj: # a = b.c decodeBC(rkNode) - let src = if regs[rb].kind == rkNode: regs[rb].node else: regs[rb].nodeAddr[] - case src.kind - of nkEmpty..nkNilLit: - # for nkPtrLit, this could be supported in the future, use something like: - # derefPtrToReg(src.intVal + offsetof(src.typ, rc), typ_field, regs[ra], isAssign = false) - # where we compute the offset in bytes for field rc - stackTrace(c, tos, pc, errNilAccess & " " & $("kind", src.kind, "typ", typeToString(src.typ), "rc", rc)) - of nkObjConstr: - let n = src[rc + 1].skipColon - regs[ra].node = n + if rb >= regs.len or regs[rb].kind == rkNone or + (regs[rb].kind == rkNode and regs[rb].node == nil) or + (regs[rb].kind == rkNodeAddr and regs[rb].nodeAddr[] == nil): + stackTrace(c, tos, pc, errNilAccess) else: - let n = src[rc] - regs[ra].node = n + let src = if regs[rb].kind == rkNode: regs[rb].node else: regs[rb].nodeAddr[] + case src.kind + of nkEmpty..nkNilLit: + # for nkPtrLit, this could be supported in the future, use something like: + # derefPtrToReg(src.intVal + offsetof(src.typ, rc), typ_field, regs[ra], isAssign = false) + # where we compute the offset in bytes for field rc + stackTrace(c, tos, pc, errNilAccess & " " & $("kind", src.kind, "typ", typeToString(src.typ), "rc", rc)) + of nkObjConstr: + let n = src[rc + 1].skipColon + regs[ra].node = n + of nkTupleConstr: + let n = if src.typ != nil and tfTriggersCompileTime in src.typ.flags: + src[rc] + else: + src[rc].skipColon + regs[ra].node = n + else: + let n = src[rc] + regs[ra].node = n of opcLdObjAddr: # a = addr(b.c) decodeBC(rkNodeAddr) @@ -740,11 +890,11 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of nkObjConstr: let n = src.sons[rc + 1] if n.kind == nkExprColonExpr: - regs[ra].nodeAddr = addr n.sons[1] + takeAddress regs[ra], n.sons[1] else: - regs[ra].nodeAddr = addr src.sons[rc + 1] + takeAddress regs[ra], src.sons[rc + 1] else: - regs[ra].nodeAddr = addr src.sons[rc] + takeAddress regs[ra], src.sons[rc] of opcWrObj: # a.b = c decodeBC(rkNode) @@ -755,8 +905,10 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = stackTrace(c, tos, pc, errNilAccess) elif dest[shiftedRb].kind == nkExprColonExpr: writeField(dest[shiftedRb][1], regs[rc]) + dest[shiftedRb][1].flags.incl nfSkipFieldChecking else: writeField(dest[shiftedRb], regs[rc]) + dest[shiftedRb].flags.incl nfSkipFieldChecking of opcWrStrIdx: decodeBC(rkNode) let idx = regs[rb].intVal.int @@ -771,7 +923,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = decodeB(rkNodeAddr) case regs[rb].kind of rkNode: - regs[ra].nodeAddr = addr(regs[rb].node) + takeAddress regs[ra], regs[rb].node of rkNodeAddr: # bug #14339 regs[ra].nodeAddr = regs[rb].nodeAddr else: @@ -807,11 +959,10 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = # vmgen generates opcWrDeref, which means that we must dereference # twice. # TODO: This should likely be handled differently in vmgen. - if (nfIsRef notin regs[ra].nodeAddr[].flags and - nfIsRef notin n.flags): - regs[ra].nodeAddr[][] = n[] - else: - regs[ra].nodeAddr[] = n + let nAddr = regs[ra].nodeAddr + if nAddr[] == nil: stackTrace(c, tos, pc, "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] of rkNode: # xxx: also check for nkRefTy as in opcLdDeref? @@ -864,14 +1015,21 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcLenSeq: decodeBImm(rkInt) #assert regs[rb].kind == nkBracket - let high = (imm and 1) # discard flags + let + high = (imm and 1) # discard flags + node = regs[rb].node if (imm and nimNodeFlag) != 0: # used by mNLen (NimNode.len) regs[ra].intVal = regs[rb].node.safeLen - high else: - # safeArrLen also return string node len - # used when string is passed as openArray in VM - regs[ra].intVal = regs[rb].node.safeArrLen - high + case node.kind + of nkTupleConstr: # refer to `of opcSlice` + regs[ra].intVal = node[2].intVal - node[1].intVal + 1 - high + else: + # safeArrLen also return string node len + # used when string is passed as openArray in VM + regs[ra].intVal = node.safeArrLen - high + of opcLenStr: decodeBImm(rkInt) assert regs[rb].kind == rkNode @@ -879,7 +1037,10 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcLenCstring: decodeBImm(rkInt) assert regs[rb].kind == rkNode - regs[ra].intVal = regs[rb].node.strVal.cstring.len - imm + if regs[rb].node.kind == nkNilLit: + regs[ra].intVal = -imm + else: + regs[ra].intVal = regs[rb].node.strVal.cstring.len - imm of opcIncl: decodeB(rkNode) let b = regs[rb].regToNode @@ -1000,6 +1161,12 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = decodeBC(rkInt) template getTyp(n): untyped = n.typ.skipTypes(abstractInst) + template skipRegisterAddr(n: TFullReg): TFullReg = + var tmp = n + while tmp.kind == rkRegisterAddr: + tmp = tmp.regAddr[] + tmp + proc ptrEquality(n1: ptr PNode, n2: PNode): bool = ## true if n2.intVal represents a ptr equal to n1 let p1 = cast[int](n1) @@ -1013,19 +1180,22 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = return t2.kind in PtrLikeKinds and n2.intVal == p1 else: return false - if regs[rb].kind == rkNodeAddr: - if regs[rc].kind == rkNodeAddr: - ret = regs[rb].nodeAddr == regs[rc].nodeAddr + let rbReg = skipRegisterAddr(regs[rb]) + let rcReg = skipRegisterAddr(regs[rc]) + + if rbReg.kind == rkNodeAddr: + if rcReg.kind == rkNodeAddr: + ret = rbReg.nodeAddr == rcReg.nodeAddr else: - ret = ptrEquality(regs[rb].nodeAddr, regs[rc].node) - elif regs[rc].kind == rkNodeAddr: - ret = ptrEquality(regs[rc].nodeAddr, regs[rb].node) + ret = ptrEquality(rbReg.nodeAddr, rcReg.node) + elif rcReg.kind == rkNodeAddr: + ret = ptrEquality(rcReg.nodeAddr, rbReg.node) else: - let nb = regs[rb].node - let nc = regs[rc].node + let nb = rbReg.node + let nc = rcReg.node if nb.kind != nc.kind: discard elif (nb == nc) or (nb.kind == nkNilLit): ret = true # intentional - elif (nb.kind in {nkSym, nkTupleConstr, nkClosure} and nb.typ.kind == tyProc) and sameConstant(nb, nc): + elif nb.kind in {nkSym, nkTupleConstr, nkClosure} and nb.typ != nil and nb.typ.kind == tyProc and sameConstant(nb, nc): ret = true # this also takes care of procvar's, represented as nkTupleConstr, e.g. (nil, nil) elif nb.kind == nkIntLit and nc.kind == nkIntLit and nb.intVal == nc.intVal: # TODO: nkPtrLit @@ -1040,7 +1210,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = strictSymEquality=true)) of opcSameNodeType: decodeBC(rkInt) - regs[ra].intVal = ord(regs[rb].node.typ.sameTypeOrNil regs[rc].node.typ) + regs[ra].intVal = ord(regs[rb].node.typ.sameTypeOrNil(regs[rc].node.typ, {ExactTypeDescValues, ExactGenericParams})) + # The types should exactly match which is why we pass `{ExactTypeDescValues..ExactGcSafety}`. of opcXor: decodeBC(rkInt) regs[ra].intVal = ord(regs[rb].intVal != regs[rc].intVal) @@ -1067,6 +1238,12 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcEqStr: decodeBC(rkInt) regs[ra].intVal = ord(regs[rb].node.strVal == regs[rc].node.strVal) + of opcEqCString: + decodeBC(rkInt) + let bNil = regs[rb].node.kind == nkNilLit + let cNil = regs[rc].node.kind == nkNilLit + regs[ra].intVal = ord((bNil and cNil) or + (not bNil and not cNil and regs[rb].node.strVal == regs[rc].node.strVal)) of opcLeStr: decodeBC(rkInt) regs[ra].intVal = ord(regs[rb].node.strVal <= regs[rc].node.strVal) @@ -1138,7 +1315,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let ast = a.sym.ast.shallowCopy for i in 0..<a.sym.ast.len: ast[i] = a.sym.ast[i] - ast[bodyPos] = transformBody(c.graph, c.idgen, a.sym, cache=true) + ast[bodyPos] = transformBody(c.graph, c.idgen, a.sym, {useCache, force}) ast.copyTree() of opcSymOwner: decodeB(rkNode) @@ -1156,13 +1333,13 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if a.kind == nkSym and a.sym.kind in skProcKinds and b.kind == nkSym and b.sym.kind in skProcKinds: regs[ra].intVal = - if sfFromGeneric in a.sym.flags and a.sym.owner == b.sym: 1 + if sfFromGeneric in a.sym.flags and a.sym.instantiatedFrom == b.sym: 1 else: 0 else: stackTrace(c, tos, pc, "node is not a proc symbol") of opcEcho: let rb = instr.regB - template fn(s) = msgWriteln(c.config, s, {msgStdout}) + template fn(s) = msgWriteln(c.config, s, {msgStdout, msgNoUnitSep}) if rb == 1: fn(regs[ra].node.strVal) else: var outp = "" @@ -1173,25 +1350,34 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcContainsSet: decodeBC(rkInt) regs[ra].intVal = ord(inSet(regs[rb].node, regs[rc].regToNode)) - of opcSubStr: - decodeBC(rkNode) - inc pc - assert c.code[pc].opcode == opcSubStr - let rd = c.code[pc].regA - createStr regs[ra] - regs[ra].node.strVal = substr(regs[rb].node.strVal, - regs[rc].intVal.int, regs[rd].intVal.int) of opcParseFloat: decodeBC(rkInt) - inc pc - assert c.code[pc].opcode == opcParseFloat - let rd = c.code[pc].regA var rcAddr = addr(regs[rc]) if rcAddr.kind == rkRegisterAddr: rcAddr = rcAddr.regAddr elif regs[rc].kind != rkFloat: regs[rc] = TFullReg(kind: rkFloat) - regs[ra].intVal = parseBiggestFloat(regs[rb].node.strVal, - rcAddr.floatVal, regs[rd].intVal.int) + + let coll = regs[rb].node + + case coll.kind + of nkTupleConstr: + let + data = coll[0] + left = coll[1].intVal + right = coll[2].intVal + case data.kind + of nkStrKinds: + regs[ra].intVal = parseBiggestFloat(data.strVal.toOpenArray(int left, int right), rcAddr.floatVal) + of nkBracket: + var s = newStringOfCap(right - left + 1) + for i in left..right: + s.add char data[int i].intVal + regs[ra].intVal = parseBiggestFloat(s, rcAddr.floatVal) + else: + internalError(c.config, c.debug[pc], "opcParseFloat: Incorrectly created openarray") + else: + regs[ra].intVal = parseBiggestFloat(regs[rb].node.strVal, rcAddr.floatVal) + of opcRangeChck: let rb = instr.regB let rc = instr.regC @@ -1205,14 +1391,19 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let rb = instr.regB let rc = instr.regC let bb = regs[rb].node + if bb.kind == nkNilLit: + stackTrace(c, tos, pc, "attempt to call nil closure") let isClosure = bb.kind == nkTupleConstr + if isClosure and bb[0].kind == nkNilLit: + stackTrace(c, tos, pc, "attempt to call nil closure") let prc = if not isClosure: bb.sym else: bb[0].sym if prc.offset < -1: # it's a callback: - c.callbacks[-prc.offset-2].value( + c.callbacks[-prc.offset-2]( VmArgs(ra: ra, rb: rb, rc: rc, slots: cast[ptr UncheckedArray[TFullReg]](addr regs[0]), currentException: c.currentExceptionA, - currentLineInfo: c.debug[pc])) + 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`") @@ -1225,8 +1416,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let prcValue = c.globals[prc.position-1] if prcValue.kind == nkEmpty: globalError(c.config, c.debug[pc], "cannot run " & prc.name.s) - var slots2: TNodeSeq - slots2.setLen(tos.slots.len) + var slots2: TNodeSeq = newSeq[PNode](tos.slots.len) for i in 0..<tos.slots.len: slots2[i] = regToNode(tos.slots[i]) let newValue = callForeignFunction(c.config, prcValue, prc.typ, slots2, @@ -1244,8 +1434,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = #echo "new pc ", newPc, " calling: ", prc.name.s var newFrame = PStackFrame(prc: prc, comesFrom: pc, next: tos) newSeq(newFrame.slots, prc.offset+ord(isClosure)) - if not isEmptyType(prc.typ[0]): - putIntoReg(newFrame.slots[0], getNullValue(prc.typ[0], prc.info, c.config)) + if not isEmptyType(prc.typ.returnType): + putIntoReg(newFrame.slots[0], getNullValue(c, prc.typ.returnType, prc.info, c.config)) for i in 1..rc-1: newFrame.slots[i] = regs[rb+i] if isClosure: @@ -1265,6 +1455,9 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = for i in 1..rc-1: let node = regs[rb+i].regToNode node.info = c.debug[pc] + if prc.typ[i].kind notin {tyTyped, tyUntyped}: + node.annotateType(prc.typ[i], c.config) + macroCall.add(node) var a = evalTemplate(macroCall, prc, genSymOwner, c.config, c.cache, c.templInstCounter, c.idgen) if a.kind == nkStmtList and a.len == 1: a = a[0] @@ -1312,7 +1505,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcExcept: # This opcode is never executed, it only holds information for the # exception handling routines. - doAssert(false) + raiseAssert "unreachable" of opcFinally: # Pop the last safepoint introduced by a opcTry. This opcode is only # executed _iff_ no exception was raised in the body of the `try` @@ -1337,7 +1530,13 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[ra].node c.currentExceptionA = raised # Set the `name` field of the exception - c.currentExceptionA[2].skipColon.strVal = c.currentExceptionA.typ.sym.name.s + var exceptionNameNode = newStrNode(nkStrLit, c.currentExceptionA.typ.sym.name.s) + if c.currentExceptionA[2].kind == nkExprColonExpr: + exceptionNameNode.typ = c.currentExceptionA[2][1].typ + c.currentExceptionA[2][1] = exceptionNameNode + else: + exceptionNameNode.typ = c.currentExceptionA[2].typ + c.currentExceptionA[2] = exceptionNameNode c.exceptionInstr = pc var frame = tos @@ -1346,7 +1545,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = frame = frame.next jumpTo = findExceptionHandler(c, frame, raised) - case jumpTo.why: + case jumpTo.why of ExceptionGotoHandler: # Jump to the handler, do nothing when the `finally` block ends. savedPC = -1 @@ -1369,7 +1568,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcNew: ensureKind(rkNode) let typ = c.types[instr.regBx - wordExcess] - regs[ra].node = getNullValue(typ, c.debug[pc], c.config) + regs[ra].node = getNullValue(c, typ, c.debug[pc], c.config) regs[ra].node.flags.incl nfIsRef of opcNewSeq: let typ = c.types[instr.regBx - wordExcess] @@ -1381,7 +1580,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[ra].node.typ = typ newSeq(regs[ra].node.sons, count) for i in 0..<count: - regs[ra].node[i] = getNullValue(typ[0], c.debug[pc], c.config) + regs[ra].node[i] = getNullValue(c, typ.elementType, c.debug[pc], c.config) of opcNewStr: decodeB(rkNode) regs[ra].node = newNodeI(nkStrLit, c.debug[pc]) @@ -1393,7 +1592,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcLdNull: ensureKind(rkNode) let typ = c.types[instr.regBx - wordExcess] - regs[ra].node = getNullValue(typ, c.debug[pc], c.config) + regs[ra].node = getNullValue(c, typ, c.debug[pc], c.config) # opcLdNull really is the gist of the VM's problems: should it load # a fresh null to regs[ra].node or to regs[ra].node[]? This really # depends on whether regs[ra] represents the variable itself or whether @@ -1443,7 +1642,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = node2.flags.incl nfIsPtr regs[ra].node = node2 elif not derefPtrToReg(node.intVal, typ, regs[ra], isAssign = false): - stackTrace(c, tos, pc, "opcLdDeref unsupported type: " & $(typeToString(typ), typ[0].kind)) + stackTrace(c, tos, pc, "opcLdDeref unsupported type: " & $(typeToString(typ), typ.elementType.kind)) of opcLdGlobalAddrDerefFFI: let rb = instr.regBx - wordExcess - 1 let node = c.globals[rb] @@ -1460,7 +1659,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcRepr: decodeB(rkNode) createStr regs[ra] - regs[ra].node.strVal = renderTree(regs[rb].regToNode, {renderNoComments, renderDocComments}) + regs[ra].node.strVal = renderTree(regs[rb].regToNode, {renderNoComments, renderDocComments, renderNonExportedFields}) of opcQuit: if c.mode in {emRepl, emStaticExpr, emStaticStmt}: message(c.config, c.debug[pc], hintQuitCalled) @@ -1468,7 +1667,10 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = else: return TFullReg(kind: rkNone) of opcInvalidField: - stackTrace(c, tos, pc, errFieldXNotFound & regs[ra].node.strVal) + let msg = regs[ra].node.strVal + let disc = regs[instr.regB].regToNode + let msg2 = formatFieldDefect(msg, $disc) + stackTrace(c, tos, pc, msg2) of opcSetLenStr: decodeB(rkNode) #createStrKeepNode regs[ra] @@ -1512,8 +1714,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = # reference with the value `nil`, so `isNil` should be false! (node.kind == nkNilLit and nfIsRef notin node.flags) or (not node.typ.isNil and node.typ.kind == tyProc and - node.typ.callConv == ccClosure and node[0].kind == nkNilLit and - node[1].kind == nkNilLit)) + node.typ.callConv == ccClosure and node.safeLen > 0 and + node[0].kind == nkNilLit and node[1].kind == nkNilLit)) of opcNBindSym: # cannot use this simple check # if dynamicBindSym notin c.config.features: @@ -1528,7 +1730,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = rb = instr.regB rc = instr.regC idx = int(regs[rb+rc-1].intVal) - callback = c.callbacks[idx].value + callback = c.callbacks[idx] args = VmArgs(ra: ra, rb: rb, rc: rc, slots: cast[ptr UncheckedArray[TFullReg]](addr regs[0]), currentException: c.currentExceptionA, currentLineInfo: c.debug[pc]) @@ -1706,7 +1908,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if regs[rb].node.kind != nkSym: stackTrace(c, tos, pc, "node is not a symbol") else: - regs[ra].node.strVal = $sigHash(regs[rb].node.sym) + regs[ra].node.strVal = $sigHash(regs[rb].node.sym, c.config) of opcSlurp: decodeB(rkNode) createStr regs[ra] @@ -1740,14 +1942,15 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = elif instr.opcode == opcNHint: message(c.config, info, hintUser, a.strVal) of opcParseExprToAst: - decodeB(rkNode) - # c.debug[pc].line.int - countLines(regs[rb].strVal) ? - var error: string + decodeBC(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.} = + regs[rc].node.strVal, 0, + proc (conf: ConfigRef; info: TLineInfo; msg: TMsgKind; arg: string) = if error.len == 0 and msg <= errMax: error = formatMsg(conf, info, msg, arg)) + + regs[ra].node = newNode(nkEmpty) if error.len > 0: c.errorFlag = error elif ast.len != 1: @@ -1756,15 +1959,16 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = else: regs[ra].node = ast[0] of opcParseStmtToAst: - decodeB(rkNode) - var error: string + decodeBC(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.} = + regs[rc].node.strVal, 0, + proc (conf: ConfigRef; info: TLineInfo; msg: TMsgKind; arg: string) = if error.len == 0 and msg <= errMax: error = formatMsg(conf, info, msg, arg)) if error.len > 0: c.errorFlag = error + regs[ra].node = newNode(nkEmpty) else: regs[ra].node = ast of opcQueryErrorFlag: @@ -1784,14 +1988,24 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of 1: # getLine regs[ra].node = newIntNode(nkIntLit, n.info.line.int) of 2: # getColumn - regs[ra].node = newIntNode(nkIntLit, n.info.col) + regs[ra].node = newIntNode(nkIntLit, n.info.col.int) else: internalAssert c.config, false regs[ra].node.info = n.info regs[ra].node.typ = n.typ - of opcNSetLineInfo: + of opcNCopyLineInfo: decodeB(rkNode) regs[ra].node.info = regs[rb].node.info + of opcNSetLineInfoLine: + decodeB(rkNode) + regs[ra].node.info.line = regs[rb].intVal.uint16 + of opcNSetLineInfoColumn: + decodeB(rkNode) + regs[ra].node.info.col = regs[rb].intVal.int16 + of opcNSetLineInfoFile: + decodeB(rkNode) + regs[ra].node.info.fileIndex = + fileInfoIdx(c.config, RelativeFile regs[rb].node.strVal) of opcEqIdent: decodeBC(rkInt) # aliases for shorter and easier to understand code below @@ -1916,12 +2130,6 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = dest.ident = regs[rb].node.ident else: stackTrace(c, tos, pc, errFieldXNotFound & "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 - regs[ra].node.typ = b.sym.typ of opcNSetStrVal: decodeB(rkNode) var dest = regs[ra].node @@ -1971,18 +2179,18 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = else: regs[rc].node.strVal if k < 0 or k > ord(high(TSymKind)): internalError(c.config, c.debug[pc], "request to create symbol of invalid kind") - var sym = newSym(k.TSymKind, getIdent(c.cache, name), nextSymId c.idgen, c.module.owner, c.debug[pc]) + var sym = newSym(k.TSymKind, getIdent(c.cache, name), c.idgen, c.module.owner, c.debug[pc]) incl(sym.flags, sfGenSym) regs[ra].node = newSymNode(sym) regs[ra].node.flags.incl nfIsRef of opcNccValue: decodeB(rkInt) - let destKey = regs[rb].node.strVal + let destKey {.cursor.} = regs[rb].node.strVal regs[ra].intVal = getOrDefault(c.graph.cacheCounters, destKey) of opcNccInc: let g = c.graph declBC() - let destKey = regs[rb].node.strVal + let destKey {.cursor.} = regs[rb].node.strVal let by = regs[rc].intVal let v = getOrDefault(g.cacheCounters, destKey) g.cacheCounters[destKey] = v+by @@ -1990,7 +2198,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcNcsAdd: let g = c.graph declBC() - let destKey = regs[rb].node.strVal + let destKey {.cursor.} = regs[rb].node.strVal let val = regs[rc].node if not contains(g.cacheSeqs, destKey): g.cacheSeqs[destKey] = newTree(nkStmtList, val) @@ -2000,7 +2208,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcNcsIncl: let g = c.graph declBC() - let destKey = regs[rb].node.strVal + let destKey {.cursor.} = regs[rb].node.strVal let val = regs[rc].node if not contains(g.cacheSeqs, destKey): g.cacheSeqs[destKey] = newTree(nkStmtList, val) @@ -2014,22 +2222,22 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcNcsLen: let g = c.graph decodeB(rkInt) - let destKey = regs[rb].node.strVal + let destKey {.cursor.} = regs[rb].node.strVal regs[ra].intVal = if contains(g.cacheSeqs, destKey): g.cacheSeqs[destKey].len else: 0 of opcNcsAt: let g = c.graph decodeBC(rkNode) let idx = regs[rc].intVal - let destKey = regs[rb].node.strVal + let destKey {.cursor.} = regs[rb].node.strVal 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)) of opcNctPut: let g = c.graph - let destKey = regs[ra].node.strVal - let key = regs[instr.regB].node.strVal + let destKey {.cursor.} = regs[ra].node.strVal + let key {.cursor.} = regs[instr.regB].node.strVal let val = regs[instr.regC].node if not contains(g.cacheTables, destKey): g.cacheTables[destKey] = initBTree[string, PNode]() @@ -2041,14 +2249,14 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcNctLen: let g = c.graph decodeB(rkInt) - let destKey = regs[rb].node.strVal + let destKey {.cursor.} = regs[rb].node.strVal regs[ra].intVal = if contains(g.cacheTables, destKey): g.cacheTables[destKey].len else: 0 of opcNctGet: let g = c.graph decodeBC(rkNode) - let destKey = regs[rb].node.strVal - let key = regs[rc].node.strVal + let destKey {.cursor.} = regs[rb].node.strVal + let key {.cursor.} = regs[rc].node.strVal if contains(g.cacheTables, destKey): if contains(g.cacheTables[destKey], key): regs[ra].node = getOrDefault(g.cacheTables[destKey], key) @@ -2059,7 +2267,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcNctHasNext: let g = c.graph decodeBC(rkInt) - let destKey = regs[rb].node.strVal + let destKey {.cursor.} = regs[rb].node.strVal regs[ra].intVal = if g.cacheTables.contains(destKey): ord(btrees.hasNext(g.cacheTables[destKey], regs[rc].intVal.int)) @@ -2068,7 +2276,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcNctNext: let g = c.graph decodeBC(rkNode) - let destKey = regs[rb].node.strVal + let destKey {.cursor.} = regs[rb].node.strVal let index = regs[rc].intVal if contains(g.cacheTables, destKey): let (k, v, nextIndex) = btrees.next(g.cacheTables[destKey], index.int) @@ -2083,21 +2291,9 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = decodeB(rkNode) var typ = regs[rb].node.typ internalAssert c.config, typ != nil - while typ.kind == tyTypeDesc and typ.len > 0: typ = typ[0] + while typ.kind == tyTypeDesc and typ.hasElementType: typ = typ.skipModifier createStr regs[ra] regs[ra].node.strVal = typ.typeToString(preferExported) - of opcMarshalLoad: - let ra = instr.regA - let rb = instr.regB - inc pc - let typ = c.types[c.code[pc].regBx - wordExcess] - putIntoReg(regs[ra], loadAny(regs[rb].node.strVal, typ, c.cache, c.config, c.idgen)) - of opcMarshalStore: - decodeB(rkNode) - inc pc - let typ = c.types[c.code[pc].regBx - wordExcess] - createStrKeepNode(regs[ra]) - storeAny(regs[ra].node.strVal, typ, regs[rb].regToNode, c.config) c.profiler.leave(c) @@ -2105,16 +2301,17 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = proc execute(c: PCtx, start: int): PNode = var tos = PStackFrame(prc: nil, comesFrom: 0, next: nil) - newSeq(tos.slots, c.prc.maxSlots) + newSeq(tos.slots, c.prc.regInfo.len) result = rawExecute(c, start, tos).regToNode proc execProc*(c: PCtx; sym: PSym; args: openArray[PNode]): PNode = c.loopIterations = c.config.maxLoopIterationsVM if sym.kind in routineKinds: - if sym.typ.len-1 != args.len: + if sym.typ.paramsLen != args.len: + result = nil localError(c.config, sym.info, "NimScript: expected $# arguments, but got $#" % [ - $(sym.typ.len-1), $args.len]) + $(sym.typ.paramsLen), $args.len]) else: let start = genProc(c, sym) @@ -2123,14 +2320,15 @@ proc execProc*(c: PCtx; sym: PSym; args: openArray[PNode]): PNode = newSeq(tos.slots, maxSlots) # setup parameters: - if not isEmptyType(sym.typ[0]) or sym.kind == skMacro: - putIntoReg(tos.slots[0], getNullValue(sym.typ[0], sym.info, c.config)) + if not isEmptyType(sym.typ.returnType) or sym.kind == skMacro: + putIntoReg(tos.slots[0], getNullValue(c, sym.typ.returnType, sym.info, c.config)) # XXX We could perform some type checking here. - for i in 1..<sym.typ.len: - putIntoReg(tos.slots[i], args[i-1]) + for i in 0..<sym.typ.paramsLen: + putIntoReg(tos.slots[i+1], args[i]) result = rawExecute(c, start, tos).regToNode else: + result = nil localError(c.config, sym.info, "NimScript: attempt to call non-routine: " & sym.name.s) @@ -2155,6 +2353,11 @@ proc getGlobalValue*(c: PCtx; s: PSym): PNode = 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 + c.globals[s.position-1] = val + include vmops proc setupGlobalCtx*(module: PSym; graph: ModuleGraph; idgen: IdGenerator) = @@ -2164,7 +2367,7 @@ proc setupGlobalCtx*(module: PSym; graph: ModuleGraph; idgen: IdGenerator) = else: refresh(PCtx graph.vm, module, idgen) -proc myOpen(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext {.nosinks.} = +proc setupEvalGen*(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = #var c = newEvalContext(module, emRepl) #c.features = {allowCast, allowInfiniteLoops} #pushStackFrame(c, newStackFrame()) @@ -2173,7 +2376,7 @@ proc myOpen(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext setupGlobalCtx(module, graph, idgen) result = PCtx graph.vm -proc myProcess(c: PPassContext, n: PNode): PNode = +proc interpreterCode*(c: PPassContext, n: PNode): PNode = let c = PCtx(c) # don't eval errornous code: if c.oldErrorCount == c.config.errorCounter: @@ -2183,14 +2386,12 @@ proc myProcess(c: PPassContext, n: PNode): PNode = result = n c.oldErrorCount = c.config.errorCounter -proc myClose(graph: ModuleGraph; c: PPassContext, n: PNode): PNode = - result = myProcess(c, n) - -const evalPass* = makePass(myOpen, myProcess, myClose) - proc evalConstExprAux(module: PSym; idgen: IdGenerator; g: ModuleGraph; prc: PSym, n: PNode, mode: TEvalMode): PNode = + when defined(nimsuggest): + if g.config.expandDone(): + return n #if g.config.errorCounter > 0: return n let n = transformExpr(g, idgen, module, n) setupGlobalCtx(module, g, idgen) @@ -2202,8 +2403,8 @@ proc evalConstExprAux(module: PSym; idgen: IdGenerator; assert c.code[start].opcode != opcEof when debugEchoCode: c.echoCode start var tos = PStackFrame(prc: prc, comesFrom: 0, next: nil) - newSeq(tos.slots, c.prc.maxSlots) - #for i in 0..<c.prc.maxSlots: tos.slots[i] = newNode(nkEmpty) + newSeq(tos.slots, c.prc.regInfo.len) + #for i in 0..<c.prc.regInfo.len: tos.slots[i] = newNode(nkEmpty) result = rawExecute(c, start, tos).regToNode if result.info.col < 0: result.info = n.info c.mode = oldMode @@ -2221,13 +2422,19 @@ proc setupCompileTimeVar*(module: PSym; idgen: IdGenerator; g: ModuleGraph; n: P discard evalConstExprAux(module, idgen, g, nil, n, emStaticStmt) proc prepareVMValue(arg: PNode): PNode = - ## strip nkExprColonExpr from tuple values recurively. That is how + ## strip nkExprColonExpr from tuple values recursively. That is how ## they are expected to be stored in the VM. # Early abort without copy. No transformation takes place. if arg.kind in nkLiterals: return arg + if arg.kind == nkExprColonExpr and arg[0].typ != nil and + arg[0].typ.sym != nil and arg[0].typ.sym.magic == mPNimrodNode: + # Poor mans way of protecting static NimNodes + # XXX: Maybe we need a nkNimNode? + return arg + result = copyNode(arg) if arg.kind == nkTupleConstr: for child in arg: @@ -2242,11 +2449,11 @@ proc prepareVMValue(arg: PNode): PNode = proc setupMacroParam(x: PNode, typ: PType): TFullReg = case typ.kind of tyStatic: + result = TFullReg(kind: rkNone) putIntoReg(result, prepareVMValue(x)) else: var n = x if n.kind in {nkHiddenSubConv, nkHiddenStdConv}: n = n[1] - n = n.canonValue n.flags.incl nfIsRef n.typ = x.typ result = TFullReg(kind: rkNode, node: n) @@ -2255,17 +2462,17 @@ iterator genericParamsInMacroCall*(macroSym: PSym, call: PNode): (PSym, PNode) = let gp = macroSym.ast[genericParamsPos] for i in 0..<gp.len: let genericParam = gp[i].sym - let posInCall = macroSym.typ.len + i + let posInCall = macroSym.typ.signatureLen + i if posInCall < call.len: yield (genericParam, call[posInCall]) # to prevent endless recursion in macro instantiation const evalMacroLimit = 1000 -proc errorNode(idgen: IdGenerator; owner: PSym, n: PNode): PNode = - result = newNodeI(nkEmpty, n.info) - result.typ = newType(tyError, nextTypeId idgen, owner) - result.typ.flags.incl tfCheckedForDestructor +#proc errorNode(idgen: IdGenerator; owner: PSym, n: PNode): PNode = +# result = newNodeI(nkEmpty, n.info) +# result.typ = newType(tyError, idgen, owner) +# result.typ.flags.incl tfCheckedForDestructor proc evalMacroCall*(module: PSym; idgen: IdGenerator; g: ModuleGraph; templInstCounter: ref int; n, nOrig: PNode, sym: PSym): PNode = @@ -2278,9 +2485,10 @@ proc evalMacroCall*(module: PSym; idgen: IdGenerator; g: ModuleGraph; templInstC # immediate macros can bypass any type and arity checking so we check the # arity here too: - if sym.typ.len > n.safeLen and sym.typ.len > 1: + let sl = sym.typ.signatureLen + if sl > n.safeLen and sl > 1: globalError(g.config, n.info, "in call '$#' got $#, but expected $# argument(s)" % [ - n.renderTree, $(n.safeLen-1), $(sym.typ.len-1)]) + n.renderTree, $(n.safeLen-1), $(sym.typ.paramsLen)]) setupGlobalCtx(module, g, idgen) var c = PCtx g.vm @@ -2305,12 +2513,12 @@ proc evalMacroCall*(module: PSym; idgen: IdGenerator; g: ModuleGraph; templInstC tos.slots[0] = TFullReg(kind: rkNode, node: newNodeI(nkEmpty, n.info)) # setup parameters: - for i in 1..<sym.typ.len: - tos.slots[i] = setupMacroParam(n[i], sym.typ[i]) + for i, param in paramTypes(sym.typ): + tos.slots[i-FirstParamAt+1] = setupMacroParam(n[i-FirstParamAt+1], param) let gp = sym.ast[genericParamsPos] for i in 0..<gp.len: - let idx = sym.typ.len + i + let idx = sym.typ.signatureLen + i if idx < n.len: tos.slots[idx] = setupMacroParam(n[idx], gp[i].sym.typ) else: diff --git a/compiler/vmconv.nim b/compiler/vmconv.nim index b82fb2ff3..45d925df0 100644 --- a/compiler/vmconv.nim +++ b/compiler/vmconv.nim @@ -1,4 +1,7 @@ -import ast +import ast except elementType +import idents, lineinfos, astalgo +import vmdef +import std/times template elementType*(T: typedesc): typedesc = typeof(block: @@ -14,7 +17,7 @@ proc fromLit*(a: PNode, T: typedesc): auto = for ai in a: result.incl Ti(ai.intVal) else: - static: doAssert false, "not yet supported: " & $T # add as needed + static: raiseAssert "not yet supported: " & $T # add as needed proc toLit*[T](a: T): PNode = ## generic type => PNode @@ -41,5 +44,14 @@ proc toLit*[T](a: T): PNode = reti.add ai.toLit result.add reti else: - static: doAssert false, "not yet supported: " & $T # add as needed + static: raiseAssert "not yet supported: " & $T # add as needed +proc toTimeLit*(a: Time, c: PCtx, obj: PNode, info: TLineInfo): PNode = + # probably refactor it into `toLit` in the future + result = newTree(nkObjConstr) + result.add(newNode(nkEmpty)) # can be changed to a symbol according to PType + for k, ai in fieldPairs(a): + let reti = newNode(nkExprColonExpr) + reti.add newSymNode(lookupInRecord(obj, getIdent(c.cache, k)), info) + reti.add ai.toLit + result.add reti diff --git a/compiler/vmdef.nim b/compiler/vmdef.nim index e8b5cdda9..bdb0aeed1 100644 --- a/compiler/vmdef.nim +++ b/compiler/vmdef.nim @@ -10,6 +10,8 @@ ## This module contains the type definitions for the new evaluation engine. ## An instruction is 1-3 int32s in memory, it is a register based VM. +import std/[tables, strutils] + import ast, idents, options, modulegraphs, lineinfos type TInstrType* = uint64 @@ -79,6 +81,7 @@ type opcWrStrIdx, opcLdStrIdx, # a = b[c] opcLdStrIdxAddr, # a = addr(b[c]) + opcSlice, # toOpenArray(collection, left, right) opcAddInt, opcAddImmInt, @@ -96,11 +99,11 @@ type opcLeFloat, opcLtFloat, opcLeu, opcLtu, opcEqRef, opcEqNimNode, opcSameNodeType, opcXor, opcNot, opcUnaryMinusInt, opcUnaryMinusFloat, opcBitnotInt, - opcEqStr, opcLeStr, opcLtStr, opcEqSet, opcLeSet, opcLtSet, + opcEqStr, opcEqCString, opcLeStr, opcLtStr, opcEqSet, opcLeSet, opcLtSet, opcMulSet, opcPlusSet, opcMinusSet, opcConcatStr, opcContainsSet, opcRepr, opcSetLenStr, opcSetLenSeq, opcIsNil, opcOf, opcIs, - opcSubStr, opcParseFloat, opcConv, opcCast, + opcParseFloat, opcConv, opcCast, opcQuit, opcInvalidField, opcNarrowS, opcNarrowU, opcSignExtend, @@ -124,7 +127,7 @@ type opcNGetSize, opcNSetIntVal, - opcNSetFloatVal, opcNSetSymbol, opcNSetIdent, opcNSetType, opcNSetStrVal, + opcNSetFloatVal, opcNSetSymbol, opcNSetIdent, opcNSetStrVal, opcNNewNimNode, opcNCopyNimNode, opcNCopyNimTree, opcNDel, opcGenSym, opcNccValue, opcNccInc, opcNcsAdd, opcNcsIncl, opcNcsLen, opcNcsAt, @@ -138,7 +141,8 @@ type opcNError, opcNWarning, opcNHint, - opcNGetLineInfo, opcNSetLineInfo, + opcNGetLineInfo, opcNCopyLineInfo, opcNSetLineInfoLine, + opcNSetLineInfoColumn, opcNSetLineInfoFile opcEqIdent, opcStrToIdent, opcGetImpl, @@ -178,7 +182,6 @@ type opcNBindSym, opcNDynBindSym, opcSetType, # dest.typ = types[Bx] opcTypeTrait, - opcMarshalLoad, opcMarshalStore, opcSymOwner, opcSymIsInstantiationOf @@ -229,8 +232,7 @@ type PProc* = ref object blocks*: seq[TBlock] # blocks; temp data structure sym*: PSym - slots*: array[TRegister, tuple[inUse: bool, kind: TSlotKind]] - maxSlots*: int + regInfo*: seq[tuple[inUse: bool, kind: TSlotKind]] VmArgs* = object ra*, rb*, rc*: Natural @@ -257,7 +259,8 @@ type traceActive*: bool loopIterations*: int comesFromHeuristic*: TLineInfo # Heuristic for better macro stack traces - callbacks*: seq[tuple[key: string, value: VmCallback]] + callbacks*: seq[VmCallback] + callbackIndex*: Table[string, int] errorFlag*: string cache*: IdentCache config*: ConfigRef @@ -266,9 +269,10 @@ type profiler*: Profiler templInstCounter*: ref int # gives every template instantiation a unique ID, needed here for getAst vmstateDiff*: seq[(PSym, PNode)] # we remember the "diff" to global state here (feature for IC) + procToCodePos*: Table[int, int] PStackFrame* = ref TStackFrame - TStackFrame* = object + TStackFrame* {.acyclic.} = object prc*: PSym # current prc; proc that is evaluated slots*: seq[TFullReg] # parameters passed to the proc + locals; # parameters come first @@ -289,7 +293,7 @@ proc newCtx*(module: PSym; cache: IdentCache; g: ModuleGraph; idgen: IdGenerator PCtx(code: @[], debug: @[], globals: newNode(nkStmtListExpr), constants: newNode(nkStmtList), types: @[], prc: PProc(blocks: @[]), module: module, loopIterations: g.config.maxLoopIterationsVM, - comesFromHeuristic: unknownLineInfo, callbacks: @[], errorFlag: "", + comesFromHeuristic: unknownLineInfo, callbacks: @[], callbackIndex: initTable[string, int](), errorFlag: "", cache: cache, config: g.config, graph: g, idgen: idgen) proc refresh*(c: PCtx, module: PSym; idgen: IdGenerator) = @@ -298,15 +302,24 @@ proc refresh*(c: PCtx, module: PSym; idgen: IdGenerator) = c.loopIterations = c.config.maxLoopIterationsVM c.idgen = idgen +proc reverseName(s: string): string = + result = newStringOfCap(s.len) + let y = s.split('.') + for i in 1..y.len: + result.add y[^i] + if i != y.len: + result.add '.' + proc registerCallback*(c: PCtx; name: string; callback: VmCallback): int {.discardable.} = result = c.callbacks.len - c.callbacks.add((name, callback)) + c.callbacks.add(callback) + c.callbackIndex[reverseName(name)] = result const firstABxInstr* = opcTJmp largeInstrs* = { # instructions which use 2 int32s instead of 1: - opcSubStr, opcConv, opcCast, opcNewSeq, opcOf, - opcMarshalLoad, opcMarshalStore} + opcConv, opcCast, opcNewSeq, opcOf + } slotSomeTemp* = slotTempUnknown relativeJumps* = {opcTJmp, opcFJmp, opcJmp, opcJmpBack} diff --git a/compiler/vmdeps.nim b/compiler/vmdeps.nim index a9157bc03..294aaaa79 100644 --- a/compiler/vmdeps.nim +++ b/compiler/vmdeps.nim @@ -7,9 +7,14 @@ # distribution, for details about the copyright. # -import ast, types, msgs, os, options, idents, lineinfos +import ast, types, msgs, options, idents, lineinfos from pathutils import AbsoluteFile +import std/os + +when defined(nimPreviewSlimSystem): + import std/syncio + proc opSlurp*(file: string, info: TLineInfo, module: PSym; conf: ConfigRef): string = try: var filename = parentDir(toFullPath(conf, info)) / file @@ -26,7 +31,7 @@ proc opSlurp*(file: string, info: TLineInfo, module: PSym; conf: ConfigRef): str proc atomicTypeX(cache: IdentCache; name: string; m: TMagic; t: PType; info: TLineInfo; idgen: IdGenerator): PNode = - let sym = newSym(skType, getIdent(cache, name), nextSymId(idgen), t.owner, info) + let sym = newSym(skType, getIdent(cache, name), idgen, t.owner, info) sym.magic = m sym.typ = t result = newSymNode(sym) @@ -44,13 +49,13 @@ proc mapTypeToBracketX(cache: IdentCache; name: string; m: TMagic; t: PType; inf inst=false): PNode = result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) result.add atomicTypeX(cache, name, m, t, info, idgen) - for i in 0..<t.len: - if t[i] == nil: - let void = atomicTypeX(cache, "void", mVoid, t, info, idgen) - void.typ = newType(tyVoid, nextTypeId(idgen), t.owner) - result.add void + for a in t.kids: + if a == nil: + let voidt = atomicTypeX(cache, "void", mVoid, t, info, idgen) + voidt.typ = newType(tyVoid, idgen, t.owner) + result.add voidt else: - result.add mapTypeToAstX(cache, t[i], info, idgen, inst) + result.add mapTypeToAstX(cache, a, info, idgen, inst) proc objectNode(cache: IdentCache; n: PNode; idgen: IdGenerator): PNode = if n.kind == nkSym: @@ -69,9 +74,9 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; var allowRecursion = allowRecursionX template atomicType(name, m): untyped = atomicTypeX(cache, name, m, t, info, idgen) template atomicType(s): untyped = atomicTypeX(s, info) - template mapTypeToAst(t,info): untyped = mapTypeToAstX(cache, t, info, idgen, inst) - template mapTypeToAstR(t,info): untyped = mapTypeToAstX(cache, t, info, idgen, inst, true) - template mapTypeToAst(t,i,info): untyped = + template mapTypeToAst(t, info): untyped = mapTypeToAstX(cache, t, info, idgen, inst) + template mapTypeToAstR(t, info): untyped = mapTypeToAstX(cache, t, info, idgen, inst, true) + template mapTypeToAst(t, i, info): untyped = if i<t.len and t[i]!=nil: mapTypeToAstX(cache, t[i], info, idgen, inst) else: newNodeI(nkEmpty, info) template mapTypeToBracket(name, m, t, info): untyped = @@ -102,19 +107,19 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; of tyUncheckedArray: result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) result.add atomicType("UncheckedArray", mUncheckedArray) - result.add mapTypeToAst(t[0], info) + result.add mapTypeToAst(t.elementType, info) of tyArray: result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) result.add atomicType("array", mArray) - if inst and t[0].kind == tyRange: + if inst and t.indexType.kind == tyRange: var rng = newNodeX(nkInfix) rng.add newIdentNode(getIdent(cache, ".."), info) - rng.add t[0].n[0].copyTree - rng.add t[0].n[1].copyTree + rng.add t.indexType.n[0].copyTree + rng.add t.indexType.n[1].copyTree result.add rng else: - result.add mapTypeToAst(t[0], info) - result.add mapTypeToAst(t[1], info) + result.add mapTypeToAst(t.indexType, info) + result.add mapTypeToAst(t.elementType, info) of tyTypeDesc: if t.base != nil: result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) @@ -124,33 +129,37 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; result = atomicType("typeDesc", mTypeDesc) of tyGenericInvocation: result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) - for i in 0..<t.len: - result.add mapTypeToAst(t[i], info) + for a in t.kids: + result.add mapTypeToAst(a, info) of tyGenericInst: if inst: if allowRecursion: - result = mapTypeToAstR(t.lastSon, info) + result = mapTypeToAstR(t.skipModifier, info) + # keep original type info for getType calls on the output node: + result.typ = t else: result = newNodeX(nkBracketExpr) - #result.add mapTypeToAst(t.lastSon, info) - result.add mapTypeToAst(t[0], info) - for i in 1..<t.len-1: - result.add mapTypeToAst(t[i], info) + #result.add mapTypeToAst(t.last, info) + result.add mapTypeToAst(t.genericHead, info) + for _, a in t.genericInstParams: + result.add mapTypeToAst(a, info) else: - result = mapTypeToAstX(cache, t.lastSon, info, idgen, inst, allowRecursion) + result = mapTypeToAstX(cache, t.skipModifier, info, idgen, inst, allowRecursion) + # keep original type info for getType calls on the output node: + result.typ = t of tyGenericBody: if inst: - result = mapTypeToAstR(t.lastSon, info) + result = mapTypeToAstR(t.typeBodyImpl, info) else: - result = mapTypeToAst(t.lastSon, info) + result = mapTypeToAst(t.typeBodyImpl, info) of tyAlias: - result = mapTypeToAstX(cache, t.lastSon, info, idgen, inst, allowRecursion) + result = mapTypeToAstX(cache, t.skipModifier, info, idgen, inst, allowRecursion) of tyOrdinal: - result = mapTypeToAst(t.lastSon, info) + result = mapTypeToAst(t.skipModifier, info) of tyDistinct: if inst: result = newNodeX(nkDistinctTy) - result.add mapTypeToAst(t[0], info) + result.add mapTypeToAst(t.skipModifier, info) else: if allowRecursion or t.sym == nil: result = mapTypeToBracket("distinct", mDistinct, t, info) @@ -165,11 +174,11 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; if objectDef.kind == nkRefTy: objectDef = objectDef[0] result.add objectDef[0].copyTree # copy object pragmas - if t[0] == nil: + if t.baseClass == nil: result.add newNodeI(nkEmpty, info) else: # handle parent object var nn = newNodeX(nkOfInherit) - nn.add mapTypeToAst(t[0], info) + nn.add mapTypeToAst(t.baseClass, info) result.add nn if t.n.len > 0: result.add objectNode(cache, t.n, idgen) @@ -179,10 +188,10 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; if allowRecursion or t.sym == nil: result = newNodeIT(nkObjectTy, if t.n.isNil: info else: t.n.info, t) result.add newNodeI(nkEmpty, info) - if t[0] == nil: + if t.baseClass == nil: result.add newNodeI(nkEmpty, info) else: - result.add mapTypeToAst(t[0], info) + result.add mapTypeToAst(t.baseClass, info) result.add copyTree(t.n) else: result = atomicType(t.sym) @@ -196,7 +205,7 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; # only named tuples have a node, unnamed tuples don't if t.n.isNil: result = newNodeX(nkTupleConstr) - for subType in t.sons: + for subType in t.kids: result.add mapTypeToAst(subType, info) else: result = newNodeX(nkTupleTy) @@ -208,19 +217,19 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; of tyPtr: if inst: result = newNodeX(nkPtrTy) - result.add mapTypeToAst(t[0], info) + result.add mapTypeToAst(t.elementType, info) else: result = mapTypeToBracket("ptr", mPtr, t, info) of tyRef: if inst: result = newNodeX(nkRefTy) - result.add mapTypeToAst(t[0], info) + result.add mapTypeToAst(t.elementType, info) else: result = mapTypeToBracket("ref", mRef, t, info) of tyVar: if inst: result = newNodeX(nkVarTy) - result.add mapTypeToAst(t[0], info) + result.add mapTypeToAst(t.elementType, info) else: result = mapTypeToBracket("var", mVar, t, info) of tyLent: result = mapTypeToBracket("lent", mBuiltinType, t, info) @@ -228,17 +237,24 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; of tySequence: result = mapTypeToBracket("seq", mSeq, t, info) of tyProc: if inst: - result = newNodeX(nkProcTy) + result = newNodeX(if tfIterator in t.flags: nkIteratorTy else: nkProcTy) var fp = newNodeX(nkFormalParams) - if t[0] == nil: + if t.returnType == nil: fp.add newNodeI(nkEmpty, info) else: - fp.add mapTypeToAst(t[0], t.n[0].info) - for i in 1..<t.len: + fp.add mapTypeToAst(t.returnType, t.n[0].info) + for i in FirstParamAt..<t.kidsLen: fp.add newIdentDefs(t.n[i], t[i]) result.add fp - result.add if t.n[0].len > 0: t.n[0][pragmasEffects].copyTree - else: newNodeI(nkEmpty, info) + var prag = + if t.n[0].len > 0: + t.n[0][pragmasEffects].copyTree + else: + newNodeI(nkEmpty, info) + if t.callConv != ccClosure or tfExplicitCallConv in t.flags: + if prag.kind == nkEmpty: prag = newNodeI(nkPragma, info) + prag.add newIdentNode(getIdent(cache, $t.callConv), info) + result.add prag else: result = mapTypeToBracket("proc", mNone, t, info) of tyOpenArray: result = mapTypeToBracket("openArray", mOpenArray, t, info) @@ -257,7 +273,7 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; result.add t.n[1].copyTree of tyPointer: result = atomicType("pointer", mPointer) of tyString: result = atomicType("string", mString) - of tyCString: result = atomicType("cstring", mCstring) + of tyCstring: result = atomicType("cstring", mCstring) of tyInt: result = atomicType("int", mInt) of tyInt8: result = atomicType("int8", mInt8) of tyInt16: result = atomicType("int16", mInt16) @@ -273,12 +289,12 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; of tyUInt32: result = atomicType("uint32", mUInt32) of tyUInt64: result = atomicType("uint64", mUInt64) of tyVarargs: result = mapTypeToBracket("varargs", mVarargs, t, info) - of tyProxy: result = atomicType("error", mNone) + of tyError: result = atomicType("error", mNone) of tyBuiltInTypeClass: result = mapTypeToBracket("builtinTypeClass", mNone, t, info) of tyUserTypeClass, tyUserTypeClassInst: if t.isResolvedUserTypeClass: - result = mapTypeToAst(t.lastSon, info) + result = mapTypeToAst(t.last, info) else: result = mapTypeToBracket("concept", mNone, t, info) result.add t.n.copyTree @@ -287,8 +303,9 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; of tyAnd: result = mapTypeToBracket("and", mAnd, t, info) of tyOr: result = mapTypeToBracket("or", mOr, t, info) of tyNot: result = mapTypeToBracket("not", mNot, t, info) + of tyIterable: result = mapTypeToBracket("iterable", mIterableType, t, info) of tyAnything: result = atomicType("anything", mNone) - of tyInferred: assert false + of tyInferred: result = mapTypeToAstX(cache, t.skipModifier, info, idgen, inst, allowRecursion) of tyStatic, tyFromExpr: if inst: if t.n != nil: result = t.n.copyTree diff --git a/compiler/vmgen.nim b/compiler/vmgen.nim index 7d7382d18..0c7a49984 100644 --- a/compiler/vmgen.nim +++ b/compiler/vmgen.nim @@ -15,11 +15,10 @@ # this doesn't matter. However it matters for strings and other complex # types that use the 'node' field; the reason is that slots are # re-used in a register based VM. Example: -# -#.. code-block:: nim -# let s = a & b # no matter what, create fresh node -# s = a & b # no matter what, keep the node -# +# ```nim +# let s = a & b # no matter what, create fresh node +# s = a & b # no matter what, keep the node +# ``` # Also *stores* into non-temporary memory need to perform deep copies: # a.b = x.y # We used to generate opcAsgn for the *load* of 'x.y' but this is clearly @@ -27,12 +26,20 @@ # solves the opcLdConst vs opcAsgnConst issue. Of course whether we need # this copy depends on the involved types. +import std/[tables, intsets, strutils] + +when defined(nimPreviewSlimSystem): + import std/assertions + import - strutils, ast, types, msgs, renderer, vmdef, - intsets, magicsys, options, lowerings, lineinfos, transf + ast, types, msgs, renderer, vmdef, trees, + magicsys, options, lowerings, lineinfos, transf, astmsgs from modulegraphs import getBody +when defined(nimCompilerStacktraceHints): + import std/stackframes + const debugEchoCode* = defined(nimVMDebug) @@ -46,6 +53,7 @@ type gfNode # Affects how variables are loaded - always loads as rkNode gfNodeAddr # Affects how variables are loaded - always loads as rkNodeAddr gfIsParam # do not deepcopy parameters, they are immutable + gfIsSinkParam # deepcopy sink parameters TGenFlags = set[TGenFlag] proc debugInfo(c: PCtx; info: TLineInfo): string = @@ -94,11 +102,6 @@ proc codeListing(c: PCtx, result: var string, start=0; last = -1) = let idx = x.regBx-wordExcess result.addf("\t$#\tr$#, $# ($#)", opc.toStr, x.regA, c.constants[idx].renderTree, $idx) - elif opc in {opcMarshalLoad, opcMarshalStore}: - let y = c.code[i+1] - result.addf("\t$#\tr$#, r$#, $#", opc.toStr, x.regA, x.regB, - c.types[y.regBx-wordExcess].typeToString) - inc i else: result.addf("\t$#\tr$#, $#", opc.toStr, x.regA, x.regBx-wordExcess) result.add("\t# ") @@ -113,7 +116,8 @@ proc echoCode*(c: PCtx; start=0; last = -1) {.deprecated.} = codeListing(c, buf, start, last) echo buf -proc gABC(ctx: PCtx; n: PNode; opc: TOpcode; a, b, c: TRegister = 0) = +proc gABC(ctx: PCtx; n: PNode; opc: TOpcode; + a: TRegister = 0, b: TRegister = 0, c: TRegister = 0) = ## Takes the registers `b` and `c`, applies the operation `opc` to them, and ## stores the result into register `a` ## The node is needed for debug information @@ -188,7 +192,7 @@ proc getSlotKind(t: PType): TSlotKind = case t.skipTypes(abstractRange-{tyTypeDesc}).kind of tyBool, tyChar, tyEnum, tyOrdinal, tyInt..tyInt64, tyUInt..tyUInt64: slotTempInt - of tyString, tyCString: + of tyString, tyCstring: slotTempStr of tyFloat..tyFloat128: slotTempFloat @@ -209,22 +213,22 @@ proc getFreeRegister(cc: PCtx; k: TSlotKind; start: int): TRegister = # we prefer the same slot kind here for efficiency. Unfortunately for # discardable return types we may not know the desired type. This can happen # for e.g. mNAdd[Multiple]: - for i in start..c.maxSlots-1: - if c.slots[i].kind == k and not c.slots[i].inUse: - c.slots[i].inUse = true + for i in start..c.regInfo.len-1: + if c.regInfo[i].kind == k and not c.regInfo[i].inUse: + c.regInfo[i].inUse = true return TRegister(i) # if register pressure is high, we re-use more aggressively: - if c.maxSlots >= high(TRegister): - for i in start..c.maxSlots-1: - if not c.slots[i].inUse: - c.slots[i] = (inUse: true, kind: k) + if c.regInfo.len >= high(TRegister): + for i in start..c.regInfo.len-1: + if not c.regInfo[i].inUse: + c.regInfo[i] = (inUse: true, kind: k) return TRegister(i) - if c.maxSlots >= high(TRegister): + if c.regInfo.len >= high(TRegister): globalError(cc.config, cc.bestEffort, "VM problem: too many registers required") - result = TRegister(max(c.maxSlots, start)) - c.slots[result] = (inUse: true, kind: k) - c.maxSlots = result + 1 + result = TRegister(max(c.regInfo.len, start)) + c.regInfo.setLen int(result)+1 + c.regInfo[result] = (inUse: true, kind: k) proc getTemp(cc: PCtx; tt: PType): TRegister = let typ = tt.skipTypesOrNil({tyStatic}) @@ -242,29 +246,29 @@ proc getTemp(cc: PCtx; tt: PType): TRegister = proc freeTemp(c: PCtx; r: TRegister) = let c = c.prc - if c.slots[r].kind in {slotSomeTemp..slotTempComplex}: + if r < c.regInfo.len and c.regInfo[r].kind in {slotSomeTemp..slotTempComplex}: # this seems to cause https://github.com/nim-lang/Nim/issues/10647 - c.slots[r].inUse = false + c.regInfo[r].inUse = false proc getTempRange(cc: PCtx; n: int; kind: TSlotKind): TRegister = # if register pressure is high, we re-use more aggressively: let c = cc.prc # we could also customize via the following (with proper caching in ConfigRef): # let highRegisterPressure = cc.config.getConfigVar("vm.highRegisterPressure", "40").parseInt - if c.maxSlots >= HighRegisterPressure or c.maxSlots+n >= high(TRegister): - for i in 0..c.maxSlots-n: - if not c.slots[i].inUse: + if c.regInfo.len >= HighRegisterPressure or c.regInfo.len+n >= high(TRegister): + for i in 0..c.regInfo.len-n: + if not c.regInfo[i].inUse: block search: for j in i+1..i+n-1: - if c.slots[j].inUse: break search + if c.regInfo[j].inUse: break search result = TRegister(i) - for k in result..result+n-1: c.slots[k] = (inUse: true, kind: kind) + for k in result..result+n-1: c.regInfo[k] = (inUse: true, kind: kind) return - if c.maxSlots+n >= high(TRegister): + if c.regInfo.len+n >= high(TRegister): globalError(cc.config, cc.bestEffort, "VM problem: too many registers required") - result = TRegister(c.maxSlots) - inc c.maxSlots, n - for k in result..result+n-1: c.slots[k] = (inUse: true, kind: kind) + 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) proc freeTempRange(c: PCtx; start: TRegister, n: int) = for i in start..start+n-1: c.freeTemp(TRegister(i)) @@ -304,6 +308,8 @@ proc genx(c: PCtx; n: PNode; flags: TGenFlags = {}): TRegister = #internalAssert c.config, tmp >= 0 # 'nim check' does not like this internalAssert. if tmp >= 0: result = TRegister(tmp) + else: + result = 0 proc clearDest(c: PCtx; n: PNode; dest: var TDest) {.inline.} = # stmt is different from 'void' in meta programming contexts. @@ -316,10 +322,6 @@ proc isNotOpr(n: PNode): bool = n.kind in nkCallKinds and n[0].kind == nkSym and n[0].sym.magic == mNot -proc isTrue(n: PNode): bool = - n.kind == nkSym and n.sym.kind == skEnumField and n.sym.position != 0 or - n.kind == nkIntLit and n.intVal != 0 - proc genWhile(c: PCtx; n: PNode) = # lab1: # cond, tmp @@ -348,21 +350,22 @@ proc genWhile(c: PCtx; n: PNode) = c.patch(lab2) proc genBlock(c: PCtx; n: PNode; dest: var TDest) = - let oldRegisterCount = c.prc.maxSlots + let oldRegisterCount = c.prc.regInfo.len withBlock(n[0].sym): c.gen(n[1], dest) - for i in oldRegisterCount..<c.prc.maxSlots: - #if c.prc.slots[i].kind in {slotFixedVar, slotFixedLet}: + for i in oldRegisterCount..<c.prc.regInfo.len: + #if c.prc.regInfo[i].kind in {slotFixedVar, slotFixedLet}: if i != dest: when not defined(release): - if c.prc.slots[i].inUse and c.prc.slots[i].kind in {slotTempUnknown, - slotTempInt, - slotTempFloat, - slotTempStr, - slotTempComplex}: - doAssert false, "leaking temporary " & $i & " " & $c.prc.slots[i].kind - c.prc.slots[i] = (inUse: false, kind: slotEmpty) + if c.config.cmd != cmdCheck: + if c.prc.regInfo[i].inUse and c.prc.regInfo[i].kind in {slotTempUnknown, + slotTempInt, + slotTempFloat, + slotTempStr, + slotTempComplex}: + raiseAssert "leaking temporary " & $i & " " & $c.prc.regInfo[i].kind + c.prc.regInfo[i] = (inUse: false, kind: slotEmpty) c.clearDest(n, dest) @@ -403,18 +406,24 @@ proc genIf(c: PCtx, n: PNode; dest: var TDest) = c.gen(it[0], tmp) elsePos = c.xjmp(it[0], opcFJmp, tmp) # if false c.clearDest(n, dest) - c.gen(it[1], dest) # then part + if isEmptyType(it[1].typ): # maybe noreturn call, don't touch `dest` + c.gen(it[1]) + else: + c.gen(it[1], dest) # then part if i < n.len-1: endings.add(c.xjmp(it[1], opcJmp, 0)) c.patch(elsePos) else: c.clearDest(n, dest) - c.gen(it[0], dest) + if isEmptyType(it[0].typ): # maybe noreturn call, don't touch `dest` + c.gen(it[0]) + else: + c.gen(it[0], dest) for endPos in endings: c.patch(endPos) c.clearDest(n, dest) proc isTemp(c: PCtx; dest: TDest): bool = - result = dest >= 0 and c.prc.slots[dest].kind >= slotTempUnknown + result = dest >= 0 and c.prc.regInfo[dest].kind >= slotTempUnknown proc genAndOr(c: PCtx; n: PNode; opc: TOpcode; dest: var TDest) = # asgn dest, a @@ -436,14 +445,12 @@ proc genAndOr(c: PCtx; n: PNode; opc: TOpcode; dest: var TDest) = c.gABC(n, opcAsgnInt, dest, tmp) freeTemp(c, tmp) -proc canonValue*(n: PNode): PNode = - result = n - proc rawGenLiteral(c: PCtx; n: PNode): int = result = c.constants.len #assert(n.kind != nkCall) n.flags.incl nfAllConst - c.constants.add n.canonValue + n.flags.excl nfIsRef + c.constants.add n internalAssert c.config, result < regBxMax proc sameConstant*(a, b: PNode): bool = @@ -505,17 +512,25 @@ proc genCase(c: PCtx; n: PNode; dest: var TDest) = let it = n[i] if it.len == 1: # else stmt: - if it[0].kind != nkNilLit or it[0].typ != nil: + let body = it[0] + if body.kind != nkNilLit or body.typ != nil: # an nkNilLit with nil for typ implies there is no else branch, this # avoids unused related errors as we've already consumed the dest - c.gen(it[0], dest) + if isEmptyType(body.typ): # maybe noreturn call, don't touch `dest` + c.gen(body) + else: + c.gen(body, dest) else: let b = rawGenLiteral(c, it) c.gABx(it, opcBranch, tmp, b) - let elsePos = c.xjmp(it.lastSon, opcFJmp, tmp) - c.gen(it.lastSon, dest) + let body = it.lastSon + let elsePos = c.xjmp(body, opcFJmp, tmp) + if isEmptyType(body.typ): # maybe noreturn call, don't touch `dest` + c.gen(body) + else: + c.gen(body, dest) if i < n.len-1: - endings.add(c.xjmp(it.lastSon, opcJmp, 0)) + endings.add(c.xjmp(body, opcJmp, 0)) c.patch(elsePos) c.clearDest(n, dest) for endPos in endings: c.patch(endPos) @@ -531,7 +546,10 @@ proc genTry(c: PCtx; n: PNode; dest: var TDest) = if dest < 0 and not isEmptyType(n.typ): dest = getTemp(c, n.typ) var endings: seq[TPosition] = @[] let ehPos = c.xjmp(n, opcTry, 0) - c.gen(n[0], dest) + if isEmptyType(n[0].typ): # maybe noreturn call, don't touch `dest` + c.gen(n[0]) + else: + c.gen(n[0], dest) c.clearDest(n, dest) # Add a jump past the exception handling code let jumpToFinally = c.xjmp(n, opcJmp, 0) @@ -549,7 +567,11 @@ proc genTry(c: PCtx; n: PNode; dest: var TDest) = if it.len == 1: # general except section: c.gABx(it, opcExcept, 0, 0) - c.gen(it.lastSon, dest) + let body = it.lastSon + if isEmptyType(body.typ): # maybe noreturn call, don't touch `dest` + c.gen(body) + else: + c.gen(body, dest) c.clearDest(n, dest) if i < n.len: endings.add(c.xjmp(it, opcJmp, 0)) @@ -581,7 +603,7 @@ proc genLit(c: PCtx; n: PNode; dest: var TDest) = # assignments now: #var opc = opcLdConst if dest < 0: dest = c.getTemp(n.typ) - #elif c.prc.slots[dest].kind == slotFixedVar: opc = opcAsgnConst + #elif c.prc.regInfo[dest].kind == slotFixedVar: opc = opcAsgnConst let lit = genLiteral(c, n) c.gABx(n, opcLdConst, dest, lit) @@ -599,10 +621,17 @@ proc genCall(c: PCtx; n: PNode; dest: var TDest) = let fntyp = skipTypes(n[0].typ, abstractInst) for i in 0..<n.len: var r: TRegister = x+i - c.gen(n[i], r, {gfIsParam}) - if i >= fntyp.len: + if i >= fntyp.signatureLen: + c.gen(n[i], r, {gfIsParam}) internalAssert c.config, tfVarargs in fntyp.flags c.gABx(n, opcSetType, r, c.genType(n[i].typ)) + else: + if fntyp[i] != nil and fntyp[i].kind == tySink and + fntyp[i].skipTypes({tySink}).kind in {tyObject, tyString, tySequence}: + c.gen(n[i], r, {gfIsSinkParam}) + else: + c.gen(n[i], r, {gfIsParam}) + if dest < 0: c.gABC(n, opcIndCall, 0, x, n.len) else: @@ -641,9 +670,19 @@ proc genCheckedObjAccessAux(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags proc genAsgnPatch(c: PCtx; le: PNode, value: TRegister) = case le.kind of nkBracketExpr: - let dest = c.genx(le[0], {gfNode}) - let idx = c.genIndex(le[1], le[0].typ) - c.gABC(le, opcWrArr, dest, idx, value) + let + dest = c.genx(le[0], {gfNode}) + idx = c.genIndex(le[1], le[0].typ) + collTyp = le[0].typ.skipTypes(abstractVarRange-{tyTypeDesc}) + + case collTyp.kind + of tyString, tyCstring: + c.gABC(le, opcWrStrIdx, dest, idx, value) + of tyTuple: + c.gABC(le, opcWrObj, dest, int le[1].intVal, value) + else: + c.gABC(le, opcWrArr, dest, idx, value) + c.freeTemp(dest) c.freeTemp(idx) of nkCheckedFieldExpr: @@ -666,6 +705,9 @@ proc genAsgnPatch(c: PCtx; le: PNode, value: TRegister) = let dest = c.genx(le, {gfNodeAddr}) c.gABC(le, opcWrDeref, dest, 0, value) c.freeTemp(dest) + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + if sameBackendType(le.typ, le[1].typ): + genAsgnPatch(c, le[1], value) else: discard @@ -744,18 +786,20 @@ proc genNarrow(c: PCtx; n: PNode; dest: TDest) = let t = skipTypes(n.typ, abstractVar-{tyTypeDesc}) # uint is uint64 in the VM, we we only need to mask the result for # other unsigned types: - if t.kind in {tyUInt8..tyUInt32} or (t.kind == tyUInt and t.size < 8): - c.gABC(n, opcNarrowU, dest, TRegister(t.size*8)) - elif t.kind in {tyInt8..tyInt32} or (t.kind == tyInt and t.size < 8): - c.gABC(n, opcNarrowS, dest, TRegister(t.size*8)) + let size = getSize(c.config, t) + if t.kind in {tyUInt8..tyUInt32} or (t.kind == tyUInt and size < 8): + c.gABC(n, opcNarrowU, dest, TRegister(size*8)) + elif t.kind in {tyInt8..tyInt32} or (t.kind == tyInt and size < 8): + c.gABC(n, opcNarrowS, dest, TRegister(size*8)) proc genNarrowU(c: PCtx; n: PNode; dest: TDest) = let t = skipTypes(n.typ, abstractVar-{tyTypeDesc}) # uint is uint64 in the VM, we we only need to mask the result for # other unsigned types: + let size = getSize(c.config, t) if t.kind in {tyUInt8..tyUInt32, tyInt8..tyInt32} or - (t.kind in {tyUInt, tyInt} and t.size < 8): - c.gABC(n, opcNarrowU, dest, TRegister(t.size*8)) + (t.kind in {tyUInt, tyInt} and size < 8): + c.gABC(n, opcNarrowU, dest, TRegister(size*8)) proc genBinaryABCnarrow(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = genBinaryABC(c, n, dest, opc) @@ -812,15 +856,19 @@ proc genVarargsABC(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = var r: TRegister = x+i-1 c.gen(n[i], r) c.gABC(n, opc, dest, x, n.len-1) - c.freeTempRange(x, n.len) + c.freeTempRange(x, n.len-1) proc isInt8Lit(n: PNode): bool = if n.kind in {nkCharLit..nkUInt64Lit}: result = n.intVal >= low(int8) and n.intVal <= high(int8) + else: + result = false proc isInt16Lit(n: PNode): bool = if n.kind in {nkCharLit..nkUInt64Lit}: result = n.intVal >= low(int16) and n.intVal <= high(int16) + else: + result = false proc genAddSubInt(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = if n[2].isInt8Lit: @@ -832,11 +880,23 @@ proc genAddSubInt(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = genBinaryABC(c, n, dest, opc) c.genNarrow(n, dest) -proc genConv(c: PCtx; n, arg: PNode; dest: var TDest; opc=opcConv) = - if n.typ.kind == arg.typ.kind and arg.typ.kind == tyProc: - # don't do anything for lambda lifting conversions: - gen(c, arg, dest) +proc genConv(c: PCtx; n, arg: PNode; dest: var TDest, flags: TGenFlags = {}; opc=opcConv) = + let t2 = n.typ.skipTypes({tyDistinct}) + let targ2 = arg.typ.skipTypes({tyDistinct}) + + proc implicitConv(): bool = + if sameBackendType(t2, targ2): return true + # xxx consider whether to use t2 and targ2 here + if n.typ.kind == arg.typ.kind and arg.typ.kind == tyProc: + # don't do anything for lambda lifting conversions: + result = true + else: + result = false + + if implicitConv(): + gen(c, arg, dest, flags) return + let tmp = c.genx(arg) if dest < 0: dest = c.getTemp(n.typ) c.gABC(n, opc, dest, tmp) @@ -852,31 +912,42 @@ proc genCard(c: PCtx; n: PNode; dest: var TDest) = c.freeTemp(tmp) proc genCastIntFloat(c: PCtx; n: PNode; dest: var TDest) = - const allowedIntegers = {tyInt..tyInt64, tyUInt..tyUInt64, tyChar} - var signedIntegers = {tyInt..tyInt64} - var unsignedIntegers = {tyUInt..tyUInt64, tyChar} + template isSigned(typ: PType): bool {.dirty.} = + typ.kind == tyEnum and firstOrd(c.config, typ) < 0 or + typ.kind in {tyInt..tyInt64} + template isUnsigned(typ: PType): bool {.dirty.} = + typ.kind == tyEnum and firstOrd(c.config, typ) >= 0 or + typ.kind in {tyUInt..tyUInt64, tyChar, tyBool} + + const allowedIntegers = {tyInt..tyInt64, tyUInt..tyUInt64, tyChar, tyEnum, tyBool} + let src = n[1].typ.skipTypes(abstractRange)#.kind let dst = n[0].typ.skipTypes(abstractRange)#.kind let srcSize = getSize(c.config, src) let dstSize = getSize(c.config, dst) + const unsupportedCastDifferentSize = + "VM does not support 'cast' from $1 with size $2 to $3 with size $4 due to different sizes" if src.kind in allowedIntegers and dst.kind in allowedIntegers: let tmp = c.genx(n[1]) if dest < 0: dest = c.getTemp(n[0].typ) c.gABC(n, opcAsgnInt, dest, tmp) if dstSize != sizeof(BiggestInt): # don't do anything on biggest int types - if dst.kind in signedIntegers: # we need to do sign extensions + if isSigned(dst): # we need to do sign extensions if dstSize <= srcSize: # Sign extension can be omitted when the size increases. c.gABC(n, opcSignExtend, dest, TRegister(dstSize*8)) - elif dst.kind in unsignedIntegers: - if src.kind in signedIntegers or dstSize < srcSize: + elif isUnsigned(dst): + if isSigned(src) or dstSize < srcSize: # Cast from signed to unsigned always needs narrowing. Cast # from unsigned to unsigned only needs narrowing when target # is smaller than source. c.gABC(n, opcNarrowU, dest, TRegister(dstSize*8)) c.freeTemp(tmp) - elif srcSize == dstSize and src.kind in allowedIntegers and - dst.kind in {tyFloat, tyFloat32, tyFloat64}: + elif src.kind in allowedIntegers and + dst.kind in {tyFloat, tyFloat32, tyFloat64}: + if srcSize != dstSize: + globalError(c.config, n.info, unsupportedCastDifferentSize % + [$src.kind, $srcSize, $dst.kind, $dstSize]) let tmp = c.genx(n[1]) if dest < 0: dest = c.getTemp(n[0].typ) if dst.kind == tyFloat32: @@ -885,13 +956,16 @@ proc genCastIntFloat(c: PCtx; n: PNode; dest: var TDest) = c.gABC(n, opcCastIntToFloat64, dest, tmp) c.freeTemp(tmp) - elif srcSize == dstSize and src.kind in {tyFloat, tyFloat32, tyFloat64} and + elif src.kind in {tyFloat, tyFloat32, tyFloat64} and dst.kind in allowedIntegers: + if srcSize != dstSize: + globalError(c.config, n.info, unsupportedCastDifferentSize % + [$src.kind, $srcSize, $dst.kind, $dstSize]) let tmp = c.genx(n[1]) if dest < 0: dest = c.getTemp(n[0].typ) if src.kind == tyFloat32: c.gABC(n, opcCastFloatToInt32, dest, tmp) - if dst.kind in unsignedIntegers: + if isUnsigned(dst): # integers are sign extended by default. # since there is no opcCastFloatToUInt32, narrowing should do the trick. c.gABC(n, opcNarrowU, dest, TRegister(32)) @@ -970,7 +1044,7 @@ proc genBindSym(c: PCtx; n: PNode; dest: var TDest) = proc fitsRegister*(t: PType): bool = assert t != nil - t.skipTypes(abstractInst-{tyTypeDesc}).kind in { + t.skipTypes(abstractInst + {tyStatic} - {tyTypeDesc}).kind in { tyRange, tyEnum, tyBool, tyInt..tyUInt64, tyChar} proc ldNullOpcode(t: PType): TOpcode = @@ -988,7 +1062,7 @@ proc whichAsgnOpc(n: PNode; requiresCopy = true): TOpcode = else: (if requiresCopy: opcAsgnComplex else: opcFastAsgnComplex) -proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = +proc genMagic(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}, m: TMagic) = case m of mAnd: c.genAndOr(n, opcFJmp, dest) of mOr: c.genAndOr(n, opcTJmp, dest) @@ -1014,7 +1088,7 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = c.genAsgnPatch(n[1], d) c.freeTemp(d) of mOrd, mChr, mArrToSeq, mUnown: c.gen(n[1], dest) - of mIsolate: + of generatedMagics: genCall(c, n, dest) of mNew, mNewFinalize: unused(c, n, dest) @@ -1039,10 +1113,22 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = of mLengthOpenArray, mLengthArray, mLengthSeq: genUnaryABI(c, n, dest, opcLenSeq) of mLengthStr: - case n[1].typ.kind + case n[1].typ.skipTypes(abstractVarRange).kind of tyString: genUnaryABI(c, n, dest, opcLenStr) - of tyCString: genUnaryABI(c, n, dest, opcLenCstring) - else: doAssert false, $n[1].typ.kind + of tyCstring: genUnaryABI(c, n, dest, opcLenCstring) + else: raiseAssert $n[1].typ.kind + of mSlice: + var + d = c.genx(n[1]) + left = c.genIndex(n[2], n[1].typ) + right = c.genIndex(n[3], n[1].typ) + if dest < 0: dest = c.getTemp(n.typ) + c.gABC(n, opcNodeToReg, dest, d) + c.gABC(n, opcSlice, dest, left, right) + c.freeTemp(left) + c.freeTemp(right) + c.freeTemp(d) + of mIncl, mExcl: unused(c, n, dest) var d = c.genx(n[1]) @@ -1073,10 +1159,11 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = genBinaryABC(c, n, dest, opcShlInt) # genNarrowU modified let t = skipTypes(n.typ, abstractVar-{tyTypeDesc}) - if t.kind in {tyUInt8..tyUInt32} or (t.kind == tyUInt and t.size < 8): - c.gABC(n, opcNarrowU, dest, TRegister(t.size*8)) - elif t.kind in {tyInt8..tyInt32} or (t.kind == tyInt and t.size < 8): - c.gABC(n, opcSignExtend, dest, TRegister(t.size*8)) + let size = getSize(c.config, t) + if t.kind in {tyUInt8..tyUInt32} or (t.kind == tyUInt and size < 8): + c.gABC(n, opcNarrowU, dest, TRegister(size*8)) + elif t.kind in {tyInt8..tyInt32} or (t.kind == tyInt and size < 8): + c.gABC(n, opcSignExtend, dest, TRegister(size*8)) of mAshrI: genBinaryABC(c, n, dest, opcAshrInt) of mBitandI: genBinaryABC(c, n, dest, opcBitandInt) of mBitorI: genBinaryABC(c, n, dest, opcBitorInt) @@ -1110,12 +1197,13 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = genUnaryABC(c, n, dest, opcBitnotInt) #genNarrowU modified, do not narrow signed types let t = skipTypes(n.typ, abstractVar-{tyTypeDesc}) - if t.kind in {tyUInt8..tyUInt32} or (t.kind == tyUInt and t.size < 8): - c.gABC(n, opcNarrowU, dest, TRegister(t.size*8)) - of mCharToStr, mBoolToStr, mIntToStr, mInt64ToStr, - mFloatToStr, mCStrToStr, mStrToStr, mEnumToStr: - genConv(c, n, n[1], dest) - of mEqStr, mEqCString: genBinaryABC(c, n, dest, opcEqStr) + let size = getSize(c.config, t) + if t.kind in {tyUInt8..tyUInt32} or (t.kind == tyUInt and size < 8): + c.gABC(n, opcNarrowU, dest, TRegister(size*8)) + of mCharToStr, mBoolToStr, mCStrToStr, mStrToStr, mEnumToStr: + genConv(c, n, n[1], dest, flags) + of mEqStr: genBinaryABC(c, n, dest, opcEqStr) + of mEqCString: genBinaryABC(c, n, dest, opcEqCString) of mLeStr: genBinaryABC(c, n, dest, opcLeStr) of mLtStr: genBinaryABC(c, n, dest, opcLtStr) of mEqSet: genBinarySet(c, n, dest, opcEqSet) @@ -1155,21 +1243,11 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = d2 = c.genx(d2AsNode) var tmp1 = c.genx(n[1]) - tmp3 = c.genx(n[3]) c.gABC(n, opcParseFloat, dest, tmp1, d2) - c.gABC(n, opcParseFloat, tmp3) c.freeTemp(tmp1) - c.freeTemp(tmp3) c.genAsgnPatch(d2AsNode, d2) c.freeTemp(d2) - of mReset: - unused(c, n, dest) - var d = c.genx(n[1]) - # XXX use ldNullOpcode() here? - c.gABx(n, opcLdNull, d, c.genType(n[1].typ)) - c.gABx(n, opcNodeToReg, d, d) - c.genAsgnPatch(n[1], d) - of mDefault: + of mDefault, mZeroDefault: if dest < 0: dest = c.getTemp(n.typ) c.gABx(n, ldNullOpcode(n.typ), dest, c.genType(n.typ)) of mOf, mIs: @@ -1187,7 +1265,7 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = let tmp = c.genx(n[1]) case n[1].typ.skipTypes(abstractVar-{tyTypeDesc}).kind: of tyString: c.gABI(n, opcLenStr, dest, tmp, 1) - of tyCString: c.gABI(n, opcLenCstring, dest, tmp, 1) + of tyCstring: c.gABI(n, opcLenCstring, dest, tmp, 1) else: c.gABI(n, opcLenSeq, dest, tmp, 1) c.freeTemp(tmp) of mEcho: @@ -1211,9 +1289,9 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = unused(c, n, dest) genBinaryStmtVar(c, n, opcAddSeqElem) of mParseExprToAst: - genUnaryABC(c, n, dest, opcParseExprToAst) + genBinaryABC(c, n, dest, opcParseExprToAst) of mParseStmtToAst: - genUnaryABC(c, n, dest, opcParseStmtToAst) + genBinaryABC(c, n, dest, opcParseStmtToAst) of mTypeTrait: let tmp = c.genx(n[1]) if dest < 0: dest = c.getTemp(n.typ) @@ -1282,9 +1360,6 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = of mNSetIdent: unused(c, n, dest) genBinaryStmt(c, n, opcNSetIdent) - of mNSetType: - unused(c, n, dest) - genBinaryStmt(c, n, opcNSetType) of mNSetStrVal: unused(c, n, dest) genBinaryStmt(c, n, opcNSetStrVal) @@ -1304,7 +1379,19 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = of "copyLineInfo": internalAssert c.config, n.len == 3 unused(c, n, dest) - genBinaryStmt(c, n, opcNSetLineInfo) + genBinaryStmt(c, n, opcNCopyLineInfo) + of "setLine": + internalAssert c.config, n.len == 3 + unused(c, n, dest) + genBinaryStmt(c, n, opcNSetLineInfoLine) + of "setColumn": + internalAssert c.config, n.len == 3 + unused(c, n, dest) + genBinaryStmt(c, n, opcNSetLineInfoColumn) + of "setFile": + internalAssert c.config, n.len == 3 + unused(c, n, dest) + genBinaryStmt(c, n, opcNSetLineInfoFile) else: internalAssert c.config, false of mNHint: unused(c, n, dest) @@ -1347,16 +1434,25 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = globalError(c.config, n.info, sizeOfLikeMsg("offsetof")) of mRunnableExamples: discard "just ignore any call to runnableExamples" - of mDestroy: discard "ignore calls to the default destructor" + of mDestroy, mTrace: discard "ignore calls to the default destructor" + of mEnsureMove: + gen(c, n[1], dest) of mMove: let arg = n[1] let a = c.genx(arg) if dest < 0: dest = c.getTemp(arg.typ) gABC(c, arg, whichAsgnOpc(arg, requiresCopy=false), dest, a) # XXX use ldNullOpcode() here? - c.gABx(n, opcLdNull, a, c.genType(arg.typ)) - c.gABx(n, opcNodeToReg, a, a) - c.genAsgnPatch(arg, a) + # Don't zero out the arg for now #17199 + # c.gABx(n, opcLdNull, a, c.genType(arg.typ)) + # c.gABx(n, opcNodeToReg, a, a) + # c.genAsgnPatch(arg, a) + c.freeTemp(a) + of mDup: + let arg = n[1] + let a = c.genx(arg) + if dest < 0: dest = c.getTemp(arg.typ) + gABC(c, arg, whichAsgnOpc(arg, requiresCopy=false), dest, a) c.freeTemp(a) of mNodeId: c.genUnaryABC(n, dest, opcNodeId) @@ -1364,29 +1460,11 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = # mGCref, mGCunref, globalError(c.config, n.info, "cannot generate code for: " & $m) -proc genMarshalLoad(c: PCtx, n: PNode, dest: var TDest) = - ## Signature: proc to*[T](data: string): T - if dest < 0: dest = c.getTemp(n.typ) - var tmp = c.genx(n[1]) - c.gABC(n, opcMarshalLoad, dest, tmp) - c.gABx(n, opcMarshalLoad, 0, c.genType(n.typ)) - c.freeTemp(tmp) - -proc genMarshalStore(c: PCtx, n: PNode, dest: var TDest) = - ## Signature: proc `$$`*[T](x: T): string - if dest < 0: dest = c.getTemp(n.typ) - var tmp = c.genx(n[1]) - c.gABC(n, opcMarshalStore, dest, tmp) - c.gABx(n, opcMarshalStore, 0, c.genType(n[1].typ)) - c.freeTemp(tmp) - proc unneededIndirection(n: PNode): bool = n.typ.skipTypes(abstractInstOwned-{tyTypeDesc}).kind == tyRef -proc canElimAddr(n: PNode): PNode = - if n[0].typ.skipTypes(abstractInst).kind in {tyObject, tyTuple, tyArray}: - # objects are reference types in the VM - return n[0] +proc canElimAddr(n: PNode; idgen: IdGenerator): PNode = + result = nil case n[0].kind of nkObjUpConv, nkObjDownConv, nkChckRange, nkChckRangeF, nkChckRange64: var m = n[0][0] @@ -1394,19 +1472,28 @@ proc canElimAddr(n: PNode): PNode = # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) result = copyNode(n[0]) result.add m[0] + if n.typ.skipTypes(abstractVar).kind != tyOpenArray: + result.typ = n.typ + elif n.typ.skipTypes(abstractInst).kind in {tyVar}: + result.typ = toVar(result.typ, n.typ.skipTypes(abstractInst).kind, idgen) of nkHiddenStdConv, nkHiddenSubConv, nkConv: var m = n[0][1] if m.kind in {nkDerefExpr, nkHiddenDeref}: # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) result = copyNode(n[0]) + result.add n[0][0] result.add m[0] + if n.typ.skipTypes(abstractVar).kind != tyOpenArray: + result.typ = n.typ + elif n.typ.skipTypes(abstractInst).kind in {tyVar}: + result.typ = toVar(result.typ, n.typ.skipTypes(abstractInst).kind, idgen) else: if n[0].kind in {nkDerefExpr, nkHiddenDeref}: # addr ( deref ( x )) --> x result = n[0][0] proc genAddr(c: PCtx, n: PNode, dest: var TDest, flags: TGenFlags) = - if (let m = canElimAddr(n); m != nil): + if (let m = canElimAddr(n, c.idgen); m != nil): gen(c, m, dest, flags) return @@ -1418,13 +1505,13 @@ proc genAddr(c: PCtx, n: PNode, dest: var TDest, flags: TGenFlags) = else: let tmp = c.genx(n[0], newflags) if dest < 0: dest = c.getTemp(n.typ) - if c.prc.slots[tmp].kind >= slotTempUnknown: + if c.prc.regInfo[tmp].kind >= slotTempUnknown: gABC(c, n, opcAddrNode, dest, tmp) # hack ahead; in order to fix bug #1781 we mark the temporary as # permanent, so that it's not used for anything else: - c.prc.slots[tmp].kind = slotTempPerm + c.prc.regInfo[tmp].kind = slotTempPerm # XXX this is still a hack - #message(n.info, warnUser, "suspicious opcode used") + #message(c.congig, n.info, warnUser, "suspicious opcode used") else: gABC(c, n, opcAddrReg, dest, tmp) c.freeTemp(tmp) @@ -1454,11 +1541,16 @@ proc setSlot(c: PCtx; v: PSym) = if v.position == 0: v.position = getFreeRegister(c, if v.kind == skLet: slotFixedLet else: slotFixedVar, start = 1) -proc cannotEval(c: PCtx; n: PNode) {.noinline.} = +template cannotEval(c: PCtx; n: PNode) = + if c.config.cmd == cmdCheck: + localError(c.config, n.info, "cannot evaluate at compile time: " & + n.renderTree) + return globalError(c.config, n.info, "cannot evaluate at compile time: " & n.renderTree) proc isOwnedBy(a, b: PSym): bool = + result = false var a = a.owner while a != nil and a.kind != skModule: if a == b: return true @@ -1471,19 +1563,22 @@ proc getOwner(c: PCtx): PSym = proc importcCondVar*(s: PSym): bool {.inline.} = # see also importcCond if sfImportc in s.flags: - return s.kind in {skVar, skLet, skConst} + result = s.kind in {skVar, skLet, skConst} + else: + result = false proc checkCanEval(c: PCtx; n: PNode) = # we need to ensure that we don't evaluate 'x' here: # proc foo() = var x ... let s = n.sym if {sfCompileTime, sfGlobal} <= s.flags: return - if s.importcCondVar: return + if compiletimeFFI in c.config.features and s.importcCondVar: return if s.kind in {skVar, skTemp, skLet, skParam, skResult} and not s.isOwnedBy(c.prc.sym) and s.owner != c.module and c.mode != emRepl: # little hack ahead for bug #12612: assume gensym'ed variables # are in the right scope: if sfGenSym in s.flags and c.prc.sym == nil: discard + elif s.kind == skParam and s.typ.kind == tyTypeDesc: discard else: cannotEval(c, n) elif s.kind in {skProc, skFunc, skConverter, skMethod, skIterator} and sfForward in s.flags: @@ -1513,12 +1608,16 @@ proc preventFalseAlias(c: PCtx; n: PNode; opc: TOpcode; proc genAsgn(c: PCtx; le, ri: PNode; requiresCopy: bool) = case le.kind of nkBracketExpr: - let dest = c.genx(le[0], {gfNode}) - let idx = c.genIndex(le[1], le[0].typ) - let tmp = c.genx(ri) - if le[0].typ.skipTypes(abstractVarRange-{tyTypeDesc}).kind in { - tyString, tyCString}: + let + dest = c.genx(le[0], {gfNode}) + idx = c.genIndex(le[1], le[0].typ) + tmp = c.genx(ri) + collTyp = le[0].typ.skipTypes(abstractVarRange-{tyTypeDesc}) + case collTyp.kind + of tyString, tyCstring: c.preventFalseAlias(le, opcWrStrIdx, dest, idx, tmp) + of tyTuple: + c.preventFalseAlias(le, opcWrObj, dest, int le[1].intVal, tmp) else: c.preventFalseAlias(le, opcWrArr, dest, idx, tmp) c.freeTemp(tmp) @@ -1569,6 +1668,9 @@ proc genAsgn(c: PCtx; le, ri: PNode; requiresCopy: bool) = c.freeTemp(cc) else: gen(c, ri, dest) + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + if sameBackendType(le.typ, le[1].typ): + genAsgn(c, le[1], ri, requiresCopy) else: let dest = c.genx(le, {gfNodeAddr}) genAsgn(c, dest, ri, requiresCopy) @@ -1579,11 +1681,21 @@ proc genTypeLit(c: PCtx; t: PType; dest: var TDest) = n.typ = t genLit(c, n, dest) +proc isEmptyBody(n: PNode): bool = + case n.kind + of nkStmtList: + for i in 0..<n.len: + if not isEmptyBody(n[i]): return false + result = true + else: + result = n.kind in {nkCommentStmt, nkEmpty} + proc importcCond*(c: PCtx; s: PSym): bool {.inline.} = ## return true to importc `s`, false to execute its body instead (refs #8405) + result = false if sfImportc in s.flags: if s.kind in routineKinds: - return getBody(c.graph, s).kind == nkEmpty + return isEmptyBody(getBody(c.graph, s)) proc importcSym(c: PCtx; info: TLineInfo; s: PSym) = when hasFFI: @@ -1597,10 +1709,10 @@ proc importcSym(c: PCtx; info: TLineInfo; s: PSym) = localError(c.config, info, "cannot 'importc' variable at compile time; " & s.name.s) -proc getNullValue*(typ: PType, info: TLineInfo; conf: ConfigRef): PNode +proc getNullValue*(c: PCtx; typ: PType, info: TLineInfo; conf: ConfigRef): PNode proc genGlobalInit(c: PCtx; n: PNode; s: PSym) = - c.globals.add(getNullValue(s.typ, n.info, c.config)) + c.globals.add(getNullValue(c, s.typ, n.info, c.config)) s.position = c.globals.len # This is rather hard to support, due to the laziness of the VM code # generator. See tests/compile/tmacro2 for why this is necessary: @@ -1636,6 +1748,8 @@ proc genRdVar(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = c.gABx(n, opcLdGlobalAddr, dest, s.position) elif isImportcVar: c.gABx(n, opcLdGlobalDerefFFI, dest, s.position) + elif gfIsSinkParam in flags: + genAsgn(c, dest, n, requiresCopy = true) elif fitsRegister(s.typ) and gfNode notin flags: var cc = c.getTemp(n.typ) c.gABx(n, opcLdGlobal, cc, s.position) @@ -1649,10 +1763,10 @@ proc genRdVar(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = s.kind in {skParam, skResult}): if dest < 0: dest = s.position + ord(s.kind == skParam) - internalAssert(c.config, c.prc.slots[dest].kind < slotSomeTemp) + internalAssert(c.config, c.prc.regInfo.len > dest and c.prc.regInfo[dest].kind < slotSomeTemp) else: # we need to generate an assignment: - let requiresCopy = c.prc.slots[dest].kind >= slotSomeTemp and + let requiresCopy = c.prc.regInfo[dest].kind >= slotSomeTemp and gfIsParam notin flags genAsgn(c, dest, n, requiresCopy) else: @@ -1676,15 +1790,13 @@ proc genArrAccessOpcode(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode; c.gABC(n, opcNodeToReg, dest, cc) c.freeTemp(cc) else: - #message(n.info, warnUser, "argh") + #message(c.config, n.info, warnUser, "argh") #echo "FLAGS ", flags, " ", fitsRegister(n.typ), " ", typeToString(n.typ) c.gABC(n, opc, dest, a, b) c.freeTemp(a) c.freeTemp(b) -proc genObjAccess(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = - let a = c.genx(n[0], flags) - let b = genField(c, n[1]) +proc genObjAccessAux(c: PCtx; n: PNode; a, b: int, dest: var TDest; flags: TGenFlags) = if dest < 0: dest = c.getTemp(n.typ) if {gfNodeAddr} * flags != {}: c.gABC(n, opcLdObjAddr, dest, a, b) @@ -1697,6 +1809,11 @@ proc genObjAccess(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = c.gABC(n, opcLdObj, dest, a, b) c.freeTemp(a) +proc genObjAccess(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = + genObjAccessAux(c, n, c.genx(n[0], flags), genField(c, n[1]), dest, flags) + + + proc genCheckedObjAccessAux(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = internalAssert c.config, n.kind == nkCheckedFieldExpr # nkDotExpr to access the requested field @@ -1721,18 +1838,20 @@ proc genCheckedObjAccessAux(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags let setLit = c.genx(checkExpr[1]) var rs = c.getTemp(getSysType(c.graph, n.info, tyBool)) c.gABC(n, opcContainsSet, rs, setLit, discVal) - c.freeTemp(discVal) c.freeTemp(setLit) # If the check fails let the user know let lab1 = c.xjmp(n, if negCheck: opcFJmp else: opcTJmp, rs) c.freeTemp(rs) let strType = getSysType(c.graph, n.info, tyString) - var fieldNameRegister: TDest = c.getTemp(strType) - let strLit = newStrNode($accessExpr[1], accessExpr[1].info) + var msgReg: TDest = c.getTemp(strType) + let fieldName = $accessExpr[1] + let msg = genFieldDefect(c.config, fieldName, disc.sym) + let strLit = newStrNode(msg, accessExpr[1].info) strLit.typ = strType - c.genLit(strLit, fieldNameRegister) - c.gABC(n, opcInvalidField, fieldNameRegister) - c.freeTemp(fieldNameRegister) + c.genLit(strLit, msgReg) + c.gABC(n, opcInvalidField, msgReg, discVal) + c.freeTemp(discVal) + c.freeTemp(msgReg) c.patch(lab1) proc genCheckedObjAccess(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = @@ -1762,36 +1881,41 @@ proc genCheckedObjAccess(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = proc genArrAccess(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = let arrayType = n[0].typ.skipTypes(abstractVarRange-{tyTypeDesc}).kind - if arrayType in {tyString, tyCString}: + case arrayType + of tyString, tyCstring: let opc = if gfNodeAddr in flags: opcLdStrIdxAddr else: opcLdStrIdx genArrAccessOpcode(c, n, dest, opc, flags) - elif arrayType == tyTypeDesc: + of tyTuple: + c.genObjAccessAux(n, c.genx(n[0], flags), int n[1].intVal, dest, flags) + of tyTypeDesc: c.genTypeLit(n.typ, dest) else: let opc = if gfNodeAddr in flags: opcLdArrAddr else: opcLdArr genArrAccessOpcode(c, n, dest, opc, flags) -proc getNullValueAux(t: PType; obj: PNode, result: PNode; conf: ConfigRef; currPosition: var int) = - if t != nil and t.len > 0 and t[0] != nil: - let b = skipTypes(t[0], skipPtrs) - getNullValueAux(b, b.n, result, conf, currPosition) +proc getNullValueAux(c: PCtx; t: PType; obj: PNode, result: PNode; conf: ConfigRef; currPosition: var int) = + if t != nil and t.baseClass != nil: + let b = skipTypes(t.baseClass, skipPtrs) + getNullValueAux(c, b, b.n, result, conf, currPosition) case obj.kind of nkRecList: - for i in 0..<obj.len: getNullValueAux(nil, obj[i], result, conf, currPosition) + for i in 0..<obj.len: getNullValueAux(c, nil, obj[i], result, conf, currPosition) of nkRecCase: - getNullValueAux(nil, obj[0], result, conf, currPosition) + getNullValueAux(c, nil, obj[0], result, conf, currPosition) for i in 1..<obj.len: - getNullValueAux(nil, lastSon(obj[i]), result, conf, currPosition) + getNullValueAux(c, nil, lastSon(obj[i]), result, conf, currPosition) of nkSym: let field = newNodeI(nkExprColonExpr, result.info) field.add(obj) - field.add(getNullValue(obj.sym.typ, result.info, conf)) + let value = getNullValue(c, obj.sym.typ, result.info, conf) + value.flags.incl nfSkipFieldChecking + field.add(value) result.add field doAssert obj.sym.position == currPosition inc currPosition else: globalError(conf, result.info, "cannot create null element for: " & $obj) -proc getNullValue(typ: PType, info: TLineInfo; conf: ConfigRef): PNode = +proc getNullValue(c: PCtx; typ: PType, info: TLineInfo; conf: ConfigRef): PNode = var t = skipTypes(typ, abstractRange+{tyStatic, tyOwned}-{tyTypeDesc}) case t.kind of tyBool, tyEnum, tyChar, tyInt..tyInt64: @@ -1800,10 +1924,10 @@ proc getNullValue(typ: PType, info: TLineInfo; conf: ConfigRef): PNode = result = newNodeIT(nkUIntLit, info, t) of tyFloat..tyFloat128: result = newNodeIT(nkFloatLit, info, t) - of tyCString, tyString: + of tyString: result = newNodeIT(nkStrLit, info, t) result.strVal = "" - of tyVar, tyLent, tyPointer, tyPtr, tyUntyped, + of tyCstring, tyVar, tyLent, tyPointer, tyPtr, tyUntyped, tyTyped, tyTypeDesc, tyRef, tyNil: result = newNodeIT(nkNilLit, info, t) of tyProc: @@ -1811,22 +1935,22 @@ proc getNullValue(typ: PType, info: TLineInfo; conf: ConfigRef): PNode = result = newNodeIT(nkNilLit, info, t) else: result = newNodeIT(nkTupleConstr, info, t) - result.add(newNodeIT(nkNilLit, info, t)) - result.add(newNodeIT(nkNilLit, info, t)) + result.add(newNodeIT(nkNilLit, info, getSysType(c.graph, info, tyPointer))) + result.add(newNodeIT(nkNilLit, info, getSysType(c.graph, info, tyPointer))) of tyObject: result = newNodeIT(nkObjConstr, info, t) result.add(newNodeIT(nkEmpty, info, t)) # initialize inherited fields, and all in the correct order: var currPosition = 0 - getNullValueAux(t, t.n, result, conf, currPosition) + getNullValueAux(c, t, t.n, result, conf, currPosition) of tyArray: result = newNodeIT(nkBracket, info, t) for i in 0..<toInt(lengthOrd(conf, t)): - result.add getNullValue(elemType(t), info, conf) + result.add getNullValue(c, elemType(t), info, conf) of tyTuple: result = newNodeIT(nkTupleConstr, info, t) - for i in 0..<t.len: - result.add getNullValue(t[i], info, conf) + for a in t.kids: + result.add getNullValue(c, a, info, conf) of tySet: result = newNodeIT(nkCurly, info, t) of tySequence, tyOpenArray: @@ -1849,21 +1973,38 @@ proc genVarSection(c: PCtx; n: PNode) = let s = a[0].sym checkCanEval(c, a[0]) if s.isGlobal: + let runtimeAccessToCompileTime = c.mode == emRepl and + sfCompileTime in s.flags and s.position > 0 if s.position == 0: if importcCond(c, s): c.importcSym(a.info, s) else: - let sa = getNullValue(s.typ, a.info, c.config) + let sa = getNullValue(c, s.typ, a.info, c.config) #if s.ast.isNil: getNullValue(s.typ, a.info) - #else: canonValue(s.ast) + #else: s.ast assert sa.kind != nkCall c.globals.add(sa) s.position = c.globals.len - if a[2].kind != nkEmpty: + if runtimeAccessToCompileTime: + discard + elif a[2].kind != nkEmpty: let tmp = c.genx(a[0], {gfNodeAddr}) let val = c.genx(a[2]) c.genAdditionalCopy(a[2], opcWrDeref, tmp, 0, val) c.freeTemp(val) c.freeTemp(tmp) + elif not importcCondVar(s) and not (s.typ.kind == tyProc and s.typ.callConv == ccClosure) and + sfPure notin s.flags: # fixes #10938 + # there is a pre-existing issue with closure types in VM + # if `(var s: proc () = default(proc ()); doAssert s == nil)` works for you; + # you might remove the second condition. + # the problem is that closure types are tuples in VM, but the types of its children + # shouldn't have the same type as closure types. + let tmp = c.genx(a[0], {gfNodeAddr}) + let sa = getNullValue(c, s.typ, a.info, c.config) + let val = c.genx(sa) + c.genAdditionalCopy(sa, opcWrDeref, tmp, 0, val) + c.freeTemp(val) + c.freeTemp(tmp) else: setSlot(c, s) if a[2].kind == nkEmpty: @@ -1929,10 +2070,12 @@ proc genSetConstr(c: PCtx, n: PNode, dest: var TDest) = c.freeTemp(a) proc genObjConstr(c: PCtx, n: PNode, dest: var TDest) = + if tfUnion in n.typ.flags: # bug #22708 # bug #13481 + globalError(c.config, n.info, "object with '{.union.}' pragmas is not supported by VM") if dest < 0: dest = c.getTemp(n.typ) let t = n.typ.skipTypes(abstractRange+{tyOwned}-{tyTypeDesc}) if t.kind == tyRef: - c.gABx(n, opcNew, dest, c.genType(t[0])) + c.gABx(n, opcNew, dest, c.genType(t.elementType)) else: c.gABx(n, opcLdNull, dest, c.genType(n.typ)) for i in 1..<n.len: @@ -1966,34 +2109,46 @@ proc genTupleConstr(c: PCtx, n: PNode, dest: var TDest) = proc genProc*(c: PCtx; s: PSym): int -proc matches(s: PSym; x: string): bool = - let y = x.split('.') +proc toKey(s: PSym): string = + result = "" var s = s - for i in 1..y.len: - if s == nil or (y[^i].cmpIgnoreStyle(s.name.s) != 0 and y[^i] != "*"): - return false - s = if sfFromGeneric in s.flags: s.owner.owner else: s.owner - while s != nil and s.kind == skPackage and s.owner != nil: s = s.owner - result = true + while s != nil: + result.add s.name.s + if s.owner != nil: + if sfFromGeneric in s.flags: + s = s.instantiatedFrom.owner + else: + s = s.owner + result.add "." + else: + break proc procIsCallback(c: PCtx; s: PSym): bool = if s.offset < -1: return true - var i = -2 - for key, value in items(c.callbacks): - if s.matches(key): - doAssert s.offset == -1 - s.offset = i - return true - dec i + let key = toKey(s) + if c.callbackIndex.contains(key): + let index = c.callbackIndex[key] + doAssert s.offset == -1 + s.offset = -2'i32 - index.int32 + result = true + else: + result = false proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = + when defined(nimCompilerStacktraceHints): + setFrameMsg c.config$n.info & " " & $n.kind & " " & $flags case n.kind of nkSym: let s = n.sym checkCanEval(c, n) case s.kind - of skVar, skForVar, skTemp, skLet, skParam, skResult: + of skVar, skForVar, skTemp, skLet, skResult: genRdVar(c, n, dest, flags) + of skParam: + if s.typ.kind == tyTypeDesc: + genTypeLit(c, s.typ.skipTypes({tyTypeDesc}), dest) + else: + 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: @@ -2002,8 +2157,11 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = elif importcCond(c, s): c.importcSym(n.info, s) genLit(c, n, dest) of skConst: - let constVal = if s.ast != nil: s.ast else: s.typ.n - gen(c, constVal, dest) + let constVal = if s.astdef != nil: s.astdef else: s.typ.n + if dontInlineConstant(n, constVal): + genLit(c, constVal, dest) + else: + gen(c, constVal, dest) of skEnumField: # we never reach this case - as of the time of this comment, # skEnumField is folded to an int in semfold.nim, but this code @@ -2027,16 +2185,10 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = if n[0].kind == nkSym: let s = n[0].sym if s.magic != mNone: - genMagic(c, n, dest, s.magic) + genMagic(c, n, dest, flags, s.magic) elif s.kind == skMethod: localError(c.config, n.info, "cannot call method " & s.name.s & " at compile time") - elif matches(s, "stdlib.marshal.to"): - # XXX marshal load&store should not be opcodes, but use the - # general callback mechanisms. - genMarshalLoad(c, n, dest) - elif matches(s, "stdlib.marshal.$$"): - genMarshalStore(c, n, dest) else: genCall(c, n, dest) clearDest(c, n, dest) @@ -2051,9 +2203,9 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = genLit(c, n, dest) of nkUIntLit..pred(nkNilLit): genLit(c, n, dest) of nkNilLit: - if not n.typ.isEmptyType: genLit(c, getNullValue(n.typ, n.info, c.config), dest) + if not n.typ.isEmptyType: genLit(c, getNullValue(c, n.typ, n.info, c.config), dest) else: unused(c, n, dest) - of nkAsgn, nkFastAsgn: + of nkAsgn, nkFastAsgn, nkSinkAsgn: unused(c, n, dest) genAsgn(c, n[0], n[1], n.kind == nkAsgn) of nkDotExpr: genObjAccess(c, n, dest, flags) @@ -2090,36 +2242,37 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = unused(c, n, dest) gen(c, n[0]) of nkHiddenStdConv, nkHiddenSubConv, nkConv: - genConv(c, n, n[1], dest) + genConv(c, n, n[1], dest, flags) of nkObjDownConv: - genConv(c, n, n[0], dest) + genConv(c, n, n[0], dest, flags) of nkObjUpConv: - genConv(c, n, n[0], dest) + genConv(c, n, n[0], dest, flags) of nkVarSection, nkLetSection: unused(c, n, dest) genVarSection(c, n) - of declarativeDefs, nkMacroDef: - unused(c, n, dest) of nkLambdaKinds: #let s = n[namePos].sym #discard genProc(c, s) genLit(c, newSymNode(n[namePos].sym), dest) of nkChckRangeF, nkChckRange64, nkChckRange: - let - tmp0 = c.genx(n[0]) - tmp1 = c.genx(n[1]) - tmp2 = c.genx(n[2]) - c.gABC(n, opcRangeChck, tmp0, tmp1, tmp2) - c.freeTemp(tmp1) - c.freeTemp(tmp2) - if dest >= 0: - gABC(c, n, whichAsgnOpc(n), dest, tmp0) - c.freeTemp(tmp0) + if skipTypes(n.typ, abstractVar).kind in {tyUInt..tyUInt64}: + genConv(c, n, n[0], dest, flags) else: - dest = tmp0 + let + tmp0 = c.genx(n[0]) + tmp1 = c.genx(n[1]) + tmp2 = c.genx(n[2]) + c.gABC(n, opcRangeChck, tmp0, tmp1, tmp2) + c.freeTemp(tmp1) + c.freeTemp(tmp2) + if dest >= 0: + gABC(c, n, whichAsgnOpc(n), dest, tmp0) + c.freeTemp(tmp0) + else: + dest = tmp0 of nkEmpty, nkCommentStmt, nkTypeSection, nkConstSection, nkPragma, nkTemplateDef, nkIncludeStmt, nkImportStmt, nkFromStmt, nkExportStmt, - nkMixinStmt, nkBindStmt: + nkMixinStmt, nkBindStmt, declarativeDefs, nkMacroDef: unused(c, n, dest) of nkStringToCString, nkCStringToString: gen(c, n[0], dest) @@ -2129,7 +2282,7 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = of nkPar, nkClosure, nkTupleConstr: genTupleConstr(c, n, dest) of nkCast: if allowCast in c.features: - genConv(c, n, n[1], dest, opcCast) + genConv(c, n, n[1], dest, flags, opcCast) else: genCastIntFloat(c, n, dest) of nkTypeOfExpr: @@ -2175,10 +2328,10 @@ proc genExpr*(c: PCtx; n: PNode, requiresValue = true): int = proc genParams(c: PCtx; params: PNode) = # res.sym.position is already 0 - c.prc.slots[0] = (inUse: true, kind: slotFixedVar) + setLen(c.prc.regInfo, max(params.len, 1)) + c.prc.regInfo[0] = (inUse: true, kind: slotFixedVar) for i in 1..<params.len: - c.prc.slots[i] = (inUse: true, kind: slotFixedLet) - c.prc.maxSlots = max(params.len, 1) + c.prc.regInfo[i] = (inUse: true, kind: slotFixedLet) proc finalJumpTarget(c: PCtx; pc, diff: int) = internalAssert(c.config, regBxMin < diff and diff < regBxMax) @@ -2188,12 +2341,12 @@ proc finalJumpTarget(c: PCtx; pc, diff: int) = TInstrType(diff+wordExcess) shl regBxShift).TInstr proc genGenericParams(c: PCtx; gp: PNode) = - var base = c.prc.maxSlots + var base = c.prc.regInfo.len + setLen c.prc.regInfo, base + gp.len for i in 0..<gp.len: var param = gp[i].sym param.position = base + i # XXX: fix this earlier; make it consistent with templates - c.prc.slots[base + i] = (inUse: true, kind: slotFixedLet) - c.prc.maxSlots = base + gp.len + c.prc.regInfo[base + i] = (inUse: true, kind: slotFixedLet) proc optimizeJumps(c: PCtx; start: int) = const maxIterations = 10 @@ -2237,26 +2390,30 @@ proc optimizeJumps(c: PCtx; start: int) = else: discard proc genProc(c: PCtx; s: PSym): int = - var x = s.ast[miscPos] - if x.kind == nkEmpty or x[0].kind == nkEmpty: + let + pos = c.procToCodePos.getOrDefault(s.id) + wasNotGenProcBefore = pos == 0 + noRegistersAllocated = s.offset == -1 + if wasNotGenProcBefore or noRegistersAllocated: + # xxx: the noRegisterAllocated check is required in order to avoid issues + # where nimsuggest can crash due as a macro with pos will be loaded + # but it doesn't have offsets for register allocations see: + # https://github.com/nim-lang/Nim/issues/18385 + # Improvements and further use of IC should remove the need for this. #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 + var eofInstr: TInstr = default(TInstr) if last >= 0 and c.code[last].opcode == opcEof: eofInstr = c.code[last] c.code.setLen(last) c.debug.setLen(last) #c.removeLastEof result = c.code.len+1 # skip the jump instruction - if x.kind == nkEmpty: - x = newTree(nkBracket, newIntNode(nkIntLit, result), x) - else: - x[0] = newIntNode(nkIntLit, result) - s.ast[miscPos] = x + c.procToCodePos[s.id] = result # thanks to the jmp we can add top level statements easily and also nest # procs easily: - let body = transformBody(c.graph, c.idgen, s, cache = not isCompileTimeProc(s)) + let body = transformBody(c.graph, c.idgen, s, if isCompileTimeProc(s): {} else: {useCache}) let procStart = c.xjmp(body, opcJmp, 0) var p = PProc(blocks: @[], sym: s) let oldPrc = c.prc @@ -2271,19 +2428,18 @@ proc genProc(c: PCtx; s: PSym): int = if tfCapturesEnv in s.typ.flags: #let env = s.ast[paramsPos].lastSon.sym #assert env.position == 2 - c.prc.slots[c.prc.maxSlots] = (inUse: true, kind: slotFixedLet) - inc c.prc.maxSlots + c.prc.regInfo.add (inUse: true, kind: slotFixedLet) gen(c, body) # generate final 'return' statement: c.gABC(body, opcRet) c.patch(procStart) c.gABC(body, opcEof, eofInstr.regA) c.optimizeJumps(result) - s.offset = c.prc.maxSlots + s.offset = c.prc.regInfo.len.int32 #if s.name.s == "main" or s.name.s == "[]": # echo renderTree(body) # c.echoCode(result) c.prc = oldPrc else: - c.prc.maxSlots = s.offset - result = x[0].intVal.int + c.prc.regInfo.setLen s.offset + result = pos diff --git a/compiler/vmhooks.nim b/compiler/vmhooks.nim index 573d84853..2d7ad63e7 100644 --- a/compiler/vmhooks.nim +++ b/compiler/vmhooks.nim @@ -9,6 +9,9 @@ import pathutils +when defined(nimPreviewSlimSystem): + import std/assertions + template setX(k, field) {.dirty.} = a.slots[a.ra].ensureKind(k) a.slots[a.ra].field = v @@ -36,10 +39,21 @@ proc setResult*(a: VmArgs; v: seq[string]) = for x in v: n.add newStrNode(nkStrLit, x) a.slots[a.ra].node = n -template getX(k, field) {.dirty.} = +proc setResult*(a: VmArgs; v: (BiggestInt, BiggestInt)) = + a.slots[a.ra].ensureKind(rkNode) + var tuplen = newNode(nkTupleConstr) + tuplen.add newIntNode(nkIntLit, v[0]) + tuplen.add newIntNode(nkIntLit, v[1]) + a.slots[a.ra].node = tuplen + +template getReg(a, i): untyped = doAssert i < a.rc-1 - doAssert a.slots[i+a.rb+1].kind == k - result = a.slots[i+a.rb+1].field + a.slots[i+a.rb+1].unsafeAddr + +template getX(k, field): untyped {.dirty.} = + let p = getReg(a, i) + doAssert p.kind == k, $p.kind + p.field proc numArgs*(a: VmArgs): int = result = a.rc-1 @@ -47,19 +61,17 @@ proc numArgs*(a: VmArgs): int = proc getInt*(a: VmArgs; i: Natural): BiggestInt = getX(rkInt, intVal) proc getBool*(a: VmArgs; i: Natural): bool = getInt(a, i) != 0 proc getFloat*(a: VmArgs; i: Natural): BiggestFloat = getX(rkFloat, floatVal) -proc getString*(a: VmArgs; i: Natural): string = - doAssert i < a.rc-1 - doAssert a.slots[i+a.rb+1].kind == rkNode - result = a.slots[i+a.rb+1].node.strVal - -proc getNode*(a: VmArgs; i: Natural): PNode = - doAssert i < a.rc-1 - doAssert a.slots[i+a.rb+1].kind == rkNode - result = a.slots[i+a.rb+1].node +proc getNode*(a: VmArgs; i: Natural): PNode = getX(rkNode, node) +proc getString*(a: VmArgs; i: Natural): string = getX(rkNode, node).strVal +proc getVar*(a: VmArgs; i: Natural): PNode = + let p = getReg(a, i) + # depending on whether we come from top-level or proc scope, we need to consider 2 cases + case p.kind + of rkRegisterAddr: result = p.regAddr.node + of rkNodeAddr: result = p.nodeAddr[] + else: raiseAssert $p.kind proc getNodeAddr*(a: VmArgs; i: Natural): PNode = - doAssert i < a.rc-1 - doAssert a.slots[i+a.rb+1].kind == rkNodeAddr - let nodeAddr = a.slots[i+a.rb+1].nodeAddr + let nodeAddr = getX(rkNodeAddr, nodeAddr) doAssert nodeAddr != nil result = nodeAddr[] diff --git a/compiler/vmmarshal.nim b/compiler/vmmarshal.nim index ffd8e16d7..0e67ededa 100644 --- a/compiler/vmmarshal.nim +++ b/compiler/vmmarshal.nim @@ -9,15 +9,21 @@ ## Implements marshaling for the VM. -import streams, json, intsets, tables, ast, astalgo, idents, types, msgs, +import ast, astalgo, idents, types, msgs, options, lineinfos +import std/[streams, json, intsets, tables] + +when defined(nimPreviewSlimSystem): + import std/[assertions, formatfloat] + proc ptrToInt(x: PNode): int {.inline.} = result = cast[int](x) # don't skip alignment proc getField(n: PNode; position: int): PSym = case n.kind of nkRecList: + result = nil for i in 0..<n.len: result = getField(n[i], position) if result != nil: return @@ -32,7 +38,8 @@ proc getField(n: PNode; position: int): PSym = else: discard of nkSym: if n.sym.position == position: result = n.sym - else: discard + else: result = nil + else: result = nil proc storeAny(s: var string; t: PType; a: PNode; stored: var IntSet; conf: ConfigRef) @@ -75,11 +82,11 @@ proc storeAny(s: var string; t: PType; a: PNode; stored: var IntSet; s.add("]") of tyTuple: s.add("{") - for i in 0..<t.len: + for i, ti in t.ikids: if i > 0: s.add(", ") s.add("\"Field" & $i) s.add("\": ") - storeAny(s, t[i], a[i].skipColon, stored, conf) + storeAny(s, ti, a[i].skipColon, stored, conf) s.add("}") of tyObject: s.add("{") @@ -91,16 +98,17 @@ proc storeAny(s: var string; t: PType; a: PNode; stored: var IntSet; if i > 0: s.add(", ") if a[i].kind == nkRange: var x = copyNode(a[i][0]) - storeAny(s, t.lastSon, x, stored, conf) - while x.intVal+1 <= a[i][1].intVal: + storeAny(s, t.elementType, x, stored, conf) + inc x.intVal + while x.intVal <= a[i][1].intVal: s.add(", ") - storeAny(s, t.lastSon, x, stored, conf) + storeAny(s, t.elementType, x, stored, conf) inc x.intVal else: - storeAny(s, t.lastSon, a[i], stored, conf) + storeAny(s, t.elementType, a[i], stored, conf) s.add("]") of tyRange, tyGenericInst, tyAlias, tySink: - storeAny(s, t.lastSon, a, stored, conf) + storeAny(s, t.skipModifier, a, stored, conf) of tyEnum: # we need a slow linear search because of enums with holes: for e in items(t.n): @@ -119,9 +127,9 @@ proc storeAny(s: var string; t: PType; a: PNode; stored: var IntSet; s.add("[") s.add($x.ptrToInt) s.add(", ") - storeAny(s, t.lastSon, a, stored, conf) + storeAny(s, t.elementType, a, stored, conf) s.add("]") - of tyString, tyCString: + of tyString, tyCstring: if a.kind == nkNilLit: s.add("null") else: s.add(escapeJson(a.strVal)) of tyInt..tyInt64, tyUInt..tyUInt64: s.add($a.intVal) @@ -139,7 +147,9 @@ proc loadAny(p: var JsonParser, t: PType, conf: ConfigRef; idgen: IdGenerator): PNode = case t.kind - of tyNone: assert false + of tyNone: + result = nil + assert false of tyBool: case p.kind of jsonFalse: result = newIntNode(nkIntLit, 0) @@ -149,6 +159,7 @@ proc loadAny(p: var JsonParser, t: PType, of tyChar: if p.kind == jsonString: var x = p.str + result = nil if x.len == 1: result = newIntNode(nkIntLit, ord(x[0])) next(p) @@ -157,8 +168,11 @@ proc loadAny(p: var JsonParser, t: PType, result = newIntNode(nkIntLit, getInt(p)) next(p) return + else: + result = nil raiseParseErr(p, "string of length 1 expected for a char") of tyEnum: + result = nil if p.kind == jsonString: for e in items(t.n): if e.sym.name.s == p.str: @@ -187,17 +201,19 @@ proc loadAny(p: var JsonParser, t: PType, if p.kind == jsonArrayEnd: next(p) else: raiseParseErr(p, "") else: + result = nil raiseParseErr(p, "'[' expected for a seq") of tyTuple: if p.kind != jsonObjectStart: raiseParseErr(p, "'{' expected for an object") next(p) result = newNode(nkTupleConstr) var i = 0 + let tupleLen = t.kidsLen while p.kind != jsonObjectEnd and p.kind != jsonEof: if p.kind != jsonString: raiseParseErr(p, "string expected for a field name") next(p) - if i >= t.len: + if i >= tupleLen: raiseParseErr(p, "too many fields to tuple type " & typeToString(t)) result.add loadAny(p, t[i], tab, cache, conf, idgen) inc i @@ -220,7 +236,7 @@ proc loadAny(p: var JsonParser, t: PType, if pos >= result.len: setLen(result.sons, pos + 1) let fieldNode = newNode(nkExprColonExpr) - fieldNode.add newSymNode(newSym(skField, ident, nextSymId(idgen), nil, unknownLineInfo)) + fieldNode.add newSymNode(newSym(skField, ident, idgen, nil, unknownLineInfo)) fieldNode.add loadAny(p, field.typ, tab, cache, conf, idgen) result[pos] = fieldNode if p.kind == jsonObjectEnd: next(p) @@ -230,8 +246,7 @@ proc loadAny(p: var JsonParser, t: PType, next(p) result = newNode(nkCurly) while p.kind != jsonArrayEnd and p.kind != jsonEof: - result.add loadAny(p, t.lastSon, tab, cache, conf, idgen) - next(p) + result.add loadAny(p, t.elementType, tab, cache, conf, idgen) if p.kind == jsonArrayEnd: next(p) else: raiseParseErr(p, "']' end of array expected") of tyPtr, tyRef: @@ -245,17 +260,20 @@ proc loadAny(p: var JsonParser, t: PType, raiseParseErr(p, "cannot load object with address " & $p.getInt) next(p) of jsonArrayStart: + result = nil next(p) if p.kind == jsonInt: let idx = p.getInt next(p) - result = loadAny(p, t.lastSon, tab, cache, conf, idgen) + result = loadAny(p, t.elementType, tab, cache, conf, idgen) tab[idx] = result else: raiseParseErr(p, "index for ref type expected") if p.kind == jsonArrayEnd: next(p) else: raiseParseErr(p, "']' end of ref-address pair expected") - else: raiseParseErr(p, "int for pointer type expected") - of tyString, tyCString: + else: + result = nil + raiseParseErr(p, "int for pointer type expected") + of tyString, tyCstring: case p.kind of jsonNull: result = newNode(nkNilLit) @@ -263,27 +281,34 @@ proc loadAny(p: var JsonParser, t: PType, of jsonString: result = newStrNode(nkStrLit, p.str) next(p) - else: raiseParseErr(p, "string expected") + else: + result = nil + raiseParseErr(p, "string expected") of tyInt..tyInt64, tyUInt..tyUInt64: if p.kind == jsonInt: result = newIntNode(nkIntLit, getInt(p)) next(p) return + else: + result = nil raiseParseErr(p, "int expected") of tyFloat..tyFloat128: if p.kind == jsonFloat: result = newFloatNode(nkFloatLit, getFloat(p)) next(p) return + else: + result = nil raiseParseErr(p, "float expected") of tyRange, tyGenericInst, tyAlias, tySink: - result = loadAny(p, t.lastSon, tab, cache, conf, idgen) + result = loadAny(p, t.skipModifier, tab, cache, conf, idgen) else: + result = nil internalError conf, "cannot marshal at compile-time " & t.typeToString proc loadAny*(s: string; t: PType; cache: IdentCache; conf: ConfigRef; idgen: IdGenerator): PNode = var tab = initTable[BiggestInt, PNode]() - var p: JsonParser + var p: JsonParser = default(JsonParser) open(p, newStringStream(s), "unknown file") next(p) result = loadAny(p, t, tab, cache, conf, idgen) diff --git a/compiler/vmops.nim b/compiler/vmops.nim index 5748b41b3..45194e633 100644 --- a/compiler/vmops.nim +++ b/compiler/vmops.nim @@ -12,26 +12,36 @@ from std/math import sqrt, ln, log10, log2, exp, round, arccos, arcsin, arctan, arctan2, cos, cosh, hypot, sinh, sin, tan, tanh, pow, trunc, floor, ceil, `mod`, cbrt, arcsinh, arccosh, arctanh, erf, erfc, gamma, - lgamma - + lgamma, divmod +from std/sequtils import toSeq when declared(math.copySign): - from std/math import copySign + # pending bug #18762, avoid renaming math + from std/math as math2 import copySign when declared(math.signbit): - from std/math import signbit + # ditto + from std/math as math3 import signbit + -from std/os import getEnv, existsEnv, dirExists, fileExists, putEnv, walkDir, - getAppFilename, raiseOSError, osLastError +from std/envvars import getEnv, existsEnv, delEnv, putEnv, envPairs +from std/os import getAppFilename +from std/private/oscommon import dirExists, fileExists +from std/private/osdirs import walkDir, createDir +from std/private/ospaths2 import getCurrentDir -from std/md5 import getMD5 from std/times import cpuTime from std/hashes import hash from std/osproc import nil -from sighashes import symBodyDigest + +when defined(nimPreviewSlimSystem): + import std/syncio +else: + from std/formatfloat import addFloatRoundtrip, addFloatSprintf + # There are some useful procs in vmconv. -import vmconv +import vmconv, vmmarshal template mathop(op) {.dirty.} = registerCallback(c, "stdlib.math." & astToStr(op), `op Wrapper`) @@ -39,6 +49,15 @@ template mathop(op) {.dirty.} = template osop(op) {.dirty.} = registerCallback(c, "stdlib.os." & astToStr(op), `op Wrapper`) +template oscommonop(op) {.dirty.} = + registerCallback(c, "stdlib.oscommon." & astToStr(op), `op Wrapper`) + +template osdirsop(op) {.dirty.} = + registerCallback(c, "stdlib.osdirs." & astToStr(op), `op Wrapper`) + +template envvarsop(op) {.dirty.} = + registerCallback(c, "stdlib.envvars." & astToStr(op), `op Wrapper`) + template timesop(op) {.dirty.} = registerCallback(c, "stdlib.times." & astToStr(op), `op Wrapper`) @@ -46,25 +65,27 @@ template systemop(op) {.dirty.} = registerCallback(c, "stdlib.system." & astToStr(op), `op Wrapper`) template ioop(op) {.dirty.} = - registerCallback(c, "stdlib.io." & astToStr(op), `op Wrapper`) + registerCallback(c, "stdlib.syncio." & astToStr(op), `op Wrapper`) template macrosop(op) {.dirty.} = registerCallback(c, "stdlib.macros." & astToStr(op), `op Wrapper`) -template md5op(op) {.dirty.} = - registerCallback(c, "stdlib.md5." & astToStr(op), `op Wrapper`) - -template wrap1f_math(op) {.dirty.} = +template wrap1fMath(op) {.dirty.} = proc `op Wrapper`(a: VmArgs) {.nimcall.} = doAssert a.numArgs == 1 setResult(a, op(getFloat(a, 0))) mathop op -template wrap2f_math(op) {.dirty.} = +template wrap2fMath(op) {.dirty.} = proc `op Wrapper`(a: VmArgs) {.nimcall.} = setResult(a, op(getFloat(a, 0), getFloat(a, 1))) mathop op +template wrap2iMath(op) {.dirty.} = + proc `op Wrapper`(a: VmArgs) {.nimcall.} = + setResult(a, op(getInt(a, 0), getInt(a, 1))) + mathop op + template wrap0(op, modop) {.dirty.} = proc `op Wrapper`(a: VmArgs) {.nimcall.} = setResult(a, op()) @@ -95,7 +116,17 @@ template wrap2svoid(op, modop) {.dirty.} = op(getString(a, 0), getString(a, 1)) modop op -template wrapDangerous(op, modop) {.dirty.} = +template wrapDangerous1svoid(op, modop) {.dirty.} = + if vmopsDanger notin c.config.features and (defined(nimsuggest) or c.config.cmd == cmdCheck): + proc `op Wrapper`(a: VmArgs) {.nimcall.} = + discard + modop op + else: + proc `op Wrapper`(a: VmArgs) {.nimcall.} = + op(getString(a, 0)) + modop op + +template wrapDangerous2svoid(op, modop) {.dirty.} = if vmopsDanger notin c.config.features and (defined(nimsuggest) or c.config.cmd == cmdCheck): proc `op Wrapper`(a: VmArgs) {.nimcall.} = discard @@ -117,39 +148,53 @@ proc staticWalkDirImpl(path: string, relative: bool): PNode = for k, f in walkDir(path, relative): result.add toLit((k, f)) -when defined(nimHasInvariant): - from std / compilesettings import SingleValueSetting, MultipleValueSetting - - proc querySettingImpl(conf: ConfigRef, switch: BiggestInt): string = - case SingleValueSetting(switch) - of arguments: result = conf.arguments - of outFile: result = conf.outFile.string - of outDir: result = conf.outDir.string - of nimcacheDir: result = conf.getNimcacheDir().string - of projectName: result = conf.projectName - of projectPath: result = conf.projectPath.string - of projectFull: result = conf.projectFull.string - of command: result = conf.command - of commandLine: result = conf.commandLine - of linkOptions: result = conf.linkOptions - of compileOptions: result = conf.compileOptions - of ccompilerPath: result = conf.cCompilerPath - of backend: result = $conf.backend - of libPath: result = conf.libpath.string - - proc querySettingSeqImpl(conf: ConfigRef, switch: BiggestInt): seq[string] = - template copySeq(field: untyped): untyped = - for i in field: result.add i.string - - case MultipleValueSetting(switch) - of nimblePaths: copySeq(conf.nimblePaths) - of searchPaths: copySeq(conf.searchPaths) - of lazyPaths: copySeq(conf.lazyPaths) - of commandArgs: result = conf.commandArgs - of cincludes: copySeq(conf.cIncludes) - of clibs: copySeq(conf.cLibs) +from std / compilesettings import SingleValueSetting, MultipleValueSetting + +proc querySettingImpl(conf: ConfigRef, switch: BiggestInt): string = + {.push warning[Deprecated]:off.} + case SingleValueSetting(switch) + of arguments: result = conf.arguments + of outFile: result = conf.outFile.string + of outDir: result = conf.outDir.string + of nimcacheDir: result = conf.getNimcacheDir().string + of projectName: result = conf.projectName + of projectPath: result = conf.projectPath.string + of projectFull: result = conf.projectFull.string + of command: result = conf.command + of commandLine: result = conf.commandLine + of linkOptions: result = conf.linkOptions + of compileOptions: result = conf.compileOptions + of ccompilerPath: result = conf.cCompilerPath + of backend: result = $conf.backend + of libPath: result = conf.libpath.string + of gc: result = $conf.selectedGC + of mm: result = $conf.selectedGC + {.pop.} + +proc querySettingSeqImpl(conf: ConfigRef, switch: BiggestInt): seq[string] = + template copySeq(field: untyped): untyped = + result = @[] + for i in field: result.add i.string + + case MultipleValueSetting(switch) + of nimblePaths: copySeq(conf.nimblePaths) + of searchPaths: copySeq(conf.searchPaths) + of lazyPaths: copySeq(conf.lazyPaths) + of commandArgs: result = conf.commandArgs + 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 registerAdditionalOps*(c: PCtx) = + + template wrapIterator(fqname: string, iter: untyped) = + registerCallback c, fqname, proc(a: VmArgs) = + setResult(a, toLit(toSeq(iter))) + + proc gorgeExWrapper(a: VmArgs) = let ret = opGorge(getString(a, 0), getString(a, 1), getString(a, 2), a.currentLineInfo, c.config) @@ -158,72 +203,76 @@ proc registerAdditionalOps*(c: PCtx) = proc getProjectPathWrapper(a: VmArgs) = setResult a, c.config.projectPath.string - wrap1f_math(sqrt) - wrap1f_math(cbrt) - wrap1f_math(ln) - wrap1f_math(log10) - wrap1f_math(log2) - wrap1f_math(exp) - wrap1f_math(arccos) - wrap1f_math(arcsin) - wrap1f_math(arctan) - wrap1f_math(arcsinh) - wrap1f_math(arccosh) - wrap1f_math(arctanh) - wrap2f_math(arctan2) - wrap1f_math(cos) - wrap1f_math(cosh) - wrap2f_math(hypot) - wrap1f_math(sinh) - wrap1f_math(sin) - wrap1f_math(tan) - wrap1f_math(tanh) - wrap2f_math(pow) - wrap1f_math(trunc) - wrap1f_math(floor) - wrap1f_math(ceil) - wrap1f_math(erf) - wrap1f_math(erfc) - wrap1f_math(gamma) - wrap1f_math(lgamma) + wrap1fMath(sqrt) + wrap1fMath(cbrt) + wrap1fMath(ln) + wrap1fMath(log10) + wrap1fMath(log2) + wrap1fMath(exp) + wrap1fMath(arccos) + wrap1fMath(arcsin) + wrap1fMath(arctan) + wrap1fMath(arcsinh) + wrap1fMath(arccosh) + wrap1fMath(arctanh) + wrap2fMath(arctan2) + wrap1fMath(cos) + wrap1fMath(cosh) + wrap2fMath(hypot) + wrap1fMath(sinh) + wrap1fMath(sin) + wrap1fMath(tan) + wrap1fMath(tanh) + wrap2fMath(pow) + wrap1fMath(trunc) + wrap1fMath(floor) + wrap1fMath(ceil) + wrap1fMath(erf) + wrap1fMath(erfc) + wrap1fMath(gamma) + wrap1fMath(lgamma) + wrap2iMath(divmod) when declared(copySign): - wrap2f_math(copySign) + wrap2fMath(copySign) when declared(signbit): - wrap1f_math(signbit) + wrap1fMath(signbit) registerCallback c, "stdlib.math.round", proc (a: VmArgs) {.nimcall.} = let n = a.numArgs case n of 1: setResult(a, round(getFloat(a, 0))) of 2: setResult(a, round(getFloat(a, 0), getInt(a, 1).int)) - else: doAssert false, $n - - wrap1s(getMD5, md5op) + else: raiseAssert $n proc `mod Wrapper`(a: VmArgs) {.nimcall.} = setResult(a, `mod`(getFloat(a, 0), getFloat(a, 1))) registerCallback(c, "stdlib.math.mod", `mod Wrapper`) when defined(nimcore): - wrap2s(getEnv, osop) - wrap1s(existsEnv, osop) - wrap2svoid(putEnv, osop) - wrap1s(dirExists, osop) - wrap1s(fileExists, osop) - wrapDangerous(writeFile, ioop) + wrap2s(getEnv, envvarsop) + wrap1s(existsEnv, envvarsop) + wrap2svoid(putEnv, envvarsop) + wrap1svoid(delEnv, envvarsop) + wrap1s(dirExists, oscommonop) + wrap1s(fileExists, oscommonop) + wrapDangerous2svoid(writeFile, ioop) + wrapDangerous1svoid(createDir, osdirsop) wrap1s(readFile, ioop) wrap2si(readLines, ioop) systemop getCurrentExceptionMsg systemop getCurrentException - registerCallback c, "stdlib.*.staticWalkDir", proc (a: VmArgs) {.nimcall.} = + registerCallback c, "stdlib.osdirs.staticWalkDir", proc (a: VmArgs) {.nimcall.} = setResult(a, staticWalkDirImpl(getString(a, 0), getBool(a, 1))) - when defined(nimHasInvariant): - registerCallback c, "stdlib.compilesettings.querySetting", proc (a: VmArgs) = - setResult(a, querySettingImpl(c.config, getInt(a, 0))) - registerCallback c, "stdlib.compilesettings.querySettingSeq", proc (a: VmArgs) = - setResult(a, querySettingSeqImpl(c.config, getInt(a, 0))) + registerCallback c, "stdlib.staticos.staticDirExists", proc (a: VmArgs) {.nimcall.} = + setResult(a, dirExists(getString(a, 0))) + registerCallback c, "stdlib.staticos.staticFileExists", proc (a: VmArgs) {.nimcall.} = + setResult(a, fileExists(getString(a, 0))) + registerCallback c, "stdlib.compilesettings.querySetting", proc (a: VmArgs) = + setResult(a, querySettingImpl(c.config, getInt(a, 0))) + registerCallback c, "stdlib.compilesettings.querySettingSeq", proc (a: VmArgs) = + setResult(a, querySettingSeqImpl(c.config, getInt(a, 0))) if defined(nimsuggest) or c.config.cmd == cmdCheck: discard "don't run staticExec for 'nim suggest'" @@ -237,17 +286,24 @@ proc registerAdditionalOps*(c: PCtx) = registerCallback c, "stdlib.macros.symBodyHash", proc (a: VmArgs) = let n = getNode(a, 0) if n.kind != nkSym: - stackTrace(c, PStackFrame(prc: c.prc.sym, comesFrom: 0, next: nil), c.exceptionInstr, - "symBodyHash() requires a symbol. '" & $n & "' is of kind '" & $n.kind & "'", n.info) + stackTrace2(c, "symBodyHash() requires a symbol. '$#' is of kind '$#'" % [$n, $n.kind], 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: - stackTrace(c, PStackFrame(prc: c.prc.sym, comesFrom: 0, next: nil), c.exceptionInstr, - "isExported() requires a symbol. '" & $n & "' is of kind '" & $n.kind & "'", n.info) + stackTrace2(c, "isExported() requires a symbol. '$#' is of kind '$#'" % [$n, $n.kind], n) setResult(a, sfExported in n.sym.flags) + registerCallback c, "stdlib.macrocache.hasKey", proc (a: VmArgs) = + let + table = getString(a, 0) + key = getString(a, 1) + setResult(a, table in c.graph.cacheTables and key in c.graph.cacheTables[table]) + + registerCallback c, "stdlib.vmutils.vmTrace", proc (a: VmArgs) = + c.config.isVmTrace = getBool(a, 0) + proc hashVmImpl(a: VmArgs) = var res = hashes.hash(a.getString(0), a.getInt(1).int, a.getInt(2).int) if c.config.backend == backendJs: @@ -286,27 +342,33 @@ proc registerAdditionalOps*(c: PCtx) = ## reproducible builds and users need to understand that this runs at CT. ## Note that `staticExec` can already do equal amount of damage so it's more ## of a semantic issue than a security issue. - registerCallback c, "stdlib.os.getCurrentDir", proc (a: VmArgs) {.nimcall.} = - setResult(a, os.getCurrentDir()) + registerCallback c, "stdlib.ospaths2.getCurrentDir", proc (a: VmArgs) {.nimcall.} = + setResult(a, getCurrentDir()) registerCallback c, "stdlib.osproc.execCmdEx", proc (a: VmArgs) {.nimcall.} = let options = getNode(a, 1).fromLit(set[osproc.ProcessOption]) a.setResult osproc.execCmdEx(getString(a, 0), options).toLit - registerCallback c, "stdlib.times.getTime", proc (a: VmArgs) {.nimcall.} = - setResult(a, times.getTime().toLit) + registerCallback c, "stdlib.times.getTimeImpl", proc (a: VmArgs) = + let obj = a.getNode(0).typ.n + setResult(a, times.getTime().toTimeLit(c, obj, a.currentLineInfo)) proc getEffectList(c: PCtx; a: VmArgs; effectIndex: int) = let fn = getNode(a, 0) + var list = newNodeI(nkBracket, fn.info) if fn.typ != nil and fn.typ.n != nil and fn.typ.n[0].len >= effectListLen and fn.typ.n[0][effectIndex] != nil: - var list = newNodeI(nkBracket, fn.info) for e in fn.typ.n[0][effectIndex]: list.add opMapTypeInstToAst(c.cache, e.typ.skipTypes({tyRef}), e.info, c.idgen) - setResult(a, list) + else: + list.add newIdentNode(getIdent(c.cache, "UncomputedEffects"), fn.info) + + setResult(a, list) registerCallback c, "stdlib.effecttraits.getRaisesListImpl", proc (a: VmArgs) = getEffectList(c, a, exceptionEffects) registerCallback c, "stdlib.effecttraits.getTagsListImpl", proc (a: VmArgs) = getEffectList(c, a, tagEffects) + registerCallback c, "stdlib.effecttraits.getForbidsListImpl", proc (a: VmArgs) = + getEffectList(c, a, forbiddenEffects) registerCallback c, "stdlib.effecttraits.isGcSafeImpl", proc (a: VmArgs) = let fn = getNode(a, 0) @@ -316,3 +378,40 @@ proc registerAdditionalOps*(c: PCtx) = let fn = getNode(a, 0) setResult(a, (fn.typ != nil and tfNoSideEffect in fn.typ.flags) or (fn.kind == nkSym and fn.sym.kind == skFunc)) + + registerCallback c, "stdlib.typetraits.hasClosureImpl", proc (a: VmArgs) = + let fn = getNode(a, 0) + setResult(a, fn.kind == nkClosure or (fn.typ != nil and fn.typ.callConv == ccClosure)) + + registerCallback c, "stdlib.formatfloat.addFloatRoundtrip", proc(a: VmArgs) = + let p = a.getVar(0) + let x = a.getFloat(1) + addFloatRoundtrip(p.strVal, x) + + registerCallback c, "stdlib.formatfloat.addFloatSprintf", proc(a: VmArgs) = + let p = a.getVar(0) + let x = a.getFloat(1) + addFloatSprintf(p.strVal, x) + + registerCallback c, "stdlib.strutils.formatBiggestFloat", proc(a: VmArgs) = + setResult(a, formatBiggestFloat(a.getFloat(0), FloatFormatMode(a.getInt(1)), + a.getInt(2), chr(a.getInt(3)))) + + wrapIterator("stdlib.envvars.envPairsImplSeq"): envPairs() + + registerCallback c, "stdlib.marshal.toVM", proc(a: VmArgs) = + let typ = a.getNode(0).typ + case typ.kind + of tyInt..tyInt64, tyUInt..tyUInt64: + setResult(a, loadAny(a.getString(1), typ, c.cache, c.config, c.idgen).intVal) + of tyFloat..tyFloat128: + setResult(a, loadAny(a.getString(1), typ, c.cache, c.config, c.idgen).floatVal) + else: + setResult(a, loadAny(a.getString(1), typ, c.cache, c.config, c.idgen)) + + registerCallback c, "stdlib.marshal.loadVM", proc(a: VmArgs) = + let typ = a.getNode(0).typ + let p = a.getReg(1) + var res: string = "" + storeAny(res, typ, regToNode(p[]), c.config) + setResult(a, res) diff --git a/compiler/vmprofiler.nim b/compiler/vmprofiler.nim index f586c8ffe..3f0db84bd 100644 --- a/compiler/vmprofiler.nim +++ b/compiler/vmprofiler.nim @@ -1,7 +1,7 @@ -import - options, vmdef, times, lineinfos, strutils, tables, - msgs +import options, vmdef, lineinfos, msgs + +import std/[times, strutils, tables] proc enter*(prof: var Profiler, c: PCtx, tos: PStackFrame) {.inline.} = if optProfileVM in c.config.globalOptions: @@ -28,11 +28,11 @@ proc leave*(prof: var Profiler, c: PCtx) {.inline.} = proc dump*(conf: ConfigRef, pd: ProfileData): string = var data = pd.data - echo "\nprof: µs #instr location" + result = "\nprof: µs #instr location" for i in 0..<32: var tMax: float - var infoMax: ProfileInfo - var flMax: TLineInfo + var infoMax: ProfileInfo = default(ProfileInfo) + var flMax: TLineInfo = default(TLineInfo) for fl, info in data: if info.time > infoMax.time: infoMax = info diff --git a/compiler/vtables.nim b/compiler/vtables.nim new file mode 100644 index 000000000..928c64dd5 --- /dev/null +++ b/compiler/vtables.nim @@ -0,0 +1,167 @@ +import ast, modulegraphs, magicsys, lineinfos, options, cgmeth, types +import std/[algorithm, tables, intsets, assertions] + + + +proc genVTableDispatcher(g: ModuleGraph; methods: seq[PSym]; index: int): PSym = +#[ +proc dispatch(x: Base, params: ...) = + cast[proc bar(x: Base, params: ...)](x.vTable[index])(x, params) +]# + var base = methods[0].ast[dispatcherPos].sym + result = base + var paramLen = base.typ.signatureLen + var body = newNodeI(nkStmtList, base.info) + + var disp = newNodeI(nkIfStmt, base.info) + + var vTableAccess = newNodeIT(nkBracketExpr, base.info, base.typ) + let nimGetVTableSym = getCompilerProc(g, "nimGetVTable") + let ptrPNimType = nimGetVTableSym.typ.n[1].sym.typ + + var nTyp = base.typ.n[1].sym.typ + var dispatchObject = newSymNode(base.typ.n[1].sym) + if nTyp.kind == tyObject: + dispatchObject = newTree(nkAddr, dispatchObject) + else: + if g.config.backend != backendCpp: # TODO: maybe handle ptr? + if nTyp.kind == tyVar and nTyp.skipTypes({tyVar}).kind != tyObject: + dispatchObject = newTree(nkDerefExpr, dispatchObject) + + var getVTableCall = newTree(nkCall, + newSymNode(nimGetVTableSym), + dispatchObject, + newIntNode(nkIntLit, index) + ) + getVTableCall.typ = base.typ + var vTableCall = newNodeIT(nkCall, base.info, base.typ.returnType) + var castNode = newTree(nkCast, + newNodeIT(nkType, base.info, base.typ), + getVTableCall) + + castNode.typ = base.typ + vTableCall.add castNode + for col in 1..<paramLen: + let param = base.typ.n[col].sym + vTableCall.add newSymNode(param) + + var ret: PNode + if base.typ.returnType != nil: + var a = newNodeI(nkFastAsgn, base.info) + a.add newSymNode(base.ast[resultPos].sym) + a.add vTableCall + ret = newNodeI(nkReturnStmt, base.info) + ret.add a + else: + ret = vTableCall + + if base.typ.n[1].sym.typ.skipTypes(abstractInst).kind in {tyRef, tyPtr}: + let ifBranch = newNodeI(nkElifBranch, base.info) + let boolType = getSysType(g, unknownLineInfo, tyBool) + var isNil = getSysMagic(g, unknownLineInfo, "isNil", mIsNil) + let checkSelf = newNodeIT(nkCall, base.info, boolType) + checkSelf.add newSymNode(isNil) + checkSelf.add newSymNode(base.typ.n[1].sym) + ifBranch.add checkSelf + ifBranch.add newTree(nkCall, + newSymNode(getCompilerProc(g, "chckNilDisp")), newSymNode(base.typ.n[1].sym)) + let elseBranch = newTree(nkElifBranch, ret) + disp.add ifBranch + disp.add elseBranch + else: + disp = ret + + body.add disp + body.flags.incl nfTransf # should not be further transformed + result.ast[bodyPos] = body + +proc containGenerics(base: PType, s: seq[tuple[depth: int, value: PType]]): bool = + result = tfHasMeta in base.flags + for i in s: + if tfHasMeta in i.value.flags: + result = true + break + +proc collectVTableDispatchers*(g: ModuleGraph) = + var itemTable = initTable[ItemId, seq[LazySym]]() + var rootTypeSeq = newSeq[PType]() + var rootItemIdCount = initCountTable[ItemId]() + for bucket in 0..<g.methods.len: + var relevantCols = initIntSet() + if relevantCol(g.methods[bucket].methods, 1): incl(relevantCols, 1) + sortBucket(g.methods[bucket].methods, relevantCols) + let base = g.methods[bucket].methods[^1] + let baseType = base.typ.firstParamType.skipTypes(skipPtrs-{tyTypeDesc}) + if baseType.itemId in g.objectTree and not containGenerics(baseType, g.objectTree[baseType.itemId]): + let methodIndexLen = g.bucketTable[baseType.itemId] + if baseType.itemId notin itemTable: # once is enough + rootTypeSeq.add baseType + itemTable[baseType.itemId] = newSeq[LazySym](methodIndexLen) + + sort(g.objectTree[baseType.itemId], cmp = proc (x, y: tuple[depth: int, value: PType]): int = + if x.depth >= y.depth: 1 + else: -1 + ) + + for item in g.objectTree[baseType.itemId]: + if item.value.itemId notin itemTable: + itemTable[item.value.itemId] = newSeq[LazySym](methodIndexLen) + + var mIndex = 0 # here is the correpsonding index + if baseType.itemId notin rootItemIdCount: + rootItemIdCount[baseType.itemId] = 1 + else: + mIndex = rootItemIdCount[baseType.itemId] + rootItemIdCount.inc(baseType.itemId) + for idx in 0..<g.methods[bucket].methods.len: + let obj = g.methods[bucket].methods[idx].typ.firstParamType.skipTypes(skipPtrs) + itemTable[obj.itemId][mIndex] = LazySym(sym: g.methods[bucket].methods[idx]) + g.addDispatchers genVTableDispatcher(g, g.methods[bucket].methods, mIndex) + else: # if the base object doesn't have this method + g.addDispatchers genIfDispatcher(g, g.methods[bucket].methods, relevantCols, g.idgen) + +proc sortVTableDispatchers*(g: ModuleGraph) = + var itemTable = initTable[ItemId, seq[LazySym]]() + var rootTypeSeq = newSeq[ItemId]() + var rootItemIdCount = initCountTable[ItemId]() + for bucket in 0..<g.methods.len: + var relevantCols = initIntSet() + if relevantCol(g.methods[bucket].methods, 1): incl(relevantCols, 1) + sortBucket(g.methods[bucket].methods, relevantCols) + let base = g.methods[bucket].methods[^1] + let baseType = base.typ.firstParamType.skipTypes(skipPtrs-{tyTypeDesc}) + if baseType.itemId in g.objectTree and not containGenerics(baseType, g.objectTree[baseType.itemId]): + let methodIndexLen = g.bucketTable[baseType.itemId] + if baseType.itemId notin itemTable: # once is enough + rootTypeSeq.add baseType.itemId + itemTable[baseType.itemId] = newSeq[LazySym](methodIndexLen) + + sort(g.objectTree[baseType.itemId], cmp = proc (x, y: tuple[depth: int, value: PType]): int = + if x.depth >= y.depth: 1 + else: -1 + ) + + for item in g.objectTree[baseType.itemId]: + if item.value.itemId notin itemTable: + itemTable[item.value.itemId] = newSeq[LazySym](methodIndexLen) + + var mIndex = 0 # here is the correpsonding index + if baseType.itemId notin rootItemIdCount: + rootItemIdCount[baseType.itemId] = 1 + else: + mIndex = rootItemIdCount[baseType.itemId] + rootItemIdCount.inc(baseType.itemId) + for idx in 0..<g.methods[bucket].methods.len: + let obj = g.methods[bucket].methods[idx].typ.firstParamType.skipTypes(skipPtrs) + itemTable[obj.itemId][mIndex] = LazySym(sym: g.methods[bucket].methods[idx]) + + for baseType in rootTypeSeq: + g.setMethodsPerType(baseType, itemTable[baseType]) + for item in g.objectTree[baseType]: + let typ = item.value.skipTypes(skipPtrs) + let idx = typ.itemId + for mIndex in 0..<itemTable[idx].len: + if itemTable[idx][mIndex].sym == nil: + let parentIndex = typ.baseClass.skipTypes(skipPtrs).itemId + itemTable[idx][mIndex] = itemTable[parentIndex][mIndex] + g.setMethodsPerType(idx, itemTable[idx]) diff --git a/compiler/wordrecg.nim b/compiler/wordrecg.nim index 6a68e2c70..39e0b2e25 100644 --- a/compiler/wordrecg.nim +++ b/compiler/wordrecg.nim @@ -17,99 +17,112 @@ type TSpecialWord* = enum wInvalid = "", wAddr = "addr", wAnd = "and", wAs = "as", wAsm = "asm", - wBind = "bind", wBlock = "block", wBreak = "break", wCase = "case", wCast = "cast", - wConcept = "concept", wConst = "const", wContinue = "continue", wConverter = "converter", + wBind = "bind", wBlock = "block", wBreak = "break", wCase = "case", wCast = "cast", + wConcept = "concept", wConst = "const", wContinue = "continue", wConverter = "converter", wDefer = "defer", wDiscard = "discard", wDistinct = "distinct", wDiv = "div", wDo = "do", - wElif = "elif", wElse = "else", wEnd = "end", wEnum = "enum", wExcept = "except", - wExport = "export", wFinally = "finally", wFor = "for", wFrom = "from", wFunc = "func", - wIf = "if", wImport = "import", wIn = "in", wInclude = "include", wInterface = "interface", + wElif = "elif", wElse = "else", wEnd = "end", wEnum = "enum", wExcept = "except", + wExport = "export", wFinally = "finally", wFor = "for", wFrom = "from", wFunc = "func", + wIf = "if", wImport = "import", wIn = "in", wInclude = "include", wInterface = "interface", wIs = "is", wIsnot = "isnot", wIterator = "iterator", wLet = "let", wMacro = "macro", - wMethod = "method", wMixin = "mixin", wMod = "mod", wNil = "nil", wNot = "not", wNotin = "notin", - wObject = "object", wOf = "of", wOr = "or", wOut = "out", wProc = "proc", wPtr = "ptr", - wRaise = "raise", wRef = "ref", wReturn = "return", wShl = "shl", wShr = "shr", wStatic = "static", - wTemplate = "template", wTry = "try", wTuple = "tuple", wType = "type", wUsing = "using", + wMethod = "method", wMixin = "mixin", wMod = "mod", wNil = "nil", wNot = "not", wNotin = "notin", + wObject = "object", wOf = "of", wOr = "or", wOut = "out", wProc = "proc", wPtr = "ptr", + wRaise = "raise", wRef = "ref", wReturn = "return", wShl = "shl", wShr = "shr", wStatic = "static", + wTemplate = "template", wTry = "try", wTuple = "tuple", wType = "type", wUsing = "using", wVar = "var", wWhen = "when", wWhile = "while", wXor = "xor", wYield = "yield", wColon = ":", wColonColon = "::", wEquals = "=", wDot = ".", wDotDot = "..", wStar = "*", wMinus = "-", - wMagic = "magic", wThread = "thread", wFinal = "final", wProfiler = "profiler", + wUnderscore = "_", + wMagic = "magic", wThread = "thread", wFinal = "final", wProfiler = "profiler", wMemTracker = "memtracker", wObjChecks = "objchecks", - wIntDefine = "intdefine", wStrDefine = "strdefine", wBoolDefine = "booldefine", - wCursor = "cursor", wNoalias = "noalias", + wIntDefine = "intdefine", wStrDefine = "strdefine", wBoolDefine = "booldefine", + wCursor = "cursor", wNoalias = "noalias", wEffectsOf = "effectsOf", + wUncheckedAssign = "uncheckedAssign", wRunnableExamples = "runnableExamples", - wImmediate = "immediate", wConstructor = "constructor", wDestructor = "destructor", + wImmediate = "immediate", wConstructor = "constructor", wDestructor = "destructor", wDelegator = "delegator", wOverride = "override", wImportCpp = "importcpp", - wCppNonPod = "cppNonPod", - wImportObjC = "importobjc", wImportCompilerProc = "importcompilerproc", - wImportc = "importc", wImportJs = "importjs", wExportc = "exportc", wExportCpp = "exportcpp", + wCppNonPod = "cppNonPod", + wImportObjC = "importobjc", wImportCompilerProc = "importCompilerProc", + wImportc = "importc", wImportJs = "importjs", wExportc = "exportc", wExportCpp = "exportcpp", wExportNims = "exportnims", wIncompleteStruct = "incompleteStruct", # deprecated wCompleteStruct = "completeStruct", wRequiresInit = "requiresInit", wAlign = "align", wNodecl = "nodecl", wPure = "pure", wSideEffect = "sideEffect", wHeader = "header", wNoSideEffect = "noSideEffect", wGcSafe = "gcsafe", wNoreturn = "noreturn", - wNosinks = "nosinks", wMerge = "merge", wLib = "lib", wDynlib = "dynlib", - wCompilerProc = "compilerproc", wCore = "core", wProcVar = "procvar", - wBase = "base", wUsed = "used", wFatal = "fatal", wError = "error", wWarning = "warning", + wNosinks = "nosinks", wLib = "lib", wDynlib = "dynlib", + wCompilerProc = "compilerproc", wCore = "core", wProcVar = "procvar", + wBase = "base", wUsed = "used", wFatal = "fatal", wError = "error", wWarning = "warning", wHint = "hint", wWarningAsError = "warningAsError", wHintAsError = "hintAsError", wLine = "line", wPush = "push", - wPop = "pop", wDefine = "define", wUndef = "undef", wLineDir = "lineDir", + wPop = "pop", wDefine = "define", wUndef = "undef", wLineDir = "lineDir", wStackTrace = "stackTrace", wLineTrace = "lineTrace", wLink = "link", wCompile = "compile", - wLinksys = "linksys", wDeprecated = "deprecated", wVarargs = "varargs", wCallconv = "callconv", - wDebugger = "debugger", wNimcall = "nimcall", wStdcall = "stdcall", wCdecl = "cdecl", + wLinksys = "linksys", wDeprecated = "deprecated", wVarargs = "varargs", wCallconv = "callconv", + wDebugger = "debugger", wNimcall = "nimcall", wStdcall = "stdcall", wCdecl = "cdecl", wSafecall = "safecall", wSyscall = "syscall", wInline = "inline", wNoInline = "noinline", wFastcall = "fastcall", wThiscall = "thiscall", wClosure = "closure", wNoconv = "noconv", - wOn = "on", wOff = "off", wChecks = "checks", wRangeChecks = "rangeChecks", + wOn = "on", wOff = "off", wChecks = "checks", wRangeChecks = "rangeChecks", wBoundChecks = "boundChecks", wOverflowChecks = "overflowChecks", wNilChecks = "nilChecks", - wFloatChecks = "floatChecks", wNanChecks = "nanChecks", wInfChecks = "infChecks", + wFloatChecks = "floatChecks", wNanChecks = "nanChecks", wInfChecks = "infChecks", wStyleChecks = "styleChecks", wStaticBoundchecks = "staticBoundChecks", wNonReloadable = "nonReloadable", wExecuteOnReload = "executeOnReload", - wAssertions = "assertions", wPatterns = "patterns", wTrMacros = "trmacros", + wAssertions = "assertions", wPatterns = "patterns", wTrMacros = "trmacros", wSinkInference = "sinkInference", wWarnings = "warnings", - wHints = "hints", wOptimization = "optimization", wRaises = "raises", + wHints = "hints", wOptimization = "optimization", wRaises = "raises", wWrites = "writes", wReads = "reads", wSize = "size", wEffects = "effects", wTags = "tags", - wRequires = "requires", wEnsures = "ensures", wInvariant = "invariant", + wForbids = "forbids", wRequires = "requires", wEnsures = "ensures", wInvariant = "invariant", wAssume = "assume", wAssert = "assert", wDeadCodeElimUnused = "deadCodeElim", # deprecated, dead code elim always happens wSafecode = "safecode", wPackage = "package", wNoForward = "noforward", wReorder = "reorder", wNoRewrite = "norewrite", wNoDestroy = "nodestroy", wPragma = "pragma", wCompileTime = "compileTime", wNoInit = "noinit", wPassc = "passc", wPassl = "passl", - wLocalPassc = "localPassC", wBorrow = "borrow", wDiscardable = "discardable", + wLocalPassc = "localPassC", wBorrow = "borrow", wDiscardable = "discardable", wFieldChecks = "fieldChecks", wSubsChar = "subschar", wAcyclic = "acyclic", wShallow = "shallow", wUnroll = "unroll", wLinearScanEnd = "linearScanEnd", - wComputedGoto = "computedGoto", wInjectStmt = "injectStmt", wExperimental = "experimental", - wWrite = "write", wGensym = "gensym", wInject = "inject", wDirty = "dirty", + wComputedGoto = "computedGoto", wExperimental = "experimental", wDoctype = "doctype", + wWrite = "write", wGensym = "gensym", wInject = "inject", wDirty = "dirty", wInheritable = "inheritable", wThreadVar = "threadvar", wEmit = "emit", - wAsmNoStackFrame = "asmNoStackFrame", wImplicitStatic = "implicitStatic", + wAsmNoStackFrame = "asmNoStackFrame", wAsmSyntax = "asmSyntax", wImplicitStatic = "implicitStatic", wGlobal = "global", wCodegenDecl = "codegenDecl", wUnchecked = "unchecked", wGuard = "guard", wLocks = "locks", wPartial = "partial", wExplain = "explain", - wLiftLocals = "liftlocals", - - wAuto = "auto", wBool = "bool", wCatch = "catch", wChar = "char", - wClass = "class", wCompl = "compl", wConst_cast = "const_cast", wDefault = "default", - wDelete = "delete", wDouble = "double", wDynamic_cast = "dynamic_cast", - wExplicit = "explicit", wExtern = "extern", wFalse = "false", wFloat = "float", - wFriend = "friend", wGoto = "goto", wInt = "int", wLong = "long", wMutable = "mutable", - wNamespace = "namespace", wNew = "new", wOperator = "operator", wPrivate = "private", - wProtected = "protected", wPublic = "public", wRegister = "register", - wReinterpret_cast = "reinterpret_cast", wRestrict = "restrict", wShort = "short", - wSigned = "signed", wSizeof = "sizeof", wStatic_cast = "static_cast", wStruct = "struct", - wSwitch = "switch", wThis = "this", wThrow = "throw", wTrue = "true", wTypedef = "typedef", + wLiftLocals = "liftlocals", wEnforceNoRaises = "enforceNoRaises", wSystemRaisesDefect = "systemRaisesDefect", + wRedefine = "redefine", wCallsite = "callsite", + wQuirky = "quirky", + + # codegen keywords, but first the ones that are also pragmas: + wExtern = "extern", wGoto = "goto", wRegister = "register", + wUnion = "union", wPacked = "packed", wVirtual = "virtual", + wVolatile = "volatile", wMember = "member", + wByCopy = "bycopy", wByRef = "byref", + + # codegen keywords but not pragmas: + wAuto = "auto", wBool = "bool", wCatch = "catch", wChar = "char", + wClass = "class", wCompl = "compl", wConstCast = "const_cast", wDefault = "default", + wDelete = "delete", wDouble = "double", wDynamicCast = "dynamic_cast", + wExplicit = "explicit", wFalse = "false", wFloat = "float", + wFriend = "friend", wInt = "int", wLong = "long", wMutable = "mutable", + wNamespace = "namespace", wNew = "new", wOperator = "operator", wPrivate = "private", + wProtected = "protected", wPublic = "public", + wReinterpretCast = "reinterpret_cast", wRestrict = "restrict", wShort = "short", + wSigned = "signed", wSizeof = "sizeof", wStaticCast = "static_cast", wStruct = "struct", + wSwitch = "switch", wThis = "this", wThrow = "throw", wTrue = "true", wTypedef = "typedef", wTypeid = "typeid", wTypeof = "typeof", wTypename = "typename", - wUnion = "union", wPacked = "packed", wUnsigned = "unsigned", wVirtual = "virtual", - wVoid = "void", wVolatile = "volatile", wWchar_t = "wchar_t", + wUnsigned = "unsigned", wVoid = "void", - wAlignas = "alignas", wAlignof = "alignof", wConstexpr = "constexpr", wDecltype = "decltype", + wAlignas = "alignas", wAlignof = "alignof", wConstexpr = "constexpr", wDecltype = "decltype", wNullptr = "nullptr", wNoexcept = "noexcept", - wThread_local = "thread_local", wStatic_assert = "static_assert", - wChar16_t = "char16_t", wChar32_t = "char32_t", + wThreadLocal = "thread_local", wStaticAssert = "static_assert", + wChar16 = "char16_t", wChar32 = "char32_t", wWchar = "wchar_t", wStdIn = "stdin", wStdOut = "stdout", wStdErr = "stderr", - wInOut = "inout", wByCopy = "bycopy", wByRef = "byref", wOneWay = "oneway", - wBitsize = "bitsize" + wInOut = "inout", wOneWay = "oneway", + # end of codegen keywords + + wBitsize = "bitsize", wImportHidden = "all", + wSendable = "sendable" TSpecialWords* = set[TSpecialWord] @@ -120,28 +133,18 @@ const nimKeywordsLow* = ord(wAsm) nimKeywordsHigh* = ord(wYield) - ccgKeywordsLow* = ord(wAuto) + ccgKeywordsLow* = ord(wExtern) ccgKeywordsHigh* = ord(wOneWay) cppNimSharedKeywords* = { wAsm, wBreak, wCase, wConst, wContinue, wDo, wElse, wEnum, wExport, wFor, wIf, wReturn, wStatic, wTemplate, wTry, wWhile, wUsing} + + nonPragmaWordsLow* = wAuto + nonPragmaWordsHigh* = wOneWay -const enumUtilsExist = compiles: - import std/enumutils - -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.} = - # 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 +from std/enumutils import genEnumCaseStmt +from std/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) |